Как вывести на экран все данные dataframe в leafletProxy()?

Question

Я работаю с R в RStudio и создал блестящую приборную панель. На панели инструментов я использую функцию leaflet() для построения карты. Сейчас я пытаюсь поставить маркеры на карте, которая показывает преступления в Чикаго. Я работаю с функциями selectInput() и sliderInput(), чтобы выбрать другой тип преступления, местоположение и год. Если я выделю что-то внутри поля ввода, маркеры появятся на карте Чикаго, и это будет отлично работать. Но я хочу, чтобы при запуске блестящего приложения все маркеры отображались без фильтрации на основе selectInput(). Это мой код ui.R:

  tabItem(tabName = "map",
    div(class="outer",
    tags$head(
    tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"))),

    leafletOutput("map", width = "100%", height = "100%"),

    absolutePanel(id = "mapControls", fixed = TRUE, draggable = TRUE, top = 150, left = "auto", right = 15, bottom = "auto", width = 200, height = "auto",

    selectInput("mapCrimeType", label= "Select Crime Type", choices = unique(cc$Primary.Type), multiple = TRUE),

    selectInput("mapLocation", label= "Select Location", choices = unique(cc$Location.Description), multiple = TRUE),

    sliderInput("mapYear", label = "Select Year", min = 2001, max = 2016, step = 1, sep = '', value = c(2001,2016))

          )
  ),

А это мой код server.R:

server <- function(input, output) {

  ### Draw Map ###
  output$map = renderLeaflet({
      leaflet() %>% 
      addProviderTiles(providers$Esri.WorldStreetMap) %>% 
      setView(lng = -87.6105, lat = 41.8947, zoom=11)
  }) 

  reactMap = reactive({
    cc %>% 
    filter(Primary.Type %in% input$mapCrimeType &
             Location.Description %in% input$mapLocation &
             Year %in% cbind(input$mapYear[1],input$mapYear[2]))
  })

  observe({
    proxy = leafletProxy("map", data = reactMap()) %>%
      clearMarkers() %>%
      clearMarkerClusters() %>%
      addCircleMarkers(clusterOptions = markerClusterOptions(),
                       lng =~ Longitude, lat =~ Latitude, radius = 5, group = 'Cluster', 
                       popup =~ paste('<b><font color="Black">', 'Crime Information', 
                      '</font></b><br/>', 'Crime Type:', Primary.Type,'<br/>',
                      'Date:', Date,'<br/>', #'Time:', Time,'<br/>',
                      'Location:', Location.Description,'<br/>', 'Block:', Block, '<br/>', 'Arrest:', Arrest, '<br/>'))
  })

Я думаю, что я должен изменить что-то в реактивной функции внутри файла server.R. Я надеюсь, что кто-нибудь может мне помочь.

ОБНОВЛЕНИЕ: Работа с этим набором данных: https://www.kaggle.com/currie32/crimes-in-chicago

Answer 1

Трудно протестировать без примеров данных, но у вас есть 1 из 2 вариантов, которые я могу придумать:

Первый вариант - предварительно выбрать все параметры для mapCrimeType и mapLocation, добавив selected = unique(cc$Primary.Type) а также selected = unique(cc$Location.Description) соответственно. Я добавил mapYear ниже, но там ничего не нужно менять, так как вы выбрали весь диапазон с value = c(2001,2016) уже.

    selectInput("mapCrimeType", label= "Select Crime Type", choices = unique(cc$Primary.Type), multiple = TRUE, selected = unique(cc$Primary.Type)),

    selectInput("mapLocation", label= "Select Location", choices = unique(cc$Location.Description), multiple = TRUE, selected = unique(cc$Location.Description)),

    sliderInput("mapYear", label = "Select Year", min = 2001, max = 2016, step = 1, sep = '', value = c(2001,2016))

Если это слишком грязно (я не уверен, сколько вариантов у них есть), вы можете попробовать следующее:

  reactMap = reactive({
    if (is.null(input$mapCrimeType)) {
      mapCrimeType = unique(cc$Primary.Type)
    } else {
      mapCrimeType = input$mapCrimeType
    }
    if (is.null(input$mapLocation)) {
      mapLocation = unique(cc$Location.Description)
    } else {
      mapLocation = input$mapLocation
    }
    cc %>% 
    filter(Primary.Type %in% mapCrimeType &
             Location.Description %in% mapLocation &
             Year %in% cbind(input$mapYear[1],input$mapYear[2]))
  })

По сути, всякий раз, когда любой из selectInputs имеет значение NULL, мы включаем все варианты для этого selectInput (или оба, когда оба имеют значение NULL). Позвольте мне знать, если это помогает.

Обновить

Пожалуйста, попробуйте полный ответ ниже. У меня была ошибка выше.

if (is.null(input$mapLocation)) {
      mapLocation = unique(cc$Location.Description)
    } else {
      mapLocation = input$mapLocation
    }

имел is.null(input$mapCrimeType) скопировано из предыдущего оператора if.

Проверенный ответ здесь:

library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)

ui <- tabItem(tabName = "map",
                          div(class="outer",
                              tags$head(
                                  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"))),

                          leafletOutput("map", width = "100%", height = "100%"),

                          absolutePanel(id = "mapControls", fixed = TRUE, draggable = TRUE, top = 150, left = "auto", right = 15, bottom = "auto", width = 200, height = "auto",

                                        selectInput("mapCrimeType", label= "Select Crime Type", choices = unique(cc$Primary.Type), multiple = TRUE),

                                        selectInput("mapLocation", label= "Select Location", choices = unique(cc$Location.Description), multiple = TRUE),

                                        sliderInput("mapYear", label = "Select Year", min = 2001, max = 2016, step = 1, sep = '', value = c(2001,2016))

                          )
    )

server <- function(input, output) {

    ### Draw Map ###
    output$map = renderLeaflet({
        leaflet() %>% 
            addProviderTiles(providers$Esri.WorldStreetMap) %>% 
            setView(lng = -87.6105, lat = 41.8947, zoom=11)
    }) 

    reactMap = reactive({
        if (is.null(input$mapCrimeType)) {
            mapCrimeType = unique(cc$Primary.Type)
        } else {
            mapCrimeType = input$mapCrimeType
        }
        if (is.null(input$mapLocation)) {
            mapLocation = unique(cc$Location.Description)
        } else {
            mapLocation = input$mapLocation
        }
        cc %>% 
            filter(Primary.Type %in% mapCrimeType &
                       Location.Description %in% mapLocation &
                       between(Year, input$mapYear[1], input$mapYear[2]))
    })

    observe({
        proxy = leafletProxy("map", data = reactMap()) %>%
            clearMarkers() %>%
            clearMarkerClusters() %>%
            addCircleMarkers(clusterOptions = markerClusterOptions(),
                             lng =~ Longitude, lat =~ Latitude, radius = 5, group = 'Cluster', 
                             popup =~ paste('<b><font color="Black">', 'Crime Information', 
                                            '</font></b><br/>', 'Crime Type:', Primary.Type,'<br/>',
                                            'Date:', Date,'<br/>', #'Time:', Time,'<br/>',
                                            'Location:', Location.Description,'<br/>', 'Block:', Block, '<br/>', 'Arrest:', Arrest, '<br/>'))
    })
}

shinyApp(ui = ui, server = server)

Я добавил пункт из lbusett, что ваш годовой фильтр отображал данные только за минимальный и максимальный годы, а не за годы, что я сделал с помощью between функция от dplyr,

Вы можете включить ответ lbusett, который точнее, как показано ниже:

reactMap <- reactive({

  out_cc <- cc %>% 
    dplyr::filter(., Year >= input$mapYear[1] & 
                  Year <= input$mapYear[2])

  if (!is.null(input$mapCrimeType)) {
    out_cc <- out_cc %>% 
      dplyr::filter(., Primary.Type %in% input$mapCrimeType)
  }

  if (!is.null(input$mapLocation)) {
    out_cc <- out_cc %>% 
      dplyr::filter(., Location.Description %in% input$mapLocation)
  }

  out_cc

})

Answer 2

Без тестирования, но это должно работать. Просто измените реактив на:

reactMap <- reactive({

  out_cc <- cc %>% 
    dplyr::filter(., Year %in% cbind(input$mapYear[1],input$mapYear[2]))

  if (!is.null(input$mapCrimeType)) {
    out_cc <- out_cc %>% 
      dplyr::filter(., Primary.Type %in% input$mapCrimeType)
  }

  if (!is.null(input$mapLocation)) {
    out_cc <- out_cc %>% 
      dplyr::filter(., Location.Description %in% input$mapLocation)
  }

  out_cc

})

При вызове без "выбранного" значения и с multiple = TRUEСелекторы имеют NULL значение в начале или когда вы отмените выбор всего. Таким образом, вам просто нужно пропустить фильтрацию по данной переменной, когда соответствующий вход NULL,

Кстати, я могу ошибаться, но я думаю, что вам, возможно, придется изменить свой фильтр "Год" на что-то вроде:

dplyr::filter(., Year >= input$mapYear[1] & 
                  Year <= input$mapYear[2])

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