In my last post I described how I built a shiny application called “DFaceR” 
that used Chernoff Faces to plot multidimensional data.  To improve application 
response time during plotting, I needed to split large datasets into more  
manageable “pages” to be plotted.
Rather than take the path of least resistance and use either numericInput or 
sliderInput widgets that come with shiny to interact with paginated data, I  
wanted nice page number and prev/next buttons like on a dataTables.js table.
In this post, I describe how I built a custom shiny widget called pager-ui  
to achieve this.
Prior to starting, I did some research (via google) for any preexisting shiny  
paging solutions.  However, nothing matched what I wanted.  So I set forth and 
built my own solution using the following framework:
- a couple of hidden numeric inputs to store the current page and total number 
of pages - jquery event handlers bound to change events on the above numeric inputs
 - a javascript function to render page number buttons based on the currently  
selected page and the total number of pages 
The solution I deployed with DFaceR used a template javascript file that was updated 
with the containing pager-ui element id when the widget was added to ui.R. 
Reading, reacting to, and updating the widget required directly accessing the  
hidden numeric inputs in server.R.
While this worked, it was not the formal way to build a custom input widget as 
described by this shiny developer article. 
Thankfully, only a little extra work was needed to build it the correct way.
Custom widget components
According to the developer article, a custom input requires the following:
- javascript code to 
- define the widget’s behavior (i.e. jQuery event handlers)
 - register an input binding object with 
shiny 
 - an R function to add the HTML for the widget to 
ui.R 
Widget layout
For reference, the (simplified) pager widget HTML is:
<div class="pager-ui">
  <!-- Input fields that Shiny will react to -->
  <div class="hidden">
    <input type="number" class="page-current" value="1" />
    <input type="number" class="pages-total" value="10" />
  </div>
  <div class="page-buttons">
    <!-- Everything in here is dynamically rendered via javascript -->
    <span class="btn-group">
      <button class="btn btn-default page-prev-button">Prev</button>
      <button class="btn btn-default page-next-button">Next</button>
    </span>
    <span class="btn-group">
      <!-- button for the current page has class btn-info -->
      <button class="btn btn-info page-num-button" data-page-num="1">1</button>
      <!-- other buttons have class btn-default -->
      <button class="btn btn-default page-num-button" data-page-num="2">2</button>
      <!-- ... rest of page num buttons ... -->
    </span>
  </div><!-- /.page-buttons -->
</div><!-- /.pager-ui -->
As a personal preference, I’ve put the prev and next buttons together in  
their own btn-group because it keeps their positions in the page consistent 
rather than have them jump around depending on how many page buttons are rendered.
Also note that the page-num buttons encode their respective page numbers in  
data-page-num attributes.
Everything in the div.page-buttons element is rendered dynamically via javascript.
The javascript …
As is probably the case with most widgets for shiny, most of the code for  
pager-ui is written in javascript.  This is understandable since much of the  
user facing interactivity happens in a web browser.
Making the widget behave
The pager widget has the following behaviors:
- in/de-crease the current page number with next/previous button clicks
 - set the current page number with page number button clicks
 - rerender the buttons as needed when the current page number changes
 - rerender the buttons as needed when the total number of pages changes
 
To keep things a little DRY, I use a simple object for accessing the specific 
pager-ui element being used:
PagerUI = function(target, locate, direction) {
  var me = this;
  me.root = null;
  me.page_current = null;
  me.pages_total = null;
  if (typeof locate !== 'undefined' && locate) {
    if (direction === 'child') {
      me.root = $(target).find(".pager-ui").first();
    } else {
      // default direction is to search parents of target
      me.root = $(target)
        .parentsUntil(".pager-ui")
        .parent();  // travers to the root pager-ui node
    }
  } else {
    // pager-ui node is explicitly specified
    me.root = $(target);
  }
  if (me.root) {
    me.page_current = me.root.find(".page-current");
    me.pages_total = me.root.find(".pages-total");
  }
  return(me);
};
This takes a selector or jQuery object in target for either specifying the 
specific pager-ui container used, or a starting point (e.g. a child button) 
from which to search for the container.
This keeps the event handler callbacks relatively short and easier to maintain. 
In total, there are four event handlers which map directly to the behaviors  
described above, all of them delegated to the document node of the DOM.
First, one to handle clicks from page-number buttons:
// delegate a click event handler for pager page-number buttons
$(document).on("click", "button.page-num-button", function(event) {
  var $btn = $(event.target);
  var page_num = $btn.data("page-num");
  var $pager = new PagerUI($btn, true);
  $pager.page_current
    .val(page_num)
    .trigger("change");
});
Next, a couple to handle clicks from previous and next buttons:
$(document).on("click", "button.page-prev-button", function(event) {
  var $pager = new PagerUI(event.target, true);
  var page_current = parseInt($pager.page_current.val());
  if (page_current > 1) {
    $pager.page_current
      .val(page_current-1)
      .trigger('change');
  }
});
$(document).on("click", "button.page-next-button", function(event) {
  var $pager = new PagerUI(event.target, true);
  var page_current = parseInt($pager.page_current.val());
  var pages_total = parseInt($pager.pages_total.val());
  if (page_current < pages_total) {
    $pager.page_current
      .val(page_current+1)
      .trigger('change');
  }
});
Finally, a couple handlers to catch change events on the hidden numeric fields 
and rerender the widget:
// delegate a change event handler for pages-total to draw the page buttons
$(document).on("change", "input.pages-total", function(event) {
  var $pager = new PagerUI(event.target, true);
  pagerui_render($pager.root);
});
// delegate a change event handler for page-current to draw the page buttons
$(document).on("change", "input.page-current", function(event) {
  var $pager = new PagerUI(event.target, true);
  pagerui_render($pager.root);
});
Rendering is done via the pagerui_render() function.  It is pretty long so  
check out the source (linked below) for the full details.  In a nutshell it:
renders all of the page-number buttons needed for the following cases, using
...spacer buttons when necessary:- current page is within the first 3 pages
 - current page is within the last 3 pages
 - current page is somewhere in the middle
 
