Динамическое выделение и масштабирование переменных в блестящем приложении

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.

Добавлены дополнительные функции, когда при нажатии кнопки масштабирования дважды удаляется столбец масштаба.