Shiny应用中多年度数据集取交集后如何筛选对应数据子集

需求背景 #

现有3份从URL获取的公共年度数据集、1份用户上传的CSV年度数据集，共4份数据覆盖的时间范围不统一，需要提取4份数据公共时间周期内的记录用于后续计算。 #

现有基础逻辑 #

本地R环境下的实现代码如下：

n <- intersect(intersect(intersect(AMP$Year,SST$Year), GTA$Year),DMI$Year)
AMP1 <- subset(AMP, Year %in% intersect(AMP$Year,n))

需将该逻辑迁移到Shiny应用中，已完成交集计算部分的开发，缺少用交集结果筛选各数据集的实现，当前Shiny代码如下：

library(shiny)
library(data.table)

a <- fread('https://www.cpc.ncep.noaa.gov/data/indices/sstoi.indices',header = TRUE)
b <- as.matrix(a[,c(1,2,9)])
df <- data.frame( Year = b[,1],month = b[,2], value = b[,3])
SS <- df %>% filter(!between(month, 4, 10)) %>%
  arrange(Year, month) %>%
  filter(!(Year == min(Year) & month %in% 1:3 | 
             Year == max(Year) & month %in% 11:12)) %>%
  group_by(grp = cumsum(month == 11)) %>%
  summarise(Year = last(Year),
            value = mean(value)) %>%
  select(-grp)

SST <- as.matrix(SS) 

d <- fread('https://www.metoffice.gov.uk/hadobs/hadcrut4/data/current/time_series/HadCRUT.4.6.0.0.annual_ns_avg.txt',
           header = FALSE)

GTA <- as.matrix(d[,1:2])

dat <- fread('https://psl.noaa.gov/gcos_wgsp/Timeseries/Data/dmi.had.long.data',header = FALSE,fill = TRUE)
e <- dat[,c(1,7:12)][complete.cases(dat[,c(1,7:12)]),]
f <- matrix(as.numeric(unlist(e)),nrow=nrow(e))
g <- replace(f, f== -9999.000, NA)
h <- g[complete.cases(g),]
me = rowMeans(h[,2:7],na.rm = T)

DMI <- as.matrix(data.frame(Year = h[,1],value = me)) 


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file", "Choose observation precipitation CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
    ),
    mainPanel(
      tableOutput('ID')
    )
  )
)
server <- function(input, output,session) {
  
  inputdata <- reactive({
    infile = input$file
    if(is.null(infile))
      return(NULL)
    df <- read.csv(infile$datapath,header=input$header)
    return(df)
  })
  output$ID <- renderTable({
    req(inputdata())
    AMP <- as.matrix(inputdata())
    n <- intersect(intersect(intersect(AMP[,1],SST[,1]), GTA[,1]),DMI[,1])
  return(n)
  })
  
}

shinyApp(ui, server)

用户上传的AMP数据参考结构：

set.seed(123)
df1 <- data.frame(year = rep(1971:2013),value = rnorm(43))

优化实现方案 #

核心优化点 #

• 多向量取交集可用Reduce()函数替代多层嵌套的intersect()，代码更简洁易维护
• 交集本身已经是所有数据集的公共年份，筛选时直接用年份 %in% 公共年份即可，不需要二次取交集
• 所有依赖用户上传数据的计算逻辑用req()做非空校验，避免Shiny初始化时报错

修改后完整Shiny代码 #

library(shiny)
library(data.table)
library(dplyr)

# 预加载公共数据集
a <- fread('https://www.cpc.ncep.noaa.gov/data/indices/sstoi.indices',header = TRUE)
b <- as.matrix(a[,c(1,2,9)])
df <- data.frame( Year = b[,1],month = b[,2], value = b[,3])
SS <- df %>% filter(!between(month, 4, 10)) %>%
  arrange(Year, month) %>%
  filter(!(Year == min(Year) & month %in% 1:3 | 
             Year == max(Year) & month %in% 11:12)) %>%
  group_by(grp = cumsum(month == 11)) %>%
  summarise(Year = last(Year),
            value = mean(value)) %>%
  select(-grp)

SST <- as.matrix(SS) 

d <- fread('https://www.metoffice.gov.uk/hadobs/hadcrut4/data/current/time_series/HadCRUT.4.6.0.0.annual_ns_avg.txt',
           header = FALSE)

GTA <- as.matrix(d[,1:2])

dat <- fread('https://psl.noaa.gov/gcos_wgsp/Timeseries/Data/dmi.had.long.data',header = FALSE,fill = TRUE)
e <- dat[,c(1,7:12)][complete.cases(dat[,c(1,7:12)]),]
f <- matrix(as.numeric(unlist(e)),nrow=nrow(e))
g <- replace(f, f== -9999.000, NA)
h <- g[complete.cases(g),]
me = rowMeans(h[,2:7],na.rm = T)

DMI <- as.matrix(data.frame(Year = h[,1],value = me)) 


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file", "选择降水观测CSV文件", accept = ".csv"),
      checkboxInput("header", "CSV包含表头", TRUE),
    ),
    mainPanel(
      h3("公共年份列表"),
      tableOutput('common_year'),
      h3("筛选后AMP数据前10行示例"),
      tableOutput('filtered_amp')
    )
  )
)
server <- function(input, output,session) {
  
  # 读取用户上传的AMP数据
  inputdata <- reactive({
    infile = input$file
    if(is.null(infile))
      return(NULL)
    df <- read.csv(infile$datapath,header=input$header)
    return(df)
  })
  
  # 计算4份数据集的公共年份
  common_years <- reactive({
    req(inputdata())
    AMP <- as.matrix(inputdata())
    Reduce(intersect, list(AMP[,1], SST[,1], GTA[,1], DMI[,1]))
  })
  
  # 筛选各数据集，均设为响应式变量方便后续计算调用
  filtered_AMP <- reactive({
    req(common_years())
    AMP <- as.matrix(inputdata())
    AMP[AMP[,1] %in% common_years(), ]
  })
  filtered_SST <- reactive({
    req(common_years())
    SST[SST[,1] %in% common_years(), ]
  })
  filtered_GTA <- reactive({
    req(common_years())
    GTA[GTA[,1] %in% common_years(), ]
  })
  filtered_DMI <- reactive({
    req(common_years())
    DMI[DMI[,1] %in% common_years(), ]
  })
  
  # 输出公共年份
  output$common_year <- renderTable({
    req(common_years())
    data.frame(公共年份 = common_years())
  })
  # 输出筛选后的AMP示例
  output$filtered_amp <- renderTable({
    req(filtered_AMP())
    head(filtered_AMP(), 10)
  })
  
}

shinyApp(ui, server)

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