Merge e876106 into fce329c

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: PHEindicatormethods
 Type: Package
-Version: 1.1.5.9000
+Version: 1.1.5.9901
 Title: Common Public Health Statistics and their Confidence Intervals 
 Description: Functions to calculate commonly used public health statistics and 
     their confidence intervals using methods approved for use in the production  

NEWS.md

@@ -1,7 +1,11 @@
+## PHEindicatormethods v1.1.5.9901
+
+Include summative numerator and denominator counts in life expectancy
+calculation.
+
 ## PHEindicatormethods v1.1.5.9000
 Some warnings that occurred with `phe_life_expectancy()` have been fixed
 
-
 ## PHEindicatormethods v1.1.5
 phe_sii function updated to be compatible with nest and unnest functions from tidyr version 1.0
 

R/LifeExpectancy.R

@@ -381,6 +381,20 @@ phe_life_expectancy <- function(data, deaths, population, startage,
   z <- qnorm(confidence + (1 - confidence)/2)
   data$group_id_2b_removed <- data %>%
     group_indices()
+
+  # add summative counts
+  #
+  # add fields {{deaths}}_cmltv, {{population}}_cmltv to hold for each ageband a
+  # cumulative total count for that and successive agebands
+  #
+  # ... implemented below as reverse sort on ageband, cumulative sum, then sort
+  # again on ageband to get back to revert the sort
+  #
+  data <- data %>%
+    arrange(desc(startage_2b_removed), .by_group = TRUE) %>%
+    mutate_at(vars(!!population, !!deaths), c(cmltv = cumsum)) %>%
+    arrange(startage_2b_removed, .by_group = TRUE)
+
   data <- data %>%
     mutate(id_2b_removed = row_number(),
            ni_2b_removed = as.numeric(lead(startage_2b_removed) - startage_2b_removed),
@@ -457,6 +471,17 @@ phe_life_expectancy <- function(data, deaths, population, startage,
                          statistic = paste("life expectancy at", !!startage),
                          method = "Chiang, using Silcocks et al for confidence limits")
   }
-  return(data)
 
+  # add summative counts
+  #
+  # set {{deaths}} and {{population}} fields with their respective
+  # {{}}_cmltv values
+  #
+  # ... implemented below as drop and rename
+  #
+  data <- data %>%
+    select_at(vars(-!!deaths, -!!population)) %>%
+    rename_at(vars(ends_with("_cmltv")), function(x){sub("_cmltv", "", x)})
+
+  return(data)
 }

tests/testthat/testLifeExpectancy.R

@@ -200,7 +200,7 @@ test_that("LE and CIs calculate correctly",{
   expect_equal(round(test5, n), round(answer1[3, ], n),
                check.attributes = FALSE, #because the row names are different and we are only interested in values
                info = "return single age band")
-  expect_equal(test6, answer2,
+  expect_equal(select(test6, -pops, -deaths), select(answer2, -pops, -deaths), # pops and deaths are mutated
                check.attributes = FALSE, #because the row names are different and we are only interested in values
                info = "type = 'full' with two filters")
   expect_equal(sum(!is.na(test_neg)), 0,