Подтвердить что ты не робот

Приложение Shiny R, которое позволяет пользователям изменять данные

Это еще не вопрос практический, а скорее теоретический. Я думал об использовании Shiny для отображения некоторых исходных данных интерактивным способом. Это отлично.

Однако - возможно ли, чтобы пользователи меняли отображаемые данные?

Скажем, если у меня есть куча слайдеров для пользователей, чтобы ограничить базовые данные, чтобы они удовлетворяли определенным условиям и отображали эти наблюдения, - можно ли разрешить пользователям вносить изменения в эти данные и отправлять эти изменения в сервер, который, в свою очередь, сохраняет эти изменения?

Я имею в виду сценарии, в которых пользователи могут использовать Блестящее приложение для просмотра данных и обнаружения потенциальных выбросов в данных - пользователь может затем отметить их как выбросы. Однако эта информация должна быть передана на сервер.

Возможно ли такое приложение? Существуют ли некоторые примеры?

4b9b3361

Ответ 1

В Shiny вы можете практически сделать что угодно, так как вы можете создать свой собственный input и output bindings – поэтому ответ на ваш вопрос - да, то, что вы спрашиваете, возможно. Скажем, у вас есть кадр данных, который вы отправляете на веб-страницу для просмотра пользователем. Например, вы хотите, чтобы пользователи просто щелкали по ячейке, если она была удалена, которая должна быть удалена (заменена на 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, чтобы при щелчке ячейки вы могли записать номер строки и столбца (см. здесь), а затем заменить это ячейка с NA в Shiny. Ваша привязка к вводу может выглядеть примерно так (См. Здесь информацию о том, что происходит здесь):

$(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 обновление вашего фрейма данных каждый раз, когда пользователь внесет изменения. Вы хотели бы иметь какую-то кнопку отправки, чтобы после того, как пользователь выполнил все свои изменения, они могут быть применены.


Я даже не тестировал ни один из этих удаленно, поэтому почти наверняка есть некоторые ошибки. Но поскольку вы просто задавали теоретический вопрос, я не слишком много проверял. В общем, общая тактика должна работать. С помощью привязок ввода вы можете получить что-либо с веб-страницы обратно на сервер и наоборот с привязкой к выводам. Может быть, говорить "что-нибудь" - это растяжка? но вы можете многое сделать.

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

shiny-app

В этом случае нажатие на точку увеличивает значение одного из столбцов ( "размер" ) в соответствующей строке (которое визуализируется с использованием аргумента 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

Было бы легко изменить это, чтобы переключить значение в столбце "outlier" (чтобы вы могли отменить свое решение) или напрямую вносить постоянные изменения в фрейм данных.

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