R блестящий: отменить выделение - PullRequest
0 голосов
/ 09 ноября 2018

Прежде всего, спасибо Шри, который очистил и сделал мой предыдущий код более производительным здесь

Во всяком случае, у меня есть некоторый код, который позволяет пользователю выбрать один или несколько видов (из selectizeInput). Приложение отображает распределение видов на карте.

Теперь, я озадачен, потому что я не могу отменить выбор видов? После построения распределений они остаются на карте, и я больше не могу их удалять ... Я искал тщательно, но не мог видеть это .. Я довольно плохо знаком с блестящими ... так что, вероятно, легкая ошибка?

Весь код ниже, Спасибо!!! Jónás

DATAFRAME

df<- data.frame(
  Number_Total = sample(c("5", "6", "1", "3")),
  Species = sample(c("Ilione trifaria", "Pherbellia argyrotarsis", 
"Euthycera seguyi", "Ilione trifaria")),
  X= sample(c("37", "28", "21", "30")),
  Y= sample(c("-5", "-16", "-10", "-15"))
)

UI

ui <- (fluidPage(titlePanel("Species Checker"),  
                 sidebarLayout(
                   sidebarPanel(
                      selectizeInput('species', 'Choose species', 
choices = df$Species, multiple = TRUE, 
options = list(placeholder = 'select species'))
                     ),
                   mainPanel(
                     leafletOutput("CountryMap", width = 600, height = 600))
                 )
))

SERVER

server <- function(input, output, session) {
  map_data <- reactive({
    #req(input$species)
    df[df$Species %in% input$species, ]
  })

  output$CountryMap <- renderLeaflet({
    leaflet() %>% addTiles() %>% 
      setView(lng = 20, lat = 40, zoom = 2)
  })

  map_proxy <- leafletProxy("CountryMap")

  observe({
    md <- map_data()
    map_proxy %>%
      addCircles(lng = md$Y, lat = md$X, weight = 10, 
                 radius = sqrt(md$Number_Total)*15000, popup = md$Species)
  })
}

Запустите приложение

shinyApp(ui = ui, server = server)

1 Ответ

0 голосов
/ 10 ноября 2018

Попробуйте нижеприведенное (некоторые переменные в df приведены без кавычек, так как в противном случае приложение вылетает):

library(tidyverse)
library(shiny)
library(leaflet)

df <- data.frame(
  Number_Total = sample(c(5, 6, 1, 3)),
  Species = sample(c("Ilione trifaria", "Pherbellia argyrotarsis", 
                     "Euthycera seguyi", "Ilione trifaria")),
  X= sample(c(37, 28, 21, 30)),
  Y= sample(c(-5, -16, -10, -15))
)

ui <- (fluidPage(titlePanel("Species Checker"),  
                 sidebarLayout(
                   sidebarPanel(
                     selectizeInput('species', 'Choose species', 
                                    choices = df$Species, multiple = TRUE, 
                                    options = list(placeholder = 'select species'))
                   ),
                   mainPanel(
                     leafletOutput("CountryMap", width = 600, height = 600))
                 )
))

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

  map_data <- reactive({
    #req(input$species)
    df[df$Species %in% input$species, ]
  })

  output$CountryMap <- renderLeaflet({

    leaflet() %>% addTiles() %>% 
      setView(lng = 20, lat = 40, zoom = 2) %>%
      addCircles(lng = map_data() %>% pull(Y), lat = map_data() %>% pull(X), weight = 10, 
                 radius = sqrt(map_data() %>% pull(Number_Total))*15000, 
                 popup = map_data() %>% pull(Species))

    })

}

shinyApp(ui = ui, server = server)

Вам нужно извлечь значения непосредственно из контекста reactive; Я бы также предложил сделать это в одном утверждении, а не распространять его по всему.

P.S. В случае, если ваш исходный фрейм данных действительно содержит все переменные в формате character, вы можете добавить на всякий случай оператор mutate_at в части map_data, например:

map_data <- reactive({
    #req(input$species)
    df[df$Species %in% input$species, ] %>%
      mutate_at(vars(c("Number_Total", "X", "Y")), funs(as.numeric))

Тогда скрипт также будет работать с указанным здесь исходным кадром данных без изменений вручную.

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