From 5063f3fadc726667469e7608a311928e0f35a693 Mon Sep 17 00:00:00 2001 From: JustinMShea Date: Mon, 13 Jul 2026 19:32:50 -0500 Subject: [PATCH 1/9] Validate option series contract fields --- R/instrument.R | 62 +++++----- R/option_series_validation.R | 186 +++++++++++++++++++++++++++++ inst/tinytest/test_option_series.R | 169 ++++++++++++++++++++++++++ 3 files changed, 384 insertions(+), 33 deletions(-) create mode 100644 R/option_series_validation.R create mode 100644 inst/tinytest/test_option_series.R diff --git a/R/instrument.R b/R/instrument.R index 277c290..9889384 100644 --- a/R/instrument.R +++ b/R/instrument.R @@ -561,24 +561,28 @@ option_series <- function(primary_id , root_id = NULL, suffix_id = NULL, } else { #if you give it only a root_id it will make the suffix_id #using expires, callput, and strike if (is.null(suffix_id)) { - sdate <- if (nchar(expires) == 8) { - try(as.Date(expires, format='%Y%m%d'), silent=TRUE) - } else try(as.Date(expires),silent=TRUE) - if (inherits(sdate,'try-error')) { - stop("expires is missing or of incorrect format") - } - sright <- try(switch(callput, C=,c=,call="C", P=,p=,put="P"), - silent=TRUE) - if (inherits(sright,'try-error')) { - stop(paste("must provide 'callput' or a 'suffix_id'", - "from which 'callput' can be inferred.")) + sdate <- .option_series_date(expires, "expires") + if (is.null(sdate)) { + stop("must provide 'expires' or a 'suffix_id'", + call. = FALSE) } + normalized_callput <- .normalize_option_callput( + callput, + allow_default = FALSE + ) + strike <- .validate_option_strike(strike) if (is.null(strike)) { stop(paste("must provide 'strike' or a 'suffix_id'", - "from which 'strike' can be inferred.")) + "from which 'strike' can be inferred."), + call. = FALSE) + } + sright <- if (identical(normalized_callput, "call")) { + "C" + } else { + "P" } - suffix_id <- paste(format(sdate,'%y%m%d'), sright, strike, - sep="") + suffix_id <- paste(format(sdate, '%y%m%d'), sright, strike, + sep = "") } primary_id <- paste(gsub("\\.","",root_id), suffix_id, sep="_") } @@ -616,29 +620,21 @@ option_series <- function(primary_id , root_id = NULL, suffix_id = NULL, pid <- parse_id(primary_id) if (is.null(root_id)) root_id <- pid$root if (is.null(suffix_id)) suffix_id <- pid$suffix - if (is.null(strike)) { - if (is.na(pid$strike)) stop('strike must be provided.') - strike <- pid$strike - } - if (is.null(expires)) { - #TODO: option_series ids contain the entire date. - # Don't have to settle for YYYY-MM - expires <- paste(pid$year, - sprintf("%02d",match(pid$month, - toupper(month.abb))),sep='-') - if (!identical(integer(0), grep("NA",expires))) { - stop(paste("must provide 'expires' formatted '%Y-%m-%d',", - "or a 'suffix_id' from which to infer 'expires'")) - } - } + validated <- .validate_option_series_fields( + suffix_id = suffix_id, + expires = expires, + first_traded = first_traded, + callput = callput, + strike = strike + ) + expires <- validated$expires + callput <- validated$callput + strike <- validated$strike + contract<-getInstrument(root_id, type='option') ## with options series we probably need to be more sophisticated, ## and find the existing series from prior periods (probably years) ## and then add the first_traded and expires to the time series - if(length(callput)==2) callput <- switch(pid$right, C='call', P='put') - if (is.null(callput)) { - stop("value of callput must be specified as 'call' or 'put'") - } if (!isTRUE(overwrite)) { temp_series<-try(getInstrument(primary_id, silent=TRUE),silent=TRUE) if(inherits(temp_series,"option_series")) { diff --git a/R/option_series_validation.R b/R/option_series_validation.R new file mode 100644 index 0000000..ca4b02c --- /dev/null +++ b/R/option_series_validation.R @@ -0,0 +1,186 @@ +# Internal validation helpers for option series instruments. + +.option_series_date <- function(x, argument, allow_multiple = FALSE) { + if (is.null(x)) return(NULL) + + if (!allow_multiple && length(x) != 1L) { + stop("'", argument, "' must be a single date", call. = FALSE) + } + if (length(x) < 1L || anyNA(x)) { + stop("'", argument, "' must not contain missing values", call. = FALSE) + } + + parse_one <- function(value) { + if (inherits(value, "Date")) return(value) + + value <- as.character(value) + parsed <- tryCatch( + if (grepl("^[0-9]{8}$", value)) { + as.Date(value, format = "%Y%m%d") + } else { + suppressWarnings(as.Date(value)) + }, + error = function(e) as.Date(NA) + ) + + if (is.na(parsed)) { + stop("'", argument, "' must be coercible to Date", call. = FALSE) + } + parsed + } + + as.Date(vapply(as.list(x), parse_one, as.Date("1970-01-01")), + origin = "1970-01-01") +} + +.normalize_option_callput <- function(callput, allow_default = TRUE) { + if (allow_default && length(callput) == 2L && + identical(tolower(callput), c("call", "put"))) { + return(NULL) + } + if (length(callput) != 1L || is.na(callput)) { + stop("'callput' must be one of 'call', 'put', 'C', or 'P'", + call. = FALSE) + } + + normalized <- switch(tolower(as.character(callput)), + c = "call", + call = "call", + p = "put", + put = "put", + NULL) + if (is.null(normalized)) { + stop("'callput' must be one of 'call', 'put', 'C', or 'P'", + call. = FALSE) + } + normalized +} + +.validate_option_strike <- function(strike) { + if (is.null(strike)) return(NULL) + if (!is.numeric(strike) || length(strike) != 1L || + is.na(strike) || !is.finite(strike) || strike <= 0) { + stop("'strike' must be a single positive number", call. = FALSE) + } + strike +} + +.parse_option_suffix <- function(suffix_id) { + if (is.null(suffix_id) || length(suffix_id) != 1L || + is.na(suffix_id) || !nzchar(suffix_id)) { + stop("'suffix_id' must identify a single option contract", + call. = FALSE) + } + + parsed <- suppressWarnings( + try(parse_suffix(suffix_id, silent = TRUE), silent = TRUE) + ) + if (inherits(parsed, "try-error") || is.null(parsed) || + !all(c("outright", "option") %in% parsed$type) || + length(parsed$format) != 1L || is.na(parsed$format) || + !parsed$format %in% c("opt2", "opt4")) { + stop("'suffix_id' must identify an outright option contract", + call. = FALSE) + } + + day <- if (identical(parsed$format, "opt2")) { + substr(suffix_id, 5L, 6L) + } else { + substr(suffix_id, 7L, 8L) + } + + expiration_text <- sprintf( + "%04d-%02d-%02d", + parsed$year, + match(parsed$month, toupper(month.abb)), + as.integer(day) + ) + expiration <- tryCatch( + suppressWarnings(as.Date(expiration_text)), + error = function(e) as.Date(NA) + ) + if (is.na(expiration)) { + stop("'suffix_id' contains an invalid option expiration date", + call. = FALSE) + } + + parsed_callput <- switch(parsed$right, C = "call", P = "put", NULL) + if (is.null(parsed_callput) || !is.numeric(parsed$strike) || + length(parsed$strike) != 1L || is.na(parsed$strike) || + !is.finite(parsed$strike) || parsed$strike <= 0) { + stop("'suffix_id' contains invalid option contract fields", + call. = FALSE) + } + + list( + expiration = expiration, + callput = parsed_callput, + strike = parsed$strike, + parsed = parsed + ) +} + +.validate_option_series_fields <- function(suffix_id, expires = NULL, + first_traded = NULL, + callput = c("call", "put"), + strike = NULL) { + suffix <- .parse_option_suffix(suffix_id) + + explicit_expiration <- .option_series_date(expires, "expires") + expiration <- if (is.null(explicit_expiration)) { + suffix$expiration + } else { + if (!identical(explicit_expiration, suffix$expiration)) { + warning( + "suffix_id '", suffix_id, "' indicates expiration ", + format(suffix$expiration), ", but expires is ", + format(explicit_expiration), + call. = FALSE + ) + } + explicit_expiration + } + + traded <- .option_series_date(first_traded, "first_traded", + allow_multiple = TRUE) + if (!is.null(traded) && any(traded > expiration)) { + stop("'first_traded' must not be later than 'expires'", + call. = FALSE) + } + + explicit_callput <- .normalize_option_callput(callput) + resolved_callput <- if (is.null(explicit_callput)) { + suffix$callput + } else { + if (!identical(explicit_callput, suffix$callput)) { + warning( + "suffix_id '", suffix_id, "' indicates a ", + suffix$callput, ", but callput is '", explicit_callput, "'", + call. = FALSE + ) + } + explicit_callput + } + + explicit_strike <- .validate_option_strike(strike) + resolved_strike <- if (is.null(explicit_strike)) { + suffix$strike + } else { + if (!isTRUE(all.equal(explicit_strike, suffix$strike, + tolerance = sqrt(.Machine$double.eps)))) { + warning( + "suffix_id '", suffix_id, "' indicates strike ", + format(suffix$strike), ", but strike is ", + format(explicit_strike), + call. = FALSE + ) + } + explicit_strike + } + + list( + expires = if (is.null(expires)) format(expiration) else expires, + callput = resolved_callput, + strike = resolved_strike + ) +} diff --git a/inst/tinytest/test_option_series.R b/inst/tinytest/test_option_series.R new file mode 100644 index 0000000..0bef3d7 --- /dev/null +++ b/inst/tinytest/test_option_series.R @@ -0,0 +1,169 @@ +# option_series() contract identity and validation + +rm_instruments(keep.currencies = FALSE) +currency("USD") +stock("SPY", "USD") +option( + ".SPY", + currency = "USD", + multiplier = 100, + tick_size = 0.01, + underlying_id = "SPY" +) + +# Constructing from fields creates an exact-date option identifier. +created <- option_series( + root_id = ".SPY", + expires = "2027-01-15", + callput = "call", + strike = 600 +) +expect_identical(created, "SPY_270115C600") + +contract <- getInstrument(created, type = "option_series") +expect_inherits(contract, "option_series") +expect_inherits(contract, "option") +expect_identical(contract$root_id, ".SPY") +expect_identical(contract$suffix_id, "270115C600") +expect_identical(contract$expires, "2027-01-15") +expect_identical(contract$callput, "call") +expect_equal(contract$strike, 600) +expect_identical(contract$currency, "USD") +expect_equal(contract$multiplier, 100) +expect_equal(contract$tick_size, 0.01) +expect_identical(contract$underlying_id, "SPY") + +# A complete option identifier supplies the exact expiration date, right, +# and strike rather than reducing expiration to year-month. +parsed <- option_series( + "SPY_270115P550", + root_id = ".SPY", + assign_i = FALSE +) +expect_inherits(parsed, "option_series") +expect_identical(parsed$expires, "2027-01-15") +expect_identical(parsed$callput, "put") +expect_equal(parsed$strike, 550) + +# Four-digit years and OSI-style fixed-width strikes are supported. +osi <- option_series( + "SPY_20270115C00600000", + root_id = ".SPY", + assign_i = FALSE +) +expect_identical(osi$expires, "2027-01-15") +expect_identical(osi$callput, "call") +expect_equal(osi$strike, 600) + +# Common call/put aliases are normalized when fields are used to construct +# the identifier. +alias_contract <- option_series( + root_id = ".SPY", + expires = "2027-02-19", + callput = "P", + strike = 500, + assign_i = FALSE +) +expect_identical(alias_contract$primary_id, "SPY_270219P500") +expect_identical(alias_contract$callput, "put") + +# Explicit fields that conflict with the identifier are retained for backward +# compatibility, but the inconsistency is reported. +expect_warning( + option_series( + "SPY_270115C600", + root_id = ".SPY", + expires = "2027-01-16", + assign_i = FALSE + ), + "indicates expiration 2027-01-15" +) +expect_warning( + option_series( + "SPY_270115C600", + root_id = ".SPY", + callput = "put", + assign_i = FALSE + ), + "indicates a call" +) +expect_warning( + option_series( + "SPY_270115C600", + root_id = ".SPY", + strike = 601, + assign_i = FALSE + ), + "indicates strike 600" +) + +# Invalid contract fields fail with domain-specific messages. +expect_error( + option_series( + root_id = ".SPY", + expires = "not-a-date", + callput = "call", + strike = 600, + assign_i = FALSE + ), + "coercible to Date" +) +expect_error( + option_series( + root_id = ".SPY", + expires = "2027-01-15", + callput = "neither", + strike = 600, + assign_i = FALSE + ), + "must be one of" +) +expect_error( + option_series( + root_id = ".SPY", + expires = "2027-01-15", + callput = "call", + strike = 0, + assign_i = FALSE + ), + "positive number" +) +expect_error( + option_series( + "SPY_270231C600", + root_id = ".SPY", + assign_i = FALSE + ), + "invalid option expiration date" +) +expect_error( + option_series( + "SPY_270115C600", + root_id = ".SPY", + first_traded = "2027-01-16", + assign_i = FALSE + ), + "must not be later" +) +expect_error( + option_series( + "SPY_BAD", + root_id = ".SPY", + assign_i = FALSE + ), + "option contract" +) + +# Listed option expirations require an exact calendar date. +expect_error( + option_series( + "SPY_270319C600", + root_id = ".SPY", + expires = "2027-03", + assign_i = FALSE + ), + "coercible to Date" +) + + +rm_instruments(keep.currencies = FALSE) From 71d24dbe06e81d15ec2d4971da8626fac05ed8c1 Mon Sep 17 00:00:00 2001 From: "Justin M. Shea" Date: Mon, 13 Jul 2026 19:47:49 -0500 Subject: [PATCH 2/9] Potential fix for pull request finding Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- R/option_series_validation.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/option_series_validation.R b/R/option_series_validation.R index ca4b02c..53a3f59 100644 --- a/R/option_series_validation.R +++ b/R/option_series_validation.R @@ -12,6 +12,7 @@ parse_one <- function(value) { if (inherits(value, "Date")) return(value) + if (inherits(value, "POSIXt")) return(as.Date(value)) value <- as.character(value) parsed <- tryCatch( From c958233bf2335e0da857093f1764499c1ec489bd Mon Sep 17 00:00:00 2001 From: JustinMShea Date: Mon, 13 Jul 2026 19:57:54 -0500 Subject: [PATCH 3/9] Test POSIX option series dates --- R/option_series_validation.R | 23 +++++++++++--- inst/tinytest/test_option_series.R | 50 ++++++++++++++++++++++++++++++ 2 files changed, 69 insertions(+), 4 deletions(-) diff --git a/R/option_series_validation.R b/R/option_series_validation.R index 53a3f59..c9d01c1 100644 --- a/R/option_series_validation.R +++ b/R/option_series_validation.R @@ -10,11 +10,26 @@ stop("'", argument, "' must not contain missing values", call. = FALSE) } - parse_one <- function(value) { - if (inherits(value, "Date")) return(value) - if (inherits(value, "POSIXt")) return(as.Date(value)) + parse_one <- function(value) { + if (inherits(value, "Date")) { + return(value) + } + + if (inherits(value, "POSIXt")) { + tz <- attr(value, "tzone") + + if (is.null(tz) || length(tz) == 0L || + is.na(tz[[1L]]) || !nzchar(tz[[1L]])) { + tz <- "UTC" + } else { + tz <- tz[[1L]] + } + + return(as.Date(value, tz = tz)) + } + + value <- as.character(value) - value <- as.character(value) parsed <- tryCatch( if (grepl("^[0-9]{8}$", value)) { as.Date(value, format = "%Y%m%d") diff --git a/inst/tinytest/test_option_series.R b/inst/tinytest/test_option_series.R index 0bef3d7..c82b64b 100644 --- a/inst/tinytest/test_option_series.R +++ b/inst/tinytest/test_option_series.R @@ -166,4 +166,54 @@ expect_error( ) +# POSIXct expiration values are accepted. +posix_expiry <- as.POSIXct( + "2027-03-19 16:00:00", + tz = "America/Chicago" +) + +posix_contract <- option_series( + "SPY_270319C600", + root_id = ".SPY", + expires = posix_expiry, + assign_i = FALSE +) + +expect_equal( + as.Date(posix_contract$expires), + as.Date("2027-03-19") +) + +# POSIXlt values are also accepted. +posixlt_expiry <- as.POSIXlt( + "2027-03-19 16:00:00", + tz = "America/Chicago" +) + +posixlt_contract <- option_series( + "SPY_270319C600", + root_id = ".SPY", + expires = posixlt_expiry, + assign_i = FALSE +) + +expect_equal( + as.Date(posixlt_contract$expires), + as.Date("2027-03-19") +) + + +expect_silent( + option_series( + "SPY_270319C600", + root_id = ".SPY", + expires = as.Date("2027-03-19"), + first_traded = as.POSIXct( + "2027-03-01 09:30:00", + tz = "America/New_York" + ), + assign_i = FALSE + ) +) + rm_instruments(keep.currencies = FALSE) From 839211fb4380325f214e3a8f9c560663cb3fa641 Mon Sep 17 00:00:00 2001 From: "Justin M. Shea" Date: Mon, 13 Jul 2026 20:08:29 -0500 Subject: [PATCH 4/9] Potential fix for expiry stored consistently Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- R/option_series_validation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/option_series_validation.R b/R/option_series_validation.R index c9d01c1..99e5bb4 100644 --- a/R/option_series_validation.R +++ b/R/option_series_validation.R @@ -195,7 +195,7 @@ } list( - expires = if (is.null(expires)) format(expiration) else expires, + expires = format(expiration), callput = resolved_callput, strike = resolved_strike ) From a8d97a38553e4b5c5d018d9ceefdd3274184fedb Mon Sep 17 00:00:00 2001 From: JustinMShea Date: Mon, 13 Jul 2026 20:24:15 -0500 Subject: [PATCH 5/9] Fix POSIX option expiration tests --- inst/tinytest/test_option_series.R | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/inst/tinytest/test_option_series.R b/inst/tinytest/test_option_series.R index c82b64b..4852abb 100644 --- a/inst/tinytest/test_option_series.R +++ b/inst/tinytest/test_option_series.R @@ -166,7 +166,7 @@ expect_error( ) -# POSIXct expiration values are accepted. +# POSIXct expiration values are accepted and normalized. posix_expiry <- as.POSIXct( "2027-03-19 16:00:00", tz = "America/Chicago" @@ -179,12 +179,13 @@ posix_contract <- option_series( assign_i = FALSE ) -expect_equal( - as.Date(posix_contract$expires), - as.Date("2027-03-19") +expect_identical( + posix_contract$expires, + "2027-03-19" ) -# POSIXlt values are also accepted. + +# POSIXlt expiration values are accepted and normalized. posixlt_expiry <- as.POSIXlt( "2027-03-19 16:00:00", tz = "America/Chicago" @@ -197,9 +198,9 @@ posixlt_contract <- option_series( assign_i = FALSE ) -expect_equal( - as.Date(posixlt_contract$expires), - as.Date("2027-03-19") +expect_identical( + posixlt_contract$expires, + "2027-03-19" ) From 5d2e7529fc11a924406af90757d3ec18569a34d6 Mon Sep 17 00:00:00 2001 From: "Justin M. Shea" Date: Mon, 13 Jul 2026 20:30:11 -0500 Subject: [PATCH 6/9] Potential fix for pull request finding Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- R/option_series_validation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/option_series_validation.R b/R/option_series_validation.R index 99e5bb4..800da07 100644 --- a/R/option_series_validation.R +++ b/R/option_series_validation.R @@ -55,7 +55,7 @@ return(NULL) } if (length(callput) != 1L || is.na(callput)) { - stop("'callput' must be one of 'call', 'put', 'C', or 'P'", + stop("'callput' must be a single value: 'call', 'put', 'C', or 'P'", call. = FALSE) } From 36bce15fa534ae84d0e6017fc488f822c7762a0e Mon Sep 17 00:00:00 2001 From: "Justin M. Shea" Date: Mon, 13 Jul 2026 20:36:54 -0500 Subject: [PATCH 7/9] Potential fix for pull request finding Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- R/option_series_validation.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/option_series_validation.R b/R/option_series_validation.R index 800da07..15f708e 100644 --- a/R/option_series_validation.R +++ b/R/option_series_validation.R @@ -45,6 +45,10 @@ parsed } + if (inherits(x, "POSIXlt")) { + x <- as.POSIXct(x) + } + as.Date(vapply(as.list(x), parse_one, as.Date("1970-01-01")), origin = "1970-01-01") } From c6b1325c78410f624e3bdb93d8f29af57db34928 Mon Sep 17 00:00:00 2001 From: "Justin M. Shea" Date: Mon, 13 Jul 2026 21:09:17 -0500 Subject: [PATCH 8/9] Convert POSIXlt immediatly Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- R/option_series_validation.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/option_series_validation.R b/R/option_series_validation.R index 15f708e..ac99e89 100644 --- a/R/option_series_validation.R +++ b/R/option_series_validation.R @@ -3,13 +3,16 @@ .option_series_date <- function(x, argument, allow_multiple = FALSE) { if (is.null(x)) return(NULL) + if (inherits(x, "POSIXlt")) { + x <- as.POSIXct(x) + } + if (!allow_multiple && length(x) != 1L) { stop("'", argument, "' must be a single date", call. = FALSE) } if (length(x) < 1L || anyNA(x)) { stop("'", argument, "' must not contain missing values", call. = FALSE) } - parse_one <- function(value) { if (inherits(value, "Date")) { return(value) From 95293d0ded0432bcf4ec4a9ead08506fe8ee1f4a Mon Sep 17 00:00:00 2001 From: JustinMShea Date: Mon, 13 Jul 2026 21:21:33 -0500 Subject: [PATCH 9/9] cleaner conversion of POSIXlt --- R/option_series_validation.R | 4 ---- inst/tinytest/test_option_series.R | 17 +++++++++++++++++ 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/R/option_series_validation.R b/R/option_series_validation.R index ac99e89..c480101 100644 --- a/R/option_series_validation.R +++ b/R/option_series_validation.R @@ -48,10 +48,6 @@ parsed } - if (inherits(x, "POSIXlt")) { - x <- as.POSIXct(x) - } - as.Date(vapply(as.list(x), parse_one, as.Date("1970-01-01")), origin = "1970-01-01") } diff --git a/inst/tinytest/test_option_series.R b/inst/tinytest/test_option_series.R index 4852abb..814d3ec 100644 --- a/inst/tinytest/test_option_series.R +++ b/inst/tinytest/test_option_series.R @@ -217,4 +217,21 @@ expect_silent( ) ) +expect_error( + option_series( + "SPY_270319C600", + root_id = ".SPY", + expires = as.POSIXlt( + c( + "2027-03-19 16:00:00", + "2027-03-20 16:00:00" + ), + tz = "America/Chicago" + ), + assign_i = FALSE + ), + "must be a single date" +) + + rm_instruments(keep.currencies = FALSE)