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 prev and next buttons depending on the currently
  selected page (e.g. the prev button 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 it
• getValue: return the widget’s value (can be JSON if complex)
• setValue: not used
• subscribe: binds event callbacks to the widget, optionally specifying use of
  a rate policy. Note the use of jQuery event namespacing
• unsubscribe: unbinds event callbacks on the widget – again using jQuery event
  namespacing
• getRatePolicy: 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,

• initialize
• receiveMessage

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 in ui.R
• updatePageruiInput(): to update the widget with new data, used in server.R

Generating the HTML for the widget

The widget requires two javascript files:

• input_binding_pager-ui.js containing all the behavior and shiny input binding code
• underscore-min.js a dependency of pagerui_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.