I have a question about updating a text output in a shiny app.
In an observer, I make several computations, and, between each of them, I want to show informations in a text output.
I tried several things, but the only thing it is showing is the last information :
library(shiny)
ui <- fluidPage(
headerPanel("Hello !"),
mainPanel(
actionButton("bouton", "Clic !"),
textOutput("texte")
)
)
server <- function(input,output, session){
observeEvent(input$bouton, {
output$texte = renderText("Initialization...")
Sys.sleep(1)
output$texte = renderText("Almost ready...")
Sys.sleep(3)
output$texte = renderText("Ok !")
})
}
runApp(list(ui=ui,server=server), launch.browser = TRUE)
Or :
library(shiny)
ui <- fluidPage(
headerPanel("Hello !"),
mainPanel(
actionButton("bouton", "Clic !"),
textOutput("texte")
)
)
server <- function(input,output, session){
rv = reactiveValues()
rv$mess = ""
observeEvent(input$bouton, {
rv$mess = "Initialization..."
Sys.sleep(1)
rv$mess = "Almost ready..."
Sys.sleep(3)
rv$mess = "Ok !"
})
observe({
output$texte <<- renderText(rv$mess)
})
}
runApp(list(ui=ui,server=server))
Edit : in these two examples, it shows nothing until the last message "OK !"
Where am I wrong ?
Thanks for your help !
Thanks to Eugene, this is my working piece of code (server only) :
server <- function(input,output, session){
rv = reactiveValues()
rv$mess = ""
observeEvent(input$bouton, {
withProgress({
setProgress(message = "Initialization...")
Sys.sleep(1)
setProgress(message = "Almost ready...")
Sys.sleep(3)
setProgress(message = "Ok !")
Sys.sleep(2)
})
})
}
You might consider achieving this with shiny's progress indicators by:
wrapping everything in your observer in withProgress, and
using setProgress( message = "some message" ) where you use rv$mess and output$texte
However, the progress indicator will show up in the top-right (or elsewhere if you modify the css) and not in your output box.
http://shiny.rstudio.com/articles/progress.html
Related
i am struggling with the logic of updating a button in the ui based on code that is living in a module. When I click the button i want it to change the colour but nothing happens. I understand to make ui input reactive in order to use it in the server module but i do not get it working the other way around. Help (and some explanation) is highly appreciated!
here is my code: (I left the save to csv part upon click as i got that to work).
library(shiny)
library(shinyBS)
module_company_ui<-function(id){
# `NS(id)` returns a namespace function, which was save as `ns` and will
# invoke later.
ns <- NS(id)
tagList(
radioButtons(ns("company_name"), label= "Is the << COMPANY NAME >> correct?",
c("choose from below" = "10",
"correct" = "0.15",
"correct, but some noise" = "0.075",
"not sure" = "0.05",
"wrong" = "0"),selected = character(0)),
textOutput(ns("txt")),
bsButton(ns('save_inputs'), " Save", type="action", block=TRUE, style="info", icon=icon(name="save"))
)
}
module_save_inputs<-function(id, value_company){
moduleServer(
id,
## Below is the module function
function(input, output, session) {
save<-reactive(input$save_inputs)
observeEvent(save(), {
updateButton(session, "save_inputs",label = " Save", block = T, style = "success", icon=icon(name="save"))
})
})
}
ui <- fluidPage(
module_company_ui("company")
)
server <- function(input, output, session) {
module_save_inputs("company")
}
shinyApp(ui, server)
You need namespace ns for the updateButton. Try this
module_save_inputs<-function(id, value_company){
moduleServer(
id,
## Below is the module function
function(input, output, session) {
ns <- session$ns
save<-reactive(input$save_inputs)
observeEvent(save(), {
updateButton(session, ns("save_inputs"),label = " Save", block = T, style = "success", icon=icon(name="save"))
})
})
}
The below code is working, but I need to enhance it by observing multiple inputs.
I need a multiple observeEvent on input$dateinput which selects the xlsx file to open and input$myfilter which checks if the user wants to apply a specific filter to the data.
but when I change
observeEvent(input$dateinput,... to:
observeEvent( c(input$dateinput, input$myfilter),{
The app crashes with Warning: Error in file: invalid 'description' argument [No stack trace available]
The code otherwise runs fine. Any help? thanks
full code : EDIT: THIS IS NOW REPRODUCIBLE AND DOES NOT REQUIRE ANY EXCEL FILE
library(shiny)
library(shinyWidgets)
library(openxlsx)
opendir <- function(dir = getwd()){
if (.Platform['OS.type'] == "windows"){
shell.exec(dir)
} else {
system(paste(Sys.getenv("R_BROWSER"), dir))
}
}
ui <- fluidPage(
sidebarPanel(
uiOutput("gpui")
),
mainPanel(
titlePanel("test app"),
br(),
checkboxInput("myfilter", label = "Filter all unnecessary (71, 46, 44) documents", value = TRUE),
br(),
tableOutput("datatable")
)
)
server <- function(input, output, session) {
rvalues <- reactiveValues()
rvalues$listfiles <- list.files(pattern=".xlsx")
observeEvent(input$refresh, {
print(input$dateinput)
session$reload()
})
observeEvent(input$openfolder, {
opendir()
})
output$gpui <- renderUI({
tagList(
actionButton("openfolder", "Open Data Folder"),
actionButton("refresh", "Refresh data folder"),
pickerInput("dateinput","Choose the date", choices=isolate(rvalues$listfiles), options = list(`actions-box` = TRUE),multiple = F)
)
})
observeEvent(input$myfilter,{
print("myfilter")
})
observeEvent( input$dateinput ,{
print(input$dateinput)
print("selecteddata")
cols <- c("Purchasing.Document", "Net.Order.Value", "Currency", "G/L.Account",
"Short.Text",
"Requisitioner", "Release.indicator", "Deletion.indicator")
seldata <- read.xlsx(input$dateinput)
print(nrow(seldata))
seldata <- seldata[,cols]
myfilter <- substr(seldata$Purchasing.Document,1,2) %in% c("71", "46", "44")
if(input$myfilter) {
rvalues$data <- seldata[myfilter,]
}
rvalues$data <- seldata
})
output$datatable <- renderTable(
rvalues$data,
striped = T,
spacing = 's'
)
}
shinyApp(ui, server)
For multiple observes in observeEvent() wrap them in curly brackets without commas, just as regular code.
Try:
shiny::observeEvent(
eventExpr = {
input$dataInput
input$myFilter
},
handlerExpr = {
# You code to run
}
)
In my experience it can be safer to wrap complex observeEvent expressions (handlerExpr) in isolate({}) to suppress any undesired reactivity.
When your observer reacts to input$myfilter, it is triggered at the startup. And input$dateinput is NULL. So you get this error:
> openxlsx::read.xlsx(NULL)
Error in file(description = xlsxFile) : argument 'description' incorrect
Here is an example. The progress bar just jumps from 0% to 100% due a single function getres(). How to indicate the progress smoothly?
library("shiny")
library("shinyWidgets")
library("DESeq2")
library("airway")
data(airway)
getres <- function(eset){
dds<-DESeqDataSet(eset, design = ~cell + dex)
keep <- rowSums(counts(dds)) >= 10
dds <- dds[keep,]
dds <- DESeq(dds)
res <- results(dds)
return(res)
}
ui <- fluidPage(
tags$h1("Progress bar in Sweet Alert"),
useSweetAlert(), # /!\ needed with 'progressSweetAlert'
actionButton(
inputId = "go",
label = "Launch long calculation !"
)
)
server <- function(input, output, session) {
observeEvent(input$go, {
progressSweetAlert(
session = session, id = "myprogress",
title = "Work in progress",
display_pct = TRUE, value = 0
)
for (i in seq_len(1)) {
Sys.sleep(0.1)
updateProgressBar(
session = session,
id = "myprogress",
res<-getres(airway),
value = i
)
}
closeSweetAlert(session = session)
sendSweetAlert(
session = session,
title =" Calculation completed !",
type = "success"
)
})
}
shinyApp(ui = ui, server = server)
I was unable to run your example as airway and DESeq2 are not available for R 3.6+. BUT there is an interesting package that I have been meaning to try out called waiter.
Within waiter there is waitress which will "let you display loading bars on the entire screen or specific elements only."
There is a great demo app where you play with the different functions.
Here is an example from the docs!
library(shiny)
library(waiter)
ui <- navbarPage(
"Waitress on nav",
tabPanel(
"home",
use_waitress(),
plotOutput("plot")
)
)
server <- function(input, output){
# now waitress ranges from 0 to 100
waitress <- Waitress$new("nav", theme = "overlay", min = 0, max = 10)
output$plot <- renderPlot({
for(i in 1:10){
waitress$inc(1) # increase by 10%
Sys.sleep(.5)
}
hist(runif(100))
waitress$close() # hide when done
})
}
shinyApp(ui, server)
Hope this helps or gives you other ideas!
ran into this weird issue when teaching a student about shiny programming.
What i wanted was to make code that deletes the verbatimtextOuput element, rather than print an empty value
This is the code he wrote, but it deletes all buttons, the whole UI basically. Can this be done? I know more complex options like conditional panels etc, but just trying to figure out why removeUI doesn't do what I expected here.
Thanks!
app:
library(shiny)
ui<-fluidPage( h5("Hello there"), #First text on the window
br(), #empty line
actionButton(inputId = "ClickonMe", label = "Make data"), # button 1
actionButton(inputId = "ClickonMe2", label = "Print data"), # button 2
actionButton(inputId = "ClickonMe3", label = "Transform data"),
verbatimTextOutput("Response_text") #reactive text output )
server <- function(input,output) {
values <- reactiveValues()
observeEvent(input$ClickonMe,
values$name <- TRUE )
observeEvent(input$ClickonMe3,
if (values$name == TRUE) { values$name <- FALSE}
else { values$name <- TRUE} )
observeEvent(input$ClickonMe2,
if (values$name == TRUE) { output$Response_text <- renderPrint( isolate({values$name}) ) }
else if (values$name == FALSE) { removeUI(
selector = "div:has(> #Response_text)"
)
}
) }
shinyApp(ui, server)
EDIT VERSION:
changed pork chops answer a little so that this version removes and remakes the verbatim element in the ui.
What i now try to fully understand is, is why the piece req(....) has such an impact. the print(values$name) proofs that the variable exist, and the observer sees it, yet if you # the req( ) line, suddenly the app stops recreating the verbatimtextouput after it has been removed the first time.
Hope I can learn why this is the case. Thank you!
library(shiny)
ui <- fluidPage(
h5("Hello there"), # First text on the window
br(), # empty line
actionButton(inputId = "ClickonMe", label = "Make data"), # button 1
actionButton(inputId = "ClickonMe2", label = "Print data"), # button 2
actionButton(inputId = "ClickonMe3", label = "Transform data"),
mainPanel(verbatimTextOutput("Response_text"))
)
server <- function(input,output,session) {
values <- reactiveValues()
values$name <- T
observeEvent(input$ClickonMe,{
values$name <- T
})
observeEvent(input$ClickonMe3,{
if (values$name){ values$name <- F}
else{ values$name <- T }
})
observeEvent(input$ClickonMe2,{
print(values$name)
output$Response_text <- renderPrint({ isolate({
req(values$name)
if(!values$name){
removeUI(
selector = "div:has(> #Response_text)"
)
}else {
as.character(values$name)}
})
})
})
}
1) First of all please have a look at the Google's R Style Guide when writing code and try to stick to it I think both you and your students will benefit from it.
2) Use curly braces too when using functions such as observeEvent and renderPrint
3) Familiarise yourself with req function which is very handy
Sample Code how to remove UI:
library(shiny)
ui <- fluidPage(
h5("Hello there"), # First text on the window
br(), # empty line
actionButton(inputId = "ClickonMe", label = "Make data"), # button 1
actionButton(inputId = "ClickonMe2", label = "Print data"), # button 2
actionButton(inputId = "ClickonMe3", label = "Transform data"),
mainPanel(verbatimTextOutput("Response_text"))
)
server <- function(input,output,session) {
values <- reactiveValues()
values$name <- NULL
observeEvent(input$ClickonMe,{
values$name <- T
})
observeEvent(input$ClickonMe3,{
if (values$name){
values$name <- F}
else{
values$name <- T
}
})
observeEvent(input$ClickonMe2,{
if (values$name){
values$name <- F
}
else{
values$name <- T
}
})
output$Response_text <- renderPrint({
req(values$name)
if(!values$name){
removeUI(
selector = "div:has(> #Response_text)"
)
}
as.character(values$name)})
}
shinyApp(ui, server)
EDIT: My original question asked about checkboxInput(), but I've updated to checkboxGroupInput() to better reflect my problem...
I am trying to get my Shiny app to do one of two things based on the (un)checked status of a checkboxGroupInput.
When the boxes are checked, I can get my code to work. However, I can't figure out how to make unchecking all boxes lead to a unique result.
How do I do this?
This google groups question asked this 4+ years ago, but the response then was that this is simply a bug. I'm assuming this has been addressed since??
Below is a reproducible example.
- In this example, unchecking the box leads to an error reading "Error in if: argument is of length zero."
library(shiny)
ui <- fluidPage(
checkboxGroupInput(inputId = "test.check", label = "", choices = "Uncheck For 2", selected = "Uncheck For 2"),
verbatimTextOutput(outputId = "test")
)
server <- function(input, output) {
output$test <- renderPrint({
if(input$test.check == "Uncheck For 2") {
1
} else {
2
}
})
}
shinyApp(ui = ui, server = server)
Is there perhaps an "if.unchecked" type of function I can use?
I've tried is.null after the else statement with the same result as the above example....
Here's code that works:
library(shiny)
ui <- fluidPage(
checkboxGroupInput(inputId="test.check", label="", choices="Uncheck For 2", selected="Uncheck For 2"),
verbatimTextOutput(outputId = "test")
)
server <- function(input, output) {
output$test <- renderPrint({
if(!is.null(input$test.check)) {
1
} else{
2
}
})
}
shinyApp(ui = ui, server = server)