Reputation: 3920
I'm trying to develop the following Shiny user interface:
Currently my code looks like this:
ui = fluidPage(
actionButton("add", "Add a graph"),
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
),
uiOutput("box1"),
uiOutput("box2"),
uiOutput("box3")
)
server = function(input, output, session) {
graphtable <- reactiveValues(i=1, data=NULL)
icur <- reactiveVal(1)
observeEvent(input$add, {
graphtable$data <- rbind(graphtable$data, c(graphtable$i, input$obs))
icur(icur()+1)
})
output$box1 =renderUI({
if (icur() == 1){
tagList("Plot 1", actionLink("del1", "Delete"),plotOutput("activeplot"))
}else if (icur() > 1){
tagList("Plot 1", actionLink("del1", "Delete"),plotOutput("plot1"))
}
})
output$box2 =renderUI({
if (icur() == 2){
tagList("Plot 2", actionLink("del2", "Delete"),plotOutput("activeplot"))
}else if (icur() > 2){
tagList("Plot 2", actionLink("del2", "Delete"),plotOutput("plot2"))
}
})
output$box3 =renderUI({
if (icur() == 3){
tagList("Plot 3", actionLink("del3", "Delete"),plotOutput("activeplot"))
}else if (icur() > 3) {
tagList("Plot 3", actionLink("del3", "Delete"),plotOutput("plot3"))
}
})
observeEvent(input$del1, {
icur(icur()-1)
graphtable$data = graphtable$data[-1,, drop=F]
})
observeEvent(input$del2, {
icur(icur()-1)
graphtable$data = graphtable$data[-2,, drop=F]
})
observeEvent(input$del3, {
icur(icur()-1)
graphtable$data = graphtable$data[-3,, drop=F]
})
output$plot1 = renderPlot({plot(1:graphtable$data[1,2])})
output$plot2 = renderPlot({plot(1:graphtable$data[2,2])})
output$plot3 = renderPlot({plot(1:graphtable$data[3,2])})
output$activeplot = renderPlot({plot(1:input$obs, xlab = icur())})
}
Mysteriously, this code works... some of the time. The behaviour is fine when there's 1 or 2 graphs. But when you click to add a third graph, the RenderUI doesn't fully update. The text appears, but the active graph continues to be the 2nd graph!
Is there something I'm misunderstanding? How do I fix this? I have tried adding a delay with shinyjs to no avail but maybe I'm doing it wrong. Is there some way to force renderUI to update?
Upvotes: 1
Views: 236
Reputation: 3920
With some fiddling I might have identified the issue - it seems like there's a race condition where when icur updates, potentially box3 could update before box2 does (reactive expressions apparently do NOT execute in the order they appear in the code). This creates a problem in that box2 is still showing activeplot, so box3 is unable to show the graph it wants to be showing. Indeed there's a javascript error to that effect. I don't really understand why this means box2 would continue to show activeplot though. Perhaps because of the aforementioned error it also stops trying to update box2 as well.
Well, the below code seems to work: (I also added in some isolates, but I don't know if they are required)
ui = fluidPage(
actionButton("add", "Add a graph"),
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
),
uiOutput("box1"),
uiOutput("box2"),
uiOutput("box3"),
uiOutput("box4"),
uiOutput("box5")
)
server = function(input, output, session) {
graphtable <- reactiveValues(i=1, data=NULL)
icur <- reactiveVal(1)
observeEvent(input$add, {
graphtable$data <- rbind(graphtable$data, c(graphtable$i, input$obs))
icur(icur()+1)
icur()
})
output$box1 =renderUI({
if (icur() == 1){
tagList("Plot 1", actionLink("del1", "Delete"),plotOutput("activeplot"))
}else if (icur() > 1){
tagList("Plot 1", actionLink("del1", "Delete"),plotOutput("plot1"))
}
})
output$box2 =renderUI({
if (icur() == 2){
tagList("Plot 2", actionLink("del2", "Delete"),plotOutput("activeplot1"))
}else if (icur() > 2){
tagList("Plot 2", actionLink("del2", "Delete"),plotOutput("plot2"))
}
})
output$box3 =renderUI({
if (icur() == 3){
tagList("Plot 3", actionLink("del3", "Delete"),plotOutput("activeplot"))
}else if (icur() > 3) {
tagList("Plot 3", actionLink("del3", "Delete"),plotOutput("plot3"))
}
})
output$box4 =renderUI({
if (icur() == 4){
tagList("Plot 4", actionLink("del4", "Delete"),plotOutput("activeplot1"))
}else if (icur() > 4) {
tagList("Plot 4", actionLink("del4", "Delete"),plotOutput("plot4"))
}
})
output$box5 =renderUI({
if (icur() == 5){
tagList("Plot 5", actionLink("del5", "Delete"),plotOutput("activeplot"))
}else if (icur() > 5) {
tagList("Plot 5", actionLink("del5", "Delete"),plotOutput("plot5"))
}
})
observeEvent(input$del1, {
graphtable$data = graphtable$data[-1,, drop=F]
icur(icur()-1)
})
observeEvent(input$del2, {
graphtable$data = graphtable$data[-2,, drop=F]
icur(icur()-1)
})
observeEvent(input$del3, {
graphtable$data = graphtable$data[-3,, drop=F]
icur(icur()-1)
})
observeEvent(input$del4, {
graphtable$data = graphtable$data[-4,, drop=F]
icur(icur()-1)
})
observeEvent(input$del5, {
graphtable$data = graphtable$data[-5,, drop=F]
icur(icur()-1)
})
output$plot1 = renderPlot({plot(1:isolate(graphtable$data)[1,2])})
output$plot2 = renderPlot({plot(1:isolate(graphtable$data)[2,2])})
output$plot3 = renderPlot({plot(1:isolate(graphtable$data)[3,2])})
output$plot4 = renderPlot({plot(1:isolate(graphtable$data)[4,2])})
output$plot5 = renderPlot({plot(1:isolate(graphtable$data)[5,2])})
output$activeplot = renderPlot({if ( icur() %% 2) plot(1:input$obs, xlab = isolate(icur()))})
output$activeplot1 = renderPlot({if ( (icur()+1) %% 2) plot(1:input$obs, xlab = isolate(icur()))})
}
The point is to have two activeplots so there's never the case that two boxes are trying to show the same activeplot at the same time.
Maybe this is an awful and hacky solution, and maybe my understanding is incorrect, so perhaps someone else can find a better way of resolving this problem.
Upvotes: 1