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
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)