I've created a Shiny app that allows for dynamic selection of Bootswatch themes. The dynamic selection occurs in the server.R file using tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "...")) with each .css file saved in my app's www directory as "themename.min.css." Here's a minimal example:
library(shiny)
shinyApp(
ui <- fluidPage(
# style ui output (changed on server side )
uiOutput("style"),
# navigation toolbar
navbarPage(id = "navbar",
title = "Themes",
position = "fixed-top",
collapsible = T,
navbarMenu(title = "Theme Selector",
tabPanel("Cosmo", value = "cosmo"),
tabPanel("Journal", value = "journal"),
tabPanel("Slate", value = "slate"),
tabPanel("United", value = "united"))
) # END NAVBAR PAGE
), # END UI
server <- function(input, output, session){
# dynamically update bootswatch theme
output$style <- renderUI({
# themes
themes <- c("cosmo", "journal", "slate", "united")
# loop through layouts and apply css file accordingly
for(i in 1:length(themes)){
if(input$navbar == themes[i]){
return(tags$head(tags$link(rel = "stylesheet", type = "text/css", href = paste0(themes[i], ".min.css"))))
}
} # END LOOP
}) # END RENDER UI
} # END SERVER
) # END SHINY APP
So in this example, I have the 4 themes saved in my www directory as "cosmo.min.css," "journal.min.css," etc. The dynamic selection of themes does work in a sense--the themes do change as the user selects them from the navigation bar dropdown menu. BUT it seems that certain CSS elements overwrite others as the user changes theme selections. For example, the Slate theme has a gray/silvery navbar. After I select that theme, all subsequent theme selections display that same silver navbar. Each theme works individually, but selecting them dynamically causes issues.
It seems that using tags$head overwrites certain elements from each CSS file? But I can't seem to use includeCSS in the server.R file to make the selection dynamic, but I also don't know how to make the theme selection dynamic in the ui.R file.
I am familiar with the shinythemes package, which does have a dynamic theme selector, but the package explicitly states that this function is only to be used in development, whereas I want to deploy my theme-selector application. I checked out the source code for that function, but I don't know Javascript to be able to tailor it to my specific needs.
I was able to accomplish this by using includeCSS instead of HTML tags to reference the stylesheet.
for(i in 1:length(themes)){
if(!is.null(input$themes)){
if(input$themes == themes[i]){
return(includeCSS(paste0("www/", themes[i], ".css")))
}
}
} # END LOOP
Related
I'm having some trouble displaying icons with sparklines within a DT::datatable column in a Shiny app even though I have escaped the HTML.
Edit: Removed 2nd question.
library(shiny)
library(dplyr)
ui <- fluidPage(
htmlwidgets::getDependency('sparkline'),
DT::dataTableOutput("table")
)
server <- function(input, output) {
raw_data <- data.frame(date = 2000:2021,
value = sample(100:500, 22),
icon = as.character(icon("arrow-up")))
data <- raw_data %>%
group_by(icon) %>%
# Create the sparkline
summarise("value" = sparkline::spk_chr(c(value),
xvalues = date,
tooltipFormat = '{{x}}: {{y}}'))
output$table <- DT::renderDataTable({
cb <- htmlwidgets::JS('function(){debugger;HTMLWidgets.staticRender();}')
DT::datatable(data = data,
escape = FALSE,
options = list(drawCallback = cb))
})
}
shinyApp(ui, server)
By default, the shiny::icon function:
generates the HTML code corresponding to the icon;
generates a script tag which includes the font-awesome icon library.
When you do as.character(icon(......, you only get the HTML code. The font-awesome library is not loaded, that's why the icon does not display.
The simplest way to get the icon is to use the glyphicon icon library, which is included in bootstrap so there's nothing to load (since bootstrap is loaded in Shiny apps):
as.character(icon("arrow-up", lib = "glyphicon"))
If you really want a font-awesome icon, there are two possibilities:
include the font-awesome library with a link tag;
or use the icon function elsewhere in your app, without as.character (you can hide it with the display:none CSS property if you don't want to see this icon) as shown below.
# add inside ui
tags$span(icon("tag"), style = "display: none;")
I am able to use shiny's custom themes successfully, i.e.
# Internal, hidden function
# Called by CherryPickPalette()
CustomPal <- function(new_pal){
if (interactive()){
cherrypickedpalette <- runApp(list(
ui = fluidPage(
theme = shinythemes::shinytheme("slate"),
Will give app the following look and feel
However if I replace with custom .css, the program ignores it, i.e.
Custom CSS, h5.css
h5 {
color: orange;
text-align: center;
}
Code using h5.css
# Internal, hidden function
# Called by CherryPickPalette()
CustomPal <- function(new_pal){
if (interactive()){
cherrypickedpalette <- runApp(list(
ui = fluidPage(
theme = "h5.css",
titlePanel("Cherry Pick Your Own Palette!"),
sidebarPanel (hr(),
selectInput('col', 'Options', new_pal, multiple=TRUE, selectize=FALSE, size = 15)
),
mainPanel(
h5('Your Cherry-Picked Palette'),
fluidRow(column(12,verbatimTextOutput("col"))),
h5 text, i.e. "Your Cherry-Picked Palette" is unaffected.
R directory structure is here
Please help!
I am not sure why it does not work with this directory structure, but you can try that instead:
ui = fluidPage(
# theme = "h5.css",
tags$head(includeCSS("R/www/h5.css")),
titlePanel("Cherry Pick Your Own Palette!"),
...
)
I create a shiny app and I need to add a language option. I would like add a selectizeInput like :
selectizeInput("language",
"Select language:",
choices = c("English"="en","Français"="fr"),
selected = app_default_languague, multiple=FALSE, width = '70%'
)
but with flags in front of each country. Flags logo are in "www/" directory. Do you know how i can make this please ?
There is an example in Rstudio gallery but i don't understand it ....
http://shiny.rstudio.com/gallery/selectize-rendering-methods.html
selectizeInput is based on the Javascript library selectize.js which has powerful settings including templates to render your own options and the selected item.
In order to do that you have to use a bit of Javascript code. This code is stored in rendersjsItem. That is a Javascript function that generates and returns a piece of HTML like this:
<div class="option">
<img width="25" height="25" class="flag" src="fr.svg" />
French
</div>
This assumes that your files are located in the www folder with the country code as name, e.g. "fr.svg". The example below specifies names and country codes in the vector countries.
All you need to do is take rendersjsItem and use it as render option for the selectizeInput. If you want to change the styling you can modify the CSS of the flag class.
Full Solution
library(shiny)
countries <- c(German = "de", Czech = "cz", French = "fr")
app_default_languague <- "cz"
# Assuming the flag icons are directly in the 'www' folder with names "de.svg", "cz.svg", etc.
rendersjsItem <-
I("{
option: function(item, escape) {
return '<div class=\"option\"><img width=\"25\" height=\"25\" class=\"flag\"' +
'src=\"' + item.value + '.svg\" />' +
item.label + '</div>';
}
}")
ui <- fluidPage(
tags$head(
# Add CSS to format the language selection options with flag + text
tags$style(HTML(".flag {height:24px; width:24px; margin-right: 12px}"))
),
title = "Selectize Test",
selectizeInput("language", "Select language",
choices = countries,
selected = app_default_languague, multiple=FALSE, width = "70%",
options = list(
placeholder = "Type a language name, e.g. German",
render = rendersjsItem
)),
textOutput("SelectedLanguage")
)
server <- function(input, output, session) {
output$SelectedLanguage <- renderText(input$language)
}
shinyApp(ui, server)
Side Note
The World Wide Web Consortium (W3C) recommends that flag icons should not be used to indicate languages. There are multiple reason. Instead, use the name of the language in it's target language, i.e. do not write "German" but "Deutsch". Examples: Deutsch, English, Español, Français, Italiano, ...
See also ux.stackexchange.
Import them using jpeg library and and create a vector
I am trying to understand how will the below code behave
library(shiny)
ui<-fluidPage(
sliderInput("inpslider","Slider",1,10,5),
uiOutput("radio"),
)
server <- function(input, output) {
output$radio<-renderUI({
x<-input$inpslider
radioGroupButtons(inputId = 'myRadioButton', choices = c("A","B"),status = 'warning',
direction = 'vertical', justified = T)
})
}
The first time the code runs it will add an input slider and grouped radio button.
Question:- Since output$radio block contains the reactive value input$slider it will be executed whenever the slider value is changed, So will shiny add a new set of radio button(on top of previous one) every time output$radio is executed? or will the old set of radio buttons will be flushed out every time and new one is added?
You're creating the element with renderUI each time the slider is invalidated it doesnt matter if you press it or reload it...
I'm trying to add a tabPanel in navbarPage so that when you click on it opens a modal window instead of a new tab. The snippet below is not valid because tabPanel does not have an id parameter.
library(shiny)
library(shinyBS)
shinyUI(fluidPage(
navbarPage("Sample App", id = "main_menu",
tabPanel("Open Modal", id = "moda")),
bsModal("modal1", "Example", "moda", p("This is a modal"))
)
If I edit the generated HTML code from browser, I can make this possible by changing the line
Open Modal
with
Open Modal
on the <li> element.
Any idea how to do this or at least how can I override the generated html from shiny?
One solution is to use Javascript to rewrite the attribute for the tab title. The JS code below finds the tab title link, and rewrites its attributes.
library(shiny)
jsStr <- '$(document).ready(function(){
$("a[data-value=\'OpenModal\']").attr({
"href":"#",
"data-toggle":"modal",
"data-target":"#modal1"
});
})
'
ui <- shinyUI(fluidPage(
tags$head(tags$script(HTML(jsStr))),
navbarPage("title",
tabPanel("OpenModal")
),
bsModal("modal1", "Example", "moda", p("This is a modal"))
))