Implements faster format_POSIXct(), thanks @gaborcsardi

Author: shikokuchuo

NAMESPACE

@@ -20,6 +20,7 @@ export(autostrat)
 export(coredata)
 export(df_append)
 export(df_merge)
+export(format_POSIXct)
 export(grid_dup)
 export(hasStrat)
 export(ichimoku)

NEWS.md

@@ -1,5 +1,9 @@
 # ichimoku 1.5.5.9000 (development)
 
+#### New features:
+
+* `format_POSIXct()` is a much faster equivalent of the base R `format.POSIXct()`, used internally and exported as a utility.
+
 # ichimoku 1.5.5
 
 #### New features:

R/iplot.R

@@ -1,4 +1,4 @@
-# Copyright (C) 2021-2023 Hibiki AI Limited <info@hibiki-ai.com>
+# Copyright (C) 2021-2025 Hibiki AI Limited <info@hibiki-ai.com>
 #
 # This file is part of ichimoku.
 #
@@ -78,7 +78,7 @@ iplot <- function(x,
   tformat <- if (attr(x, "periodicity") > 80000) "%F" else "%F %T"
   start <- index.ichimoku(x, 1L)
   end <- index.ichimoku(x, dims[1L])
-  xadj <- if (nchar(format.POSIXct(start)) > 10) -17 else 5
+  xadj <- if (nchar(format_POSIXct(start)) > 10) -17 else 5
 
   ui <- fluidPage(
     tags$head(tags$style("
@@ -210,7 +210,7 @@ drawInfotip <- function(sidx, sdata, left, top, type, custom = NULL) {
         <div style='text-align: center; margin: 0; padding: 0'>L: %.5g</div>
         <div style='margin: 2px 0 0 0; padding: 0'>Tenkan: %.5g<br />Kijun: %.5g<br />Senkou A: %.5g<br />Senkou B: %.5g<br />Chikou: %.5g%s</div>",
         if (is.na(cd) || cd == 0) "&#8212;" else if (cd == 1) "&#9651;" else if (cd == -1) "&#9660;",
-        format.POSIXct(sidx), sdata[["high"]], sdata[["open"]], sdata[["close"]], sdata[["low"]],
+        format_POSIXct(sidx), sdata[["high"]], sdata[["open"]], sdata[["close"]], sdata[["low"]],
         sdata[["tenkan"]], sdata[["kijun"]], sdata[["senkouA"]], sdata[["senkouB"]], sdata[["chikou"]],
         switch(
           type,

R/methods.R

@@ -1,4 +1,4 @@
-# Copyright (C) 2021-2023 Hibiki AI Limited <info@hibiki-ai.com>
+# Copyright (C) 2021-2025 Hibiki AI Limited <info@hibiki-ai.com>
 #
 # This file is part of ichimoku.
 #
@@ -85,10 +85,10 @@ str.ichimoku <- function(object, ...) {
   dims <- attr(object, "dim")
   if (is.null(dims)) {
     xlen <- length(object)
-    dates <- format.POSIXct(index.ichimoku(object, c(1L, xlen)))
+    dates <- format_POSIXct(index.ichimoku(object, c(1L, xlen)))
     cat("ichimoku object with no dimensions\nVector <numeric> w/ length:", xlen, file = stdout())
   } else {
-    dates <- format.POSIXct(index.ichimoku(object, c(1L, dims[1L])))
+    dates <- format_POSIXct(index.ichimoku(object, c(1L, dims[1L])))
     cat("ichimoku object [", dates[1L], " / ", dates[2L], "] (",
         dims[1L], ", ", dims[2L], ")", if (hasStrat(object)) " w/ strat",
         "\n <double> $", file = stdout(), sep = "")
@@ -171,7 +171,7 @@ summary.ichimoku <- function(object, strat = TRUE, ...) {
         end <- sum(!is.na(core[, "close"]))
         high <- which.max(core[1:end, "high"])
         low <- which.min(core[1:end, "low"])
-        dates <- format.POSIXct(index.ichimoku(object, c(1L, high, low, end)))
+        dates <- format_POSIXct(index.ichimoku(object, c(1L, high, low, end)))
         cat("\n            Max: ", dates[2L], " [", core[high, "high"],
             "]\nStart: ", dates[1L], " [", core[1L, "open"],
             "]   End: ", dates[4L], " [", core[end, "close"],
@@ -262,20 +262,23 @@ NULL
 #' @method coredata ichimoku
 #' @export
 #'
-coredata.ichimoku <- function(x, fmt, ...)
-  if (missing(fmt))
-    .Call(ichimoku_coredata, x) else if (is.null(attr(x, "dim")))
-      `attributes<-`(
-        x,
-        list(names = if (is.character(fmt)) format.POSIXct(index.ichimoku(x), format = fmt) else
-          format.POSIXct(index.ichimoku(x)))
-      ) else
-        `attributes<-`(
-          x,
-          list(dim = attr(x, "dim"),
-               dimnames = list(if (is.character(fmt)) format.POSIXct(index.ichimoku(x), format = fmt) else
-                 format.POSIXct(index.ichimoku(x)), attr(x, "dimnames")[[2L]]))
-        )
+coredata.ichimoku <- function(x, fmt, ...) {
+  missing(fmt) && return(.Call(ichimoku_coredata, x))
+  if (is.null(attr(x, "dim"))) {
+    `attributes<-`(
+      x,
+      list(names = if (is.character(fmt)) format.POSIXct(index.ichimoku(x), format = fmt) else
+        format_POSIXct(index.ichimoku(x)))
+    )
+  } else {
+    `attributes<-`(
+      x,
+      list(dim = attr(x, "dim"),
+           dimnames = list(if (is.character(fmt)) format.POSIXct(index.ichimoku(x), format = fmt) else
+             format_POSIXct(index.ichimoku(x)), attr(x, "dimnames")[[2L]]))
+    )
+  }
+}
 
 #' @name index
 #' @rdname index.ichimoku
@@ -311,7 +314,7 @@ NULL
 #' @method index ichimoku
 #' @export
 #'
-index.ichimoku <- function(x, subset, ...)
-  if (missing(subset))
-    .Call(ichimoku_index, x) else
-      .Call(ichimoku_psxct, .subset(attr(x, "index"), subset))
+index.ichimoku <- function(x, subset, ...) {
+  missing(subset) && return(.Call(ichimoku_index, x))
+  .Call(ichimoku_psxct, .subset(attr(x, "index"), subset))
+}

R/mltools.R

@@ -1,4 +1,4 @@
-# Copyright (C) 2021-2023 Hibiki AI Limited <info@hibiki-ai.com>
+# Copyright (C) 2021-2025 Hibiki AI Limited <info@hibiki-ai.com>
 #
 # This file is part of ichimoku.
 #
@@ -284,7 +284,7 @@ mlgrid <- function(x,
 
   veclist <- switch(y, none = veclist, c(list(y = target), veclist))
   grid <- do.call(cbind, veclist)
-  dimnames(grid)[[1L]] <- format.POSIXct(index.ichimoku(x))
+  dimnames(grid)[[1L]] <- format_POSIXct(index.ichimoku(x))
   grid <- .Call(ichimoku_naomit, grid)
 
   if (type == "z-score") {

R/oanda.R

@@ -1,4 +1,4 @@
-# Copyright (C) 2021-2024 Hibiki AI Limited <info@hibiki-ai.com>
+# Copyright (C) 2021-2025 Hibiki AI Limited <info@hibiki-ai.com>
 #
 # This file is part of ichimoku.
 #
@@ -941,7 +941,7 @@ oanda_view <- function(market = c("allfx", "bonds", "commodities", "fx", "metals
          timestamp = time)
   )
 
-  cat("\n", format.POSIXct(time), " / ", price, "\n", file = stdout(), sep = "")
+  cat("\n", format_POSIXct(time), " / ", price, "\n", file = stdout(), sep = "")
   print(df)
 
 }
@@ -980,7 +980,7 @@ oanda_quote <- function(instrument, price = c("M", "B", "A"), server, apikey) {
                     server = server, apikey = apikey, .validate = FALSE)
   pctchg <- 100 * (data[["c"]] / data[["o"]] - 1)
   cat(sprintf("%s %s open: %.6g high: %.6g low: %.6g last:\u001b[7m %.6g \u001b[27m %%chg: %.4f %s\n",
-              instrument, format.POSIXct(.Call(ichimoku_psxct, data[["t"]])),
+              instrument, format_POSIXct(.Call(ichimoku_psxct, data[["t"]])),
               data[["o"]], data[["h"]], data[["l"]], data[["c"]], pctchg, price), file = stdout())
 
 }
@@ -1063,7 +1063,7 @@ oanda_positions <- function(instrument, time, server, apikey) {
     scale_y_continuous(),
     labs(x = "Price", y = "% short / % long",
          title = paste0("OANDA Position Book: ", instrument, " at ",
-                        format.POSIXct(timestamp), " / Current Price: ", currentprice)),
+                        format_POSIXct(timestamp), " / Current Price: ", currentprice)),
     coord_flip(),
     theme_ichimoku_light()
   )
@@ -1158,7 +1158,7 @@ oanda_orders <- function(instrument, time, server, apikey) {
     scale_y_continuous(),
     labs(x = "Price", y = "% short / % long",
          title = paste0("OANDA Order Book: ", instrument, " at ",
-                        format.POSIXct(timestamp), " / Current Price: ", currentprice)),
+                        format_POSIXct(timestamp), " / Current Price: ", currentprice)),
     coord_flip(),
     theme_ichimoku_light()
   )

R/utils.R

@@ -1,4 +1,4 @@
-# Copyright (C) 2021-2023 Hibiki AI Limited <info@hibiki-ai.com>
+# Copyright (C) 2021-2025 Hibiki AI Limited <info@hibiki-ai.com>
 #
 # This file is part of ichimoku.
 #
@@ -364,6 +364,23 @@ more <- function(rows)
 #'
 is.ichimoku <- function(x) .Call(ichimoku_isichimoku, x)
 
+#' Format POSIXct
+#'
+#' Converts a POSIXct double timestamp into a character string much faster
+#' than \code{\link{format.POSIXct}}.
+#'
+#' @param x an object of class \sQuote{POSIXct}.
+#'
+#' @return A character string
+#'
+#' @examples
+#' format_POSIXct(Sys.time())
+#'
+#' @export
+#'
+format_POSIXct <- function(x)
+  format.POSIXlt(as.POSIXlt.POSIXct(x, tz = "UTC"), "%Y-%m-%d %H:%M:%S")
+
 #' match.arg Replacement
 #'
 #' Internal version of match.arg used to return an integer value for integer

man/format_POSIXct.Rd

@@ -538,7 +538,7 @@ layers <- list(
   ggplot2::scale_y_continuous(),
   ggplot2::labs(x = "Price", y = "% short / % long",
                 title = paste0("OANDA Position Book: ", instrument, " at ",
-                        format.POSIXct(timestamp), " / Current Price: ", currentprice)),
+                        format_POSIXct(timestamp), " / Current Price: ", currentprice)),
   ggplot2::coord_flip(),
   ichimoku:::theme_ichimoku_light()
 )