How to automatically collapse code in RShiny app server (reactives, renders, etc) - r

I am working with a very large RShiny app and want to take advantage of code folding to organize the server.R file in this application. However, when I use the code-fold hotkey, it does not fold the various elements defined in the server (the reactive, render, etc. elements).
I'd like to be able to take this
# observe some things
observe({
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query[['tab']])) {
updateTabItems(session, "sidebarMenu", selected = query[['tab']])
}
if (!is.null(query[['player']])) {
updateSelectInput(session, "profile", selected = query[['player']])
}
})
# Lots of "reactive" data fetching functions
league_stats <- reactive({
get1 <- fetch('yada')
return(get1)
})
# another reactive
shooting <- reactive({
get1$SHORT_MR_MADE<-sum(get1$short_mr_fgm,na.rm=T)
...
...
)}
and collapse it into this (or something like this) by just hitting the code-collapse hotkey.
# observe some things
observe({--})
# Lots of "reactive" data fetching functions
league_stats <- reactive({--})
# another reactive
shooting <- reactive({--})
Is this possible to do with R / RStudio? I would like to avoid using the 4 # signs #### above the function to code fold, as this will hide the shooting <- reactive({--}) strings as well, however I'd like to still have show (and just hide the code inside).
I will oftentimes wrap code in functions since functions collapse, however I cannot wrap RShiny reactive elements in functions (or, i'm not sure how), as it seems like this breaks the app.

Shiny reactives behave as other functions, but you need to take care about passing to them the input, session or other reactives (as function, not as value) they need.
As an illustration :
library(shiny)
generateUI <- function() {fluidPage(
actionButton("do", "Click Me"),
textOutput('counter')
)}
ui <- generateUI()
myobserver <- function(input,counter) {
observeEvent(input$do, {
cat('Clicked \n')
counter(counter()+1)
})
}
myformater <- function(counter) {
renderText(paste('count is',counter()))
}
server <- function(input, output, session) {
counter <- reactiveVal(0)
myobserver(input,counter)
output$counter <- myformater(counter)
}
shinyApp(ui, server)
Collapsed code :

Another way to do this without creating them as functions is to put an identifier above each code chunk:
library(shiny)
# Generate UI ----
generateUI <- function() {fluidPage(
actionButton("do", "Click Me"),
textOutput('counter')
)}
ui <- generateUI()
# Observer ----
myobserver <- function(input,counter) {
observeEvent(input$do, {
cat('Clicked \n')
counter(counter()+1)
})
}
# Formatter ----
myformater <- function(counter) {
renderText(paste('count is',counter()))
}
# Server ----
server <- function(input, output, session) {
counter <- reactiveVal(0)
myobserver(input,counter)
output$counter <- myformater(counter)
}
shinyApp(ui, server)
You will then be able to collapse code segments in between the two identifiers to view as shown below:

Related

In R Shiny, how can you render outputs outside an observer where their names are reactives?

I have a Shiny app where I have a dynamically created tabsetPanel where each tab contains a table. I do not know how many tabs/tables will be created in each session by users. I understand that it is bad practice to put render* functions inside observe or observeEvent calls but I can't think of any other way to do this. A minimal example of what I'm trying to do is shown below, which just picks a data set randomly to display on a given tab. Essentially, I'm trying to figure out how to call my table renderers without putting them inside an observe. More generally, although I have read it is bad practice to do this, I would also appreciate an explanation of exactly why it's not a good thing to do:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("tabs", "Number of tabs", value = 5),
),
mainPanel(
uiOutput("mytabset")
)
)
)
server <- function(input, output) {
output$mytabset <- renderUI({
mytabs <- lapply(seq_len(input$tabs), function(x) {
tabPanel(
paste("Tab", x),
tableOutput(paste0("tab", x))
)
})
do.call(tabsetPanel, mytabs)
})
observe({
set.seed(1)
lapply(seq_len(input$tabs), function(x) {
output[[paste0("tab", x)]] <- renderTable({
sample(list(mtcars, iris, trees, cars), 1)
})
})
})
}
shinyApp(ui = ui, server = server)
I haven't used them in a while, but I think if you use modules, you can call them from outside of a reactive context, and won't need an observe..? :)

Object not found R Shiny

