Skip to content
Snippets Groups Projects
Commit 74bbda4b authored by Ruben Heinrich's avatar Ruben Heinrich
Browse files

[base] Fixing export functionality

parent 48c4cd27
No related branches found
No related tags found
1 merge request!6Merge branch 7 fixed functionality into master
Hide whitespace changes
Inline Side-by-side
R/export_gml.R
+ 45
− 27
View file @ 74bbda4b
#This script contains various functions to turn data for a .gml file into the correct XML format
#===== export_gml =====
#'export_gml
#'@description Wrapper function to create a .gml XML document based on the user input data
#'@param ogs6_obj A OGS6 class object
#'@description Creates a .gml XML document based on user input data
#'@param ogs6_obj OGS6: Simulation object to export r2ogs6_gml object from
export_gml <- function(ogs6_obj) {
gml_xml <- xml2::xml_new_root(.value = "OpenGeoSysGLI",
"xmlns:xsi" = "http://www.w3.org/2001/XMLSchema-instance",
"xmlns:ogs" = "http://www.opengeosys.org")
gml_xml <- xml2::xml_new_root(
.value = "OpenGeoSysGLI",
"xmlns:xsi" = "http://www.w3.org/2001/XMLSchema-instance",
"xmlns:ogs" = "http://www.opengeosys.org"
)
xml2::xml_add_child(gml_xml, xml2::as_xml_document(list(name = list(ogs6_obj$gml$name))), .copy = FALSE)
xml2::xml_add_child(gml_xml,
xml2::as_xml_document(
list(name = list(ogs6_obj$gml$name))),
.copy = FALSE)
xml2::xml_add_child(gml_xml, points_to_xml(ogs6_obj$gml$points), .copy = FALSE)
xml2::xml_add_child(gml_xml,
points_to_xml(ogs6_obj$gml$points),
.copy = FALSE)
if(!is.null(ogs6_obj$gml$polylines)){
xml2::xml_add_child(gml_xml, polylines_to_xml(ogs6_obj$gml$polylines), .copy = FALSE)
xml2::xml_add_child(gml_xml,
polylines_to_xml(ogs6_obj$gml$polylines),
.copy = FALSE)
}
if(!is.null(ogs6_obj$gml$surfaces)){
xml2::xml_add_child(gml_xml, surfaces_to_xml(ogs6_obj$gml$surfaces), .copy = FALSE)
xml2::xml_add_child(gml_xml,
surfaces_to_xml(ogs6_obj$gml$surfaces),
.copy = FALSE)
}
file <- paste0(ogs6_obj$sim_path, ogs6_obj$gml$name, ".gml")
......@@ -32,7 +44,7 @@ export_gml <- function(ogs6_obj) {
#'points_to_xml
#'@description Turns a tibble of points into an XML node
#'@param points The specified tibble
#'@param points tibble: The specified points
#'@return An XML node containing the points
points_to_xml <- function(points) {
points_node <- list(points = list())
......@@ -46,7 +58,8 @@ points_to_xml <- function(points) {
z = points[[3]][[i]]))
if(has_names && points[[4]][[i]] != ""){
attributes(point_node[[1]]) <- c(attributes(point_node[[1]]), name = points[[4]][[i]])
attributes(point_node[[1]]) <- c(attributes(point_node[[1]]),
name = points[[4]][[i]])
}
points_node[[1]] <- c(points_node[[1]], point_node)
......@@ -58,7 +71,7 @@ points_to_xml <- function(points) {
#'polylines_to_xml
#'@description Turns a list of polylines into an XML node
#'@param polylines A list of polylines
#'@param polylines list: The specified polylines
#'@return An XML node containing the polylines
polylines_to_xml <- function(polylines) {
polylines_node <- list(polylines = list())
......@@ -71,14 +84,17 @@ polylines_to_xml <- function(polylines) {
pnt_list <- c(pnt_list, list(pnt = list(polylines[[i]][[2]][[j]])))
}
polylines_node[[1]] <- c(polylines_node[[1]], list(polyline = structure(pnt_list,
id = (i-1),
name = polylines[[i]][[1]])))
polylines_node[[1]] <-
c(polylines_node[[1]],
list(polyline = structure(pnt_list,
id = (i-1),
name = polylines[[i]][[1]])))
}
return(xml2::as_xml_document(polylines_node))
}
#'surfaces_to_xml
#'@description Turns a list of surfaces into an XML node
#'@param surfaces A list of surfaces
......@@ -87,18 +103,20 @@ surfaces_to_xml <- function(surfaces) {
surfaces_node <- list(surfaces = list())
for(i in 1:length(surfaces)){
surfaces_node[[1]] <- c(surfaces_node[[1]], list(surface = structure(c(list(element = structure(list(),
p1 = surfaces[[i]][[2]][[1]],
p2 = surfaces[[i]][[2]][[2]],
p3 = surfaces[[i]][[2]][[3]])),
list(element = structure(list(),
p1 = surfaces[[i]][[3]][[1]],
p2 = surfaces[[i]][[3]][[2]],
p3 = surfaces[[i]][[3]][[3]]))),
id = (i-1),
name = surfaces[[i]][[1]])))
surfaces_node[[1]] <-
c(surfaces_node[[1]],
list(surface = structure(c(
list(element = structure(list(),
p1 = surfaces[[i]][[2]][[1]],
p2 = surfaces[[i]][[2]][[2]],
p3 = surfaces[[i]][[2]][[3]])),
list(element = structure(list(),
p1 = surfaces[[i]][[3]][[1]],
p2 = surfaces[[i]][[3]][[2]],
p3 = surfaces[[i]][[3]][[3]]))),
id = (i-1),
name = surfaces[[i]][[1]])))
}
return(xml2::as_xml_document(surfaces_node))
}
R/export_prj.R
+ 41
− 20
View file @ 74bbda4b
#This script contains functions to export the .prj data
#'export_prj
#'@description Wrapper function to create a .prj XML document based on the user input data
#'@param ogs6_obj ...
#'@description Wrapper function to create a .prj XML document based on the user
#' input data
#'@param ogs6_obj OGS6: Simulation object
export_prj <- function(ogs6_obj) {
meshes_node <- NULL
......@@ -14,23 +15,43 @@ export_prj <- function(ogs6_obj) {
meshes_node <- to_node(ogs6_obj$meshes[[1]]$mesh_ref, "mesh")
}
#Add all of the required children
prj_node <- list(
OpenGeoSysProject = list(
meshes_node,
to_node(ogs6_obj$geometry),
to_node(ogs6_obj$processes),
to_node(ogs6_obj$media),
to_node(ogs6_obj$time_loop),
to_node(ogs6_obj$parameters),
to_node(ogs6_obj$curves),
to_node(ogs6_obj$process_variables),
to_node(ogs6_obj$nonlinear_solvers),
to_node(ogs6_obj$linear_solvers),
to_node(ogs6_obj$test_definition),
to_node(ogs6_obj$insitu)
)
)
# First instantiate our big wrapper list
prj_node <- list(OpenGeoSysProject = list())
special_cases <- c("meshes",
"gml")
#Handle special cases
prj_node[[1]] <- c(prj_node[[1]], list(meshes_node))
if(!is.null(ogs6_obj$geometry)){
prj_node[[1]] <- c(prj_node[[1]], list(to_node(ogs6_obj$geometry)))
}
#Get implemented classes
impl_classes <- get_implemented_classes()
#Add default cases
for(i in seq_len(length(impl_classes))){
param_name <- names(impl_classes)[[i]]
#If parameter was a special case we already handled, skip
if(param_name %in% special_cases){
next
}
get_param_call <- paste0("ogs6_obj$", param_name)
param <- eval(parse(text = get_param_call))
#If parameter wasn't defined, skip
if(length(param) == 0){
next
}
to_node_call <- paste0("to_node(ogs6_obj$", param_name, ")")
param_node <- eval(parse(text = to_node_call))
prj_node[[1]] <- c(prj_node[[1]], list(param_node))
}
file <- paste0(ogs6_obj$sim_path, ogs6_obj$sim_name, ".prj")
......@@ -39,4 +60,4 @@ export_prj <- function(ogs6_obj) {
xml2::write_xml(prj_xml, file, options = "format", encoding="ISO-8859-1")
return(invisible())
}
\ No newline at end of file
}
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment