In michael-cw/SurveySolutionsCOVID19tools: Different Shiny Tools for CATI Surveys

## options
options(future.globals.maxSize=10000*1024^2)
options(java.parameters = "- Xmx5g")
options(shiny.maxRequestSize=6000*1024^2)
## styles
smTab<-list(dom="tp")

.sbframe-commentary .flexfill-container {
  width: 500px important!;
}

Column {.sidebar data-width=300}

h3("Sampling Frame")
h5("Only CSV files!")
helpText("File requirements:",br(),
         "1. Single .csv file", br(),
         "2. Frame file must only contain complete obserevations.", br(),
         "3. Categorical variables should be provided as character.", br(),
         "4. Double and Integer as numeric.")
## 1. File Upload
zipFileInput(id = "framefile",label = "Upload Frame Data", accept = (c("text/csv", ".csv")))
frameFile<-callModule(zipFile, "framefile")
## 2. Select Mode
radioButtons("methodselect", "Select Approach", choices = c("SamplingStrata"=1, "Cube Sample"=2), selected = 1, inline = T)
## Sampling Strata Inputs
conditionalPanel("input.methodselect==1",
                 samplingStrataInput(id = "updateStratInputs")
)

conditionalPanel("input.methodselect==2",
                 samplingCubeInput(id = "updateCubeInputs")
)
## Sampling Strata Settings
numericInput("sampSEED", "Set Seed",value = floor(runif(1, 1000,9999)), min=0, step = 1)
conditionalPanel("input.methodselect==1",
                 numericInput("minStrat", "Minimum Units/Strata", value = 2, min=0, step = 1),
                 numericInput("nBins", "Number of Bins for continous", value = 3, min=0, step = 1, max=50)
)

radioButtons("reGenesees", "Enhanced Simulation with ReGenesees?", c("Yes"=1, "No"=2), selected = 2, inline = T)

observeEvent(input$reGenesees, {
  if (input$reGenesees==1) {
    showModal(modalDialog(
      title = "Attention!",
      "For this purpose you require the ReGenesees package installed. If that is not the case, please got to: https://www.istat.it/en/methods-and-tools/methods-and-it-tools/process/processing-tools/regenesees",
      easyClose = TRUE,
      footer = NULL
    ))
  }
})

Sample Upload

observe({
  FF<-frameFile()
  shiny::validate(need(FF, message = "Upload .csv file first!"))
  if(input$methodselect==1){ 
    callModule(samplingStrataOutput, "updateStratInputs", dataset = FF)
  } else if (input$methodselect==2) {
    callModule(samplingCubeOutput, "updateCubeInputs", dataset = FF) 
  }
})
## Correlation Matrix
plotly::renderPlotly({
  FF<<-frameFile()
  shiny::validate(need(FF, message = "Upload .csv file first!"))
  ## Correlation Matrix for numeric values
  tokeep <- which(sapply(FF,is.numeric))
  FF<-FF[ ,tokeep, with=FALSE]
  XX<-stats::cor(FF)
  ## drop NA row/columns
  XX<-XX[, colSums(is.na(XX)) != (nrow(XX)-1)]
  XX<-XX[rowSums(is.na(XX)) != (ncol(XX)),]
  plotly::plot_ly(z=XX, type = "heatmap", 
                  colors = RColorBrewer::brewer.pal(10, "RdYlBu"))%>%
    plotly::layout(
      xaxis = list(
        ticktext = colnames(XX), 
        tickvals = 1:length(colnames(XX)),
        tickmode = "array"
      ),
      yaxis = list(
        ticktext = rownames(XX), 
        tickvals = 1:length(rownames(XX)),
        tickmode = "array"
      ))
})

---

After loading the data, and selection of the input variables, click the start button. This will iniate the sampling process, and present the results under the Sampling Properties section.

#startButtonUI("startStrat")
conditionalPanel("input.methodselect==1",
                 samplingStrataInput_para("hotinputs")
)
conditionalPanel("input.methodselect==2",
                 samplingCubeUI("cubeStart")
)

## 1. Stratified Sampling
str_all_inputs<-callModule(samplingStrataOutput_para, "hotinputs",
                           dataset = frameFile(),
                           target_var = reactive(input$`updateStratInputs-target_var`),
                           domain_var = reactive(input$`updateStratInputs-domain_var`))
