From dd1b58b6762e7435cc032d807a47fa7484d17cf6 Mon Sep 17 00:00:00 2001 From: lilyclements Date: Sun, 21 Jul 2024 21:52:42 +0100 Subject: [PATCH] files on testing data_by_year --- tests/testthat/test-get_X_definitions.R | 156 ++++++++++++++++++ .../testdata/data_by_year_example.rds | Bin 0 -> 607 bytes .../testdata/zambia_by_year_example.rds | Bin 0 -> 1100 bytes 3 files changed, 156 insertions(+) create mode 100644 tests/testthat/test-get_X_definitions.R create mode 100644 tests/testthat/testdata/data_by_year_example.rds create mode 100644 tests/testthat/testdata/zambia_by_year_example.rds diff --git a/tests/testthat/test-get_X_definitions.R b/tests/testthat/test-get_X_definitions.R new file mode 100644 index 0000000..188c4e6 --- /dev/null +++ b/tests/testthat/test-get_X_definitions.R @@ -0,0 +1,156 @@ +library(testthat) + +# Test case 1 +gcs_auth_file(file = "testdata/epicsa_token.json") + +#zambia_by_year_example <- get_r_instat_definitions(data_book$get_calculations("ZambiaEastern_by_Station_Name_s_year1")) +#saveRDS(zambia_by_year_example, "testdata/zambia_by_year_example.rds") +ghana_by_year_example <- readRDS("testdata/data_by_year_example.rds") +zambia_by_year_example <- readRDS("testdata/zambia_by_year_example.rds") + +# Test cases +test_that("get_start_rains_definitions returns correct structure with start_rains", { + result <- get_start_rains_definitions(ghana_by_year_example$start_rains) + expect_true("start_rains" %in% names(result)) + expect_true(all(c("start_day", "end_day", "threshold", "total_rainfall", + "over_days", "amount_rain", "proportion", "prob_rain_day", + "dry_spell", "spell_max_dry_days", "spell_interval", + "dry_period", "max_rain", "period_interval", "period_max_dry_days") %in% names(result$start_rains))) +}) + +test_that("get_start_rains_definitions returns NA for missing variables", { + result <- get_start_rains_definitions(NULL) + expect_true("start_rains" %in% names(result)) + expect_true(all(is.na(unlist(result$start_rains)))) +}) + +test_that("get_start_rains_definitions extracts correct values", { + result <- get_start_rains_definitions(ghana_by_year_example$start_rain) + expect_equal(result$start_rains$start_day, 1) + expect_equal(result$start_rains$end_day, 366) + expect_equal(result$start_rains$threshold, 0.85) + expect_equal(result$start_rains$total_rainfall, TRUE) + expect_equal(result$start_rains$amount_rain, 20) + expect_equal(result$start_rains$over_days, 2) + expect_equal(result$start_rains$proportion, FALSE) +}) + +########## end_rains + +# Test cases +test_that("get_end_rains_definitions returns correct structure with end_rains", { + result <- get_end_rains_definitions(ghana_by_year_example$end_rains) + expect_true("end_rains" %in% names(result)) + expect_true(all(c("start_day", "end_day", "output", "min_rainfall", "interval_length") %in% names(result$end_rains))) +}) + +test_that("get_end_rains_definitions returns NA for missing variables", { + result <- get_end_rains_definitions(NULL) + expect_true("end_rains" %in% names(result)) + expect_true(all(is.na(unlist(result$end_rains)))) +}) + +test_that("get_end_rains_definitions extracts correct values", { + result <- get_end_rains_definitions(ghana_by_year_example$end_rains) + expect_equal(result$end_rains$start_day, 1) + expect_equal(result$end_rains$end_day, 366) + expect_equal(result$end_rains$output, "both") + expect_equal(result$end_rains$min_rainfall, 10) + expect_equal(result$end_rains$interval_length, 1) +}) + +test_that("get_end_rains_definitions handles different structures correctly", { + end_rains <- list( + filter = list( + "[[1]]" = "(roll_sum_rain > 10) | is.na(x=roll_sum_rain)", + roll_sum_rain = list( + ghana = "rainfall", + "[[2]]" = "RcppRoll::roll_sumr(x=rainfall, n=3, fill=NA, na.rm=FALSE)" + ) + ), + filter_2 = "doy >= 1 & doy <= 366" + ) + result <- get_end_rains_definitions(end_rains) + expect_equal(result$end_rains$start_day, 1) + expect_equal(result$end_rains$end_day, 366) + expect_equal(result$end_rains$output, "both") + expect_equal(result$end_rains$min_rainfall, 10) + expect_equal(result$end_rains$interval_length, 3) +}) + +########## temperature summaries + +# Test cases +test_that("get_end_rains_definitions returns correct structure with end_rains", { + result <- get_temperature_summary_definitions(year = "year", + month = "month", + data_by_year = ghana_by_year_example, + min_tmin_column = "min_min_temperature", mean_tmin_column = "mean_min_temperature", + max_tmin_column = "max_min_temperature", min_tmax_column = "min_max_temperature", + mean_tmax_column = "mean_max_temperature", max_tmax_column = "min_max_temperature") + expect_true("mean_tmin" %in% names(result)) + expect_true("mean_tmax" %in% names(result)) + expect_true("min_tmin" %in% names(result)) + expect_true("min_tmax" %in% names(result)) + expect_true("max_tmin" %in% names(result)) + expect_true("max_tmax" %in% names(result)) + expect_true(all(c("to", "na_rm", "na_n", "na_n_non", "na_consec", "na_prop") %in% names(result$mean_tmin))) + expect_true(all(c("to", "na_rm", "na_n", "na_n_non", "na_consec", "na_prop") %in% names(result$mean_tmax))) + expect_true(all(c("to", "na_rm", "na_n", "na_n_non", "na_consec", "na_prop") %in% names(result$min_tmin))) + expect_true(all(c("to", "na_rm", "na_n", "na_n_non", "na_consec", "na_prop") %in% names(result$min_tmax))) + expect_true(all(c("to", "na_rm", "na_n", "na_n_non", "na_consec", "na_prop") %in% names(result$max_tmin))) + expect_true(all(c("to", "na_rm", "na_n", "na_n_non", "na_consec", "na_prop") %in% names(result$max_tmax))) + + expect_equal(result$mean_tmin$to, "annual") + expect_equal(result$mean_tmin$na_rm, NA) + expect_equal(result$mean_tmin$na_n, NA) + expect_equal(result$mean_tmin$na_n_non, NA) + expect_equal(result$mean_tmin$na_consec, NA) + expect_equal(result$mean_tmin$na_prop, NA) +}) + +### season length +test_that("get_season_length_definitions returns correct structure with length", { + result <- get_season_length_definitions(length = ghana_by_year_example$length) + expect_true("seasonal_length" %in% names(result)) + expect_true(all(c("end_type") %in% names(result$seasonal_length))) + expect_equal(result$seasonal_length$end_type, "rains") +}) + + +# end_season ------------------------------------------------------ +# Test cases +test_that("get_end_season_definitions returns correct structure with end_season", { + result <- get_end_season_definitions(zambia_by_year_example$end_season) + expect_true("end_season" %in% names(result)) + expect_true(all(c("start_day", "end_day", "water_balance_max", "capacity", "evaporation", "evaporation_value") %in% names(result$end_season))) +}) + +test_that("get_end_season_definitions returns NA for missing variables", { + result <- get_end_season_definitions(NULL) + expect_true("end_season" %in% names(result)) + expect_true(all(is.na(unlist(result$end_season)))) +}) + +test_that("get_end_season_definitions extracts correct values", { + result <- get_end_season_definitions(zambia_by_year_example$end_season) + expect_equal(result$end_season$start_day, 245) + expect_equal(result$end_season$end_day, 366) + expect_equal(result$end_season$water_balance_max, 0.5) + expect_equal(result$end_season$capacity, 100) + expect_equal(result$end_season$evaporation, "value") + expect_equal(result$end_season$evaporation_value, 5) +}) + +# TO TEST: +#zambia_by_year_example$sum_rainfall +#zambia_by_year_example$sum_rainday + + +# TO TEST: +# get_crop_success_ +# get_probability_ + +# then test build_* +# then test collate +# then test get_r_instat_definitions \ No newline at end of file diff --git a/tests/testthat/testdata/data_by_year_example.rds b/tests/testthat/testdata/data_by_year_example.rds new file mode 100644 index 0000000000000000000000000000000000000000..994912442cfe241161b58cd8aa919631ae227c3a GIT binary patch literal 607 zcmV-l0-*gLiwFP!000002JKZrYuhjsR^p^x%0>t6cGhXL!40uX%P@1HldI*u;_x$O-?|rgAZvg--Fz8vp8pIu85> zyK-ifqHLa^GTCulSdc7yckDtoGgGIt!i7^3;W-sD#c@<=J)^YEOkfeu7yyI579KL3 zkj%&(US45_<>FeA^^Js2wq3UYk3u*ZzdCT>3)mfzBzvT@zkkQ=>1TP{bu9U22=vHCIa>Uq|tz; zm?{6DAeb9uZE`n&XL7iuzMj;!T)qzB{^6m)GE~WrqdB`MCyYp*)~B8q$W!YLDTE+g zL-uQZD+Kvk{id@mdAgV|kOmX(I1mnaJ$n*B$4N1#XQF6lw@O_yv={Bp7Ymu&N8anlI?O)i=rbV!lsM3`R01Q1mGUjA8&MG)om~8 zN3tv>ELtde0}!k!dpn645+q3p$70Tj0o!uW3FZY#2xfK;Lull?@QVz3T}Hl36SS&w zi}_aXmp_)`otXdMh70^;M;W tU5YEU+bu5&GG8whwo`_?ASq!xq!^8f=!_ju$+$Ad>z{)Qt^iC8008J=D2@OC literal 0 HcmV?d00001 diff --git a/tests/testthat/testdata/zambia_by_year_example.rds b/tests/testthat/testdata/zambia_by_year_example.rds new file mode 100644 index 0000000000000000000000000000000000000000..c7e4ca19bb2c9f38ae656e0507674b2b9840b621 GIT binary patch literal 1100 zcmV-S1he}eiwFP!000002JKl}Z__XoPH%&8(GWavd%!#ZsVG(3tz0TH3BeFIAv8cj zyjX7ILQs-ciOW)n-@u>YU+|-V<0Q@;H|aV?HxPN~VjrJ#Y=7sRFOK)_gr;c~ty-#R zl^Qg)m4~m|oo+|d%IBcB7C)=-I|IKGv{vDH+#{AdB(|-{U-%QpA>I_jQxA}VgkA%= zr0F>zd9(d?i}x^_jw$qSxHlT;6ExbP)FAD$zAX8AcaoVbHNCUgn=a7< z!yMaFuh$z|p3k5wlD}R@Ur?UT$hLW~FjwAFkw?em(H&Fnwt=S9H(ow~$c)pfCLo+_>8-EJMSCACeoi8?JIOl^th(>)o4 z1VUMsf=nGqLzI)5n=x26B_8>U)NKs#OCp`sOh?*xwl>@t;;2Lw3 z@%X`u*IV_2?zy7u98pLltB8=)#YmglT)|NIlVX&aKg4zmdE2u4- z+G^nn6ydW4&TKpV1&&p@WpYK|>GN&3n%&G&&taCw^1{Fcc7RE)8i=<@km)J4#>gUX zQPws!Cj+Vv4FS0xfO#E_!AKv&4Dh9J6TxAz1#a6d{x>ifv20Q8d^xvJm*@1YHjG-X z#f(-1k-=c%Ol)9dgMU`+mkc^t@lbZy3O6VLxD2{*Qnj%J{7A42{5E3zI8HDvygYM& zJOl(uumDl5M2RZ*GVRnk$~*lz@i~mo%#_p13E6cvx-*wSnQZqPU!=1HD85az2vEHr z80`0K7ZKk=$1kvj;erGU5-dotAi=#!P+ZF$oaI!`IN>wmF>$y}jZoLbJ|+H09XY={ z0{JLA$PC-H6c88|C?kypw7;ROY5DYBWzNi&o{GC&hY~lu+~rEezc&8t#d;R