Odd Hypothesis
The other other alternative to H0
2022/04/26
re:Introduction
2016/04/12
Desktop DeployR
I'm going to be giving a talk this Thursday at my local R/Data Science Meetup about my method for deploying self contained desktop R applications. Since my original post on the subject (over 2 years ago!) I've made many of improvements thanks to the many useful comments I received and my own "dog-fooding".
So many in fact that the framework is a project in its own right, which I'm calling DesktopDeployR. This post will officially document the changes I've made and share the project to the greater R/Data Science community.
If you haven't already, I recommend reading my original post to understand the fundamentals of how such deployments are done.
For the impatient, the TL;DR summary is: on a Windows system, use R-Portable and Windows Scripting Host to launch a Shiny app in a user's default web browser.
Changes
System and R scripts for app launch are more separated from app specific code. Specifically, the framework's directory structure is now:
<app>/+- app/| +- library/ # <- private app library| +- shiny/ # <- where shiny app files go| +- app.R| +- config.cfg| +- packages.txt+- dist/ # <- the core framework| +- R-Portable/| +- script/+- log/+- appname.batThis means you can drop a pre-made Shiny application alongside the launch framework and it should work with minimal effort.
Being app-agnostic also means that the the framework is not specific to Shiny apps. I have successfully tested it with RGtk and Tcl/Tk based apps as well. It is just a matter of putting the necessary code to start your app in
app.R
. For a Shiny app, this is simply the following line:shiny::runApp('./app/shiny')App launch is configurable via a JSON config file (shown above in the
app/
folder). There are options to configure:- the path to an R installation, so that a system one can be specified instead of R-Portable, making the deployed app size smaller (if that's important to you).
- the CRAN mirror to use for installing package dependencies
- where error logs are stored - e.g. with the app in the
log/
folder or in a user's home directory on the system.
Windows Scripting Host scripts are now written in Javascript, because it was a mistake to use VBScript, especially with regards to parsing JSON config files.
Primary app package dependencies are specified in a
packages.txt
file which is used to create a private package library when the app is first launched. This was inspired byrequirements.txt
files used to install a set of Python packages usingpip
.The private library is added to
.libPaths()
at launch, so modifying anRprofile.site
file is no longer necessary.Primary app package dependencies are also "ensured", meaning if they change (i.e. new ones are added) they are installed into the private library the next time the app is launched.
There is a GUI progress bar displayed during launch that updates as primary package dependencies are loaded. This is useful feedback that the app is actually doing something, especially if there a many dependencies to load.
As before, you still need to download the version of R-Portable you need and install it into a template framework that you clone for each deployment. However, Since the app uses a private library for dependencies, the R-Portable install can stay and be launched "vanilla", which makes swapping it out (e.g. for upgrades) much easier.
Chrome Portable is no longer part of the framework. It behaved very inconsistently and would generate errors that I hadn't a clue how to debug. The current crop of browsers (IE10+ included) all work well with Shiny. This is also a moot point if you're deploying a non-Shiny app.
Availability
Now that the framework is more portable, I can also more easily open source it. If you want to give it a try with your own projects the GitHub repository is here. I'd also appreciate any feedback (or help) to make it better.
Happy DesktopDeployR-ing!
2015/10/20
Paging Widget for Shiny Apps
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
andnext
buttons depending on the currently
selected page (e.g. theprev
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 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,
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 inui.R
updatePageruiInput()
: 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.js
containing all the behavior and shiny input binding codeunderscore-min.js
a 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.
2015/10/10
Facing your data
A few years ago, I came across a post on FlowingData about using Chernoff Faces as a fun way to visualize multidimensional data:
> The assumption is that we can read people's faces easily in real life,
> so we should be able to recognize small differences when they represent data.
> Now that's a pretty big assumption, but debate aside, they're fun to make.
I showed this concept to a coworker, who found it amusing and championed (albeit in jest) making an application to enable scientists at our company to use faces as a standard visualization for data analysis and reporting. From that point on it was one of our running jokes to “face” our data. Unfortunately, being that the company was small and everyone (including myself) was always busy, there was rarely any spare time to devote to this. That is, until now …
I recently accepted a position at UCSD and had a week off between the last day at my old job and the first day at my new job. I thought this would be a good time to build a shiny
application for plotting data with Chernoff Faces.
Chernoff Faces in R
To plot Chernoff Faces in R, one uses the faces()
function from the aplpack
package:
library(aplpack)
#> Loading required package: tcltk
faces(mtcars)
#> effect of variables:
#> modified item Var
#> "height of face " "mpg"
#> "width of face " "cyl"
#> "structure of face" "disp"
#> "height of mouth " "hp"
#> "width of mouth " "drat"
#> "smiling " "wt"
#> "height of eyes " "qsec"
#> "width of eyes " "vs"
#> "height of hair " "am"
#> "width of hair " "gear"
#> "style of hair " "carb"
#> "height of nose " "mpg"
#> "width of nose " "cyl"
#> "width of ear " "disp"
#> "height of ear " "hp"
As shown above, the side-effects of this function are:
- a plot of faces, each representing individual rows of the data
- a printed
data.matrix
displaying how variables (columns) in the data are mapped to facial features.
mtcars
data set - e.g. Honda Civic, Toyota Corolla, and Fiat 128.
There are a couple quirks:
- data needs to be all numeric - any
character
orfactor
columns need to be handled (converted) appropriately - the face drawing algorithm takes a bit of time - I wouldn’t recommend it for input data with more than 500 observations. In my opinion, anything more than a 10x10 grid of faces becomes visually overwhelming.
Cleaning your face … data
Because the data to faces()
needs to be numeric, here’s what happens when trying to draw faces using the iris
data set:
faces(iris)
#> Error in x - min(x): non-numeric argument to binary operator
This error occurs because the Species
column is a factor:
str(iris)
#> 'data.frame': 150 obs. of 5 variables:
#> $ Sepal.Length: num 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
#> $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
#> $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
#> $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
#> $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
Converting this column to its numeric equivalent successfully creates faces:
set.seed(1234)
sample_rows = sample(1:nrow(iris), 25)
tmp = iris[sample_rows,]
tmp$Species = as.numeric(tmp$Species)
faces(tmp, print.info=F)
Alternatively, the Species
column could be excluded from the data sent to faces()
and used for labeling:
tmp = iris[sample_rows,]
labels = as.character(tmp$Species)
tmp = tmp[-which(colnames(tmp) == 'Species')]
faces(tmp, labels = labels, print.info=F)
Considering the above, a couple helper functions are in order. One to produce labels from character
columns:
label_data = function(data) {
if (is.null(data)) {
return(NULL)
}
col_classes = sapply(data, class)
cols_char = which(sapply(data, inherits, what='character'))
labels = NULL
if (length(cols_char)) {
if (length(cols_char) > 1) {
labels = do.call(paste, c(as.list(data[,cols_char]), sep=', '))
} else {
labels = data[[cols_char]]
}
}
return(labels)
}
and one to remove any character
columns and convert factor
columns to numeric values:
clean_data = function(data) {
# faces expects a data.matrix-like object with all numeric columns
if (is.null(data)) {
return(NULL)
}
col_classes = sapply(data, class)
cols_char = which(sapply(data, inherits, what='character'))
cols_fctr = which(sapply(data, inherits, what='factor'))
# try to preserve character columns as labels (row.names)
if (length(cols_char)) {
tryCatch({
row_names = if (length(cols_char) > 1) {
do.call(paste, c(as.list(data[,cols_char]), sep=', '))
} else {
data[[cols_char]]
}
rownames(data) = row_names
},
error = function(e) {
# unable to parse rownames, drop completely
message(sprintf('unable to assign row names: %s', e$message))
},
finally = {
data = data[-cols_char]
}
)
}
# convert factor columns to integer
if (length(cols_fctr)) {
data[,cols_fctr] = sapply(data[,cols_fctr], as.integer)
}
return(data)
}
Paginated faces
Plotting faces()
for all 150 rows in the iris
dataset takes nearly three seconds on my 5yr old laptop:
system.time({faces(clean_data(iris), print.info=F)})
#> user system elapsed
#> 2.61 0.23 2.84
So providing smaller chunks of data to faces()
will be necessary to keep a shiny
application nice and responsive. Splitting iris
into multiple 50-row “pages” is much more snappy:
system.time({
sample_rows = 1:50
faces(clean_data(iris)[sample_rows,], print.info=F)
})
#> user system elapsed
#> 0.86 0.11 0.97
system.time({
sample_rows = 51:100
faces(clean_data(iris)[sample_rows,], print.info=F)
})
#> user system elapsed
#> 0.89 0.08 0.97
system.time({
sample_rows = 101:150
faces(clean_data(iris)[sample_rows,], print.info=F)
})
#> user system elapsed
#> 0.89 0.07 0.95
While faces()
can perform normalization, it only operates on the data provided. Paging prior to calling faces()
requires that the entire data set be normalized beforehand. Hence a scale_data()
function is needed:
scale_data = function(data) {
# normalizes data to [-1,1] which faces(scale=T) does
apply(data, 2, function(x) {
(x - min(x)) / (max(x) - min(x)) * 2 - 1
})
}
Thus the workflow to produce faces for any given page of data is:
data = scale_data(clean_data(raw_data))
page_rows = # ... code to create a list of row indices for pages ... #
# for page_num in 1:length(page_rows) ...
data_page = data[page_rows[[page_num]], ]
face_page = faces(data_page, scale=F, print.info=F, plot.faces=F)
plot(face_page)
Shiny faces
The complete application, DFaceR (pun intended), is published on shinyapps.io. Source code is available on GitHub.
All of the core face plotting functionality was straight forward to build into a shiny
application. The tricky part was building the data paging functionality.
The path of least resistance would have been to use either a numericInput
or sliderInput
to page through the data. However, I wanted nice page number and prev/next buttons as can be gotten on a dataTables.js
table. A quick internet search produced nothing that matched my needs. So, I created my own widget for this which I’ll describe in more detail in an upcoming post.
For now, enjoy “facing” your data.
Written with Rmarkdown and StackEdit.