I am trying to access the data frame created in one render function into another render function.
There are two server outputs, lvi and Category, in lvi I have created Data1 data frame and Category I have created Data2 dataframe. I want to select Data2 where Data1 ID is matching.
I am following the below steps to achieve my objective but I get error "Object Data1 not found".
My UI is
ui <- fluidPage(
# App title ----
titlePanel("Phase1"),
fluidPage(
column(4,
# Input: Select a file ----
fileInput("file1", "Import file1")
)
),
fluidPage(
column(4,
# Input: Select a file ----
fileInput("file2", "Import File2")
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
dataTableOutput("lvi"),
dataTableOutput("category")
)
)
My server code is
server <- function(input, output) {
output$lvi <- renderDataTable({
req(input$file1)
Data1 <- as.data.frame(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
output$category <- renderDataTable({
req(input$file2)
Data2 <- as.data.frame(read_excel(input$file2$datapath, sheet = "Sheet1"))
Data2 <- Data2[,c(2,8)]
Data2 <- Data2[Data1$ID == "ID001",]
})
}
shinyApp(ui, server)
Once a reactive block is done executing, all elements within it go away, like a function. The only thing that survives is what is "returned" from that block, which is typically either the last expression in the block (or, when in a real function, something in return(...)). If you think of reactive (and observe) blocks as "functions", you may realize that the only thing that something outside of the function knows of what goes on inside the function is if the function explicitly returns it somehow.
With that in mind, the way you get to a frame inside one render/reactive block is to not calculate it inside that reactive block: instead, create that frame in its own data-reactive block and use it in both the render and the other render.
Try this (untested):
server <- function(input, output) {
Data1_rx <- eventReactive(input$file1, {
req(input$file1, file.exists(input$file1$datapath))
as.dataframe(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
output$lvi <- renderDataTable({ req(Data1_rx()) })
output$category <- renderDataTable({
req(input$file2, file.exists(input$file2$datapath),
Data1_rx(), "ID" %in% names(Data1_rx()))
Data2 <- as.data.frame(read_excel(input$file2$datapath, sheet = "Sheet1"))
Data2 <- Data2[,c(2,8)]
Data2 <- Data2[Data1_rx()$ID == "ID001",]
})
}
shinyApp(ui, server)
But since we're already going down the road of "better design" and "best practices", let's break data2 out and the data2-filtered frame as well ... you may not be using it separately now, but it's often better to separate "loading/generate frames" from "rendering into something beautiful". That way, if you need to know something about the data you loaded, you don't have to (a) reload it elsewhere, inefficient; or (b) try to rip into the internals of the shiny DataTable object and get it manually. (Both are really bad ideas.)
So a slightly better solution might start with:
server <- function(input, output) {
Data1_rx <- eventReactive(input$file1, {
req(input$file1, file.exists(input$file1$datapath))
as.dataframe(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
Data2_rx <- eventReactive(input$file2, {
req(input$file2, file.exists(input$file2$datapath))
dat <- as.dataframe(read_excel(input$file2$datapath, sheet = "Sheet1"))
dat[,c(2,8)]
})
Data12_rx <- reactive({
req(Data1_rx(), Data2_rx())
Data2_rx()[ Data1_rx()$ID == "ID001", ]
})
output$lvi <- renderDataTable({ req(Data1_rx()); })
output$category <- renderDataTable({ req(Data12_rx()); })
}
shinyApp(ui, server)
While this code is a little longer, it also groups "data loading/munging" together, and "render data into something beautiful" together. And if you need to look at early data or filtered data, it's all right there.
(Side note: one performance hit you might see from this is that you now have more copies of data floating around. As long you are not dealing with "large" data, this isn't a huge deal.)

How to update reactive output inside a for loop in R shiny

I'm new to Shiny and have hit a problem I can't find an answer for. Basically, I have a Shiny app that does some long calculations in a loop and I want it to output a "progress report" every few iterations. However, even though I reassign my reactive variable within the loop, the output doesn't update until the loop (or entire function?) has finished.
Here is a simplified test case of what I mean:
library(shiny)
# Basic interface
ui <- fluidPage(
actionButton("run", "Run"),
textOutput("textbox")
)
# Basic server with loop
server <- function(input, output) {
textvals=reactiveValues(a=0)
observeEvent(input$run, {
for(i in 1:10){
textvals$a=i # Expect output to update here, but doesn't
Sys.sleep(0.1) # Slight pause so isn't instantaneous
}
})
output$textbox <- renderText({
textvals$a
})
}
# Run the application
shinyApp(ui = ui, server = server)
What I would expect is that the display would update 1, 2, 3, ... 10 as the loop executes. Instead, it just jumps straight from 0 to 10. How can I force an update partway through the loop?
Thank you.
With using invalidateLater you can get something closed to what you want. Not the shortest way to do it I think, but it may help you to find a better solution.
library(shiny)
# Basic interface
ui <- fluidPage(
actionButton("run", "Run"),
textOutput("textbox")
)
# Basic server with loop
server <- function(input, output, session) {
textvals <- reactiveVal(0)
active <- reactiveVal(FALSE)
output$textbox <- renderText({
textvals()
})
observe({
invalidateLater(1000, session)
isolate({
if (active()) {
textvals(textvals() + 1)
if (textvals() > 9) {
active(FALSE)
}
}
})
})
observeEvent(input$run, {
active(TRUE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
By the way, reactive and for loops don't really get on well. This may help : https://gist.github.com/bborgesr/e1ce7305f914f9ca762c69509dda632e

Shiny - Inserting UI with a for loop returns the same elements in every outputs

I want to insert a non predefined number of graph inside my Shiny App. I use a for loop and a series of insertUI.
Thing is when I run it, the text elements behave as expected, but the graphs are all rendering the same image. How can I prevent that?
Here's a reprex:
library(shiny)
ui <- fluidPage(
tags$div(
class = "this",
actionButton("go", "go")
)
)
server <- function(input, output, session) {
observeEvent( input$go , {
x <- reactiveValues(x = list(iris, mtcars, airquality))
for (i in 1:3){
insertUI(
".this",
ui = tagList(
p(paste("Number", i)),
renderPlot({
plot(x$x[[i]])
})
))
}
})
}
shinyApp(ui, server)
Beware closures in for loops ;). There's no block scope in R, so each for loop iteration shares the same iterator variable i. And the renderXX functions essentially store expressions that aren't evaluated immediately, but only later when it's time to render.
So by the time the plots are ready to render, the for loop is done, i is now 3, and each plot(x$x[[i]]) expression is called as plot(x$x[[3]]).
You can get around this by creating a new scope for each loop iteration using local() or a function. My favorite solution is using lapply as you've found, to run each loop iteration in a function with i as a function-scoped variable.
Many languages without block scope have this same gotcha, like Python and JS:
JavaScript closure inside loops – simple practical example
How do lexical closures work?
So, found the answer to my own question — using lapply() makes this work:
library(shiny)
ui <- fluidPage(
tags$div(
class = "this",
actionButton("go", "go")
)
)
server <- function(input, output, session) {
observeEvent( input$go , {
x <- reactiveValues(x = list(iris, mtcars, airquality))
lapply(1:3, function(i){
insertUI(
".this",
ui = tagList(
p(paste("Number", i)),
renderPlot({
plot(x$x[[i]])
})
))
})
})
}
shinyApp(ui, server)

Shiny in R: How to properly use observe?

I have a problem with my code. I have 2 input files which I want to read with click of button and a numeric input which contains a filter value for the output of the table being created from the 2 files (after manipulating the data). The whole process (read files + create table + filter) right now is executed every time the user click the button. I want to do only the filter action if the input files doesn't change, because the process takes long time.
After the first click I want to do only the filtering command when the numeric input changes, unless the input files is also changed by the user.
The following code reproduces my problem:
library(shiny)
library(data.table)
server <- function(input, output, session) {
output$table1 <- renderDataTable({
input$gobtn
isolate({
infile1 <<- input$f1
infile2 <<- input$f2
if (is.null(infile1) || is.null(infile1)) {
return (NULL)
}
else {
calc()
}
})
})
calc <- function() {
inf1 <<- fread(infile1$datapath)
inf2 <<- fread(infile2$datapath)
# do some process with files data.....
my_table <- as.data.table(rbind(inf1, inf2))
setnames(my_table, c('name', 'rank'))
result <- my_table[rank > input$rank]
return(result)
}
}
ui <- basicPage(
fileInput("f1", "f1"),
fileInput("f2", "f2"),
numericInput("rank", "show rank only above :", value = 6),
actionButton("gobtn", "show"),
dataTableOutput('table1')
)
shinyApp(ui = ui, server = server)
The way to use reactivity is to break things into parts, so that you only need to update what is necessary. The first step in your pipeline is reading and processing the files. This seems like a good reactive: if they don't change, nothing happens, but when they change, everything that needs to be recalculated is recalculated. The next step is filtering, when the filter variable changes we want to refilter the data. Then we can just put that in the output.
server <- function(input, output, session) {
processedData <- reactive({
req(input$f1,input$f2)
inf1 <- fread(input$f1$datapath)
inf2 <- fread(input$f2$datapath)
# do some process with files data.....
my_table <- as.data.table(rbind(inf1, inf2))
setnames(my_table, c('name', 'rank'))
my_table
}
filteredData <- reactive({
req(input$rank)
processedData()[processedData()$rank > input$rank]
})
output$table1 <- renderDataTable({
input$gobtn
isolate({
filteredData()
})
})
}

Resources