# The book's "Standardized Mean Difference" app, rebuilt on the DMAR package
# (the analysis companion to Designing Experiments and Analyzing Data) and
# themed with NDPalette. The estimate and confidence interval come from
# DMAR::smd() and DMAR::ci_smd(); the figures are painted with the
# scale_*_nd() colors (solid Notre Dame navy and gold).
#
# Requires the DMAR and shinyWidgets packages in addition to NDPalette,
# shiny, bslib, and ggplot2. Run with:
#   shiny::runApp(system.file("examples", "nd-smd-app", package = "NDPalette"))
library(shiny)
library(ggplot2)
library(DMAR)
library(NDPalette)
library(shinyWidgets)   # sliderTextInput, for labeled confidence-level stops

nd_theme <- bslib::bs_theme(
  version   = 5,
  bg        = nd_tints[["light_warm_white"]],   # a very subtle warm/yellow tint
  fg        = nd_color("navy"),
  primary   = nd_color("navy"),
  secondary = nd_color("bright_gold")
)

ui <- bslib::page_sidebar(
  theme = nd_theme,
  title = "Standardized Mean Difference",
  sidebar = bslib::sidebar(
    width = 300,
    textInput("Mean.1", "Mean for group 1", value = ".75"),
    textInput("Mean.2", "Mean for group 2", value = ".2"),
    textInput("s.1", "Standard deviation of group 1", value = "2.34"),
    textInput("s.2", "Standard deviation of group 2", value = "2.78"),
    numericInput("n.1", "Sample size for group 1", min = 2, value = 25, step = 1),
    numericInput("n.2", "Sample size for group 2", min = 2, value = 30, step = 1),
    radioButtons("ub", "Estimator",
                 c("Common" = FALSE, "Unbiased" = TRUE)),
    # Confidence level restricted to the values one would actually use;
    # grid = TRUE marks 80, 85, 90, 95, and 99 clearly on the slider.
    shinyWidgets::sliderTextInput(
      "cl", "Confidence level",
      choices = c("80%", "85%", "90%", "95%", "99%"),
      selected = "95%", grid = TRUE)
  ),
  bslib::layout_columns(
    col_widths = c(4, 4, 4),
    bslib::value_box(
      HTML("Standardized Mean Difference <span style='white-space:nowrap'>(<i>d</i>)</span>"),
      textOutput("d_box"), theme = "primary"),
    bslib::value_box("Lower limit", textOutput("lo_box"), theme = "secondary"),
    bslib::value_box("Upper limit", textOutput("hi_box"), theme = "secondary")
  ),
  bslib::layout_columns(
    col_widths = c(7, 5),
    bslib::card(
      bslib::card_header("The two distributions (assumed normal)"),
      plotOutput("dmar_plot", height = "320px")
    ),
    bslib::card(
      bslib::card_header("The estimate against Cohen's benchmarks"),
      plotOutput("bench", height = "320px")
    )
  ),
  bslib::card(
    bslib::card_header("Details"),
    verbatimTextOutput("details"),
    bslib::card_footer(
      "Effect size computed with ", tags$code("smd()"), ", ",
      tags$code("ci_smd()"), ", and ", tags$code("plot_smd()"),
      " from the DMAR package, the analysis companion to ",
      tags$em("Designing Experiments and Analyzing Data"),
      ". Themed with the NDPalette R package."
    )
  )
)

