I want Shiny to wait a little bit for the user to input their group size (without using a button). This is a simpler version of my code, but in my actual code, I have more user inputs (so I only want Shiny to wait 2 seconds for this input only). I've been trying to figure out how I would use debounce for this code, but I'm not sure.
library(shiny)
shinyApp(ui <- fluidPage(sidebarPanel(
"",
numericInput("groupSize", label =
"How many people will be with you?", value = ""),
textOutput("output")
)) ,
server <- function(input, output, session) {
getNumber <- reactive({
req(input$groupSize>=0)
groupSize <- input$groupSize
})
output$output <- renderText({
getNumber()
})
})
This works with debounce:
create a reactive input function groupsize
pass this function to debounce to create a new function groupsize_d
use this new function for rendering
library(shiny)
shinyApp(ui <- fluidPage(sidebarPanel(
"",
numericInput("groupSize", label =
"How many people will be with you?", value = ""),
textOutput("output")
)) ,
server <- function(input, output, session) {
groupsize <- reactive(input$groupSize)
groupsize_d <- debounce(groupsize,2000)
getNumber <- reactive({
req(groupsize_d()>=0)
groupsize_d()
})
output$output <- renderText({
getNumber()
})
})
Related
I'm working on an R shiny app structured like this:
library(shiny)
library(DT)
# global function
make_data = function(input){
data.frame(x = input$x, `x_times_2` = input$x*2)
}
ui <- fluidPage(
sliderInput("x", label = "Set x:", min = 1, value = 7, max = 10),
# Recalculates continuously, bad!
dataTableOutput("dtab"),
# Recalculates when inputs change, good!
# tableOutput("tab")
)
server <- function(input, output, session) {
reactive_data = reactive({
print("Recalculating Data")
make_data(reactiveValuesToList(input))
})
output$tab = renderTable({
reactive_data()
})
output$dtab = renderDataTable({
reactive_data()
})
}
shinyApp(ui, server)
My problem is that dataTableOutput("dtab") forces continuous recalculation of reactive_data whereas tableOutput("tab") (correctly) only recalculates when inputs change. Can someone help me understand why this happens?
I need to be able to pass inputs into a global function that makes a data frame which I then need to display. I want to use dataTableOutput() for the customization that DT offers but need it to only recalculate when any input is changed.
In this situation, you could use eventReactive() instead of reactive. Try this
reactive_data = eventReactive(input$x, {
print("Recalculating Data")
make_data(reactiveValuesToList(input))
})
I have this question: In a Shiny App, I construct a varible with a reactive(). The thing is that, in the midle of this process (that is a long one) I construct other varibles that I need too.
For example:
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("colum_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
a <- reactive({
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
df_2 <- subset(df_1,select=-c(fc))
column_names <- colnames(df_2)
df_3 <- df_2*2
df_3
})
output$my_table = renderTable({
a()
})
output$colum_names = renderTable({
df_column_names = data.frame(column_names())
df_column_names
})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
In this (very short) example, I would need the variable "a" (of course) and the variable "column_names". I can do something like create a new reactive that reproduce all the process until the line that contain "column_names" and finish it there. But the process is too long and I prefer to do it more "eficiently".
Any idea??
Thank you so much!
The process you're describing is correct : instead of assigning variables, just assign reactives and Shiny will handle the depedencies between them.
Note that in the example you provided, reactives aren't needed because the content is up to now static.
library(shiny)
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("column_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
a <- reactive({subset(df_1,select=-c(fc))})
column_names <- reactive({colnames(a())})
output$my_table = renderTable({a()})
output$column_names = renderTable({column_names()})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
I found a interesting answer to my own question: if you want to do something like that, you can use "<<-" instead of "<-" and it save the variable when you are working insede a function (like reactive()). Let´s see:
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("colum_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
a <- reactive({
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
df_2 <- subset(df_1,select=-c(fc))
column_names <- colnames(df_2)
# HERE THE SOLUTION!!
column_names_saved <<- column_names
df_3 <- df_2*2
df_3
})
output$my_table = renderTable({
a()
})
output$colum_names = renderTable({
df_column_names = data.frame(column_names_saved)
df_column_names
})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
Then, into the funtion you must continues with the variable "column_names", but when you need to use it later, you can use "column_name_saved". (just be carefull with one thing: onece you save the variable into the funtion, you canot change it)
Thanks!!!
I am trying to create a Shiny App which can be used in the R workspace to create a user friendly front end to some code- so that someone can just type in and click some boxes instead of creating lists and dataframes themselves- and then what they input will be stored in the workspace in R to do the code. I have basically adapted someone else's code but can't work out how I save the dynamically created UI called col - which makes text inputs so if people type something in this is saved.
When I try to add some way of saving it I get an error Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.). The code is below, is there a way I can save the information from the text input?
CrossBreakUI <- function(id, number) {
ns <- NS(id)
tagList(
fluidRow(
column(4, numericInput(ns("n"), "Number of Groups in Cross-Break", value=5, min=1), uiOutput(ns("col")))
)
)
}
variables <- function(input, output, session, variable.number){
output$textInput <- renderUI({
ns <- session$ns
textInput(ns("textInput"),
label = "")
})
col_names <- reactive(paste0("col", seq_len(input$n)))
output$col <- renderUI({
ns <- session$ns
map(col_names(), ~ textInput(ns(.x), NULL))
})
reactive({
# Create Pair: variable and its value
df <- data.frame(
"variable.number" = variable.number,
stringsAsFactors = FALSE
)
})
}
ui <- fixedPage(
div(
CrossBreakUI("var1", 1)
))
server <- function(input, output) {
add.variable <- reactiveValues()
add.variable$df <- data.frame(
"n" = numeric(0),
"col" = character(0),
stringsAsFactors = FALSE
)
var1 <- callModule(variables, paste0("var", 1), 1)
observeEvent(input[[NS(paste0("var", 1), "n")]], {
add.variable$df[1,1] <- input[[NS(paste0("var", 1), "n")]]
})
**#THIS IS THE ERROR- IT DOES NOT SAVE THE TEXT INPUT FROM THIS VARIABLE**
observeEvent(input[[NS(paste0("var", 1), "col")]], {
add.variable$df[1,2] <- input[[NS(paste0("var", 1), "col")]]
})
observe({
assign(x ="CrossBreak", value=add.variable$df, envir= .GlobalEnv) })
}
Second revision
If my understanding is correct, I think this gets close to what you want. You have a numericInput. The UI presents a series of textInputs. The number of textInputs changes in response to changes in the numericInput's value. The values of the textInputs are saved to a variable in the global environment (and the value of this global variable is printed to the console as the app terminates). Values already entered in the textInputs are preserved when the UI updates.
My solution differs from yours in that you have one module attempting to control every textInput and a main server that attempts to interrogate each textInput to obtain its value. I use multiple instances of a single module, one for each textInput. Each module instance manages the persistence of its textInput's value independently of all the other instances.
library(shiny)
groupList <- list()
# Module to define a self-contained "write-my-value" textInput
writeMyValueTextInputUI <- function(id, idx) {
ns <- NS(id)
textInput(ns("groupName"), paste0("Group ", idx))
}
writeMyValueTextInput <- function(input, output, session, id) {
ns <- session$ns
# Initialise
observe ({
id <- as.numeric(id)
if (id <= length(groupList)) updateTextInput(session, "groupName", value=groupList[[id]])
})
observeEvent(input$groupName, {
req(input$groupName)
# Note global assignment
groupList[[id]] <<- input$groupName
})
rv <- reactive ({
input$groupName
})
return(rv)
}
ui <- fluidPage(
titlePanel("Crossbreak demo"),
sidebarLayout(
sidebarPanel(
numericInput("groupCount", "Number of groups in cross-break:", min=1, value=5),
),
mainPanel(
textOutput("groupCount"),
uiOutput("groupList")
)
)
)
server <- function(input, output, session) {
onStop(function() cat(paste0(groupList, collapse=", ")))
ns <- session$ns
controllers <- list()
output$groupList <- renderUI({
req(input$groupCount)
textInputs <- lapply(
1:input$groupCount,
function(x) {
id <- ns(paste0("text", x))
controllers[[x]] <- callModule(writeMyValueTextInput, id, x)
return(writeMyValueTextInputUI(id, x))
}
)
do.call(tagList, textInputs)
})
}
shinyApp(ui = ui, server = server)
=========================
I haven't tried running your code (it's not really a simple self-contained example), but the following is just one way of running an app from the console. (is that what you mean when you say "from the global environment?)...
myList <- list(
ui = bootstrapPage(
numericInput('n', 'Number of obs', 100),
plotOutput('plot')
),
server = function(input, output) {
output$plot <- renderPlot({ hist(runif(input$n)) })
}
)
if (interactive()) runApp(myList)
I based my code on this page which also has other examples...
Note that you can't do this if you're running an R script in a batch job, as the batch job has no context in which to display the app. Hence if (interactive())...
OK. Responding to OP's clarification, here's a really crude demonstraion of one way of doing what she wants. Note the use of the global assignment operator (<<-) in the observeEvent.
x <- NA
print(paste0("globalValue is currently: ", x))
myList <- list(
ui = bootstrapPage(
numericInput('n', 'Please give me a number', 100)
),
server = function(input, output) {
observeEvent(input$n, {x <<- input$n})
}
)
if (interactive()) runApp(myList)
print(paste0("globalValue is now: ", x))
On my system, stepping through these statements in the console gives:
> x <- NA
> print(paste0("globalValue is currently: ", x))
[1] "globalValue is currently: NA"
> myList <- list(
+ ui = bootstrapPage(
+ numericInput('n', 'Please give me a number', 100)
+ ),
+ server = function(input, output) {
+ observeEvent(input$n, {x <<- input$n})
+ }
+ )
> if (interactive()) runApp(myList)
Listening on http://127.0.0.1:4429
> print(paste0("globalValue is now: ", x))
[1] "globalValue is now: 104"
>
Obviously, this isn't a realistic production solution. Possible solutions might include:
Writing to a temporary Rds file in the app and then reading it in once the app terminates.
Using session$userData to store the required information whilst the app is running and then using onStop to do custom processing as the app terminates.
I'm sure there will be others.
[OP: As an aside, look at the length of my code compared to yours. Put yourself in the shoes of someone who's willing to provide solutions. Whose question are they most likely to answer: yours or mine? Providing compact, relevant code makes it far more likely you'll get a useful reply.]
I would like to make shiny application that can retrieve some reactive value (initialized with reactiveVal) so that, when an error occure, I can save the value of my "reactive value" just before the application breaks.
I tried a few things with the option "shiny.error" (options(shiny.error = function(){...}))" but I can get these value...
Here is a skeleton of a simple app :
library(shiny)
options(shiny.error = function() {
previous_frames <- sys.frames()
## Some code that enables to get the value of the reactive value "rv"
## when the error occured (and save in a file "recover.txt" for instance).
## I expected that I could retrieve the reactive value in "previous_frames",
## but it seems not to be the case...
})
ui <- fluidPage(
tagList(
actionButton("increment", label = "Increment")
, textOutput("value")
, actionButton("do_error", "Create an error")
)
)
server <- function(input, output, session) {
rv <- reactiveVal(0)
observeEvent(input$increment, {
rv(rv() + 1)
})
output$value <- renderText({
rv()
})
observeEvent(input$do_error, {
stop("an error")
})
}
shinyApp(ui = ui, server = server)
Do you have any idea how I can retrieve the value of a "reactive value" (i.e. initialized with reactiveVal, in this case the value of rv()) when an error occure (preferably using option shiny.error)?
I've just found a simple solution: place the options call in the server function and call directly the value in an observer:
library(shiny)
ui <- fluidPage(
tagList(
actionButton("increment", label = "Increment")
, textOutput("value")
, actionButton("do_error", "Create an error")
)
)
server <- function(input, output, session) {
options(shiny.error = function() {
# I can retrieve the value :)
observe({
print(paste0("value = ",rv()))
})
})
rv <- reactiveVal(0)
observeEvent(input$increment, {
rv(rv() + 1)
})
output$value <- renderText({
rv()
})
observeEvent(input$do_error, {
stop("an error")
})
}
shinyApp(ui = ui, server = server)*
I am having trouble with nested selectizeInputs, i.e. a group of select inputs where the selection in the first determines the choices in the second, which control the choices in the third, and so on.
Let's say I have an select1 that lets you choose a dataset, and select2 which lets you pick a variable in the dataset. Obviously the choices in select2 depend on the selection in select1. I find that if a user selects a variable from select2, and then changes select1, it doesn't immediately wipe out the value from select2, but instead it goes through a reactive sequence with the new value in select1, and the old value from select2, which is suddenly referencing a variable in a different dataset, which is a problem.
Example:
library(shiny)
ui =fluidPage(
selectizeInput('d',choices=c('mtcars','iris'),
label="Datasets"),
uiOutput("vars"),
htmlOutput("out")
)
server = function(input, output, session) {
output$vars <- renderUI({
req(input$d)
selectizeInput("v",choices=names(get(input$d)), label="Variables",
options=list(onInitialize=I('function() {this.setValue("");}')))
})
output$out <- renderUI({
req(input$d,input$v)
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
})
}
runApp(list(ui = ui, server = server))
On launch, select mpg, and displays max value.
Now, after selecting mpg, if you switch to iris, you will get a barely noticeable error, then it corrects itself. This is a toy example, so the error is insignificant, but there could easily be cases where the error is much more dire (as is the case with the app I am currently developing).
Is there a way to handle nested selectizeInputs such that changes in an upstream selectizeInput won't evaluate with old values of down stream selectizeInputs when changed?
Thanks
edit: This issue turns out to have to do more with modules than anything else I believe:
library(shiny)
library(DT)
testModUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("out"))
}
testMod <- function(input, output, session, data) {
output$out <- DT::renderDataTable({
data()
},caption="IN MODULE")
}
ui =fluidPage(
selectizeInput('d',choices=c('mtcars','iris'),
label="Datasets"),
uiOutput("vars"),
testModUI("test"),
DT::dataTableOutput("test2")
)
server = function(input, output, session) {
output$vars <- renderUI({
req(input$d)
selectizeInput("v",choices=names(get(input$d)), label="Variables",
options=list(onInitialize=I('function() {this.setValue("");}')))
})
observe({
req(input$d,input$v)#,get(input$d)[[input$v]])
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
callModule(testMod,"test",reactive(data.frame(v1=max(get(input$d)[[input$v]]))))
})
output$test2 <- DT::renderDataTable({
req(input$d,input$v)#,get(input$d)[[input$v]])
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
data.frame(v1=max(get(input$d)[[input$v]]))
},caption="OUTSIDE MODULE")
}
runApp(list(ui = ui, server = server))
Hello you can put condition to check if your code is going to run, here you just need that input$v to be a valid variable from input$d, so do :
output$out <- renderUI({
req(input$d,input$v)
if (input$v %in% names(get(input$d))) {
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
}
})
# or
output$out <- renderUI({
req(input$d,input$v)
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
})
EDIT with module, you can define your module with an expression to validate like this :
testMod <- function(input, output, session, data, validExpr) {
output$out <- DT::renderDataTable({
validate(need(validExpr(), FALSE))
data()
},caption="IN MODULE")
}
And call the module in the server with the expression in a function :
observe({
req(input$d,input$v)
callModule(
module = testMod,
id = "test",
data = reactive({ data.frame(v1=max(get(input$d)[[input$v]])) }),
validExpr = function() input$v %in% names(get(input$d))
)
})