sorry if this is a simple question, but I am quite new to Shiny and even newer to using Modules.
I have a larger application in which one of its pages I use a button to open a Shiny Modal, there are quite a few things going on in this modal, so I made a separate server for it. Inside the modal server are some observeEvent handlers. The problem arises when the user tries to use the modal more than once, as, apparently, opening the modal a second time creates a second instance of its server and then the observeEvents trigger multiple times.
I know that if I use different IDs for the server I can solve this, but I would really like to keep the same ID. In my head, I thought creating a server with the same ID would replace the previous one, but that doesn't seem to be the case. Maybe I just need to delete the previous server when the modal closes(?), I am not sure. Anyway, any help is appreciated.
Here is a reproducible example that shows this behaviour:
Opening the modal a second time and clicking the button makes multiple notifications appear.
modal_server <- function(id){
moduleServer(id,
function(input, output, session){
ns <- session$ns
showModal(modalDialog(actionButton(ns("show_notification"), "Show Notification")))
observeEvent(input$show_notification, {
showNotification("hi")
})
})
}
ui <- fluidPage(
actionButton("show_modal", "Show Modal")
)
server <- function(input, output, session) {
observeEvent(input$show_modal, {
modal_server(id = "modal")
})
}
shinyApp(ui = ui, server = server)
One option to fix your issue would be to move the UI code to the module too and use two observeEvents inside the module server to handle the two events, i.e. showing the modal and showing the notification:
library(shiny)
modal_ui <- function(id) {
ns <- NS(id)
actionButton(ns("show_modal"), "Show Modal")
}
modal_server <- function(id) {
moduleServer(
id,
function(input, output, session) {
ns <- NS(id)
observeEvent(input$show_modal, {
showModal({
modalDialog(
actionButton(ns("show_notification"), "Show Notification")
)
})
})
observeEvent(input$show_notification, {
showNotification("hi")
})
}
)
}
ui <- fluidPage(
modal_ui("modal")
)
server <- function(input, output, session) {
modal_server(id = "modal")
}
shinyApp(ui = ui, server = server)
Related
The below example code "Code" saves to the browser the user slider input from one session to the next, using package shinyStorePlus. I would like the user to be able to clear the saved inputs via a click of the "clear" actionButton(). When the commented-out code in "Code" is uncommented, revealing the clear function in the server section, clicking that actionButton() results in error Warning: Error in envir$session$sendCustomMessage: attempt to apply non-function. However, if I pull the clear data code of clearStore(appId = appid) out of the observer and run the code this way, it works fine in clearing out the saved browser data. As an example, running the "Isolated Clearing Code" at the very bottom, completely outside the observer, clears out the browser data like it should.
What am I doing wrong here with my use of an observer? I've fooled around with using isolate(), making the appid reactive, etc., and nothing seems to work.
Code:
library(shiny)
library(shinyStorePlus)
ui <- fluidPage(
initStore(), br(),
sliderInput("input1",label=NULL,min=1,max=200,value=100),
actionButton("clear","Clear data")
)
server <- function(input, output, session) {
appid <- "application001"
setupStorage(
appId = appid,
inputs = list("input1")
)
# observeEvent(input$clear,{
# clearStore(appId = appid)
# })
}
shinyApp(ui, server)
Isolated Clearing Code:
ui <- fluidPage(
initStore(),
)
server <- function(input, output, session) {
appid <- "application001"
clearStore(appId = appid)
}
shinyApp(ui, server)
This seems to be an issue with shinyStorePlus' code:
> clearStore
function (appId)
{
envir <- parent.frame()
envir$session$sendCustomMessage("clearStorage", appId)
}
using parent.frame() to get the session is unfavorable.
Please check the following instead:
library(shiny)
library(shinyStorePlus)
clearStore <- function(appId, session = getDefaultReactiveDomain()){
session$sendCustomMessage("clearStorage", appId)
}
ui <- fluidPage(
initStore(), br(),
sliderInput("input1",label=NULL,min=1,max=200,value=100),
actionButton("clear","Clear data")
)
server <- function(input, output, session) {
appid <- "application001"
setupStorage(
appId = appid,
inputs = list("input1")
)
observeEvent(input$clear,{
clearStore(appId = appid)
})
}
shinyApp(ui, server)
I left a PR here.
In my shiny server I am figuring out the name of a markdown file which I want to show in the UI. I know how to pass the file name, as a string, back to the UI but I don't now how to tell includeMarkdown() to treat the string as a file name.
My code so far is below. Any advice?
library(shiny)
fileConn<-file("hello.md")
writeLines(c("# Hello","# World"), fileConn)
close(fileConn)
ui <- fluidPage(
includeMarkdown("hello.md"),
br(),
div("File name text:", textOutput("fileNameText", inline = TRUE)),
#includeMarkdown(fileNameText) # this needs help
)
server <- function(input, output, session) {
selectedName <- reactive({
paste0("hello.md") # this is actually more complicated...
})
output$fileNameText <- renderText(
paste0(selectedName())
)
}
shinyApp(ui = ui, server = server)
Your example code works fine, but from your description, I am thinking your asking how to pass a different filename to includeMarkdown() that was created somewhere else in the app, correct?
The first step is to understand includeMarkdown() as a UI element that will change depending on other UI elements (and stuff that happens in server). The solution is to use a placeholder in the ui to hold the place for the includeMarkdown() element, and create that particular element in server using renderUI.
Hopefully you can follow this example. I'm using uiOutput('displayFile') to hold the place for the element that's created in server.
library(shiny)
fileConn<-file("hello.md")
writeLines(c("# Hello","# World"), fileConn)
close(fileConn)
fileConn1<-file("goodbye.md")
writeLines(c("# Goodbye","# Everyone!"), fileConn1)
close(fileConn1)
ui <- fluidPage(
selectInput('file_selection', 'Choose Markdown File:', choices=c('hello.md','goodbye.md')),
uiOutput('displayFile')
)
server <- function(input, output, session) {
output$displayFile <- renderUI({
includeMarkdown(input$file_selection)
})
}
shinyApp(ui = ui, server = server)
My Shiny application runs a script build.R when the user clicks the action button. I would like to inform the user not to close the app while the script is being run. When done, the user is informed that building was successful.
Here's my minimal reproducible code:
library(shiny)
ui <- fluidPage(
actionButton("build", "run the buildscript"),
textOutput("rstatus")
)
server <- function(input, output, session) {
reloadstatus <- reactiveVal("")
observeEvent(input$build, {
reloadstatus("building, do not close the app")
# in the actual app would be source("build.R")
Sys.sleep(1)
reloadstatus("successfully built")
})
output$rstatus <- renderText({
reloadstatus()
})
}
shinyApp(ui, server)
I guess it does not work because Shiny tries to first run the observeEvent till the end before altering the reactiveVal. How can I achieve my desired output (first "reloading..." second "successfully...")?
You can use shinyjs to update the content of message.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("build", "run the buildscript"),
p(id = "rstatus", "")
)
server <- function(input, output, session) {
observeEvent(input$build, {
shinyjs::html("rstatus", "building, do not close the app")
# in the actual app would be source("build.R")
Sys.sleep(1)
shinyjs::html("rstatus", "successfully built")
})
}
shinyApp(ui, server)
In the following example, the text is not shown in the start. If I click on the "show"-Button the text appears. If I then click on the "hide"-Button nothing else happens anymore.
In fact the "textis$visible" variable has always the correct value, but i think the if-statement in the observeEvent funktion is only calculated after the very first button click.
Is there a way to force observeEvent to re-evaluate the if statement? Or are there other ways to stop shiny from executing code in the server part and restart it again (in the real case there would be a whole bunch of function calls inside the if statement, not just hide and show some text)
library(shiny)
ui <- fluidPage(
actionButton(inputId="show","show"),
actionButton(inputId="hide","hide"),
textOutput(outputId = "some_text")
)
server <- function(input, output) {
textis<-reactiveValues(visible=FALSE)
observeEvent(input$show,
textis$visible<-TRUE)
observeEvent(input$hide,
textis$visible<-FALSE)
observeEvent(textis$visible , if(textis$visible){
output$some_text<-renderText({"this is some text"})
})}
shinyApp(ui = ui, server = server)
The observeEvent expressions are evaluated any time the value of their event expression changes. But, in the code you have above, when textis$visible changes, the observer only has instructions to perform if textis$visible is true. In the code snippet below, I've used else{...} to give that observer an action to perform when testis$visible is not true.
observeEvent(textis$visible , if(textis$visible){
output$some_text<-renderText({"this is some text"})
} else {output$some_text<-renderText({''}) }
)}
So, if you paste the else clause above into your app, the output some_text will disappear when the hide button is clicked.
It is not very good practice to put a render element in an observer (and it is unnecessary). Also since you have only one reactiveValue, you could use reactiveVal(), see the example below. You can call its value with text_visible(), and update it with text_visible(new_value).
Working example:
library(shiny)
ui <- fluidPage(
actionButton(inputId="show","show"),
actionButton(inputId="hide","hide"),
textOutput(outputId = "some_text")
)
server <- function(input, output) {
text_visible<-reactiveVal(TRUE)
observeEvent(input$show,
text_visible(TRUE))
observeEvent(input$hide,
text_visible(FALSE))
output$some_text<-renderText({
if(text_visible())
return("this is some text")
else
return("")
})
}
shinyApp(ui = ui, server = server)
try something like this:
library(shiny)
ui <- fluidPage(
actionButton(inputId="show","show"),
actionButton(inputId="hide","hide"),
textOutput(outputId = "some_text")
)
server <- function(input, output) {
textis <- reactiveVal(F)
observeEvent(input$show,{textis(T)})
observeEvent(input$hide,{textis(F)})
result <- eventReactive(textis(),{
if(!textis()){
return()
}
"this is some text"
})
output$some_text<-renderText({result()})
}
shinyApp(ui = ui, server = server)
I am trying to modularize a complex Shiny app for which I have a conditionalPanel that should only appear given a certain input state.
Before I made everything modular, the input and conditionalPanel were both in ui.R, and I could reference the input using something like this:
conditionalPanel("input.select == 'Option one'", p('Option one is selected'))
Now that I have modularized things, accessing the input is more complicated. I thought the following was the way to do it, but it doesn't quite work. (Here I've combined things into a single standalone script):
library(shiny)
## Module code for 'selectorUI' and 'selector'
selectorUI <- function(id) {
ns <- NS(id)
selectizeInput(inputId = ns('select'),
label = 'Make a choice:',
choices = c('Option one', 'Option two'))
}
selector <- function(input, output, session) {
reactive(input$select)
}
## Main app
ui <- shinyUI(fluidPage(
selectorUI('id1'),
conditionalPanel(condition = "output.selected == 'Option one'", p('Option one is selected.'))
))
server <- shinyServer(function(input, output, session) {
output$selected <- callModule(selector, 'id1')
})
shinyApp(ui = ui, server = server)
I think this should work, but it doesn't - it only works if I make another reference to output$selected in the main ui section:
ui <- shinyUI(fluidPage(
selectorUI('id1'),
textOutput('selected'), ## Adding just this one line makes the next line work
conditionalPanel(condition = "output.selected == 'Option one'", p('Option one is selected.'))
))
Unfortunately of course this has the unwanted effect of rendering the result of textOutput('selected'). I can only guess that the reason this works is because it somehow triggers the reactive in a way that the JavaScript reference alone does not.
Any idea how I should be getting this conditionalPanel to work properly?
Thank you..
EDIT: Turns out not actually a bug: https://github.com/rstudio/shiny/issues/1318. See my own answer below.
But also note that I actually like the renderUI solution given in the accepted answer better than my original conditionalPanel approach.
After calling the module the ID of selectizeInput is id1-select. In javaScript there are two ways of accessing object properties:
objectName.property or objectName['property']
Since there is - in the ID we have to refer to it via string, so the second method is way to go.
The condition in conditionalPanel becomes:
input['id1-select'] == 'Option one'
Full example:
library(shiny)
## Module code for 'selectorUI' and 'selector'
selectorUI <- function(id) {
ns <- NS(id)
selectizeInput(inputId = ns('select'),
label = 'Make a choice:',
choices = c('Option one', 'Option two'))
}
## Main app
ui <- shinyUI(fluidPage(
selectorUI('id1'),
conditionalPanel(condition = "input['id1-select'] == 'Option one'",
p('Option one is selected.'))
))
server <- shinyServer(function(input, output, session) {
})
shinyApp(ui = ui, server = server)
EDIT:
This does work, but doesn't it violate the notion of modularity? You would have to know the code for the module internally calls that input 'select' in order to construct 'id1-select'.
Yes, you're right.
According to this article, the trick you used i.e. assigning a module call to the output$selected and then accessing its value on the client side via output.selected should work but it doesn't. I don't know why...it is maybe a bug. (I have the newest shiny version from github)
The only thing I can think of is to use renderUI instead of conditionalPanel as in the example below:
library(shiny)
## Module code for 'selectorUI' and 'selector'
selectorUI <- function(id) {
ns <- NS(id)
selectizeInput(inputId = ns('select'),
label = 'Make a choice:',
choices = c('Option one', 'Option two'))
}
selector <- function(input, output, session) {
reactive(input$select)
}
## Main app
ui <- shinyUI(fluidPage(
selectorUI('id1'),
uiOutput("dynamic1")
))
server <- shinyServer(function(input, output, session) {
output$dynamic1 <- renderUI({
condition1 <- callModule(selector, 'id1') # or just callModule(selector, 'id1')()
if (condition1() == 'Option one') return(p('Option one is selected.'))
})
})
shinyApp(ui = ui, server = server)
Turns out it actually isn't a bug, just a little tricky. According to Joe Cheng,
Right--we don't, by default, calculate/render output values if they aren't going to be visible. And if we don't calculate them, you can't use them in conditions.
You can change this behavior this by setting an output to calculate every time, you can use this in your server.R (replace outputId with the corresponding value):
outputOptions(output, "outputId", suspendWhenHidden = FALSE)
So to fix the problem with my original example, we only need to add that one line to the server function:
server <- shinyServer(function(input, output, session) {
output$selected <- callModule(selector, 'id1')
outputOptions(output, 'selected', suspendWhenHidden = FALSE) # Adding this line
})