sets the enabled state of the
prevandnextbuttons depending on the currently
selected page (e.g. theprevbutton is disabled if the current page is 1).
Shiny registration
To fully tie the widget to shiny it needs to be “registered”.  This basically 
provides a standard interface between the widget and shiny’s core javascript 
framework via an input binding object.
The shiny input binding for pager-ui is:
var pageruiInputBinding = new Shiny.InputBinding();
$.extend(pageruiInputBinding, {
  find: function(scope) {
    return( $(scope).find(".pager-ui") );
  },
  // getId: function(el) {},
  getValue: function(el) {
    return({
      page_current: parseInt($(el).find(".page-current").val()),
      pages_total: parseInt($(el).find(".pages-total").val())
    });
  },
  setValue: function(el, value) {
    $(el).find(".page-current").val(value.page_current);
    $(el).find(".pages-total").val(value.pages_total);
  },
  subscribe: function(el, callback) {
    $(el).on("change.pageruiInputBinding", function(e) {
      callback(true);
    });
    $(el).on("click.pageruiInputBinding", function(e) {
      callback(true);
    });
  },
  unsubscribe: function(el) {
    $(el).off(".pageruiInputBinding");
  },
  getRatePolicy: function() {
    return("debounce");
  },
  /**
   * The following two methods are not covered in the developer article, but
   * are documented in the comments in input_binding.js
   */
  initialize: function(el) {
    // called when document is ready using initial values defined in ui.R
    pagerui_render(el);
  },
  receiveMessage: function(el, data) {
    // This is used for receiving messages that tell the input object to do
    // things, such as setting values (including min, max, and others).
    if (data.page_current) {
      $(el).find(".page-current")
        .val(data.page_current)
        .trigger('change');
    }
    if (data.pages_total) {
      $(el).find(".pages-total")
        .val(data.pages_total)
        .trigger('change');
    }
  }
});
Shiny.inputBindings
  .register(pageruiInputBinding, "oddhypothesis.pageruiInputBinding");
Let’s break this apart …
There are nine methonds defined in the interface.  The first seven are documented 
by the developer article,
find: locate the widget and return a jQuery object reference to itgetValue: return the widget’s value (can be JSON if complex)setValue: not usedsubscribe: binds event callbacks to the widget, optionally specifying use of
a rate policy. Note the use of jQuery event namespacingunsubscribe: unbinds event callbacks on the widget - again using jQuery event
namespacinggetRatePolicy: specifies the rate policy to used - either “throttle” or
“debounce”
and are pretty close to the boilerplate examples with only a few custom changes.
First, the getValue method returns a JSON object with two properties  
(page_current and pages_total):
getValue: function(el) {
  return({
    page_current: parseInt($(el).find(".page-current").val()),
    pages_total: parseInt($(el).find(".pages-total").val())
  });
}
This means that when the widget is accessed in server.R via the input object,  
it will return a list() with the following structure:
List of 2
 $ page_current: int 1
 $ pages_total : int 4
Second, event callbacks are subscribed with a “debounce” rate policy:
subscribe: function(el, callback) {
  $(el).on("change.pageruiInputBinding", function(e) {
    callback(true);
  });
  $(el).on("click.pageruiInputBinding", function(e) {
    callback(true);
  });
},
getRatePolicy: function() {
  return("debounce");
}
This prevents excessive callback executions, and subsequent weird behavior, if  
the prev and next buttons are clicked too rapidly.
The last two methods of the input binding,
initializereceiveMessage
are ones that I added based on documentation I found in shiny’s  
source code for input bindings.
The initialize method is called when the document is ready, which I found 
necessary to, well, initialize the widget with default values.  For this widget, 
all that needs to happen is for it to be rendered for the first time.
initialize: function(el) {
  // called when document is ready using initial values defined in ui.R
  pagerui_render(el);
}
The receiveMessage method is used to communicate with the widget from server.R. 
In most cases, this will send a data update, but one could imagine other useful 
messages that could be sent.
receiveMessage: function(el, data) {
  // This is used for receiving messages that tell the input object to do
  // things, such as setting values (including min, max, and others).
  if (data.page_current) {
    $(el).find(".page-current")
      .val(data.page_current)
      .trigger('change');
  }
  if (data.pages_total) {
    $(el).find(".pages-total")
      .val(data.pages_total)
      .trigger('change');
  }
}
To finish up the input binding, it is registered with:
Shiny.inputBindings
  .register(pageruiInputBinding, "oddhypothesis.pageruiInputBinding");
