Подмножество data.frame по списку и применение функции на каждой части по строкам

Question

Это может показаться типичной проблемой plyr, но у меня есть что-то другое в виду. Вот функция, которую я хочу оптимизировать (пропустите цикл for).

# dummy data 
set.seed(1985) 
lst <- list(a=1:10, b=11:15, c=16:20) 
m <- matrix(round(runif(200, 1, 7)), 10) 
m <- as.data.frame(m) 


dfsub <- function(dt, lst, fun) { 
    # check whether dt is `data.frame` 
    stopifnot (is.data.frame(dt)) 
    # check if vectors in lst are "whole"/integer 
    # vector elements should be column indexes 
    is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol 
    # fall if any non-integers in list 
    idx <- rapply(lst, is.wholenumber) 
    stopifnot(idx) 
    # check for list length 
    stopifnot(ncol(dt) == length(idx)) 
    # subset the data 
    subs <- list() 
    for (i in 1:length(lst)) { 
      # apply function on each part, by row 
      subs[[i]] <- apply(dt[ , lst[[i]]], 1, fun) 
    } 
    # preserve names 
    names(subs) <- names(lst) 
    # convert to data.frame 
    subs <- as.data.frame(subs) 
    # guess what =) 
    return(subs) 
} 

И вот короткая демонстрация ... На самом деле, я собираюсь объяснить, что я в первую очередь хотел сделать. Я хотел подмножить data.frame векторами, собранными в объекте list. Поскольку это часть кода из функции, которая сопровождает манипуляции данными в психологических исследованиях, вы можете рассмотреть m как результат индивидуальной анкеты (10 предметов, 20 vars). Векторы в списке содержат индексы столбцов, которые определяют подшкалы вопросника (например, индивидуальные черты). Каждая подшкала определяется несколькими элементами (столбцы в data.frame). Если мы предполагаем, что оценка по каждому подшкал не более чем sum (или какой-либо другая функция) значений строк (результаты по этой части анкеты по каждому предмету), вы можете запустить:

> dfsub(m, lst, sum) 
    a b c 
1 46 20 24 
2 41 24 21 
3 41 13 12 
4 37 14 18 
5 57 18 25 
6 27 18 18 
7 28 17 20 
8 31 18 23 
9 38 14 15 
10 41 14 22 

Я взял взгляд при этой функции, и я должен признать, что этот маленький цикл не испортил код вообще ... НО, если есть более простой/эффективный способ сделать это, пожалуйста, дайте мне знать!

Answer 1

Я бы взял другой подход и сохранить все, как кадры данных, так что вы можете использовать слияние и ddply. Я думаю, вы найдете этот подход немного более общим, и легче проверить, что каждый шаг выполняется правильно.

# Convert everything to long data frames 
m$id <- 1:nrow(m) 

library(reshape) 
obs <- melt(m, id = "id") 
obs$variable <- as.numeric(gsub("V", "", obs$variable)) 

varinfo <- melt(lst) 
names(varinfo) <- c("variable", "scale") 

# Merge and summarise 
obs <- merge(obs, varinfo, by = "variable") 

ddply(obs, c("id", "scale"), summarise, 
    mean = mean(value), 
    sum = sum(value)) 

Answer 2

после загрузки пакета plyr, замените

subs <- list() 
    for (i in 1:length(lst)) { 
      # apply function on each part, by row 
      subs[[i]] <- apply(dt[ , lst[[i]]], 1, fun) 
    } 

с

subs <- llply(lst,function(x) apply(dt[,x],1,fun)) 

Answer 3

@Hadley, я проверил свой ответ, так как это довольно просто и легко для бухгалтерии (кроме того, это более универсальный-раствор). Тем не менее, вот мой недолгий сценарий, который делает вещь и требует только base (это тривиально, так как я устанавливаю plyr и reshape сразу после установки R). Теперь, вот источник:

dfsub <- function(dt, lst, fun) { 
     # check whether dt is `data.frame` 
     stopifnot (is.data.frame(dt)) 
     # convert data.frame factors to numeric 
     dt <- as.data.frame(lapply(dt, as.numeric)) 
     # check if vectors in lst are "whole"/integer 
     # vector elements should be column indexes 
     is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol 
     # fall if any non-integers in list 
     idx <- rapply(lst, is.wholenumber) 
     stopifnot(idx) 
     # check for list length 
     stopifnot(ncol(dt) == length(idx)) 
     # subset the data 
     subs <- list() 
     for (i in 1:length(lst)) { 
       # apply function on each part, by row 
       subs[[i]] <- apply(dt[ , lst[[i]]], 1, fun) 
     } 
     names(subs) <- names(lst) 
     # convert to data.frame 
     subs <- as.data.frame(subs) 
     # guess what =) 
     return(subs) 
} 

Answer 4

Для вашего конкретного примера, однострочный решение sapply(lst,function(x) rowSums(m[,x])) (хотя вы можете добавить еще несколько строк, чтобы проверить правильный ввод и положить в названиях столбцов).

У вас есть другие, более общие, приложения? Или это возможно случай YAGNI?