Изменение и объединение реактивного фрейма данных, загруженного пользователем, в блестящее приложение

Я создаю блестящее приложение, часть которого вычисляет модель линейной регрессии на основе данных, загруженных и измененных пользователем. Я делаю все шаг за шагом, поэтому здесь я покажу вам только код тестового приложения, касающийся основной проблемы. Идея такая:

  1. Пользователь загружает данные из файла .csv, используя fileInput в блестящем
  2. Данные отображаются, а затем, после их изучения, пользователь может изменять переменные по своему выбору.
  3. Каждая выбранная и измененная переменная отображается со старыми переменными как новая реактивная таблица данных - мне удалось пройти через нее с помощью этой: Добавить значения в реактивную таблицу блестящим цветом

Теперь все отлично работает с приведенным ниже кодом, когда указан исходный набор данных:

test_df <- data.frame(a = seq(1000, 21000, 1000), b = seq(1:21), c = seq(100, 300, 10))

library(shiny)

runApp(list(
  ui=pageWithSidebar(headerPanel("Adding entries to table"),
                 sidebarPanel(uiOutput("select1"),
                              selectInput("select2", "Choose modification",
                                          choices = c("log", "different"), 
                                          selected = NULL, multiple = F),
                              actionButton("update", "Update Table")),
                 mainPanel(tableOutput("table1"))),

server=function(input, output, session) {

values <- reactiveValues()

### specifing the dataset ###
values$df <- data.frame(test_df)
nr <<- nrow(test_df)

### this will contain the modified values ###
values$d <- data.frame(1:nr)

### selecting a variable to modify ###
output$select1 <- renderUI({
  nc <- ncol(values$df)
  nam <- colnames(values$df)
  selectInput("var", label = "Select var:",
              choices = c(nam), multiple = F,
              selected = nam[1])
})

### calculations needed for modifactions ###
newEntry <- observeEvent(input$update, {

  if(input$select2 == "log") {
    newCol <- isolate(
      c(log(values$df[input$var]))
    )
    newCol <- as.data.frame(newCol)
    colnames(newCol) <- paste0("Log of ", input$var)
  } 

  else if(input$select2 == "different") {
    newCol <- isolate(
      c(1-exp(-(values$df[input$var]/100)))
    )
    newCol <- as.data.frame(newCol)
    colnames(newCol) <- paste0(input$var, "Diff of", input$dr1)
  } 
  ### adding new modified columns to the dataframe ###
  isolate(
    values$d <- dplyr::bind_cols(values$d, newCol)
  )

})

output$table1 <- renderTable({
  d1 <- values$d
  nc <- ncol(d1)

  ### printing the whole dataframe (initial+modified) - skipping ###
  ### the first column of modified values, as it doesn't contain our data ###
  if(input$update == 0) {
    print(data.frame(test_df))
  } else {
    data.frame(values$df, d1[2:nc])
  }
})

}))

Однако, когда я хочу включить первый шаг, который означает загрузку набора данных ПОСЛЕ запуска приложения, приложение не запускается, поскольку теперь я имею в виду реактивный контент, которого, вероятно, не существует. Вот обновленный код с возможностью загрузки данных из вашего собственного источника:

library(shiny)

