Random Weights

When doing a quantitative benefit/risk analysis, it may be of interest to add some uncertainty around the weights. If this is the case, one can specify a vector of weights in lieu of a single weight:

library(brisk)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

benefit_fun <- approxfun(c(0, 0.5, 1), c(0, 0.2, 1))
risk_fun <- approxfun(c(0, 0.3, 0.6, 1), c(1, 0.9, 0.2, 0))

# weights
w1 <- runif(1e4, 0.6, 0.8)
w2 <- runif(1e4, 0.2, 0.3)

set.seed(1132)
out <- br(
  benefit("response", benefit_fun, weight = w1),
  risk("side_effect", risk_fun, weight = w2),
  br_group(
    label = "placebo",
    response = rbeta(1e4, 1 + 30, 1 + 70),
    side_effect = rbeta(1e4, 1 + 3, 1 + 97)
  ),
  br_group(
    label = "drug",
    response = rbeta(1e4, 1 + 60, 1 + 40),
    side_effect = rbeta(1e4, 1 + 40, 1 + 60)
  )
)

head(select(out, iter, response_weight, side_effect_weight))
#> # A tibble: 6 × 3
#>    iter response_weight side_effect_weight
#>   <int>           <dbl>              <dbl>
#> 1     1           0.670              0.281
#> 2     2           0.626              0.296
#> 3     3           0.653              0.294
#> 4     4           0.799              0.275
#> 5     5           0.618              0.296
#> 6     6           0.698              0.280

In some cases is may be desirable to have weights which sum to 1 (e.g. when using the mcda() function). If this is the case, one can use the sim_weights() function to generate a set of weights which sums to 1. One needs to provide the number of weights to generate, and upper/lower bounds for each endpoint. The function then generates weights using the bounds. For instance, the following code will generate weights such that the ratio of side effect to response is from 0.2 to 0.3:

w <- sim_weights(1e4, response = c(1, 1), side_effect = c(0.2, 0.3))
head(w)
#> # A tibble: 6 × 2
#>   response side_effect
#>      <dbl>       <dbl>
#> 1    0.778       0.222
#> 2    0.813       0.187
#> 3    0.801       0.199
#> 4    0.793       0.207
#> 5    0.789       0.211
#> 6    0.777       0.223
summary(w$side_effect / w$response)
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#>  0.2000  0.2237  0.2477  0.2486  0.2730  0.3000

These weights can then be used in the benefit-risk analyses:

out2 <- br(
  benefit("response", benefit_fun, weight = w$response),
  risk("side_effect", risk_fun, weight = w$side_effect),
  br_group(
    label = "placebo",
    response = rbeta(1e4, 1 + 30, 1 + 70),
    side_effect = rbeta(1e4, 1 + 3, 1 + 97)
  ),
  br_group(
    label = "drug",
    response = rbeta(1e4, 1 + 60, 1 + 40),
    side_effect = rbeta(1e4, 1 + 40, 1 + 60)
  )
)

head(select(out2, iter, response_weight, side_effect_weight))
#> # A tibble: 6 × 3
#>    iter response_weight side_effect_weight
#>   <int>           <dbl>              <dbl>
#> 1     1           0.778              0.222
#> 2     2           0.813              0.187
#> 3     3           0.801              0.199
#> 4     4           0.793              0.207
#> 5     5           0.789              0.211
#> 6     6           0.777              0.223