2
votes

In R, I am familiar with the renderMenu option to render a list of rows in a dataframe as a drop-down menu:

Server side:

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

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

and UI side:

dashboardHeader(dropdownMenuOutput("task_menu"))

do you have an idea of how to do something similar with infoBoxes as part of a fluidRow in the dashboardBody?

Concretely, I have a data frame with attributes such as category, title, description, icon, and web link and I would like to generate a dashboard that shows this information in a more user friendly way than just a data table. Ideally, I would generate tabs for each category as well (rather than hard-code them and filter accordingly).

Below is a reproductible code that renders the data as a table. I would like to render each row as an infobox instead, or something much more visual than the data table, and possibly each category in its own tab.

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)

Thank you!

1
Could you upload a full, reproducible example, with some fake data for task_data and a complete shinyApp. This will make it more likely that your qiestion will be answered soon. As i am not sure if you can combine fluidRows and dashboardPage-elements.SeGa

1 Answers

0
votes

Hopefully this might help you a bit on your way ;)

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)