Ответ 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.
Но выше демо должно служить хорошим доказательством концепции.