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而{（1}}作为表A保留在我脑海中，这太令人困惑了。
我还使初始化程序更加人性化 - df2输出难以阅读。
使用dput可以更清楚地完成map和input$num作业。我建议使用dplyr，因为它确实可以使代码更清晰，更容易出错。
我从dplyr调用中提取了ui和server函数，这为您提供了更多缩进空间和更常见的模式。

强制性截图：

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

1 个答案: