Эффективный подход с использованием комбинации lapply
, Map
& Reduce
из базы R:
l <- lapply(df, table)
m <- Map(function(x,y) unname(y[match(x, names(y))]), df, l)
df$D <- Reduce(`*`, m)
, что дает:
> head(df, 15)
A B C D
1 3 5 0.4 57344
2 5 6 0.5 79560
3 0 4 0.1 77996
4 2 6 0.1 65348
5 5 11 0.6 65520
6 3 8 0.5 63360
7 6 6 0.2 64090
8 1 9 0.4 62160
9 10 2 0.2 56420
10 5 2 0.2 70980
11 4 11 0.3 52650
12 7 6 0.5 57120
13 10 1 0.2 76570
14 7 10 0.5 58800
15 8 10 0.3 84175
Что это делает:
lapply(df, table)
создает список частот для каждого столбца
- С
Map
список создается с match
, где каждый элемент списка имеет ту же длину, что и число строк df
. Каждый элемент списка представляет собой вектор частот, соответствующий значениям в df
.
- При
Reduce
произведение векторов в списке m
вычисляется поэлементно: первое значение каждого вектора в списке m
умножается друг на друга, затем 2-е значение и т. Д.
Тот же подход в tidyverse
:
library(dplyr)
library(purrr)
df %>%
mutate(D = map(df, table) %>%
map2(df, ., function(x,y) unname(y[match(x, names(y))])) %>%
reduce(`*`))
Использованные данные:
set.seed(2018)
df <- data.frame(A = sample(rep(0:10, c(34,37,31,32,27,39,29,28,37,39,31)), 364),
B = sample(rep(1:11, c(38,28,38,37,32,34,29,33,30,35,30)), 364),
C = sample(rep(seq(0.1,0.6,0.1), c(62,65,65,56,60,56)), 364))