runApp(list(
ui=pageWithSidebar(headerPanel("Adding entries to table"),
                 sidebarPanel(fileInput("file1", "Choose file to upload", accept = c("text/csv", "text/comma-separated-values", "text/tab-separated-values", "text/plain", ".csv",".tsv")), 
                              checkboxInput("header", "Header", TRUE), 
                              radioButtons("sep", "Separator",c(Comma=",",Semicolon=";",Tab="\t"),","), 
                              radioButtons("dec", "Decimal",c(Comma=",",Dot="."),","), 
                              actionButton("Load", "Load the File"),
                              uiOutput("select1"),
                              selectInput("select2", "Choose modification",
                                          choices = c("log", "different"), 
                                          selected = NULL, multiple = F),
                              actionButton("update", "Update Table")),
                 mainPanel(tableOutput("table1"))),

server=function(input, output, session) {

values <- reactiveValues()

### uploading data from external source ###
data1 <- reactive({
  if(input$Load == 0){return()}
  inFile <- input$file1
  if (is.null(inFile)){return(NULL)}

  isolate({ 
    input$Load
    my_data <- read.csv(inFile$datapath, header = input$header, sep = input$sep, stringsAsFactors = FALSE, dec = input$dec)
  })
  my_data
})

### specifing the dataset ###
values$df <- data.frame(data1())
nr <<- nrow(data1())

### this will contain the modified values ###
values$d <- data.frame(1:nr)

### selecting a variable to modify ###
output$select1 <- renderUI({
  nc <- ncol(values$df)
  nam <- colnames(values$df)
  selectInput("var", label = "Select var:",
              choices = c(nam), multiple = F,
              selected = nam[1])
})

### calculations needed for modifactions ###
newEntry <- observeEvent(input$update, {

  if(input$select2 == "log") {
    newCol <- isolate(
      c(log(values$df[input$var]))
    )
    newCol <- as.data.frame(newCol)
    colnames(newCol) <- paste0("Log of ", input$var)
  } 

  else if(input$select2 == "different") {
    newCol <- isolate(
      c(1-exp(-(values$df[input$var]/100)))
    )
    newCol <- as.data.frame(newCol)
    colnames(newCol) <- paste0(input$var, "Diff of", input$dr1)
  } 
  ### adding new modified columns to the dataframe ###
  isolate(
    values$d <- dplyr::bind_cols(values$d, newCol)
  )

})

output$table1 <- renderTable({
  d1 <- values$d
  nc <- ncol(d1)

  ### printing the whole dataframe (initial+modified) - skipping the first ###
  ### column of modified values, as it doesn't contain our data ###
  if(input$update == 0) {
    print(data.frame(test_df))
  } else {
    data.frame(values$df, d1[2:nc])
  }
})

}))

Я получаю ошибку:

Ошибка в .getReactiveEnvironment () $ currentContext: операция не разрешена> без активного реактивного контекста. (Вы пытались сделать что-то, что можно сделать только> внутри реактивного выражения или наблюдателя.)

Конечно, мне что-то не хватает о реактивности Shiny, но я внимательно прочитал много разных статей, вопросов и т. Д. И не могу найти ответа на этот. Проблема не в загрузке самого файла, потому что этот блок кода отлично работает в другом приложении, когда я записываю реактивный набор данных в обычную переменную, прежде чем обращаться к его содержимому. Но как я могу это сделать здесь при записи данных в values$...? Или, может быть, есть другое решение для такой работы с реактивными данными из внешнего источника? Надеюсь, я все прояснил.


person Maria J.    schedule 15.12.2016    source источник
comment
Помогает, если поставить req(input$file1) в начале data1 reactive?   -  person John Paul    schedule 15.12.2016
comment
@JohnPaul Нет, приложение закрывается с той же ошибкой.   -  person Maria J.    schedule 16.12.2016
comment
Попытайтесь поместить свой values$xxx в наблюдателя, когда он заметен в реактивном контексте, например observe({values$df <- data1()}). Здесь data1() является реактивным, поэтому ваш код не работает.   -  person Stéphane Laurent    schedule 18.12.2016


Ответы (1)


Спасибо @ StéphaneLaurent за вашу помощь! По-прежнему были проблемы с глобальной переменной nr, но следующие изменения заставили ее работать.

Сначала я указываю тестовые данные, которые будут показаны до того, как пользователь загрузит какие-либо данные (чтобы у приложения была некоторая база для вычислений, а не нули): test_df <- data.frame(a = seq(1000, 21000, 1000), b = seq(1:21), c = seq(100, 300, 10)).

Затем я использую его при указании реактивного фрейма данных, если пользовательский ввод отсутствует:

  data1 <- reactive({
  if(input$Load == 0){return(test_df)}
  inFile <- input$file1
  if (is.null(inFile)){return(test_df)}

  isolate({ 
    input$Load
    my_data <- read.csv(inFile$datapath, header = input$header, sep = input$sep, stringsAsFactors = FALSE, dec = input$dec)
  })
  my_data
})

И, наконец, я использую функцию observe для своих переменных, которые зависят от некоторых других реактивных переменных:

observe({
  values$df <- data.frame(data1())
  nr <- nrow(data1())
  values$d <- data.frame(1:nr)
})

Остальной код не требует дополнительных изменений, и теперь приложение работает отлично.

person Maria J.    schedule 27.12.2016