diff --git a/single_cell/dge/helper_functions/format_pvals.R b/single_cell/dge/helper_functions/format_pvals.R new file mode 100644 index 0000000..4334aa3 --- /dev/null +++ b/single_cell/dge/helper_functions/format_pvals.R @@ -0,0 +1,170 @@ +#' Produces rounded p-values or *-transformed p-values +#' @param pvals Numeric vector of adjusted or unadjusted p-values +#' @parma summarize Logical, TRUE by default, naming whether p-values should be summarized into bins of not significant, significant, more significant, ect. +#' with the exact details of these bins and the exact summary style determined by additional inputs below. +#' @param round Logical, TRUE by default, naming whether pvalues should be rounded to \code{round_digits} digits. +#' @param round_digits Integer giving the number of decimal points for rounding +#' @param sig_cut_l1,sig_cut_l2,sig_cut_l3 Numbers which set the boundaries of significance bins when \code{summarize = TRUE}. +#' In particular, \code{sig_cut_l1} set the primary cutoff where \code{pvals > sig_cut_l1} are deemed not significant. +#' @param non_sig_label String, "NS" by default, giving the label used for non-significant pvalues when \code{summarize = TRUE} +#' @param summarize_style One of '*', 'value', or 'value-l1' which toggles three distinct options for how pvals are transformed when \code{summarize = TRUE}: +#' \itemize{ +#' \item \code{*} = 4 bins using all \code{sig_cut} inputs labeled as \code{non_sig_label}, \code{*}, \code{**}, and \code{***} +#' \item \code{value} = 2 bins using only \code{sig_cut_l1}, labeled as \code{non_sig_label} for non-significant pvals, and the pval itself otherwise (rounded if \code{round = TRUE}) +#' \item \code{value-l1} = 3 bins set using \code{sig_cut_l1} and \code{sig_cut_l2}, labeled as \code{non_sig_label} for non-significant pvals, the pval itself for pvals between \code{sig_cut_l1} and \code{sig_cut_l2} (rounded if \code{round = TRUE}), and '\code{value_style_p_string} < \code{sig_cut_l2}' for pvals smaller than \code{sig_cut_l2}. +#' } +#' @param value_style_p_string String, 'padj' by default, giving a name to call the p-values when \code{summarize = TRUE} and \vode{summarize_style} is \code{'value'} or \code{'value-l1'}. +#' Note that when p-values are not multiple hypothesis corrected this should be changed to 'p' or similar to not give the wrong impression. +#' @param value_style_symbol String, '=' by default, giving the spacer to use between \code{value_style_p_string} and the p-value descriptor, when \code{summarize = TRUE} and \vode{summarize_style} is \code{'value'} or \code{'value-l1'}. +#' @param value_style_compact Logical determining whether to include spaces between \code{value_style_p_string}, \code{value_style_symbol}, and the p-value descriptor, when \code{summarize = TRUE} and \vode{summarize_style} is \code{'value'} or \code{'value-l1'}. +#' @param warn_if_nothing_done Logical which can be set to FALSE to remove the warning provided if the function is called with parameters that turn off all functions, a.k.a. \code{sumarrize = TRUE} and \code{round = TRUE}. +#' @return A string or numeric vector of transformed p-values +#' @details This function rounds and/or transforms given \code{pvals} into any of three summary formats. +#' +#' The function DOES NOT perform multiple hypothesis adjustments. Such adjustment should be performed before running this function. +#' +#' Rounding is performed is \code{round} is \code{TRUE}, to \code{round_digits} number of digits. +#' +#' Pvalues are summarized when \code{summarize} is \code{TRUE}, by first binning pvalues, +#' then labeling in one of three general ways depending on the value of \code{summarize_style}: +#' \itemize{ +#' \item \code{*} = 4 bins: \code{NS}, \code{*}, \code{**}, \code{***} +#' \item \code{value} = 2 bins: \code{NS}, \code{} +#' \item \code{value-l1} = 4 bins: \code{NS}, \code{}, \code{pval < 0.001}, \code{pval < 0.0001} +#' } +#' +#' Bin delineations are given by \code{sig_cut_l1}, \code{sig_cut_l2}, and \code{sig_cut_l3}: +#' \itemize{ +#' \item Non-significant: \code{pvals > sig_cut_l1} (Default: \code{pvals > 0.05}) +#' \item Level1 significance: \code{sig_cut_l1 >= pvals >= sig_cut_l2} (Default: \code{0.05 > pvals >= 0.001}) +#' \item Level2 significance: \code{sig_cut_l2 > pvals >= sig_cut_l3} (Default: \code{0.001 > pvals >= 0.0001}) +#' \item Level3 significance: \code{sig_cut_l3 > pvals} (Default: \code{pvals < 0.0001}) +#' } +#' +#' Note that exact styles of these labels can be adjusted via \code{non_sig_label}, \code{value_style_p_string}, \code{value_style_symbol}, and \code{value_style_compact}. +#' +#' @examples +#' ex_pvals <- c(0.5, 0.055, 0.03, 0.003, 0.0003, 0.00003) +#' +#' format_pvals(ex_pvals) +#' +#' # To only round pvalues, set 'summarize = FALSE' +#' format_pvals(ex_pvals, summarize = FALSE) +#' # Note that if 'round_digits' is set too small, you can get labels of '0' +#' format_pvals(ex_pvals, summarize = FALSE, round_digits = 3) +#' +#' # Change 'summarize_style' to 'value' or 'value-l1' to have a different +#' # summarization scheme. +#' format_pvals(ex_pvals, summarize_style = 'value') +#' format_pvals(ex_pvals, summarize_style = 'value-l1') +#' +#' # If your pvalues are not multiple hypothesis adjusted, it is best to change +#' # 'value_style_p_string' to 'p': +#' format_pvals(ex_pvals, summarize_style = 'value', +#' value_style_p_string = 'p') +#' +#' # To entirely remove the 'pval = ' portion from labels, use all of +#' # 'value_style_p_string', 'value_style_symbol' and 'value_style_compact': +#' format_pvals(ex_pvals, summarize_style = 'value', +#' value_style_p_string = '', +#' value_style_symbol = '', +#' value_style_compact = TRUE) +#' format_pvals(ex_pvals, summarize_style = 'value-l1', +#' value_style_p_string = '', +#' value_style_symbol = '', +#' value_style_compact = TRUE) +#' +#' # Change 'sig_cut_l1', 'sig_cut_l2', or 'sig_cut_l3' to adjust significance and +#' # binning cutoffs. E.g. the below example will highlight and show all p-values +#' # within the murky range of 0.05 to 0.1: +#' format_pvals(ex_pvals, +#' summarize_style = 'value-l1', +#' sig_cut_l1 = 0.1, +#' sig_cut_l2 = 0.05) +#' format_pvals(ex_pvals, +#' summarize_style = 'value-l1', +#' sig_cut_l1 = 0.1, +#' sig_cut_l2 = 0.05, +#' sig_cut_l3 = 0.01, +#' value_style_p_string = '', +#' value_style_symbol = '', +#' value_style_compact = TRUE) +#' @author Dan Bunis +format_pvals <- function( + pvals, + summarize = TRUE, + round = TRUE, + round_digits = 5, + sig_cut_l1 = 0.05, + sig_cut_l2 = 0.001, + sig_cut_l3 = 0.0001, + non_sig_label = "NS", + summarize_style = c('*', 'value', 'value-l1'), + value_style_p_string = 'padj', + value_style_symbol = '=', + value_style_compact = FALSE, + warn_if_nothing_done = TRUE +) { + + if (!summarize && !round && warn_if_nothing_done) { + warning("Nothing to do. 'summarize' and 'round' are both FALSE.") + return (pvals) + } + summarize_style <- match.arg(summarize_style) + if (sig_cut_l2 >= sig_cut_l1) { + stop("'sig_cut_l2' should be smaller than 'sig_cut_l1'") + } + + if (sig_cut_l3 >= sig_cut_l2) { + stop("'sig_cut_l3' should be smaller than 'sig_cut_l2'") + } + if (sig_cut_l3 >= sig_cut_l1) { + stop("'sig_cut_l3' should be smaller than 'sig_cut_l1'") + } + + rounded <- round(pvals, round_digits) + p_use <- out <- if (round) { rounded } else { pvals } + + if (summarize) { + level <- ifelse( + pvals > sig_cut_l1, + 0, + ifelse( + pvals >= sig_cut_l2, + 1, + ifelse( + pvals >= sig_cut_l3, + 2, + 3 + ) + ) + ) + sep <- ifelse(value_style_compact, "", " ") + if (summarize_style=='value') { + out[level==0] <- non_sig_label + out[level>0] <- paste( + sep = sep, value_style_p_string, value_style_symbol, + format(p_use[level>0], drop0trailing = TRUE, scientific=FALSE)) + } else if (summarize_style=='value-l1') { + out[level==0] <- non_sig_label + out[level==1] <- paste( + sep = sep, value_style_p_string, value_style_symbol, + format(p_use[level==1], drop0trailing = TRUE, scientific=FALSE)) + out[level==2] <- paste( + sep = sep, value_style_p_string, "<", + format(sig_cut_l2, drop0trailing = TRUE, scientific=FALSE)) + out[level==3] <- paste( + sep = sep, value_style_p_string, "<", + format(sig_cut_l3, drop0trailing = TRUE, scientific=FALSE)) + } else { + out[level==0] <- non_sig_label + out[level==1] <- "*" + out[level==2] <- "**" + out[level==3] <- "***" + } + } else { + out <- format(out, drop0trailing = TRUE, scientific=FALSE) + } + + out +}