How to build htmlwidgets

Posted 6 Oct 2018

What is an htmlwidget?

An htmlwidget lets you integrate Javascript and R, it is not limited to visualisation libraries but was designed with it in mind and as such will work extremely well with the latter. As stated on the htmlwidgets website:

Bring the best of JavaScript data visualization to R

This article aims at demonstrating:

  1. The ease with which one can build an htmlwidget such as plotly or leaflet.
  2. The surprisingly little knowledge of JavaScript that is required to build such an htmlwidget.
  3. Some amazing undocumented features of htmlwidgets.

This article assumes you do not have much knowledge of JavaScript but nonetheless expects that you are somewhat familiar with the language and how it works, despite the fact that you may never have written any JavaScript. A good understanding of JSON goes a long way.

To explain how to build such a widget, we shall make one together: gior, an htmlwidget for gio.js. You can visit the shiny demo to see what we will achieve, the source code sits on Github. Below is an example of the end product

# devtools::install_github("JohnCoene/gior")
library(gior)

data("country_data")

country_data %>%
  gior() %>%
  g_data(from, to, value)


Setup

Let’s setup an htmlwidget, the latter being designed by RStudio it’s very easy. Here we get you setup from scratch, if you want to just get on with building the widget you can clone base-gior and skip to the “How do these work together” section. base-gior is the initial setup, it includes the required JavaScript files and some data for you to test your functions as you build your package, see the Github repository for more details. If you do not start from gior-base and would rather build everything from scratch start by running the following:

  1. Create a package as you normally would, either with the RStudio interface, or devtools.
  2. Run the magical htmlwidgets::scaffoldWidget("gior") to create an htmlwidget called gior.

Note that if you decide to call the widget something other than gior some things such as function names might differ from what is detailed here.

The second command will create the following folder structure and, if ran within the RStudio IDE, will open the gior.R, gior.js and gior.yaml; the core files of an htmlwidget.

R/
| gior.R

inst/
|-- htmlwidgets/
|   |-- gior.js
|   |-- gior.yaml

In actual fact, at this point you already have a working htmlwidget. If you look at the gior.R file that was created you will see a function named gior ẁhich takes, amongst other arguments, message. You can thus document and build your pacakge.

# install.packages("devtools")

# create man pages of our newly function
devtools::document()

# Build the package
# or CTRL/CMD + SHIFT + B in RStudio
devtools::install()

library(gior)

gior(message = "Hello htmlwidgets")

This will display your message in the RStudio Viewer or browser: you have a working htmlwidget. However, it’s not doing much right now. Let’s get it to do interesting things.

The first thing we need to do is to add the required JavaScript files. We want to create a lib folder under inst/htmlwidgets which will hold the source JavaScript scripts. If you are somewhat unfamiliar with R packages, an R package expects a certain directory structure; the inst directory stands for installation, this is where we put files that must be installed as is.

Looking at the documentation of gio.js we see that the library depends on three.js, we are therefore going to need both files three.min.js and gio.min.js. In HTML you would do it like so:

<script src="path/to/three.min.js"></script>
<script src="path/to/gio.min.js"></script>

It works slightly differently with htmlwidgets though it produces the exact same, we’ll see that eventually. First we are going to need those files, download them (gio.js, three-js). Under the lib diretory create two folders (one for each libraries), you can name them however you want but I called them gio-2.0 and three, those will hold our files JavaScript files (.min.js). files. The directory structure you obtain should look like this:

R/
| gior.R

inst/
|-- htmlwidgets/
|   |-- gior.js
|   |-- gior.yaml
|   |-- lib/
|   |   |-- gio-2.0/
|   |   |   |-- gio.min.js
|   |   |-- three/
|   |   |   |-- three.min.js

Now that we have our JavaScript files in the inst folder we must add them to our gior.yml file which currently looks like this:

# (uncomment to add a dependency)
# dependencies:
#  - name:
#    version:
#    src:
#    script:
#    stylesheet:

The .yml file holds our dependencies. We have put them in the lib directory but unless we reference them in our .yml they will not do anything and simply be downloaded when the package is installed.

dependencies:
 - name: three
   version: 97
   src: htmlwidgets/lib/three
   script: three.min.js
 - name: gio
   version: 2.0
   src: htmlwidgets/lib/gio-2.0
   script: gio.min.js

It is therefore important to list the dependencies in the correct order, gio.min.js depends on three.min.js and not vice versa, list them accordingly in gior.yml. This is how we source our files, bear with me as we first go through the other files created by htmlwidgets::scaffoldWidget.

Your Javascript functions will be in gior.js which, after running htmlwidgets::scaffoldWidget("gior"), looks like:

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        el.innerText = x.message;

      },

      resize: function(width, height) {}

    };
  }
});

We won’t touch that file just yet, leave it as is.

Below is the very R function that will create your htmlwidget, note that htmlwidgets::createWidget is rendered on print and not before! We will see later why this is interesting.

gior <- function(message, width = NULL, height = NULL, elementId = NULL) {

  # forward options using x
  x = list(
    message = message
  )

  # create widget
  htmlwidgets::createWidget(
    name = 'gior',
    x,
    width = width,
    height = height,
    package = 'test',
    elementId = elementId
  )
}

The gior.R file will also include the shiny “magic” bindings: giorOutput & renderGior. They are magic because they make your htmlwidget work with Shiny without you ever having to touch them (at least, I never had to ), add the roxygen2 documentation but leave the code as is.

Now that we have set up everything let’s take a quick look at the “widget” our package creates. Make sure you document and rebuild the package.

# create man pages of our newly function
devtools::document()

# Build the package
# or CTRL/CMD + SHIFT + B in RStudio
devtools::install()

library(gior)

gior(message = "Hello htmlwidgets")

First we see our message (Hello htmlwidgets) displayed in the RStudio Viewer. This already tells us that the message we wrote has been passed to JavaScript and rendered as HTML. Then open the visualisation in your browser (using the button a the top of the Viewer) and look at the source (CTRL/CMD + SHIFT + U from the browser), at the top, within the <head></head> tags you should see.

<script src="lib/htmlwidgets-1.3/htmlwidgets.js"></script>
<script src="lib/three-97/three.min.js"></script>
<script src="lib/gio-2/gio.min.js"></script>
<script src="lib/gior-binding-0.0.1/gior.js"></script>

The first is the JavaScript htmlwidget library, following that we see the files we specified in the gior.yml files and finally our bindings, gior.js. These should appear as links in your source, I recommend checking that they are all working by clicking these. An issue likely means that you have not referenced the correct paths in your gior.yml. If it works fine we are done with gior.yml which we won’t be changing from here onwards.

By inspecting the HTML (CTRL/CMD + SHIFT + I) you should also see that the message is included in a div.

How do these files work together?

At this point, we went through each file individually but we did not tackle how they work together. They obviously have to since R is “talking to” JavaScript (.R to .js). So far we should understand that our R function passes the message to our JavaScript binding gior.js and create a div.

gior(message = "Hello htmlwidgets")

Our message is displayed in the RStudio viewer or browser. Looking at the source of the gior function we see that the argument message is added to a list x which is passed to the function htmlwidgets::createWidget(). Now let’s see how this is handled by gior.js.

el.innerText = x.message;

innerText is a JavaScript function that lets you add text to an element el which is the element created by htmlwidgets.

gior(message = "Hello htmlwidgets", elementId = "my-viz")

If you run the function above then inspect your visualisation (CTRL/CMD + SHIFT + I) you should see that the id the of div is my-viz. This tell us that el is the created div, we also assume that x.message is selected message from the x array. We can modify our JavaScript binding to ensure it is the case. Let’s log those to see what they are exactly.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        console.log(el.id);
        console.log(x);
      
        el.innerText = x.message;

      },

      resize: function(width, height) {}

    };
  }
});

Remember to rebuild the package after changing the above

