блестящий фильтр, перекрывающий предоставленные пользователем даты с датами набора данных - PullRequest
Новая
       13

блестящий фильтр, перекрывающий предоставленные пользователем даты с датами набора данных

0 голосов
/ 06 ноября 2019

У меня есть простое задание в сиянии, которое я не могу решить. Я пытаюсь отфильтровать даты (следуя этому примеру ) в кадре данных, если интервалы между двумя датами перекрывают выбранные пользователем. По сути, я пытаюсь реализовать следующую функцию в двух частях - одна, которая будет 1. фильтровать данные и 2. также сообщать пользователю идентификаторы tally между интервалами где-то на экране в отдельной области: 

library(dplyr)
library(shiny)
library(lubridate)

df <- data.frame(date1 = seq.Date(from =as.Date("1997-01-01"), 
                                  to=as.Date("1997-01-07"), by="day"),
                 date2 = seq.Date(from =as.Date("1997-01-03"), 
                                  to=as.Date("1997-01-09"), by="day"),
                 id = c(rep("a", 3), rep("b",4)))
df
       date1      date2 id
1 1997-01-01 1997-01-03  a
2 1997-01-02 1997-01-04  a
3 1997-01-03 1997-01-05  a
4 1997-01-04 1997-01-06  b
5 1997-01-05 1997-01-07  b
6 1997-01-06 1997-01-08  b
7 1997-01-07 1997-01-09  b

Моя основная функция для вычисления, если пользовательские даты перекрывают даты в наборе данных (а также подсчитывать их по разным идентификаторам): 

my_interval <- function(date_from, date_to) {
  df2 <- df %>%
    mutate(tmp_interval = as.integer(int_overlaps(interval(date1, date2), 
                                                  interval(as.Date(date_from), as.Date(date_to))))) %>%
    filter(tmp_interval == 1) %>%
    distinct(id) %>%
    ungroup() 
  x <- c("The number of IDs between ", date_from, " and ", date_to, " was ", tally(df2))
  return(paste(x, collapse = ""))
}
my_interval("1997-01-03", "1997-01-05")
#"The number of IDs between 1997-01-03 and 1997-01-05 was 2"

Если я хочу сначала просто отфильтровать данные в блестящем,следующее возвращает ошибку unused argument (input$dateRange[2])

ui <- fluidPage(
  titlePanel("test"),

  column(4, wellPanel(
    dateRangeInput('dateRange',
                   label = 'Filter overlapping dates',
                   start = as.Date('1997-01-01') , end = as.Date('1997-03-01')
    )
  )),
  column(6,
         dataTableOutput('my_table')
  )
)

server <- function(input, output, session) {
  output$my_table  <- renderDataTable({
    df %>%
      mutate(tmp_interval = as.integer(int_overlaps(interval(date1, date2), 
                                                    interval(input$dateRange[1]), input$dateRange[2]))) %>%
      filter(tmp_interval == 1)
  })
}

shinyApp(ui = ui, server = server)

Любые предложения по исправлению (и улучшению) кода приветствуются. Кроме того, мне интересно, это лучший способ найти перекрывающиеся даты, он медленно работает только на 70000 строк.

...