允许用户将新变量添加到Shiny App中的数据集

Question

嗨同仁Shiny用户，

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

RAWDATA：

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  
        ) 
       ) 
      ) 
) 

server.R：

function(input, output, session) { 

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

    observeEvent(input$addButton, { 

     eval(parse(text=input$filter)) 

    }) 
} 

例如，这里有两个新的变量定义尝试。如果我们添加第一个定义，rawdata将会有一个额外的列（Value）。如果我们添加第二个定义，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())有显著风险仔细地（例如：评估传入的文本为。参见关于specific dangers of eval(parse())的SO讨论）。

解决这些风险的方法是突变（双关意外）传入文本和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= " , "), 
     ")" 
) 
))} 
})