subplot barplot conversion to plotly

components/base/R/pgx-plotting.R

@@ -7,22 +7,6 @@
 ## Plotting functions
 ########################################################################
 
-if(0) {
-
-    fc <- pgx.getMetaMatrix(ngs, level='geneset')$fc
-    x <- Matrix::head( fc[order(-rowMeans(fc**2)),], 60 )
-
-    par(mar=c(20,4,4,2), mfrow=c(1,1))
-    barplot( t(x), beside=FALSE, las=3)
-    ##par(mgp=c(2,1,0))
-    pgx.stackedBarplot(x, ylab="cumulative logFC", cex.names=0.001, srt=60, adj=1)
-
-    par(mar=c(4,0,4,2), mfrow=c(1,2)); frame()
-    pgx.stackedBarplot(Matrix::head(x,40), xlab="cumulative logFC", hz=TRUE, cex.names=0.8)
-
-    x=zx0;dim=2;method="pca"
-}
-
 heatmapWithAnnot <- function(F, anno.type=c('boxplot','barplot'),
                              bar.height=NULL, map.height=NULL,
                              row_fontsize=9, column_fontsize=9,
@@ -3388,38 +3372,41 @@ pgx.plotSampleClustering <- function(x, dim=2,
 
 }
 
-pgx.stackedBarplot <- function(x, hz=FALSE, srt=NULL, cex.text=0.9, ...)
-{
-    ##x <- x[order(rowMeans(x,na.rm=TRUE)),]
-    ##barplot( t(x), beside=FALSE, las=3)
-    x.pos <- pmax(x,0)
-    x.neg <- pmin(x,0)
-    y0 <- max(abs(rowSums(x,na.rm=TRUE)))
-    y0 <- max(rowSums(pmax(x,0),na.rm=TRUE),
-              rowSums(pmax(-x,0),na.rm=TRUE))
-
-    rownames(x.neg) <- NULL
-    p <- NULL
-    if(hz==TRUE) {
-        ##p <- barplot( t(x.pos), horiz=TRUE, beside=FALSE, las=1, xlim=c(-1,1)*y0 )
-        ##barplot( t(x.neg), horiz=TRUE, beside=FALSE, las=1, add=TRUE )
-
-        p <- barplot( t(x.pos), horiz=TRUE, beside=FALSE, las=1, xlim=c(-1,1)*y0, ... )
-        barplot( t(x.neg), horiz=TRUE, beside=FALSE, las=1, add=TRUE, ... )
-
+pgx.stackedBarplot <- function(x,
+                               showlegend,
+                               ylab = NULL,
+                               xlab = NULL,
+                               horiz = FALSE
+                               ) {
 
-    } else {
-        p <- barplot( t(x.pos), beside=FALSE, las=3, ylim=c(-1.1,1.1)*y0, ... )
-        barplot( t(x.neg), beside=FALSE, las=3, add=TRUE, ... )
+  x_plot <- cbind(data.frame(groups = rownames(x)), x)
 
-        if(!is.null(srt)) {
-            text(p, par("usr")[3], labels=rownames(x), srt=srt, adj=1, xpd=TRUE, cex=cex.text)
-        }
+  x_plot <- data.table::melt(x_plot, id.vars='groups',value.name = "Effect")
 
-    }
+  if(horiz == FALSE){
+    x_plot$groups <- factor(x_plot$groups, levels = rownames(x))
+  }else{
+    c1 <- which(colnames(x_plot)=='variable')
+    c2 <- which(colnames(x_plot)=='Effect')
+    c3 <- which(colnames(x_plot)=='groups')
+    colnames(x_plot)[c1] <- "Effect"
+    colnames(x_plot)[c2] <- "groups"
+    colnames(x_plot)[c3] <- "variable"
+    }
+
+  plotly::plot_ly(x_plot, x = ~groups,
+                  y = ~Effect,
+                  type = 'bar',
+                  name = ~variable,
+                  color = ~variable) %>%
+    plotly::layout(showlegend = showlegend, barmode = 'stack',
+                   yaxis = list(title = ylab),
+                   xaxis = list(title = xlab)) %>%
+    plotly_default1()
 
 }
 
+
 ## for plotly
 darkmode <- function(p, dim=2) {
     font.par <- list(

components/board.clustering/R/clustering_plot_PCAplot.R

@@ -0,0 +1,258 @@
+##
+## This file is part of the Omics Playground project.
+## Copyright (c) 2018-2022 BigOmics Analytics Sagl. All rights reserved.
+##
+
+
+
+## Annotate clusters ############
+
+clustering_plot_clustpca_ui <- function(id,
+                                        label='',
+                                        height=c(600,800),
+                                        parent)
+{
+  ns <- shiny::NS(id)
+
+  info_text = tagsub(paste0(' The <b>PCA/tSNE</b> panel visualizes unsupervised clustering obtained by the principal components analysis (',a_PCA,') or t-distributed stochastic embedding (',a_tSNE,') algorithms. This plot shows the relationship (or similarity) between the samples for visual analytics, where similarity is visualized as proximity of the points. Samples that are ‘similar’ will be placed close to each other.
+<br><br>Users can customise the PCA/tSNE plot in the plot settings, including the {color} and {shape} of points using a phenotype class, choose t-SNE or PCA layout, label the points, or display 2D and 3D visualisation of the PCA/tSNE plot.'))
+
+  caption = "<b>PCA/tSNE plot.</b> The plot visualizes the similarity in expression of samples as a scatterplot in reduced dimension (2D or 3D). Samples that are similar are clustered near to each other, while samples with different expression are positioned farther away. Groups of samples with similar profiles will appear as <i>clusters</i> in the plot."
+
+
+  plot_opts = shiny::tagList(
+    withTooltip( shiny::selectInput(parent("hmpca.colvar"), "Color/label:", choices=NULL, width='100%'),
+      "Set colors/labels according to a given phenotype."),
+    withTooltip( shiny::selectInput(parent("hmpca.shapevar"), "Shape:", choices=NULL, width='100%'),
+      "Set shapes according to a given phenotype."),
+    withTooltip( shiny::radioButtons(
+      ns('hmpca_legend'), label =  "Legend:",
+      choices = c('group label','bottom'), inline=TRUE),
+      "Normalize matrix before calculating distances."),
+    withTooltip( shiny::checkboxGroupInput( ns('hmpca_options'),"Other:",
+      choices=c('sample label','3D','normalize'), inline=TRUE),
+      "Normalize matrix before calculating distances.")
+  )
+
+  PlotModuleUI(
+    ns("pltmod"),
+    title = "PCA/tSNE plot",
+    label = label,
+    plotlib = "plotly",
+    info.text = info_text,
+    caption = caption,
+    options = plot_opts,
+    download.fmt=c("png","pdf","csv"),
+    width = c("auto","100%"),
+    height = height
+  )
+}
+
+clustering_plot_clustpca_server <- function(id,
+                                            pgx,
+                                            hmpca.colvar,
+                                            hm_getClusterPositions,
+                                            hmpca.shapevar,
+                                            hm_clustmethod,
+                                            watermark=FALSE,
+                                            parent)
+{
+  moduleServer( id, function(input, output, session) {
+    ns <- session$ns
+
+    ## Plot ############
+
+    plot_data <- shiny::reactive({
+
+        clust <- hm_getClusterPositions()
+        ##data.frame( x=clust$pos[,1], y=clust$pos[,2], clust=clust$clust )
+
+        return(
+          list(
+            hmpca_options = input$hmpca_options,
+            hmpca.colvar = hmpca.colvar(),
+            hmpca.shapevar = hmpca.shapevar(),
+            df = data.frame( x=clust$pos[,1], y=clust$pos[,2]),
+            pgx = pgx,
+            hm_clustmethod = hm_clustmethod(),
+            hmpca_legend = input$hmpca_legend
+          )
+        )
+
+    })
+
+    plot.RENDER <- function() {
+
+        ##pgx <- inputData()
+        pd <- plot_data()
+
+        hmpca_options <- pd[['hmpca_options']]
+        hmpca.colvar <- pd[['hmpca.colvar']]
+        hmpca.shapevar <- pd[['hmpca.shapevar']]
+        pos <- pd[['df']]
+        pgx <- pd[['pgx']]
+        hm_clustmethod <- pd[["hm_clustmethod"]]
+        hmpca_legend <- pd[["hmpca_legend"]]
+
+        do3d = ("3D" %in% hmpca_options)
+        ##clust <- hm_getClusterPositions()
+        sel <- rownames(pos)
+        df  <- cbind(pos, pgx$Y[sel,])
+        # if(!is.null(clust$clust)) df[["<cluster>"]] <- clust$clust
+
+        colvar = shapevar = linevar = textvar = NULL
+        if(hmpca.colvar %in% colnames(df)) colvar <- factor(df[,hmpca.colvar])
+        if(hmpca.shapevar %in% colnames(df)) shapevar <- factor(df[,hmpca.shapevar])
+        ##if(input$hmpca.line %in% colnames(df)) linevar = factor(df[,input$hmpca.line])
+        ##if(input$hmpca.text %in% colnames(df)) textvar = factor(df[,input$hmpca.text])
+        mode = "markers"
+        ann.text = rep(" ",nrow(df))
+        if(!do3d && "sample label" %in% hmpca_options) ann.text = rownames(df)
+        if(!is.null(colvar)) {
+            colvar = factor(colvar)
+            textvar <- factor(df[,hmpca.colvar])
+        }
+        symbols = c('circle','square','star','triangle-up','triangle-down','pentagon',
+                    'bowtie','hexagon', 'asterisk','hash','cross','triangle-left',
+                    'triangle-right','+',c(15:0))
+
+        Y <- cbind("sample"=rownames(pos), pgx$Y[sel,])
+        ##tt.info <- paste('Sample:', rownames(df),'</br>Group:', df$group)
+        tt.info <- apply(Y, 1, function(y) paste0(colnames(Y),": ",y,"</br>",collapse=""))
+        tt.info <- as.character(tt.info)
+        cex1 = c(1.0,0.8,0.6)[1 + 1*(nrow(pos)>30) + 1*(nrow(pos)>200)]
+
+        if(do3d ) {
+            ## 3D plot
+            j0 = 1:nrow(df)
+            j1 = NULL
+            if(!is.null(linevar)) {
+                linevar = factor(linevar)
+                j0 = which(linevar==levels(linevar)[1])
+                j1 = which(linevar!=levels(linevar)[1])
+            }
+            plt <- plotly::plot_ly(df, mode=mode) %>%
+                plotly::add_markers(x = df[j0,1], y = df[j0,2], z = df[j0,3], type="scatter3d",
+                            color = colvar[j0], ## size = sizevar, sizes=c(80,140),
+                            ##marker = list(size = 5*cex1),
+                            marker = list(size=5*cex1, line=list(color="grey10", width=0.1)),
+                            symbol = shapevar[j0], symbols=symbols,
+                            text = tt.info[j0] ) %>%
+                plotly::add_annotations(x = pos[,1], y = pos[,2], z = pos[,3],
+                                text = ann.text,
+                                ##xref = "x", yref = "y",
+                                showarrow = FALSE)
+            if(!is.null(j1) & length(j1)>0) {
+                plt <- plt %>%  plotly::add_markers(
+                                    x = df[j1,1], y = df[j1,2], z = df[j1,3], type="scatter3d",
+                                    color = colvar[j1], ## size = sizevar, sizes=c(80,140),
+                                    ##marker = list(size=5*cex1, line=list(color="grey10", width=2)),
+                                    symbol = shapevar[j1], symbols=symbols,
+                                    text=tt.info[j1])
+            }
+            ## add cluster annotation labels
+            if(0 && length(unique(colvar))>1) {
+                ## add cluster annotation labels
+                grp.pos <- apply(pos,2,function(x) tapply(x,colvar,median))
+                ##grp.pos <- matrix(grp.pos, ncol=3)
+                cex2 <- ifelse(length(grp.pos)>20,0.8,1)
+                plt <- plt %>% plotly::add_annotations(
+                                   x = grp.pos[,1], y = grp.pos[,2], z = grp.pos[,3],
+                                   text = rownames(grp.pos),
+                                   font=list(size=24*cex2, color='#555'),
+                                   showarrow = FALSE)
+            }
+
+        } else {
+
+            ## 2D plot
+            j0 = 1:nrow(df)
+            j1 = NULL
+            if(!is.null(linevar)) {
+                linevar = factor(linevar)
+                j0 = which(linevar==levels(linevar)[1])
+                j1 = which(linevar!=levels(linevar)[1])
+            }
+            plt <- plotly::plot_ly(df, mode=mode) %>%
+                plotly::add_markers(x = df[j0,1], y = df[j0,2], type="scatter",
+                            color = colvar[j0], ## size = sizevar, sizes=c(80,140),
+                            marker = list(size=16*cex1, line=list(color="grey20", width=0.6)),
+                            symbol = shapevar[j0], symbols=symbols,
+                            text = tt.info[j0] ) %>%
+                plotly::add_annotations(x = pos[,1], y = pos[,2],
+                                text = ann.text,
+                                ##xref = "x", yref = "y",
+                                showarrow = FALSE)
+
+            ## add node labels
+            if(!is.null(j1) & length(j1)>0 ) {
+                plt <- plt %>%  plotly::add_markers(
+                                    x = df[j1,1], y = df[j1,2], type="scatter",
+                                    color = colvar[j1], ## size = sizevar, sizes=c(80,140),
+                                    marker = list(size=16*cex1, line=list(color="grey20", width=1.8)),
+                                    symbol = shapevar[j1], symbols=symbols,
+                                    text=tt.info[j1])
+            }
+
+            ## add group/cluster annotation labels
+
+            if(hmpca_legend == 'inside') {
+                plt <- plt %>%
+                    plotly::layout(legend = list(x=0.05, y=0.95))
+            } else if(hmpca_legend == 'bottom') {
+                plt <- plt %>%
+                    plotly::layout(legend = list(orientation='h'))
+            } else {
+                if(!is.null(textvar) && length(unique(textvar))>1) {
+                    grp.pos <- apply(pos,2,function(x) tapply(x,as.character(textvar),median))
+                    cex2 <- 1
+                    if(length(grp.pos)>20) cex2 <- 0.8
+                    if(length(grp.pos)>50) cex2 <- 0.6
+                    plt <- plt %>% plotly::add_annotations(
+                                               x = grp.pos[,1], y = grp.pos[,2],
+                                               text = paste0("<b>",rownames(grp.pos),"</b>"),
+                                               font = list(size=24*cex2, color='#555'),
+                                               showarrow = FALSE)
+                }
+                plt <- plt %>%
+                    plotly::layout(showlegend = FALSE)
+            }
+
+
+        }
+        title = paste0("<b>PCA</b>  (",nrow(pos)," samples)")
+        if(hm_clustmethod=="tsne") title = paste0("<b>tSNE</b>  (",nrow(pos)," samples)")
+        ## plt <- plt %>% plotly::layout(title=title) %>%
+        ##     plotly::config(displayModeBar = FALSE)
+        plt <- plt %>%
+            ##config(displayModeBar = FALSE) %>%
+            plotly::config(displayModeBar = TRUE) %>%
+            ##config(modeBarButtonsToRemove = all.plotly.buttons ) %>%
+            plotly::config(displaylogo = FALSE) %>%
+            plotly::config(toImageButtonOptions = list(format='svg', height=800, width=800))
+        ##print(plt)
+        return(plt)
+    }
+
+    modal_plot.RENDER <- function() {
+        plot.RENDER()
+    }
+
+    PlotModuleServer(
+      "pltmod",
+      plotlib = "plotly",
+      func = plot.RENDER,
+      func2 = modal_plot.RENDER,
+      csvFunc = plot_data,   ##  *** downloadable data as CSV
+      ##renderFunc = plotly::renderPlotly,
+      ##renderFunc2 = plotly::renderPlotly,
+      res = c(90,170),                ## resolution of plots
+      pdf.width = 8, pdf.height = 8,
+      add.watermark = watermark
+    )
+
+
+
+  })
+
+}