# create listener for what mode we're currently working in (bivariate, multivariate, time series...)
plotmanager <- shiny::reactiveValues()
# preload pca/plsda
shiny::observe({
if(is.null(plotmanager$make)){
NULL # if not reloading anything, nevermind
}else{
if(!is.null(mSet)){
success = F
try({
emptyax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
for(do in plotmanager$make){
toWrap <- getPlots(do, mSet,
input, gbl,
lcl, venn_yes,
my_selection)
lcl <<- toWrap$lcl
toWrap <- toWrap$plots
isHeatmap = grepl("heatmap_", names(toWrap))
toWrap$heatmap_plot = toWrap[isHeatmap]
toWrap[which(isHeatmap)] <- NULL
mapply(function(myplot, plotName){
isSquare <- grepl("pca|plsda|tsne|roc|heatmap|var|samp|network|umap|ica", plotName) & !grepl("scree|cv|perm|venn", plotName)
# === WRAPPER ===
empty <- if(grepl(plotName, pattern="var|samp")) "output_empty2_width" else "output_empty3_width"
output[[paste0(plotName, "_wrap")]] <- shiny::renderUI({
if(plotName != "network"){
list(conditionalPanel(
condition = 'input.ggplotly == true',
plotly::plotlyOutput(paste0(plotName, "_interactive"), height = "100%")) ,
conditionalPanel(
condition = 'input.ggplotly == false',
list(fluidRow(align="right",
downloadButton(outputId = paste0("download_", plotName),
label = icon("Click to download"))),
plotOutput(plotName, height = session$clientData[[empty]]/if(isSquare) 1.4 else 2)
)
))
}else{
visNetwork::visNetworkOutput(paste0(plotName, "_interactive"),
height = session$clientData[[empty]]/if(isSquare) 1.4 else 2)
}
})
# === PLOTS ===
observe({
canBe3D <- grepl("pca|plsda|tsne|umap|ica", plotName) & !grepl("scree|perm|cv", plotName)
if(canBe3D){
whichAnal <- stringr::str_match(plotName, "pca|plsda|tsne|umap|ica")[,1]
is3D <- !input[[paste0(whichAnal, "_2d3d")]]
}else{
is3D <- plotName %in% c("network",
"network_heatmap")
}
if(!is.null(session$clientData[[empty]])){
if(!(plotName %in% c("network",
"wordcloud"))){
try({
if(length(myplot) > 1){
if(plotName == "heatmap_plot") myplot$heatmap_static() else{
if(length(myplot$layers[[1]]$data) > 0){
myplot$data = myplot$layers[[1]]$data
}
if(input$plot_mzlabels & (
any(grepl("mz|m/z", names(myplot$data)))
)){
if(length(myplot$layers[[1]]$mapping) > 0){
myplot$mapping = myplot$layers[[1]]$mapping
}
myX = rlang::quo_get_expr(myplot$mapping[['x']])
myY = rlang::quo_get_expr(myplot$mapping[['y']])
myText = rlang::quo_get_expr(myplot$mapping[['text']])
myCol = rlang::quo_get_expr(myplot$mapping[['colour']])
flip = grepl("tt|fc|aov|var|samp|corr", plotName)
if(length(myplot$data) == 0){
myplot$data = myplot$layers[[1]]$data
}
if("significant" %in% colnames(myplot$data)){
plotdata = myplot$data[significant == "YES"]
}else{
plotdata = myplot$data
}
myplot = myplot + ggrepel::geom_label_repel(data = plotdata,
aes_string(y = myY,
x = myX,
label = myText),
color="black",
size = 5)
}
}
output[[plotName]] <- shiny::renderPlot({
suppressWarnings(print(myplot))
})
}
}, silent = F)
plotFn <- paste0(c(gsub(":|,:", "_", mSet$settings$cls.name),
plotName), collapse="_")
if(grepl(x=plotFn, "ml")){
plotFn <- paste(plotFn, mSet$analSet$ml$last$method, mSet$analSet$ml$last$name, sep = "_")
}
}
output[[paste0(plotName, "_interactive")]] <-
if(plotName == "network"){
visNetwork::renderVisNetwork(myplot)
}else if(plotName == "wordcloud"){
wordcloud2::renderWordcloud2(myplot)
}else{
plotly::renderPlotly({
if(!is3D & plotName != "heatmap_plot"){
myplot <- plotly::ggplotly(suppressWarnings(print(myplot)),
tooltip = "text",
height = session$clientData[[empty]]/if(isSquare) 1.4 else 2)
}
if(plotName != "heatmap_plot"){
myplot <- if(grepl("venn", plotName)) plotly::ggplotly(suppressWarnings(print(myplot))) %>% plotly::layout(xaxis = emptyax,
yaxis = emptyax,
showlegend=input$legend) else myplot %>% plotly::layout(showlegend=input$legend)
}else{
myplot <- if(plotName == "heatmap_plot") suppressWarnings(print(myplot$heatmap_interactive)) else plotly::ggplotly(suppressWarnings(print(myplot))) %>% plotly::layout(height = session$clientData[[empty]]/1.4,
width = session$clientData[[empty]])
}
if(canBe3D){
try({
if(length(myplot$x$data) > 0){
for(i in 1:length(myplot$x$data)){
if(myplot$x$data[[i]]$hoveron == "fills"){
myplot$x$data[[i]]$hoverinfo <- "skip"
}
}
}
}, silent = T)
}
suppressWarnings({
suppressWarnings(print(myplot %>%
plotly::config(
toImageButtonOptions = list(
format = if(input$plotsvg) "svg" else "png",
filename = paste0(plotFn, "_interactive")
))
))
})
})
}
output[[paste0("download_", plotName)]] <- downloadHandler(
filename = function() paste0(plotFn, if(input$plotsvg) ".svg" else ".png"),
content = function(file){
if(plotName == "heatmap_plot"){
saveFun = if(input$plotsvg) svg else png
saveFun(file=file)
suppressWarnings(print(myplot$heatmap_static()))
dev.off()
}else{
ggplot2::ggsave(file, plot = suppressWarnings(print(myplot)))
}
}
)
}
})
}, toWrap, names(toWrap))
}
success = T
})
if(!success){
metshiAlert("Data plotting failed!")
}
}
plotmanager$make <- NULL # set reloading to 'off'
}
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.