Optimize sta_pam() and add test

Rafnuss · Apr 9, 2022 · eb39869 · eb39869
1 parent ae97874
commit eb39869
Show file tree

Hide file tree

Showing 2 changed files with 44 additions and 8 deletions.
diff --git a/R/PAM.R → R/pam.R b/R/PAM.R → R/pam.R
@@ -391,16 +391,20 @@ pam_sta <- function(pam) {
   pam$sta$sta_id <- seq_len(nrow(pam$sta))
 
   # Assign to each pressure the stationary period to which it belong to.
-  pressure_sta_id <- sapply(pam$pressure$date, function(x) {
-    which(pam$sta$start < x & x < pam$sta$end)
-  })
-  pressure_sta_id[sapply(pressure_sta_id, function(x) length(x) == 0)] <- 0
-  pam$pressure$sta_id <- unlist(pressure_sta_id)
+  tmp <- mapply(function(start, end) {
+    start < pam$pressure$date & pam$pressure$date < end
+  }, pam$sta$start, pam$sta$end)
+  tmp <- which(tmp, arr.ind = TRUE)
+  pam$pressure$sta_id <- 0
+  pam$pressure$sta_id[tmp[, 1]] <- tmp[, 2]
 
   # Assign to each light measurement the stationary period
-  light_sta_id <- sapply(pam$light$date, function(x) which(pam$sta$start < x & x < pam$sta$end))
-  light_sta_id[sapply(light_sta_id, function(x) length(x) == 0)] <- 0
-  pam$light$sta_id <- unlist(light_sta_id)
+  tmp <- mapply(function(start, end) {
+    start < pam$light$date & pam$light$date < end
+  }, pam$sta$start, pam$sta$end)
+  tmp <- which(tmp, arr.ind = TRUE)
+  pam$light$sta_id <- 0
+  pam$light$sta_id[tmp[, 1]] <- tmp[, 2]
 
   return(pam)
 }
diff --git a/tests/testthat/test-pam.R b/tests/testthat/test-pam.R
@@ -0,0 +1,32 @@
+
+test_that("Check pam_read()", {
+  expect_type(pam_read(pathname = system.file("extdata", package = "GeoPressureR")), "list")
+  expect_type(pam_read(
+    pathname = system.file("extdata", package = "GeoPressureR"),
+    crop_start = "2017-06-20", crop_end = "2018-05-02"
+  ), "list")
+  expect_true(nrow(pam_read(
+    pathname = system.file("extdata", package = "GeoPressureR"),
+    crop_start = "2019-06-20", crop_end = "2018-05-02"
+  )$light) == 0)
+})
+
+test_that("Check trainset_read()", {
+  pam_data <- pam_read(
+    pathname = system.file("extdata", package = "GeoPressureR"),
+    crop_start = "2017-06-20", crop_end = "2018-05-02"
+  )
+  expect_type(trainset_read(pam_data, pathname = system.file("extdata", package = "GeoPressureR")), "list")
+})
+
+
+test_that("Check pam_sta()", {
+  pam_data <- pam_read(
+    pathname = system.file("extdata", package = "GeoPressureR"),
+    crop_start = "2017-06-20", crop_end = "2018-05-02"
+  )
+  pam_data <- trainset_read(pam_data, pathname = system.file("extdata", package = "GeoPressureR"))
+
+  expect_error(pam_sta(pam_data), NA)
+  expect_true(nrow(pam_sta(pam_data)$sta) > 0)
+})