编辑：创建当前输入值的快照，将其保存到本地文件，然后使用快照ID将其恢复

Question

我创建了许多输入（参数）的Shiny应用程序。我们的用户希望返回相同的输入值。

我已经检查了这个示例（http://shiny.rstudio.com/articles/client-data.html），它显示通过会话$ clientData $ url_search获取url，但是无法从左侧的sidebarPanel输入生成url。例如：

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

如何生成可以在Shiny中恢复相同值的URL？由于有很多输入，因此短期应该是最好的。

如果我的问题不明确，请告诉我。

感谢您的任何建议。

Answer 1

为了简单起见，您不必在server.R中编写任何代码。通过编写一些javascript代码，可以很好地解析URL查询字符串（例如?obs=10）并设置相应的输入。

下面我将举一个简单的例子，您可以看到如何动态设置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

最后，您需要在Shiny项目目录下创建文件夹www/js，并将此parse_input.js文件放在js文件夹中。

$(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);
                }
            });
        });
    }
});

然后，您可以使用http://localhost:7691/?sex=Female&age=44&username=Jane等网址访问该网站。

您应该在主面板上看到文本变为：

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

编辑：创建当前输入值的快照，将其保存到本地文件，然后使用快照ID将其恢复

Bangyou提醒我，我的原始答案（上文）没有解决他的问题。以下是我的第二次回答这个问题的试验。

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');


});

一个简短的解释：

我们创建两个自定义输入和输出绑定：
- 用户点击“保存”按钮后会触发输入绑定，这会更改隐藏的<input>标记。这允许我们将输入的当前快照发送到服务器。
- 服务器使用观察者来观看快照输入。然后它更新user.saved.snapshots变量，并将其保存到磁盘文件中。
- 我们还创建了自定义输出绑定。服务器将使用此输出绑定将用户输入的特定快照发送到客户端。如果查询字符串?snapshot=[number]可见，服务器将仅向客户端发送有效数据。
或者，您可以使用input$inputs_snapshot列表对象创建显式恢复URL（例如 ?username=Eric&age=44&sex=Male），因为您可以从那里访问所有输入值。我们的javascript也提供了这个功能。

有许多细节需要打磨。您可以考虑使用RSQLite包将这些配置文件保存到SQLite数据库。

但上面的演示应该是一个很好的概念证明。

Answer 2

对于基于R的解决方案，解决将Shiny应用程序的小部件的当前状态编码为URL查询字符串以及从该URL恢复用户输入值的问题，请参阅shinyURL包。它还具有方便的复制到剪贴板按钮，以及与TinyURL Web服务的接口，用于缩短URL。

该软件包非常易于安装和使用。它可以从GitHub获得：

devtools::install_github("aoles/shinyURL")

要在您的应用中启用shinyURL，请按以下3个步骤操作：

在 server.R 和 ui.R 中加载包。
```
library("shinyURL")
```
在 server.R 中的闪亮服务器函数内添加对shinyURL.server(session)的调用，其中session是传递给服务器函数的参数。
将shinyURL.ui()窗口小部件添加到 ui.R 。

Answer 3

基于@ xin-yin建议，我添加了几行代码，以便在观察服务器中的功能时允许保存当前选项.R（基于来自https://gist.github.com/alexbbrown/6e77383b48a044191771的想法）。所有代码都粘贴在这里以防其他人需要它们。

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

Answer 4

建立daattali（Shiny saving URL state subpages and tabs），这需要任意数量的输入，并为几种不同类型的输入分配值：

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))
    }
  }

 }

 })
})

要测试的示例网址：127.0.0.1:5767/?symbol=BBB,AAA,CCC,DDD&date_start=2005-01-02&period_select=2&smaLen=153&usema=1

如何生成一个URL来恢复Shiny中的用户输入值

4 个答案:

ui.R

server.R

WWW / JS / parse_input.js

编辑：创建当前输入值的快照，将其保存到本地文件，然后使用快照ID将其恢复

ui.R

server.R

WWW / JS / parse_input.js