updating get_extremes function after ZMD meeting

R/get_extremes.R

@@ -13,8 +13,8 @@
 #' 
 #' @examples
 #' # data(daily_niger)
-#' # filtered_data <- get_extremes(data = daily_niger, element = "rain", type = "threshold", value = 50)
-get_extremes <- function(data, element, type = c("percentile", "threshold"), value = 95, direction = c("greater", "less")) {
+#' filtered_data <- get_extremes1(data = daily_niger, station = NULL, year = "year", element = "rain", type = "threshold", value = 50)
+get_extremes1 <- function(data, station = NULL, year, element, type = c("percentile", "threshold"), value = 95, direction = c("greater", "less")) {
   type <- match.arg(type)
   direction <- match.arg(direction)
 
@@ -32,10 +32,18 @@ get_extremes <- function(data, element, type = c("percentile", "threshold"), val
 
   # Filter data based on the threshold and direction
   if (direction == "greater") {
-    extreme_data <- data %>% dplyr::filter(.data[[element]] > threshold_value)
+    extreme_data <- data %>% dplyr::filter(.data[[element]] > threshold_value, .preserve = TRUE)
   } else {
-    extreme_data <- data %>% dplyr::filter(.data[[element]] < threshold_value)
+    extreme_data <- data %>% dplyr::filter(.data[[element]] < threshold_value,  .preserve = TRUE)
+  } 
+
+  if (!is.null(station)){
+    extreme_data <- extreme_data %>% dplyr::group_by(.data[[station]], .drop = FALSE)
   }
+  extreme_data[[year]] <- factor(extreme_data[[year]])
+  extreme_data <- extreme_data %>%
+    dplyr::group_by(.data[[year]], .add = TRUE, .drop = FALSE) %>%
+    summarise(count = n())
 
   return(extreme_data)
 }

tests/testthat/test-get_extremes.R

@@ -5,26 +5,27 @@ library(dplyr)
 # Sample data for testing
 test_data <- data.frame(
   date = seq(as.Date("2020-01-01"), as.Date("2020-01-10"), by = "day"),
+  year = 2020,
   rain = c(10, 20, 30, 40, 50, 60, 70, 80, 90, 100),
   temp = c(15, 16, 17, 18, 19, 20, 21, 22, 23, 24)
 )
 
 # Test for threshold type
 test_that("Test threshold type", {
-  result <- get_extremes(test_data, "rain", "threshold", 50)
-  expect_true(all(result$rain > 50))
+  result <- get_extremes(test_data, year = "year", element = "rain", type = "threshold", value = 50)
+  expect_identical(result$count, nrow(test_data %>% dplyr::filter(rain > 50)))
 })
 
 # Test for percentile type
 test_that("Test percentile type", {
-  result <- get_extremes(test_data, "temp", "percentile", 90)
-  expect_true(all(result$temp > quantile(test_data$temp, probs = 0.90)))
+  result <- get_extremes(test_data, year = "year", element = "temp", type = "percentile", value = 80)
+  expect_identical(result$count, nrow(test_data %>% filter(temp > quantile(test_data$temp, probs = 0.80))))
 })
 
 # Test for direction 'less'
 test_that("Test direction 'less'", {
-  result <- get_extremes(test_data, "temp", "threshold", 20, "less")
-  expect_true(all(result$temp < 20))
+  result <- get_extremes(test_data, year = "year", element = "temp", type = "threshold", value = 20, direction = "less")
+  expect_identical(result$count, nrow(test_data %>% filter(temp < 20)))
 })
 
 # Test for error handling