Make two data tables in Shiny scroll together so columns stay aligned

I have a large data set. I'm only providing a small subset of the data below.

I've built a shiny app that I want to help users compare a single data entry point to the entire data set so that they can filter and sort the different columns in the entire data set and see how data points for the single-entry data compares.

There are about 40 columns of data and I have built the application so that the data page shows two data tables using DT. I want to figure out a way to code this so that when you scroll left or right on one of the data tables the other follows the same scrolling. Essentially, the columns stay aligned.

The app I am using has a sidebar with filters that can be applied to the data and two additional pages that I'm not including here but that is the reason for using dashboardPage

Here is my code which is currently resulting in only one table scrolling when you scroll left or right. (You may have to make the window smaller to see the scroll bar)

library(shiny)
library(DT)
library(shinydashboard)
library(shinydashboardPlus)

ui <- dashboardPage(
  dashboardHeader(title = "Credit Analysis"),
  
  dashboardSidebar(),
  dashboardBody(
    DTOutput("table1"),
  DTOutput("table2"),
  tags$script(HTML("
    $(document).ready(function() {
      var table1 = $('#table1').DataTable();
      var table2 = $('#table2').DataTable();
      
      $('#table1').on('scroll', function() {
        $('#table2').scrollLeft($(this).scrollLeft());
      });
      
      $('#table2').on('scroll', function() {
        $('#table1').scrollLeft($(this).scrollLeft());
      });
    });
  "))
  )
)


server <- function(input, output, session) {
  names <- c("Alice", "Bob", "Charlie", "David", "Will", "Sarah", "Kelly")
  names1 <- "Joe"
  ages <- c(25, 30, 35, 40, 23, 44, 33)
  ages1 <- 37
  states <- c("NY", "CA", "IL", "TX", "NY", "TN", "MO")
  states1 <- "IL"
  cities <- c("New York", "Los Angeles", "Chicago", "Houston", "New York", "Nashville", "St Louis")
  cities1 <- "Chicago"
  homevalues <- c(700000, 1100000, 500000, 550000, 850000, 400000, 350000)
  homevalues1 <- 800000
  dependents <- c(0, 1, 1, 3, 0, 0, 1)
  dependents1 <- 2
  employed <- c("Yes", "Yes", "Yes", "No", "No", "Yes", "Yes")
  employed1 <- "Yes"
  incomes <- c(100000, 80000, 65000, 10000, 90000, 150000, 75000)
  incomes1 <- 60000
  creditScore <- c(550, 470, 670, 720, 540, 600, 780)
  creditScore1 <- 690
  
  data <- data.frame(Name = names, Age = ages, State = states, City = cities, Dependents = dependents, Job = employed, CS = creditScore, Income = incomes, Home = homevalues)
  singleData <- data.frame(Name = names1, Age = ages1, State = states1, City = cities1, Dependents = dependents1, Job = employed1, CS = creditScore1, Income = incomes1, Home = homevalues1)  
  
  output$table1 <- renderDT({
    datatable(singleData, options = list(dom = 't', scrollX = TRUE))
  })
  
  output$table2 <- renderDT({
    datatable(data, options = list(scrollX = TRUE))
  })
}

shinyApp(ui, server)

Solution

I was able to figure out a solution for this. Essentially, I created a javascript function in the UI that made the table and the corresponding headers scroll with the other table and headers. Then in the server portion of my code I added drawCallback to the datatables code to utilize the javascript function.

library(shiny)
library(shinydashboard)
library(DT)

# Define UI
ui <- dashboardPage(
  dashboardHeader(title = "Synchronized DataTables"),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    tabsetPanel( 
      tabPanel("Synchronized Tables",
               fluidRow(
                 box(DTOutput("table1"), width = 12),
                 box(DTOutput("table2"), width = 12)
               )
      )
    ),
    # Inject JavaScript to synchronize the scroll after tables are rendered
tags$script(HTML("
  function syncScroll() {
    var credit_comp_tableBody = $('#credit_comp_table').find('.dataTables_scrollBody');
    var tableBody = $('#table').find('.dataTables_scrollBody');
    var credit_comp_tableHead = $('#credit_comp_table').find('.dataTables_scrollHead');
    var tableHead = $('#table').find('.dataTables_scrollHead');

    if (credit_comp_tableBody.length && tableBody.length) {
      // Remove previous scroll listeners
      credit_comp_tableBody.off('scroll');
      tableBody.off('scroll');

      // Sync scroll
      credit_comp_tableBody.on('scroll', function() {
        tableBody.scrollLeft($(this).scrollLeft());
        credit_comp_tableHead.scrollLeft($(this).scrollLeft());
        tableHead.scrollLeft($(this).scrollLeft());
      });
      tableBody.on('scroll', function() {
        credit_comp_tableBody.scrollLeft($(this).scrollLeft());
        credit_comp_tableHead.scrollLeft($(this).scrollLeft());
        tableHead.scrollLeft($(this).scrollLeft());
      });
    }
  }
"))
  )
)

# Define server logic
server <- function(input, output) {
  output$table1 <- renderDT({
    datatable(
      mtcars,
      options = list(scrollX = TRUE, 
drawCallback = JS('function() { syncScroll(); }')
) # Enable horizontal scrolling
    )
  })

  output$table2 <- renderDT({
   datatable(
      mtcars,
      options = list(scrollX = TRUE,
                     drawCallback = JS('function() { syncScroll(); }')
    ) 
    )
  })
}

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