2013-02-27 14 views
7

In SPSS ist es ziemlich einfach, eine Übersichtstabelle der kategorischen Variablen „Benutzerdefinierte Tabellen“ zu erstellen:erstellen Übersichtstabelle der kategorischen Variablen unterschiedlicher Längen

This example is from SPSS

Wie kann ich dies in R tun?

Allgemeine und erweiterbare Lösungen sind bevorzugt, und Lösungen mit den Plyr und/oder Reshape2-Pakete, weil ich versuche, diese zu lernen.

Beispiel Daten: (mtcars ist in der R-Installation)

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

P.S.

Bitte beachten Sie, mein Ziel ist es, alles in eine Tabelle wie auf dem Bild zu bekommen. Ich habe seit vielen Stunden gekämpft, aber meine Versuche waren so schlecht, dass das Veröffentlichen des Codes wahrscheinlich nicht zur Verständlichkeit der Frage beitragen wird.

+1

wenn Sie _like der picture_ sagen, Sie sind zu Verbesserungen offen oder tut muss es genau diesem Format entsprechen? :) –

+0

Offen für Verbesserungen :) –

Antwort

5

Eine Möglichkeit, die Ausgabe zu erhalten, aber nicht die Formatierung:

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 Das ist seltsam. Haben Sie in einer sauberen R-Sitzung versucht? – James

+1

Danke allen! Ich akzeptierte diese Antwort, weil sie alles in einem Tisch hatte, nicht zu kompliziert war und Plyr benutzte. –

5

Eine Basis R Lösung lapply() und do.call() mit rbind() mit zusammen die Stücke zum Aufnähen:

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

Ergebnisse 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 Der Rest ist Formatierung.

0

Hier ist eine Lösung mit der freq Funktion der questionr Paket (schamlosen autopromotion, 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

Hier ist meine Lösung. Es ist nicht schön, deshalb lege ich eine Tasche über den Kopf (wickeln Sie es in eine Funktion). Ich füge auch eine andere Variable hinzu, um zu demonstrieren, dass es allgemein ist (hoffe ich).

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 

Mit googleVis Paket können Sie eine praktische HTML-Tabelle machen.

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

enter image description here

+1

Schön, aber für die Räume könnte es einfacher zu tun "ifelse (dupliziert (x)", "x") – James

+0

+1 wusste nicht über gvisTable – juba

1

Sie können der folgende Code-Schnipsel nützlich finden. Es verwendet die Basispaketfunktionen Tabelle, margin.table und prop.table und benötigt keine anderen Pakete. Es spielt die Ergebnisse in eine Liste mit dem Namen Dimensionen sammeln jedoch (diese auf eine einzige Matrix mit rbind gesammelt werden können):

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

Leider scheint es noch kein R-Paket zu sein, dass kann eine schöne Ausgabe wie erzeugen SPSS.Die meisten Funktionen zum Generieren von Tabellen scheinen ihre eigenen speziellen Formate zu definieren, was Sie in Schwierigkeiten bringt, wenn Sie auf eine andere Weise exportieren oder daran arbeiten wollen.
Aber ich bin mir sicher, R ist dazu in der Lage und so begann ich meine eigenen Funktionen zu schreiben. Ich bin glücklich, das Ergebnis mit Ihnen zu teilen (Arbeit in Arbeit-Status, aber erledigt den Job):

Die folgende Funktion gibt für alle Faktorvariablen in einem dat.frame die Häufigkeit oder den Prozentsatz zurück (calc = " perc ") für jede Ebene der Faktorvariablen" Variable ".
Die wichtigste Sache kann sein, dass die Ausgabe eine einfache & benutzerfreundliche data.frame ist. Im Vergleich zu vielen anderen Funktionen ist es kein Problem, die Ergebnisse einer Arbeit damit zu exportieren, wie Sie wollen.

Ich weiß, dass es viel Potenzial für weitere Verbesserungen, dh eine Möglichkeit hinzufügen Reihe vs. Spalte Prozentrechnung für die Auswahl usw.

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