How to scroll to the bottom after clicking a button in shiny data tables

Question

I have a simple Shiny app that shows me a load of pictures within a data table in shiny. I have 20,000 images and I want to delete ones I dont like. At the moment when I delete a row the app then takes me to the top of the data table which is not useful for this number of images.

As a simple solution I thought I could make sure the app returned to the image above the one I had just deleted. I imagine this would be managed by a javascript function but I don't know how to implement this. I imagine it should be placed in the section of the code below tags$script . Can someone show me how/ give me guidance on how to implement this functionality

Here is the code for my app:

server

library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
server<-shinyServer(function(input, output) {
  vals<-reactiveValues(myTabData = data.table(NULL))

  vals$Data<-data.table(Endo_Endoscopist=DT$Endo_Endoscopist,
                        PatientID=DT$PatientID,
                        NBIorWLorFICE=DT$NBIorWLorFICE,
                        url=DT$url)

  output$MainBody<-renderUI({
    fluidPage(
      box(width=12,
          h3(strong("Actions on datatable with buttons"),align="center"),
          hr(),
          column(12,dataTableOutput("Main_table")),
          tags$script("$(document).on('click', '#Main_table button', function () {
                      Shiny.onInputChange('lastClickId',this.id);
                      Shiny.onInputChange('lastClick', Math.random())
  });")

      )
      )
  })

  output$Main_table<-renderDataTable({
    DT=vals$Data

    DT[["Actions"]]<-
      paste0('
             <div class="btn-group" role="group" aria-label="Basic example">
             <button type="button" class="btn btn-secondary delete" id=delete_',1:nrow(vals$Data),'>Delete</button>
             <button type="button" class="btn btn-secondary modify"id=modify_',1:nrow(vals$Data),'>Modify</button>
             </div>

             ')
    datatable(DT,
              escape=F)}
      )


  output$downloadData <- downloadHandler(
    filename = function() {
      "Main_table.csv"
    },
    content = function(file) {
      write.csv(vals$Data, file, row.names = FALSE)

      # Warning: Error in write.table: unimplemented type 'list' in 'EncodeElement'
      # write.csv(vals$Data, file, row.names = FALSE)
    }
  )




  ##Managing in row deletion
  modal_modify<-modalDialog(
    fluidPage(
      h3(strong("Row modification"),align="center"),
      hr(),
      dataTableOutput('row_modif'),
      actionButton("save_changes","Save changes"),

      tags$script(HTML("$(document).on('click', '#save_changes', function () {
                       var list_value=[]
                       for (i = 0; i < $( '.new_input' ).length; i++)
                       {
                       list_value.push($( '.new_input' )[i].value)
                       }
                       Shiny.onInputChange('newValue', list_value)
  });"))
    ),
    size="l"
      )


  observeEvent(input$lastClick,
               {
                 if (input$lastClickId%like%"delete")
                 {
                   row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
                   vals$Data=vals$Data[-row_to_del]
                 }
                 else if (input$lastClickId%like%"modify")
                 {
                   showModal(modal_modify)
                 }
               }
  )

  output$row_modif<-renderDataTable({
    selected_row=as.numeric(gsub("modify_","",input$lastClickId))
    old_row=vals$Data[selected_row]
    row_change=list()
    for (i in colnames(old_row))
    {
      if (is.numeric(vals$Data[[i]]))
      {
        row_change[[i]]<-paste0('<input class="new_input" type="number" id=new_',i,'><br>')
      }
      else
        row_change[[i]]<-paste0('<input class="new_input" type="text" id=new_',i,'><br>')
    }
    row_change=as.data.table(row_change)
    setnames(row_change,colnames(old_row))
    browser()
    DT=rbind(old_row,row_change)
    rownames(DT)<-c("Current values","New values")
    DT

  },escape=F,options=list(dom='t',ordering=F),selection="none"
  )


  observeEvent(input$newValue,
               {
                 newValue=lapply(input$newValue, function(col) {
                   if (suppressWarnings(all(!is.na(as.numeric(as.character(col)))))) {
                     as.numeric(as.character(col))
                   } else {
                     col
                   }
                 })
                 DF=data.frame(lapply(newValue, function(x) t(data.frame(x))))
                 colnames(DF)=colnames(vals$Data)
                 vals$Data[as.numeric(gsub("modify_","",input$lastClickId))]<-DF

               }
  )

  })

ui

library(shiny)
library(shinydashboard)

ui<-fluidPage(dashboardBody(uiOutput("MainBody"),
                            downloadLink("downloadData", "Download"))             
)

Answer 1

Here is a way to delete rows without re-rendering the table. I hope this helps.

library(DT)
library(shiny)

dat <- iris[1:5, 1:2]
dat$Action <- 
  paste0(
    '<button type="button" class="btn btn-secondary delete" id="delete_', 
    1:nrow(dat)-1, 
    '" onclick="deleteRow(this.id);">Delete</button>')
dat$rowId <- paste0("row_", 1:nrow(dat)-1)

js <- paste0(
  c(
    "function deleteRow(id){",
    "  var rowNum = id.split('_')[1];",
    "  var table = $('#mytable').find('table').DataTable();",
    "  var nrows = table.rows().count();",
    "  for(var i=0; i < nrows; ++i){",
    "    if(table.row(i).id() == 'row_' + rowNum){",
    "      table.row(i).remove().draw(false);",
    "      break;",
    "    }",
    "  }",
    "}"
  ), 
  collapse = "\n"
)

ui <- fluidPage(
  tags$head(tags$script(HTML(js))),
  DTOutput("mytable")
)

server <- function(input, output){
  output[["mytable"]] <- renderDT({
    datatable(dat, escape = FALSE, selection = "none", 
              options = list(
                columnDefs = list(
                  list(targets = ncol(dat), visible = FALSE)
                ),
                rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat)))))
  }, server = FALSE)
}

shinyApp(ui, server)

Or, simpler:

dat <- iris[1:5, 1:2]
dat$Action <- 
  '<button type="button" class="btn btn-secondary delete">Delete</button>'

callback <- c(
  "table.on('click', 'button.delete', function(){",
  "  var tr = $(this).closest('tr');",
  "  table.row(tr[0]).remove().draw(false);",
  "});"
)

ui <- fluidPage(
  DTOutput("mytable")
)

server <- function(input, output){
  output[["mytable"]] <- renderDT({
    datatable(dat, escape = -ncol(dat)-1, selection = "none", 
              callback = JS(callback))
  }, server = FALSE)
}

shinyApp(ui, server)