qy can now handle inputs without seperator between quarter and year

  (e.g. `myfile42019`)

Author: Stefan Fleck

DESCRIPTION

@@ -2,7 +2,7 @@ Type: Package
 Package: dint
 Title: A Toolkit for Year-Quarter, Year-Month and Year-Isoweek
     Dates
-Version: 2.1.3.9000
+Version: 2.1.3.9001
 Authors@R: 
     person(given = "Stefan",
            family = "Fleck",

NEWS.md

@@ -2,6 +2,8 @@
 
 * vectors of length 1 are now recycled when adding or subtracting `date_xx` 
   objects, e.g. `date_yq(2019, 1) + 1:4` is now possible (#5).
+* `qy` can now handle inputs without seperator between quarter and year 
+  (e.g. `myfile42019`)
 
 
 # dint 2.1.3

R/parser.R

@@ -42,7 +42,7 @@ yq <- function(x, quiet = FALSE){
 #' @export
 qy <- function(x, quiet = FALSE){
   assert(is.character(x), "'x' must be a character vector")
-  r <- vapply(x, parse_yq, integer(1), pattern = "^[^0-9]*[1-4][^0-9]*\\d{4}[^0-9]*$", USE.NAMES = FALSE)
+  r <- vapply(x, parse_qy, integer(1), pattern = "^[^0-9]*[1-4][^0-9]*\\d{4}[^0-9]*$", USE.NAMES = FALSE)
 
   if (!quiet){
     failed <- sum(is.na(r)) - sum(is.na(x))
@@ -129,6 +129,31 @@ parse_yq <- function(x, pattern){
 
 
 
+parse_qy <- function(x, pattern){
+  if (!grepl(pattern, x)){
+    return(NA_integer_)
+  }
+
+  extr <- function(string, pos, length){
+    if (identical(pos, -1))
+      NA_integer_
+    else
+      as.integer(substr(string, pos, pos + length))
+  }
+
+  pos_y <- regexpr("\\d{4}[^0-9]*$", x)
+  year  <- extr(x, pos_y, 3)
+  x <- strtrim(x, pos_y - 1L)
+
+  pos_q <- regexpr("[1-4]{1}[^0-9]*", x)
+  quarter <- extr(x, pos_q, 0)
+
+  as.integer(year) * 10L + as.integer(quarter)
+}
+
+
+
+
 #' @inheritParams parse_yq
 #' @return an `integer` scalar for as_date_ym
 #' @noRd

tests/testthat/test_parser.R

@@ -4,11 +4,7 @@ context("parser")
 test_that("yq/qy work as expected", {
 
   x <- c("dfw2018q2", "bl2017qasdg4sadgfas", "201712", "blubb", "2017-2016", NA)
-
-  expect_warning(
-    r <- as.integer(yq(x)),
-    "3 failed"
-  )
+  expect_warning(r <- as.integer(yq(x)), "3 failed")
 
   expect_identical(
     r,
@@ -18,16 +14,17 @@ test_that("yq/qy work as expected", {
 
   x <- c("d2fw2018", "b4l2017", "122017", "blubb", "2017-2016", NA)
 
-  expect_warning(
-    r <- as.integer(qy(x)),
-    "3 failed"
-  )
+  expect_warning(r <- as.integer(qy(x)), "3 failed")
 
   expect_identical(
     r,
     c(20182L, 20174L, NA_integer_, NA_integer_, NA_integer_, NA_integer_)
   )
 
+  expect_identical(qy("stpQ42015"))
+
+
+
 })