Создать сводную таблицу категориальных переменных различной длины

Question

В SPSS это довольно легко создать сводную таблицу категориальных переменных, используя «Custom Tables»:

Как я могу это сделать в R?

Общие и расширяемые решения являются предпочтительными и решениями, использующими пакеты Plyr и/или Reshape2 , потому что я пытаюсь их изучить.

Пример данных: (mtcars в установке R)

df <- colwise(function(x) as.factor(x)) (mtcars[,8:11]) 

P.S.

Обратите внимание: моя цель состоит в том, чтобы все в стол, как на картинке. Я много работал в течение многих часов, но мои попытки были настолько бедными, что размещение кода, вероятно, не добавило бы к понятности вопроса.

Answer 1

Один из способов, чтобы получить выход, но не форматирование:

library(plyr) 
ldply(mtcars[,8:11],function(x) t(rbind(names(table(x)),table(x),paste0(prop.table(table(x))*100,"%")))) 
    .id 1 2  3 
1 vs 0 18 56.25% 
2 vs 1 14 43.75% 
3 am 0 19 59.375% 
4 am 1 13 40.625% 
5 gear 3 15 46.875% 
6 gear 4 12 37.5% 
7 gear 5 5 15.625% 
8 carb 1 7 21.875% 
9 carb 2 10 31.25% 
10 carb 3 3 9.375% 
11 carb 4 10 31.25% 
12 carb 6 1 3.125% 
13 carb 8 1 3.125% 

Answer 2

Основание R решение с использованием lapply() и do.call() с rbind(), чтобы сшить вместе части:

x <- lapply(mtcars[, c("vs", "am", "gear", "carb")], table) 

neat.table <- function(x, name){ 
    xx <- data.frame(x) 
    names(xx) <- c("Value", "Count") 
    xx$Fraction <- with(xx, Count/sum(Count)) 
    data.frame(Variable = name, xx) 
} 

do.call(rbind, lapply(seq_along(x), function(i)neat.table(x[i], names(x[i])))) 

Результаты в:

Variable Value Count Fraction 
1  vs  0 18 0.56250 
2  vs  1 14 0.43750 
3  am  0 19 0.59375 
4  am  1 13 0.40625 
5  gear  3 15 0.46875 
6  gear  4 12 0.37500 
7  gear  5  5 0.15625 
8  carb  1  7 0.21875 
9  carb  2 10 0.31250 
10  carb  3  3 0.09375 
11  carb  4 10 0.31250 
12  carb  6  1 0.03125 
13  carb  8  1 0.03125 

Th e rest - форматирование.

Answer 3

Вот решение, используя freq функцию questionr пакета (бесстыдной autopromotion, извините):

R> lapply(df, freq) 
$vs 
    n % 
0 18 56.2 
1 14 43.8 
NA 0 0.0 

$am 
    n % 
0 19 59.4 
1 13 40.6 
NA 0 0.0 

$gear 
    n % 
3 15 46.9 
4 12 37.5 
5 5 15.6 
NA 0 0.0 

$carb 
    n % 
1 7 21.9 
2 10 31.2 
3 3 9.4 
4 10 31.2 
6 1 3.1 
8 1 3.1 
NA 0 0.0 

Answer 4

Вот мое решение. Это некрасиво, вот почему я положил сумку на голову (оберните ее функцией). Я также добавляю еще одну переменную, чтобы продемонстрировать, что она вообще (я надеюсь).

prettyTable <- function(x) { 

    tbl <- apply(x, 2, function(m) { 
    marc <- sort(unique(m)) 
    cnt <- matrix(table(m), ncol = 1) 
    out <- cbind(marc, cnt) 
    out <- out[order(marc), ] # do sorting 
    out <- cbind(out, round(prop.table(out, 2)[, 2] * 100, 2)) 
    }) 

    x2 <- do.call("rbind", tbl) 

    spaces <- unlist(lapply(apply(x, 2, unique), length)) 
    space.names <- names(spaces) 
    spc <- rep("", sum(spaces)) 
    ind <- cumsum(spaces) 
    ind <- abs(spaces - ind)+1 
    spc[ind] <- space.names 

    out <- cbind(spc, x2) 
    out <- as.data.frame(out) 

    names(out) <- c("Variable", "Levels", "Count", "Column N %") 
    out 
} 

prettyTable(x = mtcars[, c(2, 8:11)]) 

    Variable Levels Count Column N % 
