我想将lapply作为参数的函数提供,如下所示:
function(p){
lapply(coords, function(x) paste0("x@",p))}
但它给了我以下错误:
as.vector错误(x,"字符"): 不能强迫类型'关闭'到#'字符'
的矢量可重复的例子是这样的:
gid <- c(1,2)
zone_id <- c(589, 581)
town_id <- c(474, 466)
wkt_geometry <- c("MULTIPOLYGON(((-70.902653 -33.242532,-70.900006 -33.237868,-70.900668 -33.236605,-70.899909 -33.232652,-70.89831 -33.229934,-70.897992 -33.227534,-70.899267 -33.222999,-70.897992 -33.219532,-70.897641 -33.200243,-70.892572 -33.204329,-70.88857 -33.20633,-70.885546 -33.20799,-70.884318 -33.20965,-70.882689 -33.213397,-70.882051 -33.220599,-70.873443 -33.222199,-70.865792 -33.221399,-70.865154 -33.220865,-70.861647 -33.217398,-70.85814 -33.209397,-70.855909 -33.202461,-70.85304 -33.198727,-70.846663 -33.191792,-70.846663 -33.184057,-70.846344 -33.177122,-70.830722 -33.177389,-70.822752 -33.178989,-70.819563 -33.174188,-70.813825 -33.170987,-70.800944 -33.16732,-70.793388 -33.166292,-70.791496 -33.17379,-70.783797 -33.179596,-70.748539 -33.259149,-70.743316 -33.270727,-70.747927 -33.275772,-70.754351 -33.2785,-70.759947 -33.285681,-70.762916 -33.286342,-70.772603 -33.290689,-70.783412 -33.282591,-70.786165 -33.279097,-70.788321 -33.277946,-70.825829 -33.278245,-70.836842 -33.277051,-70.848297 -33.272638,-70.850352 -33.273257,-70.853415 -33.272184,-70.855298 -33.272017,-70.862105 -33.272412,-70.868061 -33.269172,-70.87846 -33.257314,-70.88375 -33.253678,-70.895186 -33.250674,-70.897354 -33.246738,-70.902653 -33.242532)))",
"MULTIPOLYGON(((-70.793388 -33.166292,-70.78131 -33.169929,-70.772849 -33.169721,-70.766379 -33.170762,-70.75966 -33.173677,-70.752444 -33.172011,-70.749458 -33.168473,-70.734776 -33.16077,-70.728306 -33.161186,-70.725568 -33.162435,-70.714121 -33.162435,-70.685504 -33.165142,-70.672813 -33.169097,-70.66485 -33.170138,-70.656389 -33.171388,-70.651391 -33.17226,-70.654977 -33.176059,-70.656312 -33.178125,-70.65728 -33.180025,-70.660418 -33.179745,-70.676771 -33.18198,-70.676488 -33.188112,-70.67926 -33.202358,-70.680196 -33.203671,-70.682466 -33.203979,-70.6829 -33.204286,-70.684936 -33.209201,-70.685504 -33.216101,-70.688844 -33.225207,-70.690981 -33.231827,-70.696012 -33.237303,-70.697394 -33.239876,-70.697523 -33.241653,-70.702239 -33.241919,-70.708004 -33.244915,-70.717354 -33.251168,-70.72421 -33.265236,-70.731222 -33.268233,-70.736832 -33.270577,-70.741818 -33.274095,-70.743316 -33.270727,-70.748539 -33.259149,-70.783797 -33.179596,-70.791496 -33.17379,-70.793388 -33.166292)))")
shape.df <- data.frame(gid, zone_id, wkt_geometry)
SGeom <- function(wkt, p4ss, geom1, geom2){
require(rgeos)
require(sp)
list_geom <- lapply(wkt, "readWKT", p4s=p4ss)
coords <- mapply(spChFIDs, list_geom, as.character(shape.df[,1]))
SGeomdf <- paste0("Spatial", geom1, "DataFrame")(paste0("Spatial", geom1)(unlist(lapply(coords,
function(x) paste0("x@", geom2))),
proj4string=p4ss),
shape.df[, -ncol(shape.df)])
SGeomdf
}
geom.shp <- SGeom(wkt = shape.df$wkt_geometry, p4ss = CRS("+proj=longlat +datum=WGS84"), Polygons, polygons)
我该如何解决?
答案 0 :(得分:1)
我认为你需要一些元编程。以下不优雅,但适用于您的示例。如果这是您想要的,您应该能够为geom2
参数提供您想要的任何插槽。
SGeom <- function(wkt, p4ss, geom1, geom2){
require(rgeos)
require(sp)
list_geom <- lapply(wkt, "readWKT", p4s=p4ss)
coords <- mapply(spChFIDs, list_geom, as.character(shape.df[,1]))
res <- unlist(mapply(function(x, g){
expr <- paste0('x@', g)
eval(parse(text=expr))
}, coords, MoreArgs=list(g = deparse(substitute(geom2)))))
fcall1 <- call(paste0("Spatial", substitute(geom1)),
substitute(res),
proj4string=substitute(p4ss))
res2 <- eval(fcall1)
fcall2 <- call(paste0("Spatial", substitute(geom1), "DataFrame"),
Sr = substitute(res2),
data = quote(shape.df[, -ncol(shape.df)]))
SGeomdf <- eval(fcall2)
return(SGeomdf)
}
geom.shp <- SGeom(wkt = shape.df$wkt_geometry,
p4ss = CRS("+proj=longlat +datum=WGS84"),
geom1=Polygons,
geom2=polygons)