Merge branch 'release/2.5.1'

.Rbuildignore

@@ -10,3 +10,4 @@
 ^docs$
 ^pkgdown$
 ^README\.Rmd$
+^.lintr$

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: preproc.iquizoo
 Title: Utility Functions for Data Processing of Iquizoo Games
-Version: 2.5.0
+Version: 2.5.1
 Authors@R:
     person("Liang", "Zhang", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-9041-1150"))

NEWS.md

@@ -1,3 +1,9 @@
+# preproc.iquizoo 2.5.1
+
+## Breaking Changes
+
+* Ensure the number of reversals in `calc_staircase_wetherill()` to be even. Odd number of reversals will be automatically adjusted to even number by removing the first reversal from the condition with larger number of reversals ([#75](https://github.com/psychelzh/preproc.iquizoo/issues/75)).
+
 # preproc.iquizoo 2.5.0
 
 ## New Features

R/bart.R

@@ -1,7 +1,6 @@
 #' Balloon Analogue Risk Task
 #'
-#' This task is deemed as a measure of impulsivity. Read more details on
-#' [this website](http://www.impulsivity.org/measurement/BART).
+#' This task is deemed as a measure of impulsivity.
 #'
 #' @template common
 #' @template options

R/utils-common.R

@@ -62,20 +62,41 @@ check_outliers_rt <- function(x, threshold = 2.5) {
 #' @return The mean threshold.
 #' @keywords internal
 calc_staircase_wetherill <- function(x) {
+  find_reversals <- function(x, type = c("peaks", "valleys")) {
+    type <- match.arg(type)
+    if (type == "valleys") x <- -x
+    mat <- pracma::findpeaks(x)
+    if (!is.null(mat)) {
+      if (type == "valleys") {
+        -mat[, 1]
+      } else {
+        mat[, 1]
+      }
+    } else {
+      warn(paste("No", type, "found from input"), "input_not_suitable")
+      NULL
+    }
+  }
   # use run length encoding to remove repetitions in transformed method
   x <- rle(x)$values
-  # return `NA` if no peaks or valleys found
-  peaks_mat <- pracma::findpeaks(x)
-  if (!is.null(peaks_mat)) {
-    peaks <- peaks_mat[, 1]
-  } else {
-    peaks <- NA_real_
-  }
-  valleys_mat <- pracma::findpeaks(-x)
-  if (!is.null(valleys_mat)) {
-    valleys <- -valleys_mat[, 1]
-  } else {
-    valleys <- NA_real_
+  reversals <- list(peaks = NULL, valleys = NULL)
+  for (type_reversal in names(reversals)) {
+    cur_reversals <- find_reversals(x, type_reversal)
+    if (is.null(cur_reversals)) {
+      return(NA_real_)
+    }
+    reversals[[type_reversal]] <- cur_reversals
   }
-  mean(c(peaks, valleys))
+  with(
+    reversals, {
+      num_peaks <- length(peaks)
+      num_valleys <- length(valleys)
+      if (num_peaks > num_valleys) {
+        peaks <- peaks[-1]
+      } else if (num_peaks < num_valleys) {
+        valleys <- valleys[-1]
+      }
+      mean(c(peaks, valleys))
+    }
+  )
 }

README.Rmd

@@ -17,7 +17,7 @@ knitr::opts_chunk$set(
 
 <!-- badges: start -->
 [![R-CMD-check](https://github.com/psychelzh/preproc.iquizoo/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/psychelzh/preproc.iquizoo/actions/workflows/R-CMD-check.yaml)
-[![Codecov test coverage](https://codecov.io/gh/psychelzh/preproc.iquizoo/branch/main/graph/badge.svg)](https://codecov.io/gh/psychelzh/preproc.iquizoo?branch=main)
+[![Codecov test coverage](https://codecov.io/gh/psychelzh/preproc.iquizoo/branch/main/graph/badge.svg)](https://app.codecov.io/gh/psychelzh/preproc.iquizoo?branch=main)
 [![lint](https://github.com/psychelzh/preproc.iquizoo/workflows/lint/badge.svg)](https://github.com/psychelzh/preproc.iquizoo/actions)
 <!-- badges: end -->
 

README.md

@@ -7,7 +7,7 @@
 
 [![R-CMD-check](https://github.com/psychelzh/preproc.iquizoo/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/psychelzh/preproc.iquizoo/actions/workflows/R-CMD-check.yaml)
 [![Codecov test
-coverage](https://codecov.io/gh/psychelzh/preproc.iquizoo/branch/main/graph/badge.svg)](https://codecov.io/gh/psychelzh/preproc.iquizoo?branch=main)
+coverage](https://codecov.io/gh/psychelzh/preproc.iquizoo/branch/main/graph/badge.svg)](https://app.codecov.io/gh/psychelzh/preproc.iquizoo?branch=main)
 [![lint](https://github.com/psychelzh/preproc.iquizoo/workflows/lint/badge.svg)](https://github.com/psychelzh/preproc.iquizoo/actions)
 <!-- badges: end -->
 

tests/testthat/_snaps/condstairs.md

@@ -23,7 +23,7 @@
         {
           "type": "double",
           "attributes": {},
-          "value": [4]
+          "value": [3.5]
         },
         {
           "type": "double",
@@ -33,12 +33,12 @@
         {
           "type": "double",
           "attributes": {},
-          "value": [4.625]
+          "value": [4.375]
         },
         {
           "type": "double",
           "attributes": {},
-          "value": [-1.25]
+          "value": [-1.75]
         }
       ]
     }
@@ -73,7 +73,7 @@
         {
           "type": "double",
           "attributes": {},
-          "value": [4, 4]
+          "value": [3.5, 3.5]
         },
         {
           "type": "double",
@@ -83,12 +83,12 @@
         {
           "type": "double",
           "attributes": {},
-          "value": [4.625, 4.625]
+          "value": [4.375, 4.375]
         },
         {
           "type": "double",
           "attributes": {},
-          "value": [-1.25, -1.25]
+          "value": [-1.75, -1.75]
         }
       ]
     }

tests/testthat/_snaps/staircase.md

@@ -63,7 +63,7 @@
         {
           "type": "double",
           "attributes": {},
-          "value": [147.08333333, 150.38461538]
+          "value": [147.08333333, 150]
         },
         {
           "type": "double",

tests/testthat/_snaps/stopsignal.md

@@ -103,12 +103,12 @@
         {
           "type": "double",
           "attributes": {},
-          "value": [308.92857143, 341.98717949]
+          "value": [308.92857143, 341.66666667]
         },
         {
           "type": "double",
           "attributes": {},
-          "value": [-12.56061404, 58.95698386]
+          "value": [-12.56061404, 59.27749668]
         }
       ]
     }

tests/testthat/test-calc_staircase_wetherill.R

@@ -1,9 +1,12 @@
 test_that("Correctly find all peaks and valleys", {
   lvls <- c(2:5, 4:1, 2:4)
   expect_equal(calc_staircase_wetherill(lvls), 3)
+  lvls <- c(2:5, 4:1, 2:4, 3:1)
+  expect_equal(calc_staircase_wetherill(lvls), 2.5)
 })
 
 test_that("Return NA if no peaks or valleys", {
-  lvls <- c(2:5)
-  expect_true(is.na(calc_staircase_wetherill(lvls)))
+  is.na(calc_staircase_wetherill(c(2:5))) |>
+    expect_true() |>
+    expect_warning(class = "input_not_suitable")
 })