bsplus: Carousel for dynamic number of plots in Shiny - r

Question

I am trying to create an application where a user selection determines the number of plots to be placed into a carousel. I have a MWE below, where a user "selects" anywhere between 1-10 of the lines in the parallel coordinate plot on the left. After doing so, on the right, 1-10 plots are created (one for each of the lines the user selected). This all seems to be working, and the dynamic number of plots are stored in a tagList() object.
With larger datasets, the number of lines the user can select can be large and the output plots can look crowded. Hence, I am trying to put the output plots into a carousel. Currently, I have all output plots in a carousel - but they are all shoved into the first page of the carousel.
I would be grateful to hear any advice on how I can tweak this MWE so that each page of the carousel only contains one of the output plots.
library(shiny)
library(plotly)
library(data.table)
library(dplyr)
library(tidyr)
library(bsplus)
ui <- shinyUI(pageWithSidebar(
headerPanel("Dynamic number of plots"),
sidebarPanel(
plotlyOutput("plot")
),
mainPanel(
# This is the dynamic UI for the plots
bs_carousel(id = "tabPrev", use_indicators = TRUE) %>%
bs_append(content = uiOutput("plots"))
)
)
)
server <- shinyServer(function(input, output) {
set.seed(1)
dat <- data.frame(ID = paste0("ID",1:10), A.1 = runif(10), A.2 = runif(10), A.3 = runif(10), B.1 = runif(10), B.2 = runif(10), B.3 = runif(10))
dat$ID <- as.character(dat$ID)
# Convert DF from scatterplot to PCP
datt <- data.frame(t(dat))
names(datt) <- as.matrix(datt[1, ])
datt <- datt[-1, ]
datt[] <- lapply(datt, function(x) type.convert(as.character(x)))
setDT(datt, keep.rownames = TRUE)[]
colnames(datt)[1] <- "x"
dat_long <- melt(datt, id.vars ="x" )
dat_long <- separate(dat_long, x, c("group", "rep"), remove=FALSE)
dat_long$group <- factor(dat_long$group)
output$plot <- renderPlotly({
plot_ly(dat_long, x= ~x, y= ~value, type = 'scatter', mode = 'lines+markers', color = ~variable) %>% layout(dragmode="box", showlegend = FALSE)
})
d <- reactive(event_data("plotly_selected"))
observeEvent(d(),{
# Insert the right number of plot output objects into the web page
output$plots <- renderUI({
lengthY <- reactive((length(unique(d()$curveNumber))))
if (lengthY()<1){
plot_output_list <- list()
}
else{
plot_output_list <- lapply(1:lengthY(), function(i) {
plotname <- paste("plot", i, sep="")
plotlyOutput(plotname, height = 280, width = 250)
})
}
# Convert the list to a tagList - this is necessary for the list of items
# to display properly.
do.call(tagList, plot_output_list)
})
})
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
observeEvent(d(),{
lengthY <- reactive(length(unique(d()$curveNumber)))
for (i in 1:lengthY()) {
# Need local so that each item gets its own number. Without it, the value
# of i in the renderPlot() will be the same across all instances, because
# of when the expression is evaluated.
local({
my_i <- i
curveY <- reactive(d()$curveNumber[my_i])
plotname <- paste("plot", my_i, sep="")
ax <- list(title = "", showticklabels = TRUE)
ay <- list(title = "Read Count")
indDat <- as.data.frame(dat_long[variable %in% dat[curveY()+1,]$ID])
g1 <- levels(indDat$group)[1]
g2 <- levels(indDat$group)[2]
g1m <- mean(filter(indDat, group==g1)$value)
g2m <- mean(filter(indDat, group==g2)$value)
output[[plotname]] <- renderPlotly({
indDat %>% plot_ly(x = ~group, y = ~value, type = "scatter", marker = list(size = 10), color = ~group, colors = "Set2", hoverinfo = "text", text = paste0("Read count = ", format(round(indDat$value, 2), nsmall = 2))) %>% layout(xaxis = ax, yaxis = ay, legend = list(x = 0.35, y = -0.26)) %>% add_segments(x = g1, xend = g2, y = g1m, yend = g2m, showlegend = FALSE, line = list(color='#000000')) %>% add_trace(x = g1, y= g1m, showlegend = FALSE, hoverinfo = "text", text = paste0("Mean Read Count = ", round(g1m, digits = 2)), marker = list(color='#000000')) %>% add_trace(x = g2, y= g2m, showlegend = FALSE, hoverinfo = "text", text = paste0("Mean Read Count = ", round(g2m, digits = 2)), marker = list(color='#000000'))
})
})
}
})
})
shinyApp(ui, server)

Answer 1

The way I would do this is embedding the bs_carousel inside the renderUI. It does work but I couldn't manage to remove the plots object totally, which sometimes plots... If I remove it, only the first plot appears in the carousel.
1- Change the ui to :
ui <- shinyUI(pageWithSidebar(
headerPanel("Dynamic number of plots"),
sidebarPanel(
plotlyOutput("plot")
),
mainPanel(
uiOutput("car_ui"),
uiOutput("plots")
)
)
)
2- Add this code in the first observeEvent, just above the output$plots
output$car_ui <- renderUI({
lengthY <- length(unique(d()$curveNumber))
if (lengthY<1){
plot_output_list <- list()
}
else{
plot_output_list <- lapply(1:lengthY, function(i) {
plotname <- paste("plot", i, sep="")
plotlyOutput(plotname, height = 280, width = 250)
})
}
car <- bs_carousel(id = "carousel", use_indicators = TRUE)
Reduce(bs_append, plot_output_list, init=car)
})
Also note you don't have to put all your calculations (lengthY...) in a reactive