简体   繁体   中英

How to write coordinates of polygons in a XML with in R?

I have a data frame with all coordinates of my polygons (cells). And I try to create a function

example:

id_cell id_wall x1 y1 x2  y2  x3 y3
1       1       1  1  1   2   2  2
1       2       2  2  2   1   NA NA
1       3       1  1  2   1   NA NA
2       4       1  2  2   2   NA NA
2       5       1  2  1.5 2.5 2  2

What I try to obtain

<wall id="1">
   <points>
      <point x ="1" y= "1"/>
      <point x ="1" y= "2"/>
      <point x ="2" y= "2"/>
   </points>
</wall>
<wall id="2">
   <points>
      <point x ="2" y= "2"/>
      <point x ="2" y= "1"/>
   </points>
</wall>
...

What I have tried for the moment is using paste0 function with collapse = "":

write_xml <- function(cells, path = "my_file.xml"){

  xml <- NULL
  xml <- paste0(xml,paste0('\t\t<wall id="',cells$id_wall,'">\n',
                       '\t\t\t<points>\n',
                       '\t\t\t\t<point x="',cells$x1,'" y="',cells$y1,'"/>\n',
                       '\t\t\t\t<point x="',cells$x2,'" y="',cells$y2,'"/>\n',
                       '\t\t\t\t<point x="',cells$x3,'" y="',cells$y3,'"/>\n',
                       '\t\t\t</points>\n',
                       '\t\t</wall>\n', collapse = ""))
  xml <- str_remove_all(xml, '\t\t\t\t<point x=\"NA\" y=\"NA\"/>\n')

cat(xml, file = path)
return(TRUE)}

which works perfectly.

Now, my data is more complicate and per wall I can have a big number of coordinates x1 y1 x2 y2 x3 y3... x_n y_n. Each time I run my code it can generate different number for n And I have thousands of walls

So, What I would like is to be able to somehow adjust the number of line in the function to match the length of longest walls

                           '\t\t\t\t<point x="',cells$x4,'" y="',cells$y4,'"/>\n',
                           '\t\t\t\t<point x="',cells$x5,'" y="',cells$y5,'"/>\n',

Thank you for reading this question, I hope it is clear enough,

Have a nice day!

I was thinking this would work, but it does not.


xml <- NULL
col_nam <- cells%>%
    select((starts_with("x") | starts_with("y")) & ends_with(as.character(c(0:9))))%>%
    colnames()
  N <- max(parse_number(col_nam))
  begin <- tibble(tag1 = '\t\t<wall id="',
                id_wall = cells$id_wall,
                tag2 = '>\n\t\t\t<points>\n')
  middle <- tibble(tag_x1 = '\t\t\t\t<point x="',
                   x1 = cells$x1,
                   tag_y1 = '" y="',
                   y1 = cells$y1,
                   tag_end1 = '"/>\n')
  for(k in 2:N){
    h <- k*2-1 # odd number
    tmp_coord <- cells%>%
      select(all_of(col_nam[c(h,h+1)]))
    tmp_middle <- tibble(tag_x = '\t\t\t\t<point x="',
                         x = tmp_coord[,1],
                         tag_y = '" y="',
                         y = tmp_coord[,2],
                         tag_end = '"/>\n')
    tmp_col_name <- colnames(tmp_middle)
    colnames(tmp_middle) <- paste0(t(tmp_col_name), k)
    middle <- cbind(middle, tmp_middle)
  }
  taged_walls <- cbind(begin,middle)%>%
    mutate(tag_ending = '\t\t\t</points>\n\t\t</wall>\n')
  xml <- paste0(xml, paste0(t(taged_walls), collapse = ""))
  xml <- paste0(xml, '\t</walls>\n')
  xml <- str_remove_all(xml, '\t\t\t\t<point x=\"NA\" y=\"NA\"/>\n')

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM