inst/shiny/app.R

In SampleSizeCalculator: Sample Size Calculator under Complex Survey Design

library(shiny)
library(SampleSizeCalculator)
library(DT)
library(shinythemes)
library(bslib)

# --------------------
# UI
# --------------------
ui <- navbarPage(
  theme = shinytheme("flatly"),
  title = div(
    strong("Sample Size Calculator", style = "color:#2c3e50; font-size:24px; font-weight:bold;"),
    ),

  # Include custom CSS to change navbar background
  header = tags$head(
    tags$style(HTML("
      .navbar-default {
        background-color: #EAF2F8 !important;  /* light background */
        border-color: #EAF2F8 !important;
      }
      .navbar-default .navbar-nav > li > a {
        color: #2c3e50 !important;           /* tab text color */
        font-weight: bold;
      }
      .navbar-default .navbar-brand {
        color: #2c3e50 !important;           /* title text color */
      }
      .navbar-default .navbar-nav > .active > a {
        background-color: #AED6F1 !important; /* active tab color */
        color: #1B2631 !important;
      }
    "))
  ),

  # ---- Tab 1: SRS - Mean ----
  tabPanel("SRS - Mean",
           sidebarLayout(
             sidebarPanel(
               h4("Inputs", style = "color:#2c3e50; font-weight:bold;"),
               selectInput("mean_cv_known", "Is CV Known?", choices = c("TRUE", "FALSE")),
               conditionalPanel(
                 condition = "input.mean_cv_known == 'TRUE'",
                 numericInput("mean_cv_value", "Enter the known CV value:", value = NA, min = 0)
               ),
               selectInput("mean_replace", "Sampling Design",
                           choices = c("Without Replacement" = FALSE, "With Replacement" = TRUE)),
               numericInput("mean_alpha", "Significance Level (alpha)", value = 0.05, min = 0, max = 1, step = 0.01),
               numericInput("mean_re", "Relative Error", value = 0.2, min = 0),
               numericInput("mean_N", "Population Size (NA for With Replacement)", value = NA, step = 1),
               fileInput("mean_samplefile", "Upload Preliminary Sample Data (CSV)", accept = ".csv"),
               downloadButton("download_mean_sample", "Download Preliminary Sample Data Template", class = "btn btn-info"),
               br(), br(),
               actionButton("calc_mean", "Calculate Sample Size", class = "btn btn-primary btn-lg")
             ),
             mainPanel(
               h4("Results", style = "color:#2c3e50; font-weight:bold"),
               verbatimTextOutput("mean_result"),
               tags$div(
                 style = "background:linear-gradient(135deg,#f0f9ff,#cce7ff);
                          border-radius:10px; padding:15px; margin:10px 0;
                          box-shadow:0 0 10px rgba(0,0,0,0.05);",
                 h4("💡 Why Use This App?", style="margin-top:0;"),
                 tags$ul(
                   tags$li("⚡ Get sample sizes instantly without complex formulas"),
                   tags$li("📊 Built-in methods for Simple Random Sampling and Stratified Random Sampling"),
                   tags$li("📂 Use your own preliminary sample datasets"),
                   tags$li("🌐 Works fully in your browser — no coding needed"),
                   tags$li("🎯 Ideal for researchers, students, and analysts")
                 )
               ),
               h5("Sample Data Preview:"),
               DTOutput("mean_sample")
             )
           )),

  # ---- Tab 2: SRS - Proportion ----
  tabPanel("SRS - Proportion",
           sidebarLayout(
             sidebarPanel(
               h4("Inputs", style = "color:#2c3e50; font-weight:bold;"),
               selectInput("prop_replace", "Sampling Design",
                           choices = c("Without Replacement" = FALSE, "With Replacement" = TRUE)),
               numericInput("prop_alpha", "Significance Level (alpha)", value = 0.05, min = 0, max = 1, step = 0.01),
               numericInput("prop_re", "Relative Error", value = 0.2, min = 0),
               numericInput("prop_N", "Population Size (NA for With Replacement)", value = NA, step = 1),
               fileInput("prop_samplefile", "Upload Preliminary Sample Data (CSV: 0/1)", accept = ".csv"),
               downloadButton("download_prop_sample", "Download Preliminary Sample Data Template", class = "btn btn-info"),
               br(), br(),
               actionButton("calc_prop", "Calculate Sample Size", class = "btn btn-success btn-lg")
             ),
             mainPanel(
               h4("Results", style = "color:#2c3e50; font-weight:bold"),
               verbatimTextOutput("prop_result"),
               tags$div(
                 style = "background:linear-gradient(135deg,#f0f9ff,#cce7ff);
                          border-radius:10px; padding:15px; margin:10px 0;
                          box-shadow:0 0 10px rgba(0,0,0,0.05);",
                 h4("💡 Why Use This App?", style="margin-top:0;"),
                 tags$ul(
                   tags$li("⚡ Calculate sample size for binary data"),
                   tags$li("📊 Handles both with and without replacement sampling design"),
                   tags$li("📂 Load your own preliminary survey binary dataset"),
                   tags$li("🎯 Perfect for surveys with binary outcome variables")
                 )
               ),
               h5("Sample Data Preview:"),
               DTOutput("prop_sample")
             )
           )),

  # ---- Tab 3: Stratified Sampling ----
  tabPanel("Stratified Sampling",
           sidebarLayout(
             sidebarPanel(
               h4("Inputs", style = "color:#2c3e50; font-weight:bold;"),
               selectInput("str_allocation", "Allocation Method",
                           choices = c("Equal", "Proportional", "Neyman", "Optimum")),
               numericInput("str_n", "Total Sample Size", value = 100, min = 1),
               textInput("str_size", "Strata Sizes (comma-separated)", value = "500,300,200"),
               textInput("str_sd", "Strata Standard Deviations (comma-separated; to be provided for Neyman & Optimum Allocation)", value = "10,20,30"),
               textInput("str_cost", "Strata Costs (comma-separated; to be provided only for Optimum Allocation)", value = "5,10,15"),
               # downloadButton("download_str_sample", "Download Sample Data", class = "btn btn-info"),#
               br(), br(),
               actionButton("calc_str", "Allocate Sample Size", class = "btn btn-warning btn-lg")
             ),
             mainPanel(
               h4("Results", style = "color:#2c3e50; font-weight:bold"),
               verbatimTextOutput("str_result"),
               tags$div(
                 style = "background:linear-gradient(135deg,#f0f9ff,#cce7ff);
                          border-radius:10px; padding:15px; margin:10px 0;
                          box-shadow:0 0 10px rgba(0,0,0,0.05);",
                 h4("💡 Why Use This App?", style="margin-top:0;"),
                 tags$ul(
                   tags$li("⚡ Calculate Strata-wise Sample Size under Stratified Sampling"),
                   tags$li("📊 Supports Equal, Proportional, Neyman & Optimum allocation"),
                   tags$li("📂 Just enter strata sizes, SDs, and costs"),
                   tags$li("🎯 Designed for complex survey designs")
                 )
               )
             )
           )),

  # ---- Footer ----
  footer = tagList(
    tags$hr(),
    tags$div(
      style = "text-align:center; font-size:14px; color:#555;",
      HTML(
        "Developed by <b>Dr. Nobin Ch Paul</b>, ICAR-NIASM, Baramati, Pune, MS, India and
         <b>Dr. Pradip Basak</b>, UBKV, Cooch Behar, West Bengal, India<br>
         Contact: <a href='mailto:nobin.icar@gmail.com'>nobin.icar@gmail.com</a> ; <a href='mailto:pradipbasak.99@gmail.com'>pradipbasak.99@gmail.com</a>"
      )
    ),
    br()
  )
)

# --------------------
# Server
# --------------------
server <- function(input, output, session) {

  # Download Handlers
  output$download_mean_sample <- downloadHandler(
    filename = function() { "sampledata_mean.csv" },
    file <- file.path(tempdir(), "sampledata_mean.csv"),
    content = function(file) {
      write.csv(data.frame(value = c(12,14,8,5,36,24,18,17,6,9)), file,row.names = FALSE)
    }
  )

  output$download_prop_sample <- downloadHandler(
    filename = function() { "sampledata_prop.csv" },
    file <- file.path(tempdir(), "sampledata_prop.csv"),
    content = function(file) {
      write.csv(data.frame(value = c(1,0,1,1,1,0,0,0,1,1)), file, row.names = FALSE)
    }
  )

  output$download_str_sample <- downloadHandler(
    filename = function() { "sampledata_strata.csv" },
    file <- file.path(tempdir(), "sampledata_strata.csv"),
    content = function(file) {
      write.csv(data.frame(
        Strata_Size = c(500,300,200),
        Strata_SD = c(10,20,30),
        Strata_Cost = c(5,10,15)
      ), file, row.names = FALSE)
    }
  )

  # SscSrsMean
  mean_data <- reactive({
    req(input$mean_samplefile)
    read.csv(input$mean_samplefile$datapath)
  })
  output$mean_sample <- renderDT({
    req(mean_data())
    datatable(head(mean_data(), 10), options = list(pageLength = 5))
  })
  observeEvent(input$calc_mean, {
    if (input$mean_cv_known == "TRUE") {
      result <- SscSrsMean(
        CV_known = TRUE,
        replace = as.logical(input$mean_replace),
        alpha = input$mean_alpha,
        re = input$mean_re,
        N = ifelse(is.na(input$mean_N), NA, input$mean_N),
        preliminary_sample = NULL,
        cv_value = input$mean_cv_value
      )
    } else {
      prelim <- as.numeric(unlist(mean_data()))
      result <- SscSrsMean(
        CV_known = FALSE,
        replace = as.logical(input$mean_replace),
        alpha = input$mean_alpha,
        re = input$mean_re,
        N = ifelse(is.na(input$mean_N), NA, input$mean_N),
        preliminary_sample = prelim
      )
    }
    output$mean_result <- renderPrint({ result })
  })

  # SscSrsProp
  prop_data <- reactive({
    req(input$prop_samplefile)
    read.csv(input$prop_samplefile$datapath)
  })
  output$prop_sample <- renderDT({
    req(prop_data())
    datatable(head(prop_data(), 10), options = list(pageLength = 5))
  })
  observeEvent(input$calc_prop, {
    prelim <- as.numeric(unlist(prop_data()))
    result <- SscSrsProp(
      replace = as.logical(input$prop_replace),
      alpha = input$prop_alpha,
      re = input$prop_re,
      N = ifelse(is.na(input$prop_N), NA, input$prop_N),
      preliminary_sample = prelim
    )
    output$prop_result <- renderPrint({ result })
  })

  # SscStr
  observeEvent(input$calc_str, {
    size <- as.numeric(unlist(strsplit(input$str_size, ",")))
    sd <- suppressWarnings(as.numeric(unlist(strsplit(input$str_sd, ","))))
    cost <- suppressWarnings(as.numeric(unlist(strsplit(input$str_cost, ","))))
    result <- SscStr(
      Allocation = input$str_allocation,
      n = input$str_n,
      Strata_Size = size,
      Strata_Standard_deviation = if (all(is.na(sd))) NA else sd,
      Strata_Cost = if (all(is.na(cost))) NA else cost
    )
    output$str_result <- renderPrint({ result })
  })
}

shinyApp(ui, server)