在R中将数据表导出为Google地图KML文件

4

导出KML文件以在Google Maps中使用。以下是导出的代码(改编自这里):

t_expkml_c <- function(obj, archivo,
                     col_nombre, col_desc, col_color,
                     mapa_colores = "mapa_colores_topaz",
                     mapa_nombre = "Mapa_TSE", mapa_desc = "Mapa Creado por PE de TSE") {
  
  # - changes projection
  if (proj4string(obj)!="+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0") {
    cat("Input SpatialPolygonsDataFrame ",obj," re-projected from ",
        proj4string(obj)," to WGS84 longlat\n",sep="")
    assign(obj,spTransform(obj,CRS(" +proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0")))
  } # check projection
  
  # opens file
  kmlFile <- file(archivo,
                  open = "w")
  
  # goes through each polygon
  # usa maptools::kmlPolygon
  Xout <- sapply(slot(obj,
                      "polygons"),
                 function(x) {
                   maptools::kmlPolygon(x, # Object 
                                        name = as(obj, "data.frame")[slot(x, "ID"), col_nombre],
                                        # name column
                                        col = mapa_colores[as.numeric(as(obj, "data.frame")[slot(x, "ID"), col_color])],
                                        # color column
                                        lwd = 0.5, # stroke
                                        border = NA, # borders
                                        visibility = TRUE, 
                                        description = as(obj,"data.frame")[slot(x, "ID"), col_desc], #description (what I need to change)
                   )
                 }
  )
  
  # export polyon out
  cat(kmlPolygon(kmlname=mapa_nombre,
                 kmldescription=mapa_desc)$header,
      file = kmlFile, sep="\n")
  # estilos
  cat(unlist(Xout["style",]),
      file = kmlFile, sep="\n")
  # contenidos
  cat(unlist(Xout["content",]),
      file = kmlFile, sep="\n")
  # footers
  cat(kmlPolygon()$footer,
      file = kmlFile, sep="\n")
  close(kmlFile) # end
}

当我只从kmlmap@data数据框中选择一列时(该对象是SpatialPolygonsDataFrame类),这个方法运行得很好。然而,我想要导出一个更大的数据表格,以便它可以显示在Google Maps形状的描述中。

例如,这是一个只有一列的导出结果(原始导出); enter image description here

如果我想添加其他描述符,我会像这样在Google Maps中更改数据表:

enter image description here

但我想要在R中复制原始导出的这种行为。我尝试更改description参数以添加列名称的向量或甚至是列名称的索引(即c("Column2", "Column3")1:2),并尝试将HTML添加到描述列(当在Google Maps数据表中不同的列中可视化时,这显然不起作用)。

我该如何实现这个目标?


稍微偏离一下话题:您是如何使用地图上的表格来填充信息窗口的?(我刚刚在我的软件包的开发版本中推出了一个add_kml()函数,它将允许您从R内部绘制KML地图) - SymbolixAU
你的链接已经失效。 - SymbolixAU
1个回答

1
你需要使用HTML将列拼接在一起。
sc<- c(103.8259077,1.320045,103.8265944,1.3143817,103.829813,1.3132662, 103.8346624,1.3173421,103.8259077,1.320045)
polys_coords<-list()
polys_coords[[1]]<-matrix(sc,  byrow=TRUE, ncol=2)
polys_coords[[2]]<-polys_coords[[1]]+0.05
polys_coords[[3]]<-polys_coords[[1]]-0.05
polys_spatial<-SpatialPolygons(
  Srl= list ( Polygons( srl=lapply(polys_coords, function(x) Polygon(x)), ID="1"),
              Polygons( srl=lapply(polys_coords, function(x) Polygon(x-0.01)), ID="2"),
              Polygons( srl=lapply(polys_coords, function(x) Polygon(x+0.01)), ID="3"))
)
proj4string(polys_spatial)<-CRS(" +proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0")
df<-SpatialPolygonsDataFrame(polys_spatial, data.frame(NAME=paste0("Name",1:3), DESCA=paste0("Poly",1:3), DESCB=paste0("Gon",1:3)))
#   NAME DESCA DESCB
# 1 Name1 Poly1  Gon1
# 2 Name2 Poly2  Gon2
# 3 Name3 Poly3  Gon3

xOut<-sapply(df@polygons, function(x) kmlPolygon(x, name=as.data.frame(df)[x@ID,"NAME"], 
                                                 description=paste( 
                                                               sapply(2:3, function(i) {
                                                                 y<-as.data.frame(df) 
                                                                 paste0("<p><strong>",colnames(y)[i], "</strong>: ", y[x@ID,i],"</p>") } ) , 
                                                              collapse=""))
)

xOut[["content",1]][1:5]
# [1] ""                                                                                                                
# [2] "<Placemark>"                                                                                                     
# [3] "<name>Name1</name>"                                                                                              
# [4] "<description><![CDATA[<p><strong>DESCA</strong>: Poly1</p><p><strong>DESCB</strong>: Gon1</p>]]></description>"
# [5] "<styleUrl>#1</styleUrl>" 
xOut[["content",2]][1:5]
# [1] ""                                                                                                                
# [2] "<Placemark>"                                                                                                     
# [3] "<name>Name2</name>"                                                                                              
# [4] "<description><![CDATA[<p><strong>DESCA</strong>: Poly2</p><p><strong>DESCB</strong>: Gon2</p>]]></description>"
# [5] "<styleUrl>#2</styleUrl>"

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接