First of all, I will make a brief example for you to understand the idea.
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")
Now, my idea is to use shiny. In this sense, I created two selecInput
, the first corresponds to Filter 1
(which cluster do you want to see) and the other to Filter 2
(which property do you want to see). Choosing these two pieces of information generates the route as I did in the example above. However, I am not able to fix this problem in shiny.
This question is very similar and might help:
CodePudding user response:
Your shiny example as three inputs:
Slider
, which gets passed tok
in the function signatureFilter1
, which appears to be the same ask
(i.e. choosing a cluster), and currently gets passed toFilter1
in the function signatureFilter2
, which is for selecting the Property, but never gets passed to the function.
I think what you want to do is include only Slider
and Filter2
(or Filter1
and Filter2
).
Then change the Modelcl
to
Modelcl<-reactive({
function.cl(df,df1,input$Slider,input$Filter2)
})
Then, in your actual function, rename your inputs in the signature so that they are better aligned with what you are passing in. I suggest something like this:
function.cl<-function(df,df1,cluster,property){
Then, you can
data_table1<-df1[df1$cluster==cluster,c(1:2)]
data_table2<-df[df$Properties==property,c(2:3)]
Finally, notice that you have an error in your call to google_directions()
. you need to make sure that the origin
and destination
parameters are different. currently, they are both set to data_table1
Here is an example, with the changes made:
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)