SHINTINE中涉及地图生成的问题 [英] Issue involving map generation in shiny

问题描述

朋友可以帮助我解决以下问题：

我在下面插入了三个可执行代码，第一个使用sftnetworks包生成地图，显示两个位置之间的路线。在本例中，定义了生成地图的两个位置： from = c(df_spec_clust[1, c("Longitude")], df_spec_clust[1, c("Latitude")]) 和to = c (df_spec_prop [4, c ("Longitude")], df_spec_prop [4, c ("Latitude")])]。在第二个示例中，我希望以闪亮的格式生成地图，但不会像在第一个代码中那样精确地定义位置。我希望从我创建的过滤器(过滤1和过滤2)中选择它们。但是，我无法生成地图。你能帮我个忙吗？为了向您展示，我设法在问题的第三个代码中正确地生成了地图，但是使用了另一个包(leaflet)。但是，我仍然想不出使用sfnetworks包使其工作的方法。如有任何帮助，我们将不胜感激。

谢谢！

第一个代码

library(sf)
library(sfnetworks)
library(tmap)
library(rdist)
library(geosphere)

#for the roads file
download.file("https://github.com/JovaniSouza/JovaniSouza5/raw/master/Test.zip", "Test.zip")
unzip("Test.zip")

#database df
df <- structure(
  list(Property = c(1,2,3,4,5,6,7), Latitude = c(-24.779225, -24.789635, -24.763461, -24.794394, -24.747102,-24.781307,-24.761081),
    Longitude = c(-49.934816, -49.922324, -49.911616, -49.906262, -49.890796,-49.8875254,-49.8875254), 
    Waste = c(526, 350, 526, 469, 285, 433, 456)),class = "data.frame", row.names = c(NA, -7L))

#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average") 
k=3
clusters<-cutree(fit.average, k) 
nclusters<-matrix(table(clusters))  
df$cluster <- clusters 

