简体   繁体   中英

How do I make my r codes work inside shiny?

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.

Edit

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM