README.md

URL as Input/Output

This is a sample project to test use of URL as an output and input for shiny scripts.

It presents the data in 3 ways:

• in the URL
• in the Input controls
• as text in the output

You can copy and share the URL You can edit the URL (and press enter) to update. The URL is live updated. It only works on browsers which support hashchange - so probably webkit & FF.

Goals

The goal is to use the URL as a duplicate of the input state of a shiny app, with the following features:

* URL gets updated as input gets updated
* input gets updated as URL gets updated
* some mechanism to avoid circuits
* If URL is provided to a new browser, page state is reproduced

Technology Warning

Initially it will use the 'hashchange' event, which is NOT universally available.

There is an option to use various query.js plugins later.

Also I haven't thought carefully about feedback loops - it might explode in flames.

Version Log

• Fields to sync is now a variable - not hardcoded in the server
• Supports textinput fields as well (included in example)

server.R

library(shiny)

url_fields_to_sync <- c("beverage","milk","sugarLumps","customer");

# Define server logic required to respond to d3 requests
shinyServer(function(input, output) {
  
  # Generate a plot of the requested variable against mpg and only 
  # include outliers if requested
  output$order <- reactiveText(function() {
    paste(input$beverage, 
          if(input$milk) "with milk" else ", black",
          "and", 
          if (input$sugarLumps == 0) "no" else input$sugarLumps,
          "sugar lumps",
          "for",
          if (input$customer == "") "next customer" else input$customer)
  })
  
  firstTime <- TRUE
  
  output$hash <- reactiveText(function() {
    
    newHash = paste(collapse=";",
                    Map(function(field) {
                          paste(sep="=",
                                field,
                                input[[field]])
                        },
                        url_fields_to_sync))
    
    # the VERY FIRST time we pass the input hash up.
    return(
      if (!firstTime) {
        newHash
      } else {
        if (is.null(input$hash)) {
          NULL
        } else {
          firstTime<<-F;
          isolate(input$hash)
        }
      }
    )
  })
})

ui.R

library(shiny)

hashProxy <- function(inputoutputID) {
  div(id=inputoutputID,class=inputoutputID,tag("div",""));
}

# Define UI for shiny d3 chatter application
shinyUI(pageWithSidebar(
  
  # Application title
  headerPanel("Shiny Persisting Input in URL",
              "Demo of how to persist inputs in browser URL"),
  
  sidebarPanel(
    tags$p("This widget is a demonstration of how to preserve input state across sessions, using the URL hash."),
    selectInput("beverage", "Choose a beverage:", 
                choices = c("Tea", "Coffee", "Cocoa")),
    checkboxInput("milk", "Milk"),
    sliderInput("sugarLumps", "Sugar Lumps:", 
                min=0, max=10, value=3),
    textInput("customer", "Your Name:")
  ),
  
  mainPanel(
    includeHTML("URL.js"),
    h3(textOutput("order")),
    hashProxy("hash")
  )
))

URL.js

<script type="text/javascript">
(function(){
 
  this.countValue=0;
  
  var changeInputsFromHash = function(newHash) {
    // get hash OUTPUT
    var hashVal = $(newHash).data().shinyInputBinding.getValue($(newHash))
    if (hashVal == "") return
    // get values encoded in hash
    var keyVals = hashVal.substring(1).split(";").map(function(x){return x.split("=")})
    // find input bindings corresponding to them
    keyVals.map(function(x) {
      var el=$("#"+x[0])
      
      if (el.length > 0 && el.val() != x[1]) {
      
        console.log("Attempting to update input " + x[0] + " with value " + x[1]);
        if (el.attr("type") == "checkbox") {
            el.prop('checked',x[1]=="TRUE")
            el.change()
        } else if(el.attr("type") == "radio") {
          console.log("I don't know how to update radios")
        } else if(el.attr("type") == "slider") {
          // This case should be setValue but it's not implemented in shiny
          el.slider("value",x[1])
          //el.change()
        } else { 
            el.data().shinyInputBinding.setValue(el[0],x[1])
            el.change()
        }
      }
    })
  }
  
  var HashOutputBinding = new Shiny.OutputBinding();
  $.extend(HashOutputBinding, {
    find: function(scope) {
      return $(scope).find(".hash");
    },
    renderError: function(el,error) {
      console.log("Shiny app failed to calculate new hash");
    },
    renderValue: function(el,data) {
      console.log("Updated hash");
      document.location.hash=data;
      changeInputsFromHash(el);
    }
  });
  Shiny.outputBindings.register(HashOutputBinding);
  
  var HashInputBinding = new Shiny.InputBinding();
  $.extend(HashInputBinding, {
    find: function(scope) {
      return $(scope).find(".hash");
    },
    getValue: function(el) {
      return document.location.hash;
    },
    subscribe: function(el, callback) {
      window.addEventListener("hashchange",
        function(e) {
          changeInputsFromHash(el);
          callback();
        }
        , false);
    }
  });
  Shiny.inputBindings.register(HashInputBinding);
 
  
})()
</script>