From 6cd335b50b658646f714153d7684d334e141d0aa Mon Sep 17 00:00:00 2001 From: nvphungdev <283886185+nvphungdev@users.noreply.github.com> Date: Sun, 17 May 2026 08:42:46 +0700 Subject: [PATCH 1/2] fix: restore numeric vector outputs Signed-off-by: nvphungdev <283886185+nvphungdev@users.noreply.github.com> --- R/ta_APO.R | 14 +++----------- R/ta_BBANDS.R | 14 +++----------- R/ta_CMO.R | 14 +++----------- R/ta_DEMA.R | 14 +++----------- R/ta_EMA.R | 14 +++----------- R/ta_HT_DCPERIOD.R | 14 +++----------- R/ta_HT_DCPHASE.R | 14 +++----------- R/ta_HT_PHASOR.R | 14 +++----------- R/ta_HT_SINE.R | 14 +++----------- R/ta_HT_TRENDLINE.R | 14 +++----------- R/ta_HT_TRENDMODE.R | 14 +++----------- R/ta_KAMA.R | 14 +++----------- R/ta_MACD.R | 14 +++----------- R/ta_MACDEXT.R | 14 +++----------- R/ta_MACDFIX.R | 14 +++----------- R/ta_MAMA.R | 14 +++----------- R/ta_MOM.R | 14 +++----------- R/ta_PPO.R | 14 +++----------- R/ta_ROC.R | 14 +++----------- R/ta_ROCR.R | 14 +++----------- R/ta_RSI.R | 14 +++----------- R/ta_SMA.R | 14 +++----------- R/ta_STOCHRSI.R | 14 +++----------- R/ta_T3.R | 14 +++----------- R/ta_TEMA.R | 14 +++----------- R/ta_TRIMA.R | 14 +++----------- R/ta_TRIX.R | 14 +++----------- R/ta_VOLUME.R | 14 +++----------- R/ta_WMA.R | 14 +++----------- R/utils.R | 17 +++++++++++++++++ codegen/generate_unit-tests.sh | 18 +++++++----------- codegen/templates/moving_average_template.R.in | 14 +++----------- codegen/templates/numeric_template.R.in | 14 +++----------- tests/testthat/test-ta_APO.R | 16 ++++++---------- tests/testthat/test-ta_BBANDS.R | 16 ++++++---------- tests/testthat/test-ta_CMO.R | 16 ++++++---------- tests/testthat/test-ta_DEMA.R | 16 ++++++---------- tests/testthat/test-ta_EMA.R | 16 ++++++---------- tests/testthat/test-ta_HT_DCPERIOD.R | 16 ++++++---------- tests/testthat/test-ta_HT_DCPHASE.R | 16 ++++++---------- tests/testthat/test-ta_HT_PHASOR.R | 16 ++++++---------- tests/testthat/test-ta_HT_SINE.R | 16 ++++++---------- tests/testthat/test-ta_HT_TRENDLINE.R | 16 ++++++---------- tests/testthat/test-ta_HT_TRENDMODE.R | 16 ++++++---------- tests/testthat/test-ta_KAMA.R | 16 ++++++---------- tests/testthat/test-ta_MACD.R | 16 ++++++---------- tests/testthat/test-ta_MACDEXT.R | 16 ++++++---------- tests/testthat/test-ta_MACDFIX.R | 16 ++++++---------- tests/testthat/test-ta_MAMA.R | 16 ++++++---------- tests/testthat/test-ta_MOM.R | 16 ++++++---------- tests/testthat/test-ta_PPO.R | 16 ++++++---------- tests/testthat/test-ta_ROC.R | 16 ++++++---------- tests/testthat/test-ta_ROCR.R | 16 ++++++---------- tests/testthat/test-ta_RSI.R | 16 ++++++---------- tests/testthat/test-ta_SMA.R | 16 ++++++---------- tests/testthat/test-ta_STOCHRSI.R | 16 ++++++---------- tests/testthat/test-ta_T3.R | 16 ++++++---------- tests/testthat/test-ta_TEMA.R | 16 ++++++---------- tests/testthat/test-ta_TRIMA.R | 16 ++++++---------- tests/testthat/test-ta_TRIX.R | 16 ++++++---------- tests/testthat/test-ta_WMA.R | 16 ++++++---------- 61 files changed, 285 insertions(+), 632 deletions(-) diff --git a/R/ta_APO.R b/R/ta_APO.R index 907ac26ed..0eb1adaa0 100644 --- a/R/ta_APO.R +++ b/R/ta_APO.R @@ -172,17 +172,9 @@ absolute_price_oscillator.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_BBANDS.R b/R/ta_BBANDS.R index a02d74e4c..621d03bb8 100644 --- a/R/ta_BBANDS.R +++ b/R/ta_BBANDS.R @@ -182,17 +182,9 @@ bollinger_bands.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_CMO.R b/R/ta_CMO.R index 746249e3e..ef01386c0 100644 --- a/R/ta_CMO.R +++ b/R/ta_CMO.R @@ -151,17 +151,9 @@ chande_momentum_oscillator.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_DEMA.R b/R/ta_DEMA.R index 8dc00b6cf..8f445d9df 100644 --- a/R/ta_DEMA.R +++ b/R/ta_DEMA.R @@ -163,17 +163,9 @@ double_exponential_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_EMA.R b/R/ta_EMA.R index e85e4d49c..ac34efe7b 100644 --- a/R/ta_EMA.R +++ b/R/ta_EMA.R @@ -163,17 +163,9 @@ exponential_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_HT_DCPERIOD.R b/R/ta_HT_DCPERIOD.R index e806d99c3..99397d60a 100644 --- a/R/ta_HT_DCPERIOD.R +++ b/R/ta_HT_DCPERIOD.R @@ -142,17 +142,9 @@ dominant_cycle_period.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_HT_DCPHASE.R b/R/ta_HT_DCPHASE.R index 315e5007b..0572389ba 100644 --- a/R/ta_HT_DCPHASE.R +++ b/R/ta_HT_DCPHASE.R @@ -142,17 +142,9 @@ dominant_cycle_phase.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_HT_PHASOR.R b/R/ta_HT_PHASOR.R index 27f29560a..73e8db523 100644 --- a/R/ta_HT_PHASOR.R +++ b/R/ta_HT_PHASOR.R @@ -142,17 +142,9 @@ phasor_components.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_HT_SINE.R b/R/ta_HT_SINE.R index dad2622eb..097435831 100644 --- a/R/ta_HT_SINE.R +++ b/R/ta_HT_SINE.R @@ -142,17 +142,9 @@ sine_wave.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_HT_TRENDLINE.R b/R/ta_HT_TRENDLINE.R index f0051a5a9..a79acd244 100644 --- a/R/ta_HT_TRENDLINE.R +++ b/R/ta_HT_TRENDLINE.R @@ -142,17 +142,9 @@ trendline.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_HT_TRENDMODE.R b/R/ta_HT_TRENDMODE.R index dcbbacf1a..4b53e6846 100644 --- a/R/ta_HT_TRENDMODE.R +++ b/R/ta_HT_TRENDMODE.R @@ -142,17 +142,9 @@ trend_cycle_mode.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_KAMA.R b/R/ta_KAMA.R index 5f0f0d315..23e543d29 100644 --- a/R/ta_KAMA.R +++ b/R/ta_KAMA.R @@ -163,17 +163,9 @@ kaufman_adaptive_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_MACD.R b/R/ta_MACD.R index 364b16b81..f7970cfdb 100644 --- a/R/ta_MACD.R +++ b/R/ta_MACD.R @@ -172,17 +172,9 @@ moving_average_convergence_divergence.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_MACDEXT.R b/R/ta_MACDEXT.R index 23d99dd0e..b2ddbb5c6 100644 --- a/R/ta_MACDEXT.R +++ b/R/ta_MACDEXT.R @@ -178,17 +178,9 @@ extended_moving_average_convergence_divergence.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_MACDFIX.R b/R/ta_MACDFIX.R index 636895fc3..bec7c72c1 100644 --- a/R/ta_MACDFIX.R +++ b/R/ta_MACDFIX.R @@ -152,17 +152,9 @@ fixed_moving_average_convergence_divergence.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_MAMA.R b/R/ta_MAMA.R index 7918e21e9..944af7d92 100644 --- a/R/ta_MAMA.R +++ b/R/ta_MAMA.R @@ -182,17 +182,9 @@ mesa_adaptive_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_MOM.R b/R/ta_MOM.R index df7120207..c997ab767 100644 --- a/R/ta_MOM.R +++ b/R/ta_MOM.R @@ -151,17 +151,9 @@ momentum.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_PPO.R b/R/ta_PPO.R index 0b54a3a7f..b5e436f68 100644 --- a/R/ta_PPO.R +++ b/R/ta_PPO.R @@ -172,17 +172,9 @@ percentage_price_oscillator.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_ROC.R b/R/ta_ROC.R index 65a5b4325..14028bdf8 100644 --- a/R/ta_ROC.R +++ b/R/ta_ROC.R @@ -151,17 +151,9 @@ rate_of_change.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_ROCR.R b/R/ta_ROCR.R index a387f2573..98072ba6e 100644 --- a/R/ta_ROCR.R +++ b/R/ta_ROCR.R @@ -151,17 +151,9 @@ ratio_of_change.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_RSI.R b/R/ta_RSI.R index 557646de3..0bc701281 100644 --- a/R/ta_RSI.R +++ b/R/ta_RSI.R @@ -151,17 +151,9 @@ relative_strength_index.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_SMA.R b/R/ta_SMA.R index da7f19954..bea7d94c6 100644 --- a/R/ta_SMA.R +++ b/R/ta_SMA.R @@ -163,17 +163,9 @@ simple_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_STOCHRSI.R b/R/ta_STOCHRSI.R index c42c46426..250694c80 100644 --- a/R/ta_STOCHRSI.R +++ b/R/ta_STOCHRSI.R @@ -173,17 +173,9 @@ stochastic_relative_strength_index.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_T3.R b/R/ta_T3.R index 34ac9aca2..7184fa2fb 100644 --- a/R/ta_T3.R +++ b/R/ta_T3.R @@ -173,17 +173,9 @@ t3_exponential_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_TEMA.R b/R/ta_TEMA.R index 07c502522..f6a95f803 100644 --- a/R/ta_TEMA.R +++ b/R/ta_TEMA.R @@ -163,17 +163,9 @@ triple_exponential_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_TRIMA.R b/R/ta_TRIMA.R index 5b49db271..e62076eee 100644 --- a/R/ta_TRIMA.R +++ b/R/ta_TRIMA.R @@ -163,17 +163,9 @@ triangular_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_TRIX.R b/R/ta_TRIX.R index 269a686cd..e62a687f1 100644 --- a/R/ta_TRIX.R +++ b/R/ta_TRIX.R @@ -151,17 +151,9 @@ triple_exponential_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_VOLUME.R b/R/ta_VOLUME.R index 11e587d66..070e8ea99 100644 --- a/R/ta_VOLUME.R +++ b/R/ta_VOLUME.R @@ -159,17 +159,9 @@ trading_volume.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/ta_WMA.R b/R/ta_WMA.R index e6fcc602a..9066c4d68 100644 --- a/R/ta_WMA.R +++ b/R/ta_WMA.R @@ -163,17 +163,9 @@ weighted_moving_average.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/R/utils.R b/R/utils.R index d31333a58..1d0045cfc 100644 --- a/R/utils.R +++ b/R/utils.R @@ -152,6 +152,23 @@ assert_column_names <- function(formula, available_variables) { x } +as_numeric_output <- function(x) { + lookback <- attr(x, "lookback", exact = TRUE) + + if (is.matrix(x)) { + if (ncol(x) != 1L) { + return(x) + } + + x <- x[, 1L] + } + + x <- as.double(x) + attr(x, "lookback") <- lookback + + x +} + ## class related utility ## functions is.formula <- function(x) { diff --git a/codegen/generate_unit-tests.sh b/codegen/generate_unit-tests.sh index 07e5dd983..685ea702f 100755 --- a/codegen/generate_unit-tests.sh +++ b/codegen/generate_unit-tests.sh @@ -345,20 +345,16 @@ testthat::test_that(desc = ' methods', code = { ${FUN}(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) EOF -fi \ No newline at end of file +fi diff --git a/codegen/templates/moving_average_template.R.in b/codegen/templates/moving_average_template.R.in index a7fbec5ca..601adcd27 100644 --- a/codegen/templates/moving_average_template.R.in +++ b/codegen/templates/moving_average_template.R.in @@ -155,17 +155,9 @@ $FUN.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x diff --git a/codegen/templates/numeric_template.R.in b/codegen/templates/numeric_template.R.in index adc86c376..b2eecce12 100644 --- a/codegen/templates/numeric_template.R.in +++ b/codegen/templates/numeric_template.R.in @@ -26,17 +26,9 @@ ${FUN}.numeric <- function( as.logical(na.bridge) ) - ## check if it has 'dims' - ## and convert to double if - ## not to honor the 'type-safety'-esque - ## approach - ## - ## NOTE: this adds a few ns overhead but - ## its a robust alternative to code it - ## manually. Any suggestions are welcome - if (is.null(dim(x))) { - x <- as.double(x) - } + ## convert one-column matrix outputs + ## to a double vector for vector input + x <- as_numeric_output(x) x } diff --git a/tests/testthat/test-ta_APO.R b/tests/testthat/test-ta_APO.R index 1b3387c0a..6a44cfee2 100644 --- a/tests/testthat/test-ta_APO.R +++ b/tests/testthat/test-ta_APO.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { absolute_price_oscillator(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_BBANDS.R b/tests/testthat/test-ta_BBANDS.R index 3690e5e93..238809d1b 100644 --- a/tests/testthat/test-ta_BBANDS.R +++ b/tests/testthat/test-ta_BBANDS.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { bollinger_bands(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_CMO.R b/tests/testthat/test-ta_CMO.R index 41d42161d..f4ebea873 100644 --- a/tests/testthat/test-ta_CMO.R +++ b/tests/testthat/test-ta_CMO.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { chande_momentum_oscillator(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_DEMA.R b/tests/testthat/test-ta_DEMA.R index 9ee69bfc8..6a6ba8e70 100644 --- a/tests/testthat/test-ta_DEMA.R +++ b/tests/testthat/test-ta_DEMA.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { double_exponential_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_EMA.R b/tests/testthat/test-ta_EMA.R index 4803a1540..9727c2f61 100644 --- a/tests/testthat/test-ta_EMA.R +++ b/tests/testthat/test-ta_EMA.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { exponential_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_HT_DCPERIOD.R b/tests/testthat/test-ta_HT_DCPERIOD.R index 7b396040e..8ccdab5e0 100644 --- a/tests/testthat/test-ta_HT_DCPERIOD.R +++ b/tests/testthat/test-ta_HT_DCPERIOD.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { dominant_cycle_period(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_HT_DCPHASE.R b/tests/testthat/test-ta_HT_DCPHASE.R index 4e7104590..d2db18264 100644 --- a/tests/testthat/test-ta_HT_DCPHASE.R +++ b/tests/testthat/test-ta_HT_DCPHASE.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { dominant_cycle_phase(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_HT_PHASOR.R b/tests/testthat/test-ta_HT_PHASOR.R index 5cf64d6d0..f08458d9c 100644 --- a/tests/testthat/test-ta_HT_PHASOR.R +++ b/tests/testthat/test-ta_HT_PHASOR.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { phasor_components(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_HT_SINE.R b/tests/testthat/test-ta_HT_SINE.R index c37440e1f..501aaf0c4 100644 --- a/tests/testthat/test-ta_HT_SINE.R +++ b/tests/testthat/test-ta_HT_SINE.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { sine_wave(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_HT_TRENDLINE.R b/tests/testthat/test-ta_HT_TRENDLINE.R index 5476e4340..2989d5a37 100644 --- a/tests/testthat/test-ta_HT_TRENDLINE.R +++ b/tests/testthat/test-ta_HT_TRENDLINE.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { trendline(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_HT_TRENDMODE.R b/tests/testthat/test-ta_HT_TRENDMODE.R index 1a2709bbe..d3cdaa2aa 100644 --- a/tests/testthat/test-ta_HT_TRENDMODE.R +++ b/tests/testthat/test-ta_HT_TRENDMODE.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { trend_cycle_mode(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_KAMA.R b/tests/testthat/test-ta_KAMA.R index f93fb9efb..3aa0f28b2 100644 --- a/tests/testthat/test-ta_KAMA.R +++ b/tests/testthat/test-ta_KAMA.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { kaufman_adaptive_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_MACD.R b/tests/testthat/test-ta_MACD.R index 095b330f3..36a1ae586 100644 --- a/tests/testthat/test-ta_MACD.R +++ b/tests/testthat/test-ta_MACD.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { moving_average_convergence_divergence(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_MACDEXT.R b/tests/testthat/test-ta_MACDEXT.R index beb57c9d3..72fb59806 100644 --- a/tests/testthat/test-ta_MACDEXT.R +++ b/tests/testthat/test-ta_MACDEXT.R @@ -249,18 +249,14 @@ testthat::test_that(desc = ' methods', code = { extended_moving_average_convergence_divergence(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_MACDFIX.R b/tests/testthat/test-ta_MACDFIX.R index d619fb7f8..dc316ca41 100644 --- a/tests/testthat/test-ta_MACDFIX.R +++ b/tests/testthat/test-ta_MACDFIX.R @@ -243,18 +243,14 @@ testthat::test_that(desc = ' methods', code = { fixed_moving_average_convergence_divergence(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_MAMA.R b/tests/testthat/test-ta_MAMA.R index 53bd0ce80..43eefc0ea 100644 --- a/tests/testthat/test-ta_MAMA.R +++ b/tests/testthat/test-ta_MAMA.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { mesa_adaptive_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_MOM.R b/tests/testthat/test-ta_MOM.R index 7fa114c4f..ce5dc95e3 100644 --- a/tests/testthat/test-ta_MOM.R +++ b/tests/testthat/test-ta_MOM.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { momentum(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_PPO.R b/tests/testthat/test-ta_PPO.R index 7157bfeb2..963cb3bb6 100644 --- a/tests/testthat/test-ta_PPO.R +++ b/tests/testthat/test-ta_PPO.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { percentage_price_oscillator(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_ROC.R b/tests/testthat/test-ta_ROC.R index b17ac22a3..9ac9dff84 100644 --- a/tests/testthat/test-ta_ROC.R +++ b/tests/testthat/test-ta_ROC.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { rate_of_change(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_ROCR.R b/tests/testthat/test-ta_ROCR.R index 54d1c43d0..3224cb183 100644 --- a/tests/testthat/test-ta_ROCR.R +++ b/tests/testthat/test-ta_ROCR.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { ratio_of_change(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_RSI.R b/tests/testthat/test-ta_RSI.R index dff50d26e..40cc132df 100644 --- a/tests/testthat/test-ta_RSI.R +++ b/tests/testthat/test-ta_RSI.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { relative_strength_index(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_SMA.R b/tests/testthat/test-ta_SMA.R index abfaeb274..3e09822dc 100644 --- a/tests/testthat/test-ta_SMA.R +++ b/tests/testthat/test-ta_SMA.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { simple_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_STOCHRSI.R b/tests/testthat/test-ta_STOCHRSI.R index 76ffb2cf8..07f616565 100644 --- a/tests/testthat/test-ta_STOCHRSI.R +++ b/tests/testthat/test-ta_STOCHRSI.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { stochastic_relative_strength_index(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_T3.R b/tests/testthat/test-ta_T3.R index 42a748726..49a2ea849 100644 --- a/tests/testthat/test-ta_T3.R +++ b/tests/testthat/test-ta_T3.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { t3_exponential_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_TEMA.R b/tests/testthat/test-ta_TEMA.R index 5511c07ce..2ac581dfb 100644 --- a/tests/testthat/test-ta_TEMA.R +++ b/tests/testthat/test-ta_TEMA.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { triple_exponential_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_TRIMA.R b/tests/testthat/test-ta_TRIMA.R index 4dfb628ed..e2eec73a5 100644 --- a/tests/testthat/test-ta_TRIMA.R +++ b/tests/testthat/test-ta_TRIMA.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { triangular_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_TRIX.R b/tests/testthat/test-ta_TRIX.R index 21a9b3874..626d53588 100644 --- a/tests/testthat/test-ta_TRIX.R +++ b/tests/testthat/test-ta_TRIX.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { triple_exponential_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) diff --git a/tests/testthat/test-ta_WMA.R b/tests/testthat/test-ta_WMA.R index 0a0b08c94..22d69882b 100644 --- a/tests/testthat/test-ta_WMA.R +++ b/tests/testthat/test-ta_WMA.R @@ -240,18 +240,14 @@ testthat::test_that(desc = ' methods', code = { weighted_moving_average(BTC[[1]]) ) - ## the numeric methods returns - ## depending on the underlying functions - ## so the checks for equal lengths is conditional target_length <- length(BTC[[1]]) - if (is.null(dim(x))) { - testthat::expect_true( - length(x) == target_length - ) + if (NCOL(x) == 1L) { + testthat::expect_true(is.double(x)) + testthat::expect_false(is.matrix(x)) + testthat::expect_equal(length(x), target_length) } else { - testthat::expect_true( - nrow(x) == target_length - ) + testthat::expect_true(is.matrix(x)) + testthat::expect_equal(nrow(x), target_length) } }) From 6c15f8c35645edf2f474668b2992dc7bb22d0395 Mon Sep 17 00:00:00 2001 From: nvphungdev <283886185+nvphungdev@users.noreply.github.com> Date: Sun, 17 May 2026 16:38:21 +0700 Subject: [PATCH 2/2] fix: simplify numeric output conversion Signed-off-by: nvphungdev <283886185+nvphungdev@users.noreply.github.com> --- R/ta_APO.R | 6 +++--- R/ta_BBANDS.R | 6 +++--- R/ta_CMO.R | 6 +++--- R/ta_DEMA.R | 6 +++--- R/ta_EMA.R | 6 +++--- R/ta_HT_DCPERIOD.R | 6 +++--- R/ta_HT_DCPHASE.R | 6 +++--- R/ta_HT_PHASOR.R | 6 +++--- R/ta_HT_SINE.R | 6 +++--- R/ta_HT_TRENDLINE.R | 6 +++--- R/ta_HT_TRENDMODE.R | 6 +++--- R/ta_KAMA.R | 6 +++--- R/ta_MACD.R | 6 +++--- R/ta_MACDEXT.R | 6 +++--- R/ta_MACDFIX.R | 6 +++--- R/ta_MAMA.R | 6 +++--- R/ta_MOM.R | 6 +++--- R/ta_PPO.R | 6 +++--- R/ta_ROC.R | 6 +++--- R/ta_ROCR.R | 6 +++--- R/ta_RSI.R | 6 +++--- R/ta_SMA.R | 6 +++--- R/ta_STOCHRSI.R | 6 +++--- R/ta_T3.R | 6 +++--- R/ta_TEMA.R | 6 +++--- R/ta_TRIMA.R | 6 +++--- R/ta_TRIX.R | 6 +++--- R/ta_VOLUME.R | 6 +++--- R/ta_WMA.R | 6 +++--- R/utils.R | 17 ----------------- codegen/templates/moving_average_template.R.in | 6 +++--- codegen/templates/numeric_template.R.in | 6 +++--- 32 files changed, 93 insertions(+), 110 deletions(-) diff --git a/R/ta_APO.R b/R/ta_APO.R index 0eb1adaa0..48bc40851 100644 --- a/R/ta_APO.R +++ b/R/ta_APO.R @@ -172,9 +172,9 @@ absolute_price_oscillator.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_BBANDS.R b/R/ta_BBANDS.R index 621d03bb8..3676bb6ad 100644 --- a/R/ta_BBANDS.R +++ b/R/ta_BBANDS.R @@ -182,9 +182,9 @@ bollinger_bands.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_CMO.R b/R/ta_CMO.R index ef01386c0..213017705 100644 --- a/R/ta_CMO.R +++ b/R/ta_CMO.R @@ -151,9 +151,9 @@ chande_momentum_oscillator.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_DEMA.R b/R/ta_DEMA.R index 8f445d9df..e7d0a423f 100644 --- a/R/ta_DEMA.R +++ b/R/ta_DEMA.R @@ -163,9 +163,9 @@ double_exponential_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_EMA.R b/R/ta_EMA.R index ac34efe7b..e999fc54b 100644 --- a/R/ta_EMA.R +++ b/R/ta_EMA.R @@ -163,9 +163,9 @@ exponential_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_HT_DCPERIOD.R b/R/ta_HT_DCPERIOD.R index 99397d60a..d65003f83 100644 --- a/R/ta_HT_DCPERIOD.R +++ b/R/ta_HT_DCPERIOD.R @@ -142,9 +142,9 @@ dominant_cycle_period.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_HT_DCPHASE.R b/R/ta_HT_DCPHASE.R index 0572389ba..401954a82 100644 --- a/R/ta_HT_DCPHASE.R +++ b/R/ta_HT_DCPHASE.R @@ -142,9 +142,9 @@ dominant_cycle_phase.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_HT_PHASOR.R b/R/ta_HT_PHASOR.R index 73e8db523..f29847715 100644 --- a/R/ta_HT_PHASOR.R +++ b/R/ta_HT_PHASOR.R @@ -142,9 +142,9 @@ phasor_components.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_HT_SINE.R b/R/ta_HT_SINE.R index 097435831..7de5d1d60 100644 --- a/R/ta_HT_SINE.R +++ b/R/ta_HT_SINE.R @@ -142,9 +142,9 @@ sine_wave.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_HT_TRENDLINE.R b/R/ta_HT_TRENDLINE.R index a79acd244..3ffbe7b8b 100644 --- a/R/ta_HT_TRENDLINE.R +++ b/R/ta_HT_TRENDLINE.R @@ -142,9 +142,9 @@ trendline.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_HT_TRENDMODE.R b/R/ta_HT_TRENDMODE.R index 4b53e6846..a3d0fc48c 100644 --- a/R/ta_HT_TRENDMODE.R +++ b/R/ta_HT_TRENDMODE.R @@ -142,9 +142,9 @@ trend_cycle_mode.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_KAMA.R b/R/ta_KAMA.R index 23e543d29..2e02e82f2 100644 --- a/R/ta_KAMA.R +++ b/R/ta_KAMA.R @@ -163,9 +163,9 @@ kaufman_adaptive_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_MACD.R b/R/ta_MACD.R index f7970cfdb..5e900a280 100644 --- a/R/ta_MACD.R +++ b/R/ta_MACD.R @@ -172,9 +172,9 @@ moving_average_convergence_divergence.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_MACDEXT.R b/R/ta_MACDEXT.R index b2ddbb5c6..5b9b4f7b8 100644 --- a/R/ta_MACDEXT.R +++ b/R/ta_MACDEXT.R @@ -178,9 +178,9 @@ extended_moving_average_convergence_divergence.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_MACDFIX.R b/R/ta_MACDFIX.R index bec7c72c1..9bf9dd6da 100644 --- a/R/ta_MACDFIX.R +++ b/R/ta_MACDFIX.R @@ -152,9 +152,9 @@ fixed_moving_average_convergence_divergence.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_MAMA.R b/R/ta_MAMA.R index 944af7d92..863fe8f58 100644 --- a/R/ta_MAMA.R +++ b/R/ta_MAMA.R @@ -182,9 +182,9 @@ mesa_adaptive_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_MOM.R b/R/ta_MOM.R index c997ab767..e0d939087 100644 --- a/R/ta_MOM.R +++ b/R/ta_MOM.R @@ -151,9 +151,9 @@ momentum.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_PPO.R b/R/ta_PPO.R index b5e436f68..509b2efc6 100644 --- a/R/ta_PPO.R +++ b/R/ta_PPO.R @@ -172,9 +172,9 @@ percentage_price_oscillator.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_ROC.R b/R/ta_ROC.R index 14028bdf8..554e94961 100644 --- a/R/ta_ROC.R +++ b/R/ta_ROC.R @@ -151,9 +151,9 @@ rate_of_change.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_ROCR.R b/R/ta_ROCR.R index 98072ba6e..64adfaad7 100644 --- a/R/ta_ROCR.R +++ b/R/ta_ROCR.R @@ -151,9 +151,9 @@ ratio_of_change.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_RSI.R b/R/ta_RSI.R index 0bc701281..1d0263dfa 100644 --- a/R/ta_RSI.R +++ b/R/ta_RSI.R @@ -151,9 +151,9 @@ relative_strength_index.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_SMA.R b/R/ta_SMA.R index bea7d94c6..79c660f13 100644 --- a/R/ta_SMA.R +++ b/R/ta_SMA.R @@ -163,9 +163,9 @@ simple_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_STOCHRSI.R b/R/ta_STOCHRSI.R index 250694c80..8573ca9b1 100644 --- a/R/ta_STOCHRSI.R +++ b/R/ta_STOCHRSI.R @@ -173,9 +173,9 @@ stochastic_relative_strength_index.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_T3.R b/R/ta_T3.R index 7184fa2fb..933356d9f 100644 --- a/R/ta_T3.R +++ b/R/ta_T3.R @@ -173,9 +173,9 @@ t3_exponential_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_TEMA.R b/R/ta_TEMA.R index f6a95f803..98857cbc2 100644 --- a/R/ta_TEMA.R +++ b/R/ta_TEMA.R @@ -163,9 +163,9 @@ triple_exponential_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_TRIMA.R b/R/ta_TRIMA.R index e62076eee..a63af2579 100644 --- a/R/ta_TRIMA.R +++ b/R/ta_TRIMA.R @@ -163,9 +163,9 @@ triangular_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_TRIX.R b/R/ta_TRIX.R index e62a687f1..e4b64072e 100644 --- a/R/ta_TRIX.R +++ b/R/ta_TRIX.R @@ -151,9 +151,9 @@ triple_exponential_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_VOLUME.R b/R/ta_VOLUME.R index 070e8ea99..f60c636d6 100644 --- a/R/ta_VOLUME.R +++ b/R/ta_VOLUME.R @@ -159,9 +159,9 @@ trading_volume.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/ta_WMA.R b/R/ta_WMA.R index 9066c4d68..7053c48e2 100644 --- a/R/ta_WMA.R +++ b/R/ta_WMA.R @@ -163,9 +163,9 @@ weighted_moving_average.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x } diff --git a/R/utils.R b/R/utils.R index 1d0045cfc..d31333a58 100644 --- a/R/utils.R +++ b/R/utils.R @@ -152,23 +152,6 @@ assert_column_names <- function(formula, available_variables) { x } -as_numeric_output <- function(x) { - lookback <- attr(x, "lookback", exact = TRUE) - - if (is.matrix(x)) { - if (ncol(x) != 1L) { - return(x) - } - - x <- x[, 1L] - } - - x <- as.double(x) - attr(x, "lookback") <- lookback - - x -} - ## class related utility ## functions is.formula <- function(x) { diff --git a/codegen/templates/moving_average_template.R.in b/codegen/templates/moving_average_template.R.in index 601adcd27..228b774a1 100644 --- a/codegen/templates/moving_average_template.R.in +++ b/codegen/templates/moving_average_template.R.in @@ -155,9 +155,9 @@ $FUN.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x diff --git a/codegen/templates/numeric_template.R.in b/codegen/templates/numeric_template.R.in index b2eecce12..32d89dbf1 100644 --- a/codegen/templates/numeric_template.R.in +++ b/codegen/templates/numeric_template.R.in @@ -26,9 +26,9 @@ ${FUN}.numeric <- function( as.logical(na.bridge) ) - ## convert one-column matrix outputs - ## to a double vector for vector input - x <- as_numeric_output(x) + if (dim(x)[2] == 1L) { + x <- as.double(x) + } x }