Skip to content

Commit 8317e01

Browse files
NRaillardNRaillard
committed
Make tests more robusts
1 parent 5d5596e commit 8317e01

10 files changed

Lines changed: 3485 additions & 116 deletions

‎R/utils.R‎

Lines changed: 158 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,12 @@ closest_point_field <- function(x, lat = NULL, closest = 1L, ...) {
3232
if (!(length(x) == length(lat))) {
3333
stop("If 'lat' is provided, it sould be the same length as 'x'.")
3434
}
35-
return(closest_point_field(cbind(x, lat), lat = NULL, closest = closest, ...))
35+
return(closest_point_field(
36+
cbind(x, lat),
37+
lat = NULL,
38+
closest = closest,
39+
...
40+
))
3641
}
3742

3843
# Concert the input to a matrix with 2 columns, one point per line
@@ -86,7 +91,12 @@ closest_point_spec <- function(x, lat = NULL, closest = 1L, ...) {
8691
if (!(length(x) == length(lat))) {
8792
stop("If 'lat' is provided, it sould be the same length as 'x'.")
8893
}
89-
return(closest_point_spec(cbind(x, lat), lat = NULL, closest = closest, ...))
94+
return(closest_point_spec(
95+
cbind(x, lat),
96+
lat = NULL,
97+
closest = closest,
98+
...
99+
))
90100
}
91101

92102
# Concert the input to a matrix with 2 columns, one point per line
@@ -195,7 +205,6 @@ metconv2zmcomp <- function(speed, direction, names = c("uwnd", "vwnd")) {
195205
}
196206

197207

198-
199208
#' JONWSAP spectrum
200209
#'
201210
#' Creates a JONWSAP density spectrum (one-sided), defined by its integral parameters.
@@ -279,6 +288,7 @@ jonswap <- function(hs = 5, tp = 15, fmax = rscd_freq, df = NULL, gam = 3.3) {
279288
", gamma=",
280289
gam
281290
)
291+
sp$freq <- as.vector(sp$freq)
282292
tibble::as_tibble(sp)
283293
}
284294

@@ -331,7 +341,6 @@ mean_direction <- function(directions, weights = NULL) {
331341
directions <- directions[!is.na(directions)]
332342
}
333343

