inst/shiny/app.R

library(shiny)
library(shinythemes)
library(moments)

# Sample dataset generator
generate_sample_data <- function(N = 400) {
  set.seed(123)
  X_pop <- runif(N, 5, 15)
  Y_pop <- 10 + 2 * X_pop + rnorm(N, sd = 2)
  data.frame(X = X_pop, Y = Y_pop)
}

ui <- fluidPage(
  theme = shinytheme("cerulean"),

  tags$style(HTML("
    .btn-primary {
      background-color: #007bff;
      border-color: #007bff;
      font-weight: bold;
      font-size: 16px;
      width: 100%;
      margin-top: 10px;
    }
    .well {
      background-color: #f5faff;
      border-radius: 8px;
      padding: 15px;
      box-shadow: 0 0 12px rgba(0,123,255,0.2);
    }
    h4 {
      color: #004085;
      font-weight: 700;
      margin-bottom: 15px;
    }
    .footer {
      margin-top: 30px;
      padding-top: 15px;
      font-size: 14px;
      color: #555555;
    }
    .footer a {
      color: #004085;
      text-decoration: none;
      font-weight: 600;
    }
  ")),

  titlePanel(
    div(style = "color: #004085; font-weight: 700; font-size: 18px; text-align:center;",
        " Estimation of Finite Population Total under Complex Sampling Design viz. SRSWOR")
  ),

  sidebarLayout(
    sidebarPanel(
      class = "well",
      numericInput("pop_size", "Population Size (N):", value = 400, min = 10),
      numericInput("sample_size", "Sample Size (n):", value = 40, min = 1),
      numericInput("sim_no", "Number of Simulations:", value = 500, min = 10),
      numericInput("seed", "Random Seed:", value = 123),

      fileInput("upload_data", "Upload CSV file (with columns X and Y):",
                accept = c(".csv")),

      downloadButton("downloadSample", "Download Sample Dataset"),

      actionButton("runSim", "Run Simulation", class = "btn-primary"),

      width = 4
    ),

    mainPanel(
      tabsetPanel(
        tabPanel("Results",
                 h4("Simulation Results"),
                 tableOutput("resultsTable")),
        tabPanel("Download",
                 h4("Download Simulation Results"),
                 downloadButton("downloadReport", "Download Results (.csv)"))
      ),

      div(class = "footer",
          tags$hr(),
          tags$div(
            align = "center",
            tags$strong("Developed by Nobin Ch Paul, ICAR-NIASM, Baramati"),
            tags$br(),
            "Contact email: ", tags$a(href = "mailto:nobin.icar@gmail.com", "nobin.icar@gmail.com")
          )
      )
    )
  )
)

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

  user_data <- reactive({
    req(input$pop_size)

    if (!is.null(input$upload_data)) {
      df <- read.csv(input$upload_data$datapath)
      validate(
        need(all(c("X", "Y") %in% names(df)), "Uploaded data must have columns: X and Y")
      )
      return(df)
    } else {
      return(generate_sample_data(N = input$pop_size))
    }
  })

  sim_results <- eventReactive(input$runSim, {
    data <- user_data()
    surveySimR::survey_sim_est(Y = data$Y, X = data$X, n = input$sample_size,
                               SimNo = input$sim_no, seed = input$seed)
  })

  output$resultsTable <- renderTable({
    req(sim_results())
    sim_results()
  }, striped = TRUE, hover = TRUE, bordered = TRUE)

  output$downloadSample <- downloadHandler(
    filename = function() {
      "sample_dataset.csv"
    },
    content = function(file) {
      write.csv(generate_sample_data(), file, row.names = FALSE)
    }
  )

  output$downloadReport <- downloadHandler(
    filename = function() {
      paste0("survey_simulation_results_", Sys.Date(), ".csv")
    },
    content = function(file) {
      write.csv(sim_results(), file, row.names = TRUE)
    }
  )
}

shinyApp(ui = ui, server = server)

Try the surveySimR package in your browser

Any scripts or data that you put into this service are public.

surveySimR documentation built on June 8, 2025, 10:37 a.m.