From 0d9d67ecd249b6fbdcf41c5909c9580e3172e4ff Mon Sep 17 00:00:00 2001 From: Stevie Ped Date: Sun, 11 Feb 2024 22:51:29 +1030 Subject: [PATCH] More bugs and added labelFunX as arg to plotProfileHeatmap --- NAMESPACE | 1 + R/fitAssayDiff.R | 14 ++++++++------ R/mergeByHMP.R | 10 ++++++---- R/plotProfileHeatmap.R | 23 +++++++++++++---------- man/dot-makeFinalProfileHeatmap.Rd | 1 + man/fitAssayDiff-methods.Rd | 8 +++++--- man/plotProfileHeatmap-methods.Rd | 4 ++++ 7 files changed, 38 insertions(+), 23 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 819ebaa3..ff815ce2 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/fitAssayDiff.R b/R/fitAssayDiff.R index b7d45c89..4310969f 100644 --- a/R/fitAssayDiff.R +++ b/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,7 +149,7 @@ 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" @@ -155,7 +157,7 @@ setMethod( 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" diff --git a/R/mergeByHMP.R b/R/mergeByHMP.R index 63a85fca..049a9d65 100644 --- a/R/mergeByHMP.R +++ b/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]) diff --git a/R/plotProfileHeatmap.R b/R/plotProfileHeatmap.R index 1f30988b..42f20a32 100644 --- a/R/plotProfileHeatmap.R +++ b/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( diff --git a/man/dot-makeFinalProfileHeatmap.Rd b/man/dot-makeFinalProfileHeatmap.Rd index de7071c4..9b277b70 100644 --- a/man/dot-makeFinalProfileHeatmap.Rd +++ b/man/dot-makeFinalProfileHeatmap.Rd @@ -18,6 +18,7 @@ x_lab = NULL, y_lab = NULL, fill_lab = NULL, + lab_fun_x = waiver(), label_side = c("left", "right", "none"), ... ) diff --git a/man/fitAssayDiff-methods.Rd b/man/fitAssayDiff-methods.Rd index 218c9889..7c0d7edb 100644 --- a/man/fitAssayDiff-methods.Rd +++ b/man/fitAssayDiff-methods.Rd @@ -22,7 +22,8 @@ fitAssayDiff(x, ...) offset = NULL, null = c("interval", "worst.case"), weighted = FALSE, - ... + ..., + robust = FALSE ) } \arguments{ @@ -30,8 +31,7 @@ fitAssayDiff(x, ...) \item{...}{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}} \item{assay}{The assay to use for analysis} @@ -70,6 +70,8 @@ is created during model fitting} \item{null}{Passed to \link[edgeR]{glmTreat}} \item{weighted}{logical(1) Passed to \link[edgeR]{calcNormFactors}} + +\item{robust}{Passed to \link[limma]{treat} and \link[limma]{eBayes}} } \value{ A SummarizedExperiment object with results set as the \code{rowData} element. diff --git a/man/plotProfileHeatmap-methods.Rd b/man/plotProfileHeatmap-methods.Rd index e66b42a6..ba3ed1fc 100644 --- a/man/plotProfileHeatmap-methods.Rd +++ b/man/plotProfileHeatmap-methods.Rd @@ -21,6 +21,7 @@ plotProfileHeatmap(object, ...) xLab = xValue, yLab = NULL, fillLab = fillValue, + labelFunX = waiver(), relHeight = 0.3, sortFilter = NULL, maxDist = 100, @@ -40,6 +41,7 @@ plotProfileHeatmap(object, ...) xLab = xValue, yLab = NULL, fillLab = fillValue, + labelFunX = waiver(), relHeight = 0.3, summaryLabelSide = "left", respectLevels = FALSE, @@ -73,6 +75,8 @@ contain a line-plot representing this summary value for each x-axis bin} \item{xLab, yLab, fillLab}{Labels for plotting aesthetics. Can be overwritten using labs() on any returned object} +\item{labelFunX}{Function for formatting x-axis labels} + \item{relHeight}{The relative height of the top summary panel. Represents the fraction of the plotting area taken up by the summary panel.}