Ho voluto sommare singole colonne per gruppo e il mio primo pensiero è stato quello di utilizzare tapply. Tuttavia, non riesco a far funzionare tapply. È possibile utilizzare tapply per sommare più colonne? Se no, perché no?somma più colonne per gruppo con picchetto
Ho cercato su Internet estesamente e ho trovato numerose domande simili postate nel 2008. Tuttavia, nessuna di queste domande ha avuto risposta direttamente. Invece, le risposte suggeriscono invariabilmente di usare una funzione diversa.
Di seguito è riportato un set di dati di esempio per il quale desidero sommare mele per stato, ciliegie per stato e prugne per stato. Di seguito ho compilato numerose alternative a tapply che funzionano.
Nella parte inferiore, viene visualizzata una semplice modifica al codice sorgente tapply che consente a tapply di eseguire l'operazione desiderata.
Tuttavia, forse sto trascurando un modo semplice per eseguire l'operazione desiderata con tapply. Non sto cercando funzioni alternative, sebbene siano accettate ulteriori alternative.
Data la semplicità della mia modifica al codice sorgente tapply, mi chiedo perché, o qualcosa di simile, non sia già stato implementato.
Grazie per qualsiasi consiglio. Se la mia domanda è un duplicato, sarò felice di pubblicare la mia domanda come risposta a quell'altra domanda.
Ecco il set di dati di esempio:
df.1 <- read.table(text = '
state county apples cherries plums
AA 1 1 2 3
AA 2 10 20 30
AA 3 100 200 300
BB 7 -1 -2 -3
BB 8 -10 -20 -30
BB 9 -100 -200 -300
', header = TRUE, stringsAsFactors = FALSE)
Questo non funziona:
tapply(df.1, df.1$state, function(x) {colSums(x[,3:5])})
Le pagine di aiuto dice:
tapply(X, INDEX, FUN = NULL, ..., simplify = TRUE)
X an atomic object, typically a vector.
ero confuso dalla frase typically a vector che mi ha fatto chiedere se fosse possibile utilizzare un data frame . Non sono mai stato chiaro su cosa significa atomic object.
Qui ci sono diverse alternative a tapply che funzionano. La prima alternativa è un work-around che combina tapply con apply.
apply(df.1[,c(3:5)], 2, function(x) tapply(x, df.1$state, sum))
# apples cherries plums
# AA 111 222 333
# BB -111 -222 -333
with(df.1, aggregate(df.1[,3:5], data.frame(state), sum))
# state apples cherries plums
# 1 AA 111 222 333
# 2 BB -111 -222 -333
t(sapply(split(df.1[,3:5], df.1$state), colSums))
# apples cherries plums
# AA 111 222 333
# BB -111 -222 -333
t(sapply(split(df.1[,3:5], df.1$state), function(x) apply(x, 2, sum)))
# apples cherries plums
# AA 111 222 333
# BB -111 -222 -333
aggregate(df.1[,3:5], by=list(df.1$state), sum)
# Group.1 apples cherries plums
# 1 AA 111 222 333
# 2 BB -111 -222 -333
by(df.1[,3:5], df.1$state, colSums)
# df.1$state: AA
# apples cherries plums
# 111 222 333
# ------------------------------------------------------------
# df.1$state: BB
# apples cherries plums
# -111 -222 -333
with(df.1,
aggregate(x = list(apples = apples,
cherries = cherries,
plums = plums),
by = list(state = state),
FUN = function(x) sum(x)))
# state apples cherries plums
# 1 AA 111 222 333
# 2 BB -111 -222 -333
lapply(split(df.1, df.1$state), function(x) {colSums(x[,3:5])})
# $AA
# apples cherries plums
# 111 222 333
#
# $BB
# apples cherries plums
# -111 -222 -333
Ecco il codice sorgente per tapply tranne che ho cambiato la linea:
nx <- length(X)
a:
nx <- ifelse(is.vector(X), length(X), dim(X)[1])
Questa versione modificata del tapply esegue l'operazione desiderata:
my.tapply <- function (X, INDEX, FUN = NULL, ..., simplify = TRUE)
{
FUN <- if (!is.null(FUN)) match.fun(FUN)
if (!is.list(INDEX)) INDEX <- list(INDEX)
nI <- length(INDEX)
if (!nI) stop("'INDEX' is of length zero")
namelist <- vector("list", nI)
names(namelist) <- names(INDEX)
extent <- integer(nI)
nx <- ifelse(is.vector(X), length(X), dim(X)[1]) # replaces nx <- length(X)
one <- 1L
group <- rep.int(one, nx) #- to contain the splitting vector
ngroup <- one
for (i in seq_along(INDEX)) {
index <- as.factor(INDEX[[i]])
if (length(index) != nx)
stop("arguments must have same length")
namelist[[i]] <- levels(index)#- all of them, yes !
extent[i] <- nlevels(index)
group <- group + ngroup * (as.integer(index) - one)
ngroup <- ngroup * nlevels(index)
}
if (is.null(FUN)) return(group)
ans <- lapply(X = split(X, group), FUN = FUN, ...)
index <- as.integer(names(ans))
if (simplify && all(unlist(lapply(ans, length)) == 1L)) {
ansmat <- array(dim = extent, dimnames = namelist)
ans <- unlist(ans, recursive = FALSE)
} else {
ansmat <- array(vector("list", prod(extent)),
dim = extent, dimnames = namelist)
}
if(length(index)) {
names(ans) <- NULL
ansmat[index] <- ans
}
ansmat
}
my.tapply(df.1$apples, df.1$state, function(x) {sum(x)})
# AA BB
# 111 -111
my.tapply(df.1[,3:4] , df.1$state, function(x) {colSums(x)})
# $AA
# apples cherries
# 111 222
#
# $BB
# apples cherries
# -111 -222