server <- function(input, output, session) {
  res <- reactive({
    m1 <- as.numeric(input$Mean.1); m2 <- as.numeric(input$Mean.2)
    s1 <- as.numeric(input$s.1);    s2 <- as.numeric(input$s.2)
    n1 <- input$n.1; n2 <- input$n.2
    cl <- as.numeric(sub("%", "", input$cl)) / 100   # "95%" -> 0.95
    validate(
      need(isTRUE(n1 > 1) && isTRUE(n2 > 1), "Sample sizes must exceed 1."),
      need(isTRUE(s1 > 0) && isTRUE(s2 > 0), "Standard deviations must be positive."),
      need(!is.na(m1) && !is.na(m2), "Means must be numbers.")
    )
    d_tbl <- DMAR::smd(mean_1 = m1, mean_2 = m2, s_1 = s1, s_2 = s2,
                       n_1 = n1, n_2 = n2, unbiased = as.logical(input$ub))
    d  <- d_tbl$value[d_tbl$term == "smd"]
    ci <- DMAR::ci_smd(smd = d, n_1 = n1, n_2 = n2, conf_level = cl)
    list(m1 = m1, m2 = m2, s1 = s1, s2 = s2, n1 = n1, n2 = n2, cl = cl,
         d = d,
         lo = ci$value[ci$term == "lower_limit"],
         hi = ci$value[ci$term == "upper_limit"])
  })

  output$d_box  <- renderText(sprintf("%.3f", res()$d))
  output$lo_box <- renderText(sprintf("%.3f", res()$lo))
  output$hi_box <- renderText(sprintf("%.3f", res()$hi))

  # The two distributions, drawn with SOLID Notre Dame navy and gold lines
  # (only a faint fill), so the dark navy reads as navy rather than washing
  # out to grey the way a half-transparent fill does.
  output$dmar_plot <- renderPlot({
    v   <- res()
    pal <- nd_palette(2)                                  # navy, bright gold
    lo  <- min(v$m1, v$m2) - 3.2 * max(v$s1, v$s2)
    hi  <- max(v$m1, v$m2) + 3.2 * max(v$s1, v$s2)
    xs  <- seq(lo, hi, length.out = 400)
    df  <- rbind(
      data.frame(x = xs, density = dnorm(xs, v$m1, v$s1), Group = "Group 1"),
      data.frame(x = xs, density = dnorm(xs, v$m2, v$s2), Group = "Group 2"))
    ggplot(df, aes(x, density, color = Group, fill = Group)) +
      geom_area(alpha = 0.12, position = "identity") +    # faint fill only
      geom_line(linewidth = 1.6) +                         # strong solid lines
      geom_vline(xintercept = c(v$m1, v$m2), color = pal,
                 linetype = 2, linewidth = 0.7) +
      scale_color_nd() + scale_fill_nd() +
      guides(fill = "none",
             color = guide_legend(override.aes = list(linewidth = 3))) +
      labs(subtitle = bquote("Standardized mean difference:" ~ italic(d) ~ "=" ~
                               .(sprintf("%.3f", v$d))),
           caption = paste0("Each curve is a normal distribution implied by that ",
                            "group's mean and SD\n(theoretical, not the empirical ",
                            "data)."),
           x = "outcome", y = "density", color = NULL) +
      theme_minimal(base_size = 14) +
      theme(legend.position = "top",
            plot.background  = element_rect(fill = "white", color = NA),
            panel.background = element_rect(fill = "white", color = NA))
  })

  # The estimate and CI against Cohen's small/medium/large benchmarks.
  output$bench <- renderPlot({
    v <- res()
    ggplot() +
      geom_vline(xintercept = 0, color = "grey70") +
      geom_vline(xintercept = c(.2, .5, .8, -.2, -.5, -.8),
                 color = nd_color("metallic_gold"), linetype = 3) +
      annotate("text", x = c(.2, .5, .8), y = 1.34,
               label = c("small", "medium", "large"),
               color = nd_color("dark_olive"), size = 3.4) +
      geom_segment(aes(x = v$lo, xend = v$hi, y = 1, yend = 1),
                   color = nd_color("navy"), linewidth = 1.5) +
      geom_point(aes(x = v$d, y = 1), color = nd_color("bright_gold"),
                 size = 5) +
      scale_y_continuous(limits = c(0.7, 1.5), breaks = NULL) +
      labs(x = expression(paste("standardized mean difference (", italic(d), ")")),
           y = NULL,
           subtitle = bquote(italic(d) ~ "=" ~ .(sprintf("%.3f", v$d)) * "," ~
                               .(sprintf("%g%% CI [%.3f, %.3f]",
                                         round(v$cl * 100), v$lo, v$hi)))) +
      theme_minimal(base_size = 13) +
      theme(plot.background = element_rect(fill = "white", color = NA))
  })

  output$details <- renderPrint({
    v <- res()
    cat(sprintf("Group 1:  mean = %s,  SD = %s,  n = %d\n", v$m1, v$s1, v$n1))
    cat(sprintf("Group 2:  mean = %s,  SD = %s,  n = %d\n\n", v$m2, v$s2, v$n2))
    cat(sprintf("Standardized mean difference (d): %.4f\n", v$d))
    cat(sprintf("%g%% confidence interval:          [%.4f, %.4f]\n",
                round(v$cl * 100), v$lo, v$hi))
    mag <- cut(abs(v$d), c(-Inf, .2, .5, .8, Inf),
               c("negligible", "small", "medium", "large"))
    cat(sprintf("\nApproximate magnitude (Cohen):    %s\n", as.character(mag)))
  })
}

shinyApp(ui, server)
