I have a problem with renderUI and I couldn't find a solution anywhere. Probably I'm asking the wrong question to google and more than a shiny problem is a basic R problem.
I have a function in R which depending on the input will return a table or a text. So I created both the options in my server.R in this way:
output$table <- renderTable {(
x <- function (y)
print(x)
)}
output$text <- renderText {(
x <- function (y)
print(x)
)}
If I put both the outputs in renderUI one will always give me an error. In case of textOutput if the output is a table:
Error: argument 1 (type 'list') cannot be handled by 'cat'
and
Error:no applicable method for 'xtable' applied to an object of class "character"
if it is viceversa.
My question is there a way to catch this error and use an if statement within renderUI to display only one of the two?
I'm here to give you more details if you need.
[EDIT]
server.R
library(shiny)
library(drsmooth)
shinyServer(function(input, output,session) {
-- upload dataframe and input management goes here --
output$nlbcd <- renderTable({
nlbcd<-nlbcd(dosecolumn="Dose", targetcolumn=response(),cutoffdose=cutoff(),data=data1())
print(nlbcd)
})
output$nlbcdText <- renderText({
nlbcd<-nlbcd(dosecolumn="Dose", targetcolumn=response(),cutoffdose=cutoff(),data=data1())
print(nlbcd)
})
output$tb <- renderUI({
tableOutput("nlbcd"),
textOutput("nlbcdText")
})
})
You have some issues here, the function will return different classes, including errors and warnings with interpretations. Here is a standalone example of what can happen with this function, you are encouraged to include the TryCatch in your code:
ui.R
shinyUI(
pageWithSidebar(
headerPanel("drsmooth"), sidebarPanel(
numericInput("num", label = h3("Choose 'cutoffdose'"), value = 0)
),
mainPanel(
verbatimTextOutput('current')
)
)
)
server.R
library(drsmooth)
shinyServer(function(input, output, session) {
output$current <- renderPrint({
dose <- input$num
tryCatch(isolate(nlbcd("dose", "MF_Log", cutoffdose=dose, data=DRdata)),
error=function(e) {
cat(isolate(conditionMessage(e)))
}
)
})
})
Sample outputs:
I would try to use function class().
output$table <- renderTable {(
x <- function (y)
if(class(x) == "table")
print(x)
)}
output$text <- renderText {(
x <- function (y)
if(class(x) == "list")
print(x)
)}
Related
In the below example code I reactively subset the mtcars dataframe inside the renderPlot() function. However, in my larger App with many render functions in the server section I am having to repeat the same rv$x[1:input$samples], etc., over and over in many places. How would I apply this subsetting instead "at the top", into the rv <- reactiveValues(...) function itself or equivalent "master function"? I tried subsetting inside the reactiveValues() and got the message "Warning: Error in : Can't access reactive value 'samples' outside of reactive consumer. Do you need to wrap inside reactive() or observer()?" I assumed incorrectly that the reactiveValues() function is a "reactive consumer".
If someone can answer this basic understanding question, please explain the logic for correctly subsetting "at the top" because I am getting very embarrassed by my repeated questions about Shiny reactivity.
library(shiny)
ui <- fluidPage(
sliderInput('samples','Nbr of samples:',min=2,max=32,value=16),
plotOutput("p")
)
server <- function(input, output, session) {
rv <- reactiveValues(
x = mtcars$mpg,
y = mtcars$wt
)
output$p <- renderPlot({plot(rv$x[1:input$samples],rv$y[1:input$samples])})
}
shinyApp(ui, server)
There are multiple ways you can handle this.
Here is one way to create new subset reactive values inside observe.
library(shiny)
ui <- fluidPage(
sliderInput('samples','Nbr of samples:',min=2,max=32,value=16),
plotOutput("p")
)
server <- function(input, output, session) {
rv <- reactiveValues(
x = mtcars$mpg,
y = mtcars$wt
)
observe({
rv$x_sub <- rv$x[1:input$samples]
rv$y_sub <- rv$y[1:input$samples]
})
output$p <- renderPlot({plot(rv$x_sub,rv$y_sub)})
}
shinyApp(ui, server)
I'd use reactiveValues only if you need them to be modified in different places.
reactive is shiny's basic solution for this:
library(shiny)
library(datasets)
ui <- fluidPage(
sliderInput(
'samples',
'Nbr of samples:',
min = 2,
max = 32,
value = 16
),
plotOutput("p")
)
server <- function(input, output, session) {
reactive_mtcars <- reactive({mtcars[1:input$samples,]})
output$p <- renderPlot({
plot(reactive_mtcars()$mpg, reactive_mtcars()$wt)
})
}
shinyApp(ui, server)
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)
I have a shiny app that calls a script which iterates producing a figure in each iteration. I need to show each plot and tried using recordPlot to save each plot to a list and call every element individually but the objects are not recognized later by the app. Then I also tried to include the different outputs in IF statements but my algorithm only produces the last plot for all outputs, it is like the IF statements are being ignored and I don't know howto deal whit it. Here is a simplification of my code:
library(shiny)
ui <- fluidPage(
# Main panel for displaying outputs ----
mainPanel(
actionButton("exec", "Start!!"),
tagList(tags$h4("First iteration:")),
plotOutput('PlotIter1'),
tags$hr(),
tagList(tags$h4("Second iteration:")),
plotOutput('PlotIter2'),
tags$hr(),
tagList(tags$h4("Third iteration:")),
plotOutput('PlotIter3'),
tags$hr())
)
server <- function(input, output) {
ii <- 1
observeEvent(input$exec,{
continue <- TRUE
while(continue==TRUE){
if(ii == 1){
output$PlotIter1<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
if(ii == 2){
output$PlotIter2<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
if(ii == 3){
output$PlotIter3<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
ii <- ii+1
if(ii == 4){continue <- FALSE}
}
})
}
shinyApp(ui, server)
Edit:
By using the local() approach provided by r2evans and Gregor de Cillia the issue is partially solved, but changing the server() to one closer to mine, (replacing the IF statements for other strategy FAPP equivalent) including some calculations between each plot, the problem persist and the last data are plotted in all three plots.
server <- function(input, output) {
y=rnorm(10,20,2)
for (i in 1:3) {
local({
thisi <- i
plotname <- sprintf("PlotIter%d", thisi)
output[[plotname]] <<- renderPlot({
plot(y, main=paste0("iteration: ",thisi,", mean: ",mean(y)
))
abline(h=mean(y),col=thisi)
})
})
y=y+100
}
}
I suggest that doing it with a while (or similar) loop is missing some reactivity potential. In fact, it looks like you are trying to force order of plotting within shiny's depedency/reactivity layer.
I think there should be three separate blocks, iterating as simultaneously as R/shiny will allow:
library(shiny)
ui <- fluidPage(
# Main panel for displaying outputs ----
mainPanel(
actionButton("exec", "Start!!"),
tagList(tags$h4("First iteration:")),
plotOutput('PlotIter1'),
tags$hr(),
tagList(tags$h4("Second iteration:")),
plotOutput('PlotIter2'),
tags$hr(),
tagList(tags$h4("Third iteration:")),
plotOutput('PlotIter3'),
tags$hr()
)
)
server <- function(input, output) {
output$PlotIter1 <- renderPlot({
plot(rep(1,50),main=1)
})
output$PlotIter2 <- renderPlot({
plot(rep(2,50),main=2)
})
output$PlotIter3 <- renderPlot({
plot(rep(3,50),main=3)
})
}
shinyApp(ui, server)
I'll go one step further in my inference, though, that you really aren't interested in just 1-3 with this plot; perhaps you want to do it programmatically? (I had to look this up, because I asked a very similar question several years ago, and received a good workaround from jcheng5 (one of the main authors of shiny).
server <- function(input, output) {
for (i in 1:3) {
local({
thisi <- i
plotname <- sprintf("PlotIter%d", thisi)
output[[plotname]] <<- renderPlot({
plot(rep(thisi, 50), main=thisi)
})
})
}
}
This method only works, of course, if the plots are relatively identical with small changes. Otherwise, the first version up above might be more appropriate.
There are actually several problems you might run into when using renderXXX, reactive or observe inside loops because of lazy evaluation. From my experience, the cleanest workaround is to use lapply and loop over shiny modules like so
## context server.R
lapply(1:n, function(i) { callModule(myModule, id = NS("myModule", i), moduleParam = i) })
## context: ui.R
lapply(1:n, function(i) { myModuleUI(id = NS("myModule, i), param = i)
For your case however, a quicker fix would be to just use local as suggested in the first answer here. Notice that the ii <- ii part is necesary for this to work since it "localizes" the variable ii.
library(shiny)
ui <- fluidPage(
# Main panel for displaying outputs ----
mainPanel(
actionButton("exec", "Start!!"),
tagList(tags$h4("First iteration:")),
plotOutput('PlotIter1'),
tags$hr(),
tagList(tags$h4("Second iteration:")),
plotOutput('PlotIter2'),
tags$hr(),
tagList(tags$h4("Third iteration:")),
plotOutput('PlotIter3'),
tags$hr())
)
server <- function(input, output) {
ii <- 1
observeEvent(input$exec,{
continue <- TRUE
while(continue==TRUE){
local({
ii <- ii
if(ii == 1){
output$PlotIter1<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
if(ii == 2){
output$PlotIter2<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
if(ii == 3){
output$PlotIter3<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
})
ii <- ii+1
if(ii == 4){continue <- FALSE}
}
})
}
shinyApp(ui, server)
Here is a demonstration of the modularized approach
myModule <- function(input, output, session, moduleParam) {
output$PlotIter <- renderPlot({
plot(rep(moduleParam, 50), main = moduleParam)
})
}
myModuleUI <- function(id, moduleParam) {
ns <- NS(id)
tagList(
tags$h4(paste0("iteration ", moduleParam, ":")),
plotOutput(ns('PlotIter')),
tags$hr()
)
}
shinyApp(
fluidPage(
actionButton("exec", "Start!!"),
lapply(1:4, function(i) {myModuleUI(NS("myModule", i), i)})
),
function(input, output, session) {
observeEvent(
input$exec,
lapply(1:4, function(i) {callModule(myModule, NS("myModule", i), i)})
)
}
)
Sidenote: If you want to capture several plots from the same script, you can use evaluate::evaluate for that
library(evaluate)
plotList <- list()
i <- 0
evaluate(
function() {
source("path/to/script.R")
},
output_handler = output_handler(
graphics = function(plot) {
i <- i + 1
plotList[[i]] <- plot
}
)
)
For somebody in the future, the solution that I finally came with, was changing the data structure to a list in which the result of every iteration is stored, after that, every element in the list are plotted to the corresponding render plot inside a for cycle. Naturally, it couldn´t be possible whithout the very important things that r2evans and Gregor de Cecilia pointed out. So, this approach gives the following server.R function:
server <- function(input, output){
y <- list()
#First data set
y[[1]] <- rnorm(10,20,2)
#Simple example of iteration results storage in the list simulating an iteration like procces
for(i in 2:3){
y[[i]]=y[[i-1]]+100
}
#Plots of every result
for(j in 1:3){
local({
thisi <- j
plotname <- sprintf("PlotIter%d", thisi)
output[[plotname]] <<- renderPlot({
plot(y[[thisi]], main=paste0("Iteration: ",thisi,", mean: ",round(mean(y[[thisi]]),2)
))
abline(h=mean(y[[thisi]]),col=thisi)
})
})
}
}
Here is a simple demo of the problem:
library(shiny)
ui <- fluidPage(
textOutput("Text1"),
textOutput("Text2")
)
server <- function(input, output) {
for(i in 1:2) {
id <- paste0("Text", i)
output[[id]] <- renderText(paste0("This is text #", i)) # Problem!
}
}
shinyApp(ui, server)
This program produces output
This is text #2
This is text #2
rather then #1 and #2.
Evidently, Shiny stores the expressions passed to renderText() in the line marked # Problem!, and evaluates them after the for-loop is finished. The expressions depend on variable i, and its final value i = 2 is used in evaluating both expressions.
How can I produce correct output (how can I force Shiny to use different values of i in different expressions), while still using the loop? In my code the loop limits are dynamic, and I cannot replace the loop with several static calls.
Why the for-loop does not work, check the output of this example:
library(shiny)
ui <- fluidPage(
textOutput("Text1"),
textOutput("Text2")
)
server <- function(input, output) {
for(i in 1:3) {
id <- paste0("Text", i)
output[[id]] <- renderText(paste0("This is text #", i)) # Problem!
}
i=10 # we set i to 10.
}
shinyApp(ui, server)
As you can see, all renderText elements use the last (global) value for i. This is not the case in the lapply, where an argument is passed to the function, but that argument is not defined in the global environment.
So you could use lapply instead of a for-loop, like this:
library(shiny)
ui <- fluidPage(
textOutput("Text1"),
textOutput("Text2")
)
server <- function(input, output) {
lapply(1:2,function(i){
id <- paste0("Text", i)
output[[id]] <- renderText(paste0("This is text #", i)) # Problem!
})
}
shinyApp(ui, server)
Output:
If you also want the ui to be reactive, you could use renderUI and uiOutput, for example as follows:
library(shiny)
ui <- fluidPage(
numericInput("number_of_text","Number of text",min=1,max=10,value=3),
uiOutput('my_text')
)
server <- function(input, output) {
reactive_text <- reactive({
all_text <- lapply(1:input$number_of_text,function(i){
id <- paste0("Text", i)
renderText(paste0("This is text #", i)) # Problem!
})
# do.call(all_text,tagList)
})
output$my_text <- renderUI({
do.call(fluidRow, reactive_text())
})
}
shinyApp(ui, server)
Output:
Hope this helps!
I've got an issue with my current shiny code.
I have to generate a dynamic number of tabs depending on the results of a given function (that part works fine). Then, I want to generate the input of these tabs in other loops of for example renderText. However, the final output of the textOutput for my generated renderText is always the one of the last renderText of the loops.
Here is a small example of the idea:
library(shiny)
library(shinydashboard)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
uiOutput("multipleUI")
)
)
server <- function(input, output) {
output$multipleUI <- renderUI({
tabs <- list(NULL)
for(i in 1:5){
tabs[[i]] <- tabPanel(title = paste0("tab ",i),
textOutput(paste0("out",i)), # prints j as 5 in all tabs
paste0("local out ",i)) # prints i as current loop value for each tab)
}
do.call(tabBox,tabs)
})
observe({
for(j in 1:5){
txt = paste0("generated out ", j)
print(txt) # print with current j
output[[paste0("out",j)]] <- renderText({txt})
}
})
}
shinyApp(ui, server)
While it might not be that important for renderText where I can just work around the issue, I intend to render a lot of plots and tables and couldn't think of a workaround there.
I'd appreciate any help!
EDIT: I've updated the code to show a small working example
Here's a solution that seems to work. I'm using lapply to create the tabs. Let me know if it works for what you need.
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
do.call(tabsetPanel, c(id='tab',lapply(1:5, function(i) {
tabPanel(
title=paste0('tab ', i),
textOutput(paste0('out',i))
)
})))
)
)
server <- function(input, output) {
lapply(1:5, function(j) {
output[[paste0('out',j)]] <- renderPrint({
paste0('generated out ', j)
})
})
}
shinyApp(ui, server)