looping error in alert generation with shinyalert - r

Good days, I am programming in Rstudio, using shiny, and I wanted to generate an alert that is activated only when I want to leave a tabPanel without completing a condition, but not if I do not enter the tabPanel before, this is the way I found. The problem is that every time that I leave the Panel 1 without fulfilling the condition of completing text, alerts are generated that are accumulating (1 alert the first time, two the second, three the third, etc.) I wanted to consult if somebody knows why it is this and how to avoid it.
thank you very much
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
observe({
req(input$tabselected == "Tab1")
observeEvent(
input$tabselected,
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE
)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
)
}
)
}
shinyApp(ui = ui, server = server)

Is this the behavior you desire? Your example was recursive so you had reoccurring popup event. We can create a reactiveValues variable to keep track of the events, like so:
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
v <- reactiveValues(to_alert = FALSE)
observeEvent(input$tabselected,{
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
v$to_alert <- TRUE
}else{
v$to_alert <- FALSE
}
},ignoreInit = TRUE)
observeEvent(v$to_alert,{
if (v$to_alert){
shinyalert(title = "Save your work before changing tab", type = "warning",showConfirmButton = TRUE)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
})
}
shinyApp(ui = ui, server = server)

Related

How to have a user input text and create a list with shiny? R

I have the following app which allows for text to be entered and it is then saved as VALUE and printed on a panel.
Although it looks like I can only do this with one text input at a time - even if I click add (so I don't believe this button is working). On top of that I would like for the user to be able to add multiple inputs (like I have below).
And then my VALUE function should be list with multiple inputs.
code below
library(shiny)
ui <- fluidPage(
headerPanel("R Package App"),
sidebarPanel(
# selectInput("options", "options", choices=c('abc','def')),
textInput("textbox", "Enter R Package Name", ""),
actionButton("add","Add")
),
mainPanel(
textOutput("caption")
)
)
server <- function(input, output, session) {
observe({
VALUE <- ''
if(input$add>0) {
isolate({
VALUE <- input$textbox
})
}
updateTextInput(session, inputId = "textbox", value = VALUE)
})
output$caption <- renderText({
input$textbox
})
}
shinyApp(ui = ui, server = server)
Have you considered using selectizeInput with it's create option?
library(shiny)
packagesDF <- as.data.frame(installed.packages())
ui <- fluidPage(
headerPanel("R Package App"),
sidebarPanel(
selectizeInput(
inputId = "selectedPackages",
label = "Enter R Package Name",
choices = packagesDF$Package,
selected = NULL,
multiple = TRUE,
width = "100%",
options = list(
'plugins' = list('remove_button'),
'create' = TRUE,
'persist' = TRUE
)
)
),
mainPanel(textOutput("caption"))
)
server <- function(input, output, session) {
output$caption <- renderText({
paste0(input$selectedPackages, collapse = ", ")
})
}
shinyApp(ui = ui, server = server)

How to display a confirmation message while switching tabs (tabPanel) within a R Shiny app?

I am trying to implement something similar to this within the app and not at the browser level as described here.
After capturing the value of the new tab (tabPanel value) selected, could not display the confirmation message before switching to the newly selected tab to display its content.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(id = "tabselected",
tabPanel("Tab1"),
tabPanel("Tab2",plotOutput("plot"))
)
)
server <- function(input, output) {
observeEvent(input$tabselected, {
if(input$tabselected == "Tab2")
{
shinyalert(title = "Save your work before changing tab", type = "warning", showConfirmButton = TRUE)
output$plot <- renderPlot({ ggplot(mtcars)+geom_abline() })
}
})
}
shinyApp(ui = ui, server = server)
You can simply redirect to Tab1 via updateTabsetPanel as long as your desired condition is met.
Here is an example requiring the user to type something in the textInput before it's allowed to switch the tab.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(
id = "tabselected",
tabPanel("Tab1", p(), textInput("requiredText", "Required Text")),
tabPanel("Tab2", p(), plotOutput("plot"))
))
server <- function(input, output, session) {
observeEvent(input$tabselected, {
if (input$tabselected == "Tab2" && !isTruthy(input$requiredText)) {
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE)
output$plot <- renderPlot({
ggplot(mtcars) + geom_abline() + ggtitle(req(input$requiredText))
})
}
})
}
shinyApp(ui = ui, server = server)
By the way an alternative approach wpuld be using showTab and hideTab to display the tabs only if all conditions are fulfilled.

