Updated addVlines

The function is now called addEvents, and supports multiple coloring and associated texts.

NAMESPACE

@@ -2,10 +2,10 @@
 
 export("%>%")
 export(addBBands)
+export(addEvents)
 export(addMA)
 export(addMACD)
 export(addRSI)
-export(addVlines)
 export(addVolume)
 export(availableExchanges)
 export(availableIntervals)

R/chart.R

@@ -205,6 +205,7 @@ chart <- function(
 
 
       chart <- chart %>% plotly::layout(
+        margin = list(l = 60, r = 60, b = 110, t = 60),
         yaxis = list(
           title = 'Price'
         ),
@@ -214,12 +215,12 @@ chart <- function(
             )
         ),
         showlegend = TRUE,
-        legend = list(orientation = 'h', x = 0, y = 1),
+        legend = list(orientation = 'h', x = 0, y = 1.1),
         paper_bgcolor='rgba(0,0,0,0)',
         plot_bgcolor='rgba(0,0,0,0)'
       ) %>% plotly::add_annotations(
         x= 0,
-        y= 1,
+        y= 1.05,
         xref = "paper",
         yref = "paper",
         text = paste(

R/chartEvent.R

@@ -0,0 +1,102 @@
+#' add eventlines to
+#' the chart
+#'
+#' @description
+#' A short description...
+#'
+#' `r lifecycle::badge("experimental")`
+#'
+#' @param plot Chart
+#' @param event a data.frame with index, event and colors.
+#'
+#' @example man/examples/scr_addEvents.R
+#'
+#' @family chart indicators
+#' @export
+addEvents <- function(
+    plot,
+    event
+) {
+
+  # check if class is
+  # data.frame or the likes of it
+  if (!inherits(event, 'data.frame')) {
+
+    rlang::abort(
+      message = 'The event data has to be data.frame, or similar.'
+    )
+
+  }
+
+  # check if the column names
+  # include event, labels, color
+  colnames(event) <- tolower(
+    colnames(
+      event
+    )
+  )
+
+  if (sum(grepl(x = colnames(event),pattern = 'index|event|color')) != 3) {
+
+    # determine the missing column names
+    # from the data
+    missing_cols <- setdiff(
+      c('index', 'event', 'color'),
+      colnames(event)
+    )
+
+    rlang::abort(
+      message = paste('Colum:', paste(collapse = ', ', missing_cols), 'are missing. Check your spelling, or add the columns.')
+    )
+
+
+  }
+
+
+  # 1) extract the main
+  # chart from the plot
+  plot_ <- plot$main
+
+
+
+  plot_ <- plotly::layout(
+    p = plot_,
+    shapes = do.call(
+      list,
+      lapply(
+        1:nrow(event),
+        function(i) {
+
+          vline(
+            x = event$index[i],
+            col = event$color[i]
+          )
+        }
+
+      )
+    ),
+    annotations = do.call(
+      list,
+      lapply(
+        1:nrow(event),
+        function(i) {
+
+          annotations(
+            x = event$index[i],
+            text = event$event[i]
+          )
+        }
+
+      )
+    )
+  )
+
+  plot$main <- plot_
+  # attributes(plot)$quote <- toDF(quote)
+
+  return(
+    invisible(plot)
+  )
+
+}
+

R/chart_indicators.R

@@ -472,64 +472,4 @@ addRSI <- function(
 
 
 }
-
-
-#' add vertical lines to
-#' the chart
-#'
-#' @description
-#' A short description...
-#'
-#' `r lifecycle::badge("experimental")`
-#'
-#' @param plot Chart
-#' @param object an XTS object with dates
-#' where the vertical line has to be drawn
-#' @param color description
-#'
-#' @example man/examples/scr_addVlines.R
-#'
-#' @family chart indicators
-#' @export
-addVlines <- function(plot, object, color = 'steelblue') {
-
-  # quote <- toDF(
-  #   object
-  # )
-
-  # 1) extract the main
-  # chart from the plot
-  plot_ <- plot$main
-
-
-
-  plot_ <- plotly::layout(
-    p = plot_,
-    shapes = do.call(
-      list,
-      lapply(
-        zoo::index(object),
-        function(x) {
-
-          vline(
-            x,
-            color = color
-          )
-        }
-
-      )
-    )
-  )
-
-  plot$main <- plot_
-  # attributes(plot)$quote <- toDF(quote)
-
-  return(
-    invisible(plot)
-  )
-
-
-
-}
-
 # script end;

R/helper.R

@@ -310,7 +310,7 @@ toQuote <- function(DF) {
 
 vline <- function(
     x = 0,
-    color = 'steelblue'
+    col = 'steelblue'
 ) {
 
   list(
@@ -330,4 +330,31 @@ vline <- function(
 
 
 
+
+annotations <- function(
+    x = 0,
+    text = 'text'
+) {
+
+  list(
+    x = x,
+    y = 1,
+    text = text,
+    showarrow = FALSE,
+    #xref = 'paper',
+    yref = 'paper',
+    xanchor = 'right',
+    yanchor = 'auto',
+    xshift = 0,
+    textangle = -90,
+    yshift = 0,
+    font = list(
+      size = 15,
+      color = "black",
+      angle = '90'
+    )
+  )
+
+
+}
 # script end;