From f1572633e4de26407a7f7884947e7660a3d46296 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Tue, 18 Oct 2022 15:15:20 +0200 Subject: [PATCH 01/17] implement bare scatter --- NAMESPACE | 1 + R/jaspScatter.R | 139 +++++++++++++++++++++++++++++++++++++++++++++ man/jaspScatter.Rd | 82 ++++++++++++++++++++++++++ 3 files changed, 222 insertions(+) create mode 100644 R/jaspScatter.R create mode 100644 man/jaspScatter.Rd diff --git a/NAMESPACE b/NAMESPACE index f3a6ac40..5f2095f0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -54,6 +54,7 @@ export(graphOptions) export(hypothesis2BFtxt) export(is.jaspGraphsPlot) export(jaspHistogram) +export(jaspScatter) export(needsParsing) export(parseThis) export(plotEditing) diff --git a/R/jaspScatter.R b/R/jaspScatter.R new file mode 100644 index 00000000..83ef4904 --- /dev/null +++ b/R/jaspScatter.R @@ -0,0 +1,139 @@ +#' @title Scatter plots with optional confidence and prediction intervals. +#' +#' @description This plot consists of three layers: +#' \enumerate{ +#' \item The distribution of the data displayed as [geom_point] or as a [ggplot2::geom_hex]. +#' \item Smooth line through the data displayed using [ggplot2::geom_smooth]. +#' \item Prediction interval of y given x using [stats::predict.lm](assuming linear relationship), or prediction ellipse assuming bivariate normal distribution. +#' } +#' @param x Numeric vector of values on the x-axis. +#' @param y Numeric vector of values on the y-axis. +#' @param group Optional grouping variable. +#' @param xName Character; x-axis label. +#' @param yName Character; y-axis label. +#' @param type Character; How should the distribution of the data be displayed: +#' \describe{ +#' \item{"point"}{Using [geom_point].} +#' \item{"hex"}{Using [ggplot2::geom_hex].} +#' \item{"contour"}{Using [ggplot2::geom_contour].} +#' } +#' @param bins,binwidth Arguments passed to [ggplot2::geom_hex]. +#' @param palette Argument passed to [JASPcolors]. Palette to use for drawing [ggplot2::geom_hex] and [ggplot2::geom_contour]. +#' @param fill Argument passed to [geom_point]. +#' @param alpha Argument passed to [geom_point] or [ggplot2::geom_hex]. +#' @param smooth Character; passed as \code{method} argument to [ggplot2::geom_smooth], +#' unless \code{smooth == "none"}, in which case the layer si not plotted. +#' @param smoothCi Logical; Should confidence interval around the smooth line be plotted? +#' Passed as \code{se} argument to [ggplot2::geom_smooth]. +#' @param smoothCiLevel Numeric; Confidence level of the confidence interval around the smooth line. +#' Passed as \code{level} argument to [ggplot2::geom_smooth]. +#' @param smoothColor Color of the smooth line. +#' @param predict Character; Method for drawing the prediction interval: +#' \describe{ +#' \item{"none"}{Prediction interval is not displayed.} +#' \item{"lm"}{Prediction interval is plotted, the confidence bands are calculated using [stats::predict.lm].} +#' \item{"ellipse"}{Prediction ellipse is plotted, assuming bi-variate normal model.} +#' } +#' @param predictCiLevel Numeric; Confidence level of the prediction interval. +#' @param predictColor Color of the prediction interval. +#' @param suppressAxesLabels Logical; should axis labels be suppressed. +#' @export +jaspScatter <- function( + x, y, group = NULL, xName = NULL, yName = NULL, + type = c("point", "hex", "bin", "density", "contour"), + args = list(), + smooth = c("none", "lm", "glm", "gam", "loess"), + smoothCi = FALSE, + smoothCiLevel = 0.95, + smoothArgs = list(), + predict = c("none", "lm", "ellipse"), + predictCiLevel = 0.95, + predictArgs = list(), + suppressAxesLabels = FALSE +) { + + if (is.null(group)) { + df <- data.frame(x = x, y = y) + aes <- ggplot2::aes(x = x, y = y) + } else { + df <- data.frame(x = x, y = y, group = group) + aes <- ggplot2::aes(x = x, y = y, group = group, fill = group, color = group) + } + + type <- match.arg(type) + smooth <- match.arg(smooth) + predict <- match.arg(predict) + + + baseGeom <- switch( + type, + point = jaspGraphs::geom_point, + hex = ggplot2::geom_hex, + bin = ggplot2::geom_bin2d, + density = ggplot2::geom_density2d, + contour = ggplot2::geom_density2d_filled + ) + baseLayer <- do.call(baseGeom, args) + + + formula <- switch( + smooth, + gam = if(is.null(smoothArgs$formula)) { y ~ s(x, bs = "cs") } else { smoothArgs$formula }, + if(is.null(smoothArgs$formula)) { y ~ x } else { smoothArgs$formula } + ) + + if (smooth != "none") { + smoothArgs$method <- smooth + smoothArgs$se <- smoothCi + smoothArgs$level <- smoothCiLevel + smoothArgs$formula <- formula + smoothLayer <- do.call(ggplot2::geom_smooth, smoothArgs) + } else { + smoothLayer <- NULL + } + + + if (predict == "lm") { + fit <- lm(y~x, data = df) + preds <- predict(fit, newdata = df, interval = "prediction", level = predictCiLevel) + preds <- as.data.frame(preds) + preds[["x"]] <- df[["x"]] + predictArgs$data <- preds + predictArgs$mapping <- ggplot2::aes(x = x, ymin = lwr, ymax = upr) + predictLayer <- do.call(ggplot2::geom_ribbon, predictArgs) + } else if (predict == "ellipse") { + predictArgs$geom <- "polygon" + predictArgs$type <- "t" + predictArgs$level <- predictCiLevel + predictLayer <- do.call(ggplot2::stat_ellipse, predictArgs) + } else { + predictLayer <- NULL + } + + plot <- ggplot2::ggplot(data = df, mapping = aes) + + predictLayer + + smoothLayer + + baseLayer + + jaspGraphs::themeJaspRaw() + + jaspGraphs::geom_rangeframe() + + ggplot2::xlab(xName) + + ggplot2::ylab(yName)# + + # ggplot2::scale_fill_gradientn(limits = 0:1, colors = JASPcolors(palette = palette)) + + return(plot) +} + + +jaspScatterWithMargins <- function( + x, y, group = NULL, xName = NULL, yName = NULL + ) { + + bottomLeft <- jaspScatter(x = x, y = y) + topLeft <- jaspHistogram(x = x) + bottomRight <- jaspHistogram(x = y) + ggplot2::coord_flip() + topRight <- patchwork::plot_spacer() + + patchwork::wrap_plots( + topLeft, topRight, bottomLeft, bottomRight + ) +} diff --git a/man/jaspScatter.Rd b/man/jaspScatter.Rd new file mode 100644 index 00000000..d5999017 --- /dev/null +++ b/man/jaspScatter.Rd @@ -0,0 +1,82 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/jaspScatter.R +\name{jaspScatter} +\alias{jaspScatter} +\title{Scatter plots with optional confidence and prediction intervals.} +\usage{ +jaspScatter( + x, + y, + group = NULL, + xName = NULL, + yName = NULL, + type = c("point", "hex", "bin", "density", "contour"), + args = list(), + smooth = c("none", "lm", "glm", "gam", "loess"), + smoothCi = FALSE, + smoothCiLevel = 0.95, + smoothArgs = list(), + predict = c("none", "lm", "ellipse"), + predictCiLevel = 0.95, + predictArgs = list(), + suppressAxesLabels = FALSE +) +} +\arguments{ +\item{x}{Numeric vector of values on the x-axis.} + +\item{y}{Numeric vector of values on the y-axis.} + +\item{group}{Optional grouping variable.} + +\item{xName}{Character; x-axis label.} + +\item{yName}{Character; y-axis label.} + +\item{type}{Character; How should the distribution of the data be displayed: +\describe{ +\item{"point"}{Using \link{geom_point}.} +\item{"hex"}{Using \link[ggplot2:geom_hex]{ggplot2::geom_hex}.} +\item{"contour"}{Using \link[ggplot2:geom_contour]{ggplot2::geom_contour}.} +}} + +\item{smooth}{Character; passed as \code{method} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}, +unless \code{smooth == "none"}, in which case the layer si not plotted.} + +\item{smoothCi}{Logical; Should confidence interval around the smooth line be plotted? +Passed as \code{se} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}.} + +\item{smoothCiLevel}{Numeric; Confidence level of the confidence interval around the smooth line. +Passed as \code{level} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}.} + +\item{predict}{Character; Method for drawing the prediction interval: +\describe{ +\item{"none"}{Prediction interval is not displayed.} +\item{"lm"}{Prediction interval is plotted, the confidence bands are calculated using \link[stats:predict.lm]{stats::predict.lm}.} +\item{"ellipse"}{Prediction ellipse is plotted, assuming bi-variate normal model.} +}} + +\item{predictCiLevel}{Numeric; Confidence level of the prediction interval.} + +\item{suppressAxesLabels}{Logical; should axis labels be suppressed.} + +\item{bins, binwidth}{Arguments passed to \link[ggplot2:geom_hex]{ggplot2::geom_hex}.} + +\item{palette}{Argument passed to \link{JASPcolors}. Palette to use for drawing \link[ggplot2:geom_hex]{ggplot2::geom_hex} and \link[ggplot2:geom_contour]{ggplot2::geom_contour}.} + +\item{fill}{Argument passed to \link{geom_point}.} + +\item{alpha}{Argument passed to \link{geom_point} or \link[ggplot2:geom_hex]{ggplot2::geom_hex}.} + +\item{smoothColor}{Color of the smooth line.} + +\item{predictColor}{Color of the prediction interval.} +} +\description{ +This plot consists of three layers: +\enumerate{ +\item The distribution of the data displayed as \link{geom_point} or as a \link[ggplot2:geom_hex]{ggplot2::geom_hex}. +\item Smooth line through the data displayed using \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}. +\item Prediction interval of y given x using \link[stats:predict.lm]{stats::predict.lm}(assuming linear relationship), or prediction ellipse assuming bivariate normal distribution. +} +} From 9e73e446e7ce761bae33463bc83a1294ae6ebce5 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Tue, 18 Oct 2022 18:41:48 +0200 Subject: [PATCH 02/17] basic marginal plot --- R/jaspHistogram.R | 61 +++++++++++++++++++++++++++++++++++++++++--- R/jaspScatter.R | 61 ++++++++++++++++++++++++++++++++++++++------ man/jaspHistogram.Rd | 11 +++++++- man/jaspScatter.Rd | 4 ++- 4 files changed, 123 insertions(+), 14 deletions(-) diff --git a/R/jaspHistogram.R b/R/jaspHistogram.R index de546182..cc5dbd47 100644 --- a/R/jaspHistogram.R +++ b/R/jaspHistogram.R @@ -22,7 +22,10 @@ #' @param densityShade, logical, should the area underneath the density be shaded? #' @param densityShadeAlpha, numeric in \[0, 1\], transparancy for the shaded density. #' @param densityLineWidth, positive number, the line width of the superimposed density. +#' @param hideXAxisLabels, logical, should the x-axis line be hidden? Defaults to \code{FALSE}. #' @param hideYAxisLabels, logical, should the y-axis line be hidden? Defaults to \code{showDensity}. +#' @param hideXAxisName, logical, should the x-axis name be hidden? Defaults to \code{FALSE}. +#' @param hideYAxisName, logical, should the y-axis name be hidden? Defaults to \code{FALSE}. #' @example inst/examples/ex-jaspHistogram.R #' @export jaspHistogram <- function( @@ -40,7 +43,11 @@ jaspHistogram <- function( densityShade = FALSE, densityShadeAlpha = 0.6, densityLineWidth = 1, - hideYAxisLabels = density) { + hideXAxisLabels = FALSE, + hideYAxisLabels = density, + hideXAxisName = FALSE, + hideYAxisName = FALSE + ) { # validate input if (!is.vector(x, mode = "numeric")) @@ -49,7 +56,7 @@ jaspHistogram <- function( if (missing(xName)) xName <- deparse1(substitute(x)) # identical to plot.default - if (!is.character(xName)) + if (!is.character(xName) && !is.null(xName)) stop2("`xName` must be character but has class ", paste(class(xName), collapse = ", "), "!") if (!is.null(groupingVariable) && !is.factor(groupingVariable)) @@ -224,15 +231,61 @@ jaspHistogram <- function( densityShadedAreaGeom + densityLineGeom + rugGeom + - ggplot2::scale_x_continuous(name = xName, breaks = xBreaks, limits = range(xBreaks)) + - ggplot2::scale_y_continuous(name = yName, breaks = yBreaks, limits = range(yBreaks)) + + ggplot2::scale_x_continuous(breaks = xBreaks, limits = range(xBreaks)) + + ggplot2::xlab(xName) + + ggplot2::scale_y_continuous(breaks = yBreaks, limits = range(yBreaks)) + + ggplot2::ylab(yName) + scaleFill + scaleColor + geom_rangeframe() + themeJaspRaw(legend.position = "right") + if (hideXAxisLabels) + plot <- plot + theme(axis.ticks.x = element_blank(), axis.text.x = element_blank()) + if (hideYAxisLabels) plot <- plot + theme(axis.ticks.y = element_blank(), axis.text.y = element_blank()) + if (hideXAxisName) + plot <- plot + theme(axis.title.x = element_blank()) + + if (hideYAxisName) + plot <- plot + theme(axis.title.y = element_blank()) + return(plot) } + +getJaspHistogramBreaks <- function(x, binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA) { + if (!is.vector(x, mode = "numeric")) + stop2("`x` must be a numeric vector but has class ", paste(class(x), collapse = ", ")) + + binWidthType <- match.arg(binWidthType) + x <- stats::na.omit(as.numeric(x)) + + if (binWidthType == "doane") { + + # https://en.wikipedia.org/wiki/Histogram#Doane's_formula + sigma.g1 <- sqrt((6*(length(x) - 2)) / ((length(x) + 1)*(length(x) + 3))) + g1 <- mean(abs(x)^3) + k <- 1 + log2(length(x)) + log2(1 + (g1 / sigma.g1)) + binWidthType <- k + + } else if (binWidthType == "fd" && grDevices::nclass.FD(x) > 10000) { # FD-method will produce extreme number of bins and crash ggplot, mention this in footnote + + warning2("The Freedman-Diaconis method would produce an extreme number of bins, setting the number of bins to 10,000.") + binWidthType <- 10000 + + } else if (binWidthType == "manual") { + + if (is.na(numberOfBins)) + stop2("numberOfBins argument must be specified when a binWidthType == 'manual'.") + + binWidthType <- numberOfBins + + } + + h <- graphics::hist(x, plot = FALSE, breaks = binWidthType) + breaks <- getPrettyAxisBreaks(c(x, h[["breaks"]]), min.n = 3) + + return(breaks) +} diff --git a/R/jaspScatter.R b/R/jaspScatter.R index 83ef4904..3d9e2aed 100644 --- a/R/jaspScatter.R +++ b/R/jaspScatter.R @@ -49,7 +49,9 @@ jaspScatter <- function( predict = c("none", "lm", "ellipse"), predictCiLevel = 0.95, predictArgs = list(), - suppressAxesLabels = FALSE + suppressAxesLabels = FALSE, + xBreaks = NULL, + yBreaks = NULL ) { if (is.null(group)) { @@ -110,6 +112,16 @@ jaspScatter <- function( predictLayer <- NULL } + if (missing(xBreaks) || is.null(xBreaks)) + xBreaks <- getPrettyAxisBreaks(x) + xRange <- range(c(x, xBreaks)) + xScale <- scale_x_continuous(breaks = xBreaks) + + if (missing(yBreaks) || is.null(yBreaks)) + yBreaks <- getPrettyAxisBreaks(y) + yRange <- range(c(y, yBreaks)) + yScale <- scale_y_continuous(breaks = yBreaks) + plot <- ggplot2::ggplot(data = df, mapping = aes) + predictLayer + smoothLayer + @@ -117,23 +129,56 @@ jaspScatter <- function( jaspGraphs::themeJaspRaw() + jaspGraphs::geom_rangeframe() + ggplot2::xlab(xName) + - ggplot2::ylab(yName)# + - # ggplot2::scale_fill_gradientn(limits = 0:1, colors = JASPcolors(palette = palette)) + ggplot2::ylab(yName) + + xScale + + yScale + + # this ensures that the axes do not get stretched outside of the data range + # in case that the bounds of smoothLayer or predictLayer are outside of the region + ggplot2::coord_cartesian(xlim = xRange, ylim = yRange) + + scale_JASPcolor_discrete() return(plot) } jaspScatterWithMargins <- function( - x, y, group = NULL, xName = NULL, yName = NULL + x, y, group = NULL, xName = NULL, yName = NULL, margins = c(0.25, 0.75), + binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA, + histogramArgs = list(density = TRUE) ) { - bottomLeft <- jaspScatter(x = x, y = y) - topLeft <- jaspHistogram(x = x) - bottomRight <- jaspHistogram(x = y) + ggplot2::coord_flip() + xBreaks <- getJaspHistogramBreaks(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) + yBreaks <- getJaspHistogramBreaks(x = y, binWidthType = binWidthType, numberOfBins = numberOfBins) + + bottomLeft <- jaspScatter(x = x, y = y, group = group, xBreaks = xBreaks, yBreaks = yBreaks) + + histogramArgs[["binWidthType"]] <- binWidthType + histogramArgs[["numberOfBins"]] <- numberOfBins + + topLeftArgs <- histogramArgs + topLeftArgs[["x"]] <- x + topLeftArgs[["groupingVariable"]]<- group + topLeftArgs[["groupingVariableName"]] <- " " + topLeftArgs[["hideXAxisLabels"]] <- TRUE + topLeftArgs[["hideYAxisLabels"]] <- TRUE + topLeftArgs[["hideXAxisName"]] <- TRUE + topLeftArgs[["hideYAxisName"]] <- TRUE + topLeft <- do.call(jaspHistogram, topLeftArgs) + + bottomRightArgs <- histogramArgs + bottomRightArgs[["x"]] <- y + bottomRightArgs[["hideXAxisLabels"]] <- TRUE + bottomRightArgs[["hideYAxisLabels"]] <- TRUE + bottomRightArgs[["hideXAxisName"]] <- TRUE + bottomRightArgs[["hideYAxisName"]] <- TRUE + bottomRight <- do.call(jaspHistogram, bottomRightArgs) + + ggplot2::coord_flip() + + topRight <- patchwork::plot_spacer() patchwork::wrap_plots( - topLeft, topRight, bottomLeft, bottomRight + topLeft, topRight, bottomLeft, bottomRight, + widths = rev(margins), heights = margins ) } diff --git a/man/jaspHistogram.Rd b/man/jaspHistogram.Rd index a9a8ab9b..d8539194 100644 --- a/man/jaspHistogram.Rd +++ b/man/jaspHistogram.Rd @@ -20,7 +20,10 @@ jaspHistogram( densityShade = FALSE, densityShadeAlpha = 0.6, densityLineWidth = 1, - hideYAxisLabels = density + hideXAxisLabels = FALSE, + hideYAxisLabels = density, + hideXAxisName = FALSE, + hideYAxisName = FALSE ) } \arguments{ @@ -54,7 +57,13 @@ jaspHistogram( \item{densityLineWidth, }{positive number, the line width of the superimposed density.} +\item{hideXAxisLabels, }{logical, should the x-axis line be hidden? Defaults to \code{FALSE}.} + \item{hideYAxisLabels, }{logical, should the y-axis line be hidden? Defaults to \code{showDensity}.} + +\item{hideXAxisName, }{logical, should the x-axis name be hidden? Defaults to \code{FALSE}.} + +\item{hideYAxisName, }{logical, should the y-axis name be hidden? Defaults to \code{FALSE}.} } \description{ A plot histogram with three components. diff --git a/man/jaspScatter.Rd b/man/jaspScatter.Rd index d5999017..2a3edaf3 100644 --- a/man/jaspScatter.Rd +++ b/man/jaspScatter.Rd @@ -19,7 +19,9 @@ jaspScatter( predict = c("none", "lm", "ellipse"), predictCiLevel = 0.95, predictArgs = list(), - suppressAxesLabels = FALSE + suppressAxesLabels = FALSE, + xBreaks = NULL, + yBreaks = NULL ) } \arguments{ From ad30aabccdfe2d302fd8f7139b9bf749b5ac5e24 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 19 Oct 2022 11:58:24 +0200 Subject: [PATCH 03/17] better handling of xName, yName --- R/jaspScatter.R | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/R/jaspScatter.R b/R/jaspScatter.R index 3d9e2aed..ef232d9a 100644 --- a/R/jaspScatter.R +++ b/R/jaspScatter.R @@ -9,8 +9,8 @@ #' @param x Numeric vector of values on the x-axis. #' @param y Numeric vector of values on the y-axis. #' @param group Optional grouping variable. -#' @param xName Character; x-axis label. -#' @param yName Character; y-axis label. +#' @param xName Character; x-axis label. If left empty, the name of the \code{x} object is displayed. To remove the axis label, use \code{NULL}. +#' @param yName Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}. #' @param type Character; How should the distribution of the data be displayed: #' \describe{ #' \item{"point"}{Using [geom_point].} @@ -39,7 +39,7 @@ #' @param suppressAxesLabels Logical; should axis labels be suppressed. #' @export jaspScatter <- function( - x, y, group = NULL, xName = NULL, yName = NULL, + x, y, group = NULL, xName, yName, type = c("point", "hex", "bin", "density", "contour"), args = list(), smooth = c("none", "lm", "glm", "gam", "loess"), @@ -62,6 +62,12 @@ jaspScatter <- function( aes <- ggplot2::aes(x = x, y = y, group = group, fill = group, color = group) } + if (missing(xName)) + xName <- deparse1(substitute(x)) # identical to plot.default + + if (missing(yName)) + yName <- deparse1(substitute(y)) # identical to plot.default + type <- match.arg(type) smooth <- match.arg(smooth) predict <- match.arg(predict) @@ -81,7 +87,7 @@ jaspScatter <- function( formula <- switch( smooth, gam = if(is.null(smoothArgs$formula)) { y ~ s(x, bs = "cs") } else { smoothArgs$formula }, - if(is.null(smoothArgs$formula)) { y ~ x } else { smoothArgs$formula } + if(is.null(smoothArgs$formula)) { y ~ x } else { smoothArgs$formula } ) if (smooth != "none") { @@ -140,7 +146,6 @@ jaspScatter <- function( return(plot) } - jaspScatterWithMargins <- function( x, y, group = NULL, xName = NULL, yName = NULL, margins = c(0.25, 0.75), binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA, From d27f6d6a541d3e438583c2900c36ac7fe655f6e5 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 19 Oct 2022 12:35:22 +0200 Subject: [PATCH 04/17] use consistent jasp color palette for groups --- R/jaspScatter.R | 47 +++++++++++++++++++++++++++++++++------------- man/jaspScatter.Rd | 10 +++++----- 2 files changed, 39 insertions(+), 18 deletions(-) diff --git a/R/jaspScatter.R b/R/jaspScatter.R index ef232d9a..c3f9f674 100644 --- a/R/jaspScatter.R +++ b/R/jaspScatter.R @@ -41,7 +41,7 @@ jaspScatter <- function( x, y, group = NULL, xName, yName, type = c("point", "hex", "bin", "density", "contour"), - args = list(), + args = list(color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, smoothCiLevel = 0.95, @@ -54,10 +54,17 @@ jaspScatter <- function( yBreaks = NULL ) { + type <- match.arg(type) + smooth <- match.arg(smooth) + predict <- match.arg(predict) + if (is.null(group)) { df <- data.frame(x = x, y = y) aes <- ggplot2::aes(x = x, y = y) } else { + if(type != "point") + stop("grouping variable is allowed only for type = 'point'.") + df <- data.frame(x = x, y = y, group = group) aes <- ggplot2::aes(x = x, y = y, group = group, fill = group, color = group) } @@ -68,10 +75,6 @@ jaspScatter <- function( if (missing(yName)) yName <- deparse1(substitute(y)) # identical to plot.default - type <- match.arg(type) - smooth <- match.arg(smooth) - predict <- match.arg(predict) - baseGeom <- switch( type, @@ -87,7 +90,7 @@ jaspScatter <- function( formula <- switch( smooth, gam = if(is.null(smoothArgs$formula)) { y ~ s(x, bs = "cs") } else { smoothArgs$formula }, - if(is.null(smoothArgs$formula)) { y ~ x } else { smoothArgs$formula } + if(is.null(smoothArgs$formula)) { y ~ x } else { smoothArgs$formula } ) if (smooth != "none") { @@ -128,10 +131,24 @@ jaspScatter <- function( yRange <- range(c(y, yBreaks)) yScale <- scale_y_continuous(breaks = yBreaks) + + if (type == "point" && !is.null(group)) { + scales <- list( + scale_JASPfill_discrete(), + scale_JASPcolor_discrete() + ) + } else if (type %in% c("hex", "bin")) { + scales <- scale_JASPfill_continuous() + } else if (type == "density") { + scales <- scale_JASPfill_discrete() + } else { + scales <- NULL + } + plot <- ggplot2::ggplot(data = df, mapping = aes) + - predictLayer + - smoothLayer + baseLayer + + smoothLayer + + predictLayer + jaspGraphs::themeJaspRaw() + jaspGraphs::geom_rangeframe() + ggplot2::xlab(xName) + @@ -141,21 +158,22 @@ jaspScatter <- function( # this ensures that the axes do not get stretched outside of the data range # in case that the bounds of smoothLayer or predictLayer are outside of the region ggplot2::coord_cartesian(xlim = xRange, ylim = yRange) + - scale_JASPcolor_discrete() + scales return(plot) } jaspScatterWithMargins <- function( - x, y, group = NULL, xName = NULL, yName = NULL, margins = c(0.25, 0.75), + x, y, group = NULL, xName, yName, margins = c(0.25, 0.75), binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA, - histogramArgs = list(density = TRUE) + histogramArgs = list(density = TRUE), + ... ) { xBreaks <- getJaspHistogramBreaks(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) yBreaks <- getJaspHistogramBreaks(x = y, binWidthType = binWidthType, numberOfBins = numberOfBins) - bottomLeft <- jaspScatter(x = x, y = y, group = group, xBreaks = xBreaks, yBreaks = yBreaks) + bottomLeft <- jaspScatter(x = x, y = y, group = group, xName = xName, yName = yName, xBreaks = xBreaks, yBreaks = yBreaks, ...) histogramArgs[["binWidthType"]] <- binWidthType histogramArgs[["numberOfBins"]] <- numberOfBins @@ -172,6 +190,8 @@ jaspScatterWithMargins <- function( bottomRightArgs <- histogramArgs bottomRightArgs[["x"]] <- y + bottomRightArgs[["groupingVariable"]]<- group + bottomRightArgs[["groupingVariableName"]] <- " " bottomRightArgs[["hideXAxisLabels"]] <- TRUE bottomRightArgs[["hideYAxisLabels"]] <- TRUE bottomRightArgs[["hideXAxisName"]] <- TRUE @@ -185,5 +205,6 @@ jaspScatterWithMargins <- function( patchwork::wrap_plots( topLeft, topRight, bottomLeft, bottomRight, widths = rev(margins), heights = margins - ) + ) + + patchwork::plot_layout(guides = "collect") } diff --git a/man/jaspScatter.Rd b/man/jaspScatter.Rd index 2a3edaf3..e88cd44f 100644 --- a/man/jaspScatter.Rd +++ b/man/jaspScatter.Rd @@ -8,10 +8,10 @@ jaspScatter( x, y, group = NULL, - xName = NULL, - yName = NULL, + xName, + yName, type = c("point", "hex", "bin", "density", "contour"), - args = list(), + args = list(color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, smoothCiLevel = 0.95, @@ -31,9 +31,9 @@ jaspScatter( \item{group}{Optional grouping variable.} -\item{xName}{Character; x-axis label.} +\item{xName}{Character; x-axis label. If left empty, the name of the \code{x} object is displayed. To remove the axis label, use \code{NULL}.} -\item{yName}{Character; y-axis label.} +\item{yName}{Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}.} \item{type}{Character; How should the distribution of the data be displayed: \describe{ From 09f78564ffbb4a69d0b4112061b34382163bf501 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 19 Oct 2022 14:15:06 +0200 Subject: [PATCH 05/17] rename jaspScatter to jaspBivariate --- NAMESPACE | 3 +- R/{jaspScatter.R => jaspBivariate.R} | 72 +++++++++++++++++------- man/{jaspScatter.Rd => jaspBivariate.Rd} | 43 +++++++------- man/jaspBivariateWithMargins.Rd | 54 ++++++++++++++++++ 4 files changed, 127 insertions(+), 45 deletions(-) rename R/{jaspScatter.R => jaspBivariate.R} (66%) rename man/{jaspScatter.Rd => jaspBivariate.Rd} (62%) create mode 100644 man/jaspBivariateWithMargins.Rd diff --git a/NAMESPACE b/NAMESPACE index 5f2095f0..15ec626a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -53,8 +53,9 @@ export(ggMatrixPlot) export(graphOptions) export(hypothesis2BFtxt) export(is.jaspGraphsPlot) +export(jaspBivariate) +export(jaspBivariateWithMargins) export(jaspHistogram) -export(jaspScatter) export(needsParsing) export(parseThis) export(plotEditing) diff --git a/R/jaspScatter.R b/R/jaspBivariate.R similarity index 66% rename from R/jaspScatter.R rename to R/jaspBivariate.R index c3f9f674..efb59595 100644 --- a/R/jaspScatter.R +++ b/R/jaspBivariate.R @@ -1,8 +1,8 @@ -#' @title Scatter plots with optional confidence and prediction intervals. +#' @title Bivariate plots with optional confidence and prediction intervals. #' #' @description This plot consists of three layers: #' \enumerate{ -#' \item The distribution of the data displayed as [geom_point] or as a [ggplot2::geom_hex]. +#' \item The bivariate distribution. #' \item Smooth line through the data displayed using [ggplot2::geom_smooth]. #' \item Prediction interval of y given x using [stats::predict.lm](assuming linear relationship), or prediction ellipse assuming bivariate normal distribution. #' } @@ -15,32 +15,32 @@ #' \describe{ #' \item{"point"}{Using [geom_point].} #' \item{"hex"}{Using [ggplot2::geom_hex].} -#' \item{"contour"}{Using [ggplot2::geom_contour].} +#' \item{"bin"}{Using [ggplot2::geom_bin2d].} +#' \item{"contour"}{Using [ggplot2::geom_density2d].} +#' \item{"density"}{Using [ggplot2::geom_density2d_filled].} #' } -#' @param bins,binwidth Arguments passed to [ggplot2::geom_hex]. -#' @param palette Argument passed to [JASPcolors]. Palette to use for drawing [ggplot2::geom_hex] and [ggplot2::geom_contour]. -#' @param fill Argument passed to [geom_point]. -#' @param alpha Argument passed to [geom_point] or [ggplot2::geom_hex]. +#' @param args A list of additional arguments passed to the geom function determined by \code{type} argument. #' @param smooth Character; passed as \code{method} argument to [ggplot2::geom_smooth], -#' unless \code{smooth == "none"}, in which case the layer si not plotted. +#' unless \code{smooth == "none"}, in which case the layer is not plotted. #' @param smoothCi Logical; Should confidence interval around the smooth line be plotted? #' Passed as \code{se} argument to [ggplot2::geom_smooth]. #' @param smoothCiLevel Numeric; Confidence level of the confidence interval around the smooth line. #' Passed as \code{level} argument to [ggplot2::geom_smooth]. -#' @param smoothColor Color of the smooth line. +#' @param smoothArgs A list of additional arguments passed to [ggplot2::geom_smooth]. #' @param predict Character; Method for drawing the prediction interval: #' \describe{ #' \item{"none"}{Prediction interval is not displayed.} #' \item{"lm"}{Prediction interval is plotted, the confidence bands are calculated using [stats::predict.lm].} -#' \item{"ellipse"}{Prediction ellipse is plotted, assuming bi-variate normal model.} +#' \item{"ellipse"}{Prediction ellipse is plotted using [ggplot2::stat_ellipse].} #' } -#' @param predictCiLevel Numeric; Confidence level of the prediction interval. -#' @param predictColor Color of the prediction interval. -#' @param suppressAxesLabels Logical; should axis labels be suppressed. +#' @param predictLevel Numeric; Confidence level of the prediction interval. +#' @param predictArgs A list of additional arguments passed to the function that draws the prediction interval. +#' @param xBreaks Optional numeric vector that specifies the breaks along the x-axis. +#' @param yBreaks Optional numeric vector that specifies the breaks along the y-axis. #' @export -jaspScatter <- function( +jaspBivariate <- function( x, y, group = NULL, xName, yName, - type = c("point", "hex", "bin", "density", "contour"), + type = c("point", "hex", "bin", "contour", "density"), args = list(color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, @@ -49,7 +49,6 @@ jaspScatter <- function( predict = c("none", "lm", "ellipse"), predictCiLevel = 0.95, predictArgs = list(), - suppressAxesLabels = FALSE, xBreaks = NULL, yBreaks = NULL ) { @@ -81,8 +80,8 @@ jaspScatter <- function( point = jaspGraphs::geom_point, hex = ggplot2::geom_hex, bin = ggplot2::geom_bin2d, - density = ggplot2::geom_density2d, - contour = ggplot2::geom_density2d_filled + contour = ggplot2::geom_density2d, + density = ggplot2::geom_density2d_filled ) baseLayer <- do.call(baseGeom, args) @@ -163,17 +162,42 @@ jaspScatter <- function( return(plot) } -jaspScatterWithMargins <- function( +#' @title Bivariate plots with marginal distributions along the axes. +#' +#' @description This plot consists of four elements: +#' \enumerate{ +#' \item The bivariate plot of \code{x} and \code{y} in the bottom-left panel displayed by [jaspBivariate]. +#' \item Marginal distributions along the diagonal displayed by [jaspHistogram]. The plot on the bottom-right has transposed axes. +#' \item (Optional) custom plot on the top-right panel. See details. +#' } +#' +#' @param x Numeric vector of values on the x-axis. +#' @param y Numeric vector of values on the y-axis. +#' @param group Optional grouping variable. +#' @param xName Character; x-axis label. If left empty, the name of the \code{x} object is displayed. To remove the axis label, use \code{NULL}. +#' @param yName Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}. +#' @param margins Numeric vector; The proportions of the subplots relative to each other. +#' @param binWidthType See [jaspHistogram]. Used for determining consistent axes for the bivariate and marginal distribution plots. +#' @param numberOfBins See [jaspHistogram]. Used for determining consistent axes for the bivariate and marginal distribution plots. +#' @param histogramArgs An optional list of options passed to [jaspHistogram]. +#' @param topRightPlotFunction An optional function that can be used to plotting something in the top-right panel. If \code{NULL} (default), an empty area is plotted. +#' @param topRightPlotArgs An optional list of options passed to \code{topRightPlotFunction}. +#' @param ... Additional options passed to [jaspBivariate]. +#' +#' @export +jaspBivariateWithMargins <- function( x, y, group = NULL, xName, yName, margins = c(0.25, 0.75), binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA, histogramArgs = list(density = TRUE), + topRightPlotFunction = NULL, + topRightPlotArgs = list(), ... ) { xBreaks <- getJaspHistogramBreaks(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) yBreaks <- getJaspHistogramBreaks(x = y, binWidthType = binWidthType, numberOfBins = numberOfBins) - bottomLeft <- jaspScatter(x = x, y = y, group = group, xName = xName, yName = yName, xBreaks = xBreaks, yBreaks = yBreaks, ...) + bottomLeft <- jaspBivariate(x = x, y = y, group = group, xName = xName, yName = yName, xBreaks = xBreaks, yBreaks = yBreaks, ...) histogramArgs[["binWidthType"]] <- binWidthType histogramArgs[["numberOfBins"]] <- numberOfBins @@ -200,7 +224,13 @@ jaspScatterWithMargins <- function( ggplot2::coord_flip() - topRight <- patchwork::plot_spacer() + if (is.function(topRightPlotFunction) && is.list(topRightPlotArgs)) { + topRightPlotArgs[["x"]] <- x + topRightPlotArgs[["y"]] <- y + topRight <- do.call(topRightPlotFunction, topRightPlotArgs) + } else if (is.null(topRightPlotFunction)) { + topRight <- patchwork::plot_spacer() + } patchwork::wrap_plots( topLeft, topRight, bottomLeft, bottomRight, diff --git a/man/jaspScatter.Rd b/man/jaspBivariate.Rd similarity index 62% rename from man/jaspScatter.Rd rename to man/jaspBivariate.Rd index e88cd44f..029504c4 100644 --- a/man/jaspScatter.Rd +++ b/man/jaspBivariate.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/jaspScatter.R -\name{jaspScatter} -\alias{jaspScatter} -\title{Scatter plots with optional confidence and prediction intervals.} +% Please edit documentation in R/jaspBivariate.R +\name{jaspBivariate} +\alias{jaspBivariate} +\title{Bivariate plots with optional confidence and prediction intervals.} \usage{ -jaspScatter( +jaspBivariate( x, y, group = NULL, xName, yName, - type = c("point", "hex", "bin", "density", "contour"), + type = c("point", "hex", "bin", "contour", "density"), args = list(color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, @@ -19,7 +19,6 @@ jaspScatter( predict = c("none", "lm", "ellipse"), predictCiLevel = 0.95, predictArgs = list(), - suppressAxesLabels = FALSE, xBreaks = NULL, yBreaks = NULL ) @@ -39,11 +38,15 @@ jaspScatter( \describe{ \item{"point"}{Using \link{geom_point}.} \item{"hex"}{Using \link[ggplot2:geom_hex]{ggplot2::geom_hex}.} -\item{"contour"}{Using \link[ggplot2:geom_contour]{ggplot2::geom_contour}.} +\item{"bin"}{Using \link[ggplot2:geom_bin_2d]{ggplot2::geom_bin2d}.} +\item{"contour"}{Using \link[ggplot2:geom_density_2d]{ggplot2::geom_density2d}.} +\item{"density"}{Using \link[ggplot2:geom_density_2d]{ggplot2::geom_density2d_filled}.} }} +\item{args}{A list of additional arguments passed to the geom function determined by \code{type} argument.} + \item{smooth}{Character; passed as \code{method} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}, -unless \code{smooth == "none"}, in which case the layer si not plotted.} +unless \code{smooth == "none"}, in which case the layer is not plotted.} \item{smoothCi}{Logical; Should confidence interval around the smooth line be plotted? Passed as \code{se} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}.} @@ -51,33 +54,27 @@ Passed as \code{se} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smooth} \item{smoothCiLevel}{Numeric; Confidence level of the confidence interval around the smooth line. Passed as \code{level} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}.} +\item{smoothArgs}{A list of additional arguments passed to \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}.} + \item{predict}{Character; Method for drawing the prediction interval: \describe{ \item{"none"}{Prediction interval is not displayed.} \item{"lm"}{Prediction interval is plotted, the confidence bands are calculated using \link[stats:predict.lm]{stats::predict.lm}.} -\item{"ellipse"}{Prediction ellipse is plotted, assuming bi-variate normal model.} +\item{"ellipse"}{Prediction ellipse is plotted using \link[ggplot2:stat_ellipse]{ggplot2::stat_ellipse}.} }} -\item{predictCiLevel}{Numeric; Confidence level of the prediction interval.} - -\item{suppressAxesLabels}{Logical; should axis labels be suppressed.} - -\item{bins, binwidth}{Arguments passed to \link[ggplot2:geom_hex]{ggplot2::geom_hex}.} - -\item{palette}{Argument passed to \link{JASPcolors}. Palette to use for drawing \link[ggplot2:geom_hex]{ggplot2::geom_hex} and \link[ggplot2:geom_contour]{ggplot2::geom_contour}.} - -\item{fill}{Argument passed to \link{geom_point}.} +\item{predictArgs}{A list of additional arguments passed to the function that draws the prediction interval.} -\item{alpha}{Argument passed to \link{geom_point} or \link[ggplot2:geom_hex]{ggplot2::geom_hex}.} +\item{xBreaks}{Optional numeric vector that specifies the breaks along the x-axis.} -\item{smoothColor}{Color of the smooth line.} +\item{yBreaks}{Optional numeric vector that specifies the breaks along the y-axis.} -\item{predictColor}{Color of the prediction interval.} +\item{predictLevel}{Numeric; Confidence level of the prediction interval.} } \description{ This plot consists of three layers: \enumerate{ -\item The distribution of the data displayed as \link{geom_point} or as a \link[ggplot2:geom_hex]{ggplot2::geom_hex}. +\item The bivariate distribution. \item Smooth line through the data displayed using \link[ggplot2:geom_smooth]{ggplot2::geom_smooth}. \item Prediction interval of y given x using \link[stats:predict.lm]{stats::predict.lm}(assuming linear relationship), or prediction ellipse assuming bivariate normal distribution. } diff --git a/man/jaspBivariateWithMargins.Rd b/man/jaspBivariateWithMargins.Rd new file mode 100644 index 00000000..74d128f4 --- /dev/null +++ b/man/jaspBivariateWithMargins.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/jaspBivariate.R +\name{jaspBivariateWithMargins} +\alias{jaspBivariateWithMargins} +\title{Bivariate plots with marginal distributions along the axes.} +\usage{ +jaspBivariateWithMargins( + x, + y, + group = NULL, + xName, + yName, + margins = c(0.25, 0.75), + binWidthType = c("doane", "fd", "scott", "sturges", "manual"), + numberOfBins = NA, + histogramArgs = list(density = TRUE), + topRightPlotFunction = NULL, + topRightPlotArgs = list(), + ... +) +} +\arguments{ +\item{x}{Numeric vector of values on the x-axis.} + +\item{y}{Numeric vector of values on the y-axis.} + +\item{group}{Optional grouping variable.} + +\item{xName}{Character; x-axis label. If left empty, the name of the \code{x} object is displayed. To remove the axis label, use \code{NULL}.} + +\item{yName}{Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}.} + +\item{margins}{Numeric vector; The proportions of the subplots relative to each other.} + +\item{binWidthType}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} + +\item{numberOfBins}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} + +\item{histogramArgs}{An optional list of options passed to \link{jaspHistogram}.} + +\item{topRightPlotFunction}{An optional function that can be used to plotting something in the top-right panel. If \code{NULL} (default), an empty area is plotted.} + +\item{topRightPlotArgs}{An optional list of options passed to \code{topRightPlotFunction}.} + +\item{...}{Additional options passed to \link{jaspBivariate}.} +} +\description{ +This plot consists of four elements: +\enumerate{ +\item The bivariate plot of \code{x} and \code{y} in the bottom-left panel displayed by \link{jaspBivariate}. +\item Marginal distributions along the diagonal displayed by \link{jaspHistogram}. The plot on the bottom-right has transposed axes. +\item (Optional) custom plot on the top-right panel. See details. +} +} From e04bda29ea39e86f540568ec79b4f86146801317 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 19 Oct 2022 14:54:40 +0200 Subject: [PATCH 06/17] fixe groupName and legend position stuff --- R/jaspBivariate.R | 66 ++++++++++++++++++++------------- man/jaspBivariate.Rd | 12 ++++-- man/jaspBivariateWithMargins.Rd | 3 ++ 3 files changed, 51 insertions(+), 30 deletions(-) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index efb59595..30b8ddce 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -11,6 +11,7 @@ #' @param group Optional grouping variable. #' @param xName Character; x-axis label. If left empty, the name of the \code{x} object is displayed. To remove the axis label, use \code{NULL}. #' @param yName Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}. +#' @param groupName Character; label of the grouping variable displayed as a legend title. If left empty, the name of the \code{group} object is displayed. #' @param type Character; How should the distribution of the data be displayed: #' \describe{ #' \item{"point"}{Using [geom_point].} @@ -37,9 +38,10 @@ #' @param predictArgs A list of additional arguments passed to the function that draws the prediction interval. #' @param xBreaks Optional numeric vector that specifies the breaks along the x-axis. #' @param yBreaks Optional numeric vector that specifies the breaks along the y-axis. +#' @param legendPosition Character; passed as \code{legend.position} to [themeJaspRaw]. #' @export jaspBivariate <- function( - x, y, group = NULL, xName, yName, + x, y, group = NULL, xName, yName, groupName, type = c("point", "hex", "bin", "contour", "density"), args = list(color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), @@ -47,10 +49,11 @@ jaspBivariate <- function( smoothCiLevel = 0.95, smoothArgs = list(), predict = c("none", "lm", "ellipse"), - predictCiLevel = 0.95, + predictLevel = 0.95, predictArgs = list(), xBreaks = NULL, - yBreaks = NULL + yBreaks = NULL, + legendPosition = "none" ) { type <- match.arg(type) @@ -74,6 +77,9 @@ jaspBivariate <- function( if (missing(yName)) yName <- deparse1(substitute(y)) # identical to plot.default + if (!is.null(group) && missing(groupName)) + groupName <- deparse1(substitute(group)) + baseGeom <- switch( type, @@ -105,7 +111,7 @@ jaspBivariate <- function( if (predict == "lm") { fit <- lm(y~x, data = df) - preds <- predict(fit, newdata = df, interval = "prediction", level = predictCiLevel) + preds <- predict(fit, newdata = df, interval = "prediction", level = predictLevel) preds <- as.data.frame(preds) preds[["x"]] <- df[["x"]] predictArgs$data <- preds @@ -114,7 +120,7 @@ jaspBivariate <- function( } else if (predict == "ellipse") { predictArgs$geom <- "polygon" predictArgs$type <- "t" - predictArgs$level <- predictCiLevel + predictArgs$level <- predictLevel predictLayer <- do.call(ggplot2::stat_ellipse, predictArgs) } else { predictLayer <- NULL @@ -133,8 +139,8 @@ jaspBivariate <- function( if (type == "point" && !is.null(group)) { scales <- list( - scale_JASPfill_discrete(), - scale_JASPcolor_discrete() + scale_JASPfill_discrete(name = groupName), + scale_JASPcolor_discrete(name = groupName) ) } else if (type %in% c("hex", "bin")) { scales <- scale_JASPfill_continuous() @@ -148,7 +154,7 @@ jaspBivariate <- function( baseLayer + smoothLayer + predictLayer + - jaspGraphs::themeJaspRaw() + + jaspGraphs::themeJaspRaw(legend.position = legendPosition) + jaspGraphs::geom_rangeframe() + ggplot2::xlab(xName) + ggplot2::ylab(yName) + @@ -176,6 +182,7 @@ jaspBivariate <- function( #' @param group Optional grouping variable. #' @param xName Character; x-axis label. If left empty, the name of the \code{x} object is displayed. To remove the axis label, use \code{NULL}. #' @param yName Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}. +#' @param groupName Character; label of the grouping variable displayed as a legend title. If left empty, the name of the \code{group} object is displayed. #' @param margins Numeric vector; The proportions of the subplots relative to each other. #' @param binWidthType See [jaspHistogram]. Used for determining consistent axes for the bivariate and marginal distribution plots. #' @param numberOfBins See [jaspHistogram]. Used for determining consistent axes for the bivariate and marginal distribution plots. @@ -186,7 +193,7 @@ jaspBivariate <- function( #' #' @export jaspBivariateWithMargins <- function( - x, y, group = NULL, xName, yName, margins = c(0.25, 0.75), + x, y, group = NULL, xName, yName, groupName, margins = c(0.25, 0.75), binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA, histogramArgs = list(density = TRUE), topRightPlotFunction = NULL, @@ -194,32 +201,39 @@ jaspBivariateWithMargins <- function( ... ) { + if (!is.null(group) && missing(groupName)) { + groupName <- deparse1(substitute(group)) + } else if(missing(groupName)) { + groupName <- "" + } + xBreaks <- getJaspHistogramBreaks(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) yBreaks <- getJaspHistogramBreaks(x = y, binWidthType = binWidthType, numberOfBins = numberOfBins) - bottomLeft <- jaspBivariate(x = x, y = y, group = group, xName = xName, yName = yName, xBreaks = xBreaks, yBreaks = yBreaks, ...) + bottomLeft <- jaspBivariate(x = x, y = y, group = group, xName = xName, yName = yName, groupName = groupName, xBreaks = xBreaks, yBreaks = yBreaks, ...) + histogramArgs[["binWidthType"]] <- binWidthType histogramArgs[["numberOfBins"]] <- numberOfBins - topLeftArgs <- histogramArgs - topLeftArgs[["x"]] <- x - topLeftArgs[["groupingVariable"]]<- group - topLeftArgs[["groupingVariableName"]] <- " " - topLeftArgs[["hideXAxisLabels"]] <- TRUE - topLeftArgs[["hideYAxisLabels"]] <- TRUE - topLeftArgs[["hideXAxisName"]] <- TRUE - topLeftArgs[["hideYAxisName"]] <- TRUE + topLeftArgs <- histogramArgs + topLeftArgs[["x"]] <- x + topLeftArgs[["groupingVariable"]] <- group + topLeftArgs[["groupingVariableName"]] <- groupName + topLeftArgs[["hideXAxisLabels"]] <- TRUE + topLeftArgs[["hideYAxisLabels"]] <- TRUE + topLeftArgs[["hideXAxisName"]] <- TRUE + topLeftArgs[["hideYAxisName"]] <- TRUE topLeft <- do.call(jaspHistogram, topLeftArgs) - bottomRightArgs <- histogramArgs - bottomRightArgs[["x"]] <- y - bottomRightArgs[["groupingVariable"]]<- group - bottomRightArgs[["groupingVariableName"]] <- " " - bottomRightArgs[["hideXAxisLabels"]] <- TRUE - bottomRightArgs[["hideYAxisLabels"]] <- TRUE - bottomRightArgs[["hideXAxisName"]] <- TRUE - bottomRightArgs[["hideYAxisName"]] <- TRUE + bottomRightArgs <- histogramArgs + bottomRightArgs[["x"]] <- y + bottomRightArgs[["groupingVariable"]] <- group + bottomRightArgs[["groupingVariableName"]] <- groupName + bottomRightArgs[["hideXAxisLabels"]] <- TRUE + bottomRightArgs[["hideYAxisLabels"]] <- TRUE + bottomRightArgs[["hideXAxisName"]] <- TRUE + bottomRightArgs[["hideYAxisName"]] <- TRUE bottomRight <- do.call(jaspHistogram, bottomRightArgs) + ggplot2::coord_flip() diff --git a/man/jaspBivariate.Rd b/man/jaspBivariate.Rd index 029504c4..170abeed 100644 --- a/man/jaspBivariate.Rd +++ b/man/jaspBivariate.Rd @@ -10,6 +10,7 @@ jaspBivariate( group = NULL, xName, yName, + groupName, type = c("point", "hex", "bin", "contour", "density"), args = list(color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), @@ -17,10 +18,11 @@ jaspBivariate( smoothCiLevel = 0.95, smoothArgs = list(), predict = c("none", "lm", "ellipse"), - predictCiLevel = 0.95, + predictLevel = 0.95, predictArgs = list(), xBreaks = NULL, - yBreaks = NULL + yBreaks = NULL, + legendPosition = "none" ) } \arguments{ @@ -34,6 +36,8 @@ jaspBivariate( \item{yName}{Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}.} +\item{groupName}{Character; label of the grouping variable displayed as a legend title. If left empty, the name of the \code{group} object is displayed.} + \item{type}{Character; How should the distribution of the data be displayed: \describe{ \item{"point"}{Using \link{geom_point}.} @@ -63,13 +67,13 @@ Passed as \code{level} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smoo \item{"ellipse"}{Prediction ellipse is plotted using \link[ggplot2:stat_ellipse]{ggplot2::stat_ellipse}.} }} +\item{predictLevel}{Numeric; Confidence level of the prediction interval.} + \item{predictArgs}{A list of additional arguments passed to the function that draws the prediction interval.} \item{xBreaks}{Optional numeric vector that specifies the breaks along the x-axis.} \item{yBreaks}{Optional numeric vector that specifies the breaks along the y-axis.} - -\item{predictLevel}{Numeric; Confidence level of the prediction interval.} } \description{ This plot consists of three layers: diff --git a/man/jaspBivariateWithMargins.Rd b/man/jaspBivariateWithMargins.Rd index 74d128f4..0b481bc3 100644 --- a/man/jaspBivariateWithMargins.Rd +++ b/man/jaspBivariateWithMargins.Rd @@ -10,6 +10,7 @@ jaspBivariateWithMargins( group = NULL, xName, yName, + groupName, margins = c(0.25, 0.75), binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA, @@ -30,6 +31,8 @@ jaspBivariateWithMargins( \item{yName}{Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}.} +\item{groupName}{Character; label of the grouping variable displayed as a legend title. If left empty, the name of the \code{group} object is displayed.} + \item{margins}{Numeric vector; The proportions of the subplots relative to each other.} \item{binWidthType}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} From cc6f65aefbb030ca70416962e4a9b49d89d706df Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 19 Oct 2022 14:57:42 +0200 Subject: [PATCH 07/17] reduce code duplication --- R/jaspBivariate.R | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index 30b8ddce..145216d3 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -212,28 +212,23 @@ jaspBivariateWithMargins <- function( bottomLeft <- jaspBivariate(x = x, y = y, group = group, xName = xName, yName = yName, groupName = groupName, xBreaks = xBreaks, yBreaks = yBreaks, ...) - - histogramArgs[["binWidthType"]] <- binWidthType - histogramArgs[["numberOfBins"]] <- numberOfBins + histogramArgs[["binWidthType"]] <- binWidthType + histogramArgs[["numberOfBins"]] <- numberOfBins + histogramArgs[["groupingVariable"]] <- group + histogramArgs[["groupingVariableName"]] <- groupName + histogramArgs[["hideXAxisLabel"]] <- TRUE + histogramArgs[["hideXAxisLabel"]] <- TRUE + histogramArgs[["hideXAxisName"]] <- TRUE + histogramArgs[["hideYAxisName"]] <- TRUE topLeftArgs <- histogramArgs topLeftArgs[["x"]] <- x - topLeftArgs[["groupingVariable"]] <- group - topLeftArgs[["groupingVariableName"]] <- groupName - topLeftArgs[["hideXAxisLabels"]] <- TRUE - topLeftArgs[["hideYAxisLabels"]] <- TRUE - topLeftArgs[["hideXAxisName"]] <- TRUE - topLeftArgs[["hideYAxisName"]] <- TRUE + topLeft <- do.call(jaspHistogram, topLeftArgs) bottomRightArgs <- histogramArgs bottomRightArgs[["x"]] <- y - bottomRightArgs[["groupingVariable"]] <- group - bottomRightArgs[["groupingVariableName"]] <- groupName - bottomRightArgs[["hideXAxisLabels"]] <- TRUE - bottomRightArgs[["hideYAxisLabels"]] <- TRUE - bottomRightArgs[["hideXAxisName"]] <- TRUE - bottomRightArgs[["hideYAxisName"]] <- TRUE + bottomRight <- do.call(jaspHistogram, bottomRightArgs) + ggplot2::coord_flip() From 1416a17e3033e6b9fd87814c745b86a0f5cfd3b6 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 19 Oct 2022 17:35:35 +0200 Subject: [PATCH 08/17] add jaspMatrixPlot --- NAMESPACE | 1 + R/jaspBivariate.R | 9 ++- R/jaspMatrixPlot.R | 174 ++++++++++++++++++++++++++++++++++++++++++ man/jaspBivariate.Rd | 4 +- man/jaspMatrixPlot.Rd | 55 +++++++++++++ 5 files changed, 238 insertions(+), 5 deletions(-) create mode 100644 R/jaspMatrixPlot.R create mode 100644 man/jaspMatrixPlot.Rd diff --git a/NAMESPACE b/NAMESPACE index 15ec626a..1059c76c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -56,6 +56,7 @@ export(is.jaspGraphsPlot) export(jaspBivariate) export(jaspBivariateWithMargins) export(jaspHistogram) +export(jaspMatrixPlot) export(needsParsing) export(parseThis) export(plotEditing) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index 145216d3..8b0b7bff 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -42,7 +42,7 @@ #' @export jaspBivariate <- function( x, y, group = NULL, xName, yName, groupName, - type = c("point", "hex", "bin", "contour", "density"), + type = c("point", "hex", "bin", "contour", "density", "none"), args = list(color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, @@ -64,8 +64,8 @@ jaspBivariate <- function( df <- data.frame(x = x, y = y) aes <- ggplot2::aes(x = x, y = y) } else { - if(type != "point") - stop("grouping variable is allowed only for type = 'point'.") + if(type != "point" && type != "none") + stop("grouping variable is allowed only for type = 'point' or 'none'.") df <- data.frame(x = x, y = y, group = group) aes <- ggplot2::aes(x = x, y = y, group = group, fill = group, color = group) @@ -87,7 +87,8 @@ jaspBivariate <- function( hex = ggplot2::geom_hex, bin = ggplot2::geom_bin2d, contour = ggplot2::geom_density2d, - density = ggplot2::geom_density2d_filled + density = ggplot2::geom_density2d_filled, + none = function(...) { return(NULL) } ) baseLayer <- do.call(baseGeom, args) diff --git a/R/jaspMatrixPlot.R b/R/jaspMatrixPlot.R new file mode 100644 index 00000000..d5dd7d5e --- /dev/null +++ b/R/jaspMatrixPlot.R @@ -0,0 +1,174 @@ +#' Matrix plot +#' +#' @description Plot that consists of \code{ncol{data}} by \code{ncol{data}} plots, +#' where subplot on position \eqn{(i, j)} plots \code{data[, c(i, j)]}. +#' The plot can display three different types of plots: +#' \describe{ +#' \item{\code{diagonal}}{Where \code{i == j}.} +#' \item{\code{topRight}}{Where \code{i < j}.} +#' \item{\code{bottomLeft}}{Where \code{i > j}.} +#' } +#' +#' @param data Data frame of data to plot. +#' @param diagonal A function that draws the plots on the diagonal. Must accept arguments \code{x} (numeric), \code{xName} (character). +#' @param diagonalArgs A list of additional arguments to pass to \code{diagonal}. +#' @param topRight A function that draws the plots on the top right off-diagonal. Must accept arguments \code{x} (numeric), \code{y} (numeric), \code{xName} (character), and \code{yName} (character). +#' @param topRightArgs A list of additional arguments to pass to \code{topRight}. +#' @param bottomLeft A function that draws the plots on the bottom left off-diagonal. Must accept arguments \code{x} (numeric), \code{y} (numeric), \code{xName} (character), and \code{yName} (character). +#' @param bottomLeftArgs A list of additional arguments to pass to \code{bottomLeft}. +#' @param overwriteDiagonalAxes,overwriteTopRightAxes,overwriteBottomLeftAxes Which axes should be overwritten such that they have a common range. Possible options: +#' \describe{ +#' \item{\code{"none"}}{No axes are overwritten, hence the plots get their own scales given by \code{diagonal}, \code{topRight}, and \code{bottomLeft} functions, respectively.} +#' \item{\code{"both"}}{Both axes are overwritten. The plots inherit scales by setting their \code{breaks} determined by [getPrettyAxisBreaks], and the plotting region is set by [ggplot2::coord_cartesian] with \code{limits} set to \code{range(breaks)}. Further, the name of the axis is set to \code{NULL}.} +#' \item{\code{"x"}}{x-axis gets overwritten (see option \code{"both"}), y-axis does not (see option \code{"none"}).} +#' \item{\code{"y"}}{y-axis gets overwritten (see option \code{"both"}), x-axis does not (see option \code{"none"}).} +#' } +#' @param axesLabels Optional character vector; provide column/row names of the matrix. +#' @export +jaspMatrixPlot <- function( + data, + diagonalPlotFunction = jaspHistogram, + diagonalPlotArgs = list(), + topRightPlotFunction = jaspBivariate, + topRightPlotArgs = list(), + bottomLeftPlotFunction = NULL, + bottomLeftPlotArgs = list(), + overwriteDiagonalAxes = "x", + overwriteTopRightAxes = "both", + overwriteBottomLeftAxes = "both", + axesLabels +) { + + # validate input + if (!is.data.frame(data) || nrow(data) == 0 || ncol(data) < 2) + stop2("`data` must be a data frame") + + if(missing(axesLabels)) { + axesLabels <- colnames(data) + } else if(ncol(data) != length(axesLabels)) { + stop2("`axesLabels` must be the same length as `ncol(data)`.") + } + + isNumeric <- vapply(data, is.numeric, logical(1)) + data <- data[, isNumeric, drop = FALSE] + axesLabels <- axesLabels[isNumeric] + + if (ncol(data) < 2) + stop2("`data` must have more than 1 numeric column.") + + overwriteDiagonalAxes <- match.arg(overwriteDiagonalAxes, choices = c("none", "both", "x", "y")) + overwriteTopRightAxes <- match.arg(overwriteTopRightAxes, choices = c("none", "both", "x", "y")) + overwriteBottomLeftAxes <- match.arg(overwriteBottomLeftAxes, choices = c("none", "both", "x", "y")) + + titles <- c(list(patchwork::plot_spacer()), lapply(axesLabels, .makeTitle)) + + plots <- titles + i <- length(plots) + 1 + for (row in seq_along(axesLabels)) { + y <- data[[row]] + yName <- axesLabels[[row]] + yBreaks <- getJaspHistogramBreaks(y) + + plots[[i]] <- .makeTitle(yName, angle = 90) + i <- i + 1 + + for (col in seq_along(axesLabels)) { + x <- data[[col]] + xName <- axesLabels[[col]] + xBreaks <- getJaspHistogramBreaks(x) + + if (row == col) { # diagonal + if(is.function(diagonalPlotFunction)) { + diagonalPlotArgs[["x"]] <- x + diagonalPlotArgs[["xName"]] <- xName + plot <- .trySubPlot(diagonalPlotFunction, diagonalPlotArgs, overwriteDiagonalAxes) + } else { + plot <- patchwork::plot_spacer() + } + } else if(row < col) { # topRight + if(is.function(topRightPlotFunction)) { + topRightPlotArgs[["x"]] <- x + topRightPlotArgs[["y"]] <- y + topRightPlotArgs[["xName"]] <- xName + topRightPlotArgs[["yName"]] <- yName + topRightPlotArgs[["xBreaks"]] <- xBreaks + topRightPlotArgs[["yBreaks"]] <- yBreaks + plot <- .trySubPlot(topRightPlotFunction, topRightPlotArgs, overwriteTopRightAxes) + } else { + plot <- patchwork::plot_spacer() + } + } else { # bottomLeft + if(is.function(bottomLeftPlotFunction)) { + bottomLeftPlotArgs[["x"]] <- x + bottomLeftPlotArgs[["y"]] <- y + bottomLeftPlotArgs[["xName"]] <- xName + bottomLeftPlotArgs[["yName"]] <- yName + bottomLeftPlotArgs[["xBreaks"]] <- xBreaks + bottomLeftPlotArgs[["yBreaks"]] <- yBreaks + plot <- .trySubPlot(bottomLeftPlotFunction, bottomLeftPlotArgs, overwriteBottomLeftAxes) + } else { + plot <- patchwork::plot_spacer() + } + } + # plots[[col, row]] <- plot + plots[[i]] <- plot + i <- i + 1 + } + } + + margins <- c(1*length(axesLabels), rep(9, length(axesLabels))) + + out <- patchwork::wrap_plots(plots, ncol = ncol(data)+1, nrow = ncol(data)+1, byrow = TRUE, widths = margins, heights = margins) + out <- out + patchwork::plot_layout(guides = "collect") + return(out) +} + +.makeTitle <- function(nm, angle = 0) { + ggplot2::ggplot() + + ggplot2::annotate( + "text", + x = 1/2, y = 1/2, label = nm, angle = angle, + size = 1.2 * jaspGraphs::getGraphOption("fontsize") / ggplot2::.pt + ) + + ggplot2::ylim(0:1) + ggplot2::xlim(0:1) + + ggplot2::theme_void() +} + +.makeErrorPlot <- function(e) { + message <- as.character(e) + message <- strsplit(message, ": ")[[1]] + message <- paste(message[-1], collapse = "") + message <- strwrap(message, width = 20, initial = gettext("Plotting not possible:\n")) + message <- paste(message, collapse = "\n") + + res <- ggplot2::ggplot() + + ggplot2::geom_label( + data = data.frame(x = 0.5, y = 0.5, label = message), + mapping = ggplot2::aes(x = x, y = y, label = label), + fill = adjustcolor("red", alpha = 0.5), + size = 0.7 * jaspGraphs::getGraphOption("fontsize") / ggplot2::.pt, + hjust = "center", + vjust = "center" + ) + + ggplot2::xlim(0:1) + + ggplot2::ylim(0:1) + + ggplot2::theme_void() + + return(res) +} + + +.trySubPlot <- function(fun, args, overwriteAxes) { + res <- try(do.call(fun, args), silent = TRUE) + + if(inherits(res, "try-error")) + return(.makeErrorPlot(res)) + + if(overwriteAxes %in% c("both", "x")) + res <- res + ggplot2::xlab(NULL) + + if(overwriteAxes %in% c("both", "y")) + res <- res + ggplot2::ylab(NULL) + + return(res) +} diff --git a/man/jaspBivariate.Rd b/man/jaspBivariate.Rd index 170abeed..3cf943f1 100644 --- a/man/jaspBivariate.Rd +++ b/man/jaspBivariate.Rd @@ -11,7 +11,7 @@ jaspBivariate( xName, yName, groupName, - type = c("point", "hex", "bin", "contour", "density"), + type = c("point", "hex", "bin", "contour", "density", "none"), args = list(color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, @@ -74,6 +74,8 @@ Passed as \code{level} argument to \link[ggplot2:geom_smooth]{ggplot2::geom_smoo \item{xBreaks}{Optional numeric vector that specifies the breaks along the x-axis.} \item{yBreaks}{Optional numeric vector that specifies the breaks along the y-axis.} + +\item{legendPosition}{Character; passed as \code{legend.position} to \link{themeJaspRaw}.} } \description{ This plot consists of three layers: diff --git a/man/jaspMatrixPlot.Rd b/man/jaspMatrixPlot.Rd new file mode 100644 index 00000000..fc5a4022 --- /dev/null +++ b/man/jaspMatrixPlot.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/jaspMatrixPlot.R +\name{jaspMatrixPlot} +\alias{jaspMatrixPlot} +\title{Matrix plot} +\usage{ +jaspMatrixPlot( + data, + diagonalPlotFunction = jaspHistogram, + diagonalPlotArgs = list(), + topRightPlotFunction = jaspBivariate, + topRightPlotArgs = list(), + bottomLeftPlotFunction = NULL, + bottomLeftPlotArgs = list(), + overwriteDiagonalAxes = "x", + overwriteTopRightAxes = "both", + overwriteBottomLeftAxes = "both", + axesLabels +) +} +\arguments{ +\item{data}{Data frame of data to plot.} + +\item{overwriteDiagonalAxes, overwriteTopRightAxes, overwriteBottomLeftAxes}{Which axes should be overwritten such that they have a common range. Possible options: +\describe{ +\item{\code{"none"}}{No axes are overwritten, hence the plots get their own scales given by \code{diagonal}, \code{topRight}, and \code{bottomLeft} functions, respectively.} +\item{\code{"both"}}{Both axes are overwritten. The plots inherit scales by setting their \code{breaks} determined by \link{getPrettyAxisBreaks}, and the plotting region is set by \link[ggplot2:coord_cartesian]{ggplot2::coord_cartesian} with \code{limits} set to \code{range(breaks)}. Further, the name of the axis is set to \code{NULL}.} +\item{\code{"x"}}{x-axis gets overwritten (see option \code{"both"}), y-axis does not (see option \code{"none"}).} +\item{\code{"y"}}{y-axis gets overwritten (see option \code{"both"}), x-axis does not (see option \code{"none"}).} +}} + +\item{axesLabels}{Optional character vector; provide column/row names of the matrix.} + +\item{diagonal}{A function that draws the plots on the diagonal. Must accept arguments \code{x} (numeric), \code{xName} (character).} + +\item{diagonalArgs}{A list of additional arguments to pass to \code{diagonal}.} + +\item{topRight}{A function that draws the plots on the top right off-diagonal. Must accept arguments \code{x} (numeric), \code{y} (numeric), \code{xName} (character), and \code{yName} (character).} + +\item{topRightArgs}{A list of additional arguments to pass to \code{topRight}.} + +\item{bottomLeft}{A function that draws the plots on the bottom left off-diagonal. Must accept arguments \code{x} (numeric), \code{y} (numeric), \code{xName} (character), and \code{yName} (character).} + +\item{bottomLeftArgs}{A list of additional arguments to pass to \code{bottomLeft}.} +} +\description{ +Plot that consists of \code{ncol{data}} by \code{ncol{data}} plots, +where subplot on position \eqn{(i, j)} plots \code{data[, c(i, j)]}. +The plot can display three different types of plots: +\describe{ +\item{\code{diagonal}}{Where \code{i == j}.} +\item{\code{topRight}}{Where \code{i < j}.} +\item{\code{bottomLeft}}{Where \code{i > j}.} +} +} From a55fad4dd1a1534eaf61ba8f03715696de73b714 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 19 Oct 2022 18:26:40 +0200 Subject: [PATCH 09/17] add support for histogram bins in jaspMatrixPlot --- R/jaspHistogram.R | 66 ++++++++++++++++++------------------------- R/jaspMatrixPlot.R | 13 ++++++--- man/jaspHistogram.Rd | 5 ++-- man/jaspMatrixPlot.Rd | 6 ++++ 4 files changed, 45 insertions(+), 45 deletions(-) diff --git a/R/jaspHistogram.R b/R/jaspHistogram.R index cc5dbd47..b05ce84c 100644 --- a/R/jaspHistogram.R +++ b/R/jaspHistogram.R @@ -30,23 +30,24 @@ #' @export jaspHistogram <- function( x, xName, - groupingVariable = NULL, + groupingVariable = NULL, groupingVariableName, - histogram = TRUE, + histogram = TRUE, histogramPosition = "dodge", - binWidthType = c("doane", "fd", "scott", "sturges", "manual"), - numberOfBins = NA, - rugs = FALSE, - rugsColor = FALSE, - density = FALSE, - densityColor = FALSE, - densityShade = FALSE, + binWidthType = c("doane", "fd", "scott", "sturges", "manual"), + numberOfBins = NULL, + rugs = FALSE, + rugsColor = FALSE, + density = FALSE, + densityColor = FALSE, + densityShade = FALSE, densityShadeAlpha = 0.6, - densityLineWidth = 1, - hideXAxisLabels = FALSE, - hideYAxisLabels = density, - hideXAxisName = FALSE, - hideYAxisName = FALSE + densityLineWidth = 1, + hideXAxisLabels = FALSE, + hideYAxisLabels = density, + hideXAxisName = FALSE, + hideYAxisName = FALSE, + xBreaks = NULL ) { # validate input @@ -73,31 +74,15 @@ jaspHistogram <- function( hasGroupingVariable <- !is.null(groupingVariable) x <- stats::na.omit(as.numeric(x)) - if (binWidthType == "doane") { - - # https://en.wikipedia.org/wiki/Histogram#Doane's_formula - sigma.g1 <- sqrt((6*(length(x) - 2)) / ((length(x) + 1)*(length(x) + 3))) - g1 <- mean(abs(x)^3) - k <- 1 + log2(length(x)) + log2(1 + (g1 / sigma.g1)) - binWidthType <- k - - } else if (binWidthType == "fd" && grDevices::nclass.FD(x) > 10000) { # FD-method will produce extreme number of bins and crash ggplot, mention this in footnote - - warning2("The Freedman-Diaconis method would produce an extreme number of bins, setting the number of bins to 10,000.") - binWidthType <- 10000 - - } else if (binWidthType == "manual") { - - if (is.na(numberOfBins)) - stop2("numberOfBins argument must be specified when a binWidthType == 'manual'.") - - binWidthType <- numberOfBins - + if(!is.null(xBreaks) || !missing(xBreaks)) { + binWidthType <- "manual" + numberOfBins <- xBreaks } - h <- graphics::hist(x, plot = FALSE, breaks = binWidthType) + h <- getJaspHistogramData(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) xBreaks <- getPrettyAxisBreaks(c(x, h[["breaks"]]), min.n = 3) + histogramGeom <- scaleFill <- maxCounts <- maxDensity <- NULL if (histogram) { if (hasGroupingVariable) { @@ -255,7 +240,7 @@ jaspHistogram <- function( return(plot) } -getJaspHistogramBreaks <- function(x, binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA) { +getJaspHistogramData <- function(x, binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA) { if (!is.vector(x, mode = "numeric")) stop2("`x` must be a numeric vector but has class ", paste(class(x), collapse = ", ")) @@ -277,7 +262,7 @@ getJaspHistogramBreaks <- function(x, binWidthType = c("doane", "fd", "scott", " } else if (binWidthType == "manual") { - if (is.na(numberOfBins)) + if (is.null(numberOfBins)) stop2("numberOfBins argument must be specified when a binWidthType == 'manual'.") binWidthType <- numberOfBins @@ -285,7 +270,10 @@ getJaspHistogramBreaks <- function(x, binWidthType = c("doane", "fd", "scott", " } h <- graphics::hist(x, plot = FALSE, breaks = binWidthType) - breaks <- getPrettyAxisBreaks(c(x, h[["breaks"]]), min.n = 3) + return(h) +} - return(breaks) +getJaspHistogramBreaks <- function(x, binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA) { + h <- getJaspHistogramData(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) + return(h[["breaks"]]) } diff --git a/R/jaspMatrixPlot.R b/R/jaspMatrixPlot.R index d5dd7d5e..4a6cafed 100644 --- a/R/jaspMatrixPlot.R +++ b/R/jaspMatrixPlot.R @@ -23,6 +23,8 @@ #' \item{\code{"x"}}{x-axis gets overwritten (see option \code{"both"}), y-axis does not (see option \code{"none"}).} #' \item{\code{"y"}}{y-axis gets overwritten (see option \code{"both"}), x-axis does not (see option \code{"none"}).} #' } +#' @param binWidthType See [jaspHistogram]. Used for determining consistent axes. +#' @param numberOfBins See [jaspHistogram]. Used for determining consistent axes. #' @param axesLabels Optional character vector; provide column/row names of the matrix. #' @export jaspMatrixPlot <- function( @@ -36,6 +38,8 @@ jaspMatrixPlot <- function( overwriteDiagonalAxes = "x", overwriteTopRightAxes = "both", overwriteBottomLeftAxes = "both", + binWidthType = c("doane", "fd", "scott", "sturges", "manual"), + numberOfBins = NA, axesLabels ) { @@ -67,7 +71,7 @@ jaspMatrixPlot <- function( for (row in seq_along(axesLabels)) { y <- data[[row]] yName <- axesLabels[[row]] - yBreaks <- getJaspHistogramBreaks(y) + yBreaks <- getJaspHistogramBreaks(x = y, binWidthType = binWidthType, numberOfBins = numberOfBins) plots[[i]] <- .makeTitle(yName, angle = 90) i <- i + 1 @@ -75,12 +79,13 @@ jaspMatrixPlot <- function( for (col in seq_along(axesLabels)) { x <- data[[col]] xName <- axesLabels[[col]] - xBreaks <- getJaspHistogramBreaks(x) + xBreaks <- getJaspHistogramBreaks(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) if (row == col) { # diagonal if(is.function(diagonalPlotFunction)) { - diagonalPlotArgs[["x"]] <- x - diagonalPlotArgs[["xName"]] <- xName + diagonalPlotArgs[["x"]] <- x + diagonalPlotArgs[["xName"]] <- xName + diagonalPlotArgs[["xBreaks"]] <- xBreaks plot <- .trySubPlot(diagonalPlotFunction, diagonalPlotArgs, overwriteDiagonalAxes) } else { plot <- patchwork::plot_spacer() diff --git a/man/jaspHistogram.Rd b/man/jaspHistogram.Rd index d8539194..37c929eb 100644 --- a/man/jaspHistogram.Rd +++ b/man/jaspHistogram.Rd @@ -12,7 +12,7 @@ jaspHistogram( histogram = TRUE, histogramPosition = "dodge", binWidthType = c("doane", "fd", "scott", "sturges", "manual"), - numberOfBins = NA, + numberOfBins = NULL, rugs = FALSE, rugsColor = FALSE, density = FALSE, @@ -23,7 +23,8 @@ jaspHistogram( hideXAxisLabels = FALSE, hideYAxisLabels = density, hideXAxisName = FALSE, - hideYAxisName = FALSE + hideYAxisName = FALSE, + xBreaks = NULL ) } \arguments{ diff --git a/man/jaspMatrixPlot.Rd b/man/jaspMatrixPlot.Rd index fc5a4022..7424b72f 100644 --- a/man/jaspMatrixPlot.Rd +++ b/man/jaspMatrixPlot.Rd @@ -15,6 +15,8 @@ jaspMatrixPlot( overwriteDiagonalAxes = "x", overwriteTopRightAxes = "both", overwriteBottomLeftAxes = "both", + binWidthType = c("doane", "fd", "scott", "sturges", "manual"), + numberOfBins = NA, axesLabels ) } @@ -29,6 +31,10 @@ jaspMatrixPlot( \item{\code{"y"}}{y-axis gets overwritten (see option \code{"both"}), x-axis does not (see option \code{"none"}).} }} +\item{binWidthType}{See \link{jaspHistogram}. Used for determining consistent axes.} + +\item{numberOfBins}{See \link{jaspHistogram}. Used for determining consistent axes.} + \item{axesLabels}{Optional character vector; provide column/row names of the matrix.} \item{diagonal}{A function that draws the plots on the diagonal. Must accept arguments \code{x} (numeric), \code{xName} (character).} From 4b80effb1a65bd22f73f8fc7559a91f51afa1443 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 19 Oct 2022 23:14:48 +0200 Subject: [PATCH 10/17] polish some rough edges --- R/jaspBivariate.R | 20 +++++++++++++------- R/jaspHistogram.R | 7 +++---- R/jaspMatrixPlot.R | 4 ++-- man/jaspBivariateWithMargins.Rd | 4 ++-- man/jaspMatrixPlot.Rd | 4 ++-- 5 files changed, 22 insertions(+), 17 deletions(-) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index 8b0b7bff..f5bc9d2a 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -127,13 +127,19 @@ jaspBivariate <- function( predictLayer <- NULL } - if (missing(xBreaks) || is.null(xBreaks)) + if (missing(xBreaks) || is.null(xBreaks)) { xBreaks <- getPrettyAxisBreaks(x) + } else { + xBreaks <- getPrettyAxisBreaks(xBreaks) + } xRange <- range(c(x, xBreaks)) xScale <- scale_x_continuous(breaks = xBreaks) - if (missing(yBreaks) || is.null(yBreaks)) + if (missing(yBreaks) || is.null(yBreaks)) { yBreaks <- getPrettyAxisBreaks(y) + } else { + yBreaks <- getPrettyAxisBreaks(yBreaks) + } yRange <- range(c(y, yBreaks)) yScale <- scale_y_continuous(breaks = yBreaks) @@ -195,7 +201,7 @@ jaspBivariate <- function( #' @export jaspBivariateWithMargins <- function( x, y, group = NULL, xName, yName, groupName, margins = c(0.25, 0.75), - binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA, + binWidthType = "doane", numberOfBins = NULL, histogramArgs = list(density = TRUE), topRightPlotFunction = NULL, topRightPlotArgs = list(), @@ -222,13 +228,13 @@ jaspBivariateWithMargins <- function( histogramArgs[["hideXAxisName"]] <- TRUE histogramArgs[["hideYAxisName"]] <- TRUE - topLeftArgs <- histogramArgs - topLeftArgs[["x"]] <- x + topLeftArgs <- histogramArgs + topLeftArgs[["x"]] <- x topLeft <- do.call(jaspHistogram, topLeftArgs) - bottomRightArgs <- histogramArgs - bottomRightArgs[["x"]] <- y + bottomRightArgs <- histogramArgs + bottomRightArgs[["x"]] <- y bottomRight <- do.call(jaspHistogram, bottomRightArgs) + ggplot2::coord_flip() diff --git a/R/jaspHistogram.R b/R/jaspHistogram.R index b05ce84c..c7766707 100644 --- a/R/jaspHistogram.R +++ b/R/jaspHistogram.R @@ -102,10 +102,9 @@ jaspHistogram <- function( size = .7, position = histogramPosition ) - # for each groupingvariable, bin by breaks and find the largest count temp <- do.call(rbind, tapply(x, groupingVariable, function(subset) { - h <- graphics::hist(subset, plot = FALSE, breaks = binWidthType) + h <- getJaspHistogramData(subset, binWidthType = binWidthType, numberOfBins = numberOfBins) c(counts = max(h[["counts"]]), density = max(h[["density"]])) })) maxCounts <- max(temp[, "counts"]) @@ -240,7 +239,7 @@ jaspHistogram <- function( return(plot) } -getJaspHistogramData <- function(x, binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA) { +getJaspHistogramData <- function(x, binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NULL) { if (!is.vector(x, mode = "numeric")) stop2("`x` must be a numeric vector but has class ", paste(class(x), collapse = ", ")) @@ -273,7 +272,7 @@ getJaspHistogramData <- function(x, binWidthType = c("doane", "fd", "scott", "st return(h) } -getJaspHistogramBreaks <- function(x, binWidthType = c("doane", "fd", "scott", "sturges", "manual"), numberOfBins = NA) { +getJaspHistogramBreaks <- function(x, binWidthType = "doane", numberOfBins = NULL) { h <- getJaspHistogramData(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) return(h[["breaks"]]) } diff --git a/R/jaspMatrixPlot.R b/R/jaspMatrixPlot.R index 4a6cafed..94cc4ec3 100644 --- a/R/jaspMatrixPlot.R +++ b/R/jaspMatrixPlot.R @@ -38,8 +38,8 @@ jaspMatrixPlot <- function( overwriteDiagonalAxes = "x", overwriteTopRightAxes = "both", overwriteBottomLeftAxes = "both", - binWidthType = c("doane", "fd", "scott", "sturges", "manual"), - numberOfBins = NA, + binWidthType = "doane", + numberOfBins = NULL, axesLabels ) { diff --git a/man/jaspBivariateWithMargins.Rd b/man/jaspBivariateWithMargins.Rd index 0b481bc3..036269ae 100644 --- a/man/jaspBivariateWithMargins.Rd +++ b/man/jaspBivariateWithMargins.Rd @@ -12,8 +12,8 @@ jaspBivariateWithMargins( yName, groupName, margins = c(0.25, 0.75), - binWidthType = c("doane", "fd", "scott", "sturges", "manual"), - numberOfBins = NA, + binWidthType = "doane", + numberOfBins = NULL, histogramArgs = list(density = TRUE), topRightPlotFunction = NULL, topRightPlotArgs = list(), diff --git a/man/jaspMatrixPlot.Rd b/man/jaspMatrixPlot.Rd index 7424b72f..dd131b92 100644 --- a/man/jaspMatrixPlot.Rd +++ b/man/jaspMatrixPlot.Rd @@ -15,8 +15,8 @@ jaspMatrixPlot( overwriteDiagonalAxes = "x", overwriteTopRightAxes = "both", overwriteBottomLeftAxes = "both", - binWidthType = c("doane", "fd", "scott", "sturges", "manual"), - numberOfBins = NA, + binWidthType = "doane", + numberOfBins = NULL, axesLabels ) } From 9d9a3a89d099032c9fba79fd62dfe677ab82f8d8 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 7 Dec 2022 13:10:16 +0100 Subject: [PATCH 11/17] minot comments --- R/jaspBivariate.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index f5bc9d2a..a007bf95 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -64,8 +64,8 @@ jaspBivariate <- function( df <- data.frame(x = x, y = y) aes <- ggplot2::aes(x = x, y = y) } else { - if(type != "point" && type != "none") - stop("grouping variable is allowed only for type = 'point' or 'none'.") + if (type != "point" && type != "none") + stop2("grouping variable is allowed only for type = 'point' or 'none'.") df <- data.frame(x = x, y = y, group = group) aes <- ggplot2::aes(x = x, y = y, group = group, fill = group, color = group) @@ -111,8 +111,8 @@ jaspBivariate <- function( if (predict == "lm") { - fit <- lm(y~x, data = df) - preds <- predict(fit, newdata = df, interval = "prediction", level = predictLevel) + fit <- stats::lm(y~x, data = df) + preds <- stats::predict(fit, newdata = df, interval = "prediction", level = predictLevel) preds <- as.data.frame(preds) preds[["x"]] <- df[["x"]] predictArgs$data <- preds From d46d23fd7214ef128bcbb5e28c5772954879bdb4 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 9 Dec 2022 11:36:16 +0100 Subject: [PATCH 12/17] implement jaspMarginal --- NAMESPACE | 5 + R/jaspBivariate.R | 4 +- R/jaspMarginal.R | 257 ++++++++++++++++++++++++++++++++ inst/examples/ex-jaspMarginal.R | 23 +++ man/jaspBivariate.Rd | 4 +- man/jaspMarginal.Rd | 137 +++++++++++++++++ 6 files changed, 426 insertions(+), 4 deletions(-) create mode 100644 R/jaspMarginal.R create mode 100644 inst/examples/ex-jaspMarginal.R create mode 100644 man/jaspMarginal.Rd diff --git a/NAMESPACE b/NAMESPACE index 1059c76c..82631ede 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,7 +24,11 @@ S3method(plot,jaspGraphs) S3method(plot,jaspGraphsPlot) S3method(print,jaspGraphs) S3method(print,jaspGraphsPlot) +export(.densityArgs) export(.graphOptions) +export(.histogramArgs) +export(.marginalArgs) +export(.rugArgs) export(GeomAbline2) export(GeomAlignedText) export(GeomRangeFrame) @@ -56,6 +60,7 @@ export(is.jaspGraphsPlot) export(jaspBivariate) export(jaspBivariateWithMargins) export(jaspHistogram) +export(jaspMarginal) export(jaspMatrixPlot) export(needsParsing) export(parseThis) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index a007bf95..5df3b095 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -47,10 +47,10 @@ jaspBivariate <- function( smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, smoothCiLevel = 0.95, - smoothArgs = list(), + smoothArgs = list(color = "black"), predict = c("none", "lm", "ellipse"), predictLevel = 0.95, - predictArgs = list(), + predictArgs = list(color = "black", linetype = 2, linewidth = 1, fill = NA), xBreaks = NULL, yBreaks = NULL, legendPosition = "none" diff --git a/R/jaspMarginal.R b/R/jaspMarginal.R new file mode 100644 index 00000000..ede1f20d --- /dev/null +++ b/R/jaspMarginal.R @@ -0,0 +1,257 @@ +#' @title Histograms and Density plots for JASP +#' +#' @description A plot histogram with four optional components. +#' \describe{ +#' \item{\code{histogram}}{Histogram which can be tweaked with \code{breaks} and \code{histogramArgs} arguments.} +#' \item{\code{density}}{Density line(s) which can be tweaked with \code{densityArgs}.} +#' \item{\code{densityOverlay}}{Density line which can be tweaked with \code{densityOverlayArgs}. Only one line is shown for the full data regardless of whether `group` is used.} +#' \item{\code{rug}}{Rugs underneath the figure which can be tweaked with \code{rugArgs}.} + +#' } +#' +#' Each of these components can be enabled (or disabled) individually. +#' +#' `.marginalArgs`, `histogramArgs`, `.rugArgs`, and `.densityArgs` are helper functions for specifying the list of tweaking options for the individual components without overriding other default values. +#' +#' @details +#' Colors are taken from \code{graphOptions("palette")}. +#' +#' @return +#' `jaspMarginal` returns the ggplot object. +#' `.marginalArgs`, `histogramArgs`, `.rugArgs`, and `.densityArgs` return a list passed as arguments into their respective ggplot geoms. +#' +#' @param x, numeric, the data to show the plot for. +#' @param group, factor, show \code{histogram}, \code{density}, and \code{rug} split by groups? +#' @param xName, string, the title on the x-axis. Use \code{NULL} to hide the axis title. If `base::missing`, the value is inferred from the object name passed to \code{x}. +#' @param groupName, character, legend name of the grouping variable. Use \code{NULL} to hide the legend title. If `base::missing`, the value is inferred from the object name passed to \code{group}. +#' @param yName, string, the title on the y-axis. Use \code{NULL} to hide the axis title. If `base::missing`, "Density" or "Count" is used depending on the value of \code{type}. +#' @param type, string, should count or density be displayed on the y-axis? If \code{"auto"}, \code{"density"} is used if \code{density} or \code{densityOverlay} is used, otherwise \code{"count"} is used. \code{"count"} preserves marginal densities if split by group, \code{"density"} re-normalizes each subgroup. +#' @param breaks, see \code{breaks} from `graphics::hist`. Additionally allows \code{"doane"} method. +#' @param histogram, logical, should a histogram be shown? +#' @param histogramArgs, list, additional arguments passed to \code{\link[ggplot2]{geom_histogram}}. Use `.histogramArgs` to set the options. +#' @param rug, logical, should rugs be shown on the x-axis? +#' @param rugArgs, list, additional arguments passed to \code{\link[ggplot2]{geom_rug}}. Use `.rugArgs` to set the options. +#' @param density, logical, should a density be superimposed on the plot? +#' @param densityArgs, logical, additional arguments passed to \code{\link[ggplot2]{geom_density}}. Use `.densityArgs` to set the options. +#' @param densityOverlay, logical, should a density overlay be superimposed on the plot? +#' @param densityOverlayArgs, logical, additional arguments passed to \code{\link[ggplot2]{geom_density}}. Use `.densityArgs` to set the options. +#' @param axisLabels, string, which axes should have labels displayed? If \code{"auto"}, \code{"x"} is used if \code{type == "density"}, otherwise \code{"both"} is used. +#' @example inst/examples/ex-jaspMarginal.R +#' @rdname jaspMarginal +#' @export +jaspMarginal <- function( + x, + group = NULL, + xName, + groupName, + yName, + type = c("auto", "count", "density"), + breaks = "sturges", + histogram = TRUE, + histogramArgs = .histogramArgs(), + rug = FALSE, + rugArgs = .rugArgs(), + density = FALSE, + densityArgs = .densityArgs(), + densityOverlay = FALSE, + densityOverlayArgs = .densityArgs(linewidth = 1), + axisLabels = c("auto", "both", "x", "y", "none") +) { + + # validate input + type <- match.arg(type) + if(type == "auto") { + type <- if(density || densityOverlay) "density" else "count" + } + + if (!is.vector(x, mode = "numeric")) + stop2("`x` must be a numeric vector but has class ", paste(class(x), collapse = ", ")) + + if (missing(xName)) + xName <- deparse1(substitute(x)) # identical to plot.default + + if (missing(yName)) + yName <- if(type == "density") gettext("Density") else gettext("Count") + + if (!is.character(xName) && !is.null(xName)) + stop2("`xName` must be character but has class ", paste(class(xName), collapse = ", "), "!") + + if (!is.null(group) && !is.factor(group)) + stop2("`group` must be a factor vector but has class ", paste(class(group), collapse = ", "), "!") + + if (!is.null(group) && missing(groupName)) + groupName <- deparse1(substitute(group)) # identical to plot.default + + if (!missing(groupName) && !is.character(groupName)) + stop2("`groupName` must be character but has class ", paste(class(groupName), collapse = ", "), "!") + + axisLabels <- match.arg(axisLabels) + if (axisLabels == "auto") { + axisLabels <- if (type == "density") "x" else "both" + } + + hasGroupingVariable <- !is.null(group) + + if(hasGroupingVariable) { + data <- data.frame(x = x, group = group) + } else { + data <- data.frame(x = x) + } + data <- na.omit(data) + + h <- getJaspMarginalData(x = data[["x"]], breaks = breaks) + xBreaks <- getPrettyAxisBreaks(c(data[["x"]], h[["breaks"]]), min.n = 3) + + histogramLayer <- densityLayer <- densityOverlayLayer <- rugLayer <- NULL + if (histogram) { + yy <- as.symbol(type) + histogramAes <- + if(hasGroupingVariable) { + ggplot2::aes(x = x, y = ggplot2::after_stat({{yy}}), fill = group, group = group) + } else { + ggplot2::aes(x = x, y = ggplot2::after_stat({{yy}})) + } + # default gray filling + if(is.null(histogramArgs[["fill"]]) && is.null(histogramAes[["fill"]])) histogramArgs[["fill"]] <- "gray" + + histogramArgs[["mapping"]] <- histogramAes + histogramArgs[["breaks"]] <- h[["breaks"]] + + histogramLayer <- do.call(ggplot2::geom_histogram, histogramArgs) + } + + if (density) { + bw <- diff(h[["breaks"]])[1] + yy <- as.symbol(type) + yy <- if(type == "density") { + substitute(ggplot2::after_stat(yy)) + } else { + substitute(bw * ggplot2::after_stat(yy)) + } + + densityAes <- + if(hasGroupingVariable) { + ggplot2::aes(x = x, y = {{yy}}, fill = group, group = group) + } else { + ggplot2::aes(x = x, y = {{yy}}) + } + environment(densityAes$y) <- environment(densityAes$x) + + densityArgs[["mapping"]] <- densityAes + densityLayer <- do.call(ggplot2::geom_density, densityArgs) + + } + + if (densityOverlay) { + bw <- diff(h[["breaks"]])[1] + yy <- as.symbol(type) + yy <- if(type == "density") { + substitute(ggplot2::after_stat(yy)) + } else { + substitute(bw * ggplot2::after_stat(yy)) + } + + densityOverlayAes <- ggplot2::aes(x = x, y = {{yy}}) + environment(densityOverlayAes$y) <- environment(densityOverlayAes$x) + + densityOverlayArgs[["mapping"]] <- densityOverlayAes + densityOverlayLayer <- do.call(ggplot2::geom_density, densityOverlayArgs) + } + + if (rug) { + rugAes <- + if(!hasGroupingVariable) { + ggplot2::aes(x = x) + } else { + ggplot2::aes(x = x, color = group, group = group) + } + + rugArgs[["mapping"]] <- rugAes + rugLayer <- do.call(ggplot2::geom_rug, rugArgs) + } + + plot <- ggplot2::ggplot(data = data) + + histogramLayer + + densityLayer + + densityOverlayLayer + + rugLayer + + geom_rangeframe() + + themeJaspRaw(legend.position = "right") + + scale_x_continuous(breaks = xBreaks, limits = range(xBreaks)) + + ggplot2::xlab(xName) + + ggplot2::ylab(yName) + + yRange <- ggplot2::layer_scales(plot)[["y"]][["range"]][["range"]] + yBreaks <- getPrettyAxisBreaks(yRange) + plot <- plot + + scale_y_continuous(breaks = yBreaks, limits = range(yBreaks)) + + if (hasGroupingVariable) plot <- plot + scale_JASPfill_discrete(name = groupName) + scale_JASPcolor_discrete(name = groupName) + + if (!axisLabels %in% c("x", "both")) + plot <- plot + theme(axis.ticks.x = element_blank(), axis.text.x = element_blank()) + + if (!axisLabels %in% c("y", "both")) + plot <- plot + theme(axis.ticks.y = element_blank(), axis.text.y = element_blank()) + + return(plot) +} + +#' @rdname jaspMarginal +#' @export +.marginalArgs <- function() { + args <- as.list(environment()) + return(args) +} +formals(.marginalArgs) <- formals(jaspMarginal) + + +getJaspMarginalData <- function(x, breaks) { + if (is.character(breaks)) { + if(length(breaks) != 1) { + stop2("`breaks` must be of length 1.") + } else if (tolower(breaks) == "doane") { + # https://en.wikipedia.org/wiki/Histogram#Doane's_formula + sigma.g1 <- sqrt((6*(length(x) - 2)) / ((length(x) + 1)*(length(x) + 3))) + g1 <- mean(abs(x)^3) + k <- 1 + log2(length(x)) + log2(1 + (g1 / sigma.g1)) + breaks <- k + } else if (tolower(breaks) == "fd" && grDevices::nclass.FD(x) > 10000) { # FD-method will produce extreme number of bins and crash ggplot, mention this in footnote + warning2("The Freedman-Diaconis method would produce an extreme number of bins, setting the number of bins to 10,000.") + breaks <- 10000 + } + } + + h <- graphics::hist(x, plot = FALSE, breaks = breaks) + return(h) +} + +#' @rdname jaspMarginal +#' @export +.histogramArgs <- function(color = "black", size = 0.7, position = ggplot2::position_dodge(), ...) { + args <- list(...) + args[["color"]] <- color + args[["size"]] <- size + args[["position"]] <- position + + return(args) +} + +#' @rdname jaspMarginal +#' @export +.rugArgs <- function(...) { + args <- list(...) + + return(args) +} + +#' @rdname jaspMarginal +#' @export +.densityArgs <- function(color = "black", linewidth = 0.7, alpha = 0.5, ...) { + args <- list(...) + args[["color"]] <- color + args[["linewidth"]] <- linewidth + args[["alpha"]] <- alpha + + return(args) +} diff --git a/inst/examples/ex-jaspMarginal.R b/inst/examples/ex-jaspMarginal.R new file mode 100644 index 00000000..a81295d9 --- /dev/null +++ b/inst/examples/ex-jaspMarginal.R @@ -0,0 +1,23 @@ +set.seed(1) +x <- rnorm(250) +jaspMarginal(x) +jaspMarginal(x, breaks = 5) +jaspMarginal(x, breaks = 'doane') + +jaspMarginal(x, density = TRUE, histogram = FALSE, rug = TRUE) + + +group <- as.factor(sample(letters[1:2], 500, TRUE, prob = c(0.3, 0.7))) +x <- rnorm(500, mean = c(a = 0, b = 1)[group]) + +jaspMarginal(x, group, density = TRUE, rug = TRUE) # does not preserve marginal proportions +jaspMarginal(x, group, density = TRUE, rug = TRUE, type = "count") # preserves marginal proportions + +# stacked groups +jaspMarginal( + x, group, density = TRUE, type = "count", + histogramArgs = .histogramArgs(position = ggplot2::position_stack()), + densityArgs = .densityArgs(position = ggplot2::position_stack()) + ) + +jaspMarginal(x, group, densityOverlay = TRUE, type = "count", histogramArgs = .histogramArgs(position = ggplot2::position_stack())) diff --git a/man/jaspBivariate.Rd b/man/jaspBivariate.Rd index 3cf943f1..59a3e7e4 100644 --- a/man/jaspBivariate.Rd +++ b/man/jaspBivariate.Rd @@ -16,10 +16,10 @@ jaspBivariate( smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, smoothCiLevel = 0.95, - smoothArgs = list(), + smoothArgs = list(color = "black"), predict = c("none", "lm", "ellipse"), predictLevel = 0.95, - predictArgs = list(), + predictArgs = list(color = "black", linetype = 2, linewidth = 1, fill = NA), xBreaks = NULL, yBreaks = NULL, legendPosition = "none" diff --git a/man/jaspMarginal.Rd b/man/jaspMarginal.Rd new file mode 100644 index 00000000..9b8e6dfd --- /dev/null +++ b/man/jaspMarginal.Rd @@ -0,0 +1,137 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/jaspMarginal.R +\name{jaspMarginal} +\alias{jaspMarginal} +\alias{.marginalArgs} +\alias{.histogramArgs} +\alias{.rugArgs} +\alias{.densityArgs} +\title{Histograms and Density plots for JASP} +\usage{ +jaspMarginal( + x, + group = NULL, + xName, + groupName, + yName, + type = c("auto", "count", "density"), + breaks = "sturges", + histogram = TRUE, + histogramArgs = .histogramArgs(), + rug = FALSE, + rugArgs = .rugArgs(), + density = FALSE, + densityArgs = .densityArgs(), + densityOverlay = FALSE, + densityOverlayArgs = .densityArgs(linewidth = 1), + axisLabels = c("auto", "both", "x", "y", "none") +) + +.marginalArgs( + x, + group = NULL, + xName, + groupName, + yName, + type = c("auto", "count", "density"), + breaks = "sturges", + histogram = TRUE, + histogramArgs = .histogramArgs(), + rug = FALSE, + rugArgs = .rugArgs(), + density = FALSE, + densityArgs = .densityArgs(), + densityOverlay = FALSE, + densityOverlayArgs = .densityArgs(linewidth = 1), + axisLabels = c("auto", "both", "x", "y", "none") +) + +.histogramArgs( + color = "black", + size = 0.7, + position = ggplot2::position_dodge(), + ... +) + +.rugArgs(...) + +.densityArgs(color = "black", linewidth = 0.7, alpha = 0.5, ...) +} +\arguments{ +\item{x, }{numeric, the data to show the plot for.} + +\item{group, }{factor, show \code{histogram}, \code{density}, and \code{rug} split by groups?} + +\item{xName, }{string, the title on the x-axis. Use \code{NULL} to hide the axis title. If \code{base::missing}, the value is inferred from the object name passed to \code{x}.} + +\item{groupName, }{character, legend name of the grouping variable. Use \code{NULL} to hide the legend title. If \code{base::missing}, the value is inferred from the object name passed to \code{group}.} + +\item{yName, }{string, the title on the y-axis. Use \code{NULL} to hide the axis title. If \code{base::missing}, "Density" or "Count" is used depending on the value of \code{type}.} + +\item{type, }{string, should count or density be displayed on the y-axis? If \code{"auto"}, \code{"density"} is used if \code{density} or \code{densityOverlay} is used, otherwise \code{"count"} is used. \code{"count"} preserves marginal densities if split by group, \code{"density"} re-normalizes each subgroup.} + +\item{breaks, }{see \code{breaks} from \code{graphics::hist}. Additionally allows \code{"doane"} method.} + +\item{histogram, }{logical, should a histogram be shown?} + +\item{histogramArgs, }{list, additional arguments passed to \code{\link[ggplot2]{geom_histogram}}. Use \code{.histogramArgs} to set the options.} + +\item{rug, }{logical, should rugs be shown on the x-axis?} + +\item{rugArgs, }{list, additional arguments passed to \code{\link[ggplot2]{geom_rug}}. Use \code{.rugArgs} to set the options.} + +\item{density, }{logical, should a density be superimposed on the plot?} + +\item{densityArgs, }{logical, additional arguments passed to \code{\link[ggplot2]{geom_density}}. Use \code{.densityArgs} to set the options.} + +\item{densityOverlay, }{logical, should a density overlay be superimposed on the plot?} + +\item{densityOverlayArgs, }{logical, additional arguments passed to \code{\link[ggplot2]{geom_density}}. Use \code{.densityArgs} to set the options.} + +\item{axisLabels, }{string, which axes should have labels displayed? If \code{"auto"}, \code{"x"} is used if \code{type == "density"}, otherwise \code{"both"} is used.} +} +\value{ +\code{jaspMarginal} returns the ggplot object. +\code{.marginalArgs}, \code{histogramArgs}, \code{.rugArgs}, and \code{.densityArgs} return a list passed as arguments into their respective ggplot geoms. +} +\description{ +A plot histogram with four optional components. +\describe{ +\item{\code{histogram}}{Histogram which can be tweaked with \code{breaks} and \code{histogramArgs} arguments.} +\item{\code{density}}{Density line(s) which can be tweaked with \code{densityArgs}.} +\item{\code{densityOverlay}}{Density line which can be tweaked with \code{densityOverlayArgs}. Only one line is shown for the full data regardless of whether \code{group} is used.} +\item{\code{rug}}{Rugs underneath the figure which can be tweaked with \code{rugArgs}.} +} + +Each of these components can be enabled (or disabled) individually. + +\code{.marginalArgs}, \code{histogramArgs}, \code{.rugArgs}, and \code{.densityArgs} are helper functions for specifying the list of tweaking options for the individual components without overriding other default values. +} +\details{ +Colors are taken from \code{graphOptions("palette")}. +} +\examples{ +set.seed(1) +x <- rnorm(250) +jaspMarginal(x) +jaspMarginal(x, breaks = 5) +jaspMarginal(x, breaks = 'doane') + +jaspMarginal(x, density = TRUE, histogram = FALSE, rug = TRUE) + + +group <- as.factor(sample(letters[1:2], 500, TRUE, prob = c(0.3, 0.7))) +x <- rnorm(500, mean = c(a = 0, b = 1)[group]) + +jaspMarginal(x, group, density = TRUE, rug = TRUE) # does not preserve marginal proportions +jaspMarginal(x, group, density = TRUE, rug = TRUE, type = "count") # preserves marginal proportions + +# stacked groups +jaspMarginal( + x, group, density = TRUE, type = "count", + histogramArgs = .histogramArgs(position = ggplot2::position_stack()), + densityArgs = .densityArgs(position = ggplot2::position_stack()) + ) + +jaspMarginal(x, group, densityOverlay = TRUE, type = "count", histogramArgs = .histogramArgs(position = ggplot2::position_stack())) +} From f018a2e45f97cdc98ab6201cbadaeb97267686b3 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 9 Dec 2022 12:28:41 +0100 Subject: [PATCH 13/17] substitute jaspHistogram with jaspMarginal in jaspBivariateWithScatter --- R/jaspBivariate.R | 51 +++++++++++++++++++++------------ R/jaspMarginal.R | 7 ++++- man/jaspBivariateWithMargins.Rd | 17 ++++++----- 3 files changed, 46 insertions(+), 29 deletions(-) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index 5df3b095..4a252425 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -201,8 +201,8 @@ jaspBivariate <- function( #' @export jaspBivariateWithMargins <- function( x, y, group = NULL, xName, yName, groupName, margins = c(0.25, 0.75), - binWidthType = "doane", numberOfBins = NULL, - histogramArgs = list(density = TRUE), + xMarginalArgs = .marginalArgs(), + yMarginalArgs = .marginalArgs(), topRightPlotFunction = NULL, topRightPlotArgs = list(), ... @@ -214,29 +214,42 @@ jaspBivariateWithMargins <- function( groupName <- "" } - xBreaks <- getJaspHistogramBreaks(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) - yBreaks <- getJaspHistogramBreaks(x = y, binWidthType = binWidthType, numberOfBins = numberOfBins) + if (missing(xName)) + xName <- deparse1(substitute(x)) # identical to plot.default + + if (missing(yName)) + yName <- deparse1(substitute(y)) # identical to plot.default + + if (is.null(group)) { + df <- data.frame(x = x, y = y) + } else { + df <- data.frame(x = x, y = y, group = group) + } + df <- na.omit(df) + + xBreaks <- getJaspMarginalBreaks(x = df[["x"]], breaks = xMarginalArgs[["breaks"]]) + yBreaks <- getJaspMarginalBreaks(x = df[["y"]], breaks = yMarginalArgs[["breaks"]]) - bottomLeft <- jaspBivariate(x = x, y = y, group = group, xName = xName, yName = yName, groupName = groupName, xBreaks = xBreaks, yBreaks = yBreaks, ...) + bottomLeft <- jaspBivariate(x = df[["x"]], y = df[["y"]], group = if(is.null(group)) NULL else group, xName = xName, yName = yName, groupName = groupName, xBreaks = xBreaks, yBreaks = yBreaks, ...) - histogramArgs[["binWidthType"]] <- binWidthType - histogramArgs[["numberOfBins"]] <- numberOfBins - histogramArgs[["groupingVariable"]] <- group - histogramArgs[["groupingVariableName"]] <- groupName - histogramArgs[["hideXAxisLabel"]] <- TRUE - histogramArgs[["hideXAxisLabel"]] <- TRUE - histogramArgs[["hideXAxisName"]] <- TRUE - histogramArgs[["hideYAxisName"]] <- TRUE + xMarginalArgs[["x"]] <- df[["x"]] + xMarginalArgs["group"] <- if (is.null(group)) list(NULL) else list(df[["group"]]) + xMarginalArgs["xName"] <- list(NULL) + xMarginalArgs["yName"] <- list(NULL) + xMarginalArgs["groupName"] <- list(groupName) + xMarginalArgs[["axisLabels"]] <- "none" - topLeftArgs <- histogramArgs - topLeftArgs[["x"]] <- x + topLeft <- do.call(jaspMarginal, xMarginalArgs) - topLeft <- do.call(jaspHistogram, topLeftArgs) - bottomRightArgs <- histogramArgs - bottomRightArgs[["x"]] <- y + yMarginalArgs[["x"]] <- df[["y"]] + yMarginalArgs["group"] <- if (is.null(group)) list(NULL) else list(df[["group"]]) + yMarginalArgs["xName"] <- list(NULL) + yMarginalArgs["yName"] <- list(NULL) + yMarginalArgs["groupName"] <- list(groupName) + yMarginalArgs[["axisLabels"]] <- "none" - bottomRight <- do.call(jaspHistogram, bottomRightArgs) + + bottomRight <- do.call(jaspMarginal, yMarginalArgs) + ggplot2::coord_flip() diff --git a/R/jaspMarginal.R b/R/jaspMarginal.R index ede1f20d..622591d2 100644 --- a/R/jaspMarginal.R +++ b/R/jaspMarginal.R @@ -82,7 +82,7 @@ jaspMarginal <- function( if (!is.null(group) && missing(groupName)) groupName <- deparse1(substitute(group)) # identical to plot.default - if (!missing(groupName) && !is.character(groupName)) + if (!missing(groupName) && !is.character(groupName) && !is.null(groupName)) stop2("`groupName` must be character but has class ", paste(class(groupName), collapse = ", "), "!") axisLabels <- match.arg(axisLabels) @@ -226,6 +226,11 @@ getJaspMarginalData <- function(x, breaks) { return(h) } +getJaspMarginalBreaks <- function(x, breaks) { + h <- getJaspMarginalData(x, breaks) + return(h[["breaks"]]) +} + #' @rdname jaspMarginal #' @export .histogramArgs <- function(color = "black", size = 0.7, position = ggplot2::position_dodge(), ...) { diff --git a/man/jaspBivariateWithMargins.Rd b/man/jaspBivariateWithMargins.Rd index 036269ae..7b464c0d 100644 --- a/man/jaspBivariateWithMargins.Rd +++ b/man/jaspBivariateWithMargins.Rd @@ -12,9 +12,8 @@ jaspBivariateWithMargins( yName, groupName, margins = c(0.25, 0.75), - binWidthType = "doane", - numberOfBins = NULL, - histogramArgs = list(density = TRUE), + xMarginalArgs = .marginalArgs(), + yMarginalArgs = .marginalArgs(), topRightPlotFunction = NULL, topRightPlotArgs = list(), ... @@ -35,17 +34,17 @@ jaspBivariateWithMargins( \item{margins}{Numeric vector; The proportions of the subplots relative to each other.} -\item{binWidthType}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} - -\item{numberOfBins}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} - -\item{histogramArgs}{An optional list of options passed to \link{jaspHistogram}.} - \item{topRightPlotFunction}{An optional function that can be used to plotting something in the top-right panel. If \code{NULL} (default), an empty area is plotted.} \item{topRightPlotArgs}{An optional list of options passed to \code{topRightPlotFunction}.} \item{...}{Additional options passed to \link{jaspBivariate}.} + +\item{binWidthType}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} + +\item{numberOfBins}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} + +\item{histogramArgs}{An optional list of options passed to \link{jaspHistogram}.} } \description{ This plot consists of four elements: From fc3d8cbca884c3fbcb3af072968e1eb40a9a35b7 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Tue, 22 Aug 2023 19:12:01 +0200 Subject: [PATCH 14/17] update bivariate --- R/jaspBivariate.R | 26 +++++++++++++++++++++++--- man/jaspBivariate.Rd | 4 ++-- 2 files changed, 25 insertions(+), 5 deletions(-) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index 4a252425..c88a1b2d 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -1,12 +1,12 @@ #' @title Bivariate plots with optional confidence and prediction intervals. -#' +# #' @encoding UTF-8 #' @description This plot consists of three layers: #' \enumerate{ #' \item The bivariate distribution. #' \item Smooth line through the data displayed using [ggplot2::geom_smooth]. #' \item Prediction interval of y given x using [stats::predict.lm](assuming linear relationship), or prediction ellipse assuming bivariate normal distribution. #' } -#' @param x Numeric vector of values on the x-axis. +#' @param x Numeric vector of values on the x-axis. `r "\u03BC"` #' @param y Numeric vector of values on the y-axis. #' @param group Optional grouping variable. #' @param xName Character; x-axis label. If left empty, the name of the \code{x} object is displayed. To remove the axis label, use \code{NULL}. @@ -50,7 +50,7 @@ jaspBivariate <- function( smoothArgs = list(color = "black"), predict = c("none", "lm", "ellipse"), predictLevel = 0.95, - predictArgs = list(color = "black", linetype = 2, linewidth = 1, fill = NA), + predictArgs = .predictArgs(), xBreaks = NULL, yBreaks = NULL, legendPosition = "none" @@ -175,6 +175,26 @@ jaspBivariate <- function( return(plot) } +.predictArgs <- function(color = "black", linetype = 2, linewidth = 1, fill = NA, ...) { + args <- list(...) + args[["color"]] <- color + args[["linetype"]] <- linetype + args[["linewidth"]] <- linewidth + args[["fill"]] <- fill + + return(args) +} + +.smoothArgs <- function(method = "lm", se = FALSE, level = 0.95, formula = y~x, ...) { + args <- list(...) + args[["method"]] <- method + args[["se"]] <- se + args[["level"]] <- level + args[["formula"]] <- formula + + return(args) +} + #' @title Bivariate plots with marginal distributions along the axes. #' #' @description This plot consists of four elements: diff --git a/man/jaspBivariate.Rd b/man/jaspBivariate.Rd index 59a3e7e4..2cd4612b 100644 --- a/man/jaspBivariate.Rd +++ b/man/jaspBivariate.Rd @@ -19,14 +19,14 @@ jaspBivariate( smoothArgs = list(color = "black"), predict = c("none", "lm", "ellipse"), predictLevel = 0.95, - predictArgs = list(color = "black", linetype = 2, linewidth = 1, fill = NA), + predictArgs = .predictArgs(), xBreaks = NULL, yBreaks = NULL, legendPosition = "none" ) } \arguments{ -\item{x}{Numeric vector of values on the x-axis.} +\item{x}{Numeric vector of values on the x-axis. μ} \item{y}{Numeric vector of values on the y-axis.} From 8762e65c4caa98d69ac58eb5e01dc569a686dd11 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 11 Sep 2023 16:42:29 +0200 Subject: [PATCH 15/17] add patchwork to dependencies --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b14f9533..bdfb10d6 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,5 +20,6 @@ Imports: RColorBrewer, rlang, scales, - viridisLite + viridisLite, + patchwork Roxygen: list(markdown = TRUE) From 404fa57afe1776f292ca6de5c0259fa1d20604ac Mon Sep 17 00:00:00 2001 From: vandenman Date: Tue, 21 May 2024 15:42:40 +0200 Subject: [PATCH 16/17] tweaks --- DESCRIPTION | 4 +- NAMESPACE | 14 +++++++ R/JASPScatterPlot.R | 60 +++++++++++++++++++++++------ R/customGeoms.R | 5 ++- R/enums.R | 1 + R/geom_rangeframe.R | 2 +- R/ggMatrixPlot.R | 9 +++++ R/jaspBivariate.R | 37 +++++++++++------- R/jaspHistogram.R | 3 +- R/jaspMarginal.R | 39 +++++++++++-------- R/jaspMatrixPlot.R | 20 +++++----- R/plotEditingAxes.R | 4 ++ R/plotEditingOptions.R | 7 ++++ R/plotQQnorm.R | 10 +++-- man/JASPScatterPlot.Rd | 10 ++++- man/geom_abline2.Rd | 31 +++++++++++++-- man/geom_aligned_text.Rd | 62 ++++++++++++++++++++++++------ man/geom_rangeframe.Rd | 67 ++++++++++++++++++++++++++------- man/jaspBivariate.Rd | 6 +-- man/jaspBivariateWithMargins.Rd | 15 ++++---- man/jaspHistogram.Rd | 2 + man/jaspMarginal.Rd | 64 ++++++++++++++++++++++++++----- man/jaspMatrixPlot.Rd | 24 ++++++------ man/plotQQnorm.Rd | 8 ++-- 24 files changed, 377 insertions(+), 127 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bdfb10d6..0bb7b829 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,14 +1,14 @@ Package: jaspGraphs Type: Package Title: Custom Graphs for JASP -Version: 0.19.0 +Version: 0.19.0.9000 Author: Don van den Bergh Maintainer: JASP-team Description: Graph making functions and wrappers for JASP. License: GPL Encoding: UTF-8 LazyData: true -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Suggests: testthat Imports: ggplot2 (>= 3.0.0), diff --git a/NAMESPACE b/NAMESPACE index 82631ede..cf1cb452 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,11 +1,21 @@ # Generated by roxygen2: do not edit by hand +S3method("$",Enum) S3method("[[",jaspGraphsPlot) S3method("[[<-",jaspGraphsPlot) S3method(getAxisBreaks,gg) S3method(getAxisBreaks,ggplot) S3method(getAxisBreaks,ggplot_built) S3method(getAxisBreaks,list) +S3method(getAxisInfo,ScaleContinuousPosition) +S3method(getAxisInfo,ScaleDiscretePosition) +S3method(getPlotEditingOptions,"function") +S3method(getPlotEditingOptions,default) +S3method(getPlotEditingOptions,gg) +S3method(getPlotEditingOptions,ggplot) +S3method(getPlotEditingOptions,ggplot_built) +S3method(getPlotEditingOptions,jaspGraphsPlot) +S3method(getPlotEditingOptions,qgraph) S3method(getPrettyAxisBreaks,character) S3method(getPrettyAxisBreaks,default) S3method(getPrettyAxisBreaks,factor) @@ -13,7 +23,11 @@ S3method(getPrettyAxisBreaks,numeric) S3method(ggMatrixPlot,default) S3method(ggMatrixPlot,list) S3method(ggMatrixPlot,matrix) +S3method(internalUpdateAxis,ScaleContinuousPosition) +S3method(internalUpdateAxis,ScaleDiscretePosition) S3method(length,jaspGraphsPlot) +S3method(makeLabels,default) +S3method(makeLabels,list) S3method(names,jaspGraphsPlot) S3method(needsParsing,character) S3method(needsParsing,data.frame) diff --git a/R/JASPScatterPlot.R b/R/JASPScatterPlot.R index 5d2bb6fe..96de4ae2 100644 --- a/R/JASPScatterPlot.R +++ b/R/JASPScatterPlot.R @@ -1,7 +1,7 @@ #' @importFrom ggplot2 geom_smooth theme_void geom_ribbon #' @importFrom rlang .data -#' @title Create a scatter plot with density +#' @title DEPRECATED, use [jaspBivariateWithMargins] instead. Create a scatter plot with density #' #' @param x x variable. #' @param y y variable. @@ -19,6 +19,8 @@ #' @param showLegend Should the legend be shown? #' @param legendTitle A string for the title of the legend. \code{NULL} implies the legend is not shown. #' @param emulateGgMarginal Should the result be as similar as possible to \code{\link[ggExtra]{ggMarginal}}? Overwrites other parameters. +#' @param plotComposer, String, should "gridExtra" or "patchwork" be used for combining plots? +#' @param legendPosition where should the legend position be placed? "topRightPatch", #' @param ... passed to \code{\link{themeJaspRaw}}. #' #' @details The only change added when \code{emulateGgMarginal = TRUE} is that \code{ggplot2::theme(plot.margin = unit(c(0, 0, 0.25, 0.25), "cm"))} @@ -37,8 +39,16 @@ JASPScatterPlot <- function(x, y, group = NULL, xName = NULL, yName = NULL, showLegend = !is.null(group), legendTitle = NULL, emulateGgMarginal = FALSE, + plotComposer = c("gridExtra", "patchwork"), + legendPosition = "topRightPatch", ...) { + lifecycle::deprecate_warn( + "0.19.0.9000", + "JASPScatterPlot()", + "jaspBivariateWithMargins()" + ) + # TODO: make actual error messages stopifnot( is.numeric(x), @@ -53,6 +63,7 @@ JASPScatterPlot <- function(x, y, group = NULL, xName = NULL, yName = NULL, ) plotAbove <- match.arg(plotAbove) plotRight <- match.arg(plotRight) + plotComposer <- match.arg(plotComposer) # can't make a legend without group showLegend <- showLegend && !is.null(group) @@ -76,7 +87,7 @@ JASPScatterPlot <- function(x, y, group = NULL, xName = NULL, yName = NULL, dots <- list(...) if (showLegend) - dots <- setDefaults(dots, legend.position = "right") + dots <- setDefaults(dots, legend.position = if (identical(legendPosition, "topRightPatch")) "right" else legendPosition) mainPlot <- ggplot(df, mapping) + geom_point() + @@ -99,16 +110,41 @@ JASPScatterPlot <- function(x, y, group = NULL, xName = NULL, yName = NULL, topPlot <- JASPScatterSubPlot(x, group, plotAbove, x.range, colorAreaUnderDensity, alphaAreaUnderDensity) rightPlot <- JASPScatterSubPlot(y, group, plotRight, y.range, colorAreaUnderDensity, alphaAreaUnderDensity, flip = TRUE) - plotList <- list(mainPlot = mainPlot, topPlot = topPlot, rightPlot = rightPlot) - plotList <- plotList[lengths(plotList) > 0L] + if (plotComposer == "patchwork") { - plot <- jaspGraphsPlot$new( - subplots = plotList, - plotFunction = reDrawAlignedPlot, - size = 5, - showLegend = showLegend - ) - return(plot) + topRightPatch <- if (is.null(topPlot)) { + NULL + } else if (identical(legendPosition, "topRightPatch")) { + patchwork::guide_area() + } else { + patchwork::plot_spacer() + } + noLegend <- theme(legend.position = "none") + extraLegend <- if (identical(legendPosition, "topRightPatch")) NULL else theme(legend.position = legendPosition) + + plot <- + (topPlot + noLegend) + topRightPatch + + mainPlot + (rightPlot + noLegend) + + patchwork::plot_layout( + widths = c(1, 1 / 5), + heights = c(1 / 5, 1), + guides = "collect" + ) & extraLegend + return(plot) + + } else { + + plotList <- list(mainPlot = mainPlot, topPlot = topPlot, rightPlot = rightPlot) + plotList <- plotList[lengths(plotList) > 0L] + + plot <- jaspGraphsPlot$new( + subplots = plotList, + plotFunction = reDrawAlignedPlot, + size = 5, + showLegend = showLegend + ) + return(plot) + } } JASPScatterSubPlot <- function(x, group = NULL, type = c("density", "histogram", "none"), range, @@ -129,7 +165,7 @@ JASPScatterSubPlot <- function(x, group = NULL, type = c("density", "histogram", foo <- function(x, ...) as.data.frame(stats::density(x, from = range[1L], to = range[2L])[c("x", "y")]) geom <- geom_line(linewidth = 0.5, show.legend = FALSE) geom2 <- if (colorAreaUnderDensity) { - geom_ribbon(aes(ymin = 0, ymax = .data$y), alpha = alpha) + geom_ribbon(aes(ymin = 0, ymax = .data$y), alpha = alpha, show.legend = FALSE) } else { NULL } diff --git a/R/customGeoms.R b/R/customGeoms.R index a31c5e30..804d71d7 100644 --- a/R/customGeoms.R +++ b/R/customGeoms.R @@ -1,3 +1,4 @@ +#'@importFrom ggplot2 aes setDefaults <- function(lst, ...) { @@ -23,7 +24,7 @@ setDefaults <- function(lst, ...) { jaspGeomPoint <- ggplot2::ggproto( `_class` = "jaspGeomPoint", `_inherit` = ggplot2::GeomPoint, - default_aes = aes(size = 3, shape = 21, colour = "black", fill = "grey", alpha = NA, stroke = 0.5) + default_aes = ggplot2::aes(size = 3, shape = 21, colour = "black", fill = "grey", alpha = NA, stroke = 0.5) ) #' @title Custom geoms @@ -51,7 +52,7 @@ geom_point <- function(mapping = NULL, data = NULL, stat = "identity", position jaspGeomLine <- ggplot2::ggproto( `_class` = "jaspGeomLine", `_inherit` = ggplot2::GeomLine, - default_aes = aes(linewidth = 1.00, colour = "black", linetype = 1, alpha = NA) + default_aes = ggplot2::aes(linewidth = 1.00, colour = "black", linetype = 1, alpha = NA) ) #' @rdname geom_point diff --git a/R/enums.R b/R/enums.R index 769ae093..ceaef9fc 100644 --- a/R/enums.R +++ b/R/enums.R @@ -12,6 +12,7 @@ createEnum <- function(nameValuePairs) { e } +#' @exportS3Method "$" Enum `$.Enum` <- function(x, y) { out <- NextMethod(x, y) if (is.null(out)) stop2(sprintf("nonexisting enum type %s!", y)) diff --git a/R/geom_rangeframe.R b/R/geom_rangeframe.R index 567a38a9..76903344 100644 --- a/R/geom_rangeframe.R +++ b/R/geom_rangeframe.R @@ -207,7 +207,7 @@ GeomRangeFrame <- ggplot2::ggproto("GeomRangeFrame", ggplot2::Geom, } ggname("geom_rangeframe", gTree(children = do.call("gList", rugs))) }, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), + default_aes = ggplot2::aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), draw_key = ggplot2::draw_key_path ) diff --git a/R/ggMatrixPlot.R b/R/ggMatrixPlot.R index e4e87314..db115531 100755 --- a/R/ggMatrixPlot.R +++ b/R/ggMatrixPlot.R @@ -30,6 +30,7 @@ makeLabels <- function(label, angle = 0, size = 1, family = graphOptions("family UseMethod("makeLabels", label) } +#' @exportS3Method makeLabels.default <- function(label, angle = 0, size = 1, family = graphOptions("family"), vjust = "center", hjust = "center", x = .5, y = .5) { @@ -70,6 +71,7 @@ makeLabels.default <- function(label, angle = 0, size = 1, family = graphOptions } } +#' @exportS3Method makeLabels.list <- function(label, angle = 0, size = 1, family = graphOptions("family"), vjust = "center", hjust = "center", x = .5, y = .5) { @@ -385,6 +387,13 @@ ggMatrixPlot.default <- function(plotList = NULL, nr = NULL, nc = NULL, scaleXYlabels = c(.9,.9), debug = FALSE) { + lifecycle::deprecate_warn( + "0.19.0.9000", + "jaspGraphs::ggMatrixPlot(...)", + "jaspGraphs::jaspMatrixPlot(...)", + details = "jaspMatrixPlot supersedes ggMatrixPlot." + ) + removeXYlabels <- match.arg(removeXYlabels) if (is.null(plotList) && debug) { diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R index c88a1b2d..9613114d 100644 --- a/R/jaspBivariate.R +++ b/R/jaspBivariate.R @@ -6,7 +6,7 @@ #' \item Smooth line through the data displayed using [ggplot2::geom_smooth]. #' \item Prediction interval of y given x using [stats::predict.lm](assuming linear relationship), or prediction ellipse assuming bivariate normal distribution. #' } -#' @param x Numeric vector of values on the x-axis. `r "\u03BC"` +#' @param x Numeric vector of values on the x-axis. #' @param y Numeric vector of values on the y-axis. #' @param group Optional grouping variable. #' @param xName Character; x-axis label. If left empty, the name of the \code{x} object is displayed. To remove the axis label, use \code{NULL}. @@ -43,11 +43,11 @@ jaspBivariate <- function( x, y, group = NULL, xName, yName, groupName, type = c("point", "hex", "bin", "contour", "density", "none"), - args = list(color = "black"), + args = list(),#color = "black"), smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, smoothCiLevel = 0.95, - smoothArgs = list(color = "black"), + smoothArgs = list(),#color = "black"), predict = c("none", "lm", "ellipse"), predictLevel = 0.95, predictArgs = .predictArgs(), @@ -67,6 +67,7 @@ jaspBivariate <- function( if (type != "point" && type != "none") stop2("grouping variable is allowed only for type = 'point' or 'none'.") + group <- factor(group) df <- data.frame(x = x, y = y, group = group) aes <- ggplot2::aes(x = x, y = y, group = group, fill = group, color = group) } @@ -116,7 +117,7 @@ jaspBivariate <- function( preds <- as.data.frame(preds) preds[["x"]] <- df[["x"]] predictArgs$data <- preds - predictArgs$mapping <- ggplot2::aes(x = x, ymin = lwr, ymax = upr) + predictArgs$mapping <- ggplot2::aes(x = x, ymin = .data$lwr, ymax = .data$upr) predictLayer <- do.call(ggplot2::geom_ribbon, predictArgs) } else if (predict == "ellipse") { predictArgs$geom <- "polygon" @@ -158,8 +159,8 @@ jaspBivariate <- function( } plot <- ggplot2::ggplot(data = df, mapping = aes) + - baseLayer + smoothLayer + + baseLayer + predictLayer + jaspGraphs::themeJaspRaw(legend.position = legendPosition) + jaspGraphs::geom_rangeframe() + @@ -211,26 +212,27 @@ jaspBivariate <- function( #' @param yName Character; y-axis label. If left empty, the name of the \code{y} object is displayed. To remove the axis label, use \code{NULL}. #' @param groupName Character; label of the grouping variable displayed as a legend title. If left empty, the name of the \code{group} object is displayed. #' @param margins Numeric vector; The proportions of the subplots relative to each other. -#' @param binWidthType See [jaspHistogram]. Used for determining consistent axes for the bivariate and marginal distribution plots. -#' @param numberOfBins See [jaspHistogram]. Used for determining consistent axes for the bivariate and marginal distribution plots. -#' @param histogramArgs An optional list of options passed to [jaspHistogram]. +#' @param xMarginalArgs List, options for the marginal plot above. Defaults to the default values of [jaspMarginal]. +#' @param yMarginalArgs List, options for the marginal plot to the right. Defaults to the default values of [jaspMarginal]. #' @param topRightPlotFunction An optional function that can be used to plotting something in the top-right panel. If \code{NULL} (default), an empty area is plotted. #' @param topRightPlotArgs An optional list of options passed to \code{topRightPlotFunction}. +#' @param legendPosition Either "topRight" or any values that is accepted by \code{\link[ggplot2]{theme}} for `legend.position`. If set to "topRight" then `topRightPlotFunction` cannot be used. #' @param ... Additional options passed to [jaspBivariate]. #' #' @export jaspBivariateWithMargins <- function( - x, y, group = NULL, xName, yName, groupName, margins = c(0.25, 0.75), + x, y, group = NULL, xName, yName, groupName, margins = c(1/6, 5/6), xMarginalArgs = .marginalArgs(), yMarginalArgs = .marginalArgs(), topRightPlotFunction = NULL, topRightPlotArgs = list(), + legendPosition = "topRight", ... ) { if (!is.null(group) && missing(groupName)) { groupName <- deparse1(substitute(group)) - } else if(missing(groupName)) { + } else if (missing(groupName)) { groupName <- "" } @@ -245,7 +247,7 @@ jaspBivariateWithMargins <- function( } else { df <- data.frame(x = x, y = y, group = group) } - df <- na.omit(df) + df <- stats::na.omit(df) xBreaks <- getJaspMarginalBreaks(x = df[["x"]], breaks = xMarginalArgs[["breaks"]]) yBreaks <- getJaspMarginalBreaks(x = df[["y"]], breaks = yMarginalArgs[["breaks"]]) @@ -258,6 +260,7 @@ jaspBivariateWithMargins <- function( xMarginalArgs["yName"] <- list(NULL) xMarginalArgs["groupName"] <- list(groupName) xMarginalArgs[["axisLabels"]] <- "none" + xMarginalArgs[["sides"]] <- "" topLeft <- do.call(jaspMarginal, xMarginalArgs) @@ -268,22 +271,30 @@ jaspBivariateWithMargins <- function( yMarginalArgs["yName"] <- list(NULL) yMarginalArgs["groupName"] <- list(groupName) yMarginalArgs[["axisLabels"]] <- "none" + yMarginalArgs[["sides"]] <- "" bottomRight <- do.call(jaspMarginal, yMarginalArgs) + ggplot2::coord_flip() + if (is.function(topRightPlotFunction) && is.list(topRightPlotArgs)) { + + if (identical(legendPosition, "topRight")) stop2(r"{`legendPosition = "topRight"` cannot be used in conjunction with `topRightPlotFunction`.}") + topRightPlotArgs[["x"]] <- x topRightPlotArgs[["y"]] <- y topRight <- do.call(topRightPlotFunction, topRightPlotArgs) + } else if (is.null(topRightPlotFunction)) { - topRight <- patchwork::plot_spacer() + topRight <- if (identical(legendPosition, "topRight")) patchwork::guide_area() else patchwork::plot_spacer() } + extraLegend <- if (identical(legendPosition, "topRight")) NULL else theme(legend.position = legendPosition) + patchwork::wrap_plots( topLeft, topRight, bottomLeft, bottomRight, widths = rev(margins), heights = margins ) + - patchwork::plot_layout(guides = "collect") + patchwork::plot_layout(guides = "collect") & extraLegend } diff --git a/R/jaspHistogram.R b/R/jaspHistogram.R index c7766707..d6342011 100644 --- a/R/jaspHistogram.R +++ b/R/jaspHistogram.R @@ -26,6 +26,7 @@ #' @param hideYAxisLabels, logical, should the y-axis line be hidden? Defaults to \code{showDensity}. #' @param hideXAxisName, logical, should the x-axis name be hidden? Defaults to \code{FALSE}. #' @param hideYAxisName, logical, should the y-axis name be hidden? Defaults to \code{FALSE}. +#' @param xBreaks custom x-axis breaks. #' @example inst/examples/ex-jaspHistogram.R #' @export jaspHistogram <- function( @@ -74,7 +75,7 @@ jaspHistogram <- function( hasGroupingVariable <- !is.null(groupingVariable) x <- stats::na.omit(as.numeric(x)) - if(!is.null(xBreaks) || !missing(xBreaks)) { + if (!is.null(xBreaks) || !missing(xBreaks)) { binWidthType <- "manual" numberOfBins <- xBreaks } diff --git a/R/jaspMarginal.R b/R/jaspMarginal.R index 622591d2..56d03433 100644 --- a/R/jaspMarginal.R +++ b/R/jaspMarginal.R @@ -36,6 +36,7 @@ #' @param densityOverlay, logical, should a density overlay be superimposed on the plot? #' @param densityOverlayArgs, logical, additional arguments passed to \code{\link[ggplot2]{geom_density}}. Use `.densityArgs` to set the options. #' @param axisLabels, string, which axes should have labels displayed? If \code{"auto"}, \code{"x"} is used if \code{type == "density"}, otherwise \code{"both"} is used. +#' @param sides, string passed to [geom_rangeframe]. #' @example inst/examples/ex-jaspMarginal.R #' @rdname jaspMarginal #' @export @@ -55,7 +56,8 @@ jaspMarginal <- function( densityArgs = .densityArgs(), densityOverlay = FALSE, densityOverlayArgs = .densityArgs(linewidth = 1), - axisLabels = c("auto", "both", "x", "y", "none") + axisLabels = c("auto", "both", "x", "y", "none"), + sides = "bl" ) { # validate input @@ -71,7 +73,7 @@ jaspMarginal <- function( xName <- deparse1(substitute(x)) # identical to plot.default if (missing(yName)) - yName <- if(type == "density") gettext("Density") else gettext("Count") + yName <- if (type == "density") gettext("Density") else gettext("Count") if (!is.character(xName) && !is.null(xName)) stop2("`xName` must be character but has class ", paste(class(xName), collapse = ", "), "!") @@ -92,12 +94,12 @@ jaspMarginal <- function( hasGroupingVariable <- !is.null(group) - if(hasGroupingVariable) { + if (hasGroupingVariable) { data <- data.frame(x = x, group = group) } else { data <- data.frame(x = x) } - data <- na.omit(data) + data <- stats::na.omit(data) h <- getJaspMarginalData(x = data[["x"]], breaks = breaks) xBreaks <- getPrettyAxisBreaks(c(data[["x"]], h[["breaks"]]), min.n = 3) @@ -106,13 +108,13 @@ jaspMarginal <- function( if (histogram) { yy <- as.symbol(type) histogramAes <- - if(hasGroupingVariable) { - ggplot2::aes(x = x, y = ggplot2::after_stat({{yy}}), fill = group, group = group) + if (hasGroupingVariable) { + ggplot2::aes(x = x, y = ggplot2::after_stat({{yy}}), color = group, fill = group, group = group) } else { ggplot2::aes(x = x, y = ggplot2::after_stat({{yy}})) } # default gray filling - if(is.null(histogramArgs[["fill"]]) && is.null(histogramAes[["fill"]])) histogramArgs[["fill"]] <- "gray" + if (is.null(histogramArgs[["fill"]]) && is.null(histogramAes[["fill"]])) histogramArgs[["fill"]] <- "gray" histogramArgs[["mapping"]] <- histogramAes histogramArgs[["breaks"]] <- h[["breaks"]] @@ -123,15 +125,15 @@ jaspMarginal <- function( if (density) { bw <- diff(h[["breaks"]])[1] yy <- as.symbol(type) - yy <- if(type == "density") { + yy <- if (type == "density") { substitute(ggplot2::after_stat(yy)) } else { substitute(bw * ggplot2::after_stat(yy)) } densityAes <- - if(hasGroupingVariable) { - ggplot2::aes(x = x, y = {{yy}}, fill = group, group = group) + if (hasGroupingVariable) { + ggplot2::aes(x = x, y = {{yy}}, color = group, fill = group, group = group) } else { ggplot2::aes(x = x, y = {{yy}}) } @@ -145,7 +147,7 @@ jaspMarginal <- function( if (densityOverlay) { bw <- diff(h[["breaks"]])[1] yy <- as.symbol(type) - yy <- if(type == "density") { + yy <- if (type == "density") { substitute(ggplot2::after_stat(yy)) } else { substitute(bw * ggplot2::after_stat(yy)) @@ -175,7 +177,7 @@ jaspMarginal <- function( densityLayer + densityOverlayLayer + rugLayer + - geom_rangeframe() + + geom_rangeframe(sides = sides) + themeJaspRaw(legend.position = "right") + scale_x_continuous(breaks = xBreaks, limits = range(xBreaks)) + ggplot2::xlab(xName) + @@ -232,10 +234,12 @@ getJaspMarginalBreaks <- function(x, breaks) { } #' @rdname jaspMarginal +#' @param size see `?ggplot2::aes_linetype_size_shape` +#' @inheritParams ggplot2::geom_point #' @export -.histogramArgs <- function(color = "black", size = 0.7, position = ggplot2::position_dodge(), ...) { +.histogramArgs <- function(size = 0.7, position = ggplot2::position_dodge(), ...) { args <- list(...) - args[["color"]] <- color + # args[["color"]] <- color args[["size"]] <- size args[["position"]] <- position @@ -251,10 +255,13 @@ getJaspMarginalBreaks <- function(x, breaks) { } #' @rdname jaspMarginal +#' @param linewidth see `?ggplot2::aes_linetype_size_shape` +#' @param alpha color transparency +#' @inheritParams ggplot2::geom_point #' @export -.densityArgs <- function(color = "black", linewidth = 0.7, alpha = 0.5, ...) { +.densityArgs <- function(linewidth = 0.7, alpha = 0.5, ...) { args <- list(...) - args[["color"]] <- color + # args[["color"]] <- color args[["linewidth"]] <- linewidth args[["alpha"]] <- alpha diff --git a/R/jaspMatrixPlot.R b/R/jaspMatrixPlot.R index 94cc4ec3..12ec8fc9 100644 --- a/R/jaspMatrixPlot.R +++ b/R/jaspMatrixPlot.R @@ -10,12 +10,12 @@ #' } #' #' @param data Data frame of data to plot. -#' @param diagonal A function that draws the plots on the diagonal. Must accept arguments \code{x} (numeric), \code{xName} (character). -#' @param diagonalArgs A list of additional arguments to pass to \code{diagonal}. -#' @param topRight A function that draws the plots on the top right off-diagonal. Must accept arguments \code{x} (numeric), \code{y} (numeric), \code{xName} (character), and \code{yName} (character). -#' @param topRightArgs A list of additional arguments to pass to \code{topRight}. -#' @param bottomLeft A function that draws the plots on the bottom left off-diagonal. Must accept arguments \code{x} (numeric), \code{y} (numeric), \code{xName} (character), and \code{yName} (character). -#' @param bottomLeftArgs A list of additional arguments to pass to \code{bottomLeft}. +#' @param diagonalPlotFunction A function that draws the plots on the diagonal. Must accept arguments \code{x} (numeric), \code{xName} (character). +#' @param diagonalPlotArgs A list of additional arguments to pass to \code{diagonalPlotFunction}. +#' @param topRightPlotFunction A function that draws the plots in the upper triangle. Must accept arguments \code{x} (numeric), \code{xName} (character). +#' @param topRightPlotArgs A list of additional arguments to pass to \code{topRightPlotFunction}. +#' @param bottomLeftPlotFunction A function that draws the plots in the lower triangle. Must accept arguments \code{x} (numeric), \code{xName} (character). +#' @param bottomLeftPlotArgs A list of additional arguments to pass to \code{bottomLeftPlotFunction}. #' @param overwriteDiagonalAxes,overwriteTopRightAxes,overwriteBottomLeftAxes Which axes should be overwritten such that they have a common range. Possible options: #' \describe{ #' \item{\code{"none"}}{No axes are overwritten, hence the plots get their own scales given by \code{diagonal}, \code{topRight}, and \code{bottomLeft} functions, respectively.} @@ -133,7 +133,7 @@ jaspMatrixPlot <- function( ggplot2::annotate( "text", x = 1/2, y = 1/2, label = nm, angle = angle, - size = 1.2 * jaspGraphs::getGraphOption("fontsize") / ggplot2::.pt + size = 1.2 * getGraphOption("fontsize") / ggplot2::.pt ) + ggplot2::ylim(0:1) + ggplot2::xlim(0:1) + ggplot2::theme_void() @@ -149,9 +149,9 @@ jaspMatrixPlot <- function( res <- ggplot2::ggplot() + ggplot2::geom_label( data = data.frame(x = 0.5, y = 0.5, label = message), - mapping = ggplot2::aes(x = x, y = y, label = label), - fill = adjustcolor("red", alpha = 0.5), - size = 0.7 * jaspGraphs::getGraphOption("fontsize") / ggplot2::.pt, + mapping = ggplot2::aes(x = .data$x, y = .data$y, label = .data$label), + fill = grDevices::adjustcolor("red", alpha.f = 0.5), + size = 0.7 * getGraphOption("fontsize") / ggplot2::.pt, hjust = "center", vjust = "center" ) + diff --git a/R/plotEditingAxes.R b/R/plotEditingAxes.R index 96fd0024..3eaa5a65 100644 --- a/R/plotEditingAxes.R +++ b/R/plotEditingAxes.R @@ -95,6 +95,7 @@ getAxisInfo <- function(x, opts, ggbuild) { UseMethod("getAxisInfo", x) } +#' @exportS3Method getAxisInfo.ScaleContinuousPosition <- function(x, opts, ggbuild) { xory <- getXorY(x, ggbuild) @@ -168,6 +169,7 @@ getAxisInfo.ScaleContinuousPosition <- function(x, opts, ggbuild) { } +#' @exportS3Method getAxisInfo.ScaleDiscretePosition <- function(x, opts, ggbuild) { xory <- getXorY(x, ggbuild) @@ -202,6 +204,7 @@ internalUpdateAxis <- function(currentAxis, newSettings) { UseMethod("internalUpdateAxis", currentAxis) } +#' @exportS3Method internalUpdateAxis.ScaleContinuousPosition <- function(currentAxis, newSettings) { if (newSettings[["breaksType"]] == BreaksType$Null) { @@ -237,6 +240,7 @@ internalUpdateAxis.ScaleContinuousPosition <- function(currentAxis, newSettings) return(currentAxis) } +#' @exportS3Method internalUpdateAxis.ScaleDiscretePosition <- function(currentAxis, newSettings) { # newSettings only contains not modified settings! diff --git a/R/plotEditingOptions.R b/R/plotEditingOptions.R index 0d689a02..bfbe8bd8 100644 --- a/R/plotEditingOptions.R +++ b/R/plotEditingOptions.R @@ -27,6 +27,7 @@ getPlotEditingOptions <- function(graph) { UseMethod("getPlotEditingOptions", graph) } +#' @exportS3Method getPlotEditingOptions.gg <- function(graph) { # ensures that loading an edited graph returns the final set of options if (!is.null(graph[["plot_env"]][[".____plotEditingOptions____"]][["oldOptions"]])) @@ -34,10 +35,12 @@ getPlotEditingOptions.gg <- function(graph) { return(getPlotEditingOptions.ggplot(graph)) } +#' @exportS3Method getPlotEditingOptions.ggplot <- function(graph) { getPlotEditingOptions.ggplot_built(ggplot_build(graph)) } +#' @exportS3Method getPlotEditingOptions.ggplot_built <- function(graph) { # TODO: test if graph can be edited at all! @@ -72,18 +75,22 @@ getPlotEditingOptions.ggplot_built <- function(graph) { return(out) } +#' @exportS3Method getPlotEditingOptions.qgraph <- function(graph) { plotEditingOptionsError(gettext("This plot cannot be edited because it was created with qgraph instead of ggplot.")) } +#' @exportS3Method getPlotEditingOptions.jaspGraphsPlot <- function(graph) { plotEditingOptionsError(gettext("This plot cannot be edited because it consists of multiple smaller figures.")) } +#' @exportS3Method getPlotEditingOptions "function" getPlotEditingOptions.function <- function(graph) { plotEditingOptionsError(gettext("This plot cannot be edited because it was created with base R instead of ggplot.")) } +#' @exportS3Method getPlotEditingOptions.default <- function(graph) { plotEditingOptionsError( gettextf("cannot create plotEditingOptions for object of class: %s.", paste(class(graph), collapse = ",")), diff --git a/R/plotQQnorm.R b/R/plotQQnorm.R index 6473c96f..6ada6700 100644 --- a/R/plotQQnorm.R +++ b/R/plotQQnorm.R @@ -5,6 +5,8 @@ #' @param lower Numeric vector, lower confidence interval of each residual. If NULL, no error bars are drawn. #' @param upper Numeric vector, lower confidence interval of each residual. If NULL, no error bars are drawn. #' @param abline Logical, should an abline be drawn through the origin? +#' @param ablineOrigin Logical, should the abline go through the origin? +#' @param identicalAxes Logical, should the x and y axis breaks be identical? #' @param ablineColor String, color of the abline. #' @param xName String, name for the x-axis. #' @param yName String, name for the y-axis. @@ -20,8 +22,8 @@ #' jaspGraphs::plotQQnorm(x, lower, upper) #' #' @export -plotQQnorm <- function(residuals, lower = NULL, upper = NULL, abline = TRUE, ablineOrigin = FALSE, ablineColor = "red", identicalAxes = FALSE, - xName = gettext("Theoretical quantiles",domain="R-jaspGraphs"), yName = gettext("Observed quantiles",domain="R-jaspGraphs")) { +plotQQnorm <- function(residuals, lower = NULL, upper = NULL, abline = TRUE, ablineOrigin = FALSE, ablineColor = "red", identicalAxes = FALSE, + xName = gettext("Theoretical quantiles",domain = "R-jaspGraphs"), yName = gettext("Observed quantiles",domain = "R-jaspGraphs")) { n <- length(residuals) hasErrorbars <- !is.null(lower) && !is.null(upper) @@ -65,7 +67,7 @@ plotQQnorm <- function(residuals, lower = NULL, upper = NULL, abline = TRUE, abl dfLine <- data.frame(x = xvals, y = yvals) g <- ggplot2::ggplot(data = df, aes(x = .data$x, y = .data$y)) - if (abline && ablineOrigin) { + if (abline && ablineOrigin) { g <- g + ggplot2::geom_line(data = data.frame(x = c(min(xvals), max(xvals)), y = c(min(xvals), max(xvals))), mapping = ggplot2::aes(x = .data$x, y = .data$y), col = ablineColor, @@ -73,7 +75,7 @@ plotQQnorm <- function(residuals, lower = NULL, upper = NULL, abline = TRUE, abl } else if (abline) { g <- g + ggplot2::geom_line(mapping = aes(x = .data$x, y = .data$y), data = dfLine, inherit.aes = FALSE, color = ablineColor) } - + if (hasErrorbars) g <- g + ggplot2::geom_errorbar(aes(ymin = .data$ymin, ymax = .data$ymax)) diff --git a/man/JASPScatterPlot.Rd b/man/JASPScatterPlot.Rd index b1959c36..128b13cb 100644 --- a/man/JASPScatterPlot.Rd +++ b/man/JASPScatterPlot.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/JASPScatterPlot.R \name{JASPScatterPlot} \alias{JASPScatterPlot} -\title{Create a scatter plot with density} +\title{DEPRECATED, use \link{jaspBivariateWithMargins} instead. Create a scatter plot with density} \usage{ JASPScatterPlot( x, @@ -21,6 +21,8 @@ JASPScatterPlot( showLegend = !is.null(group), legendTitle = NULL, emulateGgMarginal = FALSE, + plotComposer = c("gridExtra", "patchwork"), + legendPosition = "topRightPatch", ... ) } @@ -57,10 +59,14 @@ JASPScatterPlot( \item{emulateGgMarginal}{Should the result be as similar as possible to \code{\link[ggExtra]{ggMarginal}}? Overwrites other parameters.} +\item{plotComposer, }{String, should "gridExtra" or "patchwork" be used for combining plots?} + +\item{legendPosition}{where should the legend position be placed? "topRightPatch",} + \item{...}{passed to \code{\link{themeJaspRaw}}.} } \description{ -Create a scatter plot with density +DEPRECATED, use \link{jaspBivariateWithMargins} instead. Create a scatter plot with density } \details{ The only change added when \code{emulateGgMarginal = TRUE} is that \code{ggplot2::theme(plot.margin = unit(c(0, 0, 0.25, 0.25), "cm"))} diff --git a/man/geom_abline2.Rd b/man/geom_abline2.Rd index 0a61db71..acab8d1c 100644 --- a/man/geom_abline2.Rd +++ b/man/geom_abline2.Rd @@ -37,10 +37,33 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{method}{Either "breaks" (default) to respect the extrema of the axes or "ggplot2" to obtain the ggplot2 behavior.} -\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are -often aesthetics, used to set an aesthetic to a fixed value, like -\code{colour = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These +arguments broadly fall into one of 4 categories below. Notably, further +arguments to the \code{position} argument, or aesthetics that are required +can \emph{not} be passed through \code{...}. Unknown arguments that are not part +of the 4 categories below are ignored. +\itemize{ +\item Static aesthetics that are not mapped to a scale, but are at a fixed +value and apply to the layer as a whole. For example, \code{colour = "red"} +or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} +section that lists the available options. The 'required' aesthetics +cannot be passed on to the \code{params}. Please note that while passing +unmapped aesthetics as vectors is technically possible, the order and +required length is not guaranteed to be parallel to the input data. +\item When constructing a layer using +a \verb{stat_*()} function, the \code{...} argument can be used to pass on +parameters to the \code{geom} part of the layer. An example of this is +\code{stat_density(geom = "area", outline.type = "both")}. The geom's +documentation lists which parameters it can accept. +\item Inversely, when constructing a layer using a +\verb{geom_*()} function, the \code{...} argument can be used to pass on parameters +to the \code{stat} part of the layer. An example of this is +\code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation +lists which parameters it can accept. +\item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through +\code{...}. This can be one of the functions described as +\link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. +}} \item{slope}{controls the slope of the lines. If set, \code{data}, \code{mapping} and \code{show.legend} are overridden.} diff --git a/man/geom_aligned_text.Rd b/man/geom_aligned_text.Rd index f701d499..eb392c41 100644 --- a/man/geom_aligned_text.Rd +++ b/man/geom_aligned_text.Rd @@ -42,19 +42,59 @@ the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} -\item{stat}{The statistical transformation to use on the data for this -layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the -stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than -\code{"stat_count"})} +\item{stat}{The statistical transformation to use on the data for this layer. +When using a \verb{geom_*()} function to construct a layer, the \code{stat} +argument can be used the override the default coupling between geoms and +stats. The \code{stat} argument accepts the following: +\itemize{ +\item A \code{Stat} ggproto subclass, for example \code{StatCount}. +\item A string naming the stat. To give the stat as a string, strip the +function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, +give the stat as \code{"count"}. +\item For more information and other ways to specify the stat, see the +\link[ggplot2:layer_stats]{layer stat} documentation. +}} -\item{position}{Position adjustment, either as a string, or the result of -a call to a position adjustment function. Cannot be jointly specified with -\code{nudge_x} or \code{nudge_y}.} +\item{position}{A position adjustment to use on the data for this layer. +Cannot be jointy specified with \code{nudge_x} or \code{nudge_y}. This +can be used in various ways, including to prevent overplotting and +improving the display. The \code{position} argument accepts the following: +\itemize{ +\item The result of calling a position function, such as \code{position_jitter()}. +\item A string nameing the position adjustment. To give the position as a +string, strip the function name of the \code{position_} prefix. For example, +to use \code{position_jitter()}, give the position as \code{"jitter"}. +\item For more information and other ways to specify the position, see the +\link[ggplot2:layer_positions]{layer position} documentation. +}} -\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are -often aesthetics, used to set an aesthetic to a fixed value, like -\code{colour = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These +arguments broadly fall into one of 4 categories below. Notably, further +arguments to the \code{position} argument, or aesthetics that are required +can \emph{not} be passed through \code{...}. Unknown arguments that are not part +of the 4 categories below are ignored. +\itemize{ +\item Static aesthetics that are not mapped to a scale, but are at a fixed +value and apply to the layer as a whole. For example, \code{colour = "red"} +or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} +section that lists the available options. The 'required' aesthetics +cannot be passed on to the \code{params}. Please note that while passing +unmapped aesthetics as vectors is technically possible, the order and +required length is not guaranteed to be parallel to the input data. +\item When constructing a layer using +a \verb{stat_*()} function, the \code{...} argument can be used to pass on +parameters to the \code{geom} part of the layer. An example of this is +\code{stat_density(geom = "area", outline.type = "both")}. The geom's +documentation lists which parameters it can accept. +\item Inversely, when constructing a layer using a +\verb{geom_*()} function, the \code{...} argument can be used to pass on parameters +to the \code{stat} part of the layer. An example of this is +\code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation +lists which parameters it can accept. +\item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through +\code{...}. This can be one of the functions described as +\link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. +}} \item{parse}{If \code{TRUE}, the labels will be parsed into expressions and displayed as described in \code{?plotmath}.} diff --git a/man/geom_rangeframe.Rd b/man/geom_rangeframe.Rd index c05933a2..bb3cbff4 100644 --- a/man/geom_rangeframe.Rd +++ b/man/geom_rangeframe.Rd @@ -40,20 +40,59 @@ the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} -\item{stat}{The statistical transformation to use on the data for this -layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the -stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than -\code{"stat_count"})} - -\item{position}{Position adjustment, either as a string naming the adjustment -(e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a -position adjustment function. Use the latter if you need to change the -settings of the adjustment.} - -\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are -often aesthetics, used to set an aesthetic to a fixed value, like -\code{colour = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +\item{stat}{The statistical transformation to use on the data for this layer. +When using a \verb{geom_*()} function to construct a layer, the \code{stat} +argument can be used the override the default coupling between geoms and +stats. The \code{stat} argument accepts the following: +\itemize{ +\item A \code{Stat} ggproto subclass, for example \code{StatCount}. +\item A string naming the stat. To give the stat as a string, strip the +function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, +give the stat as \code{"count"}. +\item For more information and other ways to specify the stat, see the +\link[ggplot2:layer_stats]{layer stat} documentation. +}} + +\item{position}{A position adjustment to use on the data for this layer. This +can be used in various ways, including to prevent overplotting and +improving the display. The \code{position} argument accepts the following: +\itemize{ +\item The result of calling a position function, such as \code{position_jitter()}. +This method allows for passing extra arguments to the position. +\item A string naming the position adjustment. To give the position as a +string, strip the function name of the \code{position_} prefix. For example, +to use \code{position_jitter()}, give the position as \code{"jitter"}. +\item For more information and other ways to specify the position, see the +\link[ggplot2:layer_positions]{layer position} documentation. +}} + +\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These +arguments broadly fall into one of 4 categories below. Notably, further +arguments to the \code{position} argument, or aesthetics that are required +can \emph{not} be passed through \code{...}. Unknown arguments that are not part +of the 4 categories below are ignored. +\itemize{ +\item Static aesthetics that are not mapped to a scale, but are at a fixed +value and apply to the layer as a whole. For example, \code{colour = "red"} +or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} +section that lists the available options. The 'required' aesthetics +cannot be passed on to the \code{params}. Please note that while passing +unmapped aesthetics as vectors is technically possible, the order and +required length is not guaranteed to be parallel to the input data. +\item When constructing a layer using +a \verb{stat_*()} function, the \code{...} argument can be used to pass on +parameters to the \code{geom} part of the layer. An example of this is +\code{stat_density(geom = "area", outline.type = "both")}. The geom's +documentation lists which parameters it can accept. +\item Inversely, when constructing a layer using a +\verb{geom_*()} function, the \code{...} argument can be used to pass on parameters +to the \code{stat} part of the layer. An example of this is +\code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation +lists which parameters it can accept. +\item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through +\code{...}. This can be one of the functions described as +\link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. +}} \item{sides}{A string that controls which sides of the plot the frames appear on. It can be set to a string containing any of \code{'trbl'}, for top, right, diff --git a/man/jaspBivariate.Rd b/man/jaspBivariate.Rd index 2cd4612b..964dc97d 100644 --- a/man/jaspBivariate.Rd +++ b/man/jaspBivariate.Rd @@ -12,11 +12,11 @@ jaspBivariate( yName, groupName, type = c("point", "hex", "bin", "contour", "density", "none"), - args = list(color = "black"), + args = list(), smooth = c("none", "lm", "glm", "gam", "loess"), smoothCi = FALSE, smoothCiLevel = 0.95, - smoothArgs = list(color = "black"), + smoothArgs = list(), predict = c("none", "lm", "ellipse"), predictLevel = 0.95, predictArgs = .predictArgs(), @@ -26,7 +26,7 @@ jaspBivariate( ) } \arguments{ -\item{x}{Numeric vector of values on the x-axis. μ} +\item{x}{Numeric vector of values on the x-axis.} \item{y}{Numeric vector of values on the y-axis.} diff --git a/man/jaspBivariateWithMargins.Rd b/man/jaspBivariateWithMargins.Rd index 7b464c0d..acfa6448 100644 --- a/man/jaspBivariateWithMargins.Rd +++ b/man/jaspBivariateWithMargins.Rd @@ -11,11 +11,12 @@ jaspBivariateWithMargins( xName, yName, groupName, - margins = c(0.25, 0.75), + margins = c(1/6, 5/6), xMarginalArgs = .marginalArgs(), yMarginalArgs = .marginalArgs(), topRightPlotFunction = NULL, topRightPlotArgs = list(), + legendPosition = "topRight", ... ) } @@ -34,17 +35,17 @@ jaspBivariateWithMargins( \item{margins}{Numeric vector; The proportions of the subplots relative to each other.} -\item{topRightPlotFunction}{An optional function that can be used to plotting something in the top-right panel. If \code{NULL} (default), an empty area is plotted.} +\item{xMarginalArgs}{List, options for the marginal plot above. Defaults to the default values of \link{jaspMarginal}.} -\item{topRightPlotArgs}{An optional list of options passed to \code{topRightPlotFunction}.} +\item{yMarginalArgs}{List, options for the marginal plot to the right. Defaults to the default values of \link{jaspMarginal}.} -\item{...}{Additional options passed to \link{jaspBivariate}.} +\item{topRightPlotFunction}{An optional function that can be used to plotting something in the top-right panel. If \code{NULL} (default), an empty area is plotted.} -\item{binWidthType}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} +\item{topRightPlotArgs}{An optional list of options passed to \code{topRightPlotFunction}.} -\item{numberOfBins}{See \link{jaspHistogram}. Used for determining consistent axes for the bivariate and marginal distribution plots.} +\item{legendPosition}{Either "topRight" or any values that is accepted by \code{\link[ggplot2]{theme}} for \code{legend.position}. If set to "topRight" then \code{topRightPlotFunction} cannot be used.} -\item{histogramArgs}{An optional list of options passed to \link{jaspHistogram}.} +\item{...}{Additional options passed to \link{jaspBivariate}.} } \description{ This plot consists of four elements: diff --git a/man/jaspHistogram.Rd b/man/jaspHistogram.Rd index 37c929eb..793cb74a 100644 --- a/man/jaspHistogram.Rd +++ b/man/jaspHistogram.Rd @@ -65,6 +65,8 @@ jaspHistogram( \item{hideXAxisName, }{logical, should the x-axis name be hidden? Defaults to \code{FALSE}.} \item{hideYAxisName, }{logical, should the y-axis name be hidden? Defaults to \code{FALSE}.} + +\item{xBreaks}{custom x-axis breaks.} } \description{ A plot histogram with three components. diff --git a/man/jaspMarginal.Rd b/man/jaspMarginal.Rd index 9b8e6dfd..6776d030 100644 --- a/man/jaspMarginal.Rd +++ b/man/jaspMarginal.Rd @@ -24,7 +24,8 @@ jaspMarginal( densityArgs = .densityArgs(), densityOverlay = FALSE, densityOverlayArgs = .densityArgs(linewidth = 1), - axisLabels = c("auto", "both", "x", "y", "none") + axisLabels = c("auto", "both", "x", "y", "none"), + sides = "bl" ) .marginalArgs( @@ -43,19 +44,15 @@ jaspMarginal( densityArgs = .densityArgs(), densityOverlay = FALSE, densityOverlayArgs = .densityArgs(linewidth = 1), - axisLabels = c("auto", "both", "x", "y", "none") + axisLabels = c("auto", "both", "x", "y", "none"), + sides = "bl" ) -.histogramArgs( - color = "black", - size = 0.7, - position = ggplot2::position_dodge(), - ... -) +.histogramArgs(size = 0.7, position = ggplot2::position_dodge(), ...) .rugArgs(...) -.densityArgs(color = "black", linewidth = 0.7, alpha = 0.5, ...) +.densityArgs(linewidth = 0.7, alpha = 0.5, ...) } \arguments{ \item{x, }{numeric, the data to show the plot for.} @@ -89,6 +86,55 @@ jaspMarginal( \item{densityOverlayArgs, }{logical, additional arguments passed to \code{\link[ggplot2]{geom_density}}. Use \code{.densityArgs} to set the options.} \item{axisLabels, }{string, which axes should have labels displayed? If \code{"auto"}, \code{"x"} is used if \code{type == "density"}, otherwise \code{"both"} is used.} + +\item{sides, }{string passed to \link{geom_rangeframe}.} + +\item{size}{see \code{?ggplot2::aes_linetype_size_shape}} + +\item{position}{A position adjustment to use on the data for this layer. This +can be used in various ways, including to prevent overplotting and +improving the display. The \code{position} argument accepts the following: +\itemize{ +\item The result of calling a position function, such as \code{position_jitter()}. +This method allows for passing extra arguments to the position. +\item A string naming the position adjustment. To give the position as a +string, strip the function name of the \code{position_} prefix. For example, +to use \code{position_jitter()}, give the position as \code{"jitter"}. +\item For more information and other ways to specify the position, see the +\link[ggplot2:layer_positions]{layer position} documentation. +}} + +\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These +arguments broadly fall into one of 4 categories below. Notably, further +arguments to the \code{position} argument, or aesthetics that are required +can \emph{not} be passed through \code{...}. Unknown arguments that are not part +of the 4 categories below are ignored. +\itemize{ +\item Static aesthetics that are not mapped to a scale, but are at a fixed +value and apply to the layer as a whole. For example, \code{colour = "red"} +or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} +section that lists the available options. The 'required' aesthetics +cannot be passed on to the \code{params}. Please note that while passing +unmapped aesthetics as vectors is technically possible, the order and +required length is not guaranteed to be parallel to the input data. +\item When constructing a layer using +a \verb{stat_*()} function, the \code{...} argument can be used to pass on +parameters to the \code{geom} part of the layer. An example of this is +\code{stat_density(geom = "area", outline.type = "both")}. The geom's +documentation lists which parameters it can accept. +\item Inversely, when constructing a layer using a +\verb{geom_*()} function, the \code{...} argument can be used to pass on parameters +to the \code{stat} part of the layer. An example of this is +\code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation +lists which parameters it can accept. +\item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through +\code{...}. This can be one of the functions described as +\link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. +}} + +\item{linewidth}{see \code{?ggplot2::aes_linetype_size_shape}} + +\item{alpha}{color transparency} } \value{ \code{jaspMarginal} returns the ggplot object. diff --git a/man/jaspMatrixPlot.Rd b/man/jaspMatrixPlot.Rd index dd131b92..c7a2d1cd 100644 --- a/man/jaspMatrixPlot.Rd +++ b/man/jaspMatrixPlot.Rd @@ -23,6 +23,18 @@ jaspMatrixPlot( \arguments{ \item{data}{Data frame of data to plot.} +\item{diagonalPlotFunction}{A function that draws the plots on the diagonal. Must accept arguments \code{x} (numeric), \code{xName} (character).} + +\item{diagonalPlotArgs}{A list of additional arguments to pass to \code{diagonalPlotFunction}.} + +\item{topRightPlotFunction}{A function that draws the plots in the upper triangle. Must accept arguments \code{x} (numeric), \code{xName} (character).} + +\item{topRightPlotArgs}{A list of additional arguments to pass to \code{topRightPlotFunction}.} + +\item{bottomLeftPlotFunction}{A function that draws the plots in the lower triangle. Must accept arguments \code{x} (numeric), \code{xName} (character).} + +\item{bottomLeftPlotArgs}{A list of additional arguments to pass to \code{bottomLeftPlotFunction}.} + \item{overwriteDiagonalAxes, overwriteTopRightAxes, overwriteBottomLeftAxes}{Which axes should be overwritten such that they have a common range. Possible options: \describe{ \item{\code{"none"}}{No axes are overwritten, hence the plots get their own scales given by \code{diagonal}, \code{topRight}, and \code{bottomLeft} functions, respectively.} @@ -36,18 +48,6 @@ jaspMatrixPlot( \item{numberOfBins}{See \link{jaspHistogram}. Used for determining consistent axes.} \item{axesLabels}{Optional character vector; provide column/row names of the matrix.} - -\item{diagonal}{A function that draws the plots on the diagonal. Must accept arguments \code{x} (numeric), \code{xName} (character).} - -\item{diagonalArgs}{A list of additional arguments to pass to \code{diagonal}.} - -\item{topRight}{A function that draws the plots on the top right off-diagonal. Must accept arguments \code{x} (numeric), \code{y} (numeric), \code{xName} (character), and \code{yName} (character).} - -\item{topRightArgs}{A list of additional arguments to pass to \code{topRight}.} - -\item{bottomLeft}{A function that draws the plots on the bottom left off-diagonal. Must accept arguments \code{x} (numeric), \code{y} (numeric), \code{xName} (character), and \code{yName} (character).} - -\item{bottomLeftArgs}{A list of additional arguments to pass to \code{bottomLeft}.} } \description{ Plot that consists of \code{ncol{data}} by \code{ncol{data}} plots, diff --git a/man/plotQQnorm.Rd b/man/plotQQnorm.Rd index d6297648..b9497867 100644 --- a/man/plotQQnorm.Rd +++ b/man/plotQQnorm.Rd @@ -9,7 +9,7 @@ plotQQnorm( lower = NULL, upper = NULL, abline = TRUE, - ablineOrigin = FALSE, + ablineOrigin = FALSE, ablineColor = "red", identicalAxes = FALSE, xName = gettext("Theoretical quantiles", domain = "R-jaspGraphs"), @@ -23,13 +23,13 @@ plotQQnorm( \item{upper}{Numeric vector, lower confidence interval of each residual. If NULL, no error bars are drawn.} -\item{abline}{Logical, should an abline be drawn that best fits the points?} +\item{abline}{Logical, should an abline be drawn through the origin?} -\item{ablineOrigin}{Logical, should the abline be drawn through the origin?} +\item{ablineOrigin}{Logical, should the abline go through the origin?} \item{ablineColor}{String, color of the abline.} -\item{identicalAxes}{Logical, should the axes have the same range?} +\item{identicalAxes}{Logical, should the x and y axis breaks be identical?} \item{xName}{String, name for the x-axis.} From ca2dda0408d79756265401cdf9a5c2e26a3e6a6a Mon Sep 17 00:00:00 2001 From: vandenman Date: Wed, 22 May 2024 13:48:05 +0200 Subject: [PATCH 17/17] fix a note in the R CMD Check --- DESCRIPTION | 1 - NAMESPACE | 3 +++ R/JASPgraphsPlot.R | 3 +++ R/colorPalettes.R | 4 ++++ 4 files changed, 10 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0bb7b829..a2268d24 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,6 @@ Maintainer: JASP-team Description: Graph making functions and wrappers for JASP. License: GPL Encoding: UTF-8 -LazyData: true RoxygenNote: 7.3.1 Suggests: testthat Imports: diff --git a/NAMESPACE b/NAMESPACE index cf1cb452..1bfef3e3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -93,6 +93,8 @@ export(themeApaRaw) export(themeJasp) export(themeJaspRaw) export(themePubrRaw) +importFrom(R6,R6Class) +importFrom(RColorBrewer,brewer.pal) importFrom(ggplot2,.pt) importFrom(ggplot2,ScaleContinuousPosition) importFrom(ggplot2,aes) @@ -142,3 +144,4 @@ importFrom(gtable,gtable_add_padding) importFrom(gtable,gtable_add_rows) importFrom(rlang,.data) importFrom(scales,censor) +importFrom(viridisLite,viridis) diff --git a/R/JASPgraphsPlot.R b/R/JASPgraphsPlot.R index 220b1f95..863b7905 100644 --- a/R/JASPgraphsPlot.R +++ b/R/JASPgraphsPlot.R @@ -1,5 +1,8 @@ #' @importFrom ggplot2 is.ggplot +# silences a note in the R CMD Check but is not strictly necessary +#'@importFrom R6 R6Class + jaspGraphsPlot <- R6::R6Class( classname = "jaspGraphsPlot", public = list( diff --git a/R/colorPalettes.R b/R/colorPalettes.R index d8c0accc..43db0dfb 100644 --- a/R/colorPalettes.R +++ b/R/colorPalettes.R @@ -1,6 +1,10 @@ #'@importFrom ggplot2 continuous_scale discrete_scale +# these two silence a note in the R CMD Check but are not strictly necessary +#'@importFrom viridisLite viridis +#'@importFrom RColorBrewer brewer.pal + jaspGraphs_data <- list2env(list( # discrete color scales colorblind = list(colors = RColorBrewer::brewer.pal(8L, "Dark2")),