From 1a629dc022bd9847c8328bee7080771d33ccdd5b Mon Sep 17 00:00:00 2001 From: William Gearty Date: Thu, 11 Jan 2024 17:45:30 -0500 Subject: [PATCH] Add geom_points_range(); rearrange some vignette stuff --- DESCRIPTION | 2 +- NAMESPACE | 8 + NEWS.md | 1 + R/points_range.R | 194 ++++++++++++ README.md | 1 - _pkgdown.yml | 27 +- man/geom_points_range.Rd | 154 ++++++++++ .../geom-points-range-aes-new.svg | 242 +++++++++++++++ .../points_range/geom-points-range-bg-new.svg | 285 ++++++++++++++++++ .../points_range/geom-points-range-h-new.svg | 232 ++++++++++++++ .../points_range/geom-points-range-v-new.svg | 232 ++++++++++++++ tests/testthat/setup-data.R | 4 + tests/testthat/test-points_range.R | 52 ++++ vignettes/coord_geo.Rmd | 12 - vignettes/ggarrange2.Rmd | 2 +- vignettes/phylogenies.Rmd | 1 - vignettes/time.Rmd | 158 ++++++++++ vignettes/traits.Rmd | 1 - 18 files changed, 1581 insertions(+), 27 deletions(-) create mode 100644 R/points_range.R create mode 100644 man/geom_points_range.Rd create mode 100644 tests/testthat/_snaps/points_range/geom-points-range-aes-new.svg create mode 100644 tests/testthat/_snaps/points_range/geom-points-range-bg-new.svg create mode 100644 tests/testthat/_snaps/points_range/geom-points-range-h-new.svg create mode 100644 tests/testthat/_snaps/points_range/geom-points-range-v-new.svg create mode 100644 tests/testthat/test-points_range.R create mode 100644 vignettes/time.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index 9a564cf..0d29b7b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,10 +39,10 @@ Imports: lifecycle Suggests: dplyr, - magrittr, divDyn, gsloid, ape, + palaeoverse, paleotree, dispRity, ggtree (>= 3.6.1), diff --git a/NAMESPACE b/NAMESPACE index 491f50a..85a3236 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(coord_trans_flip) export(coord_trans_xy) export(disparity_through_time) export(geom_phylomorpho) +export(geom_points_range) export(getScaleData) export(get_scale_data) export(ggarrange2) @@ -26,6 +27,7 @@ export(scale_color_geo) export(scale_colour_geo) export(scale_discrete_geo) export(scale_fill_geo) +export(stat_points_range) import(scales) importFrom(cli,cli_abort) importFrom(curl,nslookup) @@ -36,6 +38,9 @@ importFrom(ggplot2,CoordCartesian) importFrom(ggplot2,CoordFlip) importFrom(ggplot2,CoordPolar) importFrom(ggplot2,CoordTrans) +importFrom(ggplot2,Geom) +importFrom(ggplot2,GeomLinerange) +importFrom(ggplot2,GeomPoint) importFrom(ggplot2,Stat) importFrom(ggplot2,aes) importFrom(ggplot2,annotate) @@ -45,6 +50,7 @@ importFrom(ggplot2,coord_flip) importFrom(ggplot2,coord_polar) importFrom(ggplot2,coord_trans) importFrom(ggplot2,discrete_scale) +importFrom(ggplot2,draw_key_pointrange) importFrom(ggplot2,expansion) importFrom(ggplot2,geom_rect) importFrom(ggplot2,geom_segment) @@ -55,6 +61,7 @@ importFrom(ggplot2,ggplotGrob) importFrom(ggplot2,ggplot_build) importFrom(ggplot2,ggproto) importFrom(ggplot2,ggproto_parent) +importFrom(ggplot2,has_flipped_aes) importFrom(ggplot2,last_plot) importFrom(ggplot2,layer) importFrom(ggplot2,scale_color_manual) @@ -62,6 +69,7 @@ importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_x_continuous) importFrom(ggplot2,scale_x_reverse) importFrom(ggplot2,set_last_plot) +importFrom(ggplot2,standardise_aes_names) importFrom(ggplot2,theme_void) importFrom(grDevices,dev.interactive) importFrom(grDevices,dev.new) diff --git a/NEWS.md b/NEWS.md index 4847314..3f7e12e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # deeptime (development version) * Fixed the interaction between coord_geo() and ggsave() (#49) +* Added geom_points_range(), a function designed for visualizing temporal occurrence data # deeptime 1.0.1 diff --git a/R/points_range.R b/R/points_range.R new file mode 100644 index 0000000..52a55a6 --- /dev/null +++ b/R/points_range.R @@ -0,0 +1,194 @@ +#' Display points and their range +#' +#' This geom is like [ggplot2::geom_pointrange()] in that it draws points and +#' lines. However, unlike [ggplot2::geom_pointrange()], this geom takes in sets +#' of x-y points and calculates the ranges/intervals based on those. It then +#' plots both the original points and the ranges using +#' [ggplot2::geom_linerange()]. In cases where not all points are connected +#' (because of grouping due to aesthetics), the `background_line` argument can +#' be used to add lines that span the entire point range for each `x` or `y` +#' category. +#' +#' @section Aesthetics: \code{geom_points_range()} understands the following +#' aesthetics (required aesthetics are in bold): +#' +#' - **x** +#' - **y** +#' - size +#' - color/colour +#' - fill +#' - shape +#' - alpha +#' - group +#' - linetype +#' - linewidth +#' +#' @param background_line A named list of aesthetic values to use for plotted +#' line segments that span the entire `y` or `x` range for each `x` or `y` +#' category. The default aesthetics will be used for any aesthetics that are +#' not specified in the list. If NULL (the default), no line segments will be +#' plotted. +#' @param ... Arguments passed on to both [ggplot2::geom_linerange()] and +#' [ggplot2::geom_point()]. +#' @importFrom ggplot2 layer +#' @inheritParams ggplot2::geom_pointrange +#' @inheritSection ggplot2::geom_pointrange Orientation +#' @export +#' @examples +#' library(ggplot2) +#' @examplesIf require(palaeoverse) +#' library(palaeoverse) +#' data(tetrapods) +#' tetrapod_names <- tetrapods$accepted_name[1:50] +#' beds_sampled <- sample.int(n = 10, size = 50, replace = TRUE) +#' occdf <- data.frame(taxon = tetrapod_names, bed = beds_sampled) +#' ggplot(occdf, aes(y = reorder(taxon, bed, min), x = bed)) + +#' geom_points_range() +geom_points_range <- function(mapping = NULL, data = NULL, + stat = "points_range", position = "identity", + ..., + na.rm = FALSE, orientation = NA, + background_line = NULL, + show.legend = NA, inherit.aes = TRUE) { + layer( + data = data, + mapping = mapping, + stat = stat, + geom = GeomPointsRange, + position = position, + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list(na.rm = na.rm, orientation = orientation, + background_line = background_line, ...) + ) +} + +#' @rdname geom_points_range +#' @section Computed variables: These are calculated by the 'stat' part of +#' layers and can be accessed with [delayed evaluation][ggplot2::aes_eval]. +#' \code{stat_points_range()} provides the following variables, some of which +#' depend on the orientation: +#' \itemize{ +#' \item \code{after_stat(ymin)} \emph{or} \code{after_stat(xmin)}\cr +#' the minimum extent of the point range +#' \item \code{after_stat(ymax)} \emph{or} \code{after_stat(xmax)}\cr +#' the maximum extent of the point range +#' } +#' @importFrom ggplot2 layer +#' @inheritParams ggplot2::stat_identity +#' @export +stat_points_range <- function(mapping = NULL, data = NULL, + geom = "points_range", position = "identity", + ..., + na.rm = FALSE, orientation = NA, + show.legend = NA, inherit.aes = TRUE) { + layer( + data = data, + mapping = mapping, + stat = StatPointsRange, + geom = geom, + position = position, + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list(na.rm = na.rm, orientation = orientation, ...) + ) +} + +#' @importFrom ggplot2 ggproto Stat has_flipped_aes +StatPointsRange <- ggproto("StatPointsRange", Stat, + required_aes = c("x", "y"), + extra_params = c("na.rm", "orientation"), + setup_params = function(self, data, params) { + params$flipped_aes <- has_flipped_aes(data, params, + main_is_orthogonal = TRUE, + group_has_equal = TRUE, + main_is_optional = TRUE) + params + }, + setup_data = function(self, data, params) { + data <- flip_data(data, params$flipped_aes) + data <- remove_missing( + data, + na.rm = params$na.rm, + vars = "x", + name = "stat_points_range" + ) + flip_data(data, params$flipped_aes) + }, + compute_group = function(data, scales, na.rm = FALSE, flipped_aes = FALSE) { + # flip the data if needed + data <- flip_data(data, flipped_aes) + # calculate the y ranges + data <- transform(data, + ymin = min(y, na.rm = na.rm), + ymax = max(y, na.rm = na.rm)) + # flip the data back if needed + data <- flip_data(data, flipped_aes) + data + }, +) + +#' @importFrom ggplot2 ggproto Geom GeomPoint GeomLinerange draw_key_pointrange +#' @importFrom ggplot2 standardise_aes_names +#' @importFrom grid gList gTree +GeomPointsRange <- ggproto("GeomPointsRange", Geom, + required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"), + extra_params = c("na.rm", "orientation"), + default_aes = aes(shape = 19, colour = "black", size = 0.5, fill = NA, + alpha = NA, stroke = 0.5, + linewidth = 0.5, linetype = 1), + draw_key = draw_key_pointrange, + setup_params = function(self, data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, + setup_data = function(data, params) { + data + }, + draw_panel = function(self, data, panel_params, coord, fatten = 4, + flipped_aes = FALSE, background_line = NULL, + na.rm = FALSE) { + grob_list <- gList() + if (!is.null(background_line)) { + # flip the data if needed + data <- flip_data(data, flipped_aes) + # split the data and calculate a full y range for each x category + lst <- split(data, data$x) + lst <- lapply(lst, function(df) { + data.frame(x = unique(df$x), PANEL = unique(data$PANEL), + ymin = min(df$y), ymax = max(df$y)) + }) + # put it all together and + df <- do.call(rbind, lst) + for (name in names(background_line)) { + df[[name]] <- background_line[[name]] + } + df <- flip_data(df, flipped_aes) + names(df) <- standardise_aes_names(names(df)) + df <- self$use_defaults(df) + # add background lines as a grob + grob_list <- gList(grob_list, + GeomLinerange$draw_panel(df, panel_params, coord, + flipped_aes = flipped_aes, + na.rm = na.rm)) + # flip the data back if needed + data <- flip_data(data, flipped_aes) + } + # add the normal grobs + grob_list <- gList( + grob_list, + GeomLinerange$draw_panel(unique(data), panel_params, coord, + flipped_aes = flipped_aes, na.rm = na.rm), + GeomPoint$draw_panel(transform(data, size = size * fatten), + panel_params, coord, na.rm = na.rm) + ) + gTree(name = "geom_points_range", children = grob_list) + }, +) + +#' @importFrom grid grobName +ggname <- function(prefix, grob) { + # copied from ggplot2 + grob$name <- grobName(grob, prefix) + grob +} diff --git a/README.md b/README.md index 746bc43..5ba90e5 100644 --- a/README.md +++ b/README.md @@ -32,7 +32,6 @@ devtools::install_github("willgearty/deeptime") ```r library(deeptime) library(dplyr) -library(magrittr) ``` ### Add timescales to plots diff --git a/_pkgdown.yml b/_pkgdown.yml index 327ca61..1730cdb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -30,9 +30,10 @@ articles: contents: - coord_geo - phylogenies + - coord - traits + - time - ggarrange2 - - coord reference: - title: Adding geological timescales to plots @@ -80,6 +81,14 @@ reference: - scale_color_geo - get_scale_data +- title: Transforming coordinate systems + desc: > + These functions can be used to modify the way that your data is plotted + by `{ggplot2}`. + contents: + - coord_trans_flip + - coord_trans_xy + - title: Plotting trait data desc: > These functions can be used for visualizing species trait data. @@ -89,6 +98,13 @@ reference: - panel.disparity - coord_trans_xy + - title: Plotting temporal data + desc: > + These functions can be used for visualizing temporal data. + contents: + - geom_points_range + - stat_points_range + - title: Combining and arranging plots desc: > These functions can be used to combine and arrange plots into @@ -96,12 +112,3 @@ reference: contents: - ggarrange2 - gtable_frame2 - -- title: Transforming coordinate systems - desc: > - These functions can be used to modify the way that your data is plotted - by `{ggplot2}`. - contents: - - coord_trans_flip - - coord_trans_xy - diff --git a/man/geom_points_range.Rd b/man/geom_points_range.Rd new file mode 100644 index 0000000..9f1303d --- /dev/null +++ b/man/geom_points_range.Rd @@ -0,0 +1,154 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/points_range.R +\name{geom_points_range} +\alias{geom_points_range} +\alias{stat_points_range} +\title{Display points and their range} +\usage{ +geom_points_range( + mapping = NULL, + data = NULL, + stat = "points_range", + position = "identity", + ..., + na.rm = FALSE, + orientation = NA, + background_line = NULL, + show.legend = NA, + inherit.aes = TRUE +) + +stat_points_range( + mapping = NULL, + data = NULL, + geom = "points_range", + position = "identity", + ..., + na.rm = FALSE, + orientation = NA, + show.legend = NA, + inherit.aes = TRUE +) +} +\arguments{ +\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and +\code{inherit.aes = TRUE} (the default), it is combined with the default mapping +at the top level of the plot. You must supply \code{mapping} if there is no plot +mapping.} + +\item{data}{The data to be displayed in this layer. There are three +options: + +If \code{NULL}, the default, the data is inherited from the plot +data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. + +A \code{data.frame}, or other object, will override the plot +data. All objects will be fortified to produce a data frame. See +\code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. + +A \code{function} will be called with a single argument, +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{...}{Arguments passed on to both \code{\link[ggplot2:geom_linerange]{ggplot2::geom_linerange()}} and +\code{\link[ggplot2:geom_point]{ggplot2::geom_point()}}.} + +\item{na.rm}{If \code{FALSE}, the default, missing values are removed with +a warning. If \code{TRUE}, missing values are silently removed.} + +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + +\item{background_line}{A named list of aesthetic values to use for plotted +line segments that span the entire \code{y} or \code{x} range for each \code{x} or \code{y} +category. The default aesthetics will be used for any aesthetics that are +not specified in the list. If NULL (the default), no line segments will be +plotted.} + +\item{show.legend}{logical. Should this layer be included in the legends? +\code{NA}, the default, includes if any aesthetics are mapped. +\code{FALSE} never includes, and \code{TRUE} always includes. +It can also be a named logical vector to finely select the aesthetics to +display.} + +\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, +rather than combining with them. This is most useful for helper functions +that define both data and aesthetics and shouldn't inherit behaviour from +the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} + +\item{geom}{The geometric object to use to display the data, either as a +\code{ggproto} \code{Geom} subclass or as a string naming the geom stripped of the +\code{geom_} prefix (e.g. \code{"point"} rather than \code{"geom_point"})} +} +\description{ +This geom is like \code{\link[ggplot2:geom_linerange]{ggplot2::geom_pointrange()}} in that it draws points and +lines. However, unlike \code{\link[ggplot2:geom_linerange]{ggplot2::geom_pointrange()}}, this geom takes in sets +of x-y points and calculates the ranges/intervals based on those. It then +plots both the original points and the ranges using +\code{\link[ggplot2:geom_linerange]{ggplot2::geom_linerange()}}. In cases where not all points are connected +(because of grouping due to aesthetics), the \code{background_line} argument can +be used to add lines that span the entire point range for each \code{x} or \code{y} +category. +} +\section{Aesthetics}{ + \code{geom_points_range()} understands the following +aesthetics (required aesthetics are in bold): +\itemize{ +\item \strong{x} +\item \strong{y} +\item size +\item color/colour +\item fill +\item shape +\item alpha +\item group +\item linetype +\item linewidth +} +} + +\section{Computed variables}{ + These are calculated by the 'stat' part of +layers and can be accessed with \link[ggplot2:aes_eval]{delayed evaluation}. +\code{stat_points_range()} provides the following variables, some of which +depend on the orientation: +\itemize{ +\item \code{after_stat(ymin)} \emph{or} \code{after_stat(xmin)}\cr +the minimum extent of the point range +\item \code{after_stat(ymax)} \emph{or} \code{after_stat(xmax)}\cr +the maximum extent of the point range +} +} + +\section{Orientation}{ + + +This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. + +} + +\examples{ +library(ggplot2) +\dontshow{if (require(palaeoverse)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(palaeoverse) +data(tetrapods) +tetrapod_names <- tetrapods$accepted_name[1:50] +beds_sampled <- sample.int(n = 10, size = 50, replace = TRUE) +occdf <- data.frame(taxon = tetrapod_names, bed = beds_sampled) +ggplot(occdf, aes(y = reorder(taxon, bed, min), x = bed)) + + geom_points_range() +\dontshow{\}) # examplesIf} +} diff --git a/tests/testthat/_snaps/points_range/geom-points-range-aes-new.svg b/tests/testthat/_snaps/points_range/geom-points-range-aes-new.svg new file mode 100644 index 0000000..1a8dcad --- /dev/null +++ b/tests/testthat/_snaps/points_range/geom-points-range-aes-new.svg @@ -0,0 +1,242 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Araeoscelis casei +Cricotus +Dvinosaurus +Lepospondyli +Ophiacodon +Procolophon trigoniceps +Sphenacodontidae +Anconastes vesperus +Diadectes +Edaphosaurus boanerges +Eryops +Limnoscelidae +Ophiacodon navajovicus +Trimerorhachis +Diplocaulus +Rhipaeosaurus +Tetrapoda +Anthracosauria +Baphetidae +Platyoposaurus watsoni +Archeria crassidisca +Dimetrodon +Gorgonopsia +Platyoposaurus stuckenbergi +Silvanerpeton miripedes +Westlothiana lizziae +Zatrachys serratus +Dendrerpeton +Sphenacodontia +Trimerorhachis insignis +Broiliellus olsoni +Diadectes zenos +Melosaurus uralensis +Platyhystrix rugosus +Archeria +Broiliellus arroyoensis +Eryops megacephalus +Nectridea +Aspidosaurus +Balanerpeton woodi +Edaphosaurus colohistion +Mesosauridae +Ophiacodon mirus + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +4 +8 +12 +bed +reorder(taxon, bed, min) + +certainty + + + + +0 +1 +geom_points_range_aes new + + diff --git a/tests/testthat/_snaps/points_range/geom-points-range-bg-new.svg b/tests/testthat/_snaps/points_range/geom-points-range-bg-new.svg new file mode 100644 index 0000000..b4e0db0 --- /dev/null +++ b/tests/testthat/_snaps/points_range/geom-points-range-bg-new.svg @@ -0,0 +1,285 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Araeoscelis casei +Cricotus +Dvinosaurus +Lepospondyli +Ophiacodon +Procolophon trigoniceps +Sphenacodontidae +Anconastes vesperus +Diadectes +Edaphosaurus boanerges +Eryops +Limnoscelidae +Ophiacodon navajovicus +Trimerorhachis +Diplocaulus +Rhipaeosaurus +Tetrapoda +Anthracosauria +Baphetidae +Platyoposaurus watsoni +Archeria crassidisca +Dimetrodon +Gorgonopsia +Platyoposaurus stuckenbergi +Silvanerpeton miripedes +Westlothiana lizziae +Zatrachys serratus +Dendrerpeton +Sphenacodontia +Trimerorhachis insignis +Broiliellus olsoni +Diadectes zenos +Melosaurus uralensis +Platyhystrix rugosus +Archeria +Broiliellus arroyoensis +Eryops megacephalus +Nectridea +Aspidosaurus +Balanerpeton woodi +Edaphosaurus colohistion +Mesosauridae +Ophiacodon mirus + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +4 +8 +12 +bed +reorder(taxon, bed, min) + +certainty + + + + +0 +1 +geom_points_range_bg new + + diff --git a/tests/testthat/_snaps/points_range/geom-points-range-h-new.svg b/tests/testthat/_snaps/points_range/geom-points-range-h-new.svg new file mode 100644 index 0000000..9369dee --- /dev/null +++ b/tests/testthat/_snaps/points_range/geom-points-range-h-new.svg @@ -0,0 +1,232 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Araeoscelis casei +Cricotus +Dvinosaurus +Lepospondyli +Ophiacodon +Procolophon trigoniceps +Sphenacodontidae +Anconastes vesperus +Diadectes +Edaphosaurus boanerges +Eryops +Limnoscelidae +Ophiacodon navajovicus +Trimerorhachis +Diplocaulus +Rhipaeosaurus +Tetrapoda +Anthracosauria +Baphetidae +Platyoposaurus watsoni +Archeria crassidisca +Dimetrodon +Gorgonopsia +Platyoposaurus stuckenbergi +Silvanerpeton miripedes +Westlothiana lizziae +Zatrachys serratus +Dendrerpeton +Sphenacodontia +Trimerorhachis insignis +Broiliellus olsoni +Diadectes zenos +Melosaurus uralensis +Platyhystrix rugosus +Archeria +Broiliellus arroyoensis +Eryops megacephalus +Nectridea +Aspidosaurus +Balanerpeton woodi +Edaphosaurus colohistion +Mesosauridae +Ophiacodon mirus + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2.5 +5.0 +7.5 +10.0 +bed +reorder(taxon, bed, min) +geom_points_range_h new + + diff --git a/tests/testthat/_snaps/points_range/geom-points-range-v-new.svg b/tests/testthat/_snaps/points_range/geom-points-range-v-new.svg new file mode 100644 index 0000000..c108350 --- /dev/null +++ b/tests/testthat/_snaps/points_range/geom-points-range-v-new.svg @@ -0,0 +1,232 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2.5 +5.0 +7.5 +10.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Araeoscelis casei +Cricotus +Dvinosaurus +Lepospondyli +Ophiacodon +Procolophon trigoniceps +Sphenacodontidae +Anconastes vesperus +Diadectes +Edaphosaurus boanerges +Eryops +Limnoscelidae +Ophiacodon navajovicus +Trimerorhachis +Diplocaulus +Rhipaeosaurus +Tetrapoda +Anthracosauria +Baphetidae +Platyoposaurus watsoni +Archeria crassidisca +Dimetrodon +Gorgonopsia +Platyoposaurus stuckenbergi +Silvanerpeton miripedes +Westlothiana lizziae +Zatrachys serratus +Dendrerpeton +Sphenacodontia +Trimerorhachis insignis +Broiliellus olsoni +Diadectes zenos +Melosaurus uralensis +Platyhystrix rugosus +Archeria +Broiliellus arroyoensis +Eryops megacephalus +Nectridea +Aspidosaurus +Balanerpeton woodi +Edaphosaurus colohistion +Mesosauridae +Ophiacodon mirus +reorder(taxon, bed, min) +bed +geom_points_range_v new + + diff --git a/tests/testthat/setup-data.R b/tests/testthat/setup-data.R index 8f243e8..b8eb724 100644 --- a/tests/testthat/setup-data.R +++ b/tests/testthat/setup-data.R @@ -47,6 +47,10 @@ if (suppressPackageStartupMessages(require(dispRity, quietly = TRUE))) { data(demo_data) } +if (suppressPackageStartupMessages(require(palaeoverse, quietly = TRUE))) { + data(tetrapods) +} + suppressPackageStartupMessages(require(gsloid, quietly = TRUE)) suppressPackageStartupMessages(require(ggtree, quietly = TRUE)) suppressPackageStartupMessages(require(dispRity, quietly = TRUE)) diff --git a/tests/testthat/test-points_range.R b/tests/testthat/test-points_range.R new file mode 100644 index 0000000..b6d3c21 --- /dev/null +++ b/tests/testthat/test-points_range.R @@ -0,0 +1,52 @@ +test_that("geom_points_range works", { + skip_if_not_installed("palaeoverse") + tetrapod_names <- tetrapods$accepted_name[1:50] + beds_sampled <- sample.int(n = 10, size = 50, replace = TRUE) + occdf <- data.frame(taxon = tetrapod_names, bed = beds_sampled) + + # check that vertical orientation works + gg <- ggplot(occdf, aes(x = reorder(taxon, bed, min), y = bed)) + + geom_points_range(size = 1) + + theme_classic(base_size = 16) + expect_true(is.ggplot(gg)) + expect_true(is(gg$layers[[1]]$geom, "GeomPointsRange")) + expect_true(is(gg$layers[[1]]$stat, "StatPointsRange")) + expect_doppelganger_deeptime("geom_points_range_v", gg) + + # check that horizontal orientation works + gg <- ggplot(occdf, aes(y = reorder(taxon, bed, min), x = bed)) + + geom_points_range(size = .5) + + theme_classic(base_size = 16) + expect_true(is.ggplot(gg)) + expect_true(is(gg$layers[[1]]$geom, "GeomPointsRange")) + expect_true(is(gg$layers[[1]]$stat, "StatPointsRange")) + expect_doppelganger_deeptime("geom_points_range_h", gg) + + # check that aesthetics and groupings work + occdf$certainty <- factor(rep(1, 50), levels = c(0, 1)) + occdf <- rbind(occdf, + data.frame(taxon = "Eryops", bed = c(12, 15), certainty = 0)) + gg <- ggplot(occdf, aes(y = reorder(taxon, bed, min), x = bed, + fill = certainty, linetype = certainty)) + + geom_points_range(size = .5, shape = 21) + + scale_fill_manual(values = c("white", "black")) + + scale_linetype_manual(values = c("dashed", "solid")) + + theme_classic(base_size = 16) + expect_true(is.ggplot(gg)) + expect_true(is(gg$layers[[1]]$geom, "GeomPointsRange")) + expect_true(is(gg$layers[[1]]$stat, "StatPointsRange")) + expect_doppelganger_deeptime("geom_points_range_aes", gg) + + # check that background lines work + gg <- ggplot(occdf, aes(y = reorder(taxon, bed, min), x = bed, + fill = certainty, linetype = certainty)) + + geom_points_range(size = .5, shape = 21, + background_line = list(linetype = "dashed")) + + scale_fill_manual(values = c("white", "black")) + + scale_linetype_manual(values = c("dashed", "solid")) + + theme_classic(base_size = 16) + expect_true(is.ggplot(gg)) + expect_true(is(gg$layers[[1]]$geom, "GeomPointsRange")) + expect_true(is(gg$layers[[1]]$stat, "StatPointsRange")) + expect_doppelganger_deeptime("geom_points_range_bg", gg) +}) diff --git a/vignettes/coord_geo.Rmd b/vignettes/coord_geo.Rmd index 407eac2..9e1d716 100644 --- a/vignettes/coord_geo.Rmd +++ b/vignettes/coord_geo.Rmd @@ -22,7 +22,6 @@ library(deeptime) # Load other packages library(ggplot2) library(dplyr) -library(magrittr) # for piping # Load divDyn for coral data library(divDyn) data(corals) @@ -194,17 +193,6 @@ ggplot(coral_div_dis) + theme(axis.ticks.length.x = unit(0, "lines")) ``` -## Geological timescale color scales for ggplot -In addition to adding a timescale to a plot, you may also want to color your data based on it's age. __deeptime__ has `scale_color_geo()` and `scale_fill_geo()` for this very purpose! Note that currently these scales only work with discrete data. The default behavior is for the color/fill aesthetic values to match the names of the intervals in `dat`. -```{r} -ggplot(coral_div_dis, aes(x = n, y = diet, fill = period)) + - geom_col() + - scale_fill_geo(periods) + - xlab("Coral Genera") + - ylab("Diet") + - theme_classic() -``` - ## More advanced topics Looking to learn about more advanced features of __deeptime__? Look no further: diff --git a/vignettes/ggarrange2.Rmd b/vignettes/ggarrange2.Rmd index 4121f2f..0a463d7 100644 --- a/vignettes/ggarrange2.Rmd +++ b/vignettes/ggarrange2.Rmd @@ -75,5 +75,5 @@ ggarrange2(p1, p2, p3, Note that I provide no guarantee that `ggarrange2()` solves every problem when arranging plots. The following other options may also be very useful: - The `{cowplot}` package has the `cowplot::plot_grid()` function which accomplishes many of the same features as `ggarrange2()`. -- The `{patchwork}` has very intuitive tools for combining and arranging plots (e.g, using mathematical symbols). +- The `{patchwork}` package has very intuitive tools for combining and arranging plots (e.g., using mathematical symbols). diff --git a/vignettes/phylogenies.Rmd b/vignettes/phylogenies.Rmd index 4f6ea8e..5e53abb 100644 --- a/vignettes/phylogenies.Rmd +++ b/vignettes/phylogenies.Rmd @@ -20,7 +20,6 @@ library(deeptime) # Load other packages library(ggplot2) library(dplyr) -library(magrittr) # for piping # Load ggtree library(ggtree) # Load phytools for some example data diff --git a/vignettes/time.Rmd b/vignettes/time.Rmd new file mode 100644 index 0000000..af04476 --- /dev/null +++ b/vignettes/time.Rmd @@ -0,0 +1,158 @@ +--- +title: "Plotting temporal data" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Plotting temporal data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set(collapse = TRUE, fig.width = 7, fig.height = 5, fig.align = "center") +``` + +
+Many packages exist to visualize temporal data (e.g., geological or evolutionary biological data). __deeptime__ similarly has a few novel ways to help you plot your temporal data in useful ways. We'll first load some packages and example data so we can demonstrate some of this functionality. + +```{r message = FALSE} +# Load deeptime +library(deeptime) +# Load other packages +library(ggplot2) +library(dplyr) +# Load palaeoverse for tetrapod occurrence data +library(palaeoverse) +data(tetrapods) +``` + +## Plot occurrences through time +Do you have a bunch of temporal occurrences of taxa or some sort of geological phenomenon, but you don't want to go through all of the pain of figuring out how to visualize those occurrences and their temporal ranges? And it needs to be customizable and have a pretty geological or stratigraphic timescale on the side? Well, then `geom_points_range()` is your friend! + +`geom_points_range()` is like `ggplot2::geom_pointrange()` in that it plots points and their ranges. However, the "raw" data that goes into `ggplot2::geom_pointrange()` is the lower, upper, and the coordinates for an individual point for each group. First, we're too lazy to calculate our own ranges! Second, only one point per group? But we have a whole bunch of occurrences for each group that need to be plotted! The difference with `geom_points_range()` is that the raw data it takes in is all of your grouped temporal data. It then does all of the work for you to plot those individual occurrences AND the ranges of those occurrences for each group. Let's try it out with some Permian vertebrate occurrence data from the `palaeoverse`: + +```{r} +# sort the occurrences from most common genera to least common genera +# assume the age is just the mean of the max and min +occdf <- tetrapods %>% + filter(accepted_rank == "genus") %>% + select(occurrence_no, accepted_name, max_ma, min_ma) %>% + mutate(accepted_name = reorder(accepted_name, accepted_name, length)) %>% + arrange(desc(accepted_name)) %>% + mutate(age = (max_ma + min_ma) / 2) +# get a reasonable subset of those occurrences +occdf <- occdf[1:300, ] + +# plot those occurrences +ggplot(data = occdf) + + geom_points_range(aes(x = age, y = accepted_name)) + + theme_classic() +``` + +And then, of course, we want to add a timescale: +```{r} +ggplot(data = occdf) + + geom_points_range(aes(x = age, y = accepted_name)) + + scale_x_reverse() + + coord_geo(pos = list("bottom", "bottom"), dat = list("stages", "periods"), + abbrv = list(TRUE, FALSE), expand = TRUE, size = "auto") + + theme_classic() +``` + +What if we aren't certain about some of our data points? Maybe we don't necessarily know if they are assigned to the correct genus or perhaps we are uncertain about their age? Fortunately, we have all of the tools of ggplot available to us! First we'll simulate some binary "certainty" values, then we'll plot certainty as additional aesthetics: + +```{r message = FALSE, include = FALSE} +set.seed(1234) +``` +```{r} +occdf$certainty <- factor(sample(0:1, nrow(occdf), replace = TRUE)) + +ggplot(data = occdf) + + geom_points_range(aes(x = age, y = accepted_name, + fill = certainty, linetype = certainty), shape = 21) + + scale_x_reverse() + + scale_fill_manual(values = c("white", "black")) + + scale_linetype_manual(values = c("dashed", "solid")) + + coord_geo(pos = list("bottom", "bottom"), dat = list("stages", "periods"), + abbrv = list(TRUE, FALSE), expand = TRUE, size = "auto") + + theme_classic() +``` + +Finally, we can sort the taxa so that they are arranged in order of their earliest occurrence: + +```{r} +occdf$accepted_name <- reorder(occdf$accepted_name, occdf$age, max, + decreasing = TRUE) +ggplot(data = occdf) + + geom_points_range(aes(x = age, y = accepted_name, + fill = certainty, linetype = certainty), shape = 21) + + scale_x_reverse() + + scale_fill_manual(values = c("white", "black")) + + scale_linetype_manual(values = c("dashed", "solid")) + + coord_geo(pos = list("bottom", "bottom"), dat = list("stages", "periods"), + abbrv = list(TRUE, FALSE), expand = TRUE, size = "auto") + + theme_classic() +``` + +Note that our uncertain lines (0) overlap with our certain lines (1), so there is a continuous line spanning each taxon's entire range. However, if we tweak some of the data, we can change that, causing a gap in the ranges: + +```{r} +oldest_certain <- occdf %>% + filter(accepted_name == "Diictodon", certainty == 1) %>% + pull(age) %>% max() + +occdf$age[occdf$accepted_name == "Diictodon" & occdf$certainty == 0] <- + oldest_certain + 10 + +ggplot(data = occdf) + + geom_points_range(aes(x = age, y = accepted_name, + fill = certainty, linetype = certainty), shape = 21) + + scale_x_reverse() + + scale_fill_manual(values = c("white", "black")) + + scale_linetype_manual(values = c("dashed", "solid")) + + coord_geo(pos = list("bottom", "bottom"), dat = list("stages", "periods"), + abbrv = list(TRUE, FALSE), expand = TRUE, size = "auto") + + theme_classic() +``` + +We can fix this by using the `background_line` argument, which can be a list of aesthetic values to use for the background line segments: + +```{r} +ggplot(data = occdf) + + geom_points_range(aes(x = age, y = accepted_name, + fill = certainty, linetype = certainty), shape = 21, + background_line = list(linetype = "dashed")) + + scale_x_reverse() + + scale_fill_manual(values = c("white", "black")) + + scale_linetype_manual(values = c("dashed", "solid")) + + coord_geo(pos = list("bottom", "bottom"), dat = list("stages", "periods"), + abbrv = list(TRUE, FALSE), expand = TRUE, size = "auto") + + theme_classic() +``` + +Finally, while I've showcased this geom with the use case of plotting occurrence data, note that the potential usage for this function is much broader. Basically any set of data with a categorical and a continuous variable could be visualized like this (when appropriate). + +## Geological timescale color scales for ggplot +You may also want to color your data based on its age. __deeptime__ has `scale_color_geo()` and `scale_fill_geo()` for this very purpose! Note that currently these scales only work with discrete data. The default behavior is for the color/fill aesthetic values to match the names of the intervals in `dat`. Here, we'll use the coral_div_dis data from the first vignette tutorial: + +```{r message = FALSE, include = FALSE} +library(divDyn) +data(corals) + +coral_div_dis <- corals %>% + filter(period != "") %>% + group_by(diet, period) %>% + summarise(n = n()) %>% + mutate(period_age = (periods$max_age[match(period, periods$name)] + + periods$min_age[match(period, periods$name)]) / 2) %>% + arrange(-period_age) +``` + +```{r} +ggplot(coral_div_dis, aes(x = n, y = diet, fill = period)) + + geom_col() + + scale_fill_geo(periods) + + xlab("Coral Genera") + + ylab("Diet") + + theme_classic() +``` +
diff --git a/vignettes/traits.Rmd b/vignettes/traits.Rmd index cbf2c57..f20f535 100644 --- a/vignettes/traits.Rmd +++ b/vignettes/traits.Rmd @@ -20,7 +20,6 @@ library(deeptime) # Load other packages library(ggplot2) library(dplyr) -library(magrittr) # for piping # Load dispRity for example data library(dispRity) data(demo_data)