R Shiny observeEvent continues to trigger - r

I'm struggling to get an observeEvent process to run only once after it's triggering event - a button click. This illustrates:
require(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
output$report = renderText(input$input_value)
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))
You'll see that after the button has been clicked once, the textOutput becomes responsive to textInput changes rather than button clicks.
I've tried this approach:
server = function(input, output, session) {
o = observeEvent(input$execute, {
output$report = renderText(input$input_value)
o$destroy
})
}
No effect. I've also tried employing the isolate function with no luck. Grateful for suggestions.

You probably had your isolate() call wrapped around renderText() instead of input$input_value. This should do it for you:
require(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
output$report = renderText(isolate(input$input_value))
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

Alliteratively you can bring the reactive values into an isolated scope of observeEvent() as below:
library(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
# bringing reactive values into an isolated scope
inp_val <- input$input_value
output$report <- renderText(inp_val)
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

Related

Spinner loading before action button is pressed

Below is the sample application where I have put spinner loading. But the issue is , even before the action button is pressed, the spinner is been seen. Actually, only when action button is pressed, it should come. I know this can be achieved by adding eventReactive, but is there a way to achieve this only by using observeEvent
library(shiny)
library(dplyr)
library(shinycssloaders)
library(DT)
ui <- fluidPage(
actionButton("plot","plot"),
withSpinner(dataTableOutput("Test"),color="black")
)
server <- function(input, output, session) {
observeEvent(input$plot, {
output$Test <- DT::renderDT(DT::datatable(head(iris),
rownames = FALSE, options = list(dom = 't',
ordering=FALSE)))
})
}
shinyApp(ui = ui, server = server)
One solution is to use uiOutput so that the ui for the spinner and the table are created only when you click on the button:
library(shiny)
library(dplyr)
library(shinycssloaders)
library(DT)
ui <- fluidPage(
actionButton("plot","plot"),
uiOutput("spinner")
)
server <- function(input, output, session) {
observeEvent(input$plot, {
output$spinner <- renderUI({
withSpinner(dataTableOutput("Test"), color="black")
})
output$Test <- DT::renderDT({
Sys.sleep(3)
DT::datatable(head(iris),
rownames = FALSE, options = list(dom = 't', ordering=FALSE))
})
})
}
shinyApp(ui = ui, server = server)

In shiny, how to have a new actionButton when a different variable is selected?

I have a simple task of printing the output of a call to table() on a selected variable.
I want to display the output when the button "Print" is clicked.
In the following example, once the button is clicked, the output is always triggered when I change the selected variable.
If I clicked "Print", and then change the selected variable, I want the ouput to be gone, waited to be printed again when clicking "Print".
Thank you!
Here is a reproducible example:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab = reactive( table(data[[input$selectedvar]]) )
observeEvent(input$print, {
output$info = renderPrint( tab() )
})
}
shinyApp(ui, server)
That's because output$info is reactive to tab(), even while it is enclosed in an observeEvent. I think this app does what you want:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab <- reactiveVal()
observeEvent(input$selectedvar, {
tab(NULL)
})
observeEvent(input$print, {
tab(table(data[[input$selectedvar]]))
})
output$info <- renderPrint({
tab()
})
}
shinyApp(ui, server)

Hyperlink not working with dashes in a datatable in Shiny

In a shiny app I'm showing a table where a column must have links to different websites, referred as "info". But I found that this doesn't work
tagList( as.character(a("info",href="https://plus.google.com/communities/107454103091776894629/stream/c37ddecb-dd31-4a62-bfe0-5d48d9309b8b")))
but this one does, showing correctly a hyperlink
tagList( as.character(a("info",href="https://plus.google.com/communities/107454103091776894629/")))
This is contained in a DT::renderDataTable in a shiny app (with escape=FALSE)
Yes, the second code works, and I noticed that the one difference was that this last one doesn't have dashes. Already tried sprintf.
In a ui
ui <- fluidPage(fluidRow(
column(width = 12,
div(dataTableOutput("web_scraped"), style = "font-size:70%")
))
)
meanwhile a server has
server <- function(input, output, session) {
output$web_scraped <- DT::renderDataTable(
DT::datatable({
data.frame("test"=HTML( as.character(a("info",href="https://plus.google.com/communities/107454103091776894629/"))),stringsAsFactors = FALSE)
},escape = FALSE))
}
shinyApp(ui = ui, server = server)
I need it to be
server <- function(input, output, session) {
output$web_scraped <- DT::renderDataTable(
DT::datatable({
data.frame("test"=HTML( as.character(a("info",href="https://plus.google.com/communities/107454103091776894629/stream/c37ddecb-dd31-4a62-bfe0-5d48d9309b8b"))),stringsAsFactors = FALSE)
},escape = FALSE))
}
shinyApp(ui = ui, server = server)

