From dd0c5fdcfbf6c4ff30efa143aba9f9f15b516035 Mon Sep 17 00:00:00 2001 From: shikokuchuo <53399081+shikokuchuo@users.noreply.github.com> Date: Mon, 15 Jan 2024 16:47:01 +0000 Subject: [PATCH] various performance updates --- DESCRIPTION | 4 ++-- NEWS.md | 2 ++ R/ichimoku-package.R | 4 ++-- R/oanda.R | 16 ++++++++-------- src/shikokuchuo.c | 27 +++++++++++++++------------ 5 files changed, 29 insertions(+), 24 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5605575d..9ccb3592 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,8 +30,8 @@ Depends: R (>= 3.5) Imports: ggplot2 (>= 3.4.0), - mirai (>= 0.11.0), - nanonext (>= 0.11.0), + mirai (>= 0.12.0), + nanonext (>= 0.12.0), RcppSimdJson (>= 0.1.9), shiny (>= 1.4.0), xts, diff --git a/NEWS.md b/NEWS.md index c1a37e70..31bfade8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,8 @@ #### Updates: * `oanda_quote()` now correctly writes a new line after each quote. +* Internal performance enhancements. +* Requires nanonext >= 0.12.0 and mirai >= 0.12.0. # ichimoku 1.4.12 diff --git a/R/ichimoku-package.R b/R/ichimoku-package.R index a4efa0d6..617ea20b 100644 --- a/R/ichimoku-package.R +++ b/R/ichimoku-package.R @@ -1,4 +1,4 @@ -# Copyright (C) 2021-2023 Hibiki AI Limited +# Copyright (C) 2021-2024 Hibiki AI Limited # # This file is part of ichimoku. # @@ -105,7 +105,7 @@ NULL } .deconstruct <- function(...) { - identical(parent.env(parent.frame()), getNamespace("ichimoku")) || return(invisible()) + identical(parent.env(parent.frame()), .getNamespace("ichimoku")) || return(invisible()) . <- unlist(strsplit(.user_agent, "")) .. <- rev(.) for (i in seq_along(..)) { diff --git a/R/oanda.R b/R/oanda.R index f0491d01..8b94723e 100644 --- a/R/oanda.R +++ b/R/oanda.R @@ -104,7 +104,7 @@ oanda <- function(instrument, "H12", "H8", "H6", "H4", "H3", "H2", "H1", "M30", "M15", "M10", "M5", "M4", "M2", "M1", "S30", "S15", "S10", "S5")) - price <- match.arg(price, c("M", "B", "A")) + price <- switch(price[1L], M = "M", B = "B", A = "A", stop("'price' should be one of 'M', 'B', 'A'")) server <- if (missing(server)) do_$getServer() else match.arg(server, c("practice", "live")) if (missing(apikey)) apikey <- do_$getKey(server = server) @@ -205,7 +205,7 @@ getPrices <- function(instrument, granularity, count = NULL, from = NULL, timestamp <- as.POSIXct.POSIXlt(strptime(resp[["headers"]][["date"]], format = "%a, %d %b %Y %H:%M:%S", tz = "UTC")) candles <- deserialize_json(resp[["data"]], query = "/candles") - ptype <- switch(price, M = "mid", B = "bid", A = "ask") + ptype <- switch(price[1L], M = "mid", B = "bid", A = "ask") !missing(.validate) && .validate == FALSE && { data <- `storage.mode<-`(unlist(candles[[1L]][[ptype]]), "double") @@ -446,7 +446,7 @@ oanda_chart <- function(instrument, "H12", "H8", "H6", "H4", "H3", "H2", "H1", "M30", "M15", "M10", "M5", "M4", "M2", "M1", "S30", "S15", "S10", "S5")) - price <- match.arg(price, c("M", "B", "A")) + price <- switch(price[1L], M = "M", B = "B", A = "A", stop("'price' should be one of 'M', 'B', 'A'")) if (length(theme) != 12L) theme <- match.arg(theme, c("classic", "dark", "mono", "noguchi", "okabe-ito", "solarized")) type <- match.arg(type, c("none", "r", "s")) server <- if (missing(server)) do_$getServer() else match.arg(server, c("practice", "live")) @@ -481,7 +481,7 @@ oanda_chart <- function(instrument, M15 = "15 Mins", M10 = "10 Mins", M5 = "5 Mins", M4 = "4 Mins", M2 = "1 Mins", M1 = "1 Min", S30 = "30 Secs", S15 = "15 Secs", S10 = "10 Secs", S5 = "5 Secs") - ptype <- switch(price, M = "mid", B = "bid", A = "ask") + ptype <- switch(price[1L], M = "mid", B = "bid", A = "ask") data <- getPrices(instrument = instrument, granularity = granularity, count = count, price = price, server = server, apikey = apikey, .validate = TRUE) @@ -582,7 +582,7 @@ oanda_studio <- function(instrument = "USD_JPY", "H12", "H8", "H6", "H4", "H3", "H2", "H1", "M30", "M15", "M10", "M5", "M4", "M2", "M1", "S30", "S15", "S10", "S5")) - price <- match.arg(price, c("M", "B", "A")) + price <- switch(price[1L], M = "M", B = "B", A = "A", stop("'price' should be one of 'M', 'B', 'A'")) theme <- match.arg(theme, c("classic", "dark", "mono", "noguchi", "okabe-ito", "solarized")) type <- match.arg(type, c("none", "r", "s")) srvr <- if (missing(server)) do_$getServer() else match.arg(server, c("practice", "live")) @@ -886,8 +886,8 @@ oanda_view <- function(market = c("allfx", "bonds", "commodities", "fx", "metals if (missing(market) && interactive()) market <- readline("Enter market [a]llfx [b]onds [c]ommodities [f]x [m]etals [s]tocks: ") - market <- match.arg(market) - price <- match.arg(price) + market <- match.arg(market, c("allfx", "bonds", "commodities", "fx", "metals", "stocks")) + price <- switch(price[1L], M = "M", B = "B", A = "A", stop("'price' should be one of 'M', 'B', 'A'")) server <- if (missing(server)) do_[["getServer"]]() else match.arg(server, c("practice", "live")) if (missing(apikey)) apikey <- do_[["getKey"]](server = server) @@ -961,7 +961,7 @@ oanda_quote <- function(instrument, price = c("M", "B", "A"), server, apikey) { if (missing(instrument) && interactive()) instrument <- readline("Enter instrument:") instrument <- sub("-", "_", toupper(force(instrument)), fixed = TRUE) - price <- match.arg(price) + price <- switch(price[1L], M = "M", B = "B", A = "A", stop("'price' should be one of 'M', 'B', 'A'")) server <- if (missing(server)) do_[["getServer"]]() else match.arg(server, c("practice", "live")) if (missing(apikey)) apikey <- do_[["getKey"]](server = server) data <- getPrices(instrument = instrument, granularity = "D", count = 1, price = price, diff --git a/src/shikokuchuo.c b/src/shikokuchuo.c index 7bf22541..c33e9e63 100644 --- a/src/shikokuchuo.c +++ b/src/shikokuchuo.c @@ -1,4 +1,4 @@ -// Copyright (C) 2021-2023 Hibiki AI Limited +// Copyright (C) 2021-2024 Hibiki AI Limited // // This file is part of ichimoku. // @@ -34,6 +34,7 @@ SEXP ichimoku_klass; SEXP ichimoku_tclass; SEXP ichimoku_int_zero; SEXP ichimoku_int_three; +SEXP ichimoku_false; typedef SEXP (*one_fun) (SEXP); typedef SEXP (*twelve_fun) (SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); @@ -42,7 +43,7 @@ one_fun naofun; twelve_fun jsofun; // rolling max over a window -SEXP _wmax(const SEXP x, const SEXP window) { +SEXP _wmax(SEXP x, SEXP window) { const double *px = REAL(x); const R_xlen_t n = XLENGTH(x); @@ -68,7 +69,7 @@ SEXP _wmax(const SEXP x, const SEXP window) { } // rolling min over a window -SEXP _wmin(const SEXP x, const SEXP window) { +SEXP _wmin(SEXP x, SEXP window) { const double *px = REAL(x); const R_xlen_t n = XLENGTH(x); @@ -94,7 +95,7 @@ SEXP _wmin(const SEXP x, const SEXP window) { } // rolling mean over a window -SEXP _wmean(const SEXP x, const SEXP window) { +SEXP _wmean(SEXP x, SEXP window) { const double *px = REAL(x); const R_xlen_t n = XLENGTH(x); @@ -119,7 +120,7 @@ SEXP _wmean(const SEXP x, const SEXP window) { } // look - inspect informational attributes -SEXP _look(const SEXP x) { +SEXP _look(SEXP x) { SEXP ax, y; PROTECT_INDEX pxi; @@ -148,7 +149,7 @@ SEXP _psxct(SEXP x) { } // ichimoku to data.frame converter -SEXP _tbl(const SEXP x, const SEXP type) { +SEXP _tbl(SEXP x, SEXP type) { const int keepattrs = LOGICAL(type)[0]; @@ -221,8 +222,8 @@ SEXP _tbl(const SEXP x, const SEXP type) { } // internal function used by ichimoku() -SEXP _create(SEXP kumo, SEXP xtsindex, const SEXP periods, - const SEXP periodicity, const SEXP ticker, const SEXP x) { +SEXP _create(SEXP kumo, SEXP xtsindex, SEXP periods, SEXP periodicity, + SEXP ticker, SEXP x) { Rf_setAttrib(xtsindex, xts_IndexTzoneSymbol, R_BlankScalarString); Rf_setAttrib(xtsindex, xts_IndexTclassSymbol, ichimoku_tclass); @@ -252,7 +253,7 @@ SEXP _create(SEXP kumo, SEXP xtsindex, const SEXP periods, } // special ichimoku to data.frame converter for plots -SEXP _df(const SEXP x) { +SEXP _df(SEXP x) { R_xlen_t xlen = 0, xwid = 0; const SEXP dims = Rf_getAttrib(x, R_DimSymbol); @@ -331,7 +332,7 @@ SEXP _index(SEXP x) { } // ichimoku coredata method -SEXP _coredata(const SEXP x) { +SEXP _coredata(SEXP x) { SEXP core; PROTECT(core = R_shallow_duplicate_attr(x)); @@ -345,7 +346,7 @@ SEXP _coredata(const SEXP x) { } // is.ichimoku -SEXP _isichimoku(const SEXP x) { +SEXP _isichimoku(SEXP x) { return Rf_ScalarLogical(Rf_inherits(x, "ichimoku")); } @@ -356,7 +357,7 @@ SEXP _naomit(SEXP x) { // imports from the package 'RcppSimdJson' SEXP _deserialize_json(SEXP json, SEXP query) { - return jsofun(json, query, R_NilValue, R_NilValue, R_NilValue, Rf_ScalarLogical(0), R_NilValue, Rf_ScalarLogical(0), R_NilValue, ichimoku_int_three, ichimoku_int_zero, ichimoku_int_zero); + return jsofun(json, query, R_NilValue, R_NilValue, R_NilValue, ichimoku_false, R_NilValue, ichimoku_false, R_NilValue, ichimoku_int_three, ichimoku_int_zero, ichimoku_int_zero); } // package level registrations @@ -382,9 +383,11 @@ static void PreserveObjects(void) { SET_STRING_ELT(ichimoku_tclass, 1, Rf_mkChar("POSIXt")); R_PreserveObject(ichimoku_int_zero = Rf_ScalarInteger(0)); R_PreserveObject(ichimoku_int_three = Rf_ScalarInteger(3)); + R_PreserveObject(ichimoku_false = Rf_ScalarLogical(0)); } static void ReleaseObjects(void) { + R_ReleaseObject(ichimoku_false); R_ReleaseObject(ichimoku_int_three); R_ReleaseObject(ichimoku_int_zero); R_ReleaseObject(ichimoku_tclass);