#' @title step7Server
#'
#' @description Server logic for the step #7 (Perform imputation) tab.
#' @author Jedid Ahn
#'
#' @param input Shiny input
#' @param output Shiny output
#' @param session Shiny session
#' @param rvStep5Results Reactive value list containing DF_DROPPED_COLS,
#' DF_DROPPED_ROWS, varNames, parNames, dataDF
#' @param rvStep6Results Reactive value list containing transDataDF, asIsDF,
#' DF_EXCLUDED_COLS
#' @param rvStep7Results Reactive value containing DF_PREPPED_DATA
#' @param rvVarDataTypes Reactive value list containing catVars, ordVars,
#' numVars, asIsVars, excludeVars
#'
step7Server <- function(input, output, session, rvStep5Results,
rvStep6Results, rvStep7Results, rvVarDataTypes){
sliderValues <- reactiveVal()
# Run this code as soon as step 6 is confirmed.
observeEvent(input$nextStep6, {
# Determine the default and max number of components to impute
# transDataDF on.
sliderValues(getNumComponents(input, rvStep6Results, rvVarDataTypes))
resetStep7(output, session, sliderValues())
})
# Disable slider input if user wants to skip the imputation step.
observeEvent(input$selectImputeOpt7, {
if (input$selectImputeOpt7 == "no"){
shinyjs::disable(id = "numComponents7")
}
else{
shinyjs::enable(id = "numComponents7")
}
})
# Perform imputation once confirmation button is clicked.
observeEvent(input$confirmImputation7, {
# Run imputation algorithm.
dataPreview <- rvStep7Results()
# Output truncated data frame for visualization.
output$dataDFOutput7 <- DT::renderDataTable({
DT::datatable(dataPreview, options = list(scrollX = TRUE))
})
# Disable radio buttons.
shinyjs::disable(id = "selectImputeOpt7")
# Disable slider input.
shinyjs::disable(id = "numComponents7")
# Disable confirm button.
shinyjs::disable(id = "confirmImputation7")
# Enable reset and export buttons.
shinyjs::enable(id = "confirmReset7")
shinyjs::enable(id = "exportDF")
})
# Reset button: Clear output.
observeEvent(input$confirmReset7, {
resetStep7(output, session, sliderValues())
})
# Export up to 4 data frames into the local environment, as long as
# they are not NULL.
observeEvent(input$exportDF, {
exported <- c("DF_PREPPED_DATA")
DF_PREPPED_DATA <- rvStep7Results()
assign("DF_PREPPED_DATA", DF_PREPPED_DATA, envir = globalenv())
DF_DROPPED_ROWS <- rvStep5Results()$DF_DROPPED_ROWS
if (!is.null(DF_DROPPED_ROWS)){
assign("DF_DROPPED_ROWS", DF_DROPPED_ROWS, envir = globalenv())
exported <- c(exported, "DF_DROPPED_ROWS")
}
DF_DROPPED_COLS <- rvStep5Results()$DF_DROPPED_COLS
if (!is.null(DF_DROPPED_COLS)){
assign("DF_DROPPED_COLS", DF_DROPPED_COLS, envir = globalenv())
exported <- c(exported, "DF_DROPPED_COLS")
}
DF_EXCLUDED_COLS <- rvStep6Results()$DF_EXCLUDED_COLS
if (!is.null(DF_EXCLUDED_COLS)){
assign("DF_EXCLUDED_COLS", DF_EXCLUDED_COLS, envir = globalenv())
exported <- c(exported, "DF_EXCLUDED_COLS")
}
shinyWidgets::sendSweetAlert(
session,
title = "SUCCESS",
text = tags$span(
"The following data frames were exported successfully: ",
tags$b(paste(exported, collapse = ", ")), ".",
tags$br(), tags$br(),
"Please close the app and click the stop button in the RStudio
console to view addition(s)."
),
type = "success",
btn_labels = "Ok",
btn_colors = "#5BC0DE"
)
})
}
# Helper function to avoid duplicate code.
resetStep7 <- function(output, session, sliderValues){
# Clear data frame preview.
output$dataDFOutput7 <- DT::renderDataTable(NULL)
# Enable radio buttons.
shinyjs::enable(id = "selectImputeOpt7")
# Reset selected radio button.
updateRadioButtons(
session,
"selectImputeOpt7",
label = "Impute data?",
choices = c("Yes" = "yes", "No" = "no"),
selected = NULL,
inline = TRUE
)
# Enable slider input.
shinyjs::enable(id = "numComponents7")
# NEW: Update the default and max slider values.
updateSliderInput(
session,
"numComponents7",
label = "Number of components to impute on:",
min = 2,
max = sliderValues$sliderMax,
value = sliderValues$sliderDefault,
step = 1
)
# Enable confirm button.
shinyjs::enable(id = "confirmImputation7")
# Disable reset and export buttons.
shinyjs::disable(id = "confirmReset7")
shinyjs::disable(id = "exportDF")
}
# [END]
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.