As a good measure, I placed all of the above javascript in an  
immediately invoked function expression:
(function(){
  // ... code ...
}());
to ensure that I didn’t inadvertently overwrite any variables in the global scope.
All of the above javascript lives in one file that is placed in:
<app>
|- ui.R
|- server.R
|- global.R
+- www/
   +- js/
      +- input_binding_pager-ui.js  <-- here
The R code …
Compared to the javascript code, the R code is fairly simple.  There are two 
functions:
pageruiInput(): to put the widget in the layout, used inui.RupdatePageruiInput(): to update the widget with new data, used inserver.R
Generating the HTML for the widget
The widget requires two javascript files:
input_binding_pager-ui.jscontaining all the behavior and shiny input binding codeunderscore-min.jsa dependency ofpagerui_render()
These files only need to be referenced in the app once, regardless of how many 
pager-ui widgets are used.  Therefore, they are added using singleton() in 
the R code:
tagList(
  singleton(
    tags$head(
      tags$script(src = 'js/underscore-min.js'),
      tags$script(src = 'js/input_binding_pager-ui.js')
    )
  ),
  # ... rest of html generation code ...
)
The rest of the HTML generation code follows the layout specified earlier with 
special considerations for making the numeric input field ids unique by propagating 
the pager-ui id, and setting default numeric values.
pageruiInput = function(inputId, page_current = NULL, pages_total = NULL) {
  # construct the pager-ui framework
  tagList(
    singleton(
      tags$head(
        tags$script(src = 'js/underscore-min.js'),
        tags$script(src = 'js/input_binding_pager-ui.js')
      )
    ),
    # root pager-ui node
    div(
      id = inputId,
      class = 'pager-ui',
      # container for hidden numeric fields
      div(
        class = 'hidden',
        # numeric input to store current page
        tags$input(
          id = paste(inputId, 'page_current', sep='__'),
          class = 'page-current',
          type = 'number',
          value = ifelse(!is.null(page_current), page_current, 1),
          min = 1,
          max = ifelse(!is.null(pages_total), pages_total, 1)
        ),
        # numeric input to store total pages
        tags$input(
          id = paste(inputId, 'pages_total', sep='__'),
          class = 'pages-total',
          type = 'number',
          value = ifelse(!is.null(pages_total), pages_total, 0),
          min = 0,
          max = ifelse(!is.null(pages_total), pages_total, 0)
        )
      ),
      # container for pager button groups
      div(
        class = 'page-buttons',
        # prev/next buttons
        span(
          class = 'page-button-group-prev-next btn-group',
          tags$button(
            id = paste(inputId, 'page-prev-button', sep='__'),
            class = 'page-prev-button btn btn-default',
            'Prev'
          ),
          tags$button(
            id = paste(inputId, 'page-next-button', sep='__'),
            class = 'page-next-button btn btn-default',
            'Next'
          )
        ),
        # page number buttons
        # dynamically generated via javascript
        span(
          class = 'page-button-group-numbers btn-group'
        )
      )
    )
  )
}
To update the widget from server.R there is an updatePageruiInput() function 
whose body was effectively copied from other update*() functions that are used 
for other inputs (notably text and numeric inputs).
updatePageruiInput = function(
  session, inputId, page_current = NULL, pages_total = NULL) {
  message = shiny:::dropNulls(list(
    page_current = shiny:::formatNoSci(page_current),
    pages_total = shiny:::formatNoSci(pages_total)
  ))
  session$sendInputMessage(inputId, message)
}
Thus, to add a pager-ui widget to a shiny ui:
# ui.R
shinyUI(pageWithSideBar(
  headerPanel(...),
  sidebarPanel(...),
  mainPanel(
    pageruiInput(inputId='pager', page_current = 1, pages_total = 1),
    ...
  )
))
On the server side, the value from the widget is accessed by:
# server.R
shinyServer(function(input, output, session) {
  # ...
  pager_state = reactive({
    input$pager
  })
  # ...
}
which will return a list with two elements page_current and pages_total.
To update the widget from server.R simply call updatePageruiInput() as needed:
# server.R
shinyServer(function(input, output, session) {
  # ...
  observeEvent(
    eventExpr = {
      input$btn_update_page
    },
    handlerExpr = {
      new_page = # ... code to determine new page ...
      updatePageruiInput(session, 'pager', page_current = new_page)
    }
  )
  # ...
})
See for yourself
The source code for a demo shiny app that uses this widget, and contains all the 
code needed to add this widget to other apps is  
available on Github.
Happy paging.
Written with StackEdit.




