dplyr case_when в сложном сценарии - PullRequest
Новая
       86

dplyr case_when в сложном сценарии

2 голосов
/ 16 июня 2020

Предположим, что я составляю таблицу вероятностей в каждом раунде исследования по странам, раундам и типам. И мне нужно рассчитать вес на основе раундов, в которых человек участвовал до этого момента. Вес рассчитывается как обратная сумма всех вероятностей (p) минус произведение всех вероятностей до раунда, в котором участвовал человек.

Я подумал об использовании case_when () и, по крайней мере, записал его на 10 раундов, если я не могу найти способ автоматизировать его для будущих раундов, но не уверен, что я на правильном пути. Приветствуются любые указания от настоящего пользователя R! 

For id=1 in the example below,
p is 0.78584735 for round=1 and type=2 and country="DE"
p is 0.07271288 for round=2 and type=2 and country="DE"
Then, p_tot should be (0.78584735+0.07271288)- (0.78584735*0.07271288)


# Table with probabilities

  set.seed(1245)
  prob_table <- data.frame(country=c(rep("DE",6), rep("UK",6)), 
                           round=c(rep(1,3),rep(2,3),rep(1,3),rep(2,3)),
                           type=c(rep(1:3,2)), p=c(runif(12)))

# Data frame with participants

df <- data.frame(id=c(1:15), country=c(rep("DE",8), rep("UK",7)), 
                 round=c(2,3,1,1,1,2,1,1,2,3,1,3,2,2,2),
                 type=c(2,3,1,1,1,2,3,1,2,1,1,3,1,1,2))

# Calculate total probability

df %<>% mutate(
  p_tot = case_when(
    country=="DE" & round==1 & type==1 
    ~ prob_table%>% filter(country=="DE" & round<=1 & type==1) %>% 
      sum(all elements of p column)-multiply(all elements of p column),

    country=="DE" & round==1 & type==1 
    ~ prob_table%>% filter(country=="DE" & round<=1 & type==1) %>% 
      sum(all elements of p column)-multiply(all elements of p column),

    ...
    ...

    TRUE ~ NA
  )
)


# calculate weight

df$weight <- 1/df$p_tot

1 Ответ

1 голос
/ 17 июня 2020

Вы можете использовать значения каждой строки для создания фильтра вместо его жесткого кодирования.

Обычно подобная проблема решается путем объединения двух таблиц, но less than equal (round<=1) Состояние усложняет задачу, поэтому я использовал такой же подход, как и ваш.

Надеюсь, это поможет: 

library(dplyr)


# We change name to avoid collision during the filter
names(prob_table) <- paste('p', names(prob_table), sep = '_')

# Calculate total probability
df %>% 
  rowwise() %>% 
  mutate(
    p_tot = prob_table %>% 
      filter(p_country == country, p_round <= round, p_type == type) %>% 
      summarise(s = sum(p_p), 
                m = prod(p_p),
                f = s - m) %>% 
      pull(f),
    weight = 1 / p_tot
  )
#> Source: local data frame [15 x 6]
#> Groups: <by row>
#> 
#> # A tibble: 15 x 6
#>       id country round  type p_tot weight
#>    <int> <fct>   <dbl> <dbl> <dbl>  <dbl>
#>  1     1 DE          2     2 0.801   1.25
#>  2     2 DE          3     3 0.447   2.24
#>  3     3 DE          1     1 0     Inf   
#>  4     4 DE          1     1 0     Inf   
#>  5     5 DE          1     1 0     Inf   
#>  6     6 DE          2     2 0.801   1.25
#>  7     7 DE          1     3 0     Inf   
#>  8     8 DE          1     1 0     Inf   
#>  9     9 UK          2     2 0.532   1.88
#> 10    10 UK          3     1 0.475   2.10
#> 11    11 UK          1     1 0     Inf   
#> 12    12 UK          3     3 0.762   1.31
#> 13    13 UK          2     1 0.475   2.10
#> 14    14 UK          2     1 0.475   2.10
#> 15    15 UK          2     2 0.532   1.88

Создано 17.06.2020 с помощью пакета REPEX (v0.3.0)

...