diff --git a/.Rbuildignore b/.Rbuildignore index 0d60c6b..d5786df 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,9 +1,12 @@ ^phsmethods\.Rproj$ ^\.Rproj\.user$ ^README\.Rmd$ +^README\.html$ ^README-.*\.png$ ^data-raw$ ^\.github$ ^_pkgdown\.yml$ ^docs$ ^pkgdown$ +^cran-comments\.md$ +^CRAN-SUBMISSION$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 5b5ee01..7dc5e06 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -29,16 +29,19 @@ jobs: - {os: ubuntu-latest, r: 'release', must_pass: true} # Development and recent releases - - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release', must_pass: false} - - {os: ubuntu-latest, r: 'oldrel-1', must_pass: true} - - {os: ubuntu-latest, r: 'oldrel-2', must_pass: true} + - {os: windows-latest, r: 'devel', http-user-agent: 'release', must_pass: true} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release', must_pass: true} + - {os: ubuntu-latest, r: 'oldrel-1', must_pass: false} + - {os: ubuntu-latest, r: 'oldrel-2', must_pass: false} # An approximation for the PHS RStudio Desktop installation - {os: windows-latest, r: '3.6.1', must_pass: true} + - {os: windows-latest, r: '4.0.1', must_pass: true} - # An approximation of the PHS RStudio Server Pro setup + # An approximation of the PHS RStudio setup on Posit Workbench - {os: ubuntu-latest, r: '3.6.1', must_pass: true} - - {os: ubuntu-latest, r: '3.5.1', must_pass: false} + - {os: ubuntu-latest, r: '4.0.2', must_pass: true} + - {os: ubuntu-latest, r: '4.1.2', must_pass: true} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/render-README.yaml b/.github/workflows/render-README.yaml index 610b90f..61f745a 100644 --- a/.github/workflows/render-README.yaml +++ b/.github/workflows/render-README.yaml @@ -33,14 +33,20 @@ jobs: - name: Render README.Rmd run: Rscript -e 'rmarkdown::render("README.Rmd")' - - name: Commit and create a Pull Request + - name: Commit and create a Pull Request on master + if: ${{ github.ref == 'refs/heads/master' }} uses: peter-evans/create-pull-request@v4 with: - add-paths: README.md - commit-message: Render `README.md` after changes to the `.Rmd` version - branch: render_readme + commit-message: "Automated re-knit of the README" + branch: document_master delete-branch: true - title: Automated re-knit of the README + title: Re-knit README.md due to changes made to README.Rmd labels: documentation,Maintainance assignees: ${{ github.actor }} reviewers: ${{ github.actor }} + + - name: Commit and push changes on all other branches + if: ${{ github.ref != 'refs/heads/master' }} + uses: stefanzweifel/git-auto-commit-action@v4 + with: + commit_message: "Automated re-knit of the README" diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 6f5abde..79b902d 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -5,10 +5,8 @@ on: branches: - 'main' - 'master' - pull_request: - - 'main' - - 'master' - 'dev**' + pull_request: name: test-coverage diff --git a/.gitignore b/.gitignore index 0d7f03b..f76801d 100644 --- a/.gitignore +++ b/.gitignore @@ -2,5 +2,6 @@ .Rhistory .RData .Ruserdata +*.html docs inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index 66ade97..8d89c82 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: phsmethods -Title: Standard Methods for use in Public Health Scotland -Version: 0.2.3 +Title: Standard Methods for Use in Public Health Scotland +Version: 1.0.0 Authors@R: c( - person("Public Health Scotland", , , "phs.source@phs.scot", role = "cph"), + person("Public Health Scotland", , , "phs.datascience@phs.scot", role = "cph"), person("David", "Caldwell", , "David.Caldwell@phs.scot", role = "aut"), person("Lucinda", "Lawrie", , "Lucinda.Lawrie@phs.scot", role = "rev"), person("Jack", "Hannah", , "jack.hannah2@phs.scot", role = "aut"), @@ -17,13 +17,16 @@ Authors@R: c( comment = c(ORCID = "0000-0002-5380-2029")), person("Nicolaos", "Christofidis", , "nicolaos.christofidis@phs.scot", role = "aut") ) -Description: Bespoke functions for commonly undertaken analytical tasks in - Public Health Scotland. +Description: A collection of methods for commonly undertaken analytical + tasks, primarily developed for Public Health Scotland (PHS) analysts, + but the package is also generally useful to others working in the + healthcare space, particularly since it has functions for working with + Community Health Index (CHI) numbers. The package can help to make + data manipulation and analysis more efficient and reproducible. License: GPL (>= 2) URL: https://github.com/Public-Health-Scotland/phsmethods, https://public-health-scotland.github.io/phsmethods/ -BugReports: - https://github.com/Public-Health-Scotland/phsmethods/issues +BugReports: https://github.com/Public-Health-Scotland/phsmethods/issues Depends: R (>= 2.10) Imports: @@ -32,7 +35,6 @@ Imports: lifecycle, lubridate, magrittr, - purrr, readr, rlang, scales (>= 1.0.0), @@ -53,5 +55,6 @@ Config/testthat/edition: 3 Encoding: UTF-8 Language: en-GB LazyData: true +Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 VignetteBuilder: knitr diff --git a/NEWS.md b/NEWS.md index ba6a8c6..df40860 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# phsmethods 1.0.0 (2023-09-26) + +- This is the first new major release to CRAN. + # phsmethods 0.2.3 (2023-09-11) - The [{gdata}](https://github.com/r-gregmisc/gdata) import has been dropped and replaced with [{scales}](https://scales.r-lib.org/). diff --git a/R/age_calculate.R b/R/age_calculate.R index 06a82be..6671fa8 100644 --- a/R/age_calculate.R +++ b/R/age_calculate.R @@ -1,17 +1,23 @@ #' Calculate age between two dates #' -#' @description This function calculates the age between two dates using functions in \code{lubridate}. -#' It calculates age in either years or months. +#' @description This function calculates the age between two dates using +#' functions in `lubridate`. It calculates age in either years or months. #' -#' @param start A start date (e.g. date of birth) which must be supplied with \code{Date} or \code{POSIXct} or \code{POSIXlt} -#' class. \code{\link[base:as.Date]{as.Date()}}, -#' \code{\link[lubridate:ymd]{lubridate::dmy()}} and -#' \code{\link[base:as.POSIXlt]{as.POSIXct()}} are examples of functions which +#' @param start A start date (e.g. date of birth) which must be supplied with +#' `Date` or `POSIXct` or `POSIXlt` +#' class. [base::as.Date()], +#' [`lubridate::dmy()`][lubridate::ymd] and +#' [`as.POSIXct()`][base::as.POSIXlt] are examples of functions which #' can be used to store dates as an appropriate class. -#' @param end An end date which must be supplied with \code{Date} or \code{POSIXct} or \code{POSIXlt} class. -#' Default is \code{Sys.Date()} or \code{Sys.time()} depending on the class of \code{start}. -#' @param units Type of units to be used. years and months are accepted. Default is \code{years}. -#' @param round_down Should returned ages be rounded down to the nearest whole number. Default is \code{TRUE}. +#' @param end An end date which must be supplied with `Date` or `POSIXct` or +#' `POSIXlt` class. Default is `Sys.Date()` or `Sys.time()` depending on the +#' class of `start`. +#' @param units Type of units to be used. years and months are accepted. +#' Default is `years`. +#' @param round_down Should returned ages be rounded down to the nearest whole +#' number. Default is `TRUE`. +#' +#' @return A numeric vector representing the ages in the given units. #' #' @examples #' library(lubridate) @@ -20,7 +26,8 @@ #' age_calculate(birth_date, end_date) #' age_calculate(birth_date, end_date, units = "months") #' -#' # If the start day is leap day (February 29th), age increases on 1st March every year. +#' # If the start day is leap day (February 29th), age increases on 1st March +#' # every year. #' leap1 <- lubridate::ymd("2020-02-29") #' leap2 <- lubridate::ymd("2022-02-28") #' leap3 <- lubridate::ymd("2022-03-01") @@ -28,9 +35,16 @@ #' age_calculate(leap1, leap2) #' age_calculate(leap1, leap3) #' @export -age_calculate <- function(start, end = if (lubridate::is.Date(start)) Sys.Date() else Sys.time(), - units = c("years", "months"), round_down = TRUE) { - make_inheritance_checks(list(start = start, end = end), target_classes = c("Date", "POSIXt"), ignore_null = FALSE) +age_calculate <- function( + start, + end = if (lubridate::is.Date(start)) Sys.Date() else Sys.time(), + units = c("years", "months"), + round_down = TRUE) { + make_inheritance_checks( + list(start = start, end = end), + target_classes = c("Date", "POSIXt"), + ignore_null = FALSE + ) units <- match.arg(tolower(units), c("years", "months")) diff --git a/R/chi_check.R b/R/chi_check.R index 477ce48..1f45fdd 100644 --- a/R/chi_check.R +++ b/R/chi_check.R @@ -1,7 +1,7 @@ #' @title Check the validity of a CHI number #' -#' @description \code{chi_check} takes a CHI number or a vector of CHI numbers -#' with \code{character} class. It returns feedback on the validity of the +#' @description `chi_check` takes a CHI number or a vector of CHI numbers +#' with `character` class. It returns feedback on the validity of the #' entered CHI number and, if found to be invalid, provides an explanation as #' to why. #' @@ -16,44 +16,46 @@ #' even for female. The tenth digit is a check digit, denoted `checksum`. #' #' While a CHI number is made up exclusively of numeric digits, it cannot be -#' stored with \code{numeric} class in R. This is because leading zeros in +#' stored with `numeric` class in R. This is because leading zeros in #' numeric values are silently dropped, a practice not exclusive to R. For this -#' reason, \code{chi_check} accepts input values of \code{character} class +#' reason, `chi_check` accepts input values of `character` class #' only. A leading zero can be added to a nine-digit CHI number using -#' \code{\link{chi_pad}}. +#' [chi_pad()]. #' -#' \code{chi_check} assesses whether an entered CHI number is valid by checking +#' `chi_check` assesses whether an entered CHI number is valid by checking #' whether the answer to each of the following criteria is `Yes`: #' -#' \itemize{ -#' \item Does it contain no non-numeric characters? -#' \item Is it ten digits in length? -#' \item Do the first six digits denote a valid date? -#' \item Is the checksum digit correct? -#' } +#' * Does it contain no non-numeric characters? +#' * Is it ten digits in length? +#' * Do the first six digits denote a valid date? +#' * Is the checksum digit correct? #' -#' @param x a CHI number or a vector of CHI numbers with \code{character} class. +#' @param x a CHI number or a vector of CHI numbers with `character` class. #' -#' @return \code{chi_check} returns a character string. Depending on the +#' @return `chi_check` returns a character string. Depending on the #' validity of the entered CHI number, it will return one of the following: #' -#' \itemize{ -#' \item `Valid CHI` -#' \item `Invalid character(s) present` -#' \item `Too many characters` -#' \item `Too few characters` -#' \item `Invalid date` -#' \item `Invalid checksum` -#' \item `Missing (NA)` -#' \item `Missing (Blank)` -#' } +#' * `Valid CHI` +#' * `Invalid character(s) present` +#' * `Too many characters` +#' * `Too few characters` +#' * `Invalid date` +#' * `Invalid checksum` +#' * `Missing (NA)` +#' * `Missing (Blank)` #' #' @examples #' chi_check("0101011237") #' chi_check(c("0101201234", "3201201234")) #' #' library(dplyr) -#' df <- tibble(chi = c("3213201234", "123456789", "12345678900", "010120123?", NA)) +#' df <- tibble(chi = c( +#' "3213201234", +#' "123456789", +#' "12345678900", +#' "010120123?", +#' NA +#' )) #' df %>% #' mutate(validity = chi_check(chi)) #' @export diff --git a/R/chi_pad.R b/R/chi_pad.R index 1a35609..4babb33 100644 --- a/R/chi_pad.R +++ b/R/chi_pad.R @@ -1,7 +1,7 @@ #' @title Add a leading zero to nine-digit CHI numbers #' -#' @description \code{chi_pad} takes a nine-digit CHI number with -#' \code{character} class and prefixes it with a zero. Any values provided +#' @description `chi_pad` takes a nine-digit CHI number with +#' `character` class and prefixes it with a zero. Any values provided #' which are not a string comprised of nine numeric digits remain unchanged. #' #' @details The Community Health Index (CHI) is a register of all patients in @@ -14,21 +14,24 @@ #' zero. #' #' While a CHI number is made up exclusively of numeric digits, it cannot be -#' stored with \code{numeric} class in R. This is because leading zeros in +#' stored with `numeric` class in R. This is because leading zeros in #' numeric values are silently dropped, a practice not exclusive to R. For this -#' reason, \code{chi_pad} accepts input values of \code{character} class +#' reason, `chi_pad` accepts input values of `character` class #' only, and returns values of the same class. It does not assess the validity -#' of a CHI number - please see \code{\link{chi_check}} for that. +#' of a CHI number - please see [chi_check()] for that. #' #' @inheritParams chi_check #' +#' @return The original character vector with CHI numbers padded if applicable. +#' #' @examples #' chi_pad(c("101011237", "101201234")) #' @export - chi_pad <- function(x) { if (!inherits(x, "character")) { - cli::cli_abort("The input must be a {.cls character} vector, not a {.cls {class(x)}} vector.") + cli::cli_abort( + "The input must be a {.cls character} vector, not a {.cls {class(x)}} vector." + ) } # Add a leading zero to any string comprised of nine numeric digits diff --git a/R/create_age_groups.R b/R/create_age_groups.R index 76ae9a7..4f2ef79 100644 --- a/R/create_age_groups.R +++ b/R/create_age_groups.R @@ -1,31 +1,31 @@ #' Create age groups #' #' @description -#' \code{create_age_groups()} takes a numeric vector and assigns each age to the +#' `create_age_groups()` takes a numeric vector and assigns each age to the #' appropriate age group. #' #' @param x a vector of numeric values -#' @param from the start of the smallest age group. The default is \code{0}. -#' @param to the end point of the age groups. The default is \code{90}. -#' @param by the size of the age groups. The default is \code{5}. +#' @param from the start of the smallest age group. The default is `0`. +#' @param to the end point of the age groups. The default is `90`. +#' @param by the size of the age groups. The default is `5`. #' @param as_factor The default behaviour is to return a character vector. Use -#' \code{TRUE} to return a factor vector instead. +#' `TRUE` to return a factor vector instead. #' #' @return A character vector, where each element is the age group for the -#' corresponding element in \code{x}. If \code{as_factor = TRUE}, a factor +#' corresponding element in `x`. If `as_factor = TRUE`, a factor #' vector is returned instead. #' #' @details -#' The \code{from}, \code{to} and \code{by} values are used to create distinct -#' age groups. \code{from} dictates the starting age of the lowest age group, -#' and \code{by} indicates how wide each group should be. \code{to} stipulates +#' The `from`, `to` and `by` values are used to create distinct +#' age groups. `from` dictates the starting age of the lowest age group, +#' and `by` indicates how wide each group should be. `to` stipulates #' the cut-off point at which all ages equal to or greater than this value -#' should be categorised together in a \code{to+} group. If the specified value -#' of \code{to} is not a multiple of \code{by}, the value of \code{to} is -#' rounded down to the nearest multiple of \code{by}. +#' should be categorised together in a `to+` group. If the specified value +#' of `to` is not a multiple of `by`, the value of `to` is +#' rounded down to the nearest multiple of `by`. #' -#' The default values of \code{from}, \code{to} and \code{by} correspond to the -#' \href{https://www.opendata.nhs.scot/dataset/standard-populations/resource/edee9731-daf7-4e0d-b525-e4c1469b8f69}{European Standard Population} +#' The default values of `from`, `to` and `by` correspond to the +#' [European Standard Population](https://www.opendata.nhs.scot/dataset/standard-populations/resource/edee9731-daf7-4e0d-b525-e4c1469b8f69) #' age groups. #' #' @examples diff --git a/R/data.R b/R/data.R index 52a8cdf..28715f0 100644 --- a/R/data.R +++ b/R/data.R @@ -1,22 +1,22 @@ #' Codes and names of Scottish geographical and administrative areas. #' #' A dataset containing Scotland's geography codes and associated area names. -#' It is used within \code{\link{match_area}}. +#' It is used within [match_area()]. #' -#' @details \code{geo_code} contains geography codes pertaining to Health +#' @details `geo_code` contains geography codes pertaining to Health #' Boards, Council Areas, Health and Social Care Partnerships, Intermediate #' Zones, Data Zones (2001 and 2011), Electoral Wards, Scottish Parliamentary #' Constituencies, UK Parliamentary Constituencies, Travel to work areas, #' National Parks, Community Health Partnerships, Localities (S19), #' Settlements (S20) and Scotland. #' -#' @seealso The script used to create the \code{area_lookup} dataset on -#' \href{https://github.com/Public-Health-Scotland/phsmethods/blob/master/data-raw/area_lookup.R}{GitHub}. +#' @seealso The script used to create the `area_lookup` dataset on +#' [GitHub](https://github.com/Public-Health-Scotland/phsmethods/blob/master/data-raw/area_lookup.R). #' -#' @format A \code{\link[tibble]{tibble}} with 2 variables and over 17,000 rows: +#' @format A [tibble::tibble()] with 2 variables and over 17,000 rows: #' \describe{ #' \item{geo_code}{Standard geography code - 9 characters} #' \item{area_name}{Name of the area the code represents} #' } -#' @source \url{https://statistics.gov.scot/} +#' @source "area_lookup" diff --git a/R/dob_from_chi.R b/R/dob_from_chi.R index a5e928a..b0de730 100644 --- a/R/dob_from_chi.R +++ b/R/dob_from_chi.R @@ -1,17 +1,21 @@ #' @title Extract Date of Birth (DoB) from the CHI number #' -#' @description \code{dob_from_chi} takes a CHI number or a vector of CHI numbers -#' and returns the DoB as implied by the CHI number(s). If the DoB is ambiguous -#' it will return NA +#' @description `dob_from_chi` takes a CHI number or a vector of CHI numbers +#' and returns the Date of Birth (DoB) as implied by the CHI number(s). If the +#' DoB is ambiguous it will return NA. #' -#' @param chi_number a CHI number or a vector of CHI numbers with \code{character} class. -#' @param min_date,max_date optional min and/or max dates that the Date of Birth could take as the century needs to be guessed. -#' Must be either length 1 for a 'fixed' date or the same length as \code{chi_number} for a date per CHI number. -#' min_date can be date based on common sense in the dataset, whilst max_date can be date when an event happens such as discharge date. -#' @param chi_check logical, optionally skip checking the CHI for validity which will be -#' faster but should only be used if you have previously checked the CHI(s). The default (TRUE) will check the CHI numbers. +#' @param chi_number a CHI number or a vector of CHI numbers with `character` +#' class. +#' @param min_date,max_date optional min and/or max dates that the +#' DoB could take as the century needs to be guessed. Must be either length 1 +#' for a 'fixed' date or the same length as `chi_number` for a date +#' per CHI number. `min_date` can be date based on common sense in the dataset, +#' whilst `max_date` can be date when an event happens such as discharge date. +#' @param chi_check logical, optionally skip checking the CHI for validity which +#' will be faster but should only be used if you have previously checked the +#' CHI(s). The default (TRUE) will check the CHI numbers. #' -#' @return a date vector of DoB. It will be the same length as \code{chi_number}. +#' @return a date vector of DoB. It will be the same length as `chi_number`. #' @export #' #' @examples @@ -37,18 +41,29 @@ #' min_date = as.Date("1930-01-01"), #' max_date = adm_date #' )) -dob_from_chi <- function(chi_number, min_date = NULL, max_date = NULL, chi_check = TRUE) { +dob_from_chi <- function( + chi_number, + min_date = NULL, + max_date = NULL, + chi_check = TRUE) { # Do type checking on the params if (!inherits(chi_number, "character")) { - cli::cli_abort("{.arg chi_number} must be a {.cls character} vector, not a {.cls {class(chi_number)}} vector.") + cli::cli_abort( + "{.arg chi_number} must be a {.cls character} vector, not a {.cls {class(chi_number)}} vector." + ) } - make_inheritance_checks(list(min_date = min_date, max_date = max_date), target_classes = c("Date", "POSIXct")) + make_inheritance_checks( + list(min_date = min_date, max_date = max_date), + target_classes = c("Date", "POSIXct") + ) # min and max date are in a reasonable range if (!is.null(min_date) & !is.null(max_date)) { if (any(max_date < min_date)) { - cli::cli_abort("{.arg max_date}, must always be greater than or equal to {.arg min_date}.") + cli::cli_abort( + "{.arg max_date}, must always be greater than or equal to {.arg min_date}." + ) } } @@ -62,7 +77,9 @@ dob_from_chi <- function(chi_number, min_date = NULL, max_date = NULL, chi_check if (any(max_date > Sys.Date())) { to_replace <- max_date > Sys.Date() max_date[to_replace] <- Sys.Date() - cli::cli_warn(c("!" = "Any {.arg max_date} values which are in the future will be set to today: {.val {Sys.Date()}}.")) + cli::cli_warn( + c("!" = "Any {.arg max_date} values which are in the future will be set to today: {.val {Sys.Date()}}.") + ) } # Default the min_date to 1 Jan 1900 @@ -77,7 +94,9 @@ dob_from_chi <- function(chi_number, min_date = NULL, max_date = NULL, chi_check new_na_count <- sum(is.na(chi_number)) - na_count if (new_na_count > 0) { - cli::cli_alert_warning(("{format(new_na_count, big.mark = ',')}{cli::qty(new_na_count)} CHI number{?s} {?is/are} invalid and will be given {.val NA} for {?its/their} Date{?s} of Birth.")) + cli::cli_alert_warning( + ("{format(new_na_count, big.mark = ',')}{cli::qty(new_na_count)} CHI number{?s} {?is/are} invalid and will be given {.val NA} for {?its/their} Date{?s} of Birth.") + ) } } @@ -105,10 +124,12 @@ dob_from_chi <- function(chi_number, min_date = NULL, max_date = NULL, chi_check is.na(date_1900) ~ date_2000, # Invalid leap year date in 20XX. is.na(date_2000) ~ date_1900, - # When 20XX date is in the valid range and the 19XX date isn't, 20XX is guessed. + # When 20XX date is in the valid range and the 19XX date isn't, + # 20XX is guessed. (date_2000 >= min_date & date_2000 <= max_date) & !(date_1900 >= min_date & date_1900 <= max_date) ~ date_2000, - # When 19XX date is in the valid range and the 20XX date isn't, 19XX is guessed. + # When 19XX date is in the valid range and the 20XX date isn't, + # 19XX is guessed. (date_1900 >= min_date & date_1900 <= max_date) & !(date_2000 >= min_date & date_2000 <= max_date) ~ date_1900 )) @@ -127,19 +148,26 @@ dob_from_chi <- function(chi_number, min_date = NULL, max_date = NULL, chi_check #' @title Extract age from the CHI number #' -#' @description \code{age_from_chi} takes a CHI number or a vector of CHI numbers -#' and returns the age as implied by the CHI number(s). If the DoB is ambiguous -#' it will return NA. It uses \code{dob_from_chi}. +#' @description `age_from_chi` takes a CHI number or a vector of CHI numbers +#' and returns the age as implied by the CHI number(s). If the Date of Birth +#' (DoB) is ambiguous it will return NA. It uses [dob_from_chi()]. #' -#' @param chi_number a CHI number or a vector of CHI numbers with \code{character} class. -#' @param ref_date calculate the age at this date, default is to use \code{Sys.Date()} i.e. today. -#' @param min_age,max_age optional min and/or max dates that the Date of Birth could take as the century needs to be guessed. -#' Must be either length 1 for a 'fixed' age or the same length as \code{chi_number} for an age per CHI number. -#' min_age can be age based on common sense in the dataset, whilst max_age can be age when an event happens such as the age at discharge. -#' @param chi_check logical, optionally skip checking the CHI for validity which will be -#' faster but should only be used if you have previously checked the CHI(s), the default (TRUE) will to check the CHI numbers. +#' @param chi_number a CHI number or a vector of CHI numbers with `character` +#' class. +#' @param ref_date calculate the age at this date, default is to use +#' `Sys.Date()` i.e. today. +#' @param min_age,max_age optional min and/or max dates that the DoB could take +#' as the century needs to be guessed. +#' Must be either length 1 for a 'fixed' age or the same length as `chi_number` +#' for an age per CHI number. +#' `min_age` can be age based on common sense in the dataset, whilst `max_age` +#' can be age when an event happens such as the age at discharge. +#' @param chi_check logical, optionally skip checking the CHI for validity which +#' will be faster but should only be used if you have previously checked the +#' CHI(s), the default (TRUE) will to check the CHI numbers. #' -#' @return an integer vector of ages in years truncated to the nearest year. It will be the same length as \code{chi_number}. +#' @return an integer vector of ages in years truncated to the nearest year. +#' It will be the same length as `chi_number`. #' @export #' #' @examples @@ -167,7 +195,12 @@ dob_from_chi <- function(chi_number, min_date = NULL, max_date = NULL, chi_check #' mutate(chi_age = age_from_chi(chi, #' ref_date = dis_date #' )) -age_from_chi <- function(chi_number, ref_date = NULL, min_age = 0, max_age = NULL, chi_check = TRUE) { +age_from_chi <- function( + chi_number, + ref_date = NULL, + min_age = 0, + max_age = NULL, + chi_check = TRUE) { # Do type checking on the params if (!inherits(chi_number, "character")) { cli::cli_abort("{.arg chi_number} must be a {.cls character} vector, not a {.cls {class(chi_number)}} vector.") diff --git a/R/extract_fin_year.R b/R/extract_fin_year.R index 2a74537..69be46a 100644 --- a/R/extract_fin_year.R +++ b/R/extract_fin_year.R @@ -1,44 +1,36 @@ #' @title Extract the formatted financial year from a date #' -#' @description \code{extract_fin_year} takes a date and extracts the +#' @description `extract_fin_year` takes a date and extracts the #' correct financial year in the PHS specified format from it. #' #' @details The PHS accepted format for financial year is YYYY/YY e.g. 2017/18. #' -#' @param date A date which must be supplied with \code{Date} or \code{POSIXct} -#' class. \code{\link[base:as.Date]{as.Date()}}, -#' \code{\link[lubridate:ymd]{lubridate::dmy()}} and -#' \code{\link[base:as.POSIXlt]{as.POSIXct()}} are examples of functions which +#' @param date A date which must be supplied with `Date`, `POSIXct`, `POSIXlt` or +#' `POSIXt` class. [base::as.Date()], +#' [`lubridate::dmy()`][lubridate::ymd] and +#' [`as.POSIXct()`][base::as.POSIXlt] are examples of functions which #' can be used to store dates as an appropriate class. #' +#' @return A character vector of financial years in the form '2017/18'. +#' #' @examples #' x <- lubridate::dmy(c(21012017, 04042017, 17112017)) #' extract_fin_year(x) #' @export extract_fin_year <- function(date) { - if (!inherits(date, c("Date", "POSIXct"))) { - cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, + if (!inherits(date, c("Date", "POSIXt"))) { + cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXt} vector, not a {.cls {class(date)}} vector.") } - # Simply converting all elements of the input vector resulted in poor - # performance for large vectors. The function was rewritten to extract - # a vector of unique elements from the input, convert those to financial year - # and then match them back on to the original input. This vastly improves - # performance for large inputs. - - unique_date <- unique(date) - - unique_fy_q <- - lubridate::year(unique_date) - (lubridate::month(unique_date) %in% 1:3) - - unique_fy <- ifelse( - is.na(unique_date), - NA_character_, - paste0(unique_fy_q, "/", (unique_fy_q %% 100L) + 1L) - ) - - fin_years <- unique_fy[match(date, unique_date)] - - return(fin_years) + # Note: lubridate year and month coerce to double + # We only need integers for our purposes + posix <- as.POSIXlt(date, tz = lubridate::tz(date)) + y <- posix$year + 1900L + m <- posix$mon + fy <- y - (m < 3L) + next_fy <- (fy + 1L) %% 100L + out <- sprintf("%.4d/%02d", fy, next_fy) + out[is.na(date)] <- NA_character_ + out } diff --git a/R/file_size.R b/R/file_size.R index 4f38bbe..c343d4a 100644 --- a/R/file_size.R +++ b/R/file_size.R @@ -1,58 +1,58 @@ #' @title Calculate file size #' -#' @description \code{file_size} takes a filepath and an optional regular +#' @description `file_size` takes a filepath and an optional regular #' expression pattern. It returns the size of all files within that directory #' which match the given pattern. #' #' @details The sizes of files with certain extensions are returned with the -#' type of file prefixed. For example, the size of a 12 KB \code{.xlsx} file is +#' type of file prefixed. For example, the size of a 12 KB `.xlsx` file is #' returned as `Excel 12 KB`. The complete list of explicitly catered-for file #' extensions and their prefixes are as follows: #' #' \itemize{ -#' \item \code{.xls}, \code{.xlsb}, \code{.xlsm} and \code{.xlsx} files are +#' \item `.xls`, `.xlsb`, `.xlsm` and `.xlsx` files are #' prefixed with `Excel` -#' \item \code{.csv} files are prefixed with `CSV` -#' \item \code{.sav} and \code{.zsav} files are prefixed with `SPSS` -#' \item \code{.doc}, \code{.docm} and \code{.docx} files are prefixed with +#' \item `.csv` files are prefixed with `CSV` +#' \item `.sav` and `.zsav` files are prefixed with `SPSS` +#' \item `.doc`, `.docm` and `.docx` files are prefixed with #' `Word` -#' \item \code{.rds} files are prefixed with `RDS` -#' \item \code{.txt} files are prefixed with `Text`, -#' \item \code{.fst} files are prefixed with `FST`, -#' \item \code{.pdf} files are prefixed with `PDF`, -#' \item \code{.tsv} files are prefixed with `TSV`, -#' \item \code{.html} files are prefixed with `HTML`, -#' \item \code{.ppt}, \code{.pptm} and \code{.pptx} files are prefixed with +#' \item `.rds` files are prefixed with `RDS` +#' \item `.txt` files are prefixed with `Text`, +#' \item `.fst` files are prefixed with `FST`, +#' \item `.pdf` files are prefixed with `PDF`, +#' \item `.tsv` files are prefixed with `TSV`, +#' \item `.html` files are prefixed with `HTML`, +#' \item `.ppt`, `.pptm` and `.pptx` files are prefixed with #' `PowerPoint`, -#' \item \code{.md} files are prefixed with `Markdown` +#' \item `.md` files are prefixed with `Markdown` #' } #' #' Files with extensions not contained within this list will have their size #' returned with no prefix. To request that a certain extension be explicitly #' catered for, please create an issue on -#' \href{https://github.com/Health-SocialCare-Scotland/phsmethods/issues}{GitHub}. +#' [GitHub](https://github.com/Public-Health-Scotland/phsmethods/issues). #' #' File sizes are returned as the appropriate multiple of the unit byte #' (bytes (B), kilobytes (KB), megabytes (MB), etc.). Each multiple is taken to #' be 1,024 units of the preceding denomination. #' #' @param filepath A character string denoting a filepath. Defaults to the -#' working directory, \code{getwd()}. +#' working directory, `getwd()`. #' @param pattern An optional character string denoting a -#' \code{\link[base:regex]{regular expression}} pattern. Only file names which -#' match the regular expression will be returned. See the \strong{See Also} +#' [`regular expression()`][base::regex] pattern. Only file names which +#' match the regular expression will be returned. See the **See Also** #' section for resources regarding how to write regular expressions. #' -#' @return A \code{\link[tibble]{tibble}} listing the names of files within -#' \code{filepath} which match \code{pattern} and their respective sizes. The -#' column names of this tibble are `name` and `size`. If no \code{pattern} is -#' specified, \code{file_size} returns the names and sizes of all files within -#' \code{filepath}. File names and sizes are returned in alphabetical order of -#' file name. Sub-folders contained within \code{filepath} will return a file +#' @return A [tibble::tibble()] listing the names of files within +#' `filepath` which match `pattern` and their respective sizes. The +#' column names of this tibble are `name` and `size`. If no `pattern` is +#' specified, `file_size` returns the names and sizes of all files within +#' `filepath`. File names and sizes are returned in alphabetical order of +#' file name. Sub-folders contained within `filepath` will return a file #' size of `0 B`. #' -#' If \code{filepath} is an empty folder, or \code{pattern} matches no files -#' within \code{filepath}, \code{file_size} returns \code{NULL}. +#' If `filepath` is an empty folder, or `pattern` matches no files +#' within `filepath`, `file_size` returns `NULL`. #' #' @examples #' # Name and size of all files in working directory @@ -68,13 +68,12 @@ #' extract(1) #' #' @seealso For more information on using regular expressions, see this -#' \href{https://www.jumpingrivers.com/blog/regular-expressions-every-r-programmer-should-know/}{Jumping Rivers blog post} +#' [Jumping Rivers blog post](https://www.jumpingrivers.com/blog/regular-expressions-every-r-programmer-should-know/) #' and this -#' \href{https://stringr.tidyverse.org/articles/regular-expressions.html}{vignette} -#' from the \code{\link[stringr:stringr-package]{stringr}} package. +#' [vignette](https://stringr.tidyverse.org/articles/regular-expressions.html) +#' from the [`stringr()`][stringr::stringr-package] package. #' #' @export - file_size <- function(filepath = getwd(), pattern = NULL) { if (!file.exists(filepath)) { cli::cli_abort("A valid {.arg filepath} must be supplied.") diff --git a/R/format_postcode.R b/R/format_postcode.R index d242fd5..112f383 100644 --- a/R/format_postcode.R +++ b/R/format_postcode.R @@ -1,8 +1,8 @@ #' @title Format a postcode #' -#' @description \code{format_postcode} takes a character string or vector of character -#' strings. It extracts the input values which adhere to the standard UK -#' postcode format (with or without spaces), assigns the appropriate amount +#' @description `format_postcode` takes a character string or vector of +#' character strings. It extracts the input values which adhere to the standard +#' UK postcode format (with or without spaces), assigns the appropriate amount #' of spacing to them (for both pc7 and pc8 formats) and ensures all letters #' are capitalised. #' @@ -16,10 +16,10 @@ #' \item 2 letters #' } #' -#' \href{https://assets.publishing.service.gov.uk/government/uploads/system/uploads/attachment_data/file/283357/ILRSpecification2013_14Appendix_C_Dec2012_v1.pdf}{UK government regulations} +#' [UK government regulations](https://assets.publishing.service.gov.uk/government/uploads/system/uploads/attachment_data/file/283357/ILRSpecification2013_14Appendix_C_Dec2012_v1.pdf) #' mandate which letters and numbers can be used in specific sections of a #' postcode. However, these regulations are liable to change over time. For -#' this reason, \code{format_postcode} does not validate whether a given +#' this reason, `format_postcode` does not validate whether a given #' postcode actually exists, or whether specific numbers and letters are being #' used in the appropriate places. It only assesses whether the given input is #' consistent with the above format and, if so, assigns the appropriate amount @@ -29,9 +29,9 @@ #' which adhere to the standard UK postcode format may be upper or lower case #' and will be formatted regardless of existing spacing. Any input values which #' do not adhere to the standard UK postcode format will generate an NA and a -#' warning message - see \strong{Value} section for more information. +#' warning message - see **Value** section for more information. #' @param format A character string denoting the desired output format. Valid -#' options are `pc7` and `pc8`. The default is `pc7`. See \strong{Value} +#' options are `pc7` and `pc8`. The default is `pc7`. See **Value** #' section for more information on the string length of output values. #' @param quiet (optional) If quiet is `TRUE` all messages and warnings will be #' suppressed. This is useful in a production context and when you are sure of @@ -39,12 +39,12 @@ #' postcodes. This will also make the function a bit quicker as fewer checks #' are performed. #' -#' @return When \code{format} is set equal to \code{pc7}, \code{format_postcode} +#' @return When `format` is set equal to `pc7`, `format_postcode` #' returns a character string of length 7. 5 character postcodes have two #' spaces after the 2nd character; 6 character postcodes have 1 space after the #' 3rd character; and 7 character postcodes have no spaces. #' -#' When \code{format} is set equal to \code{pc8}, \code{format_postcode} returns +#' When `format` is set equal to `pc8`, `format_postcode` returns #' a character string with maximum length 8. All postcodes, whether 5, 6 or 7 #' characters, have one space before the last 3 characters. #' diff --git a/R/make_inheritance_checks.R b/R/make_inheritance_checks.R index 9ebcc42..f89372c 100644 --- a/R/make_inheritance_checks.R +++ b/R/make_inheritance_checks.R @@ -1,11 +1,15 @@ #' Check that a set of arguments inherits from a set of classes #' Throws an exception if one argument does not pass the checks. #' Argument must have AT LEAST ONE of the specified classes to pass. -#' @param arguments a list object containing argument_name=argument pairs for each argument. Argument names must be provided or else they will be ignored. +#' @param arguments a list object containing argument_name=argument pairs for +#' each argument. Argument names must be provided or else they will be ignored. #' @param target_classes character vector of the classes to check for. -#' @param ignore_null boolean. Indicates whether to ignore arguments with value NULL (TRUE) or to throw an exception (FALSE). Default = TRUE. +#' @param ignore_null boolean. Indicates whether to ignore arguments with value +#' NULL (TRUE) or to throw an exception (FALSE). Default = TRUE. -make_inheritance_checks <- function(arguments, target_classes, ignore_null = TRUE) { +make_inheritance_checks <- function(arguments, + target_classes, + ignore_null = TRUE) { caller_func <- ifelse(length(sys.calls()) > 1, deparse(sys.calls()[[sys.nframe() - 1]]), NA @@ -22,7 +26,13 @@ make_inheritance_checks <- function(arguments, target_classes, ignore_null = TRU if (ignore_null) { return(NULL) } else { - return(stringr::str_glue("{.arg {% argument %}} is {.val NULL} but must be {cli::qty(target_classes)} {?any of }{.cls {target_classes}}.", .open = "{%", .close = "%}")) + return( + stringr::str_glue( + "{.arg {% argument %}} is {.val NULL} but must be {cli::qty(target_classes)} {?any of }{.cls {target_classes}}.", + .open = "{%", + .close = "%}" + ) + ) } } if (!inherits(arguments[[argument]], target_classes) & !is.null(arguments[[argument]])) { diff --git a/R/match_area.R b/R/match_area.R index 896c272..15929b9 100644 --- a/R/match_area.R +++ b/R/match_area.R @@ -1,10 +1,10 @@ #' @title Translate geography codes into area names #' -#' @description \code{match_area} takes a geography code or vector of geography +#' @description `match_area` takes a geography code or vector of geography #' codes. It matches the input to the corresponding value in the -#' \code{\link{area_lookup}} dataset and returns the corresponding area name. +#' [area_lookup()] dataset and returns the corresponding area name. #' -#' @details \code{match_area} relies predominantly on the standard 9 digit +#' @details `match_area` relies predominantly on the standard 9 digit #' geography codes. The only exceptions are: #' \itemize{ #' \item RA2701: No Fixed Abode @@ -13,7 +13,7 @@ #' \item RA2704: Unknown Residency #' } #' -#' \code{match_area} caters for both current and previous versions of geography +#' `match_area` caters for both current and previous versions of geography #' codes (e.g 2014 and 2019 Health Boards). #' #' It can account for geography codes pertaining to Health Boards, Council @@ -23,10 +23,10 @@ #' Community Health Partnerships, Localities (S19), Settlements (S20) and #' Scotland. #' -#' \code{match_area} returns a non-NA value only when an exact match is present +#' `match_area` returns a non-NA value only when an exact match is present #' between the input value and the corresponding variable in the -#' \code{\link{area_lookup}} dataset. These exact matches are sensitive to both -#' case and spacing. It is advised to inspect \code{\link{area_lookup}} in the +#' [area_lookup()] dataset. These exact matches are sensitive to both +#' case and spacing. It is advised to inspect [area_lookup()] in the #' case of unexpected results, as these may be explained by subtle differences #' in transcription between the input value and the corresponding value in the #' lookup dataset. @@ -34,10 +34,10 @@ #' @param x A geography code or vector of geography codes. #' @return Each geography code within Scotland is unique, and consequently -#' \code{match_area} returns a single area name for each input value. +#' `match_area` returns a single area name for each input value. #' Any input value without a corresponding value in the -#' \code{\link{area_lookup}} dataset will return an NA output value. +#' [area_lookup()] dataset will return an NA output value. #' #' @examples #' match_area("S20000010") diff --git a/R/phsmethods.R b/R/phsmethods.R index 8d320e0..8197566 100644 --- a/R/phsmethods.R +++ b/R/phsmethods.R @@ -1,9 +1,9 @@ -#' \code{phsmethods} package +#' `phsmethods` package #' #' Standard Methods for use in PHS. #' #' See the README on -#' \href{https://github.com/Health-SocialCare-Scotland/phsmethods#readme}{GitHub}. +#' [GitHub](https://github.com/Public-Health-Scotland/phsmethods#readme). #' #' @docType package #' @name phsmethods diff --git a/R/qtr.R b/R/qtr.R index 68c7ea6..57ec4be 100644 --- a/R/qtr.R +++ b/R/qtr.R @@ -7,13 +7,13 @@ #' value. #' #' \itemize{ -#' \item \code{qtr} returns the current quarter +#' \item `qtr` returns the current quarter #' -#' \item \code{qtr_end} returns the last month in the quarter +#' \item `qtr_end` returns the last month in the quarter #' -#' \item \code{qtr_next} returns the next quarter +#' \item `qtr_next` returns the next quarter #' -#' \item \code{qtr_prev} returns the previous quarter +#' \item `qtr_prev` returns the previous quarter #' } #' #' @details Quarters are defined as: @@ -25,11 +25,13 @@ #' \item October to December (Oct-Dec) #' } #' -#' @param date A date which must be supplied with \code{Date} or \code{POSIXct} -#' @param format A \code{character} string specifying the format the quarter +#' @param date A date which must be supplied with `Date` or `POSIXct` +#' @param format A `character` string specifying the format the quarter #' should be displayed in. Valid options are `long` (January to March 2018) and #' `short` (Jan-Mar 2018). The default is `long`. #' +#' @return A character vector of financial quarters in the specified format. +#' #' @examples #' x <- lubridate::dmy(c(26032012, 04052012, 23092012)) #' qtr(x) diff --git a/R/rename.R b/R/rename.R index b4f053e..0a481e1 100644 --- a/R/rename.R +++ b/R/rename.R @@ -8,14 +8,14 @@ #' work and will error. At the next update they will be #' removed completely. #' -#' * `postcode()` -> `format_postcode()` -#' * `age_group()` -> `create_age_groups()` -#' * `fin_year()` -> `extract_fin_year()` +#' * `postcode()` → `format_postcode()` +#' * `age_group()` → `create_age_groups()` +#' * `fin_year()` → `extract_fin_year()` #' #' @keywords internal #' @name rename #' @aliases NULL -#' @md +#' @returns `r lifecycle::badge('deprecated')` NULL #' @rdname rename diff --git a/R/sex_from_chi.R b/R/sex_from_chi.R index cb4c1e9..c9706cd 100644 --- a/R/sex_from_chi.R +++ b/R/sex_from_chi.R @@ -1,8 +1,8 @@ #' @title Extract sex from the CHI number #' -#' @description \code{sex_from_chi} takes a CHI number or a vector of CHI numbers -#' and returns the sex as implied by the CHI number(s). The default return type is -#' an integer but this can be modified. +#' @description `sex_from_chi` takes a CHI number or a vector of CHI numbers +#' and returns the sex as implied by the CHI number(s). The default return type +#' is an integer but this can be modified. #' #' @details The Community Health Index (CHI) is a register of all patients in #' NHS Scotland. A CHI number is a unique, ten-digit identifier assigned to @@ -11,35 +11,46 @@ #' The ninth digit of a CHI number identifies a patient's sex: odd for men, #' even for women. #' -#' The default behaviour for \code{sex_from_chi} is to first check the CHI number is -#' valid using \code{check_chi} and then to return 1 for male and 2 for female. +#' The default behaviour for `sex_from_chi` is to first check the CHI number is +#' valid using `check_chi` and then to return 1 for male and 2 for female. #' -#' There are options to return custom values e.g. \code{'M'} and \code{'F'} or to return -#' a factor which will have labels \code{'Male'} and \code{'Female')} +#' There are options to return custom values e.g. `'M'` and `'F'` or to return +#' a factor which will have labels `'Male'` and `'Female')` #' -#' @param chi_number a CHI number or a vector of CHI numbers with \code{character} class. -#' @param male_value,female_value optionally supply custom values for Male and Female. Note -#' that that these must be of the same class. -#' @param as_factor logical, optionally return as a factor with labels \code{'Male'} -#' and \code{'Female'}. Note that this will override any custom values supplied with -#' \code{male_value} or \code{female_value}. -#' @param chi_check logical, optionally skip checking the CHI for validity which will be -#' faster but should only be used if you have previously checked the CHI(s). +#' @param chi_number a CHI number or a vector of CHI numbers with `character` +#' class. +#' @param male_value,female_value optionally supply custom values for Male and +#' Female. Note that that these must be of the same class. +#' @param as_factor logical, optionally return as a factor with labels `'Male'` +#' and `'Female'`. Note that this will override any custom values supplied with +#' `male_value` or `female_value`. +#' @param chi_check logical, optionally skip checking the CHI for validity which +#' will be faster but should only be used if you have previously checked the +#' CHI(s). #' -#' @return a vector with the same class as \code{male_value} and \code{female_value}, (integer -#' by default) unless \code{as_factor} is \code{TRUE} in which case a factor will be returned. +#' @return a vector with the same class as `male_value` and `female_value`, +#' (integer by default) unless `as_factor` is `TRUE` in which case a factor will +#' be returned. #' @export #' #' @examples #' sex_from_chi("0101011237") #' sex_from_chi(c("0101011237", "0101336489", NA)) -#' sex_from_chi(c("0101011237", "0101336489", NA), male_value = "M", female_value = "F") +#' sex_from_chi( +#' c("0101011237", "0101336489", NA), +#' male_value = "M", +#' female_value = "F" +#' ) #' sex_from_chi(c("0101011237", "0101336489", NA), as_factor = TRUE) #' #' library(dplyr) #' df <- tibble(chi = c("0101011237", "0101336489", NA)) #' df %>% mutate(chi_sex = sex_from_chi(chi)) -sex_from_chi <- function(chi_number, male_value = 1L, female_value = 2L, as_factor = FALSE, chi_check = TRUE) { +sex_from_chi <- function(chi_number, + male_value = 1L, + female_value = 2L, + as_factor = FALSE, + chi_check = TRUE) { # Do type checking on male/female values male_class <- class(male_value) female_class <- class(female_value) @@ -74,7 +85,11 @@ sex_from_chi <- function(chi_number, male_value = 1L, female_value = 2L, as_fact # Convert to a factor if required if (as_factor) { - sex <- factor(sex, levels = c(male_value, female_value), labels = c("Male", "Female")) + sex <- factor( + x = sex, + levels = c(male_value, female_value), + labels = c("Male", "Female") + ) } return(sex) diff --git a/README.Rmd b/README.Rmd index 9ad1ae7..25a8263 100644 --- a/README.Rmd +++ b/README.Rmd @@ -33,7 +33,7 @@ knitr::opts_chunk$set( - `dob_from_chi()` extracts Date of Birth (DoB) from the CHI number - `age_from_chi()` extracts age from the CHI number -`phsmethods` can be used on both the [PHS server](https://pwb.publichealthscotland.org/) and desktop versions of RStudio. +`phsmethods` can be used on both the PHS server and desktop versions of RStudio. ## Installation diff --git a/README.md b/README.md index 6ba6466..ab443a0 100644 --- a/README.md +++ b/README.md @@ -28,8 +28,7 @@ in [Public Health Scotland - `dob_from_chi()` extracts Date of Birth (DoB) from the CHI number - `age_from_chi()` extracts age from the CHI number -`phsmethods` can be used on both the [PHS -server](https://pwb.publichealthscotland.org/) and desktop versions of +`phsmethods` can be used on both the PHS server and desktop versions of RStudio. ## Installation diff --git a/cran-comments.md b/cran-comments.md new file mode 100644 index 0000000..858617d --- /dev/null +++ b/cran-comments.md @@ -0,0 +1,5 @@ +## R CMD check results + +0 errors | 0 warnings | 1 note + +* This is a new release. diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..221d9ef --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,25 @@ +Authors’ +DD +DoB +FST +Knit’ +Maechler +RStudio +TSV +YY +YYYY +blogpost +cli +codecov +etc +filepath +gdata +nd +pkgdown +qtr +rOpenSci +rd +tibble +tidyverse +’ +’s diff --git a/man/age_calculate.Rd b/man/age_calculate.Rd index 0181d7f..4970a03 100644 --- a/man/age_calculate.Rd +++ b/man/age_calculate.Rd @@ -12,22 +12,29 @@ age_calculate( ) } \arguments{ -\item{start}{A start date (e.g. date of birth) which must be supplied with \code{Date} or \code{POSIXct} or \code{POSIXlt} -class. \code{\link[base:as.Date]{as.Date()}}, +\item{start}{A start date (e.g. date of birth) which must be supplied with +\code{Date} or \code{POSIXct} or \code{POSIXlt} +class. \code{\link[base:as.Date]{base::as.Date()}}, \code{\link[lubridate:ymd]{lubridate::dmy()}} and \code{\link[base:as.POSIXlt]{as.POSIXct()}} are examples of functions which can be used to store dates as an appropriate class.} -\item{end}{An end date which must be supplied with \code{Date} or \code{POSIXct} or \code{POSIXlt} class. -Default is \code{Sys.Date()} or \code{Sys.time()} depending on the class of \code{start}.} +\item{end}{An end date which must be supplied with \code{Date} or \code{POSIXct} or +\code{POSIXlt} class. Default is \code{Sys.Date()} or \code{Sys.time()} depending on the +class of \code{start}.} -\item{units}{Type of units to be used. years and months are accepted. Default is \code{years}.} +\item{units}{Type of units to be used. years and months are accepted. +Default is \code{years}.} -\item{round_down}{Should returned ages be rounded down to the nearest whole number. Default is \code{TRUE}.} +\item{round_down}{Should returned ages be rounded down to the nearest whole +number. Default is \code{TRUE}.} +} +\value{ +A numeric vector representing the ages in the given units. } \description{ -This function calculates the age between two dates using functions in \code{lubridate}. -It calculates age in either years or months. +This function calculates the age between two dates using +functions in \code{lubridate}. It calculates age in either years or months. } \examples{ library(lubridate) @@ -36,7 +43,8 @@ end_date <- lubridate::ymd("2022-02-21") age_calculate(birth_date, end_date) age_calculate(birth_date, end_date, units = "months") -# If the start day is leap day (February 29th), age increases on 1st March every year. +# If the start day is leap day (February 29th), age increases on 1st March +# every year. leap1 <- lubridate::ymd("2020-02-29") leap2 <- lubridate::ymd("2022-02-28") leap3 <- lubridate::ymd("2022-03-01") diff --git a/man/age_from_chi.Rd b/man/age_from_chi.Rd index b4892c0..e6e0967 100644 --- a/man/age_from_chi.Rd +++ b/man/age_from_chi.Rd @@ -13,24 +13,31 @@ age_from_chi( ) } \arguments{ -\item{chi_number}{a CHI number or a vector of CHI numbers with \code{character} class.} +\item{chi_number}{a CHI number or a vector of CHI numbers with \code{character} +class.} -\item{ref_date}{calculate the age at this date, default is to use \code{Sys.Date()} i.e. today.} +\item{ref_date}{calculate the age at this date, default is to use +\code{Sys.Date()} i.e. today.} -\item{min_age, max_age}{optional min and/or max dates that the Date of Birth could take as the century needs to be guessed. -Must be either length 1 for a 'fixed' age or the same length as \code{chi_number} for an age per CHI number. -min_age can be age based on common sense in the dataset, whilst max_age can be age when an event happens such as the age at discharge.} +\item{min_age, max_age}{optional min and/or max dates that the DoB could take +as the century needs to be guessed. +Must be either length 1 for a 'fixed' age or the same length as \code{chi_number} +for an age per CHI number. +\code{min_age} can be age based on common sense in the dataset, whilst \code{max_age} +can be age when an event happens such as the age at discharge.} -\item{chi_check}{logical, optionally skip checking the CHI for validity which will be -faster but should only be used if you have previously checked the CHI(s), the default (TRUE) will to check the CHI numbers.} +\item{chi_check}{logical, optionally skip checking the CHI for validity which +will be faster but should only be used if you have previously checked the +CHI(s), the default (TRUE) will to check the CHI numbers.} } \value{ -an integer vector of ages in years truncated to the nearest year. It will be the same length as \code{chi_number}. +an integer vector of ages in years truncated to the nearest year. +It will be the same length as \code{chi_number}. } \description{ \code{age_from_chi} takes a CHI number or a vector of CHI numbers -and returns the age as implied by the CHI number(s). If the DoB is ambiguous -it will return NA. It uses \code{dob_from_chi}. +and returns the age as implied by the CHI number(s). If the Date of Birth +(DoB) is ambiguous it will return NA. It uses \code{\link[=dob_from_chi]{dob_from_chi()}}. } \examples{ age_from_chi("0101336489") diff --git a/man/area_lookup.Rd b/man/area_lookup.Rd index 9986703..e232eec 100644 --- a/man/area_lookup.Rd +++ b/man/area_lookup.Rd @@ -5,10 +5,10 @@ \alias{area_lookup} \title{Codes and names of Scottish geographical and administrative areas.} \format{ -A \code{\link[tibble]{tibble}} with 2 variables and over 17,000 rows: +A \code{\link[tibble:tibble]{tibble::tibble()}} with 2 variables and over 17,000 rows: \describe{ - \item{geo_code}{Standard geography code - 9 characters} - \item{area_name}{Name of the area the code represents} +\item{geo_code}{Standard geography code - 9 characters} +\item{area_name}{Name of the area the code represents} } } \source{ @@ -19,7 +19,7 @@ area_lookup } \description{ A dataset containing Scotland's geography codes and associated area names. -It is used within \code{\link{match_area}}. +It is used within \code{\link[=match_area]{match_area()}}. } \details{ \code{geo_code} contains geography codes pertaining to Health diff --git a/man/chi_check.Rd b/man/chi_check.Rd index 95d577f..e042552 100644 --- a/man/chi_check.Rd +++ b/man/chi_check.Rd @@ -12,16 +12,15 @@ chi_check(x) \value{ \code{chi_check} returns a character string. Depending on the validity of the entered CHI number, it will return one of the following: - \itemize{ -\item `Valid CHI` -\item `Invalid character(s) present` -\item `Too many characters` -\item `Too few characters` -\item `Invalid date` -\item `Invalid checksum` -\item `Missing (NA)` -\item `Missing (Blank)` +\item \verb{Valid CHI} +\item \verb{Invalid character(s) present} +\item \verb{Too many characters} +\item \verb{Too few characters} +\item \verb{Invalid date} +\item \verb{Invalid checksum} +\item \code{Missing (NA)} +\item \code{Missing (Blank)} } } \description{ @@ -39,18 +38,17 @@ The first six digits of a CHI number are a patient's date of birth in DD/MM/YY format. The ninth digit of a CHI number identifies a patient's sex: odd for male, -even for female. The tenth digit is a check digit, denoted `checksum`. +even for female. The tenth digit is a check digit, denoted \code{checksum}. While a CHI number is made up exclusively of numeric digits, it cannot be stored with \code{numeric} class in R. This is because leading zeros in numeric values are silently dropped, a practice not exclusive to R. For this reason, \code{chi_check} accepts input values of \code{character} class only. A leading zero can be added to a nine-digit CHI number using -\code{\link{chi_pad}}. +\code{\link[=chi_pad]{chi_pad()}}. \code{chi_check} assesses whether an entered CHI number is valid by checking -whether the answer to each of the following criteria is `Yes`: - +whether the answer to each of the following criteria is \code{Yes}: \itemize{ \item Does it contain no non-numeric characters? \item Is it ten digits in length? @@ -63,7 +61,13 @@ chi_check("0101011237") chi_check(c("0101201234", "3201201234")) library(dplyr) -df <- tibble(chi = c("3213201234", "123456789", "12345678900", "010120123?", NA)) +df <- tibble(chi = c( + "3213201234", + "123456789", + "12345678900", + "010120123?", + NA +)) df \%>\% mutate(validity = chi_check(chi)) } diff --git a/man/chi_pad.Rd b/man/chi_pad.Rd index d7bb3da..68b7d04 100644 --- a/man/chi_pad.Rd +++ b/man/chi_pad.Rd @@ -9,6 +9,9 @@ chi_pad(x) \arguments{ \item{x}{a CHI number or a vector of CHI numbers with \code{character} class.} } +\value{ +The original character vector with CHI numbers padded if applicable. +} \description{ \code{chi_pad} takes a nine-digit CHI number with \code{character} class and prefixes it with a zero. Any values provided @@ -29,7 +32,7 @@ stored with \code{numeric} class in R. This is because leading zeros in numeric values are silently dropped, a practice not exclusive to R. For this reason, \code{chi_pad} accepts input values of \code{character} class only, and returns values of the same class. It does not assess the validity -of a CHI number - please see \code{\link{chi_check}} for that. +of a CHI number - please see \code{\link[=chi_check]{chi_check()}} for that. } \examples{ chi_pad(c("101011237", "101201234")) diff --git a/man/create_age_groups.Rd b/man/create_age_groups.Rd index ef46d0c..735a67b 100644 --- a/man/create_age_groups.Rd +++ b/man/create_age_groups.Rd @@ -32,7 +32,7 @@ The \code{from}, \code{to} and \code{by} values are used to create distinct age groups. \code{from} dictates the starting age of the lowest age group, and \code{by} indicates how wide each group should be. \code{to} stipulates the cut-off point at which all ages equal to or greater than this value -should be categorised together in a \code{to+} group. If the specified value +should be categorised together in a \verb{to+} group. If the specified value of \code{to} is not a multiple of \code{by}, the value of \code{to} is rounded down to the nearest multiple of \code{by}. diff --git a/man/dob_from_chi.Rd b/man/dob_from_chi.Rd index 3b8e8ff..809e12e 100644 --- a/man/dob_from_chi.Rd +++ b/man/dob_from_chi.Rd @@ -7,22 +7,26 @@ dob_from_chi(chi_number, min_date = NULL, max_date = NULL, chi_check = TRUE) } \arguments{ -\item{chi_number}{a CHI number or a vector of CHI numbers with \code{character} class.} +\item{chi_number}{a CHI number or a vector of CHI numbers with \code{character} +class.} -\item{min_date, max_date}{optional min and/or max dates that the Date of Birth could take as the century needs to be guessed. -Must be either length 1 for a 'fixed' date or the same length as \code{chi_number} for a date per CHI number. -min_date can be date based on common sense in the dataset, whilst max_date can be date when an event happens such as discharge date.} +\item{min_date, max_date}{optional min and/or max dates that the +DoB could take as the century needs to be guessed. Must be either length 1 +for a 'fixed' date or the same length as \code{chi_number} for a date +per CHI number. \code{min_date} can be date based on common sense in the dataset, +whilst \code{max_date} can be date when an event happens such as discharge date.} -\item{chi_check}{logical, optionally skip checking the CHI for validity which will be -faster but should only be used if you have previously checked the CHI(s). The default (TRUE) will check the CHI numbers.} +\item{chi_check}{logical, optionally skip checking the CHI for validity which +will be faster but should only be used if you have previously checked the +CHI(s). The default (TRUE) will check the CHI numbers.} } \value{ a date vector of DoB. It will be the same length as \code{chi_number}. } \description{ \code{dob_from_chi} takes a CHI number or a vector of CHI numbers -and returns the DoB as implied by the CHI number(s). If the DoB is ambiguous -it will return NA +and returns the Date of Birth (DoB) as implied by the CHI number(s). If the +DoB is ambiguous it will return NA. } \examples{ dob_from_chi("0101336489") diff --git a/man/extract_fin_year.Rd b/man/extract_fin_year.Rd index d3e083e..5c06015 100644 --- a/man/extract_fin_year.Rd +++ b/man/extract_fin_year.Rd @@ -7,12 +7,15 @@ extract_fin_year(date) } \arguments{ -\item{date}{A date which must be supplied with \code{Date} or \code{POSIXct} -class. \code{\link[base:as.Date]{as.Date()}}, +\item{date}{A date which must be supplied with \code{Date}, \code{POSIXct}, \code{POSIXlt} or +\code{POSIXt} class. \code{\link[base:as.Date]{base::as.Date()}}, \code{\link[lubridate:ymd]{lubridate::dmy()}} and \code{\link[base:as.POSIXlt]{as.POSIXct()}} are examples of functions which can be used to store dates as an appropriate class.} } +\value{ +A character vector of financial years in the form '2017/18'. +} \description{ \code{extract_fin_year} takes a date and extracts the correct financial year in the PHS specified format from it. diff --git a/man/file_size.Rd b/man/file_size.Rd index db45309..e5cf38c 100644 --- a/man/file_size.Rd +++ b/man/file_size.Rd @@ -11,18 +11,18 @@ file_size(filepath = getwd(), pattern = NULL) working directory, \code{getwd()}.} \item{pattern}{An optional character string denoting a -\code{\link[base:regex]{regular expression}} pattern. Only file names which +\code{\link[base:regex]{regular expression()}} pattern. Only file names which match the regular expression will be returned. See the \strong{See Also} section for resources regarding how to write regular expressions.} } \value{ -A \code{\link[tibble]{tibble}} listing the names of files within +A \code{\link[tibble:tibble]{tibble::tibble()}} listing the names of files within \code{filepath} which match \code{pattern} and their respective sizes. The -column names of this tibble are `name` and `size`. If no \code{pattern} is +column names of this tibble are \code{name} and \code{size}. If no \code{pattern} is specified, \code{file_size} returns the names and sizes of all files within \code{filepath}. File names and sizes are returned in alphabetical order of file name. Sub-folders contained within \code{filepath} will return a file -size of `0 B`. +size of \verb{0 B}. If \code{filepath} is an empty folder, or \code{pattern} matches no files within \code{filepath}, \code{file_size} returns \code{NULL}. @@ -35,31 +35,31 @@ which match the given pattern. \details{ The sizes of files with certain extensions are returned with the type of file prefixed. For example, the size of a 12 KB \code{.xlsx} file is -returned as `Excel 12 KB`. The complete list of explicitly catered-for file +returned as \verb{Excel 12 KB}. The complete list of explicitly catered-for file extensions and their prefixes are as follows: \itemize{ \item \code{.xls}, \code{.xlsb}, \code{.xlsm} and \code{.xlsx} files are -prefixed with `Excel` -\item \code{.csv} files are prefixed with `CSV` -\item \code{.sav} and \code{.zsav} files are prefixed with `SPSS` +prefixed with \code{Excel} +\item \code{.csv} files are prefixed with \code{CSV} +\item \code{.sav} and \code{.zsav} files are prefixed with \code{SPSS} \item \code{.doc}, \code{.docm} and \code{.docx} files are prefixed with -`Word` -\item \code{.rds} files are prefixed with `RDS` -\item \code{.txt} files are prefixed with `Text`, -\item \code{.fst} files are prefixed with `FST`, -\item \code{.pdf} files are prefixed with `PDF`, -\item \code{.tsv} files are prefixed with `TSV`, -\item \code{.html} files are prefixed with `HTML`, +\code{Word} +\item \code{.rds} files are prefixed with \code{RDS} +\item \code{.txt} files are prefixed with \code{Text}, +\item \code{.fst} files are prefixed with \code{FST}, +\item \code{.pdf} files are prefixed with \code{PDF}, +\item \code{.tsv} files are prefixed with \code{TSV}, +\item \code{.html} files are prefixed with \code{HTML}, \item \code{.ppt}, \code{.pptm} and \code{.pptx} files are prefixed with -`PowerPoint`, -\item \code{.md} files are prefixed with `Markdown` +\code{PowerPoint}, +\item \code{.md} files are prefixed with \code{Markdown} } Files with extensions not contained within this list will have their size returned with no prefix. To request that a certain extension be explicitly catered for, please create an issue on -\href{https://github.com/Health-SocialCare-Scotland/phsmethods/issues}{GitHub}. +\href{https://github.com/Public-Health-Scotland/phsmethods/issues}{GitHub}. File sizes are returned as the appropriate multiple of the unit byte (bytes (B), kilobytes (KB), megabytes (MB), etc.). Each multiple is taken to @@ -84,5 +84,5 @@ For more information on using regular expressions, see this \href{https://www.jumpingrivers.com/blog/regular-expressions-every-r-programmer-should-know/}{Jumping Rivers blog post} and this \href{https://stringr.tidyverse.org/articles/regular-expressions.html}{vignette} -from the \code{\link[stringr:stringr-package]{stringr}} package. +from the \code{\link[stringr:stringr-package]{stringr()}} package. } diff --git a/man/format_postcode.Rd b/man/format_postcode.Rd index b3c6b09..0dcc45f 100644 --- a/man/format_postcode.Rd +++ b/man/format_postcode.Rd @@ -14,10 +14,10 @@ do not adhere to the standard UK postcode format will generate an NA and a warning message - see \strong{Value} section for more information.} \item{format}{A character string denoting the desired output format. Valid -options are `pc7` and `pc8`. The default is `pc7`. See \strong{Value} +options are \code{pc7} and \code{pc8}. The default is \code{pc7}. See \strong{Value} section for more information on the string length of output values.} -\item{quiet}{(optional) If quiet is `TRUE` all messages and warnings will be +\item{quiet}{(optional) If quiet is \code{TRUE} all messages and warnings will be suppressed. This is useful in a production context and when you are sure of the data or you are specifically using this function to remove invalid postcodes. This will also make the function a bit quicker as fewer checks @@ -30,7 +30,7 @@ spaces after the 2nd character; 6 character postcodes have 1 space after the 3rd character; and 7 character postcodes have no spaces. When \code{format} is set equal to \code{pc8}, \code{format_postcode} returns - a character string with maximum length 8. All postcodes, whether 5, 6 or 7 +a character string with maximum length 8. All postcodes, whether 5, 6 or 7 characters, have one space before the last 3 characters. Any input values which do not adhere to the standard UK postcode format will @@ -44,9 +44,9 @@ contain lower case letters will generate a warning message explaining that these letters will be capitalised. } \description{ -\code{format_postcode} takes a character string or vector of character -strings. It extracts the input values which adhere to the standard UK -postcode format (with or without spaces), assigns the appropriate amount +\code{format_postcode} takes a character string or vector of +character strings. It extracts the input values which adhere to the standard +UK postcode format (with or without spaces), assigns the appropriate amount of spacing to them (for both pc7 and pc8 formats) and ensures all letters are capitalised. } diff --git a/man/make_inheritance_checks.Rd b/man/make_inheritance_checks.Rd index eb50fb0..be8e295 100644 --- a/man/make_inheritance_checks.Rd +++ b/man/make_inheritance_checks.Rd @@ -9,11 +9,13 @@ Argument must have AT LEAST ONE of the specified classes to pass.} make_inheritance_checks(arguments, target_classes, ignore_null = TRUE) } \arguments{ -\item{arguments}{a list object containing argument_name=argument pairs for each argument. Argument names must be provided or else they will be ignored.} +\item{arguments}{a list object containing argument_name=argument pairs for +each argument. Argument names must be provided or else they will be ignored.} \item{target_classes}{character vector of the classes to check for.} -\item{ignore_null}{boolean. Indicates whether to ignore arguments with value NULL (TRUE) or to throw an exception (FALSE). Default = TRUE.} +\item{ignore_null}{boolean. Indicates whether to ignore arguments with value +NULL (TRUE) or to throw an exception (FALSE). Default = TRUE.} } \description{ Check that a set of arguments inherits from a set of classes diff --git a/man/match_area.Rd b/man/match_area.Rd index 807e638..79bee65 100644 --- a/man/match_area.Rd +++ b/man/match_area.Rd @@ -13,12 +13,12 @@ match_area(x) Each geography code within Scotland is unique, and consequently \code{match_area} returns a single area name for each input value. Any input value without a corresponding value in the -\code{\link{area_lookup}} dataset will return an NA output value. +\code{\link[=area_lookup]{area_lookup()}} dataset will return an NA output value. } \description{ \code{match_area} takes a geography code or vector of geography codes. It matches the input to the corresponding value in the -\code{\link{area_lookup}} dataset and returns the corresponding area name. +\code{\link[=area_lookup]{area_lookup()}} dataset and returns the corresponding area name. } \details{ \code{match_area} relies predominantly on the standard 9 digit @@ -42,8 +42,8 @@ Scotland. \code{match_area} returns a non-NA value only when an exact match is present between the input value and the corresponding variable in the -\code{\link{area_lookup}} dataset. These exact matches are sensitive to both -case and spacing. It is advised to inspect \code{\link{area_lookup}} in the +\code{\link[=area_lookup]{area_lookup()}} dataset. These exact matches are sensitive to both +case and spacing. It is advised to inspect \code{\link[=area_lookup]{area_lookup()}} in the case of unexpected results, as these may be explained by subtle differences in transcription between the input value and the corresponding value in the lookup dataset. diff --git a/man/phsmethods.Rd b/man/phsmethods.Rd index ea38a6c..64143ac 100644 --- a/man/phsmethods.Rd +++ b/man/phsmethods.Rd @@ -9,5 +9,5 @@ Standard Methods for use in PHS. } \details{ See the README on -\href{https://github.com/Health-SocialCare-Scotland/phsmethods#readme}{GitHub}. +\href{https://github.com/Public-Health-Scotland/phsmethods#readme}{GitHub}. } diff --git a/man/qtr.Rd b/man/qtr.Rd index 4f966e1..c74b617 100644 --- a/man/qtr.Rd +++ b/man/qtr.Rd @@ -19,8 +19,11 @@ qtr_prev(date, format = c("long", "short")) \item{date}{A date which must be supplied with \code{Date} or \code{POSIXct}} \item{format}{A \code{character} string specifying the format the quarter -should be displayed in. Valid options are `long` (January to March 2018) and -`short` (Jan-Mar 2018). The default is `long`.} +should be displayed in. Valid options are \code{long} (January to March 2018) and +\code{short} (Jan-Mar 2018). The default is \code{long}.} +} +\value{ +A character vector of financial quarters in the specified format. } \description{ The qtr functions take a date input and calculate the relevant diff --git a/man/rename.Rd b/man/rename.Rd index a0e14f0..ad1e445 100644 --- a/man/rename.Rd +++ b/man/rename.Rd @@ -12,6 +12,9 @@ age_group(x, from = 0, to = 90, by = 5, as_factor = FALSE) fin_year(date) } +\value{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} +} \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} @@ -20,9 +23,9 @@ to improve code clarity. The old functions no longer work and will error. At the next update they will be removed completely. \itemize{ -\item \code{postcode()} -> \code{format_postcode()} -\item \code{age_group()} -> \code{create_age_groups()} -\item \code{fin_year()} -> \code{extract_fin_year()} +\item \code{postcode()} → \code{format_postcode()} +\item \code{age_group()} → \code{create_age_groups()} +\item \code{fin_year()} → \code{extract_fin_year()} } } \keyword{internal} diff --git a/man/sex_from_chi.Rd b/man/sex_from_chi.Rd index 4dc3798..c7e4071 100644 --- a/man/sex_from_chi.Rd +++ b/man/sex_from_chi.Rd @@ -13,26 +13,29 @@ sex_from_chi( ) } \arguments{ -\item{chi_number}{a CHI number or a vector of CHI numbers with \code{character} class.} +\item{chi_number}{a CHI number or a vector of CHI numbers with \code{character} +class.} -\item{male_value, female_value}{optionally supply custom values for Male and Female. Note -that that these must be of the same class.} +\item{male_value, female_value}{optionally supply custom values for Male and +Female. Note that that these must be of the same class.} \item{as_factor}{logical, optionally return as a factor with labels \code{'Male'} and \code{'Female'}. Note that this will override any custom values supplied with \code{male_value} or \code{female_value}.} -\item{chi_check}{logical, optionally skip checking the CHI for validity which will be -faster but should only be used if you have previously checked the CHI(s).} +\item{chi_check}{logical, optionally skip checking the CHI for validity which +will be faster but should only be used if you have previously checked the +CHI(s).} } \value{ -a vector with the same class as \code{male_value} and \code{female_value}, (integer -by default) unless \code{as_factor} is \code{TRUE} in which case a factor will be returned. +a vector with the same class as \code{male_value} and \code{female_value}, +(integer by default) unless \code{as_factor} is \code{TRUE} in which case a factor will +be returned. } \description{ \code{sex_from_chi} takes a CHI number or a vector of CHI numbers -and returns the sex as implied by the CHI number(s). The default return type is -an integer but this can be modified. +and returns the sex as implied by the CHI number(s). The default return type +is an integer but this can be modified. } \details{ The Community Health Index (CHI) is a register of all patients in @@ -46,12 +49,16 @@ The default behaviour for \code{sex_from_chi} is to first check the CHI number i valid using \code{check_chi} and then to return 1 for male and 2 for female. There are options to return custom values e.g. \code{'M'} and \code{'F'} or to return -a factor which will have labels \code{'Male'} and \code{'Female')} +a factor which will have labels \code{'Male'} and \verb{'Female')} } \examples{ sex_from_chi("0101011237") sex_from_chi(c("0101011237", "0101336489", NA)) -sex_from_chi(c("0101011237", "0101336489", NA), male_value = "M", female_value = "F") +sex_from_chi( + c("0101011237", "0101336489", NA), + male_value = "M", + female_value = "F" +) sex_from_chi(c("0101011237", "0101336489", NA), as_factor = TRUE) library(dplyr) diff --git a/tests/testthat/_snaps/extract_fin_year.md b/tests/testthat/_snaps/extract_fin_year.md new file mode 100644 index 0000000..1c006e6 --- /dev/null +++ b/tests/testthat/_snaps/extract_fin_year.md @@ -0,0 +1,113 @@ +# Correct outputs + + Code + start <- lubridate::make_date(1999, 4, 1) + end <- lubridate::make_date(2100, 3, 31) + dates <- seq(start, end, by = "day") + df <- data.frame(date = dates, fin_year = extract_fin_year(dates)) + dplyr::summarise(df, first_date = min(date), last_date = max(date), days = dplyr::n(), + .by = fin_year) + Output + fin_year first_date last_date days + 1 1999/00 1999-04-01 2000-03-31 366 + 2 2000/01 2000-04-01 2001-03-31 365 + 3 2001/02 2001-04-01 2002-03-31 365 + 4 2002/03 2002-04-01 2003-03-31 365 + 5 2003/04 2003-04-01 2004-03-31 366 + 6 2004/05 2004-04-01 2005-03-31 365 + 7 2005/06 2005-04-01 2006-03-31 365 + 8 2006/07 2006-04-01 2007-03-31 365 + 9 2007/08 2007-04-01 2008-03-31 366 + 10 2008/09 2008-04-01 2009-03-31 365 + 11 2009/10 2009-04-01 2010-03-31 365 + 12 2010/11 2010-04-01 2011-03-31 365 + 13 2011/12 2011-04-01 2012-03-31 366 + 14 2012/13 2012-04-01 2013-03-31 365 + 15 2013/14 2013-04-01 2014-03-31 365 + 16 2014/15 2014-04-01 2015-03-31 365 + 17 2015/16 2015-04-01 2016-03-31 366 + 18 2016/17 2016-04-01 2017-03-31 365 + 19 2017/18 2017-04-01 2018-03-31 365 + 20 2018/19 2018-04-01 2019-03-31 365 + 21 2019/20 2019-04-01 2020-03-31 366 + 22 2020/21 2020-04-01 2021-03-31 365 + 23 2021/22 2021-04-01 2022-03-31 365 + 24 2022/23 2022-04-01 2023-03-31 365 + 25 2023/24 2023-04-01 2024-03-31 366 + 26 2024/25 2024-04-01 2025-03-31 365 + 27 2025/26 2025-04-01 2026-03-31 365 + 28 2026/27 2026-04-01 2027-03-31 365 + 29 2027/28 2027-04-01 2028-03-31 366 + 30 2028/29 2028-04-01 2029-03-31 365 + 31 2029/30 2029-04-01 2030-03-31 365 + 32 2030/31 2030-04-01 2031-03-31 365 + 33 2031/32 2031-04-01 2032-03-31 366 + 34 2032/33 2032-04-01 2033-03-31 365 + 35 2033/34 2033-04-01 2034-03-31 365 + 36 2034/35 2034-04-01 2035-03-31 365 + 37 2035/36 2035-04-01 2036-03-31 366 + 38 2036/37 2036-04-01 2037-03-31 365 + 39 2037/38 2037-04-01 2038-03-31 365 + 40 2038/39 2038-04-01 2039-03-31 365 + 41 2039/40 2039-04-01 2040-03-31 366 + 42 2040/41 2040-04-01 2041-03-31 365 + 43 2041/42 2041-04-01 2042-03-31 365 + 44 2042/43 2042-04-01 2043-03-31 365 + 45 2043/44 2043-04-01 2044-03-31 366 + 46 2044/45 2044-04-01 2045-03-31 365 + 47 2045/46 2045-04-01 2046-03-31 365 + 48 2046/47 2046-04-01 2047-03-31 365 + 49 2047/48 2047-04-01 2048-03-31 366 + 50 2048/49 2048-04-01 2049-03-31 365 + 51 2049/50 2049-04-01 2050-03-31 365 + 52 2050/51 2050-04-01 2051-03-31 365 + 53 2051/52 2051-04-01 2052-03-31 366 + 54 2052/53 2052-04-01 2053-03-31 365 + 55 2053/54 2053-04-01 2054-03-31 365 + 56 2054/55 2054-04-01 2055-03-31 365 + 57 2055/56 2055-04-01 2056-03-31 366 + 58 2056/57 2056-04-01 2057-03-31 365 + 59 2057/58 2057-04-01 2058-03-31 365 + 60 2058/59 2058-04-01 2059-03-31 365 + 61 2059/60 2059-04-01 2060-03-31 366 + 62 2060/61 2060-04-01 2061-03-31 365 + 63 2061/62 2061-04-01 2062-03-31 365 + 64 2062/63 2062-04-01 2063-03-31 365 + 65 2063/64 2063-04-01 2064-03-31 366 + 66 2064/65 2064-04-01 2065-03-31 365 + 67 2065/66 2065-04-01 2066-03-31 365 + 68 2066/67 2066-04-01 2067-03-31 365 + 69 2067/68 2067-04-01 2068-03-31 366 + 70 2068/69 2068-04-01 2069-03-31 365 + 71 2069/70 2069-04-01 2070-03-31 365 + 72 2070/71 2070-04-01 2071-03-31 365 + 73 2071/72 2071-04-01 2072-03-31 366 + 74 2072/73 2072-04-01 2073-03-31 365 + 75 2073/74 2073-04-01 2074-03-31 365 + 76 2074/75 2074-04-01 2075-03-31 365 + 77 2075/76 2075-04-01 2076-03-31 366 + 78 2076/77 2076-04-01 2077-03-31 365 + 79 2077/78 2077-04-01 2078-03-31 365 + 80 2078/79 2078-04-01 2079-03-31 365 + 81 2079/80 2079-04-01 2080-03-31 366 + 82 2080/81 2080-04-01 2081-03-31 365 + 83 2081/82 2081-04-01 2082-03-31 365 + 84 2082/83 2082-04-01 2083-03-31 365 + 85 2083/84 2083-04-01 2084-03-31 366 + 86 2084/85 2084-04-01 2085-03-31 365 + 87 2085/86 2085-04-01 2086-03-31 365 + 88 2086/87 2086-04-01 2087-03-31 365 + 89 2087/88 2087-04-01 2088-03-31 366 + 90 2088/89 2088-04-01 2089-03-31 365 + 91 2089/90 2089-04-01 2090-03-31 365 + 92 2090/91 2090-04-01 2091-03-31 365 + 93 2091/92 2091-04-01 2092-03-31 366 + 94 2092/93 2092-04-01 2093-03-31 365 + 95 2093/94 2093-04-01 2094-03-31 365 + 96 2094/95 2094-04-01 2095-03-31 365 + 97 2095/96 2095-04-01 2096-03-31 366 + 98 2096/97 2096-04-01 2097-03-31 365 + 99 2097/98 2097-04-01 2098-03-31 365 + 100 2098/99 2098-04-01 2099-03-31 365 + 101 2099/00 2099-04-01 2100-03-31 365 + diff --git a/tests/testthat/_snaps/format_postcode.md b/tests/testthat/_snaps/format_postcode.md index ae6814a..a66d72f 100644 --- a/tests/testthat/_snaps/format_postcode.md +++ b/tests/testthat/_snaps/format_postcode.md @@ -2,8 +2,10 @@ Code format_postcode("g2") - Warning + Condition + Warning: 1 value has lower case letters these will be converted to upper case. + Warning: 1 non-NA input value does not adhere to the standard UK postcode format (with or without spaces) and will be coded as NA. The standard format is: * 1 or 2 letters, followed by @@ -18,8 +20,10 @@ Code format_postcode(c("DG98BS", "dg98b")) - Warning + Condition + Warning: 1 value has lower case letters these will be converted to upper case. + Warning: 1 non-NA input value does not adhere to the standard UK postcode format (with or without spaces) and will be coded as NA. The standard format is: * 1 or 2 letters, followed by @@ -34,7 +38,8 @@ Code format_postcode(c("ML53RB", NA, "ML5", "???", 53, as.factor("ML53RB"))) - Warning + Condition + Warning: 4 non-NA input values do not adhere to the standard UK postcode format (with or without spaces) and will be coded as NA. The standard format is: * 1 or 2 letters, followed by @@ -53,8 +58,10 @@ [1] "KY1 1RZ" NA NA NA Code format_postcode(c("KY1 1RZ", "ky1rz", "KY11 R", "KY11R!"), quiet = FALSE) - Warning + Condition + Warning: 1 value has lower case letters these will be converted to upper case. + Warning: 3 non-NA input values do not adhere to the standard UK postcode format (with or without spaces) and will be coded as NA. The standard format is: * 1 or 2 letters, followed by diff --git a/tests/testthat/_snaps/rename.md b/tests/testthat/_snaps/rename.md index 8ddf50b..897392d 100644 --- a/tests/testthat/_snaps/rename.md +++ b/tests/testthat/_snaps/rename.md @@ -2,126 +2,136 @@ Code expect_equal(stringr::str_length(postcode("G26QE", format = "pc7")), 7) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(stringr::str_length(postcode("G26QE", format = "pc8")), 6) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(stringr::str_length(postcode(c("KA89NB", "PA152TY"), format = "pc7")), c(7, 7)) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(stringr::str_length(postcode(c("KA89NB", "PA152TY"), format = "pc8")), c(7, 8)) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(postcode("G36RB"), "G3 6RB") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(postcode("G432XR"), "G43 2XR") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(postcode("DG29BA"), "DG2 9BA") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(postcode("FK101RY"), "FK101RY") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(postcode("E1W3TJ"), "E1W 3TJ") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(postcode("EC1Y8SE"), "EC1Y8SE") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code input_hampden <- c("G429BA", "g429ba", "G42 9BA", "G 4 2 9 B A", "G429b a") - formatted_hampden <- suppressWarnings(postcode(input_hampden)) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + expect_true(length(unique(postcode(input_hampden))) == 1) + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code - expect_true(length(unique(formatted_hampden)) == 1) - Error - object 'formatted_hampden' not found - Code - expect_equal(unique(formatted_hampden), "G42 9BA") - Error - object 'formatted_hampden' not found + expect_equal(unique(postcode(input_hampden)), "G42 9BA") + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + i Please use `format_postcode()` instead. Code expect_true(is.na(suppressWarnings(postcode("G2?QE")))) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_warning(postcode(c("G207AL", "G2O07AL"))) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_equal(suppressWarnings(postcode(c("EH7 5QG", NA, "EH11 2NL", "EH5 2HF*"))), c("EH7 5QG", NA, "EH112NL", NA)) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code input_dens <- c("Dd37Jy", "DD37JY", "D d 337JY") - warnings_dens <- capture_warnings(postcode(input_dens)) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + expect_length(capture_warnings(postcode(input_dens)), 2) + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. - Code - expect_length(warnings_dens, 2) - Error - object 'warnings_dens' not found Code input_pittodrie <- c("ab245qh", NA, "ab245q", "A B245QH") - warnings_pittodrie <- capture_warnings(postcode(input_pittodrie)) - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + expect_length(capture_warnings(postcode(input_pittodrie)), 3) + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. - Code - expect_length(warnings_pittodrie, 3) - Error - object 'warnings_pittodrie' not found Code expect_warning(postcode("g2"), "^1") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_warning(postcode(c("DG98BS", "dg98b")), "^1") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_warning(postcode(c("KY1 1RZ", "ky1rz", "KY11 R", "KY11R!")), "^3") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. Code expect_warning(postcode(c("ML53RB", NA, "ML5", "???", 53, as.factor("ML53RB"))), "^4") - Error - `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `postcode()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `format_postcode()` instead. # age_group is deprecated @@ -129,8 +139,9 @@ Code expect_identical(age_group(c(4, 51, 21, 89), 0, 80, 10, as_factor = FALSE), c( "0-9", "50-59", "20-29", "80+")) - Error - `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `create_age_groups()` instead. Code expect_identical(age_group(c(8, 94, 44, 55, 14), 0, 90, 5, as_factor = TRUE), @@ -138,28 +149,32 @@ "10-14", "15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80-84", "85-89", "90+"), ordered = TRUE)) - Error - `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `create_age_groups()` instead. Code expect_identical(age_group(c(81, 86, 33, 11), 4, 84, 3, as_factor = FALSE), c( "79-81", "82+", "31-33", "10-12")) - Error - `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `create_age_groups()` instead. Code expect_identical(age_group(c(0, 99, 1000, 5, 5), 5, 90, 5, as_factor = FALSE), c(NA, "90+", "90+", "5-9", "5-9")) - Error - `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `create_age_groups()` instead. Code expect_identical(age_group(10, as_factor = TRUE), factor(c("10-14"), levels = c( "0-4", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80-84", "85-89", "90+"), ordered = TRUE)) - Error - `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `age_group()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `create_age_groups()` instead. Code expect_error(age_group(c("1", "57", "apple", "12"), as_factor = FALSE)) @@ -169,43 +184,51 @@ Code expect_equal(fin_year(as.Date("20120331", "%Y%m%d")), "2011/12") - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. Code expect_equal(fin_year(as.Date("20120401", "%Y%m%d")), "2012/13") - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. Code expect_equal(fin_year(as.POSIXct("20190104", format = "%Y%m%d")), "2018/19") - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. Code expect_equal(fin_year(as.Date("17111993", "%d%m%Y")), "1993/94") - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. Code expect_equal(fin_year(as.Date("19980404", "%Y%m%d")), "1998/99") - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. Code expect_equal(fin_year(as.Date("21-Jan-2017", "%d-%B-%Y")), "2016/17") - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. Code expect_equal(fin_year(as.POSIXct("20181401", format = "%Y%d%m")), "2017/18") - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. Code expect_equal(fin_year(lubridate::dmy(29102019)), "2019/20") - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. Code expect_error(fin_year("28102019")) @@ -213,7 +236,8 @@ expect_error(fin_year(as.numeric("28102019"))) expect_error(fin_year(as.factor("28-Oct-2019"))) expect_equal(fin_year(c(lubridate::dmy(5012020), NA)), c("2019/20", NA)) - Error - `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. + Condition + Error: + ! `fin_year()` was deprecated in phsmethods 0.2.1 and is now defunct. i Please use `extract_fin_year()` instead. diff --git a/tests/testthat/test-create_age_groups.R b/tests/testthat/test-create_age_groups.R index e08866e..a15155c 100644 --- a/tests/testthat/test-create_age_groups.R +++ b/tests/testthat/test-create_age_groups.R @@ -56,8 +56,12 @@ test_that("Default value for age groups", { test_that("Handling of non-numeric values for x", { # If x is not numeric cut will error - expect_error(create_age_groups(c("1", "57", "apple", "12"), as_factor = FALSE)) + expect_error( + create_age_groups(c("1", "57", "apple", "12"), as_factor = FALSE) + ) # This is true even if all elements are numbers stored as character - expect_error(create_age_groups(c("26", "9", "78", "81"), as_factor = FALSE)) + expect_error( + create_age_groups(c("26", "9", "78", "81"), as_factor = FALSE) + ) }) diff --git a/tests/testthat/test-extract_fin_year.R b/tests/testthat/test-extract_fin_year.R index 46cd8d5..5bc5cff 100644 --- a/tests/testthat/test-extract_fin_year.R +++ b/tests/testthat/test-extract_fin_year.R @@ -22,3 +22,93 @@ test_that("Non-date formats produce an error", { test_that("NAs are handled correctly", { expect_equal(extract_fin_year(c(lubridate::dmy(05012020), NA)), c("2019/20", NA)) }) + +test_that("YYYY/YY format applied correctly", { + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "01/April/1999"), NA)), + c(NA, "1999/00", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "01/April/2000"), NA)), + c(NA, "2000/01", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "01/April/2001"), NA)), + c(NA, "2001/02", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "31/March/1999"), NA)), + c(NA, "1998/99", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "31/March/2000"), NA)), + c(NA, "1999/00", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "31/March/2001"), NA)), + c(NA, "2000/01", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "01/December/1999"), NA)), + c(NA, "1999/00", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "01/December/2000"), NA)), + c(NA, "2000/01", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "01/December/2999"), NA)), + c(NA, "2999/00", NA) + ) + expect_equal( + extract_fin_year(c(lubridate::dmy(NA, "01/December/3000"), NA)), + c(NA, "3000/01", NA) + ) + + expect_equal( + extract_fin_year( + lubridate::as_datetime( + c(lubridate::dmy(NA, "01/April/1999"), NA) + ) + ), + c(NA, "1999/00", NA) + ) + + expect_equal( + extract_fin_year( + lubridate::as_datetime( + c(lubridate::dmy(NA, "01/December/2000"), NA) + ) + ), + c(NA, "2000/01", NA) + ) + + expect_equal( + extract_fin_year( + lubridate::as_datetime( + c(lubridate::dmy(NA, "01/April/0001"), NA) + ) + ), + c(NA, "0001/02", NA) + ) +}) + +test_that("Correct outputs", { + expect_snapshot({ + start <- lubridate::make_date(1999, 4, 1) + end <- lubridate::make_date(2100, 3, 31) + dates <- seq(start, end, by = "day") + + df <- data.frame( + date = dates, + fin_year = extract_fin_year(dates) + ) + + dplyr::summarise(df, + first_date = min(date), + last_date = max(date), + days = dplyr::n(), + .by = fin_year + ) + }) +}) diff --git a/tests/testthat/test-rename.R b/tests/testthat/test-rename.R index f9c00a3..bd9272c 100644 --- a/tests/testthat/test-rename.R +++ b/tests/testthat/test-rename.R @@ -18,10 +18,9 @@ test_that("postcode is deprecated", { expect_equal(postcode("EC1Y8SE"), "EC1Y8SE") input_hampden <- c("G429BA", "g429ba", "G42 9BA", "G 4 2 9 B A", "G429b a") - formatted_hampden <- suppressWarnings(postcode(input_hampden)) - expect_true(length(unique(formatted_hampden)) == 1) - expect_equal(unique(formatted_hampden), "G42 9BA") + expect_true(length(unique(postcode(input_hampden))) == 1) + expect_equal(unique(postcode(input_hampden)), "G42 9BA") expect_true(is.na(suppressWarnings(postcode("G2?QE")))) expect_warning(postcode(c("G207AL", "G2O07AL"))) @@ -34,12 +33,10 @@ test_that("postcode is deprecated", { ) input_dens <- c("Dd37Jy", "DD37JY", "D d 337JY") - warnings_dens <- capture_warnings(postcode(input_dens)) - expect_length(warnings_dens, 2) + expect_length(capture_warnings(postcode(input_dens)), 2) input_pittodrie <- c("ab245qh", NA, "ab245q", "A B245QH") - warnings_pittodrie <- capture_warnings(postcode(input_pittodrie)) - expect_length(warnings_pittodrie, 3) + expect_length(capture_warnings(postcode(input_pittodrie)), 3) expect_warning(postcode("g2"), "^1") expect_warning(postcode(c("DG98BS", "dg98b")), "^1")