Shiny app for normal distribution

normal-shiny.R

# Normal Distribution Explorer — exposes all parameters & base R functions

library(shiny)
library(ggplot2)

ui <- fluidPage(
  titlePanel("Normal Distribution Explorer"),
  sidebarLayout(
    sidebarPanel(
      h4("Parameters"),
      numericInput("mu", HTML("Mean (&mu;)"), value = 0, step = 0.1),
      radioButtons(
        "param_type", "Choose parameterization for dispersion:",
        c("Standard Deviation (σ)" = "sd",
          "Variance (σ²)" = "var",
          "Precision (τ = 1/σ²)" = "prec"),
        inline = FALSE
      ),
      conditionalPanel(
        "input.param_type == 'sd'",
        numericInput("sd", HTML("Standard deviation (&sigma;) > 0"), value = 1, min = 1e-9, step = 0.1)
      ),
      conditionalPanel(
        "input.param_type == 'var'",
        numericInput("var", HTML("Variance (&sigma;<sup>2</sup>) > 0"), value = 1, min = 1e-9, step = 0.1)
      ),
      conditionalPanel(
        "input.param_type == 'prec'",
        numericInput("prec", HTML("Precision (&tau; = 1/&sigma;<sup>2</sup>) > 0"), value = 1, min = 1e-9, step = 0.1)
      ),
      hr(),
      h4("Plot controls"),
      sliderInput("k", "x-range (μ ± k·σ)", min = 1, max = 6, value = 4, step = 1),
      sliderInput("npoints", "Plot resolution (points)", min = 101, max = 2001, value = 801, step = 100),
      helpText(HTML("Snapshot: displays all equivalent parameters below.")),
      verbatimTextOutput("param_snapshot", placeholder = TRUE)
    ),
    mainPanel(
      tabsetPanel(id = "tabs",
                  tabPanel("Density (dnorm)",
                           br(),
                           fluidRow(
                             column(6,
                                    numericInput("x0", "Evaluate density at x₀:", value = 0),
                                    checkboxInput("dnorm_log", "Return log-density (log = TRUE)", value = FALSE),
                                    strong("dnorm(x₀, μ, σ, log) ="),
                                    verbatimTextOutput("dnorm_val", placeholder = TRUE)
                             ),
                             column(6,
                                    numericInput("shade_a", "Shade probability between a and b (optional) — a:", value = NA),
                                    numericInput("shade_b", "b:", value = NA),
                                    helpText("If both a and b are provided with a < b, shaded area and value are shown below."),
                                    strong("P(a < X < b) ="),
                                    verbatimTextOutput("between_prob", placeholder = TRUE)
                             )
                           ),
                           plotOutput("densityPlot", height = "380px")
                  ),
                  tabPanel("Distribution / CDF (pnorm)",
                           br(),
                           fluidRow(
                             column(6,
                                    numericInput("q0", "Evaluate CDF at q₀:", value = 0),
                                    checkboxInput("pnorm_lower", "lower.tail = TRUE (P[X ≤ q])", value = TRUE),
                                    checkboxInput("pnorm_logp", "log.p = TRUE (return log-prob)", value = FALSE),
                                    strong("pnorm(q₀, μ, σ, lower.tail, log.p) ="),
                                    verbatimTextOutput("pnorm_val", placeholder = TRUE)
                             ),
                             column(6,
                                    numericInput("cdf_a", "Compute P(a < X < b) — a:", value = -1),
                                    numericInput("cdf_b", "b:", value = 1),
                                    strong("P(a < X < b) ="),
                                    verbatimTextOutput("cdf_between_val", placeholder = TRUE),
                                    helpText("This uses the standard tail (lower.tail = TRUE) and non-log scale.")
                             )
                           ),
                           plotOutput("cdfPlot", height = "380px")
                  ),
                  tabPanel("Quantile (qnorm)",
                           br(),
                           fluidRow(
                             column(6,
                                    numericInput("p", "Quantile level p:", value = 0.95),
                                    checkboxInput("qnorm_lower", "lower.tail = TRUE (quantile of left tail)", value = TRUE),
                                    checkboxInput("qnorm_logp", "log.p = TRUE (p is given on log scale)", value = FALSE),
                                    strong("qnorm(p, μ, σ, lower.tail, log.p) ="),
                                    verbatimTextOutput("qnorm_val", placeholder = TRUE),
                                    helpText("If log.p = TRUE, supply p on the log scale (≤ 0).")
                             ),
                             column(6,
                                    numericInput("p_show", "Also show x for p = (0.025, 0.5, 0.975): base (ignore log.p)", value = 0, min = 0, max = 1, step = NA),
                                    tableOutput("three_quantiles")
                             )
                           )
                  ),
                  tabPanel("Random Sample (rnorm)",
                           br(),
                           fluidRow(
                             column(6,
                                    numericInput("n", "Sample size (n):", value = 1000, min = 1, step = 1),
                                    numericInput("seed", "Seed (optional):", value = NA),
                                    sliderInput("bins", "Histogram bins:", min = 10, max = 120, value = 40),
                                    checkboxInput("show_rug", "Show rug marks", value = FALSE)
                             ),
                             column(6,
                                    strong("Sample summary:"),
                                    verbatimTextOutput("sample_summary", placeholder = TRUE)
                             )
                           ),
                           plotOutput("histPlot", height = "420px")
                  )
      )
    )
  )
)

