track previous tab in Shiny (r) - r

In a tabset in Shiny, is there any way to track which tab panel the user has navigated from in order to get to the current panel? I'm nearly at the stage of using a counter variable for each panel to track how often it has been visited, but was wondering if there is a more elegant solution.

One possible way to do this is to use reactiveValues to store the current and previous tab input ids. A minimal example app doing this is shown below. The app tracks and prints out the currently selected and previously selected tabs.
library(shiny)
ui = shinyUI(
fluidPage(
tabsetPanel(id = 'selected_tab',
tabPanel('1','1'),
tabPanel('2','2'),
tabPanel('3','3')
),#tabsetPanel
"current tab:",
verbatimTextOutput('current_tab'),
"previous tab:",
verbatimTextOutput('last_tab')
)#fPage
)#shinyUi
server = shinyServer(function(input, output, session) {
#init reactive value storage
rv = reactiveValues()
#trigger event on tab selection change
observeEvent(input$selected_tab, {
#store old current tab as last tab reactive value
rv$last_tab = rv$current_tab
#store new current tab as cur tab reactive value
rv$current_tab = input$selected_tab
})
output$current_tab = renderPrint(rv$current_tab)
output$last_tab = renderPrint(rv$last_tab)
})#shinyserver
shinyApp(ui, server)

Related

Shiny App re-runs observeEvent when restoring a bookmarked state

I'm building a data-driven Shiny App that requires the user to bookmark the App state sometimes so that she can save the processed data then reverting to it later to continue working on the App. I have used the bookmarking method in Shiny but I'm stuck with a problem that makes Shiny re-run the event whenever I restore the state, as if I hit the button again.
I attach herewith a sample code representing the problem. It is a simple interface with months and years dropdown menus. The user is expected to select a month and a year then hit the 'Set Billing Month' button to store the values. If the user elects to Bookmark the state, she hits the Bookmark button and receives the modal box with the URL. The user can then plug the URL into the browser and restores the state as she left it. All that works well except that when the App restores the state, it re-runs the observeEvent function of the Set Month button. This is evident by throwing the designed message "Billing Month has been set!" that appears when hitting the button.
I'm expecting Shiny to restore the bookmarked values without re-running the App to get them back. The bookmarking is done on 'server' as a store. This issue causes a problem to me especially for other functions that require loading big data and processing them.
I tried to replicate the problem with the sample code below.
Any assistance is highly appreciated!
`
library(shiny)
library(shinyjs)
enableBookmarking()
ui <- function(request) {
fluidPage(
useShinyjs(),
bookmarkButton(),
titlePanel("Billing App"),
tabsetPanel(
tabPanel("Invoicing Setup",
selectInput("BillMo",label = "Month",choices = c(1,2,3,4,5,6,7,8,9,10,11,12)),
selectInput("BillYr",label = "Year",choices = c(2022,2023,2024,2025,2026,2027,2028,2029,2030)),
actionButton("btnSetInvMo",label = "Set Billing Month",icon = NULL)
)
)
)
}
server <- function(input, output, session) {
# Set up Reactive Values
rVals <- reactiveValues(rBillMo=NULL,
rBillYr=NULL)
observeEvent(input$btnSetInvMo,{
BillMo <- as.integer(input$BillMo)
BillYr <- as.integer(input$BillYr)
# Assign reactive variables
observe({rVals$rBillMo <- BillMo})
observe({rVals$rPrvMo2 <- BillYr})
shinyjs::disable("btnSetInvMo")
showNotification("Billing Month has been set!", type = "message")
})
# BOOKMARKING
onBookmark(function(state){
state$values$billMo <- rVals$rBillMo
state$values$billYr <- rVals$rBillYr
})
onRestore(function(state){
rVals$rBillMo <- reactive(state$values$BillMo)
rVals$rBillYr <- reactive(state$values$BillYr)
})
}
shinyApp(ui, server,enableBookmarking = "server")
`
Add ignoreInit = TRUE to your observer
observeEvent(input$btnSetInvMo,{
BillMo <- as.integer(input$BillMo)
BillYr <- as.integer(input$BillYr)
# Assign reactive variables
observe({rVals$rBillMo <- BillMo})
observe({rVals$rPrvMo2 <- BillYr})
shinyjs::disable("btnSetInvMo")
print("doing")
showNotification("Billing Month has been set!", type = "message")
},ignoreInit = TRUE)