334-
335344
# Check for negative weights (which would cause issues with weighting)
336345
if (any(weights < 0)) {
337346
warning("Negative weights detected. Using absolute values.")
@@ -486,7 +495,6 @@ cut_directions <- function(directions, n_bins = 8, labels = NULL) {
486495
}
487496

488497

489-
490498
#' Get season from date time object
491499
#'
492500
#' @param datetime a POSIXct vector from with the season is constructed
@@ -513,21 +521,34 @@ cut_directions <- function(directions, n_bins = 8, labels = NULL) {
513521
#' by = "month"
514522
#' )
515523
#' cut_seasons(dates)
516-
cut_seasons <- function(datetime,
517-
definition = "meteorological",
518-
hemisphere = "northern",
519-
labels = NULL) {
524+
cut_seasons <- function(
525+
datetime,
526+
definition = "meteorological",
527+
hemisphere = "northern",
528+
labels = NULL
529+
) {
520530
# Validate inputs
521531
if (!inherits(datetime, "POSIXct")) {
522532
stop("datetime must be a POSIXct object")
523533
}
524534

525-
if (!definition %in% c(
526-
"meteorological", "astronomical",
527-
"djf", "jfm", "amj", "jas", "ond", "fma"
528-
)) {
529-
stop("definition must be one of: 'meteorological', 'astronomical',
530-
'djf', 'jfm', 'amj', 'jas', 'ond', 'fma'")
535+
if (
536+
!definition %in%
537+
c(
538+
"meteorological",
539+
"astronomical",
540+
"djf",
541+
"jfm",
542+
"amj",
543+
"jas",
544+
"ond",
545+
"fma"
546+
)
547+
) {
548+
stop(
549+
"definition must be one of: 'meteorological', 'astronomical',
550+
'djf', 'jfm', 'amj', 'jas', 'ond', 'fma'"
551+
)
531552
}
532553

533554
if (!hemisphere %in% c("northern", "southern")) {
@@ -544,8 +565,18 @@ cut_seasons <- function(datetime,
544565
# Dec-Jan-Feb = Winter, Mar-Apr-May = Spring, etc.
545566
season_month <- c(12, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)
546567
season_labels <- c(
547-
"Winter", "Winter", "Winter", "Spring", "Spring", "Spring",
548-
"Summer", "Summer", "Summer", "Autumn", "Autumn", "Autumn"
568+
"Winter",
569+
"Winter",
570+
"Winter",
571+
"Spring",
572+
"Spring",
573+
"Spring",
574+
"Summer",
575+
"Summer",
576+
"Summer",
577+
"Autumn",
578+
"Autumn",
579+
"Autumn"
549580
)
550581
seasons <- season_labels[match(month, season_month)]
551582
} else if (definition == "astronomical") {
@@ -558,10 +589,22 @@ cut_seasons <- function(datetime,
558589
d <- yday[i]
559590

560591
# Approximate astronomical dates (can vary by 1-2 days)
561-
spring_equinox <- as.numeric(format(as.Date(paste(y, "03", "20", sep = "-")), "%j"))
562-
summer_solstice <- as.numeric(format(as.Date(paste(y, "06", "21", sep = "-")), "%j"))
563-
autumn_equinox <- as.numeric(format(as.Date(paste(y, "09", "22", sep = "-")), "%j"))
564-
winter_solstice <- as.numeric(format(as.Date(paste(y, "12", "21", sep = "-")), "%j"))
592+
spring_equinox <- as.numeric(format(
593+
as.Date(paste(y, "03", "20", sep = "-")),
594+
"%j"
595+
))
596+
summer_solstice <- as.numeric(format(
597+
as.Date(paste(y, "06", "21", sep = "-")),
598+
"%j"
599+
))
600+
autumn_equinox <- as.numeric(format(
601+
as.Date(paste(y, "09", "22", sep = "-")),
602+
"%j"
603+
))
604+
winter_solstice <- as.numeric(format(
605+
as.Date(paste(y, "12", "21", sep = "-")),
606+
"%j"
607+
))
565608

566609
if (d >= winter_solstice || d < spring_equinox) {
567610
seasons[i] <- "Winter"
@@ -577,57 +620,122 @@ cut_seasons <- function(datetime,
577620
# Dec-Jan-Feb, Mar-Apr-May, Jun-Jul-Aug, Sep-Oct-Nov
578621
season_month <- c(12, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)
579622
season_labels <- c(
580-
"DJF", "DJF", "DJF", "MAM", "MAM", "MAM",
581-
"JJA", "JJA", "JJA", "SON", "SON", "SON"
623+
"DJF",
624+
"DJF",
625+
"DJF",
626+
"MAM",
627+
"MAM",
628+
"MAM",
629+
"JJA",
630+
"JJA",
631+
"JJA",
632+
"SON",
633+
"SON",
634+
"SON"
582635
)
583636
seasons <- season_labels[match(month, season_month)]
584637
} else if (definition == "jfm") {
585638
# Jan-Feb-Mar, Apr-May-Jun, Jul-Aug-Sep, Oct-Nov-Dec
586639
season_month <- 1:12
587640
season_labels <- c(
588-
"JFM", "JFM", "JFM", "AMJ", "AMJ", "AMJ",
589-
"JAS", "JAS", "JAS", "OND", "OND", "OND"
641+
"JFM",
642+
"JFM",
643+
"JFM",
644+
"AMJ",
645+
"AMJ",
646+
"AMJ",
647+
"JAS",
648+
"JAS",
649+
"JAS",
650+
"OND",
651+
"OND",
652+
"OND"
590653
)
591654
seasons <- season_labels[match(month, season_month)]
592655
} else if (definition == "amj") {
593656
# Apr-May-Jun, Jul-Aug-Sep, Oct-Nov-Dec, Jan-Feb-Mar
594657
season_month <- 1:12
595658
season_labels <- c(
596-
"JFM", "JFM", "JFM", "AMJ", "AMJ", "AMJ",
597-
"JAS", "JAS", "JAS", "OND", "OND", "OND"
659+
"JFM",
660+
"JFM",
661+
"JFM",
662+
"AMJ",
663+
"AMJ",
664+
"AMJ",
665+
"JAS",
666+
"JAS",
667+
"JAS",
668+
"OND",
669+
"OND",
670+
"OND"
598671
)
599672
seasons <- season_labels[match(month, season_month)]
600673
} else if (definition == "jas") {
601674
# Jul-Aug-Sep, Oct-Nov-Dec, Jan-Feb-Mar, Apr-May-Jun
602675
season_month <- 1:12
603676
season_labels <- c(
604-
"JFM", "JFM", "JFM", "AMJ", "AMJ", "AMJ",
605-
"JAS", "JAS", "JAS", "OND", "OND", "OND"
677+
"JFM",
678+
"JFM",
679+
"JFM",
680+
"AMJ",
681+
"AMJ",
682+
"AMJ",
683+
"JAS",
684+
"JAS",
685+
"JAS",
686+
"OND",
687+
"OND",
688+
"OND"
606689
)
607690
seasons <- season_labels[match(month, season_month)]
608691
} else if (definition == "ond") {
609692
# Oct-Nov-Dec, Jan-Feb-Mar, Apr-May-Jun, Jul-Aug-Sep
610693
season_month <- 1:12
611694
season_labels <- c(
612-
"JFM", "JFM", "JFM", "AMJ", "AMJ", "AMJ",
613-
"JAS", "JAS", "JAS", "OND", "OND", "OND"
695+
"JFM",
696+
"JFM",
697+
"JFM",
698+
"AMJ",
699+
"AMJ",
700+
"AMJ",
701+
"JAS",
702+
"JAS",
703+
"JAS",
704+
"OND",
705+
"OND",
706+
"OND"
614707
)
615708
seasons <- season_labels[match(month, season_month)]
616709
} else if (definition == "fma") {
617710
# Feb-Mar-Apr, May-Jun-Jul, Aug-Sep-Oct, Nov-Dec-Jan
618711
season_month <- 1:12
619712
season_labels <- c(
620-
"NDJ", "FMA", "FMA", "FMA", "MJJ", "MJJ",
621-
"MJJ", "ASO", "ASO", "ASO", "NDJ", "NDJ"
713+
"NDJ",
714+
"FMA",
715+
"FMA",
716+
"FMA",
717+
"MJJ",
718+
"MJJ",
719+
"MJJ",
720+
"ASO",
721+
"ASO",
722+
"ASO",
723+
"NDJ",
724+
"NDJ"
622725
)
623726
seasons <- season_labels[match(month, season_month)]
624727
}
625728

626729
# Flip seasons for southern hemisphere
627-
if (hemisphere == "southern" && definition %in% c("meteorological", "astronomical")) {
730+
if (
731+
hemisphere == "southern" &&
732+
definition %in% c("meteorological", "astronomical")
733+
) {
628734
season_mapping <- c(
629-
"Spring" = "Autumn", "Summer" = "Winter",
630-
"Autumn" = "Spring", "Winter" = "Summer"
735+
"Spring" = "Autumn",
736+
"Summer" = "Winter",
737+
"Autumn" = "Spring",
738+
"Winter" = "Summer"
631739
)
632740
seasons <- season_mapping[seasons]
633741
}
@@ -636,8 +744,12 @@ cut_seasons <- function(datetime,
636744
if (!is.null(labels)) {
637745
unique_seasons <- unique(seasons[!is.na(seasons)])
638746
if (length(labels) != length(unique_seasons)) {
639-
stop(paste("Number of labels (", length(labels),
640-
") must match number of unique seasons (", length(unique_seasons), ")",
747+
stop(paste(
748+
"Number of labels (",
749+
length(labels),
750+
") must match number of unique seasons (",
751+
length(unique_seasons),
752+
")",
641753
sep = ""
642754
))
643755
}
@@ -713,7 +825,9 @@ fractional_day_of_year <- function(datetime) {
713825

714826
# Extract timezone (defaults to UTC if missing)
715827
tz <- attr(datetime, "tzone")
716-
if (is.null(tz) || tz == "") tz <- "UTC"
828+
if (is.null(tz) || tz == "") {
829+
tz <- "UTC"
830+
}
717831

718832
# Get the year for each datetime
719833
year <- as.POSIXlt(datetime, tz = tz)$year + 1900
@@ -731,7 +845,11 @@ fractional_day_of_year <- function(datetime) {
731845
)
732846

733847
# Compute time difference in hours
734-
hours_diff <- as.numeric(difftime(datetime[valid], start_of_year, units = "hours"))
848+
hours_diff <- as.numeric(difftime(
849+
datetime[valid],
850+
start_of_year,
851+
units = "hours"
852+
))
735853

736854
# Convert to fractional days
737855
fractional_day[valid] <- hours_diff / 24

‎tests/testthat/Rplots.pdf‎

0 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)