Shiny R application that allows users to modify da

Question

This is not yet a practical question but rather a theoretical one. I was thinking of using Shiny to display some raw data in an interactive way. This is fine.

However - is it possible to have users change the data that is displayed?

Say, if I have a bunch of sliders for users to restrict the underlying data to satisfy certain conditions and have these observations displayed - is it possible to allow the users to make modifications to that data and have these modifications sent back to the server, which in turn saves these changes?

I am thinking of scenarios where users may use a Shiny Application to browse through data and detect potential outliers in the data -- the user can then flag these as outliers. However, that information needs to be passed back to the server.

Is such an application possible? Are there some existing examples?

Answer 1

You can basically do almost anything in Shiny since you can create your own input and output bindings – so the answer to your question is yes, what you're asking is possible. Say you have a data frame that you send to a web page to be viewed by the user. As an example, you want to allow users to simply click a cell if it's an outlier that should be removed (replaced with NA).

Let's say the data frame looks like this:

x <- data.frame(Age = c(10, 20, 1000), Weight = c(120, 131, 111))
x

# Age    Weight
# 10     120
# 20     131
# 1000   111

From shiny you would construct a normal HTML table that might look something like this when displayed on the webpage:

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

Now break out the jQuery and bind a click event so that when a cell is clicked you can record the row and column number (see here) and then replace that cell with NA in Shiny. Your input binding might look something like (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);

There's a lot going on here, but generally these input bindings are fairly similar to each other. The most important thing is the setValue() function. What should be happening there (this is untested) is the row and column number of the cell being clicked is recorded and posted back to the server.

Then from Shiny you would simply do something like:

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.
  # ... 
  # ...

})

You will probably need to make an output binding for output$outliers as well. This is simplified code here obviously, you would need to apply error checking etc.

This is just an example. In reality, you would probably not have Shiny updating your data frame every single time a user makes a change. You would want to have some sort of submit button so that once the user has made all of his/her changes they can be applied.

---

I haven't even remotely tested any of this so there are almost certainly some errors. But since you were just asking a theoretical question I didn't check it too much. The general tactic should work anyway. With input bindings you can get anything from a web page back to the server and vice versa with output bindings. Maybe saying "anything" is a stretch — but you can do a lot.

Answer 2

I have been working on a package that uses this workflow:

1. The user loads data into the R session and completes some initial screening from the command line
2. The data is passed to a Shiny app that allows the user to interactively select and modify the data
3. the user clicks a button to end the shiny session, and the modified data is returned to the R session, with all the changes made by the user intact.

This is not the usual way Shiny is used - the app isn't being deployed remotely, but instead is used locally to serve as an interactive plotting interface for a single user. I have done similar things with base graphics and the locator() function, which is tedious. It may be easier to use tcl/tk, but I was curious to see how it might work with Shiny.

Here's a toy example:

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)

In this case, clicking on a point increases the value of one of the columns ("size") in the corresponding row (which is visualized using the cex argument when plotted). The values are returned to the user and, in this case, stored in the modDF variable:

> 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

It would be easy to modify this to toggle the value in an 'outlier' column (so that you could reverse your decision), or to directly make permanent changes in the data frame.

In my actual package, I use this approach to allow the user to visually select initial parameters for a non-linear regression, immediately see the resulting model fit plotted in the browser, repeat until they get a fitted model that looks sensible, and finally save the results and return to their R session.