在 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. 第 1 列 cyl_exp - 根据交叉 table 填写预期结果。例如,在 mtcars 数据集中,如果齿轮数为 3,则此新列(参考 tab 交叉 table)的值应为 8,因为有80%的概率,如果齿轮数是3,那么cyl应该是8。
  2. 第 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