Кадр данных подмножества с daterangeInput перед дальнейшим подмножеством без Shiny - PullRequest
0 голосов
/ 17 мая 2019

Я впервые использую stackoverflow, чтобы задать вопрос, поэтому я надеюсь, что следующее достаточно ясно:

Я делаю блестящее приложение, в котором я отображаю свои данные с помощью Leaflet.График в настоящее время состоит из трех слоев (type = a, type = b, type = a + b), которые можно выбрать с помощью флажков и где я также добавил срезы для выбора длительности.

Прямо сейчасвсе работает, но я хочу добавить DaterangeInput.

Мой фрейм данных состоит из пяти переменных (в простейшем виде) имя / местоположение / тип / продолжительность / дата.Одно и то же имя может иметь множество наблюдений, поскольку они являются событиями, и разные наблюдения для одного и того же имени могут иметь тип = a или type = b.

Для моего в настоящее время работающего приложения Shiny я подменю свои необработанные данные на group_by (name) для типа = a, типа = b и типа = a + b.Таким образом, я получаю три слоя, которые я могу выбрать с помощью своей группы флажков.Подмножественные кадры данных впоследствии используются внутри реактивной функции, чтобы действовать, когда ползунок используется для изменения количества маркеров на моей карте Leaflet.

Что я хочу сделать сейчас, так это переопределить мой необработанный кадр данных с использованием daterangeInput передвсе остальное.Причина этого заключается в том, что дата является единственной уникальной переменной, поэтому я хочу, чтобы она использовалась в качестве первого фильтра, но не осознавала, пока не создала работающее приложение Shiny, в которое я просто хотела добавить одну небольшую вещь: P

Вот упрощенная версия моего кода

ui <- fluidPage(
  titlePanel(Title),
  sidebarLayout(
    sidebarPanel(

      #slider for number of events
      sliderInput(inputId = "events",
                  label = "number:",
                  min = 1, max = 100,
                  value = c(1,100),
                  step = 1),

      #type a and/or b
      checkboxInput(inputId = "a",
                    label = "a",
                    value = TRUE),
      checkboxInput(inputId = "b",
                    label = "b",
                    value = TRUE),

      #Daterange for events to plot
      dateRangeInput(inputId = "date",
                     label = "from - until:",
                     start = 1-1-2018,
                     end = 31-12-2019,
                     min = 1-1-2018,
                     max = 31-12-2019,
                     format = "dd/mm/yyyy",
                     separator = " - "),
      ),

    #printing map
    mainPanel(
      leafletOutput(outputId = "map", width = "100%", height = 900)
    )
  )
)

server <- function(input, output) {
  output$map <- renderLeaflet({

    #plot empty map
    empty_map <- leaflet() %>%
      addTiles() %>%
      setView(lng = 5.583541, lat = 52.577159, zoom = 8)
  })


  raw_date <- reactive({
    raw[raw$date >= input$date[1] & raw$date <= input$date[2],]
    raw
  })

#other filters
  #removing duplicate adresses
  reactive({
    rawdate <- raw_date()
    Name_unq <- rawdate[!duplicated(rawdate$Adres),]
    Name_unq <- Adr_tot_unq[order(Adr_tot_unq$Adres),]


  #determining information per event
    type_ab <- rawdate %>%
      group_by(Adres) %>%
      summarise(Total = sum(duration), mean = mean(duration)) %>%
      ungroup()

  #link adresses and location  
    type_ab <- data.frame(type_ab,Name_unq$Longitude,Name_unq$Latitude)
    names(type_ab)[7:8] <- c("Longitude", "Latitude")

  #determining which layer to plot
  observeEvent({input$a
    input$b},
    {if(input$a == TRUE & input$b == TRUE) {
      lpRemoveAll()
      lpAddTotal()
    } else if(input$a == FALSE & input$b == FALSE) {
      lpRemoveAll()
    }
    }
  )

 #define functions and type_ab-layer
  lpAddTotal <- function() {
    observe(
      leafletProxy(mapId = "map", data = type_ab_slider()) %>%
        clearMarkerClusters() %>%
        addMarkers(clusterOptions = markerClusterOptions(),group = "Total")
    )
  }

 #define function lpRemove
  lpRemoveAll <- function() {
    leafletProxy(mapId = "map") %>%
      clearGroup("Total") 
    }

  #functions to link sliders to layers
  type_ab_slider <- reactive({
    type_ab[(type_ab$Aantal >= input$events[1] & type_ab$Aantal <= input$events[2]),]
  })

shinyApp(ui = ui, server = server)

Заключительные замечания: я хочу разместить свои необработанные данные с помощью daterangeInput, после чего я хочу выполнить дополнительную фильтрацию для этого подмножества.

1 Ответ

0 голосов
/ 17 мая 2019

try:

raw_date <- reactive({
  raw  <- subset(raw, date >= input$date[1] & date <= input$date[2])
  raw
  })

и:

reactive({
rawdate<-raw_date()
type_a <- rawdate[type == "a"]
type_a
})

вам не нужен наблюдатель во второй части, реактивный делает то, что вы ищете.Надеюсь, это поможет!

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