RShiny - Рендеринг InfoBox из списка

Question

В R я знаком с параметром renderMenu для отображения списка строк в кадре данных в виде раскрывающегося меню:

Сторона сервера:

output$task_menu <- renderMenu({
        tasks <- apply(task_data, 1, function(row) {
          taskItem(text = row[["text"]],
                   value = row[["value"]])
        })

        dropdownMenu(type = "tasks", .list = tasks)
      })

и сторона пользовательского интерфейса:

dashboardHeader(dropdownMenuOutput("task_menu"))

У вас есть представление о том, как сделать что-то похожее с infoBoxes в составе FluidRow в dashboardBody?

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

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

library(shiny); library(shinydashboard)
library(plyr);library(dplyr)

apps_directory <- data.frame(category = c('Movies','Books','Movies','Movies','Books'), 
                             title = c('Lord of the Rings','Neverending story','Batman','Superman','The little prince'), 
                             description = c('This..', 'This..', 'This..', 'This..', 'This..'), 
                             icon = c('rocket', 'rocket', 'rocket', 'rocket','rocket'), 
                             PageURL = c('http://www.google.com', 'http://www.google.com', 'http://www.google.com','http://www.google.com','http://www.google.com'))

#add html link tags
apps_directory$PageURL <- paste0("<a href='",apps_directory$PageURL,"'>",apps_directory$PageURL,"</a>")

header <- dashboardHeader(disable = TRUE)

sidebar <- dashboardSidebar(disable = TRUE)

body <- dashboardBody(
  tableOutput("view")
)

server <- function(input, output) {
  output$view <- renderTable({apps_directory}
                             , sanitize.text.function = function(x) x)
}


ui <- dashboardPage(header = header,
                    sidebar = sidebar,
                    body = body
)
shinyApp(ui, server)

Спасибо!

Answer 1

Надеюсь, это немного поможет вам на вашем пути;)

library(shiny)
library(shinydashboard)

myTabs = lapply(X = 1: 3, FUN=infoBox, title=paste("tabPanels"));
for (i in 1:3){
  myTabs[[i]]$attribs$`data-value` <- i+1
  myTabs[[i]]$attribs$title <- paste("tabPanels", i)
  myTabs[[i]]$attribs$class <- "tab-pane fa-fw"
  myTabs[[i]]$attribs$'data-icon-class' <- paste0("fa fa-battery-",i+1)
}
nlp <- do.call(navlistPanel, myTabs)


header <- dashboardHeader(disable = TRUE)
sidebar <- dashboardSidebar(disable = TRUE)
body <- dashboardBody(
  nlp
)

server <- function(input, output) {
  output$view <- renderTable({apps_directory}
                             , sanitize.text.function = function(x) x)
}

ui <- dashboardPage(header = header,
                    sidebar = sidebar,
                    body = body
)
shinyApp(ui, server)