How to insert one more day-of-the-week condition into shiny

Question

The code in shiny below works normally. But I would like to add one more condition. Notice that in weeks_ine, I'm just considering wk$WeekE. So far ok, but I would also like to consider another condition as I want to change wk_port2eng to:

wk_port2eng <- data.frame(
    WeekE = c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"),
    WeekJ = c("Monday day","Tuesday day","Wednesday day","Thursday day","Friday day","Saturday","Sunday day"),
    WeekP = c("segunda-feira", "terca-feira", "quarta-feira", "quinta-feira",  "sexta-feira", "sabado", "domingo")
  )

So I would like to consider in weeks_ine both wk$WeekE and wk$WeekJ. How do I adjust this in the code below?

Executable code below

---

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

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-18","2021-10-18","2021-10-28","2021-10-30")),
                       Week = c("Monday", "Monday", "Sunday", "Sunday"),
                       Category = c("FDE", "FDE", "FDE", "FDE"),
                       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))
  })
  
  observe({updateDateRangeInput(session,"daterange1",start = NA, end = NA)})
  
  wk_port2eng <- data.frame(
    WeekE = c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"),
    WeekP = c("segunda-feira", "terca-feira", "quarta-feira", "quinta-feira",  "sexta-feira", "sabado", "domingo")
  )
  
  data_subset <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    Test1 <- dplyr::filter(data(), date1 %in% days)
    weeks_inp <- unique(weekdays(days))  
    wk <- wk_port2eng[wk_port2eng$WeekP %in% weeks_inp,]  ###  if weekday is in Portuguese in your notebook
    #wk <- wk_port2eng[wk_port2eng$WeekE %in% weeks_inp,]  ###  if weekday is in English in your notebook
    
    weeks_ine <- wk$WeekE
    
    meanTest1 <- data() %>%
      group_by(Week = tools::toTitleCase(Week), Category) %>% 
      summarise(mean = mean(time, na.rm = TRUE), .groups = 'drop')
    
    meanTest <- meanTest1[meanTest1$Week %in% as.character(weeks_ine),]
    left_join(meanTest, wk_port2eng, by = c("Week" = "WeekE")) %>%      
      arrange(match(WeekP, weekdays(input$daterange1))) %>%
      select(-WeekP)
  })
  
  output$table <- renderDataTable({
    data_subset()
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

Try this

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

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-18","2021-10-18","2021-10-28","2021-10-30")),
                       Week = c("Monday", "Monday", "Sunday day", "Sunday day"),
                       Category = c("FDE", "FDE", "FDE", "FDE"),
                       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))
  })
  
  observe({updateDateRangeInput(session,"daterange1",start = NA, end = NA)})
  
  # wk_port2eng <- data.frame(
  #   WeekE = c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"),
  #   WeekP = c("segunda-feira", "terca-feira", "quarta-feira", "quinta-feira",  "sexta-feira", "sabado", "domingo")
  # )
  
  wk_port2eng <- data.frame(
    WeekE = c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"),
    WeekJ = c("Monday day","Tuesday day","Wednesday day","Thursday day","Friday day","Saturday","Sunday day"),
    WeekP = c("segunda-feira", "terca-feira", "quarta-feira", "quinta-feira",  "sexta-feira", "sabado", "domingo")
  )
  
  data_subset <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    Test1 <- dplyr::filter(data(), date1 %in% days)
    weeks_inp <- unique(weekdays(days))  
    #wk <- wk_port2eng[wk_port2eng$WeekP %in% weeks_inp,]  ###  if weekday is in Portuguese in your notebook
    #wk <- wk_port2eng[wk_port2eng$WeekE %in% weeks_inp,]  ###  if weekday is in English in your notebook
    wk <- wk_port2eng[(wk_port2eng$WeekE %in% weeks_inp) | (wk_port2eng$WeekJ %in% weeks_inp),]  ###  if weekday is in English in your notebook
    
    weeks_ine <- unique(c(wk$WeekE,wk$WeekJ))
    
    meanTest1 <- data() %>%
      group_by(Week = tools::toTitleCase(Week), Category) %>% 
      dplyr::summarise(mean = mean(time, na.rm = TRUE), .groups = 'drop')
    
    meanTest <- meanTest1[meanTest1$Week %in% tools::toTitleCase(weeks_ine),]
    left_join(meanTest, wk_port2eng, by = c("Week" = "WeekE")) %>%      
      arrange(match(WeekP, weekdays(input$daterange1))) %>%
      select(-WeekP)
  })
  
  output$table <- renderDataTable({
    data_subset()
  })
  
}

shinyApp(ui = ui, server = server)