如何在 Shiny 中调整表格生成

Question

你能帮我调整下面闪亮的代码吗？第一个代码只是显示我从Test 数据库中得到的平均值。你可以看到我只有星期五的平均值，如果我选择在daterange 中查看直到星期五的一天，我想在 Shiny 中呈现这些平均值，但它运行得不是很好。仅当我将其放在 01/11 到 05/11 的 daterange 中时它才有效，但如果我选择 02/11 到 05/11，例如，它不起作用。此外，如果我输入 01/11 到 02/11，它会显示平均值，但是，它不必显示，因为这些日期都不是星期五。我插入了三张图片供您查看。如何在代码中进行调整？

第一个代码

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

第二个代码

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 至 05/11 有效

02/11 到 05/11 无效。

01/11 到 02/11 它显示平均值，但是，它不必显示

Answer 1

试试这个

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))
  })

  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
    print(weeks_ine)
    
    meanTest1 <- data() %>%
      group_by(Week,Category) %>%
      dplyr::summarize(mean(time))
    meanTest <- meanTest1[meanTest1$Week %in% as.character(weeks_ine),]
    meanTest
  })

  output$table <- renderDataTable({
    data_subset()
  })

}

shinyApp(ui = ui, server = server)