Как renderDataTable или renderTable для отдельных элементов списка из списка в блестящем - PullRequest
1 голос
/ 23 сентября 2019

Скажите, что у меня есть следующее - принимая к сведению myList:

library(shiny)

myList <- list(
  first_element = tibble(a = 1, b = 2),
  second_element = tibble(a = 4:5, e = 7:8),
  third_element = tibble(a = c("one", "two", "three"), x = c("another", "another one", "another two"))
)

ui <- fluidPage(
  titlePanel("A Title"),
  verbatimTextOutput("pretty_output")
)

server <- function(input, output, session) {
  output$pretty_output <- renderPrint({
    myList
  })
}

shinyApp(ui, server)

Это приводит к:

Shiny App

Я хотел бы представить myList как отдельные элементы renderTable или renderDataTable программно.Следующее иллюстрирует подход грубой силы, но я ищу что-то более гибкое, более СУХОЕ, используя цикл for, lapply, purrr::map() и / или что-то еще.

ПРИМЕЧАНИЕ. Длина myList должна быть неизвестной.

library(shiny)
library(DT)

myList <- list(
  first_element = tibble(a = 1, b = 2),
  second_element = tibble(a = 4:5, e = 7:8),
  third_element = tibble(a = c("one", "two", "three"), x = c("another", "another one", "another two"))
)

ui <- fluidPage(
  titlePanel("A Title"),
  dataTableOutput("dt_01"),
  dataTableOutput("dt_02"),
  dataTableOutput("dt_03")
)

server <- function(input, output, session) {
  output$dt_01 <- renderDataTable({
     datatable(myList[[1]], caption = names(myList[1]))
  })

  output$dt_02 <- renderDataTable({
    datatable(myList[[2]], caption = names(myList[2]))
  })

  output$dt_03 <- renderDataTable({
    datatable(myList[[3]], caption = names(myList[3]))
  })

}

shinyApp(ui, server)

Ответы [ 2 ]

1 голос
/ 23 сентября 2019

Пожалуйста, проверьте следующий lapply подход:

library(shiny)
library(DT)

myList <- list(
  first_element = data.frame(a = 1, b = 2),
  second_element = data.frame(a = 4:5, e = 7:8),
  third_element = data.frame(a = c("one", "two", "three"), x = c("another", "another one", "another two"))
)

ui <- fluidPage(
  titlePanel("A Title"),
  uiOutput("tables")
)

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

  lapply(names(myList), function(x) {
    output[[x]] = renderDataTable({myList[[x]]})
  })

  output$tables <- renderUI({
    lapply(names(myList), dataTableOutput)
  })

}

shinyApp(ui, server)
0 голосов
/ 23 сентября 2019

Так что я думаю, что большинство подходов будет включать renderUI, вот что я сделал (это выглядит довольно элегантно), но я оставлю это без ответа на некоторое время, чтобы посмотреть, могут ли другие вмешаться. Код под сильным влиянием этот пост :

library(shiny)

myList <- list(
  first_element = tibble(a = 1, b = 2),
  second_element = tibble(a = 4:5, e = 7:8),
  third_element = tibble(a = c("one", "two", "three"), x = c("another", "another one", "another two"))
)

ui <- fluidPage(
  titlePanel("A Title"),
  uiOutput("tables")
)

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

  # Create the outputs dynamically
  output$tables <- renderUI({

    tableList <- imap(myList, ~ {
      tagList(
        h4(.y), # Note we can sprinkle in other UI elements
        tableOutput(outputId = paste0("table_", .y))
      )
    })

    tagList(tableList)
  })

  # Now render each output
  iwalk(myList, ~{
    output_name <- paste0("table_", .y)
    output[[output_name]] <- renderTable(.x)
  })

}

shinyApp(ui, server)

Shiny App

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...