R-Shiny中按用户输入拆分数据并渲染指定格式数据表

现有数据框df1，已实现基于用户输入过滤数据并汇总总数，但需要修改代码，实现按用户选择的姓名拆分多张表，每张表按Status1/Status2（对应date1/date2非空）作为行，C/R/Y（对应typec/typer/typey为1）作为列，汇总对应数量。不确定是否需要用melt和pivot_wide操作。

附数据框代码：

df1<-structure(list(record_id = c(1, 1, 1, 1, 1, 1), Name = c("Anna", 
"Anna", "Anna", "Anna", "Anna", 
"Anna"), Country = c("USA", "USA", 
"USA", "USA", "USA", 
"USA"), 
    record_id.y = c("1", "2", "3", "4", "5", 
    "6"), emp_id = c("1837100", "203013", 
    "1820027", "1852508", "2123813", 
    "1887667"), rel = c("S", "M", "I", 
    "F", "I", "I"), Date = structure(c(17869, 
    17862, 17865, 17848, 17862, 17848), class = "Date"), date1 = structure(c(1639134523, 
    1638615986, 1638764440, 1638876083, 1644605968, 1638764441
    ), class = c("POSIXct", "POSIXt"), tzone = "UTC"), date2 = structure(c(NA, 
    NA, NA, NA, 1638615988, NA), class = c("POSIXct", "POSIXt"
    ), tzone = "UTC"), typec = c(1, 1, 1, 1, 1, 1
    ), typer = c(0, 0, 0, 0, 0, 0), typey = c(0, 
    0, 0, 0, 0, 0), is_present = c(NA_character_, NA_character_, 
    NA_character_, NA_character_, NA_character_, NA_character_
    )), row.names = c(NA, 6L), class = "data.frame")

原代码（存在逻辑问题，无法生成目标格式）：

table1 <- reactive({
    req(input$Name, 
        input$Country, 
        input$Status, 
        input$Type)
    my_data %>%
      select(Name,
             Country,
             typec,
             typer,
             typey,
             date1,
             date2,
             Date,
             rel) %>%
      filter(Name %in% input$Name,
             Date >= input$dates[1] &
               Date <= input$dates[2]) %>%
      
      filter(
        (('Status1' %in% input$status) & !is.na(date1)) | 
          (('Status2' %in% input$status) & !is.na(date2)) 
      ) %>%
      filter( 
        (('C' %in% input$type) & typec == '1') | 
          (('R' %in% input$type) & typer == '1') |
          (('Y' %in% input$type) & typey == '1')
      ) %>%
      filter(Rel %in% input$rel) %>%
      
      split(input$Name) %>%
      group_by(get(input$status, 
               input$rel, 
               input$type)) %>%
      summarize(Total=n(), .groups = "drop")
    
  }) 
output$table <- DT::renderDataTable({
    datatable(table1())
  })

期望输出格式：

Anna的统计结果
        C   R   Y
Status1  5   0   0
Status2  1   0   0

Vika的统计结果
        C   R   Y
Status1  3   2   0
Status2  0   1   1

确实需要用到**宽表转长表（pivot_longer）和长表转宽表（pivot_wider）**操作，步骤如下：

1. 核心逻辑梳理 #

• 先把date1/date2转换成对应的状态标识（Status1/Status2），标记每条数据属于哪个状态
• 把typec/typer/typey转成长格式，对应C/R/Y类型
• 过滤用户输入的条件后，按Name、状态、类型分组计数
• 再将计数结果转成以状态为行、类型为列的宽表
• 最后按Name拆分生成多张表格

2. 修正后的Shiny代码 #

library(shiny)
library(DT)
library(dplyr)
library(tidyr)

ui <- fluidPage(
  selectInput("Name", "选择姓名", choices = unique(df1$Name)),
  selectInput("Country", "选择国家", choices = unique(df1$Country)),
  dateRangeInput("dates", "选择日期范围"),
  selectInput("status", "选择状态", choices = c("Status1", "Status2"), multiple = TRUE),
  selectInput("type", "选择类型", choices = c("C", "R", "Y"), multiple = TRUE),
  selectInput("rel", "选择关系", choices = unique(df1$rel), multiple = TRUE),
  uiOutput("tables") # 用uiOutput输出多张表格
)

server <- function(input, output) {
  table_data <- reactive({
    req(input$Name, input$Country, input$status, input$type, input$rel, input$dates)
    
    df1 %>%
      select(Name, Country, typec, typer, typey, date1, date2, Date, rel) %>%
      # 1. 过滤基础条件
      filter(Name %in% input$Name,
             Country %in% input$Country,
             Date >= input$dates[1] & Date <= input$dates[2],
             rel %in% input$rel) %>%
      # 2. 标记每条数据对应的状态（Status1/Status2）
      mutate(
        Status = case_when(
          !is.na(date1) & "Status1" %in% input$status ~ "Status1",
          !is.na(date2) & "Status2" %in% input$status ~ "Status2"
        )
      ) %>%
      filter(!is.na(Status)) %>% # 过滤掉不符合所选状态的行
      # 3. 把类型列转成长格式
      pivot_longer(cols = c(typec, typer, typey),
                   names_to = "Type",
                   values_to = "Value") %>%
      # 替换类型名称为C/R/Y，过滤符合所选类型且值为1的行
      mutate(Type = recode(Type, "typec" = "C", "typer" = "R", "typey" = "Y")) %>%
      filter(Type %in% input$type, Value == 1) %>%
      # 4. 分组计数
      group_by(Name, Status, Type) %>%
      summarize(Count = n(), .groups = "drop") %>%
      # 5. 转成目标宽表格式：Status为行，Type为列
      pivot_wider(names_from = Type, values_from = Count, values_fill = 0)
  })
  
  # 6. 按Name拆分并输出多张表格
  output$tables <- renderUI({
    req(table_data())
    data_list <- split(table_data(), table_data()$Name)
    
    lapply(names(data_list), function(name) {
      tagList(
        h3(paste0(name, "的统计结果")),
        datatable(data_list[[name]] %>% select(-Name), 
                  options = list(pageLength = 10))
      )
    })
  })
}

shinyApp(ui, server)

关键代码解释 #

• mutate(Status = case_when(...))：将date1非空标记为Status1，date2非空标记为Status2，同时过滤用户未选择的状态
• pivot_longer：把typec/typer/typey三列转成Type和Value的长格式，方便后续分组计数
• pivot_wider：将分组后的计数结果转成以Status为行、C/R/Y为列的宽表，用values_fill = 0填充缺失的计数（即该状态下无对应类型的数据）
• split + lapply：按Name拆分数据，循环生成每个姓名对应的标题和表格，通过renderUI输出

内容的提问来源于stack exchange，提问作者akang