Merge pull request #191 from bigomics/develop-plot-reactivity-fixes

Develop plot reactivity fixes

components/board.dataview/R/dataview_plot_expression.R

@@ -8,20 +8,13 @@ dataview_plot_expression_ui <- function(id, label = "", height = c(600, 800)) {
 
   info_text <- paste0("Expression barplot of grouped samples (or cells) for the gene selected in the <code>Search gene</code> Samples (or cells) in the barplot can be ungrouped by setting the <code>grouped</code> under the main <i>Options</i>.")
 
-  opts <- shiny::tagList(
-    shiny::radioButtons(ns("geneplot_type"), "plot type (grouped)", c("bar", "violin", "box"),
-      inline = TRUE
-    )
-  )
-
   PlotModuleUI(
     ns("pltmod"),
     title = "Abundance/expression",
     label = label,
     outputFunc = plotly::plotlyOutput,
     outputFunc2 = plotly::plotlyOutput,
     info.text = info_text,
-    options = opts,
     download.fmt = c("png", "pdf", "csv", "obj"),
     ## width = c("auto","100%"),
     height = height

components/board.dataview/R/dataview_plot_tsneplot.R

@@ -5,17 +5,13 @@
 
 dataview_plot_tsne_ui <- function(id, label = "", height = c(350, 600)) {
   ns <- shiny::NS(id)
-  ## options (hamburger menu)
-  options <- tagList(
-    actionButton(ns("button1"), "some action")
-  )
+
   info_text <- paste0("<b>T-SNE clustering</b> of samples (or cells) colored by an expression of the gene selected in the <code>search_gene</code> dropdown menu. The red color represents an over-expression of the selected gene across samples (or cells).")
 
   PlotModuleUI(
     ns("pltmod"),
     plotlib = "plotly",
     info.text = info_text,
-    options = options,
     download.fmt = c("png", "pdf", "csv"),
     width = c("auto", "100%"),
     height = height,

components/board.dataview/R/dataview_server.R

@@ -31,15 +31,21 @@ DataViewBoard <- function(id, pgx) {
     data_infotext <- paste0(
       'The <strong>DataView module</strong> provides information and visualisations of the dataset to quickly lookup a gene,
         check the counts, or view the data tables.<br><br>
-        The <strong>Plots</strong> panel displays figures related to the expression level of the selected gene,
+
+        The <strong>Sample QC</strong> provides an overview of several sample-centric quality control metrics. In this QC tab,
+        the total number of counts (abundance) per sample and their distribution among the samples are displayed.
+        This is most useful to check the technical quality of the dataset, such as total read counts or abundance of ribosomal genes.
+
+        The <strong>Gene overview</strong> panel displays figures related to the expression level of the selected gene,
         correlation, and average expression ranking within the dataset.
         More information about the gene and hyperlinks to external databases are provided. Furthermore,
         it displays the correlation and tissue expression for a selected gene in external reference datasets.
-        In the <strong>Counts</strong> panel, the total number of counts (abundance) per sample and their distribution among the samples are displayed.
-        This is most useful to check the technical quality of the dataset, such as total read counts or abundance of ribosomal genes.
-        In <strong>Gene Table</strong> panel, the exact expression values across the samples can be looked up,
-        where genes are ordered by the correlation with respect to the first gene. Gene-wise average expression of a phenotype sample grouping
-        is also presented in this table. In the <strong>Samples</strong> panel, more complete information about samples can be found.
+
+        In <strong>Counts table</strong> panel, the exact expression values across the samples can be looked up,
+        where genes are ordered by the correlation with respect to the selected gene. Gene-wise average expression
+        of a phenotype sample grouping is also presented in this table.
+
+        In the <strong>Sample information</strong> panel, more complete information about samples can be found.
         Finally, the <strong>Contrasts</strong> panel, shows information about the phenotype comparisons.
         <br><br><br>
         <center><iframe width="560" height="315" src="https://www.youtube.com/embed/S32SPINqO8E"

components/board.dataview/R/dataview_table_rawdata.R

@@ -22,55 +22,81 @@ dataview_table_rawdata_server <- function(id,
     table_data <- shiny::reactive({
       ## get current view of raw_counts
 
-      shiny::req(pgx$X, pgx$Y, pgx$genes, pgx$model.parameters)
-      shiny::req(r.gene(), r.data_type())
-
-      dbg("[dataview_rawdata:table_data] reacted!")
-
       ## dereference reactives
       gene <- r.gene()
       data_type <- r.data_type()
       samples <- r.samples()
       groupby <- r.groupby()
 
+      parse_sample <- function(data){
+        if (samples[1] == "") samples <- colnames(data)
+        samples <- intersect(colnames(data), samples)
+        parsed_data <- data[, samples, drop = FALSE]
+      }
+
       if (is.null(gene) || gene == "" || is.na(gene)) {
         gene <- rownames(pgx$X)[1]
       }
 
       if (data_type == "counts") {
-        x <- pgx$counts
+        x <- parse_sample(pgx$counts)
+        x_cpm <- parse_sample(pgx$X)
       } else if (data_type == "CPM") {
         x <- edgeR::cpm(pgx$counts, log = FALSE)
       } else {
         ## log2CPM
-        x <- pgx$X
+        x <- parse_sample(pgx$X)
       }
+
       x0 <- x
 
       ## ------------------ select samples
-      if (samples[1] == "") samples <- colnames(pgx$X)
-      samples <- intersect(colnames(x), samples)
-      x <- x[, samples, drop = FALSE]
+
 
       ## Quickly (?) calculated correlation to selected gene
-      dbg("[dataview_rawdata:table_data] calculate rho")
-      dbg("[dataview_rawdata:table_data] data_type = ", data_type)
 
-      ## compute correlation (always in logCPM)
+      ## compute statistics
       rho <- sdx <- avg <- NULL
-      logx <- pgx$X[rownames(x), ]
-      xgenes <- pgx$genes[rownames(x), "gene_name"]
-      k <- which(xgenes == gene)
-      rho <- cor(t(logx[, samples]), logx[k, samples], use = "pairwise")[, 1]
-      rho <- round(rho[rownames(x)], digits = 3)
-      sdx <- round(apply(logx[, samples], 1, sd), digits = 3)
-      avg <- round(rowMeans(x), digits = 3)
 
-      dbg("[dataview_rawdata:table_data] compute groupings")
+      if (data_type == "counts") {
+        xgenes <- pgx$genes[rownames(x), "gene_name"]
+        k <- which(xgenes == gene)
+
+        xgenes_cpm <- pgx$genes[rownames(x_cpm), "gene_name"]
+        k_cpm <- which(xgenes_cpm == gene)
+      } else {
+        ## log2CPM
+        xgenes <- pgx$genes[rownames(x), "gene_name"]
+        k <- which(xgenes == gene)
+
+      }
+
+      if (data_type == "counts") {
+        #compute the geometric mean, exp(mean(log(x+1)))
+        logx <- log(x[rownames(x), ]+1)
+
+        #correlation should be equal between counts and logCPM, use logCPM
+        rho <- cor(t(x_cpm[,colnames(x)]), x_cpm[k_cpm, colnames(x)], use = "pairwise")[, 1]
+        rho <- round(rho[rownames(x_cpm)], digits = 3)
+        rho <- rho[match( rownames(x), names(rho))]
+        names(rho) <- rownames(x)
+
+        #geometric std deviation
+        sdx <- round(exp(apply(logx[, samples], 1, sd)),digits = 3)
+        #geometric mean
+        avg <- round(exp(rowMeans(logx)),digits = 3)
+      } else {
+        #compute the geometric mean, mean(x)
+        logx <- x
+        rho <- cor(t(logx[, samples]), logx[k, samples], use = "pairwise")[, 1]
+        rho <- round(rho[rownames(logx)], digits = 3)
+        sdx <- round(apply(logx[, samples], 1, sd), digits = 3)
+        avg <- round(rowMeans(logx), digits = 3)
+      }
 
       group <- NULL
       if (groupby %in% colnames(pgx$Y)) {
-        group <- pgx$Y[colnames(x), groupby]
+        group <- pgx$Y[colnames(logx), groupby]
       }
       if (length(samples) > 500 && groupby == "<ungrouped>") {
         group <- pgx$model.parameters$group
@@ -80,10 +106,15 @@ dataview_table_rawdata_server <- function(id,
         allgroups <- sort(unique(group))
         newx <- c()
         for (gr in allgroups) {
-          mx <- rowMeans(x[, which(group == gr), drop = FALSE], na.rm = TRUE)
+          if (data_type == "counts") {
+            mx <- exp(rowMeans(logx[, which(group == gr), drop = FALSE], na.rm = TRUE))
+          }else{
+            mx <- rowMeans(logx[, which(group == gr), drop = FALSE], na.rm = TRUE)
+          }
+
           newx <- cbind(newx, mx)
         }
-        rownames(newx) <- rownames(x)
+        rownames(newx) <- rownames(logx)
         colnames(newx) <- paste0("avg.", allgroups, "")
         x <- newx
       }

components/board.dataview/R/dataview_ui.R

@@ -69,9 +69,64 @@ DataViewUI <- function(id) {
   tabs <- shiny::tabsetPanel(
     id = ns("tabs"),
 
-    ## ----------------------------------------------------------------------------
+
+    # QC tab #####
+
+    shiny::tabPanel(
+      "Sample QC",
+      div(
+        class = "row",
+        div(
+          class = "col-md-4",
+          dataview_plot_totalcounts_ui(
+            ns("counts_total"),
+            height = imgH,
+            label = "a")
+        ),
+        div(
+          class = "col-md-4",
+          dataview_plot_boxplot_ui(
+            ns("counts_boxplot"),
+            height = imgH,
+            label = "b")
+        ),
+        div(
+          class = "col-md-4",
+          dataview_plot_histogram_ui(
+            ns("counts_histplot"),
+            height = imgH,
+            label = "c")
+        )
+      ),
+      div(
+        class = "row",
+        div(
+          class = "col-md-5",
+          dataview_plot_genetypes_ui(
+            ns("counts_genetypes"),
+            height = imgH,label = "d"
+          )
+        ),
+        div(
+          class = "col-md-7",
+          dataview_plot_abundance_ui(
+            ns("counts_abundance"),
+            height = imgH,label = "e")
+        )
+      ),
+      tags$div(
+        class = "caption",
+        HTML("<b>Counts distribution</b>. Plots associated with the counts, abundance or expression levels across
+            the samples/groups.  <b>(a)</b> Total counts per sample or average per group.
+            <b>(b)</b> Distribution of total counts per sample/group. The center horizontal bar correspond to
+            the median.  <b>(c)</b> Histograms of total counts distribution per sample/group. <b>(d)</b>
+            Abundance of major gene types per sample/group. <b>(e)</b> Average count by gene type per sample/group.")
+      )
+    ),
+
+    # Gene overview tab #####
     shiny::tabPanel(
-      "Plots",
+      "Gene overview",
       div(
         class = "row",
         div(
@@ -135,72 +190,22 @@ DataViewUI <- function(id) {
       )
     ),
 
-    ## ----------------------------------------------------------------------------
-    shiny::tabPanel(
-      "QC",
-      div(
-        class = "row",
-        div(
-          class = "col-md-4",
-          dataview_plot_totalcounts_ui(
-            ns("counts_total"),
-            height = imgH,
-            label = "a")
-        ),
-        div(
-          class = "col-md-4",
-          dataview_plot_boxplot_ui(
-            ns("counts_boxplot"),
-            height = imgH,
-            label = "b")
-        ),
-        div(
-          class = "col-md-4",
-          dataview_plot_histogram_ui(
-            ns("counts_histplot"),
-            height = imgH,
-            label = "c")
-        )
-      ),
-      div(
-        class = "row",
-        div(
-          class = "col-md-5",
-          dataview_plot_genetypes_ui(
-            ns("counts_genetypes"),
-            height = imgH,label = "d"
-            )
-        ),
-        div(
-          class = "col-md-7",
-          dataview_plot_abundance_ui(
-            ns("counts_abundance"),
-            height = imgH,label = "e")
-        )
-      ),
-      tags$div(
-        class = "caption",
-        HTML("<b>Counts distribution</b>. Plots associated with the counts, abundance or expression levels across
-            the samples/groups.  <b>(a)</b> Total counts per sample or average per group.
-            <b>(b)</b> Distribution of total counts per sample/group. The center horizontal bar correspond to
-            the median.  <b>(c)</b> Histograms of total counts distribution per sample/group. <b>(d)</b>
-            Abundance of major gene types per sample/group. <b>(e)</b> Average count by gene type per sample/group.")
-      )
-    ),
-    ## ----------------------------------------------------------------------------
+    # counts table tab #####
+
     shiny::tabPanel(
-      "Counts",
+      "Counts table",
       dataview_table_rawdata_ui(ns("rawdatatable")),
       tags$div(
         class = "caption",
         HTML("<b>Gene table.</b> The table shows the gene expression values per sample, or average
               expression values across the groups. The column 'rho' reports the correlation with the
-              gene selected in 'Search gene' in the left side bar.")
+              gene selected in 'Search gene' in the left side bar. If the data type selected is counts,
+              the geometric mean is calculated.")
       )
     ),
-    ## ----------------------------------------------------------------------------
+    # Sample information #####
     shiny::tabPanel(
-      "Samples",
+      "Sample information",
       div(
         class = "row",
         div(
@@ -239,7 +244,9 @@ DataViewUI <- function(id) {
       )
     ),
 
-    ## ----------------------------------------------------------------------------
+
+    #contrasts tab #####
+
     shiny::tabPanel(
       "Contrasts",
       dataview_table_contrasts_ui(ns("contrastTable")),
@@ -252,7 +259,9 @@ DataViewUI <- function(id) {
         )
       )
     ),
-    ## ----------------------------------------------------------------------------
+
+    # Resource info #####
+
     shiny::tabPanel(
       "Resource info",
       dataview_table_rescources_ui(ns("resources"))