Как обновить Shiny Datatable после отправки с помощью отфильтрованных видимых данных на основе Reactive? - PullRequest
Новая
       6

Как обновить Shiny Datatable после отправки с помощью отфильтрованных видимых данных на основе Reactive?

1 голос
/ 07 мая 2020

Это мой первый вопрос к SO, и я постараюсь быть максимально кратким и ясным.

Я модифицирую одну версию базового c Shiny CRUD, предоставленного Дином Аттали (которому: спасибо) для исследовательских целей. Для этого я создал игрушку MRE (см. Ниже), которая демонстрирует основные модели поведения, которых я пытаюсь достичь.

  1. Пользовательские фильтры отображают данные, основанные на реактивном (refreshData () input $ item_used)
  2. Пользователь может добавлять или удалять новые записи (saveData (), deleteData ())
  3. Пользователь может щелкать строки и динамически просматривать реактивные изменения через DT :: dataTableOutput.

Моя проблема заключается в следующем: если пользователь добавляет новую запись, и видимые данные DT фильтруются по одному из двух вариантов в раскрывающемся списке, тогда активное представление DT не обновляет . Предположим, пользователь добавляет новую запись к элементам «B», при этом все элементы и только элементы «B» отображаются в таблице (фильтруются через раскрывающийся список) - чтобы увидеть новую запись, ей необходимо выберите элементы «A», а затем снова выберите элементы «B», чтобы «обновить sh» таблицу, чтобы увидеть новую запись.

Я знаю, что здесь есть простое решение, основанное на реактивности, но я не могу его идентифицировать. Будем признательны за вашу коллективную помощь! 

library(shiny)
library(shinyjs)

# Define the fields we want to save from the form
fields <- c("name", "item_used", "notes")
data <- data.frame(name = c("Luthien","Aredhel","Beren","Turin"),
                   item_used = c("A","B","A","B"),
                   notes = c("fixed","not broken","almost fixed", "beyond repair"),
                   stringsAsFactors = FALSE)

# Shiny app with 3 fields that the user can submit data for
shinyApp(
  ui = fluidPage(sidebarLayout(
    sidebarPanel(width = 3,

                 selectInput("select_used", "Item Used?", choices = c("", "A","B")),
                 tags$hr(),
                  lapply(1:length(fields), function(x) textInput(fields[x], fields[x])),
                  actionButton("submit", "Submit"),
                 actionButton("delete", "Delete")
  ),
  mainPanel(DT::dataTableOutput("maindata", width = 300),
            tags$hr()
             ))),
  server = function(input, output, session) {

    # Whenever a field is filled, aggregate all form data
    formData <- reactive({
      data <- sapply(fields, function(x) input[[x]])
      data
    })

    # When the Submit button is clicked, save the form data
    observeEvent(input$submit, {
      saveData(formData())
    })

    # Show the previous responses
    # (update with current response when Submit is clicked)
    output$maindata <- DT::renderDataTable({
      input$delete
      input$submit
      refreshData()
    })

    observeEvent(input$maindata_rows_selected, {
      dat <- refreshData()[input$maindata_rows_selected,]
      for(i in 1:length(dat)){
        updateTextInput(session, fields[i], value = unname(dat[i]))
      }

    })

    observeEvent(input$delete,{
      deleteData()
    })

    deleteData <- function(){
      delrow <- row.names(refreshData()[input$maindata_rows_selected,])
      data <- loadData()[-c(as.numeric(delrow)),]
      data <<- data

    }

    loadData <- function(){
      data <- data
      return(data)
    }    

    saveData <- function(data) {
      data <- rbind(loadData(), formData())
      data <<- data
    }

    refreshData <- reactive({
      data <- loadData()
      if(input$select_used == ""){
        data
      } else {
        data[data$item_used == input$select_used, ]
      }
    })
  }
)

1 Ответ

0 голосов
/ 16 мая 2020

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

Вместо того, чтобы определять «обновленные данные» как реактивные, это должна быть функция. Итак ... 

 refreshData <- reactive({...})

... должно быть ... 

 refreshData <- function(){...}

Никаких других изменений исходного кода не требуется. С изменением функции refreshData в качестве функции становится возможным вставлять новые данные (через поля ввода) с сохранением отфильтрованного представления (в DT) на основе пользовательского ввода.

...