Блестящий, реагирует на события, работает несколько функций - PullRequest
0 голосов
/ 06 мая 2020

Я новичок в shiny, сейчас я пытаюсь создать код, в котором я могу рассчитывать кластеры активности (через пакет DBSCAN) на основе входных переменных: «eps» (минимальные расстояния между точками, которые должны быть частью кластера ), «minpts» (минимальное количество баллов для определенных категорий, таких как «Здоровье»), «maxpts» (минимальное количество баллов для общих категорий, таких как пабы, рестораны и т. д. c).

Я проводил тест только через листовка (без блеска), и код работает плавно, но как только я добавляю блестящую, я не могу заставить ее работать

идея состоит в том, что пользователь может изменять эти 3 переменные на боковой панели, и нажмите кнопку действия, чтобы запустить вычисление.

   #----------LIBRARIES----------#

library(plyr)
library(geosphere)
library(dbscan)
library(osmdata)
library(sf)
library(tidyr)
library(sp)
library(rgdal)
library(leaflet)
library(shiny)

#-------LOAD FILES-------#

OSM_merged <- read.csv(file = "C:\\Users\\jsainz\\Documents\\R\\Shiny_test\\OSM_merged.csv")

OSM_points <- OSM_merged

OSM_points$color <- OSM_points$category

OSM_points$color <- str_replace_all(OSM_points$color, "Culture", "#3073A")
OSM_points$color <- str_replace_all(OSM_points$color, "Educational", "# 887CAF")
OSM_points$color <- str_replace_all(OSM_points$color,"Financial", "#540002")
OSM_points$color <- str_replace_all(OSM_points$color,"Health", "#D6E899")
OSM_points$color <- str_replace_all(OSM_points$color,"Leisure", "#D2D68D")
OSM_points$color <- str_replace_all(OSM_points$color,"Office", "#D3696C")
OSM_points$color <- str_replace_all(OSM_points$color,"Shop", "#AA9739")
OSM_points$color <- str_replace_all(OSM_points$color,"Sport", "#378B2E")
OSM_points$color <- str_replace_all(OSM_points$color,"Sustain", "#554600")
OSM_points$color <- str_replace_all(OSM_points$color,"Toursim", "#5FAE57")

xy <- OSM_points[,c(2,3)]
OSM_points <- SpatialPointsDataFrame(coords = xy, data = OSM_points,proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"))

#-------FUNCTIONS-------#

assign_clusters <- function(poi_df, minPts = NA) {
  if(is.na(minPts)) {
    if(poi_df[1, "category"] %in% c("Culture", "Leisure", "Education", "Health", "Financial")) {
      minPts <- "minpts"
    } else minPts <- "maxpts"
  }

  eps <- "epsilon"

  poi_df[c("lng", "lat")] %>% 
    distm(fun = distHaversine) %>%
    as.dist() %>% 
    dbscan(eps = eps, minPts = minPts) %>% 
    .[["cluster"]] %>% 
    cbind(poi_df, cluster = .)
}

get_hull<- function(df) {

  cbind(df$lng, df$lat) %>% 
    as.matrix() %>%
    st_multipoint() %>% 
    st_convex_hull() %>% 
    st_sfc(crs = 4326) %>% 
    {st_sf(category = df$category[1], cluster = df$cluster[1], geom = .)}
}

hulls <- function(df) {

  df %>%
    split(.$cluster) %>% 
    map(get_hull)

}

#----------SHINY CODE----------#

ui <- fluidPage(

  titlePanel("Jorge_Test"),

  sidebarPanel(
  numericInput(inputId = "epsilon", label = "distance in meters to calculate activity clusters", 200),
  numericInput(inputId = "minpts", label = "minimum points to calculate clusters", 5),
  numericInput(inputId = "maxpts", label = "maximum points to calculate clusters", 10),
  actionButton("run", "Run Calculation"),
  actionButton("view", "generate plan"),
  width = 2),

  mainPanel(
  leafletOutput("mymap", width = 1550, height = 850)
  )
)

server <- function(input, output, session) {

  output$mymap <- renderLeaflet({
    leaflet("mymap")%>%
      setView(lng = 0.0982, lat = 51.7674, zoom = 15)%>%
      addProviderTiles(providers$CartoDB.Positron, options = providerTileOptions(noWrap = TRUE))%>%
      addCircleMarkers(data = OSM_points,
                       radius = .7,
                       popup = ~category,
                       color = ~color)})

  oberveEvent(input$run, {

  updateNumericInput(session, "epsilon")
  updateNumericInput(session, "minpts")
  updateNumericInput(session, "maxpts")

  })

  Clean_data <- OSM_merged %>%
    split(OSM_merged$category) %>%  
    map_df(assign_clusters)

  hulls_cat <- Clean_data %>%
    group_by(category) %>%
    summarise()

  map_cluster_hulls <- Clean_data %>%
    filter(cluster != 0) %>%
    select(lng, lat, category, cluster) %>% 
    split(.$category) %>% 
    map(hulls)

  mdata <- melt(map_cluster_hulls, id = c("category", "cluster", "geom"))
  mch <- data.frame(mdata$category, mdata$cluster, mdata$geom)

  observeEvent(input$view, {
    leafletProxy("mymap", session) %>%
    addPolygons(data = mch$geom,
                fill = NA,
                fillOpacity = .01,
                weight = 2,
                color = "red",
                opacity = .8)
  }
 )

}

shinyApp(ui, server)

есть идеи, как это решить?

вот ссылка на файл OSM_merged.csv: https://www.dropbox.com/s/5ok9frcvx8oj16y/OSM_merged.csv?dl=0

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...