cross-tabulations on multiple data.frames and columns - r

Question

I'm calculating summary statistics for numerous data frames across multiple slices vs a single response variable. I currently do this by passing a list of DFs to a function. But my function has to specify the columns (ie-slices) individually. This speeds up my process dramatically; but, I think there has to be an even more efficient way to do this via an apply() family function. I'm hoping someone here can help me out.
Here's my code:
table1 <- function(x) {
dl2 <- list()
for (i in 1:length(x)) {
z <- x[[i]]
t.sliceA <- addmargins(table(list(z$sliceA, z$Growing)))
t.sliceB <- addmargins(table(list(z$sliceB, z$Growing)))
t.sliceC <- addmargins(table(list(z$sliceC, z$Growing)))
t.sliceD <- addmargins(table(list(z$sliceD, z$Growing)))
...
t.sliceAA <- addmargins(table(list(z$sliceAA, z$Growing)))
table.list <- list(t.sliceA, t.sliceB, t.sliceC, ... , t.sliceAA)
names(table.list) <- c("t.sliceA", "t.sliceB", ... , "t.sliceAA")
dl2[[i]] <- table.list
}
assign("dl",dl2, envir=.GlobalEnv)
}
# run the function
dl <- c(DF1, DF2, ..., DF.n)
table1(dl)
I assume there must be a more efficient way to do this via lapply() where I only have to specify the columns needed. Something where I would replace the lines
t.sliceA <- [blah]
...
t.sliceAA <- [blah]
with something like:
apply(z[,c(1:4,10:12,15)],2, function(x) addmargins(table(list(x,z$Growing))))
Any help that you can provide would be very helpful. Thanks!
Update: Reproducible example
#Chase
My apologies if the this was done poorly. It's my first time using github.
https://gist.github.com/3719220
and here's the code:
# load the example datasets
a.small <- dget("df1.txt")
l.small <- dget(df2.txt)
# working function that I'd like to simplify
table1 <- function(x) {
dl2 <- list()
for (i in 1:length(x)) {
z <- x[[i]]
t.tenure <- addmargins(table(list(z$Tenure.Group, z$Growing)))
t.optfile <- addmargins(table(list(z$opt.file, z$Growing)))
t.checking <- addmargins(table(list(z$checking, z$Growing)))
t.full <- addmargins(table(list(z$add.full, z$Growing)))
t.optdm <- addmargins(table(list(z$opt.dm, z$Growing)))
t.up <- addmargins(table(list(z$add.up, z$Growing)))
t.off <- addmargins(table(list(z$offmode, z$Growing)))
table.list <- list(t.tenure, t.optfile, t.checking, t.full, t.optdm, t.up, t.off)
names(table.list) <- c("t.tenure", "t.optfile", "t.checking", "t.full", "t.optdm", "t.up", "t.off")
dl2[[i]] <- table.list
}
assign("dl",dl2, envir=.GlobalEnv)
}
# create a DF list to send to the function
dl <- list(a.small, l.small)
table1(dl) # run the function

Answer 1

As far as I can see this will be easily done with a couple of lapply statements
If we define our function to create a table with margins as
tabulate_df <- function(DF, .what, .with) {
table.add.margins <- function(...) addmargins(table(...))
lapply(DF[.what], table.add.margins, DF[[.with]])
}
Then
# the columns we want to cross tabulate with `Growing`
table_names <- setdiff(names(df1), 'Growing')
df_list <- setNames(list(df1,df2), c('df1','df2'))
lapply(df_list, tabulate_df, .what = table_names, .with = 'Growing')