Add convert_to_age_band()

DESCRIPTION

@@ -11,6 +11,7 @@ RoxygenNote: 7.3.1
 Imports: 
     bizdays,
     dplyr,
+    glue,
     janitor,
     lubridate,
     magrittr,

NAMESPACE

@@ -5,6 +5,7 @@ export(adorn_financial_years)
 export(bucket_other)
 export(convert_col_date)
 export(convert_date)
+export(convert_to_age_band)
 export(create_sss_calendar)
 export(financial_year)
 export(make_all_number_percent)

R/manipulate_data.R

@@ -1,7 +1,7 @@
 #' Transposes a Data Frame
 #'
 #' This function take a data frame or tibble and transposes it, turning columns to
-#'rows and rows to columns
+#' rows and rows to columns
 #' @param data A data frame to transpose.
 #' @param pivot_column Column to be turned into column headings. Defaults to the
 #' first column in the data frame.
@@ -14,3 +14,62 @@ transpose_data <- function(data, pivot_column = 1, names_to = "name"){
     tidyr::pivot_longer(-pivot_column, names_to = names_to) %>%
     tidyr::pivot_wider(names_from = pivot_column)
 }
+
+#' Adds a Coloumn of Age Bands to a Data Frame
+#'
+#' This function takes data frame and adds a column of age bands based on a column
+#' of ages, according to a given age band specification.
+#' @param data A data frame
+#' @param age_col Column containing age data
+#' @param age_breaks A vector of breaks in age bands
+#' @param na Value to convert nas to. Defaults to "Unknown".
+#' @export
+
+convert_to_age_band <- function(data, age_col, age_breaks, na = "Unknown"){
+
+age_band_spec <-
+  create_age_band_spec(age_breaks) %>%
+  dplyr::mutate(
+    cond = glue::glue('{age_col} >= "{low}" & {age_col} < "{high}" ~ "{name}"'),
+    cond = rlang::parse_exprs(.data$cond)
+  )
+
+data %>%
+  dplyr::mutate(
+    age_band = dplyr::case_when(!!!age_band_spec$cond)
+  ) %>%
+  dplyr::mutate(
+    age_band = dplyr::case_when(
+      is.na(age_band) ~ na,
+      TRUE ~ age_band)
+  )
+}
+
+#' Converts List of Ages to Age Band Specification
+#'
+#' @param ages Vector of breaks in age bands
+#'
+#'
+
+create_age_band_spec <- function(ages){
+
+  low_limit <-
+    dplyr::tibble(name = paste("Under", ages[1]),
+           low = 0,
+           high = ages[1])
+
+  high_limit <-
+    dplyr::tibble(name = paste(ages[length(ages)], "and over"),
+           low = ages[length(ages)],
+           high = 150)
+
+  limits <-
+    dplyr::tibble(name = paste0(ages[-length(ages)], "-", ages[-1] - 1),
+           low = ages[-length(ages)],
+           high = ages[-1])
+
+  dplyr::bind_rows(
+    low_limit, limits, high_limit
+  )
+
+}

R/summarise_data.R

@@ -41,3 +41,5 @@ adorn_financial_years <- function(data, month, financial_years){
     dplyr::arrange(.data$is_fin_year) %>%
     dplyr::select(-c(.data$is_fin_year))
 }
+
+

README.md

@@ -7,7 +7,7 @@ Security Scotland statistics team.
 
 ## Using the package
 
-To install the package directly from GitHUb, open RStudio and run:
+To install the package directly from GitHub, open RStudio and run:
 
     devtools::install_github("ScotGovAnalysis/sssstats",
                    upgrade = "never",

tests/testthat/helper.R

@@ -24,6 +24,7 @@ create_test_data_2 <- function(cols = tidyselect::everything()){
   dplyr::tibble(place = c("Aberdeen", "Glasgow", "Edinburgh", "Edinburgh", "Ayr", "Perth", "Stirling", "Inverness", "Glasgow", "Edinburgh"),
                 month = c("January 2024", "February 2023", "September 2025", "October 2024", "March 2023", "February 2022", "September 2022", "December 2024", "November 2024", "April 2022"),
                 count = c(4, 5, 7, 3, 6, 2, 7, 3, 4, 9),
-                value = c(450, 399, 233, 736, 182, 433, 469, 932, 102, 377)) %>%
+                value = c(450, 399, 233, 736, 182, 433, 469, 932, 102, 377),
+                age = count * 5 + 1) %>%
     dplyr::select(all_of(cols))
 }