I'm creating an web-app with Shiny in R. I have a dataset which I plot on the map. Using a checkboxGroupInput widget users are able to select categories they want to see on the map (or not). However, the dataset changes over time and not all categories are always available. To make clear which are available in the current set and which are not, I want to format the available categories as bold.
So far I've not been able to get a checkboxGroupInput widget to show with bold labels by the checkboxes. Is there a way to do that? I want some labels to be bold and others not. Also, using updateCheckboxGroupInput I'm able to change the options (i.e. show only available categories), but that not what I want/need.
I have tried for example:
x <- list("<b>A</b>"=1, "<b>B</b>"=2, "C"=3)
checkboxGroupInput(inputId="test", label="this is a test", choices=x)
But such an approach only displays the formatting tags as text in the user interface. Solutions using the HTML() function of Shiny doesn't seem to work either, or... I'm doing it wrong.
Any ideas?
Here is a simple Shiny interface example using the approach described above (which does not work):
library("shiny")
x <- list("<b>A</b>"=1, "<b>B</b>"=2, "C"=3)
server = function(input, output) {}
ui = fluidPage(
checkboxGroupInput(inputId="test", label="this is a test", choices=x)
)
runApp(list(ui = ui, server = server))
The next example DOES work, but it is a solution when initializing the checkbox group. Enabling the observe function in the server part shows that the same solution does not work for updateCheckboxGroupInput. That makes sense, since that function does not return HTML code. I don't know how to access the output of that update function, or how to solve it otherwise.
library("shiny")
x <- list("<b>A</b>"=1, "<b>B</b>"=2, "C"=3)
y <- list("<b>D</b>"=1, "<b>E</b>"=2, "F"=3)
server = function(input, output, session) {
# observe({
# input$test
# gsub(">", ">", gsub("<", "<", updateCheckboxGroupInput(session, "test", choices=y)))
# })
}
ui = fluidPage(
gsub(">", ">", gsub("<", "<", checkboxGroupInput(inputId="test", label="this is a test", choices=x)))
)
runApp(list(ui = ui, server = server))
For now I found a solution. Not really elegant, and probably prone to errors, but it works. I found out that the < and > characters are escaped for HTML purposes by the htmltools function called escapeHtml. By temporarily replacing that function before the updateCheckboxGroupInput is called, by a dummy function, the text is not escaped. After the updateCheckboxGroupInput is called, htmlEscape of course needs to be restored.
An example that works. After launching the app, you need to check the first box to see it work:
library("shiny")
x <- list("<b>A</b>"=1, "<b>B</b>"=2, "C"=3)
y <- list("<b>D</b>"=1, "<b>E</b>"=2, "F"=3)
server = function(input, output, session) {
observe({
value <- input$test
if (length(value) > 0 && value == 1) {
## save htmlEscape function and replace htmlEscape
saved.htmlEscape <- htmltools::htmlEscape
assignInNamespace("htmlEscape", function(x, attribute) return(x), "htmltools")
updateCheckboxGroupInput(session, "test", label="OK", choices=y)
## restore htmlEscape function
assignInNamespace("htmlEscape", saved.htmlEscape, "htmltools")
}
})
}
ui = fluidPage(
checkboxGroupInput(inputId="test", label="this is a test", choices=x)
)
runApp(list(ui = ui, server = server))
Related
I have a Shiny app that calls several custom functions in response to a click event. These custom functions make use of multiple reactive values and I didn't think I would need to pass all of those reactive values as arguments to the custom functions but it seems like I do.
I would have expected the app to behave like normal R where a custom function will search the immediate environment, then, upon not finding a variable, will search the enclosing environment and up the scope, only throwing an error if that variable's undefined at every level. Instead, when the function deals with reactive variables, it seems like code within the function is unaware of reactive variables defined outside of it. Is this true?
A quick demo app that crashes because identity_fun cannot find input$click:
library(shiny)
identity_fun <- function(x){
print(paste("Title's been changed", input$click, "times now"))
x
}
ui <- fillPage(
sidebarLayout(
sidebarPanel(
textInput("text", "Plot title here"),
actionButton("click", "Click when ready to apply it")
),
mainPanel(
plotOutput("mainplot")
)
)
)
server <- function(input, output){
input_text <- reactiveVal()
observeEvent(input$click, {
input_text(identity_fun(input$text))
})
output$mainplot <- renderPlot({
plot(1, main = input_text())
})
}
shinyApp(ui, server)
In base R, a variable outside the function is found trivially:
input <- list()
input$click <- 1
identity_fun("blah")
[1] "Title's been changed 1 times now"
[1] "blah"
and this different behavior took me by surprise when working with a Shiny app.
To fix the above app, I can pass the relevant information as an argument to identity_fun
identity_fun <- function(x, input_click){
print(paste("Title's been changed", input_click, "times now"))
x
}
and
observeEvent(input$click, {
input_text(identity_fun(input$text, input$click))
})
but I'm wondering if that's the best way of doing it. I realize this is probably intentional behavior because it seems complicated for the function to auto-detect that it uses input$click and invalidate if input$click changes, but Shiny's been magic to me before.
Is there a better way of passing reactive values to a function than by adding them as arguments?
The issue with you above example is, that identity_fun is defined outside of the server function. Shiny's input however is only available inside of the server function (there is no input variable in the global env. - you can check this e.g. via RStudio's environment tab).
The following works:
library(shiny)
ui <- fillPage(
sidebarLayout(
sidebarPanel(
textInput("text", "Plot title here"),
actionButton("click", "Click when ready to apply it")
),
mainPanel(
plotOutput("mainplot")
)
)
)
server <- function(input, output){
identity_fun <- function(x){
print(paste("Title's been changed", input$click, "times now"))
x
}
input_text <- reactiveVal()
observeEvent(input$click, {
print(identity_fun(input$text))
})
output$mainplot <- renderPlot({
plot(1, main = input_text())
})
}
shinyApp(ui, server)
Accordingly functions defined within Shiny apps work just like they do everywhere else in R.
However, I'd recommend to always pass function parameters explicitly to make your code more readable.
Please also check this article.
I build a shiny app that need to add pieces of UI dynamically based on some parameter I'll know only in real time. I created a simplistic reconstruction of my needs, and encountered a problem I describe below
so in my example I have a module called mblock. for the sake of this example it only displays a text. the actual text to display is decided at run time, and so is the number of texts (and hence blocks) will be decided at runtime
for the specific example I set texts to be a fixed vector containing all the texts to be shown, but in reality it will be computed as a reactive object. the code is below:
library(shiny)
#block module
mblockUI = function(id) {
ns = NS(id)
fluidRow(
textOutput(ns("text"))
)
}
mblock = function(input,output,session,actual_text) {
output$text = renderText({actual_text})
}
# Define the main ui
ui <- fluidPage(
uiOutput("all_blocks"),
actionButton("submit","submit")
)
# Define server logic
server <- function(input, output) {
texts = c("aaaa","bbbb","cccc") #this is a sample vector of texts to be shown in blocks
output$all_blocks = renderUI({
for(i in 1:length(texts)) {
mname = paste0("block",i) #block name to be created (the name of the module)
#print(mname)
insertUI("#submit","beforeBegin",mblockUI(mname)) #adding the ui
#now adding the server side of each block
#also passing the text to be shown
callModule(mblock,mname,texts[i])
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
The problem is that all the blocks show the same text (the last one). and I don't understand why
any ideas how to fix the code? what do I miss
(shiny version 1.4.0)
First of all, insertUI is able to work "on its own" and doesn't need renderUI. You can put it in an observe environment instead. However, be careful of the output of insertUI since it is persistent, as explained in the documentation of this function:
Unlike renderUI(), the UI generated with insertUI() is persistent: once it's created, it stays there until removed by removeUI(). Each new call to insertUI() creates more UI objects, in addition to the ones already there (all independent from one another). To update a part of the UI (ex: an input object), you must use the appropriate render function or a customized reactive function.
I don't know why but the for loop doesn't work (as your example shows) whereas lapply does (see this answer for example).
Here's your example with these corrections:
library(shiny)
#block module
mblockUI = function(id) {
ns = NS(id)
fluidRow(
textOutput(ns("text"))
)
}
mblock = function(input,output,session,actual_text) {
output$text = renderText({actual_text})
}
# Define the main ui
ui <- fluidPage(
actionButton("submit","submit")
)
# Define server logic
server <- function(input, output) {
texts = c("aaaa","bbbb","cccc") #this is a sample vector of texts to be shown in blocks
observe({
lapply(1:length(texts), function(i) {
mname = paste0("block",i) #block name to be created (the name of the module)
#print(mname)
insertUI("#submit","beforeBegin",mblockUI(mname)) #adding the ui
#now adding the server side of each block
#also passing the text to be shown
callModule(mblock,mname,texts[i])
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have a simple shiny app where the user should input comma-separated values into a text input, chose the output and click on a button to convert to an output.
I have followed the advice in Update content on server only after I click action button in Shiny to change the output only when clicking, and it works.
However, only when starting/ opening the app the first time, the field is empty, yet the output seems to try to evaluate the input field.
It is more of a cosmetic problem, because once the user filled something in, this does not recur, but I wonder how I could avoid this...
My app:
library(shiny)
ui <- fluidPage(
textInput("from", "csv", value = NULL),
actionButton("run", "Run"),
textOutput("to")
)
server <- function(input, output, session) {
list1 <- reactive({
input$run
x <- isolate(paste(read.table(text = input$from, sep = ",")))
x
})
output$to <- renderText({
list1()
})
}
shinyApp(ui = ui, server = server)
The not-desired output - I would like to get rid of the errors.
you can use req(input$from), see Check for required values
I am trying to write a Shiny module which shows a conditionalPanel based on input from the global UI. In the minimal example below the conditionalPanel should show a radioButtons widget when a checkbox in the global UI is clicked, but I can't get it to work.
What am I doing wrong?
library(shiny)
conditional <- function(input, output, session, check){
output$check <- reactive({check()})
outputOptions(output, "check", suspendWhenHidden = FALSE)
output$conditional <- renderUI({
ns <- session$ns
conditionalPanel(
condition = 'output.check',
radioButtons(ns('radioItem'),
'Select option',
choices = c('option 1','option 2'))
)
})
}
conditionalUI <- function(id){
ns <- NS(id)
uiOutput(ns('conditional'))
}
ui <- fluidPage(
fluidRow(checkboxInput('check','Show')),
fluidRow(conditionalUI('mymod'))
)
server <- function(input, output, session) {
check <- reactive({input$check})
callModule(conditional, 'mymod', check = check)
}
shinyApp(ui = ui, server = server)
Simple fix - The condition should be condition = input.check instead of condition = output.check.
You are having a problem with the naming conventions that shiny modules enforce.
Although you have a similar output object in your module, it is not the same as in server. If you specify an output
func <- function(input, output, session) {
output$something <- (...)
}
inside a module, that you called with
callModule(func, 'someIdentifier')
then your output id, which shiny uses to reference all the elements, becomes
someIdentifier-something
You can test this by writing uiOutput("mymod-conditional") instead of uiOutput(ns('conditional')).
Normally, this shouldn't bother you, since modules work the way that all references are resolved within a module. But the conditionalPanel condition, being in JavaScript ("on the other side" so to say), must use global references.
So the fix for your problem would be to change the condition to
condition = 'output["mymod-check"]'
Note that dashes cant be used with JavaScript dot notation, so bracket notation has to be used.
A trick that helped me identify the problem, was to inject JavaScript into the condition in order to show the current value of output on the client side. I placed condition = 'console.log(output)' inside the conditionalPanel so you can inspect the available object in the browser console.
I am having a lot of trouble getting a search filtering module working.
I am to run stats on a large database of cat owner information.
I want my search module to bring up a list of possible owners(that the user can select from) based on a selection from a list of cat breeds.
I thought wrapping the updateSelectInput with observe and using a reactive cat owner expression would facilitate this, in the module, but it is not working( and I can't guess why this is happening or how to debug this). It worked in these other posts([1]:R shiny passing reactive to selectInput choices , [2]:using values from a reactive input to directly input into a custom function)
Why won't my selectInput update with cat owners?
library(shiny)
df=data.frame(
cat=c("tabby","DSH","MSH","LSH","DSH","MSH","LSH","sphinx"),
owner=c("Foo","Bar","Bash","Foo","Foo","Foo","Bar","Bash"),stringsAsFactors = F)
refinedSearch<-function(input, output, session){
ownsCat<-reactive({df[df$cat%in%input$cat,"owner"]})
observe({updateSelectInput(session, "ownerSelected",
label ="Owned By",choices = ownsCat())})
return()
}
refinedSearchUI<-function(id){
ns <- NS(id)
fluidRow(
column(4,selectInput(ns("cat"),"Cat",selectize = T,
choices =c("tabby","DSH","MSH","LSH","sphinx") )),
column(4,selectInput(ns("ownerSelected"),"Owned By","",selectize = T))
)
}
ui <- fluidPage(
h1("Find cats owners"),
fluidRow(column(10,offset=1, refinedSearchUI("tmp"))),
fluidRow(column(10,offset=1, actionButton("addFilter","Add a Filter",
icon = icon("plus"))))
)
server <- function(input, output,session) {
refinedSearch(input,output,session)
observeEvent(input$add, {insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearch(input,output,session))})
}
shinyApp(ui = ui, server = server)
Thank y'all for you time.
There seems to be quite a bit of confusion on how to call modules. You need to use the callModule() function in the server. Also, when inserting UI (using the insertUI()function), you need to call the refinedSearchUI() function, not the refinedSearch() function (which, again, should always be called through callModule(), so it should never actually get called directly like that).
I'd recommend a re-reading of the modules article.
You also have a typo. The event in your observeEvent() function should be input$addFilter, not input$add (which doesn't exist, so that observer is never fired..)
If you change your server function to this, your app will work as expected:
server <- function(input, output,session) {
callModule(refinedSearch, "tmp")
observeEvent(input$addFilter, {
id <- paste0("filter_", input$add)
insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearchUI(id))
callModule(refinedSearch, id)
})
}