diff --git a/DESCRIPTION b/DESCRIPTION index b14f9533..a2268d24 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,14 +1,13 @@ 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), @@ -20,5 +19,6 @@ Imports: RColorBrewer, rlang, scales, - viridisLite + viridisLite, + patchwork Roxygen: list(markdown = TRUE) diff --git a/NAMESPACE b/NAMESPACE index f3a6ac40..1bfef3e3 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) @@ -24,7 +38,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 +71,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) @@ -71,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) @@ -120,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/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/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")), 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 new file mode 100644 index 00000000..9613114d --- /dev/null +++ b/R/jaspBivariate.R @@ -0,0 +1,300 @@ +#' @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 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'.") + + 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) + } + + 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 = .data$lwr, ymax = .data$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) + + smoothLayer + + baseLayer + + 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 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(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)) { + 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 <- stats::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" + xMarginalArgs[["sides"]] <- "" + + 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" + 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 <- 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") & extraLegend +} diff --git a/R/jaspHistogram.R b/R/jaspHistogram.R index de546182..d6342011 100644 --- a/R/jaspHistogram.R +++ b/R/jaspHistogram.R @@ -22,25 +22,34 @@ #' @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}. +#' @param xBreaks custom x-axis breaks. #' @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 +58,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 +75,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 +103,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 +216,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 00000000..56d03433 --- /dev/null +++ b/R/jaspMarginal.R @@ -0,0 +1,269 @@ +#' @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. +#' @param sides, string passed to [geom_rangeframe]. +#' @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"), + sides = "bl" +) { + + # 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 <- stats::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}}), 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" + + 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}}, color = group, 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(sides = sides) + + 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 +#' @param size see `?ggplot2::aes_linetype_size_shape` +#' @inheritParams ggplot2::geom_point +#' @export +.histogramArgs <- function(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 +#' @param linewidth see `?ggplot2::aes_linetype_size_shape` +#' @param alpha color transparency +#' @inheritParams ggplot2::geom_point +#' @export +.densityArgs <- function(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 00000000..12ec8fc9 --- /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 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.} +#' \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 * 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 = .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" + ) + + 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/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/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/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 new file mode 100644 index 00000000..964dc97d --- /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(), + smooth = c("none", "lm", "glm", "gam", "loess"), + smoothCi = FALSE, + smoothCiLevel = 0.95, + smoothArgs = list(), + 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 00000000..acfa6448 --- /dev/null +++ b/man/jaspBivariateWithMargins.Rd @@ -0,0 +1,57 @@ +% 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(1/6, 5/6), + xMarginalArgs = .marginalArgs(), + yMarginalArgs = .marginalArgs(), + topRightPlotFunction = NULL, + topRightPlotArgs = list(), + legendPosition = "topRight", + ... +) +} +\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{xMarginalArgs}{List, options for the marginal plot above. Defaults to the default values of \link{jaspMarginal}.} + +\item{yMarginalArgs}{List, options for the marginal plot to the right. Defaults to the default values of \link{jaspMarginal}.} + +\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{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{...}{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. +} +} diff --git a/man/jaspHistogram.Rd b/man/jaspHistogram.Rd index a9a8ab9b..793cb74a 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,15 @@ 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}.} + +\item{xBreaks}{custom x-axis breaks.} } \description{ A plot histogram with three components. diff --git a/man/jaspMarginal.Rd b/man/jaspMarginal.Rd new file mode 100644 index 00000000..6776d030 --- /dev/null +++ b/man/jaspMarginal.Rd @@ -0,0 +1,183 @@ +% 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"), + sides = "bl" +) + +.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"), + sides = "bl" +) + +.histogramArgs(size = 0.7, position = ggplot2::position_dodge(), ...) + +.rugArgs(...) + +.densityArgs(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.} + +\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. +\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 00000000..c7a2d1cd --- /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{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.} +\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.} +} +\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}.} +} +} 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.}