From 6780b530b805c3811d4a7c0eebea38a642702f4d Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 9 Oct 2023 13:23:58 +0200 Subject: [PATCH 01/50] chore: NEWS and DESCRIPTION development version v0.6.1.9000 --- DESCRIPTION | 4 ++-- NEWS | 23 +++++++++++++++++++++++ 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1be864c..b08a8b4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: OKplan Title: Tools to facilitate the Planning of the annual Surveillance Programmes -Version: 0.6.1 -Date: 2023-10-09 +Version: 0.6.1.9000 +Date: 2023-##-## Authors@R: c(person(given = "Petter", family = "Hopp", diff --git a/NEWS b/NEWS index e0dc484..aad655d 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,26 @@ +OKplan 0.6.1.9000 - (2023-##-##) +---------------------------------------- + +New features: + +- + + +Bug fixes: + +- + + +Other changes: + +- + + +BREAKING CHANGES: + +- + + OKplan 0.6.1 - (2023-10-09) ---------------------------------------- From 8aa47bc812a40da05210a827bd13de1b2f959ac2 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 9 Oct 2023 13:24:37 +0200 Subject: [PATCH 02/50] doc: removed link from help in write_ok_selection_list --- R/write_ok_selection_list.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/write_ok_selection_list.R b/R/write_ok_selection_list.R index 3d89622..9022fc1 100644 --- a/R/write_ok_selection_list.R +++ b/R/write_ok_selection_list.R @@ -41,7 +41,7 @@ #' #' All vectors must have the same order and the same length. #' -#' When \code{\link{calculate_sum}} is TRUE, a line with the sum will be appended. +#' When \code{calculate_sum} is \code{TRUE}, a line with the sum will be appended. #' The default is to calculate the sum of the column "ant_prover". If the sum #' should be calculated for one or more other columns, you may give thecolumn #' names as input to the argument \code{column} that will be passed to From 08a9e95e09645cbedf821a51c6f57b99f56c8a23 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 23 Oct 2023 07:13:47 +0200 Subject: [PATCH 03/50] style: improved NEWS v0.6.1 --- NEWS | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index aad655d..4fa3d87 100644 --- a/NEWS +++ b/NEWS @@ -26,9 +26,9 @@ OKplan 0.6.1 - (2023-10-09) Bug fixes: -- the argument `year` in `get_tested_herds` now accepts more than one year as input. +- The argument `year` in `get_tested_herds` now accepts more than one year as input. -- The argument column can now be passed to append_sum_line. +- `write_ok_selection_list` now accepts the argument `column` which will be passed to `append_sum_line`. Other changes: From c5196da5b924bac706a17c461ea80c596cf314f2 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 4 Dec 2023 09:11:10 +0100 Subject: [PATCH 04/50] chore: updated dependencies in DESCRIPTION Moved knitr, rmarkdown, and NVIrpackages from Imports to Suggests. --- DESCRIPTION | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b08a8b4..9afa6f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,26 +21,26 @@ LazyData: true Imports: checkmate, dplyr, - knitr, magrittr, openxlsx, rlang, - rmarkdown, stats, NVIbatch (>= 0.4.0), NVIcheckmate (>= 0.6.0), NVIdb (>= 0.3.0), NVIpretty (>= 0.4.0), - NVIrpackages, OKcheck Suggests: covr, desc, devtools, + knitr, + rmarkdown, testthat, usethis, utils, - NVIpackager + NVIpackager, + NVIrpackages Remotes: NorwegianVeterinaryInstitute/NVIbatch, NorwegianVeterinaryInstitute/NVIcheckmate, From 24e7a099d3452d32d0b11759d6eecd5c214fa8c6 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 4 Dec 2023 09:12:41 +0100 Subject: [PATCH 05/50] refactor: updated ignore_unused_imports Removed knitr, rmarkdown, and NVIrpackages as removed from Imports. --- R/ignore_unused_imports.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/ignore_unused_imports.R b/R/ignore_unused_imports.R index ced58e2..9fbb9dc 100644 --- a/R/ignore_unused_imports.R +++ b/R/ignore_unused_imports.R @@ -5,10 +5,6 @@ ignore_unused_imports <- function() { - # Packages needed for building vignette: "Contribute to ..." - rmarkdown::html_vignette - knitr::opts_chunk - NVIrpackages::NVIpackages # Packages needed for template: "check_ok_selection.Rmd" OKcheck::knit_table_if_data } From 2c7433cb563196ff7b1b83d3b485d4a359f4ac24 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 4 Dec 2023 09:13:55 +0100 Subject: [PATCH 06/50] doc: Corrected link in help for write_ok_selection_list --- man/write_ok_selection_list.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/write_ok_selection_list.Rd b/man/write_ok_selection_list.Rd index 583934e..1268acc 100644 --- a/man/write_ok_selection_list.Rd +++ b/man/write_ok_selection_list.Rd @@ -100,7 +100,7 @@ The list input to column_standards must follow a specific format. All vectors must have the same order and the same length. -When \code{\link{calculate_sum}} is TRUE, a line with the sum will be appended. +When \code{calculate_sum} is \code{TRUE}, a line with the sum will be appended. The default is to calculate the sum of the column "ant_prover". If the sum should be calculated for one or more other columns, you may give thecolumn names as input to the argument \code{column} that will be passed to From 915823cb80aa9d38172ba630cbdf9f10afa2d2dc Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 5 Dec 2023 07:03:21 +0100 Subject: [PATCH 07/50] feat: included draft for get_holiday --- notes/get_holiday.R | 114 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) create mode 100644 notes/get_holiday.R diff --git a/notes/get_holiday.R b/notes/get_holiday.R new file mode 100644 index 0000000..23c6d16 --- /dev/null +++ b/notes/get_holiday.R @@ -0,0 +1,114 @@ +library(dplyr) +year <- 2023 + +# date +# Date. +# +# day_of_week +# Integer. 1 = Monday, 7 = Sunday +# +# mon_to_fri +# Integer. 1 between Monday and Friday, 0 between Saturday and Sunday +# +# sat_to_sun +# Integer. 1 between Saturday and Sunday, 0 between Monday and Friday +# +# public_holiday +# Integer. 1 if public holiday (helligdag), 0 if not public holiday +# +# freeday +# Integer. 1 if public holiday (helligdag) or sat_to_sun==1, 0 otherwise +# +# workday +# Integer. 1 if freeday==0, 0 if freeday==1 + + +get_holiday <- function (year, + type = "all", + trapped_days = "exclude", + invert = FALSE) { + + ### ARGUMENT CHECKING ---- + # Object to store check-results + checks <- checkmate::makeAssertCollection() + + # Perform checks + datasource <- NVIcheckmate::match_arg(x = type, + choices = c("easter", "holiday", "workday", + "trapped", "weekend", "public", "sunday", "saturday", + "non-moveable", "pentacost"), + several.ok = FALSE, + ignore.case = TRUE, + add = checks) + + # Report check-results + checkmate::reportAssertions(checks) + + ### NATIONAL HOLIDAYS ---- + # Calculate Easter day + # reference + K <- floor(year/100) + M <- 15 + floor((3 * K + 3)/4) - floor((8 * K + 13)/25) + S <- 2 - floor((3 * K + 3)/4) + A <- year %% 19 + D <- (19*A+M) %% 30 + R <- floor((D+A/11)/29) + OG <- 21 + D - R + SZ <- 7 - ((year + floor(year/4)+S) %% 7) + OE <- 7 - ((OG-SZ) %% 7) + + easterday <- as.Date(paste0(year, "-03-01")) - 1 + OG + OE + easter <- rep(easterday, 4) + c(-3, -2, 0, 1) + pentacost <- rep(easterday, 3) + c(39, 49, 50) + non_moveable <- as.Date(paste0(year, c("-01-01", "-05-01", "-05-17", "-12-25", "-12-26"))) + + ### CATEGORISE INTO HOLIDAYS ---- + dates <- as.data.frame(matrix(data = c(as.Date(paste0(year, "-01-01")):as.Date(paste0(year, "-12-31"))), + dimnames = list(NULL, "date"))) + dates$date <- as.Date(dates$date, origin = "1970-01-01") + dates <- dates %>% + dplyr::mutate(weekday = lubridate::wday(.data$date, week_start=1)) %>% + dplyr::mutate(holiday = dplyr::case_when(.data$weekday %in% c(6, 7) ~ as.character(.data$weekday), + TRUE ~ "0" )) %>% + dplyr::mutate(holiday = dplyr::case_when(.data$date %in% easter ~ "e", + .data$date %in% pentacost ~ "p", + .data$date %in% non_moveable ~ "n", + TRUE ~ holiday)) %>% + dplyr::mutate(behind = dplyr::lag(holiday, 1)) %>% + dplyr::mutate(ahead = dplyr::lead(holiday, 1)) %>% + dplyr::mutate(holiday = dplyr::case_when(.data$ahead != 0 & .data$behind != 0 & .data$holiday == 0 ~ "t", + TRUE ~ holiday)) + + if ("easter" %in% type) { + dates[which(dates$holiday == "e") , "select"] <- 1 + } + if ("moving" %in% type) { + dates[which(dates$holiday %in% c("e", "p")) , "select"] <- 1 + } + if ("public" %in% type) { + dates[which(dates$holiday %in% c("e", "p", "n")), "select"] <- 1 + } + if ("sunday" %in% type) { + dates[which(dates$weekday == 7) , "select"] <- 1 + } + if ("saturday" %in% type) { + dates[which(dates$weekday == 6), "select"] <- 1 + } + if ("work" %in% type) { + dates[which(dates$holiday %in% c("0")), "select"] <- 1 + if (trapped_days != "exclude") {dates[which(dates$holiday %in% c("t")), "select"] <- 1} + } + if ("holiday" %in% type) { + dates[which(dates$holiday %in% c("e", "p", "n", "6", "7")) , "select"] <- 1 + } + if ("trapped" %in% type) { + dates[which(dates$holiday %in% c("t")), "select"] <- 1 + } + if ("raw" == type) { + dates[, "select"] <- 1 + } + + dates <- subset(dates, dates$select == 1) + dates <- dates[, c("date", "weekday", "holiday")] + return(dates) +} From 27868677cca6bba0226f0ed7de6be43339fec583 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 5 Dec 2023 07:05:21 +0100 Subject: [PATCH 08/50] refactor: updated generate_OK_column_standards Replaced national characters with unicode. Some styling. Updated left_join. --- data-raw/generate_OK_column_standards.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/data-raw/generate_OK_column_standards.R b/data-raw/generate_OK_column_standards.R index 7755244..01da5e8 100644 --- a/data-raw/generate_OK_column_standards.R +++ b/data-raw/generate_OK_column_standards.R @@ -18,7 +18,9 @@ library(usethis) # READS AND TRANSFORMS EXCEL SHEET WITH COLUMN STANDARD INFORMATION ---- -OK_column_standards <- read.xlsx(xlsxFile = paste0(set_dir_NVI("ProgrammeringR"), "standardization/colnames/colnames_translation_table.xlsx")) %>% +OK_column_standards <- read.xlsx(xlsxFile = file.path(set_dir_NVI("ProgrammeringR", slash = FALSE), + "standardization/colnames", + "colnames_translation_table.xlsx")) %>% # Selects only information used in OK-planning dplyr::filter(db == "OK_planlegging") %>% # Generates column labels based on label and spec for no and en @@ -27,7 +29,7 @@ OK_column_standards <- read.xlsx(xlsxFile = paste0(set_dir_NVI("ProgrammeringR") dplyr::mutate(label_1_no = dplyr::case_when(is.na(spec_no) ~ label_no, spec_no %in% c("dato", "geometrisk middel 3") ~ paste(label_no, spec_no), spec_no %in% c("kg", "kjennelse", "tid") ~ label_no, - spec_no %in% c("antall undersøkt") ~ paste(spec_no, label_no), + spec_no %in% c("antall unders\u00F8kt") ~ paste(spec_no, label_no), TRUE ~ spec_no)) %>% dplyr::mutate(label_1_en = dplyr::case_when(is.na(spec_en) ~ label_en, spec_en %in% c("date") ~ paste(label_en, spec_en), @@ -49,7 +51,7 @@ db_tables <- as.data.frame(unique(OK_column_standards$table_db)) %>% # Generate table with each table name on one line OK_column_standards <- OK_column_standards %>% - dplyr::left_join(db_tables, by = c("table_db" = "tables")) %>% + dplyr::left_join(db_tables, by = c("table_db" = "tables"), relationship = "many-to-many") %>% dplyr::mutate(table_db = trimws(table)) %>% dplyr::select(!table) %>% dplyr::mutate(table_db = tolower(table_db)) From aee73665930f745eb22d2010bb5631025d37009f Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 5 Dec 2023 07:06:27 +0100 Subject: [PATCH 09/50] refactor: Updated OK_column_standards Removed unnecessary columns from ok_plan --- data/OK_column_standards.rda | Bin 2462 -> 2339 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/data/OK_column_standards.rda b/data/OK_column_standards.rda index 831e6e7364400eec036ad0f25bb651b74ac94aaa..a231c92a7d8cfbd8656ed664f3eec3c174fc9955 100644 GIT binary patch literal 2339 zcmV+;3EcKVT4*^jL0KkKS=ypBvH&n^f8787|NeD%|NrI=-(bK0-{8Uk6951}2mn9< z;0>Q+U;{t^0Qmp_00000000Ff&l0p)iJx0ie(g217xn3Q|N61Y}JxhNDU9c`}<+{RUByGcsKMkC!9e$&`CBEp8xr@=IDw`?e4pbO0030)h^Rmn*4K*CuRL^cLxwdyVoLXKqYaC$RQzVMKqCyLSW^D0iM(W07?5| zDE-UqX4JlHs#E65Up`Af`8BAOi4zj5lSxtkmP)VE%2|;{%!JlT%t4tWGNb%hn#m7i zC0rQWBx4N0W+(o#er6vNCix%WnEw6^7en-Fy0ey1%cD+N%Pg$9<2bir$@*KiI8}}; z(#)9V#%`N8%4S^VWZ>5~3~=CP`xxSwI}(Qsp#CkN>*KvDoEw|xS1-k`o<&Qro&UG0 zoUg&tDK5N}#R8slNte8H~(~%*JG~iJ8F}i0$Cmx|m*KMfQgoOtl<8q?>S;`I z(=lrw=dLlw2C*Be*^7?Yn|1GxQMhT$({qLq#fxdf7b9YB#ca~5yZG^SavNf6D%o-7 zaOX}LMrB(!Z=OwYoE#?2TFlvtPR;plck^53I=MG>IXP#JOHN*1JqxRBbU8dr8gP9K zP8rWywV9S>@MI!?5TuzR6SLpYHZf4Q)~X6-RH61!il?X^2%(a@xW?72UEG;r-Yba1`UDOQ^^g37#c@6TyI6<1K(l z9~Mg^K*tyoC@d+U1kH0~OWb5YZ55QpHdJJ?zdr}yeGk6k;$J(D-2dL~oE!mux?#5- zI~LA8q;@DB50u&h0(o%X;#^5Pzq_rPtx^dh_Jy_I&+n zUOn#Csf@`?!oBw<{TnthpH_FP+EjDo?Oewe|6vY7_8zZc?lx_vj9AB3nqbyFPHr7v zS$7xK4o*(yB+O(vQvW~it?2m(cE*iMmyhS z;4dvXvGO`LqqAqY;S+Ihm|?J2TDzPPdCua~vG<=t=XN=|ovy}pJgpdaoorJA;u8>l zrsd3^5y?L%l{crEl+4OTWdWt9wD#3i=c=m;jtVhXzUEpPf&1$Ivfw4!^(lHAJVoq$ z@51mX@G;O2#?$o&Xe}qDaIdXTBTwgDt}fS|=H0opM#`$nk65tAD8fGrn|3iH3j%Oy z()E_rSFv@v6*giFefLdzRUW1Ve8ZC%`VL3?II6w+^1GPFnT~G^%*@Q{iO}Sy7XWie z*@SIP%R5TOGj?h|XJg=Wi}AA=RxB}y_{5KEv!Qbjo|KFRk~PIVxf_d$&c22 zDKTM8SfBE5$he-FayPKu;xXL*2KPlh$Z5!5ai=y@oqR7uedpd$)T8hy(vK^lAFUd7 zx|10vlTHn4lgWity~XucyH2M=y^TBDHbZ7o+3~f$ZiXq6bH!}CTqNHW#SQl1#-nYx zZ5}R8w7U#qv11w+VBqJOlcK{H-4BUdrR+oSQ{sB%@w^XwyTZ9d_-n*of~Tr5Ct%|H zFC?D}Z5Oz!i%tpPjYI7PjwS!pwks6De(}`*SDsbtFaHa@>3Je=RaZb>33?wWy@7rg z61_i9(jQ8{nf8I{cY~$&YxXep9t|{MhHR_uwrm^~X|op0W+kvP))Nd_6BsOMtwnH5 zBQ=^-W@`g7EXvH7Okgbyl)aww=N9eDg0-zWi1JXzUPt3>Y{W2+NsqR3S0Z9!!Hi}Y ztY$HNN$@m!ot0Muh5MHyaa7BP%&^CiHeg**Ios@+#n&gR6f zD!Gf~QpHU%v$<1DA>h~^dhu}&rO@W?ZsO#}TNbLA#%E(wqpxOvHb)QR=OrQH!mR#X^fSp<_lV3L2hyOJrw Jgof1-rI0rpZU6uP literal 2462 zcmV;P31Rj^T4*^jL0KkKS%}tjeE=}%f8787|NeD%|Ns6D-(bK0-{8Uk6951}2mn9< z;0}Hj@Cr}>1yq0v04M+`00004h6vDT(;(9jXaE2J000000000u(9xqoqd?FA0002U z0002c82|G8&B;CJB;Zpa4_Jsp@)Zl>iL%{6JjNmE{EMjEa#)40Mv!s z>vnzOU9X{eZc8B387i)u6bfSo+lu^`(&>uFmC1pZlRex5JqxG^X|GOz>MH?~`St~M8nHFV7 z{g|4`4)#j8F}6s?8G_7Tv6O2IOpTd1=J=2KV>IByckgc4;F#vkEXw_jG-Dl7hw#Zq z=h^)H`=~Ar&GWB6&91zpqtcF*=EIMEKMz?+cI2lho?dN*L1L^h#y^V{q2l>Znf4a# zns>OlI5%RKo*uD_QhGZFwDYmXU%a+?WX{~EK-36VGGM!)b z-Qe9$ey*oO7e?%NlN?=G;JY}qGoLp#IQDQ&-3kEX7fS^ytdNY7L?n=r7(pbh8Hn)U z*t=L?^XbE9itXdEr($(5TPf9rv$3Ty$4tenf8$(ZjtycrRkIdiY1^!O$2R-nZsu;> z?PgpSum}LtT#T3H}7?oox ztX2}nFvA$ESXjv_Pu-6;LaDkkqWEx45tIx@1}TcLuR`!*_gHq173zA*H1c{**A?qa z$#N*<>~7$^j^yuQRoIM|dh+@E!*G3-`|*uwG+v)^x-TzKYZ|5}$B4`fVi}c;MrJYr zAs{Irk_kykB8-d4h!lcJEWwy-BUx)Tkj!f;&1s_377~$$bqW=tdyg1%1wAK(TG7Mq ztU2SLHE&f_`a}K9I~UBnpXpK6N7qrMADF*Ts=iSiVNJro9aGXT=46+{jl6mQa?9ZN z4T``}%{NWb2ME3?wA-uzbu>*dcg=)8*;!0uWkyTus|JewykC9x-+9HvzSED{{u{P_ zMC>k3K);nb)U7WZdJTfiC<8DH*g)HTvc+8=8QVwj&$fJ!un1> zmAb07m$CCl>}l^M;5xoVJ5{fz*;j#S-22bC`%dRKS9`skk2^*l4%R7& zF^h_$5Pufs%%9kDPu1s7D}yN+RzNbDh-qWRJ<5De5o10jReNfx!lOztSHQ!rFtK92 zYS9O2SS>~1V4Fhv0nb~)gNV-*Z9Tzm;OOe|r96yuRq?d`A>Io~>|877Q_j=%F6S3} z)b_V-Z4tDpvq@r)pe!+pF%R%LxG{+sSQCRzuc1cOBi~)F`8uj@#2EX|%Jrdp7!~sl zY-8;lr9Y#ISHoV1Yr&=*-i*x5%{DD*m``6Eu_wjMfgYgC>%R%3l)ZKktq z(=s+26a}o|SXLNK9ei@UsY**ren$aF0Wcw&2w+mHxsQdp?JDA`ul0;8Vvft(UxvNP zb~-#5)4{W3Hf1fJO|A2EF-()5D`no{Cit!>Z?_IL8*RgA^tn4y?lFqRjA&iMgPvwi zmKeV9eI;}p68Dh&H2P0uv_6~A9{F<$Z<4$l3wfP7tjmwIFH*3FT@R+}+w#$sCoEnzW>B4Y)OHK?u$glRR5(M?kj z)@uVYEM&|xGZ|AD3qvYwrSv`b+7|}ua8|XaX&q=|FBj-+Y{W2+S&yu9S0u#6gBZ** zjAWR_9A}!1~gjmjc+VY}3wVISY{wx3TclykF7LHwz7#e6n^?yO_Eo7BR0@ zckr!XG2V{$)hweTykfnPy6i3j;^*=oDrGNq?Km7<&uLd<;Lw~+-58_e7p>r{((zpS zkE;0Fx~g<_Rp(OwDSv6DP6KnJ#KlZz3udvQIZF)2HhK(f*s<=Eb(2-(jlI91v;_A`ZY-VMhXwsX>vFmPL4@13rcuIQ= zOU&x)N1$4J)%Hun9!jrcX8 Date: Tue, 5 Dec 2023 07:30:23 +0100 Subject: [PATCH 10/50] chore: updated dependencies in DESCRIPTION Included purr in Suggests, used in generate_OK_column_standards --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 9afa6f8..6657dbb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,6 +35,7 @@ Suggests: desc, devtools, knitr, + purr, rmarkdown, testthat, usethis, From 4b6db7f12977290d949e3283022a217167f115b9 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 5 Dec 2023 07:32:53 +0100 Subject: [PATCH 11/50] perf: improved check_ok_selection Removed argument email = FALSE from output_rendered to make it possible to input email argument in the function. --- R/check_ok_selection.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/check_ok_selection.R b/R/check_ok_selection.R index 7803c37..12c3d60 100644 --- a/R/check_ok_selection.R +++ b/R/check_ok_selection.R @@ -108,6 +108,5 @@ check_ok_selection <- function(input = system.file('templates', "check_ok_select intermediates_dir = tempdir(), params = list("data" = data, "purpose" = purpose, "plan_aar" = plan_aar), display = display, - email = FALSE, ...) } From fa0fd3aec194ccf7dd1d7d02ef55f538c5a2c286 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 5 Dec 2023 07:33:20 +0100 Subject: [PATCH 12/50] chore: updated develop.R from template --- notes/develop.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/notes/develop.R b/notes/develop.R index 9d33ebd..4d939a0 100644 --- a/notes/develop.R +++ b/notes/develop.R @@ -95,3 +95,22 @@ utils::help(package = (pkg)) library(package = pkg, character.only = TRUE) +# MANUAL CHECK OF SCRIPTS ---- +# Search for string +txt <- "\\.data\\$" +files_with_pattern <- findInFiles::findInFiles(ext = "R", pattern = txt, output = "tibble") +files_with_pattern <- findInFiles::FIF2dataframe(files_with_pattern) +package <- rep(pkg, dim(files_with_pattern)[1]) +files_with_pattern <- cbind(package, files_with_pattern) + +wb <- openxlsx::createWorkbook() +# Replace with openxlsx::addWorksheet() +NVIpretty::add_formatted_worksheet(data = files_with_pattern, + workbook = wb, + sheet = make.names(paste0(pkg, txt))) +openxlsx::saveWorkbook(wb, + file = file.path("../", paste0(pkg, "_", "files_with_pattern.xlsx")), + overwrite = TRUE) + +# Replace all occurrences of string in scripts + From 85bc000dd6418865a894b7b10872722bb9d7acb5 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 5 Dec 2023 07:33:48 +0100 Subject: [PATCH 13/50] style: included comments in get_holiday --- notes/get_holiday.R | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index 23c6d16..c597c0b 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -36,7 +36,7 @@ get_holiday <- function (year, datasource <- NVIcheckmate::match_arg(x = type, choices = c("easter", "holiday", "workday", "trapped", "weekend", "public", "sunday", "saturday", - "non-moveable", "pentacost"), + "non-moveable", "pentacost", "all"), several.ok = FALSE, ignore.case = TRUE, add = checks) @@ -63,22 +63,29 @@ get_holiday <- function (year, non_moveable <- as.Date(paste0(year, c("-01-01", "-05-01", "-05-17", "-12-25", "-12-26"))) ### CATEGORISE INTO HOLIDAYS ---- + # create data frame with all dates for year[i] dates <- as.data.frame(matrix(data = c(as.Date(paste0(year, "-01-01")):as.Date(paste0(year, "-12-31"))), dimnames = list(NULL, "date"))) dates$date <- as.Date(dates$date, origin = "1970-01-01") + + # Assign weekday number dates <- dates %>% dplyr::mutate(weekday = lubridate::wday(.data$date, week_start=1)) %>% + + # Assign weekend dplyr::mutate(holiday = dplyr::case_when(.data$weekday %in% c(6, 7) ~ as.character(.data$weekday), TRUE ~ "0" )) %>% + # Assign public holidays dplyr::mutate(holiday = dplyr::case_when(.data$date %in% easter ~ "e", .data$date %in% pentacost ~ "p", .data$date %in% non_moveable ~ "n", TRUE ~ holiday)) %>% + # assign trapped days dplyr::mutate(behind = dplyr::lag(holiday, 1)) %>% dplyr::mutate(ahead = dplyr::lead(holiday, 1)) %>% dplyr::mutate(holiday = dplyr::case_when(.data$ahead != 0 & .data$behind != 0 & .data$holiday == 0 ~ "t", TRUE ~ holiday)) - + ### SELECT ROWS TO REPORT ---- if ("easter" %in% type) { dates[which(dates$holiday == "e") , "select"] <- 1 } @@ -104,7 +111,7 @@ get_holiday <- function (year, if ("trapped" %in% type) { dates[which(dates$holiday %in% c("t")), "select"] <- 1 } - if ("raw" == type) { + if ("all" == type) { dates[, "select"] <- 1 } From add6be0b970ae2092b5ce665569d501d44d8f529 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 5 Dec 2023 07:36:03 +0100 Subject: [PATCH 14/50] chore: updated dependencies in DESCRIPTION Included findInFiles and openxlsx in Suggests. Used in develop.R --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 6657dbb..d0814b3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,7 +34,9 @@ Suggests: covr, desc, devtools, + findInFiles, knitr, + openxlsx, purr, rmarkdown, testthat, From e4b6e402416a4f90324e693e0db45f03ad8a9c6b Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 5 Dec 2023 07:42:58 +0100 Subject: [PATCH 15/50] chore: corrected dependencies in DESCRIPTION Removed openxlsx from Suggests as in Imports. --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d0814b3..7df4668 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,6 @@ Suggests: devtools, findInFiles, knitr, - openxlsx, purr, rmarkdown, testthat, From 5200acb033f821aa903ae0f8cde664a49fc35334 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Wed, 6 Dec 2023 15:09:09 +0100 Subject: [PATCH 16/50] feat: upgraded get_holiday to running version Draft of help. Improved argument checking. Included exclusion of easter and xmas weeks. Improved user friendly input to arguments. --- notes/get_holiday.R | 170 ++++++++++++++++++++++++++++++++------------ 1 file changed, 125 insertions(+), 45 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index c597c0b..0bee36f 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -1,6 +1,43 @@ -library(dplyr) -year <- 2023 - +#' @title Get the holidays or working days +#' @description Get the holidays or working days for one year +#' +#' @details Performs common cleaning of PJSdata by removing samples that usually +#' should not be included when analyzing PJSdata. The cleaning is dependent +#' on having the following columns eier_lokalitettype, eierlokalitetnr and +#' hensiktkode. +#' +#' \code{abroad = "exclude"} will exclude samples that have eier_lokalitet +#' of type "land" and eier_lokalitetnr being different from NO. Samples +#' registered on other types than LAND are not excluded. +#' +#' \code{quality = "exclude"} will exclude all samples registered s quality +#' assurance and ring trials, i.e. hensiktkode starting with "09". +#' +#' @param year Data frame with data extracted from PJS. +#' @param type If equal "exclude", samples from abroad are excluded. Allowed +#' values are c("exclude", "include"). +#' @param exclude_trapped_days If equal "exclude", samples registered as quality assurance +#' and ring trials are excluded. Allowed values are c("exclude", "include"). +#' +#' @return data frame with selected dates. +#' +#' @author Petter Hopp Petter.Hopp@@vetinst.no +#' @export +#' @examples +#' \dontrun{ +#' +#' public_holidays <- get_holiday(year = 2024, +#' type = "public") +#' +#' workdays <- get_holiday(year = 2024, +#' type = "workday", +#' exclude_trapped_days = TRUE) +#' +#' workdays <- get_holiday(year = 2024, +#' type = "workday", +#' exclude_trapped_days = c("easter", "xmas")) +#' } +#' # date # Date. # @@ -24,22 +61,30 @@ year <- 2023 get_holiday <- function (year, - type = "all", - trapped_days = "exclude", - invert = FALSE) { + type = "all", + exclude_trapped_days = FALSE) { ### ARGUMENT CHECKING ---- # Object to store check-results checks <- checkmate::makeAssertCollection() # Perform checks - datasource <- NVIcheckmate::match_arg(x = type, - choices = c("easter", "holiday", "workday", - "trapped", "weekend", "public", "sunday", "saturday", - "non-moveable", "pentacost", "all"), - several.ok = FALSE, - ignore.case = TRUE, - add = checks) + checkmate::assert_integerish(year, + lower = 1971, + upper = as.numeric(format(Sys.Date(), "%Y")) + 5, + len = 1, + any.missing = FALSE, + all.missing = FALSE, + unique = TRUE) + type <- NVIcheckmate::match_arg(x = type, + choices = c("holiday", "public", "sunday", "saturday", + "weekend", "workday", "all"), + several.ok = FALSE, + ignore.case = TRUE, + add = checks) + checkmate::assert(checkmate::check_false(exclude_trapped_days), + checkmate::check_subset(exclude_trapped_days, choices = c("easter", "xmas", "trapped")), + add = checks) # Report check-results checkmate::reportAssertions(checks) @@ -59,41 +104,67 @@ get_holiday <- function (year, easterday <- as.Date(paste0(year, "-03-01")) - 1 + OG + OE easter <- rep(easterday, 4) + c(-3, -2, 0, 1) + easter_trapped <- rep(easterday, 3) + c(-6, -5, -4) pentacost <- rep(easterday, 3) + c(39, 49, 50) non_moveable <- as.Date(paste0(year, c("-01-01", "-05-01", "-05-17", "-12-25", "-12-26"))) + days_before_newyear <- 7 + if (as.numeric(format(as.Date(paste0(year, "-12-31")), "%u")) <= 3) { + days_before_newyear <- days_before_newyear + as.numeric(format(as.Date(paste0(year, "-12-31")), "%u")) + } + # as.Date(paste0(year, "-12-31")) - as.numeric(format(as.Date(paste0(year, "-12-31")), "%u")) + xmas_trapped <- rep(as.Date(paste0(year, "-12-31")), days_before_newyear) + c(-(days_before_newyear - 1):0) ### CATEGORISE INTO HOLIDAYS ---- # create data frame with all dates for year[i] dates <- as.data.frame(matrix(data = c(as.Date(paste0(year, "-01-01")):as.Date(paste0(year, "-12-31"))), dimnames = list(NULL, "date"))) dates$date <- as.Date(dates$date, origin = "1970-01-01") - + # Assign weekday number - dates <- dates %>% - dplyr::mutate(weekday = lubridate::wday(.data$date, week_start=1)) %>% - - # Assign weekend - dplyr::mutate(holiday = dplyr::case_when(.data$weekday %in% c(6, 7) ~ as.character(.data$weekday), - TRUE ~ "0" )) %>% - # Assign public holidays - dplyr::mutate(holiday = dplyr::case_when(.data$date %in% easter ~ "e", - .data$date %in% pentacost ~ "p", - .data$date %in% non_moveable ~ "n", - TRUE ~ holiday)) %>% - # assign trapped days - dplyr::mutate(behind = dplyr::lag(holiday, 1)) %>% - dplyr::mutate(ahead = dplyr::lead(holiday, 1)) %>% - dplyr::mutate(holiday = dplyr::case_when(.data$ahead != 0 & .data$behind != 0 & .data$holiday == 0 ~ "t", - TRUE ~ holiday)) - ### SELECT ROWS TO REPORT ---- - if ("easter" %in% type) { - dates[which(dates$holiday == "e") , "select"] <- 1 + dates$weekday <- format(dates$date, format = "%u") + + # Assign weekend + dates$weekend <- "0" + dates[which(dates$weekday %in% c("6", "7")), "weekend"] <- "1" + + # Assign public holidays + dates$public <- "0" + dates[which(dates$date %in% easter), "public"] <- "e" + dates[which(dates$date %in% pentacost), "public"] <- "p" + dates[which(dates$date %in% non_moveable), "public"] <- "n" + + # Assign holidays + dates$holiday <- "0" + dates[which(dates$weekend == "1" | dates$public != "0"), "holiday"] <- "1" + + # Assign workday + dates$workday <- +(!as.numeric(dates$holiday)) + + # assign trapped days + dates$trapped <- "0" + if ("easter" %in% exclude_trapped_days) { + dates[which(dates$date %in% easter_trapped), "trapped"] <- "e" } - if ("moving" %in% type) { - dates[which(dates$holiday %in% c("e", "p")) , "select"] <- 1 + if ("xmas" %in% exclude_trapped_days) { + dates[which(dates$date %in% xmas_trapped), "trapped"] <- "x" + } + + if ("trapped" %in% exclude_trapped_days) { + dates$behind <- c(NA, dates[c(1:(length(dates$holiday) - 1)), "holiday"]) + dates$ahead <- c(dates[c(2:length(dates$holiday)), "holiday"], "1") + dates[which(dates$ahead == "1" & dates$behind == "1" & dates$holiday == "0" ), "trapped"] <- "t" + dates[, c("behind", "ahead")] <- c(NULL, NULL) } + + ### SELECT ROWS TO REPORT ---- + # if ("easter" %in% type) { + # dates[which(dates$holiday == "e") , "select"] <- 1 + # } + # if ("moving" %in% type) { + # dates[which(dates$holiday %in% c("e", "p")) , "select"] <- 1 + # } if ("public" %in% type) { - dates[which(dates$holiday %in% c("e", "p", "n")), "select"] <- 1 + dates[which(dates$public %in% c("e", "p", "n")), "select"] <- 1 } if ("sunday" %in% type) { dates[which(dates$weekday == 7) , "select"] <- 1 @@ -101,21 +172,30 @@ get_holiday <- function (year, if ("saturday" %in% type) { dates[which(dates$weekday == 6), "select"] <- 1 } - if ("work" %in% type) { - dates[which(dates$holiday %in% c("0")), "select"] <- 1 - if (trapped_days != "exclude") {dates[which(dates$holiday %in% c("t")), "select"] <- 1} + if ("weekend" %in% type) { + dates[which(dates$weekend == 1), "select"] <- 1 } if ("holiday" %in% type) { dates[which(dates$holiday %in% c("e", "p", "n", "6", "7")) , "select"] <- 1 } - if ("trapped" %in% type) { - dates[which(dates$holiday %in% c("t")), "select"] <- 1 + if ("workday" %in% type) { + dates[which(dates$workday %in% c("1")), "select"] <- 1 + if ("easter" %in% exclude_trapped_days) { + dates[which(dates$trapped == "e"), "select"] <- 0 + } + if ("xmas" %in% exclude_trapped_days) { + dates[which(dates$trapped == "x"), "select"] <- 0 + } + + if ("trapped" %in% exclude_trapped_days | isTRUE(exclude_trapped_days)) { + dates[which(dates$trapped == "t"), "select"] <- 0 + } } - if ("all" == type) { - dates[, "select"] <- 1 + + if (!"all" %in% type) { + dates <- subset(dates, dates$select == 1) + dates <- dates[, c("date", "weekday", type)] } - dates <- subset(dates, dates$select == 1) - dates <- dates[, c("date", "weekday", "holiday")] return(dates) } From 6ca4f4abe365c67000cf59a291b3c6c2810c7191 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Thu, 7 Dec 2023 15:27:08 +0100 Subject: [PATCH 17/50] doc: improved help get_holiday --- notes/get_holiday.R | 47 ++++++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index 0bee36f..51c61fb 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -1,23 +1,26 @@ -#' @title Get the holidays or working days -#' @description Get the holidays or working days for one year +#' @title Get the holidays or working days +#' @description Get the holidays or working days within one year. The function is used when planning sampling to excluded days or weeks from the sampling plan. #' -#' @details Performs common cleaning of PJSdata by removing samples that usually -#' should not be included when analyzing PJSdata. The cleaning is dependent -#' on having the following columns eier_lokalitettype, eierlokalitetnr and -#' hensiktkode. -#' -#' \code{abroad = "exclude"} will exclude samples that have eier_lokalitet -#' of type "land" and eier_lokalitetnr being different from NO. Samples -#' registered on other types than LAND are not excluded. -#' -#' \code{quality = "exclude"} will exclude all samples registered s quality -#' assurance and ring trials, i.e. hensiktkode starting with "09". +#' @details One may select the following categories within one year. The categories are given as input to \code{type}. +#' \tabular{lll}{ +#' \strong{input} \tab \strong{selection \tab \strong{remark} \cr +#' holiday \tab Saturday, Sunday and public holidays \tab \cr +#' saturday \tab Saturdays \tab \tab \cr +#' sunday \tab Sundays \tab \cr +#' weekend \tab Saturday and Sundays \tab \cr +#' public \tab Public holidays \tab e = easter, x = xmas, and n = non-moveable public holiday. \cr +#' workday \tab working day \tab the opposite of holiday when \code{exclude_trapped_days} = \code{FALSE} \cr +#' trapped \tab trapped days, easter week days and/or xmas week days \tab only output when \code{type} = "raw" \cr +#' } +#' #' -#' @param year Data frame with data extracted from PJS. -#' @param type If equal "exclude", samples from abroad are excluded. Allowed -#' values are c("exclude", "include"). -#' @param exclude_trapped_days If equal "exclude", samples registered as quality assurance -#' and ring trials are excluded. Allowed values are c("exclude", "include"). +#' @param year [\code{integer(1)}]\cr +#' Year. +#' @param type [\code{character}]\cr +#' The type of holiday or workday, see details.. +#' @param exclude_trapped_days [\code{character} | \code{logical(1)}]\cr +#' Should trapped days be excluded from workdays. Can be specified, see details. +#' Defaults to \code{FALSE}. #' #' @return data frame with selected dates. #' @@ -37,7 +40,7 @@ #' type = "workday", #' exclude_trapped_days = c("easter", "xmas")) #' } -#' + # date # Date. # @@ -61,7 +64,7 @@ get_holiday <- function (year, - type = "all", + type = "raw", exclude_trapped_days = FALSE) { ### ARGUMENT CHECKING ---- @@ -78,7 +81,7 @@ get_holiday <- function (year, unique = TRUE) type <- NVIcheckmate::match_arg(x = type, choices = c("holiday", "public", "sunday", "saturday", - "weekend", "workday", "all"), + "weekend", "workday", "raw"), several.ok = FALSE, ignore.case = TRUE, add = checks) @@ -192,7 +195,7 @@ get_holiday <- function (year, } } - if (!"all" %in% type) { + if (!"raw" %in% type) { dates <- subset(dates, dates$select == 1) dates <- dates[, c("date", "weekday", type)] } From 2214e336210da9c6fcf569533d1e93386642c866 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 8 Dec 2023 08:09:48 +0100 Subject: [PATCH 18/50] refactor: changed get_holiday Improved help. Made the function more similar to the data table in fhiverse. --- notes/get_holiday.R | 93 +++++++++++++++++++++++++-------------------- 1 file changed, 51 insertions(+), 42 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index 51c61fb..a81178b 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -1,28 +1,49 @@ #' @title Get the holidays or working days -#' @description Get the holidays or working days within one year. The function is used when planning sampling to excluded days or weeks from the sampling plan. +#' @description Get the holidays or working days within one year. The +#' function is used when planning sampling to excluded days or +#' weeks from the sampling plan. #' -#' @details One may select the following categories within one year. The categories are given as input to \code{type}. -#' \tabular{lll}{ -#' \strong{input} \tab \strong{selection \tab \strong{remark} \cr -#' holiday \tab Saturday, Sunday and public holidays \tab \cr -#' saturday \tab Saturdays \tab \tab \cr -#' sunday \tab Sundays \tab \cr -#' weekend \tab Saturday and Sundays \tab \cr -#' public \tab Public holidays \tab e = easter, x = xmas, and n = non-moveable public holiday. \cr -#' workday \tab working day \tab the opposite of holiday when \code{exclude_trapped_days} = \code{FALSE} \cr -#' trapped \tab trapped days, easter week days and/or xmas week days \tab only output when \code{type} = "raw" \cr +#' @details One may select the type of holiday or workday and input +#' to \code{type} are c("holiday", "public_holiday", "weekend", +#' "workday", "raw"). The output is a +#' data frame with date, weekday number and the input type. If +#' \code{type} = "raw", columns for all types and in addition +#' "trapped" is output. +#' +#' The output data frame has the following columns: +#' \tabular{ll}{ +#' \strong{Column name} \tab \strong{Values} \cr +#' date \tab Date. \cr +#' day_of_week \tab week day number, Monday = 1, Sunday = 7. +#' weekend \tab Saturday (6) and Sunday (7). \cr +#' public_holiday \tab Public holidays ("e", "p", "n") ("Easter", "Pentacost", "non-moveable"). \cr +#' holiday \tab Saturday (6), Sunday (7) and public holidays ("e", "p", "n"). \cr +#' workday \tab working day, the opposite of holiday when \code{exclude_trapped_days} = \code{FALSE}. \cr +#' trapped \tab trapped days (t), Easter week days (e) and/or Xmas week days (x). \cr #' } #' +#' \code{exclude_trapped_days} is used to exclude trapped and +#' days that many often takes a day off from workdays. It +#' has no effect on the other types. Input "trapped" will +#' exclude trapped days, "easter" will exclude Monday to +#' Wednesday before Thursday and "xmas" will exclude the +#' days in the week of Christmas eve until New years eve. +#' +#' The function is limited to years from 1968, as before 1968 +#' Saturday was a normal working day. #' #' @param year [\code{integer(1)}]\cr #' Year. #' @param type [\code{character}]\cr #' The type of holiday or workday, see details.. #' @param exclude_trapped_days [\code{character} | \code{logical(1)}]\cr -#' Should trapped days be excluded from workdays. Can be specified, see details. -#' Defaults to \code{FALSE}. +#' Should trapped days and common days off be excluded from workdays, +#' see details. Defaults to \code{FALSE}. +#' @param fhi [\code{logical(1)}]\cr +#' If \code{TRUE} a data frame in the format of +#' in the packages fhidata, spldata and csdata is output. #' -#' @return data frame with selected dates. +#' @return data frame with the selected dates. #' #' @author Petter Hopp Petter.Hopp@@vetinst.no #' @export @@ -30,7 +51,7 @@ #' \dontrun{ #' #' public_holidays <- get_holiday(year = 2024, -#' type = "public") +#' type = "public_holiday") #' #' workdays <- get_holiday(year = 2024, #' type = "workday", @@ -73,19 +94,18 @@ get_holiday <- function (year, # Perform checks checkmate::assert_integerish(year, - lower = 1971, - upper = as.numeric(format(Sys.Date(), "%Y")) + 5, + lower = 1968, len = 1, any.missing = FALSE, all.missing = FALSE, unique = TRUE) type <- NVIcheckmate::match_arg(x = type, - choices = c("holiday", "public", "sunday", "saturday", + choices = c("holiday", "public_holiday", "weekend", "workday", "raw"), several.ok = FALSE, ignore.case = TRUE, add = checks) - checkmate::assert(checkmate::check_false(exclude_trapped_days), + checkmate::assert(checkmate::check_flag(exclude_trapped_days), checkmate::check_subset(exclude_trapped_days, choices = c("easter", "xmas", "trapped")), add = checks) @@ -117,6 +137,7 @@ get_holiday <- function (year, # as.Date(paste0(year, "-12-31")) - as.numeric(format(as.Date(paste0(year, "-12-31")), "%u")) xmas_trapped <- rep(as.Date(paste0(year, "-12-31")), days_before_newyear) + c(-(days_before_newyear - 1):0) + ### CATEGORISE INTO HOLIDAYS ---- # create data frame with all dates for year[i] dates <- as.data.frame(matrix(data = c(as.Date(paste0(year, "-01-01")):as.Date(paste0(year, "-12-31"))), @@ -124,26 +145,26 @@ get_holiday <- function (year, dates$date <- as.Date(dates$date, origin = "1970-01-01") # Assign weekday number - dates$weekday <- format(dates$date, format = "%u") + dates$day_of_week <- format(dates$date, format = "%u") # Assign weekend dates$weekend <- "0" dates[which(dates$weekday %in% c("6", "7")), "weekend"] <- "1" # Assign public holidays - dates$public <- "0" - dates[which(dates$date %in% easter), "public"] <- "e" - dates[which(dates$date %in% pentacost), "public"] <- "p" - dates[which(dates$date %in% non_moveable), "public"] <- "n" + dates$public_holiday <- "0" + dates[which(dates$date %in% easter), "public_holiday"] <- "e" + dates[which(dates$date %in% pentacost), "public_holiday"] <- "p" + dates[which(dates$date %in% non_moveable), "public_holiday"] <- "n" # Assign holidays dates$holiday <- "0" - dates[which(dates$weekend == "1" | dates$public != "0"), "holiday"] <- "1" + dates[which(dates$weekend == "1" | dates$public_holiday != "0"), "holiday"] <- "1" # Assign workday dates$workday <- +(!as.numeric(dates$holiday)) - # assign trapped days + # Assign trapped days dates$trapped <- "0" if ("easter" %in% exclude_trapped_days) { dates[which(dates$date %in% easter_trapped), "trapped"] <- "e" @@ -158,26 +179,14 @@ get_holiday <- function (year, dates[which(dates$ahead == "1" & dates$behind == "1" & dates$holiday == "0" ), "trapped"] <- "t" dates[, c("behind", "ahead")] <- c(NULL, NULL) } - + ### SELECT ROWS TO REPORT ---- - # if ("easter" %in% type) { - # dates[which(dates$holiday == "e") , "select"] <- 1 - # } - # if ("moving" %in% type) { - # dates[which(dates$holiday %in% c("e", "p")) , "select"] <- 1 - # } - if ("public" %in% type) { - dates[which(dates$public %in% c("e", "p", "n")), "select"] <- 1 - } - if ("sunday" %in% type) { - dates[which(dates$weekday == 7) , "select"] <- 1 - } - if ("saturday" %in% type) { - dates[which(dates$weekday == 6), "select"] <- 1 - } if ("weekend" %in% type) { dates[which(dates$weekend == 1), "select"] <- 1 } + if ("public_holiday" %in% type) { + dates[which(dates$public_holiday %in% c("e", "p", "n")), "select"] <- 1 + } if ("holiday" %in% type) { dates[which(dates$holiday %in% c("e", "p", "n", "6", "7")) , "select"] <- 1 } From 81bcfb2d99f3d71f960fb5a06431ddfdb5f78b2a Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 8 Dec 2023 08:15:18 +0100 Subject: [PATCH 19/50] feat: improved get_holiday Prepared for making different output formats of the data frame. --- notes/get_holiday.R | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index a81178b..72a71b0 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -39,9 +39,9 @@ #' @param exclude_trapped_days [\code{character} | \code{logical(1)}]\cr #' Should trapped days and common days off be excluded from workdays, #' see details. Defaults to \code{FALSE}. -#' @param fhi [\code{logical(1)}]\cr -#' If \code{TRUE} a data frame in the format of -#' in the packages fhidata, spldata and csdata is output. +#' @param output [\code{character(1)}]\cr +#' The output format of the data frame, see details. Defaults +#' to "selected". #' #' @return data frame with the selected dates. #' @@ -85,8 +85,9 @@ get_holiday <- function (year, - type = "raw", - exclude_trapped_days = FALSE) { + type = "workday", + exclude_trapped_days = FALSE, + output = "selected") { ### ARGUMENT CHECKING ---- # Object to store check-results @@ -101,13 +102,18 @@ get_holiday <- function (year, unique = TRUE) type <- NVIcheckmate::match_arg(x = type, choices = c("holiday", "public_holiday", - "weekend", "workday", "raw"), + "weekend", "workday"), several.ok = FALSE, ignore.case = TRUE, add = checks) checkmate::assert(checkmate::check_flag(exclude_trapped_days), checkmate::check_subset(exclude_trapped_days, choices = c("easter", "xmas", "trapped")), add = checks) + output <- NVIcheckmate::match_arg(x = output, + choices = c("selected", "fhi", "raw"), + several.ok = FALSE, + ignore.case = TRUE, + add = checks) # Report check-results checkmate::reportAssertions(checks) From 5ce08b039d09bc8ecaf8f59d4cbb89493c311352 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 8 Dec 2023 14:51:57 +0100 Subject: [PATCH 20/50] perf: improved get_holiday Standardised towards fhi table. --- notes/get_holiday.R | 129 +++++++++++++++++++++++--------------------- 1 file changed, 69 insertions(+), 60 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index 72a71b0..9084e7d 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -1,33 +1,45 @@ #' @title Get the holidays or working days #' @description Get the holidays or working days within one year. The -#' function is used when planning sampling to excluded days or -#' weeks from the sampling plan. +#' function is used when planning sampling to excluded days or +#' weeks from the sampling plan. #' #' @details One may select the type of holiday or workday and input -#' to \code{type} are c("holiday", "public_holiday", "weekend", -#' "workday", "raw"). The output is a -#' data frame with date, weekday number and the input type. If -#' \code{type} = "raw", columns for all types and in addition -#' "trapped" is output. +#' to \code{type} are c("holiday", "weekend", "public_holiday", +#' "workday"). public_holiday are the non-moveable holidays, +#' Easter and Pentacost, weekend are Saturdays and Sundays, and +#' holiday are public_holiday and weekend combined. workday is +#' the opposite of holiday when \code{exclude_trapped_days} = +#' \code{FALSE}. #' -#' The output data frame has the following columns: +#' \code{exclude_trapped_days} is used to exclude trapped and +#' days that many often takes a day off from workdays. It +#' has no effect on the other types. Input "trapped" will +#' exclude trapped days, "easter" will exclude Monday to +#' Wednesday before Thursday and "xmas" will exclude the +#' days in the week of Christmas eve until New years eve. +#' +#' The output is a data frame with the selected dates and the +#' day_of_week (number) when \code{output} = "selected". When +#' \code{output} = "raw" the data frame includes all dates and +#' the additional columns c("holiday", "weekend", "public_holiday", +#' "workday", "trapped" and "public"), see below for description. +#' +#' The output data frame for \code{output} = "raw": #' \tabular{ll}{ #' \strong{Column name} \tab \strong{Values} \cr #' date \tab Date. \cr #' day_of_week \tab week day number, Monday = 1, Sunday = 7. -#' weekend \tab Saturday (6) and Sunday (7). \cr -#' public_holiday \tab Public holidays ("e", "p", "n") ("Easter", "Pentacost", "non-moveable"). \cr -#' holiday \tab Saturday (6), Sunday (7) and public holidays ("e", "p", "n"). \cr +#' weekend \tab Saturday and Sunday = 1, otherwise 0. \cr +#' public_holiday \tab Public holidays = 1 otherwise = 0. \cr +#' holiday \tab Saturday, Sunday and public holidays = 1, otherwise = 0. \cr #' workday \tab working day, the opposite of holiday when \code{exclude_trapped_days} = \code{FALSE}. \cr -#' trapped \tab trapped days (t), Easter week days (e) and/or Xmas week days (x). \cr +#' public \tab Easter = "e", Pentacost = "p", non-moveable = "n", otherwise NA. +#' trapped \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr #' } #' -#' \code{exclude_trapped_days} is used to exclude trapped and -#' days that many often takes a day off from workdays. It -#' has no effect on the other types. Input "trapped" will -#' exclude trapped days, "easter" will exclude Monday to -#' Wednesday before Thursday and "xmas" will exclude the -#' days in the week of Christmas eve until New years eve. +#' When \code{output} = "fhi" the data frame is formatted as +#' the table xxxxx in the packages fhidata, spldata and csdata +#' created by National Public Health Institute (FHI). #' #' The function is limited to years from 1968, as before 1968 #' Saturday was a normal working day. @@ -35,7 +47,7 @@ #' @param year [\code{integer(1)}]\cr #' Year. #' @param type [\code{character}]\cr -#' The type of holiday or workday, see details.. +#' The type of holiday or workday, see details.Defaults to "workday". #' @param exclude_trapped_days [\code{character} | \code{logical(1)}]\cr #' Should trapped days and common days off be excluded from workdays, #' see details. Defaults to \code{FALSE}. @@ -62,28 +74,6 @@ #' exclude_trapped_days = c("easter", "xmas")) #' } -# date -# Date. -# -# day_of_week -# Integer. 1 = Monday, 7 = Sunday -# -# mon_to_fri -# Integer. 1 between Monday and Friday, 0 between Saturday and Sunday -# -# sat_to_sun -# Integer. 1 between Saturday and Sunday, 0 between Monday and Friday -# -# public_holiday -# Integer. 1 if public holiday (helligdag), 0 if not public holiday -# -# freeday -# Integer. 1 if public holiday (helligdag) or sat_to_sun==1, 0 otherwise -# -# workday -# Integer. 1 if freeday==0, 0 if freeday==1 - - get_holiday <- function (year, type = "workday", exclude_trapped_days = FALSE, @@ -107,10 +97,10 @@ get_holiday <- function (year, ignore.case = TRUE, add = checks) checkmate::assert(checkmate::check_flag(exclude_trapped_days), - checkmate::check_subset(exclude_trapped_days, choices = c("easter", "xmas", "trapped")), + checkmate::check_subset(exclude_trapped_days, choices = c("easter", "trapped", "xmas")), add = checks) output <- NVIcheckmate::match_arg(x = output, - choices = c("selected", "fhi", "raw"), + choices = c("fhi", "raw", "selected"), several.ok = FALSE, ignore.case = TRUE, add = checks) @@ -151,27 +141,30 @@ get_holiday <- function (year, dates$date <- as.Date(dates$date, origin = "1970-01-01") # Assign weekday number - dates$day_of_week <- format(dates$date, format = "%u") + dates$day_of_week <- as.numeric(format(dates$date, format = "%u")) # Assign weekend - dates$weekend <- "0" - dates[which(dates$weekday %in% c("6", "7")), "weekend"] <- "1" + dates$weekend <- 0 + dates[which(dates$day_of_week %in% c(6, 7)), "weekend"] <- 1 # Assign public holidays - dates$public_holiday <- "0" - dates[which(dates$date %in% easter), "public_holiday"] <- "e" - dates[which(dates$date %in% pentacost), "public_holiday"] <- "p" - dates[which(dates$date %in% non_moveable), "public_holiday"] <- "n" + dates$public <- NA_character_ + dates[which(dates$date %in% easter), "public"] <- "e" + dates[which(dates$date %in% pentacost), "public"] <- "p" + dates[which(dates$date %in% non_moveable), "public"] <- "n" + + dates$public_holiday <- 0 + dates[!is.na(dates$public), "public_holiday"] <- 1 # Assign holidays - dates$holiday <- "0" - dates[which(dates$weekend == "1" | dates$public_holiday != "0"), "holiday"] <- "1" + dates$holiday <- 0 + dates[which(dates$weekend == 1 | dates$public_holiday == 1), "holiday"] <- 1 # Assign workday - dates$workday <- +(!as.numeric(dates$holiday)) + dates$workday <- +(!dates$holiday) # Assign trapped days - dates$trapped <- "0" + dates$trapped <- NA if ("easter" %in% exclude_trapped_days) { dates[which(dates$date %in% easter_trapped), "trapped"] <- "e" } @@ -187,17 +180,18 @@ get_holiday <- function (year, } ### SELECT ROWS TO REPORT ---- + if (output == "selected") { if ("weekend" %in% type) { dates[which(dates$weekend == 1), "select"] <- 1 } if ("public_holiday" %in% type) { - dates[which(dates$public_holiday %in% c("e", "p", "n")), "select"] <- 1 + dates[which(dates$public_holiday == 1), "select"] <- 1 } if ("holiday" %in% type) { - dates[which(dates$holiday %in% c("e", "p", "n", "6", "7")) , "select"] <- 1 + dates[which(dates$holiday == 1) , "select"] <- 1 } if ("workday" %in% type) { - dates[which(dates$workday %in% c("1")), "select"] <- 1 + dates[which(dates$workday == 1), "select"] <- 1 if ("easter" %in% exclude_trapped_days) { dates[which(dates$trapped == "e"), "select"] <- 0 } @@ -209,10 +203,25 @@ get_holiday <- function (year, dates[which(dates$trapped == "t"), "select"] <- 0 } } - - if (!"raw" %in% type) { dates <- subset(dates, dates$select == 1) - dates <- dates[, c("date", "weekday", type)] + dates <- dates[, c("date", "day_of_week")] + } + + if (output == "raw") { + dates <- dates[, c("date", "day_of_week", "weekend", "public_holiday", + "holiday", "workday", "public", "trapped")] + } + + if (output == "fhi") { + dates$mon_to_fri <- 0 + dates[which(dates$day_of_week <= 5), "mon_to_fri"] <- 1 + + dates <- dates[, c("date", "day_of_week", "mon_to_fri", "weekend", "public_holiday", + "holiday", "workday")] + + # sat_to_sun + # freeday + } return(dates) From 00778c64cef373c65f37866f83b352dab790aafa Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 11 Dec 2023 07:55:51 +0100 Subject: [PATCH 21/50] refactor: improved get_holiday Improved help. Changed weekend to sat_to_sun as in fhi-tables. --- notes/get_holiday.R | 91 +++++++++++++++++++++++---------------------- 1 file changed, 46 insertions(+), 45 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index 9084e7d..542aa0d 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -1,55 +1,59 @@ #' @title Get the holidays or working days -#' @description Get the holidays or working days within one year. The -#' function is used when planning sampling to excluded days or -#' weeks from the sampling plan. +#' @description Get the holidays or working days within one year. +#' The function is intended for use when planning sampling to +#' excluded days or weeks from the sampling plan. #' -#' @details One may select the type of holiday or workday and input -#' to \code{type} are c("holiday", "weekend", "public_holiday", +#' @details \code{type} is used to select the type of holiday or +#' workday. Valid input are c("holiday", "sat_to_sun", "public_holiday", #' "workday"). public_holiday are the non-moveable holidays, -#' Easter and Pentacost, weekend are Saturdays and Sundays, and -#' holiday are public_holiday and weekend combined. workday is +#' Easter and Pentacost; sat_to_sun are Saturdays and Sundays; and +#' holiday are public_holiday and sat_to_sun combined. workday is #' the opposite of holiday when \code{exclude_trapped_days} = #' \code{FALSE}. #' -#' \code{exclude_trapped_days} is used to exclude trapped and -#' days that many often takes a day off from workdays. It -#' has no effect on the other types. Input "trapped" will -#' exclude trapped days, "easter" will exclude Monday to -#' Wednesday before Thursday and "xmas" will exclude the -#' days in the week of Christmas eve until New years eve. +#' \code{exclude_trapped_days} is used to exclude trapped days +#' and other days that many often takes a day off, i.e. the +#' Easter week and the Christmas week. It is only Valid for +#' workday and has no effect on the other types. Input +#' "trapped" or \code{TRUE} will exclude trapped days, +#' "easter" will exclude Monday to Wednesday before Thursday +#' and "xmas" will exclude the days in the week of Christmas +#' eve until New years eve. #' #' The output is a data frame with the selected dates and the -#' day_of_week (number) when \code{output} = "selected". When +#' day_of_week (integer) when \code{output} = "selected". When #' \code{output} = "raw" the data frame includes all dates and -#' the additional columns c("holiday", "weekend", "public_holiday", +#' the additional columns c("holiday", "sat_to_sun", "public_holiday", #' "workday", "trapped" and "public"), see below for description. #' #' The output data frame for \code{output} = "raw": #' \tabular{ll}{ #' \strong{Column name} \tab \strong{Values} \cr #' date \tab Date. \cr -#' day_of_week \tab week day number, Monday = 1, Sunday = 7. -#' weekend \tab Saturday and Sunday = 1, otherwise 0. \cr +#' day_of_week \tab Week day number, Monday = 1, Sunday = 7. +#' sat_to_sun \tab Saturday and Sunday = 1, otherwise 0. \cr #' public_holiday \tab Public holidays = 1 otherwise = 0. \cr #' holiday \tab Saturday, Sunday and public holidays = 1, otherwise = 0. \cr -#' workday \tab working day, the opposite of holiday when \code{exclude_trapped_days} = \code{FALSE}. \cr +#' workday \tab Working day, the opposite of holiday when \code{exclude_trapped_days} = \code{FALSE}. \cr #' public \tab Easter = "e", Pentacost = "p", non-moveable = "n", otherwise NA. #' trapped \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr #' } #' -#' When \code{output} = "fhi" the data frame is formatted as -#' the table xxxxx in the packages fhidata, spldata and csdata +#' When \code{output} %in% c("fhi", "cstime") the data frame is +#' formatted as the table cstime::nor_workdays_by_date #' created by National Public Health Institute (FHI). #' #' The function is limited to years from 1968, as before 1968 -#' Saturday was a normal working day. +#' Saturday was a normal working day in Norway. Be aware that +#' Saturday was a normal school day in Norway until and including +#' 1972. #' #' @param year [\code{integer(1)}]\cr #' Year. #' @param type [\code{character}]\cr -#' The type of holiday or workday, see details.Defaults to "workday". +#' The type(s) of holiday or workday, see details. Defaults to "workday". #' @param exclude_trapped_days [\code{character} | \code{logical(1)}]\cr -#' Should trapped days and common days off be excluded from workdays, +#' Should trapped days and common days off be excluded from workday?, #' see details. Defaults to \code{FALSE}. #' @param output [\code{character(1)}]\cr #' The output format of the data frame, see details. Defaults @@ -60,19 +64,21 @@ #' @author Petter Hopp Petter.Hopp@@vetinst.no #' @export #' @examples -#' \dontrun{ -#' +#' # Selects the public holidays #' public_holidays <- get_holiday(year = 2024, #' type = "public_holiday") -#' +#' +#' # Selects workdays except the trapped days #' workdays <- get_holiday(year = 2024, #' type = "workday", #' exclude_trapped_days = TRUE) #' +#' # Selects workdays except days in Easter and Christmas week #' workdays <- get_holiday(year = 2024, #' type = "workday", #' exclude_trapped_days = c("easter", "xmas")) -#' } +#' + get_holiday <- function (year, type = "workday", @@ -92,7 +98,7 @@ get_holiday <- function (year, unique = TRUE) type <- NVIcheckmate::match_arg(x = type, choices = c("holiday", "public_holiday", - "weekend", "workday"), + "sat_to_sun", "workday"), several.ok = FALSE, ignore.case = TRUE, add = checks) @@ -100,7 +106,7 @@ get_holiday <- function (year, checkmate::check_subset(exclude_trapped_days, choices = c("easter", "trapped", "xmas")), add = checks) output <- NVIcheckmate::match_arg(x = output, - choices = c("fhi", "raw", "selected"), + choices = c("cstime", "fhi", "raw", "selected"), several.ok = FALSE, ignore.case = TRUE, add = checks) @@ -143,9 +149,9 @@ get_holiday <- function (year, # Assign weekday number dates$day_of_week <- as.numeric(format(dates$date, format = "%u")) - # Assign weekend - dates$weekend <- 0 - dates[which(dates$day_of_week %in% c(6, 7)), "weekend"] <- 1 + # Assign sat_to_sun + dates$sat_to_sun <- 0 + dates[which(dates$day_of_week %in% c(6, 7)), "sat_to_sun"] <- 1 # Assign public holidays dates$public <- NA_character_ @@ -158,7 +164,7 @@ get_holiday <- function (year, # Assign holidays dates$holiday <- 0 - dates[which(dates$weekend == 1 | dates$public_holiday == 1), "holiday"] <- 1 + dates[which(dates$sat_to_sun == 1 | dates$public_holiday == 1), "holiday"] <- 1 # Assign workday dates$workday <- +(!dates$holiday) @@ -181,8 +187,8 @@ get_holiday <- function (year, ### SELECT ROWS TO REPORT ---- if (output == "selected") { - if ("weekend" %in% type) { - dates[which(dates$weekend == 1), "select"] <- 1 + if ("sat_to_sun" %in% type) { + dates[which(dates$sat_to_sun == 1), "select"] <- 1 } if ("public_holiday" %in% type) { dates[which(dates$public_holiday == 1), "select"] <- 1 @@ -208,20 +214,15 @@ get_holiday <- function (year, } if (output == "raw") { - dates <- dates[, c("date", "day_of_week", "weekend", "public_holiday", + dates <- dates[, c("date", "day_of_week", "sat_to_sun", "public_holiday", "holiday", "workday", "public", "trapped")] } - if (output == "fhi") { - dates$mon_to_fri <- 0 - dates[which(dates$day_of_week <= 5), "mon_to_fri"] <- 1 - - dates <- dates[, c("date", "day_of_week", "mon_to_fri", "weekend", "public_holiday", + if (output %in% c("fhi", "cstime")) { + dates$mon_to_fri <- +(!dates$sat_to_sun) + dates <- dates[, c("date", "day_of_week", "mon_to_fri", "sat_to_sun", "public_holiday", "holiday", "workday")] - - # sat_to_sun - # freeday - + colnames(dates)[6] <- "freeday" } return(dates) From bce460197dc8687d091e2c4359f74b0316fdc651 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 11 Dec 2023 12:59:27 +0100 Subject: [PATCH 22/50] refactor: updated get_holiday Used the expression non_workday instead of holiday. --- notes/get_holiday.R | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index 542aa0d..6f4a798 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -1,14 +1,14 @@ #' @title Get the holidays or working days -#' @description Get the holidays or working days within one year. +#' @description Get the non_workdays or working days within one year. #' The function is intended for use when planning sampling to #' excluded days or weeks from the sampling plan. #' -#' @details \code{type} is used to select the type of holiday or -#' workday. Valid input are c("holiday", "sat_to_sun", "public_holiday", +#' @details \code{type} is used to select the type of non_workday or +#' workday. Valid input are c("non_workday", "sat_to_sun", "public_holiday", #' "workday"). public_holiday are the non-moveable holidays, #' Easter and Pentacost; sat_to_sun are Saturdays and Sundays; and -#' holiday are public_holiday and sat_to_sun combined. workday is -#' the opposite of holiday when \code{exclude_trapped_days} = +#' non_workday are public_holiday and sat_to_sun combined. workday is +#' the opposite of non_workday when \code{exclude_trapped_days} = #' \code{FALSE}. #' #' \code{exclude_trapped_days} is used to exclude trapped days @@ -23,7 +23,7 @@ #' The output is a data frame with the selected dates and the #' day_of_week (integer) when \code{output} = "selected". When #' \code{output} = "raw" the data frame includes all dates and -#' the additional columns c("holiday", "sat_to_sun", "public_holiday", +#' the additional columns c("non_workday", "sat_to_sun", "public_holiday", #' "workday", "trapped" and "public"), see below for description. #' #' The output data frame for \code{output} = "raw": @@ -33,8 +33,8 @@ #' day_of_week \tab Week day number, Monday = 1, Sunday = 7. #' sat_to_sun \tab Saturday and Sunday = 1, otherwise 0. \cr #' public_holiday \tab Public holidays = 1 otherwise = 0. \cr -#' holiday \tab Saturday, Sunday and public holidays = 1, otherwise = 0. \cr -#' workday \tab Working day, the opposite of holiday when \code{exclude_trapped_days} = \code{FALSE}. \cr +#' non_workday \tab Saturday, Sunday and public holidays = 1, otherwise = 0. \cr +#' workday \tab Working day, the opposite of non_workday when \code{exclude_trapped_days} = \code{FALSE}. \cr #' public \tab Easter = "e", Pentacost = "p", non-moveable = "n", otherwise NA. #' trapped \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr #' } @@ -51,7 +51,7 @@ #' @param year [\code{integer(1)}]\cr #' Year. #' @param type [\code{character}]\cr -#' The type(s) of holiday or workday, see details. Defaults to "workday". +#' The type(s) of non_workday or workday, see details. Defaults to "workday". #' @param exclude_trapped_days [\code{character} | \code{logical(1)}]\cr #' Should trapped days and common days off be excluded from workday?, #' see details. Defaults to \code{FALSE}. @@ -97,7 +97,7 @@ get_holiday <- function (year, all.missing = FALSE, unique = TRUE) type <- NVIcheckmate::match_arg(x = type, - choices = c("holiday", "public_holiday", + choices = c("non_workday", "public_holiday", "sat_to_sun", "workday"), several.ok = FALSE, ignore.case = TRUE, @@ -162,12 +162,12 @@ get_holiday <- function (year, dates$public_holiday <- 0 dates[!is.na(dates$public), "public_holiday"] <- 1 - # Assign holidays - dates$holiday <- 0 - dates[which(dates$sat_to_sun == 1 | dates$public_holiday == 1), "holiday"] <- 1 + # Assign non_workdays + dates$non_workday <- 0 + dates[which(dates$sat_to_sun == 1 | dates$public_holiday == 1), "non_workday"] <- 1 # Assign workday - dates$workday <- +(!dates$holiday) + dates$workday <- +(!dates$non_workday) # Assign trapped days dates$trapped <- NA @@ -179,9 +179,9 @@ get_holiday <- function (year, } if ("trapped" %in% exclude_trapped_days) { - dates$behind <- c(NA, dates[c(1:(length(dates$holiday) - 1)), "holiday"]) - dates$ahead <- c(dates[c(2:length(dates$holiday)), "holiday"], "1") - dates[which(dates$ahead == "1" & dates$behind == "1" & dates$holiday == "0" ), "trapped"] <- "t" + dates$behind <- c(NA, dates[c(1:(length(dates$non_workday) - 1)), "non_workday"]) + dates$ahead <- c(dates[c(2:length(dates$non_workday)), "non_workday"], "1") + dates[which(dates$ahead == "1" & dates$behind == "1" & dates$non_workday == "0" ), "trapped"] <- "t" dates[, c("behind", "ahead")] <- c(NULL, NULL) } @@ -193,8 +193,8 @@ get_holiday <- function (year, if ("public_holiday" %in% type) { dates[which(dates$public_holiday == 1), "select"] <- 1 } - if ("holiday" %in% type) { - dates[which(dates$holiday == 1) , "select"] <- 1 + if ("non_workday" %in% type) { + dates[which(dates$non_workday == 1) , "select"] <- 1 } if ("workday" %in% type) { dates[which(dates$workday == 1), "select"] <- 1 @@ -215,13 +215,13 @@ get_holiday <- function (year, if (output == "raw") { dates <- dates[, c("date", "day_of_week", "sat_to_sun", "public_holiday", - "holiday", "workday", "public", "trapped")] + "non_workday", "workday", "public", "trapped")] } if (output %in% c("fhi", "cstime")) { dates$mon_to_fri <- +(!dates$sat_to_sun) dates <- dates[, c("date", "day_of_week", "mon_to_fri", "sat_to_sun", "public_holiday", - "holiday", "workday")] + "non_workday", "workday")] colnames(dates)[6] <- "freeday" } From cc479799c0e82c11bd82ec53ba6533c136ecb3b2 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 12 Dec 2023 09:40:39 +0100 Subject: [PATCH 23/50] =?UTF-8?q?refactor:=20updated=20get=5Fholiday=20Che?= =?UTF-8?q?nged=20to=20workday=20in=20help.=20Included=20Palmes=C3=B8ndag?= =?UTF-8?q?=20in=20public=5Fholiday?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- notes/get_holiday.R | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/notes/get_holiday.R b/notes/get_holiday.R index 6f4a798..ab8436b 100644 --- a/notes/get_holiday.R +++ b/notes/get_holiday.R @@ -1,15 +1,15 @@ -#' @title Get the holidays or working days -#' @description Get the non_workdays or working days within one year. +#' @title Get the holidays or workdays +#' @description Get the non-workdays or workdays within one year. #' The function is intended for use when planning sampling to #' excluded days or weeks from the sampling plan. #' -#' @details \code{type} is used to select the type of non_workday or -#' workday. Valid input are c("non_workday", "sat_to_sun", "public_holiday", -#' "workday"). public_holiday are the non-moveable holidays, -#' Easter and Pentacost; sat_to_sun are Saturdays and Sundays; and -#' non_workday are public_holiday and sat_to_sun combined. workday is -#' the opposite of non_workday when \code{exclude_trapped_days} = -#' \code{FALSE}. +#' @details \code{type} is used to select the type of non-workday or +#' workday. Valid input are one of c("non_workday", "sat_to_sun", +#' "public_holiday", "workday"). public_holiday are the non-moveable +#' holidays, Easter and Pentacost; sat_to_sun are Saturdays and +#' Sundays; and non_workday are public_holiday and sat_to_sun combined. +#' workday is the opposite of non_workday when +#' \code{exclude_trapped_days} = \code{FALSE}. #' #' \code{exclude_trapped_days} is used to exclude trapped days #' and other days that many often takes a day off, i.e. the @@ -34,7 +34,7 @@ #' sat_to_sun \tab Saturday and Sunday = 1, otherwise 0. \cr #' public_holiday \tab Public holidays = 1 otherwise = 0. \cr #' non_workday \tab Saturday, Sunday and public holidays = 1, otherwise = 0. \cr -#' workday \tab Working day, the opposite of non_workday when \code{exclude_trapped_days} = \code{FALSE}. \cr +#' workday \tab Workday, the opposite of non-workday when \code{exclude_trapped_days} = \code{FALSE}. \cr #' public \tab Easter = "e", Pentacost = "p", non-moveable = "n", otherwise NA. #' trapped \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr #' } @@ -44,14 +44,14 @@ #' created by National Public Health Institute (FHI). #' #' The function is limited to years from 1968, as before 1968 -#' Saturday was a normal working day in Norway. Be aware that +#' Saturday was a normal workday in Norway. Be aware that #' Saturday was a normal school day in Norway until and including #' 1972. #' #' @param year [\code{integer(1)}]\cr #' Year. -#' @param type [\code{character}]\cr -#' The type(s) of non_workday or workday, see details. Defaults to "workday". +#' @param type [\code{character(1)}]\cr +#' The type of non_workday or workday, see details. Defaults to "workday". #' @param exclude_trapped_days [\code{character} | \code{logical(1)}]\cr #' Should trapped days and common days off be excluded from workday?, #' see details. Defaults to \code{FALSE}. @@ -128,7 +128,7 @@ get_holiday <- function (year, OE <- 7 - ((OG-SZ) %% 7) easterday <- as.Date(paste0(year, "-03-01")) - 1 + OG + OE - easter <- rep(easterday, 4) + c(-3, -2, 0, 1) + easter <- rep(easterday, 5) + c(-7, -3, -2, 0, 1) easter_trapped <- rep(easterday, 3) + c(-6, -5, -4) pentacost <- rep(easterday, 3) + c(39, 49, 50) non_moveable <- as.Date(paste0(year, c("-01-01", "-05-01", "-05-17", "-12-25", "-12-26"))) From 43733c462f091dd08f61713da63f930cac8b983c Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 12 Dec 2023 09:41:08 +0100 Subject: [PATCH 24/50] test: created test_get_holiday first version --- tests/testthat/test_get_holiday.R | 97 +++++++++++++++++++++++++++++++ 1 file changed, 97 insertions(+) create mode 100644 tests/testthat/test_get_holiday.R diff --git a/tests/testthat/test_get_holiday.R b/tests/testthat/test_get_holiday.R new file mode 100644 index 0000000..511023c --- /dev/null +++ b/tests/testthat/test_get_holiday.R @@ -0,0 +1,97 @@ +library(OKplan) +library(testthat) + +test_that("Output from get_holiday", { + + # Selects the public holidays + public_holidays <- get_holiday(year = 2000, + type = "public_holiday") + + expect_identical(public_holidays$date, + as.Date(c("2000-01-01", "2000-04-16", "2000-04-20", + "2000-04-21", "2000-04-23", "2000-04-24", + "2000-05-01", "2000-05-17", "2000-06-01", + "2000-06-11", "2000-06-12", "2000-12-25", + "2000-12-26"), format = "%Y-%m-%d")) + + + public_holidays <- get_holiday(year = 2024, + type = "public_holiday") + expect_identical(public_holidays$date, + as.Date(c("2024-01-01", "2024-03-24", "2024-03-28", + "2024-03-29", "2024-03-31", "2024-04-01", + "2024-05-01", "2024-05-09", "2024-05-17", + "2024-05-19", "2024-05-20", "2024-12-25", + "2024-12-26"), format = "%Y-%m-%d")) + + public_holidays <- get_holiday(year = 2025, + type = "public_holiday") + expect_identical(public_holidays$date, + as.Date(c("2025-01-01", "2025-04-13", "2025-04-17", + "2025-04-18", "2025-04-20", "2025-04-21", + "2025-05-01", "2025-05-17", "2025-05-29", + "2025-06-08", "2025-06-09", "2025-12-25", + "2025-12-26"), format = "%Y-%m-%d")) + + # Selects workdays except the trapped days + workdays <- get_holiday(year = 2024, + type = "workday", + exclude_trapped_days = TRUE) + + # Selects workdays except days in Easter and Christmas week + workdays <- get_holiday(year = 2024, + type = "workday", + exclude_trapped_days = c("easter", "xmas")) + + +}) + + +test_that("Errors for get_holiday ", { + + total_budget <- 150 + # Add data frame with sample number to adjust + x <- as.data.frame(cbind(c(1:10), + c(24, 30, 36, 12, 6, 18, 6, 0, 0, 0))) + colnames(x) <- c("id", "sample") + + expect_error( + get_holiday(year = 2023, + type = "weekend" , + exclude_trapped_days = "easter", + output = "selected"), + regexpr = "Variable \'data\': Must be of type \'data.frame\'") + + expect_error( + get_holiday(year = 2023, + type = c("non_workday", "public_holiday", + "sat_to_sun", "workday") , + exclude_trapped_days = "easter", + output = "selected"), + regexpr = "Variable \'budget\': Element 1 is not >= 1") + + expect_error( + get_holiday(year = 2023, + type = c("non_workday", "public_holiday", + "sat_to_sun", "workday") , + exclude_trapped_days = "easter", + output = "selected"), + regexpr = "Variable \'sample_to_adjust\': Must be element of set {\'id\',\'sample\'}, but is \'samples\'") + + expect_error( + get_holiday(year = 2023, + type = c("non_workday", "public_holiday", + "sat_to_sun", "workday") , + exclude_trapped_days = "easter", + output = "selected"), + regexpr = "Variable \'adjusted_sample\': Must be of type \'character\', not \'double\'") + + expect_error( + get_holiday(year = 2023, + type = c("non_workday", "public_holiday", + "sat_to_sun", "workday") , + exclude_trapped_days = "easter", + output = "selected"), + regexpr = "Variable \'adjust_by\': Element 1 is not >= 1") + +}) From ffa01b6fb965fc0da1fd414a9feb40cd51b9bd45 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 12 Dec 2023 09:42:22 +0100 Subject: [PATCH 25/50] refactor: moved get_holiday to R/ --- {notes => R}/get_holiday.R | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename {notes => R}/get_holiday.R (100%) diff --git a/notes/get_holiday.R b/R/get_holiday.R similarity index 100% rename from notes/get_holiday.R rename to R/get_holiday.R From 406ad89ece3433075e830fbb737f8a4c6023a482 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 12 Dec 2023 11:46:56 +0100 Subject: [PATCH 26/50] doc: improved help for get_holiday Corrected table with data variables. Created help file. --- R/get_holiday.R | 174 ++++++++++++++++++++++----------------------- man/get_holiday.Rd | 101 ++++++++++++++++++++++++++ 2 files changed, 187 insertions(+), 88 deletions(-) create mode 100644 man/get_holiday.Rd diff --git a/R/get_holiday.R b/R/get_holiday.R index ab8436b..002b97a 100644 --- a/R/get_holiday.R +++ b/R/get_holiday.R @@ -1,59 +1,59 @@ -#' @title Get the holidays or workdays -#' @description Get the non-workdays or workdays within one year. -#' The function is intended for use when planning sampling to -#' excluded days or weeks from the sampling plan. +#' @title Get the non-workdays or workdays +#' @description Get the non-workdays or workdays within one year. +#' The function is intended for use when planning sampling to +#' excluded days or weeks from the sampling plan. #' -#' @details \code{type} is used to select the type of non-workday or -#' workday. Valid input are one of c("non_workday", "sat_to_sun", -#' "public_holiday", "workday"). public_holiday are the non-moveable -#' holidays, Easter and Pentacost; sat_to_sun are Saturdays and +#' @details \code{type} is used to select the type of non-workday or +#' workday. Valid input are one of c("non_workday", "sat_to_sun", +#' "public_holiday", "workday"). public_holiday are the non-moveable +#' holidays, Easter and Pentacost; sat_to_sun are Saturdays and #' Sundays; and non_workday are public_holiday and sat_to_sun combined. -#' workday is the opposite of non_workday when +#' workday is the opposite of non_workday when #' \code{exclude_trapped_days} = \code{FALSE}. -#' -#' \code{exclude_trapped_days} is used to exclude trapped days -#' and other days that many often takes a day off, i.e. the -#' Easter week and the Christmas week. It is only Valid for -#' workday and has no effect on the other types. Input -#' "trapped" or \code{TRUE} will exclude trapped days, -#' "easter" will exclude Monday to Wednesday before Thursday -#' and "xmas" will exclude the days in the week of Christmas -#' eve until New years eve. -#' -#' The output is a data frame with the selected dates and the +#' +#' \code{exclude_trapped_days} is used to exclude trapped days +#' and other days that many often takes a day off, i.e. the +#' Easter week and the Christmas week. It is only Valid for +#' workday and has no effect on the other types. Input +#' "trapped" or \code{TRUE} will exclude trapped days, +#' "easter" will exclude Monday to Wednesday before Thursday +#' and "xmas" will exclude the days in the week of Christmas +#' eve until New years eve. +#' +#' The output is a data frame with the selected dates and the #' day_of_week (integer) when \code{output} = "selected". When -#' \code{output} = "raw" the data frame includes all dates and -#' the additional columns c("non_workday", "sat_to_sun", "public_holiday", +#' \code{output} = "raw" the data frame includes all dates and +#' the additional columns c("non_workday", "sat_to_sun", "public_holiday", #' "workday", "trapped" and "public"), see below for description. -#' +#' #' The output data frame for \code{output} = "raw": -#' \tabular{ll}{ -#' \strong{Column name} \tab \strong{Values} \cr -#' date \tab Date. \cr -#' day_of_week \tab Week day number, Monday = 1, Sunday = 7. -#' sat_to_sun \tab Saturday and Sunday = 1, otherwise 0. \cr -#' public_holiday \tab Public holidays = 1 otherwise = 0. \cr -#' non_workday \tab Saturday, Sunday and public holidays = 1, otherwise = 0. \cr -#' workday \tab Workday, the opposite of non-workday when \code{exclude_trapped_days} = \code{FALSE}. \cr -#' public \tab Easter = "e", Pentacost = "p", non-moveable = "n", otherwise NA. -#' trapped \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr +#' \tabular{lll}{ +#' \strong{Column name} \tab \strong{Format} \tab \strong{Description} \cr +#' date \tab date \tab Date. \cr +#' day_of_week \tab integer \tab Week day number, Monday = 1, Sunday = 7. \cr +#' sat_to_sun \tab integer \tab Saturday and Sunday = 1, otherwise 0. \cr +#' public_holiday \tab integer \tab Public holidays = 1 otherwise = 0. \cr +#' non_workday \tab integer \tab Saturday, Sunday and public holidays = 1, otherwise = 0. \cr +#' workday \tab integer \tab Workday, the opposite of non-workday when \code{exclude_trapped_days} = \code{FALSE}. \cr +#' public \tab character \tab Easter = "e", Pentacost = "p", non-moveable = "n", otherwise NA. \cr +#' trapped \tab character \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr #' } -#' +#' #' When \code{output} %in% c("fhi", "cstime") the data frame is -#' formatted as the table cstime::nor_workdays_by_date +#' formatted as the table cstime::nor_workdays_by_date #' created by National Public Health Institute (FHI). -#' +#' #' The function is limited to years from 1968, as before 1968 -#' Saturday was a normal workday in Norway. Be aware that -#' Saturday was a normal school day in Norway until and including -#' 1972. +#' Saturday was a normal workday in Norway. Be aware that +#' Saturday was a normal school day in Norway until and including +#' 1972. #' #' @param year [\code{integer(1)}]\cr -#' Year. +#' Year. #' @param type [\code{character(1)}]\cr #' The type of non_workday or workday, see details. Defaults to "workday". #' @param exclude_trapped_days [\code{character} | \code{logical(1)}]\cr -#' Should trapped days and common days off be excluded from workday?, +#' Should trapped days and common days off be excluded from workday?, #' see details. Defaults to \code{FALSE}. #' @param output [\code{character(1)}]\cr #' The output format of the data frame, see details. Defaults @@ -67,28 +67,26 @@ #' # Selects the public holidays #' public_holidays <- get_holiday(year = 2024, #' type = "public_holiday") -#' -#' # Selects workdays except the trapped days +#' +#' # Selects workdays except the trapped days #' workdays <- get_holiday(year = 2024, #' type = "workday", #' exclude_trapped_days = TRUE) -#' +#' #' # Selects workdays except days in Easter and Christmas week #' workdays <- get_holiday(year = 2024, #' type = "workday", #' exclude_trapped_days = c("easter", "xmas")) -#' - - -get_holiday <- function (year, - type = "workday", +#' +get_holiday <- function(year, + type = "workday", exclude_trapped_days = FALSE, output = "selected") { - - ### ARGUMENT CHECKING ---- + + ### ARGUMENT CHECKING ---- # Object to store check-results checks <- checkmate::makeAssertCollection() - + # Perform checks checkmate::assert_integerish(year, lower = 1968, @@ -97,7 +95,7 @@ get_holiday <- function (year, all.missing = FALSE, unique = TRUE) type <- NVIcheckmate::match_arg(x = type, - choices = c("non_workday", "public_holiday", + choices = c("non_workday", "public_holiday", "sat_to_sun", "workday"), several.ok = FALSE, ignore.case = TRUE, @@ -110,65 +108,65 @@ get_holiday <- function (year, several.ok = FALSE, ignore.case = TRUE, add = checks) - + # Report check-results checkmate::reportAssertions(checks) - - ### NATIONAL HOLIDAYS ---- + + ### NATIONAL HOLIDAYS ---- # Calculate Easter day # reference - K <- floor(year/100) - M <- 15 + floor((3 * K + 3)/4) - floor((8 * K + 13)/25) - S <- 2 - floor((3 * K + 3)/4) + K <- floor(year / 100) + M <- 15 + floor((3 * K + 3) / 4) - floor((8 * K + 13) / 25) + S <- 2 - floor((3 * K + 3) / 4) A <- year %% 19 - D <- (19*A+M) %% 30 - R <- floor((D+A/11)/29) + D <- (19 * A + M) %% 30 + R <- floor((D + A / 11) / 29) OG <- 21 + D - R - SZ <- 7 - ((year + floor(year/4)+S) %% 7) - OE <- 7 - ((OG-SZ) %% 7) - + SZ <- 7 - ((year + floor(year / 4) + S) %% 7) + OE <- 7 - ((OG - SZ) %% 7) + easterday <- as.Date(paste0(year, "-03-01")) - 1 + OG + OE easter <- rep(easterday, 5) + c(-7, -3, -2, 0, 1) easter_trapped <- rep(easterday, 3) + c(-6, -5, -4) pentacost <- rep(easterday, 3) + c(39, 49, 50) - non_moveable <- as.Date(paste0(year, c("-01-01", "-05-01", "-05-17", "-12-25", "-12-26"))) - days_before_newyear <- 7 + non_moveable <- as.Date(paste0(year, c("-01-01", "-05-01", "-05-17", "-12-25", "-12-26"))) + days_before_newyear <- 7 if (as.numeric(format(as.Date(paste0(year, "-12-31")), "%u")) <= 3) { days_before_newyear <- days_before_newyear + as.numeric(format(as.Date(paste0(year, "-12-31")), "%u")) } # as.Date(paste0(year, "-12-31")) - as.numeric(format(as.Date(paste0(year, "-12-31")), "%u")) - + xmas_trapped <- rep(as.Date(paste0(year, "-12-31")), days_before_newyear) + c(-(days_before_newyear - 1):0) - - ### CATEGORISE INTO HOLIDAYS ---- + + ### CATEGORISE INTO HOLIDAYS ---- # create data frame with all dates for year[i] - dates <- as.data.frame(matrix(data = c(as.Date(paste0(year, "-01-01")):as.Date(paste0(year, "-12-31"))), + dates <- as.data.frame(matrix(data = c(as.Date(paste0(year, "-01-01")):as.Date(paste0(year, "-12-31"))), dimnames = list(NULL, "date"))) dates$date <- as.Date(dates$date, origin = "1970-01-01") - + # Assign weekday number dates$day_of_week <- as.numeric(format(dates$date, format = "%u")) - + # Assign sat_to_sun dates$sat_to_sun <- 0 dates[which(dates$day_of_week %in% c(6, 7)), "sat_to_sun"] <- 1 - + # Assign public holidays dates$public <- NA_character_ dates[which(dates$date %in% easter), "public"] <- "e" dates[which(dates$date %in% pentacost), "public"] <- "p" dates[which(dates$date %in% non_moveable), "public"] <- "n" - + dates$public_holiday <- 0 dates[!is.na(dates$public), "public_holiday"] <- 1 - + # Assign non_workdays dates$non_workday <- 0 dates[which(dates$sat_to_sun == 1 | dates$public_holiday == 1), "non_workday"] <- 1 - + # Assign workday dates$workday <- +(!dates$non_workday) - + # Assign trapped days dates$trapped <- NA if ("easter" %in% exclude_trapped_days) { @@ -177,14 +175,14 @@ get_holiday <- function (year, if ("xmas" %in% exclude_trapped_days) { dates[which(dates$date %in% xmas_trapped), "trapped"] <- "x" } - + if ("trapped" %in% exclude_trapped_days) { dates$behind <- c(NA, dates[c(1:(length(dates$non_workday) - 1)), "non_workday"]) dates$ahead <- c(dates[c(2:length(dates$non_workday)), "non_workday"], "1") - dates[which(dates$ahead == "1" & dates$behind == "1" & dates$non_workday == "0" ), "trapped"] <- "t" + dates[which(dates$ahead == "1" & dates$behind == "1" & dates$non_workday == "0"), "trapped"] <- "t" dates[, c("behind", "ahead")] <- c(NULL, NULL) } - + ### SELECT ROWS TO REPORT ---- if (output == "selected") { if ("sat_to_sun" %in% type) { @@ -194,7 +192,7 @@ get_holiday <- function (year, dates[which(dates$public_holiday == 1), "select"] <- 1 } if ("non_workday" %in% type) { - dates[which(dates$non_workday == 1) , "select"] <- 1 + dates[which(dates$non_workday == 1), "select"] <- 1 } if ("workday" %in% type) { dates[which(dates$workday == 1), "select"] <- 1 @@ -204,7 +202,7 @@ get_holiday <- function (year, if ("xmas" %in% exclude_trapped_days) { dates[which(dates$trapped == "x"), "select"] <- 0 } - + if ("trapped" %in% exclude_trapped_days | isTRUE(exclude_trapped_days)) { dates[which(dates$trapped == "t"), "select"] <- 0 } @@ -212,18 +210,18 @@ get_holiday <- function (year, dates <- subset(dates, dates$select == 1) dates <- dates[, c("date", "day_of_week")] } - + if (output == "raw") { - dates <- dates[, c("date", "day_of_week", "sat_to_sun", "public_holiday", - "non_workday", "workday", "public", "trapped")] + dates <- dates[, c("date", "day_of_week", "sat_to_sun", "public_holiday", + "non_workday", "workday", "public", "trapped")] } - + if (output %in% c("fhi", "cstime")) { dates$mon_to_fri <- +(!dates$sat_to_sun) - dates <- dates[, c("date", "day_of_week", "mon_to_fri", "sat_to_sun", "public_holiday", + dates <- dates[, c("date", "day_of_week", "mon_to_fri", "sat_to_sun", "public_holiday", "non_workday", "workday")] colnames(dates)[6] <- "freeday" } - + return(dates) } diff --git a/man/get_holiday.Rd b/man/get_holiday.Rd new file mode 100644 index 0000000..b091cef --- /dev/null +++ b/man/get_holiday.Rd @@ -0,0 +1,101 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_holiday.R +\name{get_holiday} +\alias{get_holiday} +\title{Get the non-workdays or workdays} +\usage{ +get_holiday( + year, + type = "workday", + exclude_trapped_days = FALSE, + output = "selected" +) +} +\arguments{ +\item{year}{[\code{integer(1)}]\cr +Year.} + +\item{type}{[\code{character(1)}]\cr +The type of non_workday or workday, see details. Defaults to "workday".} + +\item{exclude_trapped_days}{[\code{character} | \code{logical(1)}]\cr +Should trapped days and common days off be excluded from workday?, +see details. Defaults to \code{FALSE}.} + +\item{output}{[\code{character(1)}]\cr +The output format of the data frame, see details. Defaults +to "selected".} +} +\value{ +data frame with the selected dates. +} +\description{ +Get the non-workdays or workdays within one year. + The function is intended for use when planning sampling to + excluded days or weeks from the sampling plan. +} +\details{ +\code{type} is used to select the type of non-workday or + workday. Valid input are one of c("non_workday", "sat_to_sun", + "public_holiday", "workday"). public_holiday are the non-moveable + holidays, Easter and Pentacost; sat_to_sun are Saturdays and + Sundays; and non_workday are public_holiday and sat_to_sun combined. + workday is the opposite of non_workday when + \code{exclude_trapped_days} = \code{FALSE}. + +\code{exclude_trapped_days} is used to exclude trapped days + and other days that many often takes a day off, i.e. the + Easter week and the Christmas week. It is only Valid for + workday and has no effect on the other types. Input + "trapped" or \code{TRUE} will exclude trapped days, + "easter" will exclude Monday to Wednesday before Thursday + and "xmas" will exclude the days in the week of Christmas + eve until New years eve. + + The output is a data frame with the selected dates and the + day_of_week (integer) when \code{output} = "selected". When + \code{output} = "raw" the data frame includes all dates and + the additional columns c("non_workday", "sat_to_sun", "public_holiday", + "workday", "trapped" and "public"), see below for description. + + The output data frame for \code{output} = "raw": +\tabular{lll}{ + \strong{Column name} \tab \strong{Format} \tab \strong{Description} \cr + date \tab date \tab Date. \cr + day_of_week \tab integer \tab Week day number, Monday = 1, Sunday = 7. \cr + sat_to_sun \tab integer \tab Saturday and Sunday = 1, otherwise 0. \cr + public_holiday \tab integer \tab Public holidays = 1 otherwise = 0. \cr + non_workday \tab integer \tab Saturday, Sunday and public holidays = 1, otherwise = 0. \cr + workday \tab integer \tab Workday, the opposite of non-workday when \code{exclude_trapped_days} = \code{FALSE}. \cr + public \tab character \tab Easter = "e", Pentacost = "p", non-moveable = "n", otherwise NA. \cr + trapped \tab character \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr +} + + When \code{output} %in% c("fhi", "cstime") the data frame is + formatted as the table cstime::nor_workdays_by_date + created by National Public Health Institute (FHI). + +The function is limited to years from 1968, as before 1968 + Saturday was a normal workday in Norway. Be aware that + Saturday was a normal school day in Norway until and including + 1972. +} +\examples{ +# Selects the public holidays + public_holidays <- get_holiday(year = 2024, + type = "public_holiday") + +# Selects workdays except the trapped days + workdays <- get_holiday(year = 2024, + type = "workday", + exclude_trapped_days = TRUE) + +# Selects workdays except days in Easter and Christmas week + workdays <- get_holiday(year = 2024, + type = "workday", + exclude_trapped_days = c("easter", "xmas")) + +} +\author{ +Petter Hopp Petter.Hopp@vetinst.no +} From 1472b3475b246da544ac18d39417bd92ab97d41a Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 12 Dec 2023 11:47:34 +0100 Subject: [PATCH 27/50] feat: exported get_holiday to NAMESPACE --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index f6afed8..edc3d27 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(append_date_generated_line) export(append_sum_line) export(check_OK_selection) export(check_ok_selection) +export(get_holiday) export(get_tested_herds) export(make_random) export(style_sum_line) From 3b2bae716c0624c9b09ef128aa7ae9a4c848574a Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 12 Dec 2023 11:49:01 +0100 Subject: [PATCH 28/50] chore: corrected DESCRIPTION Corrected package name "purrrr" in Suggests. --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7df4668..c241c15 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,7 @@ Suggests: devtools, findInFiles, knitr, - purr, + purrr, rmarkdown, testthat, usethis, From c14d27c5599100bf56079b7b0e2bd1ed930f3357 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 12 Dec 2023 11:50:16 +0100 Subject: [PATCH 29/50] chore: added new features to NEWS --- NEWS | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 4fa3d87..a8109dc 100644 --- a/NEWS +++ b/NEWS @@ -3,22 +3,22 @@ OKplan 0.6.1.9000 - (2023-##-##) New features: -- +- Created get_holiday to get the non-workdays or workdays within one year. Bug fixes: -- +- To come. Other changes: -- +- To come. BREAKING CHANGES: -- +- To come. OKplan 0.6.1 - (2023-10-09) From 516c352b36e0be6e619e37e56f0b2bf90a07bc0c Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Tue, 12 Dec 2023 11:51:47 +0100 Subject: [PATCH 30/50] style: styled lines for test_get_holiday --- tests/testthat/test_get_holiday.R | 56 +++++++++++++++---------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/tests/testthat/test_get_holiday.R b/tests/testthat/test_get_holiday.R index 511023c..d21f3d6 100644 --- a/tests/testthat/test_get_holiday.R +++ b/tests/testthat/test_get_holiday.R @@ -1,29 +1,29 @@ -library(OKplan) +library(OKplan) library(testthat) test_that("Output from get_holiday", { - + # Selects the public holidays public_holidays <- get_holiday(year = 2000, type = "public_holiday") expect_identical(public_holidays$date, - as.Date(c("2000-01-01", "2000-04-16", "2000-04-20", - "2000-04-21", "2000-04-23", "2000-04-24", - "2000-05-01", "2000-05-17", "2000-06-01", - "2000-06-11", "2000-06-12", "2000-12-25", + as.Date(c("2000-01-01", "2000-04-16", "2000-04-20", + "2000-04-21", "2000-04-23", "2000-04-24", + "2000-05-01", "2000-05-17", "2000-06-01", + "2000-06-11", "2000-06-12", "2000-12-25", "2000-12-26"), format = "%Y-%m-%d")) - + public_holidays <- get_holiday(year = 2024, type = "public_holiday") expect_identical(public_holidays$date, - as.Date(c("2024-01-01", "2024-03-24", "2024-03-28", - "2024-03-29", "2024-03-31", "2024-04-01", + as.Date(c("2024-01-01", "2024-03-24", "2024-03-28", + "2024-03-29", "2024-03-31", "2024-04-01", "2024-05-01", "2024-05-09", "2024-05-17", "2024-05-19", "2024-05-20", "2024-12-25", "2024-12-26"), format = "%Y-%m-%d")) - + public_holidays <- get_holiday(year = 2025, type = "public_holiday") expect_identical(public_holidays$date, @@ -32,7 +32,7 @@ test_that("Output from get_holiday", { "2025-05-01", "2025-05-17", "2025-05-29", "2025-06-08", "2025-06-09", "2025-12-25", "2025-12-26"), format = "%Y-%m-%d")) - + # Selects workdays except the trapped days workdays <- get_holiday(year = 2024, type = "workday", @@ -43,55 +43,55 @@ test_that("Output from get_holiday", { type = "workday", exclude_trapped_days = c("easter", "xmas")) - + }) test_that("Errors for get_holiday ", { - + total_budget <- 150 # Add data frame with sample number to adjust x <- as.data.frame(cbind(c(1:10), c(24, 30, 36, 12, 6, 18, 6, 0, 0, 0))) colnames(x) <- c("id", "sample") - + expect_error( get_holiday(year = 2023, - type = "weekend" , + type = "weekend", exclude_trapped_days = "easter", output = "selected"), regexpr = "Variable \'data\': Must be of type \'data.frame\'") - + expect_error( get_holiday(year = 2023, - type = c("non_workday", "public_holiday", - "sat_to_sun", "workday") , + type = c("non_workday", "public_holiday", + "sat_to_sun", "workday"), exclude_trapped_days = "easter", output = "selected"), regexpr = "Variable \'budget\': Element 1 is not >= 1") - + expect_error( get_holiday(year = 2023, - type = c("non_workday", "public_holiday", - "sat_to_sun", "workday") , + type = c("non_workday", "public_holiday", + "sat_to_sun", "workday"), exclude_trapped_days = "easter", output = "selected"), regexpr = "Variable \'sample_to_adjust\': Must be element of set {\'id\',\'sample\'}, but is \'samples\'") - + expect_error( get_holiday(year = 2023, - type = c("non_workday", "public_holiday", - "sat_to_sun", "workday") , + type = c("non_workday", "public_holiday", + "sat_to_sun", "workday"), exclude_trapped_days = "easter", output = "selected"), regexpr = "Variable \'adjusted_sample\': Must be of type \'character\', not \'double\'") - + expect_error( get_holiday(year = 2023, - type = c("non_workday", "public_holiday", - "sat_to_sun", "workday") , + type = c("non_workday", "public_holiday", + "sat_to_sun", "workday"), exclude_trapped_days = "easter", output = "selected"), regexpr = "Variable \'adjust_by\': Element 1 is not >= 1") - + }) From 7cfa03143335289b437837ee261b8a227a99e5d7 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Wed, 13 Dec 2023 15:43:38 +0100 Subject: [PATCH 31/50] fix: corrected get_holiday Corrected problems with trapped days. --- R/get_holiday.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/get_holiday.R b/R/get_holiday.R index 002b97a..654bea8 100644 --- a/R/get_holiday.R +++ b/R/get_holiday.R @@ -136,7 +136,7 @@ get_holiday <- function(year, } # as.Date(paste0(year, "-12-31")) - as.numeric(format(as.Date(paste0(year, "-12-31")), "%u")) - xmas_trapped <- rep(as.Date(paste0(year, "-12-31")), days_before_newyear) + c(-(days_before_newyear - 1):0) + xmas_trapped <- rep(as.Date(paste0(year, "-12-31")), days_before_newyear + 1) + c(-(days_before_newyear):0) ### CATEGORISE INTO HOLIDAYS ---- # create data frame with all dates for year[i] @@ -176,7 +176,7 @@ get_holiday <- function(year, dates[which(dates$date %in% xmas_trapped), "trapped"] <- "x" } - if ("trapped" %in% exclude_trapped_days) { + if ("trapped" %in% exclude_trapped_days | isTRUE(exclude_trapped_days)) { dates$behind <- c(NA, dates[c(1:(length(dates$non_workday) - 1)), "non_workday"]) dates$ahead <- c(dates[c(2:length(dates$non_workday)), "non_workday"], "1") dates[which(dates$ahead == "1" & dates$behind == "1" & dates$non_workday == "0"), "trapped"] <- "t" From e3e4b616cc21e04f3542dca46029204f6bbad862 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Wed, 13 Dec 2023 15:44:06 +0100 Subject: [PATCH 32/50] test: created some tests in test_get_holiday --- tests/testthat/test_get_holiday.R | 175 +++++++++++++++++++++--------- 1 file changed, 121 insertions(+), 54 deletions(-) diff --git a/tests/testthat/test_get_holiday.R b/tests/testthat/test_get_holiday.R index d21f3d6..987c87d 100644 --- a/tests/testthat/test_get_holiday.R +++ b/tests/testthat/test_get_holiday.R @@ -1,97 +1,164 @@ library(OKplan) library(testthat) -test_that("Output from get_holiday", { - +test_that("Output public_holiday from get_holiday", { + # Selects the public holidays - public_holidays <- get_holiday(year = 2000, - type = "public_holiday") - + public_holidays <- get_holiday(year = 2000, + type = "public_holiday") + expect_identical(public_holidays$date, as.Date(c("2000-01-01", "2000-04-16", "2000-04-20", - "2000-04-21", "2000-04-23", "2000-04-24", - "2000-05-01", "2000-05-17", "2000-06-01", - "2000-06-11", "2000-06-12", "2000-12-25", - "2000-12-26"), format = "%Y-%m-%d")) - - - public_holidays <- get_holiday(year = 2024, - type = "public_holiday") + "2000-04-21", "2000-04-23", "2000-04-24", + "2000-05-01", "2000-05-17", "2000-06-01", + "2000-06-11", "2000-06-12", "2000-12-25", + "2000-12-26"), format = "%Y-%m-%d")) + + + public_holidays <- get_holiday(year = 2024, + type = "public_holiday") expect_identical(public_holidays$date, as.Date(c("2024-01-01", "2024-03-24", "2024-03-28", "2024-03-29", "2024-03-31", "2024-04-01", "2024-05-01", "2024-05-09", "2024-05-17", "2024-05-19", "2024-05-20", "2024-12-25", "2024-12-26"), format = "%Y-%m-%d")) - - public_holidays <- get_holiday(year = 2025, - type = "public_holiday") + + public_holidays <- get_holiday(year = 2025, + type = "public_holiday") expect_identical(public_holidays$date, as.Date(c("2025-01-01", "2025-04-13", "2025-04-17", "2025-04-18", "2025-04-20", "2025-04-21", "2025-05-01", "2025-05-17", "2025-05-29", "2025-06-08", "2025-06-09", "2025-12-25", "2025-12-26"), format = "%Y-%m-%d")) +}) - # Selects workdays except the trapped days - workdays <- get_holiday(year = 2024, - type = "workday", - exclude_trapped_days = TRUE) - - # Selects workdays except days in Easter and Christmas week - workdays <- get_holiday(year = 2024, - type = "workday", - exclude_trapped_days = c("easter", "xmas")) - - +test_that("Output trapped workdays from get_holiday", { + + # Selects workdays except the trapped days in 2000 + workdays <- get_holiday(year = 2000, + type = "workday", + exclude_trapped_days = "trapped", + output = "raw") + trapped <- workdays[which(workdays$trapped == "t"), "date"] + expect_identical(trapped, + as.Date(c("2000-06-02"), format = "%Y-%m-%d")) + + # Selects workdays except the trapped days and days off in easter and xmas + workdays <- get_holiday(year = 2000, + type = "workday", + exclude_trapped_days = c("trapped", "easter", "xmas"), + output = "raw") + trapped <- workdays[which(!is.na(workdays$trapped)), "date"] + expect_identical(trapped, + as.Date(c("2000-04-17", "2000-04-18", "2000-04-19", + "2000-06-02", "2000-12-24", "2000-12-25", + "2000-12-26", "2000-12-27", "2000-12-28", + "2000-12-29", "2000-12-30", "2000-12-31"), + format = "%Y-%m-%d")) + + # Selects workdays except the trapped days in 2024 + workdays <- get_holiday(year = 2024, + type = "workday", + exclude_trapped_days = "trapped", + output = "raw") + trapped <- workdays[which(workdays$trapped == "t"), "date"] + expect_identical(trapped, + as.Date(c("2024-05-10", "2024-12-27"), format = "%Y-%m-%d")) + + # Selects workdays except the trapped days and days off in easter and xmas + workdays <- get_holiday(year = 2024, + type = "workday", + exclude_trapped_days = c("trapped", "easter", "xmas"), + output = "raw") + trapped <- workdays[which(!is.na(workdays$trapped)), "date"] + expect_identical(trapped, + as.Date(c("2024-03-25", "2024-03-26", "2024-03-27", + "2024-05-10", "2024-12-22", "2024-12-23", + "2024-12-24", "2024-12-25", "2024-12-26", + "2024-12-27", "2024-12-28", "2024-12-29", + "2024-12-30", "2024-12-31"), format = "%Y-%m-%d")) + + # Selects workdays except the trapped days in 2025 + workdays <- get_holiday(year = 2025, + type = "workday", + exclude_trapped_days = "trapped", + output = "raw") + trapped <- workdays[which(workdays$trapped == "t"), "date"] + expect_identical(trapped, + as.Date(c("2025-05-02", "2025-05-30"), format = "%Y-%m-%d")) + + # Selects workdays except the trapped days and days off in easter and xmas + workdays <- get_holiday(year = 2025, + type = "workday", + exclude_trapped_days = c("trapped", "easter", "xmas"), + output = "raw") + trapped <- workdays[which(!is.na(workdays$trapped)), "date"] + expect_identical(trapped, + as.Date(c("2025-04-14", "2025-04-15", "2025-04-16", + "2025-05-02", "2025-05-30", "2025-12-21", + "2025-12-22", "2025-12-23", "2025-12-24", + "2025-12-25", "2025-12-26", "2025-12-27", + "2025-12-28", "2025-12-29", "2025-12-30", + "2025-12-31"), format = "%Y-%m-%d")) + }) test_that("Errors for get_holiday ", { - - total_budget <- 150 - # Add data frame with sample number to adjust - x <- as.data.frame(cbind(c(1:10), - c(24, 30, 36, 12, 6, 18, 6, 0, 0, 0))) - colnames(x) <- c("id", "sample") - + + linewidth <- options("width") + options(width = 80) + expect_error( get_holiday(year = 2023, type = "weekend", exclude_trapped_days = "easter", output = "selected"), - regexpr = "Variable \'data\': Must be of type \'data.frame\'") - + regexpr = "Variable 'type': Must be element of set", + fixed = TRUE) + expect_error( get_holiday(year = 2023, type = c("non_workday", "public_holiday", - "sat_to_sun", "workday"), + "sat_to_sun", "workday"), exclude_trapped_days = "easter", output = "selected"), - regexpr = "Variable \'budget\': Element 1 is not >= 1") - + regexpr = "Variable 'type': Must have length 1, but has length 4", + fixed = TRUE) + expect_error( - get_holiday(year = 2023, - type = c("non_workday", "public_holiday", - "sat_to_sun", "workday"), + get_holiday(year = "2023", + type = c("non_workday"), exclude_trapped_days = "easter", output = "selected"), - regexpr = "Variable \'sample_to_adjust\': Must be element of set {\'id\',\'sample\'}, but is \'samples\'") - + regexpr = "'year' failed: Must be of type 'integerish', not 'character'.", + fixed = TRUE) + expect_error( get_holiday(year = 2023, - type = c("non_workday", "public_holiday", - "sat_to_sun", "workday"), - exclude_trapped_days = "easter", + type = c("public_holiday"), + exclude_trapped_days = "exclude", output = "selected"), - regexpr = "Variable \'adjusted_sample\': Must be of type \'character\', not \'double\'") - + regexpr = "{'easter','trapped','xmas'}, but has additional elements", + fixed = TRUE) + expect_error( get_holiday(year = 2023, - type = c("non_workday", "public_holiday", - "sat_to_sun", "workday"), + type = c("sat_to_sun"), exclude_trapped_days = "easter", - output = "selected"), - regexpr = "Variable \'adjust_by\': Element 1 is not >= 1") - + output = c("raw", "fhi")), + regexpr = "argument 'pattern' has length > 1", + fixed = TRUE) + + expect_error( + get_holiday(year = 2023, + type = c("sat_to_sun"), + exclude_trapped_days = "easter", + output = "csdata"), + regexpr = "{'cstime','fhi','raw','selected'}, but is 'csdata'", + fixed = TRUE) + + options(width = unlist(linewidth)) }) From 0400a3e15673d7b839c319eb955c79b200ffbb4f Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 18 Dec 2023 07:03:48 +0100 Subject: [PATCH 33/50] test: Corrected test_get_holiday Was dependent on fixing NVIcheckmate::match_arg first. --- tests/testthat/test_get_holiday.R | 62 +++++++++++++++---------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/tests/testthat/test_get_holiday.R b/tests/testthat/test_get_holiday.R index 987c87d..802164b 100644 --- a/tests/testthat/test_get_holiday.R +++ b/tests/testthat/test_get_holiday.R @@ -2,19 +2,19 @@ library(OKplan) library(testthat) test_that("Output public_holiday from get_holiday", { - + # Selects the public holidays public_holidays <- get_holiday(year = 2000, type = "public_holiday") - + expect_identical(public_holidays$date, as.Date(c("2000-01-01", "2000-04-16", "2000-04-20", "2000-04-21", "2000-04-23", "2000-04-24", "2000-05-01", "2000-05-17", "2000-06-01", "2000-06-11", "2000-06-12", "2000-12-25", "2000-12-26"), format = "%Y-%m-%d")) - - + + public_holidays <- get_holiday(year = 2024, type = "public_holiday") expect_identical(public_holidays$date, @@ -23,7 +23,7 @@ test_that("Output public_holiday from get_holiday", { "2024-05-01", "2024-05-09", "2024-05-17", "2024-05-19", "2024-05-20", "2024-12-25", "2024-12-26"), format = "%Y-%m-%d")) - + public_holidays <- get_holiday(year = 2025, type = "public_holiday") expect_identical(public_holidays$date, @@ -35,7 +35,7 @@ test_that("Output public_holiday from get_holiday", { }) test_that("Output trapped workdays from get_holiday", { - + # Selects workdays except the trapped days in 2000 workdays <- get_holiday(year = 2000, type = "workday", @@ -44,7 +44,7 @@ test_that("Output trapped workdays from get_holiday", { trapped <- workdays[which(workdays$trapped == "t"), "date"] expect_identical(trapped, as.Date(c("2000-06-02"), format = "%Y-%m-%d")) - + # Selects workdays except the trapped days and days off in easter and xmas workdays <- get_holiday(year = 2000, type = "workday", @@ -53,11 +53,11 @@ test_that("Output trapped workdays from get_holiday", { trapped <- workdays[which(!is.na(workdays$trapped)), "date"] expect_identical(trapped, as.Date(c("2000-04-17", "2000-04-18", "2000-04-19", - "2000-06-02", "2000-12-24", "2000-12-25", - "2000-12-26", "2000-12-27", "2000-12-28", - "2000-12-29", "2000-12-30", "2000-12-31"), + "2000-06-02", "2000-12-24", "2000-12-25", + "2000-12-26", "2000-12-27", "2000-12-28", + "2000-12-29", "2000-12-30", "2000-12-31"), format = "%Y-%m-%d")) - + # Selects workdays except the trapped days in 2024 workdays <- get_holiday(year = 2024, type = "workday", @@ -66,7 +66,7 @@ test_that("Output trapped workdays from get_holiday", { trapped <- workdays[which(workdays$trapped == "t"), "date"] expect_identical(trapped, as.Date(c("2024-05-10", "2024-12-27"), format = "%Y-%m-%d")) - + # Selects workdays except the trapped days and days off in easter and xmas workdays <- get_holiday(year = 2024, type = "workday", @@ -75,11 +75,11 @@ test_that("Output trapped workdays from get_holiday", { trapped <- workdays[which(!is.na(workdays$trapped)), "date"] expect_identical(trapped, as.Date(c("2024-03-25", "2024-03-26", "2024-03-27", - "2024-05-10", "2024-12-22", "2024-12-23", - "2024-12-24", "2024-12-25", "2024-12-26", - "2024-12-27", "2024-12-28", "2024-12-29", + "2024-05-10", "2024-12-22", "2024-12-23", + "2024-12-24", "2024-12-25", "2024-12-26", + "2024-12-27", "2024-12-28", "2024-12-29", "2024-12-30", "2024-12-31"), format = "%Y-%m-%d")) - + # Selects workdays except the trapped days in 2025 workdays <- get_holiday(year = 2025, type = "workday", @@ -88,7 +88,7 @@ test_that("Output trapped workdays from get_holiday", { trapped <- workdays[which(workdays$trapped == "t"), "date"] expect_identical(trapped, as.Date(c("2025-05-02", "2025-05-30"), format = "%Y-%m-%d")) - + # Selects workdays except the trapped days and days off in easter and xmas workdays <- get_holiday(year = 2025, type = "workday", @@ -97,20 +97,20 @@ test_that("Output trapped workdays from get_holiday", { trapped <- workdays[which(!is.na(workdays$trapped)), "date"] expect_identical(trapped, as.Date(c("2025-04-14", "2025-04-15", "2025-04-16", - "2025-05-02", "2025-05-30", "2025-12-21", - "2025-12-22", "2025-12-23", "2025-12-24", - "2025-12-25", "2025-12-26", "2025-12-27", - "2025-12-28", "2025-12-29", "2025-12-30", + "2025-05-02", "2025-05-30", "2025-12-21", + "2025-12-22", "2025-12-23", "2025-12-24", + "2025-12-25", "2025-12-26", "2025-12-27", + "2025-12-28", "2025-12-29", "2025-12-30", "2025-12-31"), format = "%Y-%m-%d")) - + }) test_that("Errors for get_holiday ", { - + linewidth <- options("width") options(width = 80) - + expect_error( get_holiday(year = 2023, type = "weekend", @@ -118,7 +118,7 @@ test_that("Errors for get_holiday ", { output = "selected"), regexpr = "Variable 'type': Must be element of set", fixed = TRUE) - + expect_error( get_holiday(year = 2023, type = c("non_workday", "public_holiday", @@ -127,7 +127,7 @@ test_that("Errors for get_holiday ", { output = "selected"), regexpr = "Variable 'type': Must have length 1, but has length 4", fixed = TRUE) - + expect_error( get_holiday(year = "2023", type = c("non_workday"), @@ -135,7 +135,7 @@ test_that("Errors for get_holiday ", { output = "selected"), regexpr = "'year' failed: Must be of type 'integerish', not 'character'.", fixed = TRUE) - + expect_error( get_holiday(year = 2023, type = c("public_holiday"), @@ -143,15 +143,15 @@ test_that("Errors for get_holiday ", { output = "selected"), regexpr = "{'easter','trapped','xmas'}, but has additional elements", fixed = TRUE) - + expect_error( get_holiday(year = 2023, type = c("sat_to_sun"), exclude_trapped_days = "easter", output = c("raw", "fhi")), - regexpr = "argument 'pattern' has length > 1", + regexpr = "Variable 'output': Must have length 1, but has length 2", fixed = TRUE) - + expect_error( get_holiday(year = 2023, type = c("sat_to_sun"), @@ -159,6 +159,6 @@ test_that("Errors for get_holiday ", { output = "csdata"), regexpr = "{'cstime','fhi','raw','selected'}, but is 'csdata'", fixed = TRUE) - + options(width = unlist(linewidth)) }) From b04281a4d5ac0d1002f2c4d20c9bec415a1775c0 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Mon, 18 Dec 2023 07:04:56 +0100 Subject: [PATCH 34/50] fix: imported OK_column_standards Previous import had probably partly failed. --- data/OK_column_standards.rda | Bin 2339 -> 2439 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/data/OK_column_standards.rda b/data/OK_column_standards.rda index a231c92a7d8cfbd8656ed664f3eec3c174fc9955..f5127399c5e3a9718d227101429ca61068209b95 100644 GIT binary patch delta 2437 zcmV;033~RU5{DBJLRx4!F+o`-Q&~U78q5GOOOX*Be-54(%?eV0pb08~00M%500000 zC@D;U(WZkYhJXM705kvq0000095e$!0iZMnfB*n#qfG#0001;;kYk2`XaF<@fY1N{ z4K!(>41fRzjWP^y&4-5Y^a~KDlv!#Wf;OfYvawSeK-|9oTdA@ zEd!6ww#6$7BoS5$sA`b~edJM*L0J)GL75{mqx%?|$q#EKTd}rC#u#s0^V zrUb}h2#!oeEe$B3Mij*qkg--6V;`-G(EdlT?RhQUE!($pa8l`%sdjW#rd6{Ar|M}2 zcD8TE8PLND;$O^as>()|%8SILr6wGJe;H|%Q>*(pHWxi}^=xcn3J?i9G#8a7m?hZ>{VTe#dohSv%EJ4 z*1x+L){{l!>u$DUr^e?-PuSPp?_C*ydi=ZSDOmVm!yI@Gjr>CNkn z)?{NDqK~n$b{6~E@Y6A7nL2K=vtw&sZY}o9fnszlO+D!E52Mvb3{wxo(dHv0V=6xL^tMs8FLZOh1oRWY(PsgSD`)2q z@Zl%QrQ7NCdo$?k?fUzayw3B-5@uLfSHR@orp=6J=Fd95BBP%tdfamyTs|~67qs>J zPg7>vXvK_nX{HThf7a&V+4dKhzQBJ8Ik~(TlQEFzPGB7hjnuqUcprR>J_qA8_-tp< zCq~Y+`2KUyy(;l4H%|!4cpUAB$DQ)Lh3Th8JKc7pyJx!L6LD|4YYR-w%xK&z2db|1 zcsW4XSAl8V{7=C8-Og^V_j@}YhKxK8)+vE;35Y*ia^_F;e;kwe{R!o8%0>oI8BD}9 zvFA^EpBcd~j04mGg+`QOuZ4$LKw!akqVfUfD+Rn@1_{m=$`0vziFm#hE=`{BxH>w# zsZS#v0ruK{uJXFJl6}kP%F`OBtUrV|0x{LUXj9FtMeF-Dtb?Cl+@DBIT^t{W8w*v}{R54aZ zCOHq-e2Fn(Ojw`maOPZ(ewQR*<<>UKIj7}LSCWHx0jpLMPCbTLemo-1YE;U@U5 zC~vn8e>EFz!)WnxcBR~76^j_qyN3rn%$+PTejxjb=r|?qL-Nz^J(AG-uSk3a%qx;l zz?&z_UPAYZp2)zR7utz13V=a8DF!A2KX)Fa9O5Sf&f=J0IfpNPATO=)4}c zohINN5qTx=zL9;TUzx9A}!28mkE(Nhz*{7h& ze{vTk55KYTRJ`y1x+dtb*{97XWgEGRqA_C{_jA96YXOe*cebfz85QS>_D1WlxC@J) z%6!R`z4y4_adSPud_Aow;%?~0A8cN?fIMDx&!GArZM&+cM^Jhczu;f#G^xODba~8E z7%XNBX0eSVCB&nJJUn!&-B)SO=ESZlxr^sg$yS)z z)l*C%>1+>jyj(-_Iyt<}++3LLV%1X^%l0p)iJx0ie(g z217xne+p7W5CmjRFovT^>UlDoRQ(1~ku-V@Mnh^~Vl^96+LK47pRpo+bh59jtLnt@ z$&Z&K-N}@DF)eN&dGbqIO#8MF8*~5@&;o)Eh?gtCLz{gOFF?Xs6ht-#Wwq)q4nzc{ zK*NbQ1ePE~bfn`TMmhvlWl)wfM6&=eqd5U4e>j?gnFUOR^yqRQkeu0QgP1u6hyVn% zLL?keDm21{QZYa!af-+xA!$W4k%mHG<%9vA)BylV`(h~l%j{;FU78&MN6=q|F^1~uffwPF1(cGMSVU^lp$iQ zFvdSq6`}nPVb=4l-e&FFxi~3v#Hn@ke=5@|*@Dyj+C#4QFL6{c#R8slNte8H~(~ z%*JG~iJ8F}i0$Cmx|m*KMfQgoOtl<8q?>S;`I(=lrw=dLlw2C*Bef7y$U z*qe3lk5Ra3%+qs*5ygvX!xtlBZpCcUs=N5{b#fbGYbx1s=5Xgu8AfGWH*cOzahx0` z&05Uai%!k?Zg=xr<~q4IbvZd_j!RBnUOfw|Y;-w1OB!%}3{Dx(TD6&$W$lf}QHrOie;Goi85G4bl$c>-DNJHmtg6N^!x*esSjkGK=f`Fh zDY`N#%PMG$h{RxGn5!zgmwV9Cb&mDtdP+3#cpYvl-Am576moSpa9$^3cCl4;BNf`e z%j@k8!T$yNagAv-UOtxVW=eUz0jz46pAI81F^FRpF&UYR#4{O*W-81Xf11r^Wh~0| zQ#~2bQEGeJ_ z&2wZ+++;v)6_my{RAjQhe?JG{eGk6k;$J(D-2dL~oE!mux?#5-I~T8z|adfzItc;>&vSzYu??!ll>Y?t1g&==Oa5YF<6=)~SriOv1hQ zCjA>WF`rgNUs-n-)(%ci<|NEy zIa8HYT*{5qycBmIe>oU?&%9~x*v@S_De!+e-n@$Pl^xOCbF@Y~-(}!0Ejh9BIyR%T zXSm@Lac`Jmuvc2UoDq4>;?uGBpF`(%Il7&$#&tZc75PqiR%%2g-KPQzp zri)9eCEE2Ve|j4{MeKa2(F4vvr-MO?z%BsqbSg^(@!aoa}b}=Ih0&r>4^_JCFv30r? zHew8Y_f2|L9;O9+!;={L4oCYqs=fO1yO_tBj&BUi%*^VE(B!8V0CPy$gl$dBJ4(hg zc4|InW8id)fAO;!RxB}y_{5KEv!Qbjo|KFRk~PIVxf_d$&c22DKTM8SfBE5 z$he-FayPKu;xXL*2KPlh$Z5!5ai=y@oqR7uedpd$)T8hy(vK^lAFUd7x|10vlTHn4 zlgWi#CL5$F;fV2O6rs zD8jZV>b=GFSG!K9L%oeV+craHQrYpfzHWvol5@puyIdsS6~ztq;l`tFxNROTPPDrW zVzFZy7hvG$nUkW!7u^quTczwn@KfS?h5MHyaa7BP%&^CiHeg**Ios@+#n&gR6fD!Gf~ zQpHU%v$<1DA>h~^dhu}&rO@W?ZsO#}TNbLA#%E(IjV+_HWS(41ER^Qd% zWH8Uo!}|e#(0oY~6rb1+Dm~*K^SF7*e$F3Mpjf9W?2N2K46l6xVw@m2f~Dg H)e)tTTEJ-L From 3021edd8f619ec0b9d1049ec111a8363e74bd566 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:49:41 +0100 Subject: [PATCH 35/50] test: corrected bug in test_adjust_samples_to_budget The tests for errors did not test for specific errors. --- tests/testthat/test_adjust_samples_to_budget.R | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test_adjust_samples_to_budget.R b/tests/testthat/test_adjust_samples_to_budget.R index a805276..c9ed4ec 100644 --- a/tests/testthat/test_adjust_samples_to_budget.R +++ b/tests/testthat/test_adjust_samples_to_budget.R @@ -76,6 +76,9 @@ test_that("Adjusting sample number", { test_that("Errors for adjust_sample_number", { + linewidth <- options("width") + options(width = 80) + total_budget <- 150 # Add data frame with sample number to adjust x <- as.data.frame(cbind(c(1:10), @@ -88,7 +91,7 @@ test_that("Errors for adjust_sample_number", { sample_to_adjust = "sample", adjusted_sample = "new_sample", adjust_by = 6), - regexpr = "Variable \'data\': Must be of type \'data.frame\'") + regexp = "Variable \'data\': Must be of type \'data.frame\'") expect_error( adjust_samples_to_budget(data = x, @@ -96,7 +99,7 @@ test_that("Errors for adjust_sample_number", { sample_to_adjust = "sample", adjusted_sample = "new_sample", adjust_by = 6), - regexpr = "Variable \'budget\': Element 1 is not >= 1") + regexp = "Element 1 is not >= 1") expect_error( adjust_samples_to_budget(data = x, @@ -104,7 +107,8 @@ test_that("Errors for adjust_sample_number", { sample_to_adjust = "samples", adjusted_sample = "new_sample", adjust_by = 6), - regexpr = "Variable \'sample_to_adjust\': Must be element of set {\'id\',\'sample\'}, but is \'samples\'") + regexp = "Variable 'sample_to_adjust': Must be element of set {'id','sample'},", + fixed = TRUE) expect_error( adjust_samples_to_budget(data = x, @@ -112,7 +116,7 @@ test_that("Errors for adjust_sample_number", { sample_to_adjust = "sample", adjusted_sample = total_budget, adjust_by = 6), - regexpr = "Variable \'adjusted_sample\': Must be of type \'character\', not \'double\'") + regexp = "Variable \'adjusted_sample\': Must be of type \'character\', not") expect_error( adjust_samples_to_budget(data = x, @@ -120,6 +124,7 @@ test_that("Errors for adjust_sample_number", { sample_to_adjust = "sample", adjusted_sample = "new_sample", adjust_by = 0), - regexpr = "Variable \'adjust_by\': Element 1 is not >= 1") + regexp = "Variable \'adjust_by\': Element 1 is not >= 1") + options(width = unlist(linewidth)) }) From c7f66631bcd93f5464ade433199b26fa836105cf Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:50:07 +0100 Subject: [PATCH 36/50] test: corrected bug in test_get_holiday The tests for errors did not test for specific errors. --- tests/testthat/test_get_holiday.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test_get_holiday.R b/tests/testthat/test_get_holiday.R index 802164b..02074f6 100644 --- a/tests/testthat/test_get_holiday.R +++ b/tests/testthat/test_get_holiday.R @@ -116,7 +116,7 @@ test_that("Errors for get_holiday ", { type = "weekend", exclude_trapped_days = "easter", output = "selected"), - regexpr = "Variable 'type': Must be element of set", + regexp = "Variable 'type': Must be element of set", fixed = TRUE) expect_error( @@ -125,7 +125,7 @@ test_that("Errors for get_holiday ", { "sat_to_sun", "workday"), exclude_trapped_days = "easter", output = "selected"), - regexpr = "Variable 'type': Must have length 1, but has length 4", + regexp = "Variable 'type': Must have length 1, but has length 4", fixed = TRUE) expect_error( @@ -133,7 +133,7 @@ test_that("Errors for get_holiday ", { type = c("non_workday"), exclude_trapped_days = "easter", output = "selected"), - regexpr = "'year' failed: Must be of type 'integerish', not 'character'.", + regexp = "'year' failed: Must be of type 'integerish', not 'character'.", fixed = TRUE) expect_error( @@ -141,7 +141,7 @@ test_that("Errors for get_holiday ", { type = c("public_holiday"), exclude_trapped_days = "exclude", output = "selected"), - regexpr = "{'easter','trapped','xmas'}, but has additional elements", + regexp = "{'easter','trapped','xmas'}, but has additional elements", fixed = TRUE) expect_error( @@ -149,7 +149,7 @@ test_that("Errors for get_holiday ", { type = c("sat_to_sun"), exclude_trapped_days = "easter", output = c("raw", "fhi")), - regexpr = "Variable 'output': Must have length 1, but has length 2", + regexp = "Variable 'output': Must have length 1, but has length 2", fixed = TRUE) expect_error( @@ -157,7 +157,7 @@ test_that("Errors for get_holiday ", { type = c("sat_to_sun"), exclude_trapped_days = "easter", output = "csdata"), - regexpr = "{'cstime','fhi','raw','selected'}, but is 'csdata'", + regexp = "{'cstime','fhi','raw','selected'}, but is 'csdata'", fixed = TRUE) options(width = unlist(linewidth)) From 9d2f3f6b663901d74ad383bb32128bc336acf4b5 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:51:44 +0100 Subject: [PATCH 37/50] refactor: changed adjust_samples_to_budget Removed most occurrences of .data$ --- R/adjust_samples_to_budget.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/adjust_samples_to_budget.R b/R/adjust_samples_to_budget.R index 2a8186a..3b9e91a 100644 --- a/R/adjust_samples_to_budget.R +++ b/R/adjust_samples_to_budget.R @@ -123,10 +123,13 @@ adjust_samples_to_budget <- function(data, dplyr::mutate(total_estimated = sum(dplyr::across(dplyr::all_of(sample_to_adjust)), na.rm = TRUE)) %>% dplyr::mutate(included = dplyr::case_when(dplyr::across(dplyr::all_of(sample_to_adjust)) > 0 ~ 1, TRUE ~ 0)) %>% - dplyr::mutate(n_units = sum(.data$included, na.rm = TRUE)) %>% + # dplyr::mutate(n_units = sum(.data$included, na.rm = TRUE)) %>% + dplyr::mutate(n_units = sum(dplyr::across(dplyr::all_of("included")), na.rm = TRUE)) %>% dplyr::mutate(difference = .data$total_estimated - as.numeric(.data$budget)) %>% + # dplyr::mutate(difference = as.numeric(dplyr::all_of("total_estimated")) - as.numeric(dplyr::all_of("budget"))) %>% # This don't work dplyr::ungroup() %>% - dplyr::group_by(dplyr::across(dplyr::all_of(group)), .data$included) %>% + # dplyr::group_by(dplyr::across(dplyr::all_of(group)), .data$included) %>% + dplyr::group_by(dplyr::across(dplyr::all_of(c(group, "included")))) %>% dplyr::mutate(n_seq = 1:dplyr::n()) %>% dplyr::ungroup() From d0f0e9bb3ec83a2c525cc631c514e3473ee6263b Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:53:26 +0100 Subject: [PATCH 38/50] fix: corrected get_tested_herds --- R/get_tested_herds.R | 78 ++++++++++++++++++++++++-------------------- 1 file changed, 43 insertions(+), 35 deletions(-) diff --git a/R/get_tested_herds.R b/R/get_tested_herds.R index d5f475e..81e710d 100644 --- a/R/get_tested_herds.R +++ b/R/get_tested_herds.R @@ -96,52 +96,60 @@ get_tested_herds <- function(eos_table, dfx <- subset(dfx, dfx$driftsform %in% production) } - column_ant <- grep("ant_", colnames(dfx), value = TRUE) - column_sum <- gsub("ant_", "sum_", column_ant) - for (column_name in column_ant) { - dfx[, column_name] <- as.numeric(dfx[, column_name]) - } - agg_dfx <- stats::aggregate(x = dfx[, column_ant], by = list(dfx$eier_lokalitetnr), FUN = "sum") + if (dim(dfx)[1] > 0) { + column_ant <- grep("ant_", colnames(dfx), value = TRUE) + column_sum <- gsub("ant_", "sum_", column_ant) + for (column_name in column_ant) { + dfx[, column_name] <- as.numeric(dfx[, column_name]) + } + + agg_dfx <- stats::aggregate(x = dfx[, column_ant], by = list(dfx$eier_lokalitetnr), FUN = "sum", na.rm = TRUE) - colnames(agg_dfx) <- c("eier_lokalitetnr", column_sum) - dfx <- merge(dfx, agg_dfx, by = "eier_lokalitetnr") + colnames(agg_dfx) <- c("eier_lokalitetnr", column_sum) + dfx <- merge(dfx, agg_dfx, by = "eier_lokalitetnr") - # Select herd above minimum number of samples - if (min_prover > -1) { - if (isFALSE(tested)) { - if (any(isTRUE(grep("sum_prover", column_sum)))) { - dfx <- subset(dfx, dfx$sum_prover >= min_prover) - } else { - if (length(column_sum) == 1) { - dfx <- subset(dfx, dfx[, "column_sum"] >= min_prover) - warning(paste("The number of received samples could not be calculated,", - "but the number of tested samples were calculated using", - paste(column_ant, collapse = ", "))) + # Select herd above minimum number of samples + if (min_prover > -1) { + if (isFALSE(tested)) { + if (any(grepl("sum_prover", column_sum))) { + dfx <- subset(dfx, dfx$sum_prover >= min_prover) } else { - stop(paste0("The number of received samples could not be calculated, ", - "and the number of tested samples were given in the columns ", - paste(column_ant, collapse = ", "), - ". You need to specify the disease to calculate the number of tested samples.")) + if (length(column_sum) == 1) { + dfx <- subset(dfx, dfx[, column_sum] >= min_prover) + warning(paste("The number of received samples could not be calculated,", + "but the number of tested samples were calculated using", + paste(column_ant, collapse = ", "))) + } else { + stop(paste0("The number of received samples could not be calculated, ", + "and the number of tested samples were given in the columns ", + paste(column_ant, collapse = ", "), + ". You need to specify the disease to calculate the number of tested samples.")) + } } } - } - if (isTRUE(tested)) { - if (any(isTRUE(grep(paste0("sum_und_", tolower(disease)), column_sum)))) { - dfx <- subset(dfx, dfx[, paste0("sum_und_", tolower(disease))] >= min_prover) - } else { - if (length(column_sum) == 1) { - dfx <- subset(dfx, dfx[, "column_sum"] >= min_prover) - warning(paste("The number of tested samples were calculated using", column_ant)) + if (isTRUE(tested)) { + if (any(grepl(paste0("sum_und_", tolower(disease), "$"), column_sum))) { + dfx <- subset(dfx, dfx[, paste0("sum_und_", tolower(disease))] >= min_prover) } else { - stop(paste0("The number of tested samples were given in the columns ", - paste(column_ant, collapse = ", "), - ". You need to specify the disease to calculate the number of tested samples.")) + if (length(column_sum) == 1) { + dfx <- subset(dfx, dfx[, column_sum] >= min_prover) + if (!any(grepl(paste0("sum_und_", tolower(disease)), column_sum))) { + warning(paste("The number of tested samples were calculated using", column_ant)) + } + } else { + stop(paste0("The number of tested samples were given in the columns ", + paste(column_ant, collapse = ", "), + ". You need to specify the disease to calculate the number of tested samples.")) + } } } } - dfx <- subset(dfx, dfx[, paste0("sum_und_", tolower(disease))] >= min_prover) } + if (dim(dfx)[1] == 0) { + warning(paste("There where no saker fulfilling the selection criterea.", + "Please check the selection criterea.")) + } # Sorts data in original order and removes sort key dfx <- dfx[order(dfx$original_sort_order), ] dfx$original_sort_order <- NULL From 311a5f613ba5dbe4118bbe2e6a5162b1e5482f1c Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:54:37 +0100 Subject: [PATCH 39/50] style: styled spaces in get_holiday --- R/get_holiday.R | 54 ++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/R/get_holiday.R b/R/get_holiday.R index 654bea8..0cf95a4 100644 --- a/R/get_holiday.R +++ b/R/get_holiday.R @@ -79,9 +79,9 @@ #' exclude_trapped_days = c("easter", "xmas")) #' get_holiday <- function(year, - type = "workday", - exclude_trapped_days = FALSE, - output = "selected") { + type = "workday", + exclude_trapped_days = FALSE, + output = "selected") { ### ARGUMENT CHECKING ---- # Object to store check-results @@ -104,10 +104,10 @@ get_holiday <- function(year, checkmate::check_subset(exclude_trapped_days, choices = c("easter", "trapped", "xmas")), add = checks) output <- NVIcheckmate::match_arg(x = output, - choices = c("cstime", "fhi", "raw", "selected"), - several.ok = FALSE, - ignore.case = TRUE, - add = checks) + choices = c("cstime", "fhi", "raw", "selected"), + several.ok = FALSE, + ignore.case = TRUE, + add = checks) # Report check-results checkmate::reportAssertions(checks) @@ -141,7 +141,7 @@ get_holiday <- function(year, ### CATEGORISE INTO HOLIDAYS ---- # create data frame with all dates for year[i] dates <- as.data.frame(matrix(data = c(as.Date(paste0(year, "-01-01")):as.Date(paste0(year, "-12-31"))), - dimnames = list(NULL, "date"))) + dimnames = list(NULL, "date"))) dates$date <- as.Date(dates$date, origin = "1970-01-01") # Assign weekday number @@ -185,28 +185,28 @@ get_holiday <- function(year, ### SELECT ROWS TO REPORT ---- if (output == "selected") { - if ("sat_to_sun" %in% type) { - dates[which(dates$sat_to_sun == 1), "select"] <- 1 - } - if ("public_holiday" %in% type) { - dates[which(dates$public_holiday == 1), "select"] <- 1 - } - if ("non_workday" %in% type) { - dates[which(dates$non_workday == 1), "select"] <- 1 - } - if ("workday" %in% type) { - dates[which(dates$workday == 1), "select"] <- 1 - if ("easter" %in% exclude_trapped_days) { - dates[which(dates$trapped == "e"), "select"] <- 0 + if ("sat_to_sun" %in% type) { + dates[which(dates$sat_to_sun == 1), "select"] <- 1 } - if ("xmas" %in% exclude_trapped_days) { - dates[which(dates$trapped == "x"), "select"] <- 0 + if ("public_holiday" %in% type) { + dates[which(dates$public_holiday == 1), "select"] <- 1 } - - if ("trapped" %in% exclude_trapped_days | isTRUE(exclude_trapped_days)) { - dates[which(dates$trapped == "t"), "select"] <- 0 + if ("non_workday" %in% type) { + dates[which(dates$non_workday == 1), "select"] <- 1 + } + if ("workday" %in% type) { + dates[which(dates$workday == 1), "select"] <- 1 + if ("easter" %in% exclude_trapped_days) { + dates[which(dates$trapped == "e"), "select"] <- 0 + } + if ("xmas" %in% exclude_trapped_days) { + dates[which(dates$trapped == "x"), "select"] <- 0 + } + + if ("trapped" %in% exclude_trapped_days | isTRUE(exclude_trapped_days)) { + dates[which(dates$trapped == "t"), "select"] <- 0 + } } - } dates <- subset(dates, dates$select == 1) dates <- dates[, c("date", "day_of_week")] } From c7e97db437b6252d79c8f686849bc31fc75d5c5a Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:55:36 +0100 Subject: [PATCH 40/50] test: created test_get_tested_herds --- tests/testthat/test_get_tested_herds.R | 192 +++++++++++++++++++++++++ 1 file changed, 192 insertions(+) create mode 100644 tests/testthat/test_get_tested_herds.R diff --git a/tests/testthat/test_get_tested_herds.R b/tests/testthat/test_get_tested_herds.R new file mode 100644 index 0000000..6641bd0 --- /dev/null +++ b/tests/testthat/test_get_tested_herds.R @@ -0,0 +1,192 @@ +library(NVIdb) +library(OKplan) +library(testthat) +library(checkmate) + + +test_that("get tested herds for virus swine", { + # skip if no connection to 'EOS' have been established + skip_if_not(dir.exists(set_dir_NVI("EOS"))) + + tested <- get_tested_herds(eos_table = "proveresultat_virusinfeksjoner", + year = 2022, + tested = FALSE) + expect_data_frame(tested, nrow = 1065, ncol = 31) + + tested <- get_tested_herds(eos_table = "proveresultat_virusinfeksjoner", + year = 2022, + min_prover = 8, + tested = FALSE) + expect_data_frame(tested, nrow = 565, ncol = 31) + + tested <- get_tested_herds(eos_table = "proveresultat_virusinfeksjoner", + year = 2022, + disease = "AD", + min_prover = 8, + tested = TRUE) + expect_data_frame(tested, nrow = 565, ncol = 31) + +}) + +test_that("get tested herds for scrapie", { + # skip if no connection to 'EOS' have been established + skip_if_not(dir.exists(set_dir_NVI("EOS"))) + + tested <- get_tested_herds(eos_table = "proveresultat_scrapie", + year = 2022, + tested = FALSE) + expect_data_frame(tested, nrow = 20623, ncol = 28) + + tested <- expect_warning(get_tested_herds(eos_table = "proveresultat_scrapie", + year = 2022, + min_prover = 2, + tested = FALSE), + regexp = "The number of received samples could not be calculated") + expect_data_frame(tested, nrow = 18481, ncol = 28) + + tested <- get_tested_herds(eos_table = "proveresultat_scrapie", + year = 2022, + species = "Sau", + min_prover = 2, + tested = TRUE) + expect_data_frame(tested, nrow = 17915, ncol = 28) + +}) + +test_that("get tested herds for virus in cattle", { + # skip if no connection to 'EOS' have been established + skip_if_not(dir.exists(set_dir_NVI("EOS"))) + + tested <- get_tested_herds(eos_table = "proveresultat_bvd_ebl_ibr", + year = 2022, + tested = FALSE) + expect_data_frame(tested, nrow = 3010, ncol = 22) + + tested <- get_tested_herds(eos_table = "proveresultat_bvd_ebl_ibr", + year = 2022, + production = "Melkeproduksjon", + tested = FALSE) + expect_data_frame(tested, nrow = 1211, ncol = 22) + + tested <- get_tested_herds(eos_table = "proveresultat_bvd_ebl_ibr", + year = 2022, + min_prover = 2, + production = "Melkeproduksjon", + tested = FALSE) + expect_data_frame(tested, nrow = 234, ncol = 22) + + tested <- get_tested_herds(eos_table = "proveresultat_bvd_ebl_ibr", + year = 2022, + disease = "ibr", + min_prover = 5, + tested = TRUE) + expect_data_frame(tested, nrow = 577, ncol = 22) + + tested <- expect_warning(get_tested_herds(eos_table = "proveresultat_bvd_ebl_ibr", + year = 2022, + production = "Melk", + tested = FALSE), + regexp = "There where no saker fulfilling the selection criterea") + expect_data_frame(tested, nrow = 0, ncol = 18) + +}) + +test_that("get tested herds for paratuberculosis in ruminants", { + # skip if no connection to 'EOS' have been established + skip_if_not(dir.exists(set_dir_NVI("EOS"))) + + tested <- get_tested_herds(eos_table = "proveresultat_paratuberkulose", + year = 2022, + tested = FALSE) + expect_data_frame(tested, nrow = 279, ncol = 18) + + tested <- get_tested_herds(eos_table = "proveresultat_paratuberkulose", + year = 2022, + min_prover = 5, + tested = FALSE) + expect_data_frame(tested, nrow = 273, ncol = 18) + + tested <- expect_warning(get_tested_herds(eos_table = "proveresultat_paratuberkulose", + year = 2022, + species = "Alpakka", + min_prover = 1, + tested = TRUE), + regexp = "The number of tested samples were calculated using ant_prover") + expect_data_frame(tested, nrow = 1, ncol = 18) + + tested <- expect_warning(get_tested_herds(eos_table = "proveresultat_paratuberkulose", + year = 2022, + species = "Alpakka", + min_prover = 2, + tested = TRUE), + regexp = "There where no saker fulfilling the selection criterea") + expect_data_frame(tested, nrow = 0, ncol = 18) + +}) + + +test_that("Errors for get_tested_herds", { + + linewidth <- options("width") + options(width = 80) + + expect_error( + get_tested_herds(eos_table = "proveresultat_rubish", + year = 2022, + tested = FALSE), + regexp = "Variable 'file.path(from_path, paste0(eos_table, ", + fixed = TRUE) + + expect_error( + get_tested_herds(eos_table = "proveresultat_paratuberkulose", + year = 1990, + tested = FALSE), + regexp = "Element 1 is not >= 1995.", + fixed = TRUE) + + expect_error( + get_tested_herds(eos_table = "proveresultat_paratuberkulose", + year = 2022, + tested = "FALSE"), + regexp = "Must be of type 'logical flag'", + fixed = TRUE) + + expect_error( + get_tested_herds(eos_table = "proveresultat_virusinfeksjoner", + year = 2022, + disease = "ebl", + tested = TRUE, + min_prover = 100), + regexp = "You need to specify the disease", + fixed = TRUE) + + expect_error( + get_tested_herds(eos_table = "proveresultat_virusinfeksjoner", + year = 2022, + disease = "ad", + tested = TRUE, + min_prover = "100"), + regexp = "Must be of type 'integerish'", + fixed = TRUE) + + expect_error( + get_tested_herds(eos_table = "proveresultat_scrapie", + year = 2022, + species = FALSE, + tested = TRUE, + min_prover = 1), + regexp = "Must be of type 'character'", + fixed = TRUE) + + expect_error( + get_tested_herds(eos_table = "proveresultat_bvd_ebl_ibr", + year = 2022, + production = FALSE, + tested = TRUE, + min_prover = 1), + regexp = "Must be of type 'character'", + fixed = TRUE) + + + options(width = unlist(linewidth)) +}) From 8129b11ffa59cc279fc9220d6ee27d70b42ff925 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:57:09 +0100 Subject: [PATCH 41/50] chore: updated dependencies in DESCRIPTION Requires NVIcheckmate v0.7.3 (fixed match_arg) --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c241c15..8705228 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,7 @@ Imports: rlang, stats, NVIbatch (>= 0.4.0), - NVIcheckmate (>= 0.6.0), + NVIcheckmate (>= 0.7.3), NVIdb (>= 0.3.0), NVIpretty (>= 0.4.0), OKcheck From f186a099514f9ebe91b9517ee7d6c97870c2b851 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:57:42 +0100 Subject: [PATCH 42/50] chore: updated NEWS with fix and features --- NEWS | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index a8109dc..1f327cb 100644 --- a/NEWS +++ b/NEWS @@ -3,12 +3,12 @@ OKplan 0.6.1.9000 - (2023-##-##) New features: -- Created get_holiday to get the non-workdays or workdays within one year. +- Created `get_holiday` to get the "non-workdays" or "workdays" within one year. Bug fixes: -- To come. +- Fixed several bugs in `get_tested_herds`. Other changes: From 86e7bf2952ea9dd67f175fb695849bc455b9efa8 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 06:59:26 +0100 Subject: [PATCH 43/50] chore: updated copyright years in LICENSE --- LICENSE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LICENSE b/LICENSE index a527b52..31e9e44 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright (c) 2020 - 2023 Norwegian Veterinary Institute +Copyright (c) 2020 - 2024 Norwegian Veterinary Institute All rights reserved. Redistribution and use in source and binary forms, with or without From b164f78388c928e9484add1a9622f616ddc8e556 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 07:02:46 +0100 Subject: [PATCH 44/50] doc: updated README from template --- README.md | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 74c812d..fcbbbb2 100644 --- a/README.md +++ b/README.md @@ -29,16 +29,30 @@ for more information. [GitHub](https://github.com/NorwegianVeterinaryInstitute). To install `OKplan` you will need: -- R version > 4.0.0 +- R version > 4.0.0 - R package `remotes` -- Rtools 4.0 or Rtools 4.2 depending on R version +- Rtools version 4.0, 4.2 or 4.3 depending on R version First install and attach the `remotes` package. install.packages("remotes") library(remotes) -To install (or update) the `OKplan` package, run the following code: +To install (or update) the `OKplan` package without vignettes, run the +following code: + + remotes::install_github("NorwegianVeterinaryInstitute/OKplan", + upgrade = FALSE, + build = TRUE, + build_vignettes = FALSE) + +To install (or update) the `OKplan` package with vignettes, you will +need to first install some additional R-packages needed for creating the +vignettes. Check README below in the section [Vignettes](#vignettes) to +see which vignettes are available. To install the package with the +vignettes, first install the packages: `knitr`, `rmarkdown`, `R.rsp`, +and `NVIrpackages` (from GitHub) if they are missing. Then run the +following code: remotes::install_github("NorwegianVeterinaryInstitute/OKplan", upgrade = FALSE, @@ -82,7 +96,7 @@ for information on new features, bug fixes and other changes. ## Copyright and license -Copyright (c) 2021 - 2023 Norwegian Veterinary Institute. +Copyright (c) 2021 - 2024 Norwegian Veterinary Institute. Licensed under the BSD\_3\_clause License. See [License](https://github.com/NorwegianVeterinaryInstitute/OKplan/blob/main/LICENSE) for details. From 25da6fef8714d14c3b923b85c157502a77ae14cc Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 07:03:41 +0100 Subject: [PATCH 45/50] chore: updated CONTRIBUTING and Contribute_to_OKplan from template --- CONTRIBUTING.md | 38 ++++++++++++++++++++---------- vignettes/Contribute_to_OKplan.Rmd | 4 ++-- 2 files changed, 27 insertions(+), 15 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 4f955ef..20f885c 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -29,52 +29,62 @@ data reporting at the Norwegian Veterinary Institute (NVI). NVIconfig Private -Configuration information necessary for some NVIverse functions +Configuration information necessary for +some NVIverse functions NVIdb Public -Tools to facilitate the use of NVI’s databases +Tools to facilitate the use of NVI’s +databases NVIspatial Public -Tools to facilitate working with spatial data at NVI +Tools to facilitate working with spatial +data at NVI NVIpretty Public -Tools to make R-output pretty in accord with NVI’s graphical profile +Tools to make R-output pretty in accord +with NVI’s graphical profile NVIbatch Public -Tools to facilitate the running of R-scripts in batch mode at NVI +Tools to facilitate the running of +R-scripts in batch mode at NVI OKplan Public -Tools to facilitate the planning of surveillance programmes for the NFSA +Tools to facilitate the planning of +surveillance programmes for the NFSA OKcheck Public -Tools to facilitate checking of data from national surveillance programmes +Tools to facilitate checking of data from +national surveillance programmes NVIcheckmate Public -Extension of checkmate with argument checking adapted for NVIverse +Extension of checkmate with argument +checking adapted for NVIverse NVIpackager Public -Tools to facilitate the development of NVIverse packages +Tools to facilitate the development of +NVIverse packages NVIrpackages Public -Keeps a table of the R-Packages in NVIverse +Keeps a table of the R packages in +NVIverse @@ -147,9 +157,11 @@ development guidelines below. ## Development guidelines -If you want to contribute code, you are welcome to do so. Please try to -adhere to some principles and style convention used for -`NVIverse`-packages. +If you want to contribute code, you are welcome to do so. You will find +a description of the code conventions, which have been used, in the +vignette “NVIverse code conventions” in the package `NVIpackager`. A +summary of the principles and style convention used for +`NVIverse`-packages is given below. - Please limit the number of package dependencies for `OKplan`. The use of base functions is much appreciated. diff --git a/vignettes/Contribute_to_OKplan.Rmd b/vignettes/Contribute_to_OKplan.Rmd index 51ed7fe..1ace584 100644 --- a/vignettes/Contribute_to_OKplan.Rmd +++ b/vignettes/Contribute_to_OKplan.Rmd @@ -1,6 +1,7 @@ --- output: rmarkdown::html_vignette: + css: "NVI_vignette_style.css" keep_md: true md_document: variant: markdown_github @@ -79,8 +80,7 @@ Care to fix bugs or implement new functionality for our_package? Great! Have a l ## Development guidelines -If you want to contribute code, you are welcome to do so. Please try to adhere -to some principles and style convention used for `NVIverse`-packages. +If you want to contribute code, you are welcome to do so. You will find a description of the code conventions, which have been used, in the vignette "NVIverse code conventions" in the package `NVIpackager`. A summary of the principles and style convention used for `NVIverse`-packages is given below. * Please limit the number of package dependencies for `r NVIpkg_inline`. The use of base functions is much appreciated. From f8f3c033b46bc210ea2116335d5b95503e9f5ac8 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 07:40:32 +0100 Subject: [PATCH 46/50] doc: improved help for OK_column_standards --- R/data.R | 13 +++++++------ man/OK_column_standards.Rd | 13 +++++++------ 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/data.R b/R/data.R index 6f38aa5..a1b8af0 100644 --- a/R/data.R +++ b/R/data.R @@ -1,11 +1,12 @@ #' @title Data: Column standards for OK sampling plans. #' -#' @description A data frame with the column standards for data frames and Excel -#' sheets produced when planning of the Norwegian surveillance programmes. -#' The raw data for the column standards can be edited in the original Excel -#' table. The the code for preparing of the data frame is written in -#' "./data-raw/generate_OK_column_standards". The \code{OK_column_standards} -#' is used as input for +#' @description A data frame with the column standards for data frames +#' and Excel sheets produced when planning the sampling schemes for +#' the Norwegian surveillance programmes. The raw data for the column +#' standards can be edited in the original Excel table. The code for +#' preparing of the data frame is written in +#' "./data-raw/generate_OK_column_standards". The +#' \code{OK_column_standards} is used as input for #' \ifelse{html}{\code{\link[NVIdb]{standardize_columns}}}{\code{NVIdb::standardize_columns}}. #' #' @format A data frame with 14 variables: diff --git a/man/OK_column_standards.Rd b/man/OK_column_standards.Rd index 7a7edcc..9175e70 100644 --- a/man/OK_column_standards.Rd +++ b/man/OK_column_standards.Rd @@ -32,12 +32,13 @@ A data frame with 14 variables: OK_column_standards } \description{ -A data frame with the column standards for data frames and Excel - sheets produced when planning of the Norwegian surveillance programmes. - The raw data for the column standards can be edited in the original Excel - table. The the code for preparing of the data frame is written in - "./data-raw/generate_OK_column_standards". The \code{OK_column_standards} - is used as input for +A data frame with the column standards for data frames + and Excel sheets produced when planning the sampling schemes for + the Norwegian surveillance programmes. The raw data for the column + standards can be edited in the original Excel table. The code for + preparing of the data frame is written in + "./data-raw/generate_OK_column_standards". The + \code{OK_column_standards} is used as input for \ifelse{html}{\code{\link[NVIdb]{standardize_columns}}}{\code{NVIdb::standardize_columns}}. } \examples{ From 270f3dd7bcb0fb4f0f1e3d9c0baf7ee37aeab54a Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 07:41:32 +0100 Subject: [PATCH 47/50] doc: corrected help for get_tested_herds year accepts a vector. --- R/get_tested_herds.R | 2 +- man/get_tested_herds.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/get_tested_herds.R b/R/get_tested_herds.R index 81e710d..6b089ed 100644 --- a/R/get_tested_herds.R +++ b/R/get_tested_herds.R @@ -24,7 +24,7 @@ #' @param eos_table [\code{character(1)}]\cr #' EOS table name. -#' @param year [\code{numeric(1)}]\cr +#' @param year [\code{numeric}]\cr #' One or more years that should be selected. Defaults #' to previous year. #' @param species [\code{character}]\cr diff --git a/man/get_tested_herds.Rd b/man/get_tested_herds.Rd index 4a59b34..714a8c8 100644 --- a/man/get_tested_herds.Rd +++ b/man/get_tested_herds.Rd @@ -18,7 +18,7 @@ get_tested_herds( \item{eos_table}{[\code{character(1)}]\cr EOS table name.} -\item{year}{[\code{numeric(1)}]\cr +\item{year}{[\code{numeric}]\cr One or more years that should be selected. Defaults to previous year.} From 9cae49e94401a1a39bf868f7025f9f91caca43aa Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 07:42:57 +0100 Subject: [PATCH 48/50] doc: improved help for write_ok_selection_list Included link and corrected typos. --- R/write_ok_selection_list.R | 13 +++++++------ man/write_ok_selection_list.Rd | 13 +++++++------ 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/write_ok_selection_list.R b/R/write_ok_selection_list.R index 9022fc1..3efa166 100644 --- a/R/write_ok_selection_list.R +++ b/R/write_ok_selection_list.R @@ -4,15 +4,16 @@ #' selected units is standardised and formatted in order to be submitted #' without further formatting. #' @details The data must originate from an "okplan" file and -#' the function uses standardize_columns to select, order, format and -#' style the columns. The formatting information is either taken -#' from \code{\link{OK_column_standards}} or can be input as -#' a list. +#' the function uses +#' \ifelse{html}{\code{\link[NVIdb]{standardize_columns}}}{\code{NVIdb::standardize_columns}} +#' to select, order, format and style the columns. The formatting +#' information is either taken from \code{\link{OK_column_standards}} or +#' can be input as a list. #' #' When using \code{\link{OK_column_standards}}, the formatting information is #' taken in accord with the argument \code{dbsource}. If the formatting #' needs to be edited, it must be edited in the general source file for -#' column standards and thereafter, built into a new version of \code{OKplan}. +#' column standards and thereafter, build it into a new version of \code{OKplan}. #' As this can be a tedious process, there is a possibility to input the #' formatting information as a list. #' @@ -43,7 +44,7 @@ #' #' When \code{calculate_sum} is \code{TRUE}, a line with the sum will be appended. #' The default is to calculate the sum of the column "ant_prover". If the sum -#' should be calculated for one or more other columns, you may give thecolumn +#' should be calculated for one or more other columns, you may give the column #' names as input to the argument \code{column} that will be passed to #' \code{\link{append_sum_line}}. The sum will only be appended for columns #' that exist in the data. diff --git a/man/write_ok_selection_list.Rd b/man/write_ok_selection_list.Rd index 1268acc..36872bf 100644 --- a/man/write_ok_selection_list.Rd +++ b/man/write_ok_selection_list.Rd @@ -63,15 +63,16 @@ The sampling plan is output to an Excel sheet. The list with } \details{ The data must originate from an "okplan" file and - the function uses standardize_columns to select, order, format and - style the columns. The formatting information is either taken - from \code{\link{OK_column_standards}} or can be input as - a list. + the function uses + \ifelse{html}{\code{\link[NVIdb]{standardize_columns}}}{\code{NVIdb::standardize_columns}} + to select, order, format and style the columns. The formatting + information is either taken from \code{\link{OK_column_standards}} or + can be input as a list. When using \code{\link{OK_column_standards}}, the formatting information is taken in accord with the argument \code{dbsource}. If the formatting needs to be edited, it must be edited in the general source file for - column standards and thereafter, built into a new version of \code{OKplan}. + column standards and thereafter, build it into a new version of \code{OKplan}. As this can be a tedious process, there is a possibility to input the formatting information as a list. @@ -102,7 +103,7 @@ All vectors must have the same order and the same length. When \code{calculate_sum} is \code{TRUE}, a line with the sum will be appended. The default is to calculate the sum of the column "ant_prover". If the sum - should be calculated for one or more other columns, you may give thecolumn + should be calculated for one or more other columns, you may give the column names as input to the argument \code{column} that will be passed to \code{\link{append_sum_line}}. The sum will only be appended for columns that exist in the data. From c2624b232791a06a1ac973415423b4d1b7001232 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 07:53:01 +0100 Subject: [PATCH 49/50] doc: improved help for get_holiday Corrected and styled information for the argument output in details. --- R/get_holiday.R | 4 ++-- man/get_holiday.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/get_holiday.R b/R/get_holiday.R index 0cf95a4..1f148ff 100644 --- a/R/get_holiday.R +++ b/R/get_holiday.R @@ -39,8 +39,8 @@ #' trapped \tab character \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr #' } #' -#' When \code{output} %in% c("fhi", "cstime") the data frame is -#' formatted as the table cstime::nor_workdays_by_date +#' When \code{output \%in\%} \code{c("fhi", "cstime")} the data frame is +#' formatted as the table \code{cstime::nor_workdays_by_date} #' created by National Public Health Institute (FHI). #' #' The function is limited to years from 1968, as before 1968 diff --git a/man/get_holiday.Rd b/man/get_holiday.Rd index b091cef..0bcdf78 100644 --- a/man/get_holiday.Rd +++ b/man/get_holiday.Rd @@ -71,8 +71,8 @@ Get the non-workdays or workdays within one year. trapped \tab character \tab trapped days (t), Easter week days (e) and/or Xmas week days (x) otherwise NA. \cr } - When \code{output} %in% c("fhi", "cstime") the data frame is - formatted as the table cstime::nor_workdays_by_date + When \code{output \%in\%} \code{c("fhi", "cstime")} the data frame is + formatted as the table \code{cstime::nor_workdays_by_date} created by National Public Health Institute (FHI). The function is limited to years from 1968, as before 1968 From 0c5a5be82ba9bc04ee01f0f2ef4ad0f5110fd911 Mon Sep 17 00:00:00 2001 From: Petter Hopp Date: Fri, 5 Jan 2024 08:07:10 +0100 Subject: [PATCH 50/50] chore: NEWS and DESCRIPTION v0.7.0 --- DESCRIPTION | 4 ++-- NEWS | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8705228..57b0fab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: OKplan Title: Tools to facilitate the Planning of the annual Surveillance Programmes -Version: 0.6.1.9000 -Date: 2023-##-## +Version: 0.7.0 +Date: 2024-01-05 Authors@R: c(person(given = "Petter", family = "Hopp", diff --git a/NEWS b/NEWS index 1f327cb..632c178 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -OKplan 0.6.1.9000 - (2023-##-##) +OKplan 0.7.0 - (2024-01-05) ---------------------------------------- New features: