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)
Related
I have a Shiny app that wrangles a large csv file. Currently the user can select a facility_id number from a drop down menu to get a specific plot, see https://r.timetochange.today/shiny/Annual_Emissions2/. I would like to pass this id with a URL parameter like /?selected_facilities=1010040 so I can embed the plots in another website.
I have taken the code from How do you pass parameters to a shiny app via URL and tried to use it to update my selectInput() value in the server section of the Shiny app, but I don't really understand how the UI part is constructed so I am not getting it right. Any help would really be appreciated! Here is the relevant code:
#### shiny UI ####
facilities <- unique(ghg_emissions$facility_id)
ui <- fluidPage(
titlePanel("Annual Greenhouse Gas Emissions"),
sidebarLayout(
sidebarPanel(
selectInput("selected_facility",
"Select facility",
choices = facilities) # select input gives the drop down menu to select facilities
),
mainPanel(
plotlyOutput("facility_plot")
)
)
)
#### shiny server ####
server <- function(input, output, session) {
# Here you read the URL parameter from session$clientData$url_search
observe({
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query[['selected_facility']])) {
updateSelectInput(session, "selected_facility", value = query[['selected_facility']])
}
})
Your UI is good, the issue with the updateSelectInput, use selected rather than value and include choices.
Minimal working example:
library(shiny)
facilities <- seq(1:5)
ui <- fluidPage(
selectInput("selected_facility", "Select facility", choices = facilities)
)
server <- function(input, output, session) {
observe({
#Get URL query
query <- parseQueryString(session$clientData$url_search)
#Ignore if the URL query is null
if (!is.null(query[['selected_facility']])) {
#Update the select input
updateSelectInput(session, "selected_facility", selected = query[['selected_facility']], choices = facilities)
}
})
}
shinyApp(ui, server)
To test, run your shiny app, click 'Open in Browser' and append your query to the URL, e.g.
127.0.0.1:6054/?selected_facility=4
I have a simple shiny app where the user should input comma-separated values into a text input, chose the output and click on a button to convert to an output.
I have followed the advice in Update content on server only after I click action button in Shiny to change the output only when clicking, and it works.
However, only when starting/ opening the app the first time, the field is empty, yet the output seems to try to evaluate the input field.
It is more of a cosmetic problem, because once the user filled something in, this does not recur, but I wonder how I could avoid this...
My app:
library(shiny)
ui <- fluidPage(
textInput("from", "csv", value = NULL),
actionButton("run", "Run"),
textOutput("to")
)
server <- function(input, output, session) {
list1 <- reactive({
input$run
x <- isolate(paste(read.table(text = input$from, sep = ",")))
x
})
output$to <- renderText({
list1()
})
}
shinyApp(ui = ui, server = server)
The not-desired output - I would like to get rid of the errors.
you can use req(input$from), see Check for required values
In my shiny app I have several tabs as follows.
I have little complex functions running in this app. I think all the observe functions in the server function run when anything is done in any tab. So I need to run only relevant observe functions for relevant tab. As an example, when I am in Summary tab only the relevant observe function should run and all the other observe functions should not run. I have a code.
server <- function(input, output) {
summary <- observe({....})
occupancy<- observe({....})
Bookings<- observe({....})
Maps<- observe({....})
}
Is there any modification to the above code to run only the relevant observe function related to the tab opened in the app.?
Some approaches come to mind. But first; what do you want to do in your observers? If you are simply creating output to display to the user, don't forget to use reactive elements. They will automatically invalidate only when their output is used to display something to the user. Thus if reactive X uses input Y used to construct output for tab A, and input Y changes while we are looking at tab B, reactive X will not invalidate.
If you are using your observers to only create side-effects, such as updating inputs or showing modalDialogs, you could:
use observeEvent instead of observe to only listen to changes in a certain input or condition.
use isolate to make isolate certain dependencies.
build an if-statement in your observer, that checks which tab is selected. You can do that by giving your sidebarMenu an id (my_sidebarmenu in the example below), and check which tab is selected inside your observer by calling input$my_sidebarmenu.
Some examples given below, how this helps~
#UI.R
#loading shiny library
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id='my_sidebarmenu',
menuItem('Tab 1', tabName='tab1'),
menuItem('Tab 2', tabName='tab2'),
actionButton(inputId = 'btn','Press me!')
)
),
dashboardBody(
tabItems(
tabItem('tab1',
p('Tab 1'),
actionButton('btn_tab1','Show message!')),
tabItem('tab2',
p('Tab 2'),
actionButton('btn_tab2','Show message!'))
)
)
)
server <- function(input, output,session)
{
observeEvent(input$btn,
{
if(input$my_sidebarmenu=='tab1')
{
updateTabItems(session,'my_sidebarmenu',selected='tab2')
}
if(input$my_sidebarmenu=='tab2')
{
updateTabItems(session,'my_sidebarmenu',selected='tab1')
}
})
observeEvent(input$btn_tab1,
{
showModal(modalDialog(
title = "One.",
"You are viewing tab 1!",
easyClose = TRUE,
footer = NULL
))
})
observeEvent(input$btn_tab2,
{
showModal(modalDialog(
title = "Two.",
"You are viewing tab 2!",
easyClose = TRUE,
footer = NULL
))
})
}
shinyApp(ui,server)
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)
I have begun to create a web app using shiny where a user enters a search term and tweets containing that term are returned.
When I load this app the searchTwitter function begins automatically and on the main panel there is the error: Error: You must enter a query.
The search term is entered in the textInput box and there is a submitButton. You can enter a term and it works fine but I don't want the error to be the first thing the user sees.
ui.R:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Twitter Generator"),
sidebarPanel(
textInput("search", "Search Twitter For:", value = ""),
submitButton("Search")
),
mainPanel(
h3(textOutput("search")),
tableOutput("view"),
)
))
server.R:
library(shiny)
library(twitteR)
shinyServer(function(input, output) {
datasetInput <- reactive(function(){
rawTweets <- twListToDF(searchTwitter(paste(input$search)))
rawTweets$cleanText <- as.vector(sapply(rawTweets$text, CleanTweet))
rawTweets[, colnames(rawTweets) != "created"]
})
output$search <- reactiveText(function() {
input$search
})
output$view <- reactiveTable(function() {
head(datasetInput())
})
})
Thanks for your help
This is a logical request for and from your application design, and you should think through how to do it.
One easy way would be to add a tickbutton providing a true/false and to skip the actual twitter search if the value is FALSE. You may need to cache the previous value of rawTweets, or set it to NULL, or ...
mainPanel(
h3(textOutput("search")),
tableOutput("view")
)
try it without the second ","