根据用户输入替换数据集中的值

Question

我想使用另一个数据帧 (B) 更新一个数据帧 (A)。 B 在ui 中，用户可以选择更新表 B 中的数据。根据 B 中的更新值，我想更新 A。请参见下面的代码，该代码允许用户更新 B，但之后 A 没有更新点击操作按钮：

df2 <- structure(list(A = c(1L, 4L, 0L, 1L), 
                      B = c("3", "*", "*", "2"), 
                      C = c("4", "5", "2", "*"), 
                      D = c("*", "9", "*", "4")), 
                 .Names = c("A", "B", "C", "D"), 
                 class = "data.frame", 
                 row.names = c(NA, -4L))
df1 <- structure(list(variable = c("A", "B", "C", "D"), 
                      Value = c(2L,1L, 9L, 0L)), 
                 .Names = c("variable", "Value"), 
                 class = "data.frame",
                 row.names = c(NA, -4L))
shinyApp(
  ui <-
    fluidPage(
      titlePanel("Sample"),

      # Create a new row for the table.
      sidebarLayout(
        sidebarPanel(
          selectInput("select", label = h3("Select Variable"), 
                      choices = unique(df1$variable), 
                      selected = unique(df1$variable)[1]),
          numericInput("num", label = h3("Replace * with"), 
                          value = unique(df1$variable)[1]),
          actionButton("applyChanges", "Apply Changes")),
        mainPanel(
          dataTableOutput(outputId="table")
        ))),
  Server <- function(input, output) {

    # Filter data based on selections
    output$table <- renderDataTable({
      df1$Value[df1$variable==input$select] <<- input$num
      df1
    })
    df2_new <- eventReactive(input$applyChanges,{
      df1[as.character(df1$variable)] <- Map(function(x, y)
        replace(x, x=="*", y), df2[as.character(df1$variable)], df1$Value)
      df2_new <- df2
      return(df2_new)
    })
  })

任何帮助将不胜感激。谢谢！！

Answer 1

这符合我的想法：

library(shiny)
# old df2
dfaa <- data.frame(A = c( 1L, 4L, 0L, 1L), 
                   B = c("3","*","*","2"), 
                   C = c("4","5","2","*"), 
                   D = c("*","9","*","4"),stringsAsFactors = F) 
# old df1
dfbb <- data.frame(variable = c("A","B","C","D"), 
                  Value    = c( 2L, 1L, 9L, 0L),stringsAsFactors = F)

ui <-  fluidPage(titlePanel("Sample"),
  sidebarLayout(
    sidebarPanel(
      selectInput("select", label = h3("Select Variable"), 
                  choices = unique(dfbb$variable), 
                  selected = unique(dfbb$variable)[1]),
      numericInput("num", label = h3("Replace * in A with"), 
                   value = unique(dfbb$Value)[1]),
      actionButton("applyChanges", "Apply Changes specified in B to A")),
    mainPanel(
      h3("Table A"),  dataTableOutput(outputId="tableA"),
      h3("Table B"),  dataTableOutput(outputId="tableB")
)))

server <- function(input, output) {
  rv <- reactiveValues(dfA=dfaa,dfB=dfbb)
  observe({
    # update dfB immediately when the variable or value in the ui changes
    rv$dfB$Value[rv$dfB$variable==input$select] <- input$num
  })

  observeEvent(input$applyChanges,{
    # Here we apply the changes that were specified
    dfAcol <-as.character(rv$dfB$variable)
    rv$dfA[dfAcol] <- 
          Map(function(x, y) replace(x, x=="*", y), rv$dfA[dfAcol], rv$dfB$Value)
  })
  output$tableB <- renderDataTable({ rv$dfB })
  output$tableA <- renderDataTable({ rv$dfA })
}
shinyApp(ui=ui,server=server)

注意事项：

• 实际上与您发布的原始代码非常接近。
• 为了实现数据更新，我使用了reactiveValues 和observe 而不是eventReactive，你可以使用eventReactive 来实现，正如我之前提到的，你试过了，我也试过了，但这种方式是 更干净，更清晰，避免了可怕的<<-。
• 在主面板中添加了表 B，以便查看发生了什么。
• 我将 df2 重命名为 dfaa 和 df1 重命名为 dfbb。我只是无法将df1 作为表 B 和 df2 作为表 A 在我的脑海中，这太混乱了。
• 我还使初始化程序更加人性化 - dput 输出难以阅读。
• map 和input$num 分配将更清楚地使用dplyr 完成。我建议使用dplyr，因为它确实可以使代码更清晰、更不容易出错。
• 我从shinyApp 调用中提取了ui 和server 函数，这为您提供了更多的缩进空间和更常见的模式。

强制截图：