允许用户修改数据的闪亮 R 应用程序答案

【问题标题】：Shiny R application that allows users to modify data允许用户修改数据的闪亮 R 应用程序
【发布时间】：2013-06-20 06:15:06
【问题描述】：

这还不是一个实际问题，而是一个理论问题。我正在考虑使用 Shiny 以交互方式显示一些原始数据。这可以。

但是 - 是否可以让用户更改显示的数据？

假设我有一堆滑块供用户限制基础数据以满足某些条件并显示这些观察结果 - 是否可以允许用户修改该数据并将这些修改发送回服务器，然后保存这些更改？

我正在考虑用户可能使用 Shiny 应用程序浏览数据并检测数据中潜在异常值的场景——然后用户可以将这些标记为异常值。但是，需要将该信息传递回服务器。

这样的应用可能吗？有没有现成的例子？

【问题讨论】：

我想困难在于有一个可编辑的数据表，我不知道现有的。一旦我们有了这样一个显示和可编辑的数据表，信息就可以传回服务器。

标签： r shiny shiny-server

【解决方案1】：

您基本上可以在 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

从 shiny 你会构建一个普通的 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 并绑定一个单击事件，以便在单击单元格时记录行号和列号 (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.
  # ... 
  # ...

})

您可能还需要为 output$outliers 进行输出绑定。这显然是简化的代码，您需要应用错误检查等。

这只是一个例子。实际上，您可能不会在每次用户进行更改时都让 Shiny 更新您的数据框。您可能希望有某种提交按钮，这样一旦用户完成了所有更改，就可以应用它们。

我什至没有远程测试过这些，所以几乎可以肯定存在一些错误。但是由于您只是在问一个理论问题，因此我没有过多地检查它。无论如何，一般策略都应该奏效。使用输入绑定，您可以将任何内容从网页返回到服务器，反之亦然，使用输出绑定。也许说“任何事情”有点牵强——但你可以做很多事情。

【讨论】：

【解决方案2】：

我一直在开发使用此工作流程的软件包：

用户将数据加载到 R 会话中并从命令行完成一些初始筛选
数据被传递到 Shiny 应用程序，允许用户以交互方式选择和修改数据
用户单击按钮结束闪亮会话，修改后的数据返回到 R 会话，用户所做的所有更改都完好无损。

这不是使用 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 会话。

【讨论】：