In R Shiny, when using renderUI/uiOutput to dynamically generate sets of controls, how can I harvest those values or populate input by causing events?

Question
In R Shiny, when using
renderUI
uiOutput
to dynamically generate sets of controls, such as:
checkboxes
radiobuttons
text boxes
how can I harvest those values or populate input by causing events?
As-is, those generated controls appear to be "display only". Making a selection, marking a checkbox, or entering data only updates the display, but no Event is created and the values are not populated into the "input" variable ( ReactiveValues ); thus, nothing is received by the Shiny server process.
If these control inputs are in-fact isolated, it completely undermines the point of dynamically creating controls.
Obviously, I'm hoping that this issue has been addressed, but my searches haven't turned it up.
In my specific case, the UI allows the user to:
Select and upload a CSV file.
The logic identifies numerical, date, and grouping columns, and produces 3 sets of radiobutton control sets. The idea is that you pick which columns you are interested in.
Picking a grouping column SHOULD return that columnID back to the server, where it will display a discrete list of groups from which to select. This fails, as the selections do not generate an Event, and the input variable (provided to server.R) only contains the ReactiveValues from the static controls.
That said, the display of the controls looks fine.
Step#0 screenshot:
Step#1 screenshot:
On the server.R side, I'm using code as below to create the radioButtons.
output$radioChoices <- reactive({
...
inputGroup <- renderUI({
input_list <- tagList(
radioButtons(inputId = "choiceGrp", label = "Available Grouping Columns", choices = grpColumnNames, inline = TRUE, selected = selectedGrp),
radioButtons(inputId = "choiceNumb",label = "Available Numerical Columns",choices = numColumnNames, inline = TRUE, selected = selectedNum),
radioButtons(inputId = "choiceDate",label = "Available Date Columns", choices = dateColumnNames, inline = TRUE, selected = selectedDate),
hr()
)
do.call(tagList, input_list)
})
print(inputGroup)
output$radioChoices <- inputGroup
})
I have played around with a Submit button and ActionButtons to try and force an Event, but no dice. My skull-storming is now going to places like "do I need to somehow use Javascript here?"
Many thanks to all of you who are lending me your cycles on this matter.
I'm not sure I understand your problem. Here's a MWE that accesses the value of a widget created by uiOutput/renderUI. The values of widgets created by uiOutput/renderUIcan be accessed just like those of any other widget.
If this doesn't give you what you want, please provide more details.
library(shiny)
ui <-
fluidPage(
uiOutput("dataInput"),
textOutput("result")
)
server <- function(input, output, session) {
output$dataInput <- renderUI({
selectInput("beatles", "Who's your favourite Beatle?", choices=c("- Select one -"="", "John", "Paul", "George", "Ringo"))
})
output$result <- renderText({
req(input$beatles)
paste0("You chose ", input$beatles)
})
}
shinyApp(ui, server)

How to add Update (Refresh) Button to the app.R

