作者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/cn.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