Skip to content

Commit

Permalink
Merge branch 'develop-0.5.7'
Browse files Browse the repository at this point in the history
  • Loading branch information
@aphalo
aphalo committed May 13, 2024
2 parents af33b6a + ae6f48a commit 08fc1dc
Show file tree
Hide file tree
Showing 101 changed files with 4,400 additions and 2,782 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Package: ggpmisc
Type: Package
Title: Miscellaneous Extensions to 'ggplot2'
Version: 0.5.6
Date: 2024-05-07
Version: 0.5.6.9001
Date: 2024-05-13
Authors@R:
c(
person("Pedro J.", "Aphalo", email = "pedro.aphalo@helsinki.fi", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3385-972X")),
Expand Down
16 changes: 15 additions & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
# Generated by roxygen2: do not edit by hand

S3method(as.character,polynomial)
S3method(coef,lmodel2)
S3method(confint,lmodel2)
S3method(predict,lmodel2)
Expand All @@ -25,11 +24,23 @@ export(StatQuantBand)
export(StatQuantEq)
export(StatQuantLine)
export(StatValleys)
export(adj_rr_label)
export(bold_label)
export(coefs2poly_eq)
export(f_value_label)
export(find_peaks)
export(italic_label)
export(keep_augment)
export(keep_glance)
export(keep_tidy)
export(outcome2factor)
export(p_value_label)
export(plain_label)
export(poly2character)
export(r_ci_label)
export(r_label)
export(rr_ci_label)
export(rr_label)
export(scale_color_logFC)
export(scale_color_outcome)
export(scale_colour_logFC)
Expand All @@ -43,6 +54,7 @@ export(scale_x_logFC)
export(scale_y_FDR)
export(scale_y_Pvalue)
export(scale_y_logFC)
export(sprintf_dm)
export(stat_correlation)
export(stat_fit_augment)
export(stat_fit_deviations)
Expand All @@ -62,8 +74,10 @@ export(stat_quant_eq)
export(stat_quant_line)
export(stat_valleys)
export(symmetric_limits)
export(t_value_label)
export(threshold2factor)
export(use_label)
export(value2char)
export(xy_outcomes2factor)
export(xy_thresholds2factor)
import(ggpp)
Expand Down
7 changes: 7 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,13 @@ editor_options:
wrap: 72
---

# ggpmisc 0.6.0

- Support decreasing-power order of polynomial terms in `stat_poly_eq()`, `stat_quant_eq()` and `stat_ma_eq()`.
- Return new `qtl.label` for quantiles, separately from `grp.label`, which now works as in the other statistics based on a pseudo aesthetic. **This is a code breaking change affecting some plots.**
- Small visual changes in the formatting labels also affect some plots as the default number of digits was increased in a few cases. New utility functions used in `stat_poly_eq()`, `stat_ma_eq()`, `stat_quant_eq()`, `stat_correlation()`, and `stat_multcomp()`.
- Export new utility functions used for formatting parameter estimates into character strings.

# ggpmisc 0.5.6

- Rename parameter `trans` of `scale_y_Pvalue()` into `transform` to track deprecation in 'ggplot2' 3.5.0.
Expand Down
353 changes: 64 additions & 289 deletions R/stat-correlation.R
View file

Large diffs are not rendered by default.

184 changes: 66 additions & 118 deletions R/stat-ma-eq.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,8 @@
#' the fitted coefficients.
#' @param coef.keep.zeros logical Keep or drop trailing zeros when formatting
#' the fitted coefficients and F-value.
#' @param decreasing logical It specifies the order of the terms in the
#' returned character string; in increasing (default) or decreasing powers.
#' @param rr.digits,theta.digits,p.digits integer Number of digits after the
#' decimal point to use for R^2, theta and P-value in labels. If \code{Inf},
#' use exponential notation with three decimal places.
Expand Down Expand Up @@ -115,6 +117,15 @@
#' little interest and using a larger number for \code{n.min} than the default
#' is usually wise.
#'
#' @section Warning!: For the formatted equation to be valid, the fitted model
#' must be a polynomial, with or without intercept. If defined using
#' \code{poly()} the argument \code{raw = TRUE} must be passed. If defined
#' manually as powers of \code{x}, \strong{the terms must be in order of
#' increasing powers, with no missing intermediate power term.} Please, see
#' examples below. Currently, no check on the model is used to validate that
#' it is a polynomial, so failing to comply with this requirement results in
#' the silent output of an erroneous formatted equation.
#'
#' @section Aesthetics: \code{stat_ma_eq} understands \code{x} and \code{y}, to
#' be referenced in the \code{formula} while the \code{weight} aesthetic is
#' ignored. Both \code{x} and \code{y} must be mapped to \code{numeric}
Expand Down Expand Up @@ -189,24 +200,34 @@
#' stat_ma_line() +
#' stat_ma_eq()
#'
#' ggplot(my.data, aes(x, y)) +
#' geom_point() +
#' stat_ma_line() +
#' stat_ma_eq(mapping = use_label("eq"))
#'
#' ggplot(my.data, aes(x, y)) +
#' geom_point() +
#' stat_ma_line() +
#' stat_ma_eq(mapping = use_label("eq"), decreasing = TRUE)
#'
#' # use_label() can assemble and map a combined label
#' ggplot(my.data, aes(x, y)) +
#' geom_point() +
#' stat_ma_line(method = "MA") +
#' stat_ma_eq(use_label(c("eq", "R2", "P")))
#' stat_ma_eq(mapping = use_label(c("eq", "R2", "P")))
#'
#' ggplot(my.data, aes(x, y)) +
#' geom_point() +
#' stat_ma_line(method = "MA") +
#' stat_ma_eq(use_label(c("R2", "P", "theta", "method")))
#' stat_ma_eq(mapping = use_label(c("R2", "P", "theta", "method")))
#'
#' # using ranged major axis regression
#' ggplot(my.data, aes(x, y)) +
#' geom_point() +
#' stat_ma_line(method = "RMA",
#' range.y = "interval",
#' range.x = "interval") +
#' stat_ma_eq(use_label(c("eq", "R2", "P")),
#' stat_ma_eq(mapping = use_label(c("eq", "R2", "P")),
#' method = "RMA",
#' range.y = "interval",
#' range.x = "interval")
Expand All @@ -215,7 +236,7 @@
#' ggplot(my.data, aes(x, y)) +
#' geom_point() +
#' stat_ma_line(method = "MA") +
#' stat_ma_eq(use_label(c("eq", "R2")),
#' stat_ma_eq(mapping = use_label(c("eq", "R2")),
#' method = "MA",
#' nperm = 0)
#'
Expand All @@ -224,13 +245,13 @@
#' geom_point() +
#' stat_ma_line(formula = x ~ y) +
#' stat_ma_eq(formula = x ~ y,
#' use_label(c("eq", "R2", "P")))
#' mapping = use_label(c("eq", "R2", "P")))
#'
#' # modifying both variables within aes()
#' ggplot(my.data, aes(log(x + 10), log(y + 10))) +
#' geom_point() +
#' stat_poly_line() +
#' stat_poly_eq(use_label("eq"),
#' stat_poly_eq(mapping = use_label("eq"),
#' eq.x.rhs = "~~log(x+10)",
#' eq.with.lhs = "log(y+10)~~`=`~~")
#'
Expand All @@ -245,7 +266,7 @@
#' aes(x, y, shape = group, linetype = group, grp.label = group)) +
#' geom_point() +
#' stat_ma_line(color = "black") +
#' stat_ma_eq(use_label(c("grp", "eq", "R2"))) +
#' stat_ma_eq(mapping = use_label(c("grp", "eq", "R2"))) +
#' theme_classic()
#'
#' # Inspecting the returned data using geom_debug()
Expand All @@ -267,7 +288,7 @@
#' if (gginnards.installed)
#' ggplot(my.data, aes(x, y)) +
#' geom_point() +
#' stat_ma_eq(aes(label = after_stat(eq.label)),
#' stat_ma_eq(mapping = aes(label = after_stat(eq.label)),
#' geom = "debug",
#' output.type = "markdown")
#'
Expand Down Expand Up @@ -301,6 +322,7 @@ stat_ma_eq <- function(mapping = NULL, data = NULL,
small.p = FALSE,
coef.digits = 3,
coef.keep.zeros = TRUE,
decreasing = FALSE,
rr.digits = 2,
theta.digits = 2,
p.digits = max(1, ceiling(log10(nperm))),
Expand Down Expand Up @@ -377,6 +399,7 @@ stat_ma_eq <- function(mapping = NULL, data = NULL,
small.p = small.p,
coef.digits = coef.digits,
coef.keep.zeros = coef.keep.zeros,
decreasing = decreasing,
rr.digits = rr.digits,
theta.digits = theta.digits,
p.digits = p.digits,
Expand Down Expand Up @@ -419,6 +442,7 @@ ma_eq_compute_group_fun <- function(data,
small.p,
coef.digits,
coef.keep.zeros,
decreasing,
rr.digits,
theta.digits,
p.digits,
Expand All @@ -445,7 +469,6 @@ ma_eq_compute_group_fun <- function(data,
warning("Decimal mark must be one of '.' or ',', not: '", decimal.mark, "'")
decimal.mark <- "."
}
# range.sep <- c("." = ", ", "," = "; ")[decimal.mark]

output.type <- if (!length(output.type)) {
"expression"
Expand Down Expand Up @@ -598,7 +621,7 @@ ma_eq_compute_group_fun <- function(data,
b_0.constant = forced.origin)
z <- cbind(z, tibble::as_tibble_row(coefs))
} else {
# set defaults needed to assemble the equation as a character string
# assemble the equation as a character string
if (is.null(eq.x.rhs)) {
eq.x.rhs <- build_eq.x.rhs(output.type = output.type,
orientation = orientation)
Expand All @@ -614,125 +637,50 @@ ma_eq_compute_group_fun <- function(data,
lhs <- character(0)
}

# build equation as a character string from the coefficient estimates
eq.char <- coefs2poly_eq(coefs = coefs,
coef.digits = coef.digits,
coef.keep.zeros = coef.keep.zeros,
decreasing = decreasing,
eq.x.rhs = eq.x.rhs,
lhs = lhs,
output.type = output.type,
decimal.mark = decimal.mark)

# build the other character strings
stopifnot(rr.digits > 0)
if (rr.digits < 2) {
warning("'rr.digits < 2' Likely information loss!")
}
stopifnot(theta.digits > 0)
if (theta.digits < 2) {
warning("'theta.digits < 2' Likely information loss!")
}
stopifnot(p.digits > 0)
if (p.digits < 2) {
warning("'p.digits < 2' Likely information loss!")
}

if (output.type == "expression") {
rr.char <- sprintf_dm("\"%#.*f\"", rr.digits, rr, decimal.mark = decimal.mark)
theta.char <- sprintf_dm("\"%#.*f\"", theta.digits, theta, decimal.mark = decimal.mark)
if (p.digits == Inf) {
p.value.char <- sprintf_dm("%#.2e", p.value, decimal.mark = decimal.mark)
p.value.char <- paste(gsub("e", " %*% 10^{", p.value.char), "}", sep = "")
} else {
p.value.char <- sprintf_dm("\"%#.*f\"", p.digits, p.value, decimal.mark = decimal.mark)
}
} else {
rr.char <- sprintf_dm("%#.*f", rr.digits, rr, decimal.mark = decimal.mark)
theta.char <- sprintf_dm("%#.*f", theta.digits, theta, decimal.mark = decimal.mark)
if (p.digits == Inf) {
p.value.char <- sprintf_dm("%#.2e", p.value, decimal.mark = decimal.mark)
} else {
p.value.char <- sprintf_dm("%#.*f", p.digits, p.value, decimal.mark = decimal.mark)
}
}

# build the data frames to return
if (output.type == "expression") {
z <- tibble::tibble(eq.label = eq.char,
rr.label =
# character(0) instead of "" avoids in paste() the insertion of sep for missing labels
ifelse(is.na(rr), character(0L),
paste(ifelse(small.r, "italic(r)^2", "italic(R)^2"),
ifelse(rr < 10^(-rr.digits) & rr != 0,
sprintf_dm("\"%.*f\"", rr.digits, 10^(-rr.digits), decimal.mark = decimal.mark),
rr.char),
sep = ifelse(rr < 10^(-rr.digits) & rr != 0,
"~`<`~",
"~`=`~"))),
p.value.label =
ifelse(is.na(p.value), character(0L),
paste(ifelse(small.p, "italic(p)[perm]", "italic(P)[perm]"),
ifelse(p.value < 10^(-p.digits),
sprintf_dm("\"%.*f\"", p.digits, 10^(-p.digits), decimal.mark = decimal.mark),
p.value.char),
sep = ifelse(p.value < 10^(-p.digits),
"~`<`~",
"~`=`~"))),
theta.label = paste("italic(theta)~`=`~", theta.char, sep = ""),
n.label = paste("italic(n)~`=`~\"", n, "\"", sep = ""),
grp.label = grp.label,
method.label = paste("\"method: ", method.name, "\"", sep = ""),
r.squared = rr,
theta = theta,
p.value = p.value,
n = n)
} else if (output.type %in% c("latex", "tex", "text", "tikz")) {
z <- tibble::tibble(eq.label = eq.char,
rr.label =
# character(0) instead of "" avoids in paste() the insertion of sep for missing labels
ifelse(is.na(rr), character(0L),
paste(ifelse(small.r, "r^2", "R^2"),
ifelse(rr < 10^(-rr.digits), as.character(10^(-rr.digits)), rr.char),
sep = ifelse(rr < 10^(-rr.digits), " < ", " = "))),
p.value.label =
ifelse(is.na(p.value), character(0L),
paste(ifelse(small.p, "p_{perm}", "P_{perm}"),
ifelse(p.value < 10^(-p.digits), as.character(10^(-p.digits)), p.value.char),
sep = ifelse(p.value < 10^(-p.digits), " < ", " = "))),
theta.label = paste("theta", theta.char, sep = " = "),
n.label = paste("n", n, sep = " = "),
grp.label = grp.label,
method.label = paste("method: ", method.name, sep = ""),
r.squared = rr,
theta = theta,
p.value = p.value,
n = n)
} else if (output.type == "markdown") {
z <- tibble::tibble(eq.label = eq.char,
rr.label =
# character(0) instead of "" avoids in paste() the insertion of sep for missing labels
ifelse(is.na(rr), character(0L),
paste(ifelse(small.r, "_r_<sup>2</sup>", "_R_<sup>2</sup>"),
ifelse(rr < 10^(-rr.digits), as.character(10^(-rr.digits)), rr.char),
sep = ifelse(rr < 10^(-rr.digits), " < ", " = "))),
p.value.label =
ifelse(is.na(p.value), character(0L),
paste(ifelse(small.p, "_p_<sub>perm</sub>", "_P_<sub>perm</sub>"),
ifelse(p.value < 10^(-p.digits), as.character(10^(-p.digits)), p.value.char),
sep = ifelse(p.value < 10^(-p.digits), " < ", " = "))),
theta.label = paste("_&theta;_", theta.char, sep = " = "),
n.label = paste("_n_ = ", n, sep = ""),
grp.label = grp.label,
method.label = paste("method: ", method.name, sep = ""),
r.squared = rr,
theta = theta,
p.value = p.value,
n = n)
} else {
warning("Unknown 'output.type' argument: ", output.type)
}
z <- data.frame(eq.label = eq.char,
rr.label = rr_label(value = rr,
small.r = small.r,
digits = rr.digits,
output.type = output.type,
decimal.mark = decimal.mark),
p.value.label = p_value_label(value = p.value,
subscript = "perm",
small.p = small.p,
digits = p.digits,
output.type = output.type,
decimal.mark = decimal.mark),
theta.label = italic_label(value = theta,
value.name = ifelse(output.type %in% c("latex", "text", "tikz"),
"\theta{}", "theta"),
digits = theta.digits,
fixed = TRUE,
output.type = output.type,
decimal.mark = decimal.mark),
n.label = italic_label(value = n,
value.name = "n",
digits = 0,
fixed = TRUE,
output.type = output.type,
decimal.mark = decimal.mark),
grp.label = grp.label,
method.label = paste("\"method: ", method.name, "\"", sep = ""),
r.squared = rr,
theta = theta,
p.value = p.value,
n = n)
}

# add members common to numeric and other output types
z[["fm.method"]] <- method.name
z[["fm.class"]] <- fm.class[1]
z[["fm.formula"]] <- formula.ls
Expand Down
Loading

0 comments on commit 08fc1dc

Please sign in to comment.