Pkg dev masterclass changes and set up more GHAs

.Rbuildignore

@@ -7,3 +7,4 @@
 ^\.github$
 ^man/figures/logo\.png$
 ^LICENSE\.md$
+^vignettes/articles$

.github/workflows/check-standard.yaml

@@ -0,0 +1,49 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: R-CMD-check
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: macOS-latest,   r: 'release'}
+          - {os: windows-latest, r: 'release'}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest,   r: 'release'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::rcmdcheck
+          needs: check
+
+      - uses: r-lib/actions/check-r-package@v2
+        with:
+          upload-snapshots: true

.github/workflows/test-coverage.yaml

@@ -0,0 +1,31 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr
+          needs: coverage
+
+      - name: Test coverage
+        run: covr::codecov(quiet = FALSE)
+        shell: Rscript {0}

DESCRIPTION

@@ -1,37 +1,30 @@
-Package: ggbraid
 Type: Package
+Package: ggbraid
 Title: Braid Ribbons in 'ggplot2'
 Version: 0.2.2
 Authors@R:
-    person(
-        given = "Neal",
-        family = "Grantham",
-        role = c("aut", "cre"),
-        email = "[email protected]"
-    )
+    person("Neal", "Grantham", , "[email protected]", role = c("aut", "cre"))
 Description: A new stat, stat_braid(), that extends the functionality of
     geom_ribbon() to correctly fill the area between two alternating lines
     (or steps) with two different colors, and a geom, geom_braid(), that
     wraps geom_ribbon() and uses stat_braid() by default.
-URL: https://nsgrantham.github.io/ggbraid/, https://github.com/nsgrantham/ggbraid/
-BugReports: https://github.com/nsgrantham/ggbraid/issues/
 License: MIT + file LICENSE
+URL: https://nsgrantham.github.io/ggbraid/,
+    https://github.com/nsgrantham/ggbraid/
+BugReports: https://github.com/nsgrantham/ggbraid/issues/
 Depends:
     R (>= 3.4.0)
 Imports:
-    ggplot2 (>= 3.0.0)
+    ggplot2 (>= 3.0.0),
+    rlang
 Suggests:
-    rmarkdown,
     knitr,
-    scales,
-    readr,
-    dplyr,
-    tidyr,
-    ggtext,
-    glue,
-    hms
+    rmarkdown,
+    testthat (>= 3.0.0)
+VignetteBuilder: 
+    knitr
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.2
 Roxygen: list(markdown = TRUE)
-VignetteBuilder: knitr
+RoxygenNote: 7.2.1
+Config/testthat/edition: 3

NAMESPACE

@@ -5,4 +5,6 @@ export(StatBraid)
 export(geom_braid)
 export(stat_braid)
 import(ggplot2)
+importFrom(rlang,arg_match0)
+importFrom(stats,complete.cases)
 importFrom(stats,na.omit)

R/braid-lines.R

@@ -0,0 +1,115 @@
+compute_braided_lines <- function(data) {
+	splits <- cut(data$group, seq(0.5, max(data$group) + 1.5, by = 2))
+	do.call(rbind, lapply(split(data, splits), braid_lines))
+}
+
+braid_lines <- function(data) {
+	row_pairs <- lapply(1:nrow(data), function(i) data[i:(i+1), ])
+	do.call(rbind, lapply(row_pairs, braid_lines_row_pair))
+}
+
+braid_lines_row_pair <- function(row_pair) {
+	y1 <- y2 <- NULL  # only included to silence notes in devtools::check()
+	row1 <- row_pair[1, ]
+	row2 <- row_pair[2, ]
+
+	if (is.na(row2$braid)) {
+		return(row1)
+	}
+
+	if (row1$braid == row2$braid) {
+		return(row1)
+	}
+
+	if (row2$ymin == row2$ymax) {  # explicit intersection
+		return(
+			rbind(
+				row1,
+				transform(row2, braid = row1$braid, group = row1$group)
+			)
+		)
+	}
+
+	if (row1$x < row2$x) {
+		# Consider the intersection of two lines:
+		# one defined by points (a, b) and (c, d), and another defined by points
+		# (e, f) and (g, h).
+	  #
+	  #              • (g, h)
+	  #             /
+	  #  (a, b)    /
+	  #        •--o--•
+	  #          /    (c, d)
+	  #         /
+	  #        • (e, f)
+	  #
+	  # If b > f and d < h, or if b < f and d > h, then the two lines intersect
+		# at a single point (x0, y0) defined by
+	  #   x0 = (u * (e - g) - v * (a - c)) / w
+	  # 	y0 = (u * (f - h) - v * (b - d)) / w
+	  # where
+	  #		u = a * d - b * c
+	  #   v = e * h - f * g
+	  #   w = (a - c) * (f - h) - (b - d) * (e - g)
+	  #
+	  # For more information on this formula, visit
+	  # https://en.wikipedia.org/wiki/Line%E2%80%93line_intersection#Given_two_points_on_each_line
+
+		a <- row1$x
+		e <- row1$x
+		c <- row2$x
+		g <- row2$x
+		b <- row1$y1
+		f <- row1$y2
+		d <- row2$y1
+		h <- row2$y2
+
+		w <- (a - c) * (f - h) - (b - d) * (e - g)
+	 	u <- a * d - b * c
+	 	v <- e * h - f * g
+
+	 	x0 <- (u * (e - g) - v * (a - c)) / w
+	 	y0 <- (u * (f - h) - v * (b - d)) / w
+
+	 	return(
+	 		rbind(
+	 			row1,
+	 			transform(row1, x = x0, ymin = y0, ymax = y0),
+	 			transform(row2, x = x0, ymin = y0, ymax = y0)
+	 		)
+		)
+	}
+
+	if (row1$x == row2$x) {
+		if (row1$y1 == row2$y1) {
+			return(
+				rbind(
+					row1,
+					transform(row1, ymin = y1, ymax = y1),
+					transform(row2, ymin = y1, ymax = y1)
+				)
+			)
+		} else if (row1$y2 == row2$y2) {
+			return(
+				rbind(
+					row1,
+					transform(row1, ymin = y2, ymax = y2),
+					transform(row2, ymin = y2, ymax = y2)
+				)
+			)
+		} else {
+			# Two overlapping vertical lines so there are infinite intersections.
+			# Define a single point to serve as a reasonable intersection.
+			y2_mid <- (row1$y2 + row2$y2) / 2
+			y1_mid <- (row1$y1 + row2$y1) / 2
+			y0 <- (y1_mid + y2_mid) / 2
+			return(
+				rbind(
+					row1,
+					transform(row1, ymin = y0, ymax = y0),
+					transform(row2, ymin = y0, ymax = y0)
+				)
+			)
+		}
+	}
+}

