I wish to know if it is possible to create multiple infoBoxes with only one reactive function "ibox" as in the script below. I shall pass the values for all the infoboxes below within the ibox reactive function and see all of them getting displayed together.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
infoBoxOutput("ibox")
)))
server <- function(input, output) {
output$ibox <- renderInfoBox({
infoBox(
"Title",
5,
icon = icon("credit-card")
)
infoBox(
"Title",
5,
icon = icon("credit-card")
)
infoBox(
"Title",
4,
icon = icon("credit-card")
)
})}
shinyApp(ui, server)
As mentioned in the comments, you could use renderUI and uiOutput. However, note that renderUI only actually renders the last statement in its body. In order to render multiple objects, we can place them in a list (or column, fluidRow, etc.). Working example:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
uiOutput("ibox")
)))
server <- function(input, output) {
output$ibox <- renderUI({
list(
infoBox(
"Title",
5,
icon = icon("credit-card")
),
infoBox(
"Title",
5,
icon = icon("credit-card")
),
infoBox(
"Title",
4,
icon = icon("credit-card")
)
)
})}
shinyApp(ui, server)
Related
I'm trying to have a box inside my shiny app while using the shinythems library :
library(shiny)
library(DT)
library(shinythemes)
library(shinydashboard)
ui <- fluidPage(
theme = shinytheme("lumen"),
navbarPage("test theme",
tabPanel("tab1",
mainPanel(width = 12,
fluidRow(
box(width=6,title = "title",status = "navy", solidHeader = TRUE,
dataTableOutput(outputId = "tab"))))
))
)
)
Server <- function(input, output,session){
output$tab = renderDataTable(mtcars)
}
shinyApp(ui, server)
But it does not work as I expected !
I was hoping to get something like :
I tried the titlePanel as well but it did not work !
I don't believe you can mix-n-match Shiny fluidPage, shinythemes & elements from shinydashboard just like that. For box to properly work it needs shinydashboard CSS and to include this you'd normally use
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
layout instead of fluidPage() / fixedPage() Shiny layouts.
Though.. there's shinyWidgets::useShinydashboard() :
library(DT)
library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinyWidgets)
ui <- fluidPage(
theme = shinytheme("lumen"),
shinyWidgets::useShinydashboard(),
navbarPage("test theme",
tabPanel("tab1",
mainPanel(width = 12,
fluidRow(
box(width = 12,
title = "title", status = "warning", solidHeader = TRUE,
dataTableOutput(outputId = "tab")
)
)
)
)
)
)
server <- function(input, output, session) {
output$tab <- renderDataTable(mtcars)
}
shinyApp(ui, server)
DT might not be the best example here as it requires some setup for responsiveness (it doesn't respect box boundaries and box(width = 6, ...) just draws over half of the table).
I'm trying to see a text from the reactive part in a box() but I don't know why it doesn't show up.
en ui.R:
fluidRow(
box(title = "Status summary", solidHeader = TRUE, status = "primary", width = 4, textOutput("selected_var"))),
in server.R :
server = function(input, output) {
output$selected_var <- renderText({"You have selected this"})
}
I can see :
thank you in advance
It's hard to know exactly what's wrong without seeing a full reproducible example. But your basic syntax seems fine.
Here's a full example that shows the textOutput rendering correctly in box():
# app.R
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(
title = "Status summary",
solidHeader = TRUE,
status = "primary",
width = 4,
textOutput("selected_var")
)
)
)
server <- function(input, output, session) {
output$selected_var <- renderText("Your input is X")
}
shinyApp(ui, 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 want to display a table of data in a pop-up window by clicking on valueBox. The valueBox itself should work as an actionButton.
When I click on the valueBox it should render a table in pop-up window as in the picture below.
Can anyone help on this code?
My code:
library(shiny)
library(shinydashboard)
data <- iris
ui <- dashboardPage(
dashboardHeader(title = "Telemedicine HP"),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBox( 60, subtitle = tags$p("Attended", style = "font-size: 200%;"),
icon = icon("trademark"), color = "purple", width = 4,
href = NULL))))
server <- function(input,output){
}
shinyApp(ui, server)
Here is another solution without shinyjs
library(shiny)
library(shinydashboard)
library(shinyBS)
data <- iris
ui <- tagList(
dashboardPage(
dashboardHeader(title = "Telemedicine HP"),
dashboardSidebar(),
dashboardBody(
fluidRow(
div(id='clickdiv',
valueBox(60, subtitle = tags$p("Attended", style = "font-size: 200%;"), icon = icon("trademark"), color = "purple", width = 4, href = NULL)
)
),
bsModal("modalExample", "Data Table", "clickdiv", size = "large",dataTableOutput("table"))
)
)
)
server <- function(input, output, session){
output$table <- renderDataTable({
head(data)
})
}
shinyApp(ui, server)
You can create an onclick event with shinyjs. Therefore you need to add useShinyjs() in your ui, which you can do by wrapping your ui in a tagList.
The onclick function is triggered in your server when an element with a given ID is clicked. So you also need to give the valueBox an ID. I decided to wrap it in a div with an ID.
Next part is to create a popup whenever the onclick event is triggered. You can do this by using the showModal function from shinyBS.
Working example
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyBS)
data <- iris
ui <- tagList(
useShinyjs(),
dashboardPage(
dashboardHeader(title = "Telemedicine HP"),
dashboardSidebar(),
dashboardBody(
fluidRow(
div(id='clickdiv',
valueBox(60, subtitle = tags$p("Attended", style = "font-size: 200%;"), icon = icon("trademark"), color = "purple", width = 4, href = NULL)
)
)
)
)
)
server <- function(input, output, session){
onclick('clickdiv', showModal(modalDialog(
title = "Your title",
renderDataTable(data)
)))
}
shinyApp(ui, server)
I am building a shiny dashboard and I want to implement a valueBox within the Dashboard.
body <- dashboardBody(
fluidRow(
valueBox(totalSales,"Total Sales",color="blue")
),
fluidRow(
DT::dataTableOutput("salesTable")
),
fluidRow(
DT::dataTableOutput("top10Sales")
)
)
And this is the result:
The number on the upper left is the variable totalSales but it isn't formatted in a valueBox.
Does anyone know what the problem is?
I appreciate your answers!!
My try with valueBoxOutput, but with the same result:
ui.R
body <- dashboardBody(
fluidRow(
valueBoxOutput("totalSales")
),
fluidRow(
DT::dataTableOutput("salesTable")
),
fluidRow(
DT::dataTableOutput("top10Sales")
)
)
server.R
function(input, output, session) {
output$salesTable = DT::renderDataTable(top10Sales)
output$top10Sales = DT::renderDataTable(top10Sales)
#output$totalSales = DT::renderDataTable(totalSales)
output$totalSales <- renderValueBox({
valueBox(totalSales, "Approval",color = "yellow")
})
}
And still the same result:
By the way: Infobox is working:
infoBox("test", value=1, width=3)
valueBox has to be used on the server side. To display a shiny dynamic UI element, there's generally a function (in this case valueBoxOutput) available to display it:
library(shinydashboard)
library(dplyr)
library(DT)
body <- dashboardBody(
fluidRow(
valueBoxOutput("totalCars")
),
fluidRow(
DT::dataTableOutput("table")
)
)
ui <- dashboardPage(header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = body
)
server <- function(input, output) {
output$table = DT::renderDataTable(mtcars)
output$totalCars <- renderValueBox({
valueBox("Total", nrow(mtcars), color = "blue")
})
}
shinyApp(ui, server)