You had a problem in selectInput
. You were calling a function to get the Filter1
and Filter2
, but the function needs Filter1
and Filter2
to execute. The following code executes, but it is slow in showing the map. Updating Filter1
and Filter2
gives an updated map, but it takes a few seconds.
A more robust way to define it would be to define the dataframe in a separate function. That will help us define Filter1
and Filter2
, and then we can pass on this information to the plot function. This will eliminate the chances of passing non-existing combinations which has been a problem sometimes.
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)
Output: