r - 如何在闪亮相交后对数据进行子集化

Question

我有 3 组来自 URL 的数据和 1 个用户输入的 CSV 文件。所有 4 个数据集都是每年，可用的时间段不同。我想要同一时期的所有 4 个数据进行进一步计算。我做了一些检查，发现我可以使用相交的结果来交叉 4 个数据（GTA、SST、DMI 和 AMP）和子集。这就是在 r 中的做法。

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

我想在我闪亮的应用程序中使用它。这是我为子集数据而创建的闪亮应用程序的一部分。我计算出相交部分。现在我需要有关如何使用相交列对数据进行子集化的帮助？

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

如果有更好的方法来做到这一点，我全神贯注。在比较 r 中超过 2 个数据帧时，我没有发现很多。任何帮助，将不胜感激。谢谢你。

标签： rshinysubset

Answer 1

也许你可以试试这个 -

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)
    df
  })
  output$ID <- renderTable({
    req(inputdata())
    AMP <- as.matrix(inputdata())
    n <- intersect(intersect(intersect(AMP[,1],SST[,1]), GTA[,1]),DMI[,1])
    AMP1 <- AMP[AMP[, 1] %in% n, ]
    AMP1
  })
  
}

shinyApp(ui, server)