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
Related
I want to use shiny.i18n in my app, which uses tooltips to provide more information on certain elements (using two types of tooltips, either with tipify or bsTooltip). However, I could not find how to integrate both, and the tooltips are not rendered properly.
As an example, this:
library(shiny)
library(shinyjs)
library(shinyBS)
library(shiny.i18n)
i18n <- Translator$new(translation_csvs_path = "data_translation/")
i18n$set_translation_language("en")
ui <- fluidPage(
useShinyjs(),
shiny.i18n::usei18n(i18n),
div(style = "float: left;",
selectInput('selected_language',
i18n$t("Change language"),
choices = i18n$get_languages(),
selected = i18n$get_key_translation())
),
mainPanel(
i18n$t("This is some text without a tooltip"),
textOutput("Text"),
bsTooltip("Text",
i18n$t("This is some text"),
placement="right", trigger = "hover", options=list(container="body")),
tipify(
actionButton("Button", "", icon = icon("house-user")),
i18n$t("This is a button"),
placement="right", trigger = "hover", options=list(container="body"))
))
server <- function(input, output, session) {
observeEvent(input$selected_language, {
shiny.i18n::update_lang(session, input$selected_language)
})
output$Text <- renderText({i18n$t("This is some text with a tooltip")})
}
shinyApp(ui, server)
file translate_fr.csv:
"en","fr"
"Hello","Bonjour"
"This is some text without a tooltip","Ceci est un texte sans tooltip"
"This is some text with a tooltip","Ceci est un texte avec tooltip"
"This is a button", "Ceci est un bouton"
"This is some text", "Ceci est un texte"
"Change language","Changer de langue"
returns:
While the tooltip should just contain "This is a button". I'm quite new to these tools - what am I missing?
The Problem is that the tooltips and tipify do not support HTML. That is the reason why your tooltips display the raw HTML created by shiny.18n.
There are two ways to achieve what you want.
The first one is to use popovers from the shinyBS packages. These support HTML and will achieve the language feature you are looking for.
The other one is to render the tooltips on the serverside in shiny. This way no HTML will be involved in creating the translations. This way would allow you to even use tipify/tooltips you asked for.
The reason for this problem is, that shiny.18n has two kind of tricks to achieve the translations. The first one is one the browser side. As you displayed shiny.18n is wrapping a span tag around the translations, so that it can later be modified by using JavaScripts in the browser.
The other method is to render everything new on the server side. This way no HTML will be needed, as the process is happening not on the browser anyway.
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'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
From the shiny dashboard github, I've gathered that it's possible to create drop down menus at the top right of the header, but there are only 3 "types" (messages, notifications, and tasks).
https://rstudio.github.io/shinydashboard/structure.html#structure-overview
Is there a method for creating a custom dropdown? I'd like to make a settings dropdown, where I give the user some checkboxes that they can use to adjust the dashboard in ways (displaying/hiding things, filtering data, etc.)
I customized one of the three types of menu to allow this. You could then add actionItem(s) for items. tabSelect property when true simulate the selection of a sidebarMenuItem.
dropdownActionMenu <- function (..., title=NULL, icon = NULL, .list = NULL, header=NULL) {
items <- c(list(...), .list)
lapply(items, shinydashboard:::tagAssert, type = "li")
type <- "notifications" # TODO créer action + CSS
dropdownClass <- paste0("dropdown ", type, "-menu")
tags$li(class = dropdownClass, a(href = "#", class = "dropdown-toggle",
`data-toggle` = "dropdown", icon, title), tags$ul(class = "dropdown-menu",
if(!is.null(header)) tags$li(class="header",header),
tags$li(tags$ul(class = "menu", items))))
}
actionItem = function (inputId, text, icon = NULL, tabSelect=FALSE) {
if(!is.null(icon)) {
shinydashboard:::tagAssert(icon, type = "i")
icon <- tagAppendAttributes(icon, class = paste0("text-", "success"))
}
if(tabSelect) {
tags$li(a(onclick=paste0("shinyjs.tabSelect('",inputId,"')"),icon,text))
} else {
tags$li(actionLink(inputId,text,icon))
}
}
javascript function to select tab (to be inserted after useShinyjs() in body)
extendShinyjs(text="shinyjs.tabSelect=function(tabName){$('a[data-value='+tabName+']').click();}")
Sample code
dashboardHeader(
dropdownActionMenu(title="test",
actionItem("mnuFirst","First"),
actionItem("mnuSecond","Second")
)
)
Shiny Dashboard is based on admin LTE. So the existing type of drop downs are designed for admin LTE use case, which is quite different from many Shiny app usage.
If something is not even available in admin LTE, it's less likely to be supported in Shiny dashboard.
For your specific question, you can put some controls in the side bar. Another possibility is to use the wrench icon in box, which is not implemented in Shiny yet.
I am trying to create simple webapp where I want to take in multiline input from user using HTML textarea control. Is there any out of the box way of creating such an input control in Shiny?
Help page of textInput doesn't show much options
textInput {shiny} R Documentation
Create a text input control
Description
Create an input control for entry of unstructured text values
Usage
textInput(inputId, label, value = "")
Arguments
inputId
Input variable to assign the control's value to
label
Display label for the control
value
Initial value
Value
A text input control that can be added to a UI definition.
Examples
textInput("caption", "Caption:", "Data Summary")
You can add a textarea using tags and it should be picked up by Shiny automatically:
tags$textarea(id="foo", rows=3, cols=40, "Default value")
Or if you're more comfortable with straight HTML you can also do
HTML('<textarea id="foo" rows="3" cols="40">Default value</textarea>')
In either case, input$foo should reflect the textarea's value.
For benefit of others, I will post how I solved the problem using custom UI control following Shiny tutorial
Firstly, I crearted textarea.js file as follows
$(document).on("click", "textarea.inputTextarea", function(evt) {
// evt.target is the button that was clicked
var el = $(evt.target);
// Raise an event to signal that the value changed
el.trigger("change");
});
var inputTextareaBinding = new Shiny.InputBinding();
$.extend(inputTextareaBinding, {
find: function(scope) {
return $(scope).find(".inputTextarea");
},
getValue: function(el) {
return $(el).text();
},
setValue: function(el, value) {
$(el).text(value);
},
subscribe: function(el, callback) {
$(el).on("change.inputTextareaBinding", function(e) {
callback();
});
},
unsubscribe: function(el) {
$(el).off(".inputTextareaBinding");
}
});
Shiny.inputBindings.register(inputTextareaBinding);
Then I added following function in ui.R of shiny webapp before shinyUI() is called
inputTextarea <- function(inputId, value="", nrows, ncols) {
tagList(
singleton(tags$head(tags$script(src = "textarea.js"))),
tags$textarea(id = inputId,
class = "inputtextarea",
rows = nrows,
cols = ncols,
as.character(value))
)
}
Then I used above defined function to create the desired textarea control element in ui.R
shinyUI(pageWithSidebar(
# Application title
headerPanel("Test Header Panel"),
sidebarPanel(),
mainPanel(
inputTextarea('exampleTextarea', '',20,35 )
)
))
May or may not be relevant here, but I made the shinyAce package to wrap up and expose the Ace text editor in Shiny. Ace is primarily used for code editing (complete with syntax highlighting for a variety of languages), but provides a text-area-like interface for writing composing multi-line text/code.
You can check out the example to see if that might be what you're looking for. (Try different "modes" for syntax highlighting and themes for color combinations.)
From version 0.14 shiny has an implementation of textAreaInput.
Building off of Joe's answer (https://stackoverflow.com/a/14452837/5776618), you can also nest tags into your own function to achieve the same output as the standard Shiny built-in input functions.
textareaInput <- function(id, label, value, rows=20, cols=35, class="form-control"){
tags$div(
class="form-group shiny-input-container",
tags$label('for'=id,label),
tags$textarea(id=id,class=class,rows=rows,cols=cols,value))
}
This is a way to avoid writing the JS code (if you want to) while still...
having a function that calls the same way the built-in Shiny inputs are called, and
includes the div, label, and Bootstrap's form-control CSS style (so that it looks like the built-in Shiny input controls)
Using the function is same as if you are using the built-in or if you built a custom UI.
textareaInput("textareaID","Text Area Label", "Insert text here...", rows = 20, cols = 35)
Here's a quick solution that preserves the shiny input feel, but allows custom number of columns:
textareaInput <- function(inputID, label, value="", rows=10, columns=80) {
HTML(paste0('<div class="form-group shiny-input-container">
<label for="', inputID, '">', label,'</label>
<textarea id="', inputID, '" rows="', rows,'" cols="',
columns,'">', value, '</textarea></div>'))
}
In your ui.R script, you can add:
textareaInput("shazam", "My text box")
Note: To get a Bootstrap feel to the textarea, you can use:
textareaInput <- function(inputID, label, value="", rows=10) {
HTML(paste0('<div class="form-group shiny-input-container">
<label for="', inputID, '">', label,'</label>
<textarea class="form-control" id="', inputID,
'" rows="', rows, '">', value, '</textarea></div>'))
}