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)
Related
Once I add an HTML document in my shiny app my graphs stop populating. I am using bs4dash but shinydashboard also has the exact same issue.
Below is my code as well as a screenshot of what is happening.
Code before i add HTML document
Ui
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
fluidRow(
box(
#width = 12,
#includeHTML("first.html")
)
)
)
)
Server
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
Now when i remove the hastags to display my HMTL document. My graph all of a sudden disappears.
Ui
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
Server
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
I would like to have the graph still show. What is going wrong in the code. Thank you
I cannot reproduce your problem. I just observed that your fluidRow is the fourth parameter of dashboardPage which, however, expects a dashboardControlbar. Both, putting the fluidRow into dashboardBody or wrapping it in a call to dashboardControlbar works for me.
So either it is your first.html or indeed "just" the missing dashboardControlbar.
first.html
<span>I am an external HTML</span>
app.R
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
),
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
ui2 <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
dashboardControlbar(
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
shinyApp(ui, server)
## shinyApp(ui2, server) ## works likewise
Screenshots
Does anyone know how to make the title of a tabBox go above the tabs in a shinydashboard app? For example, in the figure below, the title is on the right, but I would like it to go on top of the box.
Code for this tabBox:
library(shiny)
library(shinydashboard)
ui = dashboardPage(dashboardHeader(title = "tabBoxes"), dashboardSidebar(),
dashboardBody(
fluidRow(
tabBox(title = HTML("Hello friend<br>"),
tabPanel("merp", "hi there"),
tabPanel("derp", "hello"),
tabPanel("herp", "howdy")
))
)
)
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
}
shinyApp(ui = ui, server = server
)
For those who might look for the solution here, a pretty simple fix was to put the tabBox (with no title) inside of a box with a title:
library(shiny)
library(shinydashboard)
ui = dashboardPage(dashboardHeader(title = "tabBoxes"), dashboardSidebar(),
dashboardBody(
fluidRow(box(title = HTML("Hello friend<br>"),
tabBox(
tabPanel("merp", "hi there"),
tabPanel("derp", "hello"),
tabPanel("herp", "howdy"))
))
)
)
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
}
shinyApp(ui = ui, server = server)
There is the side argument e.g
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(
tabBox(
title = "First tabBox",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1", height = "250px",side = 'right',
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
)
))
shinyApp(
ui = dashboardPage(dashboardHeader(title = "tabBoxes"), dashboardSidebar(), body),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
}
)
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)
})
}
I have a shiny application where I want to build a conditional query system on a data frame.
First, I want to have a selectInput showing all available tables. After the user has chosen a table, I want another box to appear where he can select the column name he wants to filter for. This is what I have until now:
ui.r:
library(shiny)
library(shinydashboard)
source("global_variables.r")
ui=dashboardPage(
dashboardHeader(title="Test"),
dashboardSidebar(
sidebarMenu(
menuItem("Conditionals",tabName = "conditionals")
)
),
dashboardBody(
tabItems(
tabItem(tabName="conditionals",
fluidRow(
box(
title = "Conditionals",
width = 4,
selectInput("Con_tableName",choices=c("NONE",tableNames),label = "Table Name"),
tags$div(id = 'placeholder')
)
)
)
)
)
)
server.r:
library(shiny)
source("global_variables.r", local = FALSE)
Table1=data.frame();
shinyServer(
function(input, output,session) {
observe({
reactive(
if(input$Con_tableName!="NONE"){
insertUI( selector="#placeholder",
ui={
selectInput("Con_colName",choices=c("NONE",colnames(dynGet(input$Con_tableName))),label = "Column Name")
}
)
}
)
})
}
)
global_variables.r:
tableNames=c("Table1","Table2","Table3")
The problem is, that if I choose a value in the selectInput, observe doesnt get fired.
EDIT:
According to BigDataScientists comment,changed insertUI to renderUI. Updated files:
ui.r:
library(shiny)
library(shinydashboard)
source("global_variables.r")
ui=dashboardPage(
dashboardHeader(title="Test"),
dashboardSidebar(
sidebarMenu(
menuItem("Conditionals",tabName = "conditionals")
)
),
dashboardBody(
tabItems(
tabItem(tabName="conditionals",
fluidRow(
box(
title = "Conditionals",
width = 4,
selectInput("Con_tableName",choices=c("NONE",tableNames),label = "Table Name"),
uiOutput("conditionalUI")
)
)
)
)
)
)
server.r:
library(shiny)
source("global_variables.r", local = FALSE)
Table1=data.frame();
shinyServer(
function(input, output,session) {
observeEvent(input$Con_tableName,{
reactive(
if(input$Con_tableName!="NONE"){
output$conditionalUI=renderUI({
selectInput("Con_colName",choices=c("NONE",colnames(input$Con_tableName)),label = "Column Name")
})
}
)
})
}
)
You can use conditionalPanel(). Below there is a small example which might work in your case.
library(shiny)
shinyApp(
ui <- fluidPage(
mainPanel(
selectInput("input1", "Select something", choices = c('','1','2','3')),
conditionalPanel("input.input1!=''",
selectInput('input2', "Select something else", choices = c('4','5')))
)
),
server <- function(input, output){}
)
I have initial loading of data from the DB in the server.R which takes a few seconds. Until this is done, the page displayed is distorted (wrong data in selection box, and weird placing of the boxes, see below).
I want to display a different page (or at least different content in my first-displayed tab) until the data is completely loaded.
I thought about doing some kind of conditionalPanel using a condition based on a dedicated global variable (initial_loading_done), but wherever I tried placing the conditionalPanel it didn't work.
This is the structure of my UI.R:
shinyUI(
dashboardPage(
dashboardHeader(title = "Title"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab1", tabName = "Tab1",icon = icon("dashboard")),
menuItem("Tab2", tabName = "Tab2", icon = icon("bar-chart-o"))
)
),
dashboardBody(
includeCSS("custom_css.css"),
tabItems(
tabItem(tabName = "Tab1",
fluidRow(<content>),
mainPanel(
fluidRow(<content>)
)
),
tabItem(tabName = "Tab2",
fluidRow(<content>),
mainPanel(
dataTableOutput('my_data_table')
)
)
)
)
)
)
Here's a very simple example using shinyjs package
The idea is to create the loading "page" and the content "page" under different IDs, have the content page initially hidden, and use show() and hide() after the app is ready
library(shiny)
library(shinyjs)
load_data <- function() {
Sys.sleep(2)
hide("loading_page")
show("main_content")
}
ui <- fluidPage(
useShinyjs(),
div(
id = "loading_page",
h1("Loading...")
),
hidden(
div(
id = "main_content",
"Data loaded, content goes here"
)
)
)
server <- function(input, output, session) {
load_data()
}
shinyApp(ui = ui, server = server)
In server I like to use reactiveValues() to store a setupComplete condition. Then, when the data is loaded my setupComplete is set to TRUE.
In the ui we can then assess this setupComplete condition in a conditionalPanel, and only display the content (in my example the three box() widgets).
Here's a working example
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton(inputId = "btn_data", label = "Download"),
conditionalPanel(condition = "output.setupComplete",
box( title = "box1" ),
box( title = "box2" ),
box( title = "boc3" )
),
conditionalPanel(condition = "!output.setupComplete",
box( title = "loading"))
)
)
server <- function(input, output) {
rv <- reactiveValues()
rv$setupComplete <- FALSE
## simulate data load
observe({
if(input$btn_data){
df <- data.frame(id = seq(1,200),
val = rnorm(200, 0, 1))
## Simulate the data load
Sys.sleep(5)
## set my condition to TRUE
rv$setupComplete <- TRUE
}
## the conditional panel reads this output
output$setupComplete <- reactive({
return(rv$setupComplete)
})
outputOptions(output, 'setupComplete', suspendWhenHidden=FALSE)
})
}
shinyApp(ui, server)
The code
hidden(
div(
id = "main_content",
"Data loaded, content goes here"
)
doesn't work with tabsetPanel. But if you move the id to the div level it works beautifully. Thanks to shinyjs author Dean Attali for this tip. https://stackoverflow.com/users/4432127/keshete
hidden(
div(id = "mainTabsetPanel",
tabsetPanel(
....