作者celestialgod (天)
看板R_Language
標題Re: [問題] 類似樞紐分析的表格製作
時間Sun Mar 24 01:17:30 2019
※ 引述《paganina (可以慢慢講嗎)》之銘言：
: [問題類型]:程式諮詢
: 用R做樞紐分析的表格
: [熟悉程度]
: 入門(寫過一點點程式，對語法不熟悉)
數字計算覺得哪裏怪怪的
group A(B)的三個年紀比例加起來是1
又說那個是性別比例... 覺得很怪...
我先當作你要算男性在group A(B)中，各年紀的分布....
----
好久沒寫R...
給你三種解法，base R再多個欄位就沒辦法了，建議跳過
dplyr的解法不太直覺，自行斟酌
我喜歡的還是data.table的解法乾淨俐落XD
# base R解法
set.seed(100)
DF <- data.frame(
group = rep(c("A", "B"), 15),
sex = sample(c("M", "F"), size = 30, replace = TRUE),
age = rep(c("0-20", "21-60", "61-100"), 10),
stringsAsFactors = FALSE
)
out_DF <- as.data.frame(tapply(DF$sex, list(DF$age, DF$group), function(x)
sum(x == "M")))
out_DF$age <- rownames(out_DF)
rownames(out_DF) <- NULL
transform(out_DF, A = A / sum(A), B = B / sum(B))
# A B age
# 1 0.6666667 0.2222222 0-20
# 2 0.3333333 0.4444444 21-60
# 3 0.0000000 0.3333333 61-100
# dplyr
library(dplyr)
library(tidyr)
set.seed(100)
DF <- data_frame(
group = rep(c("A", "B"), 15),
sex = sample(c("M", "F"), size = 30, replace = TRUE),
age = rep(c("0-20", "21-60", "61-100"), 10)
)
DF %>% group_by(group, age) %>%
# get count of male by group and age
summarise(proportion_male = sum(sex == "M")) %>%
group_by(group) %>%
# get proportion of male
mutate(proportion_male = proportion_male / sum(proportion_male)) %>%
# get pivot table
spread(group, proportion_male)
# # A tibble: 3 x 3
# age A B
# <chr> <dbl> <dbl>
# 1 0-20 0.667 0.222
# 2 21-60 0.333 0.444
# 3 61-100 0. 0.333
# data.table
library(data.table)
set.seed(100)
DT <- data.table(
group = rep(c("A", "B"), 15),
sex = sample(c("M", "F"), size = 30, replace = TRUE),
age = rep(c("0-20", "21-60", "61-100"), 10)
)
# get pivot table with male counts in cell
DT2 <- dcast(DT, age ~ group, function(x) sum(x == "M"), value.var = "sex")
# calculate proportion of male
DT2[ , c("A", "B") := lapply(.SD, function(x) x / sum(x)),
.SDcols = c("A", "B")]
DT2
# age A B
# 1: 0-20 0.6666667 0.2222222
# 2: 21-60 0.3333333 0.4444444
# 3: 61-100 0.0000000 0.3333333
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 119.14.59.166
※ 文章網址: https://webptt.com/m.aspx?n=bbs/R_Language/M.1553361454.A.F36.html
※ 編輯: celestialgod (119.14.59.166), 03/24/2019 01:54:29
※ 編輯: celestialgod (119.14.59.166), 03/24/2019 01:55:57
1F：推 frojet: 看各位大大的程式碼，真是叫我學會很多技巧 03/24 06:35
2F：推 cywhale: data.table []裡面可以寫lapply真的很方便~~ 03/24 08:29
3F：→ paganina: 感謝cel大大，大方解惑，有解決問題了，感謝 03/24 15:52