Reverted to refactored version without turnpoint(). Updated changelog…

… file.

CHANGELOG.md

@@ -10,7 +10,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - added tests with realistic testdata for `extract_features.R` [#42](https://github.com/RECETOX/recetox-aplcms/pull/42), [#54](https://github.com/RECETOX/recetox-aplcms/pull/54)
 - added tests for `feature.align.R` ([#40](https://github.com/RECETOX/recetox-aplcms/pull/40)), and `adjust.time.R` ([#39](https://github.com/RECETOX/recetox-aplcms/pull/40))
 - added CI to repository's GitHub Actions [#45](https://github.com/RECETOX/recetox-aplcms/pull/45),[#49](https://github.com/RECETOX/recetox-aplcms/pull/49)
-- added pastecs library to dependencies  [#91](https://github.com/RECETOX/recetox-aplcms/pull/91)
 ### Changed
 - refactored `feature.align.R` [#63](https://github.com/RECETOX/recetox-aplcms/pull/63)
 - refactored `adjust.time.R` [#64](https://github.com/RECETOX/recetox-aplcms/pull/64)

R/find.turn.point.R

@@ -1,6 +1,39 @@
-#' @import pastecs
-NULL
-#> NULL
+#' @description
+#' Compute local maxima turn points. 
+#' @param y The y values of a curve in x-y plane.
+#' @param ties.method specifies the method rank uses to break ties.
+#' @return boolean row with local maxima turn point.
+find_local_maxima <- function(y, ties.method) {
+    padded_y <- rev(as.vector(c(-Inf, y, -Inf)))
+
+    # each row is 3 consecutive values in descending order
+    # rows are sorted in ascending order
+    z <- embed(padded_y, dim = 3)
+
+    # reverse the row ordering
+    # first column is equal y
+    z <- z[rev(seq(nrow(z))), ]
+
+    # row where the max is in the middle is a turn point
+    v <- max.col(z, ties.method = ties.method) == 2
+
+    return(v)
+}
+
+#' @description
+#' Compute maxima and minima turn points. 
+#' @param y The y values of a curve in x-y plane.
+#' @return boolean row with local maxima and minima turn points.
+msExtrema <- function(y) {
+    index1 <- find_local_maxima(y, ties.method = "first")
+    index2 <- find_local_maxima(-y, ties.method = "last")
+
+    # this is some sort of safety mechanism to protect against numerical issues
+    index.max <- index1 & !index2
+    index.min <- index2 & !index1
+
+    list(index.max = index.max, index.min = index.min)
+}
 
 #' Find peaks and valleys of a curve.
 #'
@@ -17,20 +50,33 @@ NULL
 #' @examples
 #' find.turn.point(y)
 find.turn.point <- function(y) {
-    y <- y[!is.na(y)]                             # filter NA values
-    if (length(unique(y)) == 1) {                 # if exactly one distinct value
-        middle_index <- round(length(y) / 2)      # get mid index
-        start_and_end <- c(1, length(y))          # get first and last index
+    y <- y[!is.na(y)] # filter NA values
+
+    if (length(unique(y)) == 1) { # if exactly one distinct value
+        middle_index <- round(length(y) / 2) # get mid index
+        start_and_end <- c(1, length(y)) # get first and last index
         return(list(pks = middle_index, vlys = start_and_end))
     } else {
-        list_tp <- pastecs::turnpoints(y)
-        peaks <- which(list_tp$peaks)  
-        pits <- which(list_tp$pits)
+        b <- msExtrema(y)
+
+        pks <- which(b$index.max)
+        vlys <- which(b$index.min)
+
+        if (pks[1] != 1) {
+            vlys <- c(1, vlys)
+        }
+
+        if (pks[length(pks)] != length(y)) {
+            vlys <- c(vlys, length(y))
+        }
 
-        if (length(peaks) == 1) {   
-            pits <- c(1, list_tp$n)
+        if (length(pks) == 1) {
+            vlys <- c(1, length(y))
         }
 
-    return(list(pks = peaks, vlys = pits))
+        x <- new("list")
+        x$pks <- pks
+        x$vlys <- vlys
+        return(x)
     }
 }