delta dist plot

NAMESPACE

@@ -66,6 +66,7 @@ exportMethods(assay_stdevs)
 exportMethods(assemble_report)
 exportMethods(blocks)
 exportMethods(component_deviations)
+exportMethods(component_deviations_de)
 exportMethods(component_deviations_fdr)
 exportMethods(component_means)
 exportMethods(component_stdevs)
@@ -79,6 +80,7 @@ exportMethods(filepath)
 exportMethods(generate_markdown)
 exportMethods(group_means)
 exportMethods(group_quants)
+exportMethods(group_quants_de)
 exportMethods(group_quants_fdr)
 exportMethods(group_standards)
 exportMethods(groups)
@@ -97,8 +99,6 @@ exportMethods(parent)
 exportMethods(plot_assay_means)
 exportMethods(plot_assay_stdevs)
 exportMethods(plot_component_deviations)
-exportMethods(plot_component_deviations_de)
-exportMethods(plot_component_deviations_fdr)
 exportMethods(plot_component_means)
 exportMethods(plot_component_stdevs)
 exportMethods(plot_dists)

R/delta_control.R

@@ -38,7 +38,7 @@ delta_control <- function(
   component.deviations = FALSE,
   keep = NULL,
   summarise = "groups",
-  plot = c("group.quants.de", "component.deviations.de"),
+  plot = c("group.quants.de", "component.deviations.de", "group.quants.de.batch", "component.deviations.de.batch"),
   model = "MCMCglmm",
   nwarmup = 4096,
   thin = 256,
@@ -68,7 +68,7 @@ setValidity("delta_control", function(object) {
   if (length(object@component.deviations) != 1) return("'component.deviations' is not valid!")
   if (!(all(object@keep %in% c("markdown", "group.quants.de", "component.deviations.de")))) return("'keep' is not valid!")
   if (!(all(object@keep %in% c("groups")))) return("'summarise' is not valid!")
-  if (!(all(object@plot %in% c("group.quants.de", "component.deviations.de")))) return("'plot' is not valid!")
+  if (!(all(object@plot %in% c("group.quants.de", "component.deviations.de", "group.quants.de.batch", "component.deviations.de.batch")))) return("'plot' is not valid!")
   if (length(object@model) != 1 || !(object@model %in% c("", "MCMCglmm"))) return("'model' is not valid!")
   if (length(object@nwarmup) != 1 || object@nwarmup < 0) return("'nwarmup' must be non-negative!")
   if (length(object@thin) != 1 || object@thin <= 0) return("'thin' must be positive!")

R/delta_dea.R

@@ -53,7 +53,7 @@ setMethod("dea_MCMCglmm", "seaMass_delta", function(
   DTs <- batch_split(DTs, cols, 4 * ctrl@nthread)
 
   # loop over all chains and all groups/components
-  dir.create(file.path(filepath(object), type), showWarnings = F)
+  dir.create(file.path(filepath(object), paste0(type, ".de")), showWarnings = F)
   for (chain in chains) {
     DT.index <- parallel_lapply(DTs, function(item, object, type, cols, chain, specs, contrasts, fixed1, random, rcov, start, prior, tune, pedigree, nodes, scale, pr, pl, DIC, saveX, saveZ, saveXL, slice, ginverse, trunc) {
       ctrl <- control(object)
@@ -229,7 +229,7 @@ setMethod("dea_MCMCglmm", "seaMass_delta", function(
           )]
           DT0.index <- cbind(
             DT0.de[DT0.index$from, c(cols, "Effect", "Contrast", "Baseline"), with = F],
-            data.table(file = factor(file.path(type, paste(chain, batch, "fst", sep = ".")))),
+            data.table(file = factor(file.path(paste0(type, ".de"), paste(chain, batch, "fst", sep = ".")))),
             DT0.index
           )
 
@@ -254,7 +254,7 @@ setMethod("dea_MCMCglmm", "seaMass_delta", function(
         DT0.de[, Effect := as.integer(Effect)]
         DT0.de[, Contrast := as.integer(Contrast)]
         DT0.de[, Baseline := as.integer(Baseline)]
-        fst::write.fst(DT0.de, file.path(filepath(object), type, paste(chain, batch, "fst", sep = ".")))
+        fst::write.fst(DT0.de, file.path(filepath(object), paste0(type, ".de"), paste(chain, batch, "fst", sep = ".")))
 
         if (chain == 1) return(DT0.index)
       }
@@ -273,7 +273,7 @@ setMethod("dea_MCMCglmm", "seaMass_delta", function(
         DT.index[, Component := factor(Component, levels = 1:nlevels(components), labels = levels(components))]
         rm(components)
       }
-      fst::write.fst(DT.index, file.path(filepath(object), paste(type, "index.fst", sep = ".")))
+      fst::write.fst(DT.index, file.path(filepath(object), paste0(type, ".de.index.fst")))
     }
 
     rm(DT.index)

R/delta_fdr.R

@@ -45,7 +45,7 @@ setMethod("fdr_ash", "seaMass_delta", function(
   cat(paste0("[", Sys.time(), "]   running ash ", gsub("\\.", " ", type), " fdr...\n"))
 
   if (is.null(data)) {
-    DT <- read(object, ".", type, summary = T, summary.func = summary.func, as.data.table = T)
+    DT <- read(object, ".", paste0(type, ".de"), summary = T, summary.func = summary.func, as.data.table = T)
   } else {
     DT <- as.data.table(data)
   }

R/delta_plots.R

@@ -11,11 +11,10 @@ setMethod("plots", "seaMass_delta", function(object, batch, job.id) {
   cat(paste0("[", Sys.time(), "]   generating...\n"))
 
   # grab out batch of groups
-  fit.sigma <- root(object)
-  groups <- unique(groups(fit.sigma, as.data.table = T)[G.qC > 0, Group])
+  groups <- unique(groups(root(object), as.data.table = T)[G.qC > 0, Group])
   groups <- groups[rep_len(1:nbatch, length(groups)) == batch]
+
   # plots!
-  #lims <- readRDS(file.path(filepath(object), "limits.rds"))
   report.index <- rbindlists(parallel_lapply(groups, function(item, object) {
     ctrl <- control(object)
     lims <- readRDS(file.path(filepath(object), "limits.rds"))
@@ -25,22 +24,22 @@ setMethod("plots", "seaMass_delta", function(object, batch, job.id) {
     root1 <- file.path(filepath(object), "markdown", paste0("group.", as.integer(item)))
     dir.create(root1, showWarnings = F)
 
-    # if ("group.quants" %in% ctrl@plot) {
-    #   group <- control(fit.sigma)@group[1]
-    #
-    #   fig <- plot_group_quants(object, item, value.limits = lims$group.quants, summary = T)
-    #   text1 <- paste0(group, " quants", ifelse(name(object) == "default", "", paste0(" (", name(object), ")")))
-    #   text2 <- paste0(group, " quants", ifelse(name(object) == "default", " ", paste0(" (", name(object), ") ")), " for ", item)
-    #   report.index1$group.quant <- data.table(
-    #     section = text1, section.order = 100, item = item, item.order = as.integer(item),
-    #     item.href = generate_markdown(
-    #       object,
-    #       fig,
-    #       root1, paste0("seamass_delta__", name(object), "__", tolower(group), "_quants_", as.integer(item)),
-    #       text2
-    #     )
-    #   )
-    # }
+    if ("group.quants.de" %in% ctrl@plot) {
+      group <- control(root(object))@group[1]
+
+      fig <- plot_group_quants_fdr(object, item, value.limits = lims$group.quants, summary = T)
+      text1 <- paste0(group, " differential expression", ifelse(name(object) == "default", "", paste0(" (", name(object), ")")))
+      text2 <- paste0(group, " differential expression", ifelse(name(object) == "default", "", paste0(" (", name(object), ") ")), " for ", item)
+      report.index1$group.quant.de <- data.table(
+        section = text1, section.order = 75, item = item, item.order = as.integer(item),
+        item.href = generate_markdown(
+          object,
+          fig,
+          root1, paste0("seamass_delta__", name(object), "__", tolower(group), "_fdr_", as.integer(item)),
+          text2
+        )
+      )
+    }
 
     if (length(report.index1) > 0) {
       # zip

R/delta_process.R

@@ -21,7 +21,7 @@ setMethod("process", "seaMass_delta", function(object, chain, job.id) {
     cat(paste0("[", Sys.time(), "]  DELTA-OUTPUT name=", name(object), "\n"))
 
     # summarise group de and perform fdr correction
-    if (file.exists(file.path(filepath(object), "group.quants.index.fst"))) {
+    if (file.exists(file.path(filepath(object), "group.quants.de.index.fst"))) {
       if(ctrl@fdr.model != "") {
         ellipsis <- ctrl@ellipsis
         ellipsis$object <- object
@@ -32,15 +32,21 @@ setMethod("process", "seaMass_delta", function(object, chain, job.id) {
       }
     }
 
+    # markdown folder
+    report.index <- list()
+    root <- file.path(filepath(fit.theta), "markdown", "study")
+    dir.create(root, recursive = T, showWarnings = F)
+    group <- control(root(object))@group[1]
+
     # calculate plot limits
     if (ctrl@plots == T) {
       cat(paste0("[", Sys.time(), "]   calculating plot limits...\n"))
       lims <- list()
-      if ("group.quants.de" %in% ctrl@plot) lims$group.quants.de <- limits_dists(group_quants(object, summary = T, as.data.table = T))
+      if ("group.quants.de" %in% ctrl@plot) lims$group.quants.de <- limits_dists(group_quants_de(object, summary = T, as.data.table = T))
       saveRDS(lims, file.path(filepath(object), "limits.rds"))
     }
 
-    # write out group fdr
+    # write out and plot group fdr
     if (file.exists(file.path(filepath(object), "group.quants.fdr.fst"))) {
       cat(paste0("[", Sys.time(), "]   writing group quants differential expression output...\n"))
 
@@ -50,11 +56,37 @@ setMethod("process", "seaMass_delta", function(object, chain, job.id) {
         cat(paste0("[", Sys.time(), "]    batch=", batch, "...\n"))
 
         name <- ifelse(name(object) == "default", "", paste0("__", name(object)))
-        group <- control(root(object))@group[1]
+
+        # write
         fwrite(DTs.fdr[[batch]], file.path(dirname(filepath(object)), "csv", paste0(tolower(group), "_fdr__", gsub("\\.", "_", batch), name, ".csv")))
+
+        # plot
+        if ("group.quants.de.batch" %in% ctrl@plot) {
+          cat(paste0("[", Sys.time(), "]     generating group quants differential expression plot...\n"))
+          group_quants_de(object, summary = T, as.data.table = T)
+
+          cat(paste0("[", Sys.time(), "]     generating group quants differential expression plot...\n"))
+          text <- paste0(group, "differential expression for '", gsub("\\.", "' effect, comparison '", batch), "'", name)
+          report.index$assay.stdevs <- data.table(
+            section = "Study-level", section.order = 0, item = text, item.order = 75000,
+            item.href = generate_markdown(
+              object,
+              plot_group_quants_fdr(object),
+              root, paste0("seamass_delta__", name(object), "__group_fdr__", gsub("\\.", "_", batch)),
+              text
+            )
+          )
+        }
       }
     }
 
+    # zip
+    render_markdown(object, root)
+    if (!("markdown" %in% ctrl@keep)) unlink(root, recursive = T)
+
+    # save index
+    fst::write.fst(rbindlist(report.index), file.path(filepath(fit.theta), "report", "study.report.fst"))
+
     increment_completed(filepath(object))
   }
 

R/generics.R

@@ -10,6 +10,7 @@ if (!exists("config")) setGeneric("config", function(object, ...) standardGeneri
 if (!exists("container")) setGeneric("container", function(object, ...) standardGeneric("container"))
 if (!exists("components")) setGeneric("components", function(object, ...) standardGeneric("components"))
 if (!exists("component_deviations")) setGeneric("component_deviations", function(object, ...) standardGeneric("component_deviations"))
+if (!exists("component_deviations_de")) setGeneric("component_deviations_de", function(object, ...) standardGeneric("component_deviations_de"))
 if (!exists("component_deviations_fdr")) setGeneric("component_deviations_fdr", function(object, ...) standardGeneric("component_deviations_fdr"))
 if (!exists("component_means")) setGeneric("component_means", function(object, ...) standardGeneric("component_means"))
 if (!exists("component_stdevs")) setGeneric("component_stdevs", function(object, ...) standardGeneric("component_stdevs"))
@@ -21,6 +22,7 @@ if (!exists("filepath")) setGeneric("filepath", function(object, ...) standardGe
 if (!exists("generate_markdown")) setGeneric("generate_markdown", function(object, ...) standardGeneric("generate_markdown"))
 if (!exists("group_means")) setGeneric("group_means", function(object, ...) standardGeneric("group_means"))
 if (!exists("group_quants")) setGeneric("group_quants", function(object, ...) standardGeneric("group_quants"))
+if (!exists("group_quants_de")) setGeneric("group_quants_de", function(object, ...) standardGeneric("group_quants_de"))
 if (!exists("group_quants_fdr")) setGeneric("group_quants_fdr", function(object, ...) standardGeneric("group_quants_fdr"))
 if (!exists("group_standards")) setGeneric("group_standards", function(object, ...) standardGeneric("group_standards"))
 if (!exists("groups")) setGeneric("groups", function(object, ...) standardGeneric("groups"))

R/seaMass.R

@@ -47,7 +47,7 @@ setMethod("read", "seaMass", function(
       DT <- merge(DT, items, by = colnames(items), sort = F)
     }
     else if (!is.null(items)) {
-      DT <- DT[get(colnames(DT)[2]) %in% items]
+      DT <- DT[get(colnames(DT)[ifelse(colnames(DT)[1] == "Blocks", 2, 1)]) %in% items]
     }
     if (nrow(DT) == 0) return(NULL)
   } else {
@@ -304,7 +304,9 @@ setMethod("plot_dists", "seaMass", function(
   data.table::setorderv(DT1, summary.cols, order = ifelse(horizontal, -1, 1), na.last = T)
 
   for (col in label.cols) {
-    if (any(nchar(as.character(DT1[[col]])) > 24)) {
+    if (all(is.numeric(DT1[[col]])) && !all(DT1[[col]] == round(DT1[[col]]))) {
+      DT1[, (paste0("_", col)) := formatC(signif(get(col), digits = 3), digits = 3, format = "fg", flag = "#")]
+    } else if (any(nchar(as.character(DT1[[col]])) > 24)) {
       if (horizontal) {
         DT1[, (paste0("_", col)) := paste0(
           "(", as.integer(factor(get(col), levels = rev(unique(get(col))))), ") ", ifelse(nchar(as.character(get(col))) > 21, paste0(strtrim(as.character(get(col)), 24), "..."), as.character(get(col)))
@@ -433,9 +435,12 @@ setMethod("plot_dists", "seaMass", function(
       # text tooltip
       DT.plot <- copy(DTs[[i]]) # workaround for data.table problem
       text.old <- intersect(colnames(DTs[[i]]), setdiff(summary.cols1, c(ggcolour.aes, ggfill.aes)))
-      text.cols <- sapply(text.old, function(col) gsub("\n", " ", col))
+      text.cols <- as.vector(sapply(text.old, function(col) gsub("\n", " ", col)))
       setnames(DT.plot, text.old, text.cols, skip_absent = T)
       for (col in text.cols) {
+        if (all(is.numeric(DT.plot[[col]])) && !all(DT.plot[[col]] == round(DT.plot[[col]]))) {
+          DT.plot[, (col) := formatC(signif(get(col), digits = 3), digits = 3, format = "fg", flag = "#")]
+        }
         DT.plot[, (col) := sapply(
           paste0(col, ": ", DT.plot[[col]]),
           function(str1) paste(sapply(seq(1, nchar(str1), 32), function(i) paste0(substring(str1, i, min(i + 31, nchar(str1))), '\n')), collapse='')
@@ -446,7 +451,7 @@ setMethod("plot_dists", "seaMass", function(
       for (col in text.cols) DT.plot[, (col) := NULL]
 
       # remove unnecessary columns
-      DT.plot <- DT.plot[, intersect(colnames(DT.plot), c("Summary", "value", "m", "s", "df", "dist", ggcolour.aes, ggfill.aes, "text")), with = F]
+      DT.plot <- DT.plot[, intersect(colnames(DT.plot), c("Summary", y, arg2, arg3, "dist", ggcolour.aes, ggfill.aes, "text")), with = F]
 
       # plot violin!
       args.aes <- list(
@@ -839,15 +844,21 @@ setMethod("plot_robust_pca", "seaMass", function(
 setMethod("lingofy", "seaMass", function(object, x) {
   if (is.null(x)) return(NULL)
   ctrl <- control(root(object))
-  col <- sub("^.*\\.(.*)G$", paste0("\\1\n", ctrl@group[2]), x)
-  col <- sub("^.*\\.(.*)C$", paste0("\\1\n", ctrl@component[2]), col)
-  col <- sub("^.*\\.(.*)M$", paste0("\\1\n", ctrl@measurement[2]), col)
-  col <- sub("^.*\\.(.*)D$", paste0("\\1\nDatapoints"), col)
-  col <- sub("^q\n", "quantified\n", col)
-  col <- sub("^u\n", "used\n", col)
-  col <- sub("^n\n", "total\n", col)
-  col <- sub("^s\n", "stdev of\n", col)
-  col <- sub("^m\n$", "mean of\n", col)
+  col <- sub("^(.*\\..*)G$", paste0("\\1\n", ctrl@group[2]), x)
+  col <- sub("^(.*\\..*)C$", paste0("\\1\n", ctrl@component[2]), col)
+  col <- sub("^(.*\\..*)M$", paste0("\\1\n", ctrl@measurement[2]), col)
+  col <- sub("^(.*\\..*)D$", paste0("\\1\nDatapoints"), col)
+  col <- sub("^(.*\\..*)S$", paste0("\\1\nSamples"), col)
+  col <- sub("^(.*)\\.q\n", "\\1\nquantified\n", col)
+  col <- sub("^(.*)\\.u\n", "\\1\nused\n", col)
+  col <- sub("^(.*)\\.n\n", "\\1\ntotal\n", col)
+  col <- sub("^(.*)\\.s\n", "\\1\nstdev of\n", col)
+  col <- sub("^(.*)\\.m\n$", "\\1\nmean of\n", col)
+  col <- sub("^G\n", paste0("[", ctrl@group[1], "]\n"), col)
+  col <- sub("^C\n", paste0("[", ctrl@component[1], "]\n"), col)
+  col <- sub("^M\n", paste0("[", ctrl@measurement[1], "]\n"), col)
+  col <- sub("^Cont\n", "[Contrast]\n", col)
+  col <- sub("^Base\n", "[Baseline]\n", col)
   return(col)
 })