1  cyl  4 11  34.38 
2    6  7  21.88 
3    8 14  43.75 
4  vs  0 18  56.25 
5    1 14  43.75 
6  am  0 19  59.38 
7    1 13  40.62 
8  gear  3 15  46.88 
9    4 12  37.5 
10    5  5  15.62 
11  carb  1  7  21.88 
12    2 10  31.25 
13    3  3  9.38 
14    4 10  31.25 
15    6  1  3.12 
16    8  1  3.12 

Использование googleVis пакета, вы можете сделать удобный HTML таблицу.

plot(gvisTable(prettyTable(x = mtcars[, c(2, 8:11)]))) 

Answer 5

Вы можете найти следующий фрагмент кода полезным. Он использует функции базового пакета таблица, margin.table и prop.table и не требует никаких других упаковок. Это действительно собирает результаты в виде списка с именованными размерами, однако (они могут быть собраны в одну матрицу с rbind):

dat <- table(mtcars[,8:11]) 
result <- list() 
for(m in 1:length(dim(dat))){ 
    martab <- margin.table(dat, margin=m) 
    result[[m]] <- cbind(Freq=martab, Prop=prop.table(martab)) 
} 
names(result) <- names(dimnames(dat)) 

> result 
$vs 
    Freq Prop 
0 18 0.5625 
1 14 0.4375 

$am 
    Freq Prop 
0 19 0.59375 
1 13 0.40625 

$gear 
    Freq Prop 
3 15 0.46875 
4 12 0.37500 
5 5 0.15625 

$carb 
    Freq Prop 
1 7 0.21875 
2 10 0.31250 
3 3 0.09375 
4 10 0.31250 
6 1 0.03125 
8 1 0.03125 

Answer 6

К сожалению, кажется, нет пакета R пока что может генерировать хороший выход, как SPSS.Большинство функций для генерации таблиц, по-видимому, определяют их собственные специальные форматы, что приводит к неприятностям, если вы хотите экспортировать или работать над ним по-другому.
Но я уверен, что R способен на это, и поэтому я начал писать свои собственные функции. Я рад поделиться с вами результатом (работа в процессе - статус, но выполняется):

Следующая функция возвращает для всех фактор-переменных в data.frame частоту или процент (calc = " perc ") для каждого уровня переменной" переменная ".
Важнейшей вещью может быть то, что выход представляет собой простой & удобный для пользователя data.frame. Таким образом, по сравнению со многими другими функциями, нет никакой проблемы, чтобы экспортировать результаты, работать с ним любым способом.

Я понимаю, что есть большой потенциал для дальнейшего улучшения, т.е. добавить возможность выбора строки против процентного расчета колонки и т.д.

contitable <- function(survey_data, variable, calc="freq"){  

    # Check which variables are not given as factor  
    # and exlude them from the given data.frame  
survey_data_factor_test <- as.logical(sapply(Survey, FUN=is.factor))  
    survey_data <- subset(survey_data, select=which(survey_data_factor_test))  

    # Inform the user about deleted variables  
    # is that proper use of printing to console during a function call??  
    # for now it worksjust fine...  
    flush.console()   
    writeLines(paste("\n ", sum(!survey_data_factor_test, na.rm=TRUE), 
      "non-factor variable(s) were excluded\n")) 

    variable_levels <- levels(survey_data[ , variable ])  
    variable_levels_length <- length(variable_levels)  

    # Initializing the data.frame which will gather the results  
    result <- data.frame("Variable", "Levels", t(rep(1, each=variable_levels_length)))  
    result_column_names <- paste(variable, variable_levels, sep=".")  
    names(result) <- c("Variable", "Levels", result_column_names)  

    for(column in 1:length(names(survey_data))){  

     column_levels_length <- length(levels(survey_data[ , column ])) 
     result_block <- as.data.frame(rep(names(survey_data)[column], each=column_levels_length)) 
     result_block <- cbind(result_block, as.data.frame(levels(survey_data[,column]))) 
     names(result_block) <- c("Variable", "Levels") 

     results <- table(survey_data[ , column ], survey_data[ , variable ]) 

     if(calc=="perc"){ 
     results <- apply(results, MARGIN=2, FUN=function(x){ x/sum(x) }) 
     results <- round(results*100, 1) 
     } 

     results <- unclass(results) 
     results <- as.data.frame(results) 
     names(results) <- result_column_names 
     rownames(results) <- NULL 

     result_block <- cbind(result_block, results) 
     result <- rbind(result, result_block) 
}  
result <- result[-1,]   
return(result)  
}