Is it possible to set the font for the h4() text Filters and the pickerInput() label and choices to Montserrat in shinydashboard?
library(extrafont)
font_import()
loadfonts(device = "win")
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
h4("Filters"),
tags$hr(),
fluidRow(column(12,
pickerInput(
inputId = "iss",
label = "Issue",
choices = colnames(mtcars),
multiple = F,
)
))
)
body <- dashboardBody(fluidPage(
)
)
ui <- dashboardPage(title = 'Search', header, sidebar, body)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Yes, you can add custom fonts using the tags$p call.
h4(tags$p("Filters", style = "font-family: Montserrat;"))
label = tags$p("Issue", style = "font-family: Montserrat;")
Related
Im trying to limit the max number of choices made by pickerInput() to two in shiny app but I cannot make it work.
library(shiny)
library(shinydashboard)
library(plotly)
library(shinyWidgets)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
fluidRow(column(12,
pickerInput(
inputId = "iss",
label = "Issue",
choices = colnames(mtcars),
multiple = T,
options = list("max-options-group" = 2)
)
))
)
body <- dashboardBody(fluidPage(
)
)
ui <- dashboardPage(title = 'Search', header, sidebar, body)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
The problem is that you are using "max-options-group" but you are not using any groups in your choices. You must use "max-options" = 2 in the options argument of pickerInput().
For completeness, this is the modified version of your code. We cannot pick more than 2 options with it:
library(shiny)
library(shinydashboard)
library(plotly)
library(shinyWidgets)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
fluidRow(column(12,
pickerInput(
inputId = "iss",
label = "Issue",
choices = colnames(mtcars),
multiple = T,
options = list("max-options" = 2)
)
))
)
body <- dashboardBody(fluidPage(
)
)
ui <- dashboardPage(title = 'Search', header, sidebar, body)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Try this
columns <- as.list(names(mtcars))
type <- as.list(1:ncol(mtcars))
header <- dashboardHeader()
sidebar <- dashboardSidebar(
fluidRow(column(12,
pickerInput(
inputId = "iss",
label = "Issue",
choices = list(Columns = columns,
Type = type),
selected = list(columns[[1]],type[[1]]),
multiple = T,
inline=TRUE,
options = list("max-options-group" = 1, `style` = "btn-info")
)
))
)
body <- dashboardBody(fluidPage())
ui <- dashboardPage(title = 'Search', header, sidebar, body)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
I would like to have a custom URL generated in shinyapps.IO (or willing to upgrade to appropriate Enterprise tools) based on value selected by selectInput(). In the example below, if I publish to shinyapps.IO, the URL will be https://myDomain.shinyapps.io/myAppName/.
I would like 5 unique URLs, based on the user-selected option from selectInput().
https://myDomain.shinyapps.io/myAppName/Option1
https://myDomain.shinyapps.io/myAppName/Option2
https://myDomain.shinyapps.io/myAppName/Option3
https://myDomain.shinyapps.io/myAppName/Option4
https://myDomain.shinyapps.io/myAppName/Option5
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyverse)
#################### UI ###################
ui <- dashboardPagePlus(
###### Header ####
header = dashboardHeaderPlus(
title = NULL,
titleWidth = '250',
disable = FALSE,
enable_rightsidebar = FALSE,
.list = NULL,
left_menu = tagList(
selectInput(
inputId = "options",
label = "Select an option",
choices = c('Option1', 'Option2', 'Option3', 'Option4', 'Option5'))
) #end left_menu
), #close Header
###### Sidebar ####
sidebar = dashboardSidebar(disable = TRUE),
footer = dashboardFooter(NULL),
###### Body ####
body = dashboardBody(
uiOutput('optionSelected')
) #close dashboardBody
) # closes Dashboard Page Plus
#################### SERVER ####################
server = function(input, output, session) {
output$optionSelected <- renderUI({
input$options
}
)
}
shinyApp(ui = ui, server = server)
I have read about 'Vanity URLs' at https://community.rstudio.com/t/vanity-urls-with-connect-via-deployapp/18927/4, but this does not quite seem like the solution that I am seeking.
Thank for any advice.
Like i mentioned in the comment, i think you are looking for bookmarking, see ?shiny::enableBookmarking().
For bookmarking you have to make three modifications to your code. Make
the ui code a function
ui <- function(request){...}
include a bookmark trigger/button in your ui
bookmarkButton()
Enable bookmarking before you launch the app.
enableBookmarking("url")
Minimal reproducible example would be:
ui <- function(request) {
fluidPage(
selectInput("options", "opt", choices = c('Option1', 'Option2')),
bookmarkButton()
)
}
server <- function(input, output, session) { }
enableBookmarking("url")
shinyApp(ui, server)
Automating the generation of urls
port_nr <- 3033
input_id <- "select_opt"
choices <- c('Option1', 'Option2')
paste0("http://127.0.0.1:", port_nr, "/?_inputs_&", input_id, "=",
URLencode(choices, reserved = TRUE))
Your example would read:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
ui <- function(request) {
dashboardPagePlus(
###### Header ####
header = dashboardHeaderPlus(
title = NULL,
titleWidth = '250',
disable = FALSE,
enable_rightsidebar = FALSE,
.list = NULL,
left_menu = tagList(
selectInput(
inputId = "options",
label = "Select an option",
choices = c('Option1', 'Option2', 'Option3', 'Option4', 'Option5'))
) #end left_menu
), #close Header
###### Sidebar ####
sidebar = dashboardSidebar(disable = TRUE),
footer = dashboardFooter(NULL),
###### Body ####
body = dashboardBody(
uiOutput('optionSelected'),
bookmarkButton()
) #close dashboardBody
) # closes Dashboard Page Plus
}
#################### SERVER ####################
server = function(input, output, session) {
output$optionSelected <- renderUI({
input$options
}
)
}
enableBookmarking("url")
shinyApp(ui = ui, server = server)
I'm using renderUI for the first time. When I run the app there is no tab selected by default; when defining the UI outside of the server the first tab is normally selected by default.
Any idea why this happens, or how to specify that the first tab should be selected by default on startup?
Example:
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
header <- dashboardHeader(title = "header")
sidebar <- dashboardSidebar(uiOutput("sidebar"))
body <- dashboardBody(uiOutput("body"))
ui <- dashboardPage(title = 'Radial Networks', header, sidebar, body, skin='blue')
server <- function(input, output, session){
output$body <- renderUI({
dashboardBody(
tabItems(
tabItem(
tabName = 'Chords', h2(fluidRow(
box(plotOutput('plot'), type = 'html', width = 6, height = '870px')
)))))})
output$sidebar <- renderUI({
dashboardSidebar(sidebarMenu(
menuItem("Radial Networks", tabName = "Chords", icon = icon("adjust"))))
})
output$plot <- renderPlot({
ggplot(mtcars, aes(x = factor(cyl))) +
geom_bar()
})
}
shinyApp(ui = ui, server = server)
Try adding one argument to your tabItem():
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
header <- dashboardHeader(title = "header")
sidebar <- dashboardSidebar(uiOutput("sidebar"))
body <- dashboardBody(uiOutput("body"))
ui <- dashboardPage(title = 'Radial Networks', header, sidebar, body, skin='blue')
server <- function(input, output, session){
output$body <- renderUI({
dashboardBody(
tabItems(
tabItem(
tabName = 'Chords',
h2(fluidRow(box(plotOutput('plot'),
type = 'html',
width = 6,
height = '870px')
)))))})
output$sidebar <- renderUI({
dashboardSidebar(sidebarMenu(
menuItem("Radial Networks",
tabName = "Chords",
icon = icon("adjust"),
selected = 1)))
})
output$plot <- renderPlot({
ggplot(mtcars, aes(x = factor(cyl))) +
geom_bar()
})
}
shinyApp(ui = ui, server = 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 have a dashboard where I would like to show a table, but I cant figure out why my table is not showing. If I replace the table for example with some text, h2(....) it does show. I would like to click on "Species" and have the table show on the right when clicking it.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(sidebarMenu(
menuItem(
"Species",
tabName = "Species",
icon = NULL,
switchInput(
inputId = "long1",
onLabel = "Go",
offLabel = "NoGo",
value = T
),
actionButton("Gobtn", "Get data"),
menuItem("Specs", tabName = "Specs", icon = NULL)
)
)),
dashboardBody(tabItems(
tabItem(tabName = "Species",
DT::renderDataTable("Table1")),
tabItem(tabName = "Specs",
h2("Hi"))
))
)
server.r
server <- shinyServer(function(input, output, session) {
output$Table1 <- DT::renderDataTable({
iris
})
})
shinyApp(ui, server)
Few things to get your code up and running here. Couple have been noted by other contributors.
We need to use DT::dataTableOutput("Table1") on the UI side as renderDataTable will not work here, that is the server side function.
The other would be that using the switchInput within the menuItem may confused the app, as these are not standard parameters to pass into the function. From what I can see from your code, which is a common challenge, is that you want to be able to show this switchInput only when the 'Species' tab is selected. We can account for this using conditionalPanel. To do this, we can set id = "tabs" within the sidebarMenu and then reference this sidebarMenu within the conditionalPanel:
conditionalPanel(
condition = "input.tabs== 'Species' ",
switchInput(
inputId = "long1",
onLabel = "Go",
offLabel = "NoGo",
value = T
)
)
To finish, I have altered the layouts of the ui.R and server.R, as the shinyApp function was not needed for the app to work with the server and ui files. This is how I lay out my dashboards. It may show you a few other possible ways you can use the app structure within Shiny, but equally you could just align the changes to the basic layout.
ui.R
header <- dashboardHeader(title = "Basic dashboard")
sidebar <- dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem(
"Species",
tabName = "Species",
icon = NULL),
conditionalPanel(
condition = "input.tabs== 'Species' ",
switchInput(
inputId = "long1",
onLabel = "Go",
offLabel = "NoGo",
value = T
)
),
actionButton("Gobtn", "Get data"),
menuItem("Specs", tabName = "Spec", icon = NULL)
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "Species",
DT::dataTableOutput("Table1")),
tabItem(tabName = "Spec",
h2("Hi"))
)
)
dashboardPage(skin = "blue", header = header, sidebar = sidebar, body = body)
server.R
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(DT)
shinyServer(function(input, output, session){
output$Table1 <- DT::renderDataTable({
datatable(iris)
})
})
You need to change/add some part of the dashboardBody, see Using shiny modules and shinydashboard: shiny.tag error
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(sidebarMenu(
menuItem(
"Species",
tabName = "Species",
icon = NULL,
switchInput(
inputId = "long1",
onLabel = "Go",
offLabel = "NoGo",
value = T
),
actionButton("Gobtn", "Get data")
)
)),
dashboardBody(tags$div(
tabName = "Species",
fluidRow(box(DT::dataTableOutput("Table1"))), class = "tab-content"
))
)
server.r
server <- shinyServer(function(input, output, session) {
output$Table1 <- DT::renderDataTable({
iris
})
})
shinyApp(ui, server)