Une data.frame par sous-ensemble liste et appliquer la fonction de chaque partie, par des lignes

Question

Cela peut sembler comme un problème de plyr typique, mais j'ai quelque chose de différent à l'esprit. Voici la fonction que je veux optimiser (sauter la boucle de 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)
}

Et maintenant une courte démonstration ... en fait, je suis sur le point d'expliquer ce que je voulais faire avant tout. Je voulais un sous-ensemble data.frame par des vecteurs réunis dans l'objet list. Étant donné que cela fait partie du code d'une fonction qui accompagne la manipulation des données dans la recherche psychologique, vous pouvez envisager m comme résultats du questionnaire de personnalité (10 sujets, 20 VARS). Vecteurs dans la liste des index de colonne détiennent qui définissent les sous-échelles du questionnaire (par exemple, des traits de personnalité). Chaque sous-échelle est défini par plusieurs éléments (colonnes en data.frame). Si nous supposons que le score de chaque sous-échelle est rien de plus que sum (ou une autre fonction) des valeurs de ligne (résultats sur cette partie du questionnaire pour chaque sujet), vous pouvez exécuter:

> 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

Je pris un coup d'oeil à cette fonction et je dois admettre que cette petite boucle ne gâte le code du tout ... Mais, s'il y a un moyen plus facile / efficace de le faire, s'il vous plaît, laissez-moi savoir!

Answer 1

Je prendrais une approche différente et garde tout comme les trames de données afin que vous puissiez utiliser la fusion et ddply. Je pense que vous trouverez cette approche est un peu plus générale, et il est plus facile de vérifier que chaque étape est effectuée correctement.

# 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

après le chargement du paquet de plyr, remplacer

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

avec

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

Answer 3

@Hadley, je l'ai vérifié votre réponse car il est assez simple et facile pour la tenue de livres (outre le fait qu'il est plus polyvalent solution générale). Cependant, voici mon script pas si longtemps que fait la chose et nécessite le package seulement base (ce qui est trivial puisque je viens d'installer plyr et reshape après l'installation R). Maintenant, voici la source:

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

Pour votre exemple spécifique, une solution d'une ligne est sapply(lst,function(x) rowSums(m[,x])) (bien que vous pourriez ajouter quelques lignes pour vérifier les entrées valides et mettre dans les noms de colonnes).

Avez-vous d'autres, plus généraux, des applications à l'esprit? Ou est-ce peut-être un cas de YAGNI ?