Un subconjunto hoja.de.datos por la lista y aplicar la función de cada parte, por filas

Question

Esto puede parecer como un problema típico plyr, pero tengo algo diferente en mente. Esto es la función que desea optimizar (saltar el lazo 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)
}

Y ahora una breve demostración ... en realidad, estoy a punto de explicar lo que piensa sobre todo para hacerlo. Yo quería un subconjunto data.frame por vectores recogidos en el objeto list. Dado que esta es una parte del código de una función que acompaña a la manipulación de datos en la investigación psicológica, se puede considerar como un m resultados del cuestionario de personalidad (10 sujetos, 20 VAR). Los vectores en los índices de columna de la lista de retención que definen subescalas cuestionario (por ejemplo, rasgos de personalidad). Cada subescala se define por varios elementos (columnas en data.frame). Si suponemos que la puntuación de cada subescala no es más que sum (o alguna otra función) de valores de fila (resultados en esa parte del cuestionario para cada sujeto), podría ejecutar:

> 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

Me tomó un vistazo a esta función y tengo que admitir que este pequeño bucle no es estropear el código en absoluto ... Pero, si hay una manera más fácil / eficiente de hacer esto, por favor, que me haga saber!

Answer 1

Me gustaría tener un enfoque diferente y mantener todo lo más tramas de datos para que pueda utilizar la combinación y ddply. Creo que usted encontrará este enfoque es un poco más general, y es más fácil comprobar que cada paso se realiza correctamente.

# 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

después de cargar el paquete plyr, reemplace

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

con

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

Answer 3

@Hadley, he comprobado su respuesta ya que es bastante sencillo y fácil para llevar la contabilidad (además del hecho de que es más de propósito-solución general). Sin embargo, aquí está mi no tan larga script que hace la cosa y sólo requiere paquete base (que es trivial, ya instalo plyr y reshape justo después de instalar R). Ahora, aquí está la fuente:

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

Para su ejemplo específico, una solución de una línea es sapply(lst,function(x) rowSums(m[,x])) (aunque es posible añadir más líneas para comprobar si hay una entrada válida y poner en los nombres de columna).

¿Tiene otros más generales, aplicaciones en mente? ¿O se trata, posiblemente, un caso de YAGNI ?