## 1.1 collect variables in observer listening to start stratification
start_strat<-reactiveVal(); target_var<-reactiveVal(); domain_var<-reactiveVal(); strat_var_cat<-reactiveVal(); strat_var_cont<-reactiveVal(); minStrat<-reactiveVal(); frame_CV_in<-reactiveVal()
## 1.2. run the observer w. reactive vals
observeEvent(input$`hotinputs-start_strat`, {
  start_strat(input$`hotinputs-start_strat`)
  target_var(input$`updateStratInputs-target_var`)
  domain_var(input$`updateStratInputs-domain_var`)
  strat_var_cat(input$`updateStratInputs-strat_var_cat`)
  strat_var_cont(input$`updateStratInputs-strat_var_cont`)
  minStrat(input$minStrat)
  frame_CV_in(str_all_inputs$frame_CV_in())
})


## 3. Run simulation
finalSample<-callModule(samplingStrataSRV, "stratStart",
                        dataset = frameFile(),
                        frame_CV_in = frame_CV_in,
                        start_strat = start_strat,
                        target_var = target_var,
                        domain_var = domain_var,
                        strat_var_cat = strat_var_cat,
                        strat_var_cont = strat_var_cont,
                        nBins = reactive(input$nBins),
                        seed = reactive(input$sampSEED),
                        minStrat = minStrat)
# 2. Cube Sampling
finSampCube<-callModule(samplingCubeSRV,
                        "cubeStart",
                        dataset = frameFile(),
                        seed = reactive(input$sampSEED),
                        target_var = reactive(({input$`updateCubeInputs-targetvar`})),
                        sampleSize = reactive({input$`updateCubeInputs-sampleSize`}),
                        balancedVariable = reactive({input$`updateCubeInputs-bal_var`}))

Sample Properties

conditionalPanel("input.methodselect==1",
                 simuDiagnosticUI("sstr_plots"))
conditionalPanel("input.methodselect==2",
                 simuDiagnosticUI("cube_plots")
)

callModule(simuDiagnosticSRV,
           "cube_plots",
           dataset = finSampCube$final())

callModule(simuDiagnosticSRV,
           "sstr_plots",
           dataset = finalSample$final())

---

actionButton("dwl_sample_rep", "Download Sampling Report", width = "100%")

br()
br()
DT::renderDataTable({
  if(isolate(input$methodselect)==1){
    tab<<-data.table(finalSample$finalDesign())
    tab<-tab[ ,.(n_strata=.N,
               n_sample=sum(SOLUZ)), by = .(DOM1)]
    tab[,DOM1:=as.character(DOM1)]
    total<-data.table(DOM1="Total", n_strata=sum(tab[["n_strata"]]),
                      n_sample = sum(tab[["n_sample"]]))
    tab<-rbindlist(list(total, tab), fill = T)
    DT::datatable(tab, rownames = F, 
                  options = list(smTab$dom,
                                 scrollX = TRUE)) %>%
      DT::formatRound(1:length(tab), 2)
  } else if (isolate(input$methodselect==2)) {
    tab = finSampCube$finalDesign()
    DT::datatable(tab, rownames = F, 
                  options = list(smTab$dom,
                                 scrollX = TRUE)) %>%
      DT::formatRound(1:length(tab), 2)
  }
})

Final Sample

DT::renderDataTable({
  if(isolate(input$methodselect)==1){
    DT::datatable(finalSample$finalSample())
  } else if (isolate(input$methodselect==2)) {
    DT::datatable(finSampCube$finalSample())
  }
})

---

r h3("Sample Download")

conditionalPanel("input.methodselect==1",
                 downloadBigUI("dwlframe", label = "Download Sample"))
conditionalPanel("input.methodselect==2",
                 downloadBigUI("dwlframeCube", label = "Download Sample"))

observe({
  FF<-frameFile()
  shiny::validate(need(FF, message = "Upload .csv file first!"))
  if(input$methodselect==1) {
    callModule(downloadBig, "dwlframe", modid = "dwlframe",
               frame_data = finalSample$finalFrame(),
               design = finalSample$finalDesign(),
               sample = finalSample$finalSample(),
               seed = reactive(input$sampSEED))

  } else if (input$methodselect==2) {
    callModule(downloadBig, "dwlframeCube", modid = "dwlframeCube",
               frame_data = finSampCube$finalFrame(),
               design = finSampCube$finalDesign(),
               sample = finSampCube$finalSample(),
               seed = reactive(input$sampSEED))
  }

})

### Survey Solutions Assignment
## put here the table with sample
# DT::renderDataTable({
#     DT::datatable(finalSample())
#   })

---

r h3("Survey Solutions Assignment")

michael-cw/SurveySolutionsCOVID19tools documentation built on Oct. 4, 2022, 10:34 a.m.