Is it possible to render the dashboard header dropdownmenu or a notificationitem based on a reactive object? My try didn't work.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(uiOutput("drop")),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) {
values<-reactiveValues()
values[["numvotes"]]<-1
output$drop<-renderUI({
dropdownMenu(type = "notifications", badgeStatus = "warning",
notificationItem(icon = icon("ok", lib = "glyphicon"), status = "danger",
paste(values[["numvotes"]],"vote(s)")
) )
})
}
shinyApp(ui, server)
Yes, this is explained in the documentation for shinydashboard with a renderMenu and dropdownMenuOutput:
https://rstudio.github.io/shinydashboard/structure.html#dynamic-content
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(dropdownMenuOutput("notif")),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) {
values<-reactiveValues()
values[["numvotes"]] <- 1
output$notif <- renderMenu({
dropdownMenu(type = "notifications", badgeStatus = "warning",
notificationItem(icon = icon("ok", lib = "glyphicon"), status = "danger",
paste(values[["numvotes"]], "vote(s)")
) )
})
}
shinyApp(ui, server)
Related
I was making reactive shiny web page and stucked at the code below.
library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(title = "header"),
dashboardSidebar(
sidebarMenuOutput("sideBar")),
dashboardBody(
uiOutput("test")
)
)
server = shinyServer(function(input, output, session) {
output$sideBar <- renderMenu({
sidebarMenu(id = "menu",
menuItem("Dashboard", tabName ="dashboard", icon = icon('dashboard')),
menuItem("DBcentor", tabName ="dbcenter", icon = icon('database'))
)
})
output$test <- renderUI ({
tabItems(
tabItem(tabName = "dashboard", uiOutput("dashboardbody")),
tabItem(tabName = "dbcenter", uiOutput("dbcenterbody"))
)
})
output$dashboardbody <- renderUI ({
box("Dashboard Body")
})
output$dbcenterbody <- renderUI ({
box("Dbcenter Body")
})
})
shinyApp(ui, server)
I used uiOutput to build body but after shiny app is loaded, nothing comes out at the dashboard page.
I changed my code like this,
library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(title = "header"),
dashboardSidebar(
sidebarMenuOutput("sideBar")),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard", uiOutput("dashboardbody")),
tabItem(tabName = "dbcenter", uiOutput("dbcenterbody"))
)
)
)
server = shinyServer(function(input, output, session) {
output$sideBar <- renderMenu({
sidebarMenu(id = "menu",
menuItem("Dashboard", tabName ="dashboard", icon = icon('dashboard')),
menuItem("DBcentor", tabName ="dbcenter", icon = icon('database'))
)
})
output$dashboardbody <- renderUI ({
box("Dashboard Body")
})
output$dbcenterbody <- renderUI ({
box("Dbcenter Body")
})
})
shinyApp(ui, server)
Of course it works and box("dashboadbody") comes out at the first page.
I want to use uiOutput because i should use input data to build menus and items.
Any ways to use uiOutput and get box("dashboard") on the default page at the same time?
Try this
ui = dashboardPage(
dashboardHeader(title = "header"),
dashboardSidebar(
sidebarMenuOutput("sideBar")),
dashboardBody(
uiOutput("test")
)
)
server = shinyServer(function(input, output, session) {
output$sideBar <- renderMenu({
sidebarMenu(id = "menu",
menuItem("Dashboard", tabName ="dashboard", icon = icon('dashboard')),
menuItem("DBcentor", tabName ="dbcenter", icon = icon('database'))
)
})
output$dashboardbody <- renderUI ({
box("Dashboard Body")
})
output$dbcenterbody <- renderUI ({
box("Dbcenter Body")
})
updateTabItems(session,"menu","dbcenter")
updateTabItems(session,"menu","dashboard")
output$test <- renderUI ({
tagList(
tabItems(
tabItem(tabName = "dashboard", uiOutput("dashboardbody")),
tabItem(tabName = "dbcenter", uiOutput("dbcenterbody"))
))
})
})
shinyApp(ui, server)
Below I display 2 attempts.I have a shiny dashboard with tabPanels. I would like to create the tabPanels of the tabPanel Data automatically based on the Uni dataframe. In my first try below those tabPanels are commented out inorder to make clear what I mean.
Uni<-data.frame(NAME=c("A","B","C"))
# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
dbHeader <- dashboardHeaderPlus(
title = "Tabs"
)
ui <- dashboardPagePlus(
dbHeader,
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table"),
tabsetPanel(
id ="tabA",
type = "tabs",
for(i in 1:nrow(Uni)){
tabPanel(
paste0(Uni[i,1])
,icon = icon("table"))
}
#tabPanel("A",icon = icon("table")),
#tabPanel("B", icon = icon("table")),
#tabPanel("C", icon = icon("table"))
)
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
and my 2nd attempt:
# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
dbHeader <- dashboardHeaderPlus(
title = "Tabs"
)
ui <- dashboardPagePlus(
dbHeader,
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table"),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
uiOutput("panels")
#tabPanel("A",icon = icon("table")),
#tabPanel("B", icon = icon("table")),
#tabPanel("C", icon = icon("table"))
)
)
)
)
)
server <- function(input, output) {
output$panels <- renderUI({
pan = lapply(1:length(Uni), function(i)
tabPanel(Uni[i,1],icon = icon("table")))
do.call(tabBox,pan)
})
}
shinyApp(ui = ui, server = server)
You have to write the entire tabSetPanel in a do.call statement. tabSetPanels never listen to a list of objects.
Uni<-data.frame(NAME=c("A","B","C"))
# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
dbHeader <- dashboardHeaderPlus(
title = "Tabs"
)
ui <- dashboardPagePlus(
dbHeader,
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table"),
do.call(tabsetPanel,
c(id='tabA',
type="tabs",
lapply(1:nrow(Uni), function(i) {
tabPanel(Uni[i,],icon = icon("table"))
}))
)
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
Is there a way to use a custom icon on infoBox on shinydashboard. I am trying to use the example on hrbrmstr gist but it I can not find the place to update the infoBox function.
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(width = 2, actionButton("count", "Count")),
infoBoxOutput("ibox"),
valueBoxOutput("vbox")
)
)
)
server <- function(input, output) {
output$ibox <- renderInfoBox({
infoBox(
"Title",
input$count,
#icon = icon("credit-card")
icon=icon(list(src=x, width="80px"), lib="local")
)
})
output$vbox <- renderValueBox({
valueBox(
"Title",
input$count,
icon = icon("credit-card")
)
})
}
shinyApp(ui, server)
I used the apputils package from leonawicz. I replaced the infoBox function with the apputils::infoBox.
library(shiny)
library(apputils)
#exApp("icons")
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(width = 2, actionButton("count", "Count")),
infoBoxOutput("ibox"),
valueBoxOutput("vbox")
)
)
)
server <- function(input, output) {
output$ibox <- renderInfoBox({
ic <- apputils::icon(list(src = "https://cdn1.iconfinder.com/data/icons/money-47/512/Money_Currency_Finance-41-512.png", width = "80px"), lib = "local")
apputils::infoBox(
"Title",
input$count,
icon = ic
#icon = icon("credit-card")
#icon=icon(list(src=x, width="80px"), lib="local")
)
})
output$vbox <- renderValueBox({
valueBox(
"Title",
input$count,
icon = icon("credit-card")
)
})
}
shinyApp(ui, server)
I created the main dashboard already in R using the shinydashboard package. However, my main question is how do I upload an Excel Csv file (which contains all the data) into the dashboard? I have been trying to figure this out and I am having trouble. So far, I have the following script:
install.packages("shinydashboard")
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Analysis Project"),
dashboardSidebar(
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Filter Page"),
menuItem("Data")
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard")
)
)
)
server <- function(input,output) { }
shinyApp(ui, server)
How about doing it this way?
library(shiny)
library(readxl)
ui <- fluidPage(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
textInput('file1sheet','Name of Sheet (Case-Sensitive)'),
tableOutput("value")
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
output$value <- renderTable({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$file1$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
}
shinyApp(ui, server)
Try to make a code like that !
library(shiny)
library(shinydashboard)
header <- dashboardHeader(
title = "Analysis Project"
)
sidebar <- dashboardSidebar(
menuItem(text = "Importing file", tabName = "dashboard",icon = icon("file"),
menuSubItem(text = "Importing file", tabName = "dataset")
),
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Filter Page"),
menuItem("Data")
)
body <- dashboardBody(
fluidPage(
tabItems(
tabItem(tabName = "dataset",
fluidRow(
box(width = 12,
fileInput(inputId = "file",
label = "Choose a file",
accept = c(".xlsx",".csv")
),
tableOutput(outputId = "Contents"),
verbatimTextOutput(outputId = "Data")
)
)
)
)
)
)
ui <- dashboardPage(header = header,
sidebar = sidebar,
body = body)
server <- function(input, output, session) {
output$Data <- renderPrint({
if(is.null(input$file)){
print("Import Excel data file")
} else {
inFile <- input$file
df <- read_excel(inFile$datapath)
print(df)
}
})
}
shinyApp(ui = ui, server = server)
how to render a box in shiny according to the data.
data is uploaded by user and it can have more data than this, so i have to create
a box dynamically.
i am running the below code and i am getting four box created in console not in shiny webpage.
please have a look, thankyou.
CODE
list_data <- list(c("AB","CD","EF","GH")) #data
ui <- dashboardPage(
dashboardHeader(title = "Text Mining"),
dashboardSidebar(
sidebarMenu(
menuItem("NLP Tree", tabName = "NLP")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "NLP",
fluidRow(
tabBox(width = 12,height="500",
tabPanel("Sentences",
uiOutput("nlp_sentences_tree")
)
)
)
)
)
)
)
server <- function(input, output) {
output$nlp_sentences_tree <- renderUI({
for(i in list_data[[1]]){
print(box(width = 8,
i
)
)
}
})
}
shinyApp(ui = ui, server = server)
Have a look here, I've added a button to each just so something is in there
library(shinydashboard)
library(shiny)
list_data <- list(c("AB","CD","EF","GH")) #data
ui <- dashboardPage(
dashboardHeader(title = "Text Mining"),
dashboardSidebar(
sidebarMenu(
menuItem("NLP Tree", tabName = "NLP")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "NLP",
fluidRow(
tabBox(width = 12,height="500",
tabPanel("Sentences",
uiOutput("nlp_sentences_tree")
)
)
)
)
)
)
)
server <- function(input, output) {
v <- list()
for (i in 1:length(list_data[[1]])){
v[[i]] <- box(width = 8, list_data[[1]][i],actionButton(i,i))
}
output$nlp_sentences_tree <- renderUI(v)
}
shinyApp(ui = ui, server = server)
Or with an lapply and tagList:
server <- function(input, output) {
output$nlp_sentences_tree <- renderUI({
a <- lapply(list_data[[1]], function(x) {
box(width = 8, x)
})
tagList(a)
})
}