pvalue -log10 transformation (compatible with ggtext)

pval_trans.R

# # MIT License
#
# Copyright (c) 2025 Mickaël Canouil
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:

# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.

# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

#' pval_trans
#' @import scales
pval_trans <- function(
  alpha = NULL,
  md = FALSE,
  prefix = FALSE,
  colour = "#b22222"
) {
  scales::trans_new(
    name = "pval",
    domain = c(0, 1),
    transform = function(x) {
      x[x < .Machine$double.xmin] <- .Machine$double.xmin
      -log(x, 10)
    },
    inverse = function(x) {
      10^-x
    },
    breaks = (function(n = 5, digits = 3) {
      function(x) {
        values <- as.numeric(format(
          x = min(c(x, alpha), na.rm = TRUE),
          scientific = TRUE,
          digits = digits,
          trim = TRUE
        ))
        max_break <- floor(-log(values, base = 10))
        if (max_break == 0) {
          1
        } else {
          sort(unique(c(
            10^-seq(0, max_break, by = floor(max_break / n) + 1),
            alpha
          )))
        }
      }
    })(),
    format = (function(x, digits = 3) {
      if (md & nchar(system.file(package = "ggtext")) != 0) {
        x_fmt <- gsub(
          "^(.*)e[+]*([-]*)0*(.*)$",
          "\\1 &times; 10<sup>\\2\\3</sup>",
          format(x, scientific = TRUE, digits = digits)
        )
        x_fmt[x %in% c(0, 1)] <- x[x %in% c(0, 1)]
        x_fmt <- gsub("^1 &times; ", "", x_fmt)
        if (!is.null(alpha)) {
          prefix_text <- if (prefix) "&alpha; = " else ""
          alpha_idx <- format(x, scientific = TRUE, digits = digits) ==
            format(alpha, scientific = TRUE, digits = digits)
          x_fmt[alpha_idx] <- paste0(
            "<b style='color:",
            colour,
            ";'>",
            prefix_text,
            x_fmt[alpha_idx],
            "</b>"
          )
        }
        x_fmt
      } else {
        x_fmt <- gsub(
          "^(.*)e[+]*([-]*)0*(.*)$",
          "\\1 %*% 10^\\2\\3",
          format(x, scientific = TRUE, digits = digits)
        )
        x_fmt[x %in% c(0, 1)] <- x[x %in% c(0, 1)]
        x_fmt <- gsub("^1 \\%\\*\\% ", "", x_fmt)
        if (!is.null(alpha)) {
          prefix_text <- if (prefix) "alpha == " else ""
          alpha_idx <- format(
            x,
            scientific = TRUE,
            digits = digits,
            trim = TRUE
          ) ==
            format(alpha, scientific = TRUE, digits = digits, trim = TRUE)
          x_fmt[alpha_idx] <- paste0(
            if (prefix) "alpha == " else "",
            x_fmt[alpha_idx]
          )
        }
        sapply(X = x_fmt, function(text) parse(text = text))
      }
    })
  )
}

library(ggplot2)
library(scales)
devtools::source_gist("d7cbc59a7fcbb6d231f432801ec7aa19")
#> Sourcing https://gist.githubusercontent.com/mcanouil/d7cbc59a7fcbb6d231f432801ec7aa19/raw/338f5407f511397e5fe19b2651f02113402262e3/pval_trans.R
#> SHA-1 hash of file is c90a0f6bbe9d84a0da56f9eab7cc323f4cae3039

p <- ggplot(
  data = data.frame(y = 10^-seq(0, 5), x = 1:(5 +1)),
  mapping = aes(x = x, y = y)
) + 
  geom_point() +
  geom_hline(yintercept = 0.05, colour = "firebrick2")

p + scale_y_continuous(trans = "pval")

p + scale_y_continuous(trans = pval_trans(alpha = 0.05, md = FALSE, prefix = FALSE))

p + scale_y_continuous(trans = pval_trans(alpha = 0.05, md = FALSE, prefix = TRUE))

library(ggtext)
p_md <- p + theme(axis.text.y = element_markdown())
p_md + scale_y_continuous(trans = "pval")

p_md + scale_y_continuous(trans = pval_trans(alpha = 0.05, md = TRUE, prefix = FALSE))

p_md + scale_y_continuous(trans = pval_trans(alpha = 0.05, md = TRUE, prefix = TRUE))