How to tweak table generation in Shiny

Could you help me tweak the shiny code below? The first code is just to show the averages I got from my Test database. You can see that I only have an average for Fridays, with that in Shiny I would like to present these averages if I choose to see until a day that is Friday in the daterange, but it is not working very well. It works only if I put it in the daterange from 01/11 to 05/11, but if I choose 02/11 to 05/11, for example, it doesn't work. Also, if I input 01/11 through 02/11 it shows the averages, however, it would not have to be shown as none of those dates are Friday. I inserted three images for you to see. How can I adjust this in code?

First code

library(dplyr)

   Test <- structure(list(date1 = as.Date(c("2021-11-01","2021-11-01","2021-11-01","2021-11-01")),
                           date2 = as.Date(c("2021-10-22","2021-10-22","2021-10-29","2021-10-29")), 
                           Week = c("Friday", "Friday", "Friday", "Friday"),
                           Category = c("FDE", "ABC", "FDE", "ABC"), 
                           time = c(4, 6, 6, 3)), class = "data.frame",row.names = c(NA, -4L))
  meanTest<-Test%>%
      group_by(Week,Category)%>%
      summarize(mean(time))
    > meanTest

  Week   Category    `mean(time)`
1 Friday ABC               4.5
2 Friday FDE               5

Second code

library(shiny)
library(shinythemes)
library(dplyr)

Test <- structure(list(date1 = as.Date(c("2021-11-01","2021-11-01","2021-11-01","2021-11-01")),
                       date2 = as.Date(c("2021-10-22","2021-10-22","2021-10-29","2021-10-29")), 
                       Week = c("Friday", "Friday", "Friday", "Friday"),
                       Category = c("FDE", "ABC", "FDE", "ABC"), 
                       time = c(4, 6, 6, 3)), class = "data.frame",row.names = c(NA, -4L))
ui <- fluidPage(
  
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 uiOutput('daterange')
                               ),
                               mainPanel(
                                 dataTableOutput('table')
                                 
                               )
                             ))
  ))

server <- function(input, output,session) {
  
  data <- reactive(Test)
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   min   = min(data()$date1))
  })
  
  
  
  data_subset <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    Test <- filter(data(),
                   date1 %in% days | 
                     date2 %in% days)
    
    meanTest<-Test%>%
      group_by(Week,Category)%>%
      summarize(mean(time))
    
  })
  
  
  output$table <- renderDataTable({
    data_subset()
  })
  
}

shinyApp(ui = ui, server = server)

01/11 until 05/11 works

enter image description here

02/11 until 05/11 does not work.

enter image description here

01/11 until 02/11 it shows the averages, however, it would not have to show
enter image description here

we dont know what date1 and date2 means for your context, or what the operation of testing them against some date range should result in... I guess the previous answer that I suggested, and which you accepted that assumed that one of either your date1 or your date2 should be within the daterange would be enough to pull the record through is not appropriate for your use case. But you should probably tell us what would be appropriate if you would like our help to write the logical condition...

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.