Как вывести на график все данные dataframe в leafletProxy ()? - PullRequest
Новая
       36

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

0 голосов
/ 11 декабря 2018

Я работаю с 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/>'))
  })

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

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

Ответы [ 2 ]

0 голосов
/ 12 декабря 2018

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

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])

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

0 голосов
/ 11 декабря 2018

Трудно протестировать без примеров данных, но у вас есть 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, что ваш фильтр Year отображал данные только в минимальном и максимальном годах, а не в промежутках между годами, что я сделал с помощью функции 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

})
...