dplyr case_when in a complex scenario

user_4477619 0
Viewed 199

Assume that I produce a probability table in each round of a study by country, round and type. And, I need to calculate a weight based on the rounds that a person participated up to that point. The weight is calculated as the inverse of the sum all probabilities (p) minus the product of all probabilities up to the round that a person participated.

I thought of using case_when() and at least write it out for 10 rounds if I cannot find a way to automate it for the future rounds, but not sure I am in the right way. Any guidance from a real R user is appreciated! 

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
dplyr case-when r
1 Answers

You can use the values of each row to create the filter, instead of hardcoding it.

Usually a problem like this is solved by joining the two tables, but the less than equal (round<=1) condition makes things tricky, so I used as similar approach as yours.

Hope this helps:

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

Created on 2020-06-17 by the reprex package (v0.3.0)

user_12612810
Related