Merge pull request #6 from pepijn-devries/work-in-progress

Improved test coverage

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ggfields
 Title: Add Vector Field Layers to Ggplots
-Version: 0.0.6.0001
+Version: 0.0.6.0002
 Authors@R: c(person("Pepijn", "de Vries", role = c("aut", "cre"),
     email = "[email protected]",
     comment = c(ORCID = "0000-0002-7961-6646")))

NEWS.md

@@ -1,7 +1,8 @@
-ggfields v0.0.6.0001
+ggfields v0.0.6.0002
 -------------
 
  * Fixed test
+ * Added tests
  * Added test coverage workflow
 
 ggfields v0.0.6

R/angle_correction.r

@@ -80,7 +80,7 @@ angle_correction <- function(data, panel_params, coord) {
   if ("crs" %in% names(guides) && is.na(crs)) true_aspect <- 1 else
     true_aspect  <- coord$ratio %||% coord_aspect
   if (is.na(crs)) {
-    rlang::message_cnd("ggfields", message = "CRS is not specified, correcting for aspect ratio only.")
+    rlang::inform("CRS is not specified, correcting for aspect ratio only.")
     ref <- data.frame(angle = atan2(true_aspect*sin(data$angle), cos(data$angle))) |>
       dplyr::mutate(angle = .data$angle - data$angle,
                     angle = atan2(sin(.data$angle), cos(.data$angle)))
@@ -99,10 +99,9 @@ angle_correction <- function(data, panel_params, coord) {
     ref          <- (north_of_ref - ref) |>
       dplyr::mutate(y = .data$y*true_aspect, angle = -atan2(.data$y, .data$x) + pi/2)
   }
-  rlang::message_cnd(
-    "ggfields", message = sprintf("Angle correction between %0.2f and %0.2f radials",
-                                  min(ref$angle), max(ref$angle)))
-
+  rlang::inform(sprintf("Angle correction between %0.2f and %0.2f radials",
+                        min(ref$angle), max(ref$angle)), frequency = "regularly")
+
   data |>
     dplyr::mutate(
       angle_correction = ref$angle

tests/testthat/test_anglecorrection.r

@@ -0,0 +1,54 @@
+params_mockup <-
+  c(
+    ggplot2::ggplot() + geom_fields(),
+    list(
+      x_range = c(1, 2),
+      y_range = c(50, 51),
+      crs = sf::st_crs(4326),
+      default_crs = 4326
+    )
+  )
+
+coord <- ggplot2::coord_sf()
+
+test_that(
+  "Angle correction won't work on geometries other then point", {
+    expect_error({
+      data <-
+        data.frame(
+          geometry = sf::st_sfc(sf::st_polygon())
+        ) |>
+        sf::st_as_sf(crs = 4326)
+
+      angle_correction(data, params_mockup, coord)
+    })
+  }) |> suppressMessages()
+
+test_that(
+  "Missing CRS is signalled", {
+    expect_message({
+      data <-
+        data.frame(
+          angle = 0,
+          geometry = sf::st_sfc(sf::st_polygon())
+        ) |>
+        sf::st_as_sf()
+
+      angle_correction(data, params_mockup, coord)
+    })
+  }) |> suppressMessages()
+
+test_that(
+  "Expect warning for proximity to North Pole", {
+    expect_warning({
+      data <-
+        data.frame(
+          x = seq(1, 2, 0.1),
+          y = seq(98.999, 99.999, 0.1),
+          angle = 0
+        ) |>
+        sf::st_as_sf(coords = c("x", "y"), crs = 4326, remove = FALSE)
+
+      angle_correction(data, params_mockup, coord)
+    })
+  }) |> suppressMessages()

tests/testthat/test_helpers.r

@@ -0,0 +1,96 @@
+{
+  library(dplyr, quietly = TRUE)
+  library(sf, quietly = TRUE)
+  library(stars, quietly = TRUE)
+  library(ggplot2, quietly = TRUE)
+} |>
+  suppressWarnings() |>
+  suppressMessages()
+
+self <- GeomFields
+data <- data.frame(
+  colour = "black",
+  geometry = st_point(c(1,50)) |> st_sfc(crs = 4326),
+  angle = 0,
+  PANEL = 1,
+  group = 1,
+  xmin = 1,
+  xmax = 1,
+  ymin = 50,
+  ymax = 50,
+  linewidth = 1,
+  linetype = 1,
+  alpha = 1,
+  radius = 1
+) |>
+  st_as_sf()
+
+params_mockup <-
+  c(
+    ggplot() + geom_fields(),
+    list(
+      x_range = c(1, 2),
+      y_range = c(50, 51),
+      crs = st_crs(4326),
+      default_crs = 4326
+    )
+  )
+
+coord <- coord_sf()
+
+test_that(
+  "Prep fields coerces stars to sf", {
+    expect_s3_class({
+      system.file("tif/L7_ETMs.tif", package = "stars") |> read_stars() -> x
+      ggfields:::.data_prep_fields(x)
+    }, "sf")
+  }
+)
+
+test_that(
+  "Setup params add linejoin and lineend when missing", {
+    expect_true({
+      params <- .setup_params_fields(params = list())
+      typeof(params) == "list" &&
+        all(c("linejoin", "lineend") %in% names(params))
+    })
+  }
+)
+
+test_that(
+  "Error when `x` aesthetic is not combined with `y`", {
+    expect_error({
+      data <- data |> st_drop_geometry() |>
+        mutate(x = 0)
+      ggfields:::.compute_panel_stat_fields(data = data)
+    })
+  }
+)
+
+test_that(
+  "radius and angle are coercible to numerics", {
+    expect_true({
+      test <- ggfields:::.compute_panel_stat_fields(data = data)
+      is.numeric(test$angle) && is.numeric(test$radius)
+    })
+  })
+
+test_that(
+  "Geometry is added to mapping of sf objects when missing", {
+    expect_true({
+      test <- ggfields:::.mapping_prep_fields(data, aes())
+      ("geometry" %in% names(test)) && inherits(test$geometry, "quosure")
+    })
+  })
+
+test_that(
+  "Panel draw function returns a gTree object", {
+    testthat::expect_s3_class({
+      ggfields:::.draw_panel_fields(
+        self, data, params_mockup, coord,
+        FALSE, grid::unit(0.7, "cm"),
+        grid::arrow(), angle_correction, "mitre", "butt"
+      ) |> suppressMessages()
+    }, c("gTree", "grob", "gDesc"))
+  }
+)

tests/testthat/test_plots.r

@@ -1,18 +1,22 @@
+library(ggplot2, quietly = TRUE) |> suppressWarnings()
+library(stars, quietly = TRUE) |> suppressWarnings()
+
+data("seawatervelocity")
+sw_sub <- seawatervelocity[,8:13,1:5]
+
 test_that(
   "Seawater velocity is visualised correctly", {
-    library(ggplot2) |> suppressWarnings()
-    data("seawatervelocity")
     seawater_plot <-
       ggplot() +
       geom_fields(aes(radius = as.numeric(v), angle = as.numeric(angle)),
-                  seawatervelocity)
+                  seawatervelocity) +
+      stat_fields()
     vdiffr::expect_doppelganger("ggfields seawater", seawater_plot)
   }
-)
+) |> suppressMessages()
 
 test_that(
   "Angle corrections work as expected", {
-    library(ggplot2) |> suppressWarnings()
     north_arrows <-
       expand.grid(
         x = seq(-5, 15, length.out = 10),
@@ -23,20 +27,83 @@ test_that(
       stars::st_as_stars(nx = 10, ny = 10) |>
       dplyr::mutate(angle = 0*(2*pi/360))
 
-    no_correction <-
-
     north_plot <-
       ggplot() +
       theme(legend.position = "top") +
       labs(colour = NULL) +
       geom_fields(data = north_arrows, aes(angle = angle, col = "no correction"), radius = 1,
                   .angle_correction = NULL,
+                  key_glyph = draw_key_fields,
                   max_radius = ggplot2::unit(0.7, "cm")) +
       geom_fields(data = north_arrows, aes(angle = angle, col = "corrected"), radius = 1,
+                  .angle_correction = angle_correction,
+                  key_glyph = draw_key_fields,
                   max_radius = ggplot2::unit(0.7, "cm")) +
       scale_colour_manual(values = c(`no correction` = "red", corrected = "green")) +
       coord_sf(crs = 32631)
 
     vdiffr::expect_doppelganger("ggfields north", north_plot)
   }
-)
+) |> suppressMessages()
+
+test_that(
+  "Annotation is visualised correctly", {
+
+    ## Note that the `seawatervelocity` spans a much larger area,
+    ## but the plot only focuses on `sw_sub`
+    annot_plot <- ggplot() +
+      geom_stars(data = sw_sub) +
+      annotation_fields(data = seawatervelocity,
+                        aes(angle = as.numeric(atan2(vo, uo)),
+                            radius = as.numeric(pythagoras(uo, vo)))) +
+      labs(radius = "v [m/s]")
+    vdiffr::expect_doppelganger("ggfields annot", annot_plot)
+  }
+) |> suppressMessages()
+
+test_that(
+  "Negative radii throws error in continuous scales", {
+    expect_error({
+      on.exit({grDevices::dev.off(); closeAllConnections()})
+      f <- tempfile(fileext = ".pdf")
+      p <- ggplot() +
+        geom_stars(data = sw_sub) +
+        geom_fields(data = sw_sub,
+                    aes(angle = as.numeric(atan2(vo, uo)),
+                        radius = -as.numeric(pythagoras(uo, vo))))
+      grDevices::pdf(f)
+      print(p) |> suppressMessages()
+    })
+  })
+
+test_that(
+  "Binned scales work without error", {
+    expect_no_error({
+      on.exit({grDevices::dev.off(); closeAllConnections()})
+      f <- tempfile(fileext = ".pdf")
+      p <- ggplot() +
+        geom_stars(data = sw_sub) +
+        geom_fields(data = sw_sub,
+                    aes(angle = as.numeric(atan2(vo, uo)),
+                        radius = as.numeric(pythagoras(uo, vo)))) +
+        scale_radius_binned()
+      grDevices::pdf(f)
+      print(p) |> suppressMessages()
+    })
+  })
+
+test_that(
+  "Discrete scales work without error", {
+    expect_no_error({
+      on.exit({grDevices::dev.off(); closeAllConnections()})
+      f <- tempfile(fileext = ".pdf")
+      p <- ggplot() +
+        geom_stars(data = sw_sub) +
+        annotation_fields(data = sw_sub,
+                          aes(angle = as.numeric(atan2(vo, uo)),
+                              radius = cut(as.numeric(pythagoras(uo, vo)), 3))) +
+        scale_radius_discrete()
+      grDevices::pdf(f)
+      print(p) |> suppressMessages()
+    })
+  })

tests/testthat/test_simple.r

@@ -0,0 +1,7 @@
+test_that(
+  "Pythagoras is correct", {
+    calc <- pythagoras(1:10, 10:1)
+    expect_equal(
+      sum(calc),
+      87.37186249587302)
+  })