R/braid-steps.R

@@ -0,0 +1,83 @@
+
+compute_braided_steps <- function(data) {
+	splits <- cut(data$group, seq(0.5, max(data$group) + 1.5, by = 2))
+	do.call(rbind, lapply(split(data, splits), braid_steps))
+}
+
+braid_steps <- function (data) {
+	row_pairs <- lapply(1:nrow(data), function(i) data[i:(i+1), ])
+	do.call(rbind, lapply(row_pairs, braid_steps_row_pair))
+}
+
+braid_steps_row_pair <- function(row_pair) {
+	y1 <- y2 <- NULL  # only included to silence notes in devtools::check()
+	row1 <- row_pair[1, ]
+	row2 <- row_pair[2, ]
+
+	if (is.na(row2$braid)) {
+		return(row1)
+	}
+
+	if (row1$braid == row2$braid) {
+		return(
+			rbind(
+				row1,
+				transform(row1, x = row2$x, group = row2$group)
+			)
+		)
+	}
+
+	if (row1$ymin == row1$ymax) {
+		return(
+			rbind(
+				row1,
+		  	transform(row1, x = row2$x),
+				transform(row1, x = row2$x, braid = row2$braid, group = row2$group)
+			)
+		)
+	}
+
+	if (row2$ymin == row2$ymax) {
+		return(
+			rbind(
+				row1,
+		  	transform(row1, x = row2$x),
+				transform(row2, braid = row1$braid, group = row1$group)
+			)
+		)
+	}
+
+	if (row1$y1 == row2$y1) {
+		return(
+			rbind(
+				row1,
+				transform(row1, x = row2$x),
+				transform(row1, x = row2$x, ymin = y1, ymax = y1),
+				transform(row2, ymin = y1, ymax = y1)
+			)
+		)
+	} else if (row1$y2 == row2$y2) {
+		return(
+			rbind(
+				row1,
+				transform(row1, x = row2$x),
+				transform(row1, x = row2$x, ymin = y2, ymax = y2),
+				transform(row2, ymin = y2, ymax = y2)
+			)
+		)
+	} else {
+		# Two overlapping vertical lines so there are infinite intersections.
+		# Define a single point to serve as a reasonable intersection.
+		y2_mid <- (row1$y2 + row1$y2) / 2
+		y1_mid <- (row1$y1 + row2$y1) / 2
+		y0 <- (y1_mid + y2_mid) / 2
+		return(
+			rbind(
+				row1,
+				transform(row1, x = row2$x),
+				transform(row1, x = row2$x, ymin = y0, ymax = y0),
+				transform(row2, ymin = y0, ymax = y0)
+			)
+		)
+	}
+}

R/geom-braid.R

@@ -1,20 +1,22 @@
-#' Braided ribbons
+#' Fill the area between two alternating series
 #'
 #' `geom_braid()` is an extension of `geom_ribbon()` that uses `stat_braid()`
 #' to correctly fill the area between two alternating series (lines or steps)
 #' with two different colors.
 #'
 #' @inheritParams ggplot2::layer
 #' @inheritParams ggplot2::geom_ribbon
-#' @param method Intersection and imputation method to use to braid the ribbon,
-#'   accepts `NULL`, `"line"`, or `"step"`. For `method = NULL`, the default,
-#'   print a message to the console and use `method = "line"`. For
-#'   `method = "line"`, silently braid the ribbon with two series drawn by
-#'   `geom_line()` or `geom_path()`. For `method = "step"`, silently braid the
-#'   ribbon with two series drawn by `geom_step()`.
-#' @param na.rm If `NA`, the default, missing values are imputed by
-#'   `method`. If `FALSE`, missing values are kept and appear as gaps in the
-#'   ribbon. If `TRUE`, missing values are removed.
+#' @param method The intersection and imputation method to use to braid the ribbon,
+#'   accepts `NULL`, `"line"`, or `"step"`.
+#'   * For `method = NULL`, the default, print ``geom_braid` using method = 'line'` to the console and use
+#'   `method = "line"`.
+#'   * For `method = "line"`, silently braid the ribbon with two series drawn by
+#'   `geom_line()` or `geom_path()`.
+#'   * For `method = "step"`, silently braid the ribbon with two series drawn by `geom_step()`.
+#' @param na.rm A boolean or `NA`.
+#'   * If `NA`, the default, missing values are imputed by `method`.
+#'   * If `FALSE`, missing values are kept and appear as gaps in the braided ribbon.
+#'   * If `TRUE`, missing values are removed from `.data` prior to plotting.
 #' @param geom Override the default connection with `geom_braid()`.
 #' @return A ggplot2 layer that can be added to a plot created with `ggplot()`.
 #' @examples