这不是一个实际问题,而是一个理论问题。我正在考虑使用Shiny以交互方式显示一些原始数据。这可以。
但是 - 是否可以让用户更改显示的数据?
假设,如果我有一堆滑块供用户限制基础数据以满足某些条件并显示这些观察结果 - 是否可以允许用户对该数据进行修改并将这些修改发送回服务器,然后保存这些更改?
我在考虑用户可以使用Shiny Application浏览数据并检测数据中潜在异常值的情况 - 然后用户可以将这些标记为异常值。但是,该信息需要传递回服务器。
这样的申请是否可行?是否有一些现有的例子?
答案 0 :(得分:19)
你基本上可以在Shiny中做任何事情,因为你可以创建自己的input和output绑定 - 所以你的问题的答案是肯定的,你所要求的是可能的。假设您有一个数据框,您发送到网页以供用户查看。例如,您希望允许用户只需单击一个单元格,如果它是一个应该删除的异常值(替换为NA
)。
假设数据框如下所示:
x <- data.frame(Age = c(10, 20, 1000), Weight = c(120, 131, 111))
x
# Age Weight
# 10 120
# 20 131
# 1000 111
从闪亮开始,您将构建一个普通的HTML表格,在网页上显示时可能看起来像这样:
<table class="outlier-finder" id="outliers">
<tr>
<td>Age</td>
<td>Weight</td>
</tr>
<tr>
<td>10</td>
<td>120</td>
</tr>
<tr>
<td>20</td>
<td>131</td>
</tr>
<tr>
<td>1000</td>
<td>111</td>
</tr>
</table>
现在打破jQuery并绑定一个click事件,以便在单击一个单元格时,您可以记录行号和列号(see here),然后用Shiny中的NA
替换该单元格。您的输入绑定可能类似于(see here for details of what's going on here):
$(document).on("click", ".outlier-finder td", function(evt) {
// Identify the clicked cell.
var el = $(evt.target);
// Raise an event to signal that the something has been selected.
el.trigger("change");
});
var cell_binding = new Shiny.InputBinding();
$.extend(cell_binding, {
find: function(scope) {
return $(scope).find(".outlier-finder td");
},
getValue: function(el) {
// Get the row and cell number of the selected td.
var col = el.parent().children().index(el);
var row = el.parent().parent().children().index(el.parent());
var result = [row, col];
return result;
},
setValue: function(el, value) {
$(el).text(value);
},
subscribe: function(el, callback) {
$(el).on("change.cell_binding", function(e) {
callback();
});
},
unsubscribe: function(el) {
$(el).off(".cell_binding");
}
});
Shiny.inputBindings.register(cell_binding);
这里有很多内容,但通常这些输入绑定彼此非常相似。最重要的是setValue()
函数。那里应该发生什么(这是未经测试的)是被记录的单元格的行号和列号被记录并发回服务器。
然后从Shiny你可以简单地做一些事情:
updateData <- reactive({
# Get selection
remove_outlier <- as.integer(RJSONIO::fromJSON(input$outliers))
if (!is.null(remove_outlier)) {
# Remove that outlier.
x[remove_outlier[1], remove_outlier[2]] <- NA
}
return(x)
})
output$outliers <- renderText({
# Update x.
current_x <- updateData()
# Write code to output current_x to page.
# ...
# ...
})
您可能还需要为输出$ outliers进行输出绑定。这显然是简化代码,您需要应用错误检查等。
这只是一个例子。实际上,每次用户进行更改时,您可能不会使Shiny更新数据框。您可能希望拥有某种提交按钮,以便一旦用户完成所有他/她的更改,就可以应用它们。
我甚至没有对此进行任何远程测试,因此几乎肯定存在一些错误。但既然你只是在问一个理论问题,我就没有检查过多。无论如何,一般的策略应该是有效的。使用输入绑定,您可以通过输出绑定从网页返回到服务器,反之亦然。也许说“任何事情”都是一个延伸 - 但你可以做很多事情。
答案 1 :(得分:0)
我一直在研究使用此工作流程的软件包:
这不是通常使用Shiny的方式 - 应用程序不是远程部署,而是在本地用作单个用户的交互式绘图界面。我用基本图形和locator()
函数做了类似的事情,这很乏味。使用tcl / tk可能更容易,但我很想知道它如何与Shiny一起使用。
这是一个玩具示例:
myShiny <- function(mydata){
ui <- fluidPage(
actionButton("exit", label = "Return to R"),
plotOutput("dataPlot", click = "pointPicker")
)
server <- function(input, output){
output$dataPlot <- renderPlot({
plot(x = myData()[, 1], y = myData()[,2], cex = myData()[,3])
})
myData <- reactive({
selPts <- nearPoints(mydata,
input$pointPicker, "x", "y",
threshold = 25, maxpoints = 1, allRows = TRUE)
if(sum(selPts[,"selected_"]) > 0){
## use '<<-' to modify mydata in the parent environment, not the
## local copy
mydata[which(selPts[, "selected_", ]), "size"] <<-
mydata[which(selPts[, "selected_", ]), "size"] + 1
}
mydata
})
observe({
if(input$exit > 0)
stopApp()
})
}
runApp(shinyApp(ui = ui, server = server))
return(mydata)
}
testDF <- data.frame(x = seq(0, 2 * pi, length = 13),
y = sin(seq(0, 2 * pi, length = 13)),
size = rep(1, 13))
modDF <- myShiny(testDF)
在这种情况下,单击某个点会增加相应行中某列(“大小”)的值(在绘制时使用cex
参数可视化)。这些值将返回给用户,在这种情况下,存储在modDF
变量中:
> modDF
x y size
1 0.0000000 0.000000e+00 1
2 0.5235988 5.000000e-01 5
3 1.0471976 8.660254e-01 1
4 1.5707963 1.000000e+00 1
5 2.0943951 8.660254e-01 2
6 2.6179939 5.000000e-01 1
7 3.1415927 1.224647e-16 1
8 3.6651914 -5.000000e-01 7
9 4.1887902 -8.660254e-01 1
10 4.7123890 -1.000000e+00 1
11 5.2359878 -8.660254e-01 3
12 5.7595865 -5.000000e-01 1
13 6.2831853 -2.449294e-16 1
很容易修改它以在“异常值”列中切换值(以便您可以撤销决定),或者直接在数据框中进行永久性更改。
在我的实际包中,我使用这种方法允许用户在视觉上选择非线性回归的初始参数,立即看到在浏览器中绘制的最终模型拟合,重复直到他们得到一个看起来合理的拟合模型,最后保存结果并返回R会话。