2017-09-03 132 views
1

我有一個數據框,我想從兩列中輸出一個雙向列聯表。他們都有價值「太少」,「關於正確」或「太多」。R中的雙向列聯表

我打字

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

分別爲二者的和得到的東西是這樣的:

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

我想實現的是:

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

我一直試圖使用表功能

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

但結果不是我想要

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

那麼什麼是有望走出把你想要 – Wen

+1

歡迎喜來所以,提問在[mimimal但完整的(很重要https://stackoverflow.com/help/ mcve)形式。也總是試圖包含一些示例數據(截至目前沒有人,但你可以看到'df')也許只有幾行就足以作爲一個簡單的例子 – Nate

回答

3

我給tabulate一試,這是table基礎(見?tabulate)是什麼。例如,給定

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

那麼你可以做

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 

或(通過@thelatemail)剛剛

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 
+1

我不知道爲什麼你需要'tabulate'具體。只是'addmargins(t(sapply(df,table))''會做到這一點,並且會保留這些名字。 – thelatemail

+0

@thelatemail真的,謝謝,我補充了這一點(儘管它可能與zx8754的解決方案太相似了,現在...) – lukeA

+0

不管怎樣,做'sapply'比簡單地列出一個列表更簡單 – thelatemail

2

我們可以在一個循環,然後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 

標杆

# 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 
+1

無論如何,它的速度肯定會更快,但是你的基準會遺漏'vals '並不總是提前知道(或者至少不應該被認爲是已知的),所以你必須在那裏查找'vals < - unique(df1 [,1)') – thelatemail

+0

@ thelatemail真的,也許它應該是'vals < - unique(unlist(df1))',但是從OP的例子中,他們事先知道這些值。 – zx8754