允许用户在 Shiny App 中向数据集添加新变量

Question

嗨，Shiny 用户，

我希望我的用户能够将新变量添加到主数据框中。用户将使用 textInput 键入定义。然后我们将使用 server.R 将其添加到数据框中。这是我的代码。我无法让它工作。任何帮助将不胜感激。谢谢！

原始数据：

colA <- c('1','2','3','3','2')
colB <- c('1','1','3','3','2')
colC <- c('14','12','33','33','26')
colD <- c('Value','Mainstream','Value','Premium','Premium')
colE <- c(1,2,3,4,5)
rawdata <- as.data.frame(cbind(colA,colB, colC, colD, colE))
View(rawdata)

ui.R:

fluidPage(
            sidebarLayout(
                sidebarPanel(
                    textInput("addVar", "New attribute definition"),
                    helpText("Note: Type the attribute definition using R code."),
                    helpText("For example:"), 
                    helpText("data$Value <- ifelse (data$price_tiers_new == 'Value', 1, 0)"),

                    br(),
                    actionButton("addButton", strong("Add!")),
                    width = 3
                ),

                mainPanel(
                    verticalLayout(
                        br()
                        #Will display histogram of the newly added variables       
                    )
                )
           )
)

服务器.R：

function(input, output, session) {

    curr <- reactiveValues()
    curr$df <- rawdata

    observeEvent(input$addButton, {

        eval(parse(text=input$filter))

    })
}

例如，这里有两个新的变量定义可供尝试。如果我们添加第一个定义，rawdata 将有一个额外的列（值）。如果我们添加第二个定义，rawdata 将有两个额外的列（Value 和 Premium）。

curr$df$Value <- ifelse(curr$df$colD == 'Value', 1, 0)
curr$df$Premium <- ifelse(curr$df$colD == 'Premium', 1, 0)

Answer 1

使用eval(parse(text=input$addVar)) 应该可以工作。

您还可以为textInput() 添加默认文本，以使textInput() 的使用（非常规但有趣）更加清晰。

textInput("addVar", "New attribute definition", 
          "curr$df$Value <- ifelse(curr$df$colD == 'Value', 1, 0)")

完整的应用程序（包括用于检查结果的 textOutput）将显示为：

colA <- c('1','2','3','3','2')
colB <- c('1','1','3','3','2')
colC <- c('14','12','33','33','26')
colD <- c('Value','Mainstream','Value','Premium','Premium')
colE <- c(1,2,3,4,5)
rawdata <- as.data.frame(cbind(colA, colB, colC, colD, colE))

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      textInput("addVar", "New attribute definition", "curr$df$Value <- ifelse(curr$df$colD == 'Value', 1, 0)"),
      helpText("Note: Type the attribute definition using R code."),
      helpText("For example:"), 
      helpText("data$Value <- ifelse (data$price_tiers_new == 'Value', 1, 0)"),
      br(),
      actionButton("addButton", strong("Add!")),
      width = 3
    ),

    mainPanel(
      verticalLayout(
        br(),
        verbatimTextOutput("txt")
        #Will display histogram of the newly added variables       
      )
    )
  )
)

server <- function(input, output, session) {
  output$txt <- renderPrint(curr$df)
  curr <- reactiveValues()
  curr$df <- rawdata

  observeEvent(input$addButton, {
    eval(parse(text=input$addVar))
  })
}

shinyApp(ui, server)

Answer 2

虽然这个问题有一个公认的答案，但值得注意的是eval(parse()) 如果不小心使用会有很大的风险（例如：评估传入的文本按原样。请参阅@ 上的 SO 讨论987654321@).

解决这些风险的一种方法是变异（无意双关）传入的文本和eval(parse()) 变异的文本。这样您就可以获得预期的结果或错误，但几乎不会像运行带有T <- FALSE（感谢@flodel）或其他一些植入错误的长代码这样的灾难。

例如：input_vector和name_vector分别是新变量定义条件和新变量名的列表。

input_vector <- list()
input_vector[[1]] <- "ifelse(am == 1, 'wohoo', 'io')"
input_vector[[2]] <- "vs == 1"
input_vector[[3]] <- "cyl >= 6" 
input_vector[[4]] <- "0"    
name_vector <- list()
name_vector[[1]] <- "automatic_"
name_vector[[2]] <- "VS_Equals_1_"
name_vector[[3]] <- "HighCylinder_"
name_vector[[4]] <- "Blank_"    
new_var_count <- 1:4

mutated_data <- reactive({
  mt %>% 
  {eval(parse(text=
  paste0("mutate_(.,", 
      paste0(name_vector, as.character(new_var_count),"= input_vector[[", 
      as.character(new_var_count), "]]", collapse= " , "),
      ")"
  )
))}
})