diff --git a/_posts/2024-09-09-wonderful-wednesdays-march-2024/images/.~lock.MOMS-PI Wolfinger - Russ Wolfinger.pptx# b/_posts/2024-09-09-wonderful-wednesdays-march-2024/images/.~lock.MOMS-PI Wolfinger - Russ Wolfinger.pptx# deleted file mode 100644 index 755906e..0000000 --- a/_posts/2024-09-09-wonderful-wednesdays-march-2024/images/.~lock.MOMS-PI Wolfinger - Russ Wolfinger.pptx# +++ /dev/null @@ -1 +0,0 @@ -,lorenz,lorenz-NUC8i5BEK,09.09.2024 21:20,file:///home/lorenz/.config/libreoffice/4; \ No newline at end of file diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/code/app - Steve Mallett.R b/_posts/2024-09-10-wonderful-wednesdays-april-2024/code/app - Steve Mallett.R new file mode 100644 index 0000000..c3d4340 --- /dev/null +++ b/_posts/2024-09-10-wonderful-wednesdays-april-2024/code/app - Steve Mallett.R @@ -0,0 +1,174 @@ +library(tidyverse) +library(cowplot) +library(ggtext) +library(stringr) + +ui <- fluidPage( + + # Application title + titlePanel("Power and Sample Size Tool"), + + # Sidebar with a slider input for number of bins + sidebarLayout( + sidebarPanel( + numericInput(inputId = "ALPHA", + label = h4("Alpha"), + value = 0.05, min = 0, max = 1), + numericInput(inputId = "SD", + label = h4("Standard deviation"), + value = 50), + numericInput(inputId = "TE", + label = h4("Average treatment difference (drug - placebo)"), + value = 15), + sliderInput(inputId = "N", + label = h4("Sample size (per arm)"), + min = 0, + max = 500, + value = 200, + step=10), + ), + + + + # Show a plot of the generated distribution + mainPanel( + plotOutput(outputId = "myPlot1" + , width = "800px", height = "1000px")) + ) + ) + +server <- function(input, output, session) { + + output$myPlot1 <- renderPlot({ + + n <- as.numeric(input$N) + sd <- as.numeric(input$SD) + alpha <- as.numeric(input$ALPHA) + te <- as.numeric(input$TE) + + sides <- 1 + se_diff = sqrt(2*(sd^2/n)) + power1 <- power.t.test(n = n, delta = te, sd = sd, sig.level = alpha, + power = NULL, + type = "two.sample", + alternative = "two.sided") + powern <- power1$power + powerc <- paste0("Power: ", round(powern, 2)*100, "%") + + # Null + mu_null <- 0 + lower_null <- -3 * se_diff + mu_null + upper_null <- 3 * se_diff + mu_null + crit_null <- qnorm(1-alpha/2, mean = mu_null, sd = se_diff) + crit <- paste0("Critical value: ", round(crit_null, 1)) + fpos <- paste0("False positive rate: ", round(alpha, 2)*100, "%") + fneg <- paste0("False negative rate: ", round(1-powern, 2)*100, "%") + x_null <- seq(lower_null, upper_null, length = 1000) + y_null <- dnorm(x_null, mu_null, se_diff) + df_null <- data.frame(cbind(x_null, y_null)) + + df_rej_null_r <- df_null %>% + filter(x_null > crit_null) %>% + arrange(desc(x_null)) + + df_rej_null_l <- df_null %>% + filter(x_null < crit_null*-1) %>% + arrange(x_null) + + temp_r <- data.frame(x_null = crit_null, y_null = df_rej_null_r$y_null[1]) + temp_l <- data.frame(x_null = crit_null*-1, y_null = df_rej_null_l$y_null[1]) + df_rej_null_r <- rbind(temp_r, df_rej_null_r) + df_rej_null_l <- rbind(temp_l, df_rej_null_l) + + # Alternative + mu_alt <- te + lower_alt <- -3 * se_diff + mu_alt + upper_alt <- 3 * se_diff + mu_alt + x_alt <- seq(lower_alt, upper_alt, length = 1000) + y_alt <- dnorm(x_alt, mu_alt, se_diff) + df_alt <- data.frame(cbind(x_alt, y_alt)) + + df_rej_alt_l <- df_alt %>% + filter(x_alt < crit_null) %>% + arrange(x_alt) + + temp <- data.frame(x_alt = crit_null, y_alt = df_rej_alt_l$y_alt[1]) + df_rej_alt_l2 <- rbind(df_rej_alt_l, temp) + + df_rej_alt_r <- df_alt %>% + filter(x_alt > crit_null) %>% + arrange(desc(x_alt)) + + temp <- data.frame(x_alt = crit_null, y_alt = df_rej_alt_r$y_alt[1]) + df_rej_alt_r2 <- rbind(temp, df_rej_alt_r) + + + + gnull <- ggplot(df_null, aes(x = x_null, y = y_null)) + + geom_polygon(data = df_null, color="black", fill="white") + + geom_polygon(data = df_rej_null_r, color="black", fill="#fb6a4a", alpha=0.9) + + geom_polygon(data = df_rej_null_l, color="black", fill="#fb6a4a", alpha=0.9) + + geom_segment(x=crit_null, xend=crit_null, y=y_null[1], yend=y_null[500], color="#2b8cbe", linetype="dashed") + + geom_segment(x=mu_null, xend=mu_null, y=0, yend=y_null[500], color="black", linetype="dotted") + + scale_x_continuous(limits = c(lower_null, upper_alt)) + + theme(plot.title = element_markdown(colour = "#636363", size = 12), + panel.background=element_blank(), + axis.line.x=element_line(color="black"), + axis.line.y=element_blank(), + axis.ticks.x=element_line(color="black"), + axis.ticks.y=element_blank(), + axis.title=element_blank(), + axis.text.y=element_blank(), + axis.text.x=element_text(color="black", size=20)) + + annotate("text", x = lower_null, y = y_null[500]*1.1, color="#252525", label = "Null Hypothesis", hjust=0, size=8) + + annotate("text", x = crit_null+upper_alt/80, y = y_null[500]*0.6, color="#2b8cbe", label = crit, hjust=0, size=8) + + annotate("text", x = crit_null+upper_alt/80, y = y_null[500]*0.5, color="#fb6a4a", label = fpos, hjust=0, size=8) + + galt <- ggplot(df_alt, aes(x = x_alt, y = y_alt)) + + geom_polygon(data = df_alt, color="black", fill="white") + + geom_polygon(data = df_rej_alt_r2, color="black", fill="#74c476") + + geom_polygon(data = df_rej_alt_l2, color="black", fill="#fb6a4a") + + geom_segment(x=crit_null, xend=crit_null, y=y_alt[1], yend=y_alt[500], color="#2b8cbe", linetype="dashed") + + geom_segment(x=mu_alt, xend=mu_alt, y=0, yend=y_alt[500], color="black", linetype="dotted") + + scale_x_continuous("Treatment Effect: (treatment - placebo)", + limits = c(lower_null, upper_alt)) + + theme(panel.background=element_blank(), + axis.line.x=element_line(color="#252525"), + axis.line.y=element_blank(), + axis.ticks.x=element_line(color="#252525"), + axis.ticks.y=element_blank(), + axis.title.x=element_text(color="#252525", size=20), + axis.title.y=element_blank(), + axis.text.y=element_blank(), + axis.text.x=element_text(color="#252525", size=20)) + + annotate("text", x = lower_null, y = y_null[500]*0.9, color="#252525", label = "Alternative Hypothesis", hjust=0, size=8) + + annotate("text", x = lower_null, y = y_null[500]*0.6, color="#238b45", label = powerc, hjust=0, size=8) + + annotate("text", x = lower_null, y = y_null[500]*0.5, color="#fb6a4a", label = fneg, hjust=0, size=8) + + + title0 <- ggdraw() + draw_label("Test title", size = 22) + plot_grid(gnull, galt, ncol=1, rel_heights = c(50, 50), align = "v") + + }) + + output$myPlot2 <- renderPlot({ + + df <- data.frame(matrix(nrow=1, ncol = 1)) + names(df) <- "percentage" + df$percentage <- power + df <- df %>% mutate(label = paste0(round(percentage, 2)*100, "%")) + + ggplot(data=df) + + geom_rect(aes(ymax=1, ymin=0, xmax=2, xmin=1), fill ="#ece8bd") + + geom_rect(aes(ymax = percentage, ymin = 0, xmax = 2, xmin = 1), fill = "#74c476") + + coord_polar(theta = "y",start=-pi/2) + xlim(c(0, 2)) + ylim(c(0,2)) + + geom_text(aes(x = 0, y = 0, label = label), colour="#74c476", size=14) + + # geom_text(aes(x=1.5, y=1.5), label="Power", size=4.2) + + theme_void() + + # scale_colour_manual(values = c("red"="#C9146C", "orange"="#DA9112", "green"="#129188")) + + theme(strip.background = element_blank(), + strip.text.x = element_blank()) + }) +} + +shinyApp(ui, server) \ No newline at end of file diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/code/power - T M.R b/_posts/2024-09-10-wonderful-wednesdays-april-2024/code/power - T M.R new file mode 100644 index 0000000..15ce7e9 --- /dev/null +++ b/_posts/2024-09-10-wonderful-wednesdays-april-2024/code/power - T M.R @@ -0,0 +1,60 @@ +# Wonderful Wednesday +# Statistical Power + +# by Tom Marlow + + +# T-test that shows poewr to detcet difference of 5 ot 8% in EF + +# Assumptions + +library(tidyverse) +library(pwr) + +fn_pwr <- function(n, d) { + power <- pwr.t.test(n = n, + d = d, + sig.level = 0.05, + alternative = "two.sided", + type = "two.sample")$power + return(power * 100) +} + +ssize = c(2:12) +msd <- tibble(effect = rep(c(6, 8, 10), each = 3), + sd_inc = rep(c(1, 1.25, 1.5), 3)) %>% + mutate(sd = 4 * sd_inc) %>% + mutate(delta = effect / sd) + +pwr_tab <- tibble(effect = factor(rep(msd$effect, each = length(ssize)), + levels = c(6, 8, 10), + labels = c("6%", "8%", "10%")), + sd_inc = as.factor(rep(msd$sd_inc, each = length(ssize))), + n = rep(ssize, length(msd$delta)), + d = rep(msd$delta, each = length(ssize))) %>% + mutate(power = fn_pwr(n, d)) + +pwr_fig <- ggplot(data = pwr_tab, + aes(x = n, y = power, colour = sd_inc)) + + geom_line() + + geom_hline(yintercept = 80) + + geom_line(linewidth = 1) + + scale_x_continuous(breaks = ssize, name = "Sample size") + + scale_y_continuous(breaks = seq(0, 100, by = 20)) + + labs( + y = "Power (%)", + title = "Power to detect deltas of 6, 8 and 10% in ejection fraction", + subtitles = "Two-sided, two-sample t-test, alpha=0.05, sd=4", + colour = "SD increase" + ) + + geom_point(size = 2, shape = 21, fill = "white") + + theme_bw() + + theme( + axis.text = element_text(size = 10), + axis.title = element_text(size = 12), + panel.grid.minor = element_blank(), + legend.position = "bottom") + + scale_colour_viridis_d() + + facet_wrap(effect ~ .) + +pwr_fig diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/WW April 2024 Steve Mallett - Steve Mallett.txt b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/WW April 2024 Steve Mallett - Steve Mallett.txt new file mode 100644 index 0000000..f201181 --- /dev/null +++ b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/WW April 2024 Steve Mallett - Steve Mallett.txt @@ -0,0 +1,7 @@ +April 2024 Wonderful Wednesday + +Author: Steve Mallett + +Link: + +https://steve-mallett.shinyapps.io/WWApr24Power/ \ No newline at end of file diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/g_power_1.jpg b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/g_power_1.jpg new file mode 100644 index 0000000..e6eee65 Binary files /dev/null and b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/g_power_1.jpg differ diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/g_power_2.jpg b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/g_power_2.jpg new file mode 100644 index 0000000..727cb3c Binary files /dev/null and b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/g_power_2.jpg differ diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/power - T M.jpg b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/power - T M.jpg new file mode 100644 index 0000000..d19248f Binary files /dev/null and b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/power - T M.jpg differ diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/shiny_app.jpg b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/shiny_app.jpg new file mode 100644 index 0000000..c92d60c Binary files /dev/null and b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/shiny_app.jpg differ diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/statulator_tool.jpg b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/statulator_tool.jpg new file mode 100644 index 0000000..402a67c Binary files /dev/null and b/_posts/2024-09-10-wonderful-wednesdays-april-2024/images/statulator_tool.jpg differ diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/wonderful-wednesdays-april-2024.Rmd b/_posts/2024-09-10-wonderful-wednesdays-april-2024/wonderful-wednesdays-april-2024.Rmd new file mode 100644 index 0000000..a013f22 --- /dev/null +++ b/_posts/2024-09-10-wonderful-wednesdays-april-2024/wonderful-wednesdays-april-2024.Rmd @@ -0,0 +1,354 @@ +--- +title: "Wonderful Wednesdays April 2024" +description: | + As statisticians, we often have to deal with power or sample size calculations. It can be very beneficial to visualise the impact that different factors have on the sample size or power. Produce data visualisation(s) or share tools that help your audience understand how power and sample size calculations work and what impacts the actual results of these calculations. +author: + - name: PSI VIS SIG + url: https://www.psiweb.org/sigs-special-interest-groups/visualisation +date: 04-10-2024 +categories: + - Power Calculations + - Wonderful Wednesdays +base_url: https://vis-sig.github.io/blog +preview: ./images/power - T M.jpg +output: + distill::distill_article: + self_contained: false +--- + + +# Power and sample size calculations + +Background: + +As statisticians, we often have to deal with power or sample size calculations. It can be very beneficial to visualise the impact that different factors have on the sample size or power. + +Challenge: + +Produce data visualisation(s) or share tools that help your audience understand how power and sample size calculations work and what impacts the actual results of these calculations. + +You can pick a design with + +- any number of treatment groups +- a continuous, categorical/binary, or survival endpoint +- any kind of a null hypothesis (leading, for example, to a superiority or non-inferiority test) + + +A description of the challenge can be found [here](https://github.com/VIS-SIG/Wonderful-Wednesdays/tree/master/data/2024/2024-03-13). +A recording of the session can be found [here](https://psiweb.org/vod/item/psi-vissig-wonderful-wednesday-49-explain-power). + + + +## Example 1. Shiny App + +![](./images/shiny_app.jpg) +The app can be found [here](https://steve-mallett.shinyapps.io/WWApr24Power/). + +[link to code](#example1 code) + + + + +## Example 2. Statulator Tool + +![](./images/statulator_tool.jpg) +The tool can be found [here](https://statulator.com/SampleSize/ss2M.html#/). + +[link to code](#example2 code) + + + +## Example 3. Trellised Power Curves + +![](./images/power - T M.jpg) +[high resolution image](./images/power - T M.jpg) + +[link to code](#example3 code) + + + +## Example 4. Power Analysis Software + +![](./images/g_power_1.jpg) +![](./images/g_power_2.jpg) + +The software can be found [here](https://www.psychologie.hhu.de/arbeitsgruppen/allgemeine-psychologie-und-arbeitspsychologie/gpower). + +[link to code](#example4 code) + + +# Code + + + +## Example 1. Shiny App + +```{r, echo = TRUE, eval=FALSE, python.reticulate = FALSE} +library(tidyverse) +library(cowplot) +library(ggtext) +library(stringr) + +ui <- fluidPage( + + # Application title + titlePanel("Power and Sample Size Tool"), + + # Sidebar with a slider input for number of bins + sidebarLayout( + sidebarPanel( + numericInput(inputId = "ALPHA", + label = h4("Alpha"), + value = 0.05, min = 0, max = 1), + numericInput(inputId = "SD", + label = h4("Standard deviation"), + value = 50), + numericInput(inputId = "TE", + label = h4("Average treatment difference (drug - placebo)"), + value = 15), + sliderInput(inputId = "N", + label = h4("Sample size (per arm)"), + min = 0, + max = 500, + value = 200, + step=10), + ), + + + + # Show a plot of the generated distribution + mainPanel( + plotOutput(outputId = "myPlot1" + , width = "800px", height = "1000px")) + ) + ) + +server <- function(input, output, session) { + + output$myPlot1 <- renderPlot({ + + n <- as.numeric(input$N) + sd <- as.numeric(input$SD) + alpha <- as.numeric(input$ALPHA) + te <- as.numeric(input$TE) + + sides <- 1 + se_diff = sqrt(2*(sd^2/n)) + power1 <- power.t.test(n = n, delta = te, sd = sd, sig.level = alpha, + power = NULL, + type = "two.sample", + alternative = "two.sided") + powern <- power1$power + powerc <- paste0("Power: ", round(powern, 2)*100, "%") + + # Null + mu_null <- 0 + lower_null <- -3 * se_diff + mu_null + upper_null <- 3 * se_diff + mu_null + crit_null <- qnorm(1-alpha/2, mean = mu_null, sd = se_diff) + crit <- paste0("Critical value: ", round(crit_null, 1)) + fpos <- paste0("False positive rate: ", round(alpha, 2)*100, "%") + fneg <- paste0("False negative rate: ", round(1-powern, 2)*100, "%") + x_null <- seq(lower_null, upper_null, length = 1000) + y_null <- dnorm(x_null, mu_null, se_diff) + df_null <- data.frame(cbind(x_null, y_null)) + + df_rej_null_r <- df_null %>% + filter(x_null > crit_null) %>% + arrange(desc(x_null)) + + df_rej_null_l <- df_null %>% + filter(x_null < crit_null*-1) %>% + arrange(x_null) + + temp_r <- data.frame(x_null = crit_null, y_null = df_rej_null_r$y_null[1]) + temp_l <- data.frame(x_null = crit_null*-1, y_null = df_rej_null_l$y_null[1]) + df_rej_null_r <- rbind(temp_r, df_rej_null_r) + df_rej_null_l <- rbind(temp_l, df_rej_null_l) + + # Alternative + mu_alt <- te + lower_alt <- -3 * se_diff + mu_alt + upper_alt <- 3 * se_diff + mu_alt + x_alt <- seq(lower_alt, upper_alt, length = 1000) + y_alt <- dnorm(x_alt, mu_alt, se_diff) + df_alt <- data.frame(cbind(x_alt, y_alt)) + + df_rej_alt_l <- df_alt %>% + filter(x_alt < crit_null) %>% + arrange(x_alt) + + temp <- data.frame(x_alt = crit_null, y_alt = df_rej_alt_l$y_alt[1]) + df_rej_alt_l2 <- rbind(df_rej_alt_l, temp) + + df_rej_alt_r <- df_alt %>% + filter(x_alt > crit_null) %>% + arrange(desc(x_alt)) + + temp <- data.frame(x_alt = crit_null, y_alt = df_rej_alt_r$y_alt[1]) + df_rej_alt_r2 <- rbind(temp, df_rej_alt_r) + + + + gnull <- ggplot(df_null, aes(x = x_null, y = y_null)) + + geom_polygon(data = df_null, color="black", fill="white") + + geom_polygon(data = df_rej_null_r, color="black", fill="#fb6a4a", alpha=0.9) + + geom_polygon(data = df_rej_null_l, color="black", fill="#fb6a4a", alpha=0.9) + + geom_segment(x=crit_null, xend=crit_null, y=y_null[1], yend=y_null[500], color="#2b8cbe", linetype="dashed") + + geom_segment(x=mu_null, xend=mu_null, y=0, yend=y_null[500], color="black", linetype="dotted") + + scale_x_continuous(limits = c(lower_null, upper_alt)) + + theme(plot.title = element_markdown(colour = "#636363", size = 12), + panel.background=element_blank(), + axis.line.x=element_line(color="black"), + axis.line.y=element_blank(), + axis.ticks.x=element_line(color="black"), + axis.ticks.y=element_blank(), + axis.title=element_blank(), + axis.text.y=element_blank(), + axis.text.x=element_text(color="black", size=20)) + + annotate("text", x = lower_null, y = y_null[500]*1.1, color="#252525", label = "Null Hypothesis", hjust=0, size=8) + + annotate("text", x = crit_null+upper_alt/80, y = y_null[500]*0.6, color="#2b8cbe", label = crit, hjust=0, size=8) + + annotate("text", x = crit_null+upper_alt/80, y = y_null[500]*0.5, color="#fb6a4a", label = fpos, hjust=0, size=8) + + galt <- ggplot(df_alt, aes(x = x_alt, y = y_alt)) + + geom_polygon(data = df_alt, color="black", fill="white") + + geom_polygon(data = df_rej_alt_r2, color="black", fill="#74c476") + + geom_polygon(data = df_rej_alt_l2, color="black", fill="#fb6a4a") + + geom_segment(x=crit_null, xend=crit_null, y=y_alt[1], yend=y_alt[500], color="#2b8cbe", linetype="dashed") + + geom_segment(x=mu_alt, xend=mu_alt, y=0, yend=y_alt[500], color="black", linetype="dotted") + + scale_x_continuous("Treatment Effect: (treatment - placebo)", + limits = c(lower_null, upper_alt)) + + theme(panel.background=element_blank(), + axis.line.x=element_line(color="#252525"), + axis.line.y=element_blank(), + axis.ticks.x=element_line(color="#252525"), + axis.ticks.y=element_blank(), + axis.title.x=element_text(color="#252525", size=20), + axis.title.y=element_blank(), + axis.text.y=element_blank(), + axis.text.x=element_text(color="#252525", size=20)) + + annotate("text", x = lower_null, y = y_null[500]*0.9, color="#252525", label = "Alternative Hypothesis", hjust=0, size=8) + + annotate("text", x = lower_null, y = y_null[500]*0.6, color="#238b45", label = powerc, hjust=0, size=8) + + annotate("text", x = lower_null, y = y_null[500]*0.5, color="#fb6a4a", label = fneg, hjust=0, size=8) + + + title0 <- ggdraw() + draw_label("Test title", size = 22) + plot_grid(gnull, galt, ncol=1, rel_heights = c(50, 50), align = "v") + + }) + + output$myPlot2 <- renderPlot({ + + df <- data.frame(matrix(nrow=1, ncol = 1)) + names(df) <- "percentage" + df$percentage <- power + df <- df %>% mutate(label = paste0(round(percentage, 2)*100, "%")) + + ggplot(data=df) + + geom_rect(aes(ymax=1, ymin=0, xmax=2, xmin=1), fill ="#ece8bd") + + geom_rect(aes(ymax = percentage, ymin = 0, xmax = 2, xmin = 1), fill = "#74c476") + + coord_polar(theta = "y",start=-pi/2) + xlim(c(0, 2)) + ylim(c(0,2)) + + geom_text(aes(x = 0, y = 0, label = label), colour="#74c476", size=14) + + # geom_text(aes(x=1.5, y=1.5), label="Power", size=4.2) + + theme_void() + + # scale_colour_manual(values = c("red"="#C9146C", "orange"="#DA9112", "green"="#129188")) + + theme(strip.background = element_blank(), + strip.text.x = element_blank()) + }) +} + +shinyApp(ui, server) +``` + + +[Back to blog](#example1) + + + + + +## Example 2. Statulator Tool + +No code available. + + +[Back to blog](#example2) + + + + +## Example 3. Trellised Power Curves + +```{r, echo = TRUE, eval=FALSE} +# Wonderful Wednesday +# Statistical Power + +# by Tom Marlow + + +# T-test that shows poewr to detcet difference of 5 ot 8% in EF + +# Assumptions + +library(tidyverse) +library(pwr) + +fn_pwr <- function(n, d) { + power <- pwr.t.test(n = n, + d = d, + sig.level = 0.05, + alternative = "two.sided", + type = "two.sample")$power + return(power * 100) +} + +ssize = c(2:12) +msd <- tibble(effect = rep(c(6, 8, 10), each = 3), + sd_inc = rep(c(1, 1.25, 1.5), 3)) %>% + mutate(sd = 4 * sd_inc) %>% + mutate(delta = effect / sd) + +pwr_tab <- tibble(effect = factor(rep(msd$effect, each = length(ssize)), + levels = c(6, 8, 10), + labels = c("6%", "8%", "10%")), + sd_inc = as.factor(rep(msd$sd_inc, each = length(ssize))), + n = rep(ssize, length(msd$delta)), + d = rep(msd$delta, each = length(ssize))) %>% + mutate(power = fn_pwr(n, d)) + +pwr_fig <- ggplot(data = pwr_tab, + aes(x = n, y = power, colour = sd_inc)) + + geom_line() + + geom_hline(yintercept = 80) + + geom_line(linewidth = 1) + + scale_x_continuous(breaks = ssize, name = "Sample size") + + scale_y_continuous(breaks = seq(0, 100, by = 20)) + + labs( + y = "Power (%)", + title = "Power to detect deltas of 6, 8 and 10% in ejection fraction", + subtitles = "Two-sided, two-sample t-test, alpha=0.05, sd=4", + colour = "SD increase" + ) + + geom_point(size = 2, shape = 21, fill = "white") + + theme_bw() + + theme( + axis.text = element_text(size = 10), + axis.title = element_text(size = 12), + panel.grid.minor = element_blank(), + legend.position = "bottom") + + scale_colour_viridis_d() + + facet_wrap(effect ~ .) + +pwr_fig +``` + +[Back to blog](#example3) + + + + +## Example 4. Power Analysis Software + +No code available. + +[Back to blog](#example4) \ No newline at end of file diff --git a/_posts/2024-09-10-wonderful-wednesdays-april-2024/wonderful-wednesdays-april-2024.html b/_posts/2024-09-10-wonderful-wednesdays-april-2024/wonderful-wednesdays-april-2024.html new file mode 100644 index 0000000..af643cb --- /dev/null +++ b/_posts/2024-09-10-wonderful-wednesdays-april-2024/wonderful-wednesdays-april-2024.html @@ -0,0 +1,1825 @@ + + + + +
+ + + + + + + + + + + + + + + +As statisticians, we often have to deal with power or sample size +calculations. It can be very beneficial to visualise the impact that +different factors have on the sample size or power. Produce data +visualisation(s) or share tools that help your audience understand how +power and sample size calculations work and what impacts the actual +results of these calculations.
+Background:
+As statisticians, we often have to deal with power or sample size +calculations. It can be very beneficial to visualise the impact that +different factors have on the sample size or power.
+Challenge:
+Produce data visualisation(s) or share tools that help your audience +understand how power and sample size calculations work and what impacts +the actual results of these calculations.
+You can pick a design with
+A description of the challenge can be found here.
+A recording of the session can be found here.
+The app can be found here.
+The tool can be found here.
+
The software can be found here.
+ +library(tidyverse)
+library(cowplot)
+library(ggtext)
+library(stringr)
+
+ui <- fluidPage(
+
+ # Application title
+ titlePanel("Power and Sample Size Tool"),
+
+ # Sidebar with a slider input for number of bins
+ sidebarLayout(
+ sidebarPanel(
+ numericInput(inputId = "ALPHA",
+ label = h4("Alpha"),
+ value = 0.05, min = 0, max = 1),
+ numericInput(inputId = "SD",
+ label = h4("Standard deviation"),
+ value = 50),
+ numericInput(inputId = "TE",
+ label = h4("Average treatment difference (drug - placebo)"),
+ value = 15),
+ sliderInput(inputId = "N",
+ label = h4("Sample size (per arm)"),
+ min = 0,
+ max = 500,
+ value = 200,
+ step=10),
+ ),
+
+
+ # Show a plot of the generated distribution
+ mainPanel(
+ plotOutput(outputId = "myPlot1"
+ , width = "800px", height = "1000px"))
+ )
+ )
+
+server <- function(input, output, session) {
+
+ output$myPlot1 <- renderPlot({
+
+ n <- as.numeric(input$N)
+ sd <- as.numeric(input$SD)
+ alpha <- as.numeric(input$ALPHA)
+ te <- as.numeric(input$TE)
+
+ sides <- 1
+ se_diff = sqrt(2*(sd^2/n))
+ power1 <- power.t.test(n = n, delta = te, sd = sd, sig.level = alpha,
+ power = NULL,
+ type = "two.sample",
+ alternative = "two.sided")
+ powern <- power1$power
+ powerc <- paste0("Power: ", round(powern, 2)*100, "%")
+
+ # Null
+ mu_null <- 0
+ lower_null <- -3 * se_diff + mu_null
+ upper_null <- 3 * se_diff + mu_null
+ crit_null <- qnorm(1-alpha/2, mean = mu_null, sd = se_diff)
+ crit <- paste0("Critical value: ", round(crit_null, 1))
+ fpos <- paste0("False positive rate: ", round(alpha, 2)*100, "%")
+ fneg <- paste0("False negative rate: ", round(1-powern, 2)*100, "%")
+ x_null <- seq(lower_null, upper_null, length = 1000)
+ y_null <- dnorm(x_null, mu_null, se_diff)
+ df_null <- data.frame(cbind(x_null, y_null))
+
+ df_rej_null_r <- df_null %>%
+ filter(x_null > crit_null) %>%
+ arrange(desc(x_null))
+
+ df_rej_null_l <- df_null %>%
+ filter(x_null < crit_null*-1) %>%
+ arrange(x_null)
+
+ temp_r <- data.frame(x_null = crit_null, y_null = df_rej_null_r$y_null[1])
+ temp_l <- data.frame(x_null = crit_null*-1, y_null = df_rej_null_l$y_null[1])
+ df_rej_null_r <- rbind(temp_r, df_rej_null_r)
+ df_rej_null_l <- rbind(temp_l, df_rej_null_l)
+
+ # Alternative
+ mu_alt <- te
+ lower_alt <- -3 * se_diff + mu_alt
+ upper_alt <- 3 * se_diff + mu_alt
+ x_alt <- seq(lower_alt, upper_alt, length = 1000)
+ y_alt <- dnorm(x_alt, mu_alt, se_diff)
+ df_alt <- data.frame(cbind(x_alt, y_alt))
+
+ df_rej_alt_l <- df_alt %>%
+ filter(x_alt < crit_null) %>%
+ arrange(x_alt)
+
+ temp <- data.frame(x_alt = crit_null, y_alt = df_rej_alt_l$y_alt[1])
+ df_rej_alt_l2 <- rbind(df_rej_alt_l, temp)
+
+ df_rej_alt_r <- df_alt %>%
+ filter(x_alt > crit_null) %>%
+ arrange(desc(x_alt))
+
+ temp <- data.frame(x_alt = crit_null, y_alt = df_rej_alt_r$y_alt[1])
+ df_rej_alt_r2 <- rbind(temp, df_rej_alt_r)
+
+
+
+ gnull <- ggplot(df_null, aes(x = x_null, y = y_null)) +
+ geom_polygon(data = df_null, color="black", fill="white") +
+ geom_polygon(data = df_rej_null_r, color="black", fill="#fb6a4a", alpha=0.9) +
+ geom_polygon(data = df_rej_null_l, color="black", fill="#fb6a4a", alpha=0.9) +
+ geom_segment(x=crit_null, xend=crit_null, y=y_null[1], yend=y_null[500], color="#2b8cbe", linetype="dashed") +
+ geom_segment(x=mu_null, xend=mu_null, y=0, yend=y_null[500], color="black", linetype="dotted") +
+ scale_x_continuous(limits = c(lower_null, upper_alt)) +
+ theme(plot.title = element_markdown(colour = "#636363", size = 12),
+ panel.background=element_blank(),
+ axis.line.x=element_line(color="black"),
+ axis.line.y=element_blank(),
+ axis.ticks.x=element_line(color="black"),
+ axis.ticks.y=element_blank(),
+ axis.title=element_blank(),
+ axis.text.y=element_blank(),
+ axis.text.x=element_text(color="black", size=20)) +
+ annotate("text", x = lower_null, y = y_null[500]*1.1, color="#252525", label = "Null Hypothesis", hjust=0, size=8) +
+ annotate("text", x = crit_null+upper_alt/80, y = y_null[500]*0.6, color="#2b8cbe", label = crit, hjust=0, size=8) +
+ annotate("text", x = crit_null+upper_alt/80, y = y_null[500]*0.5, color="#fb6a4a", label = fpos, hjust=0, size=8)
+
+ galt <- ggplot(df_alt, aes(x = x_alt, y = y_alt)) +
+ geom_polygon(data = df_alt, color="black", fill="white") +
+ geom_polygon(data = df_rej_alt_r2, color="black", fill="#74c476") +
+ geom_polygon(data = df_rej_alt_l2, color="black", fill="#fb6a4a") +
+ geom_segment(x=crit_null, xend=crit_null, y=y_alt[1], yend=y_alt[500], color="#2b8cbe", linetype="dashed") +
+ geom_segment(x=mu_alt, xend=mu_alt, y=0, yend=y_alt[500], color="black", linetype="dotted") +
+ scale_x_continuous("Treatment Effect: (treatment - placebo)",
+ limits = c(lower_null, upper_alt)) +
+ theme(panel.background=element_blank(),
+ axis.line.x=element_line(color="#252525"),
+ axis.line.y=element_blank(),
+ axis.ticks.x=element_line(color="#252525"),
+ axis.ticks.y=element_blank(),
+ axis.title.x=element_text(color="#252525", size=20),
+ axis.title.y=element_blank(),
+ axis.text.y=element_blank(),
+ axis.text.x=element_text(color="#252525", size=20)) +
+ annotate("text", x = lower_null, y = y_null[500]*0.9, color="#252525", label = "Alternative Hypothesis", hjust=0, size=8) +
+ annotate("text", x = lower_null, y = y_null[500]*0.6, color="#238b45", label = powerc, hjust=0, size=8) +
+ annotate("text", x = lower_null, y = y_null[500]*0.5, color="#fb6a4a", label = fneg, hjust=0, size=8)
+
+
+ title0 <- ggdraw() + draw_label("Test title", size = 22)
+ plot_grid(gnull, galt, ncol=1, rel_heights = c(50, 50), align = "v")
+
+ })
+
+ output$myPlot2 <- renderPlot({
+
+ df <- data.frame(matrix(nrow=1, ncol = 1))
+ names(df) <- "percentage"
+ df$percentage <- power
+ df <- df %>% mutate(label = paste0(round(percentage, 2)*100, "%"))
+
+ ggplot(data=df) +
+ geom_rect(aes(ymax=1, ymin=0, xmax=2, xmin=1), fill ="#ece8bd") +
+ geom_rect(aes(ymax = percentage, ymin = 0, xmax = 2, xmin = 1), fill = "#74c476") +
+ coord_polar(theta = "y",start=-pi/2) + xlim(c(0, 2)) + ylim(c(0,2)) +
+ geom_text(aes(x = 0, y = 0, label = label), colour="#74c476", size=14) +
+ # geom_text(aes(x=1.5, y=1.5), label="Power", size=4.2) +
+ theme_void() +
+ # scale_colour_manual(values = c("red"="#C9146C", "orange"="#DA9112", "green"="#129188")) +
+ theme(strip.background = element_blank(),
+ strip.text.x = element_blank())
+ })
+}
+
+shinyApp(ui, server)
+
+No code available.
+ + +# Wonderful Wednesday
+# Statistical Power
+
+# by Tom Marlow
+
+
+# T-test that shows poewr to detcet difference of 5 ot 8% in EF
+
+# Assumptions
+
+library(tidyverse)
+library(pwr)
+
+fn_pwr <- function(n, d) {
+ power <- pwr.t.test(n = n,
+ d = d,
+ sig.level = 0.05,
+ alternative = "two.sided",
+ type = "two.sample")$power
+ return(power * 100)
+}
+
+ssize = c(2:12)
+msd <- tibble(effect = rep(c(6, 8, 10), each = 3),
+ sd_inc = rep(c(1, 1.25, 1.5), 3)) %>%
+ mutate(sd = 4 * sd_inc) %>%
+ mutate(delta = effect / sd)
+
+pwr_tab <- tibble(effect = factor(rep(msd$effect, each = length(ssize)),
+ levels = c(6, 8, 10),
+ labels = c("6%", "8%", "10%")),
+ sd_inc = as.factor(rep(msd$sd_inc, each = length(ssize))),
+ n = rep(ssize, length(msd$delta)),
+ d = rep(msd$delta, each = length(ssize))) %>%
+ mutate(power = fn_pwr(n, d))
+
+pwr_fig <- ggplot(data = pwr_tab,
+ aes(x = n, y = power, colour = sd_inc)) +
+ geom_line() +
+ geom_hline(yintercept = 80) +
+ geom_line(linewidth = 1) +
+ scale_x_continuous(breaks = ssize, name = "Sample size") +
+ scale_y_continuous(breaks = seq(0, 100, by = 20)) +
+ labs(
+ y = "Power (%)",
+ title = "Power to detect deltas of 6, 8 and 10% in ejection fraction",
+ subtitles = "Two-sided, two-sample t-test, alpha=0.05, sd=4",
+ colour = "SD increase"
+ ) +
+ geom_point(size = 2, shape = 21, fill = "white") +
+ theme_bw() +
+ theme(
+ axis.text = element_text(size = 10),
+ axis.title = element_text(size = 12),
+ panel.grid.minor = element_blank(),
+ legend.position = "bottom") +
+ scale_colour_viridis_d() +
+ facet_wrap(effect ~ .)
+
+pwr_fig
+
+No code available.
+ +
`,e.githubCompareUpdatesUrl&&(t+=`View all changes to this article since it was first published.`),t+=` + If you see mistakes or want to suggest changes, please create an issue on GitHub.
+ `);const n=e.journal;return'undefined'!=typeof n&&'Distill'===n.title&&(t+=` +Diagrams and text are licensed under Creative Commons Attribution CC-BY 4.0 with the source available on GitHub, unless noted otherwise. The figures that have been reused from other sources don’t fall under this license and can be recognized by a note in their caption: “Figure from …”.
+ `),'undefined'!=typeof e.publishedDate&&(t+=` +For attribution in academic contexts, please cite this work as
+${e.concatenatedAuthors}, "${e.title}", Distill, ${e.publishedYear}.+
BibTeX citation
+${m(e)}+ `),t}var An=Math.sqrt,En=Math.atan2,Dn=Math.sin,Mn=Math.cos,On=Math.PI,Un=Math.abs,In=Math.pow,Nn=Math.LN10,jn=Math.log,Rn=Math.max,qn=Math.ceil,Fn=Math.floor,Pn=Math.round,Hn=Math.min;const zn=['Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'],Bn=['Jan.','Feb.','March','April','May','June','July','Aug.','Sept.','Oct.','Nov.','Dec.'],Wn=(e)=>10>e?'0'+e:e,Vn=function(e){const t=zn[e.getDay()].substring(0,3),n=Wn(e.getDate()),i=Bn[e.getMonth()].substring(0,3),a=e.getFullYear().toString(),d=e.getUTCHours().toString(),r=e.getUTCMinutes().toString(),o=e.getUTCSeconds().toString();return`${t}, ${n} ${i} ${a} ${d}:${r}:${o} Z`},$n=function(e){const t=Array.from(e).reduce((e,[t,n])=>Object.assign(e,{[t]:n}),{});return t},Jn=function(e){const t=new Map;for(var n in e)e.hasOwnProperty(n)&&t.set(n,e[n]);return t};class Qn{constructor(e){this.name=e.author,this.personalURL=e.authorURL,this.affiliation=e.affiliation,this.affiliationURL=e.affiliationURL,this.affiliations=e.affiliations||[]}get firstName(){const e=this.name.split(' ');return e.slice(0,e.length-1).join(' ')}get lastName(){const e=this.name.split(' ');return e[e.length-1]}}class Gn{constructor(){this.title='unnamed article',this.description='',this.authors=[],this.bibliography=new Map,this.bibliographyParsed=!1,this.citations=[],this.citationsCollected=!1,this.journal={},this.katex={},this.publishedDate=void 0}set url(e){this._url=e}get url(){if(this._url)return this._url;return this.distillPath&&this.journal.url?this.journal.url+'/'+this.distillPath:this.journal.url?this.journal.url:void 0}get githubUrl(){return this.githubPath?'https://github.com/'+this.githubPath:void 0}set previewURL(e){this._previewURL=e}get previewURL(){return this._previewURL?this._previewURL:this.url+'/thumbnail.jpg'}get publishedDateRFC(){return Vn(this.publishedDate)}get updatedDateRFC(){return Vn(this.updatedDate)}get publishedYear(){return this.publishedDate.getFullYear()}get publishedMonth(){return Bn[this.publishedDate.getMonth()]}get publishedDay(){return this.publishedDate.getDate()}get publishedMonthPadded(){return Wn(this.publishedDate.getMonth()+1)}get publishedDayPadded(){return Wn(this.publishedDate.getDate())}get publishedISODateOnly(){return this.publishedDate.toISOString().split('T')[0]}get volume(){const e=this.publishedYear-2015;if(1>e)throw new Error('Invalid publish date detected during computing volume');return e}get issue(){return this.publishedDate.getMonth()+1}get concatenatedAuthors(){if(2
tag. We found the following text: '+t);const n=document.createElement('span');n.innerHTML=e.nodeValue,e.parentNode.insertBefore(n,e),e.parentNode.removeChild(e)}}}}).observe(this,{childList:!0})}}var Ti='undefined'==typeof window?'undefined'==typeof global?'undefined'==typeof self?{}:self:global:window,_i=f(function(e,t){(function(e){function t(){this.months=['jan','feb','mar','apr','may','jun','jul','aug','sep','oct','nov','dec'],this.notKey=[',','{','}',' ','='],this.pos=0,this.input='',this.entries=[],this.currentEntry='',this.setInput=function(e){this.input=e},this.getEntries=function(){return this.entries},this.isWhitespace=function(e){return' '==e||'\r'==e||'\t'==e||'\n'==e},this.match=function(e,t){if((void 0==t||null==t)&&(t=!0),this.skipWhitespace(t),this.input.substring(this.pos,this.pos+e.length)==e)this.pos+=e.length;else throw'Token mismatch, expected '+e+', found '+this.input.substring(this.pos);this.skipWhitespace(t)},this.tryMatch=function(e,t){return(void 0==t||null==t)&&(t=!0),this.skipWhitespace(t),this.input.substring(this.pos,this.pos+e.length)==e},this.matchAt=function(){for(;this.input.length>this.pos&&'@'!=this.input[this.pos];)this.pos++;return!('@'!=this.input[this.pos])},this.skipWhitespace=function(e){for(;this.isWhitespace(this.input[this.pos]);)this.pos++;if('%'==this.input[this.pos]&&!0==e){for(;'\n'!=this.input[this.pos];)this.pos++;this.skipWhitespace(e)}},this.value_braces=function(){var e=0;this.match('{',!1);for(var t=this.pos,n=!1;;){if(!n)if('}'==this.input[this.pos]){if(0 =k&&(++x,i=k);if(d[x]instanceof n||d[T-1].greedy)continue;w=T-x,y=e.slice(i,k),v.index-=i}if(v){g&&(h=v[1].length);var S=v.index+h,v=v[0].slice(h),C=S+v.length,_=y.slice(0,S),L=y.slice(C),A=[x,w];_&&A.push(_);var E=new n(o,u?a.tokenize(v,u):v,b,v,f);A.push(E),L&&A.push(L),Array.prototype.splice.apply(d,A)}}}}}return d},hooks:{all:{},add:function(e,t){var n=a.hooks.all;n[e]=n[e]||[],n[e].push(t)},run:function(e,t){var n=a.hooks.all[e];if(n&&n.length)for(var d,r=0;d=n[r++];)d(t)}}},i=a.Token=function(e,t,n,i,a){this.type=e,this.content=t,this.alias=n,this.length=0|(i||'').length,this.greedy=!!a};if(i.stringify=function(e,t,n){if('string'==typeof e)return e;if('Array'===a.util.type(e))return e.map(function(n){return i.stringify(n,t,e)}).join('');var d={type:e.type,content:i.stringify(e.content,t,n),tag:'span',classes:['token',e.type],attributes:{},language:t,parent:n};if('comment'==d.type&&(d.attributes.spellcheck='true'),e.alias){var r='Array'===a.util.type(e.alias)?e.alias:[e.alias];Array.prototype.push.apply(d.classes,r)}a.hooks.run('wrap',d);var l=Object.keys(d.attributes).map(function(e){return e+'="'+(d.attributes[e]||'').replace(/"/g,'"')+'"'}).join(' ');return'<'+d.tag+' class="'+d.classes.join(' ')+'"'+(l?' '+l:'')+'>'+d.content+''+d.tag+'>'},!t.document)return t.addEventListener?(t.addEventListener('message',function(e){var n=JSON.parse(e.data),i=n.language,d=n.code,r=n.immediateClose;t.postMessage(a.highlight(d,a.languages[i],i)),r&&t.close()},!1),t.Prism):t.Prism;var d=document.currentScript||[].slice.call(document.getElementsByTagName('script')).pop();return d&&(a.filename=d.src,document.addEventListener&&!d.hasAttribute('data-manual')&&('loading'===document.readyState?document.addEventListener('DOMContentLoaded',a.highlightAll):window.requestAnimationFrame?window.requestAnimationFrame(a.highlightAll):window.setTimeout(a.highlightAll,16))),t.Prism}();e.exports&&(e.exports=n),'undefined'!=typeof Ti&&(Ti.Prism=n),n.languages.markup={comment://,prolog:/<\?[\w\W]+?\?>/,doctype://i,cdata://i,tag:{pattern:/<\/?(?!\d)[^\s>\/=$<]+(?:\s+[^\s>\/=]+(?:=(?:("|')(?:\\\1|\\?(?!\1)[\w\W])*\1|[^\s'">=]+))?)*\s*\/?>/i,inside:{tag:{pattern:/^<\/?[^\s>\/]+/i,inside:{punctuation:/^<\/?/,namespace:/^[^\s>\/:]+:/}},"attr-value":{pattern:/=(?:('|")[\w\W]*?(\1)|[^\s>]+)/i,inside:{punctuation:/[=>"']/}},punctuation:/\/?>/,"attr-name":{pattern:/[^\s>\/]+/,inside:{namespace:/^[^\s>\/:]+:/}}}},entity:/?[\da-z]{1,8};/i},n.hooks.add('wrap',function(e){'entity'===e.type&&(e.attributes.title=e.content.replace(/&/,'&'))}),n.languages.xml=n.languages.markup,n.languages.html=n.languages.markup,n.languages.mathml=n.languages.markup,n.languages.svg=n.languages.markup,n.languages.css={comment:/\/\*[\w\W]*?\*\//,atrule:{pattern:/@[\w-]+?.*?(;|(?=\s*\{))/i,inside:{rule:/@[\w-]+/}},url:/url\((?:(["'])(\\(?:\r\n|[\w\W])|(?!\1)[^\\\r\n])*\1|.*?)\)/i,selector:/[^\{\}\s][^\{\};]*?(?=\s*\{)/,string:{pattern:/("|')(\\(?:\r\n|[\w\W])|(?!\1)[^\\\r\n])*\1/,greedy:!0},property:/(\b|\B)[\w-]+(?=\s*:)/i,important:/\B!important\b/i,function:/[-a-z0-9]+(?=\()/i,punctuation:/[(){};:]/},n.languages.css.atrule.inside.rest=n.util.clone(n.languages.css),n.languages.markup&&(n.languages.insertBefore('markup','tag',{style:{pattern:/(
+
+
+ ${e.map(l).map((e)=>`
`)}}const Mi=`
+d-citation-list {
+ contain: layout style;
+}
+
+d-citation-list .references {
+ grid-column: text;
+}
+
+d-citation-list .references .title {
+ font-weight: 500;
+}
+`;class Oi extends HTMLElement{static get is(){return'd-citation-list'}connectedCallback(){this.hasAttribute('distill-prerendered')||(this.style.display='none')}set citations(e){x(this,e)}}var Ui=f(function(e){var t='undefined'==typeof window?'undefined'!=typeof WorkerGlobalScope&&self instanceof WorkerGlobalScope?self:{}:window,n=function(){var e=/\blang(?:uage)?-(\w+)\b/i,n=0,a=t.Prism={util:{encode:function(e){return e instanceof i?new i(e.type,a.util.encode(e.content),e.alias):'Array'===a.util.type(e)?e.map(a.util.encode):e.replace(/&/g,'&').replace(/e.length)break tokenloop;if(!(y instanceof n)){c.lastIndex=0;var v=c.exec(y),w=1;if(!v&&f&&x!=d.length-1){if(c.lastIndex=i,v=c.exec(e),!v)break;for(var S=v.index+(g?v[1].length:0),C=v.index+v[0].length,T=x,k=i,p=d.length;T
+
+`);class Ni extends ei(Ii(HTMLElement)){renderContent(){if(this.languageName=this.getAttribute('language'),!this.languageName)return void console.warn('You need to provide a language attribute to your
Footnotes
+
+`,!1);class Fi extends qi(HTMLElement){connectedCallback(){super.connectedCallback(),this.list=this.root.querySelector('ol'),this.root.style.display='none'}set footnotes(e){if(this.list.innerHTML='',e.length){this.root.style.display='';for(const t of e){const e=document.createElement('li');e.id=t.id+'-listing',e.innerHTML=t.innerHTML;const n=document.createElement('a');n.setAttribute('class','footnote-backlink'),n.textContent='[\u21A9]',n.href='#'+t.id,e.appendChild(n),this.list.appendChild(e)}}else this.root.style.display='none'}}const Pi=ti('d-hover-box',`
+
+
+