fNonlinear/ 0000755 0001762 0000144 00000000000 13203405404 012340 5 ustar ligges users fNonlinear/inst/ 0000755 0001762 0000144 00000000000 13201353171 013316 5 ustar ligges users fNonlinear/inst/COPYRIGHT.html 0000644 0001762 0000144 00000020411 11645005112 015551 0 ustar ligges 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
fNonlinear/inst/unitTests/ 0000755 0001762 0000144 00000000000 13201353171 015320 5 ustar ligges users fNonlinear/inst/unitTests/Makefile 0000644 0001762 0000144 00000000423 13203345304 016760 0 ustar ligges users PKG=fNonlinear
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}
fNonlinear/inst/unitTests/runit.NonLinModelling.R 0000644 0001762 0000144 00000014277 11645005112 021645 0 ustar ligges 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: CHAOTIC TIME SERIES MAPS:
# tentSim Simulates series from Tent map
# henonSim Simulates series from Henon map
# ikedaSim Simulates series from Ikeda map
# logisticSim Simulates series from Logistic map
# lorentzSim Simulates series from Lorentz map
# roesslerSim Simulates series from Roessler map
# FUNCTION: PHASE SPACE REPRESENTATION:
# mutualPlot Creates mutual information plot
# fnnPlot Creates false nearest neigbours plot
# FUNCTION: NON STATIONARITY PLOTS:
# recurrencePlot Creates recurrence plot
# separationPlot Creates space-time separation plot
# FUNCTION: LYAPUNOV EXPONENTS:
# lyapunovPlot Maximum Lyapunov plot
################################################################################
test.tentSim =
function()
{
# tentSim - Simulates series from Tent map
# Tent Map:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
par (mfrow = c(1, 1))
ts = tentSim(n = 1000, n.skip = 100, parms = c(a = 2), start = runif(1),
doplot = TRUE)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.henonSim =
function()
{
# henonSim - Simulates series from Henon map
# Henon Map - 2D:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
par (mfrow = c(1, 1))
ts = henonSim(n = 1000, n.skip = 100, parms = c(a = 1.4, b = 0.3),
start = runif(2), doplot = TRUE)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.ikedaSim =
function()
{
# ikedaSim - Simulates series from Ikeda map
# Ikeda Map - 2D:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
par (mfrow = c(2, 2))
ts = ikedaSim(n = 1000, n.skip = 100, parms = c(a = 0.4, b = 6, c = 0.9),
start = runif(2), doplot = TRUE)
head(ts)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.logisticSim =
function()
{
# logisticSim - Simulates series from Logistic map
# lorentzSim - Simulates series from Lorentz map
# roesslerSim - Simulates series from Roessler map
# Logistic Map:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
par (mfrow = c(1, 1))
logisticSim(n = 1000, n.skip = 100, parms = c(r = 4), start = runif(1),
doplot = TRUE)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.lorentzSim =
function()
{
# lorentzSim - Simulates series from Lorentz map
# Lorentz Map:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
par (mfrow = c(3, 2))
ts = lorentzSim(times = seq(0, 20, by = 0.01), parms = c(sigma = 16,
r = 45.92, b = 4), start = c(-14, -13, 47), doplot = TRUE)
head(ts)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.roesslerSim =
function()
{
# roesslerSim - Simulates series from Roessler map
# Roessler Map:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
par (mfrow = c(3, 2))
ts = roesslerSim(times = seq(0, 80, by = 0.05), parms = c(a = 0.2,
b = 0.2, c = 8), start = c(-1.894, -9.92, 0.025), doplot = TRUE)
head(ts)
# Return Value:
return()
}
################################################################################
test.henonSlider =
function()
{
# Henon Slider:
henonSlider = function()
{
refresh.code = function(...)
{
# Sliders:
N = .sliderMenu(no = 1)
a = .sliderMenu(no = 2)
b = .sliderMenu(no = 3)
# Plot Henon Map:
ts = henonSim(n = N, n.skip = 100, parms = c(a = a, b = b),
start = c(pi/4, exp(1)/4), doplot = TRUE)
# Frame:
par(mfrow = c(1, 1), cex = 0.7)
}
# Open Slider Menu:
.sliderMenu(refresh.code,
names = c( "N", "a", "b"),
minima = c( 100, 1.00, 0.00),
maxima = c(5000, 2.00, 1.00),
resolutions = c( 100, 0.01, 0.01),
starts = c(2000, 1.40, 0.30))
}
# Try:
# henonSlider()
# Return Value:
return()
}
################################################################################
fNonlinear/inst/unitTests/runit.Gallery.R 0000644 0001762 0000144 00000005154 11645005112 020206 0 ustar ligges 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
################################################################################
test.mutualPlotGallery =
function()
{
# Mutual Information Index:
lorentz = lorentzSim(
times = seq(0, 40, by = 0.01),
parms = c(sigma = 16, r = 45.92, b = 4),
start = c(-14, -13, 47),
doplot = FALSE)
# Plot:
par(mfrow = c(1, 1))
mutualPlot(x = lorentz[, 2], partitions = 16, lag.max = 20, doplot = TRUE)
mtext("Lorentz Map", line = 0.5, cex = 0.7)
mtext(paste("times=seq(0,40,by=0.01) | parms=c(sigma=16,r=45.92,b=4) |",
"start=c(-14,-13,47)"), side = 4, adj = 0, col = "darkgrey", cex = 0.7)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.falsennPlotGallery =
function()
{
# False Nearest Neighbours:
roessler = roesslerSim(
times = seq(0, 100, by = 0.01),
parms = c(a = 0.2, b = 0.2, c = 8),
start = c(-1.894, -9.92, 0.025),
doplot = FALSE)
# Plot:
par(mfrow = c(1, 1))
falsennPlot(x = roessler[, 2], m = 6, d = 8, t = 180, eps = 1, rt = 3)
abline(h = 0, col = "grey")
grid()
mtext("Roessler Map", line = 0.5, cex = 0.7)
mtext(paste("times=seq(0,100,by=0.01) | parms=c(a=0.2, b=0.2, c=8) |",
"start=c(-1.894,-9.92,0.025)"), side = 4, adj = 0,
col = "darkgrey", cex = 0.7)
# Return Value:
return()
}
# ------------------------------------------------------------------------------ fNonlinear/inst/unitTests/runTests.R 0000644 0001762 0000144 00000004532 11645005112 017275 0 ustar ligges users pkg <- "fNonlinear"
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")
}
################################################################################
fNonlinear/inst/unitTests/runit.NonLinPlots.R 0000644 0001762 0000144 00000010013 11645005112 021014 0 ustar ligges users
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program 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
# General Public License for more details.
#
# A copy of the GNU General Public License is available via WWW at
# http://www.gnu.org/copyleft/gpl.html. You can also obtain it by
# writing to the Free Software 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: PHASE SPACE REPRESENTATION:
# mutualPlot Creates mutual information plot
# falsennPlot Creates false nearest neigbours plot
# FUNCTION: NON STATIONARITY:
# recurrencePlot Creates recurrence plot
# separationPlot Creates space-time separation plot
# FUNCTION: LYAPUNOV EXPONENTS:
# lyapunovPlot Maximum Lyapunov plot
################################################################################
test.mutualPlot =
function()
{
# Mutual Information Index:
par(mfrow = c(1, 1))
lorentz = lorentzSim(
times = seq(0, 40, by = 0.01),
parms = c(sigma = 16, r = 45.92, b = 4),
start = c(-14, -13, 47),
doplot = FALSE)
mutualPlot(x = lorentz[, 2], partitions = 16, lag.max = 20, doplot = TRUE)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.falsennPlot =
function()
{
# False Nearest Neighbours:
par(mfrow = c(1, 1))
roessler = roesslerSim(
times = seq(0, 100, by = 0.01),
parms = c(a = 0.2, b = 0.2, c = 8),
start = c(-1.894, -9.92, 0.025),
doplot = FALSE)
falsennPlot(x = roessler[, 2], m = 6, d = 8, t = 180, eps = 1, rt = 3)
abline(h = 0, col = "grey")
grid()
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.recurrencePlot =
function()
{
# Recurrence Plot:
par(mfrow = c(2, 2), cex = 0.7)
lorentz = lorentzSim(
times = seq(0, 40, by = 0.01),
parms = c(sigma = 16, r = 45.92, b = 4),
start = c(-14, -13, 47),
doplot = FALSE)
recurrencePlot(lorentz[, 2], m = 3, d = 2, end.time = 800, eps = 3,
nt = 5, pch = '.', cex = 2)
recurrencePlot(lorentz[, 3], m = 3, d = 2, end.time = 800, eps = 3,
nt = 5, pch = '.', cex = 2)
recurrencePlot(lorentz[, 4], m = 3, d = 2, end.time = 800, eps = 3,
nt = 5, pch = '.', cex = 2)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.separationPlot =
function()
{
# Separation Plot:
par(mfrow = c(1, 1))
roessler = roesslerSim(
times = seq(0, 100, by = 0.01),
parms = c(a = 0.2, b = 0.2, c = 8),
start = c(-1.894, -9.92, 0.025),
doplot = FALSE)
separationPlot(roessler[, 2], m = 3, d = 8, idt = 1, mdt = 250)
# Return Value:
return()
}
################################################################################
test.lyapunovPlot =
function()
{
# Lyapunov Plot:
NA
# Return Value:
return()
}
################################################################################
fNonlinear/inst/unitTests/runit.NonLinTests.R 0000644 0001762 0000144 00000012512 11645005112 021023 0 ustar ligges 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: DESCRIPION:
# tsTest Time Series Test Suite
# FUNCTION: DEPENDENCY TEST:
# bdsTest Brock-Dechert-Scheinkman test for iid series
# FUNCTION: NONLINEARITY TESTS:
# wnnTest White Neural Network Test for Nonlinearity
# tnnTest Teraesvirta Neural Network Test for Nonlinearity
################################################################################
test.tsSuite =
function()
{
# NA
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.bdsTest =
function()
{
# iid example:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
x = rnorm(100)
plot(x, type = "l", col = "steelblue")
test = bdsTest(x)
print(test)
p.value = as.vector(test@test$p.value)
# Is each of the 8 p.values greater 0.1?
checkEqualsNumeric(sum(p.value > 0.1), 8)
# Not identically distributed:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
x = c(rnorm(50), runif(50))
test = bdsTest(x)
print(test)
p.value = as.vector(test@test$p.value)
# Is each of the 8 p.values smaller 1e-3?
checkEqualsNumeric(sum(p.value < 1e-3), 8)
# Not independent:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
n = 500
x = rep(0, times = n)
for(i in (2:n)) x[i] = 0.4*x[i-1] + tanh(x[i-1]) + rnorm(1, sd = 0.5)
plot(x, type = "l", col = "steelblue")
test = bdsTest(x)
print(test)
p.value = as.vector(test@test$p.value)
# Is each of the 8 p.values smaller 1e-6?
checkEqualsNumeric(sum(p.value < 1e-6), 8)
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.wnnTest =
function()
{
# White NN Test:
# See tseries Package:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
x = runif(1000, -1, 1)
plot(x, type = "l", col = "steelblue")
test = wnnTest(x)
print(test)
p.value = as.vector(test@test$p.value)
# Is each of the two p.values greater 0.5?
checkTrue(as.logical(mean(p.value > 0.5)))
## Generate time series which is nonlinear in ``mean''
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
n = 1000
x = rep(0, times = n)
for(i in (2:n)) x[i] <- 0.4*x[i-1] + tanh(x[i-1]) + rnorm(1, sd = 0.5)
plot(x, type = "l", col = "steelblue")
test = wnnTest(x)
print(test)
p.value = as.vector(test@test$p.value)
# Is each of the two p.values smaller than 1e-4?
checkTrue(as.logical(mean(p.value < 1e-4)))
# Return Value:
return()
}
# ------------------------------------------------------------------------------
test.tnnTest =
function()
{
# Teraesvirta NN Test:
# See example from tseries Package:
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
x = runif(1000, -1, 1)
plot(x, type = "l", col = "steelblue")
test = tnnTest(x)
print(test)
p.value = as.vector(test@test$p.value)
# Is each of the two p.values greater 0.5?
checkTrue(as.logical(mean(p.value > 0.5)))
## Generate time series which is nonlinear in ``mean''
RNGkind(kind = "Marsaglia-Multicarry", normal.kind = "Inversion")
set.seed(4711, kind = "Marsaglia-Multicarry")
n = 1000
x = rep(0, times = n)
for(i in (2:n)) x[i] <- 0.4*x[i-1] + tanh(x[i-1]) + rnorm(1, sd = 0.5)
plot(x, type = "l", col = "steelblue")
test = tnnTest(x)
print(test)
p.value = as.vector(test@test$p.value)
# Is each of the two p.values smaller than 1e-4?
checkTrue(as.logical(mean(p.value < 1e-4)))
# Return Value:
return()
}
################################################################################
fNonlinear/tests/ 0000755 0001762 0000144 00000000000 13201353171 013503 5 ustar ligges users fNonlinear/tests/doRUnit.R 0000644 0001762 0000144 00000001644 11645005112 015216 0 ustar ligges 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)
}
################################################################################
fNonlinear/src/ 0000755 0001762 0000144 00000000000 13201353171 013130 5 ustar ligges users fNonlinear/src/Makevars 0000644 0001762 0000144 00000000056 13203345304 014626 0 ustar ligges users PKG_LIBS=$(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
fNonlinear/src/BDSTest.c 0000644 0001762 0000144 00000027730 13203345304 014556 0 ustar ligges users /*
Blake LeBaron
Dept. Of Economics
University Of Wisconsin-Madison
July 1988
March 1990
This software is distributed with the understanding that it is free.
Users may distribute it to anyone as long as they don't charge anything.
Also, the author gives this out without any support or
responsibility for errors of any kind. I hope that the
distribution of this software will further enhance are understanding
of these new measures of dependence.
*/
/* Changes for loading into R, A. Trapletti, 20.12.2000 */
#include
#include
#include
/* NBITS is the number of useable bits per word entry. Technically
on the sun this should be 32, as the sun uses 4 byte integers.
Since the counting algorithm uses a table lookup method we must
keep that table reasonable, so only 15 bits are used. This may be
changed if space is a problem.
*/
#define NBITS 15
#define ALLBITS 0xffff
#define PREC double
#define TABLEN 32767
static int BDS_DEBUG;
/* ----------- grid macro: turn bits on --------------------------- */
#define GRIDON(x,y) \
if(x!=y) { \
if(x>y) { \
ix = y; \
iy = x; \
} \
else { \
ix = x; \
iy = y; \
} \
iy = iy-ix-1; \
ipos = iy / NBITS; \
ibit = NBITS - 1 - (iy % NBITS); \
*(*(start+ix)+ipos) |= bits[ibit];\
}
/* define struct */
struct position {
PREC value;
int pos;
};
/* globals */
static int bits[NBITS],
*mask;
static short int *grid,
**start;
static int *lookup,first=1;
static struct position *postab,*postlast;
/*
free all memory allocations
*/
static void
freeall()
{
Free(grid);
Free(mask);
Free(postab);
Free(start);
Free(lookup);
}
/* module function definitions */
/*
generate mask
mask pattern for row l, nbits: number of bits used
omit: number of bits omitted
mask: mask[0],mask[1] two word mask
*/
static void
genmask(l,n,nbits,omit,mask)
int l,n,nbits,omit,mask[];
{
int i,k,j,last,itrue;
mask[0] = mask[1] = ALLBITS;
last = (n-l-1)/nbits;
for(i=n-omit;i 2 ) {
for (i = *(start+j);i< *(start+j+1)-2;i++) {
count += lookup[*i];
if(lookup[*i]>15)
Rprintf("%d %d %d\n", (int)(i-grid),*i,lookup[*i]);
}
for(i = *(start+j+1)-2;i< *(start+j+1);i++) {
count += lookup[ (*i) & mask[j*2+ *(start+j+1)-i-1]];
}
}
else {
for(i = *(start+j);i<*(start+j+1);i++) {
count += lookup[ (*i) & mask[j*2+ *(start+j+1)-i-1]];
}
}
}
if(BDS_DEBUG)
Rprintf("count = %ld\n",count);
return ( 2*((double)count)/ (nd*(nd-1)));
}
static
double
ipow(x,m)
double x;
int m;
{
int j;
double y;
y = 1;
for(j=0;jvalue>b->value)
return(1);
else if(a->valuevalue)
return(-1);
else
return(0);
}
static void
fkc(x,n,k,c,m,remove,eps)
PREC x[],eps;
int n,m,remove;
double *k,c[];
{
/* junk integers */
int i,j;
short int *ip;
int memsize;
int nobs;
/* pointers */
register struct position *pt;
struct position *p;
/* long counts */
long count,tcount;
/* double length */
double dlength;
double phi;
register int ix,iy,ibit,ipos;
nobs = n-remove;
dlength = (double)nobs;
/* allocate memory */
if(first ) {
mask = Calloc(2*n,int);
lookup = Calloc(TABLEN+1,int);
if(BDS_DEBUG)
Rprintf("set up grid\n");
postab = Calloc(n,struct position);
/* build start : grid pointers */
if(BDS_DEBUG)
Rprintf("build start\n");
start = Calloc(n+1,short int *);
/* find out how big grid has to be */
memsize = 0;
for(i=0;i<=n;i++)
memsize += (n-i)/NBITS + 1;
/* grid is defined as short (2 byte integers) */
grid = Calloc(memsize,short);
if(grid==NULL) {
error("Out of memory\n");
/*exit(-1);*/
}
start[0] = grid;
for(i=1;i<=n;i++)
start[i] = start[i-1] + (n-i)/NBITS + 1;
/* bit vector */
bits[0] = 1;
for(i=1;i<15;i++)
bits[i] = (bits[i-1] << 1);
/* table for bit countining */
if(BDS_DEBUG)
Rprintf("build lookup\n");
for(i=0;i<=TABLEN;i++){
*(lookup+i) = 0;
for(j=0;jvalue = x[i];
(postab+i)->pos = i;
}
if(BDS_DEBUG)
Rprintf("sort\n");
qsort((char *)postab,n,sizeof(struct position),comp);
postlast = postab+n-1;
/* start row by row construction */
/* use theiler method */
if(BDS_DEBUG)
Rprintf("set grid\n");
count = 0;
phi = 0;
for(p=postab;p<=postlast;p++) {
tcount = 0;
pt = p ;
/* count to right */
while( (pt->value - p->value)<=eps) {
GRIDON(p->pos,pt->pos);
if( (p->posposvalue - pt->value)<=eps) {
if( (p->posposiy){
temp = ix;
ix = iy;
iy = temp;
}
iy = iy-ix-1;
ipos = iy / NBITS;
ibit = NBITS - 1 - (iy % NBITS);
*(*(start+ix)+ipos) |= bits[ibit];
if( *(*(start+ix)+ipos)<0)
Rprintf("%d %d %d %d\n",ipos,ibit,ix,iy);
}
*/
/*
friendly front end - This main program is a friendly
front end program that calls the routines to calculate the
bds statistic. It allows unix user to:
1.) have an easy to use command imediately
2.) see how to use the calling routines for calculations
Users doing montecarlo work will probably want to use
the subroutines directly.
These routines are:
fkc(x,n,k,c,m,n,eps)
cstat(c,cm,k,m,n)
freeall()
fkc(x,n,k,c,m,mask,eps)
x = vector of series to test (double *), but it can be modified
using the PREC definition. Setting PREC to float or int, will
allow the use of other types of series.
n = length of series (int)
k = returned value of k (double *)
c = raw c values c[1],c[2],c[3].... (Note: the correct subscripts are used.)
(double *)
m = maximum embedding - cstats will calculated for i=1 to m (int)
mask = number of points to ignore at the end of the series.
Since the calculation of c(2) can effectively use more
points then c(3), c(4) ..., often the last several points
are ignored so that all statistics are calculated on the
same set of points. ie. for m=3 we might only use x(1) through
x(n-2) for the calculations of c(2) and c(3). This is generally
set to m-1 to allow all c to be estimated on a point set of
n-m+1. (int)
eps = epsilon value for close points (double) or set to (PREC).
cstat(c,cm,k,m,n)
This simple routine calculates the standard error and the normalized
bds stat. It closely follows formulas in Brock Hsieh and LeBaron
on page 43.
c = c[1] c for embedding 1
cm = c[m] c for embedding m
k = k stat
m = embedding
n = length of series
freeall()
The fkc algorithm allocates large amounts of memory. This is
time consuming and for montecarlo simulations it is not desirable
to reallocate every time. The routine can tell whether it needs
to reallocate. For simulations fkc should be called repeatedly.
When the program is finally done freeall() should be called
to free all the allocated space.
This front end module can be removed from the begin front
end comment to the end front end comment. The remaining
routines can be compiled as a stand alone library to be
called by other programs.
fkc_slow()
This extra routine is also included. It is a slower algorithm
which performs exactly the same function as fkc. Its only advantage
is that it is simpler and requires much less memory than the fast
algorithm.
To implement it just replace the call to fkc with fkc_slow() the
arguments are exactly the same.
*/
/* begin front end ---------------------------------- */
void bdstest_main (int *N, int *M, double *x, double *c, double *cstan, double *EPS, int *TRACE)
{
int i;
double k;
int n, m;
double eps;
n = (*N);
m = (*M);
eps = (*EPS);
BDS_DEBUG = (*TRACE);
/* calculate raw c and k statistics : This is the hard part */
fkc(x,n,&k,c,m,m-1,eps);
if(BDS_DEBUG) {
Rprintf("k = %f\n",k);
for(i=1;i<=m;i++) {
Rprintf("c(%d) %f\n",i,c[i]);
}
}
/* calculate normalized stats: This is the easy part */
for(i=2;i<=m;i++) {
cstan[i] = cstat(c[1],c[i],k,i,n-m+1);
}
/* free allocated memory: This must be done when finished */
freeall();
}
/* end front end ------------------------------------------*/
fNonlinear/src/Tisean.c 0000644 0001762 0000144 00000021103 13203345304 014515 0 ustar ligges users /* -------------------------------------------------------------------------- */
#ifndef tseriesChaos_h
#define tseriesChaos_h
#include
#include
#define sqr(a) (a)*(a)
#define MIN(a,b) (a)<(b) ? (a) : (b)
#define MAX(a,b) (a)>(b) ? (a) : (b)
#endif
/* -------------------------------------------------------------------------- */
void C2(double *in_series, int *in_m, int *in_d, int *in_length,
int *in_t, double *in_eps, double *out)
{
double *series;
double eps, tmp;
int m, d, length;
long blength;
int i, j, w, t, md;
series = in_series;
m = *in_m;
d = *in_d;
t = *in_t;
eps = *in_eps;
eps = sqr(eps);
length = *in_length;
blength = length - (m-1)*d;
md = m*d; *out=0;
for(i=0; i=eps) continue;
id++;
dst = ( dst + sqr(series[i+w+d] - series[j+w+d]) )/ dst;
if (dst>rt) num++;
}
denum+=id;
}
(*out) = (double)num/(double)denum;
(*out2)= denum;
}
/* -------------------------------------------------------------------------- */
#define output2(a,b) out[(b)*ref + (a)]
void find_nearest(double *in_series, int *in_m, int *in_d, int *in_t,
int *in_length, double *in_eps, int *in_ref, int *in_k, int *in_s,
int *out)
{
double eps, *series;
int m,d, t, s, ref, k, length, blength;
int i,j,w,md;
double *dsts;
int id; int *ids;
/*
BIND PARAMETERS
*/
m = *in_m;
d = *in_d;
t = *in_t;
s = *in_s;
ref=*in_ref;
k = *in_k;
eps=*in_eps;
series=in_series;
length=*in_length;
/**/
blength = length - (m-1)*d - s;
md = m*d;
for(i = 0; i=eps) continue;
ids[id] = j;
id++;
}
R_qsort_I(dsts, ids, 1, id);
for(j=0; (j
# License: GPL version 2 or newer
# Packaged: Sun Jul 24 10:58:36 2005; antonio
# CONTENT:
# 1. PHASE SPACE REPRESENTATION
# 2. NON STATIONARITY
# 3. LYAPUNOV EXPONENTS
# 4. DIMENSIONS AND ENTROPY
################################################################################
mutualPlot =
function(x, partitions = 16, lag.max = 20, doplot = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Estimate the mutual information index of a given time
# series for a specified number of lags
# Arguments:
# x - a numeric vector, or an object either of class 'ts' or
# of class 'timeSeries'.
# partitions - an integer value setting the number of bins, by
# default 16.
# lag.max - an integer value setting the number of
# maximum lags, by default 20/
# doplot - a logical flag. Should a plot be displayed?
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# FUNCTION:
# Settings:
if (class(x) == "timeSeries") x = as.vector(x)
x = as.ts(x)
series = (x-min(x))/(diff(range(x)))
corr = numeric(lag.max+1)
# Mutual Information:
for(i in 0:lag.max) {
hist = matrix(0, partitions, partitions)
hist = .C("mutual",
series = as.double(series),
length = as.integer(length(series)),
lag = as.integer(i),
partitions = as.integer(partitions),
hist = as.double(hist),
PACKAGE = "fNonlinear")[["hist"]]
hist = matrix(hist, partitions, partitions)/sum(hist)
histx = apply(hist, 1, sum)
hist = hist[hist != 0]
histx<- histx[histx != 0]
corr[i+1] = sum(hist*log(hist)) - 2*sum(histx*log(histx))
}
names(corr) = paste(0:lag.max)
# Plot:
if (doplot) {
plot(0:lag.max, corr, xlab = "Lag", type = "b", pch = 19, cex = 0.25,
col = "steelblue", main = "Mutual Information", ...)
}
# Return Value:
corr
}
# ------------------------------------------------------------------------------
.embeddPSR =
function(x, m, d)
{ # A function implemented by Diethelm Wuertz
# Description:
# Embeds a time series given time delay and dimension parameters.
# Arguments
# x - time series
# m - embedding dimension
# d - time delay
# Value:
# Matrix with columns corresponding to lagged time series.
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# FUNCTION:
.checkEmbParms(x, m, d)
n = length(x) - (m-1)*d
res = matrix(0, n, m)
for(i in 1:m) res[,i] = x[((i-1)*d+1):(n+(i-1)*d)]
# Return Value:
res
}
# ------------------------------------------------------------------------------
.checkEmbParms =
function(series, m, d, t = 0, s = 1, ref = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Checks embedding parameters
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# FUNCTION:
n = length(series)-(m-1)*d
if (n <= 0)
stop("Not enough points to handle these parameters")
if (!is.null(ref)) if (ref > n)
stop("Not enough points to handle these parameters")
if (t < 0)
stop("Theiler window t must be non-negative")
if (s <= 0)
stop("Number of steps must be positive")
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
falsennPlot =
function(x, m, d, t, rt = 10, eps = NULL, doplot = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Use the method of false nearest neighbours to help deciding
# the optimal embedding dimension
# Arguments:
# x - time series
# m - maximum embedding dimension
# d - delay parameter
# t - Theiler window
# rt - escape factor
# eps - neighborhood diameter
# Value:
# Fraction of false neighbors (first row) and total number of
# neighbors (second row) for each specified embedding dimension
# (columns)
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# FUNCTION:
# Settings:
if (class(x) == "timeSeries") x = as.vector(x)
series = as.ts(x)
if (is.null(eps)) eps = sd(series)/10
res = numeric(m)
res2 = numeric(m)
# False Nearest Neigbours:
for(i in 1:m) {
a = .C("falseNearest",
series = as.double(series),
length = as.integer(length(series)),
m = as.integer(i),
d = as.integer(d),
t = as.integer(t),
eps = as.double(eps),
rt = as.double(rt),
out = as.double(res[i]),
out2 = as.integer(res2[i]),
PACKAGE = "fNonlinear")
res[i] = a[["out"]]
res2[i]= a[["out2"]]
}
res = rbind(res, res2)
rownames(res) = c("fraction", "total")
colnames(res) = paste("m", 1:m, sep = "")
# Plot:
if (doplot) {
plot(res[1, ], type = "b", col = "steelblue", pch = 19,
cex = 0.25, xlab = "Dimension", ylab = "Fraction of ffn",
main = "False Nearest Neigbours", ...)
}
# Return Value:
res
}
################################################################################
recurrencePlot =
function(x, m, d, end.time, eps, nt = 10, doplot = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Creates a recurrence plot
# Arguments
# x - time series
# m - embedding dimension
# d - time delay
# end.time - ending time (as no. of observations)
# eps - neighbourhood threshold
# nt - observations in each step
# ... - further parameters to be passed to plot
# Value:
# Produces the recurrence plot, as proposed by Eckmann et al. (1987).
# To reduce the number of points plotted (especially with highly
# sampled data), each nt observations, one single point is plotted.
# FUNCTION:
# Settings:
if (class(x) == "timeSeries") x = as.vector(x)
series = as.ts(x)
w = (0:(m-1))*d
.dist = function(i, j) { sum((series[i+w]-series[j+w])^2) }
.checkEmbParms(series, m, d)
if (eps <= 0) stop("eps must be positive")
nt = as.integer(nt)
if (nt<=0) nt = 1
n = length(series)-(m-1)*d
if(end.time > n) end.time = n
eps = eps^2
xyz = .embeddPSR(series, m = m, d = d)[1:end.time, ]
# Plot:
if (doplot) {
plot(0, xlim = c(0, end.time), ylim = c(0, end.time), type = "n",
main = "Recurrence Plot", xlab = "i", ylab = "j")
for(i in seq(1, end.time, by = nt))
for(j in seq(i,end.time, by = nt))
if(.dist(i,j) < eps) points(c(i, j), c(j, i), ...)
}
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
separationPlot =
function(x, m, d, mdt, idt = 1, doplot = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Creates a space-time separation plot
# Arguments:
# x - time series
# m - embedding dimension
# d - time delay
# idt - observation steps in each iteration
# mdt - number of iterations
# Value:
# Returns lines of costant probability at 10%, 20%, ..., 100%.
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# FUNCTION:
# Settings:
if (class(x) == "timeSeries") x = as.vector(x)
series = as.ts(x)
.checkEmbParms(series, m, d)
# Space Time Separations:
eps.max = diff(range(series))*sqrt(m)
res = matrix(0, 10, mdt)
res = .C("stplot",
series = as.double(series),
length = as.integer(length(series)),
m = as.integer(m),
d = as.integer(d),
mdt = as.integer(mdt),
idt = as.integer(idt),
eps.max = as.double(eps.max),
res = as.double(res),
PACKAGE = "fNonlinear")[["res"]]
stp = matrix(res, 10, mdt)
eps.m = min(stp)
eps.M = max(stp)
# Plot:
if (doplot) {
plot(0, xlim = c(0, mdt*idt/frequency(series)),
ylim = c(eps.m*0.99, eps.M*1.01),
xlab = "Time", ylab = "Distance", type = "n",
main = "Space-time Separation Plot")
x = seq(1/frequency(series), mdt*idt/frequency(series),
by = idt/frequency(series))
for(i in 1:10) lines(x, stp[i, ], col = "steelblue")
}
# Return Value:
invisible(stp)
}
################################################################################
lyapunovPlot =
function(x, m, d, t, ref, s, eps, k = 1, doplot = TRUE, ...)
{ # A function implemented by Diethelm Wuertz
# Description:
# Evaluate the maximal Lyapunov exponent of a dynamic system
# from an univariate time series
# Arguments
# x - time series
# m - embedding dimension
# d - time delay
# k - number of considered neighbours
# eps - radius where to find nearest neighbours
# s - iterations along which follow the neighbours of each point
# ref - number of points to take into account
# t - Theiler window
# Value:
# Returns the logarithm of the stretching factor in time.
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# Example:
# output = lyapunovPlot(lorenz.ts, m = 3, d = 2, s = 200, t = 40,
# ref = 1700, k = 2, eps = 4)
# FUNCTION:
# Settings:
if (class(x) == "timeSeries") x = as.vector(x)
series = as.ts(x)
.checkEmbParms(series, m, d, t, s, ref)
n = length(series) - (m-1)*d - s
if(ref < 0) ref = n
trash = numeric()
ref = 1:ref
# Finding Nearest Neighbours:
cat("Finding nearests\n")
nearest = .find.nearest(series, m = m, d = d, t = t, ref = length(ref),
s = s, eps = eps, k = k)
trash = apply(nearest, 1, function(x) any(is.na(x)))
ref = ref[!trash]
if(length(ref) == 0)
stop("not enough neighbours found")
cat("Keeping ", length(ref)," reference points\n")
# Following Points:
cat("Following points\n")
res = .follow.points(series, m = m, d = d, s = s, ref = ref,
nearest = nearest, k = k)
ans = ts(res, frequency = frequency(series), start = 0)
# Plot:
if (doplot) {
plot(ans, col = "steelblue", main = "Max Lyapunov Exponents", ...)
}
# Return Value:
ans
}
# ------------------------------------------------------------------------------
.find.nearest =
function(series, m, d, t, eps, ref, k, s)
{ # A function implemented by Diethelm Wuertz
# Description:
# Internal Function called by 'lyapunovPlot'
# Arguments:
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# FUNCTION:
# Find Nearest:
res = numeric(ref*k)
res = .C("find_nearest",
series = as.double(series),
m = as.integer(m),
d = as.integer(d),
t = as.integer(t),
length = as.integer(length(series)),
eps = as.double(eps),
ref = as.integer(ref),
k = as.integer(k),
s = as.integer(s),
res = as.integer(res),
PACKAGE = "fNonlinear")[["res"]]
res[res == -1] = NA
# Return Value:
matrix(res, ref, k)
}
# ------------------------------------------------------------------------------
.follow.points =
function(series, m, d, ref, k, s, nearest)
{ # A function implemented by Diethelm Wuertz
# Description:
# Internal Function called by 'lyapunovPlot'
# Arguments:
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# FUNCTION:
# Follow Points:
res = numeric(s)
nearest[is.na(nearest)] = -1
ans = .C("follow_points",
series = as.double(series),
m = as.integer(m),
d = as.integer(d),
length = as.integer(length(series)),
nref = as.integer(length(ref)),
nrow = as.integer(nrow(nearest)),
k = as.integer(k),
s = as.integer(s),
nearest = as.integer(nearest),
ref = as.integer(ref),
res = as.double(res),
PACKAGE = "fNonlinear")[["res"]]
# Return Value:
ans
}
# ------------------------------------------------------------------------------
.lyapunovFit =
function(x, start, end)
{ # A function implemented by Diethelm Wuertz
# Description:
# Lyapunov Fit
# Arguments:
# x - Should be the output of a call to lyap_k (see the example)
# start - Starting time of the linear bite of dsts
# end - Ending time of the linear bite of dsts
# Value:
# Returns the regression coefficients of the specified input sequence.
# Author:
# Antonio, Fabio Di Narzo
# of the original function from the 'tseriesChaos' package
# Example:
# lyapunovFit(output, start = 0.73, end = 2.47)
# FUNCTION:
# Settings:
dsts = as.ts(x)
sf = window(dsts, start, end)
start = start(sf)[1] + (start(sf)[2]-1)/frequency(sf)
end = end(sf)[1] + (end(sf)[2]-1)/frequency(sf)
lambda = seq(start, end, by = 1/frequency(dsts))
# Fit:
ans = lm(sf ~ lambda, data = data.frame(sf = sf, lambda = lambda))$coeff
# Return Value:
ans
}
################################################################################
# DIMENSIONS AND ENTROPY:
.C2 =
function(x, m, d, t, eps)
{
# Settings:
if (class(x) == "timeSeries") x = as.vector(x)
series = as.ts(x)
.checkEmbParms(series, m, d, t)
if (eps <= 0) stop("eps must be positive")
res = numeric(1)
# C2:
ans = .C("C2",
series = as.double(series),
m = as.integer(m),
d = as.integer(d),
length = as.integer(length(series)),
t = as.integer(t),
eps = as.double(eps),
res = as.double(res),
PACKAGE = "fNonlinear")[["res"]]
# Return Value:
ans
}
# ------------------------------------------------------------------------------
.d2 =
function(series, m, d, t, eps.min, neps = 100)
{
# Settings:
if (class(x) == "timeSeries") x = as.vector(x)
series = as.ts(x)
.checkEmbParms(series, m, d, t)
if (eps.min <= 0) stop("eps.min must be positive")
neps = as.integer(neps)
if (neps <= 0) neps = 100
res = numeric(neps*m)
eps.max = diff(range(series))*sqrt(m)
# d2:
res = .C("d2",
series = as.double(series),
length = as.integer(length(series)),
m = as.integer(m), d = as.integer(d),
t = as.integer(t), neps = as.integer(neps),
eps.max = as.double(eps.max),
eps.min = as.double(eps.min),
res = as.double(res),
PACKAGE = "fNonlinear")[["res"]]
res = matrix(res, neps, m)
res = res[neps:1,]
denom = length(series) - (m-1)*d
denom = (denom-t+1)*(denom-t)/2
res = apply(res, 2, cumsum)/denom
a = -log(eps.min/eps.max)/(neps-1)
eps = eps.max*exp((1-1:neps)*a)
eps = eps[neps:1]
res = cbind(eps, res)
colnames(res) = c("eps",paste("m", 1:m, sep = ""))
plot(res[ , c(1,m+1)], type = "l", log = "xy",
main = "Sample correlation integral",
xlab = expression(epsilon), ylab = expression(C(epsilon)))
for (i in m:2) lines(res[,c(1, i)])
# Return Value:
invisible(res)
}
################################################################################
fNonlinear/R/NonLinTests.R 0000644 0001762 0000144 00000031030 12323220002 015070 0 ustar ligges users
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program 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
# General Public License for more details.
#
# A copy of the GNU General Public License is available via WWW at
# http://www.gnu.org/copyleft/gpl.html. You can also obtain it by
# writing to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA.
################################################################################
# FUNCTION: DESCRIPION:
# tsTest Time Series Test Suite
# FUNCTION: DEPENDENCY TEST:
# bdsTest Brock-Dechert-Scheinkman test for iid series
# FUNCTION: NONLINEARITY TESTS:
# wnnTest White Neural Network Test for Nonlinearity
# tnnTest Teraesvirta Neural Network Test for Nonlinearity
# FUNCTION: MORE TESTS ...
# runsTest Runs test for detecting non-randomness [tseries]
################################################################################
################################################################################
# BUILTIN - PACKAGE DESCRIPTION:
# Package: tseries
# Version: 0.9-21
# Date: 2004-04-23
# Title: Time series analysis and computational finance
# Author: Compiled by Adrian Trapletti
# Maintainer: Kurt Hornik
# Description: Package for time series analysis and computational finance
# Depends: R (>= 1.9.0), quadprog
# License: GPL (see file COPYING)
# Packaged: Thu Apr 22 16:32:16 2004; hornik
# Notes: The runs.test is available as dependency test in the fBasics
# Package runs.test = function (x)
# Most of the functions are BUILTIN from Adrian Trapletti's R package
# tseries
################################################################################
################################################################################
# REQUIREMENTS: DESCRIPTION:
# embed Required from fBasics.A0-SPlusCompatibility
################################################################################
tsTest =
function(x,
method = c("bds", "tnn", "wnn"), ...)
{ # A function implemented by Diethelm Wuertz
# Load Library:
# require(tseries)
# Check Type:
if (class(x) == "timeSeries") {
if (dim(x)[2] > 1) stop("x must be an univariate time series")
}
x = as.vector(x)
# Settings:
method = match.arg(method)
test = paste(method, "Test", sep = "")
fun = match.fun(test)
# Test:
ans = fun(x = x, ...)
# Return Value:
ans
}
# ------------------------------------------------------------------------------
bdsTest =
function(x, m = 3, eps = NULL, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Brock-Dechert-Scheinkman test for iid series
# Notes:
# This function is a slightly modified copy of Adrian Trapletti's
# contributed function from his 'tseries' package.
# FUNCTION:
# Call:
call = match.call()
# Test
test = list()
# Data Set Name:
DNAME = deparse(substitute(x))
test$data.name = DNAME
# Check Type:
if (class(x) == "timeSeries") {
if (dim(x)[2] > 1) stop("x must be an univariate time series")
}
x = as.vector(x)
# Test:
if (is.null(eps)) eps = seq(0.5*sd(x), 2*sd(x), length = 4)
if (m < 2) stop("m is less than 2")
if (length(eps) == 0) stop("invalid eps")
if (any(eps <= 0)) stop("invalid eps")
n = length(x)
k = length(eps)
cc = double(m+1)
cstan = double(m+1)
# Statistic:
STATISTIC = NULL
NAMES = NULL
for(i in (1:k)) {
res = .C("bdstest_main", as.integer(n), as.integer(m),
as.double(x), as.double(cc), cstan = as.double(cstan),
as.double(eps[i]), as.integer(0), PACKAGE = "fNonlinear")
ans = res$cstan[2:m+1]
STATISTIC = c(STATISTIC, ans)
names.1 = rep(paste("eps[", i, "]", sep = ""), times = length(ans))
names.2 = paste("m=", as.character(2:m), sep = "")
NAMES = c(NAMES, paste(names.1, names.2))
}
# colnames(STATISTIC) = as.character(eps)
# rownames(STATISTIC) = as.character(2:m)
names(STATISTIC) = NAMES
test$statistic = STATISTIC
# P Value:
PVAL = 2 * pnorm(-abs(STATISTIC))
names(PVAL) = names(STATISTIC)
# colnames(PVAL) = as.character(eps)
# rownames(PVAL) = as.character(2:m)
test$p.value = PVAL
# METHOD = "BDS Test"
PARAMETER = c(m, eps)
names(PARAMETER) = c(
"Max Embedding Dimension",
paste("eps[", 1:length(eps), "]", sep = "") )
test$parameter = PARAMETER
# Add:
if (is.null(title)) title = "BDS Test"
if (is.null(description)) description = description()
# Return Value:
new("fHTEST",
call = call,
data = list(x = x),
test = test,
title = as.character(title),
description = as.character(description) )
}
# ------------------------------------------------------------------------------
wnnTest =
function(x, lag = 1, qstar = 2, q = 10, range = 4,
title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# White's Neural Network Test for Nonlinearity
# Notes:
# This function is a slightly modified copy of Adrian Trapletti's
# contributed function from his 'tseries' package.
# FUNCTION:
# Call:
CALL = match.call()
# Test
test = list()
# Data Set Name:
DNAME = deparse(substitute(x))
test$data.name = DNAME
# Check Type:
if (class(x) == "timeSeries") {
if (dim(x)[2] > 1) stop("x must be an univariate time series")
}
x = as.vector(x)
# Test - This part comes from A. Trapletti's Code:
if (lag < 1) stop("minimum lag is 1")
t = length(x)
y = embed(x, lag + 1)
xnam = paste("y[,", 2:(lag+1), "]", sep = "")
fmla = as.formula(paste("y[,1]~", paste(xnam, collapse = "+")))
rr = lm(fmla)
u = residuals(rr)
ssr0 = sum(u^2)
max = range/2
gamma = matrix(runif ((lag+1)*q, -max, max), lag+1, q)
phantom = (1 + exp(-(cbind(rep(1, t-lag), y[, 2:(lag+1)]) %*% gamma)))^(-1)
# Changed to be compatible with SPlus:
# phantomstar = as.matrix(prcomp(phantom, scale = TRUE)$x[, 2:(qstar+1)])
phantomstar = as.matrix(prcomp(scale(phantom))$x[, 2:(qstar+1)])
xnam2 = paste("phantomstar[,", 1:qstar, "]", sep = "")
xnam2 = paste(xnam2, collapse = "+")
fmla = as.formula(paste("u~", paste(paste(xnam, collapse = "+"),
xnam2, sep = "+")))
rr = lm(fmla)
v = residuals(rr)
ssr = sum(v^2)
# Statistic:
STATISTIC1 = t * log(ssr0/ssr)
STATISTIC2 = ((ssr0-ssr)/qstar)/(ssr/(t-lag-qstar))
STATISTIC = c(STATISTIC1, STATISTIC2)
names(STATISTIC) = c("Chi-squared", "F")
test$statistic = STATISTIC
# P Values:
PVAL1 = 1 - pchisq(STATISTIC1, qstar)
PVAL2 = 1 - pf(STATISTIC2, qstar, t-lag-qstar)
PVAL = c(PVAL1, PVAL2)
names(PVAL) = c("Chi-squared", "F")
test$p.value = PVAL
# Parameter:
PARAMETER = c(lag, q, range, qstar, t-lag-qstar)
names(PARAMETER) = c("lag", "q", "range", "qstar|df", "t-lag-qstar|df")
test$parameter = PARAMETER
# Add:
if (is.null(title)) title = "White Neural Network Test"
if (is.null(description)) description = description()
# Return Value:
new("fHTEST",
call = CALL,
data = list(x = x, y = y),
test = test,
title = as.character(title),
description = as.character(description) )
}
# ------------------------------------------------------------------------------
tnnTest =
function(x, lag = 1, title = NULL, description = NULL)
{ # A function implemented by Diethelm Wuertz
# Description:
# Teraesvirta's Neural Network Test for Nonlinearity
# Notes:
# This function is a slightly modified copy of Adrian Trapletti's
# contributed function from his 'tseries' package.
# FUNCTION:
# Call:
call = match.call()
# Test
test = list()
# Data Set Name:
DNAME = deparse(substitute(x))
test$data.name = DNAME
# Check Type:
if (class(x) == "timeSeries") {
if (dim(x)[2] > 1) stop("x must be an univariate time series")
}
x = as.vector(x)
# Test - This part comes from A. Trapletti's Code:
if (lag < 1) stop("minimum lag is 1")
t = length(x)
y = embed(x, lag+1)
xnam = paste("y[,", 2:(lag+1), "]", sep = "")
fmla = as.formula(paste("y[,1]~", paste(xnam, collapse = "+")))
rr = lm(fmla)
u = residuals(rr)
ssr0 = sum(u^2)
xnam2 = NULL
m = 0
for (i in (1:lag)) {
for (j in (i:lag)) {
xnam2 = c(xnam2, paste("I(y[,",i+1, "]*y[, ",j+1,"])", sep = ""))
m = m+1
}
}
xnam2 = paste(xnam2, collapse="+")
xnam3 = NULL
for (i in (1:lag)) {
for (j in (i:lag)) {
for (k in (j:lag)) {
xnam3 = c(xnam3,
paste("I(y[,", i+1, "]*y[,", j+1, "]*y[,", k+1, "])", sep = ""))
m = m+1
}
}
}
xnam3 = paste(xnam3,collapse="+")
fmla = as.formula(paste("u~", paste(paste(xnam, collapse = "+"),
xnam2, xnam3, sep = "+")))
rr = lm(fmla)
v = residuals(rr)
ssr = sum(v^2)
#Statistic:
STATISTIC1 = t*log(ssr0/ssr)
STATISTIC2 = ((ssr0-ssr)/m)/(ssr/(t-lag-m))
STATISTIC = c(STATISTIC1, STATISTIC2)
names(STATISTIC) = c("Chi-squared", "F")
test$statistic = STATISTIC
# P Value:
PVAL1 = 1 - pchisq(STATISTIC1, m)
PVAL2 = 1 - pf(STATISTIC2, m, t-lag-m)
PVAL = c(PVAL1, PVAL2)
names(PVAL) = c("Chi-squared", "F")
test$p.value = PVAL
# PARAMETER:
PARAMETER = c(lag, m, t-lag-m)
names(PARAMETER) = c("lag", "m|df", "t-lag-m|df")
test$parameter = PARAMETER
# Add:
if (is.null(title)) title = "Teraesvirta Neural Network Test"
if (is.null(description)) description = description()
# Return Value:
new("fHTEST",
call = call,
data = list(x = x),
test = test,
title = as.character(title),
description = as.character(description) )
}
################################################################################
runsTest =
function(x)
{ # A function implemented by Diethelm Wuertz
# Description:
# Performs a runs test
# Arguments:
# x - a numeric vector of data values.
# Notes:
# Implementing Trapletti's tseries R-Package
# Note:
# We consider the signs of x in the series, the zeros will be
# discarded. In addition we have to factor the data for runs.test().
# FUNCTION:
# Convert Type:
if (class(x) == "fREG") x = residuals(x)
x = as.vector(x)
# runs.test() copied from A. Traplettis tseries package
runs.test =
function (x, alternative = c("two.sided", "less", "greater"))
{
if (!is.factor(x)) stop("x is not a factor")
if (any(is.na(x))) stop("NAs in x")
if (length(levels(x)) != 2) stop("x does not contain dichotomous data")
alternative = match.arg(alternative)
DNAME = deparse(substitute(x))
n = length(x)
R = 1 + sum(as.numeric(x[-1] != x[-n]))
n1 = sum(levels(x)[1] == x)
n2 = sum(levels(x)[2] == x)
m = 1 + 2 * n1 * n2/(n1 + n2)
s = sqrt(2 * n1 * n2 * (2 * n1 * n2 - n1 - n2)/((n1 + n2)^2 *
(n1 + n2 - 1)))
STATISTIC = (R - m)/s
METHOD = "Runs Test"
if (alternative == "two.sided")
PVAL = 2 * pnorm(-abs(STATISTIC))
else if (alternative == "less")
PVAL = pnorm(STATISTIC)
else if (alternative == "greater")
PVAL = pnorm(STATISTIC, lower.tail = FALSE)
else stop("irregular alternative")
names(STATISTIC) = "Standard Normal"
structure(list(
statistic = STATISTIC,
alternative = alternative,
p.value = PVAL,
method = METHOD,
data.name = DNAME),
class = "htest") }
# Result:
x = sign(x)
x = x[x != 0]
x = factor(x)
ans = runs.test(x = x)
# Return Value:
ans
}
################################################################################
fNonlinear/R/NonLinModelling.R 0000644 0001762 0000144 00000030554 12323220002 015712 0 ustar ligges users
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program 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
# General Public License for more details.
#
# A copy of the GNU General Public License is available via WWW at
# http://www.gnu.org/copyleft/gpl.html. You can also obtain it by
# writing to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA.
################################################################################
# FUNCTION: CHAOTIC TIME SERIES MAPS:
# tentSim Simulates series from Tent map
# henonSim Simulates series from Henon map
# ikedaSim Simulates series from Ikeda map
# logisticSim Simulates series from Logistic map
# lorentzSim Simulates series from Lorentz map
# roesslerSim Simulates series from Roessler map
# .rk4 Internal Funtion - Runge-Kutta Solver
################################################################################
tentSim =
function(n = 1000, n.skip = 100, parms = c(a = 2), start = runif(1),
doplot = FALSE)
{ # A function implemented by Diethelm Wuertz
# Description:
# Simulate Data from Tent Map
# Arguments:
# n - number of points x, y
# n.skip - number of transients discarded
# start - initial x
# Details:
# Creates iterates of the Tent map:
# * x(n+1) = a * x(n) if x(n) < 0.5
# * x(n+1) = a * ( 1 - x(n)) if x(n) >= 0.5
# FUNCTION:
# Simulate Map:
a = parms[1]
if (a == 2) a = a - .Machine$double.eps
x = rep(0, times = (n+n.skip))
i = 1
x[i] = start
for ( i in 2:(n+n.skip) ) {
x[i] = (a/2) * ( 1 - 2*abs(x[i-1]-0.5) )
}
x = x[(n.skip+1):(n.skip+n)]
# Plot Map:
if (doplot) {
# Time Series Plot:
# plot(x = x, type = "l", xlab = "n", ylab = "x[n]",
# main = paste("Tent Map \n a =", as.character(a)),
# col = "steelblue")
# abline(h = 0.5, col = "grey", lty = 3)
# Delay Plot:
plot(x[-n], x[-1], xlab = "x[n]", ylab = "x[n+1]",
main = paste("Tent Map\n a =", as.character(a)),
cex = 0.25, col = "steelblue")
}
# Return Value:
ts(x)
}
# ------------------------------------------------------------------------------
henonSim =
function(n = 1000, n.skip = 100, parms = c(a = 1.4, b = 0.3),
start = runif(2), doplot = FALSE)
{ # A function implemented by Diethelm Wuertz
# Description:
# Simulate Data from Henon Map
# Arguments:
# n - number of points x, y
# n.skip - number of transients discarded
# a - parameter a
# b - parameter b
# start[1] - initial x
# start[2] - initial y
# Details:
# Creates iterates of the Henon map:
# * x(n+1) = 1 - a*x(n)^2 + b*y(n)
# * y(n+1) = x(n)
# FUNCTION:
# Simulate Map:
a = parms[1]
b = parms[2]
x = rep(0, times = (n+n.skip))
y = rep(0, times = (n+n.skip))
x[1] = start[1]
y[1] = start[2]
for ( i in 2:(n+n.skip) ) {
x[i] = 1 - a*x[i-1]^2 + b*y[i-1]
y[i] = x[i-1] }
x = x[(n.skip+1):(n.skip+n)]
y = y[(n.skip+1):(n.skip+n)]
# Plot Map:
if (doplot) {
# Time Series Plot:
# ...
# Delay Plot:
plot(x = x, y = y, type = "n", xlab = "x[n]", ylab = "y[n]",
main = paste("Henon Map \n a =", as.character(a),
" b =", as.character(b)) )
points(x = x, y = y, col = "steelblue", cex = 0.25)
}
# Return Value:
ts(cbind(x, y))
}
# ------------------------------------------------------------------------------
ikedaSim =
function(n = 1000, n.skip = 100, parms = c(a = 0.4, b = 6.0, c = 0.9),
start = runif(2), doplot = FALSE)
{ # A function written by Diethelm Wuertz
# Description:
# Simulate Ikeda Map Data
# Arguments:
# n - number of points z
# n.skip - number of transients discarded
# a - parameter a
# b - parameter b; 6.0
# c - parameter c; 0.9
# start[1] - initial Re(z)
# start[2] - initial Im(z)
# Details:
# Prints iterates of the Ikeda map (Re(z) and Im(z)):
# i*b
# z(n+1) = 1 + c*z(n)* exp( i*a - ------------ )
# 1 + |z(n)|^2
# FUNCTION:
# Simulate Map:
A = a = parms[1]
B = b = parms[2]
C = c = parms[3]
a = complex(real = 0, imaginary = a)
b = complex(real = 0, imaginary = b)
z = rep(complex(real = start[1], imaginary = start[2]), times = (n+n.skip))
for ( i in 2:(n+n.skip) ) {
z[i] = 1 + c*z[i-1] * exp(a-b/(1+abs(z[i-1])^2)) }
z = z[(n.skip+1):(n.skip+n)]
# Plot Map:
if (doplot) {
x = Re(z)
y = Im(z)
plot(x, y, type = "n", xlab = "x[n]", ylab = "y[n]",
main = paste("Ikeda Map \n", "a =", as.character(A),
" b =", as.character(B), " c =", as.character(C)) )
points(x, y, col = "steelblue", cex = 0.25)
x = Re(z)[1:(length(z)-1)]
y = Re(z)[2:length(z)]
plot(x, y, type = "n", xlab = "x[n]", ylab = "x[n+1]",
main = paste("Ikeda Map \n", "a =", as.character(A),
" b =", as.character(B), " c =", as.character(C)) )
points(x, y, col = "steelblue", cex = 0.25) }
# Return Value:
ts(cbind(Re = Re(z), Im = Im(z)))
}
# ------------------------------------------------------------------------------
logisticSim =
function(n = 1000, n.skip = 100, parms = c(r = 4), start = runif(1),
doplot = FALSE)
{ # A function written by Diethelm Wuertz
# Description:
# Simulate Data from Logistic Map
# Arguments:
# n - number of points x, y
# n.skip - number of transients discarded
# r - parameter r
# start - initial x
# Details:
# Creates iterates of the Logistic Map:
# * x(n+1) = r * x[n] * ( 1 - x[n] )
# FUNCTION:
# Simulate Map:
r = parms[1]
x = rep(0, times = (n+n.skip))
x[1] = start
for ( i in 2:(n+n.skip) ) {
x[i] = r * x[i-1] * ( 1 - x[i-1] ) }
x = x[(n.skip+1):(n.skip+n)]
# Plot Map:
if (doplot) {
plot(x = x[1:(n-1)], y = x[2:n], type = "n", xlab = "x[n-1]",
ylab = "x[n]", main = paste("Logistic Map \n r =",
as.character(r)) )
points(x = x[1:(n-1)], y = x[2:n], col = "steelblue", cex = 0.25) }
# Return Value:
ts(x)
}
# ------------------------------------------------------------------------------
lorentzSim =
function(times = seq(0, 40, by = 0.01), parms = c(sigma = 16, r = 45.92, b = 4),
start = c(-14, -13, 47), doplot = TRUE, ...)
{ # A function written by Diethelm Wuertz
# Description:
# Simulates a Lorentz Map
# Notes:
# Requires rk4 from R package "odesolve"
# FUNCTION:
# Requirements:
# BUILTIN - require(odesolve)
# Settings:
sigma = parms[1]
r = parms[2]
b = parms[3]
# Attractor:
lorentz =
function(t, x, parms) {
X = x[1]
Y = x[2]
Z = x[3]
with(as.list(parms), {
dX = sigma * ( Y - X )
dY = -X*Z + r*X - Y
dZ = X*Y - b*Z
list(c(dX, dY, dZ))})
}
# Classical RK4 with fixed time step:
s = .rk4(start, times, lorentz, parms)
# Display:
if (doplot) {
xylab = c("x", "y", "z", "x")
for (i in 2:4)
plot(s[, 1], s[, i], type = "l",
xlab = "t", ylab = xylab[i-1], col = "steelblue",
main = paste("Lorentz \n", "sigma =", as.character(sigma),
" r =", as.character(r), " b =", as.character(b)), ...)
k = c(3, 4, 2)
for (i in 2:4) plot(s[, i], s[, k[i-1]], type = "l",
xlab = xylab[i-1], ylab = xylab[i], col = "steelblue",
main = paste("Lorentz \n", "sigma =", as.character(sigma),
" r =", as.character(r), " b =", as.character(b)), ...)
}
# Result:
colnames(s) = c("t", "x", "y", "z")
# Return Value:
ts(s)
}
# ------------------------------------------------------------------------------
roesslerSim =
function(times = seq(0, 100, by = 0.01), parms = c(a = 0.2, b = 0.2, c = 8.0),
start = c(-1.894, -9.920, 0.0250), doplot = TRUE, ...)
{ # A function written by Diethelm Wuertz
# Description:
# Simulates a Lorentz Map
# Notes:
# Requires contributed R package "odesolve"
# FUNCTION:
# Settings:
a = parms[1]
b = parms[2]
c = parms[3]
# Attractor:
roessler = function(t, x, parms) {
X = x[1]; Y = x[2]; Z = x[3]
with(as.list(parms), {
dX = -(Y+Z)
dY = X + a*Y
dZ = b + X*Z -c*Z
list(c(dX, dY, dZ))}) }
# Classical RK4 with fixed time step:
s = .rk4(start, times, roessler, parms)
# Display:
if (doplot) {
xylab = c("x", "y", "z", "x")
for (i in 2:4) plot(s[, 1], s[, i], type = "l",
xlab = "t", ylab = xylab[i-1], col = "steelblue",
main = paste("Roessler \n", "a = ", as.character(a),
" b = ", as.character(b), " c = ", as.character(c)), ...)
k = c(3, 4, 2)
for (i in 2:4) plot(s[, i], s[, k[i-1]], type = "l",
xlab = xylab[i-1], ylab = xylab[i], col = "steelblue",
main = paste("Roessler \n", "a = ", as.character(a),
" b = ", as.character(b), " c = ", as.character(c)), ...)
}
# Result:
colnames(s) = c("t", "x", "y", "z")
# Return Value:
ts(s)
}
# ------------------------------------------------------------------------------
.rk4 =
function(y, times, func, parms)
{
# Description:
# Classical Runge-Kutta-fixed-step-integration
# Autrhor:
# R-Implementation by Th. Petzoldt,
# Notes:
# From Package: odesolve
# Version: 0.5-12
# Date: 2004/10/25
# Title: Solvers for Ordinary Differential Equations
# Author: R. Woodrow Setzer
# Maintainer: R. Woodrow Setzer
# Depends: R (>= 1.4.0)
# License: GPL version 2
# Packaged: Mon Oct 25 14:59:00 2004
# FUNCTION:
# Checks:
if (!is.numeric(y)) stop("`y' must be numeric")
if (!is.numeric(times)) stop("`times' must be numeric")
if (!is.function(func)) stop("`func' must be a function")
if (!is.numeric(parms)) stop("`parms' must be numeric")
# Dimension:
n = length(y)
# Call func once to figure out whether and how many "global"
# results it wants to return and some other safety checks
rho = environment(func)
tmp = eval(func(times[1], y,parms), rho)
if (!is.list(tmp)) stop("Model function must return a list\n")
if (length(tmp[[1]]) != length(y))
stop(paste("The number of derivatives returned by func() (",
length(tmp[[1]]),
"must equal the length of the initial conditions vector (",
length(y),")", sep = ""))
Nglobal = if (length(tmp) > 1) length(tmp[[2]]) else 0
y0 = y
out = c(times[1], y0)
for (i in 1:(length(times)-1)) {
t = times[i]
dt = times[i+1] - times[i]
F1 = dt * func(t, y0, parms)[[1]]
F2 = dt * func(t+dt/2, y0 + 0.5 * F1, parms)[[1]]
F3 = dt * func(t+dt/2, y0 + 0.5 * F2, parms)[[1]]
F4 = dt * func(t+dt , y0 + F3, parms)[[1]]
dy = (F1 + 2 * F2 + 2 * F3 + F4)/6
y1 = y0 + dy
out<- rbind(out, c(times[i+1], y1))
y0 = y1
}
nm = c("time",
if (!is.null(attr(y, "names"))) names(y)
else as.character(1:n))
if (Nglobal > 0) {
out2 = matrix(nrow=nrow(out), ncol = Nglobal)
for (i in 1:nrow(out2))
out2[i,] = func(out[i,1], out[i,-1], parms)[[2]]
out = cbind(out, out2)
nm = c(nm,
if (!is.null(attr(tmp[[2]],"names"))) names(tmp[[2]])
else as.character((n+1) : (n + Nglobal)))
}
dimnames(out) = list(NULL, nm)
# Return Value:
out
}
################################################################################
fNonlinear/R/zzz.R 0000644 0001762 0000144 00000003147 13202320674 013532 0 ustar ligges 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
###############################################################################
.onAttach <-
function(libname, pkgname)
{
# do whatever needs to be done when the package is loaded
# some people use it to bombard users with
# messages using
# packageStartupMessage( "\n" )
# packageStartupMessage( "Rmetrics Package fNonlinear" )
# packageStartupMessage( "Nonlinear and Chaotic Time Series Modelling" )
# packageStartupMessage( "Copyright (C) 2005-2014 Rmetrics Association Zurich" )
# packageStartupMessage( "Educational Software for Financial Engineering and Computational Science" )
# packageStartupMessage( "Rmetrics is free software and comes with ABSOLUTELY NO WARRANTY." )
# packageStartupMessage( "https://www.rmetrics.org --- Mail to: info@rmetrics.org" )
}
###############################################################################
fNonlinear/MD5 0000644 0001762 0000144 00000002167 13203405404 012656 0 ustar ligges users c8952c2cd9870a18e5a5cd1e2b4e196b *ChangeLog
67ec7f37c31b73f94da6beecff448f84 *DESCRIPTION
b47c6b9d2bd033133137220c483dbbc5 *NAMESPACE
445513831a0679f318b2e11cb4493036 *R/NonLinModelling.R
11945bd046b385f082b7fe694371a631 *R/NonLinStatistics.R
0c46ef62eb321a3f94e29f914d08bebd *R/NonLinTests.R
26e18cc03d9de67555655424e06ca838 *R/zzz.R
6042b9c5e5bec3ecc1b6959cd2858b64 *inst/COPYRIGHT.html
94cbfabc381237d2e79c712ae3ca8947 *inst/unitTests/Makefile
04c09ba0bf843fde22a246c94dc62112 *inst/unitTests/runTests.R
84a14fc2f02c5233450aeb9bac081497 *inst/unitTests/runit.Gallery.R
de9b4a76dee0e0fe9fbfeb27ab86e580 *inst/unitTests/runit.NonLinModelling.R
7f6d6e9ee92c1de9a9d95edf47840dd1 *inst/unitTests/runit.NonLinPlots.R
2d4fea2744affc3b9bb6bfb218ddd3f0 *inst/unitTests/runit.NonLinTests.R
462b4d33c7c98d3d89ce01bd67161600 *man/NonLinModelling.Rd
8544439a04e111abbf762102c82ecb59 *man/NonLinStatistics.Rd
542e6631cee08269c7ef7a9b6dded335 *man/NonLinTests.Rd
2d9b7de870f7e5cd48d32492ef3e7c77 *src/BDSTest.c
3996e7c16bfb96fad295ee425815cb4d *src/Makevars
dd18b7e84beeab62f504d54221921d64 *src/Tisean.c
91d96f5ee62d7425d7bacbce53ed491f *tests/doRUnit.R
fNonlinear/DESCRIPTION 0000644 0001762 0000144 00000001503 13203405404 014045 0 ustar ligges users Package: fNonlinear
Title: Rmetrics - Nonlinear and Chaotic Time Series Modelling
Date: 2017-11-12
Version: 3042.79
Author: Diethelm Wuertz [aut],
Tobias Setz [cre],
Yohan Chalabi [ctb]
Maintainer: Tobias Setz
Description: Provides a collection of functions for testing various aspects of
univariate time series including independence and neglected
nonlinearities. Further provides functions to investigate the chaotic
behavior of time series processes and to simulate different types of chaotic
time series maps.
Depends: R (>= 2.15.1), timeDate, timeSeries, fBasics
Imports: methods, stats
Suggests: RUnit, tcltk
LazyData: yes
License: GPL (>= 2)
URL: http://www.rmetrics.org
NeedsCompilation: yes
Packaged: 2017-11-16 17:28:36 UTC; Tobias Setz
Repository: CRAN
Date/Publication: 2017-11-16 22:02:44 UTC
fNonlinear/ChangeLog 0000644 0001762 0000144 00000001727 12267177664 014150 0 ustar ligges users 2013-06-23 chalabi
* DESCRIPTION, R/zzz.R, src/Makevars: updated Fortran flags,
version number and removed .First.lib()
2012-12-10 chalabi
* ChangeLog, DESCRIPTION: Updated ChangeLog and DESCRIPTION files
* R/NonLinStatistics.R: Fixed partial argument match
* DESCRIPTION: Updated maintainer, note and version fields
* NAMESPACE: Added NAMESPACE
* R/NonLinModelling.R: Fixed partial argument matches
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-04-02 chalabi
* DESCRIPTION: more explicit depends and suggests field in DESC
file.
2009-04-01 chalabi
* DESCRIPTION: updated DESC file
2009-01-28 chalabi
* man/NonLinTests.Rd: updated manual pages to new Rd parser
fNonlinear/man/ 0000755 0001762 0000144 00000000000 13201353171 013114 5 ustar ligges users fNonlinear/man/NonLinTests.Rd 0000644 0001762 0000144 00000021242 12323220002 015612 0 ustar ligges users \name{NonLinTests}
\alias{NonLinTests}
\alias{tsTest}
\alias{bdsTest}
\alias{tnnTest}
\alias{wnnTest}
\alias{runsTest}
\title{Time Series Tests}
\description{
A collection and description of functions
for testing various aspects of univariate
time series, including independence, and neglected
nonlinearities.
\cr
The family of time series tests includes the following
hypothesis tests:
\preformatted{
bdsTest Brock--Dechert--Scheinkman test for iid series
tnnTest Teraesvirta NN test for neglected nonlinearity
wnnTest White NN test for neglected nonlinearity
runsTest Runs test for detecting non-randomness
}
}
\usage{
bdsTest(x, m = 3, eps = NULL, title = NULL, description = NULL)
tnnTest(x, lag = 1, title = NULL, description = NULL)
wnnTest(x, lag = 1, qstar = 2, q = 10, range = 4, title = NULL, description = NULL)
runsTest(x)
}
\arguments{
\item{description}{
optional description string, or a vector of character strings.
}
\item{eps}{
[bdsTest] - \cr
a numeric vector of epsilon values for close points. The
BDS test is computed for each element of \code{eps}. It should
be set in terms of the standard deviation of \code{x}. If
\code{eps} is \code{NULL}, then the four default values
\code{seq(0.5*sd(x), 2*sd(x), length = 4)} are used.
}
\item{lag}{
[tnnTest][wnnTest] -\cr
an integer which specifies the model order in terms of lags.
}
\item{m}{
[bdsTest] - \cr
an integer indicating that the BDS test statistic is computed
for embedding dimensions \code{2}, \dots, \code{m}.
}
\item{q}{
[wnnTest] -\cr
an integer representing the number of phantom hidden units
used to compute the test statistic.
}
\item{qstar}{
[wnnTest] -\cr
the test is conducted using \code{qstar} principal components
of the phantom hidden units. The first principal component is
omitted since in most cases it appears to be collinear with the
input vector of lagged variables. This strategy preserves power
while still conserving degrees of freedom.
}
\item{range}{
[wnnTest] -\cr
the input to hidden unit weights are initialized uniformly
over \code{[-range/2, range/2]}.
}
\item{title}{
an optional title string, if not specified the inputs data
name is deparsed.
}
\item{x}{
a numeric vector or an object of class \code{"timeseries"}.
}
}
\details{
\bold{Brock--Dechert--Sheinkman Test:}
\cr\cr
The \code{bdsTest} test examines the \emph{spatial dependence} of the
observed series. To do this, the series is embedded in \code{m}-space
and the dependence of \code{x} is examined by counting \emph{near}
points. Points for which the distance is less than \code{eps} are
called near. The BDS test statistic is asymptotically standard Normal.
Note, that missing values are not allowed.
There is a special print method for objects of class \code{"bdsTest"}
which by default uses 4 digits to format real numbers.
\cr
\code{[tseries:bds.test]}
\cr
\bold{Teraesvirta Neural Network Test:}
\cr\cr
The null is the hypotheses of linearity in \code{mean}. This test
uses a Taylor series expansion of the activation function to
arrive at a suitable test statistic. If \code{type} equals \code{"F"},
then the F-statistic instead of the Chi-Squared statistic
is used in analogy to the classical linear regression.
Missing values are not allowed.
\cr
\code{[tseries:teraesvirta.test]}
\cr
\bold{White Neural Network Test:}
\cr\cr
The null is the hypotheses of linearity in ``mean''. This
type of test is consistent against arbitrary nonlinearity
in mean. If \code{type} equals \code{"F"}, then the F-statistic
instead of the Chi-Squared statistic is used in analogy to the
classical linear regression.
\cr
\code{[tseries:white.test]}
\cr
\bold{Runs Test:}
\cr\cr
The runs test can be used to decide if a data set is from a random
process. A run is defined as a series of increasing values or a
series of decreasing values. The number of increasing, or decreasing,
values is the length of the run. In a random data set, the probability
that the \emph{(i+1)-th} value is larger or smaller than the \emph{i-th}
value follows a binomial distribution, which forms the basis of the
runs test.
\cr
\code{[tseries:runs.test]}
}
\value{
In contrast to R's output report from S3 objects of class \code{"htest"}
a different output report is produced. The tests here return an S4
object of class \code{"fHTEST"}. The object contains the following slots:
\item{@call}{
the function call.
}
\item{@data}{
the data as specified by the input argument(s).
}
\item{@test}{
a list whose elements contail the results from the statistical
test. The information provided is similar to a list object of
\code{"htest"}.
}
\item{@title}{
a character string with the name of the test. This can be
overwritten specifying a user defined input argument.
}
\item{@description}{
a character string with an optional user defined description.
By default just the current date when the test was applied will
be returned.
}
The slot \code{@test} returns an object of class \code{"list"}
containing the following (otionally empty) elements:
\item{statistic}{
the value(s) of the test statistic.
}
\item{p.value}{
the p-value(s) of the test.
}
\item{parameters}{
a numeric value or vector of parameters.
}
\item{estimate}{
a numeric value or vector of sample estimates.
}
\item{conf.int}{
a numeric two row vector or matrix of 95% confidence levels.
}
\item{method}{
a character string indicating what type of test was performed.
}
\item{data.name}{
a character string giving the name(s) of the data.
}
}
\note{
The output of the various hypothesis tests is an object of class
\code{htest}. The associated \code{print} method gives an unique
report about the test results.
}
\references{
Brock, W.A., Dechert W.D., Sheinkman J.A. (1987);
\emph{A Test of Independence Based on the Correlation
Dimension},
SSRI no. 8702, Department of Economics, University of
Wisconsin, Madison.
Conover, W.J. (1980);
\emph{Practical Nonparametric Statistics},
New York, Wiley.
Cromwell J.B., Labys W.C., Terraza M. (1994);
\emph{Univariate Tests for Time Series Models},
Sage, Thousand Oaks, CA, pages 32--36.
Lee T.H., White H., Granger C.W.J. (1993);
\emph{Testing for neglected nonlinearity in time series models},
Journal of Econometrics 56, 269--290.
Teraesvirta T., Lin C.F., Granger C.W.J. (1993);
\emph{Power of the Neural Network Linearity Test},
Journal of Time Series Analysis 14, 209--220.
}
\author{
Adrian Trapletti for the tests from \R's tseries package,\cr
Blake LeBaron for the \code{bds} C program,\cr
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## bdsTest -
# iid Time Series:
par(mfrow = c(3, 1))
x = rnorm(100)
plot(x, type = "l", main = "iid Time Series")
bdsTest(x, m = 3)
# Non Identically Distributed Time Series:
x = c(rnorm(50), runif(50))
plot(x, type = "l", main = "Non-iid Time Series")
bdsTest(x, m = 3)
# Non Independent Innovations from Quadratic Map:
x = rep(0.2, 100)
for (i in 2:100) x[i] = 4*(1-x[i-1])*x[i-1]
plot(x, type = "l", main = "Quadratic Map")
bdsTest(x, m = 3)
## tnnTest -
# Time Series Non-linear in "mean" regression
par(mfrow = c(2, 1))
n = 1000
x = runif(1000, -1, 1)
tnnTest(x)
# Generate time series which is nonlinear in "mean"
x[1] = 0.0
for (i in (2:n)) {
x[i] = 0.4*x[i-1] + tanh(x[i-1]) + rnorm (1, sd = 0.5) }
plot(x, main = "Teraesvirta Test", type = "l")
tnnTest(x)
## wnnTest -
# Time Series Non-Linear in "mean" Regression
par(mfrow = c(2, 1))
n = 1000
x = runif(1000, -1, 1)
wnnTest(x)
# Generate time series which is nonlinear in "mean"
x[1] = 0.0
for (i in (2:n)) {
x[i] = 0.4*x[i-1] + tanh(x[i-1]) + rnorm (1, sd = 0.5) }
plot(x, main = "White Test", type = "l")
wnnTest(x)
}
\keyword{htest}
fNonlinear/man/NonLinModelling.Rd 0000644 0001762 0000144 00000006615 11645005112 016442 0 ustar ligges users \name{NonLinModelling}
\alias{NonLinModelling}
\alias{tentSim}
\alias{henonSim}
\alias{ikedaSim}
\alias{logisticSim}
\alias{lorentzSim}
\alias{roesslerSim}
\title{Chaotic Time Series Modelling}
\description{
A collection and description of functions to
simulate different types of chaotic time series
maps.
\cr
Chaotic Time Series Maps:
\tabular{ll}{
\code{tentSim} \tab Simulates data from the Tent Map, \cr
\code{henonSim} \tab simulates data from the Henon Map, \cr
\code{ikedaSim} \tab simulates data from the Ikeda Map, \cr
\code{logisticSim} \tab simulates data from the Logistic Map, \cr
\code{lorentzSim} \tab simulates data from the Lorentz Map, \cr
\code{roesslerSim} \tab simulates data from the Roessler Map. }
}
\usage{
tentSim(n = 1000, n.skip = 100, parms = c(a = 2), start = runif(1),
doplot = FALSE)
henonSim(n = 1000, n.skip = 100, parms = c(a = 1.4, b = 0.3),
start = runif(2), doplot = FALSE)
ikedaSim(n = 1000, n.skip = 100, parms = c(a = 0.4, b = 6.0, c = 0.9),
start = runif(2), doplot = FALSE)
logisticSim(n = 1000, n.skip = 100, parms = c(r = 4), start = runif(1),
doplot = FALSE)
lorentzSim(times = seq(0, 40, by = 0.01), parms = c(sigma = 16, r = 45.92,
b = 4), start = c(-14, -13, 47), doplot = TRUE, \dots)
roesslerSim(times = seq(0, 100, by = 0.01), parms = c(a = 0.2, b = 0.2, c = 8.0),
start = c(-1.894, -9.920, 0.0250), doplot = TRUE, \dots)
}
\arguments{
\item{doplot}{
a logical flag. Should a plot be displayed?
}
\item{n, n.skip}{
[henonSim][ikedaSim][logisticSim] - \cr
the number of chaotic time series points to be generated and the
number of initial values to be skipped from the series.
}
\item{parms}{
the named parameter vector characterizing the chaotic map.
}
\item{start}{
the vector of start values to initiate the chaotic map.
}
\item{times}{
[lorentzSim][roesslerSim] - \cr
the sequence of time series points at which to generate the map.
}
\item{\dots}{
arguments to be passed.
}
}
\value{
[*Sim] - \cr
All functions return invisible a vector of time series data.
}
\references{
Brock, W.A., Dechert W.D., Sheinkman J.A. (1987);
\emph{A Test of Independence Based on the Correlation
Dimension},
SSRI no. 8702, Department of Economics, University of
Wisconsin, Madison.
Eckmann J.P., Oliffson Kamphorst S., Ruelle D. (1987),
\emph{Recurrence plots of dynamical systems},
Europhys. Letters 4, 973.
Hegger R., Kantz H., Schreiber T. (1999);
\emph{Practical implementation of nonlinear time series
methods: The TISEAN package},
CHAOS 9, 413--435.
Kennel M.B., Brown R., Abarbanel H.D.I. (1992);
\emph{Determining embedding dimension for phase-space
reconstruction using a geometrical construction},
Phys. Rev. A45, 3403.
Rosenstein M.T., Collins J.J., De Luca C.J. (1993);
\emph{A practical method for calculating largest Lyapunov
exponents from small data sets},
Physica D 65, 117.
}
\seealso{
\code{RandomInnovations}.
}
\author{
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## logisticSim -
set.seed(4711)
x = logisticSim(n = 100)
plot(x, main = "Logistic Map")
}
\keyword{models}
fNonlinear/man/NonLinStatistics.Rd 0000644 0001762 0000144 00000016114 11645005112 016655 0 ustar ligges users \name{NonLinStatistics}
\alias{NonLinStatistics}
\alias{mutualPlot}
\alias{falsennPlot}
\alias{recurrencePlot}
\alias{separationPlot}
\alias{lyapunovPlot}
\title{Chaotic Time Series Statistics}
\description{
A collection and description of functions to
investigate the chaotic behavior of time series
processes.
\cr
Functions to Analyse Chaotic Time Series:
\tabular{ll}{
\code{mutualPlot} \tab Returns mutual information, \cr
\code{falsennPlot} \tab returns false nearest neigbours, \cr
\code{recurrencePlot} \tab returns a recurrence plot, \cr
\code{separationPlot} \tab returns a space-time separation plot, \cr
\code{lyapunovPlot} \tab computes maximum lyapunov exponent. }
}
\usage{
mutualPlot(x, partitions = 16, lag.max = 20, doplot = TRUE, \dots)
falsennPlot(x, m, d, t, rt = 10, eps = NULL, doplot = TRUE, \dots)
recurrencePlot(x, m, d, end.time, eps, nt = 10, doplot = TRUE, \dots)
separationPlot(x, m, d, mdt, idt = 1, doplot = TRUE, \dots)
lyapunovPlot(x, m, d, t, ref, s, eps, k = 1, doplot = TRUE, \dots)
}
\arguments{
\item{d}{
an integer value setting the value of the time delay.
}
\item{eps}{
[falsennPlot] - \cr
a numeric value setting the value of the neighbour diameter.
If NULL, which is the default value, then the value will be
automatically setted to \code{eps=sd(x)/10}.
\cr
[lyapunovPlot] - \cr
the radius where to find nearest neighbours.
\cr
[recurrencePlot] - \cr
the neighbourhood threshold.
}
\item{doplot}{
a logical flag. Should a plot be displayed?
}
\item{end.time}{
[recurrencePlot] - \cr
ending time as number of observations.
}
\item{idt}{
[separationPlot] - \cr
an integer value setting the number of observation steps in
each iterations. By default 1.
}
\item{k}{
[lyapunovPlot] - \cr
an integer setting th enumber of considered neighbours.
By default 1.
}
\item{lag.max}{
[mutualPlot] - \cr
an integer value setting the number of maximum lags, by
default 20.
}
\item{m}{
[*Plot] - \cr
an integer value setting the value of the maximum embedding
dimension.
}
\item{mdt}{
[separationPlot] - \cr
an integer value setting the number of iterations.
}
\item{nt}{
[recurrencePlot] - \cr
observations in each step which will be plotted, by default 10.
Increasing \code{nt} reduces number of points plotted which
is usefule especially with highly sampled data.
}
\item{rt}{
[falsennPlot] - \cr
an integer value setting the value for the escape factor. By
default 10.
}
\item{partitions}{
[mutualPlot] - \cr
an integer value setting the number of bins, by default 16.
}
\item{ref}{
[lyapunovPlot] - \cr
the number of points to take into account.
}
\item{s}{
[lyapunovPlot] - \cr
the iterations along which follow the neighbours of each point.
}
\item{t}{
[*Plot] - \cr
an integer value setting the value for the Theiler window.
}
\item{x}{
[*Plot] - \cr
a numeric vector, or an object either of class 'ts' or
of class 'timeSeries'.
}
\item{\dots}{
arguments to be passed.
}
}
\details{
\bold{Phase Space Representation:}
\cr\cr
The function \code{mutualPlot} estimates and plots the mutual
information index of a given time series for a specified number
of lags. The joint probability distribution function is estimated
with a simple bi-dimensional density histogram.
\cr
The function \code{falsennPlot} uses the Method of false nearest
neighbours to help deciding the optimal embedding dimension.
\cr
\bold{Non-Stationarity:}
\cr\cr
The funcdtion \code{recurrencePlot} creates a recurrence plot as
proposed by Eckmann et al. [1987].
\cr
The function \code{separationPlot} creates a space-time separation
plot qs introduced by Provenzale et al. [1992]. It plots the
probability that two points in the reconstructed phase-space have
distance smaller than epsilon in function of epsilon and of the
time between the points, as iso-lines at levels 10, 20, ..., 100
percent levels. The plot can be used to decide the Theiler time
window.
\cr
\bold{Lyapunov Exponents:}
\cr\cr
The function \code{lyapunovPlot} evaluates and plots the largest
Lyapunov exponent of a dynamic system from a univariate time series.
The estimate of the Lyapunov exponent uses the algorithm of Kantz.
In addition, the function computes the regression coefficients of
a user specified segment of the sequence given as input.
\cr
\bold{Dimensions and Entropies:}
\cr\cr
The function \code{C2} computes the sample correlation integral on
the provided time series for the specified length scale and
Theiler window. It uses a naiv algorithm: simply returns the
fraction of points pairs nearer than eps. It is prefarable to use
the function \code{d2}, which takes roughly the same time, but
computes the correlation sum for multiple length scales and
embedding dimensions at once.
\cr
The function \code{d2} computes the sample correlation integral
over given length scales \code{neps} for embedding dimensions
\code{1:m} for a given Theiler window. The slope of the linear
segment in the log-log plot gives an estimate of the correlation
dimension.
}
\references{
Brock, W.A., Dechert W.D., Sheinkman J.A. (1987);
\emph{A Test of Independence Based on the Correlation
Dimension},
SSRI no. 8702, Department of Economics, University of
Wisconsin, Madison.
Eckmann J.P., Oliffson Kamphorst S., Ruelle D. (1987),
\emph{Recurrence plots of dynamical systems},
Europhys. Letters 4, 973.
Hegger R., Kantz H., Schreiber T. (1999);
\emph{Practical implementation of nonlinear time series
methods: The TISEAN package},
CHAOS 9, 413--435.
Kennel M.B., Brown R., Abarbanel H.D.I. (1992);
\emph{Determining embedding dimension for phase-space
reconstruction using a geometrical construction},
Phys. Rev. A45, 3403.
Rosenstein M.T., Collins J.J., De Luca C.J. (1993);
\emph{A practical method for calculating largest Lyapunov
exponents from small data sets},
Physica D 65, 117.
}
\seealso{
\code{RandomInnovations}.
}
\author{
Diethelm Wuertz for the Rmetrics \R-port.
}
\examples{
## mutualPlot -
mutualPlot(logisticSim(1000))
## recurrencePlot -
lorentz = lorentzSim(
times = seq(0, 40, by = 0.01),
parms = c(sigma = 16, r = 45.92, b = 4),
start = c(-14, -13, 47),
doplot = FALSE)
recurrencePlot(lorentz[, 2], m = 3, d = 2, end.time = 800, eps = 3,
nt = 5, pch = '.', cex = 2)
}
\keyword{models}