From a9184d5e4bed3dd08367e3f77b9067e8e780bc3d Mon Sep 17 00:00:00 2001
From: aheinri5 <Anna@netzkritzler.de>
Date: Wed, 21 Oct 2020 15:03:35 +0200
Subject: [PATCH] Some experiments with reading files, added a few prefabs for
later tests, added minor corrections to functions after noticing some things
in the benchmark files ("name" attribute of gml points can also be something
else than "origin" now, point tibbles without a "name" column are now
accepted, polylines can now have more than 2 points and are still written to
xml correctly)
---
DESCRIPTION | 3 +-
NAMESPACE | 4 +-
R/create_gml.R | 27 ++-
R/create_gml_R6.R | 17 --
R/create_vtu.R | 16 ++
R/gml_prefabs.R | 214 ++++++++++++++++++
R/read_input_from_file.R | 26 +++
R/user_input.R | 33 ++-
R/validate_gml.R | 66 ++++++
inst/extdata/gml_points_with_names.tsv | 8 +
inst/extdata/gml_points_without_names.tsv | 8 +
man/GMLPoints.Rd | 10 -
...t_gml_to_file.Rd => export_xml_to_file.Rd} | 8 +-
man/{data_to_xml.Rd => gml_data_to_xml.Rd} | 6 +-
man/new_r2ogs6_gml_bar.Rd | 11 +
man/new_r2ogs6_gml_circle_1_axi.Rd | 11 +
man/new_r2ogs6_gml_cube_1x1x1.Rd | 11 +
man/new_r2ogs6_gml_hm1_1Dbeam.Rd | 11 +
man/new_r2ogs6_gml_hm1_2Dsquare.Rd | 11 +
man/new_r2ogs6_gml_hm1_3Dcube.Rd | 11 +
man/new_r2ogs6_gml_hm1_3Dgravity.Rd | 11 +
man/new_r2ogs6_gml_quad_1x10.Rd | 11 +
man/new_r2ogs6_gml_square_1x1.Rd | 11 +
man/points_to_xml.Rd | 2 +-
man/read_gml_points.Rd | 20 ++
man/validate_points.Rd | 18 ++
my_experimental_cube.gml | 90 ++++++++
tests/testthat/test-read_input_from_file.R | 12 +
tests/testthat/test-validate_gml.R | 24 ++
29 files changed, 656 insertions(+), 55 deletions(-)
create mode 100644 R/create_vtu.R
create mode 100644 R/gml_prefabs.R
create mode 100644 R/read_input_from_file.R
create mode 100644 R/validate_gml.R
create mode 100644 inst/extdata/gml_points_with_names.tsv
create mode 100644 inst/extdata/gml_points_without_names.tsv
rename man/{export_gml_to_file.Rd => export_xml_to_file.Rd} (59%)
rename man/{data_to_xml.Rd => gml_data_to_xml.Rd} (82%)
create mode 100644 man/new_r2ogs6_gml_bar.Rd
create mode 100644 man/new_r2ogs6_gml_circle_1_axi.Rd
create mode 100644 man/new_r2ogs6_gml_cube_1x1x1.Rd
create mode 100644 man/new_r2ogs6_gml_hm1_1Dbeam.Rd
create mode 100644 man/new_r2ogs6_gml_hm1_2Dsquare.Rd
create mode 100644 man/new_r2ogs6_gml_hm1_3Dcube.Rd
create mode 100644 man/new_r2ogs6_gml_hm1_3Dgravity.Rd
create mode 100644 man/new_r2ogs6_gml_quad_1x10.Rd
create mode 100644 man/new_r2ogs6_gml_square_1x1.Rd
create mode 100644 man/read_gml_points.Rd
create mode 100644 man/validate_points.Rd
create mode 100644 my_experimental_cube.gml
create mode 100644 tests/testthat/test-read_input_from_file.R
create mode 100644 tests/testthat/test-validate_gml.R
diff --git a/DESCRIPTION b/DESCRIPTION
index b845145..9cc1085 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -22,5 +22,6 @@ Imports:
checkmate,
tibble,
R6,
- stringr
+ stringr,
+ readr
RoxygenNote: 7.1.1
diff --git a/NAMESPACE b/NAMESPACE
index bd01f7e..ad776bc 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,7 +1,7 @@
# Generated by roxygen2: do not edit by hand
-export(data_to_xml)
-export(export_gml_to_file)
+export(export_xml_to_file)
+export(gml_data_to_xml)
export(points_to_xml)
export(polylines_to_xml)
export(surfaces_to_xml)
diff --git a/R/create_gml.R b/R/create_gml.R
index c6222ad..4fa6a13 100644
--- a/R/create_gml.R
+++ b/R/create_gml.R
@@ -1,13 +1,13 @@
#This script contains various functions to turn data for a .gml file into the correct XML format
#' Export function
-#' @param gml_data The .gml data (already in XML friendly format)
+#' @param xml_data The .gml data (already in XML friendly format)
#' @param file_name The name of the .gml file to be written
# @examples
-# export_gml_to_file(my_gml)
+# export_xml_to_file(my_gml)
#' @export
-export_gml_to_file <- function(gml_data, file_name) {
- doc <- xml2::as_xml_document(gml_data)
+export_xml_to_file <- function(xml_data, file_name) {
+ doc <- xml2::as_xml_document(xml_data)
xml2::write_xml(doc, file_name, options = "format", encoding="ISO-8859-1")
invisible()
}
@@ -21,7 +21,7 @@ export_gml_to_file <- function(gml_data, file_name) {
#' @return A XML document ready for export to a file
# @examples (WIP)
#' @export
-data_to_xml <- function(geo_name, points_tibble, polylines_list, surfaces_list) {
+gml_data_to_xml <- function(geo_name, points_tibble, polylines_list, surfaces_list) {
#data_node <- xml2::read_xml('<OpenGeoSysGLI xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:ogs="http://www.opengeosys.org"/>')
@@ -42,14 +42,15 @@ data_to_xml <- function(geo_name, points_tibble, polylines_list, surfaces_list)
#' @param point_tibble The specified tibble
#' @return An XML node containing the points
#' @examples
-#' my_tibble <- tibble::tibble(x = c(0, 0), y = c(0, 0), z = c(0, 1),is_origin = c(TRUE, FALSE))
+#' my_tibble <- tibble::tibble(x = c(0, 0), y = c(0, 0), z = c(0, 1), name = c("origin", ""))
#' point_node <- points_to_xml(my_tibble)
#' @export
points_to_xml <- function(point_tibble) {
points_node <- list(points = list())
+ has_names <- (length(point_tibble) == 4)
for(i in 1:length(point_tibble[[1]])){
- if(!point_tibble[[4]][[i]]) {
+ if(!has_names || point_tibble[[4]][[i]] == "") {
points_node[[1]] <- c(points_node[[1]], list(point = structure(list(),
id = (i-1),
x = point_tibble[[1]][[i]],
@@ -61,7 +62,7 @@ points_to_xml <- function(point_tibble) {
x = point_tibble[[1]][[i]],
y = point_tibble[[2]][[i]],
z = point_tibble[[3]][[i]],
- name = "origin")))
+ name = point_tibble[[4]][[i]])))
}
}
@@ -79,8 +80,14 @@ polylines_to_xml <- function(polyline_list) {
polylines_node <- list(polylines = list())
for(i in 1:length(polyline_list)){
- polylines_node[[1]] <- c(polylines_node[[1]], list(polyline = structure(list(pnt = list(polyline_list[[i]][[2]][[1]]),
- pnt = list(polyline_list[[i]][[2]][[2]])),
+
+ pnt_list <- list()
+
+ for(j in 1:length(polyline_list[[i]][[2]])) {
+ pnt_list <- c(pnt_list, list(pnt = list(polyline_list[[i]][[2]][[j]])))
+ }
+
+ polylines_node[[1]] <- c(polylines_node[[1]], list(polyline = structure(pnt_list,
id = (i-1),
name = polyline_list[[i]][[1]])))
}
diff --git a/R/create_gml_R6.R b/R/create_gml_R6.R
index 1e0c7cc..e08168a 100644
--- a/R/create_gml_R6.R
+++ b/R/create_gml_R6.R
@@ -223,7 +223,6 @@ GMLPoints <- R6::R6Class("GMLPoints",
private$.ids <- self$validate_ids(gml_points)
self$validate_dim(gml_points)
self$validate_coordinates(gml_points)
- self$validate_origin(gml_points)
private$.gml_points <- gml_points
},
@@ -259,22 +258,6 @@ GMLPoints <- R6::R6Class("GMLPoints",
}
},
- validate_origin = function(gml_points){
- found_origin <- FALSE
- for(i in 1:length(gml_points)){
- if (gml_points[[i]]$is_origin == TRUE){
- if(found_origin){
- stop("More than one origin point detected", call. = FALSE)
- }else{
- found_origin <- TRUE
- }
- }
- }
- if(!found_origin){
- stop("No origin point detected", call. = FALSE)
- }
- },
-
as_list = function(...) {
points_list <- list()
diff --git a/R/create_vtu.R b/R/create_vtu.R
new file mode 100644
index 0000000..1befbde
--- /dev/null
+++ b/R/create_vtu.R
@@ -0,0 +1,16 @@
+#This script contains various functions to turn data for a .vtu file into the correct XML format
+
+vtu_data_to_xml <- function() {
+
+
+}
+
+
+
+vtu_piece_to_xml <- function(n_points, n_cells, point_data, cell_data, points, cells) {
+ piece_node <- list(piece = structure(list(),
+ NumberOfPoints = 0,
+ NumberOfCells = 0))
+ return(xml2::as_xml_document(piece_node))
+}
+
diff --git a/R/gml_prefabs.R b/R/gml_prefabs.R
new file mode 100644
index 0000000..296f100
--- /dev/null
+++ b/R/gml_prefabs.R
@@ -0,0 +1,214 @@
+#This script contains some useful S3 classes for premade geometry
+
+#'Constructor based on HydroMechanics/IdealGas/flow_free_expansion/cube_1x1x1.gml
+new_r2ogs6_gml_cube_1x1x1 <- function() {
+ structure(list(
+ gml_geometry_name = "cube_1x1x1_geometry",
+
+ #Cube points (will become second XML child under root)
+ gml_points = tibble::tibble(x = c(0, 0, 0, 0, 1, 1, 1, 1),
+ y = c(0, 0, 1, 1, 0, 0, 1, 1),
+ z = c(0, 1, 1, 0, 0, 1, 1, 0),
+ name = c("origin", rep("", 7))),
+
+ #Cube polylines (will become third XML child under root)
+ gml_polylines = list(list(name = "front_left", c(0, 1)),
+ list(name = "front_right", c(4, 5)),
+ list(name = "front_bottom", c(0, 4)),
+ list(name = "front_top", c(1, 5)),
+ list(name = "bottom_left", c(0, 3)),
+ list(name = "bottom_right", c(4, 7)),
+ list(name = "top_left", c(1, 2)),
+ list(name = "top_right", c(5, 6)),
+ list(name = "back_left", c(2, 3)),
+ list(name = "back_right", c(6, 7)),
+ list(name = "back_bottom", c(3, 7)),
+ list(name = "back_top", c(2, 6))),
+
+ #Cube surfaces (will become fourth XML child under root)
+ gml_surfaces = list(list(name = "left", c(0, 1, 2), c(0, 3, 2)),
+ list(name = "right", c(4, 6, 5), c(4, 6, 7)),
+ list(name = "top", c(1, 2, 5), c(5, 2, 6)),
+ list(name = "bottom", c(0, 3, 4), c(4, 3, 7)),
+ list(name = "front", c(0, 1, 4), c(4, 1, 5)),
+ list(name = "back", c(2, 3, 6), c(6, 3, 7)))
+
+ ), class = "r2ogs6_gml_prefab")
+}
+
+
+#Another cube but without polylines
+
+
+#'Constructor based on HydroMechanics/IdealGas/flow_no_strain/square_1x1.gml
+new_r2ogs6_gml_square_1x1 <- function() {
+ structure(list(
+ gml_geometry_name = "square_1x1_geometry",
+ gml_points = tibble::tibble(x = c(0, 0, 1, 1),
+ y = c(0, 1, 0, 1),
+ z = c(0, 0, 0, 0),
+ name = c("origin", rep("", 3))),
+ gml_polylines = list(list(name = "left", c(0, 1)),
+ list(name = "right", c(2, 3)),
+ list(name = "bottom", c(0, 2)),
+ list(name = "top", c(1, 3)))
+ ), class = "r2ogs6_gml_prefab")
+}
+
+
+#'Constructor based on HydroMechanics/IdealGas/flow_pressure_boundary/quad_1x10.gml
+new_r2ogs6_gml_quad_1x10 <- function() {
+ structure(list(
+ gml_geometry_name = "quad_1x10_geometry",
+ gml_points = tibble::tibble(x = c(0, 0, 10, 10),
+ y = c(0, 1, 0, 1),
+ z = c(0, 0, 0, 0),
+ name = c("origin", rep("", 3))),
+
+ gml_polylines = list(list(name = "left", c(0, 1)),
+ list(name = "right", c(2, 3)),
+ list(name = "bottom", c(0, 2)),
+ list(name = "top", c(1, 3)))
+ ), class = "r2ogs6_gml_prefab")
+}
+
+
+#'Constructor based on HydroMechanics/StaggeredScheme/InjectionProduction1D/bar.gml
+new_r2ogs6_gml_bar <- function() {
+ structure(list(
+ gml_geometry_name = "bar",
+ gml_points = tibble::tibble(x = c(0, 10, 10, 0),
+ y = c(0, 0, 150, 150),
+ z = c(0, 0, 0, 0),
+ name = c(rep("", 4))),
+
+ gml_polylines = list(list(name = "left", c(0, 3)),
+ list(name = "right", c(1, 2)),
+ list(name = "bottom", c(0, 1)),
+ list(name = "top", c(2, 3)))
+ ), class = "r2ogs6_gml_prefab")
+}
+
+
+#'Constructor based on HydroMechanics/Verification/hm1_1Dbeam.gml
+new_r2ogs6_gml_hm1_1Dbeam <- function() {
+ structure(list(
+ gml_geometry_name = "geometry",
+ gml_points = tibble::tibble(x = c(1, 1, 1, 1, 0, 0, 0, 0),
+ y = c(0.10000000000000001, 0, 0, 0.10000000000000001,
+ 0, 0, 0.10000000000000001, 0.10000000000000001),
+ z = c(0, 0, 0.10000000000000001, 0.10000000000000001,
+ 0, 0.10000000000000001, 0, 0.10000000000000001),
+ name = c("POINT0", "POINT1", "POINT2", "POINT3",
+ "POINT4", "POINT7", "POINT8", "POINT22")),
+
+ gml_polylines = list(list(name = "POLYLINE1", c(0, 1, 2, 3, 0)),
+ list(name = "POLYLINE2", c(4, 1, 2, 5, 4)),
+ list(name = "POLYLINE3", c(6, 0, 3, 7, 6)),
+ list(name = "POLYLINE4", c(4, 1, 0, 6, 4)),
+ list(name = "POLYLINE5", c(5, 2, 3, 7, 5)),
+ list(name = "POLYLINE6", c(4, 6, 7, 5, 4)),
+ list(name = "POLYLINE7", c(1, 0, 3, 2, 1))),
+
+ gml_surfaces = list(list(name = "SURFACE1", c(0, 2, 1), c(2, 0, 3)),
+ list(name = "SURFACE2", c(4, 2, 1), c(2, 4, 5)),
+ list(name = "SURFACE3", c(6, 3, 0), c(3, 6, 7)),
+ list(name = "SURFACE4", c(4, 0, 1), c(0, 4, 6)),
+ list(name = "SURFACE5", c(5, 3, 2), c(3, 5, 7)),
+ list(name = "SURFACE6", c(4, 7, 6), c(7, 4, 5)),
+ list(name = "SURFACE7", c(1, 3, 0), c(3, 1, 2)))
+ ), class = "r2ogs6_gml_prefab")
+}
+
+
+#'Constructor based on HydroMechanics/Verification/hm1_2Dsquare.gml
+new_r2ogs6_gml_hm1_2Dsquare <- function() {
+ structure(list(
+ gml_geometry_name = "geometry",
+ gml_points = tibble::tibble(x = c(0, 1, 1, 0, 0, 0, 1, 1),
+ y = c(0, 0, 1, 1, 1, 0, 0, 1),
+ z = c(0, 0, 0, 0, 0.10000000000000001, 0.10000000000000001,
+ 0.10000000000000001, 0.10000000000000001),
+ name = c("POINT0", "POINT1", "POINT2", "POINT3",
+ "POINT6", "POINT7", "POINT17", "POINT18")),
+
+ gml_polylines = list(list(name = "POLYLINE1", c(0, 1, 2, 3, 0)),
+ list(name = "POLYLINE2", c(0, 3, 4, 5, 0)),
+ list(name = "POLYLINE3", c(0, 1, 6, 5, 0)),
+ list(name = "POLYLINE4", c(0, 1, 2, 3, 0)),
+ list(name = "POLYLINE5", c(5, 6, 7, 4, 5))),
+
+ gml_surfaces = list(list(name = "SURFACE1", c(0, 2, 1), c(2, 0, 3)),
+ list(name = "SURFACE2", c(0, 4, 3), c(4, 0, 5)),
+ list(name = "SURFACE3", c(0, 6, 1), c(6, 0, 5)),
+ list(name = "SURFACE4", c(0, 2, 1), c(2, 0, 3)),
+ list(name = "SURFACE5", c(5, 7, 6), c(7, 5, 4)))
+ ), class = "r2ogs6_gml_prefab")
+}
+
+
+#'Constructor based on HydroMechanics/Verification/hm1_3Dcube.gml
+new_r2ogs6_gml_hm1_3Dcube <- function() {
+ structure(list(
+ gml_geometry_name = "geometry",
+ gml_points = tibble::tibble(x = c(0, 1, 1, 0, 1, 0, 0, 1),
+ y = c(0, 0, 1, 1, 0, 0, 1, 1),
+ z = c(0, 0, 0, 0, 1, 1, 1, 1),
+ name = c("POINT0", "POINT1", "POINT2", "POINT3",
+ "POINT6", "POINT7", "POINT15", "POINT14")),
+
+ gml_polylines = list(list(name = "POLYLINE1", c(0, 1, 2, 3, 0)),
+ list(name = "POLYLINE2", c(0, 1, 4, 5, 0)),
+ list(name = "POLYLINE3", c(0, 3, 6, 5, 0)),
+ list(name = "POLYLINE4", c(5, 4, 7, 6, 5))),
+
+ gml_surfaces = list(list(name = "SURFACE1", c(0, 2, 1), c(2, 0, 3)),
+ list(name = "SURFACE2", c(0, 4, 1), c(4, 0, 5)),
+ list(name = "SURFACE3", c(0, 6, 3), c(6, 0, 5)),
+ list(name = "SURFACE4", c(5, 7, 4), c(7, 5, 6)))
+ ), class = "r2ogs6_gml_prefab")
+}
+
+#'Constructor based on HydroMechanics/Verification/hm1_3Dgravity.gml
+new_r2ogs6_gml_hm1_3Dgravity <- function() {
+ structure(list(
+ gml_geometry_name = "geometry",
+ gml_points = tibble::tibble(x = c(0, 60, 60, 0, 0, 60, 60, 0),
+ y = c(0, 0, 30, 30, 0, 0, 30, 30),
+ z = c(30, 30, 30, 30, 0, 0, 0, 0),
+ name = c("POINT0", "POINT1", "POINT2", "POINT3",
+ "POINT4", "POINT5", "POINT6", "POINT7")),
+
+ gml_polylines = list(list(name = "POLYLINE1", c(0, 1, 2, 3, 0)),
+ list(name = "POLYLINE2", c(4, 5, 6, 7, 4)),
+ list(name = "POLYLINE3", c(4, 5, 1, 0, 4)),
+ list(name = "POLYLINE4", c(7, 6, 2, 3, 7)),
+ list(name = "POLYLINE5", c(4, 7, 3, 0, 4)),
+ list(name = "POLYLINE6", c(5, 6, 2, 1, 5))),
+
+ gml_surfaces = list(list(name = "SURFACE1", c(0, 2, 1), c(2, 0, 3)),
+ list(name = "SURFACE2", c(4, 6, 5), c(6, 4, 7)),
+ list(name = "SURFACE3", c(4, 1, 5), c(1, 4, 0)),
+ list(name = "SURFACE4", c(7, 2, 6), c(2, 7, 3)),
+ list(name = "SURFACE5", c(4, 3, 7), c(3, 4, 0)),
+ list(name = "SURFACE6", c(5, 2, 6), c(2, 5, 1)))
+ ), class = "r2ogs6_gml_prefab")
+}
+
+
+#.../hm2_1d1bt.gml (add the hm2-gml prefabs)
+
+
+#'Constructor based on ogs6_benchmarks/Elliptic/circle_radius_1/circle_1_axi.gml
+#'
+#'
+new_r2ogs6_gml_circle_1_axi <- function() {
+ structure(list(
+ gml_geometry_name = "geometry",
+ gml_points = tibble::tibble(x = c(0, 1),
+ y = c(0, 0),
+ z = c(0, 0),
+ name = c("inner", "outer"))
+ ), class = "r2ogs6_gml_prefab")
+}
+
diff --git a/R/read_input_from_file.R b/R/read_input_from_file.R
new file mode 100644
index 0000000..fec1360
--- /dev/null
+++ b/R/read_input_from_file.R
@@ -0,0 +1,26 @@
+#This script contains various functions to read user input from a file (WIP)
+
+
+read_gml_input_from_file <- function(point_file_name, polyline_file_name, surface_file_name) {
+ read_gml_points(point_file_name)
+}
+
+#'Reads in a .tsv file and parses it as a tibble.
+#'A column specifying the name of the points is optional, but the number of columns must be consistent.
+#'If one row has an entry for the point name, all rows need an entry for the point name.
+#'If only some points need to be named, put "" (double quotes) for the points that don't have a name.
+#'@param file_name The name of the .tsv file containing the point tibble
+# @example
+#
+#
+read_gml_points <- function(file_name) {
+ point_tibble <- readr::read_tsv(file_name, col_names = FALSE, quoted_na = FALSE, comment = "#")
+ if(length(point_tibble) == 4) {
+ names(point_tibble) <- c("x", "y", "z", "name")
+ }else if(length(point_tibble) == 3) {
+ names(point_tibble) <- c("x", "y", "z")
+ }else{
+ stop(paste("Invalid number of columns detected while reading file containing .gml points"), call. = FALSE)
+ }
+ return(point_tibble)
+}
diff --git a/R/user_input.R b/R/user_input.R
index 86c8689..2acfb73 100644
--- a/R/user_input.R
+++ b/R/user_input.R
@@ -8,13 +8,13 @@
geo_name <- "cube_1x1x1_geometry"
#Some points (will become second XML child under root)
-my_points <- tibble::tibble(x = c(0, 0, 0, 0, 1, 1, 1, 1),
+my_gml_points <- tibble::tibble(x = c(0, 0, 0, 0, 1, 1, 1, 1),
y = c(0, 0, 1, 1, 0, 0, 1, 1),
z = c(0, 1, 1, 0, 0, 1, 1, 0),
- is_origin = c(TRUE, rep(FALSE,7)))
+ name = c("origin", rep("", 7)))
#Some polylines (will become third XML child under root)
-my_polylines <- list(list(name = "front_left", c(0, 1)),
+my_gml_polylines <- list(list(name = "front_left", c(0, 1)),
list(name = "front_right", c(4, 5)),
list(name = "front_bottom", c(0, 4)),
list(name = "front_top", c(1, 5)),
@@ -28,19 +28,38 @@ my_polylines <- list(list(name = "front_left", c(0, 1)),
list(name = "back_top", c(2, 6)))
#Some surfaces (will become fourth XML child under root)
-my_surfaces <- list(list(name = "left", c(0, 1, 2), c(0, 3, 2)),
+my_gml_surfaces <- list(list(name = "left", c(0, 1, 2), c(0, 3, 2)),
list(name = "right", c(4, 6, 5), c(4, 6, 7)),
list(name = "top", c(1, 2, 5), c(5, 2, 6)),
list(name = "bottom", c(0, 3, 4), c(4, 3, 7)),
list(name = "front", c(0, 1, 4), c(4, 1, 5)),
list(name = "back", c(2, 3, 6), c(6, 3, 7)))
-#Turn those into XML structure
-my_gml <- data_to_xml(geo_name, my_points, my_polylines, my_surfaces)
+
+#============================== Data for VTU file ================================
+
+
+my_vtk_specification <- list(type="UnstructuredGrid",
+ version="0.1",
+ byte_order="LittleEndian",
+ header_type="UInt32",
+ compressor="vtkZLibDataCompressor")
+
+
+
+my_vtk_pieces <- list()
+
+
+
+
+#============================== Execution ================================
+
+#Turn GML data into XML structure
+my_gml_xml <- gml_data_to_xml(geo_name, my_gml_points, my_gml_polylines, my_gml_surfaces)
#Let's export that as a new .gml XML file
-export_gml_to_file(my_gml, "my_experimental_cube.gml")
+export_xml_to_file(my_gml_xml, "my_experimental_cube.gml")
#Now the .gml XML file should be in the r2ogs6 folder (not a perfect location but ok for a little test)
diff --git a/R/validate_gml.R b/R/validate_gml.R
new file mode 100644
index 0000000..33111c9
--- /dev/null
+++ b/R/validate_gml.R
@@ -0,0 +1,66 @@
+#This script contains various functions to verify data for a .gml file (WIP)
+
+# @export
+validate_gml_data <- function(gml_geometry_name, gml_points = NA, gml_polylines = NA, gml_surfaces = NA) {
+
+ validate_points(gml_points)
+ validate_polylines(gml_polylines)
+ validate_surfaces(gml_surfaces)
+}
+
+#'Checks if the input is a tibble, if this tibble has the right number of elements,
+#' if those elements are named correctly, if the lists in the tibble are of the same length and
+#' if there is any overlapping points or duplicate point names
+#' @param gml_points A tibble with 3 vectors named 'x', 'y' and 'z' (and an optional 'name' vector)
+validate_points <- function(gml_points) {
+
+ if(!(inherits(gml_points, "tbl_df") && inherits(gml_points, "tbl") &&
+ inherits(gml_points, "data.frame"))){
+ stop(paste(gml_points, " is not of class 'tbl_df' "), call. = FALSE)
+ }
+
+ names <- names(gml_points)
+
+ if (!((length(gml_points) == 4 && names[[1]] == "x" && names[[2]] == "y" &&
+ names[[3]] == "z" && names[[4]] == "name") ||
+ (length(gml_points) == 3 && names[[1]] == "x" && names[[2]] == "y" &&
+ names[[3]] == "z"))){
+ stop(paste(gml_points, " column names do not fit to 'x, y, z, (name)' "), call. = FALSE)
+ }
+
+ has_names <- (length(gml_points) == 4)
+
+ #Find overlapping points and duplicate names
+ for(i in 1:(length(gml_points[[1]])-1)){
+ for(j in (i+1):length(gml_points[[1]])){
+ if(gml_points[[1]][[i]] == gml_points[[1]][[j]] &&
+ gml_points[[2]][[i]] == gml_points[[2]][[j]] &&
+ gml_points[[3]][[i]] == gml_points[[3]][[j]]){
+ stop("Overlapping .gml points (with the same coordinates) detected", call. = FALSE)
+ }
+
+ if(has_names){
+ if(gml_points[[4]][[i]] == gml_points[[4]][[j]] &&
+ gml_points[[4]][[i]] != ""){
+ warning("Duplicate .gml point names detected", call. = FALSE)
+ }
+ }
+ }
+ }
+
+ return(invisible(gml_points))
+}
+
+
+validate_polylines <- function(gml_polylines) {
+
+ if(!(inherits(gml_polylines, "list"))){
+ stop(paste(gml_polylines, " is not of class 'list' "), call. = FALSE)
+ }
+
+}
+
+
+validate_surfaces <- function(gml_surfaces) {
+
+}
\ No newline at end of file
diff --git a/inst/extdata/gml_points_with_names.tsv b/inst/extdata/gml_points_with_names.tsv
new file mode 100644
index 0000000..b226882
--- /dev/null
+++ b/inst/extdata/gml_points_with_names.tsv
@@ -0,0 +1,8 @@
+0 0 0 origin
+0 0 1 ""
+0 1 1 ""
+0 1 0 ""
+1 0 0 ""
+1 0 1 ""
+1 1 1 ""
+1 1 0 ""
\ No newline at end of file
diff --git a/inst/extdata/gml_points_without_names.tsv b/inst/extdata/gml_points_without_names.tsv
new file mode 100644
index 0000000..53f58dd
--- /dev/null
+++ b/inst/extdata/gml_points_without_names.tsv
@@ -0,0 +1,8 @@
+0 0 0
+0 0 1
+0 1 1
+0 1 0
+1 0 0
+1 0 1
+1 1 1
+1 1 0
\ No newline at end of file
diff --git a/man/GMLPoints.Rd b/man/GMLPoints.Rd
index 38b26db..2b84e1a 100644
--- a/man/GMLPoints.Rd
+++ b/man/GMLPoints.Rd
@@ -15,7 +15,6 @@ Class describing a set of points
\item \href{#method-validate_ids}{\code{GMLPoints$validate_ids()}}
\item \href{#method-validate_dim}{\code{GMLPoints$validate_dim()}}
\item \href{#method-validate_coordinates}{\code{GMLPoints$validate_coordinates()}}
-\item \href{#method-validate_origin}{\code{GMLPoints$validate_origin()}}
\item \href{#method-as_list}{\code{GMLPoints$as_list()}}
\item \href{#method-as_node}{\code{GMLPoints$as_node()}}
\item \href{#method-print}{\code{GMLPoints$print()}}
@@ -57,15 +56,6 @@ Class describing a set of points
\if{html}{\out{<div class="r">}}\preformatted{GMLPoints$validate_coordinates(gml_points)}\if{html}{\out{</div>}}
}
-}
-\if{html}{\out{<hr>}}
-\if{html}{\out{<a id="method-validate_origin"></a>}}
-\if{latex}{\out{\hypertarget{method-validate_origin}{}}}
-\subsection{Method \code{validate_origin()}}{
-\subsection{Usage}{
-\if{html}{\out{<div class="r">}}\preformatted{GMLPoints$validate_origin(gml_points)}\if{html}{\out{</div>}}
-}
-
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-as_list"></a>}}
diff --git a/man/export_gml_to_file.Rd b/man/export_xml_to_file.Rd
similarity index 59%
rename from man/export_gml_to_file.Rd
rename to man/export_xml_to_file.Rd
index 1170afc..8aa952f 100644
--- a/man/export_gml_to_file.Rd
+++ b/man/export_xml_to_file.Rd
@@ -1,13 +1,13 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/create_gml.R
-\name{export_gml_to_file}
-\alias{export_gml_to_file}
+\name{export_xml_to_file}
+\alias{export_xml_to_file}
\title{Export function}
\usage{
-export_gml_to_file(gml_data, file_name)
+export_xml_to_file(xml_data, file_name)
}
\arguments{
-\item{gml_data}{The .gml data (already in XML friendly format)}
+\item{xml_data}{The .gml data (already in XML friendly format)}
\item{file_name}{The name of the .gml file to be written}
}
diff --git a/man/data_to_xml.Rd b/man/gml_data_to_xml.Rd
similarity index 82%
rename from man/data_to_xml.Rd
rename to man/gml_data_to_xml.Rd
index 2edaee9..919404a 100644
--- a/man/data_to_xml.Rd
+++ b/man/gml_data_to_xml.Rd
@@ -1,10 +1,10 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/create_gml.R
-\name{data_to_xml}
-\alias{data_to_xml}
+\name{gml_data_to_xml}
+\alias{gml_data_to_xml}
\title{Wrapper function to create a XML document based on the user input data}
\usage{
-data_to_xml(geo_name, points_tibble, polylines_list, surfaces_list)
+gml_data_to_xml(geo_name, points_tibble, polylines_list, surfaces_list)
}
\arguments{
\item{geo_name}{The name of the geometry specified by the user}
diff --git a/man/new_r2ogs6_gml_bar.Rd b/man/new_r2ogs6_gml_bar.Rd
new file mode 100644
index 0000000..73bf557
--- /dev/null
+++ b/man/new_r2ogs6_gml_bar.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_bar}
+\alias{new_r2ogs6_gml_bar}
+\title{Constructor based on HydroMechanics/StaggeredScheme/InjectionProduction1D/bar.gml}
+\usage{
+new_r2ogs6_gml_bar()
+}
+\description{
+Constructor based on HydroMechanics/StaggeredScheme/InjectionProduction1D/bar.gml
+}
diff --git a/man/new_r2ogs6_gml_circle_1_axi.Rd b/man/new_r2ogs6_gml_circle_1_axi.Rd
new file mode 100644
index 0000000..14a8386
--- /dev/null
+++ b/man/new_r2ogs6_gml_circle_1_axi.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_circle_1_axi}
+\alias{new_r2ogs6_gml_circle_1_axi}
+\title{Constructor based on ogs6_benchmarks/Elliptic/circle_radius_1/circle_1_axi.gml}
+\usage{
+new_r2ogs6_gml_circle_1_axi()
+}
+\description{
+Constructor based on ogs6_benchmarks/Elliptic/circle_radius_1/circle_1_axi.gml
+}
diff --git a/man/new_r2ogs6_gml_cube_1x1x1.Rd b/man/new_r2ogs6_gml_cube_1x1x1.Rd
new file mode 100644
index 0000000..903f5d5
--- /dev/null
+++ b/man/new_r2ogs6_gml_cube_1x1x1.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_cube_1x1x1}
+\alias{new_r2ogs6_gml_cube_1x1x1}
+\title{Constructor based on HydroMechanics/IdealGas/flow_free_expansion/cube_1x1x1.gml}
+\usage{
+new_r2ogs6_gml_cube_1x1x1()
+}
+\description{
+Constructor based on HydroMechanics/IdealGas/flow_free_expansion/cube_1x1x1.gml
+}
diff --git a/man/new_r2ogs6_gml_hm1_1Dbeam.Rd b/man/new_r2ogs6_gml_hm1_1Dbeam.Rd
new file mode 100644
index 0000000..0baceff
--- /dev/null
+++ b/man/new_r2ogs6_gml_hm1_1Dbeam.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_hm1_1Dbeam}
+\alias{new_r2ogs6_gml_hm1_1Dbeam}
+\title{Constructor based on HydroMechanics/Verification/hm1_1Dbeam.gml}
+\usage{
+new_r2ogs6_gml_hm1_1Dbeam()
+}
+\description{
+Constructor based on HydroMechanics/Verification/hm1_1Dbeam.gml
+}
diff --git a/man/new_r2ogs6_gml_hm1_2Dsquare.Rd b/man/new_r2ogs6_gml_hm1_2Dsquare.Rd
new file mode 100644
index 0000000..c0dfbcb
--- /dev/null
+++ b/man/new_r2ogs6_gml_hm1_2Dsquare.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_hm1_2Dsquare}
+\alias{new_r2ogs6_gml_hm1_2Dsquare}
+\title{Constructor based on HydroMechanics/Verification/hm1_2Dsquare.gml}
+\usage{
+new_r2ogs6_gml_hm1_2Dsquare()
+}
+\description{
+Constructor based on HydroMechanics/Verification/hm1_2Dsquare.gml
+}
diff --git a/man/new_r2ogs6_gml_hm1_3Dcube.Rd b/man/new_r2ogs6_gml_hm1_3Dcube.Rd
new file mode 100644
index 0000000..0fad335
--- /dev/null
+++ b/man/new_r2ogs6_gml_hm1_3Dcube.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_hm1_3Dcube}
+\alias{new_r2ogs6_gml_hm1_3Dcube}
+\title{Constructor based on HydroMechanics/Verification/hm1_3Dcube.gml}
+\usage{
+new_r2ogs6_gml_hm1_3Dcube()
+}
+\description{
+Constructor based on HydroMechanics/Verification/hm1_3Dcube.gml
+}
diff --git a/man/new_r2ogs6_gml_hm1_3Dgravity.Rd b/man/new_r2ogs6_gml_hm1_3Dgravity.Rd
new file mode 100644
index 0000000..b227f4d
--- /dev/null
+++ b/man/new_r2ogs6_gml_hm1_3Dgravity.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_hm1_3Dgravity}
+\alias{new_r2ogs6_gml_hm1_3Dgravity}
+\title{Constructor based on HydroMechanics/Verification/hm1_3Dgravity.gml}
+\usage{
+new_r2ogs6_gml_hm1_3Dgravity()
+}
+\description{
+Constructor based on HydroMechanics/Verification/hm1_3Dgravity.gml
+}
diff --git a/man/new_r2ogs6_gml_quad_1x10.Rd b/man/new_r2ogs6_gml_quad_1x10.Rd
new file mode 100644
index 0000000..8754e2a
--- /dev/null
+++ b/man/new_r2ogs6_gml_quad_1x10.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_quad_1x10}
+\alias{new_r2ogs6_gml_quad_1x10}
+\title{Constructor based on HydroMechanics/IdealGas/flow_pressure_boundary/quad_1x10.gml}
+\usage{
+new_r2ogs6_gml_quad_1x10()
+}
+\description{
+Constructor based on HydroMechanics/IdealGas/flow_pressure_boundary/quad_1x10.gml
+}
diff --git a/man/new_r2ogs6_gml_square_1x1.Rd b/man/new_r2ogs6_gml_square_1x1.Rd
new file mode 100644
index 0000000..9c5bdd2
--- /dev/null
+++ b/man/new_r2ogs6_gml_square_1x1.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gml_prefabs.R
+\name{new_r2ogs6_gml_square_1x1}
+\alias{new_r2ogs6_gml_square_1x1}
+\title{Constructor based on HydroMechanics/IdealGas/flow_no_strain/square_1x1.gml}
+\usage{
+new_r2ogs6_gml_square_1x1()
+}
+\description{
+Constructor based on HydroMechanics/IdealGas/flow_no_strain/square_1x1.gml
+}
diff --git a/man/points_to_xml.Rd b/man/points_to_xml.Rd
index 403b7ad..3028ad0 100644
--- a/man/points_to_xml.Rd
+++ b/man/points_to_xml.Rd
@@ -16,6 +16,6 @@ An XML node containing the points
Turns a tibble of points into an XML node
}
\examples{
-my_tibble <- tibble::tibble(x = c(0, 0), y = c(0, 0), z = c(0, 1),is_origin = c(TRUE, FALSE))
+my_tibble <- tibble::tibble(x = c(0, 0), y = c(0, 0), z = c(0, 1), name = c("origin", ""))
point_node <- points_to_xml(my_tibble)
}
diff --git a/man/read_gml_points.Rd b/man/read_gml_points.Rd
new file mode 100644
index 0000000..56da0a8
--- /dev/null
+++ b/man/read_gml_points.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read_input_from_file.R
+\name{read_gml_points}
+\alias{read_gml_points}
+\title{Reads in a .tsv file and parses it as a tibble.
+A column specifying the name of the points is optional, but the number of columns must be consistent.
+If one row has an entry for the point name, all rows need an entry for the point name.
+If only some points need to be named, put "" (double quotes) for the points that don't have a name.}
+\usage{
+read_gml_points(file_name)
+}
+\arguments{
+\item{file_name}{The name of the .tsv file containing the point tibble}
+}
+\description{
+Reads in a .tsv file and parses it as a tibble.
+A column specifying the name of the points is optional, but the number of columns must be consistent.
+If one row has an entry for the point name, all rows need an entry for the point name.
+If only some points need to be named, put "" (double quotes) for the points that don't have a name.
+}
diff --git a/man/validate_points.Rd b/man/validate_points.Rd
new file mode 100644
index 0000000..f781919
--- /dev/null
+++ b/man/validate_points.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validate_gml.R
+\name{validate_points}
+\alias{validate_points}
+\title{Checks if the input is a tibble, if this tibble has the right number of elements,
+if those elements are named correctly, if the lists in the tibble are of the same length and
+if there is any overlapping points or duplicate point names}
+\usage{
+validate_points(gml_points)
+}
+\arguments{
+\item{gml_points}{A tibble with 3 vectors named 'x', 'y' and 'z' (and an optional 'name' vector)}
+}
+\description{
+Checks if the input is a tibble, if this tibble has the right number of elements,
+if those elements are named correctly, if the lists in the tibble are of the same length and
+if there is any overlapping points or duplicate point names
+}
diff --git a/my_experimental_cube.gml b/my_experimental_cube.gml
new file mode 100644
index 0000000..939bdf7
--- /dev/null
+++ b/my_experimental_cube.gml
@@ -0,0 +1,90 @@
+<?xml version="1.0" encoding="ISO-8859-1"?>
+<OpenGeoSysGLI xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:ogs="http://www.opengeosys.org">
+ <name>cube_1x1x1_geometry</name>
+ <points>
+ <point id="0" x="0" y="0" z="0" name="origin"/>
+ <point id="1" x="0" y="0" z="1"/>
+ <point id="2" x="0" y="1" z="1"/>
+ <point id="3" x="0" y="1" z="0"/>
+ <point id="4" x="1" y="0" z="0"/>
+ <point id="5" x="1" y="0" z="1"/>
+ <point id="6" x="1" y="1" z="1"/>
+ <point id="7" x="1" y="1" z="0"/>
+ </points>
+ <polylines>
+ <polyline id="0" name="front_left">
+ <pnt>0</pnt>
+ <pnt>1</pnt>
+ </polyline>
+ <polyline id="1" name="front_right">
+ <pnt>4</pnt>
+ <pnt>5</pnt>
+ </polyline>
+ <polyline id="2" name="front_bottom">
+ <pnt>0</pnt>
+ <pnt>4</pnt>
+ </polyline>
+ <polyline id="3" name="front_top">
+ <pnt>1</pnt>
+ <pnt>5</pnt>
+ </polyline>
+ <polyline id="4" name="bottom_left">
+ <pnt>0</pnt>
+ <pnt>3</pnt>
+ </polyline>
+ <polyline id="5" name="bottom_right">
+ <pnt>4</pnt>
+ <pnt>7</pnt>
+ </polyline>
+ <polyline id="6" name="top_left">
+ <pnt>1</pnt>
+ <pnt>2</pnt>
+ </polyline>
+ <polyline id="7" name="top_right">
+ <pnt>5</pnt>
+ <pnt>6</pnt>
+ </polyline>
+ <polyline id="8" name="back_left">
+ <pnt>2</pnt>
+ <pnt>3</pnt>
+ </polyline>
+ <polyline id="9" name="back_right">
+ <pnt>6</pnt>
+ <pnt>7</pnt>
+ </polyline>
+ <polyline id="10" name="back_bottom">
+ <pnt>3</pnt>
+ <pnt>7</pnt>
+ </polyline>
+ <polyline id="11" name="back_top">
+ <pnt>2</pnt>
+ <pnt>6</pnt>
+ </polyline>
+ </polylines>
+ <surfaces>
+ <surface id="0" name="left">
+ <element p1="0" p2="1" p3="2"/>
+ <element p1="0" p2="3" p3="2"/>
+ </surface>
+ <surface id="1" name="right">
+ <element p1="4" p2="6" p3="5"/>
+ <element p1="4" p2="6" p3="7"/>
+ </surface>
+ <surface id="2" name="top">
+ <element p1="1" p2="2" p3="5"/>
+ <element p1="5" p2="2" p3="6"/>
+ </surface>
+ <surface id="3" name="bottom">
+ <element p1="0" p2="3" p3="4"/>
+ <element p1="4" p2="3" p3="7"/>
+ </surface>
+ <surface id="4" name="front">
+ <element p1="0" p2="1" p3="4"/>
+ <element p1="4" p2="1" p3="5"/>
+ </surface>
+ <surface id="5" name="back">
+ <element p1="2" p2="3" p3="6"/>
+ <element p1="6" p2="3" p3="7"/>
+ </surface>
+ </surfaces>
+</OpenGeoSysGLI>
diff --git a/tests/testthat/test-read_input_from_file.R b/tests/testthat/test-read_input_from_file.R
new file mode 100644
index 0000000..2abeeca
--- /dev/null
+++ b/tests/testthat/test-read_input_from_file.R
@@ -0,0 +1,12 @@
+
+test_that("read_gml_points correctly reads point tibble from file", {
+
+ point_tibble_1 <- read_gml_points(system.file("extdata", "gml_points_with_names.tsv", package = "r2ogs6"))
+ expect_equal(length(point_tibble_1), 4)
+ expect_setequal(names(point_tibble_1), c("x", "y", "z", "name"))
+
+ point_tibble_2 <- read_gml_points(system.file("extdata", "gml_points_without_names.tsv", package = "r2ogs6"))
+ expect_equal(length(point_tibble_2), 3)
+ expect_setequal(names(point_tibble_2), c("x", "y", "z"))
+})
+
diff --git a/tests/testthat/test-validate_gml.R b/tests/testthat/test-validate_gml.R
new file mode 100644
index 0000000..2ad65b7
--- /dev/null
+++ b/tests/testthat/test-validate_gml.R
@@ -0,0 +1,24 @@
+test_that("validate_points function checks ...", {
+
+ point_list <- list(x = c(0, 0), y = c(1, 1), z = c(0, 1))
+
+ #Check class (should expect a tibble, not a list)
+ expect_error(validate_points(point_list))
+
+ point_tibble_inv_0 <- tibble::tibble(a = c(0, 0), b = c(1, 1), c = c(0, 1))
+ point_tibble_inv_1 <- tibble::tibble(x = c(0, 0), y = c(1, 1), z = c(0))
+ point_tibble_inv_2 <- tibble::tibble(x = c(0, 0), y = c(1, 1), z = c(0, 1), name = c("oh", "oh"))
+
+ #Check column names
+ expect_error(validate_points(point_tibble_inv_0))
+
+ #Check if duplicate points and point names are detected
+ expect_error(validate_points(point_tibble_inv_1))
+ expect_warning(validate_points(point_tibble_inv_2))
+
+ point_tibble_val <- tibble::tibble(x = c(0, 0), y = c(1, 1), z = c(0, 1), name = c("this", "works"))
+ point_tibble_val_2 <- tibble::tibble(x = c(0, 0), y = c(1, 1), z = c(0, 1))
+
+ expect_invisible(validate_points(point_tibble_val))
+ expect_invisible(validate_points(point_tibble_val_2))
+})
--
GitLab