Last active
March 16, 2023 03:27
-
-
Save Brendan-Schuetze/a267af9560eb2eb333374b1c427eea0d to your computer and use it in GitHub Desktop.
Cohen's d Viz
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #################################################### | |
| # Cohen's d Viz and Practice Tool | |
| # Author: Brendan A. Schuetze (https://schu.etze.co) | |
| # Paper: https://psyarxiv.com/ncsvd | |
| #################################################### | |
| library(shiny) | |
| library(shinyjs) | |
| library(ggplot2) | |
| # Record guessing errors for computing mean (bias) and standard deviation | |
| errors <- c() | |
| # This is the main plotting function which draws the two distributions | |
| getPlot <- function(Cohens_d, SD) { | |
| sd_i <- SD | |
| coh_d <- Cohens_d | |
| x <- seq(-1 * sd_i * 4.5, sd_i * 4.5, by = 0.01) | |
| y <- dnorm(x, sd = sd_i) | |
| z <- data.frame(x, y) | |
| blue_p <- ggplot(data = z, aes(x, y)) + | |
| #geom_line(size = 1.25) + | |
| geom_area(fill = "blue", alpha = 0.5, color = NA, lwd = 0) + | |
| geom_area(aes(x = x + coh_d * sd_i), fill = "red", alpha = 0.5, color = NA, lwd = 0) + | |
| theme_classic() + | |
| xlim(min(x - 4), max(x + 4)) + | |
| xlab("") + ylab("") + | |
| theme_classic() + | |
| theme(axis.text.x=element_blank(), | |
| axis.ticks.x=element_blank(), | |
| axis.text.y=element_blank(), | |
| axis.ticks.y=element_blank()) + | |
| theme(legend.position="none") + | |
| theme( | |
| panel.background = element_rect(fill='transparent'), #transparent panel bg | |
| plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg | |
| panel.grid.major = element_blank(), #remove major gridlines | |
| panel.grid.minor = element_blank(), #remove minor gridlines | |
| legend.background = element_rect(fill='transparent'), #transparent legend bg | |
| legend.box.background = element_rect(fill='transparent'), #transparent legend panel | |
| axis.line = element_blank()) | |
| blue_p | |
| } | |
| # Define UI for application that draws a histogram | |
| ui <- fluidPage( | |
| useShinyjs(), | |
| # Application title | |
| titlePanel("Cohen's d Visualization"), | |
| # Sidebar with a slider input for number of bins | |
| sidebarLayout( | |
| sidebarPanel( | |
| sliderInput("Cohens_d", | |
| "Cohen's d:", | |
| min = 0, | |
| max = 2, | |
| value = 0.5, | |
| step = 0.05), | |
| sliderInput("SD", | |
| "SD / Aspect Ratio", | |
| min = 0.50, | |
| max = 2.50, | |
| value = 1, | |
| step = 0.25), | |
| textInput("Guess", label = "My Guess"), | |
| actionButton(inputId = "Submit", "Submit Guess"), | |
| actionButton(inputId = "Randomize", "Randomize"), | |
| actionButton(inputId = "Hide", "Hide/Show Sliders"), | |
| br(), br(), | |
| strong("See also:"), | |
| br(), | |
| a("Schuetze & Yan (2022)", href = "https://psyarxiv.com/ncsvd"), | |
| br(), | |
| a("Magnusson's Cohen's d Visualization", href = "https://rpsychologist.com/cohend/") | |
| ), | |
| # Show a plot of the generated distribution | |
| mainPanel( | |
| plotOutput("distPlot"), | |
| span(textOutput("feedbackText"), style = "text-align:center; font-size: 16px; font-weight: bold;"), | |
| span(textOutput("errorVal"), style = "text-align:center; margin-top:10px; font-size: 12px; font-weight: bold;"), | |
| ) | |
| ) | |
| ) | |
| # Define server logic required to draw a histogram | |
| server <- function(input, output) { | |
| fb_text <- reactiveVal() | |
| error_text <- reactiveVal() | |
| shinyjs::hide("Guess") | |
| shinyjs::hide("Submit") | |
| observeEvent(input$Randomize, { | |
| updateSliderInput(inputId = "Cohens_d", value = runif(n = 1, min = 0, max = 2)) | |
| updateSliderInput(inputId = "SD", value = runif(n = 1, min = 0.50, max = 2.50)) | |
| fb_text("") | |
| br() | |
| error_text("") | |
| }) | |
| observeEvent(input$Submit, { | |
| errors <<- c(errors, round(as.numeric(input$Guess) - as.numeric(input$Cohens_d), 2)) | |
| fb_text(paste("Correct Answer:", round(input$Cohens_d, 2))) | |
| # Only report error statistics after minimum number of guesses | |
| if(length(errors) > 2) { | |
| error_text(paste("Bias (+ overestimating / - underestimating):", round(mean(errors, na.rm = TRUE), 2), ":: Mean Absolute Error:", round(mean(abs(errors), na.rm = TRUE), 2))) | |
| } | |
| }) | |
| output$feedbackText <- renderText(fb_text()) | |
| output$errorVal <- renderText(error_text()) | |
| observeEvent(input$Hide, { | |
| shinyjs::toggle(id = "Cohens_d", asis = TRUE) | |
| shinyjs::toggle(id = "SD", asis = TRUE) | |
| shinyjs::toggle("Guess") | |
| shinyjs::toggle("Submit") | |
| }) | |
| output$distPlot <- renderPlot({ | |
| getPlot(input$Cohens_d, input$SD) | |
| }, res = 96) | |
| } | |
| # Run the application | |
| shinyApp(ui = ui, server = server) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment