I have two maps in the dashboard and first map can plot data directly from the dataframe. But the second map need some modifications to the dataframe before plotting. I need to make a distance matrix and then cluster the data based on the distance and then plot each cluster with the route using leaflet. The codes are working outside Shiny. Could someone please tell me how to make the script run in the shiny app?
library(shiny)
library(sf)
library(sp)
library(tidyverse)
library(osrm)
library(leaflet)
library(dplyr)
library(geosphere)
Name.Person = c("Person1",
"Person2",
"Person3",
"Person4")
Name.cluster = c('1','2','3','4','5','6','7','8','9','10','11','12','13','14','15')
ui <- fluidPage(
titlePanel("Mapping"),
sidebarLayout(
sidebarPanel(
selectInput("Person",
"Please Pick the Name of the Person:",
choices = Name.Person),
selectInput("cluster",
"Please Pick the Cluster:",
choices = Name.cluster),
mainPanel(
fluidRow(column(12,
"Total Places by Person)",
leafletOutput("full"))
),
fluidRow(column( 12,
"Route for the Selected Cluster",
leafletOutput("by_cluster")
),
fluidRow(column( 12,
"Route for the Selected Cluster",
)
))
)
))
server <- function(input, output) {
ba <- df
person <- reactive({
dplyr::filter(ba, person == input$fc)
})
output$cluster <- reactive({
(input$cluster )
})
size <- reactive({
(input$size )
})
# script that is not working in the shiny
df00 <- ba
Distance<- distm(df00[9:10],df00[9:10],fun = distHaversine)
Distance<- as.data.frame(Distance)
Distance[is.na(Distance)]<-0
DMat<- as.dist(Distance)
hc1 <- hclust(as.dist(DMat), method="complete")
df00$Clusters<- cutree(hc1, k=15)
# creating table by cluster
df1 <- df00 %>% filter(Clusters == 15)
df1a <- df1[,c(5,9,10)]
colnames(df1a) <- c('name',"lon","lat")
#load location file with clusre and person details
driver <- df2
driver <- driver [,c(4,6,7)]
driver <- driver[driver$name == "Driver1", ]
#output
df.f <- rbind(driver,df1a)
df.f <- df.f[,c(1,3,2)]
trip <- osrmTrip(df.f)
trip_sp <- trip[[1]]$trip
st_geometry(trip_sp) <- NULL
output$full <- renderLeaflet({
fc <- person()
factpal <- colorFactor(topo.colors(2), domain = df00$telehealth)
leaflet(data = fc ) %>%
addTiles() %>%
addCircleMarkers(lng = fc$lon, lat = fc$lat,
color = ~factpal(telehealth),
label = fc$Clusters,
popup = fc$ID,
labelOptions = labelOptions(noHide = T)) %>%
addLegend("bottomright", pal = factpal, values = ~telehealth,
title = "Clustering",
labFormat = labelFormat(prefix = "No. of "))
})
output$by_cluster <- renderLeaflet({
leaflet(data = trip_sp) %>%
addTiles() %>%
addMarkers(lng = cluster$lon, lat = cluster$lat, label =cluster$CHE.Village, labelOptions = labelOptions(noHide = T)) %>%
addPolylines()
})
}
shinyApp(ui = ui, server = server)
lon <- c(74.503374,74.361927,72.7724,74.249446,75.307936,75.34221,72.977549,73.662936,72.705651,72.604274,72.711952,72.374334,73.619711,73.590637,73.651634,72.725441,73.749052,73.157032,73.034292,73.029592,74.29749,75.393212,75.350777,74.157203,75.371267,75.730607,75.712329,73.754,73.574,73.566137,72.700473,73.516516,-53.553577,74.440077,74.693734,72.502516,74.65723,74.633677,74.677476,74.476655)
lat <- c(34.987416,35.6635,35.713439,34.5134,36.17393,36.161473,35.663161,34.397068,36.553839,35.370134,36.654358,36.756554,36.471303,36.641188,35.740845,35.654933,36.00418,34.636157,35.108336,35.013349,35.813585,36.0733,36.077737,35.938957,35.950488,36.35913,36.377195,35.043,35.171,34.316833,36.63948,34.361317,53.130405,35.011676,34.976569,36.347314,35.043161,34.818771,35.047736,35.054789)
ID <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40)
df <- data.frame(lon,lat,ID)
df2 <- data.frame(lon,lat,ID)
lat <- 73.516516
lat <- 34.316833
ID <-100
To start, you are missing the closing parenthesis for sidebarPanel
, right before mainPanel
, that way mainPanel becomes an argument of sidebarLayout (now it is an argument of sidebarPanel).
Also, you might want to replace ba <- read.csv("modelBA.csv")
with some generated data to explore further issues.
You still have not fixed the parenthesis on the UI side. Try this (see the #'s):
ui <- fluidPage(
titlePanel("Mapping"),
sidebarLayout(
sidebarPanel(
selectInput("Person",
"Please Pick the Name of the Person:",
choices = Name.Person),
selectInput("cluster",
"Please Pick the Cluster:",
choices = Name.cluster)), # parenthesis missing
mainPanel(
fluidRow(column(12,
"Total Places by Person", # removed unnecessary parenthesis
leafletOutput("full"))
),
fluidRow(column( 12,
"Route for the Selected Cluster",
leafletOutput("by_cluster")) #parenthesis missing
),
fluidRow(column( 12,
"Route for the Selected Cluster",
)))))
Besides that, On the server side you are calling three inputs (input$fc, input$size, input$cluster), but only the "cluster" input has been defined on the UI. Also, in
person <- reactive({
dplyr::filter(ba, person == input$fc)
})
you are trying to subset ba by a column named 'person' which does not exist on the data you've provided. I recommend you define your df before the ui and make sure it has all the data needed.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.