Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
233 views
in Technique[技术] by (71.8m points)

r - Building Quadrants in Rshiny

I wanna build quadrants on my leaflet as part of my quadrat analysis. currently I have my tessalation object and im trying to draw the tiles on my leaflet. My code is below

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>")
            )
        }
      }

Any idea how I can build the quadrants? I tried with tiles as well but I cant seem to get it to work too! Pls Help!!

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

With 2 helping functions found here, which convert a Tesselation object into SpatialPolygons, you can achieve something like this:

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)

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...