Shiny: Getting a user input into a future function - shiny

I am building an shiny app, where users upload a bunch of data and than choose which should be computed. The computation itself is rather timeconsuming and should be stored in a list. To keep shiny responsive during the calculation (for the user and other users) I tried to utilize promises and future. The problem is that I am not able to get an input into future function. I always get Warning: Error in $: Can't access reactive value 'mem_pos' outside of reactive consumer. i Do you need to wrap inside reactive() or observe()? [No stack trace available]. I tried to read about reactive but I am simply stuck.
Here is a minimal example of the problem (to display it, the list has only one value each):
library(shiny)
library(promises)
library(future)
plan(multisession)
# example function
subfct = function(n) {
Sys.sleep(3)
return(n*2)
}
# shiny page
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
actionButton("mem_button", label="set mem value")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
superval = reactiveValues(mem = rep(list(0), 10))
# set the future calculations
observeEvent(input$mem_button, {future({return(subfct( input$mem_pos ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lies the problem
# show result table
observe( {output$result = renderTable({unlist(superval$mem)})})
}
# Run the application
shinyApp(ui = ui, server = server)
If the problematic line is exchanged by observeEvent(input$mem_button, {future({return(subfct( 5 ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) it basically works. But I am not able to get the user input into the function. I am grateful for a direct help or an explanation of reactive for my specific problem.

I solved it. Not enterily sure why, but isolate does the trick.
This code works for me:
library(shiny)
library(promises)
library(future)
plan(multisession)
# example function
subfct = function(n) {
Sys.sleep(3)
return(n*2)
}
# shiny page
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
actionButton("mem_button", label="set mem value")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
superval = reactiveValues(mem = rep(list(0), 10))
# set the future calculations
observeEvent(input$mem_button, {future({return(subfct( isolate(input$mem_pos) ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lied the problem
# show result table
observe( {output$result = renderTable({unlist(superval$mem)})})
}
# Run the application
shinyApp(ui = ui, server = server)

You may try to use delay() function from shinyjs package. This enables the code to run only after the times set lapses. e.g.
library(shinyjs)
ui<-fluidPage(useShinyjs(),
...)
server<-function(input,output, session){
delay (ms=,
...)
}
shinyApp(ui,server)

Related

Reload a page and switch to tab

I use the package shinyjs to allow the user to reload the page by clicking on "Reload the page" button in Tab 2 and I would like to stay on Tab 2 after reloading the page. But after realoading, the page is taking to Tab1 instead of Tab2
How can we fix it ? This is my code below :
library(shiny)
library(shinyjs)
jscode <- "shinyjs.refresh = function() { history.go(0); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jscode, functions = "refresh"),
tabsetPanel(
tabPanel("Tab 1"),
tabPanel("Tab 2", actionButton("mybutton", "Reload the page",
onclick ="javascript:window.location.reload(true)")))
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Some help would be appreciated
You can resort to plain JavaScript. The idea is that you provide an id to tabsetPanel such that you can use updateTabsetPanel in the server.
All you have to do then is to let the reloaded page know that you want to start on the second tab. As a refresh typically resets all of the inputs and reactives (you are aware of that, right?), you cannot use reactives and you have to rely on another way of communication. The query string would be one possibility.
With these ingredients you can:
Write a simple JavaScript function that reloads the page and adds a parameter to the url.
Parse the query string in the server and if the parameter is found, react on it accordingly.
library(shiny)
js <- HTML("
function doReload(tab_index) {
let loc = window.location;
let params = new URLSearchParams(loc.search);
params.set('tab_index', tab_index);
loc.replace(loc.origin + loc.pathname + '?' + params.toString());
}")
ui <- fluidPage(
tags$head(tags$script(js, type ="text/javascript")),
tabsetPanel(
tabPanel("Tab 1", value = "tab1"),
tabPanel("Tab 2", value = "tab2",
actionButton("mybutton", "Reload the page",
onclick = "doReload('tab2')")),
id = "tabsets"
)
)
server <- function(input, output, session) {
observe({
params <- parseQueryString(session$clientData$url_search)
if ("tab_index" %in% names(params)) {
updateTabsetPanel(session, "tabsets", selected = params$tab_index)
}
})
}
shinyApp(ui = ui, server = server)

I keep getting an error in my shiny app for linear regression?

I'm trying to create a shiny app and I can't seem to find the error in my code.
I keep getting this error here:
Error in match.arg(position) : 'arg' must be NULL or a character vector
I'm am also unsure as to what the inputs should be.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel("Linear Regression Shiny App"),
sidebarLayout(
sidebarPanel(
h1("Linear Regression"),
p("Select inputs for the Response
Variable"),
selectInput("ResVar",
"Response Variables:",
c("","","")
),
p("Select inputs for the Predictor
Variable"),
selectInput("PreVar",
"Predictor Variables:",
c("","","")
),
actionButton("goButton","Go!"),
plotOutput("distPlot")),
mainPanel =
verbatimTextOutput("ResVarPrint"),
verbatimTextOutput("PreVarPrint")
))
# Define server logic required to draw a histogram
server <- function(ResVar,PreVar) {
lm1 <- reactive({reformulate((input$ResVar),(input$PreVar))})
output$ResPrint <- renderPrint({input$ResVar})
output$PrePrint <- renderPrint({input$PreVar})
output$RegSum <- renderPrint({summary(lm1())})
}
# Run the application
shinyApp(ui = ui, server = server)
You had misplaced some parenthesis near the end of you UI code, and tried to use mainPanel= instead of the proper mainPanel(. The UI code below addresses the error and gets your app to load.
ui <- fluidPage(
titlePanel("Linear Regression Shiny App"),
sidebarLayout(
sidebarPanel(
h1("Linear Regression"),
p("Select inputs for the Response
Variable"),
selectInput("ResVar",
"Response Variables:",
c("","","")
),
p("Select inputs for the Predictor
Variable"),
selectInput("PreVar",
"Predictor Variables:",
c("","","")
),
actionButton("goButton","Go!"),
plotOutput("distPlot")
),
mainPanel(
verbatimTextOutput("ResVarPrint"),
verbatimTextOutput("PreVarPrint")
)
)
)
However, you may want to consider whether you actually want your plotOutput in the sidebar or whether you want it in the main panel, in which case you'll need to move it down.

Let parent server of module know that something happened inside the module

I am building an app that presents a data table and which allows you to add data. The adding of data is build by means of a form. This form is written by a module. What I want to happen is that one may fill out the form, press an 'add' button and that the data inside the table is updated.
As an example, could you help me figure out how to complete the following piece of code:
library(shiny)
library(shinydashboard)
moduleInput <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
observeEvent(input$action1, {
# Do stuff here,
# -> let the parent module or server know that something has happened
})
}
ui <- fluidPage(
verbatimTextOutput("module.pressed"),
moduleInput("first")
)
server <- function(input, output, session){
# print the currently open tab
output$module.pressed <- renderPrint({
#-> Write that we have pressed the button of the module
})
callModule(module,"first")
}
shinyApp(ui = ui, server = server)
All I thus want to do is find an easy way to present TRUE in the output field module.pressed when something happend inside the module.
Thanks!
Modules can pass reactive expression(s) to calling apps/modules by returning them in their server function. The documentation provides a few examples on how to set up interactions between modules and calling apps - https://shiny.rstudio.com/articles/modules.html
If a module needs to use a reactive expression, take the reactive expression as a function parameter. If a module wants to return reactive expressions to the calling app, then return a list of reactive expressions from the function.
library(shiny)
moduleInput <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
action1 <- reactive(input$action1)
return(reactive(input$action1))
}
ui <- fluidPage(
verbatimTextOutput("module.pressed"),
moduleInput("first")
)
server <- function(input, output, session){
action1 <- callModule(module,"first")
output$module.pressed <- renderPrint({
print(action1())
})
}
shinyApp(ui = ui, server = server)

Shiny Switch on Input from Radio Buttons Causes Error About Reactive Context

I'm trying to access the value of a radio button in shiny outside of a render function, but it always returns an error about a reactive context. Why do I need to have a reactive context to access the value of it, shouldn't I be able to see it in the shiny server function?
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"))
),
mainPanel(
plotOutput("distPlot"),
textOutput('dirtText')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# This causes the reactive error
d <- switch(input$dist,
norm = {print('duck1')},
unif = {print('duck2')},
lnorm = {print('duck3')},
exp = {print('duck4')},
{print('goose')})
}
# should now be a function pointer to one of the code blocks.
output$distPlot <- renderPlot({
# Yet this does not
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
print(input$dist)
hist(dist(500))
})
}
# Run the application
shinyApp(ui = ui, server = server)
The reactive error is as follows.
Listening on http://127.0.0.1:5181
Warning: Error in .getReactiveEnvironment()$currentContext: 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.)
Stack trace (innermost first):
46: .getReactiveEnvironment()$currentContext
45: .subset2(x, "impl")$get
44: $.reactivevalues
43: $ [/home/hschmale/wildfig/new_dashboard/switch_reactive_not_working/app.R#37]
42: server [/home/hschmale/wildfig/new_dashboard/switch_reactive_not_working/app.R#37]
1: runApp
Error in .getReactiveEnvironment()$currentContext() :
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.)
As specified in the error message you need to include your switch statement inside a reactive, like:
d <- reactive(switch(input$dist,
norm = {print('duck1')},
unif = {print('duck2')},
lnorm = {print('duck3')},
exp = {print('duck4')},
{print('goose')}))
This is because input$dist is not defined when you first run the server function, it is only defined in a renderXXX or in any other reactive function
Edit
But for this to work, you need to use d() somewhere, for example you call it in the renderPlot:
server <- function(input, output) {
d <- reactive(switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm))
output$distPlot <- renderPlot({hist(d()(500))})
}

shiny renderGvis object output not found

I can't bring a minimal example since it works for one code but not for this one I am asking about. I try to explain the structure of the code because I am pretty sure that someone can help me.
I have the usual Server.R file with
Server <- function(input, output, session) {
source("ChartServer.R")
}
where source("ChartServer.R"):
output$ChartPlotOutput <- renderGvis({
gvisChart <- CREATES A CHART
return(gvisChart)
})
and the ui.R file which is a dasboardpage:
source("servicefunctions.R")
source("dashboardBody.R")
source("dashboardHeader.R")
source("dashboardSidebar.R")
dashboardPage(
dashboardHeader,
dashboardSidebar,
dashboardBody
)
I have three tab Items of which two are working fine. However one tries to render a plot which is not working (the one mentioned in the server.R file above)
source("ChartUI.R")
aboutTab2 <- tabItem(tabName = "about2",
fluidPage(
fluidRow(
tabBox(id = "PChartUI", width = 7,
tabPanel(title = 'Prices', PChartUI)
))))
source("ChartUI.R"):
PChartUI <- tagList(
htmlOutput("ChartPlotOutput"),
imageOutput("ChartPlotWidthPlaceholder",width = '100%', height = '50px'))
when I try to run this app i always get the error:
Error in output$ChartPlotOutput <- renderGvis({ :
object 'output' not found
As mentioned I already worked with a similar structure that worked but here I can't find what I did wrong.
Thanks a lot