创建新数据框 - 为另一列减去一列

Question

我正在尝试制作一个Shiny应用程序，用户可以在其中选择要从另一个列中减去列并写入列的名称。我因打印数据帧而陷入困境，可能是因为Shiny不想按照我想要的方式考虑列。有没有人知道如何按输入变量选择列？

通常，我想在df中仅包含用户指定的样本，例如在提供的打印屏幕中（应忽略Sample3 / 4为NULL）。有没有人有任何建议如何处理这个问题？

以下是我的代码的一部分：

    library(shiny)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(
          width = 3,
          div(style = "white-space: nowrap;", 
              div(style = "white-space: nowrap;", 

                  h5(textInput("name1", label = "Sample 1 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam1", label = "Sample 1",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla1", label = "Blank 1",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",

                  h5(textInput("name2", label = "Sample 2 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam2", label = "Sample 2",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla2", label = "Blank 2",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",

                  h5(textInput("name3", label = "Sample 3 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam3", label = "Sample 3",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla3", label = "Blank 3",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",


                  h5(textInput("name4", label = "Sample 4 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam4", label = "Sample 4",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla4", label = "Blank 4",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              actionButton("update", "Update", class = "btn-primary",style='padding:4px; font-size:120%')
          )))),
    mainPanel(
      DT::dataTableOutput("contents"),
      plotOutput("plot_preview", height = "auto")
    )))

server <- function(input, output, session) {

  Layout <- c("A", " B", " A", "B")

  col1 <- c(0.84, 0.65, 0.97, 0.81)
  col2 <- c(0.43,0.55,0.53,0.66)
  col3 <- c(0.74, 0.75, 0.87, 0.71)

  df <- data.frame(Layout, col1, col2, col3) 

  cols <- colnames(df) 
  cols <- c("NULL", cols[2:4])

  updateSelectInput(session, "sam1", choices=cols)
  updateSelectInput(session, "sam2", choices=cols)
  updateSelectInput(session, "sam3", choices=cols)
  updateSelectInput(session, "sam4", choices=cols)
  updateSelectInput(session, "bla1", choices=cols)
  updateSelectInput(session, "bla2", choices=cols)
  updateSelectInput(session, "bla3", choices=cols)
  updateSelectInput(session, "bla4", choices=cols)

 ## take a colum choosed before and substract the blank - save as one column 
 observeEvent(input$update, 
              {mydatanew <- reactive(
                mydatanew <- data.frame(input$name1 = input$sam1 - input$bla1, input$name2 = input$sam2 - input$bla2))

              output$contents2 <- DT::renderDataTable( DT::datatable(mydatanew()))
             }
              )


  output$contents <- DT::renderDataTable(df)

}

shinyApp(ui, server)

示例用户输入：

Answer 1

您可以使用reactiveVal来保存数据框并进行更新。使用observeEvent添加列并将修改后的数据帧存储回reactiveVal。

此外，为了使事情变得更容易，您可以将输入调用为input[[x]]，其中x是字符串。所以我们可以循环输入而不是输入所有内容。您也可以将它用于updateSelectInput语句。按selectInput后重置actionButton元素也许会很好。您可以通过在lapply(1:4,function(x) {updateSelectInput(session,paste0('bla',x),selected='NULL')}) 的末尾添加observeEvent等行来完成此操作。

以下是一个工作示例。希望这可以帮助！

library(shiny)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(
          width = 3,
          div(style = "white-space: nowrap;", 
              div(style = "white-space: nowrap;", 

                  h5(textInput("name1", label = "Sample 1 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam1", label = "Sample 1",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla1", label = "Blank 1",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",

                  h5(textInput("name2", label = "Sample 2 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam2", label = "Sample 2",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla2", label = "Blank 2",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",

                  h5(textInput("name3", label = "Sample 3 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam3", label = "Sample 3",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla3", label = "Blank 3",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              div(style = "white-space: nowrap;",


                  h5(textInput("name4", label = "Sample 4 Name", value = "Enter name..."),style="display: inline-block; width: 100%;"),
                  h5(selectInput(inputId = "sam4", label = "Sample 4",c(),  multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;"),
                  h5(selectInput(inputId = "bla4", label = "Blank 4",c(), multiple = FALSE, selectize = TRUE),style="display:inline-block; width: 100%;")
              ),
              actionButton("update", "Update", class = "btn-primary",style='padding:4px; font-size:120%')
          )))),
    mainPanel(
      DT::dataTableOutput("contents"),
      plotOutput("plot_preview", height = "auto")
    )))

server <- function(input, output, session) {

  Layout <- c("A", " B", " A", "B")

  col1 <- c(0.84, 0.65, 0.97, 0.81)
  col2 <- c(0.43,0.55,0.53,0.66)
  col3 <- c(0.74, 0.75, 0.87, 0.71)

  df <- data.frame(Layout, col1, col2, col3) 

  cols <- colnames(df) 
  cols <- c("NULL", cols[2:4])

  updateSelectInput(session, "sam1", choices=cols)
  updateSelectInput(session, "sam2", choices=cols)
  updateSelectInput(session, "sam3", choices=cols)
  updateSelectInput(session, "sam4", choices=cols)
  updateSelectInput(session, "bla1", choices=cols)
  updateSelectInput(session, "bla2", choices=cols)
  updateSelectInput(session, "bla3", choices=cols)
  updateSelectInput(session, "bla4", choices=cols)

  reval_df <- reactiveVal(df)

  ## take a colum choosed before and substract the blank - save as one column 
  observeEvent(input$update, {
    df <- reval_df()
    for (i in 1:4)
    {
      if(input[[paste0('sam',i)]]!='NULL' & input[[paste0('bla',i)]]!='NULL')
      {
        print(i)
        df[[input[[paste0('name',i)]]]] = df[[input[[paste0('sam',i)]]]]- df[[input[[paste0('bla',i)]]]]
      }
    }
    reval_df(df)

    # reset inputs
    lapply(1:4,function(x) {updateSelectInput(session,paste0('bla',x),selected='NULL')})
    lapply(1:4,function(x) {updateSelectInput(session,paste0('name',x),selected='NULL')})
    lapply(1:4,function(x) {updateSelectInput(session,paste0('sam',x),selected='NULL')})


  })


  output$contents <- DT::renderDataTable(reval_df())

}

shinyApp(ui, server)