Make icon of airDatepickerInput clickable

I'm looking for a way to fire this line of code:
onevent('click', '???' ,{ print( 'hey1!!') })
or
onclick('DateRange' ,{ print( 'hey1!!') })
but ONLY when the user clicks on the calendar icon of an airDatepickerInput
but I don't know how to target the icon since it has no ID of its own.
Targeting 'DateRange' will not work as it will also trigger when clicking in the date range field, and that's unwanted.
The reason I want this is because I want the option to open a modal dialog that shows a plot with the date distribution of my data files the user is filtering for in my app.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res")
)
server <- function(input, output, session) {
output$res <- renderPrint(input$DateRange)
}
shinyApp(ui, server)
The author of the shinywidget package has updated the airDatepickerInput so that the button on the side can now be observed.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res_date"),
verbatimTextOutput("res_button")
)
server <- function(input, output, session) {
output$res_date <- renderPrint(input$DateRange)
output$res_button <- renderPrint(input$DateRange_button)
observeEvent(input$DateRange_button, {
print(input$DateRange_button)
})
}
shinyApp(ui, server)

R Shiny reactive triggered by navigating to particular tabPanel in navbarPage

writing with a shiny question. I have a navbarPage, id = "navbar", and in the navbarMenu user can select one among several tabPanels. Each tabPanel is assigned a value (value = 1, value = 2, etc). So input$navbar is reactive value with the value of the selected tabPanel.
I have a reactive expression defined which reacts to the changing of the tabPanel (reacts based on input$navbar). What I actually want is for this to react to navigating to a particular tabPanel, but not navigating away from that tabPanel. So, when input$navbar changes from 1 to 2 I want a reaction, but when changing from 2 to 1 no reaction. How can I achieve this?
Here is relevant snippet of my code, I don't think I need a full reproducible example for this but let me know if I'm wrong.
#ui snippet
navbarPage(id = "navbar",
navbarMenu(title = "Title",
tabPanel(title = "tp1", value = 1),
tabPanel(title = "tp2", value = 2),
#more tabPanels and ui stuff...
#server snippet
rctvfx <- reactive({
#want this to react only when input$navbar changes from ==1 to ==2
input$navbar
isolate({
#do stuff
})
})
You can use an if statement. This makes sure the code only runs if the user navigated to the corresponding tab.
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
"----",
"Section header",
tabPanel("Table")
)
),
server = function(input, output){
observe({
if (req(input$navbar) == "Table")
message("Table has been selected")
if (req(input$navbar) == "Plot")
message("Plot has been selected")
})
}
)
I would recomment do use observe rather than reactive to make sure everything runs even if all observers for the reactive are idle.
Another example of the same answer as above
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
tabPanel("Table"),
mainPanel(dataTableOutput("d"))
)
),
server = function(input, output){
output$d = renderDataTable({
if ((input$navbar) == "Table") {
head(mtcars)
} else {
((input$navbar) == "Plot")
head(iris)
}
})
}
)

Create a popup dialog box interactive

