调整以从 selecInput 生成正确的地图

Question

首先，我会做一个简单的例子，让你理解这个想法。

library(googleway)

set_key( "API KEY")


df<-structure(list(Properties = c(1,2,3,4), 
                     Latitude = c(-24.930473, -24.95575,-24.990473, -24.99575), 
                     Longitude = c(-49.994889, -49.990162,-49.999889, -49.999162), 
                     cluster = c(1,2,1,2)), class = "data.frame", row.names = c(NA, -4L))
  
  df1<-structure(list(Latitude = c(-24.924361,-24.95575), 
                      Longitude = c(-50.004343, -50.007371), 
                      cluster = c(1,2)), class = "data.frame", row.names = c(NA, -2L))
  
 # considering `Filter1= 1`, that is, cluster 1 that I want to see, and `Filter2= 3`, that is property number 3, so:

Filter1=1

Filter2=3

  data_table1<-df1[df1$cluster==Filter1,c(1:2)]
  data_table2<-df[df$Properties==Filter2,c(2:3)]
  
 
   #Generate the map with routes
  
  df2<-google_directions(origin = data_table1, destination = data_table2, 
                         mode = "driving")
  
  df_routes <- data.frame(polyline = direction_polyline(df2))
  
  
  m1<-google_map() %>%
    add_polylines(data = df_routes, polyline = "polyline")

现在，我的想法是使用 shiny。从这个意义上说，我创建了两个selecInput，第一个对应Filter 1（你想看哪个集群），另一个对应Filter 2（你想看哪个属性查看）。选择这两条信息生成路线，就像我在上面的例子中所做的那样。但是，我无法在 shiny 中解决这个问题。

这个问题非常相似，可能会有帮助：但是，它有一些不同，例如我又插入了一个过滤器。

library(shiny)
library(rdist)
library(geosphere)
library(shinythemes)
library(googleway)


set_key( "API KEY")



function.cl<-function(df,df1,k,Filter1){
  
  #database df
  df<-structure(list(Properties = c(1,2,3,4), 
                     Latitude = c(-24.930473, -24.95575,-24.990473, -24.99575), 
                     Longitude = c(-49.994889, -49.990162,-49.999889, -49.999162), 
                     cluster = c(1,2,1,2)), class = "data.frame", row.names = c(NA, -4L))
  
  df1<-structure(list(Latitude = c(-24.924361,-24.95575), 
                      Longitude = c(-50.004343, -50.007371), 
                      cluster = c(1,2)), class = "data.frame", row.names = c(NA, -2L))
  

  data_table1<-df1[df1$cluster==Filter1,c(1:2)]
  data_table2<-df[df$Properties==Filter2,c(2:3)]
  
 
   #Generate the map with routes
  
  df2<-google_directions(origin = data_table1, destination = data_table1, 
                         mode = "driving")
  
  df_routes <- data.frame(polyline = direction_polyline(df2))
  
  
  m1<-google_map() %>%
    add_polylines(data = df_routes, polyline = "polyline")
  
  plot1<-m1 
  
  return(list(
    "Plot1" = plot1,
    "Data" = df
  ))
}

ui <- bootstrapPage(
  
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Map of all clusters",
                      sidebarLayout(
                        sidebarPanel(
                          tags$b(h3("Choose the cluster number?")),
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 2, value = 2),
                          selectInput("Filter1", label = h4("Select just one cluster to show"),""),
                          selectInput("Filter2", label = h4("Select the propertie"),""),
                        ),
                        
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", (google_mapOutput("G2",width = "95%", height = "600")))))
                        
                      ))))


server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,df1,input$Slider,input$Filter1)
  })
  
  output$G2 <- renderGoogle_map({
    Modelcl()[[1]]
  })
  
  
  observeEvent(input$Slider, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
  observeEvent(c(input$Filter1 ),{
    abc <- req(Modelcl()$Data) %>% filter(cluster == as.numeric(input$Filter1))   
    updateSelectInput(session,'Filter2',
                      choices = unique(abc$Propertie))
    
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

你的三个输入的闪亮示例：

Slider，在函数签名

k

Filter1，这似乎与 k 相同（即选择集群），目前在函数签名

Filter1

Filter2，用于选择属性，但从未传递给函数。

我想你想做的是只包含 Slider 和 Filter2（或 Filter1 和 Filter2）。

然后把Modelcl改成

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

然后，在您的实际函数中，重命名您在签名中的输入，以便它们更好地与您传递的内容保持一致。我建议这样：

function.cl<-function(df,df1,cluster,property){

那么，你可以

data_table1<-df1[df1$cluster==cluster,c(1:2)]
data_table2<-df[df$Properties==property,c(2:3)]

最后，请注意您在调用 google_directions() 时出错。您需要确保 origin 和 destination 参数不同。目前，它们都设置为 data_table1

这是一个示例，其中进行了更改：


library(shiny)
library(rdist)
library(geosphere)
library(shinythemes)
library(googleway)


function.cl<-function(df,df1,cluster,property){
  

  #database df
  df<-structure(list(Properties = c(1,2,3,4), 
                     Latitude = c(-24.930473, -24.95575,-24.990473, -24.99575), 
                     Longitude = c(-49.994889, -49.990162,-49.999889, -49.999162), 
                     cluster = c(1,2,1,2)), class = "data.frame", row.names = c(NA, -4L))
  
  df1<-structure(list(Latitude = c(-24.924361,-24.95575), 
                      Longitude = c(-50.004343, -50.007371), 
                      cluster = c(1,2)), class = "data.frame", row.names = c(NA, -2L))
  
  
  data_table1<-df1[df1$cluster==cluster,c(1:2)]
  data_table2<-df[df$Properties==property,c(2:3)]
  

  #Generate the map with routes
  
  df2<-google_directions(origin = data_table1, destination = data_table2, 
                         mode = "driving")
  
  df_routes <- data.frame(polyline = direction_polyline(df2))
  
  
  m1<-google_map() %>%
    add_polylines(data = df_routes, polyline = "polyline")
  
  plot1<-m1 
  
  return(list(
    "Plot1" = plot1,
    "Data" = df
  ))
}

ui <- bootstrapPage(
  
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Map of all clusters",
                      sidebarLayout(
                        sidebarPanel(
                          tags$b(h3("Choose the cluster number?")),
                          sliderInput("Slider", h5(""),
                                      min = 1, max = 2, value = 1,step = 1),
                          selectInput("Filter2", label = h4("Select the properties"),choices =c(1,2,3,4)),
                        ),
                        
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", (google_mapOutput("G2",width = "95%", height = "600")))))
                        
                      ))))


server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,df1,input$Slider,input$Filter2)
  })
  
  output$G2 <- renderGoogle_map({
    Modelcl()[[1]]
  })
  
  
  observeEvent(input$Slider, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
  # observeEvent(c(input$Filter1 ),{
  #   abc <- req(Modelcl()$Data) %>% filter(cluster == as.numeric(input$Filter1))   
  #   updateSelectInput(session,'Filter2',
  #                     choices = unique(abc$Propertie))
  #   
  # })
  
}

shinyApp(ui = ui, server = server)

调整以从 selecInput 生成正确的地图

Adjust to generate correct maps from selecInput

google-maps

r

shiny

googleway