Better fix for the "WAT" bug

1 files changed, 56 insertions, 0 deletions

diff --git a/patch-adjRatios.R b/patch-adjRatios.R
new file mode 100644
index 0000000..a96f541
--- /dev/null
+++ b/patch-adjRatios.R
@@ -0,0 +1,56 @@
+## adjRatiosR <- function(split, div, close){
+##   split[is.na(split)] <- 1
+##   #backpopulate the split ratio vector from the tail
+##   split <- rev(cumprod(rev(split)))
+##   coredata(split) <- c(coredata(split)[-1],1)
+##   div.index <- !is.na(div)
+##   stopifnot(is.na(div[1]))
+##   if(any(div.index)){
+##     div[div.index] <- 1-div[div.index]/coredata(close[which(div.index)-1])
+##     div[!div.index] <- 1
+##     div <- rev(cumprod(rev(div)))
+##     coredata(div) <- c(coredata(div)[-1],1)
+##   }else{
+##     coredata(div) <- rep(1,length(div))
+##   }
+##   return(try.xts(merge(split,div),error="bad things are going to happen"))
+## }
+
+adjRatios <- function (splits, dividends, close) 
+{
+    if (!missing(dividends) && missing(close)) 
+        stop("\"close\" must be specified to adjust dividends")
+    if (missing(close) || all(is.na(close)) || NROW(close) == 
+        0) {
+        close <- NA
+    }
+    else {
+        close <- try.xts(close, error = stop("\"as.xts(close)\" failed"))
+    }
+    if (missing(splits) || all(is.na(splits)) || NROW(splits) == 0) {
+        splits <- NA
+    }
+    else {
+        splits <- try.xts(splits, error = stop("\"as.xts(splits)\" failed"))
+    }
+    if (missing(dividends) || all(is.na(dividends))|| NROW(dividends) == 0) {
+        dividends <- NA
+    }
+    else {
+        dividends <- try.xts(dividends, error = stop("\"as.xts(dividends)\" failed"))
+    }
+    obj <- merge.xts(close, splits, dividends)
+    # for a non NA dividend value, close from the previous day must be non NA
+    #otherwise we can't compute the dividend ratio
+    if(any(is.na(close[-length(close)][!is.na(dividends)[-1]]))){
+      stop("can't compute dividend ratio")
+    }
+    # if close is NA, then we can't compute the dividend ratio anway
+    #if (!isTRUE(is.na(close))) {
+    #    obj <- obj[!is.na(obj[, 1]), ]
+    #}
+    adj <- .Call("adjRatios", obj[, 2], obj[, 3], obj[, 1], PACKAGE = "TTR")
+    adj <- xts(cbind(adj[[1]], adj[[2]]), index(obj))
+    colnames(adj) <- c("Split", "Div")
+    return(adj)
+}