R Shiny JS跳转到最后一页与新行中的自动生成值冲突

Question

. Answers to this question are eligible for a +50 reputation bounty. Ed_Gravy is looking for a to this question:

The answer of Mr. Laurent is certainly helpful especially with defining the callback object. However, since my app code is different, I am having a hard time incoporating the answer to my code to make the app work without getting additional errors. Basically, I am looking for an answer that works with my code in the question.

I have a Shiny app that allows the user to enter their project details to the database. This is achieved by the Add Project Details Button that adds an empty row to the table. When the add button is clicked the app auto generates the next reference number (under column Reference.Number) in the new row based on the previous one.

Another function of the Add button is also to make the app jump to the last page of the table rather than having the user click on the last page number under the table.

The app almost works fine because when I click the Add button, the app does temporarily go the last page, but as soon as the auto generate value is calculated, the app goes back to the first page of the table.

What could be causing this conflict and how can this be fixed?

Sample data ( df ):

df <- structure(list(Reference.Number = c("33331", "33332", "33333", 
                                          "33334", "33335"), 
                     Request.Date = c("1/6/2022", "1/6/2022", "1/19/2022", 
                                                                              "1/20/2021", "1/24/2022"), 
                     Requestor.Name = c("Comm Dist 3 by Kitty", "Comm Dist 3 by Kitty", "Updated maps for David", "    Stone Cold", "Updated SOE 60 inch wall map"),
                     Requestor.Dept.Div = c("C 3 Staff",    "C 3 Staff", "Unincorp & Comm", "Mt.Rushmore AME Church Ft. Billy",                                         "SOE"), 
                     Requestor.Phone = c("", "", "", "", ""), 
                     Contact.Person = c("Tommy",                             "Tommy", "Bob", "Bob", "Joe"),
                     Contact.Phone = c("1111",                               "2222", "3333", "ext 1111", "3434"),
                     Deadline = c("1/20/2022",         "1/20/2022", "1/22/2022", "", "1/24/2022"),
                     Project.Description = c("45x36 portrait map ",          "45x36 portrait map  ",   "24x24 Unincorporated areas", "Percent Females Aged 25 - 55  Below Poverty Level By Zip Code",                "SOE Wall Map 60x60 p"), 
                     Project.File.Location = c("", 
                                                  "", "C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14785 Unincorporated 24x24.pdf", 
                                                  "C:\\ABC\\Demographics\\Demographic_Request\\FemalesAge10-18BelowPoveryLevel\\FemalesAge10-18BelowPoveryLevel.aprx", 
                                                  "C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14786 V P 60x60.pdf" 

Code:

library(shiny)
library(shinythemes)
library(DT)
library(tidyverse)

# Define UI for application 
ui =   navbarPage(tags$style("table, .table {color: unset;} .dataTable th, .datatables input {color: white}"),
                  title = div("GIS Team Projects"),
                  theme = shinytheme("cyborg"),
                  tabPanel("GIS Projects",
                           icon = icon("info"),
                           div(p(h1("Instructions:"),style="text-align: justify;")),
                           p("1. The user can add their project details.", style="color:black"),
                           uiOutput("all"),
                  sidebarLayout(
                    sidebarPanel(
                      actionButton("addData", "Add Project Details"),
                      ),
                    mainPanel(
                      downloadButton("download1","Download data as csv"),                
                      DTOutput("contents"),
                      tags$script(HTML("
           Shiny.addCustomMessageHandler('messageJumpToLast', function(message) {
               // select the target table via its container ID and class:
               var target = $('#contents .dataTable');
               // display last page:
               target.dataTable().api().page('last').draw(false);
           });
           "))),
                    )
                    )
)

# Define server logic required 
server <- function(input, output) {
  
  myData = reactiveVal(df)
  
  # Create an 'empty' tibble 
  user_table =  
    df %>% 
    slice(1) 
  
  user_table[1,]<-NA
  
  # Display data as is
  output$contents =
    renderDT(myData(),
             server = FALSE,
             editable = TRUE,
             options = list(lengthChange = TRUE),
             rownames = FALSE)
  
  # Store a proxy of contents 
  proxy = dataTableProxy(outputId = "contents")
  
  # Each time addData is pressed, add user_table to proxy
  observeEvent(eventExpr = input$addData, {
    myData(myData() %>% bind_rows(user_table %>% 
  mutate(Reference.Number=as.character(max(as.numeric(myData()$Reference.Number), na.rm = T)+1))))
  session$sendCustomMessage('messageJumpToLast', 'some payload here, if needed') # Don't know if this should be added or not!
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

I didn't try with your app because it gives me headache. Here is a minimal example:

library(shiny)
library(DT)

ui <- basicPage(
  br(),
  actionButton("addData", "Add Project Details", class = "btn-primary"),
  br(), br(),
  fluidRow(
    column(
      width = 12, 
      DTOutput("mytable")
    )
  )
)

callback <- c( # with this callback, the app does not jump to the last page if
  '$("#addData").on("click", function(){', # the added row goes to a new page
  '  table.page("last").draw("page");',
  '});'
)
callback <- c( # so we use this callback which includes a small delay (200ms)
  '$("#addData").on("click", function(){',
  '  setTimeout(function(){table.page("last").draw("page");}, 200);',
  '});'
)

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

  Dat <- reactiveVal(iris)
  
  #mytable
  output[["mytable"]] <- renderDT({
    datatable(
      isolate(Dat()),
      rownames = FALSE,
      editable = list(target = "cell"),
      callback = JS(callback)
    )
  }, server = FALSE)
  
  proxy <- dataTableProxy("mytable")
  
  #bind clicks
  observeEvent(input[["addData"]], {
    newRow <- data.frame(
      "Sepal.Length" = runif(1, 5, 7),
      "Sepal.Width"  = runif(1, 2, 4),
      "Petal.Length" = runif(1, 3, 5),
      "Petal.Width"  = runif(1, 0, 2),
      "Species"      = "setosa" 
    )
    Dat(rbind(Dat(), newRow)) # just to keep track of the changes
    addRow(proxy, newRow, resetPaging = FALSE)
  }) 
  
  # remove btn
  observeEvent(input[["mytable_edit"]], {
    info <- input[["mytable_edit"]]
    Dat(editData(Dat(), info, proxy))
  })
  
}

shinyApp(ui, server)

Answer 2

@Stéphane Laurent deserves all credit for this. Essentially I just used the original posters code and updated it with the answer from Stéphane Laurent. There are certain things like the observeEvent() that don't work as originally posted without the user of the addRow() . Anyways, this should work. Best of luck

df <- data.frame(structure(list(Reference.Number = c("33331", "33332", "33333", 
                                                     "33334", "33335"), 
                                Request.Date = c("1/6/2022", "1/6/2022", "1/19/2022", 
                                                 "1/20/2021", "1/24/2022"), 
                                Requestor.Name = c("Comm Dist 3 by Kitty", "Comm Dist 3 by Kitty", "Updated maps for David", "    Stone Cold", "Updated SOE 60 inch wall map"),
                                Requestor.Dept.Div = c("C 3 Staff",    "C 3 Staff", "Unincorp & Comm", "Mt.Rushmore AME Church Ft. Billy",                                         "SOE"), 
                                Requestor.Phone = c("", "", "", "", ""), 
                                Contact.Person = c("Tommy",                             "Tommy", "Bob", "Bob", "Joe"),
                                Contact.Phone = c("1111",                               "2222", "3333", "ext 1111", "3434"),
                                Deadline = c("1/20/2022",         "1/20/2022", "1/22/2022", "", "1/24/2022"),
                                Project.Description = c("45x36 portrait map ",          "45x36 portrait map  ",   "24x24 Unincorporated areas", "Percent Females Aged 25 - 55  Below Poverty Level By Zip Code",                "SOE Wall Map 60x60 p"), 
                                Project.File.Location = c("", 
                                                          "", "C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14785 Unincorporated 24x24.pdf", 
                                                          "C:\\ABC\\Demographics\\Demographic_Request\\FemalesAge10-18BelowPoveryLevel\\FemalesAge10-18BelowPoveryLevel.aprx", 
                                                          "C:\\ABC\\Tommy\\work|Map-Projects\\BD Unincororated\\#14786 V P 60x60.pdf" 
                                ))))
#Made data into dataframe, slice for me doesn't work with the list


library(shiny)
# library(shinythemes #I don't think this is important to the question and I don't have shinythemes
library(DT)
library(tidyverse)

callback <- c( # with this callback, the app does not jump to the last page if
  '$("#addData").on("click", function(){', # the added row goes to a new page
  '  table.page("last").draw("page");',
  '});'
)
callback <- c( # so we use this callback which includes a small delay (200ms)
  '$("#addData").on("click", function(){',
  '  setTimeout(function(){table.page("last").draw("page");}, 200);',
  '});'
)

# Define UI for application 
ui =   navbarPage(tags$style("table, .table {color: unset;} .dataTable th, .datatables input {color: white}"),
                  title = div("GIS Team Projects"),
                  # theme = shinytheme("cyborg"), #I don't think this is important to the question
                  tabPanel("GIS Projects",
                           icon = icon("info"),
                           div(p(h1("Instructions:"),style="text-align: justify;")),
                           p("1. The user can add their project details.", style="color:black"),
                           uiOutput("all"),
                           sidebarLayout(
                             sidebarPanel(
                               actionButton("addData", "Add Project Details"),
                             ),
                             mainPanel(
                               downloadButton("download1","Download data as csv"),                
                               DTOutput("contents"),
                               tags$script(HTML("
           Shiny.addCustomMessageHandler('messageJumpToLast', function(message) {
               // select the target table via its container ID and class:
               var target = $('#contents .dataTable');
               // display last page:
               target.dataTable().api().page('last').draw(false);
           });
           "))
                             ),
                           )
                  )
)

# Define server logic required 
server <- function(input, output) {
  
  myData = reactiveVal(df)
  
  # Create an 'empty' tibble 
  user_table =  
    df %>% 
    slice(1) 
  
  user_table[1,]<-NA
  
  # Display data as is
  output$contents =
    renderDT({
      datatable(isolate(myData()), #Isolate is needed for Stéphane Laurent's answer
                # server = FALSE, #Moved to below
                editable = TRUE,
                options = list(lengthChange = TRUE),
                rownames = FALSE,
                callback = JS(callback)
      )}, server = FALSE
    )
  
  # Store a proxy of contents 
  proxy = dataTableProxy(outputId = "contents")
  
  # Each time addData is pressed, add user_table to proxy
  observeEvent(eventExpr = input$addData, {
    #Original way of adding data doesn't work with Stéphane Laurent's answer, so I updated using their format
    # myData(myData() %>% bind_rows(user_table %>% 
    #                                 mutate(Reference.Number=as.character(max(as.numeric(myData()$Reference.Number), na.rm = T)+1))))
    newRow<-user_table %>% #replaced the original info with the answer from Stéphane Laurent
      mutate(Reference.Number=as.character(max(as.numeric(as.character(myData()$Reference.Number)), na.rm = T)+1))
    myData(rbind(myData(), newRow)) # just to keep track of the changes
    addRow(proxy, newRow, resetPaging = FALSE)
  })
  
  observeEvent(input[["contents_edit"]], {
    info <- input[["contents_edit"]]
    myData(editData(myData(), info, proxy))
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)