Выбор временного интервала от плотности в определенный день недели в R Shiny

Question

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

ui = fluidPage(
selectInput("day","Choose a day:",choices = unique(weekdays(data$Timestamp))),
plotOutput("myplot", brush = brushOpts(id ="plot_brush", direction = "x")),
verbatimTextOutput("info"))

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

output$myplot <- renderPlot({
selected_subset  = data[which(weekdays(data$Timestamp)==input$day),]
labels =     as.factor(data[which(weekdays(data$Timestamp)==input$day),]$Label)

gg <- ggplot(selected_subset,aes(x = Timestamp, fill= labels)) + 
    stat_density(alpha=.75, show.legend = T, trim= T)  + 
    scale_x_datetime(breaks = date_breaks("1 hour"), labels=date_format("%H:%M"))

plot(gg)
})

D=reactive({brushedPoints(data[which(weekdays(data$Timestamp)==input$day),],brush = input$plot_brush, xvar=Timestamp)
})

output$info <- renderPrint({D()})   
}

shinyApp(ui, server)

Answer 1

Я решил эту проблему практически, просто добавив аргументы для sliderInput в пользовательском интерфейсе. Вот код:

ui <- fluidPage(
   selectInput("day","Choose a day:",choices = unique(weekdays(data$Timestamp)),selected = "Tuesday"), 
   sliderInput("time_range", label = "Time range:",
          min = min(data[which(weekdays(data$Timestamp)=="Tuesday"),]$Timestamp), 
          max = max(data[which(weekdays(data$Timestamp)=="Tuesday"),]$Timestamp), 
          value = c(min(data[which(weekdays(data$Timestamp)=="Tuesday"),]$Timestamp), 
                    max(data[which(weekdays(data$Timestamp)=="Tuesday"),]$Timestamp)),
          step = 10,timezone = "UTC",timeFormat="%H:%M:%S", dragRange = TRUE),
                    # dragRange means that min and max can be dragged together
                    # timezone must be the same as is in the beginning of document


   plotOutput("myplot"),
   verbatimTextOutput("info"))

server <- function(input, output, session) {
    observe({   # changing of slider input for time on selected day
    updateSliderInput(session, "time_range", 
                  min = min(data[which(weekdays(data$Timestamp)==input$day),]$Timestamp), 
                  max = max(data[which(weekdays(data$Timestamp)==input$day),]$Timestamp), 
                  value = c(min(data[which(weekdays(data$Timestamp)==input$day),]$Timestamp), 
                            max(data[which(weekdays(data$Timestamp)==input$day),]$Timestamp)),
                  step = 10,timezone = "UTC",timeFormat="%H:%M:%S")})

     output$myplot <- renderPlot({
          selected_subset=data[which(weekdays(data$Timestamp)==input$day),]  
          labels = as.factor(data[which(weekdays(data$Timestamp)==input$day),]$Label)

       gg <- ggplot(selected_subset,aes(x = Timestamp, fill= labels)) + 
    stat_density(alpha=.75, show.legend = T, kernel = "rectangular", trim= T)  + 
    scale_x_datetime(breaks = date_breaks("1 hour"), labels=date_format("%H:%M")) +
    coord_cartesian(xlim = c(input$time_range[1],input$time_range[2]))

    plot(gg)
})

     output$info <- renderPrint({
selected_timestamp=data[which(weekdays(data$Timestamp)==input$day),]$Timestamp
print(table(data[which((selected_timestamp<=input$time_range[2])&(selected_timestamp>=input$time_range[1])),]$Label))
  })

 }

shinyApp(ui, server)