2013-02-27 17 views
7

In SPSS è abbastanza facile per creare una tabella riassuntiva delle variabili categoriche utilizzando "tabelle personalizzate":Crea una tabella di riepilogo delle variabili categoriali di diverse lunghezze

This example is from SPSS

Come posso fare questo in R?

Si preferiscono soluzioni generali ed espandibili e soluzioni che utilizzano i pacchetti Plyr e/o Reshape2, perché sto cercando di impararli.

Esempio Dati: (mtcars è nell'installazione R)

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

P.S.

Si prega di notare, il mio obiettivo è quello di ottenere tutto in una tabella come nell'immagine. Ho lottato per molte ore ma i miei tentativi sono stati così mediocri che postare il codice probabilmente non aggiungerà alla comprensibilità della domanda.

+1

quando dici _like il picture_, sei aperto a miglioramenti o fa deve corrispondere esattamente a quel formato? :) –

+0

Aperto ai miglioramenti :) –

risposta

5

Un modo per ottenere l'uscita, ma non la formattazione:

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% 
+0

@ReneBern Questo è strano. Hai provato in una sessione R pulita? – James

+1

Grazie a tutti! Ho accettato questa risposta perché ha ottenuto tutto in una tabella, non era troppo complicato e usato Plyr. –

5

Una soluzione di base R utilizzando lapply() e do.call() con rbind() cucire insieme i pezzi:

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

risultati in:

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 Il resto è la formattazione.

0

Ecco una soluzione che utilizza la funzione freq del questionr package (autopromotion spudorato, sorry):

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 
4

Ecco la mia soluzione. Non è carino, ed è per questo che metto una borsa in testa (avvolgendola in una funzione). Aggiungo anche un'altra variabile per dimostrare che è generale (spero).

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 

Utilizzando googleVis pacchetto, è possibile fare una tabella HTML a portata di mano.

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

enter image description here

+1

Bello, anche se per gli spazi potrebbe essere più facile fare 'ifelse (duplicato (x)," ", x)' – James

+0

+1 Non sapevo su gvisTable – juba

1

è possibile trovare il seguente frammento di codice utile. Utilizza le funzioni pacchetto base tabella, margin.table e prop.table e non richiede altri pacchetti. Fa raccogliere i risultati in un elenco con citate dimensioni tuttavia (questi potrebbero essere raccolti per una sola matrice con 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 
0

Purtroppo non sembra esserci alcun pacchetto R ancora in grado di generare un bel output come SPSS.La maggior parte delle funzioni per la generazione di tabelle sembrano definire i loro formati speciali che ti mettono nei guai se vuoi esportarli o lavorarci sopra in un altro modo.
Ma sono certo che R è in grado di farlo e così ho iniziato a scrivere le mie funzioni. Sono felice di condividere il risultato (work in progress-status, ma il lavoro viene svolto) con te:

La seguente funzione restituisce per tutte le variabili fattore in un data.frame la frequenza o la percentuale (calc = " perc ") per ogni livello della variabile fattore" variabile ".
La cosa più importante potrebbe essere che l'output è un semplice data & data.frame. Quindi, rispetto a molte altre funzioni, non è un problema esportare i risultati e lavorare con esso in qualsiasi modo tu voglia.

mi rendo conto che c'è molto potenziale per ulteriori miglioramenti, ossia aggiungere la possibilità di selezione riga vs. colonna calcolo percentuale, ecc

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