Как обновить DT datatable в Shiny, когда внутри модуля и критерии выбора изменены

Question

Я пытаюсь создать блестящий модуль для представления данных из информационных кадров с помощью пакета DT. Я хотел бы использовать модуль для стандартной настройки опций DT-таблицы, таких как language и др.

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

Это работает как задумано, когда я не использую модуль для создания таблицы DT. Когда я помещаю код в модуль, при запуске приложения создается таблица. Но при изменении критериев выбора таблица не обновляется.

Я включил приложение, иллюстрирующее проблему. Таблица 1 генерируется без использования блестящего модуля и обновляется, как ожидается, при изменении выбора. Таблица 2 выводится с использованием модуля и не обновляется при изменении выбора.

Я использую R-studio 1.1.463, R версии 3.5.2 и DT версии 0.5.

require("DT")
require("shiny")

# module for presenting data using DT
showDTdataUI <- function(id) { 
  ns <- NS(id)
  tagList(
    DT::dataTableOutput(ns("table"))
  )
  }

showDTdata <- function(input, output, session, DTdata) {
  output$table <- renderDataTable({
      DT::datatable(DTdata)
    })
}

# User interface
ui <- 
  fluidPage(
    sidebarLayout(
      sidebarPanel(id="DT",
                   width = 4,
                   helpText(h4("Select")),
                   selectInput("selectedSpecies", label = "Species",
                               choices = c("setosa","versicolor","virginica"), 
                               selected = "versicolor")
      ),
      mainPanel(
        h3("Table 1. Presenting selected data from Iris" ),
        DT::dataTableOutput("table"),
        h5(br("")),
        h3("Table 2. Presenting selected data from Iris using shiny module"),
        showDTdataUI(id="testDTModule")
      )
    )
  )


# Define server logic ----
server <- function(session, input, output) {

  selectedIris <- reactive ( {
    selected <- iris[which(iris$Species==input$selectedSpecies),]
    selected
  })

  output$table <- renderDataTable({
    DT::datatable(selectedIris())
  })

  callModule(showDTdata, id="testDTModule", DTdata=selectedIris())

}

# Run the app ----
shinyApp(ui = ui, server = server)

Answer 1

Вы должны передать реактивный провод в showDTdata:

showDTdata <- function(input, output, session, DTdata) {
  output$table <- renderDataTable({
    DT::datatable(DTdata()) # not datatable(DTdata)
  })
}

callModule(showDTdata, id="testDTModule", DTdata=selectedIris) # not DTdata=selectedIris()

Answer 2

Не зная о блестящем модульном подходе, я бы, вероятно, написал его как обычную функцию.Приложение, представленное ниже, работает, но мне любопытно, увидев ответ @Stephane, в чем преимущества использования метода callModule по сравнению с подходом обычной функции

require("DT")
require("shiny")


makeTable <- function(dataframe) { DT::datatable(dataframe) %>% 
                                   formatStyle(names(dataframe), background = '#fff') 
                                  }

# User interface
ui <- 
  fluidPage(
    sidebarLayout(
      sidebarPanel(id="DT",
                   width = 4,
                   helpText(h4("Select")),
                   selectInput("selectedSpecies", label = "Species",
                               choices = c("setosa","versicolor","virginica"), 
                               selected = "versicolor")
      ),
      mainPanel(
dataTableOutput('Table1')
      )
    )
  )


# Define server logic ----
server <- function(session, input, output) {

  selectedIris <- reactive ( {
    selected <- iris[which(iris$Species==input$selectedSpecies),]
    selected
  })

 output$Table1 <- renderDataTable(makeTable(selectedIris()))
}

# Run the app ----
shinyApp(ui = ui, server = server)

Answer 3

Делает ли это то, что вы хотите? Я удалил ваши функции и добавил selection ='multiple' в таблицу 1 (tableX), чтобы мы могли затем прослушать tableX_rows_selected

P.S .: Я заметил, что если вы сначала загрузите DT, а затем сверкаете, то все приложение больше не будет работать. Это немного странно, поскольку мы вызываем все датируемые функции с помощью DT :: ... но вы получаете предупреждение о том, что некоторые части DT замаскированы «глянцевым» или наоборот.

require("shiny")
require('DT')


# User interface
ui <- 
    fluidPage(
        sidebarLayout(
            sidebarPanel(id="DT",
                         width = 4,
                         helpText(h4("Select")),
                         selectInput("selectedSpecies", label = "Species",
                                     choices = c("setosa","versicolor","virginica"), 
                                     selected = "versicolor")
            ),
            mainPanel(
                h3("Table 1. Presenting selected data from Iris" ),
                DT::dataTableOutput("tablex"),
                br(),
                h3("Table 2. Presenting selected data from Iris using shiny module"),
                DT::dataTableOutput("table2")

            )
        )
    )


# Define server logic ----
server <- function(session, input, output) {

    values <- reactiveValues(rowselect = numeric())

    selectedIris <- reactive ( {
        selected <- iris[which(iris$Species==input$selectedSpecies),]
        selected
    })

    output$tablex <- renderDataTable({
        DT::datatable(selectedIris(), selection = 'multiple')
    })


    IrisSelected <- reactive({ 
        df <- iris[c(input$tablex_rows_selected), ]
        df
    })


    output$table2 <- renderDataTable({
        req(nrow(IrisSelected()) > 0)
        DT::datatable( IrisSelected())
    })  
}

# Run the app ----
shinyApp(ui = ui, server = server)