Issue involving map generation in shiny

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:

output

Leave a Comment