write unit tests for vector geom

inst/examples/ex-geom-axis.r

@@ -37,7 +37,6 @@ ability.cov$cov |>
 # test axes in best-approximation space
 ability_cor_eigen |> 
   transform(E3 = ifelse(V3 > 0, "rise", "fall")) |> 
-  # FIXME: Component aesthetic data values aren't mapped to color values.
   ggplot(aes(V1, V2, color = E3)) +
   coord_square() +
   geom_axis(aes(label = test), text.color = "black", text.alpha = .5) +

inst/examples/ex-geom-vector.r

@@ -1,8 +1,26 @@
-us_center <- sapply(state.center, \(x) (min(x) + max(x)) / 2)
-state_center <- cbind(
-  state = state.abb,
-  sweep(as.data.frame(state.center), 2, us_center, "-")
-)
-ggplot(state_center, aes(x, y, label = state)) +
-  coord_equal() +
-  geom_vector()
+# multidimensional scaling of covariances
+ability.cov$cov |> 
+  cov2cor() |>
+  eigen() |> getElement("vectors") |> 
+  as.data.frame() |> 
+  transform(test = rownames(ability.cov$cov)) ->
+  ability_cor_eigen
+ability_cor_eigen |> 
+  ggplot(aes(-V1, V2, label = test)) +
+  coord_square() + theme_void() +
+  geom_vector(check_overlap = TRUE) +
+  scale_y_continuous(expand = expansion(mult = .2)) +
+  ggtitle("Ability and intelligence test covariances")
+# multidimensional scaling of correlations
+ability.cov$cov |> 
+  eigen() |> getElement("vectors") |> 
+  as.data.frame() |> 
+  transform(test = rownames(ability.cov$cov)) ->
+  ability_cor_eigen
+ability_cor_eigen |> 
+  ggplot(aes(-V1, -V2, label = test)) +
+  coord_square() + theme_void() +
+  geom_vector(check_overlap = TRUE) +
+  geom_unit_circle() +
+  expand_limits(x = c(-1, 1), y = c(-1, 1)) +
+  ggtitle("Ability and intelligence test covariances")

tests/testthat/test-geom-vector.r

@@ -0,0 +1,20 @@
+r <- seq(5); t <- seq(5) * 2*pi/5
+d <- data.frame(a = r*cos(t), b = r*sin(t), alpha = LETTERS[r])
+p <- ggplot(d, aes(a, b, label = alpha))
+
+test_that("`geom_vector()` correctly handles secondary aesthetics", {
+  g <- layer_grob(
+    p + geom_vector(label.colour = "blue", label.alpha = .75)
+  )
+  # label color and opacity
+  expect_setequal(g[[1L]]$children[[2L]]$gp$col, "#0000FFBF")
+})
+
+test_that("`geom_vector()` respects element inclusion parameters", {
+  # no labels
+  g1 <- layer_grob(p + geom_vector(vector_labels = FALSE))
+  expect_equal(length(g1[[1L]]$children), 1L)
+  # labels
+  g2 <- layer_grob(p + geom_vector(vector_labels = TRUE))
+  expect_equal(length(g2[[1L]]$children), 2L)
+})