fTrading/ 0000755 0001760 0000144 00000000000 12251714075 012044 5 ustar ripley users fTrading/inst/ 0000755 0001760 0000144 00000000000 12251673346 013026 5 ustar ripley users fTrading/inst/COPYRIGHT.html 0000644 0001760 0000144 00000020411 11370220763 015252 0 ustar ripley users
Rmetrics::COPYRIGHT
Rmetrics
Copyrights
2005-12-18 Built 221.10065
________________________________________________________________________________
Copyrights (C) for
R:
see R's copyright and license file
Version R 2.0.0 claims:
- The stub packages from 1.9.x have been removed.
- All the datasets formerly in packages 'base' and 'stats' have
been moved to a new package 'datasets'.
- Package 'graphics' has been split into 'grDevices' (the graphics
devices shared between base and grid graphics) and 'graphics'
(base graphics).
- Packages must have been re-installed for this version, and
library() will enforce this.
- Package names must now be given exactly in library() and
require(), regardless of whether the underlying file system is
case-sensitive or not.
________________________________________________________________________________
for
Rmetrics:
(C) 1999-2005, Diethelm Wuertz, GPL
Diethelm Wuertz
www.rmetrics.org
info@rmetrics.org
________________________________________________________________________________
for non default loaded basic packages part of R's basic distribution
MASS:
Main Package of Venables and Ripley's MASS.
We assume that MASS is available.
Package 'lqs' has been returned to 'MASS'.
S original by Venables & Ripley.
R port by Brian Ripley .
Earlier work by Kurt Hornik and Albrecht Gebhardt.
methods:
Formally defined methods and classes for R objects, plus other
programming tools, as described in the reference "Programming
with Data" (1998), John M. Chambers, Springer NY.
R Development Core Team.
mgcv:
Routines for GAMs and other generalized ridge regression
with multiple smoothing parameter selection by GCV or UBRE.
Also GAMMs by REML or PQL. Includes a gam() function.
Simon Wood
nnet:
Feed-forward Neural Networks and Multinomial Log-Linear Models
Original by Venables & Ripley.
R port by Brian Ripley .
Earlier work by Kurt Hornik and Albrecht Gebhardt.
________________________________________________________________________________
for the code partly included as builtin functions from other R ports:
fBasics:CDHSC.F
GRASS program for distributional testing.
By James Darrell McCauley
Original Fortran Source by Paul Johnson EZ006244@ALCOR.UCDAVIS.EDU>
fBasics:nortest
Five omnibus tests for the composite hypothesis of normality
R-port by Juergen Gross
fBasics:SYMSTB.F
Fast numerical approximation to the Symmetric Stable distribution
and density functions.
By Hu McCulloch
fBasics:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fCalendar:date
The tiny C program from Terry Therneau is used
R port by Th. Lumley ,
K. Halvorsen , and
Kurt Hornik
fCalendar:holidays
The holiday information was collected from the internet and
governmental sources obtained from a few dozens of websites
fCalendar:libical
Libical is an Open Source implementation of the IETF's
iCalendar Calendaring and Scheduling protocols. (RFC 2445, 2446,
and 2447). It parses iCal components and provides a C API for
manipulating the component properties, parameters, and subcomponents.
fCalendar:vtimezone
Olsen's VTIMEZONE database consists of data files are released under
the GNU General Public License, in keeping with the license options of
libical.
fSeries:bdstest.c
C Program to compute the BDS Test.
Blake LeBaron
fSeries:fracdiff
R functions, help pages and the Fortran Code for the 'fracdiff'
function are included.
S original by Chris Fraley
R-port by Fritz Leisch
since 2003-12: Martin Maechler
fSeries:lmtest
R functions and help pages for the linear modelling tests are included .
Compiled by Torsten Hothorn ,
Achim Zeileis , and
David Mitchell
fSeries:mda
R functions, help pages and the Fortran Code for the 'mars' function
are implemeted.
S original by Trevor Hastie & Robert Tibshirani,
R port by Friedrich Leisch, Kurt Hornik and Brian D. Ripley
fSeries:modreg
Brian Ripley and the R Core Team
fSeries:polspline
R functions, help pages and the C/Fortran Code for the 'polymars'
function are implemented
Charles Kooperberg
fSeries:systemfit
Simultaneous Equation Estimation Package.
R port by Jeff D. Hamann and
Arne Henningsen
fSeries:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fSeries:UnitrootDistribution:
The program uses the Fortran routine and the tables
from J.G. McKinnon.
fSeries:urca
Unit root and cointegration tests for time series data.
R port by Bernhard Pfaff .
fExtremes:evd
Functions for extreme value distributions.
R port by Alec Stephenson
Function 'fbvpot' by Chris Ferro.
fExtremes:evir
Extreme Values in R
Original S functions (EVIS) by Alexander McNeil
R port by Alec Stephenson
fExtremes:ismev
An Introduction to Statistical Modeling of Extreme Values
Original S functions by Stuart Coles
R port/documentation by Alec Stephenson
fOptions
Option Pricing formulas are implemented along the book and
the Excel spreadsheets of E.G. Haug, "The Complete Guide to Option
Pricing"; documentation is partly taken from www.derivicom.com which
implements a C Library based on Haug. For non-academic and commercial
use we recommend the professional software from "www.derivicom.com".
fOptions:SOBOL.F
ACM Algorithm 659 by P. Bratley and B.L. Fox
Extension on Algorithm 659 by S. Joe and F.Y. Kuo
fOptions:CGAMA.F
Complex gamma and related functions.
Fortran routines by Jianming Jin.
fOptions:CONHYP.F
Confluenet Hypergeometric and related functions.
ACM Algorithm 707 by mark Nardin, W.F. Perger, A. Bhalla
fPortfolio:mvtnorm
Multivariate Normal and T Distribution.
Alan Genz ,
Frank Bretz
R port by Torsten Hothorn
fPortfolio:quadprog
Functions to solve Quadratic Programming Problems.
S original by Berwin A. Turlach
R port by Andreas Weingessel
fPortfolio:sn
The skew-normal and skew-t distributions.
R port by Adelchi Azzalini
fPortfolio:tseries
Functions for time series analysis and computational finance.
Compiled by Adrian Trapletti
fTrading/inst/unitTests/ 0000755 0001760 0000144 00000000000 12251673346 015030 5 ustar ripley users fTrading/inst/unitTests/Makefile 0000644 0001760 0000144 00000000420 11370220763 016454 0 ustar ripley users PKG=fTrading
TOP=../..
SUITE=doRUnit.R
R=R
all: inst test
inst: # Install package -- but where ?? -- will that be in R_LIBS ?
cd ${TOP}/..;\
${R} CMD INSTALL ${PKG}
test: # Run unit tests
export RCMDCHECK=FALSE;\
cd ${TOP}/tests;\
${R} --vanilla --slave < ${SUITE} fTrading/inst/unitTests/runit.RollingAnalysis.R 0000644 0001760 0000144 00000016106 11370220763 021421 0 ustar ripley users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# rollFun Compute Rolling Function Value
# rollMean Compute Rolling Mean
# rollVar Compute Rolling Variance
# rollMin Compute Rolling Minimum
# rollMax Compute Rolling Maximum
################################################################################
test.rollingVector =
function()
{
# Period:
n = 3
# TRIM = TRUE | na.rm = TRUE
trim = TRUE
na.rm = TRUE
x = 1:10
x[6] = NA
cat("\ntrim: ", trim, "\n")
cat("\n\nna.rm: ", na.rm, "\n")
# Sum:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = sum)
print(ans)
# Mean:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
print(ans)
# Var:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = var)
print(ans)
# Min:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = min)
print(ans)
# Max:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = max)
print(ans)
# TRIM = TRUE | na.rm = FALSE
trim = TRUE
na.rm = FALSE
x = 1:10
x[6] = NA
cat("\ntrim: ", trim, "\n")
cat("\n\nna.rm: ", na.rm, "\n")
# Sum:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = sum)
print(ans)
# Mean:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
print(ans)
# Var:
# ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = var)
# print(ans)
# Min:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = min)
print(ans)
# Max:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = max)
print(ans)
# TRIM = FALSE | na.rm = TRUE
trim = FALSE
na.rm = TRUE
x = 1:10
x[6] = NA
cat("\ntrim: ", trim, "\n")
cat("\n\nna.rm: ", na.rm, "\n")
# Sum:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = sum)
print(ans)
# Mean:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
print(ans)
# Var:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = var)
print(ans)
# Min:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = min)
print(ans)
# Max:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = max)
print(ans)
# TRIM = FALSE | na.rm = FALSE
trim = FALSE
na.rm = FALSE
x = 1:10
x[6] = NA
cat("\ntrim: ", trim, "\n")
cat("\n\nna.rm: ", na.rm, "\n")
# Sum:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = sum)
print(ans)
# Mean:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
print(ans)
# Var:
# ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = var)
# print(ans)
# Min:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = min)
print(ans)
# Max:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = max)
print(ans)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.rollingTimeSeries =
function()
{
# Time Series:
charvec = paste("1999", 10, 11:20, sep = "-")
print(charvec)
ts = timeSeries(data = 1:10, charvec, units = "SERIES", zone = "GMT",
FinCenter = "GMT")
print(ts)
# Period:
n = 3
# TRIM = TRUE | na.rm = TRUE
trim = TRUE
na.rm = TRUE
x = ts
series(x)[6] = NA
cat("\ntrim: ", trim, "\n")
cat("\n\nna.rm: ", na.rm, "\n")
# Sum:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = sum)
print(ans)
# Mean:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
print(ans)
# Var:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = var)
print(ans)
# Min:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = min)
print(ans)
# Max:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = max)
print(ans)
# TRIM = TRUE | na.rm = FALSE
trim = TRUE
na.rm = FALSE
x = ts
series(x)[6] = NA
cat("\ntrim: ", trim, "\n")
cat("\n\nna.rm: ", na.rm, "\n")
# Sum:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = sum)
print(ans)
# Mean:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
print(ans)
# Var:
# ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = var)
# print(ans)
# Min:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = min)
print(ans)
# Max:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = max)
print(ans)
# TRIM = FALSE | na.rm = TRUE
trim = FALSE
na.rm = TRUE
x = ts
series(x)[6] = NA
cat("\ntrim: ", trim, "\n")
cat("\n\nna.rm: ", na.rm, "\n")
# Sum:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = sum)
print(ans)
# Mean:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
print(ans)
# Var:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = var)
print(ans)
# Min:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = min)
print(ans)
# Max:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = max)
print(ans)
# TRIM = FALSE | na.rm = FALSE
trim = FALSE
na.rm = FALSE
x = ts
series(x)[6] = NA
cat("\ntrim: ", trim, "\n")
cat("\n\nna.rm: ", na.rm, "\n")
# Sum:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = sum)
print(ans)
# Mean:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
print(ans)
# Var:
# ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = var)
# print(ans)
# Min:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = min)
print(ans)
# Max:
ans = rollFun(x, n = n, trim = trim, na.rm = na.rm, FUN = max)
print(ans)
# Return Value:
return()
}
################################################################################
fTrading/inst/unitTests/runit.TechnicalAnalysis.R 0000644 0001760 0000144 00000031712 11370220763 021705 0 ustar ripley users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: UTILITY FUNCTIONS:
# emaTA Exponential Moving Average
# biasTA EMA-Bias
# medpriceTA Median Price
# typicalpriceTA Typical Price
# wcloseTA Weighted Close Price
# rocTA Rate of Change
# oscTA EMA-Oscillator
# FUNCTION: OSCILLATOR INDICATORS:
# momTA Momentum
# macdTA MACD
# cdsTA MACD Signal Line
# cdoTA MACD Oscillator
# vohlTA High/Low Volatility
# vorTA Volatility Ratio
# FUNCTION: STOCHASTICS INDICATORS:
# stochasticTA Stochastics %K/%D, fast/slow
# fpkTA Fast Percent %K
# fpdTA Fast Percent %D
# spdTA Slow Percent %D
# apdTA Averaged Percent %D
# wprTA Williams Percent %R
# rsiTA Relative Strength Index
# FUNCTION: DESCRIPTION - MORE INDICATORS:
# accelTA Acceleration
# adiTA AD Indicator
# adoscillatorTA AD Oscillator
# bollingerTA Bollinger Bands
# chaikinoTA Chaikin Oscillator
# chaikinvTA Chaikin Volatility
# garmanklassTA Garman-Klass Volatility
# nviTA Negative Volume Index
# obvTA On Balance Volume
# pviTA Positive Volume Index
# pvtrendTA Price-Volume Trend
# williamsadTA Williams AD
# williamsrTA Williams R%
# FUNCTION: SPLUS LIKE MOVING AVERAGES:
# SMA Computes Simple Moving Average
# EWMA Computes Exponentially Weighted Moving Average
# FUNCTION: DESCRIPTION:
# .dailyTA Computes an indicator for technical analysis
# FUNCTION: DESCRIPTION:
# .tradeSignals Computes trade signals from trading positions
# .tradeLengths Computes trade length from trading signals
# .hitRate Computes hit rates from returns and positions
# FUNCTION: DESCRIPTION:
# .emaSlider EMA Slider
################################################################################
test.utilityFunctions =
function()
{
# emaTA - Exponential Moving Average
# biasTA - EMA-Bias
# medpriceTA - Median Price
# typicalpriceTA - Typical Price
# wcloseTA - Weighted Close Price
# rocTA - Rate of Change
# oscTA - EMA-Oscillator
# Data from fEcofin:
X = MSFT
print(head(X))
# Data Records:
x = close = X[, "Close"]
high = X[, "High"]
low = X[, "Low"]
open = X[, "Open"]
volume = X[, "Volume"]
# Exponential Moving Average:
TA = emaTA(x, lambda = 0.1, startup = 0)
dim(TA)
head(TA)
# EMA-Bias:
TA = biasTA(x, lag = 5)
dim(TA)
head(TA)
# Median Price:
TA = medpriceTA(high, low)
dim(TA)
head(TA)
# Typical Price:
TA = typicalpriceTA(high, low, close)
dim(TA)
head(TA)
# Weighted Close Price:
TA = wcloseTA(high, low, close)
dim(TA)
head(TA)
# Rate of Change:
TA = rocTA(x, lag = 5)
dim(TA)
head(TA)
# EMA-Oscillator:
TA = oscTA(x, lag1 = 25, lag2 = 65)
dim(TA)
head(TA)
# Return Value
return()
}
################################################################################
test.oscillatorIndicators =
function()
{
# momTA - Momentum
# macdTA - MACD
# cdsTA - MACD Signal Line
# cdoTA - MACD Oscillator
# vohlTA - High/Low Volatility
# vorTA - Volatility Ratio
# Data from fEcofin:
X = MSFT
print(head(X))
# Data Records:
x = close = X[, "Close"]
high = X[, "High"]
low = X[, "Low"]
open = X[, "Open"]
volume = X[, "Volume"]
# Momentum:
TA = momTA(x, lag = 5)
dim(TA)
head(TA)
# MACD:
TA = macdTA(x, lag1 = 12, lag2 = 26)
dim(TA)
head(TA)
# MACD Signal Line:
TA = cdsTA(x, lag1 = 12, lag2 = 26, lag3 = 9)
dim(TA)
head(TA)
# MACD Oscillator:
TA = cdoTA(x, lag1 = 12, lag2 = 26, lag3 = 9)
dim(TA)
head(TA)
# High/Low Volatility:
TA = vohlTA(high, low)
dim(TA)
head(TA)
# Volatility Ratio:
TA = vorTA(high, low)
dim(TA)
head(TA)
# Return Value:
return()
}
################################################################################
test.stochasticsIndicators =
function()
{
# stochasticTA - Stochastics %K/%D, fast/slow
# fpkTA - Fast Percent %K
# fpdTA - Fast Percent %D
# spdTA - Slow Percent %D
# apdTA - Averaged Percent %D
# wprTA - Williams Percent %R
# rsiTA - Relative Strength Index
# Data from fEcofin:
X = MSFT
print(head(X))
# Data Records:
x = close = X[, "Close"]
high = X[, "High"]
low = X[, "Low"]
open = X[, "Open"]
volume = X[, "Volume"]
# Fast Stochstic:
# Note, returns a 2-colum series as output ...
TA = stochasticTA(close, high, low, lag1 = 5, lag2 = 3, type = "fast")
dim(TA)
head(TA, 10)
# Slow Stochstic:
# Note, returns a 2-colum series as output ...
TA = stochasticTA(close, high, low, lag1 = 5, lag2 = 3, lag3 = 5,
type = "slow")
dim(TA)
head(TA, 10)
# Fast Percent K:
TA = fpkTA(close, high, low, lag = 5)
dim(TA)
head(TA,10)
# Fast Percent D:
TA = fpdTA(close, high, low, lag1 = 5, lag2 = 3)
dim(TA)
head(TA, 10)
# Slow Percent %D
TA = spdTA(close, high, low, lag1 = 5, lag2 = 3, lag3 = 9)
dim(TA)
head(TA, 10)
# Averaged Percent %D
TA = apdTA(close, high, low, lag1 = 5, lag2 = 3, lag3 = 9, lag4 = 9)
dim(TA)
head(TA, 10)
# Williams Percent %R
TA = wprTA(close, high, low, lag = 5)
dim(TA)
head(TA, 10)
# Relative Strength Index
TA = rsiTA(close, lag = 14)
dim(TA)
head(TA, 10)
# Return Value:
return()
}
################################################################################
test.moreIndicators =
function()
{
# accelTA - Acceleration
# adiTA - AD Indicator
# adoscillatorTA - AD Oscillator
# bollingerTA - Bollinger Bands
# chaikinoTA - Chaikin Oscillator
# chaikinvTA - Chaikin Volatility
# garmanklassTA - Garman-Klass Volatility
# nviTA - Negative Volume Index
# obvTA - On Balance Volume
# pviTA - Positive Volume Index
# pvtrendTA - Price-Volume Trend
# williamsadTA - Williams AD
# williamsrTA- Williams R%
# Data from fEcofin:
X = MSFT
print(head(X))
x = close = X[, "Close"]
high = X[, "High"]
low = X[, "Low"]
open = X[, "Open"]
volume = X[, "Volume"]
# Acceleration
TA = accelTA(x, n = 3)
dim(TA)
head(TA, 10)
# AD Indicator
TA = adiTA(high, low, close, volume)
dim(TA)
head(TA, 10)
# AD Oscillator
TA = adoscillatorTA(open, high, low, close)
dim(TA)
head(TA, 10)
# Bollinger Bands
TA = bollingerTA(x, lag = 5, n.sd = 2)
dim(TA)
head(TA, 10)
# Chaikin Oscillator
TA = chaikinoTA(high, low, close, volume, lag1 = 10, lag2 = 3)
dim(TA)
head(TA, 10)
# Chaikin Volatility
TA = chaikinvTA(high, low, lag1 = 5, lag2 = 5)
dim(TA)
head(TA, 10)
# Garman-Klass Volatility
TA = garmanklassTA(open, high, low, close)
dim(TA)
head(TA, 10)
# Negative Volume Index
TA = nviTA(close, volume)
dim(TA)
head(TA, 10)
# On Balance Volume
TA = obvTA(close, volume)
dim(TA)
head(TA, 10)
# Positive Volume Index
TA = pviTA(close, volume)
dim(TA)
head(TA, 10)
# Price-Volume Trend
TA = pvtrendTA(close, volume)
dim(TA)
head(TA, 10)
# Williams AD
TA = williamsadTA(high, low, close)
dim(TA)
head(TA, 10)
# Williams R%
TA = williamsrTA(high, low, close, lag = 5)
dim(TA)
head(TA, 10)
# Return Value:
return()
}
################################################################################
test.splusLikeIndicators =
function()
{
# SMA - Computes Simple Moving Average
# EWMA - Computes Exponentially Weighted Moving Average
# Data from fEcofin:
X = MSFT
print(head(X))
# Data Records:
x = close = X[, "Close"]
high = X[, "High"]
low = X[, "Low"]
open = X[, "Open"]
volume = X[, "Volume"]
# SMA:
TA = SMA(x, n = 5)
dim(TA)
head(TA)
# EMA - Using Decay Length:
TA = EWMA(x, 25)
dim(TA)
head(TA)
# EMA - Using lambda:
TA = EWMA(x, 2/(25+1))
dim(TA)
head(TA)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.dailyTA =
function()
{
# .dailyTA
# Computes an indicator for technical analysis
# Data from fEcofin:
X = MSFT
print(head(X))
# EMA - Daily TA:
TA = .dailyTA(X, "ema", select = "Close", lag = 5)
head(TA)
# MACD - Daily TA:
TA = .dailyTA(X, "macd", select = "Close", lag = c(lag1 = 12, lag2 = 26))
head(TA)
# ...
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.tradingFunctions =
function()
{
# .tradeSignals - Computes trade signals from trading positions
# .tradeLengths - Computes trade length from trading signals
# .hitRate - Computes hit rates from returns and positions
# Positions:
long = +1
short = -1
neutral = 0
tradePositions = c(+1, +1, +1, -1, -1, +1, +1, -1, +1, +1, +1, -1)
tradeReturns = rnorm(12)
# Compute Trade Signals:
Positions = timeSeries(tradePositions, timeCalendar(), units = "Position")
Positions
tradeSignals = .tradeSignals(Positions)
tradeSignals
# Compute Trade Lengths:
tradeLengths = .tradeLengths(tradeSignals)
tradeLengths
# Compute Hit Rates:
.hitRate(tradeReturns, tradePositions)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.emaSlider =
function()
{
.emaSlider =
function(x)
{ # A function implemented by Diethelm Wuertz
# Description
# Displays the selected technical indicator
# FUNCTION:
# Internal Function:
refresh.code = function(...)
{
# Sliders:
lambda1 = .sliderMenu(no = 1)
lambda2 = .sliderMenu(no = 2)
startup = .sliderMenu(no = 3)
# Compute Data:
seriesPlot(x)
ema1 = emaTA(x, lambda1, startup)
N1 = ceiling(2/lambda1)-1
lines(ema1, col = "red")
ema2 = emaTA(x, lambda2, startup)
N2 = ceiling(2/lambda2)-1
lines(ema2, col = "green")
mText = paste("EMA1 =", N1, "|", "EMA2 =", N2)
mtext(mText, side = 4, adj = 0, cex = 0.7, col = "grey")
# Difference:
seriesPlot(ema2-ema1, type = "h")
lines(ema2-ema1, col = "red")
# Reset Frame:
par(mfrow = c(2, 1), cex = 0.7)
}
# Open Slider Menu:
N = min(10, dim(x)[1])
print(N)
.sliderMenu(refresh.code,
names = c( "lamda1", "lamda2", "startup" ),
minima = c( 0.01, 0.01, 0 ),
maxima = c( 0.99, 0.99, N ),
resolutions = c( 0.01, 0.01, 1 ),
starts = c( 0.10, 0.25, 0 ))
}
# Chart:
# .emaSlider(tS)
NA
# Return Value:
return()
}
################################################################################
fTrading/inst/unitTests/runTests.R 0000644 0001760 0000144 00000004530 11370220763 016774 0 ustar ripley users pkg <- "fTrading"
if(require("RUnit", quietly = TRUE))
{
library(package=pkg, character.only = TRUE)
if(!(exists("path") && file.exists(path)))
path <- system.file("unitTests", package = pkg)
## --- Testing ---
## Define tests
testSuite <- defineTestSuite(name = paste(pkg, "unit testing"),
dirs = path)
if(interactive()) {
cat("Now have RUnit Test Suite 'testSuite' for package '",
pkg, "' :\n", sep='')
str(testSuite)
cat('', "Consider doing",
"\t tests <- runTestSuite(testSuite)", "\nand later",
"\t printTextProtocol(tests)", '', sep = "\n")
} else {
## run from shell / Rscript / R CMD Batch / ...
## Run
tests <- runTestSuite(testSuite)
if(file.access(path, 02) != 0) {
## cannot write to path -> use writable one
tdir <- tempfile(paste(pkg, "unitTests", sep="_"))
dir.create(tdir)
pathReport <- file.path(tdir, "report")
cat("RUnit reports are written into ", tdir, "/report.(txt|html)",
sep = "")
} else {
pathReport <- file.path(path, "report")
}
## Print Results:
printTextProtocol(tests, showDetails = FALSE)
printTextProtocol(tests, showDetails = FALSE,
fileName = paste(pathReport, "Summary.txt", sep = ""))
printTextProtocol(tests, showDetails = TRUE,
fileName = paste(pathReport, ".txt", sep = ""))
## Print HTML Version to a File:
## printHTMLProtocol has problems on Mac OS X
if (Sys.info()["sysname"] != "Darwin")
printHTMLProtocol(tests,
fileName = paste(pathReport, ".html", sep = ""))
## stop() if there are any failures i.e. FALSE to unit test.
## This will cause R CMD check to return error and stop
tmp <- getErrors(tests)
if(tmp$nFail > 0 | tmp$nErr > 0) {
stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail,
", R errors: ", tmp$nErr, ")\n\n", sep=""))
}
}
} else {
cat("R package 'RUnit' cannot be loaded -- no unit tests run\n",
"for package", pkg,"\n")
}
################################################################################
fTrading/inst/unitTests/runit.BenchmarkAnalysis.R 0000644 0001760 0000144 00000007523 11370220763 021710 0 ustar ripley users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: BENCHMARK ANALYSIS FUNCTIONS:
# getReturns Computes return series given a price series
# FUNCTION: DRAWDOWNS:
# maxDrawDown Computes the maximum drawdown
# FUNCTION: PERFORMANCE RATIOS:
# sharpeRatio Calculates the Sharpe Ratio
# sterlingRatio Calculates the Sterling Ratio
# FUNCTION: OHLC PLOT:
# ohlcPlot Creates a Open-High-Low-Close plot
################################################################################
test.getReturns =
function()
{
# getReturns - Computes return series given a price series
# Data from fEcofin:
X = MSFT
print(head(X))
# Get Returns:
R = getReturns(X)
head(R)
# Get Returns:
R = getReturns(X, percentage = TRUE)
head(R)
# Return Value:
return()
}
################################################################################
test.maxDrawDown =
function()
{
# maxDrawDown - Computes the maximum drawdown
# Data from fEcofin:
X = MSFT
print(head(X))
# Closing Prices:
Close = as.timeSeries(X)[, "Close"]
# Maximum Draw Down:
maxDrawDown(Close)
# Plot:
plot(Close, type = "l")
abline(v = as.POSIXct("2000-11-09"), lty = 3, col = "red")
abline(v = as.POSIXct("2000-12-20"), lty = 3, col = "red")
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.sharpeRatio =
function()
{
# sharpeRatio - Calculates the Sharpe Ratio
# Data from fEcofin:
X = MSFT
print(head(X))
# Get Returns:
R = getReturns(X)
# Sharpe Ratio:
sharpeRatio(R[, "Close"])
# Return Value:
return()
}
################################################################################
test.sterlingRatio =
function()
{
# sterlingRatio - Calculates the Sterling Ratio
# Data from fEcofin:
X = MSFT
print(head(X))
# Get Returns:
R = getReturns(X)
# Sterling Ratio:
sterlingRatio(R[, "Close"])
# Return Value:
return()
}
################################################################################
test.ohlcPlot =
function()
{
# ohlcPlot - Creates a Open-High-Low-Close plot
# Data from fEcofin:
myFinCenter <<- "GMT"
X = MSFT
print(head(X))
# Get Returns:
R = returns(X)[, -5]
Y = alignDailySeries(X, method = "fillNA", include.weekends = TRUE)
# Plot:
# ohlcPlot(as.ts(R)) # CHECK !!!
# Return Value:
return()
}
################################################################################
fTrading/tests/ 0000755 0001760 0000144 00000000000 12251673346 013213 5 ustar ripley users fTrading/tests/doRUnit.R 0000644 0001760 0000144 00000001642 11370220763 014715 0 ustar ripley users #### doRUnit.R --- Run RUnit tests
####------------------------------------------------------------------------
### Origianlly follows Gregor Gojanc's example in CRAN package 'gdata'
### and the corresponding section in the R Wiki:
### http://wiki.r-project.org/rwiki/doku.php?id=developers:runit
### MM: Vastly changed: This should also be "runnable" for *installed*
## package which has no ./tests/
## ----> put the bulk of the code e.g. in ../inst/unitTests/runTests.R :
if(require("RUnit", quietly = TRUE)) {
## --- Setup ---
wd <- getwd()
pkg <- sub("\\.Rcheck$", '', basename(dirname(wd)))
library(package=pkg, character.only = TRUE)
path <- system.file("unitTests", package = pkg)
stopifnot(file.exists(path), file.info(path.expand(path))$isdir)
source(file.path(path, "runTests.R"), echo = TRUE)
}
################################################################################
fTrading/NAMESPACE 0000644 0001760 0000144 00000002627 12251706560 013272 0 ustar ripley users
################################################
## Note this file has been automatically
## generated --- Do not edit it.
################################################
################################################
## import name space
################################################
import("methods")
import("timeDate")
import("timeSeries")
import("fBasics")
################################################
## S4 classes
################################################
################################################
## S3 classes
################################################
################################################
## functions
################################################
export(
".dailyTA",
".hitRate",
".tradeLengths",
".tradeSignals",
"EWMA",
"SMA",
"accelTA",
"adiTA",
"adoscillatorTA",
"apdTA",
"biasTA",
"bollingerTA",
"cdoTA",
"cdsTA",
"chaikinoTA",
"chaikinvTA",
"emaTA",
"fpdTA",
"fpkTA",
"garmanklassTA",
"macdTA",
"maxDrawDown",
"medpriceTA",
"momTA",
"nviTA",
"obvTA",
"ohlcPlot",
"oscTA",
"pviTA",
"pvtrendTA",
"rocTA",
"rollFun",
"rollVar",
"rsiTA",
"sharpeRatio",
"spdTA",
"sterlingRatio",
"stochasticTA",
"typicalpriceTA",
"vohlTA",
"vorTA",
"wcloseTA",
"williamsadTA",
"williamsrTA",
"wprTA" )
fTrading/R/ 0000755 0001760 0000144 00000000000 12251706543 012246 5 ustar ripley users fTrading/R/rollFun.R 0000644 0001760 0000144 00000013607 12251706525 014021 0 ustar ripley users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DESCRIPTION:
# rollFun Compute Rolling Function Value
# rollMean Compute Rolling Mean
# rollVar Compute Rolling Variance
# rollMin Compute Rolling Minimum
# rollMax Compute Rolling Maximum
################################################################################
rollFun =
function(x, n, trim = TRUE, na.rm = FALSE, FUN, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Compute rolling function value
# Arguments:
# x - an univariate "timeSeries" object or a numeric vector.
# n - an integer specifying the number of periods or
# terms to use in each rolling/moving sample.
# trim - a logical flag: if TRUE, the first n-1 missing values in
# the returned object will be removed; if FALSE, they will
# be saved in the returned object. The default is TRUE.
# na.rm - a logical flag: if TRUE, missing values in x will be
# removed before computation. The default is FALSE.
# FUN - the rolling function, arguments to this function can be
# passed through the \code{\dots} argument.
# FUNCTION:
# Transform:
x.orig = x
if (is.timeSeries(x)) {
stopifnot(isUnivariate(x))
TS = TRUE
} else {
TS = FALSE
}
if (TS) {
positions = x.orig@positions
x = series(x.orig)[, 1]
} else {
x = as.vector(x.orig)
names(x) = NULL
}
# Remove NAs:
if (na.rm) {
if (TS) positions = positions[!is.na(x)]
x = as.vector(na.omit(x))
}
# Roll FUN:
start = 1
end = length(x)-n+1
m = x[start:end]
if (n > 1) {
for (i in 2:n) {
start = start + 1
end = end + 1
m = cbind(m, x[start:end])
}
} else {
m = matrix(m)
}
# Result:
ans = apply(m, MARGIN = 1, FUN = FUN, ...)
# Trim:
if (!trim)
ans = c(rep(NA, (n-1)), ans)
if (trim & TS)
positions = positions[-(1:(n-1))]
# Back to timeSeries:
if (TS) {
ans = timeSeries(as.matrix(ans), positions, recordIDs = data.frame(),
units = x.orig@units, FinCenter = x.orig@FinCenter)
}
# Return Value:
ans
}
# ------------------------------------------------------------------------------
## rollMean =
## function(x, n = 9, trim = TRUE, na.rm = FALSE)
## { # A function implemented by Diethelm Wuertz
## # Description:
## # Compute rolling mean
## # Examples:
## #
## # x = timeSeries(as.matrix(cumsum(rnorm(12))), timeCalendar(),
## # units = "rnorm",FinCenter = "GMT")
## # rollMean(x, n = 4, trim = FALSE, na.rm = FALSE)
## # rollMean(x, n = 4, trim = TRUE, na.rm = FALSE)
## #
## # series(x)[8, ] = NA
## # rollMean(x, n = 4, trim = FALSE, na.rm = FALSE)
## # rollMean(x, n = 4, trim = FALSE, na.rm = TRUE)
## # rollMean(x, n = 4, trim = TRUE, na.rm = TRUE)
## # FUNCTION:
## # Roll Mean:
## rmean = rollFun(x = x, n = n, trim = trim, na.rm = na.rm, FUN = mean)
## # Return Value:
## rmean
## }
# ------------------------------------------------------------------------------
rollVar =
function(x, n = 9, trim = TRUE, unbiased = TRUE, na.rm = FALSE)
{ # A function implemented by Diethelm Wuertz
# Description:
# Compute rolling variance
# FUNCTION:
# Handle Time Series:
if (is.timeSeries(x)) TS = TRUE else TS = FALSE
# Roll Var:
rvar = rollFun(x = x, n = n, trim = trim, na.rm = na.rm, FUN = var)
# Unbiased ?
if (!unbiased) {
if (TS) {
series(rvar) = (series(rvar) * (n-1))/n
} else {
rvar = (rvar * (n-1))/n
}
}
# Return Value:
rvar
}
# ------------------------------------------------------------------------------
## rollMax =
## function(x, n = 9, trim = TRUE, na.rm = FALSE)
## { # A function implemented by Diethelm Wuertz
## # Description:
## # Compute rolling maximum
## # FUNCTION:
## # Roll Max:
## rmax = rollFun(x = x, n = n, trim = trim, na.rm = na.rm, FUN = max)
## # Return Value:
## rmax
## }
## # ------------------------------------------------------------------------------
## rollMin =
## function(x, n = 9, trim = TRUE, na.rm = FALSE)
## { # A function implemented by Diethelm Wuertz
## # Description:
## # Compute rolling function minimum
## # FUNCTION:
## # Roll Min:
## rmin = rollFun(x = x, n = n, trim = trim, na.rm = na.rm, FUN = min)
## # Return Value:
## rmin
## }
################################################################################
fTrading/R/BenchmarkAnalysis.R 0000644 0001760 0000144 00000014367 12157313045 015776 0 ustar ripley users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: DRAWDOWNS:
# maxDrawDown Computes the maximum drawdown
# FUNCTION: PERFORMANCE RATIOS:
# sharpeRatio Calculates the Sharpe Ratio
# sterlingRatio Calculates the Sterling Ratio
# FUNCTION: OHLC PLOT:
# ohlcPlot Creates a Open-High-Low-Close plot
################################################################################
maxDrawDown =
function(x)
{ # A function implemented by Diethelm Wuertz
# Description:
# Computes the maximum drawdown
# FUNCTION:
# Check for timeSeries Object:
TS = is.timeSeries(x)
if (TS) {
positions = x@positions
x = series(x)
x = removeNA(x)
}
# Check for Univariate Series:
if (NCOL(x) > 1) {
stop("x is not a vector or univariate timeSeries")
}
# Check for NAs:
if(any(is.na(x))) {
stop("NAs in x")
}
# Maximum Drawdown:
cmaxx = cummax(x)-x
mdd = max(cmaxx)
to = which(mdd == cmaxx)
from = double(NROW(to))
for (i in 1:NROW(to))
from[i] = max(which(cmaxx[1:to[i]] == 0))
# For time Series objects:
if (TS) {
from = positions[from]
to = positions[to]
}
# Result:
ans = list(maxdrawdown = mdd, from = from, to = to)
# Return Value:
ans
}
# ------------------------------------------------------------------------------
sharpeRatio =
function(x, r = 0, scale = sqrt(250))
{ # A function implemented by Diethelm Wuertz
# Notes:
# A copy from A. Traplettis "tseries" package
#
# YC 2008-04-14 : changed to Sharpe's 1994 revision
# the risk free rate changes with time.
# from
# return(scale * (mean(y)-r)/sd(y))
# to
# return(scale * mean(y-r)/sd(y))
# FUNCTION:
# Check for timeSeries Object:
if (is.timeSeries(x)) x = removeNA(series(x))
# Check for Univariate Series:
if (NCOL(x) > 1) stop("x is not a vector or univariate time series")
# Check for NAs:
if(any(is.na(x))) stop("NAs in x")
# Sharpe Ratio:
if (NROW(x) == 1) {
return(NA)
} else {
y = diff(x) # YC : ok if x is given to function as x = log(price)
return(scale * mean(y-r)/sd(y))
}
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
sterlingRatio =
function(x)
{ # A function implemented by Diethelm Wuertz
# Notes:
# A copy from A. Traplettis "tseries" package
# FUNCTION:
# Check for timeSeries Object:
TS = is.timeSeries(x)
if (TS) {
Unit = x@units
x = series(x)
x = removeNA(x)
}
# Check for Univariate Series:
if(NCOL(x) > 1) stop("x is not a vector or univariate time series")
# Check for NAs:
if(any(is.na(x))) stop("NAs in x")
# Sterling Ratio:
if (NROW(x) == 1) {
return(NA)
} else {
ans = (x[NROW(x)]-x[1]) / maxDrawDown(x)$maxdrawdown
if (TS) names(ans) = Unit
return(ans)
}
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
ohlcPlot =
function(x, xlim = NULL, ylim = NULL, xlab = "Time", ylab, col = par("col"),
bg = par("bg"), axes = TRUE, frame.plot = axes, ann = par("ann"), main = NULL,
date = c("calendar", "julian"), format = "%Y-%m-%d",
origin = "1899-12-30", ...)
{ # A function implemented by Diethelm Wuertz
# Notes:
# A copy from A. Traplettis 'tseries' package
# FUNCTION:
# Checks:
if ((!is.mts(x)) || (colnames(x)[1] != "Open") ||
(colnames(x)[2] != "High") || (colnames(x)[3] != "Low") ||
(colnames(x)[4] != "Close"))
stop("x is not a open/high/low/close time series")
xlabel = if (!missing(x)) deparse(substitute(x)) else NULL
if (missing(ylab)) ylab = xlabel
date = match.arg(date)
time.x = time(x)
dt = min(lag(time.x)-time.x)/3
ylim = c(min(x, na.rm = TRUE), max(x, na.rm = TRUE))
if (is.null(xlim)) xlim = range(time.x)
if (is.null(ylim)) ylim = range(x[is.finite(x)])
plot.new()
plot.window(xlim, ylim, ...)
for (i in 1:NROW(x)) {
segments(time.x[i], x[i,"High"], time.x[i], x[i,"Low"],
col = col[1], bg = bg)
segments(time.x[i] - dt, x[i,"Open"], time.x[i], x[i,"Open"],
col = col[1], bg = bg)
segments(time.x[i], x[i,"Close"], time.x[i] + dt, x[i,"Close"],
col = col[1], bg = bg)
}
if (ann) title(main = main, xlab = xlab, ylab = ylab, ...)
if (axes) {
if (date == "julian") {
axis(1, ...)
axis(2, ...)
} else {
n = NROW(x)
lab.ind = round(seq(1, n, length=5))
D = as.vector(time.x[lab.ind]*86400) +
as.POSIXct(origin, tz = "GMT")
DD = format.POSIXct(D, format = format, tz ="GMT")
axis(1, at=time.x[lab.ind], labels = DD, ...)
axis(2, ...)
}
}
if (frame.plot) box(...)
}
################################################################################
fTrading/R/TechnicalAnalysis.R 0000644 0001760 0000144 00000101545 12251706543 015775 0 ustar ripley users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2007, Diethelm Wuertz, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
# FUNCTION: UTILITY FUNCTIONS:
# emaTA Exponential Moving Average
# biasTA EMA-Bias
# medpriceTA Median Price
# typicalpriceTA Typical Price
# wcloseTA Weighted Close Price
# rocTA Rate of Change
# oscTA EMA-Oscillator
# FUNCTION: OSCILLATOR INDICATORS:
# momTA Momentum
# macdTA MACD
# cdsTA MACD Signal Line
# cdoTA MACD Oscillator
# vohlTA High/Low Volatility
# vorTA Volatility Ratio
# FUNCTION: STOCHASTICS INDICATORS:
# stochasticTA Stochastics %K/%D, fast/slow
# fpkTA Fast Percent %K
# fpdTA Fast Percent %D
# spdTA Slow Percent %D
# apdTA Averaged Percent %D
# wprTA Williams Percent %R
# rsiTA Relative Strength Index
# FUNCTION: DESCRIPTION - MORE INDICATORS:
# accelTA Acceleration
# adiTA AD Indicator
# adoscillatorTA AD Oscillator
# bollingerTA Bollinger Bands
# chaikinoTA Chaikin Oscillator
# chaikinvTA Chaikin Volatility
# garmanklassTA Garman-Klass Volatility
# nviTA Negative Volume Index
# obvTA On Balance Volume
# pviTA Positive Volume Index
# pvtrendTA Price-Volume Trend
# williamsadTA Williams AD
# williamsrTA Williams R%
# FUNCTION: SPLUS LIKE MOVING AVERAGES:
# SMA Computes Simple Moving Average
# EWMA Computes Exponentially Weighted Moving Average
# FUNCTION: DESCRIPTION:
# .dailyTA Computes an indicator for technical analysis
# FUNCTION: DESCRIPTION:
# .tradeSignals Computes trade signals from trading positions
# .tradeLengths Computes trade length from trading signals
# .hitRate Computes hit rates from returns and positions
################################################################################
# Notations / Data - Prices, Volume, OpenInterest:
# O Open H High
# L Low C Close
# V Volume X one of O H, L, C, V
# ------------------------------------------------------------------------------
emaTA =
function(x, lambda = 0.1, startup = 0)
{ # A function written by Diethelm Wuertz
# Description:
# Returns the Exponential Moving Average Indicator
# Details:
# EXPONENTIAL MOVING AVERAGE:
# EMA: EMA(n) = lambda * X(n) + (1-lambda) * EMA(n-1)
# lambda = 2 / ( n+1 )
# Example:
# head(emaTA(MSFT[, "Close"]))
# FUNCTION:
# Preprocessing:
TS = is.timeSeries(x)
y = as.vector(x)
# EMA:
if (lambda >= 1) lambda = 2/(lambda+1)
if (startup == 0) startup = floor(2/lambda)
if (lambda == 0){
ema = rep (mean(x),length(x))}
if (lambda > 0){
ylam = y * lambda
ylam[1] = mean(y[1:startup])
ema = filter(ylam, filter = (1-lambda), method = "rec")}
ema = as.vector(ema)
# Convert to timeSeries object:
if (TS) {
ema = matrix(ema)
colnames(ema) = "EMA"
rownames(ema) = rownames(x)
series(x) = ema
} else {
x = ema
}
# Return Value:
x
}
# ------------------------------------------------------------------------------
biasTA =
function(x, lag = 5)
{ # A function written by Diethelm Wuertz
# Description:
# Returns the Bias Indiacator
# Example:
# head(biasTA(MSFT[, "Close"]))
# head(biasTA(rnorm(30)))
# Details:
# BIAS: (X - EMA) / EMA
# FUNCTION:
# BIAS:
xema = emaTA(x, lag)
bias = (x - xema)/xema
if (is.timeSeries(bias)) colnames(bias)<-"BIAS"
# Return Value:
bias
}
# ------------------------------------------------------------------------------
medpriceTA =
function(high, low)
{ # A function written by Diethelm Wuertz
# Description:
# Returns the Middle Price Indicator
# Example:
# head(medpriceTA(MSFT[, "High"], MSFT[, "Low"]))
# head(medpriceTA(rnorm(30), rnorm(30)))
# FUNCTION:
# MEDPRICE:
medprice = (high + low) / 2
if (is.timeSeries(medprice)) colnames(medprice)<-"MEDPRICE"
# Return Value:
medprice
}
# ------------------------------------------------------------------------------
typicalpriceTA =
function(high, low, close)
{ # A function written by Diethelm Wuertz
# Description:
# Returns the Typical Price Indicator
# Example:
# head(typicalpriceTA(MSFT[, "High"], MSFT[, "Low"], MSFT[, "Close"]))
# head(typicalpriceTA(rnorm(30), rnorm(30), rnorm(30)))
# FUNCTION:
# Typical Price
typicalprice = (high + low + close) / 3
if (is.timeSeries(typicalprice)) colnames(typicalprice)<-"TYPICALPRICE"
# Return Value:
typicalprice
}
# ------------------------------------------------------------------------------
wcloseTA =
function(high, low, close)
{ # A function written by Diethelm Wuertz
# Description:
# Returns Weighted Close Indicator
# Example:
# head(wcloseTA(MSFT[, "High"], MSFT[, "Low"], MSFT[, "Close"]))
# head(wcloseTA(rnorm(30), rnorm(30), rnorm(30)))
# FUNCTION:
# Weighted Close:
wclose = (high + low + 2 * close) / 4
if (is.timeSeries(wclose)) colnames(wclose)<-"WCLOSE"
# Return Value:
wclose
}
# ------------------------------------------------------------------------------
rocTA =
function(x, lag = 5)
{ # A function written by Diethelm Wuertz
# Description:
# Returns rate of Change Indicator
# Examples:
# head(rocTA(MSFT[, "Close"]))
# head(rocTA(rnorm(30)))
# Details:
# RATE OF CHANGE INDICATOR:
# ROC: (X(n) - X(n-k) ) / X(n)
# FUNCTION:
# Rate of Change:
if (is.timeSeries(x)) {
roc = diff(x, lag = lag, pad = 0) / x
colnames(roc)<-"ROC"
} else {
roc = diff(x, lag = lag)
roc = c(rep(0, times = lag), roc) / x
}
# Return Value:
roc
}
# ******************************************************************************
oscTA =
function(x, lag1 = 25, lag2 = 65)
{ # A function written by Diethelm Wuertz
# Description:
# Returns EMA Oscillator Indicator
# Examples:
# head(oscTA(MSFT[, "Close"]))
# head(oscTA(rnorm(30)))
# Details:
# EMA OSCILLATOR INDICATOR:
# OSC: (EMA_LONG - EMA_SHORT) / EMA_SHORT
# FUNCTION:
# Oscillator:
xema1 = emaTA(x, lag1)
xema2 = emaTA(x, lag2)
osc = (xema1 - xema2) / xema2
if (is.timeSeries(osc)) colnames(osc)<-"OSC"
# Return Value:
osc
}
# ------------------------------------------------------------------------------
momTA =
function(x, lag = 25)
{ # A function written by Diethelm Wuertz
# Description:
# Returns Momentum Indicator
# Examples:
# head(momTA(MSFT[, "Close"]))
# head(momTA(rnorm(30)))
# Details:
# MOMENTUM INDICATOR:
# MOM: X(n) - X(n-lag)
# FUNCTION:
# Momentum:
if (is.timeSeries(x)) {
mom = diff(x, lag = lag, pad = 0)
colnames(mom)<-"MOM"
} else {
mom = diff(x, lag = lag)
mom = c(rep(0, times = lag), mom)
}
# Return Value:
mom
}
# ------------------------------------------------------------------------------
macdTA =
function(x, lag1 = 12, lag2 = 26)
{ # A function written by Diethelm Wuertz
# Description:
# Returns MA Convergence-Divergence Indicator
# Details
# MACD MA CONVERGENCE DIVERGENCE INDICATOR
# Fast MACD e.g. lag1=12, lag=26
# MCD: (EMA_SHORT - EMA_LONG)
# FUNCTION:
# MACD:
macd = emaTA(x, lag1) - emaTA(x, lag2)
if (is.timeSeries(x)) colnames(macd)<-"MACD"
# Return Result:
macd
}
# ------------------------------------------------------------------------------
cdsTA =
function(x, lag1 = 12, lag2 = 26, lag3 = 9)
{ # A function written by Diethelm Wuertz
# Description:
# Returns MACD Slow Signal Line Indicator
# Details:
# MACD SLOW SIGNAL LINE INDICATOR: e.g. lag3=9
# SIG: EMA(MCD)
# FUNCTION:
# CDS:
cds = emaTA(macdTA(x, lag1, lag2), lag3)
if (is.timeSeries(x)) colnames(cds)<-"CDS"
# Return Result:
cds
}
# ------------------------------------------------------------------------------
cdoTA <-
function(x, lag1 = 12, lag2 = 26, lag3 = 9)
{ # A function written by Diethelm Wuertz
# Description:
# Returns MA Convergence-Divergence Oscillator Indicator
# Details:
# MACD - MA CONVERGENCE DIVERGENCE OSCILLATOR:
# CDO: MACD - SIG
# FUNCTION:
# CDO:
cdo = macdTA(x, lag1 = lag1, lag2 = lag2) - cdsTA(x, lag3 = lag3)
if(is.timeSeries(x)) colnames(cdo)<-"CDO"
# Return Value:
cdo
}
# ------------------------------------------------------------------------------
vohlTA =
function(high, low)
{ # A function written by Diethelm Wuertz
# Description:
# Returns High Low Volatility Indicator
# Details:
# HIGH LOW VOLATILITY:
# VOHL: high - low
# FUNCTION:
# VOHL:
vohl = high - low
if(is.timeSeries(vohl)) colnames(vohl)<-"VOHL"
# Return Value:
vohl
}
# ------------------------------------------------------------------------------
vorTA =
function(high, low)
{ # A function written by Diethelm Wuertz
# Description:
# Returns Volatility Ratio Indicator
# Details:
# VOLATILITY RATIO:
# VOR: (high-low)/low
# FUNCTION:
# VOR:
vor = (high - low) / low
if(is.timeSeries(vor)) colnames(vor)<-"VOR"
# Return Value:
vor
}
# ------------------------------------------------------------------------------
stochasticTA =
function (close, high, low, lag1 = 5, lag2 = 3, lag3 = 5,
type = c("fast", "slow"))
{ # A function written by Diethelm Wuertz
# Description:
# Returns Stochastic Indicators
# Example:
# stochasticTA(high, low, close, lag1 = 5, lag2 = 3, "fast")
# stochasticTA(high, low, close, lag1 = 5, lag2 = 3, "slow")
# FUNCTION:
# Settings:
TS = is.timeSeries(close)
if (TS) {
stopifnot(isUnivariate(close))
stopifnot(isUnivariate(high))
}
type = match.arg(type)
# Fast:
K = fpkTA(close, high, low, lag = lag1)
D = fpdTA(close, high, low, lag1 = lag1, lag2 = lag2)
# Slow:
if (type == "slow") {
K = emaTA(K, lag3)
D = emaTA(D, lag3)
}
# Indicator:
if (TS) {
stochastic = cbind(K, D)
units = c(paste(type, "K", sep = ""), paste(type, "D", sep = ""))
colnames(stochastic)<-units
} else {
stochastic = cbind(K, D)
}
# Return Value:
stochastic
}
# ------------------------------------------------------------------------------
fpkTA =
function(close, high, low, lag = 5)
{ # A function written by Diethelm Wuertz
# Description:
# Returns Fast %K Indicator
# FUNCTION:
# Settings:
TS = is.timeSeries(close)
if (TS) {
X = close
close = as.vector(close)
high = as.vector(high)
low = as.vector(low)
}
# Minimum:
minlag = function(x, lag) {
xm = x
for (i in 1:lag) {
x1 = c(x[1], x[1:(length(x)-1)])
xm = pmin(xm,x1)
x = x1
}
xm
}
# Maximum:
maxlag = function(x, lag) {
xm = x
for (i in 1:lag) {
x1 = c(x[1], x[1:(length(x)-1)])
xm = pmax(xm,x1)
x = x1
}
xm
}
# Result:
xmin = minlag(low, lag)
xmax = maxlag(high, lag)
fpk = (close - xmin ) / (xmax -xmin)
# to timeSeries:
if (TS) {
fpk = matrix(fpk)
rownames(fpk) = rownames(series(X))
colnames(fpk) = "FPK"
series(X) = fpk
} else {
X = fpk
}
# Return Value:
X
}
# ------------------------------------------------------------------------------
fpdTA =
function(close, high, low, lag1 = 5, lag2 = 3)
{ # A function written by Diethelm Wuertz
# Description:
# Returns Fast %D Indicator
# Details:
# FAST %D INDICATOR: EMA OF FAST %K
# FUNCTION:
# FPD:
TS = is.timeSeries(close)
fpd = emaTA(fpkTA(close, high, low, lag1), lag2)
if (TS) colnames(fpd)<-"FPD"
# Return Value:
fpd
}
# ------------------------------------------------------------------------------
spdTA =
function(close, high, low, lag1 = 5, lag2 = 3, lag3 = 9)
{ # A function written by Diethelm Wuertz
# Description:
# Return Slow %D Indicator
# Details:
# SLOW %D INDICATOR:
# EMA OF FAST %D
# FUNCTION:
# SPD:
TS = is.timeSeries(close)
spd = emaTA(fpdTA(close, high, low, lag1, lag2), lag3)
if (TS) colnames(spd)<-"SPD"
# Return Value:
spd
}
# ------------------------------------------------------------------------------
apdTA =
function(close, high, low, lag1 = 5, lag2 = 3, lag3 = 9, lag4 = 9)
{ # A function written by Diethelm Wuertz
# Description:
# Returns Averaged %D Indicator
# Details:
# AVERAGED %D INDICATOR: EMA OF SLOW %D
# FUNCTION:
# APD:
TS = is.timeSeries(close)
apd = emaTA(spdTA(close, high, low, lag1, lag2, lag3), lag4)
if (TS) colnames(apd)<-"APD"
# Return Value:
apd
}
# ------------------------------------------------------------------------------
wprTA =
function(close, high, low, lag = 50)
{ # A function written by Diethelm Wuertz
# Description:
# Returns Williams %R Indicator
# Details:
# Short Term: 5 to 49 days
# Intermediate Term: 50 to 100 day
# Long Term: More than 100 days
# FUNCTION:
# Check:
TS = is.timeSeries(close)
if (TS) {
X = close
close = as.vector(close)
high = as.vector(high)
low = as.vector(low)
}
# %R:
minlag =
function(x, lag)
{
xm = x
for (i in 1:lag){
x1 = c(x[1], x[1:(length(x)-1)])
xm = pmin(xm, x1)
x = x1
}
xm
}
maxlag =
function(x, lag)
{
xm = x
for (i in 1:lag){
x1 = c(x[1], x[1:(length(x)-1)])
xm = pmax(xm, x1)
x = x1
}
xm
}
xmin = minlag(low, lag)
xmax = maxlag(high, lag)
wpr = (close - xmin) / (xmax -xmin)
# to timeSeries:
if (TS) {
wpr = matrix(wpr)
rownames(wpr) = rownames(series(X))
colnames(wpr) = "WPR"
series(X) = wpr
} else {
X = wpr
}
# Return Result:
X
}
# ------------------------------------------------------------------------------
rsiTA =
function(close, lag = 14)
{ # A function written by Diethelm Wuertz
# Description:
# Returns Relative Strength Index Indicator
# FUNCTION:
# Check:
TS = is.timeSeries(close)
if (TS) {
X = close
close = as.vector(close)
}
# RSI:
sumlag =
function(x, lag){
xs = x
for (i in 1:lag){
x1 = c(x[1],x[1:(length(x)-1)])
xs = xs + x1
x = x1
}
xs
}
close1 = c(close[1],close[1:(length(close)-1)])
x = abs(close - close1)
x[close 0] = 1
ch = rocTA(close, lag = 1)/100
pvi = cumsum(ch * c(0, ind))
# Time Series Output ?
if (TS) {
pvi = matrix(pvi)
colnames(pvi) = "PVI"
rownames(pvi) = rownames(series(x))
series(x) = pvi
} else {
x = pvi
}
# Return Value:
x
}
# ------------------------------------------------------------------------------
pvtrendTA =
function(close, volume)
{ # A function written by Diethelm Wuertz
# Description:
# Returns the technical indicator price-volume trend
# FUNCTION:
# Check:
TS = is.timeSeries(close)
if (TS) {
x = close
close = as.vector(close)
volume = as.vector(volume)
}
# Indicator:
m = length(close)
ch = cumsum( volume * c(0, (close[2:m]/close[1:(m-1)]-1)*100))
# Time Series Output ?
if (TS) {
ch = matrix(ch)
colnames(ch) = "PVTREND"
rownames(ch) = rownames(series(x))
series(x) = ch
} else {
x = ch
}
# Return Value:
x
}
# ------------------------------------------------------------------------------
williamsadTA =
function(high, low, close)
{ # A function written by Diethelm Wuertz
# Description:
#
# FUNCTION:
# Check:
TS = is.timeSeries(high)
if (TS) {
x = high
high = as.vector(high)
low = as.vector(low)
close = as.vector(close)
}
# Indicator:
ind = c(0, sign(diff(close)))
williamsad = vector("numeric", length(close))
ind.pos = (ind == 1)
ind.neg = (ind == -1)
williamsad[ind.pos] = (close - low)[ind.pos]
williamsad[ind.neg] = - (high - close)[ind.neg]
williamsad = cumsum(williamsad)
names(williamsad) = as.character(1:length(x))
# Time Series Output ?
if (TS) {
williamsad = matrix(williamsad)
colnames(williamsad) = "WAD"
rownames(williamsad) = rownames(series(x))
series(x) = williamsad
} else {
x = williamsad
}
# Return Value:
x
}
# ------------------------------------------------------------------------------
williamsrTA =
function(high, low, close, lag = 20)
{ # A function written by Diethelm Wuertz
# Description:
# Returns the technical indicator Willimas' accumulation/distribution
# FUNCTION:
# Check:
TS = is.timeSeries(high)
if (TS) {
x = high
high = as.vector(high)
low = as.vector(low)
close = as.vector(close)
}
# Indicator:
n = lag
hh = rollFun(high, n, trim = FALSE, FUN = max)
ll = rollFun(low, n, trim = FALSE, FUN = min)
williamsr = (hh-close)/(hh-ll)*100
names(williamsr) = as.character(1:length(x))
# Time Series Output ?
if (TS) {
williamsr = matrix(williamsr)
colnames(williamsr) = "WR"
rownames(williamsr) = rownames(series(x))
series(x) = williamsr
} else {
x = williamsr
}
# Return Value:
williamsr
}
################################################################################
SMA =
function(x, n = 5)
{ # A function implemented by Diethelm Wuertz
# Description:
# Computes a Simple Moving Average
# Arguments:
# x - an univariate object of class "timeSeries" or a numeric vector
# FUNCTION:
# Rolling Mean:
ans = rollFun(x = x, n = n, FUN = mean)
# Return Value:
ans
}
# ------------------------------------------------------------------------------
EWMA =
function(x, lambda, startup = 0)
{ # A function implemented by Diethelm Wuertz
# Description:
# Computes an Exponentially Weighted Moving Average
# Arguments:
# x - an univariate object of class "timeSeries" or a numeric vector
# FUNCTION:
# EWMA:
ans = emaTA(x = x, lambda = lambda, startup = startup)
# Return Value:
ans
}
################################################################################
.dailyTA =
function(X, indicator = "ema", select = "Close", lag = 9)
{ # A function implemented by Diethelm Wuertz
# Description:
# Compute an indicator for technical analysis.
# Arguments:
# X - a data.frame or timeSeries object with named
# columns, at least "Close", "Open", "High" and
# "Low". The order of the columns may be arbitrary.
# FUNCTION:
if (is.timeSeries(X)) {
x = series(X)
} else {
stop("X must be a timeSeries object!")
}
if (indicator == "ema") {
ans = emaTA(x = x[, select], lambda = lag)
}
if (indicator == "bias") {
ans = biasTA(x = x[, select], lag = lag)
}
if (indicator == "medprice") {
ans = medpriceTA(high = x[, "High"], low = x[, "Low"])
}
if (indicator == "typicalprice") {
ans = typicalpriceTA(high = x[, "High"], low = x[, "Low"],
close = x[, "Close"])
}
if (indicator == "wclose") {
ans = wcloseTA(high = x[, "High"], low = x[, "Low"],
close = x[, "Close"])
}
if (indicator == "roc") {
ans = rocTA(x = x[, select], lag = lag)
}
if (indicator == "osc") {
if (length(lag) < 2)
stop("At least two lags must be specified!")
ans = oscTA(x = x[, select], lag1 = lag[1], lag2 = lag[2])
}
if (indicator == "mom") {
ans = momTA(x = x[, select], lag = lag)
}
if (indicator == "macd") {
if (length(lag) < 2)
stop("At least two lags must be specified!")
ans = macdTA(x = x[, select], lag1 = lag[1], lag2 = lag[2])
}
if (indicator == "cds") {
if (length(lag) < 3)
stop("At least three lags must be specified!")
ans = cdsTA(x = x[, select], lag1 = lag[1], lag2 = lag[2],
lag3 = lag[3])
}
if (indicator == "cdo") {
if (length(lag) < 3)
stop("At least three lags must be specified!")
ans = cdoTA(x = x[, select], lag1 = lag[1], lag2 = lag[2],
lag3 = lag[3])
}
if (indicator == "vohl") {
ans = vohlTA(high = x[, "High"], low = x[, "Low"])
}
if (indicator == "vor") {
ans = vorTA(high = x[, "High"], low = x[, "Low"])
}
if (indicator == "fpk") {
ans = fpkTA(close = x[, "Close"], high = x[, "High"],
low = x[, "Low"], lag = lag)
}
if (indicator == "fpd") {
if (length(lag) < 2)
stop("At least two lags must be specified!")
ans = fpdTA(close = x[, "Close"], high = x[, "High"],
low = x[, "Low"], lag1 = lag[1], lag2 = lag[2])
}
if (indicator == "spd") {
if (length(lag) < 3)
stop("At least three lags must be specified!")
ans = spdTA(close = x[, "Close"], high = x[, "High"],
low = x[, "Low"], lag1 = lag[1], lag2 = lag[2],
lag3 = lag[3])
}
if (indicator == "apd") {
if (length(lag) < 4)
stop("At least four lags must be specified!")
ans = apdTA(close = x[, "Close"], high = x[, "High"],
low = x[, "Low"], lag1 = lag[1], lag2 = lag[2],
lag3 = lag[3], lag4 = lag[4])
}
if (indicator == "wpr") {
ans = wprTA(close = x[, "Close"], high = x[, "High"],
low = x[, "Low"], lag = lag)
}
if (indicator == "rsi") {
ans = rsiTA(close = x[, "Close"], lag = lag)
}
# Return Value:
timeSeries(data = matrix(ans, ncol = 1), charvec = X@positions,
units = indicator, format = "ISO", zone = "GMT",
FinCenter = "GMT")
}
################################################################################
.tradeSignals =
function(Positions)
{ # A function implemented by Diethelm Wuertz
# Description:
# Computes trade signals from trading positions
# FUNCTION:
# Get Signals from Positions:
stopifnot(is.timeSeries(Positions))
Signals = diff(Positions, pad = 0)/2
Signals = Signals[abs(series(Signals)) == 1,]
# Return Value:
Signals
}
# ------------------------------------------------------------------------------
.tradeLengths =
function(tradeSignals)
{ # A function implemented by Diethelm Wuertz
# Description:
# Computes trade length from trading signals
# FUNCTION:
# Get Lengths from Signals:
stopifnot(is.timeSeries(tradeSignals))
data = diff(time(tradeSignals))
charvec = tradeSignals@positions[-1]
tradeLengths = timeSeries(data, charvec, units = "tradeLengths")
# Return Value:
tradeLengths
}
# ------------------------------------------------------------------------------
.hitRate =
function(Returns, Positions)
{ # A function implemented by Diethelm Wuertz
# Description:
# Computes hit rates from returns and positions
# FUNCTION:
# Compute hit rate:
Indicator = (Positions * sign(Returns) + 1) / 2
Rate = mean ( as.vector(Indicator), na.rm = TRUE )
Rate = round(Rate, digits = 3)
# Return Value:
Rate
}
################################################################################
fTrading/R/zzz.R 0000644 0001760 0000144 00000003464 12251677757 013253 0 ustar ripley users
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
# Copyrights (C)
# for this R-port:
# 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL
# Diethelm Wuertz
# info@rmetrics.org
# www.rmetrics.org
# for the code accessed (or partly included) from other R-ports:
# see R's copyright and license files
# for the code accessed (or partly included) from contributed R-ports
# and other sources
# see Rmetrics's copyright file
################################################################################
## .First.lib =
## function(lib, pkg)
## {
## # Startup Mesage and Desription:
## MSG <- if(getRversion() >= "2.5") packageStartupMessage else message
## dsc <- packageDescription(pkg)
## if(interactive() || getOption("verbose")) {
## # not in test scripts
## MSG(sprintf("Rmetrics Package %s (%s) loaded.", pkg, dsc$Version))
## }
## # Load dll:
## # library.dynam("fTrading", pkg, lib)
## }
if(!exists("Sys.setenv", mode = "function")) # pre R-2.5.0, use "old form"
Sys.setenv <- Sys.putenv
################################################################################
fTrading/MD5 0000644 0001760 0000144 00000001672 12251714075 012362 0 ustar ripley users 9091d138ab56e51cddf1bc64c2d488c2 *ChangeLog
f3cc87e215953567e62d812dc927c00e *DESCRIPTION
165abc67c5196d4486ee45babc3a6a6d *NAMESPACE
5aa3f5b8b7e9565e4b303e233ebbf022 *R/BenchmarkAnalysis.R
43bc1f04dc47a1531ea58c42f5a380df *R/TechnicalAnalysis.R
b1ab6cb9997df7d82daa9ce1ac3d7d37 *R/rollFun.R
a8aa095ddc3e06c36d0904964932ef3d *R/zzz.R
6042b9c5e5bec3ecc1b6959cd2858b64 *inst/COPYRIGHT.html
fb4840c9f583963d64c0ffd9a4a102ae *inst/unitTests/Makefile
c611ed7809f950e7e45acfc24e72f0b3 *inst/unitTests/runTests.R
7fd45601fc104c232ca5ecaee7dccf97 *inst/unitTests/runit.BenchmarkAnalysis.R
85305b9a5169c4080ac76e33c783d16d *inst/unitTests/runit.RollingAnalysis.R
e4f5ee44240cf4e5d16586359cfa4d59 *inst/unitTests/runit.TechnicalAnalysis.R
def1af4c75b6ed65701ff24c20a9db26 *man/BenchmarkAnalysis.Rd
4076f0087964fd0769991c22c729bf33 *man/RollingAnalysis.Rd
68b2d3bb41baa1f77426cb617cf9dfa4 *man/TechnicalAnalysis.Rd
202b3dd7403a36d827a5c6cb9211d4eb *tests/doRUnit.R
fTrading/DESCRIPTION 0000644 0001760 0000144 00000001410 12251714075 013546 0 ustar ripley users Package: fTrading
Version: 3010.78
Revision: 5400
Date: 2012-11-30
Title: Technical Trading Analysis
Author: Diethelm Wuertz and many others, see the SOURCE file
Depends: R (>= 2.4.0), methods, timeDate, timeSeries, fBasics
Suggests: RUnit, tcltk
Maintainer: Yohan Chalabi
Description: Environment for teaching "Financial Engineering and
Computational Finance"
NOTE: SEVERAL PARTS ARE STILL PRELIMINARY AND MAY BE CHANGED IN THE
FUTURE. THIS TYPICALLY INCLUDES FUNCTION AND ARGUMENT NAMES, AS
WELL AS DEFAULTS FOR ARGUMENTS AND RETURN VALUES.
LazyData: yes
License: GPL (>= 2)
URL: http://www.rmetrics.org
Packaged: 2013-12-10 21:57:14 UTC; yohan
NeedsCompilation: no
Repository: CRAN
Date/Publication: 2013-12-10 23:39:57
fTrading/ChangeLog 0000644 0001760 0000144 00000001361 12157313045 013614 0 ustar ripley users 2012-11-30 chalabi
* NAMESPACE: Added NAMESPACE.
* DESCRIPTION: Updated maintainer field.
* R/BenchmarkAnalysis.R: Fixed partial argument match.
2011-09-23 mmaechler
* DESCRIPTION: remove deprecated "LazyLoad" entry
2010-07-23 chalabi
* inst/DocCopying.pdf: removed DocCopying.pdf license is already
specified in DESCRIPTION file
2009-09-30 chalabi
* DESCRIPTION: updated version number
2009-09-29 chalabi
* ChangeLog, DESCRIPTION: updated DESC and ChangeLog
2009-09-17 chalabi
* R/TechnicalAnalysis.R: stochasticTA uses now 'cbind' rather than
'merge' to bind result.
2009-04-02 chalabi
* DESCRIPTION: more explicit depends and suggests field in DESC
file.
2009-04-01 chalabi
* DESCRIPTION: updated DESC file
fTrading/man/ 0000755 0001760 0000144 00000000000 12251707065 012620 5 ustar ripley users fTrading/man/TechnicalAnalysis.Rd 0000644 0001760 0000144 00000012757 11370220763 016515 0 ustar ripley users \name{TechnicalAnalysis}
\alias{TechnicalAnalysis}
\alias{emaTA}
\alias{biasTA}
\alias{medpriceTA}
\alias{typicalpriceTA}
\alias{wcloseTA}
\alias{rocTA}
\alias{oscTA}
\alias{momTA}
\alias{macdTA}
\alias{cdsTA}
\alias{cdoTA}
\alias{vohlTA}
\alias{vorTA}
\alias{stochasticTA}
\alias{fpkTA}
\alias{fpdTA}
\alias{spdTA}
\alias{apdTA}
\alias{wprTA}
\alias{rsiTA}
\alias{accelTA}
\alias{adiTA}
\alias{adoscillatorTA}
\alias{bollingerTA}
\alias{chaikinoTA}
\alias{chaikinvTA}
\alias{garmanklassTA}
\alias{nviTA}
\alias{obvTA}
\alias{pviTA}
\alias{pvtrendTA}
\alias{williamsadTA}
\alias{williamsrTA}
\alias{SMA}
\alias{EWMA}
\title{Tools for the Technical Analysis}
\description{
A collection and description of functions
for the technical analysis of stock markets.
The collection provides a set of the most
common technical indicators.
\cr
Utility Functions:
\tabular{ll}{
\code{emaTA} \tab Exponential Moving Average, \cr
\code{biasTA} \tab Bias Indicator, \cr
\code{medpriceTA} \tab Medium Price Indicator, \cr
\code{typicalpriceTA} \tab Typical Price Indicator, \cr
\code{wcloseTA} \tab Weighted Close Indicator, \cr
\code{rocTA} \tab Rate of Change, \cr
\code{oscTA} \tab Oscillator Indicator. }
Oscillator Indicators:
\tabular{ll}{
\code{momTA} \tab Momentum Indicator, \cr
\code{macdTA} \tab MACD Indicator, \cr
\code{cdsTA} \tab MACD Signal Line, \cr
\code{cdoTA} \tab MACD Oscillator, \cr
\code{vohlTA} \tab High/Low Volatility, \cr
\code{vorTA} \tab Volatility Ratio. }
\tabular{ll}{
\code{stochasticTA} \tab Stochastics Oscillator, \cr
\code{fpkTA} \tab Fast Percent K, \cr
\code{fpdTA} \tab Fast Percent D, \cr
\code{spdTA} \tab Slow Percent D, \cr
\code{apdTA} \tab Averaged Percent D, \cr
\code{wprTA} \tab William's Percent R, \cr
\code{rsiTA} \tab Relative Strength Index. }
S-Plus Like Moving Averages:
\tabular{ll}{
\code{SMA} \tab Simple Moving Average, \cr
\code{EWMA} \tab Exponentially Weighted Moving Average.}
}
\usage{
emaTA(x, lambda, startup = 0)
biasTA(x, lag)
medpriceTA(high, low)
typicalpriceTA(high, low, close)
wcloseTA(high, low, close)
rocTA(x, lag)
oscTA(x, lag1 = 25, lag2 = 65)
momTA(x, lag)
macdTA(x, lag1, lag2)
cdsTA(x, lag1 = 12, lag2 = 26, lag3 = 9)
cdoTA(x, lag1 = 12, lag2 = 26, lag3 = 9)
vohlTA(high, low)
vorTA(high, low)
stochasticTA(close, high, low, lag1 = 5, lag2 = 3, lag3 = 5,
type = c("fast", "slow"))
fpkTA(close, high, low, lag)
fpdTA(close, high, low, lag1, lag2)
spdTA(close, high, low, lag1, lag2, lag3)
apdTA(close, high, low, lag1, lag2, lag3, lag4)
wprTA(close, high, low, lag)
rsiTA(close, lag)
SMA(x, n = 5)
EWMA(x, lambda, startup = 0)
}
\arguments{
\item{lag, lag1, lag2, lag3, lag4}{
integer values, time lags.
}
\item{n}{
[SMA] - \cr
an integer value, time lag.
}
\item{lambda}{
[emaTA][EWMA] - \cr
a numeric value between zero and one giving the decay length
of the exponential moving average. If an integer value greater
than one is given, lambda is used as a lag of "n" periods to
calculate the decay parameter.
}
\item{startup}{
[emaTA][EWMA] - \cr
an integer value, the startup position of the exponential
moving average, by default 0.
}
\item{type}{
[stochasticTA] - \cr
a character string, either \code{"fast"} or "\code{"slow"}
characterizing the type of the percent K and percent D
indicator. By default \code{type="fast"}
}
\item{x, high, low, close}{
a numeric vector of prices, either opening, closing, or
high and low values.
For \code{ohlcPlot} a multivariate time series object of
class \code{mts}.
}
}
\value{
\code{*TA}
\cr
The technical Indicators return the following numeric vectors (or matrix):
\code{emaTA} returns the Exponential Moving Average, EMA \cr
\code{biasTA} returns the EMA-Bias, \cr
\code{medpriceTA} returns the Medium Price, \cr
\code{typicalpriceTA} returns the Typical Price, \cr
\code{wcloseTA} returns the Weighted Closing Price, \cr
\code{rocTA} returns the Rate of Change Indicator, \cr
\code{oscTA} returns the EMA Oscillator Indicator, \cr
\code{momTA} returns the Momentum Oscillator, \cr
\code{macdTA} returns the MACD Oscillator, \cr
\code{cdsTA} returns the MACD Signal Line, \cr
\code{cdo} returns the MACD Oscillator, \cr
\code{vohlTA} returns the High/Low Volatility Oscillator, \cr
\code{vorTA} returns Volatility Ratio Oscillator, \cr
\code{stochasticTA} returns a 2-column matrix with percent K and D Indicator, \cr
\code{fpkTA} returns the Fast Percent-K Stochastics Indicator, \cr
\code{fpdTA} returns the Fast Percent-D Stochastics Indicator, \cr
\code{spdTA} returns the Slow Percent-D Stochastics Indicator, \cr
\code{apdTA} returns the Averaged Percent-D Stochastics Indicator, \cr
\code{wprTA} returns the Williams Percent-R Stochastics Indicator, \cr
\code{rsiTA} returns the Relative Strength Index Stochastics Indicator. \cr
}
\author{
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## data -
# Load MSFT Data:
x = MSFT
colnames(x)
x = x[, "Close"]
head(x)
## emaTA -
# Exponential Moving Average:
y = emaTA(x, lambda = 9)
seriesPlot(x)
lines(y, col = "red")
}
\keyword{math}
fTrading/man/RollingAnalysis.Rd 0000644 0001760 0000144 00000006021 12251707065 016220 0 ustar ripley users \name{RollingAnalysis}
\alias{RollingAnalysis}
\alias{rollFun}
% \alias{rollMin}
% \alias{rollMax}
% \alias{rollMean}
\alias{rollVar}
\title{Rolling Analysis}
\description{
A collection and description of functions
to perform a rolling analysis. A rolling
analysis is often required in building
trading models.
\cr
The functions are:
\tabular{ll}{
\code{rollFun} \tab Rolling or moving sample statistics, \cr
% \code{rollMin} \tab Rolling or moving sample minimum, \cr
% \code{rollMax} \tab Rolling or moving sample maximum, \cr
% \code{rollMean} \tab Rolling or moving sample mean, \cr
\code{rollVar} \tab Rolling or moving sample variance. }
}
\usage{
rollFun(x, n, trim = TRUE, na.rm = FALSE, FUN, ...)
% rollMin(x, n = 9, trim = TRUE, na.rm = FALSE)
% rollMax(x, n = 9, trim = TRUE, na.rm = FALSE)
% rollMean(x, n = 9, trim = TRUE, na.rm = FALSE)
rollVar(x, n = 9, trim = TRUE, unbiased = TRUE, na.rm = FALSE)
}
\arguments{
\item{FUN}{
the rolling function, arguments to this function can be
passed through the \code{\dots} argument.
}
\item{n}{
an integer specifying the number of periods or
terms to use in each rolling/moving sample.
}
\item{na.rm}{
a logical flag: if TRUE, missing values in x will be removed
before computation. The default is FALSE.
}
\item{trim}{
a logical flag: if TRUE, the first n-1 missing values in
the returned object will be removed; if FALSE, they will
be saved in the returned object. The default is TRUE.
}
\item{unbiased}{
a logical flag. If TRUE, the unbiased sample variance
will be returned. The default is TRUE.
}
\item{x}{
an univariate \code{timeSeries} object or a numeric vector.
}
\item{\dots}{
additional arguments to be passed.
}
}
\value{
The functions return a \code{timeSeries} object or a numeric
vector, depending on the argument \code{x}.
\code{rollMax} returns the rolling sample maximum, \cr
\code{rollMin} returns the rolling sample minimum, \cr
\code{rollMean} returns the rolling sample mean, and \cr
\code{rollVar} returns the biased/unbiased rolling sample variance.
Note, that the function \code{rollFun} always returns a numeric
vector, independent of the argument \code{x}.
If you like to operate for \code{x} with rectangular objects,
you have to call the functions columnwise within a loop.
}
\seealso{
\code{\link{var}}.
}
\author{
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## Rolling Analysis:
x = (1:10)^2
x
trim = c(TRUE, TRUE, FALSE, FALSE)
na.rm = c(TRUE, FALSE, TRUE, FALSE)
for (i in 1:4)
rollFun(x, 5, trim[i], na.rm[i], FUN = min)
for (i in 1:4)
rollFun(x, 5, trim[i], na.rm[i], FUN = max)
for (i in 1:4)
rollVar(x, 5, trim[i], unbiased = TRUE, na.rm[i])
for (i in 1:4)
rollVar(x, 5, trim[i], unbiased = FALSE, na.rm[i])
}
\keyword{math}
fTrading/man/BenchmarkAnalysis.Rd 0000644 0001760 0000144 00000013703 11370220763 016505 0 ustar ripley users \name{BenchmarkAnalysis}
\alias{BenchmarkAnalysis}
\alias{ohlcPlot}
\alias{sharpeRatio}
\alias{sterlingRatio}
\alias{maxDrawDown}
\title{Utilities and Benchmark Analysis}
\description{
A collection and description of utility
and benchmark functions for the analysis
of financial markets. The collection
provides a set of functions for the
computation of returns, for the display
of price charts, and for benchmark
measurements.
\cr
The functions are:
\tabular{ll}{
\code{ohlcPlot} \tab Plots open--high--low--close bar charts, \cr
\code{sharpeRatio} \tab Computes Sharpe Ratio, \cr
\code{sterlingRatio} \tab Computes Sterling Ratio, \cr
\code{maxDrawDown} \tab Computes maximum drawdown.}
}
\usage{
ohlcPlot(x, xlim = NULL, ylim = NULL, xlab = "Time", ylab, col = par("col"),
bg = par("bg"), axes = TRUE, frame.plot = axes, ann = par("ann"),
main = NULL, date = c("calendar", "julian"), format = "\%Y-\%m-\%d",
origin = "1899-12-30", \dots)
sharpeRatio(x, r = 0, scale = sqrt(250))
sterlingRatio(x)
maxDrawDown(x)
}
\arguments{
\item{date, format, origin}{
[ohlcPlot] - \cr
date elements,\cr
\code{date}, a string indicating the type of x axis annotation.
Default is calendar dates. \cr
\code{format}, a string indicating the format of the x axis
annotation if \code{date == "calendar"}. For details see
\code{\link{format.POSIXct}}. \cr
\code{origin} an R object specifying the origin of the Julian
dates if \code{date == "calendar"}. Defaults to 1899-12-30
(Popular spreadsheet programs internally also use Julian dates
with this origin).
}
\item{r}{
[sharpeRatio] - \cr
the risk free rate. Default corresponds to using portfolio
returns not in excess of the riskless return.
}
\item{scale}{
[sharpeRatio] - \cr
a scale factor. Default corresponds to an annualization
when working with daily financial time series data.
}
\item{x}{
a numeric vector of prices.
For \code{ohlcPlot} a multivariate time series object of
class \code{mts} is required.
}
\item{xlim, ylim, xlab, ylab, col, bg, axes, frame.plot, ann, main}{
[ohlcPlot] - \cr
graphical arguments, see \code{\link{plot}},
\code{\link{plot.default}} and \code{\link{par}}.
}
\item{\dots}{
[ohlcPlot] - \cr
further graphical arguments passed to \code{\link{plot.window}},
\code{\link{title}}, \code{\link{axis}}, and \code{\link{box}}.
}
}
\details{
\bold{Open--High--Low--Close Chart:}
\cr\cr
Within an open--high--low--close bar chart, each bar represents
price information for the time interval between the open and the close
price. The left tick for each bar indicates the open price for the
time interval. The right tick indicates the closing price for the time
interval. The vertical length of the bar represents the price range
for the time interval.
The time scale of \code{x} must be in Julian dates (days since the
\code{origin}).
\cr
\code{[tseries:plotOHLC]}
\cr
\bold{Sharpe and Sterling Ratios:}
\cr\cr
The Sharpe ratio is defined as a portfolio's mean return in excess of
the riskless return divided by the portfolio's standard deviation. In
finance the Sharpe Ratio represents a measure of the portfolio's
risk-adjusted (excess) return.
The Sterling ratio is defined as a portfolio's overall return divided
by the portfolio's maximum drawdown statistic. In finance the
Sterling Ratio represents a measure of the portfolio's risk-adjusted
return.
\cr
\code{[tseries:sharpe]}
\cr
\bold{Maximum Drawdown:}
\cr\cr
The maximum drawdown or maximum loss statistic is defined as the
maximum value drop after one of the peaks of \code{x}. For financial
instruments the maximum drawdown represents the worst investment
loss for a buy--and--hold strategy invested in \code{x}.
\cr
\code{[tseries:maxdrawdown]}
\cr
\bold{Get Returns:}
\cr\cr
The function computes the return series given a financial security
price series. The price series may be an object of class \code{numeric}
or a time series object. This includes objects of classes \code{"ts"},
\code{"its"} and/or \code{"timeSeries"}.
}
\value{
\code{ohlcPlot}
\cr
creates an Open--High--Low--Close chart.
\code{sharpeRatio}\cr
\code{sterlingRatio}
\cr
return the Sharpe or Sterling ratio, a numeric value.
\code{maxDrawDown}
\cr
returns a list containing the following three components:
\code{maxDrawDown}, double representing the max drawdown or max loss
statistic; \code{from}, the index (or vector of indices) where the
maximum drawdown period starts; \code{to}, the index (or vector of
indices) where the max drawdown period ends.
}
\author{
Adrian Trapletti for the ohlcPlot,*Ratio and maxDrawDown functions, \cr
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## ohlcPlot -
# Plot OHLC for SP500
# ohlcPlot(x, ylab = "price", main = instrument)
## sharpeRatio -
# Sharpe Ratio for DAX and FTSE:
data(EuStockMarkets)
dax = log(EuStockMarkets[, "DAX"])
ftse = log(EuStockMarkets[, "FTSE"])
# Ratios:
sharpeRatio(dax)
sharpeRatio(ftse)
## maxDrawDown -
data(EuStockMarkets)
dax = log(EuStockMarkets[, "DAX"])
mdd = maxDrawDown(dax)
mdd
# Plot DAX:
plot(dax)
grid()
segments(time(dax)[mdd$from], dax[mdd$from],
time(dax)[mdd$to], dax[mdd$from])
segments(time(dax)[mdd$from], dax[mdd$to],
time(dax)[mdd$to], dax[mdd$to])
mid = time(dax)[(mdd$from + mdd$to)/2]
arrows(mid, dax[mdd$from], mid, dax[mdd$to], col = 2)
title(main = "DAX: Max Drawdown")
}
\keyword{math}