Question

我想在我的传单上构建象限，作为我的样方分析的一部分。目前我有我的tessalation对象，我试图在我的传单上绘制瓷砖。我的代码在

之下

library(spatstat)
library(leaflet)

firms_ppp <- ppp(x=cbd_points@coords[,1],y=cbd_points@coords[,2], window = 
window) 
qc <- quadratcount(firms_ppp) 
qc.nu <- as.numeric(qc)
    qc.tess <- as.tess(qc)
    colorpal4 <- colorNumeric("red",c(min(qc.nu, na.rm = TRUE),max(qc.nu, na.rm = TRUE)))
      for (j in 1:length(qc.tess$window$yrange)) {
        for (i in 1:length(qc.tess$window$xrange[i])) {
          leaflet() %>%
            addRectangles(lng1 = qc.tess$window$xrange[i], lng2 = qc.tess$window$xrange[i+1],
                          lat1 = rev(qc.tess$window$yrange)[j], lat2 = rev(qc.tess$window$yrange)[j+1],
                          color = colorpal4(qc.nu[j+(i-1)*(length(qc.tess$window$yrange)-1)]),
                          popup = paste("<h3>",qc.nu[j+(i-1)*(length(qc.tess$window$yrange)-1)],"</h3>")
            )
        }
      }

知道如何构建象限吗？我也尝试过瓷砖，但似乎无法让它工作！请帮助!!

Answer 1

找到2个帮助函数here，将Tesselation对象转换为SpatialPolygons，您可以实现以下目标：

library(spatstat)
library(leaflet)
library(sp)

## FUNCTIONS #####################
owin2Polygons <- function(x, id="1") {
  stopifnot(is.owin(x))
  x <- as.polygonal(x)
  closering <- function(df) { df[c(seq(nrow(df)), 1), ] }
  pieces <- lapply(x$bdry,
                   function(p) { 
                     Polygon(coords=closering(cbind(p$x,p$y)),
                             hole=spatstat.utils::is.hole.xypolygon(p))  })
  z <- Polygons(pieces, id)
  return(z)
}
tess2SP <- function(x) {
  stopifnot(is.tess(x))
  y <- tiles(x)
  nom <- names(y)
  z <- list()
  for(i in seq(y))
    z[[i]] <- owin2Polygons(y[[i]], nom[i])
  return(SpatialPolygons(z))
}


## DATA #####################
cbd_points <- data.frame(
  long = runif(100,15,19),
  lat = runif(100,40,50)
)

window <- owin(c(0,20), c(30,50))

firms_ppp <- ppp(x=cbd_points$long, y=cbd_points$lat, window = window) 
qc <- quadratcount(firms_ppp) 
qc.nu <- as.numeric(qc)
qc.tess <- as.tess(qc)
colorpal4 <- colorNumeric("red",c(min(qc.nu, na.rm = TRUE),max(qc.nu, na.rm = TRUE)))

PolyGrid <- tess2SP(qc.tess)
PolyGridDF <- SpatialPolygonsDataFrame(PolyGrid, data = data.frame(ID = 1:length(PolyGrid)), match.ID = F)


## SHINY ########################
library(shiny)
ui <- fluidPage(
  leafletOutput("map")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    pal = colorFactor("viridis", as.character(PolyGridDF$ID))
    leaflet() %>%
      addTiles() %>% 
      addPolygons(data=PolyGridDF, 
                  label = as.character(PolyGridDF$ID),
                  color = ~pal(as.character(PolyGridDF$ID)))
  })
}

shinyApp(ui, server)

在Rshiny中构建象限

1 个答案: