Consider rate of outcome in non-exposed group in interpret_oddsratio #657
Description
The {interpret_oddsratio} function derives their rules (1.68, 3.47 and 6.71) from Chen et al. (2010). As Chen et al. explain, these thresholds are influenced by the outcome rate in the unexposed group, the current rules ignores that and assumes an outcome rate of 1% in that group.
The code below demonstrates that the current thresholds are overly conservative within the range of >0.1 to ~0.9 and insufficiently conservative at the extremes. It calculates thresholds across the full spectrum of possible baseline rates (>0 to <1). While Chen et al. provide odds ratio (OR) equivalents for Cohen’s d only within the range of 0.1 to 0.2, Kraemer (2004) provides the entire range. There are minor discrepancies between the calculated values and those reported by Chen et al. and Kraemer, typically on the second decimal place, but they grow more significant at the extreme margins (e.g., around 0.99999).
To address this, I implemented a possible solution that integrates the calculate_threshold function into the {interpret_oddsratio} function. By default, the baseline rate remains at 0.01, therefore no changes unless the p0 parameter is explicitly provided. I also updated the tests for the {interpret_oddsratio} function, as the rules argument is no longer the second parameter. However, since this is my first code contribution I would like to check for the things I missed (e.g. calculate_thresholds is not suppost to be inside the function) and at least one question (My changes in the manual do not show after the build, how to do that?).
library(dplyr)
library(ggplot2)
options(scipen=999)
calculate_thresholds <- function(p0, d = c(0.2,0.5,0.8)) {
z0 <- qnorm(p0)
z1 <- z0 + d
p1 <- pnorm(z1)
or <- (p1*(1-p0))/(p0*(1-p1))
return(or)
}
chen_2010 <- c(seq(0.01,0.1,0.01))
kraemer_2004 <- c(0.00001,0.0001,0.001,0.01,
seq(0.1,0.9,0.1),
0.99,0.999,0.9999,0.99999)
data_chen <- tibble()
for (i in chen_2010) {
or <- calculate_thresholds(i)
data_chen <- bind_rows(
data_chen,
bind_cols(
cohen_d = format(i),
effect_size_02 = or[1],
effect_size_05 = or[2],
effect_size_08 = or[3]
)
)
}
data_kraemer <- tibble()
data_plot <- tibble()
for (i in kraemer_2004) {
or <- calculate_thresholds(i)
data_kraemer <- bind_rows(
data_kraemer,
bind_cols(
cohen_d = format(i),
effect_size_02 = or[1],
effect_size_05 = or[2],
effect_size_08 = or[3]
)
)
data_plot <-
bind_rows(
data_plot,
bind_cols(cohen_d = format(i, nsmall = 3),effect_size = 0.2, odds_ratio = or[1]),
bind_cols(cohen_d = format(i, nsmall = 3),effect_size = 0.5, odds_ratio = or[2]),
bind_cols(cohen_d = format(i, nsmall = 3),effect_size = 0.8, odds_ratio = or[3])
)
}
ggplot(data_plot) +
geom_point(aes(x = cohen_d, y = odds_ratio, color = factor(effect_size))) +
geom_hline(yintercept = c(1.68,3.47,6.71), linetype = "dashed", color = c("#F8766D","#00BA38", "#619CFF")) +
theme_bw() +
labs(x = "Cohen´s d", y = "Odds ratio", color = "Effect size")