Shiny: Conflict with Pop Up Message and Data Table

468 Views Asked by At

I am creating an app with a form for users to fill in with details, and press a "Submit" button: after which a row gets added to a data frame summarising the entered data. Each entry has a unique identifier, eg. Name.

If a new submission is made, but references the same identifier, I want a pop-up box to warn the user that they are about to overwrite the original data.

Using information taken from this post, I have partially managed the aim. The code performs the update as expected (in running the example below, this is evidenced in the print() command), however the ui does not update as I'd expect.

Below I have included a minimal working example, where if one enters (for example) b into the "Row Name:" field, 10 into the "New Value:" field, and then click "Assign New Value", then the pop up box appears but the data table above does not change, moreover it appears to change shade. Then if you repeat with a second command, eg. b, 8, "Assign new Value", then the formatting goes back to normal, and both commits are seen to have taken affect.

I'd greatly appreciate if someone could explain why this is happening, and how to get the app to function as one would expect (eg. updating the table after first button click).

Moreover, if anybody has an idea of how I can extend this to accept/reject the update, that'd be great! By this I mean, having the option in the pop-up box to have "Are you sure you want to update row b?", and the options Yes/No.

Note whilst in the example below I have used the solution using shinyjs::alert (see comments in the above referenced post), I previously tried using the method outlined in the bulk of the post but had the same issue.

Thanks

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))
0

There are 0 best solutions below