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!
Related
My Shiny application runs a script build.R when the user clicks the action button. I would like to inform the user not to close the app while the script is being run. When done, the user is informed that building was successful.
Here's my minimal reproducible code:
library(shiny)
ui <- fluidPage(
actionButton("build", "run the buildscript"),
textOutput("rstatus")
)
server <- function(input, output, session) {
reloadstatus <- reactiveVal("")
observeEvent(input$build, {
reloadstatus("building, do not close the app")
# in the actual app would be source("build.R")
Sys.sleep(1)
reloadstatus("successfully built")
})
output$rstatus <- renderText({
reloadstatus()
})
}
shinyApp(ui, server)
I guess it does not work because Shiny tries to first run the observeEvent till the end before altering the reactiveVal. How can I achieve my desired output (first "reloading..." second "successfully...")?
You can use shinyjs to update the content of message.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("build", "run the buildscript"),
p(id = "rstatus", "")
)
server <- function(input, output, session) {
observeEvent(input$build, {
shinyjs::html("rstatus", "building, do not close the app")
# in the actual app would be source("build.R")
Sys.sleep(1)
shinyjs::html("rstatus", "successfully built")
})
}
shinyApp(ui, server)
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 am making an app with drag and drop feature using the ShinyDND package. I would like to pass a list from input as a parameter of dragSetUI, a function that needs to be run in ui.R. I tried renderUI and uiOutput, and it almost works, but the dragged elements fail to be dropped in the drop area. As you can see in the example below, nonreactive choices work like charm. I tried creating a reactive object as well as text output, but I could not find documentation on how to refer to these objects in ui.R. Normally one would refer to output$x as "x" in Output, but here, if I add anything between quotes, it reads as string. I am really stuck with this.
library(shiny)
library(shinyDND)
nonreactive_choices<-as.list(c("a","b","c"))
ui <- shinyUI(
mainPanel(
textInput("choices","Put here a,b,c:"),
dragSetUI("drag", textval = "reactive_choices"),
dragSetUI("drag", textval = "choice_rv"),
textOutput("reactive_choices"),
dragSetUI("drag", textval = nonreactive_choices),
dropUI("drop")
)
)
server = shinyServer(function(input, output,session) {
output$reactive_choices<-reactive({
strsplit(input$choices,",")
})
observe({
chlist<-strsplit(input$choices,",")
choice_rv<-reactiveVal(chlist)
})
})
# Run the application
shinyApp(ui = ui, server = server)
Let's see why the renderUI approach does not work with shinyDND. An app using shinyDND is linked to the dragndrop.js file, which is in the shinyDND folder. In this file one can see:
$(document).ready(function(){
......
$(".dragelement").on("dragstart",function(e){
e.originalEvent.dataTransfer.setData("Text",e.target.id);
});
......
});
This defines the action to perform on elements having class dragelement when a drag is starting, and this is defined when the document is ready. dragSetUI creates such elements.
When you use a dragSetUI inside a renderUI, this creates new elements of class dragelement. But the action defined on such elements in $(document).ready is not effective for these new elements, because this action has been defined just after the document is ready, and then before the effect of renderUI.
A solution consists in defining the action of the event dragstart inside the renderUI. This works:
library(shiny)
library(shinyDND)
nonreactive_choices<-as.list(c("a","b","c"))
ui <- shinyUI(
mainPanel(
textInput("choices","Put here d,e,f:"),
dragSetUI("drag", textval = nonreactive_choices),
uiOutput("dragset"),
dropUI("drop")
)
)
server = shinyServer(function(input, output,session) {
reactive_choices <- reactive({
strsplit(input$choices,",")[[1]]
})
output$dragset <- renderUI({
tagList(
dragSetUI("drag2", textval = as.list(reactive_choices())),
tags$script('$(".dragelement").on("dragstart",function(e){
e.originalEvent.dataTransfer.setData("Text",e.target.id);
});'
)
)
})
})
# Run the application
shinyApp(ui = ui, server = server)
Comment by #ismirsehregal helped me find the solution: shinyjqui can be used for my purposes and it seems to work from inside renderUI. Here is the edited code that does exactly what I needed.
library(shiny)
library(shinyjqui)
ui <- fluidPage(
textInput("choices","Put here a,b,c:"),
uiOutput("reactiveselect"),
orderInput(inputId = 'drop', label = 'Reactive drop', items = NULL,placeholder = "drop here..."),
verbatimTextOutput("droppedorder")
)
server <- function(input, output) {
output$reactiveselect <- renderUI({
req(input$choices)
reactiveitems<- unlist(strsplit(input$choices,","))
orderInput("groupstochoose", "groups to choose from:", connect='drop',items=reactiveitems)
})
output$droppedorder<-
renderPrint({input$drop_order})
}
shinyApp(ui, server)
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.