Table de contingence à deux voies dans R

Question

J'ai une trame de données et je souhaite générer une table de contingence à deux voies à partir de deux des colonnes. Ils ont tous les deux des valeurs "Trop peu", "À propos de" ou "Trop".

je tape

df %>% 
    filter(!is.na(col1)) %>% 
    group_by(col1) %>% 
    summarise(count = n()) 

pour les deux séparément et obtenir quelque chose comme ceci:

col1  count 
<fctr>  <int> 
Too Little 19259   
About Right 9539    
Too Much 2816  

Ce que je voudrais réaliser est la suivante:

 Too Little About Right Too Much Total 
col1 19259  9539   2816  31614 
col2 20619  9374   2262  32255 
Total 39878  18913   5078  63869 

I ai essayé d'utiliser la fonction de table

addmargins(table(df$col1, df$col2)) 

Mais le résultat est pas ce que je veux

   Too Little About Right Too Much Sum 
    Too Little  13770  4424  740 18934 
    About Right  4901  3706  700 9307 
    Too Much   1250   800  679 2729 
    Sum    19921  8930  2119 30970 

Answer 1

Je donnerais tabulate un essai, qui est le fondement de table (voir ?tabulate). Par exemple donné

set.seed(123) 
vals <- LETTERS[1:3] 
df <- as.data.frame(replicate(3, sample(vals, 5, T))) 
df <- data.frame(lapply(df, "levels<-", vals)) 

vous pourriez faire

m <- t(sapply(df, tabulate, nbins = length(vals))) 
colnames(m) <- vals 
addmargins(m) 
#  A B C Sum 
# V1 1 1 3 5 
# V2 1 3 1 5 
# V3 1 2 2 5 
# Sum 3 6 6 15 

Ou (via @thelatemail) juste

addmargins(t(sapply(df, table))) 
#  A B C Sum 
# V1 1 1 3 5 
# V2 1 3 1 5 
# V3 1 2 2 5 
# Sum 3 6 6 15 

Answer 2

Nous pouvons utiliser la table dans une boucle puis rbind:

# Using dummy data from @lukeA's answer 

addmargins(do.call(rbind, lapply(df1, table))) 
#  A B C Sum 
# V1 1 1 3 5 
# V2 1 3 1 5 
# V3 1 2 2 5 
# Sum 3 6 6 15 

---

Analyse comparative

# bigger data 
set.seed(123) 
vals <- LETTERS[1:20] 
df1 <- as.data.frame(replicate(20, sample(vals, 100000, T))) 
df1 <- data.frame(lapply(df1, "levels<-", vals)) 


microbenchmark::microbenchmark(
    lukeA = { 
    m1 <- t(sapply(df1, tabulate, nbins = length(vals))) 
    colnames(m1) <- vals 
    m1 <- addmargins(m1) 
    }, 
    # as vals only used for luke's solution, keep it in. 
    lukeA_1 = { 
    vals <- LETTERS[1:20] 
    m2 <- t(sapply(df1, tabulate, nbins = length(vals))) 
    colnames(m2) <- vals 
    m2 <- addmargins(m2) 
    }, 
    thelatemail = {m3 <- addmargins(t(sapply(df1, table)))}, 
    zx8754 = {m4 <- addmargins(do.call(rbind, lapply(df1, table)))} 
) 
# Unit: milliseconds 
#  expr  min  lq  mean median  uq  max neval 
#  lukeA 2.349969 2.371922 2.518447 2.473839 2.558653 3.363738 100 
#  lukeA_1 2.351680 2.377196 2.523473 2.473839 2.542831 3.459242 100 
# thelatemail 38.316506 42.054136 43.785777 42.674912 44.234193 90.287809 100 
#  zx8754 38.695101 41.979728 44.933602 42.762006 44.244314 110.834292 100