In an attempt to make my multiplot app as 'free' as possible, I have so far build a nice way to build 1:n ggplots
- auto scale them
- auto arrange them
- make them zoomable
- make them clickable
- give smartly positioned hover messages
Each plot also gets a few buttons above it in it's div to allow the user to: - save them - make plot n full screen - remove plot from the page
and functionality for the user to build their own new plots to add to the auto layout page
The next step I was trying out, was to incorporate shinyjqui functionality but there I ran into some (expected?) obstacles
To start with: the jqui_sortable wrapper in the app successfully allows the user to pick up sub plots with the mouse, but does not actually change the layout when the user drops it somewhere. The plots simply return to the normal order when the user drops the plot object.
I followed the examples on the jqui page
The second problem, which may not be possible to overcome, is that click-hold of the mouse in the div, inside the plot OR outside of it has the same effect, it triggers the lifting up by jqui_sortable , thereby 'overruling the click-drag to zoom of the ggplot object.
In an ideal scenario I would like to trigger the jqui_sortable when clicking outside the plot (but inside the div), and ggplot2's brush
require('shiny')
require('ggplot2')
require('shinyjqui')
ui <- pageWithSidebar(
headerPanel("reorganize page"),
sidebarPanel(width = 2,
sliderInput(inputId = 'NrOfPlots', label = 'Nr of Plots', min = 1, max = 20, value = 1)
),
mainPanel(
uiOutput('FP1PlotMultiplot'),
style = 'width:1250px'
)
)
server <- function(input, output, session) {
ranges <- reactiveValues()
observe({
lapply(1:input$NrOfPlots, function(i) {
output[[paste0('FP1Plot_', i)]] <- renderPlot({
p <- ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
theme(legend.position = "none") +
ggtitle(paste('plot', i))
if(!is.null(ranges[[paste('FP1Plot', i, 'x', sep = '_')]]) & !is.null(ranges[[paste('FP1Plot', i, 'y', sep = '_')]])) {
p <- p + coord_cartesian(xlim = ranges[[paste('FP1Plot', i, 'x', sep = '_')]], ylim = ranges[[paste('FP1Plot', i, 'y', sep = '_')]] )
}
p
})
})
})
output$FP1PlotMultiplot<- renderUI({
n <- input$NrOfPlots
n_cols <- if(n == 1) {
1
} else if (n %in% c(2,4)) {
2
} else if (n %in% c(3,5,6,9)) {
3
} else {
4
}
Pwidth <- 1000/n_cols
Pheight <- 450/ceiling(n/n_cols) # calculate number of rows
Pwidth2 <- Pwidth+40
Pheight2 <- Pheight+80
plot_output_list <- list()
for(i in 1:input$NrOfPlots) {
plot_output_list <- append(plot_output_list,list(
div(id = paste0('div', 'FP1Plot_', i),
wellPanel(
plotOutput(paste0('FP1Plot_', i),
width = Pwidth,
height = Pheight,
dblclick = paste('FP1Plot' , i, 'dblclick', sep = '_'),
brush = brushOpts(
id = paste('FP1Plot', i, 'brush', sep = '_'),
resetOnNew = TRUE
)
),
style = paste('border-color:#339fff; border-width:2px; background-color: #fff; width:', Pwidth2, 'px; height:', Pheight2, 'px', sep = '')),
style = paste('display: inline-block; margin: 2px; width:', Pwidth2, 'px; height:', Pheight2, 'px', sep = ''))
))
}
jqui_sortable(do.call(tagList, plot_output_list))
})
lapply(1:20, function(i) {
observeEvent(input[[paste('FP1Plot', i, 'brush', sep = '_')]], {
brush <- input[[paste('FP1Plot', i, 'brush', sep = '_')]]
if (!is.null(brush)) {
ranges[[paste('FP1Plot', i, 'x', sep = '_')]] <- c(brush$xmin, brush$xmax)
ranges[[paste('FP1Plot', i, 'y', sep = '_')]] <- c(brush$ymin, brush$ymax)
}
})
observeEvent(input[[paste('FP1Plot', i, 'dblclick', sep = '_')]], {
ranges[[paste('FP1Plot', i, 'x', sep = '_')]] <- NULL
ranges[[paste('FP1Plot', i, 'y', sep = '_')]] <- NULL
})
})
}
shinyApp(ui, server)
