934 review tests on createslf package

.github/actions/spelling/allow.txt

@@ -8,4 +8,4 @@ McMahon
 Moohan
 Scougal
 Tayside
-Zihao
+Zihao

.github/actions/spelling/expect.txt

@@ -9,7 +9,6 @@ atlassian
 attendcat
 aut
 bedday
-beddays
 birthtime
 bodyloc
 boxi
@@ -61,16 +60,16 @@ dischto
 disdest
 dminutes
 dna
-dnas
 dontrun
 downup
 dplyr
 dsn
 dtplyr
-DVPROD
 dvprod
 envir
+fcase
 feb
+fifelse
 fileext
 Finalise
 fst
@@ -80,31 +79,32 @@ fyyear
 geogs
 ggplot
 github
-GLS
 gls
 gms
 GPOo
 gpprac
 gss
 hbnames
+hbp
 hbpraccode
 hbrescode
 hbtreatcode
 hbtreatname
 hci
 HCP
-HHG
 hhg
 hjust
 hms
 homecare
 homev
+hri
 hscdiip
 hscp
 hscpnames
 htmlwidgets
 IDPC
 infyyear
+intzone
 ipdc
 issuenumber
 itle
@@ -119,19 +119,20 @@ keytime
 keytimex
 kis
 lazydt
+lcap
+LCHO
 lgl
 lintr
 los
 ltc
-ltcs
 lubridate
 magrittr
 markdownguide
 Matern
 Mcbride
 mcmahon
 MMMYY
-monthflag
+MONTHFLAG
 mpat
 multiday
 multisession
@@ -140,7 +141,6 @@ NAs
 newcons
 nhs
 nhshosp
-NRS
 nrs
 nsu
 odbc
@@ -161,9 +161,9 @@ pkgdown
 placeinc
 plics
 PMS
+popluation
 postcodes
 PPAs
-Prac
 prac
 praccode
 ptypes
@@ -172,7 +172,7 @@ quickstart
 rankdir
 Rbuildignore
 rcmdcheck
-rdd
+RDD
 rds
 reabl
 reablement
@@ -190,29 +190,28 @@ roxygen
 Rprofile
 Rscript
 rspm
-RStudio
 rstudio
 rstudioapi
 Rtype
+scoial
+scotp
 SDcols
 seealso
 selfharm
 setkeyv
 setnafill
 setnames
+setorder
 Siar
 sigfac
 simd
-SLF
 slf
 slfhelper
 smr
 SMRA
 smrtype
-SPARRA
 sparra
 spd
-SPSS
 spss
 stadm
 starwars
@@ -223,7 +222,6 @@ submis
 tadm
 tarchetypes
 tbl
-Telecare
 telecare
 testthat
 thom

R/add_hri_variables.R

@@ -4,9 +4,9 @@
 #' \itemize{
 #' \item{keep_flag = 0 when resident is Scottish}
 #' \item{keep_flag = 1 when resident is not Scottish}
 #' \item{keep_flag = 2 when the postcode is missing or a dummy, and the gpprac is missing}
 #' \item{keep_flag = 3 when the gpprac is not English and the postcode is missing}
 #' \item{keep_flag = 4 when the gpprac is not English and the postcode is a dummy}
 #' }
 #' The intention is to only keep the records where keep_flag = 0
 #'
@@ -22,23 +22,23 @@
   # of the postcode
   pc_areas <- slf_pc_lookup %>%
     dplyr::mutate(
-      pc_area = stringr::str_match(postcode, "^[A-Z]{1,3}"),
+      pc_area = stringr::str_match(.data$postcode, "^[A-Z]{1,3}"),
       scot_flag = TRUE
     ) %>%
-    dplyr::distinct(pc_area, scot_flag)
+    dplyr::distinct(.data$pc_area, .data$scot_flag)
 
   # Create a flag, 'keep_flag', to determine whether individuals are Scottish
   # residents or not
   return_data <- data %>%
