R: Запись функции из последовательных вызовов функций в data.frame

Question

Один из моих учеников прислал мне свой сценарий R вместе со своей домашней работой, где он, очевидно, пытается собрать соответствующий вывод из нескольких последовательных вызовов функций в data.frame. Это работает, но я думаю, что это довольно уродливое решение. Я даю вам рабочий пример:

# Create sample data 
ref <- sample(c(0,1), 20, T) 
cat1 <- sample(c("ab", "cd", "ef"), 20, T) 
cat2 <- sample(c("mm", "nn"), 20, T) 
cat3 <- sample(c("low", "mid", "high"), 20, T) 
table <- data.frame(ref, cat1, cat2, cat3) 

# The ugly code 
library(gmodels) 
result <- data.frame(a = NA, b = NA, statistic = NA, p.value = NA) 

x <- CrossTable(table$ref, table$cat1, chisq=T, prop.r=F, prop.chisq=F, prop.t=F) 
result <- rbind(result, data.frame(a = names(x$prop.col[2,]),b = x$prop.col[2,], c = x$chisq[1], d = x$chisq[3],row.names = NULL)) 

x <- CrossTable(table$ref, table$cat2, chisq=T, prop.r=F, prop.chisq=F, prop.t=F) 
result <- rbind(result, data.frame(a = names(x$prop.col[2,]),b = x$prop.col[2,],c = x$chisq[1],d = x$chisq[3],row.names = NULL)) 

x <- CrossTable(table$ref, table$cat3, chisq=T, prop.r=F, prop.chisq=F, prop.t=F) 
result <- rbind(result, data.frame(a = names(x$prop.col[2,]),b = x$prop.col[2,],c = x$chisq[1],d = x$chisq[3],row.names = NULL)) 

# The result 
> result 
    a   b statistic p.value 
1 <NA>  NA  NA  NA 
2 ab 0.4444444 1.0646144 0.5872485 
3 cd 0.2500000 1.0646144 0.5872485 
4 ef 0.5714286 1.0646144 0.5872485 
5 mm 0.2857143 1.1743812 0.2785029 
6 nn 0.5384615 1.1743812 0.2785029 
7 high 0.4000000 0.1443001 0.9303913 
8 low 0.5000000 0.1443001 0.9303913 
9 mid 0.4285714 0.1443001 0.9303913 

Я думаю, что это data.frame использовала для copy'n'paste соответствующего результата в Excel без необходимости проходить через каждый из CrossTables вручную ... Я хотел дать некоторые советы, как избежать такой стычки, но, учитывая эту структуру данных, я еще не нашел аккуратного решения.

Кто-нибудь?

Answer 1

Поскольку data.frame - это по существу список векторов, вы можете применить функцию к каждому из столбцов в свою очередь с помощью lapply и преобразовать список обратно в data.frame. Это позволит избежать частичного дублирования кода и избежать кумулятивного «переплетения».

library("dplyr") # Using dplyr for bind_rows 
library("gmodels") 

ref <- sample(c(0,1), 20, T) 
cat1 <- sample(c("ab", "cd", "ef"), 20, T) 
cat2 <- sample(c("mm", "nn"), 20, T) 
cat3 <- sample(c("low", "mid", "high"), 20, T) 
mytable <- data.frame(ref, cat1, cat2, cat3) 

# Function to extract the statistical results comparing 
# the ref column to each of the other columns in turn 

results_fun <- function(x) { 
    x <- CrossTable(mytable$ref, x, chisq = TRUE, prop.r = FALSE, 
     prop.chisq = FALSE, prop.t = FALSE) 
    res <- data.frame(a = names(x$prop.col[2,]), b = x$prop.col[2, ], 
     c = x$chisq[1], d = x$chisq[3],row.names = NULL) 
    res 
} 

mylist <- lapply(mytable[-1], results_fun) 
myresults <- bind_rows(mylist) 

давая

Source: local data frame [8 x 4] 

     a   b statistic p.value 
    (chr)  (dbl)  (dbl)  (dbl) 
1 ab 0.5000000 0.3428571 0.8424604 
2 cd 0.4000000 0.3428571 0.8424604 
3 ef 0.5714286 0.3428571 0.8424604 
4 mm 0.4444444 0.2020202 0.6530951 
5 nn 0.5454545 0.2020202 0.6530951 
6 high 0.3333333 1.8666667 0.3932407 
7 low 0.6666667 1.8666667 0.3932407 
8 mid 0.6000000 1.8666667 0.3932407