R - Using GoogleSignIn and ObserveEvent

I'm trying to add Google Sign in to a Shiny App. I'm using the googleAuthR package for the sign and I want to trigger some events when the user clicks "Sign in". However, I'm not getting the ObserveEvent to trigger when I click the "Sign in" button.
Below is a code example. I'm looking to have "This works" printed out when I click "Sign in".
library(shiny)
library(googleAuthR)
options(shiny.port=3694)
options(googleAuthR.webapp.client_id = "...")
ui <- fluidPage(
titlePanel("Sample Google Sign-In"),
sidebarLayout(
sidebarPanel(
googleSignInUI("demo")
),
mainPanel(
with(tags, dl(dt("Name"), dd(textOutput("g_name")),
dt("Email"), dd(textOutput("g_email")),
dt("Image"), dd(uiOutput("g_image")) ))
)
)
)
server <- function(input, output, session) {
sign_ins <- shiny::callModule(googleSignIn, "demo")
output$g_name = renderText({ sign_ins()$name })
output$g_email = renderText({ sign_ins()$email })
output$g_image = renderUI({ img(src=sign_ins()$image) })
observeEvent(input$demo, {
print(paste("This works!"))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Any help would be appreciated. Thanks!
You need the observeEvent to somehow be dependent on the sign_ins()reactive, so an observe()with a req() would achieve what you are asking. The input$demo is the module name, not the input within the module so wouldn't give you a signal to work from. The below works:
library(shiny)
library(googleAuthR)
options(googleAuthR.webapp.client_id = "xxx")
ui <- fluidPage(
titlePanel("Sample Google Sign-In"),
sidebarLayout(
sidebarPanel(
googleSignInUI("demo")
),
mainPanel(
with(tags, dl(dt("Name"), dd(textOutput("g_name")),
dt("Email"), dd(textOutput("g_email")),
dt("Image"), dd(uiOutput("g_image")) ))
)
)
)
server <- function(input, output, session) {
sign_ins <- shiny::callModule(googleSignIn, "demo")
output$g_name = renderText({ sign_ins()$name })
output$g_email = renderText({ sign_ins()$email })
output$g_image = renderUI({ img(src=sign_ins()$image) })
observe({
req(sign_ins()$name)
print("This works")
})
}
# Run the application
shinyApp(ui = ui, server = server)

observeEvent Shiny function used in a module does not work

I'm developing an app in which I use modules to display different tab's ui content. However it seems like the module does not communicate with the main (or parent) app. It displays the proper ui but is not able to execute the observeEvent function when an actionButton is clicked, it should update the current tab and display the second one.
In my code I have created a namespace function and wrapped the actionButton's id in ns(), however it still does not work. Does anyone knows what's wrong?
library(shiny)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
observeEvent(input$action1, {
updateTabItems(session, "tabsPanel", "two")
})
}
ui <- fluidPage(
navlistPanel(id = "tabsPanel",
tabPanel("one",moduleUI("first")),
tabPanel("two",moduleUI("second"))
))
server <- function(input, output, session){
callModule(module,"first")
callModule(module,"second")
}
shinyApp(ui = ui, server = server)
The observeEvent works, but since modules only see and know the variables given to them as input parameters, it does not know the tabsetPanel specified and thus cannot update it. This problem can be solved using a reactive Value, which is passed as parameter and which is changed inside the module. Once it's changed, it is known to the main app and can update the tabsetPanel:
library(shiny)
library(shinydashboard)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session, tabsPanel, openTab){
observeEvent(input$action1, {
if(tabsPanel() == "one"){ # input$tabsPanel == "one"
openTab("two")
}else{ # input$tabsPanel == "two"
openTab("one")
}
})
return(openTab)
}
ui <- fluidPage(
h2("Currently open Tab:"),
verbatimTextOutput("opentab"),
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))
server <- function(input, output, session){
openTab <- reactiveVal()
observe({ openTab(input$tabsPanel) }) # always write the currently open tab into openTab()
# print the currently open tab
output$opentab <- renderPrint({
openTab()
})
openTab <- callModule(module,"first", reactive({ input$tabsPanel }), openTab)
openTab <- callModule(module,"second", reactive({ input$tabsPanel }), openTab)
observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}
shinyApp(ui = ui, server = server)

Resources