Reset and clear out Shiny text output using reset button - r

I am creating a calculator that takes multiple inputs and prints the calculation after clicking 'Calculate'. I also provide a reset button that successfully resets the input values back to their default.
The reset button should also clear the previously printed output (basically I want it to look exactly like it did when you first open the app).
Below is a simplified and still functioning example of the calculator.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id="form",
sidebarLayout(
sidebarPanel(
numericInput("x","X",0),
numericInput("y","Y",0)
),
mainPanel(
br(),
column(width=6,actionButton("calc", "Calculate")),
column(width=6,actionButton("reset", "Reset")),
br(),br(),br(),
textOutput("sum"))
)
))
# Define the server logic
server <- function(input, output) {
output$sum <- renderText({
req(input$calc)
isolate(paste("X + Y =", input$x + input$y))
})
observeEvent(input$reset, {
reset("form")
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have tried a few approaches offered on here for other, seemingly similar questions but I haven't managed to get them to work. I would offer some examples of what I've done but I've lost track of them at this point and I'm hoping there's just some obvious, simple answer that I've overlooked. I'm fairly new to Shiny, though, so details of why a possible answer works would also be appreciated!

Edited to based on comments.
I think the simplest observer would be:
# two observers
server <- function(input, output) {
observeEvent(input$calc, {
output$sum <- renderText({
req(input$calc)
isolate(paste("X + Y =", input$x + input$y))
})
})
observeEvent(input$reset, {
output$sum <- renderText({
})
})
}

Related

Un-suspend elements in hidden part in Shiny

When I use standard Shiny, a change in the tabPanel somehow tells the output elements to un-suspend and show their value:
library(shiny)
ui1 <- fluidPage(
tabsetPanel(
tabPanel("Start", p("Nothing to see here, really")),
tabPanel("Calc", actionButton("do", "Calc"), verbatimTextOutput("out"))
)
)
server1 <- function(input, output, session) {
output$out <- renderPrint({
input$do
})
}
shinyApp(ui1, server1)
works as expected.
Now, if I switch to another framework ( bulma in this case), the elements stay suspended. In order to make them work I have to explicitly switch off the suspendWhenHidden flag.
library(shiny)
library(shinybulma)
ui2 <- bulmaPage(
bulmaTabs(
c("Start", "Calc"),
center = FALSE,
bulmaTab("Start", p("Nothing to see here, really")),
bulmaTab("Calc", bulmaActionButton("do", "Calc"), verbatimTextOutput("out"))
)
)
server2 <- function(input, output, session) {
## Need to comment out to make it run
# session$onFlushed(function() {
# outputOptions(output,
# "out",
# suspendWhenHidden = FALSE)
# })
output$out <- renderPrint({
input$do
})
}
shinyApp(ui2, server2)
I assume that there is a (JS?) trigger attached to a change in tabSets which un-suspends the elements once the element is shown. How can I do the same for the bulma case? In other words, how can I un-suspend the elements once the respective part is shown (either JS/R is fine)?
For future reference: I issued a "bug" report on the github repo of shiny. As assumed there is an event which needs to be triggered (shown) in order to get that work (on tab change in this case)
I submitted a PR on shinybulma so this should be fixed.

Why does observeEvent don't re-evaluate it's content?

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)

Generating dynamic number of datatables without rerendering

I am wondering what the best practice is for handling a dynamic number of datatables. Here is a toy example:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
mainPanel(
sliderInput("number","Number of tables",1,10,1,1),
uiOutput("tables")
)))
server <- shinyServer(function(input, output, session) {
observe({
lapply(seq_len(input$number), function(i) {
output[[paste0("table",i)]] <- DT::renderDataTable(head(mtcars))
})
})
output$tables <- renderUI({
lapply(seq_len(input$number), function(i) {
DT::dataTableOutput(paste0("table",i))
})
})
})
# Run the application
shinyApp(ui = ui, server = server)
This approach is sort of a blunt tool, because you have to rerender all the datatables, whenever a single datatable is added or removed.
Is there a better approach to dynamically generating output that doesn't require creating all the output in a loop, and therefore recreating all the output each time there is a change?
I'm the author of insertUI and removeUI. It seems like you found a bug in insertUI when applied to interactive outputs. I filed an issue for this in the Shiny repo and will try to get to it soon. In the meantime, a workaround is to use where = "beforeBegin" instead of where = "beforeEnd" in the call to insertUI(). See my answer to the original issue filed in the DT repo for more details.
[Edit] Answer has been updated with the workaround from #Bárbara Borges (see her answer for details on why it works)
Here is an example, but note that it is working for normal tables (no refresh), but for datatables, there is no refresh when removing tables but always refreshing when adding tables. I think this is something caused by DT but haven't found the real cause yet. I am posting in the hope that someone can improve this.
library(shiny)
library(DT)
numUI <- 0
ui <- shinyUI(fluidPage(
mainPanel(
sliderInput("number","Number of tables",1,10,1,1),
tags$div(id="tables")
)))
server <- shinyServer(function(input, output, session) {
observe({
if (input$number > numUI) {
for (num in (numUI+1):input$number) {
insertUI("#tables", "beforeBegin", DT::dataTableOutput(paste0("table", num)))
output[[paste0("table",num)]] <- DT::renderDataTable(head(mtcars), server = FALSE)
}
}
if (input$number < numUI) {
for (num in (input$number+1):numUI) {
removeUI(paste0("#table", num))
}
}
numUI <<- input$number
})
})
# Run the application
shinyApp(ui = ui, server = server)

R Shiny modules with conditionalPanel and reactives

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
})

Shiny evaluates twice

I have a rather complex Shiny application and something weird happens:
When I print out some of my intermediate steps the App makes, everything gets printed out twice. That means, everything gets evaluated etc. twice.
I know without seeing the progamme its rather hard to tell what causes the problem, but maybe someone can pin point me (based on experierence/knowledge) what might be the problem.
Like I mentioned in the comment, isolate() should solve your problem.
Beyond the documentation of Rstudio http://shiny.rstudio.com/articles/reactivity-overview.html
I recommend the following blog article for interesting informations beyond the RStudio docu.
https://shinydata.wordpress.com/2015/02/02/a-few-things-i-learned-about-shiny-and-reactive-programming/
In a nutshell, the easiest way to deal with triggering is to wrap your code in isolate() and then just write down the variables/inputs, that should trigger changes before the isolate.
output$text <- renderText({
input$mytext # I trigger changes
isolate({ # No more dependencies from here on
# do stuff with input$mytext
# .....
finishedtext = input$mytext
return(finishedtext)
})
})
Reproducible example:
library(shiny)
ui <- fluidPage(
textInput(inputId = "mytext", label = "I trigger changes", value = "Init"),
textInput(inputId = "mytext2", label = "I DONT trigger changes"),
textOutput("text")
)
server <- function(input, output, session) {
output$text <- renderText({
input$mytext # I trigger changes
isolate({ # No more dependencies from here on
input$mytext2
# do stuff with input$mytext
# .....
finishedtext = input$mytext
return(finishedtext)
})
})
}
shinyApp(ui, server)
I encountered the same problem when using brush events in plotOutput. The solution turned out to be resetOnNew = T when calling plotOutput to prevent changes in my plot causing the brush event to be evaluated again.

Resources