Как записать координаты многоугольников в XML с помощью R? - PullRequest
Новая
       48

Как записать координаты многоугольников в XML с помощью R?

0 голосов
/ 13 июля 2020

У меня есть фрейм данных со всеми координатами моих многоугольников (ячеек). И я пытаюсь создать функцию

пример: 

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

То, что я пытаюсь получить 

<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>
...

То, что я пробовал на данный момент, - это использовать функцию paste0 с 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)}

что отлично работает.

Теперь мои данные более сложны, и для каждой стены я могу иметь большое количество координат x1 y1 x2 y2 x3 y3 .. . x_n y_n. Каждый раз, когда я запускаю свой код, он может генерировать разные числа для n И у меня тысячи стен

Итак, я бы хотел иметь возможность как-то регулировать количество строк в функция для соответствия длине самых длинных стен 

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

Спасибо, что прочитали этот вопрос, я надеюсь, что он достаточно ясен,

Хорошего дня!

1 Ответ

0 голосов
/ 14 июля 2020

Я думал, что это сработает, но это не так. 


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')
...