Tạo bảng tóm tắt của các biến phân loại có độ dài khác nhau

Question

Trong SPSS nó là khá dễ dàng để tạo ra một bảng tóm tắt của các biến phân loại sử dụng "Bàn Custom":

Làm thế nào tôi có thể làm điều này trong R?

Các giải pháp chung và có thể mở rộng được ưu tiên và các giải pháp sử dụng gói Plyr và/hoặc Reshape2, vì tôi đang cố gắng tìm hiểu chúng.

Ví dụ dữ liệu: (mtcars là trong quá trình cài đặt R)

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

T.B.

Xin lưu ý, mục tiêu của tôi là lấy mọi thứ trong một bảng như trong hình. Tôi đã được strugling trong nhiều giờ nhưng nỗ lực của tôi đã được như vậy nghèo mà gửi mã có lẽ sẽ không thêm vào tính toàn diện của câu hỏi.

Answer 1

Một cách để nhận được đầu ra, nhưng không phải là định dạng:

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

Một giải pháp cơ sở R sử dụng lapply() và do.call() với rbind() để khâu lại với nhau các mảnh:

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])))) 

Kết quả trong:

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 còn lại là định dạng.

Answer 3

Đây là một giải pháp sử dụng các chức năng của freqquestionr gói (autopromotion không biết xấu hổ, xin lỗi):

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

Đây là giải pháp của tôi. Nó không đẹp, đó là lý do tại sao tôi đặt một chiếc túi trên đầu của nó (bọc nó trong một chức năng). Tôi cũng thêm một biến khác để chứng minh rằng nó là chung (tôi hy vọng).

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 

Sử dụng gói googleVis, bạn có thể tạo bảng html tiện dụng.

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

Answer 5

Bạn có thể tìm thấy những đoạn mã sau đây hữu ích. Nó sử dụng các chức năng gói cơ sở bảng, margin.table và prop.table và không yêu cầu bất kỳ gói nào khác. Nó thu thập các kết quả vào một danh sách với kích thước tên tuy nhiên (những có thể được thu thập để một ma trận duy nhất với 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

Đáng tiếc là có vẻ là không có gói R nhưng có thể tạo ra một đầu ra tốt đẹp như SPSS.Hầu hết các chức năng để tạo ra các bảng dường như định nghĩa các định dạng đặc biệt của riêng chúng, điều gì khiến bạn gặp rắc rối nếu bạn muốn xuất hoặc làm việc theo cách khác.
Nhưng tôi chắc chắn R có khả năng đó và vì vậy tôi bắt đầu viết các chức năng của riêng tôi. Tôi rất vui khi chia sẻ kết quả (công việc đang ở trạng thái tiến độ, nhưng hoàn thành công việc) với bạn:

Hàm sau trả về cho tất cả các biến yếu tố trong dữ liệu.khoảng tần số hoặc tỷ lệ phần trăm (calc = " perc ") cho mỗi cấp của biến yếu tố" biến ".
Điều quan trọng nhất có thể là đầu ra là một dữ liệu thân thiện với người dùng đơn giản &. Vì vậy, so với nhiều chức năng khác, không có vấn đề gì khi xuất kết quả một tác phẩm với nó theo bất kỳ cách nào bạn muốn.

tôi nhận ra rằng có nhiều tiềm năng để cải thiện hơn nữa, tức là thêm một khả năng lựa chọn hàng so với tính toán tỷ lệ phần trăm cột vv

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)  
}