[Candlesticks-commits] r10 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Feb 13 16:09:16 CET 2012
Author: wotuzu17
Date: 2012-02-13 16:09:16 +0100 (Mon, 13 Feb 2012)
New Revision: 10
Added:
pkg/R/CSPNBlended.R
pkg/R/addPriceInfo.R
pkg/man/CSPNBlended.Rd
pkg/man/addPriceInfo.Rd
pkg/man/isOC.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/CSPDarkCloudCover.R
pkg/R/CSPDoji.R
pkg/R/CSPEngulfing.R
pkg/R/CSPGap.R
pkg/R/CSPHarami.R
pkg/R/CSPInsideDay.R
pkg/R/CSPKicking.R
pkg/R/CSPLongCandle.R
pkg/R/CSPMarubozu.R
pkg/R/CSPNHigherClose.R
pkg/R/CSPNLongCandles.R
pkg/R/CSPPiercingPattern.R
pkg/R/CSPStar.R
pkg/R/CSPStomache.R
pkg/R/CSPTasukiGap.R
pkg/R/CSPThreeInside.R
pkg/R/CSPThreeMethods.R
pkg/R/CSPThreeOutside.R
pkg/R/CSPThreeWhiteSoldiers.R
pkg/man/CSPNLongWhiteCandles.Rd
pkg/man/candlesticks-package.Rd
Log:
added reclass directive to CSP functions, added addPriceInfo
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/DESCRIPTION 2012-02-13 15:09:16 UTC (rev 10)
@@ -1,8 +1,8 @@
Package: candlesticks
Type: Package
Title: Candlestick Pattern Recognition
-Version: 0.1-8
-Date: 2012-02-10
+Version: 0.1-9
+Date: 2012-02-13
Author: Andreas Voellenklee
Maintainer: Andreas Voellenklee <wotuzu17 at gmail.com>
Depends: R (>= 2.13), xts (>= 0.8-2), quantmod (>= 0.3-17), TTR (>= 0.21-0)
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/NAMESPACE 2012-02-13 15:09:16 UTC (rev 10)
@@ -8,6 +8,7 @@
export(CSPKicking)
export(CSPLongCandle)
export(CSPLongCandleBody)
+export(CSPNBlended)
export(CSPNHigherClose)
export(CSPNLongBlackCandleBodies)
export(CSPNLongWhiteCandleBodies)
@@ -31,8 +32,9 @@
export(LagOHLC)
export(LagOC)
# special functions
+export(addPriceInfo)
export(CandleBodyLength)
export(CandleLength)
-# export(is.HL)
-# export(is.OC)
+export(is.HL)
+export(is.OC)
Modified: pkg/R/CSPDarkCloudCover.R
===================================================================
--- pkg/R/CSPDarkCloudCover.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPDarkCloudCover.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -3,10 +3,11 @@
stop("Price series must contain Open and Close.")
}
LAGTS <- LagOC(TS, k=1)
- DarkCloudCover <- eval (
+ DarkCloudCover <- reclass(eval (
Cl(LAGTS)>Op(LAGTS) & Op(TS)>Cl(TS)
& Op(TS)>Cl(LAGTS) & (Op(LAGTS)+Cl(LAGTS))/2 > Cl(TS)
- & Cl(TS)>Op(LAGTS) )
+ & Cl(TS)>Op(LAGTS) ), TS)
colnames(DarkCloudCover) <- c("DarkCloudCover")
+ xtsAttributes(DarkCloudCover) <- list(bars=2)
return(DarkCloudCover)
}
\ No newline at end of file
Modified: pkg/R/CSPDoji.R
===================================================================
--- pkg/R/CSPDoji.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPDoji.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -2,10 +2,11 @@
if (!is.OHLC(TS)) {
stop("Price series must contain Open, High, Low and Close.")
}
- Doji <- eval (abs(Op(TS)-Cl(TS))/(Hi(TS)-Lo(TS)) <= DojiBLRatio)
- DFDoji <- eval (Doji & (Op(TS)==Hi(TS) | Cl(TS)==Hi(TS)))
- GSDoji <- eval (Doji & (Op(TS)==Lo(TS) | Cl(TS)==Lo(TS)))
+ Doji <- reclass(eval (abs(Op(TS)-Cl(TS))/(Hi(TS)-Lo(TS)) <= DojiBLRatio), TS)
+ DFDoji <- reclass(eval (Doji & (Op(TS)==Hi(TS) | Cl(TS)==Hi(TS))), TS)
+ GSDoji <- reclass(eval (Doji & (Op(TS)==Lo(TS) | Cl(TS)==Lo(TS))), TS)
result <- cbind(Doji, DFDoji, GSDoji)
colnames(result) <- c("Doji", "DragonflyDoji", "GravestoneDoji")
+ xtsAttributes(result) <- list(bars=1)
return (result)
}
Modified: pkg/R/CSPEngulfing.R
===================================================================
--- pkg/R/CSPEngulfing.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPEngulfing.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -3,9 +3,10 @@
stop("Price series must contain Open and Close.")
}
LAGTS <- LagOC(TS, k=1)
- BullEngulfing <- eval( Op(LAGTS)>Cl(LAGTS) & Cl(TS)>Op(TS) & Cl(LAGTS)>=Op(TS) & Cl(TS)>=Op(LAGTS) )
- BearEngulfing <- eval( Cl(LAGTS)>Op(LAGTS) & Op(TS)>Cl(TS) & Op(LAGTS)>=Cl(TS) & Op(TS)>=Cl(LAGTS) )
+ BullEngulfing <- reclass(eval( Op(LAGTS)>Cl(LAGTS) & Cl(TS)>Op(TS) & Cl(LAGTS)>=Op(TS) & Cl(TS)>=Op(LAGTS) ), TS)
+ BearEngulfing <- reclass(eval( Cl(LAGTS)>Op(LAGTS) & Op(TS)>Cl(TS) & Op(LAGTS)>=Cl(TS) & Op(TS)>=Cl(LAGTS) ), TS)
result <- cbind(BullEngulfing, BearEngulfing)
colnames(result) <- c("Bull.Engulfing", "Bear.Engulfing")
+ xtsAttributes(result) <- list(bars=2)
return(result)
}
Modified: pkg/R/CSPGap.R
===================================================================
--- pkg/R/CSPGap.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPGap.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -6,18 +6,19 @@
LAGTS <- LagOC(TS, k=1)
TSOC <- cbind(Op(TS), Cl(TS))
LAGTSOC <- cbind(Op(LAGTS), Cl(LAGTS))
- UPGAP <- eval(as.xts(apply(LAGTSOC,1,max)) < as.xts(apply(TSOC,1,min)))
- DOWNGAP <- eval(as.xts(apply(LAGTSOC,1,min)) > as.xts(apply(TSOC,1,max)))
+ UPGAP <- reclass(eval(as.xts(apply(LAGTSOC,1,max)) < as.xts(apply(TSOC,1,min))), TS)
+ DOWNGAP <- reclass(eval(as.xts(apply(LAGTSOC,1,min)) > as.xts(apply(TSOC,1,max))), TS)
}
else if (ignoreShadows==FALSE) {
if (!is.OHLC(TS)) {
stop("Price series must contain Open, High, Low and Close.")
}
LAGTS <- LagOHLC(TS, k=1)
- UPGAP <- eval(Lo(TS) > Hi(LAGTS))
- DOWNGAP <- eval(Hi(TS) < Lo(LAGTS))
+ UPGAP <- reclass(eval(Lo(TS) > Hi(LAGTS)), TS)
+ DOWNGAP <- reclass(eval(Hi(TS) < Lo(LAGTS)), TS)
}
- result <- cbind(UPGAP,DOWNGAP)
+ result <- cbind(UPGAP, DOWNGAP)
colnames(result) <- c("GapUp", "GapDown")
+ xtsAttributes(result) <- list(bars=2)
return (result)
}
\ No newline at end of file
Modified: pkg/R/CSPHarami.R
===================================================================
--- pkg/R/CSPHarami.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPHarami.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -3,21 +3,22 @@
stop("Price series must contain Open, High, Low and Close.")
}
LAGTS <- LagOHLC(TS, k=1)
- BullHarami <- eval(
+ BullHarami <- reclass(eval(
Op(LAGTS)>Cl(LAGTS) & Cl(TS)>Op(TS)
& Op(LAGTS)>Cl(TS) & Cl(LAGTS)<Op(TS)
- & Hi(LAGTS)>=Hi(TS) & Lo(LAGTS)<=Lo(TS) )
- BearHarami <- eval(
+ & Hi(LAGTS)>=Hi(TS) & Lo(LAGTS)<=Lo(TS) ), TS)
+ BearHarami <- reclass(eval(
Cl(LAGTS)>Op(LAGTS) & Op(TS)>Cl(TS)
& Cl(LAGTS)>Op(TS) & Op(LAGTS)<Cl(TS)
- & Hi(LAGTS)>=Hi(TS) & Lo(LAGTS)<=Lo(TS) )
+ & Hi(LAGTS)>=Hi(TS) & Lo(LAGTS)<=Lo(TS) ), TS)
# some don't accept the second candle being a doji
if (excludeDoji==TRUE) {
Doji <- CSPDoji(TS, DojiBLRatio)
- BullHarami <- eval(BullHarami & !Doji[,1])
- BearHarami <- eval(BearHarami & !Doji[,1])
+ BullHarami <- reclass(eval(BullHarami & !Doji[,1]), TS)
+ BearHarami <- reclass(eval(BearHarami & !Doji[,1]), TS)
}
result <- cbind(BullHarami, BearHarami)
colnames(result) <- c("Bull.Harami", "Bear.Harami")
+ xtsAttributes(result) <- list(bars=2)
return(result)
}
Modified: pkg/R/CSPInsideDay.R
===================================================================
--- pkg/R/CSPInsideDay.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPInsideDay.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -3,8 +3,9 @@
stop("Price series must contain Open, High, Low and Close.")
}
LAGTS <- LagOHLC(TS, k=1)
- result <- eval(Hi(TS)<=Hi(LAGTS) & Lo(TS)>=Lo(LAGTS))
+ result <- reclass(eval(Hi(TS)<=Hi(LAGTS) & Lo(TS)>=Lo(LAGTS)), TS)
colnames(result) <- "InsideDay"
+ xtsAttributes(result) <- list(bars=2)
return (result)
}
@@ -13,7 +14,8 @@
stop("Price series must contain Open, High, Low and Close.")
}
LAGTS <- LagOHLC(TS, k=1)
- result <- eval(Hi(TS)>Hi(LAGTS) & Lo(TS)<Lo(LAGTS))
+ result <- reclass(eval(Hi(TS)>Hi(LAGTS) & Lo(TS)<Lo(LAGTS)), TS)
colnames(result) <- "OutsideDay"
+ xtsAttributes(result) <- list(bars=2)
return (result)
}
Modified: pkg/R/CSPKicking.R
===================================================================
--- pkg/R/CSPKicking.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPKicking.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -7,22 +7,31 @@
MB <- CSPMarubozu(TS, n=n, threshold=threshold)
WMB1 <- Lag(MB[,1], k=1)
BMB1 <- Lag(MB[,4], k=1)
- BULLK <- eval(TSGAP[,1] & # Gap Up
- BMB1 & MB[,1]) # 1st candle is black marubozu, 2nd candle is white marubozu
- BEARK <- eval(TSGAP[,2] & # Gap Down
- WMB1 & MB[,4]) # 1st candle is white marubozu, 2nd candle is black marubozu
+ BULLK <- reclass(
+ eval(TSGAP[,1] & # Gap Up
+ BMB1 & MB[,1]), # 1st candle is black marubozu, 2nd candle is white marubozu
+ TS)
+ BEARK <- reclass(
+ eval(TSGAP[,2] & # Gap Down
+ WMB1 & MB[,4]), # 1st candle is white marubozu, 2nd candle is black marubozu
+ TS)
} else if (ignoreShadows==TRUE) {
LCB <- CSPLongCandleBody(TS, n=n, threshold=threshold)
LWCB1 <- Lag(LCB[,1], k=1)
LBCB1 <- Lag(LCB[,2], k=1)
- BULLK <- eval(TSGAP[,1] & # Gap Up
- LBCB1 & LCB[,1]) # 1st candle has long black candle body, 2nd has long white candle body
- BEARK <- eval(TSGAP[,2] & # Gap Down
- LWCB1 & LCB[,2]) # 1st candle has long white candle body, 2nd has long black candle body
+ BULLK <- reclass(
+ eval(TSGAP[,1] & # Gap Up
+ LBCB1 & LCB[,1]), # 1st candle has long black candle body, 2nd has long white candle body
+ TS)
+ BEARK <- reclass(
+ eval(TSGAP[,2] & # Gap Down
+ LWCB1 & LCB[,2]), # 1st candle has long white candle body, 2nd has long black candle body
+ TS)
} else {
stop("ignoreShadows must be either TRUE or FALSE")
}
result <- cbind (BULLK, BEARK)
colnames (result) <- (c("Bull.Kicking", "Bear.Kicking"))
+ xtsAttributes(result) <- list(bars=2)
return (result)
}
\ No newline at end of file
Modified: pkg/R/CSPLongCandle.R
===================================================================
--- pkg/R/CSPLongCandle.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPLongCandle.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -4,10 +4,11 @@
}
CL <- CandleLength (TS)
CLMedian <- runMedian (CL[,1], n=n) # use relative CandleLength
- LongWhiteCandle <- eval (CL[,1] >= CLMedian*threshold & Cl(TS) >= Op(TS))
- LongBlackCandle <- eval (CL[,1] >= CLMedian*threshold & Op(TS) > Cl(TS))
+ LongWhiteCandle <- reclass(eval (CL[,1] >= CLMedian*threshold & Cl(TS) >= Op(TS)), TS)
+ LongBlackCandle <- reclass(eval (CL[,1] >= CLMedian*threshold & Op(TS) > Cl(TS)), TS)
result <- cbind (LongWhiteCandle, LongBlackCandle)
colnames (result) <- c("LongWhiteCandle", "LongBlackCandle")
+ xtsAttributes(result) <- list(bars=1)
return (result)
}
@@ -17,10 +18,11 @@
}
CBL <- CandleBodyLength (TS)
CBLMedian <- runMedian (CBL[,1], n=n) # use relative CandleBodyLength
- LongWhiteCandleBody <- eval (CBL[,1] >= CBLMedian*threshold & Cl(TS) >= Op(TS))
- LongBlackCandleBody <- eval (CBL[,1] >= CBLMedian*threshold & Op(TS) > Cl(TS))
+ LongWhiteCandleBody <- reclass(eval (CBL[,1] >= CBLMedian*threshold & Cl(TS) >= Op(TS)), TS)
+ LongBlackCandleBody <- reclass(eval (CBL[,1] >= CBLMedian*threshold & Op(TS) > Cl(TS)), TS)
result <- cbind (LongWhiteCandleBody, LongBlackCandleBody)
colnames (result) <- c("LongWhiteCandleBody", "LongBlackCandleBody")
+ xtsAttributes(result) <- list(bars=1)
return (result)
}
@@ -30,10 +32,11 @@
}
CL <- CandleLength (TS)
CLMedian <- runMedian (CL[,1], n=n) # use relative CandleLength
- ShortWhiteCandle <- eval (CL[,1] < CLMedian*threshold & Cl(TS) >= Op(TS))
- ShortBlackCandle <- eval (CL[,1] < CLMedian*threshold & Op(TS) > Cl(TS))
+ ShortWhiteCandle <- reclass(eval (CL[,1] < CLMedian*threshold & Cl(TS) >= Op(TS)), TS)
+ ShortBlackCandle <- reclass(eval (CL[,1] < CLMedian*threshold & Op(TS) > Cl(TS)), TS)
result <- cbind (ShortWhiteCandle, ShortBlackCandle)
colnames (result) <- c("LongWhiteCandle", "LongBlackCandle")
+ xtsAttributes(result) <- list(bars=1)
return (result)
}
@@ -43,9 +46,10 @@
}
CBL <- CandleBodyLength (TS)
CBLMedian <- runMedian (CBL[,1], n=n) # use relative CandleBodyLength
- ShortWhiteCandleBody <- eval (CBL[,1] < CBLMedian*threshold & Cl(TS) >= Op(TS))
- ShortBlackCandleBody <- eval (CBL[,1] < CBLMedian*threshold & Op(TS) > Cl(TS))
+ ShortWhiteCandleBody <- reclass(eval (CBL[,1] < CBLMedian*threshold & Cl(TS) >= Op(TS)), TS)
+ ShortBlackCandleBody <- reclass(eval (CBL[,1] < CBLMedian*threshold & Op(TS) > Cl(TS)), TS)
result <- cbind (ShortWhiteCandleBody, ShortBlackCandleBody)
colnames (result) <- c("ShortWhiteCandleBody", "ShortBlackCandleBody")
+ xtsAttributes(result) <- list(bars=1)
return (result)
}
Modified: pkg/R/CSPMarubozu.R
===================================================================
--- pkg/R/CSPMarubozu.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPMarubozu.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -3,15 +3,16 @@
stop("Price series must contain Open, High, Low and Close.")
}
LCB <- CSPLongCandleBody(TS, n=n, threshold=threshold)
- WhiteMarubozu <- eval( LCB[,"LongWhiteCandleBody"] & Op(TS)==Lo(TS) & Cl(TS)==Hi(TS) )
- WhiteOpeningMarubozu <- eval( LCB[,"LongWhiteCandleBody"] & Op(TS)==Lo(TS) & Cl(TS)<Hi(TS) )
- WhiteClosingMarubozu <- eval( LCB[,"LongWhiteCandleBody"] & Op(TS)>Lo(TS) & Cl(TS)==Hi(TS) )
- BlackMarubozu <- eval( LCB[,"LongBlackCandleBody"] & Op(TS)==Hi(TS) & Cl(TS)==Lo(TS) )
- BlackOpeningMarubozu <- eval( LCB[,"LongBlackCandleBody"] & Op(TS)==Hi(TS) & Cl(TS)>Lo(TS) )
- BlackClosingMarubozu <- eval( LCB[,"LongBlackCandleBody"] & Op(TS)<Hi(TS) & Cl(TS)==Lo(TS) )
+ WhiteMarubozu <- reclass(eval( LCB[,"LongWhiteCandleBody"] & Op(TS)==Lo(TS) & Cl(TS)==Hi(TS) ), TS)
+ WhiteOpeningMarubozu <- reclass(eval( LCB[,"LongWhiteCandleBody"] & Op(TS)==Lo(TS) & Cl(TS)<Hi(TS) ), TS)
+ WhiteClosingMarubozu <- reclass(eval( LCB[,"LongWhiteCandleBody"] & Op(TS)>Lo(TS) & Cl(TS)==Hi(TS) ), TS)
+ BlackMarubozu <- reclass(eval( LCB[,"LongBlackCandleBody"] & Op(TS)==Hi(TS) & Cl(TS)==Lo(TS) ), TS)
+ BlackOpeningMarubozu <- reclass(eval( LCB[,"LongBlackCandleBody"] & Op(TS)==Hi(TS) & Cl(TS)>Lo(TS) ), TS)
+ BlackClosingMarubozu <- reclass(eval( LCB[,"LongBlackCandleBody"] & Op(TS)<Hi(TS) & Cl(TS)==Lo(TS) ), TS)
result <- cbind(WhiteMarubozu, WhiteOpeningMarubozu, WhiteClosingMarubozu,
BlackMarubozu, BlackOpeningMarubozu, BlackClosingMarubozu)
colnames(result) <- c("WhiteMarubozu", "WhiteOpeningMarubozu", "WhiteClosingMarubozu",
"BlackMarubozu", "BlackOpeningMarubozu", "BlackClosingMarubozu")
+ xtsAttributes(result) <- list(bars=1)
return(result)
}
\ No newline at end of file
Added: pkg/R/CSPNBlended.R
===================================================================
--- pkg/R/CSPNBlended.R (rev 0)
+++ pkg/R/CSPNBlended.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -0,0 +1,21 @@
+CSPNBlended <- function (TS, N) {
+ if (!is.OHLC(TS)) {
+ stop("Price series must contain Open, High, Low and Close.")
+ }
+
+ if (N<1) {
+ stop("N has to be a integer >= 1")
+ }
+
+ LAGTS <- LagOHLC(TS,k=0:(N-1))
+ OP <- Op(LAGTS)[,N]
+ HI <- reclass(as.xts(apply(Hi(LAGTS),1,max)), TS)
+ LO <- reclass(as.xts(apply(Lo(LAGTS),1,min)), TS)
+ CL <- Cl(LAGTS)[,1]
+ result <- cbind(OP,HI,LO,CL)
+ colnames(result) <- c(paste(N, ".Blended.Open", sep=""),
+ paste(N, ".Blended.High", sep=""),
+ paste(N, ".Blended.Low", sep=""),
+ paste(N, ".Blended.Close", sep=""))
+ return (result)
+}
\ No newline at end of file
Modified: pkg/R/CSPNHigherClose.R
===================================================================
--- pkg/R/CSPNHigherClose.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPNHigherClose.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -6,13 +6,14 @@
stop("N has to be a integer >= 1")
}
LAGTS <- LagOC(TS,k=0:N)
- result <- eval (Cl(LAGTS)[,1] > Cl(LAGTS)[,2])
+ result <- reclass(eval (Cl(LAGTS)[,1] > Cl(LAGTS)[,2]), TS)
i <- 2
while (i < N+1) {
- result <- eval (result & (Cl(LAGTS)[,i] > Cl(LAGTS)[,(i+1)]))
+ result <- reclass(eval (result & (Cl(LAGTS)[,i] > Cl(LAGTS)[,(i+1)])), TS)
i <- i+1
}
colnames(result) <- paste(N, "HigherClose", sep="")
+ xtsAttributes(result) <- list(bars=N)
return (result)
}
@@ -24,12 +25,13 @@
stop("N has to be a integer >= 1")
}
LAGTS <- LagOC(TS,k=0:N)
- result <- eval (Cl(LAGTS)[,1] < Cl(LAGTS)[,2])
+ result <- reclass(eval (Cl(LAGTS)[,1] < Cl(LAGTS)[,2]), TS)
i <- 2
while (i < N+1) {
- result <- eval (result & (Cl(LAGTS)[,i] < Cl(LAGTS)[,(i+1)]))
+ result <- reclass(eval (result & (Cl(LAGTS)[,i] < Cl(LAGTS)[,(i+1)])), TS)
i <- i+1
}
colnames(result) <- paste(N, "LowerClose", sep="")
+ xtsAttributes(result) <- list(bars=N)
return (result)
}
\ No newline at end of file
Modified: pkg/R/CSPNLongCandles.R
===================================================================
--- pkg/R/CSPNLongCandles.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPNLongCandles.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -6,8 +6,9 @@
stop("N has to be a integer >= 1")
}
LWC <- CSPLongCandle(TS, n=n, threshold=threshold)[,1] # LongWhiteCandle
- result <- as.xts(apply(lag(LWC,k=0:(N-1)),1,all))
+ result <- reclass(as.xts(apply(lag(LWC,k=0:(N-1)),1,all)), TS)
colnames(result) <- paste(N, "LongWhiteCandles", sep="")
+ xtsAttributes(result) <- list(bars=N)
return (result)
}
@@ -19,8 +20,9 @@
stop("N has to be a integer >= 1")
}
LBC <- CSPLongCandle(TS, n=n, threshold=threshold)[,2] # LongBlackCandle
- result <- as.xts(apply(lag(LBC,k=0:(N-1)),1,all))
+ result <- reclass(as.xts(apply(lag(LBC,k=0:(N-1)),1,all)), TS)
colnames(result) <- paste(N, "LongBlackCandles", sep="")
+ xtsAttributes(result) <- list(bars=N)
return (result)
}
@@ -32,8 +34,9 @@
stop("N has to be a integer >= 1")
}
LWCB <- CSPLongCandleBody(TS, n=n, threshold=threshold)[,1] # LongWhiteCandleBody
- result <- as.xts(apply(lag(LWCB,k=0:(N-1)),1,all))
+ result <- reclass(as.xts(apply(lag(LWCB,k=0:(N-1)),1,all)), TS)
colnames(result) <- paste(N, "LongWhiteCandleBodies", sep="")
+ xtsAttributes(result) <- list(bars=N)
return (result)
}
@@ -45,7 +48,8 @@
stop("N has to be a integer >= 1")
}
LBCB <- CSPLongCandleBody(TS, n=n, threshold=threshold)[,2] # LongBlackCandleBody
- result <- as.xts(apply(lag(LBCB,k=0:(N-1)),1,all))
+ result <- reclass(as.xts(apply(lag(LBCB,k=0:(N-1)),1,all)), TS)
colnames(result) <- paste(N, "LongBlackCandleBodies", sep="")
+ xtsAttributes(result) <- list(bars=N)
return (result)
}
Modified: pkg/R/CSPPiercingPattern.R
===================================================================
--- pkg/R/CSPPiercingPattern.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPPiercingPattern.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -3,10 +3,11 @@
stop("Price series must contain Open and Close.")
}
LAGTS <- LagOC(TS, k=1)
- PiercingPattern <- eval (
+ PiercingPattern <- reclass(eval (
Op(LAGTS)>Cl(LAGTS) & Cl(TS)>Op(TS)
& Cl(LAGTS)>Op(TS) & Cl(TS)>(Op(LAGTS)+Cl(LAGTS))/2
- & Op(LAGTS)>Cl(TS) )
+ & Op(LAGTS)>Cl(TS) ), TS)
colnames(PiercingPattern) <- c("PiercingPattern")
+ xtsAttributes(PiercingPattern) <- list(bars=2)
return(PiercingPattern)
}
\ No newline at end of file
Modified: pkg/R/CSPStar.R
===================================================================
--- pkg/R/CSPStar.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPStar.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -7,15 +7,20 @@
LCB2 <- CSPLongCandleBody (LAG2TS, n=n, threshold=lthreshold)
GAP1 <- CSPGap(LAG1TS, ignoreShadows=TRUE)
SCB1 <- CSPShortCandleBody (LAG1TS, n=n, threshold=sthreshold)
- MorningStar <- eval(LCB2[,2] & # 1st candle: long black candle body
+ MorningStar <- reclass(
+ eval(LCB2[,2] & # 1st candle: long black candle body
GAP1[,2] & # gap down from 1st to 2nd candle
(SCB1[,1] | SCB1[,2]) & # 2nd candle: short black or white candle body
- Cl(TS) > (Op(LAG2TS)+Cl(LAG2TS))/2) # 3rd candle closes above middle of 1st candle body
- EveningStar <- eval(LCB2[,1] & # 1st candle: long white candle body
+ Cl(TS) > (Op(LAG2TS)+Cl(LAG2TS))/2), # 3rd candle closes above middle of 1st candle body
+ TS)
+ EveningStar <- reclass(
+ eval(LCB2[,1] & # 1st candle: long white candle body
GAP1[,1] & # gap up from 1st to 2nd candle
(SCB1[,1] | SCB1[,2]) & # 2nd candle: short black or white candle body
- Cl(TS) < (Op(LAG2TS)+Cl(LAG2TS))/2) # 3rd candle closes below middle of 1st candle body
+ Cl(TS) < (Op(LAG2TS)+Cl(LAG2TS))/2), # 3rd candle closes below middle of 1st candle body
+ TS)
result <- cbind(MorningStar, EveningStar)
colnames(result) <- c("MorningStar", "EveningStar")
+ xtsAttributes(result) <- list(bars=3)
return (result)
}
\ No newline at end of file
Modified: pkg/R/CSPStomache.R
===================================================================
--- pkg/R/CSPStomache.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPStomache.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -3,11 +3,12 @@
stop("Price series must contain Open and Close.")
}
LAGTS <- LagOC(TS, k=1)
- AboveTheStomache <- eval( Op(LAGTS)>Cl(LAGTS) & Cl(TS)>Op(TS)
- & Op(TS)>=((Op(LAGTS)+Cl(LAGTS))/2) )
- BelowTheStomache <- eval( Cl(LAGTS)>Op(LAGTS) & Op(TS)>Cl(TS)
- & ((Op(LAGTS)+Cl(LAGTS))/2>=Op(TS)) )
+ AboveTheStomache <- reclass(eval( Op(LAGTS)>Cl(LAGTS) & Cl(TS)>Op(TS)
+ & Op(TS)>=((Op(LAGTS)+Cl(LAGTS))/2) ), TS)
+ BelowTheStomache <- reclass(eval( Cl(LAGTS)>Op(LAGTS) & Op(TS)>Cl(TS)
+ & ((Op(LAGTS)+Cl(LAGTS))/2>=Op(TS)) ), TS)
result <- cbind(AboveTheStomache, BelowTheStomache)
colnames(result) <- c("AboveTheStomache", "BelowTheStomache")
+ xtsAttributes(result) <- list(bars=2)
return(result)
}
Modified: pkg/R/CSPTasukiGap.R
===================================================================
--- pkg/R/CSPTasukiGap.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPTasukiGap.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -5,17 +5,22 @@
LAG2TS <- LagOHLC(TS, k=2)
LAG1TS <- LagOHLC(TS, k=1)
GAP1 <- CSPGap(LAG1TS, ignoreShadows=FALSE)
- UTG <- eval(Op(LAG2TS) < Cl(LAG2TS) & # 1st candle: white
+ UTG <- reclass(
+ eval(Op(LAG2TS) < Cl(LAG2TS) & # 1st candle: white
GAP1[,1] & # Up Gap btwn 1st and 2nd candle
Op(LAG1TS) < Cl(LAG1TS) & # 2nd candle: white
Op(TS) < Cl(LAG1TS) & Op(TS) > Op(LAG1TS) & # 3rd candle opens within 2nd candle's body
- Cl(TS) < Lo(LAG1TS) & Cl(TS) > Hi(LAG2TS)) # 3rd candle closes within gap of 1st and 2nd candle
- DTG <- eval(Op(LAG2TS) > Cl(LAG2TS) & # 1st candle: black
+ Cl(TS) < Lo(LAG1TS) & Cl(TS) > Hi(LAG2TS)), # 3rd candle closes within gap of 1st and 2nd candle
+ TS)
+ DTG <- reclass(
+ eval(Op(LAG2TS) > Cl(LAG2TS) & # 1st candle: black
GAP1[,2] & # Down Gap btwn 1st and 2nd candle
Op(LAG1TS) > Cl(LAG1TS) & # 2nd candle: black
Op(TS) > Cl(LAG1TS) & Op(TS) < Op(LAG1TS) & # 3rd candle opens within 2nd candle's body
- Cl(TS) > Hi(LAG1TS) & Cl(TS) < Lo(LAG2TS)) # 3rd candle closes within gap of 1st and 2nd candle
+ Cl(TS) > Hi(LAG1TS) & Cl(TS) < Lo(LAG2TS)), # 3rd candle closes within gap of 1st and 2nd candle
+ TS)
result <- cbind(UTG, DTG)
colnames(result) <- c("UpsideTasukiGap", "DownsideTasukiGap")
+ xtsAttributes(result) <- list(bars=3)
return (result)
}
\ No newline at end of file
Modified: pkg/R/CSPThreeInside.R
===================================================================
--- pkg/R/CSPThreeInside.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPThreeInside.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -5,15 +5,20 @@
LAGTS2 <- Lag(Op(TS), k=2) # first candle of formation
LAGTS1 <- LagOHLC(TS, k=1) # second candle
LAGHARAMI <- CSPHarami(LAGTS1)
- TIUP <- eval(LAGHARAMI[,1] & # bullish harami
+ TIUP <- reclass(
+ eval(LAGHARAMI[,1] & # bullish harami
Cl(TS)>Op(TS) & # 3rd candle is white
Cl(TS)>Cl(LAGTS1) & # close of 3rd candle greater than close of 2nd candle
- Cl(TS)>LAGTS2) # close of 3rd candle greater than open of 1st candle
- TIDOWN <- eval(LAGHARAMI[,2] & # bearish harami
+ Cl(TS)>LAGTS2), # close of 3rd candle greater than open of 1st candle
+ TS)
+ TIDOWN <- reclass(
+ eval(LAGHARAMI[,2] & # bearish harami
Cl(TS)<Op(TS) & # 3rd candle is black
Cl(TS)<Cl(LAGTS1) & # close of 3rd candle lower than close of 2nd candle
- Cl(TS)<LAGTS2) # close of 3rd candle lower than open of 1st candle
+ Cl(TS)<LAGTS2), # close of 3rd candle lower than open of 1st candle
+ TS)
result <- cbind(TIUP, TIDOWN)
colnames(result) <- c("ThreeInsideUp", "ThreeInsideDown")
+ xtsAttributes(result) <- list(bars=3)
return(result)
}
\ No newline at end of file
Modified: pkg/R/CSPThreeMethods.R
===================================================================
--- pkg/R/CSPThreeMethods.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPThreeMethods.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -11,23 +11,28 @@
MINCL <- lag(runMin(Cl(TS), n=3), k=1) # min close for middle 3 candles
LC4 <- CSPLongCandleBody(LAG4TS, n=n, threshold=threshold)
LC0 <- CSPLongCandleBody(TS, n=n, threshold=threshold)
- RTM <- eval (LC4[,1] & # 1st candle: long white candle body
+ RTM <- reclass(
+ eval (LC4[,1] & # 1st candle: long white candle body
Op(LAG3TS) > Cl(LAG3TS) & # 2nd candle: black candle
Op(LAG1TS) > Cl(LAG1TS) & # 4th candle: black candle
MAXOP < Hi(LAG4TS) & MAXOP > Lo(LAG4TS) & # candle bodies 2,3,4 within range of 1st candle
MAXCL < Hi(LAG4TS) & MAXCL > Lo(LAG4TS) &
MINOP < Hi(LAG4TS) & MINOP > Lo(LAG4TS) &
MINCL < Hi(LAG4TS) & MINCL > Lo(LAG4TS) &
- LC0[,1] & Cl(TS) > Cl(LAG4TS)) # 5th candle: long white candle body that closes higher than 1st candle
- FTM <- eval (LC4[,2] & # 1st candle: long black candle body
+ LC0[,1] & Cl(TS) > Cl(LAG4TS)),# 5th candle: long white candle body that closes higher than 1st candle
+ TS)
+ FTM <- reclass(
+ eval (LC4[,2] & # 1st candle: long black candle body
Op(LAG3TS) < Cl(LAG3TS) & # 2nd candle: white candle
Op(LAG1TS) < Cl(LAG1TS) & # 4th candle: white candle
MAXOP < Hi(LAG4TS) & MAXOP > Lo(LAG4TS) & # candle bodies 2,3,4 within range of 1st candle
MAXCL < Hi(LAG4TS) & MAXCL > Lo(LAG4TS) &
MINOP < Hi(LAG4TS) & MINOP > Lo(LAG4TS) &
MINCL < Hi(LAG4TS) & MINCL > Lo(LAG4TS) &
- LC0[,2] & Cl(TS) < Cl(LAG4TS)) # 5th candle: long black candle body that closes lower than 1st candle
+ LC0[,2] & Cl(TS) < Cl(LAG4TS)),# 5th candle: long black candle body that closes lower than 1st candle
+ TS)
result <- cbind (RTM, FTM)
colnames (result) <- c("RisingThreeMethods", "FallingThreeMethods")
+ xtsAttributes(result) <- list(bars=5)
return (result)
}
\ No newline at end of file
Modified: pkg/R/CSPThreeOutside.R
===================================================================
--- pkg/R/CSPThreeOutside.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPThreeOutside.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -4,13 +4,14 @@
}
LAGTS1 <- LagOHLC(TS, k=1) # second candle
LAGENGULFING <- CSPEngulfing(LAGTS1)
- TOUP <- eval(LAGENGULFING[,1] & # bullish engulfing
- Cl(TS)>Op(TS) & # 3rd candle is white
- Cl(TS)>Cl(LAGTS1)) # 3rd candle closes above 2nd candle
- TODOWN <- eval(LAGENGULFING[,2] & # bearish engulfing
- Cl(TS)<Op(TS) & # 3rd candle is black
- Cl(TS)<Cl(LAGTS1)) # 3rd candle closes below 2nd candle
+ TOUP <- reclass(eval(LAGENGULFING[,1] & # bullish engulfing
+ Cl(TS)>Op(TS) & # 3rd candle is white
+ Cl(TS)>Cl(LAGTS1)), TS) # 3rd candle closes above 2nd candle
+ TODOWN <- reclass(eval(LAGENGULFING[,2] & # bearish engulfing
+ Cl(TS)<Op(TS) & # 3rd candle is black
+ Cl(TS)<Cl(LAGTS1)), TS) # 3rd candle closes below 2nd candle
result <- cbind(TOUP, TODOWN)
colnames(result) <- c("ThreeOutsideUp", "ThreeOutsideDown")
+ xtsAttributes(result) <- list(bars=3)
return(result)
}
\ No newline at end of file
Modified: pkg/R/CSPThreeWhiteSoldiers.R
===================================================================
--- pkg/R/CSPThreeWhiteSoldiers.R 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/R/CSPThreeWhiteSoldiers.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -4,19 +4,20 @@
}
THREELWCB <- CSPNLongWhiteCandleBodies(TS, N=3, n=n, threshold=threshold)
LAGTS <- LagOC(TS,k=0:2)
- result <- eval(THREELWCB[,1] &
+ result <- reclass(eval(THREELWCB[,1] &
Op(LAGTS)[,1] > Op(LAGTS)[,2] &
Op(LAGTS)[,2] > Op(LAGTS)[,3] &
Cl(LAGTS)[,1] > Cl(LAGTS)[,2] &
- Cl(LAGTS)[,2] > Cl(LAGTS)[,3])
+ Cl(LAGTS)[,2] > Cl(LAGTS)[,3]), TS)
# in strict mode the candles should open within the previous
# candle's body
if (strict==TRUE) {
- result <- eval(result &
+ result <- reclass(eval(result &
Op(LAGTS)[,1] <= Cl(LAGTS)[,2] &
- Op(LAGTS)[,2] <= Cl(LAGTS)[,3])
+ Op(LAGTS)[,2] <= Cl(LAGTS)[,3]), TS)
}
colnames(result) <- c("ThreeWhiteSoldiers")
+ xtsAttributes(result) <- list(bars=3)
return (result)
}
@@ -26,18 +27,19 @@
}
THREELBCB <- CSPNLongBlackCandleBodies(TS, N=3, n=n, threshold=threshold)
LAGTS <- LagOC(TS,k=0:2)
- result <- eval(THREELBCB[,1] &
+ result <- reclass(eval(THREELBCB[,1] &
Op(LAGTS)[,1] < Op(LAGTS)[,2] &
Op(LAGTS)[,2] < Op(LAGTS)[,3] &
Cl(LAGTS)[,1] < Cl(LAGTS)[,2] &
- Cl(LAGTS)[,2] < Cl(LAGTS)[,3])
+ Cl(LAGTS)[,2] < Cl(LAGTS)[,3]), TS)
# in strict mode the candles should open within the previous
# candle's body
if (strict==TRUE) {
- result <- eval(result &
+ result <- reclass(eval(result &
Op(LAGTS)[,1] >= Cl(LAGTS)[,2] &
- Op(LAGTS)[,2] >= Cl(LAGTS)[,3])
+ Op(LAGTS)[,2] >= Cl(LAGTS)[,3]), TS)
}
colnames(result) <- c("ThreeBlackCrows")
+ xtsAttributes(result) <- list(bars=3)
return (result)
}
\ No newline at end of file
Added: pkg/R/addPriceInfo.R
===================================================================
--- pkg/R/addPriceInfo.R (rev 0)
+++ pkg/R/addPriceInfo.R 2012-02-13 15:09:16 UTC (rev 10)
@@ -0,0 +1,17 @@
+addPriceInfo <- function (TS, CSP) {
+ attr <- xtsAttributes(CSP)
+ if (!is.numeric(attr$bars) | attr$bars <1) {
+ stop("invalid xts Attribute 'bars'")
+ }
+
+ multiplicator <- reclass(as.xts(apply(CSP,1,max)), TS)
+ BLEND <- CSPNBlended(TS, N=attr$bars)
+ PINFO <- cbind(BLEND[,1]* multiplicator,
+ BLEND[,2]* multiplicator,
+ BLEND[,3]* multiplicator,
+ BLEND[,4]* multiplicator)
+
+ colnames(PINFO) <- c("Formation.Open", "Formation.High", "Formation.Low", "Formation.Close")
+ result <- cbind(CSP, PINFO)
+ return (result)
+}
\ No newline at end of file
Added: pkg/man/CSPNBlended.Rd
===================================================================
--- pkg/man/CSPNBlended.Rd (rev 0)
+++ pkg/man/CSPNBlended.Rd 2012-02-13 15:09:16 UTC (rev 10)
@@ -0,0 +1,33 @@
+\name{CSPNBlended}
+\alias{CSPNBlended}
+\alias{BlendedCandles}
+\title{Calculate Open/High/Low/Close of N bars}
+\description{This function calculates OHLC prices of a combined candle of N bars.}
+\usage{CSPNBlended(TS, N)}
+\arguments{
+ \item{TS}{xts Time Series containing OHLC prices}
+ \item{N}{number of bars to combine into one bar}
+}
+\details{
+}
+\value{
+A xts object containing the columns:
+ \item{<N>.Blended.Open}{Opening price of the \code{N}-th elapsed candle}
+ \item{<N>.Blended.High}{Highest high of the past \code{N} candles}
+ \item{<N>.Blended.Low}{Lowest low of the past \code{N} candles}
+ \item{<N>.Blended.Close}{Close price of the current candle}
+}
+\author{Andreas Voellenklee}
+\references{
+}
+\note{This function is used by \code{\link{addPriceInfo}} to add price information of detected candlestick patterns}
+\seealso{
+\code{\link{addPriceInfo}}
+}
+\examples{
+\dontrun{
+getSymbols("YHOO", adjust=TRUE)
+CSPNBlended(YHOO, N=3) # combine 3 candles into one
+}
+}
+\keyword{}
\ No newline at end of file
Modified: pkg/man/CSPNLongWhiteCandles.Rd
===================================================================
--- pkg/man/CSPNLongWhiteCandles.Rd 2012-02-10 09:38:58 UTC (rev 9)
+++ pkg/man/CSPNLongWhiteCandles.Rd 2012-02-13 15:09:16 UTC (rev 10)
@@ -20,7 +20,7 @@
}
\details{}
\value{
- A xts object containing the column:
+ A xts object containing the columns:
\item{<N>LongWhiteCandles}{TRUE if current candle is the \code{N}-th consecutive long white candle}
\item{<N>LongBlackCandles}{TRUE if current candle is the \code{N}-th consecutive long black candle}
\item{<N>LongWhiteCandleBodies}{TRUE if current candle is the \code{N}-th consecutive long white candle body}
Added: pkg/man/addPriceInfo.Rd
===================================================================
--- pkg/man/addPriceInfo.Rd (rev 0)
+++ pkg/man/addPriceInfo.Rd 2012-02-13 15:09:16 UTC (rev 10)
@@ -0,0 +1,41 @@
+\name{addPriceInfo}
+\alias{addPriceInfo}
+\title{Add OHLC Information for detected candlestick patterns}
+\description{
+This function returns not only the occurences of candlestick patterns, but also the OHLC price information of the pattern's formation. The OHLC price information is only set on dates when the pattern is detected, and 0 otherwise.
+}
+\usage{addPriceInformation(TS, CSP)}
+\arguments{
+ \item{TS}{xts Time Series containing OHLC prices}
+ \item{CSP}{xts Time Series of detected candlestick patterns, based on TS}
+}
+\details{
+ The xtsAttribute \code{bars} of \code{CSP} is used to calculate the blended candlestick of the formation.
+}
+\value{
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/candlesticks -r 10
More information about the Candlesticks-commits
mailing list