Search functionality for multiple rhandsontables in a shiny app

Question

I have a shiny app with multiple tabs in which I am rendering rhandsontable and would like to provide a search capability. This is the module I have written for rendering such a table with search :

# Module for rendering rhandsontable with search
rtable_UI <- function(id) {
  ns <- NS(id)
  tagList(
    textInput("searchField", "Search"),
    rhandsontable::rHandsontableOutput(ns('table_output'))
  )
}

rtableServer <- function(id, df) {
  moduleServer(id, function(input, output, session) {
    output$table_output <- rhandsontable::renderRHandsontable({
      rhandsontable::rhandsontable(df, search = TRUE)
    })
  })
}

Note that searchField is not in its namespace. If I try ns("searchField" ) the search functionality does not work in my shiny app:

# Shiny App
ui <- navbarPage(
  "example",
  tabPanel(
    'First Tab',
    rtable_UI('table1')
  ),
  tabPanel(
    'Second Tab',
    rtable_UI('table2')
  )
)

server <- function(input, output, session){
  rtableServer('table1', iris)
  rtableServer('table2', mtcars)
}

shinyApp(ui, server)

The search functionality only works for the first tab and I think that’s because the ids of the search fields are the same. However changing the id also doesn’t seem to be an option as can be seen here. Is there some way of making the rhandsontable aware of the namespace?

Answer 1

This was a rather painful exercise! RHandsontable really really wanted to be in charge of the search... I digress.

If you added more tables, the only thing you would need to add is where I wrote tbr[1].classList.add('active'); /* so the data is avail */. Upon loading only the first tab is loaded. You need all the tabs to be loaded for the code to work. This only has to happen one time, so if there were three tables, for example, you would need to add tbr[2].classList.add('active');.

I didn't use any string safeguards (setting it to lowercase, trimming whitespace, etc.).

I changed the id for the search input box to searcher here so that it is unrecognized for the rhandsontable package. This has to match the id used in the JS, so if you change this string here, it has to change there, as well.

rtable_UI <- function(id) {
  ns <- NS(id)
  tagList(
    textInput(ns("searcher"), "Search"),
    rhandsontable::rHandsontableOutput(ns('table_output'))
  )
}

This is unchanged.

rtableServer <- function(id, df) {
  moduleServer(id, function(input, output, session) {
    output$table_output <- rhandsontable::renderRHandsontable({
      rhandsontable::rhandsontable(df, search = T)
    })
  })
} 

For the ui, I added tagList, tags$head, one style tag, and two scripts. One script is the changes needed to the Shiny rendering; the other script is the search function. Some of what is coded here could definitely have been done with the tag functions between shiny and htmltools, but this was a bit easier for me.

