R：用应用重写循环

Question

我有以下类型的数据集：

id;2011_01;2011_02;2011_03; ... ;2001_12
id01;NA;NA;123; ... ;NA
id02;188;NA;NA; ... ;NA

也就是说，每一行都是唯一的客户，每一列都描述了该客户过去 10 年的特征（每个月都有自己的列）。问题是我想将这 120 列数据框压缩成 10 列数据框，这是因为我知道几乎所有行（尽管月份本身可能会有所不同）每年都有 1 或 0 个观察值。

我已经完成了，当时一年，使用带有嵌套 if 子句的循环：

for(i in 1:nrow(input_data)) {
    temp_row <- input_data[i,c("2011_01","2011_02","2011_03","2011_04","2011_05","2011_06","2011_07","2011_08","2011_09","2011_10","2011_11", "2011_12")]
    loc2011 <- which(!is.na(temp_row))
    if(length(loc2011 ) > 0) {
        temp_row_2011[i,] <- temp_row[loc2011[1]] #pick the first observation if there are several
    } else {
        temp_row_2011[i,] <- NA
    }
}

由于我的数据集非常大，并且我需要执行上述循环 10 次（每年一次），这需要太多时间。我知道在 R 中使用应用命令要好得多，因此我将非常感谢您对这项任务的帮助。我怎样才能把整个事情（包括不同年份）写得更好？

Answer 1

你在追求这样的事情吗？：

    temp_row_2011 <- apply(input_data, 1, function(x){
        temp_row <- x[c("2011_01","2011_02","2011_03","2011_04","2011_05","2011_06","2011_07","2011_08","2011_09","2011_10","2011_11", "2011_12")]
        temp_row[!is.na(temp_row)][1]
    })

If 这会为您提供正确的输出，并且 if 它的运行速度比您的循环快，那么这不一定只是因为使用了apply()，还因为它分配的东西更少，避免了if {}else {}。您可以通过编译匿名函数使其运行得更快：

    reduceyear <- function(x){
        temp_row <- x[c("2011_01","2011_02","2011_03","2011_04","2011_05","2011_06","2011_07","2011_08","2011_09","2011_10","2011_11", "2011_12")]
        temp_row[!is.na(temp_row)][1]
    }
    # compile, just in case it runs faster:
    reduceyear_c <- compiler:::cmpfun(reduceyear)
    # this ought to do the same as the above.
    temp_row_2011 <- apply(input_data, 1, reduceyear_c)

您没有说input_data 是data.frame 还是matrix，但矩阵会比前者更快（但仅当input_data 是同一类数据时才有效）。

[编辑：完整示例，由 DWin 驱动]

    input_data <- matrix(ncol=24,nrow=10)
    # years and months:
    colnames(input_data) <- c(paste(2010,1:12,sep="_"),paste(2011,1:12,sep="_"))
    # some ids
    rownames(input_data) <- 1:10 
    # put in some values:
    input_data[sample(1:length(input_data),200,replace=FALSE)] <- round(runif(200,100,200))
    # make an all-NA case:
    input_data[2,1:12] <- NA

    # and here's the full deal:
    sapply(2010:2011, function(x,input_data){
        input_data_yr <- input_data[, grep(x, colnames(input_data) )] 
        apply(input_data_yr, 1, function(id){
                    id[!is.na(id)][1]
                }
        )
    }, input_data)

所有NA 案例都有效。 grep() 来自 DWin 的列选择想法。如上例所示，您实际上可以定义匿名内部函数并对其进行编译以潜在地使事物运行得更快。

Answer 2

我构建了一个小测试用例（timriffe 的建议失败了）。您可能会通过编写代码来创建更完整的测试用例（例如 2 年的 4 个季度）并在一年的一行中包含所有 NA 等病理案例，从而吸引更多的兴趣。我认为与其要求您按名称写出所有年份列，不如使用 grep() 策略循环浏览它们：

  # funyear <- function to work on one year's data and return a single vector
  # my efforts keep failing on the all(NA) row by year combos
  sapply(seq("2011", "2001"), function (pat) funyear(input_data[grep(pat, names(input_data) )] )