More bugs and added labelFunX as arg to plotProfileHeatmap

NAMESPACE

@@ -220,6 +220,7 @@ importFrom(stats,p.adjust.methods)
 importFrom(stats,prcomp)
 importFrom(stats,quantile)
 importFrom(stats,setNames)
+importFrom(stats,weighted.mean)
 importFrom(stringr,str_count)
 importFrom(stringr,str_pad)
 importFrom(stringr,str_replace_all)

R/fitAssayDiff.R

@@ -74,8 +74,8 @@
 #' @param weighted logical(1) Passed to  \link[edgeR]{calcNormFactors}
 #' @param ... Passed to \link[edgeR]{calcNormFactors} and
 #' \link[edgeR]{glmQLFit} when method = "qlf".
-#' If method = "lt", instead passed to \link[limma]{lmFit}, \link[limma]{treat},
-#' \link[limma]{eBayes}
+#' If method = "lt", instead passed to \link[limma]{lmFit}
+#' @param robust Passed to \link[limma]{treat} and \link[limma]{eBayes}
 #'
 #' @examples
 #' nrows <- 200; ncols <- 6
@@ -113,7 +113,7 @@ setMethod(
         norm = c("none", "TMM", "RLE", "TMMwsp", "upperquartile"),
         groups = NULL, fc = 1, lfc = log2(fc), asRanges = FALSE,
         offset = NULL, null = c("interval", "worst.case"),
-        weighted = FALSE, ...
+        weighted = FALSE, ..., robust = FALSE
     ) {
         method <- match.arg(method)
         norm <- match.arg(norm)
@@ -133,7 +133,9 @@ setMethod(
                 x, assay, design, lib.size, norm, groups, offset, weighted, ...
             )
             fit0 <- glmQLFTest(fit, coef = coef) # fits mu0
-            res0 <- topTags(fit0, n = n, adjust.method = "none", sort.by = "none")$table
+            res0 <- topTags(
+                fit0, n = n, adjust.method = "none", sort.by = "none"
+            )$table
             res <- res0
             p_mu0 <- res0$PValue
             if (lfc != 0) {
@@ -147,15 +149,15 @@ setMethod(
         }
         if (method == "lt") {
             fit <- .se2LT(x, assay, design, ...)
-            fit0 <- eBayes(fit, trend = TRUE, ...)
+            fit0 <- eBayes(fit, trend = TRUE, robust = robust)
             res0 <- topTable(
                 fit0, coef = coef, number = n, sort.by = "none",
                 adjust.method = "none"
             )
             res <- res0
             p_mu0 <- res0$P.Value
             if (lfc != 0) {
-                fit <- treat(fit, lfc = lfc, trend = TRUE, ...)
+                fit <- treat(fit, lfc = lfc, trend = TRUE, robust = robust)
                 res <- topTreat(
                     fit, coef = coef, number = n, sort.by = "none",
                     adjust.method = "none"

R/mergeByHMP.R

@@ -81,6 +81,7 @@ setGeneric(
 #' @importFrom dplyr across
 #' @importFrom tidyselect all_of
 #' @importFrom rlang := !! sym
+#' @importFrom stats weighted.mean
 #' @import GenomicRanges
 #' @rdname mergeByHMP-methods
 #' @export
@@ -138,15 +139,16 @@ setMethod(
         ref_hmp <- paste0(hm_pre, ref_p)
         ret_df <- summarise(
             grp_df,
+            n_windows = dplyr::n(),
+            across(
+                all_of(c(cpm, logfc)), \(x) weighted.mean(x, 1 / !!sym(ref_p))
+            ),
             across(
                 all_of(pcol), \(x) .ec_HMP(x, !!sym("weights")),
                 .names = "{hm_pre}{.col}"
             ),
-            n_windows = dplyr::n(),
             n_up = sum(!!sym(logfc) > 0 & !!sym(ref_p) < !!sym(ref_hmp)),
-            n_down = sum(!!sym(logfc) < 0 & !!sym(ref_p) < !!sym(ref_hmp)),
-            "{cpm}" := sum(!!sym(cpm) / !!sym(ref_p)) / sum(1 / !!sym(ref_p)),
-            "{logfc}" :=  sum(!!sym(logfc) / !!sym(ref_p)) / sum(1 / !!sym(ref_p))
+            n_down = sum(!!sym(logfc) < 0 & !!sym(ref_p) < !!sym(ref_hmp))
         )
         ## Replace the 'pval' column in the return columns with 'hmp'
         new_cols <- paste0(hm_pre, ret_cols[ret_cols %in% pcol])

R/plotProfileHeatmap.R

@@ -55,6 +55,7 @@
 #' are at the top of the plot
 #' @param maxDist Maximum distance from the centre to find the strongest signal
 #' when arranging the ranges
+#' @param labelFunX Function for formatting x-axis labels
 #' @param ... Passed to \link[ggplot2]{facet_grid} internally. Can be utilised
 #' for switching panel strips or passing a labeller function
 #'
@@ -103,8 +104,8 @@ setMethod(
         profileCol = "profile_data", xValue = "bp", fillValue = "score",
         facetX = NULL, facetY = NULL, colour = facetY, linetype = NULL,
         summariseBy = c("mean", "median", "min", "max", "none"),
-        xLab = xValue, yLab = NULL, fillLab = fillValue, relHeight = 0.3,
-        sortFilter = NULL, maxDist = 100, ...
+        xLab = xValue, yLab = NULL, fillLab = fillValue, labelFunX = waiver(),
+        relHeight = 0.3, sortFilter = NULL, maxDist = 100, ...
     ) {
 
         ## All elements of the list should usually have identical ranges,
@@ -138,8 +139,9 @@ setMethod(
             object = gr, profileCol = profileCol, xValue = xValue,
             fillValue = fillValue, facetX = facetX, facetY = facetY,
             colour = colour, linetype = linetype, summariseBy = summariseBy,
-            xLab = xLab, yLab = yLab, fillLab = fillLab, relHeight = relHeight,
-            sortFilter = name %in% sortFilter, maxDist = maxDist, ...
+            xLab = xLab, yLab = yLab, fillLab = fillLab, labelFunX = labelFunX,
+            relHeight = relHeight, sortFilter = name %in% sortFilter,
+            maxDist = maxDist, ...
         )
     }
 )
@@ -159,9 +161,9 @@ setMethod(
         profileCol = "profile_data", xValue = "bp", fillValue = "score",
         facetX = NULL, facetY = NULL, colour = facetY, linetype = NULL,
         summariseBy = c("mean", "median", "min", "max", "none"),
-        xLab = xValue, yLab = NULL, fillLab = fillValue, relHeight = 0.3,
-        summaryLabelSide = "left", respectLevels = FALSE, sortFilter = NULL,
-        maxDist = 100, ...
+        xLab = xValue, yLab = NULL, fillLab = fillValue, labelFunX = waiver(),
+        relHeight = 0.3, summaryLabelSide = "left", respectLevels = FALSE,
+        sortFilter = NULL, maxDist = 100, ...
     ) {
 
         ## Check the profile data.frames for identical dims & required cols
@@ -216,7 +218,8 @@ setMethod(
             colour = colour, linetype = linetype, facet_x = facetX,
             facet_y = facetY, summary_fun = summariseBy,
             rel_height = relHeight, x_lab = xLab, y_lab = yLab,
-            fill_lab = fillLab, label_side = summaryLabelSide, ...
+            fill_lab = fillLab, lab_fun_x = labelFunX,
+            label_side = summaryLabelSide, ...
         )
     }
 )
@@ -248,7 +251,7 @@ setMethod(
         facet_x = NULL, facet_y = NULL,
         summary_fun = c("mean", "median", "min", "max", "none"),
         rel_height = 0.3, x_lab = NULL, y_lab = NULL, fill_lab = NULL,
-        label_side = c("left", "right", "none"), ...
+        lab_fun_x = waiver(), label_side = c("left", "right", "none"), ...
 ) {
 
     ## data should be a simple data.frame or tibble used to make the final plot
@@ -269,7 +272,7 @@ setMethod(
     ## The basic plot
     x_axis <- scale_x_discrete(expand = rep(0, 4))
     if (is.numeric(data[[x]]))
-        x_axis <-  scale_x_continuous(expand = rep(0, 4))
+        x_axis <-  scale_x_continuous(expand = rep(0, 4), labels = lab_fun_x)
     p <- ggplot(
         data,
         aes(