Merge f5e8ab6 into e306fb4

R/functions_wmm.R

@@ -143,7 +143,7 @@
 #' @param lon GPS longitude
 #' @param lat GPS latitude, geodetic
 #' @param height GPS height in meters above ellipsoid
-#' @param time Annualized date time. E.g., 2015-02-01 = (2015 + 32/365) = 2015.088
+#' @param time Annualized date time. E.g., 2015-02-01 = (2015 + 32/365) = 2015.088; optionally an object (length 1) of class 'POSIXt' or 'Date'
 #' @param wmmVersion String representing WMM version to use. Must be consistent with \code{time} and one of the following: 'derived', 'WMM2000', 'WMM2005', 'WMM2010', 'WMM2015', 'WMM2015v2', 'WMM2020'. Default 'derived' value will infer the latest WMM version consistent with \code{time}.
 #'
 #' @return \code{list} of calculated main field and secular variation vector components in nT and nT/yr, resp. The magnetic element intensities (i.e., horizontal and total intensities, h & f) are in nT and the magnetic element angles (i.e., inclination and declination, i & d) are in degrees, with their secular variation in nT/yr and deg/yr, resp.: \code{x}, \code{y}, \code{z}, \code{xDot}, \code{yDot}, \code{zDot}, \code{h}, \code{f}, \code{i}, \code{d}, \code{hDot}, \code{fDot}, \code{iDot}, \code{dDot}
@@ -226,6 +226,16 @@ GetMagneticFieldWMM <- function(
 ) {
   geocentric <- .ConvertGeodeticToGeocentricGPS(lat, height)
 
+  if (!is.numeric(time)) {
+    if (inherits(time, c("POSIXt", "Date"))) {
+      YrJul <- with(as.POSIXlt(time), c(1900 + year, yday))
+      ydays <- if (all(YrJul[1] %% c(4, 100, 400) == 0)) 366 else 365
+      time <- YrJul[1] + YrJul[2]/ydays
+    } else {
+      stop("unrecognized 'time': ", paste(sQuote(class(time)), collapse = ", "))
+    }
+  }
+
   output <- .CalculateMagneticField(
     lon = lon,
     latGD = lat,

tests/testthat/setup.R

@@ -0,0 +1,20 @@
+# Define path to WMM test data
+folderExtdata <- file.path(
+  system.file(package = 'wmm'),
+  'extdata'
+)
+
+pathTestData <- file.path(
+  folderExtdata,
+  'WMMTestValues.csv'
+)
+
+# Import WMM test data
+testData <- data.table::fread(
+  pathTestData,
+  sep = '|',
+  header = TRUE,
+  stringsAsFactors = FALSE
+)[
+  , testID := .I
+]

tests/testthat/test-time-options.R

@@ -0,0 +1,41 @@
+testthat::context("Testing 'time' alternatives")
+
+testthat::test_that("'time' options are the same", {
+  dat <- testData[ h > 6000, ][ 1, ]
+
+  orig <- expect_silent(
+    dat[
+      , GetMagneticFieldWMM(
+        lon = lon,
+        lat = lat,
+        height = height * 1e3,
+        time = floor(year),
+        wmmVersion = wmmVersion
+      )]
+  )
+
+  posix <- expect_silent(
+    dat[
+      , GetMagneticFieldWMM(
+        lon = lon,
+        lat = lat,
+        height = height * 1e3,
+        time = as.POSIXct(paste0(floor(dat$year), "-01-01")),
+        wmmVersion = wmmVersion
+      )]
+  )
+
+  date <- expect_silent(
+    dat[
+      , GetMagneticFieldWMM(
+        lon = lon,
+        lat = lat,
+        height = height * 1e3,
+        time = as.Date(paste0(floor(dat$year), "-01-01")),
+        wmmVersion = wmmVersion
+      )]
+  )
+
+  expect_identical(orig, posix)
+  expect_identical(orig, date)
+})

tests/testthat/testWMM.R

@@ -1,26 +1,5 @@
 testthat::context('Testing WMM...')
 
-# Define path to WMM test data
-folderExtdata <- file.path(
-  system.file(package = 'wmm'),
-  'extdata'
-)
-
-pathTestData <- file.path(
-  folderExtdata,
-  'WMMTestValues.csv'
-)
-
-# Import WMM test data
-testData <- data.table::fread(
-  pathTestData,
-  sep = '|',
-  header = TRUE,
-  stringsAsFactors = FALSE
-)[
-  , testID := .I
-]
-
 # Define character vectors used for unit tests, which may be changed
 keyFields <- c('testID', 'wmmVersion')
 vectorFields <- c('x', 'y', 'z')
@@ -32,17 +11,63 @@ testFields <- c(
 calculatedFields <- paste0(testFields, 'Calculated')
 testthatFields <- c(keyFields, testFields)
 
-# Calculate magnetic field values
-testData[
-  , (calculatedFields) := GetMagneticFieldWMM(
-    lon = lon,
-    lat = lat,
-    height = height * 1e3,
-    time = year,
-    wmmVersion = wmmVersion
-  )
-  , by = testID
-]
+# Calculate magnetic field values, warning about 'is in'
+testthat::test_that("warns: is in the blackout zone", {
+  for (rn in which(testData$h < 2000)) {
+    testthat::expect_warning(
+      testData[
+        rn
+        , (calculatedFields) := GetMagneticFieldWMM(
+          lon = lon,
+          lat = lat,
+          height = height * 1e3,
+          time = year,
+          wmmVersion = wmmVersion
+        )
+        , by = testID
+      ]
+     , "Location is in the blackout zone")
+  }
+})
+
+# Calculate magnetic field values, warning about 'is approaching'
+testthat::test_that("warns: is approaching the blackout zone", {
+  for (rn in which(testData$h >= 2000 & testData$h < 6000)) {
+    testthat::expect_warning(
+      testData[
+        rn
+        , (calculatedFields) := GetMagneticFieldWMM(
+          lon = lon,
+          lat = lat,
+          height = height * 1e3,
+          time = year,
+          wmmVersion = wmmVersion
+        )
+        , by = testID
+      ]
+     , "Location is approaching the blackout zone")
+  }
+})
+
+# Calculate magnetic field values, no warning
+testthat::test_that("no warnings", {
+  testthat::expect_silent(
+    testData[
+      h >= 6000
+      , (calculatedFields) := GetMagneticFieldWMM(
+        lon = lon,
+        lat = lat,
+        height = height * 1e3,
+        time = year,
+        wmmVersion = wmmVersion
+      )
+      , by = testID
+    ])
+})
+
+testthat::test_that("nothing missed", {
+  expect_false(anyNA(testData[, c(calculatedFields), with = FALSE]))
+})
 
 # Copy table to help with set of test fields
 calculatedData <- data.table::copy(testData)[