在闪亮的应用程序中动态选择和缩放变量

Question

我有一个闪亮的应用程序，我希望用户能够在其中选择要保留在最终数据框中的变量，然后还可以选择要缩放为百分比的变量。我有这个工作，但我遇到了一个小难题。问题是如果用户决定他们想要添加一个额外的变量（或删除一个），他们必须重新进行缩放。如果我的用户有很多他们正在处理的列，这可能是一个问题。如何保持用户已经完成的缩放工作，同时允许从最终数据框中添加或删除变量？

library(shiny)
library(tidyverse)
library(DT)

# Define UI 
ui <- fluidPage(
  checkboxGroupInput("select_var", label = "Select Variables"),
  selectInput("scalescore", label = NULL, choices = c("")),
  actionButton("scale", "Scale Scores"),
  DT::dataTableOutput("table")

)

# Define server 
server <- function(session, input, output) {
  # define the reactive values
  values <- reactiveValues(df_final = NULL)

  # dynamically generate the variable names
  observe({
    vchoices <- names(mtcars)
    updateCheckboxGroupInput(session, "select_var", choices = vchoices)
  })

  # dynamically generate the variables to scale
  observe({
    vchoices <- names(values$df_final)
    updateSelectInput(session, "scalescore", choices = vchoices)
  })

  # select the variables based on checkbox
  observe({
    req(input$select_var)
    df_sel <- mtcars %>% select(input$select_var) 
    values$df_final <- df_sel
  })

  observeEvent(input$scale, {
    name <- rlang::sym(paste0(input$scalescore, "_scaled"))
    values$df_final <- values$df_final %>% mutate(!!name := round(!!rlang::sym(input$scalescore)/max(!!rlang::sym(input$scalescore), na.rm = TRUE)*100, 1))})

 output$table <- DT::renderDataTable(values$df_final)
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

我们需要维护一个向量来跟踪变量是否被缩放。这是它的完成方式，

library(shiny)
library(tidyverse)
library(DT)

# Define UI 
ui <- fluidPage(
  checkboxGroupInput("select_var", label = "Select Variables"),
  selectInput("scalescore", label = NULL, choices = c("")),
  actionButton("scale", "Scale Scores"),
  DT::dataTableOutput("table")

)

server = function(input,output,session){
  #Column names are static
  names = colnames(mtcars)

  # data scructure to store if the variable is scaled
  is_scaled = logical(length(names))
  names(is_scaled) = names #Set the names of the logical vector to the column names 

  #Update the checkbox with the column names of the dataframe
  observe({
    updateCheckboxGroupInput(session, "select_var", choices = names)
  })

  # Update the list of choices but dont include the scaled vaiables
  observe({
    vchoices <- names(data())
    vchoices = vchoices[vchoices %in% names]
    updateSelectInput(session, "scalescore", choices = vchoices)
  })

  #When the scle button is pressed, the vector which contains the list of scaled variables is updated 
  observeEvent(input$scale,{
    if(is_scaled[[input$scalescore]]){
      is_scaled[[input$scalescore]] <<- FALSE
    }else{
      is_scaled[[input$scalescore]] <<- TRUE
    }
  })

  #Function to scale the variables
  scale = function(x){
    return(round(x/max(x,na.rm = T)*100,1))
  }

  data = reactive({
    req(input$select_var)
    input$scale #simply to induce reactivity

    #Select the respective columns
    df = mtcars%>%
      select(input$select_var)

    if(any(is_scaled[input$select_var])){
      temp_vec = is_scaled[input$select_var] #Get a list of variables selected
      true_vec = temp_vec[which(temp_vec)] #Check which ones are scaled
      true_vec_names = names(true_vec) #Get the names of the variables scales

      #Scale the variables respectively
      df = df%>%
        mutate_at(.vars = true_vec_names,.funs = funs(scaled = scale(.)))
    }

    return(df)
  })

  output$table = DT::renderDataTable(data())
}

# Run the application 
shinyApp(ui = ui, server = server)

is_scaled 跟踪特定列是否被缩放。稍后选择时，如果该向量中的值为TRUE，则对其进行缩放。

还添加了其他功能，如果按两次缩放按钮，则会删除缩放列。