diff --git a/DESCRIPTION b/DESCRIPTION index 411f35f..0e5cc11 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,5 +20,6 @@ Imports: RColorBrewer, rlang, scales, - viridisLite + viridisLite, + patchwork Roxygen: list(markdown = TRUE) diff --git a/NAMESPACE b/NAMESPACE index f3a6ac4..82631ed 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) @@ -53,7 +57,11 @@ export(ggMatrixPlot) export(graphOptions) export(hypothesis2BFtxt) export(is.jaspGraphsPlot) +export(jaspBivariate) +export(jaspBivariateWithMargins) export(jaspHistogram) +export(jaspMarginal) +export(jaspMatrixPlot) export(needsParsing) export(parseThis) export(plotEditing) diff --git a/R/jaspBivariate.R b/R/jaspBivariate.R new file mode 100644 index 0000000..c88a1b2 --- /dev/null +++ b/R/jaspBivariate.R @@ -0,0 +1,289 @@ +#' @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. `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}. +#' @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].} +#' \item{"hex"}{Using [ggplot2::geom_hex].} +#' \item{"bin"}{Using [ggplot2::geom_bin2d].} +#' \item{"contour"}{Using [ggplot2::geom_density2d].} +#' \item{"density"}{Using [ggplot2::geom_density2d_filled].} +#' } +#' @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 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 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 using [ggplot2::stat_ellipse].} +#' } +#' @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. +#' @param legendPosition Character; passed as \code{legend.position} to [themeJaspRaw]. +#' @export +jaspBivariate <- function( + x, y, group = NULL, xName, yName, groupName, + type = c("point", "hex", "bin", "contour", "density", "none"), + args = list(color = "black"), + smooth = c("none", "lm", "glm", "gam", "loess"), + smoothCi = FALSE, + smoothCiLevel = 0.95, + smoothArgs = list(color = "black"), + predict = c("none", "lm", "ellipse"), + predictLevel = 0.95, + predictArgs = .predictArgs(), + xBreaks = NULL, + yBreaks = NULL, + legendPosition = "none" +) { + + 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" && 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) + } + + 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) && missing(groupName)) + groupName <- deparse1(substitute(group)) + + + baseGeom <- switch( + type, + point = jaspGraphs::geom_point, + hex = ggplot2::geom_hex, + bin = ggplot2::geom_bin2d, + contour = ggplot2::geom_density2d, + density = ggplot2::geom_density2d_filled, + none = function(...) { return(NULL) } + ) + 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 <- 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 + 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 <- predictLevel + predictLayer <- do.call(ggplot2::stat_ellipse, predictArgs) + } else { + predictLayer <- NULL + } + + 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)) { + yBreaks <- getPrettyAxisBreaks(y) + } else { + yBreaks <- getPrettyAxisBreaks(yBreaks) + } + yRange <- range(c(y, yBreaks)) + yScale <- scale_y_continuous(breaks = yBreaks) + + + if (type == "point" && !is.null(group)) { + scales <- list( + scale_JASPfill_discrete(name = groupName), + scale_JASPcolor_discrete(name = groupName) + ) + } 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) + + baseLayer + + smoothLayer + + predictLayer + + jaspGraphs::themeJaspRaw(legend.position = legendPosition) + + jaspGraphs::geom_rangeframe() + + ggplot2::xlab(xName) + + 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) + + scales + + 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: +#' \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 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 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, groupName, margins = c(0.25, 0.75), + xMarginalArgs = .marginalArgs(), + yMarginalArgs = .marginalArgs(), + topRightPlotFunction = NULL, + topRightPlotArgs = list(), + ... + ) { + + if (!is.null(group) && missing(groupName)) { + groupName <- deparse1(substitute(group)) + } else if(missing(groupName)) { + groupName <- "" + } + + 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 = df[["x"]], y = df[["y"]], group = if(is.null(group)) NULL else group, xName = xName, yName = yName, groupName = groupName, xBreaks = xBreaks, yBreaks = yBreaks, ...) + + 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" + + topLeft <- do.call(jaspMarginal, xMarginalArgs) + + + 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(jaspMarginal, yMarginalArgs) + + ggplot2::coord_flip() + + + 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, + widths = rev(margins), heights = margins + ) + + patchwork::plot_layout(guides = "collect") +} diff --git a/R/jaspHistogram.R b/R/jaspHistogram.R index de54618..c776670 100644 --- a/R/jaspHistogram.R +++ b/R/jaspHistogram.R @@ -22,25 +22,33 @@ #' @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( 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, - hideYAxisLabels = density) { + densityLineWidth = 1, + hideXAxisLabels = FALSE, + hideYAxisLabels = density, + hideXAxisName = FALSE, + hideYAxisName = FALSE, + xBreaks = NULL + ) { # validate input if (!is.vector(x, mode = "numeric")) @@ -49,7 +57,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)) @@ -66,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) { @@ -110,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"]) @@ -224,15 +215,64 @@ 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) } + +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 = ", ")) + + 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.null(numberOfBins)) + stop2("numberOfBins argument must be specified when a binWidthType == 'manual'.") + + binWidthType <- numberOfBins + + } + + h <- graphics::hist(x, plot = FALSE, breaks = binWidthType) + return(h) +} + +getJaspHistogramBreaks <- function(x, binWidthType = "doane", numberOfBins = NULL) { + h <- getJaspHistogramData(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) + return(h[["breaks"]]) +} diff --git a/R/jaspMarginal.R b/R/jaspMarginal.R new file mode 100644 index 0000000..622591d --- /dev/null +++ b/R/jaspMarginal.R @@ -0,0 +1,262 @@ +#' @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) && !is.null(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) +} + +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(), ...) { + 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/R/jaspMatrixPlot.R b/R/jaspMatrixPlot.R new file mode 100644 index 0000000..94cc4ec --- /dev/null +++ b/R/jaspMatrixPlot.R @@ -0,0 +1,179 @@ +#' 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 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( + data, + diagonalPlotFunction = jaspHistogram, + diagonalPlotArgs = list(), + topRightPlotFunction = jaspBivariate, + topRightPlotArgs = list(), + bottomLeftPlotFunction = NULL, + bottomLeftPlotArgs = list(), + overwriteDiagonalAxes = "x", + overwriteTopRightAxes = "both", + overwriteBottomLeftAxes = "both", + binWidthType = "doane", + numberOfBins = NULL, + 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(x = y, binWidthType = binWidthType, numberOfBins = numberOfBins) + + plots[[i]] <- .makeTitle(yName, angle = 90) + i <- i + 1 + + for (col in seq_along(axesLabels)) { + x <- data[[col]] + xName <- axesLabels[[col]] + xBreaks <- getJaspHistogramBreaks(x = x, binWidthType = binWidthType, numberOfBins = numberOfBins) + + if (row == col) { # diagonal + if(is.function(diagonalPlotFunction)) { + diagonalPlotArgs[["x"]] <- x + diagonalPlotArgs[["xName"]] <- xName + diagonalPlotArgs[["xBreaks"]] <- xBreaks + 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/inst/examples/ex-jaspMarginal.R b/inst/examples/ex-jaspMarginal.R new file mode 100644 index 0000000..a81295d --- /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 new file mode 100644 index 0000000..2cd4612 --- /dev/null +++ b/man/jaspBivariate.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/jaspBivariate.R +\name{jaspBivariate} +\alias{jaspBivariate} +\title{Bivariate plots with optional confidence and prediction intervals.} +\usage{ +jaspBivariate( + x, + y, + group = NULL, + xName, + yName, + groupName, + type = c("point", "hex", "bin", "contour", "density", "none"), + args = list(color = "black"), + smooth = c("none", "lm", "glm", "gam", "loess"), + smoothCi = FALSE, + smoothCiLevel = 0.95, + smoothArgs = list(color = "black"), + predict = c("none", "lm", "ellipse"), + predictLevel = 0.95, + predictArgs = .predictArgs(), + xBreaks = NULL, + yBreaks = NULL, + legendPosition = "none" +) +} +\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{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}.} +\item{"hex"}{Using \link[ggplot2:geom_hex]{ggplot2::geom_hex}.} +\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 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}.} + +\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 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{legendPosition}{Character; passed as \code{legend.position} to \link{themeJaspRaw}.} +} +\description{ +This plot consists of three layers: +\enumerate{ +\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 0000000..7b464c0 --- /dev/null +++ b/man/jaspBivariateWithMargins.Rd @@ -0,0 +1,56 @@ +% 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, + groupName, + margins = c(0.25, 0.75), + xMarginalArgs = .marginalArgs(), + yMarginalArgs = .marginalArgs(), + 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{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{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: +\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. +} +} diff --git a/man/jaspHistogram.Rd b/man/jaspHistogram.Rd index a9a8ab9..37c929e 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, @@ -20,7 +20,11 @@ jaspHistogram( densityShade = FALSE, densityShadeAlpha = 0.6, densityLineWidth = 1, - hideYAxisLabels = density + hideXAxisLabels = FALSE, + hideYAxisLabels = density, + hideXAxisName = FALSE, + hideYAxisName = FALSE, + xBreaks = NULL ) } \arguments{ @@ -54,7 +58,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/jaspMarginal.Rd b/man/jaspMarginal.Rd new file mode 100644 index 0000000..9b8e6df --- /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())) +} diff --git a/man/jaspMatrixPlot.Rd b/man/jaspMatrixPlot.Rd new file mode 100644 index 0000000..dd131b9 --- /dev/null +++ b/man/jaspMatrixPlot.Rd @@ -0,0 +1,61 @@ +% 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", + binWidthType = "doane", + numberOfBins = NULL, + 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{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).} + +\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}.} +} +}