R Shiny DT navigate to the table's last page via an action button-CodePudding

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. Now the next step is:

When the add button is clicked, the app automatically goes to the last record/page (that now has the new empty row) instead of having the user to click on the last page number.

How can I do this?

Sample Data (df):

structure(list(Reference.Number = c("33333", "44444", "22222", 
"55555", "66666"), 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"
), PDF.File.....Map.Name.... = c("", "", "", "C:\\ABC\\Demographics\\Demographic_Request\\FemalesAge10-18BelowPoveryLevel\\pdfs\\MapNo14785.pdf", 
""), Assigned.To = c("", "", "", "", ""), Completion.Date = c("", 
"", "", "", ""), Notes = c(NA, NA, NA, NA, NA), Year = c(2022, 
2022, 2022, 2022, 2022)), class = "data.frame", row.names = c(NA, -5L))

Code:

library(shiny)
library(shinythemes)
library(shinyWidgets)
library(shinyanimate)
library(DT)
library(tidyverse)

    # Define UI for application that draws a histogram
    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")),)
                        )
    )
    
    # Define server logic required to draw a histogram
    server <- function(input, output) {
    
      myData = df
      
      # Create an 'empty' tibble 
       user_table =
         myData %>% 
          slice(1) %>% 
        # Transpose the first row of test into two columns
        gather(key = "column_name", value = "value") %>%
        # Replace all values with ""
        mutate(value = "") %>%
        # Reshape the data from long to wide
        spread(column_name, value) %>%
        # Rearrange the column order to match that of test
        select(colnames(myData))
       
       # 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, {
         proxy %>% 
           addRow(user_table)
       })
      
    }
    
    # Run the application 
    shinyApp(ui = ui, server = server)

CodePudding user response：

You can make the client listen to custom messages and execute Javascript functions you've prepared in the UI part (see section from R to Javascript here).

This might look like:

ui <- fluidPage(
  actionButton('jumpToLast', 'jump to last page'),
  dataTableOutput('tableContainer'),
  ## include JS code via tags$script(HTML(...)):
  tags$script(HTML("
           Shiny.addCustomMessageHandler('messageJumpToLast', function(message) {
               // select the target table via its container ID and class:
               var target = $('#tableContainer .dataTable');
               // display last page:
               target.dataTable().api().page('last').draw(false);
           });
           ")
           )
)

server <- function(input, output, session){
  output$tableContainer <- renderDataTable(iris)

  ## when action button is clicked, send custom message to client:
  observeEvent(input$jumpToLast, {
    session$sendCustomMessage('messageJumpToLast', 'some payload here, if needed')
  })

}

shiny::shinyApp(ui, server)