Then re-run our function.

gior(message = "Hello htmlwidgets", elementId = "my-viz")

If you inspect the visualisation (from the browser with CTRL/CMD + SHIFT + I (and go in the console) you should see first the id of our widget (my-viz) and the array x that contains message. You should also be able to see the content of x as JSON. If you are not familiar with JSON just think of it as an R list, in JavaScript you select an element of a JSON with a dot (.) whereas in R you do it with a dollar sign ($): in JavaScript x.message is the equivalent of x$message in R. Simple enough.

That should give you plenty of hints as to how htmlwidgets work already. The list we create from the R function gior is serialised to JSON and “sent” to our JavaScript binding (gior.js).

Now, at last, we can start building our widget. Go ahead and look at the “Get Started” section on the homepage of gio.js. It tells us to source `three.min.js and gio.min.js, which we already do, then create a div which htmlwidgets does for us already. Onto the script, it’s just four lines.

var container = document.getElementById( "globalArea" );
var controller = new GIO.Controller( container );
controller.addData( data );
controller.init();

We’ll place them in our gior.js file.

The very first line selects the id of our div which is not globalArea. We’ve already seen that it is dynamically generated by htmlwidgets if elementId = NULL in our gior R function (remember we used console.log(el.id) to see that very id in the browser console). We will change this line to what it should be. The second line can remain as is, nothing changes there, so does the fourth. We’ll comment out the third line as we are not yet passing data to JavaScript (just yet). Below if our gior.js file at this point.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        // controller.addData( data );
        controller.init();

      },

      resize: function(width, height) {}

    };
  }
});

Let’s rebuild our package and rerun our gior function. Note that we didn’t change the latter yet and it still expects a message even though we do not use it anymore so we’ll just pass something to it.

gior(message = NULL)

Not bad at all given the very few lines of code we wrote but we commented out the line that adds data to our visualisation, which is probably what we are most interested in. Let’s implemented that.

Let’s simply pass data to our R function (instead of message).

gior <- function(data = NULL, width = "100%", height = NULL, elementId = NULL) {

  x = list(
    data = data
  )

  # create widget
  htmlwidgets::createWidget(
    name = 'gior',
    x,
    width = width,
    height = height,
    package = 'gior',
    elementId = elementId
  )
}

We’ll uncomment that JavaScript line we commented earlier on. Remember how we added the message to the element with el.innerText = x.message;? We’ll do similar except that instead of using el.message we’ll use el.data, since we changed that in our gior R function (we went from x.message to x.data).

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        controller.init();

      },

      resize: function(width, height) {}

    };
  }
});

In the documentation of gio.js we see that it expects data in the following format:

[
  {
    "e": "CN",
    "i": "US",
    "v": 3300000
  },
  {
    "e": "CN",
    "i": "RU",
    "v": 10000
  }
]

Let’s document and rebuild our package, create a data.frame that follows the format expected by the addData JavaScript function.

df <- data.frame(
  e = c("CN", "CN", "CN"),
  i = c("US", "FR", "RU"),
  v = c(10, 20, 25)
)
row.names(df) <- 1:3

#gior(df)

Aaaaaaaaaaaaand this doesn’t work…

As mentioned previously what is passed from our R function to our JavaScript binding is serialised (turned into JSON). htmlwidgets does so with the package jsonlite, the htmlwidget website details the convoluted function itself. We don’t need to get into the details at this point, an easy way to check how htmlwidgets serialises your object x is to run jsonlite::toJSON with the following arguments.

# pretty is just to make it readable
jsonlite::toJSON(df, auto_unbox = TRUE, dataframe = "column", pretty = TRUE)
## {
##   "e": ["CN", "CN", "CN"],
##   "i": ["US", "FR", "RU"],
##   "v": [10, 20, 25]
## }

It’s easy to see what has gone wrong. The htmlwidget serialiser turns the data.frame to JSON columnwise not rowwise. There are different ways to fix this. The htmlwidgets website states you may change the very way in which the object x is serialised, and details how to change that serializer. However, I would advise leaving the serialiser as is and reshaping our data on the R side: a JSON is a list, let’s build a list that looks like the expected JSON rather than rely on another function to serialise is correctly (it might lead to headaches as some children of your list my be serialised correctly in one case but not in another).

lst <- apply(df, 1, as.list)
jsonlite::toJSON(lst, auto_unbox = TRUE, dataframe = "column", pretty = TRUE)
## {
##   "1": {
##     "e": "CN",
##     "i": "US",
##     "v": "10"
##   },
##   "2": {
##     "e": "CN",
##     "i": "FR",
##     "v": "20"
##   },
##   "3": {
##     "e": "CN",
##     "i": "RU",
##     "v": "25"
##   }
## }

Close, we should remove row names.

row.names(df) <- NULL 
lst <- apply(df, 1, as.list)
jsonlite::toJSON(lst, auto_unbox = TRUE, dataframe = "column", pretty = TRUE)
## [
##   {
##     "e": "CN",
##     "i": "US",
##     "v": "10"
##   },
##   {
##     "e": "CN",
##     "i": "FR",
##     "v": "20"
##   },
##   {
##     "e": "CN",
##     "i": "RU",
##     "v": "25"
##   }
## ]

Let’s implement that in our R function.

gior <- function(data = NULL, width = "100%", height = NULL, elementId = NULL) {

  row.names(data) <- NULL
  data <- apply(data, 1, as.list)

  x = list(
    data = data
  )

  # create widget
  htmlwidgets::createWidget(
    name = 'gior',
    x,
    width = width,
    height = height,
    package = 'gior',
    elementId = elementId
  )
}

Then again, rebuild the package.

gior(df)

It works! There are plenty of other JavaScript functions/methods to implement, we’re not limited to addData. Let’s implement another one real quick as it’ll let me show you another neat trick.

You might have observed that htmlwidgets like plotly or leaflet tend to make use of the the magrittr pipe, %>%. It doesn’t do so only because it is fashionable, htmlwidgets are great examples of packages that are much easier to work with %>% than without.

Remember I mentioned that the function htmlwidgets::createWidget() renders our widget on print? Let’s inspect what this actually contains.

globe <- gior() # nothing appears in the browser/viewer
class(globe) # it's an htmlwidget!
## [1] "gior"            "suppress_viewer" "htmlwidget"
names(globe) # here's what's inside
## [1] "x"             "width"         "height"        "sizingPolicy" 
## [5] "dependencies"  "elementId"     "preRenderHook" "jsHooks"

Looks like it includes options, dependencies and other things we may not understand (and thus should not touch) but we also see x, which I suspect is this list we pass the data to. Let’s see.

globe <- gior(df)
globe$x
## List of 1
##  $ data:List of 3
##   ..$ :List of 3
##   .. ..$ e: chr "CN"
##   .. ..$ i: chr "US"
##   .. ..$ v: chr "10"
##   ..$ :List of 3
##   .. ..$ e: chr "CN"
##   .. ..$ i: chr "FR"
##   .. ..$ v: chr "20"
##   ..$ :List of 3
##   .. ..$ e: chr "CN"
##   .. ..$ i: chr "RU"
##   .. ..$ v: chr "25"

Apparently globe$x is the list in question. Now, we have seen that there are tons of other functions from gio.js that we need to implement. However, we do not want to end up with a gior function that takes 100+ arguments, that would be ridiculous, these should be split across different function. Since globe$x is actually just a list, how about we pipe (%>%) functions which simply append to this list?

Let us demonstrate by adding a set_style function which takes a single argument (a theme), it’ll correspond to setStyle in the original JavaScript library.

Let us add our R function first. Since we are using %>% we shall make this function take the output of gior as first argument, the function will accept the style argument as a second argument.

#' Set gior style
#' 
#' @param gior An object of class \code{gior} as returned by \code{\link{gior}}.
#' @param style The style of your want to pass.
#'
#' @export
set_style <- function(gior, style = "magic"){
  gior$x$stlye <- style # append style
  return(gior)
}

The function simply append style to the list and returns the whole object. Now that we add the style to our list x we need to add the corresponding JavaScript function, in the documention the example demonstrated is:

controller.setStyle("magic");

In JavaScript, just like we pass the data with x.data we can pass style with x.style. Let’s add it to our binding.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        
        // add style
        controller.addStyle(x.style);
        
        controller.init();

      },

      resize: function(width, height) {}

    };
  }
});

Now if we rebuild our package and run our R function.

# install.packages("magrittr")
library(magrittr)

gior(df) %>% 
  g_style("magic")

That works! Moverover, it the code above looks much neater than the code below (which produces the exact same output).

globe <- gior(df) 
globe <- g_style(globe, "magic")
globe

Imagine we had to do that for all the functions available in gio.js? The pipe comes in handy!

However this causes an issue, the JavaScript function addStyle expects and input, what if it is not present, what if we do not pass g_style?

#gior(df)

Doesn’t work, the viewer/browser is blank. If you open the visualisation in your browser and look at the console you will see the error. We must pass something to addStyle but we don’t and thus cause an error which, like in R, interrupts the script causing the whole thing to fall apart. Two ways to fix that (that I can think of). You could simply set a default in gior.R (x <- list(data = data, style = "magic")), but the one I want to show you (simply because it is JavaScript and you might not be aware of it) is to check whether style is present in x before running the function:

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        
        // add style
        if(x.hasOwnProperty(x.style)){
          controller.addStyle(x.style);
        }
        
        controller.init();

      },

      resize: function(width, height) {}

    };
  }
});

x.hasOwnProperty(style) let us check whether the element style is present in our JSON, in R you could do if(length(x$style)) for instance. You can rebuild the package and retry, running gior() will work.

Now we can move on to htmlwidgets secrets; functionalities that are immensely powerful but, for one reason or another, not documented anywhere (as far as I know of). These will turn a good htmlwidget into a great one. Additionally, one of these trick is extremly easy to implement. You made it this far, stick around!

In essence what we have been doing thus far is passing data from R to JavaScript, what if we could do it the other way around, from JavaScript to R? Bear with me, it’s nowhere as much work as what we did so far!

In the documentation of gio.js we find a section called callback, which lets us pick up which country has been selected on the globe and the countries connected to it. Thus far we’ve been passing data from R to JavaScript, this would allow the widget to communicate back to R, sending data from JavaScript to R!

Now that would not work in a static file but will in a server setup: Shiny.

Let’s look at the documentation of callbacks, and its example.

// use the onCountryPicked() to set callback when clicked country changed
controller.onCountryPicked( callback );

// defined a callback function, as a demo, this function simply output selectedCountry, relatedCountries which are passed parameters into console
function callback ( selectedCountry, relatedCountries ) {

  console.log(selectedCountry);
  console.log(relatedCountries);

}

A function called callback is created which is ran by onCountrPicked: when a country is selected, the function callback is executed and returns the selected country and the countries linked to the latter. Well we could easily apply that to our package.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        controller.init();
        
        controller.onCountryPicked( callback );
        
        function callback ( selectedCountry, relatedCountries ) {
        
          console.log(selectedCountry);
          console.log(relatedCountries);
        
        }

      },

      resize: function(width, height) {}

    };
  }
});

Now, after rebuilding our package, if we run gior(df), open the visualisation in the browser and inspect the visualisation with CTRL/CMD + SHIFT + I, then select a country on the globe, we see, in the console, the selected country as we all the related countries!

Let’s implement that in R so that instead of merely logging this information in the console it sends it back to R.

First we add a test (if) to check if we are in a Shiny server.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        controller.init();
        
        if (HTMLWidgets.shinyMode) {
          controller.onCountryPicked( callback );
        }
        
        function callback ( selectedCountry, relatedCountries ) {
        
          console.log(selectedCountry);
          console.log(relatedCountries);
        
        }

      },

      resize: function(width, height) {}

    };
  }
});

HTMLWidgets.shinyMode returns true when in Shiny, so the function will run only then. It is important because like R a JavaScript script will stop on error, as we saw before with set_style. Now onto sending the value back to R. This isn’t acutally done with htmlwidget but with Shiny. We use Shiny.setInputValue() which takes two arguments, first the name of the input we set, second, the values we set to that input.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        controller.init();
        
        if (HTMLWidgets.shinyMode) {
          controller.onCountryPicked( callback );
        }
        
        function callback ( selectedCountry, relatedCountries ) {
        
          Shiny.setInputValue("country_selected", selectedCountry);
          Shiny.setInputValue("country_related", relatedCountries);
        
        }

      },

      resize: function(width, height) {}

    };
  }
});

Easy! Now we rebuild our package, and make a small shinyApp to test it.

library(gior)
library(shiny)

df <- data.frame(
  e = c("CN", "CN", "CN"),
  i = c("US", "FR", "RU"),
  v = c(10, 20, 25)
)

ui <- fluidPage(
  giorOutput("myGlobe"),
  verbatimTextOutput("selected"),
  verbatimTextOutput("related")
)

server <- function(input, output, session) {

  output$myGlobe <- renderGior({
    gior(df)
  })
  
  output$selected <- renderPrint({
    input$country_selected
  })
  
  output$related <- renderPrint({
    input$country_related
  })
  
}

shinyApp(ui, server)

Brilliant but we’ll modify something. It currently works fine but will not if users uses more than one of our visualisation in their Shiny app because we would have a two visulisation setting one input. We want each visualisation to have its own respective inputs which we can easily distinguish in R.

We can do that by using the id of the widget. How about instead of having inputid_selected?

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        controller.init();
        
        if (HTMLWidgets.shinyMode) {
          controller.onCountryPicked( callback );
        }
        
        function callback ( selectedCountry, relatedCountries ) {
        
          Shiny.setInputValue(el.id + "_selected", selectedCountry);
          Shiny.setInputValue(el.id + "_related", relatedCountries);
        
        }

      },

      resize: function(width, height) {}

    };
  }
});

Confused? Let’s demonstrate how this works in Shiny.

library(gior)
library(shiny)

df <- data.frame(
  e = c("CN", "CN", "CN"),
  i = c("US", "FR", "RU"),
  v = c(10, 20, 25)
)

ui <- fluidPage(
  giorOutput("myGlobe"),
  verbatimTextOutput("selected"),
  verbatimTextOutput("related")
)

server <- function(input, output, session) {

  output$myGlobe <- renderGior({
    gior(df)
  })
  
  output$selected <- renderPrint({
    input$myGlobe_selected
  })
  
  output$related <- renderPrint({
    input$myGlobe_related
  })
  
}

shinyApp(ui, server)

We can see which country is selected with myGlobe_selected, how we wrote it in JavaScript el.id + "_selected". Now that was easy to implement! Let’s improve on it though, _related currently returns a list but it could easily be shaped into a data.frame.

We can use shiny::registerInputHandler which will let us define “handlers” that will pre-process data returned by JavaScript, if you are familiar with JavaScript you can think of it as a callback function… but in R. Below is how I generally implement it, we just want the handlers to be registered when the package is loaded or attached.

The function shiny::registerInputHandler takes three arguments, first the type which is, in effect, the name of the handler (whatever you want it to be), and a a function fun which will process the data.

.onAttach <- function(libname, pkgname) {
  shiny::registerInputHandler("giorHandler", function(data, ...) {
    jsonlite::fromJSON(jsonlite::toJSON(data, auto_unbox = TRUE))
  }, force = TRUE)
}

.onLoad <- function(libname, pkgname) {
  shiny::registerInputHandler("giorHandler", function(data, ...) {
    jsonlite::fromJSON(jsonlite::toJSON(data, auto_unbox = TRUE))
  }, force = TRUE)
}

Now that we have the handler built let’s reference it in our JavaScript callback function.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        controller.init();
        
        if (HTMLWidgets.shinyMode) {
          controller.onCountryPicked( callback );
        }
        
        function callback ( selectedCountry, relatedCountries ) {
        
          Shiny.setInputValue(el.id + "_selected:giorHandler", selectedCountry);
          Shiny.setInputValue(el.id + "_related:giorHandler", relatedCountries);
        
        }

      },

      resize: function(width, height) {}

    };
  }
});

Just like that!, simple add :nameOfYourHandler in the name of your Shiny input. Now we can rebuild our package and modify our shiny app to render a table instead of just printing the list.

library(DT)
library(gior)
library(shiny)

df <- data.frame(
  e = c("CN", "CN", "CN"),
  i = c("US", "FR", "RU"),
  v = c(10, 20, 25)
)

ui <- fluidPage(
  giorOutput("myGlobe"),
  verbatimTextOutput("selected"),
  DTOutput("related")
)

server <- function(input, output, session) {

  output$myGlobe <- renderGior({
    gior(df)
  })
  
  output$selected <- renderPrint({
    input$myGlobe_selected
  })
  
  output$related <- renderDT({
    input$myGlobe_related
  })
  
}

shinyApp(ui, server)

That is one awesome feature added to our package already, onto the final one called proxies. It is relatively easy to implement as it changes little across htmlwidgets but probably requires some more JavaScript knowledge to fully understand. Moreover I only go into so much detail because I do not want to confuse you with my own misunderstandings.

We have seen how to pass data from R to JavaScript to produce a visualisation and back. But the problem with the former is that, currently, every time we pass data from R to JavaScript we generate a new visualisation. What if we have one containing large amounts amount of data and we just want to change the style (set_style)? Our package has to reconstruct the data and send it to our binding which, in actual fact re-generates an entirely new visualisation. Very wasteful granted that we have it already drawn and only need the style changed. Moreover the original JavaScript library allows just that; interactively customising the visualisation without redrawing it every single time.

It does redraw the whole visualisation because we re-run the whole JavaScript HTMLWidgets.widget() factory function. What we should do is interact with the visualisation outside of this function, once it is drawn we can do things outside of it. To be able to that do we are going to need a function to return the visualisation, it’s fairly straightforward.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        controller.init();
        
        if (HTMLWidgets.shinyMode) {
          controller.onCountryPicked( callback );
        }
        
        function callback ( selectedCountry, relatedCountries ) {
        
          Shiny.setInputValue(el.id + "_selected:giorHandler", selectedCountry);
          Shiny.setInputValue(el.id + "_related:giorHandler", relatedCountries);
        
        }

      },

      resize: function(width, height) {},
      
      // return visualisation object
      getMap: function(){
        return(controller)
      }

    };
  }
});

Straightforward indeed, we just added getMap which returns òur visualisation, controller. Now let’s think about how this should work in Shiny. We want another R function that will allow the user to select the visualisation in question and interact with it. For instance, change the style, it would look something like this:

library(gior)
library(shiny)

df <- data.frame(
  e = c("CN", "CN", "CN"),
  i = c("US", "FR", "RU"),
  v = c(10, 20, 25)
)

ui <- fluidPage(
  giorOutput("myGlobe"),
  selectInput("style", "Style:", choices = c("stawberry", "magic"))
)

server <- function(input, output, session) {

  output$myGlobe <- renderGior({
    gior(df)
  })
  
  # This won't work yet of course
  observeEvent(input$style, {
    select_gior_visualisation("myGlobe") %>% 
      change_the_style(input$style)
  })
  
}

shinyApp(ui, server)

Let’s start by defining this select_gior_visualisation function, only we’ll call it something else.

#' Proxy
#' 
#' Return proxy
#'
#' @export
giorProxy <- function(id, session = shiny::getDefaultReactiveDomain()){

  proxy <- list(id = id, session = session)

  return(proxy)
}

It’s that simple. The function we just defined takes an id but our JavaScript function getMap does not take any argument, which begs the question, how do we use the latter? We will define a wrapper around that function outside our factory function, which based on the id looks for an htmlwidget bearing that id and if found returns the visualisation with the use of getMap.

function get_gior(id){

  var htmlWidgetsObj = HTMLWidgets.find("#" + id);

  var gior;

  if (typeof htmlWidgetsObj != 'undefined') {
    gior = htmlWidgetsObj.getMap();
  }

  return(gior);
}

At this point, we have two functions that each allow returning a visualisaiton, one in R (giorProxy) and one in JavaScript (get_gior). We can now move on to implementing an R function that will allow us to interactively change the style of the visualisation. We’ll start with the R function (as you might expect, this function will have a corresponding JavaScript function).

Our R function will need just two arguments, first the proxy (which is the object returned by giorProxy), secondly the style to set. From the proxy we get the id of the htmlwidget, we build a list to pass to “send” to JavaScript with proxy$session$sendCustomMessage. The latter takes two arguments, the name of the handler and the data it needs to send to it.

#' Set style
#' 
#' Interactively set visualisation style
#' 
#' @export
set_style_proxy <- function(proxy, style){

  data <- list(id = proxy$id, style = style)

  proxy$session$sendCustomMessage("set_style_js", data)

  return(proxy)
}

Now for the corresponding JavaScript function set_style_js. The function takes data (a list ~ JSON array) which we sent from R and includes the id of the htmlwidget and the style to set.

Shiny.addCustomMessageHandler('set_style_js',
  function(data) {
    var globe = get_gior(data.id); // get the map
    if (typeof globe != 'undefined') {
      globe.setStyle(data.style); // set the style.
    }
});

Then again, this will only work in Shiny so we’ll wrap that in the if test we already used previously. At the end our gio.js file should look like this.

HTMLWidgets.widget({

  name: 'gior',

  type: 'output',

  factory: function(el, width, height) {

    return {

      renderValue: function(x) {
      
        var container = document.getElementById( el.id );
        var controller = new GIO.Controller( container );
        controller.addData( el.data ); 
        controller.init();
        
        if (HTMLWidgets.shinyMode) {
          controller.onCountryPicked( callback );
        }
        
        function callback ( selectedCountry, relatedCountries ) {
        
          Shiny.setInputValue(el.id + "_selected:giorHandler", selectedCountry);
          Shiny.setInputValue(el.id + "_related:giorHandler", relatedCountries);
        
        }

      },

      resize: function(width, height) {},
      
      // return visualisation object
      getMap: function(){
        return(controller)
      }

    };
  }
});

function get_gior(id){

  var htmlWidgetsObj = HTMLWidgets.find("#" + id);

  var gior;

  if (typeof htmlWidgetsObj != 'undefined') {
    gior = htmlWidgetsObj.getMap();
  }

  return(gior);
}

if (HTMLWidgets.shinyMode) {
  Shiny.addCustomMessageHandler('set_style_js',
    function(data) {
      var globe = get_gior(data.id); // get the map
      if (typeof globe != 'undefined') {
        globe.setStyle(data.style); // set the style.
      }
  });
}

Now, we can document and rebuild our package and write a small Shiny app to test the proxies.

library(gior)
library(shiny)

df <- data.frame(
  e = c("CN", "CN", "CN"),
  i = c("US", "FR", "RU"),
  v = c(10, 20, 25)
)

ui <- fluidPage(
  giorOutput("myGlobe"),
  selectInput("style", "Style:", choices = c("stawberry", "magic"))
)

server <- function(input, output, session) {

  output$myGlobe <- renderGior({
    gior(df)
  })
  
  # This won't work yet of course
  observeEvent(input$style, {
    giorProxy("myGlobe") %>% 
      set_style_proxy(input$style)
  })
  
}

shinyApp(ui, server)

Useful links:

Latest package

sigmajs is an R package to interactively visualise networks.

Latest posts

R, limericks, and other indoor stuff.