ui <- tagList(
  tags$head(
    tags$style(HTML(
      ".htSearchResult {background-color: rgb(252, 237, 217);}")),
    tags$script(type="text/javascript", HTML("setTimeout(function(){
      var tbr = document.querySelectorAll('.tab-pane');
      tbr[1].classList.add('active'); /* so the data is avail */
      var inStr = document.querySelectorAll('input');        /*the input boxes*/
      var widg = document.querySelectorAll('.html-widget');  /*the tables boxes*/
      for(i = 0; i < widg.length; i++) {
        var wId = widg[i].getAttribute('id');                /* collect table IDs */
        inStr[i].className = '';             /* disassociate rhandstable search */
        inStr[i].style.cssText = 'cursor: pointer; font-size: 1em; line-height: 1.5em; padding: 6px 12px; display: block; width: 70%;';
          /* collect label and input box; add event without rhandsontable interference */
        var par = inStr[i].parentElement    
        var ipar = par.children[0].outerHTML;
        var str = inStr[i].outerHTML;
        var html = '\"replacer(\\'' + wId + '\\')\"';
        str = str.replace('>', ' onkeyup=' + html + '>');
        par.innerHTML = ipar + str;
      }
      }, 100)")),
      tags$script(type="text/javascript", HTML("function replacer(tbl) {
        $('#' + tbl).first().find('.htSearchResult').removeClass('htSearchResult'); /*remove previous search highlight*/
        var searchword = $('#' + tbl.substring(0,6) + '-searcher').val();       /* collect input */
        var custfilter = new RegExp(searchword, 'ig');                 /* setup input for search */
        if (searchword !== '') {
          looker = document.querySelector('#' + tbl);
          tellMe = looker.querySelectorAll('td');     /*look at all table cells of specific table*/
          for(i = 0; i < tellMe.length; i++) {
            tm = tellMe[i].innerText.toString();    
            if(tm.includes(searchword)){
              console.log(tellMe[i]);
              tellMe[i].classList.add('htSearchResult');    /*highlight partial match table cells*/
            }
          }
        }
      }"))),
  navbarPage(
    "example",
    tabPanel(
      'First Tab',
      rtable_UI('table1')
    ),
    tabPanel(
      'Second Tab',
      rtable_UI('table2')
    )
  ))

The call for server was not changed.

server <- function(input, output, session){
  rtableServer('table1', iris)
  rtableServer('table2', mtcars)
}

shinyApp(ui, server)

Updated for Scrolling

Alright—this update is about scrolling and ensuring that the text is highlighted.

I know that what you're working with now doesn't mirror what's in this answer for a variety of reasons. First, I'll outline in words what I've done, then code (based on my original answer).

I essentially split the function replacer. For scrolling, you don't want to remove the highlight. So there's a function with all of the code (called addMore) that has everything except the first line of replacer. The replacer function has just the original first line, then calls the function addMore.

When you add the functions to create the search bars, the tables are not available. Therefore there is nothing to attach an onscroll event to. So I created a keydown event, so that the first time a table is searched, it removes the keydown event from the input box and adds a scroll event to the right element (widget's first child's first child). You may want to use a different event than keydown, because whatever you type first is not in the input box. (That could be annoying!)

First the addMore function

tags$script(type="text/javascript", HTML("
      function addMore(tbl) {
        var searchword = $('#' + tbl.substring(0,6) + '-searcher').val(); /* collect input */
        var custfilter = new RegExp(searchword, 'ig'); /* setup input for search */
        if (searchword !== '') {
          looker = document.querySelector('#' + tbl);
          tellMe = looker.querySelectorAll('td');   /*look at all table cells of specific table*/
          for(i = 0; i < tellMe.length; i++) {
            tm = tellMe[i].innerText.toString();    
            if(tm.includes(searchword)){
              console.log(tellMe[i]);
              tellMe[i].classList.add('htSearchResult');    /*highlight partial match table cells*/
            }
          }
        }
      }"))

The new replacer function.

  tags$script(type="text/javascript", HTML("function replacer(tbl) {
        $('#' + tbl).first().find('.htSearchResult').removeClass('htSearchResult'); /*remove previous search highlight*/
        addMore(tbl);
      }"))

This function is what deletes the keydown event and adds the onscroll event.

tags$script(type="text/javascript", HTML("function popOnce(inid, widd){
  win = document.querySelector('input#' + inid);                                    
  /*wait for the first attempt to search to add listeners for scroll*/
  var par = win.parentElement    
  var ipar = par.children[0].outerHTML;
  var str = win.outerHTML;
  rx = /onkeydown.*\"/g;
  str = str.replace(rx, '');
  par.innerHTML = ipar + str;
  widg = document.querySelector('div#' + widd);
  where = widg.querySelector('div.ht_master > div.wtHolder');
  where.addEventListener('scroll', function(){addMore(widd)});
}")),

Finally, the setTimeout function. In this function, I've added the onkeydown at the same time I added the onkeyup.

tags$script(type="text/javascript", HTML("setTimeout(function(){
  var tbr = document.querySelectorAll('.tab-pane');
  tbr[1].classList.add('active'); /* so the data is avail */
  var inStr = document.querySelectorAll('input[id*=\"searcher\"]');        /*the input boxes*/
  console.log(inStr[0].getAttribute('id'));
  var widg = document.querySelectorAll('.html-widget');  /*the tables boxes*/
  for(i = 0; i < widg.length; i++) {
    var wId = widg[i].getAttribute('id');                /* collect table IDs */
    var insid = inStr[i].getAttribute('id');
    inStr[i].className = '';             /* disassociate rhandstable searcher */
    inStr[i].style.cssText = 'cursor: pointer; font-size: 1em; line-height: 1.5em; padding: 6px 12px; display: block; width: 70%;';
      /* collect label and input box; add event without rhandsontable interference */
    var par = inStr[i].parentElement    
    var ipar = par.children[0].outerHTML;
    var str = inStr[i].outerHTML;
    var html = '\"replacer(\\'' + wId + '\\')\"';
    var html2 = '\"popOnce(\\'' + insid + '\\',\\'' + wId + '\\')\"';
    /*str = str.replace('>', ' onkeyup=' + html + '>'); original before highlight scrolling */
    str = str.replace('>', ' onkeyup=' + html + ' onkeydown=' + html2 + '>');
    par.innerHTML = ipar + str;
  }}, 400)")) 

This is the same code as above, but it's all together as one chunk of code.

rtable_UI <- function(id) {
  ns <- NS(id)
  tagList(
    textInput(ns("searcher"), "Search"),
    rhandsontable::rHandsontableOutput(ns('table_output'))
  )
}

rtableServer <- function(id, df) {
  moduleServer(id, function(input, output, session) {
    output$table_output <- rhandsontable::renderRHandsontable({
      rhandsontable::rhandsontable(df, search = T, height = 700)
    })
  })
}

# Shiny App
ui <- tagList(
  tags$head(
    tags$style(HTML("
      .htSearchResult {
        background-color: rgb(252, 237, 217);
      }
      .rhandsontable.html-widget {
        overflow: hidden;
      }")),
    # next function was replacer—without the removing the highlighting
    tags$script(type="text/javascript", HTML("
      function addMore(tbl) {     /* collect input */
        var searchword = $('#' + tbl.substring(0,6) + '-searcher').val();
        var custfilter = new RegExp(searchword, 'ig'); /* setup input for search */
        if (searchword !== '') {
          looker = document.querySelector('#' + tbl);
          tellMe = looker.querySelectorAll('td');     /*look at all table cells of specific table*/
          for(i = 0; i < tellMe.length; i++) {
            tm = tellMe[i].innerText.toString();    
            if(tm.includes(searchword)){
              console.log(tellMe[i]);
              tellMe[i].classList.add('htSearchResult');  /*highlight partial match table cells*/
            }
          }
        }
      }")),
    tags$script(type="text/javascript", HTML("function popOnce(inid, widd){
      win = document.querySelector('input#' + inid);                                    
      /*wait for the first attempt to search to add listeners for scroll*/
      var par = win.parentElement    
      var ipar = par.children[0].outerHTML;
      var str = win.outerHTML;
      rx = /onkeydown.*\"/g;
      str = str.replace(rx, '');
      par.innerHTML = ipar + str;
      widg = document.querySelector('div#' + widd);
      where = widg.querySelector('div.ht_master > div.wtHolder');
      where.addEventListener('scroll', function(){addMore(widd)});
    }")),
    tags$script(type="text/javascript", HTML("setTimeout(function(){
      var tbr = document.querySelectorAll('.tab-pane');
      tbr[1].classList.add('active'); /* so the data is avail */
      var inStr = document.querySelectorAll('input[id*=\"searcher\"]');   /*the input boxes*/
      console.log(inStr[0].getAttribute('id'));
      var widg = document.querySelectorAll('.html-widget');  /*the tables boxes*/
      for(i = 0; i < widg.length; i++) {
        var wId = widg[i].getAttribute('id');                /* collect table IDs */
        var insid = inStr[i].getAttribute('id');
        inStr[i].className = '';             /* disassociate rhandstable searcher */
        inStr[i].style.cssText = 'cursor: pointer; font-size: 1em; line-height: 1.5em; padding: 6px 12px; display: block; width: 70%;';
          /* collect label and input box; add event without rhandsontable interference */
        var par = inStr[i].parentElement    
        var ipar = par.children[0].outerHTML;
        var str = inStr[i].outerHTML;
        var html = '\"replacer(\\'' + wId + '\\')\"';
        var html2 = '\"popOnce(\\'' + insid + '\\',\\'' + wId + '\\')\"';
        /* highlight scrolling modification */
        str = str.replace('>', ' onkeyup=' + html + ' onkeydown=' + html2 + '>');
        par.innerHTML = ipar + str;
      }}, 400)")),
  tags$script(type="text/javascript", HTML("function replacer(tbl) {
        $('#' + tbl).first().find('.htSearchResult').removeClass('htSearchResult'); /*remove previous search highlight*/
        addMore(tbl);
      }"))),
  navbarPage(
    "example",
    tabPanel(
      'First Tab',
      rtable_UI('table1')
    ),
    tabPanel(
      'Second Tab',
      rtable_UI('table2')
    )
  ))

server <- function(input, output, session){
  rtableServer('table1', iris)
  rtableServer('table2', mtcars)
}

shinyApp(ui, server)