0

我正在创建一个带有表单的应用程序，供用户填写详细信息，然后按“提交”按钮：然后将一行添加到汇总输入数据的数据框中。每个条目都有一个唯一的标识符，例如。姓名。

如果进行了新的提交，但引用了相同的标识符，我想要一个弹出框来警告用户他们将要覆盖原始数据。

使用从这篇文章中获取的信息，我已经部分实现了目标。代码按预期执行更新（在运行下面的示例中，这在 print() 命令中得到证明），但是 ui 没有按我预期的那样更新。

下面我包含了一个最小的工作示例，如果在“行名称：”字段中输入（例如）b，在“新值：”字段中输入 10，然后单击“分配新值”，然后弹出方框出现，但上面的数据表没有改变，而且它似乎改变了阴影。然后，如果您使用第二个命令重复，例如。b, 8, "Assign new Value"，然后格式恢复正常，并且两个提交都被视为已生效。

如果有人能解释为什么会发生这种情况，以及如何让应用程序按预期运行（例如，在第一次单击按钮后更新表格），我将不胜感激。

此外，如果有人知道我如何扩展它以接受/拒绝更新，那就太好了！我的意思是，在弹出框中可以选择“您确定要更新 b 行吗？”和“是/否”选项。

请注意，虽然在下面的示例中，我使用了使用 shinyjs::alert 的解决方案（请参阅上面引用的帖子中的评论），但我之前尝试过使用大部分帖子中概述的方法，但遇到了同样的问题。

谢谢

library(shiny)
library(shinyjs)
library(DT)

ui <- fluidPage(
  useShinyjs(),
  dataTableOutput("DF_table"),
  hr(),
  fluidRow(
    column(4, 
           textInput("rowName", "Row Name:", NULL) ),
    column(4,
           numericInput("newValue", "New Value:",NULL) ),
    column(4,
           actionButton("assignValue", label = h5("Assign New Value"), width = "100%" ) )
  )

)

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

  rvs <- reactiveValues( DF = data.frame(name = c("a", "b", "c"), value = 1:3 ) )

  observeEvent(input$assignValue,{

      # Test if the supplied row name corresponds to a row of DF.
      if(input$rowName %in% rvs$DF[,"name"] ){

        # If it does, pop up box warns user that the supplied row is being over written.
        shinyjs::alert(paste("Reassigning value of", input$rowName, sep=" ") )

        # Over writes the value in the selected row, with the new value.
        rvs$DF[match(input$rowName, rvs$DF[,"name"]), "value"] <- input$newValue
        print(rvs$DF)
      }
  })

  # Output data table.
  output$DF_table <- renderDataTable(rvs$DF, rownames = FALSE)

}


runApp(list(ui = ui, server = server))
4

0 回答 0