在 R 中添加可能事件及其概率的最佳方法 table
Best possible way to add the likely event and its probability from a cross table in R
使用 mtcars
数据集,我创建了一个交叉 table 如下 -
tab = with(mtcars, ftable(gear, cyl))
tab
这是它的样子 -
cyl 4 6 8
gear
3 1 2 12
4 8 4 0
5 2 1 2
对于这个交叉table,我已经计算了行向概率
tab_prob = tab %>% prop.table(1) %>% round(4) * 100
tab_prob
cyl 4 6 8
gear
3 6.67 13.33 80.00
4 66.67 33.33 0.00
5 40.00 20.00 40.00
我想向原始 mtcars
数据集添加两列
- 第 1 列
cyl_exp
- 根据交叉 table 填写预期结果。例如,在 mtcars
数据集中,如果齿轮数为 3
,则此新列(参考 tab
交叉 table)的值应为 8
,因为有80%
的概率,如果齿轮数是3
,那么cyl
应该是8。
- 第 2 列
cyl_prob
- 根据 cyl_exp
列中的值,在此列中写入来自 table tab_prob
的概率。
这是预期的结果 -
head(mtcars)
mpg cyl disp hp drat wt qsec vs am gear carb cyl_prob cyl_exp
1: 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4 66.67 4
2: 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4 66.67 4
3: 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1 66.67 4
4: 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1 80.00 8
5: 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2 80.00 8
6: 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 80.00 8
有没有简单的方法可以做到这一点?
谢谢!
dplyr
中有一种方法可以做到这一点:
library(dplyr)
mtcars %>%
count(cyl_exp = cyl, gear, name = 'cyl_prob') %>%
group_by(gear) %>%
mutate(cyl_prob = prop.table(cyl_prob) * 100) %>%
slice(which.max(cyl_prob)) %>%
inner_join(mtcars, by = 'gear')
# cyl_exp gear cyl_prob mpg cyl disp hp drat wt qsec vs am carb
# <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 8 3 80 21.4 6 258 110 3.08 3.22 19.4 1 0 1
# 2 8 3 80 18.7 8 360 175 3.15 3.44 17.0 0 0 2
# 3 8 3 80 18.1 6 225 105 2.76 3.46 20.2 1 0 1
# 4 8 3 80 14.3 8 360 245 3.21 3.57 15.8 0 0 4
# 5 8 3 80 16.4 8 276. 180 3.07 4.07 17.4 0 0 3
# 6 8 3 80 17.3 8 276. 180 3.07 3.73 17.6 0 0 3
# 7 8 3 80 15.2 8 276. 180 3.07 3.78 18 0 0 3
# 8 8 3 80 10.4 8 472 205 2.93 5.25 18.0 0 0 4
# 9 8 3 80 10.4 8 460 215 3 5.42 17.8 0 0 4
#10 8 3 80 14.7 8 440 230 3.23 5.34 17.4 0 0 4
# … with 22 more rows
我将数据保存为长格式,以便更容易加入。答案的第一部分用于创建交叉 table.
mtcars %>%
count(cyl_exp = cyl, gear, name = 'cyl_prob') %>%
group_by(gear) %>%
mutate(cyl_prob = prop.table(cyl_prob) * 100)
# cyl_exp gear cyl_prob
# <dbl> <dbl> <dbl>
#1 4 3 6.67
#2 4 4 66.7
#3 4 5 40
#4 6 3 13.3
#5 6 4 33.3
#6 6 5 20
#7 8 3 80
#8 8 5 40
从这里我们只保留每个gear
概率最高的行并加入数据。
我使用常规 table 和 prop.table 而不是 ftable
。我提出以下解决方案:
df <- mtcars
tab=table(mtcars$gear,mtcars$cyl)
tab_prob = round(prop.table(tab,margin=1)*100,2)
exp_cyl <- function(x){
return(as.numeric(names(which.max(tab[toString(x),]))))
}
prob_cyl <- function(x){
return(round(max(tab_prob[toString(x),]),2))
}
df <- mtcars
df %>% mutate(cyl_prob=sapply(gear,prob_cyl),cyl_exp=sapply(gear,exp_cyl))
输出:
mpg cyl disp hp drat wt qsec vs am gear carb cyl_prob cyl_exp
Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4 66.67 4
Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4 66.67 4
Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 66.67 4
Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1 80.00 8
Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2 80.00 8
Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1 80.00 8
Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4 80.00 8
Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2 66.67 4
Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2 66.67 4
Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4 66.67 4
对于data.table
,我会这样做:
mtcars <- as.data.table(mtcars, keep.rownames = T)
tab <- mtcars[, .N, by = .(gear, cyl)]
tab[, prob := N/sum(N), by = .(gear)]
tab <- tab[order(-prob, cyl)][!duplicated(gear)]
mtcars[tab, `:=`(cyl_exp = i.cyl, cyl_prob = i.prob), on = .(gear)]
# > head(mtcars)
# rn mpg cyl disp hp drat wt qsec vs am gear carb cyl_exp cyl_prob
# 1: Mazda RX4 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4 4 0.6666667
# 2: Mazda RX4 Wag 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4 4 0.6666667
# 3: Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1 4 0.6666667
# 4: Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1 8 0.8000000
# 5: Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2 8 0.8000000
# 6: Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 8 0.8000000
使用 mtcars
数据集,我创建了一个交叉 table 如下 -
tab = with(mtcars, ftable(gear, cyl))
tab
这是它的样子 -
cyl 4 6 8
gear
3 1 2 12
4 8 4 0
5 2 1 2
对于这个交叉table,我已经计算了行向概率
tab_prob = tab %>% prop.table(1) %>% round(4) * 100
tab_prob
cyl 4 6 8
gear
3 6.67 13.33 80.00
4 66.67 33.33 0.00
5 40.00 20.00 40.00
我想向原始 mtcars
数据集添加两列
- 第 1 列
cyl_exp
- 根据交叉 table 填写预期结果。例如,在mtcars
数据集中,如果齿轮数为3
,则此新列(参考tab
交叉 table)的值应为8
,因为有80%
的概率,如果齿轮数是3
,那么cyl
应该是8。 - 第 2 列
cyl_prob
- 根据cyl_exp
列中的值,在此列中写入来自 tabletab_prob
的概率。
这是预期的结果 -
head(mtcars)
mpg cyl disp hp drat wt qsec vs am gear carb cyl_prob cyl_exp
1: 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4 66.67 4
2: 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4 66.67 4
3: 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1 66.67 4
4: 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1 80.00 8
5: 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2 80.00 8
6: 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 80.00 8
有没有简单的方法可以做到这一点?
谢谢!
dplyr
中有一种方法可以做到这一点:
library(dplyr)
mtcars %>%
count(cyl_exp = cyl, gear, name = 'cyl_prob') %>%
group_by(gear) %>%
mutate(cyl_prob = prop.table(cyl_prob) * 100) %>%
slice(which.max(cyl_prob)) %>%
inner_join(mtcars, by = 'gear')
# cyl_exp gear cyl_prob mpg cyl disp hp drat wt qsec vs am carb
# <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 8 3 80 21.4 6 258 110 3.08 3.22 19.4 1 0 1
# 2 8 3 80 18.7 8 360 175 3.15 3.44 17.0 0 0 2
# 3 8 3 80 18.1 6 225 105 2.76 3.46 20.2 1 0 1
# 4 8 3 80 14.3 8 360 245 3.21 3.57 15.8 0 0 4
# 5 8 3 80 16.4 8 276. 180 3.07 4.07 17.4 0 0 3
# 6 8 3 80 17.3 8 276. 180 3.07 3.73 17.6 0 0 3
# 7 8 3 80 15.2 8 276. 180 3.07 3.78 18 0 0 3
# 8 8 3 80 10.4 8 472 205 2.93 5.25 18.0 0 0 4
# 9 8 3 80 10.4 8 460 215 3 5.42 17.8 0 0 4
#10 8 3 80 14.7 8 440 230 3.23 5.34 17.4 0 0 4
# … with 22 more rows
我将数据保存为长格式,以便更容易加入。答案的第一部分用于创建交叉 table.
mtcars %>%
count(cyl_exp = cyl, gear, name = 'cyl_prob') %>%
group_by(gear) %>%
mutate(cyl_prob = prop.table(cyl_prob) * 100)
# cyl_exp gear cyl_prob
# <dbl> <dbl> <dbl>
#1 4 3 6.67
#2 4 4 66.7
#3 4 5 40
#4 6 3 13.3
#5 6 4 33.3
#6 6 5 20
#7 8 3 80
#8 8 5 40
从这里我们只保留每个gear
概率最高的行并加入数据。
我使用常规 table 和 prop.table 而不是 ftable
。我提出以下解决方案:
df <- mtcars
tab=table(mtcars$gear,mtcars$cyl)
tab_prob = round(prop.table(tab,margin=1)*100,2)
exp_cyl <- function(x){
return(as.numeric(names(which.max(tab[toString(x),]))))
}
prob_cyl <- function(x){
return(round(max(tab_prob[toString(x),]),2))
}
df <- mtcars
df %>% mutate(cyl_prob=sapply(gear,prob_cyl),cyl_exp=sapply(gear,exp_cyl))
输出:
mpg cyl disp hp drat wt qsec vs am gear carb cyl_prob cyl_exp
Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4 66.67 4
Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4 66.67 4
Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 66.67 4
Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1 80.00 8
Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2 80.00 8
Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1 80.00 8
Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4 80.00 8
Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2 66.67 4
Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2 66.67 4
Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4 66.67 4
对于data.table
,我会这样做:
mtcars <- as.data.table(mtcars, keep.rownames = T)
tab <- mtcars[, .N, by = .(gear, cyl)]
tab[, prob := N/sum(N), by = .(gear)]
tab <- tab[order(-prob, cyl)][!duplicated(gear)]
mtcars[tab, `:=`(cyl_exp = i.cyl, cyl_prob = i.prob), on = .(gear)]
# > head(mtcars)
# rn mpg cyl disp hp drat wt qsec vs am gear carb cyl_exp cyl_prob
# 1: Mazda RX4 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4 4 0.6666667
# 2: Mazda RX4 Wag 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4 4 0.6666667
# 3: Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1 4 0.6666667
# 4: Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1 8 0.8000000
# 5: Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2 8 0.8000000
# 6: Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 8 0.8000000