I was wondering if it is possible to create a popup dialog box interactive by using shiny (and shinyBS).
For example, I have a string and I want to change it and before doing a dialog box shows up asking if I really want to change it. In case I say "yes", it does it otherwise it discards the change. Here's my try but I found two issues: 1. if you click "yes" or "no", nothing changes 2. you always need to close the box by the bottom "close".
rm(list = ls())
library(shiny)
library(shinyBS)
name <- "myname"
ui =fluidPage(
textOutput("curName"),
br(),
textInput("newName", "Name of variable:", name),
br(),
actionButton("BUTnew", "Change"),
bsModal("modalnew", "Change name", "BUTnew", size = "small",
textOutput("textnew"),
actionButton("BUTyes", "Yes"),
actionButton("BUTno", "No")
)
)
server = function(input, output, session) {
output$curName <- renderText({paste0("Current name: ", name)})
observeEvent(input$BUTnew, {
output$textnew <- renderText({paste0("Do you want to change the name?")})
})
observeEvent(input$BUTyes, {
name <- input$newName
})
}
runApp(list(ui = ui, server = server))
Other proposals are more than welcome!!
Here's a proposition, I mainly changed the server.R:
library(shiny)
library(shinyBS)
ui =fluidPage(
textOutput("curName"),
br(),
textInput("newName", "Name of variable:", "myname"),
br(),
actionButton("BUTnew", "Change"),
bsModal("modalnew", "Change name", "BUTnew", size = "small",
HTML("Do you want to change the name?"),
actionButton("BUTyes", "Yes"),
actionButton("BUTno", "No")
)
)
server = function(input, output, session) {
values <- reactiveValues()
values$name <- "myname";
output$curName <- renderText({
paste0("Current name: ", values$name)
})
observeEvent(input$BUTyes, {
toggleModal(session, "modalnew", toggle = "close")
values$name <- input$newName
})
observeEvent(input$BUTno, {
toggleModal(session, "modalnew", toggle = "close")
updateTextInput(session, "newName", value=values$name)
})
}
runApp(list(ui = ui, server = server))
A couple of points:
I created a reactiveValues to hold the name that the person currently has. This is useful because you can then update or not update this value when the person clicks on the modal button. You can access the name using values$name.
You can use toggleModal to close the modal once the user has clicked on yes or no
#NicE provided a nice solution. I'm going to offer an alternative solution using the shinyalert package instead, which I believe results in easier to understand code (disclaimer: I wrote that package so may be biased).
The main difference is that the modal creation is no longer in the UI and is now done on the server when the button is clicked. The modal uses a callback function to determine if "yes" or "no" were clicked.
library(shiny)
library(shinyalert)
ui <- fluidPage(
useShinyalert(),
textOutput("curName"),
br(),
textInput("newName", "Name of variable:", "myname"),
br(),
actionButton("BUTnew", "Change")
)
server = function(input, output, session) {
values <- reactiveValues()
values$name <- "myname"
output$curName <- renderText({
paste0("Current name: ", values$name)
})
observeEvent(input$BUTnew, {
shinyalert("Change name", "Do you want to change the name?",
confirmButtonText = "Yes", showCancelButton = TRUE,
cancelButtonText = "No", callbackR = modalCallback)
})
modalCallback <- function(value) {
if (value == TRUE) {
values$name <- input$newName
} else {
updateTextInput(session, "newName", value=values$name)
}
}
}
runApp(list(ui = ui, server = server))
You can do something like this using conditionalPanel, I would further suggest adding a button to ask for confirmation oppose to instant update.
rm(list = ls())
library(shiny)
library(shinyBS)
name <- "myname"
ui = fluidPage(
uiOutput("curName"),
br(),
actionButton("BUTnew", "Change"),
bsModal("modalnew", "Change name", "BUTnew", size = "small",
textOutput("textnew"),
radioButtons("change_name", "", choices = list("Yes" = 1, "No" = 2, "I dont know" = 3),selected = 2),
conditionalPanel(condition = "input.change_name == '1'",textInput("new_name", "Enter New Name:", ""))
)
)
)
server = function(input, output, session) {
output$curName <- renderUI({textInput("my_name", "Current name: ", name)})
observeEvent(input$BUTnew, {
output$textnew <- renderText({paste0("Do you want to change the name?")})
})
observe({
input$BUTnew
if(input$change_name == '1'){
if(input$new_name != ""){
output$curName <- renderUI({textInput("my_name", "Current name: ", input$new_name)})
}
else{
output$curName <- renderUI({textInput("my_name", "Current name: ", name)})
}
}
})
}
runApp(list(ui = ui, server = server))

Resources