server <- function(input, output, session) {
  
  # Resolve σ from the selected parameterization
  sigma <- reactive({
    if (input$param_type == "sd") {
      input$sd
    } else if (input$param_type == "var") {
      sqrt(input$var)
    } else {
      # precision τ = 1/σ^2  =>  σ = 1 / sqrt(τ)
      1 / sqrt(input$prec)
    }
  })
  
  # Validate parameters
  observe({
    if (!is.finite(sigma()) || sigma() <= 0) {
      showNotification("Dispersion must be positive and finite.", type = "error", duration = 5)
    }
  })
  
  # Parameter snapshot text
  output$param_snapshot <- renderText({
    mu  <- input$mu
    sd  <- sigma()
    var <- sd^2
    prec <- 1/var
    paste0(
      "μ = ", signif(mu, 6),
      "    σ = ", signif(sd, 6),
      "    σ² = ", signif(var, 6),
      "    τ = 1/σ² = ", signif(prec, 6)
    )
  })
  
  # X grid for plots
  xgrid <- reactive({
    sd <- sigma()
    mu <- input$mu
    k  <- input$k
    n  <- input$npoints
    seq(mu - k*sd, mu + k*sd, length.out = n)
  })
  
  # ---------- Density (dnorm) ----------
  output$dnorm_val <- renderText({
    validate(need(sigma() > 0, "σ must be > 0"))
    val <- dnorm(input$x0, mean = input$mu, sd = sigma(), log = isTRUE(input$dnorm_log))
    signif(val, 10)
  })
  
  output$between_prob <- renderText({
    a <- input$shade_a
    b <- input$shade_b
    if (is.na(a) || is.na(b) || !is.finite(a) || !is.finite(b) || a >= b) return("—")
    p <- pnorm(b, mean = input$mu, sd = sigma()) - pnorm(a, mean = input$mu, sd = sigma())
    signif(p, 10)
  })
  
  output$densityPlot <- renderPlot({
    validate(need(sigma() > 0, "σ must be > 0"))
    x <- xgrid()
    dens <- dnorm(x, mean = input$mu, sd = sigma(), log = isTRUE(input$dnorm_log))
    df <- data.frame(x = x, y = dens)
    g <- ggplot(df, aes(x, y)) +
      geom_line(linewidth = 1) +
      labs(x = "x",
           y = if (isTRUE(input$dnorm_log)) "log f(x)" else "f(x)",
           title = if (isTRUE(input$dnorm_log)) "Log-Density of Normal(μ, σ)" else "Density of Normal(μ, σ)") +
      theme_minimal(base_size = 13)
    # Shaded area if a < x < b supplied (only makes sense on non-log scale visually)
    a <- input$shade_a; b <- input$shade_b
    if (!isTRUE(input$dnorm_log) && is.finite(a) && is.finite(b) && !is.na(a) && !is.na(b) && a < b) {
      xs <- seq(max(min(x), a), min(max(x), b), length.out = 400)
      df_shade <- data.frame(xs = xs, ys = dnorm(xs, input$mu, sigma()))
      g <- g + geom_area(data = df_shade, aes(xs, ys), alpha = 0.2)
    }
    # Reference lines at μ and μ ± σ
    mu <- input$mu; sd <- sigma()
    g + geom_vline(xintercept = mu, linetype = 2) +
      geom_vline(xintercept = mu + sd, linetype = "dotted") +
      geom_vline(xintercept = mu - sd, linetype = "dotted")
  })
  
  # ---------- Distribution / CDF (pnorm) ----------
  output$pnorm_val <- renderText({
    validate(need(sigma() > 0, "σ must be > 0"))
    val <- pnorm(
      q = input$q0, mean = input$mu, sd = sigma(),
      lower.tail = isTRUE(input$pnorm_lower),
      log.p = isTRUE(input$pnorm_logp)
    )
    signif(val, 10)
  })
  
  output$cdf_between_val <- renderText({
    a <- input$cdf_a; b <- input$cdf_b
    if (!is.finite(a) || !is.finite(b) || a >= b) return("—")
    p <- pnorm(b, mean = input$mu, sd = sigma()) - pnorm(a, mean = input$mu, sd = sigma())
    signif(p, 10)
  })
  
  output$cdfPlot <- renderPlot({
    validate(need(sigma() > 0, "σ must be > 0"))
    x <- xgrid()
    Fv <- pnorm(x, mean = input$mu, sd = sigma(), lower.tail = TRUE, log.p = FALSE)
    df <- data.frame(x = x, F = Fv)
    ggplot(df, aes(x, F)) +
      geom_line(linewidth = 1) +
      labs(x = "x", y = "F(x) = P(X ≤ x)", title = "CDF of Normal(μ, σ)") +
      theme_minimal(base_size = 13) +
      geom_vline(xintercept = input$q0, linetype = 2)
  })
  
  # ---------- Quantile (qnorm) ----------
  output$qnorm_val <- renderText({
    validate(need(sigma() > 0, "σ must be > 0"))
    p <- input$p
    if (!isTRUE(input$qnorm_logp)) {
      validate(need(p >= 0 && p <= 1, "When log.p = FALSE, p must be in [0, 1]."))
    } else {
      validate(need(p <= 0, "When log.p = TRUE, p must be ≤ 0 (log-probability)."))
    }
    val <- qnorm(
      p = p, mean = input$mu, sd = sigma(),
      lower.tail = isTRUE(input$qnorm_lower),
      log.p = isTRUE(input$qnorm_logp)
    )
    signif(val, 10)
  })
  
  output$three_quantiles <- renderTable({
    # Always show standard left-tail (non-log) reference quantiles
    mu <- input$mu; sd <- sigma()
    qs <- c(0.025, 0.5, 0.975)
    xs <- qnorm(qs, mu, sd)
    data.frame(p = qs, quantile = signif(xs, 10))
  }, digits = 6, striped = TRUE, bordered = TRUE)
  
  # ---------- Random Sample (rnorm) ----------
  rvs <- reactive({
    validate(need(sigma() > 0, "σ must be > 0"))
    if (is.finite(input$seed)) set.seed(input$seed)
    rnorm(n = max(1, round(input$n)), mean = input$mu, sd = sigma())
  })
  
  output$sample_summary <- renderText({
    x <- rvs()
    ss <- c(
      n = length(x),
      mean = mean(x),
      sd = sd(x),
      min = min(x),
      q25 = quantile(x, 0.25),
      median = median(x),
      q75 = quantile(x, 0.75),
      max = max(x)
    )
    paste(capture.output(print(signif(ss, 6))), collapse = "\n")
  })
  
  output$histPlot <- renderPlot({
    x <- rvs()
    df <- data.frame(x = x)
    mu <- input$mu; sd <- sigma()
    gg <- ggplot(df, aes(x)) +
      geom_histogram(aes(y = after_stat(density)), bins = input$bins, alpha = 0.6) +
      stat_function(fun = dnorm, args = list(mean = mu, sd = sd), linewidth = 1) +
      labs(x = "x", y = "Density",
           title = "Histogram of Sample with Theoretical Normal Density") +
      theme_minimal(base_size = 13)
    if (isTRUE(input$show_rug)) {
      gg <- gg + geom_rug(alpha = 0.25)
    }
    gg
  })
}

shinyApp(ui, server)