fNonlinear/0000755000176200001440000000000012161704733012351 5ustar liggesusersfNonlinear/MD50000644000176200001440000000216712161704733012667 0ustar liggesusersc8952c2cd9870a18e5a5cd1e2b4e196b *ChangeLog e8d7c56a4a92fe069740a4e58f551023 *DESCRIPTION 09c3e6ee1c04ff70360f480924df1203 *NAMESPACE 5d4bd986d98ddda770d6a858ff185503 *R/NonLinModelling.R 259fb671ff945c117f3ecc5ea534b31d *R/NonLinStatistics.R f94d58751ab4c3f10a3df9815d4b8c7c *R/NonLinTests.R 43d12ddf9535cb944576865ae67aa615 *R/zzz.R 6042b9c5e5bec3ecc1b6959cd2858b64 *inst/COPYRIGHT.html bfc698c089cc5a73a1a6afd4dac35d98 *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 01b882f85691fd4a3373fbe5f489d896 *man/NonLinTests.Rd 2d9b7de870f7e5cd48d32492ef3e7c77 *src/BDSTest.c 3996e7c16bfb96fad295ee425815cb4d *src/Makevars dd18b7e84beeab62f504d54221921d64 *src/Tisean.c 91d96f5ee62d7425d7bacbce53ed491f *tests/doRUnit.R fNonlinear/tests/0000755000176200001440000000000012161636322013511 5ustar liggesusersfNonlinear/tests/doRUnit.R0000644000176200001440000000164411370220737015225 0ustar liggesusers#### 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/0000755000176200001440000000000012161636322013136 5ustar liggesusersfNonlinear/src/Tisean.c0000644000176200001440000002110312161636322014522 0ustar liggesusers/* -------------------------------------------------------------------------- */ #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 #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/man/0000755000176200001440000000000012161636322013122 5ustar liggesusersfNonlinear/man/NonLinTests.Rd0000644000176200001440000002207311370220737015635 0ustar liggesusers\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: \tabular{ll}{ \code{bdsTest} \tab Brock--Dechert--Scheinkman test for iid series, \cr \code{tnnTest} \tab Teraesvirta NN test for neglected nonlinearity, \cr \code{wnnTest} \tab White NN test for neglected nonlinearity, \cr \code{runsTest} \tab Runs test for detecting non-randomness.} } \note{ There is nothing really new in this package. The benefit you will get from this help page, that we bring together a collection of time series tests from several \R-packages which may be of interest for economists and financial engineers. On the other hand the user can still use the underlying function calls from the imported \R-packages. 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. } \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. } } \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/NonLinStatistics.Rd0000644000176200001440000001611411370220737016664 0ustar liggesusers\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} fNonlinear/man/NonLinModelling.Rd0000644000176200001440000000661511370220737016451 0ustar liggesusers\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/inst/0000755000176200001440000000000012161636322013324 5ustar liggesusersfNonlinear/inst/unitTests/0000755000176200001440000000000012161636322015326 5ustar liggesusersfNonlinear/inst/unitTests/runit.NonLinTests.R0000644000176200001440000001251211370220737021032 0ustar liggesusers # 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/inst/unitTests/runit.NonLinPlots.R0000644000176200001440000001001311370220737021023 0ustar liggesusers # 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.NonLinModelling.R0000644000176200001440000001427711370220737021654 0ustar liggesusers # 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.R0000644000176200001440000000515411370220737020215 0ustar liggesusers # 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.R0000644000176200001440000000453211370220737017304 0ustar liggesuserspkg <- "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/Makefile0000644000176200001440000000042211370220737016764 0ustar liggesusersPKG=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/COPYRIGHT.html0000644000176200001440000002041111370220737015560 0ustar liggesusers 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/R/0000755000176200001440000000000012161636322012550 5ustar liggesusersfNonlinear/R/zzz.R0000644000176200001440000000341112161634170013526 0ustar liggesusers # 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 - 2005, Diethelm Wuertz, GPL # Diethelm Wuertz # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ ## .First.lib = ## function(lib, pkg) ## { ## # Startup Mesage and Desription: ## MSG <- if(getRversion() >= "2.5") packageStartupMessage else message ## dsc <- packageDescription(pkg) ## if(interactive() || getOption("verbose")) { ## # not in test scripts ## MSG(sprintf("Rmetrics Package %s (%s) loaded.", pkg, dsc$Version)) ## } ## # Load dll: ## library.dynam("fNonlinear", pkg, lib) ## } if(!exists("Sys.setenv", mode = "function")) # pre R-2.5.0, use "old form" Sys.setenv <- Sys.putenv ################################################################################ fNonlinear/R/NonLinTests.R0000644000176200001440000003164111370220737015120 0ustar liggesusers # 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: 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/NonLinStatistics.R0000644000176200001440000004363712157313037016160 0ustar liggesusers # 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 - 2004, 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 PLOTS: # mutualPlot Creates mutual information plot # .embeddPSR Embeds a time series given time delay and dimension # .checkEmbParms Checks embedding parameters # falsennPlot Creates false nearest neigbours plot # FUNCTION: NON STATIONARITY PLOTS: # recurrencePlot Creates recurrence plot # separationPlot Creates space-time separation plot # FUNCTION: LYAPUNOV EXPONENTS PLOT: # lyapunovPlot Creates Maximum Lyapunov plot # .find.nearest # .follow.points # .lyapunovFit # FUNCTION: DIMENSIONS AND ENTROPY: # .C2 # .d2 ################################################################################ ################################################################################ # CHAOTIC TIME SERIES ANALYSIS # Package: tseriesChaos # Title: Analysis of nonlinear time series # Date: 2005-07-24 # Version: 0.1 # Author: Antonio, Fabio Di Narzo # Description: Routines for the analysis of nonlinear time series. # This work is largely inspired by the TISEAN project, by Rainer # Hegger, Holger Kantz and Thomas Schreiber: # http://www.mpipks-dresden.mpg.de/~tisean/ # Maintainer: Antonio, Fabio Di Narzo # 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/NonLinModelling.R0000644000176200001440000003136512157313037015733 0ustar liggesusers # 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: 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/NAMESPACE0000644000176200001440000000241312157313037013566 0ustar liggesusers ################################################ ## Note this file has been automatically ## generated --- Do not edit it. ################################################ ################################################ ## import name space ################################################ import("methods") import("timeDate") import("timeSeries") import("fBasics") import("fGarch") ################################################ ## useDynLib ################################################ useDynLib("fNonlinear") ################################################ ## S4 classes ################################################ ################################################ ## S3 classes ################################################ ################################################ ## functions ################################################ export( ".C2", ".checkEmbParms", ".d2", ".embeddPSR", ".find.nearest", ".follow.points", ".lyapunovFit", ".rk4", "bdsTest", "falsennPlot", "henonSim", "ikedaSim", "logisticSim", "lorentzSim", "lyapunovPlot", "mutualPlot", "recurrencePlot", "roesslerSim", "runsTest", "separationPlot", "tentSim", "tnnTest", "tsTest", "wnnTest" ) fNonlinear/DESCRIPTION0000644000176200001440000000144412161704733014062 0ustar liggesusersPackage: fNonlinear Version: 3010.78 Revision: 5523 Date: 2013-06-23 Title: Nonlinear and Chaotic Time Series Modelling Author: Diethelm Wuertz and many others, see the SOURCE file Depends: R (>= 2.4.0), methods, timeDate, timeSeries, fBasics, fGarch Suggests: RUnit, tcltk Maintainer: Yohan Chalabi Description: Environment for teaching "Financial Engineering and Computational Finance" Note: Several parts are still preliminary and may be changed in the future. this typically includes function and argument names, as well as defaults for arguments and return values. LazyData: yes License: GPL (>= 2) URL: http://www.rmetrics.org Packaged: 2013-06-23 18:22:10 UTC; yohan NeedsCompilation: yes Repository: CRAN Date/Publication: 2013-06-24 01:50:51 fNonlinear/ChangeLog0000644000176200001440000000172712161636303014127 0ustar liggesusers2013-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