misc updates

R/archive.R

@@ -187,7 +187,7 @@ readArchive <- function(file) {
     message("Data unverified: SHA256 hash not present")
   } else {
     sha256 <- sha256(object)
-    if (identical(sha256, as.character(x_archive_sha256)))
+    if (identical(sha256, x_archive_sha256))
       message("Data verified by SHA256: ", sha256) else
         warning(sprintf("SHA256 of restored object:   %s\ndoes not match the original: %s", sha256, x_archive_sha256), call. = FALSE)
   }

R/ichimoku.R

@@ -151,7 +151,7 @@ ichimoku.xts <- function(x, ticker, periods = c(9L, 26L, 52L), keep.data, ...) {
 #'
 ichimoku.data.frame <- function(x, ticker, periods = c(9L, 26L, 52L), keep.data, ...) {
 
-  if (missing(ticker)) ticker <- deparse(substitute(x))
+  if (missing(ticker)) ticker <- deparse(substitute(x), width.cutoff = 500L, backtick = FALSE, control = NULL, nlines = 1L)
   xlen <- dim(x)[1L]
   cnames <- attr(x, "names")
 
@@ -273,7 +273,7 @@ ichimoku.data.frame <- function(x, ticker, periods = c(9L, 26L, 52L), keep.data,
 #'
 ichimoku.matrix <- function(x, ticker, periods = c(9L, 26L, 52L), keep.data, ...) {
 
-  if (missing(ticker)) ticker <- deparse(substitute(x))
+  if (missing(ticker)) ticker <- deparse(substitute(x), width.cutoff = 500L, backtick = FALSE, control = NULL, nlines = 1L)
   x <- matrix_df(x, keep.attrs = !missing(keep.data) && isTRUE(keep.data))
 
   ichimoku.data.frame(x, ticker = ticker, periods = periods, keep.data = keep.data, ...)
@@ -317,7 +317,7 @@ ichimoku.default <- function(x, ticker, periods = c(9L, 26L, 52L), keep.data, ..
 #'
 .ichimoku <- function(x, ticker, periods = c(9L, 26L, 52L), ...) {
 
-  if (missing(ticker)) ticker <- deparse(substitute(x))
+  if (missing(ticker)) ticker <- deparse(substitute(x), width.cutoff = 500L, backtick = FALSE, control = NULL, nlines = 1L)
   xlen <- dim(x)[1L]
   if (is.numeric(periods) && length(periods) == 3L && all(periods >= 1L)) {
     periods <- as.integer(periods)

R/mltools.R

@@ -73,7 +73,7 @@ autostrat <- function(x,
   is.ichimoku(x) || stop("autostrat() only works on ichimoku objects", call. = FALSE)
   dir <- match.arg(dir)
   if (!level %in% 1:3) {
-    warning("Specified 'level' invalid - reverting to default of 1", call. = FALSE)
+    warning("'level' should be 1, 2 or 3 - reverting to default of 1", call. = FALSE)
     level <- 1
   }
 

R/utils.R

@@ -364,7 +364,7 @@ more <- function(rows) {
 #'
 #' @export
 #'
-is.ichimoku <- function(x) inherits(x, "ichimoku")
+is.ichimoku <- function(x) .Call(ichimoku_isichimoku, x)
 
 #' match.arg Replacement
 #'

src/shikokuchuo.c

@@ -344,6 +344,11 @@ SEXP _coredata(const SEXP x) {
 
 }
 
+// is.ichimoku
+SEXP _isichimoku(const SEXP x) {
+  return Rf_ScalarLogical(Rf_inherits(x, "ichimoku"));
+}
+
 // imports from the package 'xts'
 SEXP _naomit(SEXP x) {
   return naofun(x);
@@ -393,6 +398,7 @@ static const R_CallMethodDef CallEntries[] = {
   {"_df", (DL_FUNC) &_df, 1},
   {"_deserialize_json", (DL_FUNC) &_deserialize_json, 2},
   {"_index", (DL_FUNC) &_index, 1},
+  {"_isichimoku", (DL_FUNC) &_isichimoku, 1},
   {"_look", (DL_FUNC) &_look, 1},
   {"_naomit", (DL_FUNC) &_naomit, 1},
   {"_psxct", (DL_FUNC) &_psxct, 1},

tests/testthat/test-mltools.R

@@ -8,7 +8,7 @@ stratlist <- autostrat(cloud, n = 2, dir = "short", quietly = TRUE)
 test_that("autostrat ok", {
   expect_output(expect_length(expect_type(expect_invisible(autostrat(cloud, n = 2, level = 2)), "list"), 2L))
   expect_silent(expect_type(autostrat(cloud, n = 1, dir = "short", level = 3, quietly = TRUE), "list"))
-  expect_output(expect_warning(autostrat(cloud, n = 1, level = "a"), regexp = "'level' invalid"))
+  expect_output(expect_warning(autostrat(cloud, n = 1, level = "a"), regexp = "'level' should be"))
   expect_error(autostrat(sample_ohlc_data), regexp = "ichimoku object")
 })