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
Related
In my shiny server I am figuring out the name of a markdown file which I want to show in the UI. I know how to pass the file name, as a string, back to the UI but I don't now how to tell includeMarkdown() to treat the string as a file name.
My code so far is below. Any advice?
library(shiny)
fileConn<-file("hello.md")
writeLines(c("# Hello","# World"), fileConn)
close(fileConn)
ui <- fluidPage(
includeMarkdown("hello.md"),
br(),
div("File name text:", textOutput("fileNameText", inline = TRUE)),
#includeMarkdown(fileNameText) # this needs help
)
server <- function(input, output, session) {
selectedName <- reactive({
paste0("hello.md") # this is actually more complicated...
})
output$fileNameText <- renderText(
paste0(selectedName())
)
}
shinyApp(ui = ui, server = server)
Your example code works fine, but from your description, I am thinking your asking how to pass a different filename to includeMarkdown() that was created somewhere else in the app, correct?
The first step is to understand includeMarkdown() as a UI element that will change depending on other UI elements (and stuff that happens in server). The solution is to use a placeholder in the ui to hold the place for the includeMarkdown() element, and create that particular element in server using renderUI.
Hopefully you can follow this example. I'm using uiOutput('displayFile') to hold the place for the element that's created in server.
library(shiny)
fileConn<-file("hello.md")
writeLines(c("# Hello","# World"), fileConn)
close(fileConn)
fileConn1<-file("goodbye.md")
writeLines(c("# Goodbye","# Everyone!"), fileConn1)
close(fileConn1)
ui <- fluidPage(
selectInput('file_selection', 'Choose Markdown File:', choices=c('hello.md','goodbye.md')),
uiOutput('displayFile')
)
server <- function(input, output, session) {
output$displayFile <- renderUI({
includeMarkdown(input$file_selection)
})
}
shinyApp(ui = ui, server = server)
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)
I am having a lot of trouble getting a search filtering module working.
I am to run stats on a large database of cat owner information.
I want my search module to bring up a list of possible owners(that the user can select from) based on a selection from a list of cat breeds.
I thought wrapping the updateSelectInput with observe and using a reactive cat owner expression would facilitate this, in the module, but it is not working( and I can't guess why this is happening or how to debug this). It worked in these other posts([1]:R shiny passing reactive to selectInput choices , [2]:using values from a reactive input to directly input into a custom function)
Why won't my selectInput update with cat owners?
library(shiny)
df=data.frame(
cat=c("tabby","DSH","MSH","LSH","DSH","MSH","LSH","sphinx"),
owner=c("Foo","Bar","Bash","Foo","Foo","Foo","Bar","Bash"),stringsAsFactors = F)
refinedSearch<-function(input, output, session){
ownsCat<-reactive({df[df$cat%in%input$cat,"owner"]})
observe({updateSelectInput(session, "ownerSelected",
label ="Owned By",choices = ownsCat())})
return()
}
refinedSearchUI<-function(id){
ns <- NS(id)
fluidRow(
column(4,selectInput(ns("cat"),"Cat",selectize = T,
choices =c("tabby","DSH","MSH","LSH","sphinx") )),
column(4,selectInput(ns("ownerSelected"),"Owned By","",selectize = T))
)
}
ui <- fluidPage(
h1("Find cats owners"),
fluidRow(column(10,offset=1, refinedSearchUI("tmp"))),
fluidRow(column(10,offset=1, actionButton("addFilter","Add a Filter",
icon = icon("plus"))))
)
server <- function(input, output,session) {
refinedSearch(input,output,session)
observeEvent(input$add, {insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearch(input,output,session))})
}
shinyApp(ui = ui, server = server)
Thank y'all for you time.
There seems to be quite a bit of confusion on how to call modules. You need to use the callModule() function in the server. Also, when inserting UI (using the insertUI()function), you need to call the refinedSearchUI() function, not the refinedSearch() function (which, again, should always be called through callModule(), so it should never actually get called directly like that).
I'd recommend a re-reading of the modules article.
You also have a typo. The event in your observeEvent() function should be input$addFilter, not input$add (which doesn't exist, so that observer is never fired..)
If you change your server function to this, your app will work as expected:
server <- function(input, output,session) {
callModule(refinedSearch, "tmp")
observeEvent(input$addFilter, {
id <- paste0("filter_", input$add)
insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearchUI(id))
callModule(refinedSearch, id)
})
}
I am new to shiny, and may be asking basic question.
I have a dataset in local machine as of now, which has store numbers and the items it sells along with other data.
What I wish is an app that will select one store number, list all the items in that store, and then based on selection of the item show all data for that store and item.
Please find the code below
ui.R
library(shiny)
df<-read.csv("C:/Users/adey1/Office Projects/NGSC_Shiny/Ensembler App/Trial Started on 05-06-2015//example1.csv")
category<-unique(df$item_nbr)
store<-unique(df$store_nbr)
sidebarPanel(
selectInput(inputId = "Store",
label = "Store",
store),
uiOutput("items"),
mainPanel(textOutput('values'))
)
server.R
shinyServer(function(input, output) {
output$items<-renderUI({
item_list<-unique(df$item_nbr[which(df$store_nbr==input$Store)])
radioButtons("item1", "Select Item", item_list)
})
output$value<-renderTable(
subset(df,store_nbr==input$store & item_nbr==as.integer(input$item1))
)
})
Can you suggest what is wrong, and what needs to be done?
I found this changes on server side works:-
server.R
shinyServer(function(input, output) {
output$items<-renderUI({
item_list<-unique(df$item_nbr[which(df$store_nbr==input$Store)])
radioButtons("item1", "Select Item", item_list)
})
dataset=reactive({
y=which(df$store_nbr==input$Store & df$item_nbr==input$item1)
df1=as.data.frame(cbind(df$date[y],df$item_nbr[y],df$units[y],df$store_nbr[y]))
names(df1)=names(df)
df1
})
output$value<-renderTable(
dataset()
)
})
But this is very crude. Can someone get me easier solution?
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 ","