I added the button but the values will automatically change before I hit "Update Order", I don't know how to fix it. Should be like this:enter image description hereBelow is my code:
library(shiny)
ui <- fluidPage(
titlePanel("My Simple App"),
sidebarLayout(
sidebarPanel(
helpText("Controls for my app"),
selectInput("fruitchoice",
label = "Choose a fruit",
choices = list("Apples",
"Oranges",
"Mangos",
"Pomegranate"),
selected = "Percent White"),
sliderInput("amt",
label = "Order Amount:",
min=0, max = 100, value=20),
actionButton ("Update","Update Order")
),
mainPanel(
helpText("Fruit Chosen:"),
verbatimTextOutput("fruit"),
helpText("Order Amount"),
verbatimTextOutput("amt")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
SelectInput <- eventReactive (input$Update , {
runif(input$fruitchoice,amt)
})
output$fruit = renderText(input$fruitchoice)
output$amt = renderText(input$amt)
}
# Run the application
shinyApp(ui = ui, server = server)
I will show you, how to rewrite your code to get this update behavior, however I would like to also get you know that this part of code:
SelectInput <- eventReactive (input$Update , {
runif(input$fruitchoice,amt)
})
Is wrong for three reasons: (1) object amt do not exists, you probably want input$amt; (2) even if you change amt to input$amt code won't work and you will get error; (3) now you are not using SelectInput in any place in your application, so there is no reason for this part to exists, however as I don't know what is your aim and how will look the final app, I'm not saying this is generally wrong.
Ok, so now about this update button. We will focus on this code:
output$fruit = renderText(input$fruitchoice)
output$amt = renderText(input$amt)
Here you instruct program to (re)render text when input$fruitchoice or (in second line) when input$amt change, but you want to (re)render text only when user clicks the button, so you need two things - first, be sure that user clicked the button and do not (re)render text when one of input$ changes. This will work:
output$fruit = renderText({
req(input$Update)
isolate(input$fruitchoice)
})
output$amt = renderText({
req(input$Update)
isolate(input$amt)
})
If I understand Shiny correctly, isolate() makes sure that text is not (re)rendering when input$ changes (however it has internally the new values) and req() makes sure that the input$Update was clicked; and when is clicked again, Shiny recomputes [(re)renders] text. It recomputes, because we didn't use isolate() on input$Update I think.
There's a few things wrong in your code. I will give a bit of explanation for each one:
You are initializing with reactive inputs. By using renderText(input$...) you create a text output that updates automatically when your input updates. Automatically is the problem here, you don't want that. We are going to write an alternative method that stores the inputs in a separate variable that we only allow to be updated when the button is pressed. We initialize that variable like so:
rv <- reactiveValues(fruit = "Apples",
amt = 20)
EventReactive creates a reactive variable that can later be used in the code. Generally speaking what you want to use in these kind of scenarios is observeEvent. You can do so like this:
observeEvent (input$Update , {
rv$fruit <- input$fruitchoice
rv$amt <- input$amt
})
We now have a list of variables under the name "rv" and an observeEvent that updates this variable every time the button gets pressed. All that is left to do is create the renderText which you can do like so:
output$fruit <- renderText(rv$fruit)
output$amt <- renderText(rv$amt)

R Shiny - loading icon while SQL query populates selectInput

I have seen using the shinycssloaders package how loading icons can be used in conjunction with outputs (i.e., plotOutput). I have a Shiny module similar to this pseduocode:
super_module_server <- function(id) {
moduleServer(
id,
function(input, output, sesion) {
data <- sql_query()
selected <- mod_selectInput_server(data)
})
}
In this code, sql_query() retrieves data from a remote database and returns it as a tibble. It is passed to mod_selectInput_server which uses that data to populate a standard selectInput.
Is there anyway to demonstrate to the user that the SQL query is running (like a spinning icon) rather than just leaving an empty dropdown list until the data populates?
Sure, we can add a spinning loading icon alongside our dropdown.
Find a small loading gif that you like and place it in your apps www folder.
The below minimal example shows how we can use shinyjs to show and hide our loading gif.
library(shiny)
library(shinyjs)
ui <- fluidPage(
#Allow our app to use shinyjs
useShinyjs(),
#Our dropdown
selectInput("mydropdown", "Dynamic Dropdown", choices = "Nothing Here Yet"),
#An action button to populate our dropdown, simulating a long running SQL query
actionButton("myactionbutton", "Populate Dropdown"),
#Our loading icon, made hidden by default
hidden(img(id = 'icon_loading', src = 'loading.gif'))
)
server <- function(input, output, session) {
#Runs when myactionbutton is clicked
observeEvent(input$myactionbutton, {
#Show our loading icon
shinyjs::show(id = 'icon_loading')
#Sleep for 5 seconds to simulate long running SQL query
Sys.sleep(5)
#Update dropdown
updateSelectInput(session, "mydropdown", choices = runif(5))
#Hide our loading icon
shinyjs::hide(id = 'icon_loading')
})
}
shinyApp(ui, server)

Shiny initial textAreaInput value and reactive after each button press

Description
I have a textAreaInput box that I want to start with a default value. The user can click 2 actionButtons (Submit & Random Comment). Submit updates the comment from the textAreaInput for further processing (plot, etc.) while Random Comment sends a new random value to textAreaInput (the user may type in the textAreaInput box as well). I almost have it but can't get the app to update textAreaInput's value until the Submit button is pressed.
Question
I want it to be updated when Random Comment is pressed but still allow the user to erase the text box and type their own text. How can I make the app do this?
MWE
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
output$randcomment <- renderUI({
commentUi()
})
comment_value <- reactiveValues(default = 0)
observeEvent(input$submit,{
comment_value$default <- input$randtext
})
renderText(input$randtext)
commentUi <- reactive({
if (comment_value$default == 0) {
com <- stri_rand_lipsum(1)
} else {
com <- stri_rand_lipsum(1)
}
textAreaInput("comment", label = h3("Enter Course Comment"),
value = com, height = '300px', width = '300px')
})
output$commenttext <- renderText({ input$comment })
}
)
I'd approach this a little bit differently. I would use reactiveValues to populate both of the fields, and then use two observeEvents to control the contents of the reactiveValues.
I don't think you need a reactive at all in this situation. reactive is good when you want immediate processing. If you want to maintain control over when the value is processed, use reactiveValues.
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
# Reactive lists -------------------------------------------------------
# setting the initial value of each to the same value.
initial_string <- stri_rand_lipsum(1)
comment_value <- reactiveValues(comment = initial_string,
submit = initial_string)
# Event observers ----------------------------------------------------
observeEvent(input$randtext,
{
comment_value$comment <- stri_rand_lipsum(1)
}
)
# This prevents the comment_value$submit from changing until the
# Submit button is clicked. It changes to the value of the input
# box, which is updated to a random value when the Random Comment
# button is clicked.
observeEvent(input$submit,
{
comment_value$submit <- input$comment
}
)
# Output Components -------------------------------------------------
# Generate the textAreaInput
output$randcomment <- renderUI({
textAreaInput("comment",
label = h3("Enter Course Comment"),
value = comment_value$comment,
height = '300px',
width = '300px')
})
# Generate the submitted text display
output$commenttext <-
renderText({
comment_value$submit
})
}
)
Some comments on your code
I struggled a little with determining what your code was doing. Part of the reason was that your server function was organized a bit chaotically. Your components are
output
reactive list
observer
output (but not assigned to a slot...superfluous)
reactive object
output
I'd recommend grouping your reactives together, your observers together, and your outputs together. If you have truly separate systems, you can break the systems into different sections of code, but have them follow a similar pattern (I would claim that these two boxes are part of the same system)
Your commentUi reactive has a strange if-else construction. It always sets com to a random string. What's more, the if-else construction isn't really necessary because no where in your code do you ever update comment_value$default--it is always 0. It looks like you may have been trying to base this off of an action button at some point, and then concluded (rightly) that that wasn't a great option.
Also, I would advise against building UI components in your reactive objects. You'll find your reactives are much more flexible and useful if they return values and then build any UI components within the render family of functions.

Resources