#Create database df1
center<-matrix(nrow=k,ncol=2)
for(i in 1:k){
  center[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
                     weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
coordinates$cluster<-clusters 
center<-cbind(center,matrix(c(1:k),ncol=1)) 
df1<-as.data.frame(center)
colnames(df1) <-c("Latitude", "Longitude", "cluster")

#specific cluster and specific property
df_spec_clust <- df1[df1$cluster,]
df_spec_prop<-df[df$Property,]

#create map
roads = st_read("Test/regionbrazil.shp", quiet = TRUE) %>% 
  st_cast("LINESTRING")

# build sfnetwork
net = as_sfnetwork(roads, directed = FALSE) %>%
  activate("edges") %>%
  dplyr::mutate(weight = edge_length())

# routing
from = c(df_spec_clust[1, c("Longitude")], df_spec_clust[1, c("Latitude")])
to = c(df_spec_prop[4, c("Longitude")], df_spec_prop[4, c("Latitude")])
p1 = st_as_sf(data.frame(x = from[1], y = from[2]), coords = c("x", "y"), crs = st_crs(net))
p2 = st_as_sf(data.frame(x = to[1], y = to[2]), coords = c("x", "y"), crs = st_crs(net))
r = tidygraph::convert(net, to_spatial_shortest_paths, p1, p2)

# Extract the bbox for r 
bbox_r = st_as_sfc(r %>% activate(edges) %>% st_bbox())


# filter the net
small_net = st_filter(net, bbox_r)

# plot
plot1<-tm_shape(small_net %>% activate(edges) %>% st_as_sf()) +
  tm_lines() + 
  tm_shape(rbind(p1, p2)) + 
  tm_dots(col = "red", size = 0.5) + 
  tm_shape(r %>% activate(edges) %>% st_as_sf()) + 
  tm_lines(col = "red", lwd = 3)
plot1

上述代码生成的地图

第二个代码

library(shiny)
library(rdist)
library(geosphere)
library(shinythemes)
library(sf)
library(tidygraph)
library(sfnetworks)
library(tmap)

#for the roads file
 download.file("https://github.com/JovaniSouza/JovaniSouza5/raw/master/Test.zip", "Test.zip")
 unzip("Test.zip")

function.cl<-function(df,k,Filter1,Filter2){
  
  #database df
  df <- structure(
    list(Property = c(1,2,3,4,5,6,7), Latitude = c(-24.779225, -24.789635, -24.763461, -24.794394, -24.747102,-24.781307,-24.761081),
         Longitude = c(-49.934816, -49.922324, -49.911616, -49.906262, -49.890796,-49.8875254,-49.8875254), 
         Waste = c(526, 350, 526, 469, 285, 433, 456)),class = "data.frame", row.names = c(NA, -7L))
  
  #clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average") 
  clusters<-cutree(fit.average, k) 
  nclusters<-matrix(table(clusters))  
  df$cluster <- clusters 
  
  #Create database df1
  center<-matrix(nrow=k,ncol=2)
  for(i in 1:k){
    center[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
                  weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
  coordinates$cluster<-clusters 
  center<-cbind(center,matrix(c(1:k),ncol=1)) 
  df1<-as.data.frame(center)
  colnames(df1) <-c("Latitude", "Longitude", "cluster")
 
  # specific cluster and specific property
  df_spec_clust <- df1[df1$cluster==Filter1,]
  df_spec_prop<-df[df$Property==Filter2,]
  
 
  #create map
 
  roads = st_read("Test/regionbrazil.shp", quiet = TRUE) %>% 
    st_cast("LINESTRING")
  
  # build sfnetwork
  net = as_sfnetwork(roads, directed = FALSE) %>%
    activate("edges") %>%
    dplyr::mutate(weight = edge_length())
  
  # routing
  from = c(df_spec_clust[1, c("Longitude")], df_spec_clust[1, c("Latitude")])
  to = c(df_spec_prop[4, c("Longitude")], df_spec_prop[4, c("Latitude")])
  p1 = st_as_sf(data.frame(x = from[1], y = from[2]), coords = c("x", "y"), crs = st_crs(net))
  p2 = st_as_sf(data.frame(x = to[1], y = to[2]), coords = c("x", "y"), crs = st_crs(net))
  r = tidygraph::convert(net, to_spatial_shortest_paths, p1, p2)
  
  # Extract the bbox for r 
  bbox_r = st_as_sfc(r %>% activate(edges) %>% st_bbox())
  
  
  # filter the net
  small_net = st_filter(net, bbox_r)
  
  # plot
  plot1<-tm_shape(small_net %>% activate(edges) %>% st_as_sf()) +
    tm_lines() + 
    tm_shape(rbind(p1, p2)) + 
    tm_dots(col = "red", size = 0.5) + 
    tm_shape(r %>% activate(edges) %>% st_as_sf()) + 
    tm_lines(col = "red", lwd = 3)

  return(list(
    "Plot1" = plot1,
    "Data" =  df
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
          tabPanel("",
           sidebarLayout(
             sidebarPanel(
               sliderInput("Slider", h5(""),
                           min = 2, max = 4, value = 3),
               selectInput("Filter1", label = h4("Select just one cluster"),""),
               selectInput("Filter2",label=h4("Select the cluster property"),""),
             ),
             mainPanel(
               tabsetPanel(
                 tabPanel("Map", plotOutput("Map1"))))
           ))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,input$Slider,input$Filter1,input$Filter2)
  })
  

  output$Map1 <- renderPlot({
    Modelcl()[[1]]
  })
  
  observeEvent(input$Slider, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
  observeEvent(input$Filter1,{
    abc <- req(Modelcl()$Data) %>% filter(cluster == as.numeric(input$Filter1))
    updateSelectInput(session,'Filter2',
                      choices=sort(unique(abc$Property)))
  }) 
  
  
}

shinyApp(ui = ui, server = server)

地图已生成，但使用了传单包(工作正常)

library(shiny)
library(rdist)
library(geosphere)
library(shinythemes)
library(leaflet)
library(tidygraph)

function.cl<-function(df,k,Filter1,Filter2){
  
  #database df
  df <- structure(
    list(Property = c(1,2,3,4,5,6,7), Latitude = c(-24.779225, -24.789635, -24.763461, -24.794394, -24.747102,-24.781307,-24.761081),
         Longitude = c(-49.934816, -49.922324, -49.911616, -49.906262, -49.890796,-49.8875254,-49.8875254), 
         Waste = c(526, 350, 526, 469, 285, 433, 456)),class = "data.frame", row.names = c(NA, -7L))
  
  #clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average") 
  clusters<-cutree(fit.average, k) 
  nclusters<-matrix(table(clusters))  
  df$cluster <- clusters 
  
  #Create database df1
  center<-matrix(nrow=k,ncol=2)
  for(i in 1:k){
    center[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
                  weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
  coordinates$cluster<-clusters 
  center<-cbind(center,matrix(c(1:k),ncol=1)) 
  df1<-as.data.frame(center)
  colnames(df1) <-c("Latitude", "Longitude", "cluster")
  
  #specify cluster and specific cluster and specific propertie
  df_spec_clust <- df1[df1$cluster==Filter1,]
  df_spec_prop<-df[df$Property==Filter2,]
  
  
  #color for map
  ai_colors <-c("red","gray","blue","orange","green","beige","darkgreen","lightgreen", "lightred", "darkblue","lightblue",
                "purple","darkpurple","pink", "cadetblue","white","darkred", "lightgray","black")
  clust_colors <- ai_colors[df$cluster]
  icons <- awesomeIcons(
    icon = 'ios-close',
    iconColor = 'black',
    library = 'ion',
    markerColor =  clust_colors)
  
  # create icon for map
  leafIcons <- icons(
    iconUrl = ifelse(df1$cluster,
                     
                     "https://image.flaticon.com/icons/svg/542/542461.svg"
    ),
    iconWidth = 30, iconHeight = 40,
    iconAnchorX = 25, iconAnchorY = 12)
  
  html_legend <- "<img src='https://image.flaticon.com/icons/svg/542/542461.svg'>"
  
# create map
  if(nrow(df_spec_clust)>0){
    clust_colors <- ai_colors[df_spec_clust$cluster]
    icons <- awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor =  clust_colors)
    
  m1<-leaflet(df_spec_clust) %>% addTiles() %>% 
    addMarkers(~Longitude, ~Latitude, icon = leafIcons) %>%
    addAwesomeMarkers(leaflet(df_spec_prop) %>% addTiles(), lat=~df_spec_prop$Latitude, lng = ~df_spec_prop$Longitude, icon= icons,label=~cluster)

  for(i in 1:nrow(df_spec_clust)){
    df_line <- rbind(df_spec_prop[,c("Latitude","Longitude")],
                     df_spec_clust[i,c("Latitude","Longitude")])
    m1 <- m1 %>%
      addPolylines(data = df_line,
                   lat=~Latitude,
                   lng = ~Longitude,
                   color="red")
  }
  plot1<-m1} else plot1 <- NULL

  return(list(
    "Plot1" = plot1,
    "Data"= df
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("",
                      sidebarLayout(
                        sidebarPanel(
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 4, value = 3),
                          selectInput("Filter1", label = h4("Select just one cluster"),""),
                          selectInput("Filter2",label=h4("Select the cluster property"),""),
                        ),
                        mainPanel(
                          tabsetPanel(
                            tabPanel("Map", uiOutput("Map1"))))
                      ))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,input$Slider,input$Filter1,input$Filter2)
  })
  
  output$Map1 <- renderUI({ 
    if(input$Filter1!="") 
      leafletOutput("Leaf1",width = "95%", height = "600") })

  output$Leaf1 <- renderLeaflet({
    req(Modelcl())[[1]]
  })
  
  
  observeEvent(input$Slider, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
  observeEvent(input$Filter1,{
    abc <- req(Modelcl()$Data) %>% filter(cluster == as.numeric(input$Filter1))
    updateSelectInput(session,'Filter2',
                      choices=sort(unique(abc$Property)))
  }) 
  
  
}

shinyApp(ui = ui, server = server)

推荐答案

您在selectInput中遇到问题。您正在调用一个函数来获取Filter1和Filter2，但该函数需要Filter1和Filter2才能执行。执行以下代码，但它显示地图的速度很慢。更新Filter1和Filter2会得到更新的地图，但需要几秒钟。 定义它的一种更健壮的方式是在单独的函数中定义数据帧。这将帮助我们定义Filter1和Filter2，然后我们可以将此信息传递给Plot函数。这将消除通过不存在的组合的机会，而这有时是一个问题。

library(shiny)
library(rdist)
library(geosphere)
library(shinythemes)
library(sf)
library(tidygraph)
library(sfnetworks)
library(tmap)

###for the roads file
download.file("https://github.com/JovaniSouza/JovaniSouza5/raw/master/Test.zip", "Test.zip")
unzip("Test.zip")

#database df
df <- structure(
  list(Property = c(1,2,3,4,5,6,7), Latitude = c(-24.779225, -24.789635, -24.763461, -24.794394, -24.747102,-24.781307,-24.761081),
       Longitude = c(-49.934816, -49.922324, -49.911616, -49.906262, -49.890796,-49.8875254,-49.8875254),
       Waste = c(526, 350, 526, 469, 285, 433, 456)),class = "data.frame", row.names = c(NA, -7L))

fun.clusters <- function(df,k){
  ## clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average")
  clusters<-cutree(fit.average, k)
  nclusters<-matrix(table(clusters))
  df$cluster <- clusters
  return(df)
}

function.cl<-function(df,k,Filter1,Filter2){
  ## clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average")
  clusters<-cutree(fit.average, k)
  nclusters<-matrix(table(clusters))
  df$cluster <- clusters
  ##  Create database df1
  center<-matrix(nrow=k,ncol=2)
  for(i in 1:k){
    center[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
                  weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
  coordinates$cluster<-clusters
  center<-cbind(center,matrix(c(1:k),ncol=1))
  df1<-as.data.frame(center)
  colnames(df1) <-c("Latitude", "Longitude", "cluster")

  # specific cluster and specific property
  if (is.null(Filter1)) {
    df_spec_clust <- unique(df1$cluster)
  }else { df_spec_clust <- df1[df1$cluster==Filter1,]}
  if (is.null(Filter1)) {
    df_spec_prop <- unique(df$Property)
  }else {df_spec_prop<-df[df$Property==Filter2,] }


  #create map

  roads = st_read("Test/regionbrazil.shp", quiet = TRUE) %>%
    st_cast("LINESTRING")

  # build sfnetwork
  net = as_sfnetwork(roads, directed = FALSE) %>%
    activate("edges") %>%
    dplyr::mutate(weight = edge_length())

  # routing
  from = c(df_spec_clust[1, c("Longitude")], df_spec_clust[1, c("Latitude")])
  to = c(df_spec_prop[1, c("Longitude")], df_spec_prop[1, c("Latitude")])
  p1 = st_as_sf(data.frame(x = from[1], y = from[2]), coords = c("x", "y"), crs = st_crs(net))
  p2 = st_as_sf(data.frame(x = to[1], y = to[2]), coords = c("x", "y"), crs = st_crs(net))
  r = tidygraph::convert(net, to_spatial_shortest_paths, p1, p2)

  # Extract the bbox for r
  bbox_r = st_as_sfc(r %>% activate(edges) %>% st_bbox())


  # filter the net
  small_net = st_filter(net, bbox_r)

  # plot
  plot1<-tm_shape(small_net %>% activate(edges) %>% st_as_sf()) +
    tm_lines() +
    tm_shape(rbind(p1, p2)) +
    tm_dots(col = "red", size = 0.5) +
    tm_shape(r %>% activate(edges) %>% st_as_sf()) +
    tm_lines(col = "red", lwd = 3)

  return(list(
    "Plot1" = plot1,
    "Data" =  df
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl",
             tabPanel("",
                      sidebarLayout(
                        sidebarPanel(
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 4, value = 2),
                          selectInput("Filter1", label = h4("Select just one cluster"),
                                      choices=c(), selected=NULL),
                                      #choices=unique(df$cluster), selected=1),
                          selectInput("Filter2",label=h4("Select the cluster property"),
                                      choices=c(), selected=NULL)
                                      #choices=df$Property, selected=1)
                          
                        ),
                        mainPanel(
                          tabsetPanel(
                            tabPanel("Map", plotOutput("Map1"))
                            )
                        )
                      )

             )
  ))

server <- function(input, output, session) {
  
  dfa <- reactive({
    req(input$Slider)
    fun.clusters(df,input$Slider)
  })
  observeEvent(input$Slider, {

    #abc <- Modelcl()[[2]]
    abc <- dfa()
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  })
  
  observeEvent(input$Filter1,{
    
    #abcd <- Modelcl()[[2]] %>% filter(cluster == as.numeric(input$Filter1))
    abcd <- dfa() %>% filter(cluster == as.numeric(input$Filter1))
    updateSelectInput(session,'Filter2',
                      choices=sort(unique(abcd$Property)))
  })

  Modelcl<-reactive({
    req(input$Slider,input$Filter1,input$Filter2)
    function.cl(df,input$Slider,input$Filter1,input$Filter2)
  })

  output$Map1 <- renderPlot({
    Modelcl()[[1]]
  })

}

shinyApp(ui = ui, server = server)

输出：

这篇关于SHINTINE中涉及地图生成的问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！