18

I have created Shiny app with lots of inputs (parameters). Our users would like to go back with the same input values.

I have checked this example (http://shiny.rstudio.com/articles/client-data.html) which show to get url through session$clientData$url_search, but cannot generate a url from sidebarPanel inputs in the left. For example:

http://localhost:8100/?obs=10

How could generate a URL which could restore the same values in Shiny? A short one should be the best as there are many inputs.

Please let me know if my question is not clear.

Thanks for any suggestions.

Bangyou
  • 9,462
  • 16
  • 62
  • 94
  • I found a solution here: https://gist.github.com/alexbbrown/6e77383b48a044191771. This solution is working very well, until I added an "observe" to updateSelectInput for one parameter. – Bangyou Aug 05 '14 at 04:13
  • For example: https://www.dropbox.com/s/xf5u2evqt0gl0dy/test.zip. When I input url: http://127.0.0.1:6764/#obs=500,obs2=900, but value of obs2 is not shown as 900, but 502. – Bangyou Aug 05 '14 at 04:23

4 Answers4

17

To keep things simple, you don't have to write any code in server.R. Parsing the URL query string (e.g. ?obs=10) and setting the corresponding inputs can be nicely done by just writing some javascript code.

Below I present a simple example where you can see how you can dynamically set the value of any built-in input controls of Shiny.

ui.R

shinyUI(
  fluidPage(
    sidebarLayout(
        sidebarPanel(
            # wrap input controls into a container so that we can use binding.find()
            # function to quickly locate the input controls.
            tags$div(id="input_container", 
                textInput("username", h6("Username:")),
                numericInput("age", h6("Age:"), 
                            min=1, max=99, value=20, step=1),
                selectInput("sex", h6("Sex:"), choices=c("Male", "Female")),
                # load Javascript snippet to parse the query string.
                singleton(tags$script(type="text/javascript", 
                                    src="js/parse_input.js"))  
            )
        ),
        mainPanel(
            verbatimTextOutput("log")
        )
    )
  )
)

server.R

# does nothing but echoes back the user's input values
shinyServer(function(input, output) {
    output$log <- renderPrint({
        paste("Username: ", input$username, "; Age: ", input$age,
              "; Sex: ", input$sex, sep="")
    })
})

www/js/parse_input.js

Finally, you need to create folder www/js under your Shiny project directory, and put this parse_input.js file inside the js folder.

$(document).ready(function() {
    if (window.location.search) {
        var input_params = {};
        /* process query string, e.g. ?obs=10&foo=bar */
        var params = $.map(
            window.location.search.match(/[\&\?]\w+=[^\&]+/g), 
            function(p, i) { 
                var kv = p.substring(1).split("=");
                # NOTE: might have issue to parse some special characters here?
                input_params[kv[0]] = decodeURIComponent(kv[1]);
            }
        );

        /* Shiny.inputBindings.getBindings() return the InputBinding instances
           for every (native) input type that Shiny supports (selectInput, textInput,
           actionButton etc.)  */
        $.each(Shiny.inputBindings.getBindings(), function(i, b) {
            /* find all inputs within a specific input type */
            var inputs = b.binding.find('#input_container');
            $.each(inputs, function(j, inp) {
                /* check if the input's id matches the key specified in the query
                   string */
                var inp_val = input_params[$(inp).attr("id")];
                if (inp_val != undefined) {
                    b.binding.setValue(inp, inp_val);
                }
            });
        });
    }
});

You can then visit the website using URL like http://localhost:7691/?sex=Female&age=44&username=Jane.

You should see that on the main panel, the text becomes:

[1] "Username: Jane; Age: 44; Sex: Female"

EDIT: Create a snapshot of current input values, save it to a local file, and restore it using snapshot ID

Bangyou reminded me that my original answer (above) didn't address his question. So below is my second trial to answer the question.

ui.R

shinyUI(
  fluidPage(
    sidebarLayout(
        sidebarPanel(
            # wrap input controls into a container
            tags$div(id="input_container", 
                textInput("username", h6("Username:")),
                numericInput("age", h6("Age:"), 
                            min=1, max=99, value=20, step=1),
                selectInput("sex", h6("Sex:"), choices=c("Male", "Female")),
                singleton(tags$script(type="text/javascript", 
                                    src="js/parse_input.js"))  
            ),
            tags$button(type="button", id="save_options", 
                        h6("Save current options")),
            tags$input(type="text", style="display:none;", value="{}",
                       id="inputs_snapshot")

        ),
        mainPanel(
            verbatimTextOutput("log"),
            verbatimTextOutput("gen_url")
        )
    )
  )
)

server.R

#  user.saved.snapshots <- list(
#    list(sex="Male", age=32, username="Jason"),
#    list(sex="Male", age=16, username="Eric"),
#    list(sex="Female", age=46, username="Peggy")
#  )
#  
#  save(user.saved.snapshots, file="snapshots.Rdata")

# ^^ Run above code **ONCE** to initiate a dummy data file, storing some possible options. 

load("snapshots.Rdata")

renderRestoration <- function(expr, env=parent.frame(), quoted=F) {
  func <- exprToFunction(expr)
  function() {
    func() 
    # return the selected snapshot to the client side
    # Shiny will automatically wrap it into JSOn
  }
}

shinyServer(function(input, output, session) {
    output$log <- renderPrint({
        paste("Username: ", input$username, "; Age: ", input$age,
              "; Sex: ", input$sex, "\n\n", "User saved sets: ", str(user.saved.snapshots), sep="")
    })

    observe({
        if (!is.null(input$inputs_snapshot) && length(input$inputs_snapshot) > 0) {
      print(input$inputs_snapshot)
            user.saved.snapshots[[length(user.saved.snapshots) + 1]] <<- input$inputs_snapshot
      save(user.saved.snapshots, file="snapshots.Rdata")
        }
    })

  output$input_container <- renderRestoration({
    query <- parseQueryString(session$clientData$url_search)
    if (is.null(query$snapshot)) return (list())
    sid <- as.numeric(query$snapshot)
    if (sid <= length(user.saved.snapshots)) {
      user.saved.snapshots[[sid]]
    }
  })

  output$gen_url <- renderPrint({
    if (length(input$inputs_snapshot) > 0) {
      paste("The current input snapshot is created, and can be restored by visiting: \n",
            session$clientData$url_protocol, "://",
            session$clientData$url_hostname, ":",
            session$clientData$url_port, 
            session$clientData$url_pathname, "?snapshot=", length(user.saved.snapshots),
            sep=""
        )
    }
  })
})

www/js/parse_input.js

$(document).ready(function() {

    if (window.location.search) {
        /* METHOD 1: restore from a explicit URL specifying all inputs */

        var input_params = {};
        /* process query string, e.g. ?obs=10&foo=bar */
        var params = $.map(
            window.location.search.match(/[\&\?]\w+=[^\&]+/g), 
            function(p, i) { 
                var kv = p.substring(1).split("=");
                input_params[kv[0]] = decodeURIComponent(kv[1]);
            }
        );

        // you can uncomment this if you want to restore inputs from an
        // explicit options specified in the URL in format:
        //      input_id=value

        //restore_snapshot("#input_container", input_params);
    }

    var restore_snapshot = function(el, input_params) {
        /* Shiny.inputBindings.getBindings() return the InputBinding instances
           for every (native) input type that Shiny supports (selectInput, textInput,
           actionButton etc.)  */
        $.each(Shiny.inputBindings.getBindings(), function(i, b) {
            /* find all inputs within a specific input type */
            var inputs = b.binding.find(el);
            $.each(inputs, function(j, inp) {
                /* check if the input's id matches the key specified in the query
                   string */
                var inp_val = input_params[$(inp).attr("id")];
                if (inp_val != undefined) {
                    b.binding.setValue(inp, inp_val);
                }
            });
        });
    }

    $("#save_options").on('click', function() {
        /* dump all inputs within input container */
        var input_params = {}
        $.each(Shiny.inputBindings.getBindings(), function(i, b) {
            /* find all inputs within a specific input type */
            var inputs = b.binding.find('#input_container');
            $.each(inputs, function(j, inp) {
                /* check if the input's id matches the key specified in the query
                   string */
                var inp_id = $(inp).attr("id");
                if (inp_id) {
                    input_params[inp_id] = b.binding.getValue(inp);
                }
            });
        });

        console.log(input_params);
        $("#inputs_snapshot").val(JSON.stringify(input_params))
            .trigger("change");
    });

    /* ------------ Shiny Bindings -------------- */
    /* First, an input binding monitor change of a hidden input, 
     * whose value will be changed once the user clicks the 
     * "save current options" button. 
     */
    var snapshotBinding = new Shiny.InputBinding();
    $.extend(snapshotBinding, {
        find: function(scope) {
            return $(scope).find("#inputs_snapshot");
        },
        getValue: function(el) {
            return JSON.parse($(el).val());
        },
        subscribe: function(el, callback) {
            $(el).on("change.snapshot", function(e) {
                callback();
            });
        },
        unsubscribe: function(el) {
            $(el).off(".snapshot");
        }
    });

    Shiny.inputBindings.register(snapshotBinding);

    var restoreBinding = new Shiny.OutputBinding();
    $.extend(restoreBinding, {
        find: function(scope) {
            return $(scope).find("#input_container");
        },
        renderValue: function(el, data) {
            // very rudimentary sanity check
            if ($.isPlainObject(data) && data.hasOwnProperty('username')) {
                restore_snapshot(el, data);
                alert("Snapshot restored!");
            }
        }
    });

    Shiny.outputBindings.register(restoreBinding, 'inputs.Restore');


});

A short explanation:

  • We create two customized input and output binding:
    • The input binding is triggered once the user click the "Save" button, which changes a hidden <input> tag. This allows us to send the current snapshot of inputs to the server.
    • The server uses an observer to watch the snapshot input. It then updates the user.saved.snapshots variable, and save it to a disk file.
    • We also created a customized output binding. The server will use this output binding to send a specific snapshot of user inputs to the client. The server will only send valid data to the client if the query string ?snapshot=[number] is visible.
  • Alternatively, you can use the input$inputs_snapshot list object to create an explicit restoration URL, (e.g. ?username=Eric&age=44&sex=Male), because you can access all input values from there. And our javascript provides that functionality as well.

There are many details need to be polished. You probably can consider save these profiles to a SQLite database using RSQLite package.

But above demo should serve as a good proof of concept.

Bangyou
  • 9,462
  • 16
  • 62
  • 94
Xin Yin
  • 2,896
  • 21
  • 20
  • Thanks for your answer. Your example is working to set the values of each input, but cannot generate a URL according to inputs like this example: https://gist.github.com/alexbbrown/6e77383b48a044191771. I am thinking about other methods to store these setting, e.g. stored in a RData file. – Bangyou Aug 08 '14 at 02:30
  • Ah. Sorry. I went back to your original question and realized you were indeed asking for a different question. I will edit my answer. – Xin Yin Aug 08 '14 at 02:37
  • I think this time I've addressed your original question. Let me know if it still doesn't make sense. – Xin Yin Aug 08 '14 at 03:51
  • Thanks very much. it looks very nice after a quick look. – Bangyou Aug 08 '14 at 04:15
  • Let me know if you experience any problems, or if you come up with any better idea with some parts of the code. I didn't think many details through so there might be more elegant solutions. – Xin Yin Aug 08 '14 at 04:17
  • I tried both the EDITED version in this answer and the example in gist.github.com/alexbbrown/6e77383b48a044191771 and couldn't get it to work. Any ideas? – 719016 Aug 14 '14 at 09:45
  • In this example above, there are some bugs. Try it now. – Bangyou Aug 15 '14 at 11:19
4

For an R based solution to the problem of encoding the current state of a Shiny app's widgets into an URL query string, and restoring the user input values from that URL, see the shinyURL package. It additionally features a convenience copy-to-clipboard button, and interfaces with the TinyURL web service for shortening the URL.

The package is very easy to install and use. It can be obtained from GitHub:

devtools::install_github("aoles/shinyURL")

To enable shinyURL in your app follow these 3 steps:

  1. Load the package in both server.R an ui.R.

    library("shinyURL")
    
  2. Add a call to shinyURL.server(session) inside the shiny server function in server.R, where session is the argument passed to the server function.

  3. Add the shinyURL.ui() widget to ui.R.

aoles
  • 1,525
  • 10
  • 17
0

Based on @xin-yin suggestions, I added a few lines codes to allow save current options when observe functions in the server.R (Based on the ideas from https://gist.github.com/alexbbrown/6e77383b48a044191771). All codes pasted here just in case others need them.

ui.R

Same as @xin-yin answer

server.R

#  user_saved_snapshots <- list(
#    list(sex='Male', age=32, username='Jason'),
#    list(sex='Male', age=16, username='Eric'),
#    list(sex='Female', age=46, username='Peggy')
#  )
#  
#  save(user_saved_snapshots, file='snapshots.Rdata')

# ^^ Run above code **ONCE** to initiate a dummy data file, storing some possible options. 

user_saved_snapshots <- list()
if (file.exists('snapshots.Rdata'))
{
    load('snapshots.Rdata')
}

renderRestoration <- function(expr, env = parent.frame(), quoted = F) 
{
    func <- exprToFunction(expr)
    function() 
    {
        func() 
        # return the selected snapshot to the client side
        # Shiny will automatically wrap it into JSOn
    }
}

shinyServer(function(input, output, session) 
{
    output$log <- renderPrint({
        paste('Username: ', input$username, '; Age: ', input$age,
              '; Sex: ', input$sex, '\n\n', 'User saved sets: ', 
              str(user_saved_snapshots), sep = '')
    })
    firstTime <- TRUE
    observe({
        age <- input$age
        if (firstTime & nchar(session$clientData$url_search) > 0)
        {
            firstTime <<- FALSE
        } else
        {
            updateTextInput(session, "username",
                value = paste('AAAAA', age, sep = ': '))
        }
    })
    observe({
        print(input$inputs_snapshot)
        print(session$clientData$url_search)
        # if (nchar(session$clientData$url_search))
        # {
            if (!is.null(input$inputs_snapshot) && length(input$inputs_snapshot) > 0) {
                # print(input$inputs_snapshot)
                user_saved_snapshots[[length(user_saved_snapshots) + 1]] <<- input$inputs_snapshot
                save(user_saved_snapshots, file='snapshots.Rdata')
            }
        # } else
        # {
            # updateNumericInput(session, 'age', value  = 100)
        # }
    })

    output$input_container <- renderRestoration({
        query <- parseQueryString(session$clientData$url_search)
        if (is.null(query$snapshot)) return (list())
            sid <- as.numeric(query$snapshot)
        if (sid <= length(user_saved_snapshots)) 
        {
            user_saved_snapshots[[sid]]
        }
    })

    output$gen_url <- renderPrint({
    if (length(input$inputs_snapshot) > 0) 
    {
        url <- paste0(session$clientData$url_protocol, '//',
            session$clientData$url_hostname, ':',
            session$clientData$url_port, 
            session$clientData$url_pathname, '?snapshot=', 
            length(user_saved_snapshots))
        tags$div(tags$p('The current input snapshot is created, and can be restored by visiting:'),
            tags$a(url, href = url))

    }
  })
})

www/js/parse_input.js

Same as @xin-yin answer
Bangyou
  • 9,462
  • 16
  • 62
  • 94
0

Building off of daattali (Shiny saving URL state subpages and tabs), this takes any number of inputs and does the assigning of values for you for a few different types of inputs:

ui.R:

library(shiny)

shinyUI(fluidPage(
textInput("symbol", "Symbol Entry", ""),

dateInput("date_start", h4("Start Date"), value = "2005-01-01" ,startview = "year"),

selectInput("period_select", label = h4("Frequency of Updates"),
            c("Monthly" = 1,
              "Quarterly" = 2,
              "Weekly" = 3,
              "Daily" = 4)),

sliderInput("smaLen", label = "SMA Len",min = 1, max = 200, value = 115),br(),

checkboxInput("usema", "Use MA", FALSE)

))

server.R:

shinyServer(function(input, output,session) {
observe({
 query <- parseQueryString(session$clientData$url_search)

 for (i in 1:(length(reactiveValuesToList(input)))) {
  nameval = names(reactiveValuesToList(input)[i])
  valuetoupdate = query[[nameval]]

  if (!is.null(query[[nameval]])) {
    if (is.na(as.numeric(valuetoupdate))) {
      updateTextInput(session, nameval, value = valuetoupdate)
    }
    else {
      updateTextInput(session, nameval, value = as.numeric(valuetoupdate))
    }
  }

 }

 })
})

Example URL to test: 127.0.0.1:5767/?symbol=BBB,AAA,CCC,DDD&date_start=2005-01-02&period_select=2&smaLen=153&usema=1

Community
  • 1
  • 1
Jason S
  • 199
  • 2
  • 2