-    dplyr::mutate(pc_area = stringr::str_match(postcode, "^[A-Z]{1,3}")) %>%
+    dplyr::mutate(pc_area = stringr::str_match(.data$postcode, "^[A-Z]{1,3}")) %>%
     dplyr::left_join(pc_areas, by = "pc_area") %>%
     dplyr::mutate(
       dummy_postcode = .data$postcode %in% c("BF010AA", "NF1 1AB", "NK010AA") |
         stringr::str_sub(.data$postcode, 1, 4) %in% c("ZZ01", "ZZ61"),
       eng_prac = .data$gpprac %in% c(99942, 99957, 99961, 99976, 99981, 99995, 99999),
       scottish_resident = dplyr::case_when(
         .data$scot_flag ~ 0L,
         (is_missing(.data$postcode) | .data$dummy_postcode) & is.na(.data$gpprac) ~ 2L,
         !.data$eng_prac & is_missing(.data$postcode) ~ 3L,
         !.data$eng_prac & .data$dummy_postcode ~ 4L,
         .default = 1L
@@ -58,6 +58,7 @@
 #' @param data An SLF individual file.
 #' @param slf_pc_lookup The Source postcode lookup, defaults
 #' to [get_slf_postcode_path()] read using [read_file()].
+#' @param chi_variable string, claiming chi or anon_chi.
 #'
 #' @return The individual file with HRI variables matched on
 #' @export
@@ -88,42 +89,42 @@
       "ooh_cases"
     ) %>%
     flag_non_scottish_residents(slf_pc_lookup = slf_pc_lookup) %>%
-    dplyr::filter(scottish_resident == 0L) %>%
+    dplyr::filter(.data$scottish_resident == 0L) %>%
     # Scotland cost and proportion
     dplyr::mutate(
-      scotland_cost = sum(health_net_cost),
-      scotland_pct = (health_net_cost / scotland_cost) * 100
+      scotland_cost = sum(.data$health_net_cost),
+      scotland_pct = (.data$health_net_cost / .data$scotland_cost) * 100
     ) %>%
-    dplyr::arrange(dplyr::desc(health_net_cost)) %>%
-    dplyr::mutate(hri_scotp = cumsum(scotland_pct)) %>%
+    dplyr::arrange(dplyr::desc(.data$health_net_cost)) %>%
+    dplyr::mutate(hri_scotp = cumsum(.data$scotland_pct)) %>%
     # Health Board
-    dplyr::group_by(hbrescode) %>%
+    dplyr::group_by(.data$hbrescode) %>%
     dplyr::mutate(
-      hb_cost = sum(health_net_cost),
-      hb_pct = (health_net_cost / hb_cost) * 100
+      hb_cost = sum(.data$health_net_cost),
+      hb_pct = (.data$health_net_cost / .data$hb_cost) * 100
     ) %>%
-    dplyr::arrange(dplyr::desc(health_net_cost), .by_group = TRUE) %>%
-    dplyr::mutate(hri_hbp = cumsum(hb_pct)) %>%
+    dplyr::arrange(dplyr::desc(.data$health_net_cost), .by_group = TRUE) %>%
+    dplyr::mutate(hri_hbp = cumsum(.data$hb_pct)) %>%
     dplyr::ungroup() %>%
     # LCA
-    dplyr::group_by(lca) %>%
+    dplyr::group_by(.data$lca) %>%
     dplyr::mutate(
-      lca_cost = sum(health_net_cost),
-      lca_pct = (health_net_cost / lca_cost) * 100
+      lca_cost = sum(.data$health_net_cost),
+      lca_pct = (.data$health_net_cost / .data$lca_cost) * 100
     ) %>%
-    dplyr::arrange(dplyr::desc(health_net_cost), .by_group = TRUE) %>%
-    dplyr::mutate(hri_lcap = cumsum(lca_pct)) %>%
+    dplyr::arrange(dplyr::desc(.data$health_net_cost), .by_group = TRUE) %>%
+    dplyr::mutate(hri_lcap = cumsum(.data$lca_pct)) %>%
     dplyr::ungroup() %>%
     # Add HRI flags
     dplyr::mutate(
-      hri_scot = hri_scotp <= 50.0,
-      hri_hb = hri_hbp <= 50.0,
-      hri_lca = hri_lcap <= 50.0,
+      hri_scot = .data$hri_scotp <= 50.0,
+      hri_hb = .data$hri_hbp <= 50.0,
+      hri_lca = .data$hri_lcap <= 50.0,
       # Deal with potential missing variables
-      hri_hb = dplyr::if_else(is_missing(hbrescode), FALSE, hri_hb),
-      hri_hbp = dplyr::if_else(is_missing(hbrescode), NA, hri_hbp),
-      hri_lca = dplyr::if_else(is_missing(lca), FALSE, hri_lca),
-      hri_lcap = dplyr::if_else(is_missing(lca), NA, hri_lcap)
+      hri_hb = dplyr::if_else(is_missing(.data$hbrescode), FALSE, .data$hri_hb),
+      hri_hbp = dplyr::if_else(is_missing(.data$hbrescode), NA, .data$hri_hbp),
+      hri_lca = dplyr::if_else(is_missing(.data$lca), FALSE, .data$hri_lca),
+      hri_lcap = dplyr::if_else(is_missing(.data$lca), NA, .data$hri_lcap)
     ) %>%
     # Select only required variables for the lookup
     dplyr::select(

R/add_keep_population_flag.R

@@ -16,27 +16,32 @@
     ## Obtain the population estimates for Locality AgeGroup and Gender.
     pop_estimates <-
       readr::read_rds(get_pop_path(type = "datazone")) %>%
-      dplyr::select(year, datazone2011, sex, age0:age90plus)
+      dplyr::select(
+        .data$year,
+        .data$datazone2011,
+        .data$sex,
+        .data$age0:.data$age90plus
+      )
 
     # Step 1: Obtain the population estimates for Locality, AgeGroup, and Gender
     # Select out the estimates for the year of interest.
     # if we don't have estimates for this year (and so have to use previous year).
     year_available <- pop_estimates %>%
-      dplyr::pull(year) %>%
+      dplyr::pull(.data$year) %>%
       unique()
 
     if (calendar_year %in% year_available) {
       pop_estimates <- pop_estimates %>%
-        dplyr::filter(year == calendar_year)
+        dplyr::filter(.data$year == calendar_year)
     } else {
       previous_year <- sort(year_available, decreasing = TRUE)[1]
       pop_estimates <- pop_estimates %>%
-        dplyr::filter(year == previous_year)
+        dplyr::filter(.data$year == previous_year)
     }
 
     pop_estimates <- pop_estimates %>%
       # Recode gender to make it match source.
-      dplyr::mutate(sex = dplyr::if_else(sex == "M", 1, 2)) %>%
+      dplyr::mutate(sex = dplyr::if_else(.data$sex == "M", 1, 2)) %>%
       dplyr::rename(
         "age90" = "age90plus",
         "gender" = "sex"
@@ -47,79 +52,79 @@
         values_to = "population_estimate",
         cols = "age0":"age90"
       ) %>%
-      dplyr::mutate(age = as.integer(age)) %>%
-      add_age_group(age) %>%
+      dplyr::mutate(age = as.integer(.data$age)) %>%
+      add_age_group(.data$age) %>%
       dplyr::left_join(
         readr::read_rds(get_locality_path()) %>%
-          dplyr::select("locality" = "hscp_locality", datazone2011),
+          dplyr::select("locality" = "hscp_locality", .data$datazone2011),
         by = "datazone2011"
       ) %>%
-      dplyr::group_by(locality, age_group, gender) %>%
-      dplyr::summarize(population_estimate = sum(population_estimate)) %>%
+      dplyr::group_by(.data$locality, .data$age_group, .data$gender) %>%
+      dplyr::summarize(population_estimate = sum(.data$population_estimate)) %>%
       dplyr::ungroup()
 
     # Step 2: Work out the current population sizes in the SLF for Locality, AgeGroup, and Gender
     # Work out the current population sizes in the SLF for Locality AgeGroup and Gender.
     individual_file <- individual_file %>%
-      dplyr::mutate(age = as.integer(age)) %>%
-      add_age_group(age)
+      dplyr::mutate(age = as.integer(.data$age)) %>%
+      add_age_group(.data$age)
 
 
     set.seed(100)
     mid_year <- lubridate::dmy(stringr::str_glue("30-06-{calendar_year}"))
     ## issues with age being negative
     # If they don't have a locality, they're no good as we won't have an estimate to match them against.
     # Same for age and gender.
     nsu_keep_lookup <- individual_file %>%
-      dplyr::filter(gender == 1 | gender == 2) %>%
-      dplyr::filter(!is.na(locality), !is.na(age)) %>%
+      dplyr::filter(.data$gender == 1 | .data$gender == 2) %>%
+      dplyr::filter(!is.na(.data$locality), !is.na(.data$age)) %>%
       dplyr::mutate(
         # Flag service users who were dead at the mid year date.
-        flag_to_remove = dplyr::if_else(death_date <= mid_year & nsu == 0, 1, 0),
+        flag_to_remove = dplyr::if_else(.data$death_date <= mid_year & .data$nsu == 0, 1, 0),
         # If the death date is missing, keep those people.
-        flag_to_remove = dplyr::if_else(is.na(death_date), 0, flag_to_remove),
+        flag_to_remove = dplyr::if_else(is.na(.data$death_date), 0, .data$flag_to_remove),
         # If they are a non-service-user we want to keep them
-        flag_to_remove = dplyr::if_else(nsu == 1, 0, flag_to_remove)
+        flag_to_remove = dplyr::if_else(.data$nsu == 1, 0, .data$flag_to_remove)
       ) %>%
       # Remove anyone who was flagged as 1 from above.
-      dplyr::filter(flag_to_remove == 0) %>%
+      dplyr::filter(.data$flag_to_remove == 0) %>%
       # Calculate the populations of the whole SLF and of the NSU.
-      dplyr::group_by(locality, age_group, gender) %>%
+      dplyr::group_by(.data$locality, .data$age_group, .data$gender) %>%
       dplyr::mutate(
-        nsu_population = sum(nsu),
+        nsu_population = sum(.data$nsu),
         total_source_population = dplyr::n()
       ) %>%
-      dplyr::filter(nsu == 1) %>%
+      dplyr::filter(.data$nsu == 1) %>%
       dplyr::left_join(pop_estimates,
         by = c("locality", "age_group", "gender")
       ) %>%
       dplyr::mutate(
-        difference = total_source_population - population_estimate,
-        new_nsu_figure = nsu_population - difference,
-        scaling_factor = new_nsu_figure / nsu_population,
-        scaling_factor = dplyr::case_when(scaling_factor < 0 ~ 0,
-          scaling_factor > 1 ~ 1,
-          .default = scaling_factor
+        difference = .data$total_source_population - .data$population_estimate,
+        new_nsu_figure = .data$nsu_population - .data$difference,
+        scaling_factor = .data$new_nsu_figure / .data$nsu_population,
+        scaling_factor = dplyr::case_when(.data$scaling_factor < 0 ~ 0,
+          .data$scaling_factor > 1 ~ 1,
+          .default = .data$scaling_factor
         ),
-        keep_nsu = rbinom(nsu_population, 1, scaling_factor)
+        keep_nsu = stats::rbinom(.data$nsu_population, 1, .data$scaling_factor)
       ) %>%
-      dplyr::filter(keep_nsu == 1L) %>%
+      dplyr::filter(.data$keep_nsu == 1L) %>%
       dplyr::ungroup() %>%
-      dplyr::select(-flag_to_remove)
+      dplyr::select(-.data$flag_to_remove)
 
     # step 3: match the flag back onto the slf
     individual_file <- individual_file %>%
       dplyr::left_join(nsu_keep_lookup,
         by = "chi",
         suffix = c("", ".y")
       ) %>%
-      dplyr::select(-contains(".y")) %>%
+      dplyr::select(-tidyselect::contains(".y")) %>%
       dplyr::rename("keep_population" = "keep_nsu") %>%
       dplyr::mutate(
         # Flag all non-NSUs as Keep.
-        keep_population = dplyr::if_else(nsu == 0, 1, keep_population),
+        keep_population = dplyr::if_else(.data$nsu == 0, 1, .data$keep_population),
         # If the flag is missing they must be a non-keep NSU so set to 0.
-        keep_population = dplyr::if_else(is.na(keep_population), 0, keep_population),
+        keep_population = dplyr::if_else(is.na(.data$keep_population), 0, .data$keep_population),
       ) %>%
       dplyr::select(
         -c(