BeginPackage["UVW`Dynsyst`"] (* Version 2.0, 08/15/97 *) Mean::usage= "Mean[list] returns the arithmetic mean of list." Variance::usage= "Variance[list] returns the maximum likelyhood estimate of the variance of list." TentFunction::usage= "TentFunction[a,x] returns 1-a*Abs[x-1+1/a]." LogisticFunction::usage= "LogisticFunction[a,x] returns ax(1-x)." IterateAPhi::usage=" IterateAPhi[matrixA,functionPhi,vectorX0,n] computes and returns in a list the images by the function Phi of the vector X0 and its products by the successive powers of the matrix A. The coordinates of these vectors are reduced to their decimal parts." CovarianceFunction::usage= " CovarianceFunction[list,N] returns in a list the values cov(i) for i ranging from 0 to N . The value cov(i) is the covariance of list with its i-th shift." AsymptoticVariance::usage= "AsymptoticVariance[list,N] returns the sum of the values cov(i) for i ranging from 0 to N . The value cov(i) is the covariance of list with its i_th shift." CorrelationDimension::usage= " CorrelationDimension[list,step,ntep] computes the values of C(r) , r being an integer multiple of step, up to nstep values. Then the values Log[C(r)] as a function of r are plotted, and the linear regression coefficients are computed. The slope of the regression line and the correlation coefficient are printed." Begin["`Private`"] Mean[list_]:=N[Apply[Plus,list]/Length[list]]; Variance[list_]:=(list.list)/Length[list]-(Mean[list]^2); LogisticFunction[a_,x_]:=N[a*x*(1-x)]; TentFunction[a_,x_]:= 1 - a*Abs[x-1+1./a]; IterateAPhi[a_,phi_,x0_,n_]:= Block[{f,x,res,i}, f[x_]:= Mod[a.x,1.]; res = NestList[f,Mod[x0,1.],n]; res = Table[Mod[phi[res[[i]]],1.], {i,n}]; Return[res]; ]; CovarianceFunction[listofdata_List,n_]:= Block[{lcent,k,len,covar}, lcent = listofdata-Mean[listofdata]; len = Length[listofdata]; covar = Table[(Drop[lcent,-k]. Drop[lcent, k])/(len-k),{k,0,n}]; Return[covar]; ]; AsymptoticVariance[listofdata_List,n_]:= Apply[Plus, CovarianceFunction[listofdata,n]]; CorrelationDimension[listofdata_List,step_,nstep_]:= Block[{n,twoover,list,sum,i,elem, work, abscissas, ordinates,mx,my,vx,vy,cova,corr,a,b}, n = Length[listofdata]-1; twoover = 2./(n*(n-1)); list = listofdata; sum = Table[0,{nstep}]; Do [ ( elem=First[list]; list=Drop[list,1]; work=Table[Ceiling[ Sqrt[(list[[i]]-elem).(list[[i]]-elem)]/step], {i,Length[list]}]; sum=sum+Table[Count[work,i],{i,nstep}]; ),{n} ]; abscissas = Range[step,nstep*step,step]; ordinates = Log[sum*twoover]; mx = Mean[abscissas]; my = Mean[ordinates]; vx = Variance[abscissas]; vy = Variance[ordinates]; cova = (abscissas.ordinates)/nstep - (mx*my); corr = cova/Sqrt[vx*vy]; a = cova/vx; b = -a*mx + my; Print[" "]; Print["Slope = ",a]; Print[" "]; Print["Linear Correlation = ",corr]; g1 := ListPlot[Transpose[{abscissas,ordinates}], DisplayFunction->Identity]; g2 := Plot[a*x+b,{x,0,Last[abscissas]}, DisplayFunction->Identity]; Show[g1,g2,DisplayFunction->$DisplayFunction] ]; End[] EndPackage[]