R-根据用户选择的输入向dataframe添加新列

非常新的R闪亮！我已经看了好20个问题，但它们不一定能解决我面临的问题

我有一些API调用生成的数据帧，如下所示：

Project.ID        Author.ID    Author.Name     Fav.Color
Test_Project1      1234             Bob        Green
Test_Project1      2345            Jane         Blue
Test_Project1      2687            Eric         Blue
Test_Project1      8765            Tom           Red           

我的目标是允许用户使用下拉菜单从数据框中选择一列，使用一些复选框从该列中选择一些要比较的值，并向同一帧添加一个新列，以反映他们想要进行的比较。应该是这样的：

Project.ID      Author.ID    Author.Name     Fav.Color    RedvBlue   GreenvRed
Test_Project1    1234            Bob        Green          NA      Green
Test_Project1    2345            Jane         Blue        Blue     NA   
Test_Project1    2687            Eric         Blue        Blue     NA
Test_Project1    8765            Tom           Red         Red     Red

用户界面

---

非常感谢您的帮助！很抱歉，你的广告太长了

嗨，这是不是妨碍了你的工作

server <- function(input, output, session) {
  # update datatable
  viewSelection <- reactive({
    if(input$viewType == "Projects"){
      projectDT <- read.table(header = TRUE,
                              text = "Project.ID,Author.ID,Author.Name,Fav.Color
Test_Project1,1234,Bob,Green
Test_Project1,2345,Jane,Blue
Test_Project1,2687,Eric,Blue
                              Test_Project1,8765,Tom,Red",
                              sep = ",")

      #replace spaces with dots in headers
      names(projectDT) <- gsub(" ", ".", names(projectDT))

      projectDT



    }

  })
  #show table
  output$mytable <- DT::renderDataTable(DT::datatable(viewSelection()))
  #Display columns from project to view
  observeEvent({input$addCol},{
    insertUI(
      selector = "#addCol",
      where = "beforeBegin",
      ui = div(
        uiOutput(paste0("showMeta",input$addCol)),
        uiOutput(paste0("showVal",input$addCol))
      )
    )
  })
  lapply(1:5, function(idx){
    output[[paste0("showMeta",idx)]] <- renderUI({
      selectInput(inputId =  paste0("metalab",idx),
                  label =  "Metadata Label:",
                  choices =  c(" ", unique(as.vector(colnames(viewSelection())))),
                  selected = input[[paste0("metalab",idx)]]
      )
    })
  })
  lapply(1:5,
         function(idx){
           output[[paste0("showVal",idx)]] <- renderUI({
             req(input$addCol >= idx)
             checkboxGroupInput(paste0("metaval",idx),
                                "Metadata Value:",
                                choices = unique(as.vector(unlist(viewSelection()[[input[[paste0("metalab",idx)]]]]))),
                                selected = input[[paste0("metaval",idx)]]
             )
             })
         })

  output$showMeta <- renderUI({
  })
    #Display unique column values to choose from in checkbox
    #Gives Warning: Error in [.data.frame: undefined columns selected
  output$showVal <- renderUI({
    checkboxGroupInput("showVal",
                       "Metadata Value:",
                       choices = unique(as.vector(unlist(viewSelection()[[input$metalab]])))
    )
  })

  output$mytable <- DT::renderDataTable({
    req(input$viewType == "Projects")
    projectDT <- viewSelection()
    dta <- NULL
    if(input$addCol > 0){
      dta <- lapply(seq(input$addCol), function(idx){
        if(!is.null(input[[paste0("metalab", idx)]]) &&
           input[[paste0("metalab",idx)]] != " "){
          ifelse(projectDT[[input[[paste0("metalab", idx)]]]] %in% input[[paste0("metaval", idx)]] ,as.character(projectDT[[input[[paste0("metalab", idx)]]]]),NA)
        }
      })
      names(dta) <- sapply(seq(input$addCol),function(idx){
        paste0("Compare",idx,"_",paste0(input[[paste0("metaval",idx)]],collapse = "vs"))
      })
      dta <- as_data_frame( dta[!sapply(dta,is.null)])
    }
    if(!is.null(dta) &&
       !is.null(projectDT) &&
       nrow(dta) == nrow(projectDT)){
      projectDT <- cbind(projectDT,dta)
    }
    DT::datatable(projectDT)})  

}

我所做的是，我把所有的输出都从无功状态中拉出来。这主要是为了使代码更稳定

---

希望这有帮助

