I am trying to put an image inside the infoBox of a shinyApp.
I am getting this error:
Error in shinyUI(dashboardPage, dashboardHeader("ABC"),
dashboardBody(fluidPage(h1("type"), : unused arguments
(dashboardHeader("ABC"), dashboardBody(fluidPage(h1("type"),
mainPanel(tabsetPanel(tabPanel(h1("summary"), infoBox("BCD", a,
div(img(src = "ribbon.PNG", width = 100), style = "text-align:
center;"))))))))
Code:
library(shiny)
library(shinydashboard)
a = 45
ui < - shinyUI(dashboardPage,
dashboardHeader("ABC"),
dashboardBody(fluidPage(h1("type"),
mainPanel(
tabsetPanel(
tabPanel(h1("summary"),
infoBox("BCD", a, div(img(src = "ribbon.PNG",
width = 100), style = "text-align: center;"))))))))
server <- shinyServer({})
shinyApp(ui, server)
Can anyone help me on this?
Set an image img.png in the www folder and then the code below works :
library(shiny)
library(shinydashboard)
a <- 45
ui <- shinyUI(
dashboardPage(
dashboardHeader(title = "ABC"),
dashboardSidebar(),
dashboardBody(
fluidPage(
infoBox("BCD", a, div(img(src = "img.png", width = 100), style = "text-align: center;"))
)
)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
Related
I have the following code to build a Shinydashboard app. I'm trying to change the background color in the box on the top of my screen to a custom color (a color hex code color), however the options for the argument background only allow for a set of default colors. Is there a way to change the background color of this box specifically while keeping the white background for the remainder of my boxes?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = 'Dashboard'),
dashboardSidebar(sidebarMenu
(menuItem(tabName = 'Panel1', text = 'Panel 1'),
dateInput("Start_Date", "Start Date", min = '2000-01-01', max = Sys.Date(), value = '2020-01-01',format = "yyyy-mm-dd")
)
),
dashboardBody(
tabItems(tabItem(tabName = 'Panel1',
fluidRow(box(selectizeInput('select_mean', 'Select Number',
choices = c(12,24,36,48,60,120)),height=80,width=4,
background = 'black')),
fluidRow(box(width = 13, height = 655))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
You can use htmltools::tagQuery to add a style:
library(htmltools)
library(shinydashboard)
library(shiny)
b <- box(selectInput("id", "label", c("a", "b", "c")))
b <- tagQuery(b)$find(".box")$addAttrs(style = "background-color: pink;")$allTags()
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(b)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
You can do the following steps :
put your box into a tags$div and give it an ID (here : "toto")
add some CSS to the box, which is two div childs after your div toto
You can also put the CSS in a separate file, see https://shiny.rstudio.com/articles/css.html
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = 'Dashboard'),
dashboardSidebar(sidebarMenu
(menuItem(tabName = 'Panel1', text = 'Panel 1'),
dateInput("Start_Date", "Start Date", min = '2000-01-01', max = Sys.Date(), value = '2020-01-01',format = "yyyy-mm-dd")
)
),
dashboardBody(
tags$head(
tags$style(HTML("
#toto > div:nth-child(1) > div:nth-child(1) {
background-color: rgb(128, 0, 0);
}"))),
tabItems(tabItem(tabName = 'Panel1',
fluidRow(
tags$div(
id = "toto",
box(selectizeInput('select_mean', 'Select Number',
choices = c(12,24,36,48,60,120)),height=80,width=4)
)
),
fluidRow(box(width = 13, height = 655))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
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 increase the height of a select input inside the sidebar of a shinydashboard. When started, the height is correct, but immediatly, the size decrease to the default one.
I try use tags$style :
tags$style(type='text/css', "#input_id {height: 100px}")
Here is a reproductible example :
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui <- dashboardPage(
title = "Plan de gestion",
dashboardHeader(
title = "test"
),
dashboardSidebar(
sidebarMenu(
selectInput(inputId = "test_size", label = "Test", choices = c("A", "B", "C")),
tags$style(type='text/css', "#choix_param {height: 100px}")
)
),
dashboardBody(
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you for your help.
I find the solution :
tags$head(tags$style(HTML("#test_size+ div>.selectize-input {min-height: 500px}")))
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)
The given R shiny script has a selectInput and infobox below, I just want to display the selected value in the selectInput within the infobox in the ui. Please help me with a solution and if possible, kindly avoid any scripting in the sever as I have furthur dependency. If this can be done within the UI, would be great, thanks.
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2,offset = 0, style='padding:1px;',
selectInput("select the
input","select1",unique(iris$Species)))
))),
infoBox("Median Throughput Time", iris$Species)))
server <- function(input, output) { }
shinyApp(ui, server)
Trick is to make sure you know where the value of the selectInput is being assigned, which is selected_data in my example, this can be referenced within the server code by using input$selected_data.
renderUI lets you build a dynamic element which can be rendered with uiOutput and the output id, in this case, info_box
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2, offset = 0, style = 'padding:1px;',
selectInput(inputId = "selected_data",
label = "Select input",
choices = unique(iris$Species)))
)
)
),
uiOutput("info_box")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$info_box <- renderUI({
infoBox("Median Throughput Time", input$selected_data)
})
}
# Run the application
shinyApp(ui = ui, server = server)