Fast parsed xml_docs

uribo · Dec 27, 2018 · 68de03d · 68de03d
1 parent df0ab79
commit 68de03d
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 29 deletions.
diff --git a/R/commons.R b/R/commons.R
@@ -24,14 +24,7 @@ fgd_line_parse <- function(file) {
     res <-
       file_info$xml_docs %>%
       xml2::xml_find_all("/*/*/*/gml:Surface/gml:patches/gml:PolygonPatch/gml:exterior/gml:Ring/gml:curveMember/gml:Curve/gml:segments/gml:LineStringSegment/gml:posList") %>%
-      purrr::map(
-        ~ xml2::xml_text(.x, trim = TRUE) %>%
-          stringr::str_split("\n") %>%
-          purrr::flatten() %>%
-          purrr::map(~ stringr::str_split(.x, "[:space:]")) %>%
-          purrr::flatten() %>%
-          purrr::map(~ as.numeric(rev(.x)))
-      )
+      .line_parse()
   }
 
   if (file_info$type %in% c("AdmBdry", "BldL", "Cntr", "CommBdry",
@@ -47,6 +40,7 @@ fgd_line_parse <- function(file) {
       file_info$xml_docs %>%
       xml2::xml_find_all("/*/*/*/gml:Surface/gml:patches/gml:PolygonPatch/gml:exterior/gml:Ring/gml:curveMember/gml:Curve/gml:segments/gml:LineStringSegment/gml:posList") %>%
       .line_parse()
+
   }
 
   res

diff --git a/R/read_fdg.R b/R/read_fdg.R
@@ -39,7 +39,6 @@ read_fgd <- function(file) {
 
     res <-
       xml_parsed %>%
-      elem_to_line() %>%
       sf::st_sf(
         gml_id = ids,
         type = type,
@@ -96,7 +95,6 @@ read_fgd <- function(file) {
 
     res <-
       xml_parsed %>%
-      elem_to_line() %>%
       sf::st_sf(
         gml_id = ids,
         bdry_type = bdry_type,
@@ -151,7 +149,6 @@ read_fgd <- function(file) {
 
     res <-
       xml_parsed %>%
-      elem_to_line() %>%
       sf::st_sf(
         gml_id = ids,
         type = type,
@@ -172,7 +169,6 @@ read_fgd <- function(file) {
 
       res <-
         xml_parsed %>%
-        elem_to_line() %>%
         sf::st_sf(
           gml_id = ids,
           adm_name = nms,
@@ -194,8 +190,7 @@ read_fgd <- function(file) {
         sf::st_sf(
           gml_id = ids,
           adm_name = nms,
-          geometry = .
-        )
+          geometry = .)
 
     }
   }
@@ -215,7 +210,6 @@ read_fgd <- function(file) {
 
       res <-
         xml_parsed %>%
-        elem_to_line() %>%
         sf::st_sf(
           gml_id = ids,
           bld_type = bld_type,
@@ -229,7 +223,6 @@ read_fgd <- function(file) {
 
       res <-
         xml_parsed %>%
-        elem_to_line() %>%
         sf::st_sf(
           gml_id = ids,
           bld_type = bld_type,
@@ -339,7 +332,6 @@ read_fgd <- function(file) {
 
     res <-
       xml_parsed %>%
-      elem_to_line() %>%
       sf::st_sf(
         gml_id = ids,
         bld_type = type,
@@ -366,7 +358,6 @@ read_fgd <- function(file) {
 
     res <-
       xml_parsed %>%
-      elem_to_line() %>%
       sf::st_sf(
         gml_id = ids,
         type = type,
@@ -390,7 +381,6 @@ read_fgd <- function(file) {
 
       res <-
         xml_parsed %>%
-        elem_to_line() %>%
         sf::st_sf(
           gml_id = ids,
           type = type,
@@ -400,7 +390,6 @@ read_fgd <- function(file) {
 
       res <-
         xml_parsed %>%
-        elem_to_line() %>%
         sf::st_sf(
           gml_id = ids,
           type = type,
@@ -425,7 +414,6 @@ read_fgd <- function(file) {
 
       res <-
         xml_parsed %>%
-        elem_to_line() %>%
         sf::st_sf(
           gml_id = ids,
           type = type,
@@ -438,7 +426,6 @@ read_fgd <- function(file) {
 
       res <-
         xml_parsed %>%
-        elem_to_line() %>%
         sf::st_sf(
           gml_id = ids,
           type = type,

diff --git a/R/util.R b/R/util.R
@@ -58,12 +58,15 @@ set_coords <- function(raster, meshcode){
 .line_parse <- function(xml_node) {
   xml_node %>%
     xml2::xml_contents() %>%
+    xml2::xml_text(trim = TRUE) %>%
+    stringr::str_split("\n") %>%
+    purrr::map(~ stringr::str_split(.x, "[:space:]")) %>%
     purrr::map(
-      ~ xml2::xml_text(.x, trim = TRUE) %>%
-        stringr::str_split("\n") %>%
-        purrr::flatten() %>%
-        purrr::map(~ stringr::str_split(.x, "[:space:]")) %>%
-        purrr::flatten() %>%
-        purrr::map(~ as.numeric(rev(.x)))
-    )
+      ~ purrr::flatten_chr(.x) %>%
+        rev() %>%
+        as.numeric() %>%
+        matrix(., , 2, byrow = TRUE)) %>%
+    purrr::map(
+      ~ sf::st_linestring(.x)) %>%
+    sf::st_sfc(crs = 4326)
 }