Как сделать rhandsontable реагирующим как на загрузку данных, так и на пользовательские изменения? - PullRequest
0 голосов
/ 31 января 2019

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

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

Моя проблема в том, что я могу решить отдельные проблемы в вопросе.Я знаю, как сохранить rhandsontable в бэк-энде, если сделано редактирование (как описано здесь ).В приведенном ниже примере приложения я знаю, как обновить отображение имен столбцов и флажков, если загружаются новые данные.

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

library(shiny)
library(rhandsontable)

dataTabUI <- function(id, i, od, os) {
  ns <- NS(id)
  tagList(i,
          column(6, tableOutput(od)),
          column(6, rHandsontableOutput(os)))
}

dataTab <- function(input, output, session) {

}

csvFileInput <- function(id, label = "CSV file") {
  ns <- NS(id)
  tagList(
    fileInput(ns("file"), label)
  )
}

csvFile <- function(input, output, session) {
  userFile <- reactive({
    validate(need(input$file, message = FALSE))
    input$file
  })
  dataframe <- reactive({
    df <- read.csv(
      userFile()$datapath,
      header = TRUE
    )
  })
  dataframe
}

ui <- shinyUI(
  navbarPage(
    "My Application",
    tabPanel(
      "File Upload",
      dataTabUI("tab1", csvFileInput("datafile", "Upload CSV"),
                "data", "vars")
    )
  )
)

server <- function(input, output, session) {
  dataframe <- callModule(csvFile, "datafile")
  output$data <- renderTable({
    head(dataframe(), n = 10L)
  })
  output$vars <- renderRHandsontable({
    df <- dataframe()
    cnames <- colnames(df)
    ctypes <- vapply(cnames, function(cname) {
      class(df[[cname]])
    }, character(1))
    datavars <- data.frame(cnames = cnames, ctypes = ctypes,
                           treat = rep(TRUE, length(cnames)),
                           stringsAsFactors = FALSE)
    rhandsontable(datavars)
  })
}

shinyApp(ui, server)

1 Ответ

0 голосов
/ 01 февраля 2019

Благодаря полезному предложению RStudio Community я могу ответить на свой вопрос.

library(shiny)
library(rhandsontable)

dataTabUI <- function(id, i, od, os) {
  ns <- NS(id)
  tagList(i,
          column(6, tableOutput(od)),
          column(6, rHandsontableOutput(os)))
}

dataTab <- function(input, output, session) {

}

csvFileInput <- function(id, label = "CSV file") {
  ns <- NS(id)
  tagList(
    fileInput(ns("file"), label)
  )
}

csvFile <- function(input, output, session) {
  userFile <- reactive({
    validate(need(input$file, message = FALSE))
    input$file
  })
  dataframe <- reactive({
    df <- read.csv(
      userFile()$datapath,
      header = TRUE
    )
  })
  dataframe
}

ui <- shinyUI(
  navbarPage(
    "My Application",
    tabPanel(
      "File Upload",
      dataTabUI("tab1", csvFileInput("datafile", "Upload CSV"),
                "data", "vars")
    )
  )
)

server <- function(input, output, session) {
  dataframe <- callModule(csvFile, "datafile")
  output$data <- renderTable({
    head(dataframe(), n = 10L)
  })

  dfvars <- reactive({
    df <- dataframe()
    cnames <- colnames(df)
    ivars <- input$vars
    if (length(ivars) > 0) {
      odf <- hot_to_r(ivars)
      ocnames <- odf$cnames
      if (!all(vapply(ocnames, function(x) {
        x %in% cnames
      }, logical(1)))) {
        ctypes <- vapply(cnames, function(cname) {
          class(df[[cname]])
        }, character(1))
        datavars <- data.frame(cnames = cnames, ctypes = ctypes,
                               treat = rep(TRUE, length(cnames)),
                               stringsAsFactors = FALSE)
      } else {
        datavars <- odf
      }
    } else {
      ctypes <- vapply(cnames, function(cname) {
        class(df[[cname]])
      }, character(1))
      datavars <- data.frame(cnames = cnames, ctypes = ctypes,
                             treat = rep(TRUE, length(cnames)),
                             stringsAsFactors = FALSE)
    }
    datavars
  })

  output$vars <- renderRHandsontable({
    rhandsontable(dfvars())
  })

  observe({
    print(dfvars())
  })
}

shinyApp(ui, server)
...