I want to show a cssloader spinner while some processing is done. The cssloader must be shown only after an actionButton is clicked, which triggers the processing of data (this step requires some time, simulated by the sys.Sleep() function in the example below). Also, I want it to show everytime this action is triggered by the actionButton, not only the first time.
Here is an example of what I'm trying:
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("CSS loader test"),
sidebarLayout(
sidebarPanel(
selectInput("imageOptions", "Choose an image:", choices = list(option1="RStudio-Logo-Blue-Gradient.png", option2="RStudio-Logo-All-Gray.png")),
actionButton("getImage", "Show image:")
),
mainPanel(
withSpinner(uiOutput("logo"))
)
)
)
server <- function(input, output) {
url<-reactive(
paste0("https://www.rstudio.com/wp-content/uploads/2014/07/", input$imageOptions)
)
observeEvent(input$getImage,{
output$logo<-renderText({
URL<-isolate(url())
print(URL)
Sys.sleep(2)
c('<center><img src="', URL, '"width="50%" height="50%" align="middle"></center>')
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
I bet there are better ways to acomplish what I needed but here is a solution:
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("CSS loader test"),
sidebarLayout(
sidebarPanel(
selectInput("imageOptions", "Choose an image:", choices = list(option1="RStudio-Logo-Blue-Gradient.png", option2="RStudio-Logo-All-Gray.png")),
actionButton("getImage", "Show image:")
),
mainPanel(
withSpinner(uiOutput("logo"))
)
)
)
server <- function(input, output) {
url<-reactive(
paste0("https://www.rstudio.com/wp-content/uploads/2014/07/", input$imageOptions)
)
output$logo<-renderText({
validate(need(input$getImage, "")) #I'm sending an empty string as message.
input$getImage
URL<-isolate(url())
print(URL)
Sys.sleep(2)
c('<center><img src="', URL, '"width="50%" height="50%" align="middle"></center>')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Instead of getting the reactivity with a call to observeEvent the working solution is to use a call to validate(need(input$getImage, "")) inside a render function.
Related
I am trying to access the last clicked checkbox or button id from inside a Shiny module.
I have found the great response from this post helpful: R shiny - last clicked button id and have adapted the code to my question. I also took a hint from this post: https://github.com/datastorm-open/visNetwork/issues/241 but still can't get it working.
user_inputUI <- function(id){
# Create a namespace function using the provided id
ns <- NS(id)
tagList(
tags$head(tags$script(HTML("$(document).on('click', '.needed', function () {
Shiny.onInputChange('", ns("last_btn"), "', this.id);
});"))),
tags$span(HTML('<div><input id="first" type="checkbox" class="needed"></div>')),
actionButton(ns("second"), "Second",class="needed"),
actionButton(ns("third"), "Third",class="needed"),
actionButton(ns("save"), "save"),
selectInput(ns("which_"),"which_",c("first","second","third"))
)
}
update_options <- function(input, output, session) {
observeEvent(input$save,{
updateSelectInput(session,"which_",selected = input$last_btn)
})
return(reactive(input$last_btn))
}
ui <- shinyUI(fluidPage(
titlePanel("Track last clicked Action button"),
sidebarLayout(
sidebarPanel(
user_inputUI("link_id")
),
mainPanel(
textOutput("lastButtonCliked")
)
)
))
server <- shinyServer(function(input, output,session) {
last_id <- callModule(update_options, "link_id")
output$lastButtonCliked=renderText({last_id()})
})
# Run the application
shinyApp(ui = ui, server = server)
I would expect the input$last_btn value (the id name of the last button clicked) to be created and returned at the bottom of the app as well as becoming the updated input in the selectize. However, the input$last_btn is not being created, I have checked this using the debugging browser() as well.
You were almost there, but there were some minor formatting issues. The updated code is listed below.
You mainly misused HTML (I changed it to JS but thats not the problem) in the way that you just comma separated the ns("last_btn"). If you had inspected the output of your original HTML(...) statement, you would have seen that the resulting JavaScript string was
Shiny.onInputChange(' link_id-last_btn ', this.id);
And I mean the spaces around the input id. Because of the extra spaces, the input was not properly mapped on input$last_btn. I used paste0 in my example to correctly glue the strings together.
Second, there are some missing ns calls which I corrected, but that you would for sure have found out yourself once the input blocker was gone.
user_inputUI <- function(id){
# Create a namespace function using the provided id
ns <- NS(id)
tagList(
tags$head(
tags$script(
JS(paste0("$(document).on('click', '.needed', function () {debugger;
Shiny.onInputChange('", ns("last_btn"), "', this.id);
});"))
)
),
tags$span(HTML(paste0('<div><input id="', ns("first"), '" type="checkbox" class="needed"></div>'))),
actionButton(ns("second"), "Second", class="needed"),
actionButton(ns("third"), "Third", class="needed"),
actionButton(ns("save"), "save"),
selectInput(ns("which_"), "which_", c(ns("first"), ns("second"), ns("third")))
)
}
update_options <- function(input, output, session) {
observeEvent(input$last_btn, {
print(input$last_btn)
})
observeEvent(input$save, {
updateSelectInput(session, "which_", selected = input$last_btn)
})
return(reactive(input$last_btn))
}
ui <- shinyUI(fluidPage(
titlePanel("Track last clicked Action button"),
sidebarLayout(
sidebarPanel(
user_inputUI("link_id")
),
mainPanel(
textOutput("lastButtonCliked")
)
)
))
server <- shinyServer(function(input, output,session) {
last_id <- callModule(update_options, "link_id")
output$lastButtonCliked=renderText({last_id()})
})
# Run the application
shinyApp(ui = ui, server = server)
I have this app:
library(shiny)
ui <- fluidPage(
textInput("query_text","Type something:"),
actionButton(inputId='query_button',
label="Search",
icon = icon("th"),
onclick = paste("location.href='http://www.example.com?lookfor=",
input$query_text, "'", sep=""))
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I'd like to update the url with the action button, so when the user types something (for example: paper), it updates the url like this:
http://www.example.com/?lookfor=paper
Any ideias how to do it? Maybe wrapping it on a observeEvent?
Based on your replies to my comment, what you're looking for is the updateQueryString function.
library(shiny)
ui <- fluidPage(
textInput("query_text", "Type something:"),
actionButton(inputId = 'query_button', label = "Search")
)
server <- function(input, output, session) {
observeEvent(input$query_button, {
updateQueryString(paste0("?lookfor=", input$query_text))
})
}
shinyApp(ui, server)
I have this shiny app and its logic is very clear.Whenever i press the Hit button it prints 1000 hi.The problem is that if I go and close the app window while it is printing it crashes.How can i solve it?
ui <- fluidPage(
titlePanel("Data"),
sidebarLayout(
sidebarPanel(
actionButton("h","hit")
),
mainPanel()
)
)
server <- function(input, output) {
observeEvent(input$h,{
for(i in 1:1000){
print("hi")
)
})
}
shinyApp(ui = ui, server = server)
Does it do the trick for you?
tryCatch({shinyApp(ui = ui, server = server)})
I'm trying to use the relatively new shinyAlert package to see if it offers better results than the sweetalert package but I'm unable to figure out how to get this:
Myvar <- shinyalert input text
from this minimal example.
library(shiny)
library(shinyjs)
library(shinyalert)
ui <- fluidPage(
shinyjs::useShinyjs(),
useShinyalert(),
actionButton("run", "Run", class = "btn-success")
)
server <- function(input, output, session) {
shinyEnv <- environment()
observeEvent(input$run, {
shinyalert('hello', type='input')
})
}
shinyApp(ui = ui, server = server)
My thanks for any help from you geniouses out there.
Here is how you do it:
library(shiny)
library(shinyalert)
ui <- fluidPage(
useShinyalert(),
actionButton("run", "Run", class = "btn-success")
)
server <- function(input, output, session) {
observeEvent(input$run, {
shinyalert('hello', type='input', callbackR = mycallback)
})
mycallback <- function(value) {
cat(value)
}
}
shinyApp(ui = ui, server = server)
It's done using callbacks. You can assign the value to a reactive variable if you'd like.
I had fully documented the package last month and was about to release it, and then my computer crashed before I had a chance to push to github, and lost all progress. I haven't had a chance to work on it again. So sorry that the documentation isn't great yet, the package is still un-released so use at your own risk for now :)
(Notice that you don't need shinyjs for this)
I have no experience with the package shinyalert, but you can achieve what you want with the widely used and well documented modal dialogs from shiny. Maybe you there is a reason for you to stick with shinyalert that I am unaware off, but if not, example code for achieving what you want with modal dialogs:
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("run", "Run", class = "btn-success"),
textOutput("output1")
)
server <- function(input, output, session) {
dataModal <- function(failed = FALSE) {
modalDialog(
textInput("input1", "Enter text:",
placeholder = 'Enter text here'
)
)
}
# Show modal when button is clicked.
observeEvent(input$run, {
showModal(dataModal())
})
output$output1 <- renderText({
input$input1
})
}
shinyApp(ui = ui, server = server)
Let me know if this helps!
I have a Shiny apps directory that looks like this:
-- ShinyApps
|
|_ base_app
|_ my_sub_app
And in base_app I have the following code:
# app.R
#-----------
# Server Section
#-----------
server <- function(input, output) { }
#-----------
# UI section
#-----------
ui <- fixedPage(
h1("My head"),
br(),
br(),
fluidRow(
column(6,
wellPanel(
h3("AMAZON"),
hr(),
a("Go", class = "btn btn-primary btn-md",
href = "http://www.amazon.com")
)),
column(6,
wellPanel(
h3("My Sub App"),
hr(),
a("Go", class = "btn btn-primary btn-md")
# What should I do here to include My_SUB_APP
))
)
)
shinyApp(ui = ui, server = server)
Which looks like this:
What I want to do, is when click on Go button under My SubApp panel, it
will launch sub_app() How can I do it?
I don't want to pass URL (e.g. via href)
Okay, after further analysis this is technically possible.
(But a link solution with href is almost certainly better, the issue is that Shiny Server, or RStudio Connect, or whatever product you are using to host the app needs to have the app loaded already in order to access it, so why not just link to where it's hosting it?)
This solution does not have the obvious "load this directory" workflow and involves specifically loading server.R and ui.R files
In order to overwrite the current UI and server, you need to literally overwrite the ui and server.
Overwriting the ui is easy, you just render the entire thing on the server side from the beginning, and then swap the ui when they decide to press the button.
Overwriting the server is a matter of evaluating the server function of the subAPP, (Which may absolutely have namespace collisions, but for a simple app maybe it's possible)
Here's an example of a way to do it.
app.R file:
#-----------
# UI section
#-----------
ui1 <- fixedPage(
h1("My head"),
br(),
br(),
fluidRow(
column(6,
wellPanel(
h3("AMAZON"),
hr(),
a("Go", class = "btn btn-primary btn-md",
href = "http://www.amazon.com")
)),
column(6,
wellPanel(
h3("My Sub App"),
hr(),
a("Go",
# Link button to input$SubApp1
id = 'SubApp1',
class = "btn btn-primary btn-md action-button")
))
)
)
appUI <- parse(file = 'subdir/ui.R')
appServer <- eval(parse(file = 'subdir/server.R'))
#-----------
# Server Section
#-----------
server <- function(input, output, session) {
output[['fullPage']] <- renderUI({
if(!is.null(input$SubApp1) && input$SubApp1 > 0) {
# If they pressed the button once,
# run the appServer function and evaluate the parsed appUI code
appServer(input, output, session)
eval(appUI)
} else {
#
ui1
}
})
}
ui <- uiOutput('fullPage')
shinyApp(ui = ui, server = server)
subdir/ui.R (Example) :
page <-
navbarPage("X-men",id = "navibar",
tabPanel("placeholder"),
tabPanel("Plot",value = "plot"),
selected = "plot"
)
page[[3]][[1]]$children[[1]]$children[[2]]$children[[1]] <-
tags$li(tags$a(
href = 'http://google.com',
icon("home", lib = "glyphicon")
)
)
page
subdir/server.R (Example) :
function(input, output, session) {
}