非常感谢您的回答！这是非常接近我想做的！在您的回答中，您让用户可以添加一个新列，但如何才能添加多个列？在我的上图中，在用户创建了一个新的列RedvBlue之后，他们还可以添加另一个列GreenvRed。对不起，如果这是一个愚蠢的问题，谢谢你的帮助@carasg Oh das有点难，但我想我成功了；-用户现在可以以任何方式添加多达5个新列谢谢！这正是我现在想要的！

server <- function(input, output) {

    viewSelection <- reactive({
      if(input$viewType == "Projects"){
        projectDT <- getJSON("an API url")

        #replace spaces with dots in headers
        names(projectDT) <- gsub(" ", ".", names(projectDT))

        #show table
        output$mytable <- DT::renderDataTable(DT::datatable(projectDT))


        #Display columns from project to view
        output$showMeta <- renderUI({
          selectInput("metalab",
                      "Metadata Label:",
                      c(" ", unique(as.vector(colnames(projectDT))))
          )
        })

        #Display unique column values to choose from in checkbox
        #Gives Warning: Error in [.data.frame: undefined columns selected
        output$showVal <- renderUI({
          checkboxGroupInput("metaval",
                             "Metadata Value:",
                             choices = unique(as.vector(unlist(projectDT[input$metalab])))
          )
        })

      }

    })

    output$mytable <- DT::renderDataTable({DT::datatable(viewSelection())})  
}

projectDT['newCol'] = projectDT[input$metalab]

server <- function(input, output, session) {
  # update datatable
  viewSelection <- reactive({
    if(input$viewType == "Projects"){
      projectDT <- read.table(header = TRUE,
                              text = "Project.ID,Author.ID,Author.Name,Fav.Color
Test_Project1,1234,Bob,Green
Test_Project1,2345,Jane,Blue
Test_Project1,2687,Eric,Blue
                              Test_Project1,8765,Tom,Red",
                              sep = ",")

      #replace spaces with dots in headers
      names(projectDT) <- gsub(" ", ".", names(projectDT))

      projectDT



    }

  })
  #show table
  output$mytable <- DT::renderDataTable(DT::datatable(viewSelection()))
  #Display columns from project to view
  observeEvent({input$addCol},{
    insertUI(
      selector = "#addCol",
      where = "beforeBegin",
      ui = div(
        uiOutput(paste0("showMeta",input$addCol)),
        uiOutput(paste0("showVal",input$addCol))
      )
    )
  })
  lapply(1:5, function(idx){
    output[[paste0("showMeta",idx)]] <- renderUI({
      selectInput(inputId =  paste0("metalab",idx),
                  label =  "Metadata Label:",
                  choices =  c(" ", unique(as.vector(colnames(viewSelection())))),
                  selected = input[[paste0("metalab",idx)]]
      )
    })
  })
  lapply(1:5,
         function(idx){
           output[[paste0("showVal",idx)]] <- renderUI({
             req(input$addCol >= idx)
             checkboxGroupInput(paste0("metaval",idx),
                                "Metadata Value:",
                                choices = unique(as.vector(unlist(viewSelection()[[input[[paste0("metalab",idx)]]]]))),
                                selected = input[[paste0("metaval",idx)]]
             )
             })
         })

  output$showMeta <- renderUI({
  })
    #Display unique column values to choose from in checkbox
    #Gives Warning: Error in [.data.frame: undefined columns selected
  output$showVal <- renderUI({
    checkboxGroupInput("showVal",
                       "Metadata Value:",
                       choices = unique(as.vector(unlist(viewSelection()[[input$metalab]])))
    )
  })

  output$mytable <- DT::renderDataTable({
    req(input$viewType == "Projects")
    projectDT <- viewSelection()
    dta <- NULL
    if(input$addCol > 0){
      dta <- lapply(seq(input$addCol), function(idx){
        if(!is.null(input[[paste0("metalab", idx)]]) &&
           input[[paste0("metalab",idx)]] != " "){
          ifelse(projectDT[[input[[paste0("metalab", idx)]]]] %in% input[[paste0("metaval", idx)]] ,as.character(projectDT[[input[[paste0("metalab", idx)]]]]),NA)
        }
      })
      names(dta) <- sapply(seq(input$addCol),function(idx){
        paste0("Compare",idx,"_",paste0(input[[paste0("metaval",idx)]],collapse = "vs"))
      })
      dta <- as_data_frame( dta[!sapply(dta,is.null)])
    }
    if(!is.null(dta) &&
       !is.null(projectDT) &&
       nrow(dta) == nrow(projectDT)){
      projectDT <- cbind(projectDT,dta)
    }
    DT::datatable(projectDT)})  

}