R:Split-Apply-Combine ...通过聚合将函数应用于行绑定数据帧按类子集

时间:2013-07-26 21:40:56

标签: r user-defined-functions nested-loops nested-lists rbind

更新:我的NOAA GHCN-Daily气象站数据功能已被清理并合并到 rnoaa 包中,可在CRAN或此处获取: https://github.com/ropensci/rnoaa

我正在设计一个R函数来计算由多个数据帧组成的数据集的统计数据。简而言之,我想基于包含名称的参考数据帧按类拉取数据帧。然后,我想将统计函数应用于每个给定日期列出的度量值。实际上,我想调用然后覆盖数据帧列表,以计算每个唯一日期和度量值的向量上的函数,其中值不是NA。

使用'by'函数,基于类变量从数据文件迭代地将数据帧读入工作空间。导入给定类的文件后,我想rbind()该类的数据框和每年范围内的每个用户定义的度量。然后,我想将一个用户提供的统计函数串联应用于一个类中的每个度量,该类对应于年,月和日的给定值(即7月1日的平均[函数]低温[类], 1990年[日期]报告给定区域[类]中的所有位置[数据框]。我希望最终结果是新数据框,其中包含区域内每个日期的值以及应用的每个度量和统计函数的年份范围。我非常接近使用aggregate()函数获得此结果,但是我无法从聚合函数中获得合理的结果,聚合函数当前为除平均温度以外的大多数函数输出NA和NaN。任何建议都会很多赞!到目前为止,这是我的代码:

# Example parameters
w <- c("mean","sd","scale")             # Statistical functions to apply
x <- "C:/Data/"                         # Folder location of CSV files
y <- c("MaxTemp","AvgTemp","MinTemp")   # Metrics to subset the data
z <- c(1970:2000)                       # Year range to subset the data

 CSVstnClass  <- data.frame(CSVstations,CSVclasses)

  by(CSVstnClass, CSVstnClass[,2], function(a){                        # Station list by class
  suppressWarnings(assign(paste(a[,2]),paste(a[,1]),envir=.GlobalEnv))
    apply(a, 1, function(b){                                           # Data frame list, row-wise
      classData   <- data.frame()
      sapply(y, function(d){                                           # Element list
        CSV_DF    <- read.csv(paste(x,b[2],"/",b[1],".csv",sep=""))    # Read in CSV files as data frames
        CSV_DF1   <- CSV_DF[!is.na("Value")]
        CSV_DF2   <- CSV_DF1[which(CSV_DF1$Year %in% z & CSV_DF1$Element == d),]
        assign(paste(b[2],"_",d,sep=""),CSV_DF2,envir=.GlobalEnv)

        if(nrow(CSV_DF2) > 0){                                         # Remove empty data frames
          classData <<- rbind(classData,CSV_DF2)                       # Bind all data frames by row for a class and element
          assign(paste(b[2],"_",d,"_bound",sep=""),classData,envir=.GlobalEnv)

          sapply(w, function(g){                                       # Function list
                                                                       # Aggregate results of bound data frame for each unique date
            dataFunc <- aggregate(Value~Year+Month+Day+Element,data=classData,FUN=g,na.action=na.pass)
            assign(paste(b[2],"_",d,"_",g,sep=""),dataFunc,envir=.GlobalEnv)
            })
        }
        })
      })
    })

我认为我非常接近,但我不确定rbind()是否正常运行,以及为什么aggregate()函数为这么多指标输出NA和NaN。我担心数据帧没有绑定在一起,或者某些统计函数没有很好地处理缺失值。如果您有任何建议,请提前感谢您。

干杯,

亚当

1 个答案:

答案 0 :(得分:2)

您已经以一种非常难以调试的方式解决了这个问题。我建议切换一下,这样你就可以更轻松地检查每一步。 (使用信息丰富的变量名称也有帮助!)代码不太可能按原样运行,但迭代工作应该更容易,检查每个步骤是否成功,然后继续下一步。

paths <- dir("C:/Data/", pattern = "\\.csv$")

# Read in CSV files as data frames
raw <- lapply(paths, read.csv, str)

# Extract needed rows
filter_metrics <- c("MaxTemp", "AvgTemp", "MinTemp")
filter_years <- 1970:2000
filtered <- lapply(raw, subset, 
  !is.na(Value) & Year %in% filter_years & Element %in% filter_metrics)

# Drop any empty data frames
rows <- vapply(filtered, nrow, integer(1))
filtered <- filtered[rows > 0]

# Compute aggregates
my_aggregate <- function(df, fun) {
  aggregate(Value ~ Year + Month + Day + Element, data = df, FUN = fun, 
    na.action = na.pass)
}    
means <- lapply(filtered, my_aggregate, mean)
sds <- lapply(filtered, my_aggregate, sd)
scales <- lapply(filtered, my_aggregate, scale)