Ответ 1

Чтобы все было просто, вам не нужно писать код в server.R. Разбор строки запроса URL (например, ?obs=10) и установка соответствующих входов могут быть выполнены красиво, просто написав код javascript.

Ниже я представляю простой пример, в котором вы можете увидеть, как вы можете динамически установить значение любых встроенных элементов управления входом для 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 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

Наконец, вам нужно создать папку www/js в вашем каталоге проектов Shiny и поместить этот файл 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 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);
                }
            });
        });
    }
});

Затем вы можете посетить веб-сайт, используя URL, например http://localhost:7691/?sex=Female&age=44&username=Jane.

Вы должны увидеть, что на главной панели текст будет выглядеть следующим образом:

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

EDIT: создать моментальный снимок текущих входных значений, сохранить его в локальном файле и восстановить его с помощью идентификатора моментального снимка

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 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 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>. Это позволяет нам отправить текущий снимок входов на сервер.
  • Сервер использует observer для просмотра моментального снимка. Затем он обновляет переменную user.saved.snapshots и сохраняет ее в файле диска.
  • Мы также создали настраиваемую привязку вывода. Сервер будет использовать эту привязку вывода, чтобы отправить конкретный снимок пользовательских входов клиенту. Сервер будет отправлять достоверные данные клиенту, если строка запроса ?snapshot=[number] видна.
• В качестве альтернативы вы можете использовать объект списка input$inputs_snapshot для создания явного URL-адреса восстановления (например, ?username=Eric&age=44&sex=Male), потому что вы можете получить доступ ко всем входным значениям оттуда. И наш javascript также предоставляет эту функциональность.

Есть много деталей, которые нужно отполировать. Вероятно, вы можете сохранить эти профили в базе данных SQLite с помощью пакета RSQLite.

Но выше демо должно служить хорошим доказательством концепции.

Ответ 2

Для решения на основе R проблемы кодирования текущего состояния виджета приложений Shiny в строке запроса URL-адреса и восстановления значений ввода пользователя с этого URL-адреса см. shinyURL. Кроме того, он имеет удобную кнопку "копировать в буфер" и взаимодействует с веб-службой TinyURL для сокращения URL-адреса.

Пакет очень прост в установке и использовании. Он может быть получен из GitHub:

devtools::install_github("aoles/shinyURL")

Чтобы включить shinyURL в вашем приложении, выполните следующие три шага:

• Загрузите пакет как в server.R a ui.R.

  library("shinyURL")
  

• Добавьте вызов shinyURL.server(session) внутри блестящей серверной функции в server.R, где session - это аргумент, переданный серверной функции.

• Добавьте виджет shinyURL.ui() в ui.R.

Ответ 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

Ответ 4

Создание даатталий (Блестящие сберегательные подписи и вкладки состояния URL), это принимает любое количество входов и присваивает вам значения для нескольких разных типов входов:

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

 }

 })
})

Пример URL для тестирования: 127.0.0.1:5767/?symbol=BBB,AAA,CCC,DDD&date_start=2005-01-02&period_select=2&smaLen=153&usema=1