Merge branch 'main' into km-test-epi_df

Author: kenmawer

R/growth_rate.R

@@ -100,6 +100,17 @@
 #'   user.
 #' 
 #' @export
+#' @examples
+#' # COVID cases growth rate by state using default method relative change
+#' jhu_csse_daily_subset %>% 
+#'   group_by(geo_value) %>% 
+#'   mutate(cases_gr = growth_rate(x = time_value,  y = cases))
+#' 
+#' # Log scale, degree 4 polynomial and 6-fold cross validation
+#' jhu_csse_daily_subset %>% 
+#'   group_by(geo_value) %>% 
+#'   mutate(gr_poly = growth_rate( x = time_value, y = cases, log_scale = TRUE,  ord = 4,  k = 6))
+
 growth_rate = function(x = seq_along(y), y, x0 = x,
                        method = c("rel_change", "linear_reg",
                                   "smooth_spline", "trend_filter"),

R/utils.R

@@ -39,10 +39,12 @@ guess_geo_type = function(geo_value) {
     if (all(geo_value %in% state_values)) return("state")
 
     # Else if all geo values are 2 letters, then use "nation"
-    else if (all(grepl("[a-z]{2}", geo_value))) return("nation")
+    else if (all(grepl("[a-z]{2}", geo_value))
+             & !any(grepl("[a-z]{3}", geo_value))) return("nation")
 
     # Else if all geo values are 5 numbers, then use "county"
-    else if (all(grepl("[0-9]{5}", geo_value))) return("county")
+    else if (all(grepl("[0-9]{5}", geo_value)) &
+             !any(grepl("[0-9]{6}", geo_value))) return("county")
   }
 
   else if (is.numeric(geo_value)) {
@@ -79,7 +81,7 @@ guess_time_type = function(time_value) {
 
   # Else, if a Date class, then use "week" or "day" depending on gaps 
   else if (inherits(time_value, "Date")) {
-    return(ifelse(all(diff(sort(time_value)) == -7), "week", "day"))
+    return(ifelse(all(diff(sort(time_value)) == 7), "week", "day"))
   }
 
   # Else, check whether it's one of the tsibble classes

man/epi_slide.Rd

@@ -0,0 +1,108 @@
+test_that("break_string works properly",{
+  expect_equal(break_str("A dog is here", 6),"A dog\nis\nhere")
+})
+
+test_that("Abort and Warn work",{
+  expect_error(Abort("abort"))
+  expect_warning(Warn("warn"))
+})
+
+test_that("in_range works",{
+  expect_equal(in_range(1,c(2,4)),2)
+  expect_equal(in_range(3,c(2,4)),3)
+  expect_equal(in_range(5,c(2,4)),4)
+})
+
+test_that("new summarizing functions work",{
+  x <- c(3,4,5,9,NA)
+  expect_equal(Min(x),3)
+  expect_equal(Max(x),9)
+  expect_equal(Sum(x),21)
+  expect_equal(Mean(x),5.25)
+  expect_equal(Median(x),4.5)
+})
+
+test_that("Other capital letter functions work",{
+  x <- c(1,2,3,4,5)
+  expect_equal(Start(x),1)
+  expect_equal(End(x),5)
+  expect_equal(MiddleL(x),2) # Questionable for odd length vectors
+  expect_equal(MiddleR(x),3) # Questionable for odd length vectors
+  expect_equal(ExtendL(x),c(1,1,2,3,4,5))
+  expect_equal(ExtendR(x),c(1,2,3,4,5,5))
+})
+
+test_that("guess_geo_type tests for different types of geo_value's",{
+  # California, New York
+  states <- c("ca","ny")
+  
+  # Canada, USA, United Kingdom
+  nations <- c("ca","us","uk")
+  
+  # Note: These are just five-number names that may not necessarily be existent
+  # counties
+  counties <- c("12345","67890")
+  
+  # HHS regions
+  hhs <- c(1:3)
+  
+  # HRR regions
+  hrr <- c(100,200)
+  
+  # Long numbers should be custom
+  long_nums <- c(123456789,111222333)
+  
+  # Health regions in British Columbia
+  bc <- c("Vancouver Coastal","Interior","Fraser",
+              "Northern","Vancouver Island")
+  
+  # Long numbers as strings should also be custom
+  long_num_strings <- c("123456789","111222333")
+  
+  expect_equal(guess_geo_type(states),"state")
+  expect_equal(guess_geo_type(nations),"nation")
+  expect_equal(guess_geo_type(counties),"county")
+  expect_equal(guess_geo_type(hhs),"hhs")
+  expect_equal(guess_geo_type(hrr),"hrr")
+  expect_equal(guess_geo_type(long_num_strings),"custom")
+  expect_equal(guess_geo_type(bc),"custom")
+  expect_equal(guess_geo_type(long_nums),"custom")
+})
+
+test_that("guess_time_type works for different types",{
+  days <- as.Date("2022-01-01") + 0:6
+  weeks <- as.Date("2022-01-01") + 7 * 0:6
+
+  yearweeks <- tsibble::yearweek(10)
+  yearmonths <- tsibble::yearmonth(10)
+  yearquarters <- tsibble::yearquarter(10)
+  
+  years <- c(1999,2000)
+  
+  # YYYY-MM-DD is the accepted format
+  not_ymd1 <- "January 1, 2022"
+  not_ymd2 <- "1 January 2022"
+  not_ymd3 <- "1 Jan 2022"
+  
+  not_a_date <- "asdf"
+  
+  expect_equal(guess_time_type(days),"day")
+  expect_equal(guess_time_type(weeks),"week")
+
+  expect_equal(guess_time_type(yearweeks),"yearweek")  
+  expect_equal(guess_time_type(yearmonths),"yearmonth")
+  expect_equal(guess_time_type(yearquarters),"yearquarter")
+  
+  expect_equal(guess_time_type(years),"year")
+  
+  expect_equal(guess_time_type(not_ymd1),"custom")
+  expect_equal(guess_time_type(not_ymd2),"custom")
+  expect_equal(guess_time_type(not_ymd3),"custom")
+  expect_equal(guess_time_type(not_a_date),"custom")
+})
+
+test_that("enlist works",{
+  my_list <- enlist(x=1,y=2,z=3)
+  expect_equal(my_list$x,1)
+  expect_true(inherits(my_list,"list"))
+})