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 раз (по одному на каждый год), это занимает слишком много времени. Я знаю, что гораздо лучше использовать команды apply в 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]
    })

Если , то это дает вам правильный вывод, и , если , он работает быстрее, чем ваш цикл, тогдаэто не обязательно связано только с фактом использования 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

Я построил крошечный контрольный пример (для которого предложение Тимрифа не удается). Вы можете привлечь больше интереса, разместив код, который создает более полный контрольный пример, например, 4 квартала за 2 года, включая патологические случаи, такие как все 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) )] )