Synchronize horizontal scrolling of two handsontables

Question

I'd like to synchronize the scrolling of two handsontables in a shiny app. I tried some attempts based on proposals given here and here. I also tried with the jquery.scrollSync library, my code is below. Nothing works.

library(shiny)
library(rhandsontable)

ui = shinyUI(fluidPage(

  tags$head(tags$script(src = "http://trunk.xtf.dk/Project/ScrollSync/jquery.scrollSync.js")),

  sidebarLayout(

    sidebarPanel(),

    mainPanel(

      rHandsontableOutput("hot", width = 350),
      rHandsontableOutput("hot2", width = 350),

      singleton(
        tags$script(HTML('$("#hot").addClass("scrollable");'))
      ),
      singleton(
        tags$script(HTML('$("#hot2").addClass("scrollable");'))
      ),
      singleton(
        tags$script(HTML('$(".scrollable").scrollSync();'))
      )

    )
  )
))

server = shinyServer(function(input, output, session) {

  values = reactiveValues()

  data = reactive({
    if (!is.null(input$hot)) {
      DF = hot_to_r(input$hot)
    } else {
      if (is.null(values[["DF"]]))
        DF = mtcars[1:3,]
      else
        DF = values[["DF"]]
    }
    values[["DF"]] = DF
    DF
  })

  output$hot <- renderRHandsontable({
    DF = data()
    if (!is.null(DF))
      rhandsontable(DF, stretchH = "all")
  })

  output$hot2 <- renderRHandsontable({
      rhandsontable(mtcars[1:3,], stretchH = "all")
  })

})


runApp(list(ui=ui, server=server))

Edit

Below is an unsuccessful attempt to use scrollViewportTo.

library(shiny)
library(rhandsontable)

jscode <- "
$('#scroll').on('click', function () {
  $('#hot').scrollViewportTo(1,5);
});
"

ui = shinyUI(fluidPage(

  sidebarLayout(

    sidebarPanel(

      actionButton("scroll", "Scroll")

    ),

    mainPanel(

      rHandsontableOutput("hot", width = 350),

      singleton(
        tags$script(HTML(jscode))
      )

    )
  )
))

server = shinyServer(function(input, output, session) {

  values = reactiveValues()

  data = reactive({
    if (!is.null(input$hot)) {
      DF = hot_to_r(input$hot)
    } else {
      if (is.null(values[["DF"]]))
        DF = mtcars[1:3,]
      else
        DF = values[["DF"]]
    }
    values[["DF"]] = DF
    DF
  })

  output$hot <- renderRHandsontable({
    DF = data()
    if (!is.null(DF))
      rhandsontable(DF, stretchH = "all")
  })

})


runApp(list(ui=ui, server=server))

Answer 1

A solution. My case is specific: the second table has only one row, with the same number of columns as the first table, and the user only scrolls the first table.

It is also possible to have the same column widths for the two tables, but this is not done in the code below.

It would be better if the scrolling were not continuous, if it jumped row by row. Solved: see the edit at the end.

library(shiny)
library(rhandsontable)

js_getViewport <- "
$(document).ready(setTimeout(function() {
  var hot_instance = HTMLWidgets.getInstance(hot).hot
  hot_instance.updateSettings({width: hot_instance.getSettings('width').width + Handsontable.Dom.getScrollbarWidth(hot)})
  var colPlugin = hot_instance.getPlugin('autoColumnSize');
  hot_instance.addHook('afterScrollHorizontally', function(){changeViewport2(colPlugin)});
}, 2000)
)
"
js_setViewport <- "
function changeViewport2 (colPlugin) {
  var colStart = colPlugin.getFirstVisibleColumn();
  var hot2_instance = HTMLWidgets.getInstance(hot2).hot;
  hot2_instance.scrollViewportTo(0, colStart, false, false);
};
"

ui = shinyUI(fluidPage(
  tags$head(tags$script(HTML(js_getViewport)),
            tags$script(HTML(js_setViewport))),

  sidebarLayout(

    sidebarPanel(

    ),

    mainPanel(

      rHandsontableOutput("hot",  height=200),

      br(),

      rHandsontableOutput("hot2", height=100)

    )
  )
))

server = shinyServer(function(input, output, session) {

  values = reactiveValues()

  data = reactive({
    if (!is.null(input$hot)) {
      DF = hot_to_r(input$hot)
    } else {
      if (is.null(values[["DF"]]))
        DF = mtcars[,]
      else
        DF = values[["DF"]]
    }
    values[["DF"]] = DF
    DF
  })

  rowHeaderWidth <- reactive({
    max(100,floor(max(nchar(rownames(values[["DF"]])))*8))
  })

  output$hot <- renderRHandsontable({
    DF = data()
    if (!is.null(DF))
      rhandsontable(DF, stretchH = "none", useTypes=TRUE,
                    width = 500, 
                    rowHeaderWidth = rowHeaderWidth())
  })

  output$hot2 <- renderRHandsontable({
      rhandsontable(mtcars[1,], stretchH = "none", useTypes=TRUE,
                    width = 500,
                    rowHeaderWidth = rowHeaderWidth())
  })


})


runApp(list(ui=ui, server=server))

EDIT:

For a better alignment, use:

js_setViewport <- "
function changeViewport2 (colPlugin) {
  var colStart = colPlugin.getFirstVisibleColumn();
  var hot2_instance = HTMLWidgets.getInstance(hot2).hot;
  hot2_instance.scrollViewportTo(0, colStart, false, false);
  //
  var hot_instance = HTMLWidgets.getInstance(hot).hot;
  var rowStart = hot_instance.getPlugin('autoRowSize').getFirstVisibleRow();
  hot_instance.scrollViewportTo(rowStart, colStart, false, false);
};