diff --git a/CHANGES b/CHANGES new file mode 100644 index 0000000..1d4b46e --- /dev/null +++ b/CHANGES @@ -0,0 +1,92 @@ +version 2.2.1 -- 11/8/01 + + Alter the QR rotation routines supporting singular value + decomposition qrbdv.c, qrbdu1.c, and qrbdi.c to avoid a + rare numerical instability. + + Modify the installation script makelibs.sh to ensure that + the new QR rotation code is not compiled with optimization. + The QR fix does not survive the GNU compiler's optimization. + + Alter include in sany.c to read: #include "../ccmath.h". + + +version 2.2.0 -- 12/13/00 + + Convert all function definitions to the modern ASCII style. + + Revise test programs to support automatic checking of their + output against the sample output appended as a comment to + the test code source. Modifications were made to most of + the test code to support this. + + Supply shell code to permit the automatic checks of standard + test outputs. + + Corect the manual entry for the values returned by the + solv function (revision in C-01). + + +version 2.1.2 -- 10/05/00 + + Modify installation scripts makelibs.sh and install.sh + to eliminate an undefined linker option. + + Correct structure initializations in ccmath.h. (missing + braces) + + Use to define all references to allocation + functions calloc() and malloc(). This header is now + included by ccmath.h. + + Correct failures to free allocated storage in some eigenvalue + routines. + + Change declarations of unsigned long to unsigned int + to correct problems on the DEC Alpha where unsigned long + has a length of 64 bits. + + Revise ccmath.h and manual to reflect the altered + declarations of unsigned quantities. (Revisions in + C-07, C-10, and C-14.) + + Fixed a bug in the singular value distribution code + that could lead to an attempt to operate with NANs. + + +version 2.1.1 -- 5/19/00 + + Revise hash storage programs to allow use of multiple + hash schemes in a program. ( Programs that use the + functions hashins, hashdel, hfind, and hval must be + revised to use this new form.) + + Revised manual chapter C10-sort to reflect hash function + changes. + + Minor correction in manual chapter C01-matrix. + + Clean up anachronistic K&R type declarations of calloc + and malloc. (stdlib.h is now used) + + Alter index incrementation code in time series functions + that resulted in warnings from DEC ALPHA compiler. + + +version 2.1.0 -- 5/1/00 + + Add section containing benchmark test code and output. + ('benchmk' directory ) + + Specify use of '/bin/sh' in installation scripts + + Change license policy to LPGL the GNU library public license. + + + +version 2.0.1 -- 2/27/00 + + Correct spelling error in script 'install.sh'. + + 3/19/00 + Correct function name in '~/simu/supp/lranb.c' : "lrana() -> lranb()". diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..0b3d9e2 --- /dev/null +++ b/INSTALL @@ -0,0 +1,48 @@ + + INSTALL CCMATH + + The CCMATH Mathematics Library is installed using three shell scripts + located in the distribution directory containing this INSTALL file: + + makelibs.sh , non_intel.sh , and install.sh + + These scripts should be run from the distribution directory. + + NOTE: The installation scripts assume a shell that accepts Borne shell + syntax commands, such as 'bash' or 'ksh'. I They current specify + use of '/bin.sh'. You may alter this another compatible shell + by altering the first line in the script files. + + 1) SKIP THIS STEP IF YOUR TARGET IS INTEL COMPATIBLE!! + If you are installing the library on a platform that does + not use an Intel 80x86 compatible processor, run the script + non_intel.sh first. The script will query you on the byte + order employed by the target processor (little-endian for + INTEL and big-endian for many UNIX workstations). You + should know the answer before running non_intel.sh. + [ To test the byte order of your processor, compile + and run the program byteord.c , and compare the + output with sample output for a little-endian + processor appended as a comment to the byteord + source. If they differ, your processor is + big-endian. ] + + 2) Run the makelibs.sh script to compile the source code. + The script will query you on whether or not the target + processor is Intel compatible. If it is, respond by + entering 'y'. The script will compile both a static + library 'ccm.a' and a shared library 'lccm.so', + stored in the subdirectory 'tmp'. + + Optimization flags and/or the compiler command used + can be altered by editing the script. This distribution + was tested using gcc version 2.7.2.3. + + 3) Run the install.sh script as the ROOT user to install the + header file and the libraries. The default locations are: + + header: /usr/include/ccmath.h + static lib: /usr/lib/libccm.a + shared lib: /lib/libccm.so + + These locations can be altered by editing the script. diff --git a/README b/README new file mode 100644 index 0000000..4f6fbf0 --- /dev/null +++ b/README @@ -0,0 +1,83 @@ + CCMATH: A Mathematics Library + ----------------------------- + Version 2.2.0 + + developed and maintained by + Daniel A. Atkinson + + + This package contains the source and test code for the CCMATH + mathematics library. The library is a collection of functions, coded in + the C-language, that perform computations frequently encountered in + scientific, mathematical, and statistical applications. Library functions + are designed to exploit the efficiency and portability of C in such + applications. The following areas are covered: + + o Linear Algebra + o Numerical Integration + o Geometry and Trigonometry + o Curve Fitting + o Roots and Optimization + o Fourier Analysis + o Simulation Support + o Statistical Functions + o Special Functions + o Sorts and Searches + o Time Series Modeling + o Complex Arithmetic + o High Precision Arithmetic + + The library code may be freely redistributed under the terms of the + GNU library public license (LGPL). The distribution directory contains a + copy of this license. Note that CCMATH is provides AS IS, with NO WARRANTY, + either expressed or implied. + + Version 2.2.0 incorporates some major upgrades of the library designed + to facilitate its usability. First all function definitions have been + upgraded to the modern ASCII standard. This was already used in the + function declarations of the header file 'ccmath.h'. It enables compile + time checking of the types of function arguments. The test functions + have also been upgraded to support automatic comparison with sample + outputs. This a simple test of each function does not require tedious + comparison of printed numerical values. This is explained further in the + TESTING file in the current directory. + + The 'manual' subdirectory contains documentation for each of the + functions in the library. The introductory Chapter 'C00-intro' is + recommended reading for all users. Each function is covered by a detailed + function synopsis. Chapters of the manual are indexed with the name of + the subdirectory containing the source code covered in the chapter. + + Compilation and installation are covered in the INSTALL file in the + current directory. This should be fairly simple, but you will need to know + the answers to: + + 1) Is the target processor Intel compatible? + 2) If not, is the byte order big-endian or not? + + Each source code directory has a 'test' subdirectory with library + test code. This test code serves dual roles, since it permits tests of + library functions and it provides an example of how the function is used. + I strongly recommend inspection of the test code for functions you intend + to use. The modules tested by a test function are identified in the test + function's header, and a sample of test output is given in a trailing + comment. + + The 'benchmk' directory contains drivers for timing the execution + of many library functions. The file 'linux_p2.tim' in this directory + presents results that you can compare with times obtained on your + hardware. + + Problems encountered with CCMATH, comments on your use of the + package, or timing data you would like to share can be sent to me at + . To properly address problems I will need the following + information: + + a. The compiler used to compile the package, and the target + processor. + b. Compiler options used if they differ from the defaults in + 'mklibs.sh'. + c. Output from runs of test code for the suspect functions, if it + differs from the sample output in this distribution. + d. If possible, source code for the program where the problem was + discovered. diff --git a/TESTING b/TESTING new file mode 100644 index 0000000..febf197 --- /dev/null +++ b/TESTING @@ -0,0 +1,39 @@ + TESTING CCMATH + + Two script files, runtest (a shell script), and testex (a perl script) + are supplied to facilitate comparison of test program output with the + sample output appended as a comment to each test source file. These + scripts should be placed in some directory on your executable path. You + should also check the first line of each script to and modify it if + the locations assumed /bin/sh and /usr/bin/perl are not correct. + + To run a test and check its output you simply execute runtest in + the 'test' subdirectory containing the test source code. + + runtest testsource.c test-command-line-parameters + + The standard command line parameters for each test are tabulated in the + README file of the test subdirectory. This tabulation also specifies + the sequence of prompt responses (if any) required to generate the + standard test output. The output of the run is then compared, using + 'diff' to the standard output appended as a comment to the test source. + Output of a successful test will look like the sample below. + + 1,2d0 + < /* Test output + < + 36d33 + < */ + + It includes only the enclosing comment flags and possibly some blank lines. + Any differences in numerical values that appear may indicate a failed test. + + Note that some compilers generate slightly different formats for + scientific (%e) notation, so differences in such numbers, flagged by 'diff', + should be inspected to see if they actually differ in value as well as + format. + + This test capability simplifies and speeds up initial testing of + library functions. I urge you to inspect the test code and run some + alternative tests for any function that will play a critical role in + your application. diff --git a/benchmk/README b/benchmk/README new file mode 100644 index 0000000..ca1d541 --- /dev/null +++ b/benchmk/README @@ -0,0 +1,51 @@ + Benchmark Timing + + This directory contains the source code for drivers that time the +execution of important CCMATH functions. The header comments in each of +the source files describes the input command line parameters required +by the function. The file 'linux_2p.tim' contains timing data I obtained +on a 233 MHz Pentium II. + + The quoted times were obtained, after instalation of the ccmath + library, with programs compiled using + + cc -O3 "bench".c -lccm -lm , + + where "bench " is one of the following drivers. + + + timbes.c ----- time the execution of Bessel functions + timeigv.c ---- time the computation of the eigenvalues + and eigenvectors of a real symmetric matrix + timeval.c ---- time the computation of the eigenvalues of + a real symmetric matrix + timfft2.c ---- time a radix-2 Fast Fourier Transform (FFT) + timfftgc.c --- time a general radix complex FFT + timheval.c --- time the computation of the eigenvalues of a + hermitian matrix + timhevec.c --- time the computation of the eigenvalues and + eigenvectors of a hermitian matrix + timhsrt.c ---- time the heap sort of a real array + timintg.c ---- time a numerical integration of complete + elliptic integrals + timlpac.c ---- time the solution of a real linear system (LINPAC) + timmiv.c ----- time the inversion of a real matrix + timmsrt.c ---- time the merge sort of a real array + timmul.c ----- time the multiplication of real matrices + timnrml.c ---- time the generation of pseudorandom normals + timqsrt.c ---- time the 'quicksort' of a real array + timslpac.c --- time the solution of 'small' linear systems + (dimension < 400) + timssrt.c ---- time the "Shell' sort of a real array + + The following functions generate the binary matrix data files used + as input to the eigensystem timing routines. + + hmatgen.c ---- generate a hermitian matrix with the specified + dimension + smatgen.c ---- generate a real symmetric matrix with the specified + dimension + + The eigenvalues employed in these generators have a simple equal + spacing. This portion of the generator code can easily be changed + to generate matrices with more complex patterns of eigenvalues. diff --git a/benchmk/hmatgen.c b/benchmk/hmatgen.c new file mode 100644 index 0000000..dd01426 --- /dev/null +++ b/benchmk/hmatgen.c @@ -0,0 +1,31 @@ +/* hmatgen.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Create a Hermitian matrix with specified eigenvalues. + + Input parameters: size -> n for an n by n matrix + o_file -> name of output file +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ Cpx *h,*u; FILE *fp; + int i,n,m; double *e,s; + unsigned int seed; + if(na!=3){ printf("para: size o_file\n"); exit(1);} + n=atoi(*++av); m=n*n; + fp=fopen(*++av,"wb"); + fwrite((void *)&n,sizeof(int),1,fp); + h=(Cpx *)calloc(2*m,sizeof(Cpx)); u=h+m; + e=(double *)calloc(n,sizeof(double)); + for(i=0,s=1.; i n by n matrix generated + o_file -> name of binary output file +*/ +#include "ccmath.h" +void main(int na,char **av) +{ int n,m; unsigned int seed; + double *a,*ev,*evc,s; FILE *fq; + if(na!=3){ printf("para: dim o_file\n"); exit(1);} + n=atoi(*++av); m=n*n; + fq=fopen(*++av,"wb"); + evc=(double *)calloc(2*m+n,sizeof(*a)); + a=evc+m; ev=a+m; + for(m=0,s=1.; m evaluation on n by n grid (n^2 evaluations) +*/ +#include +#include +#include "ccmath.h" +void main(int na,char **av) +{ double x,v,f,dx,dv,*s,*p; + int i,j,n; clock_t st,en; + if(na!=2){ printf("para: loop_sz\n"); exit(1);} + n=atoi(*++av); + printf(" %d evaluations of Jbessel\n",n*n); + st=clock(); + dx=20./n; dv=10./n; + for(i=0,x=0.,p=s; i +#include "ccmath.h" +void main(int na,char **av) +{ int i,n,m; FILE *fp; + clock_t st,en; + double dt,s,*a,*ev; + if(na!=2){ printf("para: in_file\n"); exit(1);} + fp=fopen(*++av,"rb"); + fread((void *)&n,sizeof(int),1,fp); + printf(" eigenvalues & vectors: dim= %d\n",n); + m=n*n; + a=(double *)calloc(m,sizeof(double)); + ev=(double *)calloc(n,sizeof(double)); + fread((void *)a,sizeof(double),n*n,fp); + st=clock(); + eigen(a,ev,n); + en=clock(); + dt=(double)(en-st)/(double)CLOCKS_PER_SEC; + printf(" time= %.2f sec.\n",dt); +} diff --git a/benchmk/timeval.c b/benchmk/timeval.c new file mode 100644 index 0000000..e248f67 --- /dev/null +++ b/benchmk/timeval.c @@ -0,0 +1,32 @@ +/* timeval.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Time computation of eigenvalues for a real symmetric matrix. + + Input file: created by smatgen +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ int i,n,m; FILE *fp; + clock_t st,en; + double dt,s,*a,*ev; + if(na!=2){ printf("para: in_file\n"); exit(1);} + fp=fopen(*++av,"rb"); + fread((void *)&n,sizeof(int),1,fp); + printf(" eigenvalues: dim= %d\n",n); + m=n*n; + a=(double *)calloc(m,sizeof(double)); + ev=(double *)calloc(n,sizeof(double)); + fread((void *)a,sizeof(double),n*n,fp); + st=clock(); + eigval(a,ev,n); + en=clock(); + dt=(double)(en-st)/(double)CLOCKS_PER_SEC; + printf(" time= %.2f sec.\n",dt); +} diff --git a/benchmk/timfft2.c b/benchmk/timfft2.c new file mode 100644 index 0000000..fb19b33 --- /dev/null +++ b/benchmk/timfft2.c @@ -0,0 +1,32 @@ +/* timfft2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Time a radix-two Fast Fourier transform. + + Input parameter: n -> length of series = 2^n (n < 20) +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ Cpx *f,*ft; + int n,i,m; + clock_t st,en; unsigned int seed; + if(na!=2){ printf("para: log2(sz)\n"); exit(1);} + printf(" Time Radix-2 FFT\n"); + m=atoi(*++av); n=1<re=nrml(); (f++)->im=nrml(); + } + st=clock(); + fft2(ft,m,'i'); + en=clock(); + printf(" time= %.3f sec\n",(double)(en-st)/(double)CLOCKS_PER_SEC); +} diff --git a/benchmk/timfftgc.c b/benchmk/timfftgc.c new file mode 100644 index 0000000..c9f5ef5 --- /dev/null +++ b/benchmk/timfftgc.c @@ -0,0 +1,34 @@ +/* timfftgc.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Time the general radix Fast Fourier Transform (FFT) + + Input parameter: size= n : series length +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ Cpx *f,*ft,**pc; + int kk[20],n,i,m; + clock_t st,en; unsigned int seed; + if(na!=2){ printf("para: sz\n"); exit(1);} + n=atoi(*++av); + n=pfac(n,kk,'o'); + ft=(Cpx *)calloc(n,sizeof(*f)); + pc=(Cpx **)calloc(n,sizeof(f)); + printf(" Time General Radix FFT\n"); + seed=(unsigned int)time(0L); setnrml(seed); + for(i=0,f=ft; ire=nrml(); (f++)->im=nrml(); + } + printf(" series length: %d\n",n); + st=clock(); + fftgc(pc,ft,n,kk,'d'); + en=clock(); + printf(" time= %.3f sec\n",(double)(en-st)/(double)CLOCKS_PER_SEC); +} diff --git a/benchmk/timheval.c b/benchmk/timheval.c new file mode 100644 index 0000000..d797962 --- /dev/null +++ b/benchmk/timheval.c @@ -0,0 +1,31 @@ +/* timheval.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Time computation of eigenvalues of a Hermitian matrix. + + Input file: created by hmatgen.c +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ Cpx *a; double *ev; int n; + clock_t st,en; double dt; + FILE *fb; + if(na!=2){ printf("para: input_file\n"); exit(1);} + fb=fopen(*++av,"rb"); + fread((void *)&n,sizeof(int),1,fb); + printf(" hermitian e-val: dim=%d\n",n); + a=(Cpx *)calloc(n*n,sizeof(Cpx)); + ev=(double *)calloc(n,sizeof(double)); + fread((void *)a,sizeof(Cpx),n*n,fb); + st=clock(); + heigval(a,ev,n); + en=clock(); + dt=(double)(en-st)/(double)CLOCKS_PER_SEC; + printf(" time= %.2f sec.\n",dt); +} diff --git a/benchmk/timhevec.c b/benchmk/timhevec.c new file mode 100644 index 0000000..5117b12 --- /dev/null +++ b/benchmk/timhevec.c @@ -0,0 +1,31 @@ +/* timhevec.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Time computation of eigenvalues and eigenvectors of a Hermitian matrix. + + Input file: created by hmatgen.c +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ Cpx *a; double *ev; int n; + clock_t st,en; double dt; + FILE *fb; + if(na!=2){ printf("para: input_file\n"); exit(1);} + fb=fopen(*++av,"rb"); + fread((void *)&n,sizeof(int),1,fb); + printf(" hermitian e-val and e-vec: dim=%d\n",n); + a=(Cpx *)calloc(n*n,sizeof(Cpx)); + ev=(double *)calloc(n,sizeof(double)); + fread((void *)a,sizeof(Cpx),n*n,fb); + st=clock(); + heigvec(a,ev,n); + en=clock(); + dt=(double)(en-st)/(double)CLOCKS_PER_SEC; + printf(" time= %.2f sec.\n",dt); +} diff --git a/benchmk/timhsrt.c b/benchmk/timhsrt.c new file mode 100644 index 0000000..4f6f25b --- /dev/null +++ b/benchmk/timhsrt.c @@ -0,0 +1,36 @@ +/* timhsrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Time the sort of double precision reals using hsort + + Input parameter: n -> number of double values to sort +*/ +#include +#include "ccmath.h" +main(na,av) +int na; char **av; +{ int i,f,n; double *x,**v; + clock_t st,en; unsigned int seed; + if(na!=2){ printf("para: size\n"); exit(1);} + n=atoi(*++av); + seed=(unsigned int)time(NULL); setnrml(seed); + printf(" Time Heap Sort\n"); + printf(" %d points input\n",n); + x=(double *)calloc(n,sizeof(*x)); + v=(double **)calloc(n,sizeof(x)); + for(i=0; i number of k values uniformly spaced + over interior of interval [0,1] +*/ +#include +#include +#include "ccmath.h" +double k,fel(double x); +double Pi2=1.5707963267949966; +double te=1.e-10; +void main(int na,char **av) +{ double x0,x1,dk,dt,*val; int m,j,n; + clock_t st,en; + if(na!=2){ printf("para: num\n"); exit(1);} + n=atoi(*++av); + printf(" Timing Numerical Integration\n"); + printf(" %d complete elliptic integrals\n",n); + val=(double *)calloc(n,sizeof(double)); + dk=1./(n+1); + x0=0.; x1=Pi2; m=10; k=dk; + st=clock(); + for(j=0; j system of n linear equations +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ int i,j,n; double *a,*x,*p; + unsigned int seed; + double dt,s,cmax,fabs(); clock_t st,en; + if(na!=2){ printf(" para: dim\n"); exit(1);} + n=atoi(*++av); printf(" lpac : dim= %d\n",n); + a=(double *)calloc(n*n+n,sizeof(double)); + x=a+n*n; + seed=(unsigned int)time(NULL); setnrml(seed); + for(i=0,p=a,j=n*n; i +#include "ccmath.h" +void main(na,av) +int na; char **av; +{ int i,j,n; + unsigned int seed; clock_t st,en; + double *a; + if(na!=2){ printf("para: dim\n"); exit(1);} + printf(" Time Matrix Inverse\n"); + n=atoi(*++av); + seed=(unsigned int)time(NULL); setnrml(seed); + printf(" dimension: %d x %d\n",n,n); + a=(double *)calloc(n*n,sizeof(double)); + for(i=0,j=n*n; i array of n double precision numbers +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ struct llst *dat,*s0,*t; + double *x; int i,f,n; + clock_t st,en; unsigned int seed; + if(na!=2){ printf("para: size\n"); exit(1);} + n=atoi(*++av); + seed=(unsigned int)time(NULL); setnrml(seed); + printf(" Time Merge Sort\n"); + printf(" %d input points\n",n); + x=(double *)calloc(n,sizeof(*x)); + for(i=0; ipls=(char *)(x+i); t->pt=t+1; ++t;} + (t-1)->pt=NULL; + s0=msort(s0,n,dubcmp); + en=clock(); + for(t=s0,f=0; t->pt!=NULL ;t=t->pt){ + if(*(double *)(t->pt->pls) < *(double *)(t->pls)){ f=1; break;} + } + if(f) printf(" sort failed\n"); + printf(" time : %.3f sec.\n",(double)(en-st)/(double)CLOCKS_PER_SEC); +} diff --git a/benchmk/timmul.c b/benchmk/timmul.c new file mode 100644 index 0000000..cc32cb7 --- /dev/null +++ b/benchmk/timmul.c @@ -0,0 +1,36 @@ +/* timmul.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Time the multiplication of two real square matrices. + + Input parameter: dimension= n -> matrices are n by n +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ int i,n,m; + clock_t st,en; unsigned int seed; + double dt,r,*a,*b,*c,*p,*q; + if(na!=2){ printf("para: dimension\n"); exit(1);} + n=atoi(*++av); + m=n*n; + a=(double *)calloc(3*m,sizeof(double)); + b=a+m; c=b+m; + seed=(unsigned int)time(NULL); setnrml(seed); + for(i=0,p=a,q=b; i number of normals generated +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int i,n; double x; + clock_t st,en; double dt; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + i=123456789; setnrml(i); + printf(" Timing Random Normal Generator nrml()\n"); + printf(" number generated= %ld\n",n); + st=clock(); + for(i=0; i array of n double precision numbers +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ int i,f,n; double *x,**v; + unsigned int seed; clock_t st,en; + if(na!=2){ printf("para: size\n"); exit(1);} + n=atoi(*++av); + seed=(unsigned int)time(NULL); setnrml(seed); + printf(" Time Quick Sort\n"); + printf(" %d points input\n",n); + x=(double *)calloc(n,sizeof(*x)); + v=(double **)calloc(n,sizeof(x)); + for(i=0; i a system of dimension n + iterations= m -> repeat computation m times +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ int i,j,k,n,n2,n3,m; + double *a,*a1,*x,*p; unsigned int seed; + double dt,s; clock_t st,en; + if(na!=3){ printf(" para: dim iterations\n"); exit(1);} + printf(" Time Small Linpac"); + n=atoi(*++av); m=atoi(*++av); n2=n*n; n3=n2+n; + printf(" dim: %d itt: %d\n",n,m); + a=(double *)calloc(m*n3,sizeof(double)); + seed=(unsigned int)time(NULL); setnrml(seed); + for(k=0,a1=a; k n dimensional double precision array +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ int i,f,n; double *x,**v; + clock_t st,en; unsigned int seed; + if(na!=2){ printf("para: size\n"); exit(1);} + n=atoi(*++av); + seed=(unsigned int)time(NULL); setnrml(seed); + printf(" Time Shell Sort\n"); + printf(" %d points input\n",n); + x=(double *)calloc(n,sizeof(*x)); + v=(double **)calloc(n,sizeof(x)); + for(i=0; i +#include + + /* Definitions of Types */ + +#ifndef NULL +#define NULL ((void *)0 +#endif + + /* Complex Types */ + +#ifndef CPX +struct complex {double re,im;}; +typedef struct complex Cpx; +#define CPX 1 +#endif + + /* Orthogonal Polynomial Type */ + +#ifndef OPOL +struct orpol {double cf,hs,df;}; +typedef struct orpol Opol; +#define OPOL 1 +#endif + + /* Tree Types */ + +#ifdef BAL +struct tnode {char *key,*rec; int bal; struct tnode *pr,*pl;}; +#else +struct tnode {char *key,*rec; struct tnode *pr,*pl;}; +#endif + + /* Time Series Types */ + +struct mcof {double cf; int lag;}; +struct fmod {int fac; double val;}; + + /* List Definition */ + +struct llst {char *pls; struct llst *pt;}; + + /* Hash Table Definition */ + +struct tabl {char *key,*val; struct tabl *pt;}; + + /* Extended Precision Types */ + +/* XMATH must be defined to use extended precision functions */ +#ifdef XMATH +#ifndef XPR +#define XDIM 7 +struct xpr {unsigned short nmm[XDIM+1];}; +extern unsigned short m_sgn,m_exp; +extern short bias; +extern int itt_div,k_tanh; +extern int ms_exp,ms_trg,ms_hyp; +extern short max_p,k_lin; +extern short d_bias,d_max,d_lex; +extern struct xpr zero,one,two,ten; +extern struct xpr x_huge; + +/* Variables used in extended precision arithmetic */ + +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=2,k_tanh=5; +int ms_exp=21,ms_hyp=25,ms_trg=31; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={{0x0,0x0}}; +struct xpr one={{0x3fff,0x8000}}; +struct xpr two={{0x4000,0x8000}}; +struct xpr ten={{0x4002,0xa000}}; +struct xpr x_huge={{0x7fff,0x0}}; + +/* Variables used in the extended precision math functions */ + +struct xpr pi4={{0x3FFE,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}}; +struct xpr pi2={{0x3FFF,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}}; +struct xpr pi={{0x4000,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}}; +struct xpr ee={{0x4000,0xADF8,0x5458,0xA2BB,0x4A9A,0xAFDC,0x5620,0x273D}}; +struct xpr ln2={{0x3FFE,0xB172,0x17F7,0xD1CF,0x79AB,0xC9E3,0xB398,0x3F3}}; +struct xpr srt2={{0x3FFF,0xB504,0xF333,0xF9DE,0x6484,0x597D,0x89B3,0x754B}}; +#define XPR 1 +#endif +#endif + + + /* FUNCTION DECLARATIONS */ + + +/* Linear Algebra */ + + + /* Real Linear Systems */ + + + int minv(double *a,int n) ; + + int psinv(double *v,int n) ; + + int ruinv(double *a,int n) ; + + int solv(double *a,double *b,int n) ; + + int solvps(double *s,double *x,int n) ; + + int solvru(double *a,double *b,int n) ; + + void solvtd(double *a,double *b,double *c,double *x,int m) ; + + void eigen(double *a,double *eval,int n) ; + + void eigval(double *a,double *eval,int n) ; + + double evmax(double *a,double *u,int n) ; + + int svdval(double *d,double *a,int m,int n) ; + + int sv2val(double *d,double *a,int m,int n) ; + + int svduv(double *d,double *a,double *u,int m,double *v,int n) ; + + int sv2uv(double *d,double *a,double *u,int m,double *v,int n) ; + + int svdu1v(double *d,double *a,int m,double *v,int n) ; + + int sv2u1v(double *d,double *a,int m,double *v,int n) ; + + void mmul(double *mat,double *a,double *b,int n) ; + + void rmmult(double *mat,double *a,double *b,int m,int k,int n) ; + + void vmul(double *vp,double *mat,double *v,int n) ; + + double vnrm(double *u,double *v,int n) ; + + void matprt(double *a,int n,int m,char *fmt) ; + + void fmatprt(FILE *fp,double *a,int n,int m,char *fmt) ; + + void trnm(double *a,int n) ; + + void mattr(double *a,double *b,int m,int n) ; + + void otrma(double *at,double *u,double *a,int n) ; + + void otrsm(double *st,double *u,double *s0,int n) ; + + void mcopy(double *a,double *b,int m) ; + + void ortho(double *evc,int n) ; + + void smgen(double *a,double *eval,double *evec,int n) ; + + /* utility routines for real symmertic eigensystems */ + + void house(double *a,double *d,double *ud,int n) ; + + void housev(double *a,double *d,double *ud,int n) ; + + int qreval(double *eval,double *ud,int n) ; + + int qrevec(double *eval,double *evec,double *dp,int n) ; + + /* utility routines for singular value decomposition */ + + int qrbdi(double *d, double *e,int n) ; + + int qrbdv(double *d, double *e,double *u,int m,double *v,int n) ; + + int qrbdu1(double *d, double *e,double *u,int m,double *v,int n) ; + + void ldumat(double *a,double *u,int m,int n) ; + + void ldvmat(double *a,double *v,int n) ; + + void atou1(double *a,int m,int n) ; + + void atovm(double *v,int n) ; + + + /* Complex Matrix Algebra */ + + + int cminv(Cpx *a,int n) ; + + int csolv(Cpx *a,Cpx *b,int n) ; + + void heigvec(Cpx *a,double *eval,int n) ; + + void heigval(Cpx *a,double *eval,int n) ; + + double hevmax(Cpx *a,Cpx *u,int n) ; + + void cmmul(Cpx *c,Cpx *a,Cpx *b,int n) ; + + void cmmult(Cpx *c,Cpx *a,Cpx *b,int m,int k,int n) ; + + void cvmul(Cpx *vp,Cpx *mat,Cpx *v,int n) ; + + Cpx cvnrm(Cpx *u,Cpx *v,int n) ; + + void cmprt(Cpx *a,int n,int m,char *fmt) ; + + void trncm(Cpx *a,int n) ; + + void hconj(Cpx *u,int n) ; + + void cmattr(Cpx *a,Cpx *b,int m,int n) ; + + void utrncm(Cpx *at,Cpx *u,Cpx *a,int n) ; + + void utrnhm(Cpx *ht,Cpx *u,Cpx *h0,int n) ; + + void cmcpy(Cpx *a,Cpx *b,int n) ; + + void unitary(Cpx *u,int n) ; + + void hmgen(Cpx *h,double *eval,Cpx *u,int n) ; + + + /* utility routines for hermitian eigen problems */ + + void chouse(Cpx *a,double *d,double *ud,int n) ; + + void chousv(Cpx *a,double *d,double *ud,int n) ; + + void qrecvc(double *eval,Cpx *evec,double *ud,int n) ; + + + +/* Geometry */ + + + + void crossp(double *h,double *u,double *v) ; + + double dotp(double *u,double *v,int m) ; + + double metpr(double *u,double *a,double *v,int n) ; + + void scalv(double *r,double s,int n) ; + + void trvec(double *c,double *a,double *b,int n) ; + + double leng(double *a,double *b,int n) ; + + void rotax(double *v,double az,double pa,double ang,int k) ; + + void euler(double *pv,int m,double a,double b,double c) ; + + /* plane trigonometry */ + + void trgsas(double a,double g,double b,double *ans); + + int trgasa(double a,double ss,double b,double *asn); + + double trgarea(double a,double b,double c); + + int trgsss(double a,double b,double c,double *ang); + + int trgssa(double a,double b,double ba,double *an); + + /* spherical trigonometry */ + + void stgsas(double a,double g,double b,double *ang); + + int stgasa(double a,double c,double b,double *ang); + + int stgsss(double a,double b,double c,double *ang); + + int stgaaa(double a,double b,double c,double *ang); + + double stgarea(double a,double b,double c); + + /* hyperbolic trigonometry */ + + void htgsas(double a,double g,double b,double *an); + + int htgasa(double a,double cc,double b,double *ans); + + int htgsss(double a,double b,double c,double *ang); + + int htgaaa(double a,double b,double c,double *as); + + double htgarea(double a,double b,double c); + + + +/* Numerical Integration */ + + + + double fintg(double a,double b,int n,double te,double (*func)()) ; + + /* functional form: double (*func)(double) */ + + double chintg(double *a,int m,double (*func)()) ; + + /* functional form: double (*func)(double) */ + + double fchb(double x,double *a,int m) ; + + int deqsy(double *y,int n,double a,double b,int nd,double te, + int (*fsys)()) ; + + /* functional form: int (*fsys)(double x,double *y,double *dp) */ + + + +/* Optimization and Roots */ + + + + int optmiz(double *x,int n,double (*func)(),double de, + double test,int max) ; + + /* functional form: double (*func)(double *x) */ + + double optsch(double (*func)(),double a,double b,double test) ; + + /* functional form: double (*func)(double) */ + + int plrt(double *cof,int n,struct complex *root,double ra,double rb) ; + + struct complex polyc(struct complex z,double *cof,int n) ; + + double secrt(double (*func)(),double x,double dx,double test) ; + + /* functional form: double (*func)(double) */ + + int solnl(double *x,double *f,double (*fvec[])(),int n,double test) ; + + /* functional form: double (*fvec[])(double *x) */ + + int solnx(double *x,double *f,double (*fvec[])(),double *jm, + int n,double test) ; + + /* functional form: double (*fvec[])(double *x) */ + + + + +/* Curve Fitting and Least Squares */ + + + + void chcof(double *c,int m,double (*func)()) ; + + /* functional form: double (*func)(double) */ + + void chpade(double *c,double *a,int m,double *b,int n) ; + + double ftch(double x,double *a,int m,double *b,int n) ; + + void cspl(double *x,double *y,double *z,int m,double tn) ; + + void csplp(double *x,double *y,double *z,int m,double tn) ; + + double csfit(double w,double *x,double *y,double *z,int m) ; + + double tnsfit(double w,double *x,double *y,double *z, + int m,double tn) ; + + double dcspl(double x,double *u,double *v,double *z,int m) ; + + + /* polynominal least squares functions use the Opol structure. */ + + void plsq(double *x,double *y,int n,Opol *c,double *ssq,int m) ; + + double pplsq(double *x,double *y,int n,double *b,int m) ; + + double evpsq(double x,Opol *c,int m) ; + + double evpsqv(double x, Opol *c,int m,double *sig,double sqv) ; + + void psqcf(double *pc,Opol *c,int m) ; + + void psqvar(double *var,double s,Opol *c,int m) ; + + + /* QR transformation for linear least squares. */ + + double qrlsq(double *a,double *b,int m,int n,int *f) ; + + double qrvar(double *v,int m,int n,double ssq) ; + + + /* singular value decomposition least squares. */ + + double lsqsv(double *x,int *pr,double *var,double *d,double *b, + double *v,int m,int n,double th) ; + + int svdlsq(double *d,double *a,double *b,int m,double *v,int n) ; + + int sv2lsq(double *d,double *a,double *b,int m,double *v,int n) ; + + + /* utility called by svdlsq and sv2lsq. */ + + int qrbdbv(double *d,double *e,double *b,double *v,int n) ; + + + /* nonlinear least squares */ + + double seqlsq(double *x,double *y,int n,double *par,double *var, + int m,double de,double (*func)(),int kf) ; + + /* functional form: double (*func)(double x,double *par) */ + + double gnlsq(double *x,double *y,int n,double *par, + double *var,int m,double de,double (*func)()) ; + + /* functional form: double (*func)(double x,double *par) */ + + double fitval(double x,double *s,double *par,double (*fun)(), + double *v,int n) ; + + /* functional form: double (*func)(double x,double *par) */ + + void setfval(int i,int n) ; + + + +/* Fourier Analysis */ + + + + void fft2(struct complex *ft,int m,int inv) ; + + void fft2_d(struct complex *a,int m,int n,int f) ; + + void fftgc(struct complex **pc,struct complex *ft,int n, + int *kk,int inv) ; + + void fftgr(double *x,struct complex *ft,int n,int *kk,int inv) ; + + void ftuns(struct complex **pt,int n) ; + + int pfac(int n,int *kk,int fe) ; + + void pshuf(Cpx **pa,Cpx **pb,int *kk,int n) ; + + int pwspec(double *x,int n,int m) ; + + void smoo(double *x,int n,int m) ; + + + +/* Simulation Support */ + + + double *autcor(double *x,int n,int lag) ; + + int *hist(double *x,int n,double xmin,double xmax, + int kbin,double *bin) ; + + unsigned int lran1() ; + + void setlran1(unsigned int seed) ; + + unsigned int lrand() ; + + void setlrand(unsigned int seed) ; + + int bran(int n) ; + + void setbran(unsigned int seed) ; + + int bran2(int n) ; + + void setbran2(unsigned int seed) ; + + double unfl() ; + + void setunfl(unsigned int seed) ; + + double unfl2() ; + + void setunfl2(unsigned int seed) ; + + double nrml() ; + + void setnrml(unsigned int seed) ; + + void norm(double *err) ; + + void setnorm(unsigned int seed) ; + + void norm2(double *err) ; + + void setnorm2(unsigned int seed) ; + + void sampl(void **s,int n,void **d,int m) ; + + void shuffl(void **s,int n) ; + + /* utility routines used for 2^31 - 1 modular arithmetic */ + + unsigned int lrana(unsigned int s) ; + + unsigned int lranb(unsigned int s) ; + + + +/* Sorts and Searches */ + + + + int batdel(char *kin,struct tnode *hd) ; + + struct tnode *batins(char *kin,struct tnode *hd) ; + + struct tnode *btsearch(char *kin,struct tnode *hd) ; + + void btsort(struct tnode *hd,struct tnode **ar) ; + + void prbtree(struct tnode *hd,int m) ; + + int btdel(char *kin,struct tnode *hd) ; + + struct tnode *btins(char *kin,struct tnode *hd) ; + + struct tnode *tsearch(char *kin,struct tnode *hd) ; + + void tsort(struct tnode *hd,struct tnode **ar) ; + + void prtree(struct tnode *hd,int m) ; + + int hashdel(char *kin,struct tabl *harr[],int mh) ; + + struct tabl *hashins(char *kin,struct tabl *harr[],int mh) ; + + struct tabl *hfind(char *kin,struct tabl *harr[],int mh) ; + + int hval(char *key,int mh) ; + + struct llst *msort(struct llst *st,int dim,int (*comp)()) ; + + void qsrt(void *v,int i,int j,int (*comp)()) ; + + void hsort(void *v,int n,int (*comp)()) ; + + void ssort(void *v,int n,int (*comp)()) ; + + /* comparison functions for sort routines. */ + + /* define the functional form of int (*comp)() */ + + int dubcmp(double *x,double *y) ; + + int intcmp(int *x,int *y) ; + + int unicmp(unsigned *x,unsigned *y) ; + + /* the standard library function strcmp will also work + with these sorts */ + + + +/* Statistical Distributions */ + + + + double qnorm(double x) ; + + double pctn(double pc) ; + + double qgama(double x,double a) ; + + double pctg(double pc,double a) ; + + double qbeta(double x,double a,double b) ; + + double pctb(double pc,double a,double b) ; + + double qgnc(double x,double a,double d) ; + + double pctgn(double pc,double a,double d) ; + + double qbnc(double x,double a,double b,double d) ; + + double pctbn(double pc,double a,double b,double d) ; + + + +/* Special Functions */ + + + /* elliptic integrals and functions */ + + double nome(double k,double *pk,double *pkp) ; + + double amelp(double u,double k) ; + + double theta(double u,int n) ; + + void stheta(double k) ; + + double felp(double an,double k,double *pk,double *pz,double *ph) ; + + double gelp(double an,double k,double as,double bs, + double ds,double *pg,double *pf,double *pk) ; + + double g2elp(double an,double bn,double k,double as, + double bs,double ds) ; + + + /* bessel functions */ + + double jbes(double v,double x) ; + + double ibes(double v,double x) ; + + double kbes(double v,double x) ; + + double nbes(double v,double x) ; + + double drbes(double x,double v,int f,double *p) ; + + double rcbes() ; + + void setrcb(double u,double y,int fl,int dr,double *pf, + double *ph) ; + + + /* spherical bessel functions */ + + double jspbes(int n,double x) ; + + double kspbes(int n,double x) ; + + double yspbes(int n,double x) ; + + double drspbes(double x,int n,int f,double *p) ; + + double rcspbs() ; + + void setrcsb(int n,double y,int fl,int dr,double *pf,double *ph) ; + + /* airy functions */ + + double airy(double x,int df) ; + + double biry(double x,int df) ; + + /* gamma and related functions */ + + double gaml(double x) ; + + double psi(int m) ; + + double psih(double v) ; + + + /* support routines for evaluation of elliptic integrals */ + + double gsng(double *pa,double *pb,double *pc,double b,double an) ; + + double gsng2(double *pa,double *pb,double *pc,double b, + double an,double bn) ; + + + +/* Complex Arithmetic */ + + + + struct complex cmul(struct complex s,struct complex t) ; + + struct complex cdiv(struct complex s,struct complex t) ; + + struct complex cadd(struct complex s,struct complex t) ; + + struct complex csub(struct complex s,struct complex t) ; + + struct complex crmu(double a,struct complex z) ; + + struct complex cimu(double b,struct complex z) ; + + struct complex ccng(struct complex z) ; + + struct complex cdef(double r,double i) ; + + double cabs(struct complex c) ; + + double cnrm(struct complex z) ; + + struct complex cexp(struct complex z) ; + + struct complex clog(struct complex z) ; + + struct complex csinh(struct complex z) ; + + struct complex ccosh(struct complex z) ; + + struct complex ctanh(struct complex z) ; + + struct complex casinh(struct complex z) ; + + struct complex cacosh(struct complex z) ; + + struct complex catanh(struct complex z) ; + + struct complex casin(struct complex z) ; + + struct complex cacos(struct complex z) ; + + struct complex catan(struct complex z) ; + + struct complex csqrt(struct complex z) ; + + struct complex csin(struct complex z) ; + + struct complex ccos(struct complex z) ; + + struct complex ctan(struct complex z) ; + + + +/* Time Series */ + + + + double sarma(double er) ; + + void setsim(int k) ; + + double parma(double *x,double *e) ; + + double evfmod(struct fmod y) ; + + void setevf(int k) ; + + double drfmod(struct fmod y,double *dr) ; + + void setdrf(int k) ; + + double seqtsf(struct fmod *x,int n,double *var,int kf) ; + + double fixtsf(struct fmod *x,int n,double *var,double *cr) ; + + double evmod(double y) ; + + void setev(int k) ; + + double drmod(double y,double *dr) ; + + void setdr(int k) ; + + double seqts(double *x,int n,double *var,int kf) ; + + double fixts(double *x,int n,double *var,double *cr) ; + + int resid(double *x,int n,int lag,double **pau,int nbin, + double xa,double xb,int **phs,int *cks) ; + + int sany(double *x,int n,double *pm,double *cd,double *ci, + int nd,int ms,int lag) ; + + double sdiff(double y,int nd,int k) ; + + double sintg(double y,int nd,int k) ; + + double xmean(double *x,int n) ; + + + +/* Extended Precision Arithmetic */ + +/* XMATH must be defined to use these functions */ + +#ifdef XMATH + + struct xpr xadd(struct xpr s,struct xpr t,int f) ; + + struct xpr xmul(struct xpr s,struct xpr t) ; + + struct xpr xdiv(struct xpr s,struct xpr t) ; + + double xtodub(struct xpr s) ; + + struct xpr dubtox(double y) ; + + struct xpr inttox(int n) ; + + int xprcmp(struct xpr *pa,struct xpr *pb) ; + + struct xpr xneg(struct xpr s) ; + + struct xpr xabs(struct xpr s) ; + + int xex(struct xpr *ps) ; + + int neg(struct xpr *ps) ; + + struct xpr xfrex(struct xpr s,int *p) ; + + struct xpr xfmod(struct xpr s,struct xpr t,int *p) ; + + struct xpr xsqrt(struct xpr z) ; + + struct xpr xexp(struct xpr z) ; + + struct xpr xlog(struct xpr z) ; + + struct xpr xpwr(struct xpr s,int n) ; + + struct xpr xpr2(struct xpr s,int m) ; + + struct xpr xtan(struct xpr z) ; + + struct xpr xcos(struct xpr z) ; + + struct xpr xsin(struct xpr z) ; + + struct xpr xatan(struct xpr z) ; + + struct xpr xasin(struct xpr z) ; + + struct xpr xacos(struct xpr z) ; + + struct xpr xtanh(struct xpr z) ; + + struct xpr xsinh(struct xpr z) ; + + struct xpr xcosh(struct xpr z) ; + + struct xpr atox(char *s) ; + + void prxpr(struct xpr u,int lim) ; + + void xprint(struct xpr x) ; + + /* special applications */ + + void xchcof(struct xpr *cf,int m,struct xpr (*xfunc)()) ; + + /* functional form: xpr (*xfunc)(xpr *cf) */ + + struct xpr xevtch(struct xpr z,struct xpr *a,int m) ; + + + /* utility operations on extended precision numbers */ + + struct xpr sfmod(struct xpr s,int *p) ; + + void lshift(int n,unsigned short *pm,int m) ; + + void rshift(int n,unsigned short *pm,int m) ; + +#endif + + + /* Utility Operations (on Bits) */ + + + unsigned short bset(unsigned short x,unsigned short n) ; + + int bget(unsigned short x,unsigned short n) ; + + int bcnt(unsigned short x) ; + + unsigned int lbset(unsigned int x,int n) ; + + int lbget(unsigned int x,int n) ; + + int lbcnt(unsigned int x) ; + + void bitpc(unsigned char x) ; + + void bitps(unsigned short x) ; + + void bitpl(unsigned int x) ; + + void bitpf(float x); + + void bitpd(double x) ; + +#ifdef XMATH + void bpatx(struct xpr x) ; +#endif + + double pwr(double y,int n) ; + + +/* + special declarations required for shared library +*/ + +int np,nma,nar,nfc,ndif; +struct mcof *par,*pma,*pfc; diff --git a/cfit/chcof.c b/cfit/chcof.c new file mode 100644 index 0000000..ab53910 --- /dev/null +++ b/cfit/chcof.c @@ -0,0 +1,18 @@ +/* chcof.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +void chcof(double *c,int m,double (*func)()) +{ double *p,*q,a,da,an,f; int j; + ++m; q=c+m; a=1.570796326794897/m; da=a*2.; + for(p=c; p +void chpade(double *c,double *a,int m,double *b,int n) +{ double *mat,*ps; int r,s,k; + mat=(double *)calloc(n*n,sizeof(double)); + for(ps=mat,s=m+1,k=1; k<=n ;){ + for(r=1; r<=n ;++r) *ps++ =(c[abs(s-r)]+c[s+r])/2.; + b[k++]= -c[s++]; + } + solv(mat,b+1,n); b[0]=1.; + for(s=0; s<=m ;++s){ a[s]=c[s]; + for(r=1; r<=n ;++r) a[s]+=(c[abs(s-r)]+c[s+r])*b[r]/2.; + } + a[0]/=2.; free(mat); +} diff --git a/cfit/csfit.c b/cfit/csfit.c new file mode 100644 index 0000000..654fee3 --- /dev/null +++ b/cfit/csfit.c @@ -0,0 +1,14 @@ +/* csfit.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +double csfit(double w,double *x,double *y,double *z,int m) +{ double s,t; int j,k; + if(wx[m]) return 0.; + for(j=1; w>x[j] ;++j); k=j-1; + s=(t=w-x[k])*(x[j]-w); t/=(x[j]-x[k]); + return (t*y[j]+(1.-t)*y[k]-s*(z[j]*(1.+t)+z[k]*(2.-t))); +} diff --git a/cfit/cspl.c b/cfit/cspl.c new file mode 100644 index 0000000..7eb3038 --- /dev/null +++ b/cfit/cspl.c @@ -0,0 +1,25 @@ +/* cspl.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include +void cspl(double *x,double *y,double *z,int m,double tn) +{ double h,s,t,*pa,*pb,*a,*b; int j; + if(tn==0.) tn=2.; + else{ h=sinh(tn); tn=(tn*cosh(tn)-h)/(h-tn);} + pa=(double *)calloc(2*m,sizeof(double)); pb=pa+m; + h=x[1]-x[0]; t=(y[1]-y[0])/h; + for(j=1,a=pa,b=pb; j0 ;--j){ z[j]-= *b-- *z[j+1]; z[j]/= *a--;} + free(pa); +} diff --git a/cfit/csplp.c b/cfit/csplp.c new file mode 100644 index 0000000..593dc86 --- /dev/null +++ b/cfit/csplp.c @@ -0,0 +1,32 @@ +/* csplp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include +void csplp(double *x,double *y,double *z,int m,double tn) +{ double h,s,t,u,*pa,*pb,*pc,*a,*b,*c; + int j; + if(tn==0.) tn=2.; + else{ h=sinh(tn); tn=(tn*cosh(tn)-h)/(h-tn);} + pa=(double *)calloc(3*m,sizeof(double)); pb=pa+m; pc=pb+m; + *pc=h=x[1]-x[0]; t=u=(y[1]-y[0])/h; + for(j=1,a=pa,b=pb; j0 ;--j){ h= *--b; s= *c--; + z[j]-=h*z[j+1]; z[j]/= *a; *c-=h*s; *c/= *a--; } + z[m]-=u*z[1]; s= *(pb-1)+ *(pc+m-1)-u* *pc; + h=z[0]=(z[m]/=s); + for(j=1,c=pc; ju[m] || xu[i] ;++i); + k=i-1; h=u[i]-u[k]; + x-=u[k]; x/=h; + d=(v[i]-v[k])/h; + return d-h*((z[i]-z[k])*(1.-3.*x*x)+z[k]*(3.-6.*x)); +} diff --git a/cfit/evpsq.c b/cfit/evpsq.c new file mode 100644 index 0000000..77a62d2 --- /dev/null +++ b/cfit/evpsq.c @@ -0,0 +1,17 @@ +/* evpsq.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "orpol.h" +double evpsq(double x,Opol *c,int m) +{ int i; double f,s,t; + f=s=c[m-1].cf; t=0.; + for(i=m-2; i>=0 ;--i){ + f=c[i].cf+(x-c[i].df)*s-c[i+1].hs*t; + t=s; s=f; + } + return f; +} diff --git a/cfit/evpsqv.c b/cfit/evpsqv.c new file mode 100644 index 0000000..b9b311b --- /dev/null +++ b/cfit/evpsqv.c @@ -0,0 +1,27 @@ +/* evpsqv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "orpol.h" +double evpsqv(double x,Opol *c,int m,double *v,double sig) +{ int i; double f,h,s,t,r,z; + f=s=c[m-1].cf; t=0.; + for(i=m-2; i>=0 ;--i){ + f=c[i].cf+(x-c[i].df)*s-c[i+1].hs*t; + t=s; s=f; + } + if(v!=0){ + r=s=1.; t=z=0.; + for(i=0; i +#include +static double *h,dl=1.e-8; +double fitval(double x,double *s,double *par,double (*fun)(), + double *v,int n) +{ double f,r,d; int i,j; + f=(*fun)(x,par); + for(i=0; ia ;){ nu= *p-- +y*t-tf; tf=t; t=nu;} + nu= *p+x*t-tf; t=tf=0.; + for(p=b+n; p>b ;){ de= *p-- +y*t-tf; tf=t; t=de;} + de= *p+x*t-tf; + return nu/de; +} diff --git a/cfit/gnlsq.c b/cfit/gnlsq.c new file mode 100644 index 0000000..fbef3dd --- /dev/null +++ b/cfit/gnlsq.c @@ -0,0 +1,33 @@ +/* gnlsq.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double gnlsq(double *x,double *y,int n,double *par,double *var,int m, + double de,double (*func)()) +{ double *cp,*dp,*p,*q,*r,*s,*t; + double err,f,z,ssq; int j,k,psinv(); + cp=(double *)calloc(2*m,sizeof(double)); dp=cp+m; + for(p=var,q=var+m*m; p +void vmul(double *x,double *v,double *y,int n); +void smgen(double *var,double *y,double *v,int n); +double lsqsv(double *x,int *pr,double *var,double *d,double *b,double *v, + int m,int n,double th) +{ double ssq,sig,*y,*p; + int i,k; + y=(double *)calloc(n,sizeof(double)); + for(i=n,ssq=0.,p=b+n; in){ + sig=ssq/(double)(m-n); + for(i=0; i +#include "orpol.h" +void plsq(double *x,double *y,int n,Opol *cf,double *ssq,int m) +{ double *pm,*e,*p,*q; + double f,s,t,u,w,tp; int i,j,k,l; + pm=(double *)calloc(3*n,sizeof(double)); + for(i=0,w=u=0.,e=pm,p=e+n; i +#include "orpol.h" +void plsq(double *x,double *y,int n,Opol *c,double *ss,int m); +void psqcf(double *pc,Opol *cf,int m); +double pplsq(double *x,double *y,int n,double *bc,int m) +{ Opol *c; double *ss,sq; + c=(Opol *)calloc(m,sizeof(Opol)); + ss=(double *)calloc(m,sizeof(double)); + plsq(x,y,n,c,ss,m); + psqcf(bc,c,m); + sq=ss[m-1]; + free(c); free(ss); + return sq; +} diff --git a/cfit/psqcf.c b/cfit/psqcf.c new file mode 100644 index 0000000..2d0cba5 --- /dev/null +++ b/cfit/psqcf.c @@ -0,0 +1,29 @@ +/* psqcf.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "orpol.h" +void psqcf(double *b,Opol *c,int m) +{ int i,j,k; double *sm,*s,u,v; + if(m>1){ + sm=(double *)calloc(m*m,sizeof(double)); + sm[0]=sm[m+1]=1.; sm[1]= -c[0].df; + for(i=2; i +#include "orpol.h" +void psqvar(double *v,double sig,Opol *c,int m) +{ int i,j,k; double *sm,*s,*s1,*u,w,x; + if(m>1){ + sm=(double *)calloc(m*m+m,sizeof(double)); + u=sm+m*m; + sm[0]=sm[m+1]=1.; sm[1]= -c[0].df; + for(i=2; i +int qrbdbv(double *d,double *e,double *b,double *v,int n) +{ int i,j,k,nn,jj,nm; + double u,x,y,f,g,c,s,t,w,*p,*q; + for(j=1,t=fabs(d[0]); jt) t=s; + t*=1.e-15; nn=100*n; nm=n; + for(j=0; n>1 && j0 ;--k){ + if(fabs(e[k-1])k){ + f=s*e[i]; g*=c; + e[i-1]=u=sqrt(x*x+f*f); + c=x/u; s=f/u; + } + f=c*y+s*g; g=c*g-s*y; + for(jj=0,p=v+i; jj +#include +double qrlsq(double *a,double *b,int m,int n,int *f) +{ double *p,*q,*w,*v; + double s,h,r; + int i,j,k,mm,ms; + if(m1){ + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; w[0]+=h; + for(k=1,ms=n-i; kn) ssq/=(double)(m-n); + ruinv(v,n); + for(j=0,p=v; j +#include +double seqlsq(double *x,double *y,int n,double *par,double *var,int m, + double de,double (*func)(),int kf) +{ double *pd,*pc,*pmax,*p,*q,*r,*s,*t; + double err,ssq,f,z; int j; + pd=(double *)calloc(2*m,sizeof(double)); pc=pd+m; + if(kf==0){ for(p=var,pmax=p+m*m; p +#include +int ldvmat(double *a,double *v,int n); +int qrbdbv(double *d,double *e,double *b,double *v,int n); +int sv2lsq(double *d,double *a,double *b,int m,double *v,int n) +{ double *p,*p1,*q,*pp,*w,*e; + double s,t,h,r,sv; + int i,j,k,mm,nm,ms; + if(m1){ h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; w[0]+=h; + for(k=1,ms=n-i; k1){ sv=h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; t=1./(w[0]+=h); + sv=1.+fabs(*p/h); + for(k=1,ms=n-i; k1){ sv=h=0.; + for(j=0,q=p1,s=0.; j0.){ + h=sqrt(s); if(*p1<0.) h= -h; + sv=1.+fabs(*p1/h); + s+= *p1*h; s=1./s; t=1./(*p1+=h); + for(k=n,ms=n*(n-i); k +#include +void ldvmat(double *a,double *v,int n); +int qrbdbv(double *d,double *e,double *b,double *v,int n); +int svdlsq(double *d,double *a,double *b,int m,double *v,int n) +{ double *p,*p1,*q,*pp,*w,*e; + double s,h,r,t,sv; + int i,j,k,mm,nm,ms; + if(m1){ h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; t=1./(w[0]+=h); + for(k=1,ms=n-i; k1){ + for(j=0,q=p1,s=0.; j0.){ + h=sqrt(s); if(*p1<0.) h= -h; + sv=1.+fabs(*p1/h); + s+= *p1*h; s=1./s; t=1./(*p1+=h); + for(k=n,ms=n*(m-i); k sequential + f -> batch + e -> quit + tplsq - no inputs + tpplsq - no inputs + tqrlsq - data/tqr1.dat : (input file) + tqrlsq2 - data/tqr2.dat : (input file) + tsv2lsq - data/tlsq1.dat : (input file) + tsvdlsq - data/tlsq1.dat : (input file) diff --git a/cfit/test/data/cspin.dat b/cfit/test/data/cspin.dat new file mode 100644 index 0000000..2f07bae --- /dev/null +++ b/cfit/test/data/cspin.dat @@ -0,0 +1,8 @@ +0. 0. +.2 1.5 +.4 1.8 +.6 .5 +.8 -1. +1. -1.2 +1.2 -.3 +1.4 .5 diff --git a/cfit/test/data/lsqsv.dat b/cfit/test/data/lsqsv.dat new file mode 100644 index 0000000..4e24463 --- /dev/null +++ b/cfit/test/data/lsqsv.dat @@ -0,0 +1,2 @@ +5 8 .1 +1. .4 2.1 -1.2 -.7 diff --git a/cfit/test/data/tlsq1.dat b/cfit/test/data/tlsq1.dat new file mode 100644 index 0000000..803548e --- /dev/null +++ b/cfit/test/data/tlsq1.dat @@ -0,0 +1,11 @@ + 7 4 + +1.2 2. -1.5 -1.3 +2.1 -3. 1.4 -1. +1.25 2.5 1.3 -3.1 +-1. 1.8 -2.7 1.6 +1.2 -2. 1.3 -1.9 +-1. 2. -2. 2.3 +3. 1.5 -2.1 1.7 + +1. 1.2 2.1 -1. -2.1 1.8 -.8 diff --git a/cfit/test/data/tqr1.dat b/cfit/test/data/tqr1.dat new file mode 100644 index 0000000..347bd61 --- /dev/null +++ b/cfit/test/data/tqr1.dat @@ -0,0 +1,3 @@ + 4 40 + .025 + 1.5 -3. 2. -1.2 diff --git a/cfit/test/data/tqr2.dat b/cfit/test/data/tqr2.dat new file mode 100644 index 0000000..0adda87 --- /dev/null +++ b/cfit/test/data/tqr2.dat @@ -0,0 +1,3 @@ + 5 50 + .1 + -1. 2.5 1.5 -2. .5 diff --git a/cfit/test/tchcof.c b/cfit/test/tchcof.c new file mode 100644 index 0000000..dc3e97b --- /dev/null +++ b/cfit/test/tchcof.c @@ -0,0 +1,49 @@ +/* tchcof.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: chcof +*/ +#include "ccmath.h" +#include +char fnam[]="exp(x)"; +void main(void) +{ double c[20],fun(double x); + int m=16,j; + printf(" Test of Tchebycheff Coefficient Generator\n"); + printf(" function = %s\n",fnam); + chcof(c,m,fun); + for(j=0; j<=m ;++j) printf(" %2d %9.7f\n",j,c[j]); +} +/* other functions whose Tchebycheff series is + desired can be substituted below. */ +double fun(double x) +{ double y=exp(x); + return y; +} +/* Test output + + Test of Tchebycheff Coefficient Generator + function = exp(x) + 0 2.5321318 + 1 1.1303182 + 2 0.2714953 + 3 0.0443368 + 4 0.0054742 + 5 0.0005429 + 6 0.0000450 + 7 0.0000032 + 8 0.0000002 + 9 0.0000000 + 10 0.0000000 + 11 0.0000000 + 12 0.0000000 + 13 0.0000000 + 14 0.0000000 + 15 -0.0000000 + 16 0.0000000 +*/ diff --git a/cfit/test/tchpade.c b/cfit/test/tchpade.c new file mode 100644 index 0000000..be85ef3 --- /dev/null +++ b/cfit/test/tchpade.c @@ -0,0 +1,86 @@ +/* tchpade.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: chpade ftch + Uses: chcof matprt + + Alternative values for the degree of the numerator (nn) and + denominator (nd) can be used with the call: 'tchpade nn nd' + mc > nn+nd is required +*/ +#include "ccmath.h" +#include +#define ND 15 +#define NP 30 +int nn=3,nd=3; +/* increase mc if you intend to use nn+nd > 12 */ +int mc=12; +char fnam[]="exp([1+x]/2)"; +void main(int na,char **av) +{ double c[NP],a[ND],b[ND],fun(),y,f,er,xx,maxer; + int j; + if(na==3){ + nn=atoi(*++av); nd=atoi(*++av); + } + printf(" Test of Rational Tchebycheff Approximation\n"); + printf(" approximating %s\n\n",fnam); + chcof(c,mc,fun); + printf(" series coefficients:\n"); + for(j=0; j<=mc ;++j) printf(" %2d %14.10f\n",j,c[j]); + chpade(c,a,nn,b,nd); + printf(" numerator coef.:\n"); matprt(a,nn,1," %14.10f"); + printf(" denominator coef.:\n"); matprt(b,nd,1," %14.10f"); +/* + loop for approximate evaluation of the maximum error of + the Tchebycheff Pade' approximation +*/ + for(maxer=0.,y=-1.; y<1.01 ;y+=.05){ + er=ftch(y,a,nn,b,nd); f=fun(y); er-=f; + if((er=fabs(er))>maxer){ maxer=er; xx=y;} + } + printf(" maximum error = %e at x= %f\n",maxer,xx); +} +/* + The function used here is evaluated on the interval + -1 <= x <= 1. Other functions defined on this + interval may be substituted. +*/ +double fun(x) +double x; +{ double y=(1.+x)/2.; + return exp(y); +} +/* Test output + + Test of Rational Tchebycheff Approximation + approximating exp([1+x]/2) + + series coefficients: + 0 3.5067753088 + 1 0.8503916538 + 2 0.1052086936 + 3 0.0087221047 + 4 0.0005434368 + 5 0.0000271154 + 6 0.0000011281 + 7 0.0000000402 + 8 0.0000000013 + 9 0.0000000000 + 10 0.0000000000 + 11 0.0000000000 + 12 0.0000000000 + numerator coef.: + 1.6487668676 + 0.4085533815 + 0.0203671089 + denominator coef.: + 1.0000000000 + -0.2475754597 + 0.0123256203 + maximum error = 2.916283e-09 at x= 1.000000 +*/ diff --git a/cfit/test/tchpade2.c b/cfit/test/tchpade2.c new file mode 100644 index 0000000..c879ebb --- /dev/null +++ b/cfit/test/tchpade2.c @@ -0,0 +1,80 @@ +/* tchpade2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: chpade ftch + Uses: chcof matprt + + This test uses a restricted range for the argument of the + exponential function. + + Alternative values for the degree of the numerator (nn) and + denominator (nd) can be used with the call: 'tchpade2 nn nd' + mc > nn+nd is required. +*/ +#include "ccmath.h" +#include +#define ND 15 +#define NP 30 +int nn=3,nd=3; +int mc=12; +char fnam[]="exp([1+x]/4)"; +void main(int na,char **av) +{ double c[NP],a[ND],b[ND],fun(),y,f,er,xx,maxer; + int j; + if(na==3){ + nn=atoi(*++av); nd=atoi(*++av); + } + printf(" Test of Rational Tchebycheff Approximation\n"); + printf(" approximating %s\n\n",fnam); + chcof(c,mc,fun); + printf(" series coefficients:\n"); + for(j=0; j<=mc ;++j) printf(" %2d %14.10f\n",j,c[j]); + chpade(c,a,nn,b,nd); + printf(" numerator coef.:\n"); matprt(a,nn,1," %23.15f"); + printf(" denominator coef.:\n"); matprt(b,nd,1," %23.15f"); + for(maxer=0.,y=-1.; y<1.005 ;y+=.01){ + er=ftch(y,a,nn,b,nd); f=fun(y); er-=f; + if((er=fabs(er))>maxer){ maxer=er; xx=y;} + } + printf(" maximum error = %e at x= %f\n",maxer,xx); +} +/* function evaluated on interval -1 <= x <= 1 */ +double fun(x) +double x; +{ double y=(1.+x)/4.; + return exp(y); +} +/* Test output + + Test of Rational Tchebycheff Approximation + approximating exp([1+x]/4) + + series coefficients: + 0 2.6083336414 + 1 0.3235207557 + 2 0.0201675957 + 3 0.0008392246 + 4 0.0000262053 + 5 0.0000006548 + 6 0.0000000136 + 7 0.0000000002 + 8 0.0000000000 + 9 0.0000000000 + 10 0.0000000000 + 11 -0.0000000000 + 12 0.0000000000 + numerator coef.: + 1.284027649433916 + 0.160146208006370 + 0.004000678757135 + denominator coef.: + 1.000000000000000 + -0.124694061784970 + 0.003113992884993 + maximum error = 1.466643e-11 at x= 1.000000 +*/ diff --git a/cfit/test/tcspl.c b/cfit/test/tcspl.c new file mode 100644 index 0000000..eaea653 --- /dev/null +++ b/cfit/test/tcspl.c @@ -0,0 +1,156 @@ +/* tcspl.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: cspl csfit dcspl (when tn=0) or tnsfit (when tn!=0) + + To set a nonzero tension call: 'tcspl tn' 0 <= tn < 1 is assumed. + A user specified point set can be stored as x-y pairs in a file + and specified with the call: 'tcspl tn file'. + + The file cspin.dat is a sample file specifing the same points as + the test arrays initialized in this code. +*/ +#include "ccmath.h" +#include +#define MD 20 +/* number of splines = interpolation points - 1 */ +int n=7; +/* x values */ +double x[MD]={ + 0.0, 0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4}; +/* y values */ +double y[MD]={ + 0.0, 1.5, 1.8, 0.5, -1.0, -1.2, -0.3, 0.5}; +main(int na,char **av) +{ double p[MD],s,ds,tn; int i,j; + double atof(); FILE *fp; + if(na==2){ + fp=fopen(*++av,"r"); + for(n=0; fscanf(fp,"%lf %lf",x+n,y+n)!=EOF ;++n); + --n; + } +/* ds is the x-interval used in spline evaluation */ + ds=.04; +/* initial spline tension */ + tn=0.; + printf(" Test of Cubic Spline Interpolation\n"); + for(i=0; i<2 ;++i){ + printf("\n tension= %f\n",tn); + cspl(x,y,p,n,tn); + printf(" spline coefficients\n"); + for(j=0; j<=n ;++j) + printf(" %d x=%10.6f y=%10.6f z=%12.8f\n",j,x[j],y[j],p[j]); + if(tn==0.) printf(" evaluation of spline and derivative\n"); + else printf(" evaluation of spline with tension\n"); + for(s=0.; s<=1.4 ;s+=ds){ + if(tn==0.){ printf(" x= %8.3f F= %14.10f",s,csfit(s,x,y,p,n)); + printf(" F'= %14.10f\n",dcspl(s,x,y,p,n)); + } + else printf(" x= %8.3f F= %14.10f\n",s,tnsfit(s,x,y,p,n,tn)); + } + tn=0.6; + } +} +/* Test output + + Test of Cubic Spline Interpolation + + tension= 0.000000 + spline coefficients + 0 x= 0.000000 y= 0.000000 z= 0.00000000 + 1 x= 0.200000 y= 1.500000 z= -5.39161800 + 2 x= 0.400000 y= 1.800000 z= -8.43352800 + 3 x= 0.600000 y= 0.500000 z= -0.87427001 + 4 x= 0.800000 y= -1.000000 z= 6.93060804 + 5 x= 1.000000 y= -1.200000 z= 5.65183786 + 6 x= 1.200000 y= -0.300000 z= -2.03795946 + 7 x= 1.400000 y= 0.500000 z= 0.00000000 + evaluation of spline and derivative + x= 0.000 F= 0.0000000000 F'= 8.5783236001 + x= 0.040 F= 0.3414076262 F'= 8.4489247681 + x= 0.080 F= 0.6724633459 F'= 8.0607282721 + x= 0.120 F= 0.9828152525 F'= 7.4137341120 + x= 0.160 F= 1.2621114394 F'= 6.5079422879 + x= 0.200 F= 1.5000000000 F'= 5.3433527997 + x= 0.240 F= 1.6868809344 F'= 3.9763586396 + x= 0.280 F= 1.8161618688 F'= 2.4633527997 + x= 0.320 F= 1.8820023360 F'= 0.8043352800 + x= 0.360 F= 1.8785618688 F'= -1.0006939196 + x= 0.400 F= 1.8000000000 F'= -2.9517347990 + x= 0.440 F= 1.6438686362 F'= -4.7943593267 + x= 0.480 F= 1.4212891790 F'= -6.2741394710 + x= 0.520 F= 1.1467754036 F'= -7.3910752319 + x= 0.560 F= 0.8348410855 F'= -8.1451666094 + x= 0.600 F= 0.5000000000 F'= -8.5364136036 + x= 0.640 F= 0.1568445208 F'= -8.5589213329 + x= 0.680 F= -0.1797185847 F'= -8.2067949158 + x= 0.720 F= -0.4947039505 F'= -7.4800343525 + x= 0.760 F= -0.7731262109 F'= -6.3786396427 + x= 0.800 F= -1.0000000000 F'= -4.9026107867 + x= 0.840 F= -1.1632467193 F'= -3.2699553418 + x= 0.880 F= -1.2624148403 F'= -1.6986808657 + x= 0.920 F= -1.2999596015 F'= -0.1887873583 + x= 0.960 F= -1.2783362418 F'= 1.2597251804 + x= 1.000 F= -1.2000000000 F'= 2.6468567503 + x= 1.040 F= -1.0694576434 F'= 3.8187427001 + x= 1.080 F= -0.8994220543 F'= 4.6215183786 + x= 1.120 F= -0.7046576434 F'= 5.0551837856 + x= 1.160 F= -0.4999288217 F'= 5.1197389213 + x= 1.200 F= -0.3000000000 F'= 4.8151837856 + x= 1.240 F= -0.1165227070 F'= 4.3749845414 + x= 1.280 F= 0.0513030574 F'= 4.0326073514 + x= 1.320 F= 0.2073901752 F'= 3.7880522157 + x= 1.360 F= 0.3556515287 F'= 3.6413191343 + + tension= 0.600000 + spline coefficients + 0 x= 0.000000 y= 0.000000 z= 0.00000000 + 1 x= 0.200000 y= 1.500000 z= -5.32865356 + 2 x= 0.400000 y= 1.800000 z= -8.30205545 + 3 x= 0.600000 y= 0.500000 z= -0.86589508 + 4 x= 0.800000 y= -1.000000 z= 6.82792615 + 5 x= 1.000000 y= -1.200000 z= 5.56300619 + 6 x= 1.200000 y= -0.300000 z= -1.98013994 + 7 x= 1.400000 y= 0.500000 z= 0.00000000 + evaluation of spline with tension + x= 0.000 F= 0.0000000000 + x= 0.040 F= 0.3409532586 + x= 0.080 F= 0.6718217079 + x= 0.120 F= 0.9823751430 + x= 0.160 F= 1.2620904718 + x= 0.200 F= 1.5000000000 + x= 0.240 F= 1.6858957501 + x= 0.280 F= 1.8142735418 + x= 0.320 F= 1.8801623847 + x= 0.360 F= 1.8776903674 + x= 0.400 F= 1.8000000000 + x= 0.440 F= 1.6433919279 + x= 0.480 F= 1.4200115545 + x= 0.520 F= 1.1452841875 + x= 0.560 F= 0.8338948503 + x= 0.600 F= 0.5000000000 + x= 0.640 F= 0.1576136845 + x= 0.680 F= -0.1786437101 + x= 0.720 F= -0.4938813762 + x= 0.760 F= -0.7729054584 + x= 0.800 F= -1.0000000000 + x= 0.840 F= -1.1623146483 + x= 0.880 F= -1.2605326593 + x= 0.920 F= -1.2980274766 + x= 0.960 F= -1.2772970801 + x= 1.000 F= -1.2000000000 + x= 1.040 F= -1.0696028673 + x= 1.080 F= -0.8993088656 + x= 1.120 F= -0.7043696126 + x= 1.160 F= -0.4996814085 + x= 1.200 F= -0.3000000000 + x= 1.240 F= -0.1169270376 + x= 1.280 F= 0.0506107929 + x= 1.320 F= 0.2066891121 + x= 1.360 F= 0.3552183252 +*/ diff --git a/cfit/test/tcsplp.c b/cfit/test/tcsplp.c new file mode 100644 index 0000000..11a60a1 --- /dev/null +++ b/cfit/test/tcsplp.c @@ -0,0 +1,152 @@ +/* tcsplp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: csplp + Uses: csfit (when tn=0) tnsfit (when tn!=0) + + To set a nonzero tension call: 'tcsplp tn', 0 <= tn is assumed. + + The points for the interpolation lie on an ellipse, centered at + the origin with major axis along the x-coordinate. The number of + interpolation points (2m) and ellipse axes (a,b) can be altered + with the call: 'tcsplp tn a b m' +*/ +#include "ccmath.h" +#include +#define MD 20 +/* spline tension */ +double tn; +/* 1/2 the number of points */ +int m= 4; +/* ellipse axes (closed curve is an ellipse) */ +double a=2.,b=1.; +void main(int na,char **av) +{ double x[MD],y[MD],z[MD],w[MD],t[MD]; + double s,ds,u,atof(); int i,j; + double pi=3.1415926535897932; + if(na==4){ + a=atof(*++av); b=atof(*++av); m=atoi(*++av); + } + printf(" Test of Periodic Splines\n"); + printf(" interpolation angle = %9.3f\n",180./m); + tn=0.; + for(i=0; i<2 ;++i){ + printf("\n tension= %f\n\n",tn); + printf(" ellipse: a= %f b= %f\n",a,b); + s=0.; ds=pi/m; m*=2; + for(j=0; j<=m ;s+=ds){ x[j]=a*cos(s); y[j]=b*sin(s); t[j++]=s;} + csplp(t,x,z,m,tn); csplp(t,y,w,m,tn); + printf(" periodic spline coefficients\n"); + for(j=0; j<=m ;++j) + printf(" %2d x=%9f z=%9f y=%9f w=%9f\n",j,x[j],z[j],y[j],w[j]); + if(tn==0.) printf("\n evaluation of periodic cubic spline\n"); + else printf("\n evaluation of periodic tensioned spline\n"); + for(s=t[0],ds=pi/12.,u=t[m]+ds/2.; st[m]) s=t[m]; + if(tn==0.){ a=csfit(s,t,x,z,m); b=csfit(s,t,y,w,m);} + else{ a=tnsfit(s,t,x,z,m,tn); b=tnsfit(s,t,y,w,m,tn);} + printf(" x= %14.10f y= %14.10f\n",a,b); + } + tn=5.0; a=b=1.; + } +} +/* Test output + + Test of Periodic Splines + interpolation angle = 45.000 + + tension= 0.000000 + + ellipse: a= 2.000000 b= 1.000000 + periodic spline coefficients + 0 x= 2.000000 z=-0.350796 y= 0.000000 w=-0.000000 + 1 x= 1.414214 z=-0.248050 y= 0.707107 w=-0.124025 + 2 x= 0.000000 z= 0.000000 y= 1.000000 w=-0.175398 + 3 x=-1.414214 z= 0.248050 y= 0.707107 w=-0.124025 + 4 x=-2.000000 z= 0.350796 y= 0.000000 w=-0.000000 + 5 x=-1.414214 z= 0.248050 y=-0.707107 w= 0.124025 + 6 x=-0.000000 z=-0.000000 y=-1.000000 w= 0.175398 + 7 x= 1.414214 z=-0.248050 y=-0.707107 w= 0.124025 + 8 x= 2.000000 z=-0.350796 y=-0.000000 w=-0.000000 + + evaluation of periodic cubic spline + x= 2.0000000000 y= 0.0000000000 + x= 1.9302179004 y= 0.2583703622 + x= 1.7302610370 y= 0.4997396481 + x= 1.4142135624 y= 0.7071067812 + x= 0.9994792962 y= 0.8651305185 + x= 0.5167407245 y= 0.9651089502 + x= 0.0000000000 y= 1.0000000000 + x= -0.5167407245 y= 0.9651089502 + x= -0.9994792962 y= 0.8651305185 + x= -1.4142135624 y= 0.7071067812 + x= -1.7302610370 y= 0.4997396481 + x= -1.9302179004 y= 0.2583703622 + x= -2.0000000000 y= 0.0000000000 + x= -1.9302179004 y= -0.2583703622 + x= -1.7302610370 y= -0.4997396481 + x= -1.4142135624 y= -0.7071067812 + x= -0.9994792962 y= -0.8651305185 + x= -0.5167407245 y= -0.9651089502 + x= -0.0000000000 y= -1.0000000000 + x= 0.5167407245 y= -0.9651089502 + x= 0.9994792962 y= -0.8651305185 + x= 1.4142135624 y= -0.7071067812 + x= 1.7302610370 y= -0.4997396481 + x= 1.9302179004 y= -0.2583703622 + x= 2.0000000000 y= -0.0000000000 + + tension= 5.000000 + + ellipse: a= 1.000000 b= 1.000000 + periodic spline coefficients + 0 x= 1.000000 z=-0.094681 y= 0.000000 w= 0.000000 + 1 x= 0.923880 z=-0.087474 y= 0.382683 w=-0.036233 + 2 x= 0.707107 z=-0.066950 y= 0.707107 w=-0.066950 + 3 x= 0.382683 z=-0.036233 y= 0.923880 w=-0.087474 + 4 x= 0.000000 z=-0.000000 y= 1.000000 w=-0.094681 + 5 x=-0.382683 z= 0.036233 y= 0.923880 w=-0.087474 + 6 x=-0.707107 z= 0.066950 y= 0.707107 w=-0.066950 + 7 x=-0.923880 z= 0.087474 y= 0.382683 w=-0.036233 + 8 x=-1.000000 z= 0.094681 y= 0.000000 w=-0.000000 + 9 x=-0.923880 z= 0.087474 y=-0.382683 w= 0.036233 + 10 x=-0.707107 z= 0.066950 y=-0.707107 w= 0.066950 + 11 x=-0.382683 z= 0.036233 y=-0.923880 w= 0.087474 + 12 x=-0.000000 z= 0.000000 y=-1.000000 w= 0.094681 + 13 x= 0.382683 z=-0.036233 y=-0.923880 w= 0.087474 + 14 x= 0.707107 z=-0.066950 y=-0.707107 w= 0.066950 + 15 x= 0.923880 z=-0.087474 y=-0.382683 w= 0.036233 + 16 x= 1.000000 z=-0.094681 y=-0.000000 w= 0.000000 + + evaluation of periodic tensioned spline + x= 1.0000000000 y= 0.0000000000 + x= 0.9608472826 y= 0.2579862530 + x= 0.8618454582 y= 0.4969978003 + x= 0.7071067812 y= 0.7071067812 + x= 0.4969978003 y= 0.8618454582 + x= 0.2579862530 y= 0.9608472826 + x= 0.0000000000 y= 1.0000000000 + x= -0.2579862530 y= 0.9608472826 + x= -0.4969978003 y= 0.8618454582 + x= -0.7071067812 y= 0.7071067812 + x= -0.8618454582 y= 0.4969978003 + x= -0.9608472826 y= 0.2579862530 + x= -1.0000000000 y= 0.0000000000 + x= -0.9608472826 y= -0.2579862530 + x= -0.8618454582 y= -0.4969978003 + x= -0.7071067812 y= -0.7071067812 + x= -0.4969978003 y= -0.8618454582 + x= -0.2579862530 y= -0.9608472826 + x= -0.0000000000 y= -1.0000000000 + x= 0.2579862530 y= -0.9608472826 + x= 0.4969978003 y= -0.8618454582 + x= 0.7071067812 y= -0.7071067812 + x= 0.8618454582 y= -0.4969978003 + x= 0.9608472826 y= -0.2579862530 + x= 1.0000000000 y= -0.0000000000 +*/ diff --git a/cfit/test/tevpsq.c b/cfit/test/tevpsq.c new file mode 100644 index 0000000..4a0165b --- /dev/null +++ b/cfit/test/tevpsq.c @@ -0,0 +1,144 @@ +/* tevpsq.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: evpsq evpsqv + Uses: plsq +*/ +#include "ccmath.h" +#define ND 100 +#define NP 5 +double x[ND],y[ND]; +void main(void) +{ double dx,z,w,ss,s; +/* set dimensions of arrays used by plsq for output */ + double ssq[NP]; Opol cf[NP]; + int n,np,j; + printf(" Test of Polynominal Least Squares\n"); +/* set number of input points */ + n=ND; +/* + The test fit inputs are the values of a polynominal of + degree 4, defined in this loop. +*/ + for(j=0,dx=.1; j reduced rank solution) + + 8 meas. 5 param. + cf-in: + 1.0000 0.4000 2.1000 -1.2000 -0.7000 + sing-val: + 3.271984 0.933026 0.184390 0.024232 0.001806 + enter threshold: rank: 4 ssq= 0.000008101694 + cf-out: + 0.98806170 0.57253938 1.35978962 0.00969771 -1.36504152 + cf-var-mat: + 0.000011857 -0.000085383 0.000134713 0.000031663 -0.000114710 + -0.000085383 0.000700286 -0.001185774 -0.000255025 0.001039132 + 0.000134713 -0.001185774 0.002120958 0.000417448 -0.001911414 + 0.000031663 -0.000255025 0.000417448 0.000096597 -0.000355657 + -0.000114710 0.001039132 -0.001911414 -0.000355657 0.001752179 + var-ev: + 0.004599092 0.000079429 0.000003102 0.000000252 0.000000000 + var-evec: + 0.043243 -0.171071 -0.491188 -0.852960 0.007576 + -0.379459 0.686195 0.447672 -0.415632 -0.109486 + 0.678953 -0.029656 0.506425 -0.247091 0.469705 + 0.133146 -0.427051 0.429523 -0.161764 -0.767622 + -0.612728 -0.562690 0.342590 -0.111746 0.422006 +*/ diff --git a/cfit/test/tnlsq.c b/cfit/test/tnlsq.c new file mode 100644 index 0000000..e012ff4 --- /dev/null +++ b/cfit/test/tnlsq.c @@ -0,0 +1,135 @@ +/* tnlsq.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: seqlsq gnlsq non-linear least squares estimation + Uses: fmatprt + + The user is prompted for initial estimates of the fit function + parameters, and for control of the estimation mode used at each + step. To deliver output to a named file, use: 'tnlsq file'. +*/ +#include "ccmath.h" +/* define number of data points and parameters */ +#define ND 50 +#define NP 4 +/* set number of points and parameters */ +int n=ND,np=NP; +/* true parameter values */ +double parm[]={2.,-1.,1.5,2.}; +char fnc[]="(p0+p1*x)/(1+p2*x+p3*x^2)"; +FILE *fp; +void main(int na,char **av) +{ double de,z,dz,*p; +/* arrays used by estimation functions */ + double x[ND],y[ND],var[NP*NP]; + double ssq,fit(double u,double *v); + int j; char fl[4]; + if(na==2) fp=fopen(*++av,"w"); + else fp=stdout; + fprintf(fp," Test of Nonlinear Least Squares\n"); + fprintf(fp," fit f(x) = %s\n\n",fnc); +/* load input arrays with values corresponding to + the true function parameters +*/ + for(j=0,z=0.,dz=.1; j sequential g -> batch (gauss-newton) e -> quit +*/ + fprintf(stderr," continue ? (s,g,e) "); scanf("%s",fl); + if(*fl=='e') break; + } + fprintf(fp,"\n variance matrix:\n"); + fmatprt(fp,var,np,np," %8.5f"); +} +/* + The fit function is defined by the following code. It can be altered + to try new types of functions. +*/ +double fit(double x,double *parm) +{ return (parm[0]+x*parm[1])/(1.+x*(parm[2]+parm[3]*x)); +} +/* Test output + + Test of Nonlinear Least Squares + fit f(x) = (p0+p1*x)/(1+p2*x+p3*x^2) + + initial parameters: + 1.000 0.500 0.000 1.000 + + step 1 ssq= 2.761830601907 sequential + estimated parameters: + 1.359847 -0.411474 0.252327 1.319671 + + step 2 ssq= 0.731939569820 sequential + estimated parameters: + 1.496193 -0.601728 0.352518 1.367757 + + step 3 ssq= 0.440116200041 sequential + estimated parameters: + 1.570087 -0.688781 0.433709 1.405312 + + step 4 ssq= 0.319958479902 sequential + estimated parameters: + 1.619204 -0.739655 0.501845 1.437881 + + step 5 ssq= 0.263466800420 gauss-newton + estimated parameters: + 1.988244 -0.953015 1.536444 1.693967 + + step 6 ssq= 0.004883788924 sequential + estimated parameters: + 1.991860 -0.967221 1.531370 1.766035 + + step 7 ssq= 0.002722220022 sequential + estimated parameters: + 1.993675 -0.974577 1.526844 1.809617 + + step 8 ssq= 0.002078264568 gauss-newton + estimated parameters: + 2.000133 -0.999085 1.503270 1.992969 + + step 9 ssq= 0.000001123347 sequential + estimated parameters: + 2.000064 -0.999520 1.501720 1.996226 + + step 10 ssq= 0.000000392910 sequential + estimated parameters: + 2.000042 -0.999675 1.501166 1.997422 + + step 11 ssq= 0.000000256889 gauss-newton + estimated parameters: + 2.000000 -0.999999 1.499992 2.000015 + + step 12 ssq= 0.000000000003 sequential + estimated parameters: + 2.000000 -1.000000 1.499996 2.000007 + + variance matrix: + 0.43228 -0.15611 1.65350 -0.68475 + -0.15611 0.63871 0.21467 0.19490 + 1.65350 0.21467 15.01107 -14.38497 + -0.68475 0.19490 -14.38497 29.33553 +*/ diff --git a/cfit/test/tplsq.c b/cfit/test/tplsq.c new file mode 100644 index 0000000..4561d10 --- /dev/null +++ b/cfit/test/tplsq.c @@ -0,0 +1,97 @@ +/* tplsq.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: plsq psqcf psqvar +*/ +#include "ccmath.h" +#define ND 100 +#define NP 5 +double x[ND],y[ND]; +void main(void) +{ double dx,z; +/* set dimensions of arrays + used by plsq for output */ + double ssq[NP]; Opol cf[NP]; + double bc[NP],var[NP*NP]; + int n,np,j; + printf(" Test of Polynominal Least Squares\n"); +/* set number of input points */ + n=ND; +/* + The test fit inputs are the values of a polynominal of + degree 4, defined in this loop. +*/ + for(j=0,dx=.1; j> parameters */ + sv2lsq(d,a,b,m,v,n); + + printf(" sing-val:\n"); matprt(d,1,n," %10.6f"); + printf(" vec-b~:\n"); matprt(b,1,m," %10.6f"); + printf(" v-mat:\n"); matprt(v,n,n," %9.6f"); + for(i=n,s=0.; i +double tnsfit(double w,double *x,double *y,double *z,int m,double tn) +{ double s,t,u,a=sinh(tn); int j,k; + if(wx[m]) return 0.; + for(j=1; w>x[j] ;++j); k=j-1; + t=(w-x[k])/(s=x[j]-x[k]); s*=s/(a-tn); u=1.-t; + return t*y[j]+u*y[k]+s*(z[j]*(sinh(tn*t)-t*a)+z[k]*(sinh(tn*u)-u*a)); +} diff --git a/complex/alt/README b/complex/alt/README new file mode 100644 index 0000000..19530d2 --- /dev/null +++ b/complex/alt/README @@ -0,0 +1,4 @@ + The code in cihypa.c provides an alternate version of the + complex inverse hyperbolic functions suitable for use in + computations related to relativistic kinematics. The + difference is diff --git a/complex/alt/cihypa.c b/complex/alt/cihypa.c new file mode 100644 index 0000000..da0e238 --- /dev/null +++ b/complex/alt/cihypa.c @@ -0,0 +1,40 @@ +/* cihypa.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + alternate acosh branches for relativistic kinematics +*/ +#include "complex.h" +struct complex casinh(Cpx z) +{ struct complex u; + u.re=1.; u.im=0.; + u=csqrt(cadd(u,cmul(z,z))); + u.re+=z.re; u.im+=z.im; + return clog(u); +} +struct complex cacosh(Cpx z) +{ struct complex u; + u.re=1.; u.im=0.; + u=csqrt(csub(cmul(z,z),u)); + z.re+=u.re; z.im+=u.im; z=clog(z); + if(z.im<0.){ z.re= -z.re; z.im= -z.im;} + return z; +} +struct complex catanh(Cpx z) +{ struct complex u; +/* + int kf; + if(z.im==0. && z.re>1.) kf=1; else kf=0; +*/ + u.re=1.; u.im=0.; + u=cdiv(cadd(u,z),csub(u,z)); + u=crmu(.5,clog(u)); +/* + if(kf) u.im= -u.im; +*/ + return u; +} diff --git a/complex/alt/complex.h b/complex/alt/complex.h new file mode 100644 index 0000000..07c1d06 --- /dev/null +++ b/complex/alt/complex.h @@ -0,0 +1,21 @@ +/* complex.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef CPX +struct complex {double re,im;}; +typedef struct complex Cpx; +#define CPX 1 +#endif +#include +struct complex cadd(),csub(),cmul(),cdiv(); +struct complex crmu(),cimu(),ccng(),cdef(); +double cabs(),cnrm(); +struct complex csqrt(),cexp(),clog(); +struct complex csin(),ccos(),ctan(); +struct complex casin(),cacos(),catan(); +struct complex csinh(),ccosh(),ctanh(); +struct complex casinh(),cacosh(),catanh(); diff --git a/complex/carith.c b/complex/carith.c new file mode 100644 index 0000000..aaee82e --- /dev/null +++ b/complex/carith.c @@ -0,0 +1,50 @@ +/* carith.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +struct complex cmul(Cpx s,Cpx t) +{ double u; + u=s.re*t.re-s.im*t.im; + s.im=s.im*t.re+s.re*t.im; s.re=u; + return s; +} +struct complex cdiv(Cpx s,Cpx t) +{ double u,r; + r=t.re*t.re+t.im*t.im; + u=(s.re*t.re+s.im*t.im)/r; + s.im=(s.im*t.re-s.re*t.im)/r; s.re=u; + return s; +} +struct complex cadd(Cpx s,Cpx t) +{ s.re+=t.re; s.im+=t.im; + return s; +} +struct complex csub(Cpx s,Cpx t) +{ s.re-=t.re; s.im-=t.im; + return s; +} +struct complex crmu(double a,Cpx z) +{ z.re*=a; z.im*=a; return z; +} +struct complex cimu(double b,Cpx z) +{ double u; + u=z.re*b; z.re= -z.im*b; z.im=u; + return z; +} +struct complex ccng(Cpx z) +{ z.im= -z.im; return z; +} +struct complex cdef(double r,double i) +{ struct complex s; + s.re=r; s.im=i; return s; +} +double cabs(Cpx c) +{ return sqrt(c.re*c.re+c.im*c.im); +} +double cnrm(Cpx z) +{ return z.re*z.re+z.im*z.im; +} diff --git a/complex/cexp.c b/complex/cexp.c new file mode 100644 index 0000000..73265fa --- /dev/null +++ b/complex/cexp.c @@ -0,0 +1,23 @@ +/* cexp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +struct complex cexp(Cpx z) +{ double s,c,u; +/* s=sincos(z.im,&c); */ + s=sin(z.im); c=cos(z.im); + u=exp(z.re); + z.re=u*c; z.im=u*s; + return z; +} +struct complex clog(Cpx z) +{ double r; + r=z.re*z.re+z.im*z.im; + z.im=atan2(z.im,z.re); + z.re=ldexp(log(r),-1); + return z; +} diff --git a/complex/chypb.c b/complex/chypb.c new file mode 100644 index 0000000..0c631e8 --- /dev/null +++ b/complex/chypb.c @@ -0,0 +1,35 @@ +/* chypb.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +struct complex csinh(Cpx z) +{ double c,s,u,v; +/* s=sincos(z.im,&c); */ + s=sin(z.im); c=cos(z.im); + u=exp(z.re); v=1./u; + u=ldexp(u+v,-1); v=u-v; + z.re=v*c; z.im=u*s; + return z; +} +struct complex ccosh(Cpx z) +{ double c,s,u,v; +/* s=sincos(z.im,&c); */ + s=sin(z.im); c=cos(z.im); + u=exp(z.re); v=1./u; + u=ldexp(u+v,-1); v=u-v; + z.re=c*u; z.im=v*s; + return z; +} +struct complex ctanh(Cpx z) +{ double c,s,u,v,d; +/* s=sincos(z.im,&c); */ + s=sin(z.im); c=cos(z.im); + u=exp(z.re); v=1./u; + u=ldexp(u+v,-1); v=u-v; + d=c*c+v*v; z.re=u*v/d; z.im=s*c/d; + return z; +} diff --git a/complex/cihyp.c b/complex/cihyp.c new file mode 100644 index 0000000..2e7dce7 --- /dev/null +++ b/complex/cihyp.c @@ -0,0 +1,39 @@ +/* cihyp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +struct complex casinh(Cpx z) +{ struct complex u; + u.re=1.; u.im=0.; + u=csqrt(cadd(u,cmul(z,z))); + u.re+=z.re; u.im+=z.im; + return clog(u); +} +struct complex cacosh(Cpx z) +{ struct complex u; int kf; + if(z.im==0. && z.re< -1.) kf=1; else kf=0; + u.re=1.; u.im=0.; + u=csqrt(csub(cmul(z,z),u)); + z.re+=u.re; z.im+=u.im; z=clog(z); + if(z.re<0.){ z.re= -z.re; z.im= -z.im;} + if(kf) z.im= -z.im; + return z; +} +struct complex catanh(Cpx z) +{ struct complex u; +/* + int kf; + if(z.im==0. && z.re>1.) kf=1; else kf=0; +*/ + u.re=1.; u.im=0.; + u=cdiv(cadd(u,z),csub(u,z)); + u=crmu(.5,clog(u)); +/* + if(kf) u.im= -u.im; +*/ + return u; +} diff --git a/complex/citrg.c b/complex/citrg.c new file mode 100644 index 0000000..4a93445 --- /dev/null +++ b/complex/citrg.c @@ -0,0 +1,38 @@ +/* citrg.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +struct complex casin(Cpx z) +{ struct complex u; + u.re=1.; u.im=0.; + u=csqrt(csub(u,cmul(z,z))); + u.re-=z.im; u.im+=z.re; z=clog(u); + u.re=z.im; u.im= -z.re; + return u; +} +struct complex cacos(Cpx z) +{ struct complex u; + u.re=1.; u.im=0.; + u=csqrt(csub(u,cmul(z,z))); + z.re-=u.im; z.im+=u.re; z=clog(z); + u.re=z.im; u.im= -z.re; + return u; +} +struct complex catan(Cpx z) +{ struct complex u; +/* + int kf; + if(z.re==0. && z.im<0.) kf=1; else kf=0; +*/ + u.re= -z.im; u.im=z.re; z.re=1.; z.im=0.; + u=cdiv(cadd(z,u),csub(z,u)); + u=cimu(-.5,clog(u)); +/* + if(kf) u.re= -u.re; +*/ + return u; +} diff --git a/complex/complex.h b/complex/complex.h new file mode 100644 index 0000000..d364755 --- /dev/null +++ b/complex/complex.h @@ -0,0 +1,23 @@ +/* complex.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef CPX +struct complex {double re,im;}; +typedef struct complex Cpx; +#define CPX 1 +#endif +#include +struct complex cadd(Cpx a,Cpx b),csub(Cpx a,Cpx b); +struct complex cmul(Cpx a,Cpx b),cdiv(Cpx a,Cpx b); +struct complex crmu(double x,Cpx a),cimu(double y,Cpx a); +struct complex ccng(Cpx c),cdef(double r,double i); +double cabs(Cpx a),cnrm(Cpx a); +struct complex csqrt(Cpx a),cexp(Cpx a),clog(Cpx a); +struct complex csin(Cpx a),ccos(Cpx a),ctan(Cpx a); +struct complex casin(Cpx f),cacos(Cpx f),catan(Cpx f); +struct complex csinh(Cpx h),ccosh(Cpx h),ctanh(Cpx h); +struct complex casinh(Cpx g),cacosh(Cpx g),catanh(Cpx g); diff --git a/complex/csqrt.c b/complex/csqrt.c new file mode 100644 index 0000000..c61daaf --- /dev/null +++ b/complex/csqrt.c @@ -0,0 +1,21 @@ +/* csqrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +struct complex csqrt(Cpx z) +{ double r; + r=sqrt(z.re*z.re+z.im*z.im); + r=sqrt(ldexp(r+fabs(z.re),-1)); + if(r==0.) z.re=z.im=0.; + else{ + if(z.re>=0.){ z.re=r; z.im=ldexp(z.im/r,-1);} + else{ z.re=ldexp(fabs(z.im)/r,-1); + if(z.im>=0.) z.im=r; else z.im= -r; + } + } + return z; +} diff --git a/complex/ctrig.c b/complex/ctrig.c new file mode 100644 index 0000000..a6b2755 --- /dev/null +++ b/complex/ctrig.c @@ -0,0 +1,35 @@ +/* ctrig.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +struct complex csin(Cpx z) +{ double c,s,u,v; +/* s=sincos(z.re,&c); */ + s=sin(z.re); c=cos(z.re); + u=exp(z.im); v=1./u; + u=ldexp(u+v,-1); v=u-v; + z.re=u*s; z.im=c*v; + return z; +} +struct complex ccos(Cpx z) +{ double c,s,u,v; +/* s=sincos(z.re,&c); */ + s=sin(z.re); c=cos(z.re); + u=exp(z.im); v=1./u; + u=ldexp(u+v,-1); v=u-v; + z.re=c*u; z.im= -s*v; + return z; +} +struct complex ctan(Cpx z) +{ double c,s,u,v,d; +/* s=sincos(z.re,&c); */ + s=sin(z.re); c=cos(z.re); + u=exp(z.im); v=1./u; + u=ldexp(u+v,-1); v=u-v; + d=c*c+v*v; z.re=s*c/d; z.im=u*v/d; + return z; +} diff --git a/complex/test/README b/complex/test/README new file mode 100644 index 0000000..fe53af5 --- /dev/null +++ b/complex/test/README @@ -0,0 +1,14 @@ + This directory contains test code for the functions of the 'complex' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. Input data files, if any + are named in the test code header, are in the 'data' sub-directory. + + The correspondence between test programs and data input files + is indicated below. + + tcarith data/carith.dat + tcarop2 data/caop2.dat + tchypb data/chypb.dat + tclog data/clog.dat + tcsqrt data/csqrt.dat + tctrig data/ctrg.dat diff --git a/complex/test/data/caop2.dat b/complex/test/data/caop2.dat new file mode 100644 index 0000000..f17780d --- /dev/null +++ b/complex/test/data/caop2.dat @@ -0,0 +1,4 @@ +2. 3. +1.5 -4.3 +-1.2 5.3 +-2.1 -1. diff --git a/complex/test/data/carith.dat b/complex/test/data/carith.dat new file mode 100644 index 0000000..53aa2d1 --- /dev/null +++ b/complex/test/data/carith.dat @@ -0,0 +1,3 @@ +1. 1. 2. -.5 +1. 3. -3. -1.6 +.2 -1. -.7 4. diff --git a/complex/test/data/chypb.dat b/complex/test/data/chypb.dat new file mode 100644 index 0000000..20c6425 --- /dev/null +++ b/complex/test/data/chypb.dat @@ -0,0 +1,4 @@ +1. 1. +-.8 .75 +-.3 -1.2 +1.5 -.6 diff --git a/complex/test/data/clog.dat b/complex/test/data/clog.dat new file mode 100644 index 0000000..c6f24db --- /dev/null +++ b/complex/test/data/clog.dat @@ -0,0 +1,4 @@ +1. 2. +1. -.5 +.5 4. +-1.2 3. diff --git a/complex/test/data/csqrt.dat b/complex/test/data/csqrt.dat new file mode 100644 index 0000000..c1ed52a --- /dev/null +++ b/complex/test/data/csqrt.dat @@ -0,0 +1,4 @@ +1. 1. +-1. .5 +-1. -.5 +2. -1. diff --git a/complex/test/data/ctrg.dat b/complex/test/data/ctrg.dat new file mode 100644 index 0000000..5bc5759 --- /dev/null +++ b/complex/test/data/ctrg.dat @@ -0,0 +1,4 @@ +1. 1. +-1. 2. +-2. 3. +-.8 -1.2 diff --git a/complex/test/tcacos.c b/complex/test/tcacos.c new file mode 100644 index 0000000..7b0dac8 --- /dev/null +++ b/complex/test/tcacos.c @@ -0,0 +1,21 @@ +/* tcacos.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: cacos ccos +*/ +#include "ccmath.h" +void main(void) +{ Cpx z,f; + while(1){ + printf("z ? "); +/* enter Ctrl-Z to terminate */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + f=cacos(z); z=ccos(f); + printf("acos(z)=(%e, %e) cos(z)=(%e, %e)\n",f.re,f.im,z.re,z.im); + } +} diff --git a/complex/test/tcacosh.c b/complex/test/tcacosh.c new file mode 100644 index 0000000..7354cf6 --- /dev/null +++ b/complex/test/tcacosh.c @@ -0,0 +1,21 @@ +/* tcacosh.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: cacosh ccosh +*/ +#include "ccmath.h" +void main(void) +{ Cpx z,f; + while(1){ + printf("z ? "); +/* enter Ctrl-Z to terminate */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + f=cacosh(z); z=ccosh(f); + printf("acosh(z)=(%e,%e) cosh(f)=(%e,%e)\n",f.re,f.im,z.re,z.im); + } +} diff --git a/complex/test/tcarith.c b/complex/test/tcarith.c new file mode 100644 index 0000000..7c44a0a --- /dev/null +++ b/complex/test/tcarith.c @@ -0,0 +1,47 @@ +/* tcarith.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: cadd csub cmul cdiv + + interactive input with 'tcarith' + input from file with 'tcarith data/carith.dat' +*/ +#include "ccmath.h" +void main(int na,char **av) +{ Cpx a,b,f; FILE *fp; + if(na>1) fp=fopen(*++av,"r"); + while(1){ + if(na==1){ printf(" a? b?\n"); + if(scanf("%lf %lf %lf %lf",&a.re,&a.im,&b.re,&b.im)==EOF) break; + } + else if(fscanf(fp,"%lf %lf %lf %lf",&a.re,&a.im,&b.re,&b.im) ==EOF) break; + printf(" a=(%f, %f) b=(%f, %f)\n",a.re,a.im,b.re,b.im); + f=cadd(a,b); printf(" a+b=(%f, %f)\n",f.re,f.im); + f=csub(a,b); printf(" a-b=(%f, %f)\n",f.re,f.im); + f=cmul(a,b); printf(" a*b=(%f, %f)\n",f.re,f.im); + f=cdiv(a,b); printf(" a/b=(%f, %f)\n",f.re,f.im); + } +} +/* Test output + + a=(1.000000, 1.000000) b=(2.000000, -0.500000) + a+b=(3.000000, 0.500000) + a-b=(-1.000000, 1.500000) + a*b=(2.500000, 1.500000) + a/b=(0.352941, 0.588235) + a=(1.000000, 3.000000) b=(-3.000000, -1.600000) + a+b=(-2.000000, 1.400000) + a-b=(4.000000, 4.600000) + a*b=(1.800000, -10.600000) + a/b=(-0.674740, -0.640138) + a=(0.200000, -1.000000) b=(-0.700000, 4.000000) + a+b=(-0.500000, 3.000000) + a-b=(0.900000, -5.000000) + a*b=(3.860000, 1.500000) + a/b=(-0.251061, -0.006064) +*/ diff --git a/complex/test/tcarop2.c b/complex/test/tcarop2.c new file mode 100644 index 0000000..2eb05b0 --- /dev/null +++ b/complex/test/tcarop2.c @@ -0,0 +1,67 @@ +/* tcarop2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: cdef crmu cimu ccng cnrm cabs + + Input file: caop2.dat +*/ +#include "ccmath.h" +char cfmt[]="(%10.6f,%10.6f)\n"; +void main(int na,char **av) +{ Cpx z; double x,y,ar,ai; + FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Operations on Complex Numbers\n"); + while(fscanf(fp,"%lf %lf",&ar,&ai)!=EOF){ + x=.5; y=2.; + +/* define complex number */ + z=cdef(ar,ai); + printf("def: z= "); printf(cfmt,z.re,z.im); +/* multiply by a real nmmber */ + z=crmu(x,z); + printf("real * "); printf(cfmt,z.re,z.im); +/* multiply by an integer */ + z=cimu(y,z); + printf("imag * "); printf(cfmt,z.re,z.im); +/* complex conjugate */ + z=ccng(z); + printf("ccng(z) "); printf(cfmt,z.re,z.im); +/* norm |z|^2 */ + x=cnrm(z); + printf("norm(z)= %f ",x); +/* absolute value |z| */ + x=cabs(z); + printf("abs(z)= %f\n",x); + } +} +/* Test output + + Test of Operations on Complex Numbers +def: z= ( 2.000000, 3.000000) +real * ( 1.000000, 1.500000) +imag * ( -3.000000, 2.000000) +ccng(z) ( -3.000000, -2.000000) +norm(z)= 13.000000 abs(z)= 3.605551 +def: z= ( 1.500000, -4.300000) +real * ( 0.750000, -2.150000) +imag * ( 4.300000, 1.500000) +ccng(z) ( 4.300000, -1.500000) +norm(z)= 20.740000 abs(z)= 4.554119 +def: z= ( -1.200000, 5.300000) +real * ( -0.600000, 2.650000) +imag * ( -5.300000, -1.200000) +ccng(z) ( -5.300000, 1.200000) +norm(z)= 29.530000 abs(z)= 5.434151 +def: z= ( -2.100000, -1.000000) +real * ( -1.050000, -0.500000) +imag * ( 1.000000, -2.100000) +ccng(z) ( 1.000000, 2.100000) +norm(z)= 5.410000 abs(z)= 2.325941 +*/ diff --git a/complex/test/tcasin.c b/complex/test/tcasin.c new file mode 100644 index 0000000..691e3b0 --- /dev/null +++ b/complex/test/tcasin.c @@ -0,0 +1,21 @@ +/* tcasin.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: casin csin +*/ +#include "ccmath.h" +void main(void) +{ Cpx z,f; + while(1){ + printf("z ? "); +/* enter Ctrl-Z to terminate */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + f=casin(z); z=csin(f); + printf("asin(z)=(%e, %e) sin(f)=(%e, %e)\n",f.re,f.im,z.re,z.im); + } +} diff --git a/complex/test/tcasinh.c b/complex/test/tcasinh.c new file mode 100644 index 0000000..bf1c09d --- /dev/null +++ b/complex/test/tcasinh.c @@ -0,0 +1,21 @@ +/* tcasinh.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: casinh csinh +*/ +#include "ccmath.h" +void main(void) +{ Cpx z,f; + while(1){ + printf("z ? "); +/* enter Ctrl-Z to terminate */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + f=casinh(z); z=csinh(f); + printf("asinh(z)=(%e,%e) sinh(f)=(%e,%e)\n",f.re,f.im,z.re,z.im); + } +} diff --git a/complex/test/tcatan.c b/complex/test/tcatan.c new file mode 100644 index 0000000..c887f9b --- /dev/null +++ b/complex/test/tcatan.c @@ -0,0 +1,21 @@ +/* tcatan.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: catan ctan +*/ +#include "ccmath.h" +void main(void) +{ Cpx z,f; + while(1){ + printf("z ? "); +/* enter Ctrl-Z to terminate */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + f=catan(z); z=ctan(f); + printf("atan(z)=(%e, %e) tan(f)=(%e, %e)\n",f.re,f.im,z.re,z.im); + } +} diff --git a/complex/test/tcatanh.c b/complex/test/tcatanh.c new file mode 100644 index 0000000..5e659fe --- /dev/null +++ b/complex/test/tcatanh.c @@ -0,0 +1,21 @@ +/* tcatanh.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: catanh ctanh +*/ +#include "ccmath.h" +void main(void) +{ Cpx z,f; + while(1){ + printf("z ? "); +/* enter Ctrl-Z to terminate */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + f=catanh(z); z=ctanh(f); + printf("atanh(z)=(%e,%e) tanh(f)=(%e,%e)\n",f.re,f.im,z.re,z.im); + } +} diff --git a/complex/test/tchypb.c b/complex/test/tchypb.c new file mode 100644 index 0000000..c4c2c04 --- /dev/null +++ b/complex/test/tchypb.c @@ -0,0 +1,69 @@ +/* tchypb.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: csinh casinh + ccosh cacosh + ctanh catanh + + interactive input with 'tchypb' + input from file with 'tchypb data/chypb.dat' +*/ +#include "ccmath.h" +void main(int na,char **av) +{ Cpx z,f,u; FILE *fp; + if(na>1) fp=fopen(*++av,"r"); + while(1){ + if(na==1){ printf("z ? "); /* enter Ctrl-Z to terminate */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + } + else{ + if(fscanf(fp,"%lf %lf",&z.re,&z.im)==EOF) break; + printf(" z=(%f, %f)\n",z.re,z.im); + } + f=csinh(z); u=casinh(f); + printf(" sinh = (%f, %f)\n",f.re,f.im); + printf(" asinh= (%f, %f)\n",u.re,u.im); + f=ccosh(z); u=cacosh(f); + printf(" cosh = (%f, %f)\n",f.re,f.im); + printf(" acosh= (%f, %f)\n",u.re,u.im); + f=ctanh(z); u=catanh(f); + printf(" tanh = (%f, %f)\n",f.re,f.im); + printf(" atanh= (%f, %f)\n",u.re,u.im); + } +} +/* Test output + + z=(1.000000, 1.000000) + sinh = (0.634964, 1.298458) + asinh= (1.000000, 1.000000) + cosh = (0.833730, 0.988898) + acosh= (1.000000, 1.000000) + tanh = (1.083923, 0.271753) + atanh= (1.000000, 1.000000) + z=(-0.800000, 0.750000) + sinh = (-0.649817, 0.911647) + asinh= (-0.800000, 0.750000) + cosh = (0.978586, -0.605367) + acosh= (0.800000, -0.750000) + tanh = (-0.897049, 0.376669) + atanh= (-0.800000, 0.750000) + z=(-0.300000, -1.200000) + sinh = (-0.110345, -0.974296) + asinh= (-0.300000, -1.200000) + cosh = (0.378787, 0.283825) + acosh= (0.300000, 1.200000) + tanh = (-1.420875, -1.507490) + atanh= (-0.300000, -1.200000) + z=(1.500000, -0.600000) + sinh = (1.757370, -1.328270) + asinh= (1.500000, -0.600000) + cosh = (1.941527, -1.202282) + acosh= (1.500000, -0.600000) + tanh = (0.960485, -0.089361) + atanh= (1.500000, -0.600000) +*/ diff --git a/complex/test/tclog.c b/complex/test/tclog.c new file mode 100644 index 0000000..536c226 --- /dev/null +++ b/complex/test/tclog.c @@ -0,0 +1,49 @@ +/* tclog.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: clog cexp + + input from file with 'tclog data/clog.dat' +*/ +#include "ccmath.h" +void main(int na,char **av) +{ Cpx z,f; FILE *fp; + if(na>1) fp=fopen(*++av,"r"); + while(1){ + if(na==1){ printf(" z? "); /* terminate input with Ctrl-Z */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + } + else{ if(fscanf(fp,"%lf %lf",&z.re,&z.im)==EOF) break; + printf(" z= (%f, %f)\n",z.re,z.im); + } + f=cexp(z); z=clog(f); + printf(" exp= (%f, %f)\n",f.re,f.im); + printf(" log= (%f, %f)\n",z.re,z.im); + f=cexp(z); + printf(" exp(log)= (%f, %f)\n",f.re,f.im); + } +} +/* Test output + + z= (1.000000, 2.000000) + exp= (-1.131204, 2.471727) + log= (1.000000, 2.000000) + exp(log)= (-1.131204, 2.471727) + z= (1.000000, -0.500000) + exp= (2.385517, -1.303214) + log= (1.000000, -0.500000) + exp(log)= (2.385517, -1.303214) + z= (0.500000, 4.000000) + exp= (-1.077676, -1.247756) + log= (0.500000, -2.283185) + exp(log)= (-1.077676, -1.247756) + z= (-1.200000, 3.000000) + exp= (-0.298180, 0.042505) + log= (-1.200000, 3.000000) + exp(log)= (-0.298180, 0.042505) +*/ diff --git a/complex/test/tcsqrt.c b/complex/test/tcsqrt.c new file mode 100644 index 0000000..3811a92 --- /dev/null +++ b/complex/test/tcsqrt.c @@ -0,0 +1,47 @@ +/* tcsqrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: csqrt + Uses: cmul + + interactive input with 'tcsqrt' + input from file with 'tcsqrt data/csqrt.dat' +*/ +#include "ccmath.h" +void main(int na,char **av) +{ Cpx z,f; FILE *fp; + if(na>1) fp=fopen(*++av,"r"); + while(1){ + if(na==1){ + printf(" z? "); /* enter Ctrl-Z to terminate input */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + } + else{ if(fscanf(fp,"%lf %lf",&z.re,&z.im)==EOF) break; + printf(" z=(%f, %f)\n",z.re,z.im); + } + f=csqrt(z); + printf(" sqrt=(%f, %f)\n",f.re,f.im); + f=cmul(f,f); + printf(" check=(%f, %f)\n",f.re,f.im); + } +} +/* Test output + + z=(1.000000, 1.000000) + sqrt=(1.098684, 0.455090) + check=(1.000000, 1.000000) + z=(-1.000000, 0.500000) + sqrt=(0.242934, 1.029086) + check=(-1.000000, 0.500000) + z=(-1.000000, -0.500000) + sqrt=(0.242934, -1.029086) + check=(-1.000000, -0.500000) + z=(2.000000, -1.000000) + sqrt=(1.455347, -0.343561) + check=(2.000000, -1.000000) +*/ diff --git a/complex/test/tctrig.c b/complex/test/tctrig.c new file mode 100644 index 0000000..239b2a4 --- /dev/null +++ b/complex/test/tctrig.c @@ -0,0 +1,67 @@ +/* tctrig.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: csin casin + ccos cacos + ctan catan + + interactive input with 'tctrig' + input from file with 'tctrig data/ctrg.dat' +*/ +#include "ccmath.h" +void main(int na,char **av) +{ Cpx z,s,c,t,u; FILE *fp; + if(na>1) fp=fopen(*++av,"r"); + while(1){ + if(na==1){ printf(" z? "); /* enter Ctrl-Z to terminate */ + if(scanf("%lf %lf",&z.re,&z.im)==EOF) break; + } + else{ + if(fscanf(fp,"%lf %lf",&z.re,&z.im)==EOF) break; + printf(" z= (%f, %f)\n",z.re,z.im); + } + s=csin(z); c=ccos(z); t=ctan(z); + printf(" sin= (%f, %f)\n",s.re,s.im); u=casin(s); + printf(" asin= (%f, %f)\n",u.re,u.im); + printf(" cos= (%f, %f)\n",c.re,c.im); u=cacos(c); + printf(" acos= (%f, %f)\n",u.re,u.im); + printf(" tan= (%f, %f)\n",t.re,t.im); u=catan(t); + printf(" atan= (%f, %f)\n",u.re,u.im); + } +} +/* Test output + + z= (1.000000, 1.000000) + sin= (1.298458, 0.634964) + asin= (1.000000, 1.000000) + cos= (0.833730, -0.988898) + acos= (1.000000, 1.000000) + tan= (0.271753, 1.083923) + atan= (1.000000, 1.000000) + z= (-1.000000, 2.000000) + sin= (-3.165779, 1.959601) + asin= (-1.000000, 2.000000) + cos= (2.032723, 3.051898) + acos= (1.000000, -2.000000) + tan= (-0.033813, 1.014794) + atan= (-1.000000, 2.000000) + z= (-2.000000, 3.000000) + sin= (-9.154499, -4.168907) + asin= (-1.141593, -3.000000) + cos= (-4.189626, 9.109228) + acos= (2.000000, -3.000000) + tan= (0.003764, 1.003239) + atan= (1.141593, 3.000000) + z= (-0.800000, -1.200000) + sin= (-1.298885, -1.051652) + asin= (-0.800000, -1.200000) + cos= (1.261496, -1.082821) + acos= (0.800000, 1.200000) + tan= (-0.180828, -0.988871) + atan= (-0.800000, -1.200000) +*/ diff --git a/fft/complex.h b/fft/complex.h new file mode 100644 index 0000000..d364755 --- /dev/null +++ b/fft/complex.h @@ -0,0 +1,23 @@ +/* complex.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef CPX +struct complex {double re,im;}; +typedef struct complex Cpx; +#define CPX 1 +#endif +#include +struct complex cadd(Cpx a,Cpx b),csub(Cpx a,Cpx b); +struct complex cmul(Cpx a,Cpx b),cdiv(Cpx a,Cpx b); +struct complex crmu(double x,Cpx a),cimu(double y,Cpx a); +struct complex ccng(Cpx c),cdef(double r,double i); +double cabs(Cpx a),cnrm(Cpx a); +struct complex csqrt(Cpx a),cexp(Cpx a),clog(Cpx a); +struct complex csin(Cpx a),ccos(Cpx a),ctan(Cpx a); +struct complex casin(Cpx f),cacos(Cpx f),catan(Cpx f); +struct complex csinh(Cpx h),ccosh(Cpx h),ctanh(Cpx h); +struct complex casinh(Cpx g),cacosh(Cpx g),catanh(Cpx g); diff --git a/fft/fft2.c b/fft/fft2.c new file mode 100644 index 0000000..d406471 --- /dev/null +++ b/fft/fft2.c @@ -0,0 +1,36 @@ +/* fft2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +void fft2(struct complex *ft,int m,int inv) +{ int n,i,j,k,mm,mp; + double s,t,ang,tpi=6.283185307179586; + struct complex u,w,*p,*q,*pf; + n=1; n<<=m; pf=ft+n-1; + for(j=0,p=ft; pre; p->re=q->re; q->re=t; + t=p->im; p->im=q->im; q->im=t; } + for(mm=n/2; mm<=j ;mm/=2) j-=mm; j+=mm; + } + if(inv=='d') for(p=ft,s=1./n; p<=pf ;){ + p->re*=s; (p++)->im*=s; } + for(i=mp=1; i<=m ;++i){ + mm=mp; mp*=2; ang=tpi/mp; if(inv=='d') ang= -ang; + w.re=cos(ang); w.im=sin(ang); + for(j=0; jre*u.re-q->im*u.im; + s=q->im*u.re+q->re*u.im; + q->re=p->re-t; q->im=p->im-s; + p->re+=t; p->im+=s; + t=u.re*w.re-u.im*w.im; + u.im=u.im*w.re+u.re*w.im; u.re=t; + } + } + } +} diff --git a/fft/fft2_d.c b/fft/fft2_d.c new file mode 100644 index 0000000..5f4c3fa --- /dev/null +++ b/fft/fft2_d.c @@ -0,0 +1,25 @@ +/* fft2_d.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +void fft2(struct complex *ff,int k,int j); +fft2_d(struct complex *a,int m,int n,int f) +{ register int md,nd,i,j; struct complex *p,*q; + register struct complex *r,*s; + md=1< +void pshuf(Cpx **pa,Cpx **pb,int *kk,int n); +void fftgc(Cpx **pc,struct complex *ft,int n,int *kk,int inv) +{ Cpx a,b,z,w,*d,*p,**f,**fb; + double tpi=6.283185307179586,sc,q; + int *mm,*m,kp,i,j,k,jk,jl,ms,mp; + mm=(int *)malloc((kk[0]+1)*sizeof(int)); + d=(Cpx *)malloc(kk[*kk]*sizeof(*d)); + for(i=1,*mm=1,m=mm; i<=kk[0] ;++i,++m) *(m+1)= *m*kk[i]; + if(inv=='d'){ + for(j=0,p=ft; jre*=sc; (p++)->im*=sc;} } + else{ f=(Cpx **)malloc(n*sizeof(pc[0])); + for(j=0; jfb){ f-=ms; + sc=(*f)->re+p->re*w.re-p->im*w.im; + p->im=(*f)->im+p->im*w.re+p->re*w.im; p->re=sc; } + sc=w.re*b.re-w.im*b.im; + w.im=w.im*b.re+w.re*b.im; w.re=sc; + } + for(k=0,f=fb,p=d; k +void fftgr(double *x,struct complex *ft,int n,int *kk,int inv) +{ struct complex a,b,z,w,*d,*p,*f,*fb; + double tpi=6.283185307179586,sc,q,*t; + int *mm,*m,kp,i,j,k,jk,jl,ms,mp; + mm=(int *)malloc((kk[0]+1)*sizeof(int)); + d=(struct complex *)malloc(kk[*kk]*sizeof(w)); + for(i=1,*mm=1,m=mm; i<=kk[0] ;++i,++m) *(m+1)= *m*kk[i]; + for(j=0,t=x; jre= *t++; f->im=0.; + } + if(inv=='d'){ for(i=0,sc=1./n,f=ft; ire*=sc;} + for(i=1,m=mm; i<=kk[0] ;++i){ + ms= *m++; mp= *m; kp=kk[i]; q=tpi/mp; if(inv=='d') q= -q; + a.re=cos(q); a.im=sin(q); b.re=cos(q*=ms); b.im=sin(q); + for(j=0; jfb){ f-=ms; + sc=f->re+p->re*w.re-p->im*w.im; + p->im=f->im+p->im*w.re+p->re*w.im; p->re=sc; } + sc=w.re*b.re-w.im*b.im; + w.im=w.im*b.re+w.re*b.im; w.re=sc; + } + for(k=0,f=fb,p=d; kre+(*q)->re)/h; y=((*p)->im-(*q)->im)/h; + u=((*p)->im+(*q)->im)/h; v=((*p)->re-(*q)->re)/h; + (*p)->re=x; (*p++)->im=y; + (*q)->re=u; (*q--)->im=v; + } +} diff --git a/fft/pfac.c b/fft/pfac.c new file mode 100644 index 0000000..1290b95 --- /dev/null +++ b/fft/pfac.c @@ -0,0 +1,20 @@ +/* pfac.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +static int kpf[26]={2,3,5,7,11,13,17,19,23,29,31,37, + 41,43,47,53,59,61,67,71,73,79,83,89,97,101}; +int pfac(int n,int *kk,int fe) +{ int num,j,k,dc=1; + if(fe=='e'){ n-=(n%2); dc=2;} + for(;;n-=dc){ num=n; j=k=0; + while(j<31){ + if(num%kpf[k]!=0){ if(k==25) break; ++k;} + else{ kk[++j]=kpf[k]; num=num/kpf[k]; + if(num==1){ kk[0]=j; return n; } } + } + } +} diff --git a/fft/pshuf.c b/fft/pshuf.c new file mode 100644 index 0000000..69fa4e8 --- /dev/null +++ b/fft/pshuf.c @@ -0,0 +1,20 @@ +/* pshuf.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +pshuf(Cpx **pa,Cpx **pb,int *kk,int n) +{ int *mm,*m,i,j,k,jk; struct complex **p,**q; + mm=(int *)malloc((kk[0]+1)*sizeof(int)); + for(i=1,*mm=1,m=mm; i<=kk[0] ;++i,++m) *(m+1)= *m*kk[i]; + for(j=0,p=pb; j +int pwspec(double *x,int n,int m) +{ int j,kk[32]; double s; + struct complex {double re,im;} *p,*q; + n=pfac(n,kk,'e'); + p=(struct complex *)malloc(n*sizeof(*p)); + fftgr(x,p,n,kk,'d'); + for(s=0.,j=0; jre*q->re+q->im*q->im)/s; + if(m) smoo(x,n,m); + free(p); return n; +} diff --git a/fft/smoo.c b/fft/smoo.c new file mode 100644 index 0000000..b7fdb27 --- /dev/null +++ b/fft/smoo.c @@ -0,0 +1,25 @@ +/* smoo.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +smoo(double *x,int n,int m) +{ double *p,*q,*pmax,*pmin,*pa,*pb,*ph; + int ms; double s,t; + ms=2*m+1; ph=x+n/2; + p=pmin=(double *)calloc(ms,sizeof(*pmin)); + q=pmax=pmin+ms-1; s=t=0.; + for(pa=x+m,pb=ph-m; pa>x ;){ + t+=(*p++ = *q-- = *pa--); s+= *pb++;} + *ph=s/m; t=ms*(*pa++ = *q=t/m); s=1./ms; + for(p=pmax,q=pmin,pb=pa+m; papmax) q=pmin; + if((++p)>pmax) p=pmin; + t+=(*p= *pb++); *pa++ =s*t; + } + for(pa=ph-1,pb=ph+1; pa>x ;) *pb++ = *pa--; + free(pmin); +} diff --git a/fft/test/README b/fft/test/README new file mode 100644 index 0000000..158c868 --- /dev/null +++ b/fft/test/README @@ -0,0 +1,10 @@ + This directory contains test code for the functions of the 'fft' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. Input data files, if any + are named in the test code header, are in the 'data' sub-directory. + + Only the following three tests require command line inputs: + + t2dfft 3 0 + tpfac 63 120 175 + tsmoo 2 data/smoo.dat diff --git a/fft/test/data/smoo.dat b/fft/test/data/smoo.dat new file mode 100644 index 0000000..f02ee14 --- /dev/null +++ b/fft/test/data/smoo.dat @@ -0,0 +1 @@ +8. 3. 5. 2. 1. 4. 3. 4. 1. 2. 5. 3. diff --git a/fft/test/t2dfft.c b/fft/test/t2dfft.c new file mode 100644 index 0000000..a048ed1 --- /dev/null +++ b/fft/test/t2dfft.c @@ -0,0 +1,104 @@ +/* t2dfft.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: fft2_d +*/ +#include "ccmath.h" +#include +struct complex *pa; +void main(int na,char **av) +{ int n,nd,f; + struct complex *p; int i,j; + double tp=6.28318530717958648; + if(na!=3){ printf("para: log2(n) cd(0/1)\n"); exit(1);} + printf(" Test of 2D FFT\n"); + n=atoi(*++av); nd=1<re=sin(i*tp)*sin(j*tp); + (p++)->im=0.; + } + } + fft2_d(pa,n,n,f); + printf(" %d complex values in output\n",nd*nd); + for(i=0,p=pa; ire,p->im); + } +} +/* Test output + + Test of 2D FFT + 64 complex values in output + 0 0 0.000000 0.000000 + 0 1 0.000000 -0.000000 + 0 2 0.000000 0.000000 + 0 3 -0.000000 -0.000000 + 0 4 0.000000 0.000000 + 0 5 -0.000000 0.000000 + 0 6 0.000000 -0.000000 + 0 7 0.000000 0.000000 + 1 0 -0.000000 -0.000000 + 1 1 -0.250000 0.000000 + 1 2 -0.000000 -0.000000 + 1 3 -0.000000 -0.000000 + 1 4 0.000000 -0.000000 + 1 5 0.000000 -0.000000 + 1 6 0.000000 -0.000000 + 1 7 0.250000 0.000000 + 2 0 -0.000000 0.000000 + 2 1 -0.000000 -0.000000 + 2 2 -0.000000 -0.000000 + 2 3 0.000000 -0.000000 + 2 4 0.000000 -0.000000 + 2 5 -0.000000 -0.000000 + 2 6 0.000000 0.000000 + 2 7 0.000000 0.000000 + 3 0 0.000000 -0.000000 + 3 1 -0.000000 -0.000000 + 3 2 -0.000000 -0.000000 + 3 3 0.000000 -0.000000 + 3 4 -0.000000 0.000000 + 3 5 0.000000 0.000000 + 3 6 0.000000 0.000000 + 3 7 0.000000 0.000000 + 4 0 0.000000 0.000000 + 4 1 -0.000000 -0.000000 + 4 2 0.000000 -0.000000 + 4 3 0.000000 0.000000 + 4 4 0.000000 0.000000 + 4 5 0.000000 -0.000000 + 4 6 0.000000 0.000000 + 4 7 -0.000000 0.000000 + 5 0 0.000000 0.000000 + 5 1 0.000000 -0.000000 + 5 2 0.000000 0.000000 + 5 3 -0.000000 0.000000 + 5 4 -0.000000 -0.000000 + 5 5 0.000000 -0.000000 + 5 6 -0.000000 -0.000000 + 5 7 -0.000000 0.000000 + 6 0 0.000000 -0.000000 + 6 1 0.000000 -0.000000 + 6 2 0.000000 0.000000 + 6 3 -0.000000 0.000000 + 6 4 -0.000000 0.000000 + 6 5 0.000000 0.000000 + 6 6 -0.000000 -0.000000 + 6 7 -0.000000 0.000000 + 7 0 -0.000000 0.000000 + 7 1 0.250000 0.000000 + 7 2 0.000000 0.000000 + 7 3 -0.000000 0.000000 + 7 4 0.000000 0.000000 + 7 5 -0.000000 0.000000 + 7 6 -0.000000 0.000000 + 7 7 -0.250000 -0.000000 +*/ diff --git a/fft/test/tfft2.c b/fft/test/tfft2.c new file mode 100644 index 0000000..fd877fd --- /dev/null +++ b/fft/test/tfft2.c @@ -0,0 +1,66 @@ +/* tfft2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: fft2 +*/ +#include "ccmath.h" +#include +#define MPT 64 +void main(void) +{ Cpx *f,*p,ft[MPT]; + double tpi=6.283185307179586,ang,ann; + int n=MPT,i,j,m=6; + printf(" Test of Radix 2 Complex FFT\n"); + printf(" F(k)=cos(2pi*5*k/n),cos(2pi*3*k/n)\n"); + ang=5.*tpi/n; ann=3.*tpi/n; + for(i=0,f=ft; ire=cos(ang*i); (f++)->im=cos(ann*i);} + printf(" m= %d\n",n); + fft2(ft,m,'d'); + for(f=ft,p=ft+n/2,i=0,j=n/2; ire,f->im); + printf(" %3d %9.6f %9.6f\n",j++,p->re,p->im); + } +} +/* Test output + + Test of Radix 2 Complex FFT + F(k)=cos(2pi*5*k/n),cos(2pi*3*k/n) + m= 64 + 0 -0.000000 -0.000000 32 -0.000000 -0.000000 + 1 0.000000 -0.000000 33 -0.000000 0.000000 + 2 -0.000000 0.000000 34 0.000000 -0.000000 + 3 0.000000 0.500000 35 -0.000000 -0.000000 + 4 -0.000000 0.000000 36 0.000000 -0.000000 + 5 0.500000 -0.000000 37 -0.000000 -0.000000 + 6 0.000000 0.000000 38 0.000000 -0.000000 + 7 0.000000 -0.000000 39 0.000000 0.000000 + 8 -0.000000 0.000000 40 -0.000000 0.000000 + 9 0.000000 -0.000000 41 -0.000000 -0.000000 + 10 0.000000 -0.000000 42 -0.000000 -0.000000 + 11 0.000000 0.000000 43 0.000000 -0.000000 + 12 -0.000000 0.000000 44 0.000000 -0.000000 + 13 0.000000 -0.000000 45 0.000000 0.000000 + 14 0.000000 0.000000 46 0.000000 0.000000 + 15 -0.000000 0.000000 47 0.000000 0.000000 + 16 -0.000000 0.000000 48 -0.000000 0.000000 + 17 -0.000000 0.000000 49 0.000000 0.000000 + 18 -0.000000 0.000000 50 0.000000 0.000000 + 19 -0.000000 -0.000000 51 -0.000000 0.000000 + 20 -0.000000 -0.000000 52 0.000000 0.000000 + 21 0.000000 -0.000000 53 0.000000 -0.000000 + 22 0.000000 0.000000 54 -0.000000 0.000000 + 23 0.000000 0.000000 55 0.000000 0.000000 + 24 -0.000000 -0.000000 56 -0.000000 -0.000000 + 25 0.000000 -0.000000 57 0.000000 0.000000 + 26 0.000000 0.000000 58 0.000000 -0.000000 + 27 -0.000000 0.000000 59 0.500000 0.000000 + 28 -0.000000 0.000000 60 -0.000000 0.000000 + 29 -0.000000 -0.000000 61 -0.000000 0.500000 + 30 0.000000 -0.000000 62 -0.000000 -0.000000 + 31 -0.000000 0.000000 63 -0.000000 0.000000 +*/ diff --git a/fft/test/tfftgc.c b/fft/test/tfftgc.c new file mode 100644 index 0000000..d078f51 --- /dev/null +++ b/fft/test/tfftgc.c @@ -0,0 +1,87 @@ +/* tfftgc.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: fftgc + Uses: pfac +*/ +#include "ccmath.h" +#include +#define MPT 100 +struct complex ft[MPT],*pc[MPT]; +void main(void) +{ struct complex *f,**p,**h; + double tpi=6.283185307179586,ang,ann; + int kk[32],n=MPT,i,j; + printf(" Test of General Radix Complex FFT\n"); + printf(" F(k)=cos(2pi*5*k/n),cos(2pi*3*k/n)\n"); + ang=5.*tpi/n; ann=3.*tpi/n; + for(i=0,f=ft; ire=cos(ang*i); (f++)->im=cos(ann*i);} + n=pfac(n,kk,'o'); + printf(" n= %d\n",n); + fftgc(pc,ft,n,kk,'d'); + for(p=pc,h=pc+n/2,i=0,j=n/2; ire,(*p)->im); + printf(" %3d %9.6f %9.6f\n",j++,(*h)->re,(*h)->im); + } +} +/* Test output + + Test of General Radix Complex FFT + F(k)=cos(2pi*5*k/n),cos(2pi*3*k/n) + n= 100 + 0 -0.000000 -0.000000 50 0.000000 0.000000 + 1 -0.000000 -0.000000 51 0.000000 -0.000000 + 2 -0.000000 -0.000000 52 -0.000000 -0.000000 + 3 0.000000 0.500000 53 0.000000 -0.000000 + 4 -0.000000 0.000000 54 0.000000 -0.000000 + 5 0.500000 -0.000000 55 0.000000 -0.000000 + 6 0.000000 0.000000 56 -0.000000 0.000000 + 7 0.000000 -0.000000 57 0.000000 0.000000 + 8 0.000000 0.000000 58 0.000000 0.000000 + 9 0.000000 -0.000000 59 -0.000000 0.000000 + 10 0.000000 0.000000 60 -0.000000 0.000000 + 11 0.000000 -0.000000 61 -0.000000 -0.000000 + 12 0.000000 0.000000 62 0.000000 -0.000000 + 13 0.000000 0.000000 63 -0.000000 0.000000 + 14 0.000000 0.000000 64 -0.000000 -0.000000 + 15 0.000000 0.000000 65 0.000000 -0.000000 + 16 -0.000000 0.000000 66 0.000000 -0.000000 + 17 0.000000 -0.000000 67 0.000000 0.000000 + 18 -0.000000 0.000000 68 0.000000 0.000000 + 19 0.000000 0.000000 69 -0.000000 -0.000000 + 20 -0.000000 0.000000 70 0.000000 0.000000 + 21 0.000000 -0.000000 71 -0.000000 0.000000 + 22 0.000000 0.000000 72 -0.000000 0.000000 + 23 -0.000000 -0.000000 73 -0.000000 0.000000 + 24 -0.000000 -0.000000 74 -0.000000 -0.000000 + 25 0.000000 -0.000000 75 0.000000 0.000000 + 26 0.000000 -0.000000 76 0.000000 -0.000000 + 27 0.000000 -0.000000 77 0.000000 0.000000 + 28 0.000000 0.000000 78 0.000000 0.000000 + 29 0.000000 -0.000000 79 0.000000 0.000000 + 30 0.000000 0.000000 80 -0.000000 0.000000 + 31 0.000000 0.000000 81 0.000000 -0.000000 + 32 -0.000000 0.000000 82 0.000000 0.000000 + 33 0.000000 0.000000 83 -0.000000 0.000000 + 34 -0.000000 0.000000 84 0.000000 0.000000 + 35 -0.000000 -0.000000 85 0.000000 0.000000 + 36 0.000000 -0.000000 86 0.000000 0.000000 + 37 0.000000 0.000000 87 -0.000000 0.000000 + 38 -0.000000 -0.000000 88 -0.000000 0.000000 + 39 0.000000 -0.000000 89 -0.000000 0.000000 + 40 0.000000 0.000000 90 0.000000 0.000000 + 41 0.000000 0.000000 91 0.000000 0.000000 + 42 -0.000000 0.000000 92 0.000000 0.000000 + 43 -0.000000 0.000000 93 0.000000 0.000000 + 44 0.000000 0.000000 94 0.000000 0.000000 + 45 -0.000000 -0.000000 95 0.500000 0.000000 + 46 -0.000000 -0.000000 96 -0.000000 0.000000 + 47 -0.000000 -0.000000 97 -0.000000 0.500000 + 48 0.000000 -0.000000 98 -0.000000 -0.000000 + 49 0.000000 -0.000000 99 -0.000000 -0.000000 +*/ diff --git a/fft/test/tfftgr.c b/fft/test/tfftgr.c new file mode 100644 index 0000000..5f3567e --- /dev/null +++ b/fft/test/tfftgr.c @@ -0,0 +1,87 @@ +/* tfftgr.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: fftgr + Uses: pfac +*/ +#include "ccmath.h" +#include +#define MPT 100 +void main(void) +{ struct complex *ft,*f,*p; + double *x,ang,tpi=6.283185307179586; + int kk[32],n=MPT,i,j; void *calloc(); + printf(" Test of General Radix FFT\n"); + printf(" F(k)=sin(2pi*5*k/n)\n"); + x=(double *)calloc(n,sizeof(*x)); + ft=(struct complex *)calloc(n,sizeof(*ft)); + for(ang=5.*tpi/n,i=0; ire,f->im); + printf(" %3d %9.6f %9.6f\n",j++,p->re,p->im); + } +} +/* Test output + + Test of General Radix FFT + F(k)=sin(2pi*5*k/n) + n= 100 + 0 -0.000000 0.000000 50 0.000000 0.000000 + 1 0.000000 -0.000000 51 0.000000 0.000000 + 2 0.000000 0.000000 52 0.000000 -0.000000 + 3 0.000000 0.000000 53 0.000000 -0.000000 + 4 0.000000 0.000000 54 0.000000 -0.000000 + 5 -0.000000 -0.500000 55 0.000000 0.000000 + 6 0.000000 -0.000000 56 0.000000 0.000000 + 7 0.000000 -0.000000 57 0.000000 -0.000000 + 8 0.000000 -0.000000 58 0.000000 0.000000 + 9 -0.000000 -0.000000 59 0.000000 0.000000 + 10 0.000000 -0.000000 60 0.000000 -0.000000 + 11 0.000000 -0.000000 61 0.000000 -0.000000 + 12 0.000000 -0.000000 62 0.000000 0.000000 + 13 -0.000000 0.000000 63 0.000000 0.000000 + 14 0.000000 -0.000000 64 0.000000 -0.000000 + 15 -0.000000 -0.000000 65 0.000000 -0.000000 + 16 0.000000 -0.000000 66 0.000000 -0.000000 + 17 -0.000000 -0.000000 67 0.000000 0.000000 + 18 0.000000 -0.000000 68 0.000000 -0.000000 + 19 -0.000000 0.000000 69 0.000000 0.000000 + 20 0.000000 -0.000000 70 0.000000 0.000000 + 21 0.000000 -0.000000 71 -0.000000 0.000000 + 22 0.000000 -0.000000 72 -0.000000 0.000000 + 23 0.000000 0.000000 73 -0.000000 -0.000000 + 24 0.000000 -0.000000 74 0.000000 0.000000 + 25 -0.000000 0.000000 75 -0.000000 0.000000 + 26 0.000000 -0.000000 76 0.000000 0.000000 + 27 -0.000000 0.000000 77 0.000000 -0.000000 + 28 -0.000000 -0.000000 78 0.000000 0.000000 + 29 -0.000000 -0.000000 79 0.000000 0.000000 + 30 0.000000 -0.000000 80 0.000000 0.000000 + 31 0.000000 0.000000 81 -0.000000 0.000000 + 32 0.000000 0.000000 82 0.000000 0.000000 + 33 0.000000 -0.000000 83 -0.000000 0.000000 + 34 0.000000 0.000000 84 0.000000 0.000000 + 35 0.000000 0.000000 85 -0.000000 -0.000000 + 36 0.000000 0.000000 86 0.000000 0.000000 + 37 0.000000 -0.000000 87 -0.000000 0.000000 + 38 0.000000 -0.000000 88 0.000000 0.000000 + 39 0.000000 0.000000 89 -0.000000 0.000000 + 40 0.000000 0.000000 90 0.000000 0.000000 + 41 0.000000 -0.000000 91 -0.000000 0.000000 + 42 0.000000 -0.000000 92 0.000000 0.000000 + 43 0.000000 0.000000 93 0.000000 0.000000 + 44 0.000000 -0.000000 94 0.000000 0.000000 + 45 0.000000 0.000000 95 -0.000000 0.500000 + 46 0.000000 0.000000 96 0.000000 -0.000000 + 47 0.000000 0.000000 97 0.000000 -0.000000 + 48 0.000000 0.000000 98 0.000000 -0.000000 + 49 0.000000 -0.000000 99 0.000000 -0.000000 +*/ diff --git a/fft/test/tfftiv.c b/fft/test/tfftiv.c new file mode 100644 index 0000000..802eb5d --- /dev/null +++ b/fft/test/tfftiv.c @@ -0,0 +1,89 @@ +/* tfftiv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: fftgc + Uses: pfac +*/ +#include +#include "ccmath.h" +#include +#define MPT 100 +struct complex ft[MPT],*pc[MPT]; +void main(void) +{ struct complex *f,**p,**h; + double tpi=6.283185307179586,ang,ann; + int kk[32],n=MPT,i,j; + printf(" Test of FFT Inverse\n"); + printf(" F(k)=cos(2pi*5*k/n),sin(2pi*4*k/n)\n"); + ang=5*tpi/n; ann=4*tpi/n; + for(i=0,f=ft; ire=cos(ang*i); (f++)->im=sin(ann*i);} + n=pfac(n,kk,'o'); + printf(" n= %d\n",n); + fftgc(pc,ft,n,kk,'d'); + fftgc(pc,ft,n,kk,'i'); + for(p=pc,h=pc+n/2,i=0,j=n/2; ire,(*p)->im); + printf(" %3d %9.6f %9.6f\n",j++,(*h)->re,(*h)->im); + } +} +/* Test output + + Test of FFT Inverse + F(k)=cos(2pi*5*k/n),sin(2pi*4*k/n) + n= 100 + 0 1.000000 -0.000000 50 -1.000000 0.000000 + 1 0.951057 0.248690 51 -0.951057 0.248690 + 2 0.809017 0.481754 52 -0.809017 0.481754 + 3 0.587785 0.684547 53 -0.587785 0.684547 + 4 0.309017 0.844328 54 -0.309017 0.844328 + 5 0.000000 0.951057 55 -0.000000 0.951057 + 6 -0.309017 0.998027 56 0.309017 0.998027 + 7 -0.587785 0.982287 57 0.587785 0.982287 + 8 -0.809017 0.904827 58 0.809017 0.904827 + 9 -0.951057 0.770513 59 0.951057 0.770513 + 10 -1.000000 0.587785 60 1.000000 0.587785 + 11 -0.951057 0.368125 61 0.951057 0.368125 + 12 -0.809017 0.125333 62 0.809017 0.125333 + 13 -0.587785 -0.125333 63 0.587785 -0.125333 + 14 -0.309017 -0.368125 64 0.309017 -0.368125 + 15 -0.000000 -0.587785 65 -0.000000 -0.587785 + 16 0.309017 -0.770513 66 -0.309017 -0.770513 + 17 0.587785 -0.904827 67 -0.587785 -0.904827 + 18 0.809017 -0.982287 68 -0.809017 -0.982287 + 19 0.951057 -0.998027 69 -0.951057 -0.998027 + 20 1.000000 -0.951057 70 -1.000000 -0.951057 + 21 0.951057 -0.844328 71 -0.951057 -0.844328 + 22 0.809017 -0.684547 72 -0.809017 -0.684547 + 23 0.587785 -0.481754 73 -0.587785 -0.481754 + 24 0.309017 -0.248690 74 -0.309017 -0.248690 + 25 0.000000 0.000000 75 -0.000000 -0.000000 + 26 -0.309017 0.248690 76 0.309017 0.248690 + 27 -0.587785 0.481754 77 0.587785 0.481754 + 28 -0.809017 0.684547 78 0.809017 0.684547 + 29 -0.951057 0.844328 79 0.951057 0.844328 + 30 -1.000000 0.951057 80 1.000000 0.951057 + 31 -0.951057 0.998027 81 0.951057 0.998027 + 32 -0.809017 0.982287 82 0.809017 0.982287 + 33 -0.587785 0.904827 83 0.587785 0.904827 + 34 -0.309017 0.770513 84 0.309017 0.770513 + 35 -0.000000 0.587785 85 -0.000000 0.587785 + 36 0.309017 0.368125 86 -0.309017 0.368125 + 37 0.587785 0.125333 87 -0.587785 0.125333 + 38 0.809017 -0.125333 88 -0.809017 -0.125333 + 39 0.951057 -0.368125 89 -0.951057 -0.368125 + 40 1.000000 -0.587785 90 -1.000000 -0.587785 + 41 0.951057 -0.770513 91 -0.951057 -0.770513 + 42 0.809017 -0.904827 92 -0.809017 -0.904827 + 43 0.587785 -0.982287 93 -0.587785 -0.982287 + 44 0.309017 -0.998027 94 -0.309017 -0.998027 + 45 0.000000 -0.951057 95 -0.000000 -0.951057 + 46 -0.309017 -0.844328 96 0.309017 -0.844328 + 47 -0.587785 -0.684547 97 0.587785 -0.684547 + 48 -0.809017 -0.481754 98 0.809017 -0.481754 + 49 -0.951057 -0.248690 99 0.951057 -0.248690 +*/ diff --git a/fft/test/tftuns.c b/fft/test/tftuns.c new file mode 100644 index 0000000..41c2181 --- /dev/null +++ b/fft/test/tftuns.c @@ -0,0 +1,93 @@ +/* tftuns.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: ftuns + Uses: fftgc pfac +*/ +#include "ccmath.h" +#include +#define MPT 100 +struct complex ft[MPT],*pc[MPT]; +void main(void) +{ struct complex *f,**p,**h; double y; + int kk[32],n=MPT,i; + printf(" Test of FT Unscrambling (2 real series)\n"); + printf(" F1=-1, F2=1-2k/n for kn/2\n"); + for(i=0,y=2./n,f=ft; ire= -1.; f->im=1.-i*y;} + else{ f->re=1.; f->im=y*i-1.;} + } + ft[0].re=ft[n/2].re=0.; + n=pfac(n,kk,'o'); + printf(" n= %d\n",n); + fftgc(pc,ft,n,kk,'d'); + ftuns(pc,n); + printf("%3d %10f %10f %10f %10f\n",0,(*pc)->re,0.,(*pc)->im,0.); + for(p=pc+1,h=pc+n-1,i=1; ire,(*p)->im); + printf(" %10f %10f\n",(*h)->re,(*h)->im); + } + printf("%3d %10f %10f %10f %10f\n",i,(*p)->re,0.,(*h)->im,0.); +} +/* Test output + + Test of FT Unscrambling (2 real series) + F1=-1, F2=1-2k/n for kn/2 + n= 100 + 0 0.000000 0.000000 0.500000 0.000000 + 1 0.000000 0.636410 0.202709 -0.000000 + 2 0.000000 -0.000000 0.000000 -0.000000 + 3 -0.000000 0.211578 0.022583 -0.000000 + 4 -0.000000 -0.000000 0.000000 0.000000 + 5 0.000000 0.126275 0.008173 -0.000000 + 6 0.000000 -0.000000 0.000000 -0.000000 + 7 -0.000000 0.089475 0.004203 -0.000000 + 8 0.000000 -0.000000 -0.000000 0.000000 + 9 0.000000 0.068840 0.002570 -0.000000 + 10 0.000000 -0.000000 0.000000 -0.000000 + 11 -0.000000 0.055552 0.001743 -0.000000 + 12 0.000000 -0.000000 0.000000 0.000000 + 13 0.000000 0.046217 0.001268 -0.000000 + 14 0.000000 -0.000000 0.000000 -0.000000 + 15 0.000000 0.039252 0.000970 -0.000000 + 16 0.000000 -0.000000 0.000000 -0.000000 + 17 0.000000 0.033818 0.000772 -0.000000 + 18 0.000000 -0.000000 0.000000 0.000000 + 19 0.000000 0.029429 0.000633 0.000000 + 20 0.000000 -0.000000 0.000000 -0.000000 + 21 0.000000 0.025784 0.000532 0.000000 + 22 0.000000 -0.000000 -0.000000 0.000000 + 23 -0.000000 0.022686 0.000457 -0.000000 + 24 0.000000 -0.000000 0.000000 -0.000000 + 25 0.000000 0.020000 0.000400 -0.000000 + 26 0.000000 -0.000000 0.000000 0.000000 + 27 -0.000000 0.017632 0.000355 -0.000000 + 28 0.000000 -0.000000 0.000000 -0.000000 + 29 0.000000 0.015514 0.000320 -0.000000 + 30 0.000000 -0.000000 -0.000000 0.000000 + 31 0.000000 0.013592 0.000292 0.000000 + 32 0.000000 -0.000000 -0.000000 -0.000000 + 33 0.000000 0.011828 0.000270 0.000000 + 34 0.000000 -0.000000 -0.000000 -0.000000 + 35 0.000000 0.010191 0.000252 -0.000000 + 36 0.000000 -0.000000 0.000000 -0.000000 + 37 0.000000 0.008655 0.000237 -0.000000 + 38 0.000000 -0.000000 -0.000000 -0.000000 + 39 0.000000 0.007200 0.000226 -0.000000 + 40 0.000000 -0.000000 0.000000 -0.000000 + 41 0.000000 0.005811 0.000217 0.000000 + 42 0.000000 -0.000000 -0.000000 -0.000000 + 43 0.000000 0.004471 0.000210 0.000000 + 44 0.000000 -0.000000 -0.000000 0.000000 + 45 0.000000 0.003168 0.000205 0.000000 + 46 0.000000 -0.000000 -0.000000 -0.000000 + 47 0.000000 0.001891 0.000202 -0.000000 + 48 0.000000 -0.000000 0.000000 -0.000000 + 49 0.000000 0.000629 0.000200 0.000000 + 50 0.000000 0.000000 0.000000 0.000000 +*/ diff --git a/fft/test/tpfac.c b/fft/test/tpfac.c new file mode 100644 index 0000000..3b67921 --- /dev/null +++ b/fft/test/tpfac.c @@ -0,0 +1,49 @@ +/* tpfac.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: pfac +*/ +#include "ccmath.h" +void main(int na,char **av) +{ int n,ns,j,l,m,kk[32]; + if(na<2){ printf("para: n1 n2 ... \n"); exit(-1);} + printf("Test of Prime Factorization\n"); + for(l=1; l +#define MPT 50 +double x[MPT]; +void main(void) +{ double y; int kk[32],n=MPT,i; + printf(" Test of Power Spectra Estimator\n"); + printf(" F = 1/(k+1)\n"); + for(i=0; i +void euler(double *pv,int m,double a,double b,double c) +{ double t,cn,sn,*p,*q; int j,k; + for(k=0; k<3 ;++k){ + switch(k){ + case 0: cn=cos(c); sn=sin(c); p=pv; q=p+1; break; + case 1: cn=cos(b); sn= -sin(b); p=pv; q=p+2; break; + case 2: cn=cos(a); sn=sin(a); p=pv; q=p+1; + } + for(j=0; j +int htgaaa(double a,double b,double c,double *as) +{ double y,sa,sb,sc; + double pi=3.141592653589793; + if(a+b+c>=pi) return -1; + sa=sin(a); sb=sin(b); sc=sin(c); + a=cos(a); b=cos(b); c=cos(c); + y=a*b*c; y+=y; + y=sqrt(y+a*a+b*b+c*c-1.); + a=y/(sb*sc); as[0]=log(a+sqrt(a*a+1.)); + b=y/(sa*sc); as[1]=log(b+sqrt(b*b+1.)); + c=y/(sa*sb); as[2]=log(c+sqrt(c*c+1.)); + return 0; +} diff --git a/geom/htgarea.c b/geom/htgarea.c new file mode 100644 index 0000000..7dd4448 --- /dev/null +++ b/geom/htgarea.c @@ -0,0 +1,11 @@ +/* htgarea.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +double htgarea(double a,double b,double c) +{ double pi=3.141592653589793; + return pi-a-b-c; +} diff --git a/geom/htgasa.c b/geom/htgasa.c new file mode 100644 index 0000000..4b5a556 --- /dev/null +++ b/geom/htgasa.c @@ -0,0 +1,20 @@ +/* htgasa.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int htgasa(double a,double cc,double b,double *ans) +{ double sa,sb,x; + double pi=3.141592653589793; + if(a<0. || b<0.) return -1; + sa=sin(a); a=cos(a); sb=sin(b); b=cos(b); + x=sa*sb*cosh(cc)-a*b; + ans[1]=atan2(sqrt(1.-x*x),x); + cc=sinh(cc)*sa*sb/sin(ans[1]); + x=cc/sb; ans[0]=log(x+sqrt(x*x+1.)); + x=cc/sa; ans[2]=log(x+sqrt(x*x+1.)); + return 0; +} diff --git a/geom/htgsas.c b/geom/htgsas.c new file mode 100644 index 0000000..711552f --- /dev/null +++ b/geom/htgsas.c @@ -0,0 +1,21 @@ +/* htgsas.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +void htgsas(double a,double g,double b,double *an) +{ double sa,sb,sg; + double pi=3.141592653589793; + g=.5*(pi-g); sg=sin(g); g=cos(g); + b=.5*(a-b); a-=b; + sa=sinh(a); a=cosh(a); sb=sinh(b); b=cosh(b); + an[0]=atan2(sg*b,g*a); + an[2]=atan2(sg*sb,g*sa); + g=sg*b/sin(an[0]); + an[1]=log(g+sqrt(g*g-1)); + a=an[0]-an[2]; an[0]+=an[2]; an[2]=a; + an[1]+=an[1]; +} diff --git a/geom/htgsss.c b/geom/htgsss.c new file mode 100644 index 0000000..8c82e8d --- /dev/null +++ b/geom/htgsss.c @@ -0,0 +1,20 @@ +/* htgsss.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int htgsss(double a,double b,double c,double *ang) +{ double s; + s=.5*(a+b+c); + if(s-a<0. || s-b<0. || s-c<0.) return -1; + a=cosh(a); b=cosh(b); c=cosh(c); + s=a*b*c; s+=s; + s=sqrt(1.-a*a-b*b-c*c+s); + ang[0]=atan2(s,b*c-a); + ang[1]=atan2(s,c*a-b); + ang[2]=atan2(s,a*b-c); + return 0; +} diff --git a/geom/leng.c b/geom/leng.c new file mode 100644 index 0000000..9860622 --- /dev/null +++ b/geom/leng.c @@ -0,0 +1,17 @@ +/* leng.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#define NULL ((void *)0) +double leng(double *a,double *b,int n) +{ double s,t; int j; + if(b!=NULL){ + for(s=0.,j=0; j +static void strig(double *p,double a,double b,double c); +void rotax(double *v,double az,double pa,double ang,int k) +{ static double ca,sa,cb,sb,cn,sn; + double a[3],t,pi=3.14159265358979; int fg; + if(k==0){ if(pa==0.){ ca=cb=0.; cn=ang;} + else if(pa==pi){ ca=cb=0.; cn= -ang;} + else{ if(ang<0.){ fg=1; ang= -ang;} else fg=0; + strig(a,pa,ang,pa); + if(fg==0){ ca=az-a[0]; cn=pi-az-a[0];} + else{ a[1]= -a[1]; cn=a[0]-az; ca=az+a[0]-pi;} + } + sa=sin(ca); ca=cos(ca); sb=sin(a[1]); cb=cos(a[1]); + sn=sin(cn); cn=cos(cn); + } + t=cn*v[0]-sn*v[1]; v[1]=cn*v[1]+sn*v[0]; v[0]=t; + t=cb*v[0]+sb*v[2]; v[2]=cb*v[2]-sb*v[0]; v[0]=t; + t=ca*v[0]-sa*v[1]; v[1]=ca*v[1]+sa*v[0]; v[0]=t; +} +static void strig(double *p,double a,double b,double c) +{ double as,cs,bb; + as=sin(a); a=cos(a); cs=sin(c); c=cos(c); + bb=c*a+cs*as*cos(b); + if(bb>1.) bb=1.; else if(bb< -1.) bb= -1.; + b=cs*as*sin(b); + p[0]=atan2(b,c-a*bb); + p[1]=acos(bb); + p[2]=atan2(b,a-c*bb); +} diff --git a/geom/scalv.c b/geom/scalv.c new file mode 100644 index 0000000..d5ea8ca --- /dev/null +++ b/geom/scalv.c @@ -0,0 +1,11 @@ +/* scalv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +void scalv(double *r,double s,int n) +{ double *mx; + for(mx=r+n; r +int stgaaa(double a,double b,double c,double *ang) +{ double s; + double pi=3.141592653589793; + if(a+b+c<=pi) return -1; + a=cos(a); b=cos(b); c=cos(c); + s=a*b*c; s+=s; + s=sqrt(1.-a*a-b*b-c*c-s); + ang[0]=atan2(s,b*c+a); + ang[1]=atan2(s,a*c+b); + ang[2]=atan2(s,a*b+c); + return 0; +} diff --git a/geom/stgarea.c b/geom/stgarea.c new file mode 100644 index 0000000..9f56928 --- /dev/null +++ b/geom/stgarea.c @@ -0,0 +1,11 @@ +/* stgarea.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +double stgarea(double a,double b,double c) +{ double pi=3.141592653589793; + return (a+b+c-pi); +} diff --git a/geom/stgasa.c b/geom/stgasa.c new file mode 100644 index 0000000..e134913 --- /dev/null +++ b/geom/stgasa.c @@ -0,0 +1,27 @@ +/* stgasa.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int stgasa(double a,double c,double b,double *ang) +{ double sa,sb,sc; int f; + double pi=3.141592653589793; + if(a>=0. && b>=0.) f=0; + else if(a<0. && b<0.){ a= -a; b= -b; f=1;} + else return -1; + c*=.5; sc=sin(c); c=cos(c); + b=.5*(a-b); a-=b; + sa=sin(a); a=cos(a); sb=sin(b); b=cos(b); + ang[0]=atan2(sc*b,c*a); + ang[2]=atan2(sc*sb,c*sa); + ang[1]=atan2(sa/cos(ang[2]),a/cos(ang[0])); + a=ang[0]-ang[2]; ang[0]+=ang[2]; ang[2]=a; + ang[1]+=ang[1]; + if(ang[1]>0.) ang[1]=pi-ang[1]; + else ang[1]= -ang[1]-pi; + if(f) ang[1]= -ang[1]; + return 0; +} diff --git a/geom/stgsas.c b/geom/stgsas.c new file mode 100644 index 0000000..6897833 --- /dev/null +++ b/geom/stgsas.c @@ -0,0 +1,22 @@ +/* stgsas.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +void stgsas(double a,double g,double b,double *ang) +{ double sa,sb,sg; + double pi=3.141592653589793; + if(g>0.) g=.5*(pi-g); else g= -.5*(pi+g); + sg=sin(g); g=cos(g); + b=.5*(a-b); a-=b; + sa=sin(a); a=cos(a); sb=sin(b); b=cos(b); + ang[0]=atan2(sg*b,g*a); + ang[2]=atan2(sg*sb,g*sa); + if((sg=g*sa/cos(ang[2]))<0.707) ang[1]=asin(sg); + else ang[1]=acos(g*a/cos(ang[0])); + a=ang[0]-ang[2]; ang[0]+=ang[2]; ang[2]=a; + ang[1]+=ang[1]; +} diff --git a/geom/stgsss.c b/geom/stgsss.c new file mode 100644 index 0000000..345e728 --- /dev/null +++ b/geom/stgsss.c @@ -0,0 +1,20 @@ +/* stgsss.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int stgsss(double a,double b,double c,double *ang) +{ double s; + s=.5*(a+b+c); + if(s-a<0. || s-b<0. || s-c<0.) return -1; + a=cos(a); b=cos(b); c=cos(c); + s=a*b*c; s+=s; + s=sqrt(1.-a*a-b*b-c*c+s); + ang[0]=atan2(s,a-b*c); + ang[1]=atan2(s,b-a*c); + ang[2]=atan2(s,c-a*b); + return 0; +} diff --git a/geom/test/README b/geom/test/README new file mode 100644 index 0000000..91311de --- /dev/null +++ b/geom/test/README @@ -0,0 +1,18 @@ + This directory contains test code for the functions of the 'geom' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. Input data files, if any + are named in the test code header, are in the 'data' sub-directory. + + The following list gives the command line inputs for the + standard tests. + + teuler + thtrgas data/thtrg.dat + thtrgss data/thtrg.dat + tmetpr data/metp.dat + tptrgssa data/tptrg2.dat + tptrgtt data/tptrg.dat + trotax + tstrgas data/tstrg.dat + tstrgss data/tstrg.dat + tvops1 diff --git a/geom/test/data/metp.dat b/geom/test/data/metp.dat new file mode 100644 index 0000000..3a8d316 --- /dev/null +++ b/geom/test/data/metp.dat @@ -0,0 +1,6 @@ +4 +6. 2. 1. 2. +2. 4. 3. 1. +1. 3. 3.5 -3. +2. 1. -3. 4. +2. -.5 .5 -1. diff --git a/geom/test/data/thtrg.dat b/geom/test/data/thtrg.dat new file mode 100644 index 0000000..37f39de --- /dev/null +++ b/geom/test/data/thtrg.dat @@ -0,0 +1,2 @@ +2. 40. 3. +1.3 135. .8 diff --git a/geom/test/data/tptrg.dat b/geom/test/data/tptrg.dat new file mode 100644 index 0000000..22f4ba2 --- /dev/null +++ b/geom/test/data/tptrg.dat @@ -0,0 +1,2 @@ +2. 38. 4. +1. 150. 1.8 diff --git a/geom/test/data/tptrg2.dat b/geom/test/data/tptrg2.dat new file mode 100644 index 0000000..bdad298 --- /dev/null +++ b/geom/test/data/tptrg2.dat @@ -0,0 +1,2 @@ +2. 38. 2. +1. 150. 1.8 diff --git a/geom/test/data/tstrg.dat b/geom/test/data/tstrg.dat new file mode 100644 index 0000000..aedaf2d --- /dev/null +++ b/geom/test/data/tstrg.dat @@ -0,0 +1,2 @@ +20. 32. 70. +120. 125. 65. diff --git a/geom/test/teuler.c b/geom/test/teuler.c new file mode 100644 index 0000000..06b689c --- /dev/null +++ b/geom/test/teuler.c @@ -0,0 +1,41 @@ +/* teuler.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: euler + Uses: stgsas +*/ +#include "ccmath.h" +#include +void main(void) +{ double an1,an2,an3; + double rad=1.74532925199433e-02; + double vc[9]; int j; + printf(" Test of Rotation Programs\n"); + an1=30.*rad; an2=40.*rad; an3=35.*rad; + printf(" spherical triangle s-a-s\n"); + stgsas(an1,an2,an3,vc); + printf(" input angles: %f %f %f\n",an1/rad,an2/rad,an3/rad); + printf(" output angles: %f %f %f\n",vc[0]/rad,vc[1]/rad,vc[2]/rad); + for(j=0; j<9 ;) vc[j++]=0.; + vc[0]=vc[4]=vc[8]=1.; + euler(vc,3,an1,an2,an3); + printf("\n rotation matrix for input angles:\n"); + for(j=0; j<9 ;){ printf(" %9f",vc[j++]); if(j%3==0) printf("\n");} +} +/* Test output + + Test of Rotation Programs + spherical triangle s-a-s + input angles: 30.000000 40.000000 35.000000 + output angles: 60.345951 21.705202 85.493660 + + rotation matrix for input angles: + 0.256649 0.810485 -0.526541 + -0.790095 0.489714 0.368688 + 0.556670 0.321394 0.766044 +*/ diff --git a/geom/test/thtrgas.c b/geom/test/thtrgas.c new file mode 100644 index 0000000..f3c795b --- /dev/null +++ b/geom/test/thtrgas.c @@ -0,0 +1,46 @@ +/* thtrgas.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: htrgsas htrgasa + + input file: thtrg.dat +*/ +#include "ccmath.h" +double rad=1.7453292519943296e-2; +void main(int na,char **av) +{ double a,b,c,aa,bb,cc,ang[3]; + int n; + FILE *fp; + if(na!=2){ printf("para: in_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + n=1; + while(fscanf(fp,"%lf %lf %lf",&a,&b,&c)!=EOF){ + printf(" n=%d\n",n); + printf(" sas_in: %f %f %f\n",a,b,c); + b*=rad; + htgsas(a,b,c,ang); + aa=ang[0]/rad; bb=ang[1]; cc=ang[2]/rad; + printf(" asa_out: %f %f %f\n",aa,bb,cc); + aa*=rad; cc*=rad; + htgasa(aa,bb,cc,ang); + aa=ang[0]; bb=ang[1]/rad; cc=ang[2]; + printf(" sas_out: %f %f %f\n",aa,bb,cc); + ++n; + } +} +/* Test output + + n=1 + sas_in: 2.000000 40.000000 3.000000 + asa_out: 13.490245 2.997584 40.116968 + sas_out: 2.000000 40.000000 3.000000 + n=2 + sas_in: 1.300000 135.000000 0.800000 + asa_out: 19.686630 1.983407 10.145969 + sas_out: 1.300000 135.000000 0.800000 +*/ diff --git a/geom/test/thtrgss.c b/geom/test/thtrgss.c new file mode 100644 index 0000000..0f4d2b9 --- /dev/null +++ b/geom/test/thtrgss.c @@ -0,0 +1,56 @@ +/* thtrgss.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: htgsas htgsss htgaaa htgarea + + input file: thtrg.dat +*/ +#include "ccmath.h" +double rad=1.7453292519943296e-2; +void main(int na,char **av) +{ double a,b,c,aa,bb,cc,ang[3]; + int n; + FILE *fp; + if(na!=2){ printf("para: in_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + n=1; + while(fscanf(fp,"%lf %lf %lf",&a,&b,&c)!=EOF){ + printf(" n=%d\n",n); + printf(" sas_in: %f %f %f\n",a,b,c); + b*=rad; + htgsas(a,b,c,ang); + aa=ang[0]/rad; bb=ang[1]; cc=ang[2]/rad; + printf(" asa_out: %f %f %f\n",aa,bb,cc); + b=ang[1]; + htgsss(a,b,c,ang); + aa=ang[0]/rad; bb=ang[1]/rad; cc=ang[2]/rad; + printf(" ang_out: %f %f %f\n",aa,bb,cc); + a=ang[0]; b=ang[1]; c=ang[2]; + cc=htgarea(a,b,c); + printf(" area= %f\n",cc); + htgaaa(a,b,c,ang); + aa=ang[0]; bb=ang[1]; cc=ang[2]; + printf("side_out: %f %f %f\n",aa,bb,cc); + ++n; + } +} +/* Test output + + n=1 + sas_in: 2.000000 40.000000 3.000000 + asa_out: 13.490245 2.997584 40.116968 + ang_out: 13.490245 40.000000 40.116968 + area= 1.507839 +side_out: 2.000000 2.997584 3.000000 + n=2 + sas_in: 1.300000 135.000000 0.800000 + asa_out: 19.686630 1.983407 10.145969 + ang_out: 19.686630 135.000000 10.145969 + area= 0.264721 +side_out: 1.300000 1.983407 0.800000 +*/ diff --git a/geom/test/tmetpr.c b/geom/test/tmetpr.c new file mode 100644 index 0000000..749577b --- /dev/null +++ b/geom/test/tmetpr.c @@ -0,0 +1,54 @@ +/* tmetpr.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: metpr + + Uses: vmul dotp matprt + + Input file: metp.dat +*/ +#include "ccmath.h" +char fmt[]=" %8.4f"; +void main(int na,char **av) +{ double s,*a,*u,*v; + int i,n,m; FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + fscanf(fp,"%d",&n); m=n*n; + printf(" Metric Product Test: dimension= %d\n",n); + a=(double *)calloc(m+2*n,sizeof(double)); + u=a+m; v=u+n; + for(i=0; i +void main(void) +{ double v[3],az,pa,an; int j; + double rad=1.74532925199433e-02; + printf(" Test of Axis Rotation\n"); + v[0]=1.; v[1]=v[2]=0.; + az=60.; pa=50.; an=45.; + printf(" input vector:\n"); matprt(v,1,3," %f"); + printf(" rotation axis: az= %.3f pa= %.3f\n",az,pa); + printf(" rotation angle = %f\n",an); + for(j=0; j<8 ;++j){ + rotax(v,az*rad,pa*rad,an*rad,j); + printf(" output vector: rot = %9.3f\n",(j+1)*an); + matprt(v,1,3," %9f"); + } +} +/* Test output + + Test of Axis Rotation + input vector: + 1.000000 0.000000 0.000000 + rotation axis: az= 60.000 pa= 50.000 + rotation angle = 45.000000 + output vector: rot = 45.000 + 0.750076 0.528944 -0.396994 + output vector: rot = 90.000 + 0.146706 0.896890 -0.417212 + output vector: rot = 135.000 + -0.456664 0.888299 -0.048812 + output vector: rot = 180.000 + -0.706588 0.508205 0.492404 + output vector: rot = 225.000 + -0.456664 -0.020740 0.889397 + output vector: rot = 270.000 + 0.146706 -0.388685 0.909616 + output vector: rot = 315.000 + 0.750076 -0.380095 0.541215 + output vector: rot = 360.000 + 1.000000 -0.000000 0.000000 +*/ diff --git a/geom/test/tstrgas.c b/geom/test/tstrgas.c new file mode 100644 index 0000000..5e311a1 --- /dev/null +++ b/geom/test/tstrgas.c @@ -0,0 +1,46 @@ +/* tstrgas.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: stgsas stgasa + + input file: tstrg.dat +*/ +#include "ccmath.h" +double rad=1.7453292519943296e-2; +void main(int na,char **av) +{ double a,b,c,aa,bb,cc,ang[3]; + int n; + FILE *fp; + if(na!=2){ printf("para: in_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + n=1; + while(fscanf(fp,"%lf %lf %lf",&a,&b,&c)!=EOF){ + printf(" n=%d\n",n); + printf(" sas_in: %f %f %f\n",a,b,c); + a*=rad; b*=rad; c*=rad; + stgsas(a,b,c,ang); + aa=ang[0]/rad; bb=ang[1]/rad; cc=ang[2]/rad; + printf(" asa_out: %f %f %f\n",aa,bb,cc); + aa*=rad; bb*=rad; cc*=rad; + stgasa(aa,bb,cc,ang); + aa=ang[0]/rad; bb=ang[1]/rad; cc=ang[2]/rad; + printf(" sas_out: %f %f %f\n",aa,bb,cc); + ++n; + } +} +/* Test output + + n=1 + sas_in: 20.000000 32.000000 70.000000 + asa_out: 13.019714 53.562098 141.759115 + sas_out: 20.000000 32.000000 70.000000 + n=2 + sas_in: 120.000000 125.000000 65.000000 + asa_out: 108.924709 131.414448 81.868229 + sas_out: 120.000000 125.000000 65.000000 +*/ diff --git a/geom/test/tstrgss.c b/geom/test/tstrgss.c new file mode 100644 index 0000000..4a308d5 --- /dev/null +++ b/geom/test/tstrgss.c @@ -0,0 +1,56 @@ +/* tstrgss.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: stgsas stgsss stgaaa stgarea + + input file: tstrg.dat +*/ +#include "ccmath.h" +double rad=1.7453292519943296e-2; +void main(int na,char **av) +{ double a,b,c,aa,bb,cc,ar,ang[3]; + int n; + FILE *fp; + if(na!=2){ printf("para: in_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + n=1; + while(fscanf(fp,"%lf %lf %lf",&a,&b,&c)!=EOF){ + printf(" n=%d\n",n); + printf(" sas_in: %f %f %f\n",a,b,c); + a*=rad; b*=rad; c*=rad; + stgsas(a,b,c,ang); + aa=ang[0]/rad; bb=ang[1]/rad; cc=ang[2]/rad; + printf(" asa_out: %f %f %f\n",aa,bb,cc); + b=ang[1]; + stgsss(a,b,c,ang); + a=ang[0]; b=ang[1]; c=ang[2]; + ar=stgarea(a,b,c); + printf(" area= %f\n",ar); + aa=ang[0]/rad; bb=ang[1]/rad; cc=ang[2]/rad; + printf(" ang_out: %f %f %f\n",aa,bb,cc); + stgaaa(a,b,c,ang); + aa=ang[0]/rad; bb=ang[1]/rad; cc=ang[2]/rad; + printf(" sid_out: %f %f %f\n",aa,bb,cc); + ++n; + } +} +/* Test output + + n=1 + sas_in: 20.000000 32.000000 70.000000 + asa_out: 13.019714 53.562098 141.759115 + area= 0.118313 + ang_out: 13.019714 32.000000 141.759115 + sid_out: 20.000000 53.562098 70.000000 + n=2 + sas_in: 120.000000 125.000000 65.000000 + asa_out: 108.924709 131.414448 81.868229 + area= 2.370034 + ang_out: 108.924709 125.000000 81.868229 + sid_out: 120.000000 131.414448 65.000000 +*/ diff --git a/geom/test/tvops1.c b/geom/test/tvops1.c new file mode 100644 index 0000000..2c520c1 --- /dev/null +++ b/geom/test/tvops1.c @@ -0,0 +1,48 @@ +/* tvops1.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: dotp scalv trvec crossp leng + + Uses: matprt +*/ +#include "ccmath.h" +double x[]={ 1., 3.,4.}; +double y[]={ 4., 2.,-2.}; +void main(void) +{ double s,z[3]; + printf(" Vector Operations Test #1\n"); + printf(" input vectors: x and y\n"); + matprt(x,1,3," %.3f"); matprt(y,1,3," %.3f"); + printf(" dot product x.y= %f\n",dotp(x,y,3)); + s=2.; scalv(y,s,3); + printf(" scale y by 2:\n"); matprt(y,1,3," %.3f"); + s=1./s; scalv(y,s,3); + trvec(z,x,y,3); printf(" z=x+y: "); matprt(z,1,3," %.3f"); + crossp(z,x,y); printf(" cross product x^y:\n"); + matprt(z,1,3," %.3f"); + printf(" vector lengths:\n"); + printf(" |x|= %f\n",leng(x,0L,3)); printf(" |y|= %f\n",leng(y,0L,3)); + printf(" |x-y|= %f\n",leng(x,y,3)); +} +/* Test output + + Vector Operations Test #1 + input vectors: x and y + 1.000 3.000 4.000 + 4.000 2.000 -2.000 + dot product x.y= 2.000000 + scale y by 2: + 8.000 4.000 -4.000 + z=x+y: 5.000 5.000 2.000 + cross product x^y: + -14.000 18.000 -10.000 + vector lengths: + |x|= 5.099020 + |y|= 4.898979 + |x-y|= 6.782330 +*/ diff --git a/geom/trgarea.c b/geom/trgarea.c new file mode 100644 index 0000000..f4939bc --- /dev/null +++ b/geom/trgarea.c @@ -0,0 +1,14 @@ +/* trgarea.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double trgarea(double a,double b,double c) +{ double s; + s=a+b+c; + s=sqrt(s*(s-a-a)*(s-b-b)*(s-c-c)); + return .25*s; +} diff --git a/geom/trgasa.c b/geom/trgasa.c new file mode 100644 index 0000000..66061f8 --- /dev/null +++ b/geom/trgasa.c @@ -0,0 +1,18 @@ +/* trgasa.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int trgasa(double a,double ss,double b,double *asn) +{ double h; + double pi=3.141592653589793; + if(a<0. || b<0.) return -1; + asn[1]=h=pi-a-b; + h=sin(h); + asn[0]=ss*sin(a)/h; + asn[2]=ss*sin(b)/h; + return 0; +} diff --git a/geom/trgsas.c b/geom/trgsas.c new file mode 100644 index 0000000..0815c2c --- /dev/null +++ b/geom/trgsas.c @@ -0,0 +1,17 @@ +/* trgsas.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +void trgsas(double a,double g,double b,double *ans) +{ double u,s; + u=a*b; s=u*sin(g); + u*=cos(g); u+=u; s+=s; + a*=a; b*=b; + u=a+b-u; ans[1]=sqrt(u); + ans[0]=atan2(s,b+u-a); + ans[2]=atan2(s,a+u-b); +} diff --git a/geom/trgssa.c b/geom/trgssa.c new file mode 100644 index 0000000..0f4d707 --- /dev/null +++ b/geom/trgssa.c @@ -0,0 +1,27 @@ +/* trgssa.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int trgssa(double a,double b,double ba,double *an) +{ double x,y,z,v; + x=a*cos(ba); ba=a*sin(ba); + a*=a; b*=b; + if((y=b-ba*ba)<0.) return -1; + else y=sqrt(y); + an[0]=x+y; v=an[0]*an[0]; + z=an[0]*ba; z+=z; + an[1]=atan2(z,a+b-v); + an[2]=atan2(z,b+v-a); + if(x>y){ + an[3]=x-y; v=an[3]*an[3]; + z=an[3]*ba; z+=z; + an[4]=atan2(z,a+b-v); + an[5]=atan2(z,b+v-a); + } + else an[3]=an[4]=an[5]=0.; + return 0; +} diff --git a/geom/trgsss.c b/geom/trgsss.c new file mode 100644 index 0000000..6b7b448 --- /dev/null +++ b/geom/trgsss.c @@ -0,0 +1,20 @@ +/* trgsss.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int trgsss(double a,double b,double c,double *ang) +{ double s; + s=.5*(a+b+c); + if(s-a<0. || s-b<0. || s-c<0.) return -1; + s+=s; + s=sqrt(s*(s-a-a)*(s-b-b)*(s-c-c)); + a*=a; b*=b; c*=c; + ang[0]=atan2(s,b+c-a); + ang[1]=atan2(s,a+c-b); + ang[2]=atan2(s,a+b-c); + return 0; +} diff --git a/geom/trvec.c b/geom/trvec.c new file mode 100644 index 0000000..4ef39a5 --- /dev/null +++ b/geom/trvec.c @@ -0,0 +1,11 @@ +/* trvec.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +void trvec(double *c,double *a,double *b,int n) +{ double *mx; + for(mx=c+n; c +#include +double chintg(double *a,int m,double (*func)()) +{ double f,t,tf,aj,adel,*pf,*pe,*p,*ps; + int j; + pf=(double *)calloc(2*m,sizeof(double)); pe=pf+m; + ++m; adel=3.1415926535897932/m; + for(p=pf,ps=pe,j=1,aj=adel; p0 ;--ps,--j){ + for(p=pe-1,t=tf=0.; p>=pf ;){ f= *ps*t-tf+ *p--; tf=t; t=f;} + a[j]*=t*2./(j*m); + } + for(j=1,a[0]=0.; jm-4 ;--j) if((t=fabs(a[j]))>f) f=t; + free(pf); return f; +} diff --git a/intg/deqsy.c b/intg/deqsy.c new file mode 100644 index 0000000..d4177f9 --- /dev/null +++ b/intg/deqsy.c @@ -0,0 +1,42 @@ +/* deqsy.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include +deqsy(double *y,int n,double a,double b,int nd,double te, + int (*fsys)()) +{ double h,x,ht,st,*dp,*fp,*fq,*ap,*p,*q,*pt; + int m,j,k; + fp=(double *)calloc(13*n,sizeof(double)); + fq=fp+n; dp=fq+n; ap=dp+n; h=(b-a)/nd; + for(m=0; m>=0 ;){ ++m; (*fsys)(x=a,y,dp); + for(j=0,p=fp,q=fq,pt=dp; p1){ + for(k=0,p=fp,q=dp; pte*fabs(*p++)){ k=1; break;} + } + if(k==0) break; + if(m==10) m= -m; + } + } + for(p=y,q=fp; qa ;){ de= *p-- +y*t-tf; tf=t; t=de;} + return (*p+x*t-tf); +} diff --git a/intg/fintg.c b/intg/fintg.c new file mode 100644 index 0000000..7cdcee8 --- /dev/null +++ b/intg/fintg.c @@ -0,0 +1,25 @@ +/* fintg.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double fintg(double a,double b,int n,double te,double (*func)()) +{ int j,k,m; double s,t,x,h,ap[10],*p; + s=((*func)(b)+(*func)(a))/2.; + h=(b-a)/n; x=a; + for(j=1; j +#include "ccmath.h" +#define MDM 60 +/* order of Tchebycheff approximation */ +int mp=8; +double Pi=3.14159265358979324; +double func(double x); +void main(int na,char **av) +{ double x,y,f,a[MDM],Pi2=Pi/2.; + printf(" Test of Tchebycheff Integration\n\n"); + if(na!=1) mp=atoi(*++av); + printf(" order = %d\n",mp); + f=chintg(a,mp,func); + printf(" test magnitude = %14.10f\n\n",f); + printf(" y computed exact\n"); + for(y= -1.; y<=1. ;y+=.5){ + f=fchb(y,a,mp)*Pi2/2.; x=Pi2*(1.+y)/2.; + printf(" %6.3f %13.8f %13.8f\n",y,f,1.-cos(x)); + } +} +/* test integrand function + defined on x from -1 to 1. + Integral is 1-cos(Pi*(1+x)/4). +*/ +double func(double x) +{ double y; + y=(1.+x)/2.; return sin(Pi*y/2.); +} +/* Test output + + Test of Tchebycheff Integration + + order = 8 + test magnitude = 0.0000089716 + + y computed exact + -1.000 0.00000000 0.00000000 + -0.500 0.07612047 0.07612047 + 0.000 0.29289322 0.29289322 + 0.500 0.61731657 0.61731657 + 1.000 1.00000000 1.00000000 +*/ diff --git a/intg/test/tcnvx.c b/intg/test/tcnvx.c new file mode 100644 index 0000000..7c6420d --- /dev/null +++ b/intg/test/tcnvx.c @@ -0,0 +1,66 @@ +/* tcnvx.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: fintg +*/ +#include +#include "ccmath.h" +/* convergence test threshold */ +double te=1.e-12; +/* initial convolution displacement and increment*/ +double r=0.,dr=0.1; +char fi[]="norm(x-r)"; +double cs=0.398942280402; +void main(void) +{ double a,b,te=1.e-12; + double fnrm(double x); + printf(" Convolution Integrals Test\n\n"); + printf(" convergence threshold= %e\n\n",te); + printf(" %s over x : [-1, 1]\n",fi); + for(a= -1.,b=1.; r<2.0001 ;r+=dr){ + printf(" r=%10.6f I= %12.7f\n",r,fintg(a,b,25,te,fnrm)); + } +} +/* Normal probability density of x-r. + Note that the parameter r is delivered as an external + to the standard format integrand fnrm. +*/ +double fnrm(double x) +{ double ldexp(); + x-=r; + return exp(-ldexp(x*x,-1))*cs; +} +/* Test output + + Convolution Integrals Test + + convergence threshold= 1.000000e-12 + + norm(x-r) over x : [-1, 1] + r= 0.000000 I= 0.6826895 + r= 0.100000 I= 0.6802738 + r= 0.200000 I= 0.6730749 + r= 0.300000 I= 0.6612359 + r= 0.400000 I= 0.6449902 + r= 0.500000 I= 0.6246553 + r= 0.600000 I= 0.6006224 + r= 0.700000 I= 0.5733460 + r= 0.800000 I= 0.5433294 + r= 0.900000 I= 0.5111113 + r= 1.000000 I= 0.4772499 + r= 1.100000 I= 0.4423077 + r= 1.200000 I= 0.4068368 + r= 1.300000 I= 0.3713645 + r= 1.400000 I= 0.3363807 + r= 1.500000 I= 0.3023279 + r= 1.600000 I= 0.2695919 + r= 1.700000 I= 0.2384967 + r= 1.800000 I= 0.2093003 + r= 1.900000 I= 0.1821943 + r= 2.000000 I= 0.1573054 +*/ diff --git a/intg/test/tdeqsy.c b/intg/test/tdeqsy.c new file mode 100644 index 0000000..a08b484 --- /dev/null +++ b/intg/test/tdeqsy.c @@ -0,0 +1,79 @@ +/* tdeqsy.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: deqsy + + To specify a new convergence test threshold use the call + tdeqsy new_te +*/ +#include +#include "ccmath.h" +/* convergence test threshold */ +double te=1.e-8; +/* system dimension parameter */ +int n=2; +int fsys(double x,double *y,double *d); +void main(int na,char **av) +{ double a,b,dx,y[2]; + int m; + printf(" Test of Differential System Solver\n\n"); + if(na != 1) te=atof(*++av); + printf(" convergence threshold= %.2e\n\n",te); + y[0]=20.; y[1]=0.; a=0.; + printf(" x= %6.3f y0= %10f y1= %10f\n",a,y[0],y[1]); +/* integrate with 0.25 increments and 20 initial steps/increment */ + for(dx=.25; a<7.5 ;a=b){ + b=a+dx; m=deqsy(y,n,a,b,20,te,fsys); + printf(" x= %6.3f y0= %10f y1= %10f m=%d\n",b,y[0],y[1],m); + } +} +/* system function for the second order system + dy/dt = v , dv/dt = -f^2*y - r*v +*/ +int fsys(double x,double *y,double *d) +{ double f=1.,r=.5; + d[0]=y[1]; d[1]= -f*f*y[0]-r*y[1]; +} +/* Test output + + Test of Differential System Solver + + convergence threshold= 1.00e-08 + + x= 0.000 y0= 20.000000 y1= 0.000000 + x= 0.250 y0= 19.403339 y1= -4.651330 m=3 + x= 0.500 y0= 17.742734 y1= -8.484261 m=3 + x= 0.750 y0= 15.240260 y1= -11.370938 m=3 + x= 1.000 y0= 12.141097 y1= -13.253832 m=3 + x= 1.250 y0= 8.696494 y1= -14.140843 m=3 + x= 1.500 y0= 5.148365 y1= -14.097148 m=3 + x= 1.750 y0= 1.716249 y1= -13.234662 m=3 + x= 2.000 y0= -1.412891 y1= -11.700004 m=3 + x= 2.250 y0= -4.091769 y1= -9.661852 m=3 + x= 2.500 y0= -6.216722 y1= -7.298489 m=3 + x= 2.750 y0= -7.728642 y1= -4.786260 m=3 + x= 3.000 y0= -8.611197 y1= -2.289486 m=3 + x= 3.250 y0= -8.886756 y1= 0.047721 m=3 + x= 3.500 y0= -8.610539 y1= 2.107510 m=3 + x= 3.750 y0= -7.863524 y1= 3.802091 m=3 + x= 4.000 y0= -6.744692 y1= 5.075336 m=3 + x= 4.250 y0= -5.363124 y1= 5.902336 m=3 + x= 4.500 y0= -3.830440 y1= 6.287191 m=3 + x= 4.750 y0= -2.253977 y1= 6.259362 m=3 + x= 5.000 y0= -0.731016 y1= 5.868967 m=3 + x= 5.250 y0= 0.655718 y1= 5.181425 m=3 + x= 5.500 y0= 1.841181 y1= 4.271836 m=3 + x= 5.750 y0= 2.779739 y1= 3.219454 m=3 + x= 6.000 y0= 3.445548 y1= 2.102565 m=3 + x= 6.250 y0= 3.831743 y1= 0.994027 m=3 + x= 6.500 y0= 3.948608 y1= -0.042351 m=3 + x= 6.750 y0= 3.820959 y1= -0.954477 m=3 + x= 7.000 y0= 3.484989 y1= -1.703639 m=3 + x= 7.250 y0= 2.984812 y1= -2.265202 m=3 + x= 7.500 y0= 2.368956 y1= -2.628386 m=3 +*/ diff --git a/intg/test/tfintg.c b/intg/test/tfintg.c new file mode 100644 index 0000000..a4496d7 --- /dev/null +++ b/intg/test/tfintg.c @@ -0,0 +1,57 @@ +/* tfintg.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: fintg +*/ +#include +#include "ccmath.h" +/* Convergence test parameter */ +double te=1.e-12; +double Pi=3.14159265358979324; +char in1[]="normal probability density"; +char in2[]="1/(1+x*x)"; +void main(void) +{ double a,b; int j; + double fnrm(double x),frf(double x); + printf(" Test of Numerical Integration\n\n"); + printf(" convergence threshold= %.2e\n",te); + printf("\n integrand 1 = %s\n",in1); + for(j=0,a=0.,b=1.; j<5 ;++j,b+=1.) + printf(" %f to %f I= %12.8f\n",a,b,fintg(a,b,25,te,fnrm)); + printf("\n integrand 2 = %s\n",in2); + for(j=0,a=0.,b=1.; j<5 ;++j,b+=1.) + printf(" %f to %f I= %12.8f\n",a,b,fintg(a,b,25,te,frf)); +} +/* test function for rational integrand */ +double frf(double x) +{ return 1./(1.+x*x); +} +/* test function for normal probability density */ +double fnrm(double x) +{ return exp(-x*x/2.)/sqrt(2.*Pi); +} +/* Test output + + Test of Numerical Integration + + convergence threshold= 1.00e-12 + + integrand 1 = normal probability density + 0.000000 to 1.000000 I= 0.34134475 + 0.000000 to 2.000000 I= 0.47724987 + 0.000000 to 3.000000 I= 0.49865010 + 0.000000 to 4.000000 I= 0.49996833 + 0.000000 to 5.000000 I= 0.49999971 + + integrand 2 = 1/(1+x*x) + 0.000000 to 1.000000 I= 0.78539816 + 0.000000 to 2.000000 I= 1.10714872 + 0.000000 to 3.000000 I= 1.24904577 + 0.000000 to 4.000000 I= 1.32581766 + 0.000000 to 5.000000 I= 1.37340077 +*/ diff --git a/lgpl.license b/lgpl.license new file mode 100644 index 0000000..b4baf24 --- /dev/null +++ b/lgpl.license @@ -0,0 +1,513 @@ + + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations +below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. +^L + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it +becomes a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. +^L + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control +compilation and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. +^L + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. +^L + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. +^L + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. +^L + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply, and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License +may add an explicit geographical distribution limitation excluding those +countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. +^L + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS +^L + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms +of the ordinary General Public License). + + To apply these terms, attach the following notices to the library. +It is safest to attach them to the start of each source file to most +effectively convey the exclusion of warranty; and each file should +have at least the "copyright" line and a pointer to where the full +notice is found. + + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser 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 + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +Also add information on how to contact you by electronic and paper +mail. + +You should also get your employer (if you work as a programmer) or +your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James +Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + diff --git a/makelibs.sh b/makelibs.sh new file mode 100755 index 0000000..c0f34c7 --- /dev/null +++ b/makelibs.sh @@ -0,0 +1,41 @@ +#! /bin/sh + +# CCM Library compilation script +# run from distribution directory: 'makelibs.sh' +# When installing on an Intel based platform +# respond with y to the prompt +# otherwise abort and run the 'non_intel.sh' script first. +# Then run 'makelibs.sh' and respond with n at this prompt. + +LST="cfit complex fft geom intg matrix roots sfunc simu sort statf tseries util xarm" +MDR=`pwd` +LSOD=$MDR/tmp +echo "Intel platform ? (y/n)" +read F +for dr in $LST + do + cd $MDR/$dr + echo `pwd` + cc -c -O3 *.c + mv *.o $LSOD + done + +# Compile corrected svd QR support without optimizing +# The GNU optimizer destroys the fix! +cd $MDR/matrix +cc -c qrb*.c +mv *.o $LSOD +cd $MDR + +if [ $F = "y" ] + then cd $MDR/matrix + cc -c -O3 solv.s + mv *.o $LSOD + cd $MDR/simu + cc -c -O3 *.s + mv *.o $LSOD +fi +cd $LSOD +ar r libccm.a *.o +ld -shared -o libccm.so *.o +rm *.o diff --git a/manual/C00-intro b/manual/C00-intro new file mode 100644 index 0000000..c8fa9b4 --- /dev/null +++ b/manual/C00-intro @@ -0,0 +1,263 @@ + THE CCM MATH LIBRARY MANUAL + + Dan Atkinson + + CONTENTS + + Chapter Subject + + 1 matrix --------------------------- Linear Algebra + 2 intg --------------------------- Numerical Integration + 3 geom --------------------------- Geometry and Trigonometry + 4 cfit --------------------------- Curve Fitting + 5 roots --------------------------- Roots and Optimization + 6 fft --------------------------- Fourier Analysis + 7 simu --------------------------- Simulation Support + 8 statf --------------------------- Statistical Functions + 9 sfunc --------------------------- Special Functions + 10 sort --------------------------- Sorts and Searches + 11 tseries --------------------------- Time Series Modeling + 12 complex --------------------------- Complex Arithmetic + 13 xarm --------------------------- High Precision Arithmetic + 14 util --------------------------- Utility Operations + +------------------------------------------------------------------------------- + + CCM Library Description + + The CCM library contains a collection of functions, coded in the C + language, that perform computations in the areas indicated by the chapter + subjects in the contents list. These functions were developed and evolved + over a period of nearly thirty years of intense work on scientific and + technical problems. The primary objectives governing library development + were: portability; execution efficiency; and ease of use. + + portability: The library code has been ported to many + platforms. { Atari ST; Vax minicomputer; + UNIX workstations from HP, Sun, and SGI; + Intel based PCs running extended DOS, + and Linux.} The typical function has been + reused on numerous projects. + + efficiency: Functions in the library have been tuned + to localize data access so that they + can execute efficiently on modern systems + using multilevel cache memory. + + ease of use: Simple interfaces are a primary development + goal. The number of call parameters used + in library functions is modest. + + Library functions are designed to complement one another. For example, + analytic approximations are used for function evaluations to ensure high + and reliable accuracy. For efficiency these evaluations can be converted + by other library functions into Tchebycheff Pade' approximations with + little sacrifice in accuracy. + + The library code aims at exploiting the full expressive potential of the + C-Language. Functions are definitely not simple translations of FORTRAN code. + Pointer variables and dynamic allocation are widely used, and structures + replace multidimensional arrays. I believe that you will discover that this + approach significantly enhances the use of this code. + +------------------------------------------------------------------------------- + + Using this Manual + + Each chapter of the manual covers a major functional section of the + library, with source code in the directory whose name is included in the + chapter's name. The chapter starts with an overview of the applications + supported and some technical notes on their utility and accuracy. Each + function is described in detail in a function synopsis that defines its + action and gives a detailed description of call parameters and return + values (including any restrictions on the range of values). + + A quick way to locate the synopsis for a function is to search the + chapter containing that function using the regular expression: + + ^function-name + + since each function synopsis starts with the function's name in the + leftmost position on a line. + +------------------------------------------------------------------------------- + + Notation + + A strictly ASCII format for this manual is clearly desirable to promote + portability. This poses a problem since equations are needed to describe + functions in the library. The problem is addressed here by introducing + the following notational conventions. + + Summations: Sum(i=1 to n) { ---- } + Integrals: Intg(x=a to b) { --- } dx + Matrix transpose: A~ + Matrix Hermitian conjugate: H^ + Matrix component: B[i,j] + Vector component: U[k] + Exponentiation: x^2 or x^e , x^(-2) or x^(-e) + + Exponentiation can be distinguished from hermitian conjugation by context + and by the fact that the symbol ^ is followed by a numeral or a lower case + alphabetic symbol. + + I apologize for the use of this clumsy device. + +------------------------------------------------------------------------------- + + Notable Features of CCM + + The following list highlights features that distinguish the approach + used in the CCM library from the standard fare of numerical analysis code. + + o Functions that deal with large data sets, in + particular large linear algebra problems have + been specially designed to exploit the cache + memory systems used in modern microprocessors. + They achieve a high and stable computation rate + on large problems. + + o A combination of sequential and batch estimation + offers significant advantages in non-linear least + square computations. Functions for both types of + estimation are included in the library. The test + programs provide examples of their combined use. + + o Elliptic integrals are evaluated using the Bartky + parameterization. This permits use of a single + function for elliptic integrals of all three + major types. A major simplification in the use of + this important class of functions. + + o The pseudorandom number generators implemented in + the library employ buffer shuffle algorithms to + eliminate problems arising from the limited period + of standard congruential algorithms (see Knuth + Vol. 2 3rd edition). + + o Function evaluations in the complex arithmetic + package yield principle branch evaluations of + multi-valued functions that conform to the + recommended standard for elementary function + branch cuts. This standardization simplifies the + use of these functions in evaluating more + complicated multi-valued expressions. + + o A high-precision arithmetic package is included, + together with a full library of high precision + elementary functions. This supports a definitive + analysis of the effect of truncation errors in + floating point computation. These utilities are + also valuable in problems where extremely high + (32-decimal digit) precision is desired. + + o The time-series package in the library implements an + innovative approach to the identification, estimation, + and evaluation of Box-Jenkins ARIMA models. It also + includes a significant generalization that deals with + advanced "factor models" for extracting data from + complex time-series. The preliminaries required for + model fitting are simplified by these powerful new + estimation techniques. + +------------------------------------------------------------------------------- + + Package Structure + + Each library segment has it source code in a directory named for the + segment. This directory also contains the header files needed to compile + the code. The source directory has a subdirectory named 'test' that + contains test source code for the functions. Header comments in the test + code source describe the functions tested and the inputs needed to run the + test, while a sample of test output is appended to each test source file. + Data input files are normally found in the 'test/data' subdirectory, while + other subdirectories of the segment directory or its 'test' subdirectory + contain code explained in local 'README' files. + +------------------------------------------------------------------------------- + + Standard Header Files + + The header file is provided for general use. Modern C + compilers support the function prototypes in this file. In addition, each + library segment contains 'old style' non-prototype headers for the segment. + These should work with old C compilers. + +------------------------------------------------------------------------------- + + Bibliography + + This bibliography identifies references that we believe will be very + useful in developing scientific applications. In general, definitions of + special functions used in the CCM Math Library conform to those used by + Abramowitz and Stegun. Divergence from this convention is explicitly noted + in the relevant function synopses. + + Additional references on special topics are given in the Chapters on + specific functional areas. + + + C Language: + + B. W. Kernighan and D. M. Ritchie, "The C Programming Language." + Prentice Hall: Englewood Cliffs, NJ , 1978. + + S. P. Harbison and G. L. Steele Jr., " A C Reference Manual." + Prentice-Hall: Englewood Cliffs, NJ , 3rd Edition 1991. + + P. J. Plauger, "The Standard C Library." Prentice Hall: + Englewood Cliffs, NJ , 1992. + + A. Koenig, "C Traps and Pit Falls." Addison Wesley: + Reading, MA , 1989. + + + General Numerical Analysis + + G. Dahalquist and A. Bjorck, "Numerical Methods." + Prentice Hall: Englewood Cliffs, NJ , 1974. + + H. B. Keller and E. Isaacson, "Analysis of Numerical Methods." + McGraw-Hill: New York, NY , 1966. + + G. H. Golub and C. F. Van Loan, "Matrix Computations," 3rd + edition. The Johns Hopkins University Press: Baltimore, + MD , 1996. + + A. S. Householder, "The Theory of Matrices in Numerical Analysis." + Blaisdell: New York, NY , 1964. + + + Special Functions + + M. Abramowitz and I. A. Stegun, "Handbook of Mathematical Functions." + National Bureau of Standards: Washington, DC , 1964. + + I. S. Gradshteyn and I. W. Ryzhik, "Tables of Integrals, Series, and + Products." Academic Press: New York, NY , 1965. + + + Algorithms + + D. E. Knuth, "The Art of Computer Programming," Vol. 1: "Fundamental + Algorithms," 3rd edition, Addison-Wesley: Reading, MA , 1997. + and Vol. 2: "Seminumerical Algorithms," 3rd edition, Addison-Wesley: + Reading, MA , 1998. + and Vol. 3: "Sorting and Searching," 2nd edition, Addison-Wesley: + Reading, MA , 1998. + + R. Sedgewick, "Algorithms." + Addison-Wesley: Reading, MA , 1983. + + + Special Topics + + G. E. P. Box and G. M. Jenkins, "Time Series Analysis: Forecasting and + Control." Holden-Day: San Francisco, CA , 1976. + + R. Fletcher, "Practical Methods of Optimization," Vol. 1: "Unconstrained + Optimization." J. Wiley and Sons: New York, NY , 1980. + + J. F. Hart, E. W. Cheny, C. L. Lawson, H. J. Machly, C. K. Mesztenyi, + J. R. Rice, H. G. Thacher Jr., and C. Witzgall, "Computer + Approximations." Robert E. Krieger: Malabar, FL , 1978. diff --git a/manual/C01-matrix b/manual/C01-matrix new file mode 100644 index 0000000..03c6b90 --- /dev/null +++ b/manual/C01-matrix @@ -0,0 +1,1280 @@ + Chapter 1 + + LINEAR ALGEBRA + + Summary + + The matrix algebra library contains functions that + perform the standard computations of linear algebra. + General areas covered are: + + o Solution of Linear Systems + o Matrix Inversion + o Eigensystem Analysis + o Matrix Utility Operations + o Singular Value Decomposition + + The operations covered here are fundamental to many + areas of mathematics and statistics. Thus, functions + in this library segment are called by other library + functions. Both real and complex valued matrices + are covered by functions in the first four of these + categories. + + + Notes on Contents + + Functions in this library segment provide the basic operations of + numerical linear algebra and some useful utility functions for operations on + vectors and matrices. The following list describes the functions available for + operations with real-valued matrices. + + + o Solving and Inverting Linear Systems: + + solv --------- solve a general system of real linear equations. + solvps ------- solve a real symmetric linear system. + solvru ------- solve a real right upper triangular linear system. + solvtd ------- solve a tridiagonal real linear system. + + minv --------- invert a general real square matrix. + psinv -------- invert a real symmetric matrix. + ruinv -------- invert a right upper triangular matrix. + + + The solution of a general linear system and efficient algorithms for + solving special systems with symmetric and tridiagonal matrices are provided + by these functions. The general solution function employs a LU factorization + with partial pivoting and it is very robust. It will work efficiently on any + problem that is not ill-conditioned. The symmetric matrix solution is based + on a modified Cholesky factorization. It is best used on positive definite + matrices that do not require pivoting for numeric stability. Tridiagonal + solvers require order-N operations (N = dimension). Thus, they are highly + recommended for this important class of sparse systems. Two matrix inversion + routines are provided. The general inversion function is again LU based. It + is suitable for use on any stable (ie. well-conditioned) problem. The + Cholesky based symmetric matrix inversion is efficient and safe for use on + matrices known to be positive definite, such as the variance matrices + encountered in statistical computations. Both the solver and the inverse + functions are designed to enhance data locality. They are very effective + on modern microprocessors. + + + o Eigensystem Analysis: + + eigen ------ extract all eigen values and vectors of a real + symmetric matrix. + eigval ----- extract the eigen values of a real symmetric matrix. + evmax ------ compute the eigen value of maximum absolute magnitude + and its corresponding vector for a symmetric matrix. + + + Eigensystem functions operate on real symmetric matrices. Two forms of + the general eigen routine are provided because the computation of eigen values + only is much faster when vectors are not required. The basic algorithms use + a Householder reduction to tridiagonal form followed by QR iterations with + shifts to enhance convergence. This has become the accepted standard for + symmetric eigensystem computation. The evmax function uses an efficient + iterative power method algorithm to extract the eigen value of maximum + absolute size and the corresponding eigenvector. + + + o Singular Value Decomposition: + + svdval ----- compute the singular values of a m by n real matrix. + sv2val ----- compute the singular values of a real matrix + efficiently for m >> n. + svduv ------ compute the singular values and the transformation + matrices u and v for a real m by n matrix. + sv2uv ------ compute the singular values and transformation + matrices efficiently for m >> n. + svdu1v ----- compute the singular values and transformation + matrices u1 and v, where u1 overloads the input + with the first n column vectors of u. + sv2u1v ----- compute the singular values and the transformation + matrices u1 and v efficiently for m >> n. + + + Singular value decomposition is extremely useful when dealing with linear + systems that may be singular. Singular values with values near zero are flags + of a potential rank deficiency in the system matrix. They can be used to + identify the presence of an ill-conditioned problem and, in some cases, to + deal with the potential instability. They are applied to the linear least + squares problem in this library. Singular values also define some important + matrix norm parameters such as the 2-norm and the condition value. A complete + decomposition provides both singular values and an orthogonal decomposition of + vector spaces related to the matrix identifying the range and null-space. + Fortunately, a highly stable algorithm based on Householder reduction to + bidiagonal form and QR rotations can be used to implement the decomposition. + The library provides two forms with one more efficient when the dimensions + satisfy m > (3/2)n. + + + o Real Matrix Utilities: + + rmmult ----- multiply two compatible real matrices. + mmul ------- multiply two real square matrices. + vmul ------- multiply a vector by a square matrix (transform). + mattr ------ compute the transpose of a general matrix. + trnm ------- transpose a real square matrix in place. + otrma ------ compute orthogonal conjugate of a square matrix. + otrsm ------ compute orthogonal conjugate of a symmetric matrix. + smgen ------ construct a symmetric matrix from its eigen values + and vectors. + ortho ------ generate a general orthogonal matrix (uses random + rotation generator). + mcopy ------ make a copy of an array. + matprt ----- print a matrix in row order with a specified + format for elements to stdout or a file (fmatprt). + + + The utility functions perform simple matrix operations such as matrix + multiplication, transposition, matrix conjugation, and linear transformation + of a vector. They are used to facilitate the rapid production of test and + application code requiring these operations. The function call overhead + associated with use of these utilities becomes negligible as the dimension of + the matrices increases. The implementation of these routines is designed to + enhance data locality and thus execution performance. A generator for + orthogonal matrices can be used to generate test matrices. + + + Linear Algebra with Complex Matrices + + The complex section of the linear algebra library contains functions that + operate on general complex valued matrices and on Hermitian matrices. + Hermitian matrices are the complex analog of symmetric matrices. Complex + arithmetic is performed in-line in these functions to ensure efficient + execution. + + + o Solving and Inverting Complex Linear Systems: + + csolv ------ solve a general complex system of linear equations. + + cminv ------ invert a general complex matrix. + + + Both these functions are based on the robust LU factorization algorithm + with row pivots. They can be expected to solve or invert any system that is + well conditioned. + + + o Hermitian Eigensystem Analysis: + + heigvec ---- extract the eigen values and vectors of a Hermitian + matrix. + heigval ---- compute the eigenvalues of a Hermitian matrix. + hevmax ----- compute the eigen value of largest absolute magnitude + and the corresponding vector of a Hermitian matrix. + + + The algorithms used for complex eigensystems are complex generalizations + of those employed in the real systems. The eigen values of Hermitian matrices + are real and their eigenvectors form a unitary matrix. As in the real case, + the function for eigen values only is provided as a time saver. These + routines have important application to many quantum mechanical problems. + + + o Complex Matrix Utilities: + + cmmult ---- multiply two general, size compatible, complex matrices. + cmmul ----- multiply two square complex matrices. + cvmul ----- multiply a complex vector by a complex square matrix. + cmattr ---- transpose a general complex matrix. + trncm ----- transpose a complex square matrix in place. + hconj ----- transform a square complex matrix to its Hermitian + conjugate in place. + utrncm ---- compute the unitary transform of a complex matrix. + utrnhm ---- compute the unitary transform of a Hermitian matrix. + hmgen ----- generate a general Hermitian from its eigen values + and vectors. + unitary --- generate a general unitary matrix (uses a random + rotation generator). + cmcpy ----- copy a complex array. + cmprt ----- print a complex matrix in row order with a specified + format for matrix elements. + + + These utility operations replicate the utilities available for real + matrices. Matrix computations implemented in a manner that enhances data + locality. This ensures their efficiency on modern computers with a memory + hierarchy. + +------------------------------------------------------------------------------- + + General Technical Comments + + Efficient computation with matrices on modern processors must be + adapted to the storage scheme employed for matrix elements. The functions + of this library segment do not employ the multidimensional array intrinsic + of the C language. Access to elements employs the simple row-major scheme + described here. + + Matrices are modeled by the library functions as arrays with elements + stored in row order. Thus, the element in the jth row and kth column of + the n by n matrix M, stored in the array mat[], is addressed by + + M[j,k] = mat[n*j+k] , with 0 =< j,k <= n-1 . + + (Remember that C employs zero as the starting index.) The storage order has + important implications for data locality. + + The algorithms employed here all have excellent numerical stability, and + the default double precision arithmetic of C enhances this. Thus, any + problems encountered in using the matrix algebra functions will almost + certainly be due to an ill-conditioned matrix. (The Hilbert matrices, + + H[i,j] = 1/(1+i+j) for i,j < n + + form a good example of such ill-conditioned systems.) We remind the reader + that the appropriate response to such ill-conditioning is to seek an + alternative approach to the problem. The option of increasing precision has + already been exploited. Modification of the linear algebra algorithm code is + not normally effective in an ill-conditioned problem. + +------------------------------------------------------------------------------ + FUNCTION SYNOPSES +------------------------------------------------------------------------------ + + Linear System Solutions: +----------------------------------------------------------------------------- + +solv + + Solve a general linear system A*x = b. + + int solv(double a[],double b[],int n) + a = array containing system matrix A in row order + (altered to L-U factored form by computation) + b = array containing system vector b at entry and + solution vector x at exit + n = dimension of system + return: 0 -> normal exit + -1 -> singular input + + ----------------------------------------------------------- + +solvps + + Solve a symmetric positive definite linear system S*x = b. + + int solvps(double a[],double b[],int n) + a = array containing system matrix S (altered to + Cholesky upper right factor by computation) + b = array containing system vector b as input and + solution vector x as output + n = dimension of system + return: 0 -> normal exit + 1 -> input matrix not positive definite + + -------------------------------------------------------------- + +solvtd + + Solve a tridiagonal linear system M*x = y. + + void solvtd(double a[],double b[],double c[],double x[],int m) + a = array containing m+1 diagonal elements of M + b = array of m elements below the main diagonal of M + c = array of m elements above the main diagonal + x = array containing the system vector y initially, and + the solution vector at exit (m+1 elements) + m = dimension parameter ( M is (m+1)x(m+1) ) + + -------------------------------------------------------------- + +solvru + + Solve an upper right triangular linear system T*x = b. + + int solvru(double *a,double *b,int n) + a = pointer to array of upper right triangular matrix T + b = pointer to array of system vector + The computation overloads this with the + solution vector x. + n = dimension (dim(a)=n*n,dim(b)=n) + return value: f = status flag, with 0 -> normal exit + -1 -> system singular + +------------------------------------------------------------------------------ + + Matrix Inversion: +------------------------------------------------------------------------------ + +minv + + Invert (in place) a general real matrix A -> Inv(A). + + int minv(double a[],int n) + a = array containing the input matrix A + This is converted to the inverse matrix. + n = dimension of the system (i.e. A is n x n ) + return: 0 -> normal exit + 1 -> singular input matrix + + -------------------------------------------------------------- + +psinv + + Invert (in place) a symmetric real matrix, V -> Inv(V). + + int psinv(double v[],int n) + v = array containing a symmetric input matrix + This is converted to the inverse matrix. + n = dimension of the system (dim(v)=n*n) + return: 0 -> normal exit + 1 -> input matrix not positive definite + + The input matrix V is symmetric (V[i,j] = V[j,i]). + + -------------------------------------------------------------- + +ruinv + + Invert an upper right triangular matrix T -> Inv(T). + + int ruinv(double *a,int n) + a = pointer to array of upper right triangular matrix + This is replaced by the inverse matrix. + n = dimension (dim(a)=n*n) + return value: status flag, with 0 -> matrix inverted + -1 -> matrix singular + + +----------------------------------------------------------------------------- + + Symmetric Eigensystem Analysis: +----------------------------------------------------------------------------- + +eigval + + Compute the eigenvalues of a real symmetric matrix A. + + void eigval(double *a,double *ev,int n) + a = pointer to array of symmetric n by n input + matrix A. The computation alters these values. + ev = pointer to array of the output eigenvalues + n = dimension parameter (dim(a)= n*n, dim(ev)= n) + + -------------------------------------------------------------- + +eigen + + Compute the eigenvalues and eigenvectors of a real symmetric + matrix A. + + void eigen(double *a,double *ev,int n) + double *a,*ev; int n; + a = pointer to store for symmetric n by n input + matrix A. The computation overloads this with an + orthogonal matrix of eigenvectors E. + ev = pointer to the array of the output eigenvalues + n = dimension parameter (dim(a)= n*n, dim(ev)= n) + + The input and output matrices are related by + + A = E*D*E~ where D is the diagonal matrix of eigenvalues + D[i,j] = ev[i] if i=j and 0 otherwise. + + The columns of E are the eigenvectors. + + --------------------------------------------------------------- + +evmax + + Compute the maximum (absolute) eigenvalue and corresponding + eigenvector of a real symmetric matrix A. + + double evmax(double a[],double u[],int n) + double a[],u[]; int n; + a = array containing symmetric input matrix A + u = array containing the n components of the eigenvector + at exit (vector normalized to 1) + n = dimension of system + return: ev = eigenvalue of A with maximum absolute value + HUGE -> convergence failure + + +----------------------------------------------------------------------------- + Eigensystem Auxiliaries: +----------------------------------------------------------------------------- + + The following routines are used by the eigensystem functions. + They are not normally called by the user. + +house + + Transform a real symmetric matrix to tridiagonal form. + + void house(double *a,double *d,double *dp,int n) + a = pointer to array of the symmetric input matrix A + These values are altered by the computation. + d = pointer to array of output diagonal elements + dp = pointer to array of n-1 elements neighboring the + diagonal in the symmetric transformed matrix + n = dimension (dim(a)= n*n, dim(d)=dim(dp)=n) + + The output arrays are related to the tridiagonal matrix T by + + T[i,i+1] = T[i+1,i] = dp[i] for i=0 to n-2, and + T[i,i] = d[i] for i=0 to n-1. + -------------------------------------------------------------- + +housev + + Transform a real symmetric matrix to tridiagonal form and + compute the orthogonal matrix of this transformation. + + void housev(double *a,double *d,double *dp,int n) + a = pointer to array of symmetric input matrix A + The computation overloads this array with the + orthogonal transformation matrix O. + d = pointer to array of diagonal output elements + dp = pointer to array of n-1 elements neighboring the + diagonal in the symmetric transformed matrix + n = dimension (dim(a)= n*n, dim(d)=dim(dp)=n) + + The orthogonal transformation matrix O satisfies O~*T*O = A. + ---------------------------------------------------------------- + +qreval + + Perform a QR reduction of a real symmetric tridiagonal + matrix to diagonal form. + + int qreval(double *ev,double *dp,int n) + ev = pointer to array of input diagonal elements + The computation overloads this array with + eigenvalues. + dp = pointer to array input elements neighboring the + diagonal. This array is altered by the computation. + n = dimension (dim(ev)=dim(dp)= n) + + --------------------------------------------------------------- + +qrevec + + Perform a QR reduction of a real symmetric tridiagonal matrix + to diagonal form and update an orthogonal transformation matrix. + + int qrevec(double *ev,double *evec,double *dp,int n) + ev = pointer to array of input diagonal elements + that the computation overloads with eigenvalues + evec = pointer array of orthogonal input matrix + This is updated by the computation to a matrix + of eigenvectors. + dp = pointer to array input elements neighboring the + diagonal. This array is altered by the computation. + n = dimension (dim(ev)=dim(dp)= n) + + This function operates on the output of 'housev'. + +------------------------------------------------------------------------------ + + Matrix Utilities: +------------------------------------------------------------------------------ + +mmul + + Multiply two real square matrices C = A * B. + + void mmul(double *c,double *a,double *b,int n) + double *a,*b,*c; int n; + a = pointer to store for left product matrix + b = pointer to store for right product matrix + c = pointer to store for output matrix + n = dimension (dim(a)=dim(b)=dim(c)=n*n) + + ------------------------------------------------------- + +rmmult + + Multiply two matrices Mat = A*B. + + void rmmult(double *mat,double *a,double *b,int m,int k,int n) + double mat[],a[],b[]; int m,k,n; + mat = array containing m by n product matrix at exit + a = input array containing m by k matrix + b = input array containing k by n matrix + (all matrices stored in row order) + m,k,n = dimension parameters of arrays + + ---------------------------------------------------------- + +vmul + + Multiply a vector by a matrix Vp = Mat*V. + + void vmul(double *vp,double *mat,double *v,int n) + vp = pointer to array containing output vector + mat = pointer to array containing input matrix in row order + v = pointer to array containing input vector + n = dimension of vectors (mat is n by n) + + ---------------------------------------------------------------- + +vnrm + + Compute the inner product of two real vectors, p = u~*v. + + double vnrm(double *u,double *v,int n) + u = pointer to array of input vector u + v = pointer to array of input vector v + n = dimension (dim(u)=dim(v)=n) + return value: p = u~*v (dot product of u and v) + + ----------------------------------------------------- + +trnm + + Transpose a real square matrix in place A -> A~. + + void trnm(double *a,int n) + a = pointer to array of n by n input matrix A + This is overloaded by the transpose of A. + n = dimension (dim(a)=n*n) + + --------------------------------------------------------- + +mattr + + Transpose an m by n matrix A = B~. + + void mattr(double *a,double *b,int m,int n) + a = pointer to array containing output n by m matrix + b = pointer to array containing input m by n matrix + (matrices stored in row order) + m,n = dimension parameters (dim(a)=dim(b)=n*m) + + ------------------------------------------------------------ + +otrma + + Perform an orthogonal similarity transform C = A*B*A~. + + void otrma(double *c,double *a,double *b,int n) + c = pointer to array of output matrix C + a = pointer to array of transformation A + b = pointer to array of input matrix B + n = dimension (dim(a)=dim(b)=dim(c)=n*n) + + ----------------------------------------------------------- + +otrsm + + Perform a similarity transform on a symmetric matrix S = A*B*A~. + + void otrsm(double *sm,double *a,double *b,int n) + sm = pointer to array of output matrix S + a = pointer to array of transformation matrix A + b = pointer to array of symmetric input matrix B + n = dimension (dim(a)=dim(b)=dim(sm)=n*n) + + --------------------------------------------------------------- + +smgen + + Construct a symmetric matrix from specified eigenvalues and + eigenvectors. + + void smgen(double *a,double *eval,double *evec,int n) + a = pointer to array containing output matrix + eval = pointer to array containing the n eigenvalues + evec = pointer to array containing eigenvectors + (n by n with kth column the vector corresponding + to the kth eigenvalue) + n = system dimension + + If D is the diagonal matrix of eigenvalues + and E[i,j] = evec[j+n*i] , then A = E*D*E~. + + ---------------------------------------------------------------- + +ortho + + Generate a general orthogonal transformation matrix, E~*E = I. + + void ortho(double *e,int n) + e = pointer to array of orthogonal output matrix E + n = dimension of vector space (dim(e)=n*n) + + This function calls on the uniform random generator 'unfl' to + produce random rotation angles. Therefore this random generator + should be initialized by a call of 'setunfl' before calling + ortho (see Chapter 7). + + ----------------------------------------------------------------- + +mcopy + + Copy an array a = b. + + void mcopy(double *a,double *b,int n) + a = array containing output values, identical to input + b at exit + b = input array + n = dimension of arrays + + ----------------------------------------------------------- + +matprt + + Print an array in n rows of m columns to stdout. + + void matprt(double *a,int n,int m,char *fmt) + a = pointer to input array stored in row order (size = n*m) + n = number of output rows + m = number of output columns + fmt= pointer to character array containing format string + (printf formats eg. " %f") + + Long rows may overflow the print line. + + --------------------------------------------------------------- + +fmatprt + + Print formatted array output to a file. + + void fmatprt(FILE *fp,double *a,int n,int m,char *fmt) + fp = pointer to file opened for writing + a = pointer to input array stored in row order (size = n*m) + n = number of output rows + m = number of output columns + fmt= pounter to character array containing format string + (printf formats eg. " %f") + +------------------------------------------------------------------------------ + + Singular Value Decomposition: +------------------------------------------------------------------------------ + + A number of versions of the Singular Value Decomposition (SVD) + are implemented in the library. They support the efficient + computation of this important factorization for a real m by n + matrix A. The general form of the SVD is + + A = U*S*V~ with S = | D | + | 0 | + + where U is an m by m orthogonal matrix, V is an n by n orthogonal matrix, + D is the n by n diagonal matrix of singular value, and S is the singular + m by n matrix produced by the transformation. + + The singular values computed by these functions provide important + information on the rank of the matrix A, and on several matrix + norms of A. The number of non-zero singular values d[i] in D + equal to the rank of A. The two norm of A is + + ||A|| = max(d[i]) , and the condition number is + + k(A) = max(d[i])/min(d[i]) . + + The Frobenius norm of the matrix A is + + Fn(A) = Sum(i=0 to n-1) d[i]^2 . + + Singular values consistent with zero are easily recognized, since + the decomposition algorithms have excellent numerical stability. + The value of a 'zero' d[i] is no larger than a few times the + computational rounding error e. + + The matrix U1 is formed from the first n orthonormal column vectors + of U. U1[i,j] = U[i,j] for i = 1 to m and j = 1 to n. A singular + value decomposition of A can also be expressed in terms of the m by\ + n matrix U1, with + + A = U1*D*V~ . + + SVD functions with three forms of output are provided. The first + form computes only the singular values, while the second computes + the singular values and the U and V orthogonal transformation + matrices. The third form of output computes singular values, the + V matrix, and saves space by overloading the input array with + the U1 matrix. + + Two forms of decomposition algorithm are available for each of the + three output types. One is computationally efficient when m ~ n. + The second, distinguished by the prefix 'sv2' in the function name, + employs a two stage Householder reduction to accelerate computation + when m substantially exceeds n. Use of functions of the second form + is recommended for m > 2n. + + Singular value output from each of the six SVD functions satisfies + + d[i] >= 0 for i = 0 to n-1. +------------------------------------------------------------------------------- + +svdval + + Compute the singular values of a real m by n matrix A. + + int svdval(double *d,double *a,int m,int n) + d = pointer to double array of dimension n + (output = singular values of A) + a = pointer to store of the m by n input matrix A + (A is altered by the computation) + m = number of rows in A + n = number of columns in A (m>=n required) + return value: status flag with: + 0 -> success + -1 -> input error m < n + + ------------------------------------------------------------ + +sv2val + + Compute singular values when m >> n. + + int sv2val(double *d,double *a,int m,int n) + d = pointer to double array of dimension n + (output = singular values of A) + a = pointer to store of the m by n input matrix A + (A is altered by the computation) + m = number of rows in A + n = number of columns in A (m>=n required) + return value: status flag with: + 0 -> success + -1 -> input error m < n + -------------------------------------------------------------- + +svduv + + Compute the singular value transformation S = U~*A*V. + + int svduv(double *d,double *a,double *u,int m,double *v,int n) + d = pointer to double array of dimension n + (output = singular values of A) + a = pointer to store of the m by n input matrix A + (A is altered by the computation) + u = pointer to store for m by m orthogonal matrix U + v = pointer to store for n by n orthogonal matrix V + m = number of rows in A + n = number of columns in A (m>=n required) + return value: status flag with: + 0 -> success + -1 -> input error m < n + + -------------------------------------------------------------------- + +sv2uv + + Compute the singular value transformation when m >> n. + + int sv2uv(double *d,double *a,double *u,int m,double *v,int n) + d = pointer to double array of dimension n + (output = singular values of A) + a = pointer to store of the m by n input matrix A + (A is altered by the computation) + u = pointer to store for m by m orthogonal matrix U + v = pointer to store for n by n orthogonal matrix V + m = number of rows in A + n = number of columns in A (m>=n required) + return value: status flag with: + 0 -> success + -1 -> input error m < n + + ---------------------------------------------------------------- + +svdu1v + + Compute the singular value transformation with A overloaded by + the partial U-matrix. + + int svdu1v(double *d,double *a,int m,double *v,int n) + d = pointer to double array of dimension n + (output = singular values of A) + a = pointer to store of the m by n input matrix A + (At output a is overloaded by the matrix U1 + whose n columns are orthogonal vectors equal to + the first n columns of U.) + v = pointer to store for n by n orthogonal matrix V + m = number of rows in A + n = number of columns in A (m>=n required) + return value: status flag with: + 0 -> success + -1 -> input error m < n + + ------------------------------------------------------------------ + +sv2u1v + + Compute the singular value transformation with partial U + matrix U1 efficiently for m >> n. + + #include + int sv2u1v(d,a,m,v,n) + double *d,*a,*v; int m,n; + d = pointer to double array of dimension n + (output = singular values of A) + a = pointer to store of the m by n input matrix A + (At output a is overloaded by the matrix U1 + whose n columns are orthogonal vectors equal to + the first n columns of U.) + v = pointer to store for n by n orthogonal matrix V + m = number of rows in A + n = number of columns in A (m>=n required) + return value: status flag with: + 0 -> success + -1 -> input error m < n + +------------------------------------------------------------------------------- + Auxiliary Functions used in SVD Computation: +------------------------------------------------------------------------------- + + The following routines are used by the singular value decomposition + functions. They are not normally called by the user. + +qrbdi + + Perform a QR reduction of a bidiagonal matrix. + + int qrbdi(double *d,double *e,int m) + d = pointer to n-dimensional array of diagonal values + (overloaded by diagonal elements of reduced matrix) + e = pointer to store of superdiagonal values (loaded in + first m-1 elements of the array). Values are altered + by the computation. + m = dimension of the d and e arrays + return value: N = number of QR iterations required + + ------------------------------------------------------------- + +qrbdv + + Perform a QR reduction of a bidiagonal matrix and update the + the orthogonal transformation matrices U and V. + + int qrbdv(double *d,double *e,double *u,int m,double *v,int n) + d = pointer to n-dimensional array of diagonal values + (overloaded by diagonal elements of reduced matrix) + e = pointer to store of superdiagonal values (loaded in + first m-1 elements of the array). Values are altered + by the computation. + u = pointer to store of m by m orthogonal matrix U updated + by the computation + v = pointer to store of n by n orthogonal matrix V updated + by the computation + m = dimension parameter of the U matrix + n = size of the d and e arrays and the number of rows and + columns in the V matrix + return value: N = number of QR iterations required + + --------------------------------------------------------------- + +qrbd1 + + Perform a QR reduction of a bidiagonal matrix and update the + transformation matrices U1 and V. + + int qrbdu1(double *d,double *e,double *u1,int m,double *v,int n) + d = pointer to n-dimensional array of diagonal values + (overloaded by diagonal elements of reduced matrix) + e = pointer to store of superdiagonal values (loaded in + first m-1 elements of the array). Values are altered + by the computation. + u1 = pointer to store of m by n transformation matrix U1 + updated by the computation + v = pointer to store of n by n orthogonal matrix V updated + by the computation + m = number of rows in the U1 matrix + n = size of the d and e arrays, number of columns in the U1 + matrix, and the number of rows and columns in the V matrix. + return value: N = number of QR iterations required + + ------------------------------------------------------------------ + +ldumat + + Compute a left Householder transform matrix U from the vectors + specifying the Householder reflections. + + void ldumat(double *a,double *u,int m,int n) + a = pointer to store of m by n input matrix A. Elements + of A on and below the main diagonal specify the + vectors of n Householder reflections (see note below). + u = pointer to store for the m by m orthogonal output + matrix U. + m = number of rows in A and U, and number of columns in U. + n = number of columns in A + + -------------------------------------------------------------- + +ldvmat + + Compute a right Householder transform matrix from the vectors + specifying the Householder reflections. + + void ldvmat(double *a,double *v,int n) + a = pointer to store of n by n input matrix A. Elements + of A on and above the superdiagonal specify vectors + of a sequence of Householder reflections (see note below). + v = pointer to store for the n by n orthogonal output + matrix V + n = number of rows and columns in A and V + + ----------------------------------------------------------------- + +atou1 + + Overload a Householder left-factored matrix A with the first + n columns of the Householder orthogonal matrix. + + void atou1(double *a,int m,int n) + a = pointer to store of m by n input matrix A. Elements + of A on and below the main diagonal specify the + vectors of n Householder reflections (see note below). + This array is overloaded by the first n columns of the + Householder transformation matrix. + m = number of rows in A + n = number of columns in A + + --------------------------------------------------------------- + +atovm + + Overload a Householder right-factored square matrix A with the + Householder transformation matrix V. + + void atovm(double *v,int n) + v = pointer to store for the n by n orthogonal + output matrix V + n = number of rows and columns in V + +------------------------------------------------------------------------------- + + Individual Householder reflections are specified by a vector h. + The corresponding orthogonal reflection matrix is given by + + H = I - c* h~ . + + Input matrices store the vector, normalized to have its leading + coefficient equal to one, and the normalization factor + + c = 2/(h~*h) . + + Storage for the vectors is by column starting at the diagonal for + a left transform, and by row starting at the superdiagonal for a + right transform. The first location holds c followed by + components 2 to k of the vector. + + +------------------------------------------------------------------------------- + Complex Linear Algebra +------------------------------------------------------------------------------- + + Solution and Inverse: +------------------------------------------------------------------------------- + +csolv + + Solve a complex linear system A*x = b. + + int csolv(Cpx *a,Cpx *b,int n) + a = pointer to array of n by n system matrix A + The computation alters this array to a LU factorization. + b = pointer to input array of system vector b + This is replaced by the solution vector b -> x. + n = dimension of system (dim(a)=n*n, dim(b)=n) + return value: status flag with: 0 -> valid solution + 1 -> system singular + + --------------------------------------------------------------- + +cminv + + Invert a general complex matrix in place A -> Inv(A). + + int cminv(Cpx *a,int n) + a = pointer to input array of complex n by n matrix A + The computation replaces A by its inverse. + n = dimension of system (dim(a)=n*n) + return value: status flag with: 0 -> valid solution + 1 -> system singular + +------------------------------------------------------------------------------ + + Hermitian Eigensystems: +------------------------------------------------------------------------------ + +heigval + + Compute the eigenvalues of a Hermitian matrix. + + void heigval(Cpx *a,double *ev,int n) + a = pointer to array for the Hermitian matrix H + These values are altered by the computation. + ev = pointer to array that is loaded with the + eigenvalues of H by the computation + n = dimension (dim(a)=n*n, dim(ev)=n) + + -------------------------------------------------------- + +heigvec + + Compute the eigenvalues and eigenvectors of a Hermitian + matrix. + + void heigvec(Cpx *a,double *ev,int n) + a = pointer to array for the hermitian matrix H + This array is loaded with a unitary matrix of + eigenvectors E by the computation. + ev = pointer to array that is loaded with the + eigenvalues of H by the computation + n = dimension (dim(a)=n*n, dim(ev)=n) + + The eigen vector matrix output E satisfies + + E^*E = I and A = E*D*E^ + + where D[i,j] = ev[i] for i=j and 0 otherwise + and E^ is the Hermitian conjugate of E. + The columns of E are the eigenvectors of A. + + ---------------------------------------------------------- + +hevmax + + Compute the eigenvalue of maximum absolute value and + the corresponding eigenvector of a Hermitian matrix. + + double hevmax(Cpx *a,Cpx *u,int n) + Cpx *a,*u; int n; + a = pointer to array for the Hermitian matrix H + u = pointer to array for the eigenvector umax + n = dimension (dim(a)=n*n, dim(u)=n) + return value: emax = eigenvalue of H with largest + absolute value + + The eigenvector u and eigenvalue emax are related by u^*A*u = emax. + +------------------------------------------------------------------------------ + Hermitian Eigensystem Auxiliaries: +------------------------------------------------------------------------------ + + The following routines are called by the Hermitian eigensystem + functions. They are not normally called by the user. + +chouse + + Transform a Hermitian matrix H to real symmetric tridiagonal + form. + + void chouse(Cpx *a,double *d,double *dp,int n) + a = pointer to input array of complex matrix elements of H + This array is altered by the computation + d = pointer to output array of real diagonal elements + dp = pointer to output array of real superdiagonal elements + n = system dimension, with: + dim(a) = n * n, dim(d) = dim(dn) = n; + + ----------------------------------------------------------------- + +chousv + + Transform a Hermitian matrix H to real symmetric tridiagonal + form, and compute the unitary matrix of this transformation. + + void chousv(Cpx *a,double *d,double *dp,int n) + a = pointer to input array of complex matrix elements of H + The computation replaces this with the unitary matrix + U of the transformation. + d = pointer to output array of real diagonal elements + dp = pointer to output array of real superdiagonal elements + n = system dimension, with: + dim(a) = n*n, dim(d) = dim(dn) = n; + + The matrix U satisfies + + A = U^*T*U where T is real and tridiagonal, + with T[i,i+1] = T[i+1,i] = dp[i] and T[i,i] = d[i]. + + ------------------------------------------------------------ + +qrecvc + + Use QR transformations to reduce a real symmetric tridiagonal + matrix to diagonal form, and update a unitary transformation + matrix. + + void qrecvc(double *ev,Cpx *evec,double *dp,int n) + ev = pointer to input array of diagonal elements + The computation transforms these to eigenvalues + of the input matrix. + evec = pointer to input array of a unitary transformation + matrix U. The computation applies the QR rotations + to this matrix. + dp = pointer to input array of elements neighboring the + diagonal. These values are altered by the computation. + n = dimension parameter (dim(ev)=dim(dp)=n, dim(evec)=n*n) + + This function operates on the output of 'chousv'. + +------------------------------------------------------------------------------- + + Complex Matrix Utilities: +------------------------------------------------------------------------------- + +cvmul + + Transform a complex vector u = A*v. + + void cvmul(Cpx *u,Cpx *a,Cpx *v,int n) + u = pointer to array of output vector u. + a = pointer to array of transform matrix A. + v = pointer to array of input vector v. + n = dimension (dim(u)=dim(v)=n, dim(a)=n*n) + + ----------------------------------------------------------- + +cvnrm + + Compute a Hermitian inner product s = u^*v. + + Cpx cvnrm(Cpx *u,Cpx *v,int n) + u = pointer to array of first vector u + v = pointer to array of second vector v + n = dimension (dim(u)=dim(v)=n) + return value: s = complex value of inner product + + ----------------------------------------------------------- + +cmmul + + Multiply two square complex matrices C = A * B. + + void cmmul(Cpx *c,Cpx *a,Cpx *b,int n) + a = pointer to input array of left matrix factor A + b = pointer to input array of right matrix factor B + c = pointer to array of output product matrix C + n = dimension parameter (dim(c)=dim(a)=dim(b)=n*n) + + ------------------------------------------------------------- + +cmmult + + Multiply two complex matrices C = A * B. + + void cmmult(Cpx *c,Cpx *a,Cpx *b,int n,int m,int l) + a = pointer to input array of right n by m factor matrix A + b = pointer to input array of left m by l factor matrix B + c = pointer to store for n by l output matrix C + n,m,l = system dimension parameters, with + (dim(c)=n*l, dim(a)=n*m, dim(b)=m*l) + + ---------------------------------------------------------------- + +hconj + + Compute the Hermitian conjugate in place, A -> A^. + + void hconj(Cpx *a,int n) + a = pointer to input array for the complex matrix A + This is converted to the Hermitian conjugate A^. + n = dimension (dim(a)=n*n) + + ---------------------------------------------------------- + +utrncm + + Perform a unitary similarity transformation C = T*B*T^. + + void utrncm(Cpx *cm,Cpx *a,Cpx *b,int n) + a = pointer to the array of the transform matrix T + b = pointer to the array of the input matrix B + cm = pointer to output array of the transformed matrix C + n = dimension (dim(cm)=dim(a)=dim(b)=n*n) + + --------------------------------------------------------------- + +utrnhm + + Perform a unitary similarity transformation on a Hermitian + matrix H' = T*H*T^. + + void utrnhm(Cpx *hm,Cpx *a,Cpx *b,int n) + a = pointer to the array of the transform matrix T + b = pointer to the array of the Hermitian input matrix H + hm = pointer to array containing Hermitian output matrix H' + n = dimension (dim(cm)=dim(a)=dim(b)=n*n) + + ----------------------------------------------------------------- + +trncm + + Transpose a complex square matrix in place A -> A~. + + void trncm(Cpx *a,int n) + a = pointer to array of n by n complex matrix A + The computation replaces A by its transpose + n = dimension (dim(a)=n*n) + + --------------------------------------------------------- + +cmattr + + Compute the transpose A = B~ of a complex m by n matrix. + + void cmattr(Cpx *a,Cpx *b,int m,int n) + a = pointer to output array of matrix A + b = pointer to input array of matrix B + m, n = matrix dimensions, with B m by n and A n by m + (dim(a)=dim(b)= m*n) + + ----------------------------------------------------------------- + +hmgen + + Generate a Hermitian matrix with specified eigen values and + eigenvectors. + + void hmgen(Cpx *h,double *ev,Cpx *u,int n) + h = pointer to complex array of output matrix H + ev = pointer to real array of input eigen values + u = pointer to complex array of unitary matrix U + n = dimension (dim(h)=dim(u)=n*n, dim(ev)=n) + + If D is a diagonal matrix with D[i,j] = ev[i] for i=j and 0 + otherwise. H = U*D*U^. The columns of U are eigenvectors. + + ----------------------------------------------------------------- + +unitary + + Generate a random unitary transformation U. + + void unitary(Cpx *u,int n) + u = pointer to complex output array for U + n = dimension (dim(u)=n*n) + + + This function calls on the uniform random generator 'unfl' to + produce random rotation angles. Therefore this random generator + should be initialized by a call of 'setunfl' before calling + 'unitary' (see Chapter 7). + + --------------------------------------------------------------------- + +cmcpy + + Copy a complex array A = B. + + void cmcpy(Cpx *a,Cpx *b,int n) + a = pointer to store for output array + b = pointer to store for input array + n = dimension of complex arrays A and B + + ----------------------------------------------------------- + +cmprt + + Print rows of a complex matrix in a specified format. + + void cmprt(Cpx *a,int m,int n,char *f) + a = pointer to array of complex m by n matrix + m = number of columns + n = number of rows + f = character array holding format for complex number + output (ie., "%f, %f ") + + Long rows may overflow the print line. diff --git a/manual/C02-intg b/manual/C02-intg new file mode 100644 index 0000000..3b4c47e --- /dev/null +++ b/manual/C02-intg @@ -0,0 +1,143 @@ + Chapter 2 + + NUMERICAL INTEGRATION + + Summary + + Numerical integration functions support the + evaluation of integrals and the numerical + solution of systems of differential equations. + Areas covered by these functions are: + + o Numerical Integrals + o Differential Equations + + + Notes on Contents + + The numerical integration functions are used to evaluate integrals and to + solve systems of ordinary differential equations. + + o Numerical Integrals: + + fintg -------- integrate a function over a definite interval. + chintg ------- compute a Tchebycheff expansion to evaluate an + integral as a function of its upper limit. + fchb --------- evaluate the Tchebycheff expansion generated by + chintg. + + o Differential Equations: + + deqsy -------- solve a system of first order differential + equations. + + + General Technical Comments + + The function 'fintg' uses an extrapolation technique to adjust step size. + The efficiency of this step size adjustment can be enhanced by dividing the + range of integration into a number of subregions and employing a separate + function call for each subregion. This technique is particularly important + when the integrand is singular at some points. The function chintg develops + a Tchebycheff series to evaluate the integral as a function of its upper + limit. This capability is useful when the function represented by the + integral must be evaluated at many points. + + The integration of a system of first order differential equations uses + the Bulirsch-Stoer technique combining a modified midpoint integration step + with repeated Richardson extrapolation. This yields highly accurate and + reliable solutions. Differential equations of higher order can readily be + represented as systems of first order equations. + + Functions in this library receive pointers to user defined functions, + with a specified set of call parameters. Use external variables to deliver + additional parameters to these integrand functions. + + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + Numerical Integrals: +------------------------------------------------------------------------------- + +fintg + + Compute the integral of func(x) over a definite interval. + + #include + double fintg(double a,double b,int n,double te,double (*func)()) + a = lower limit of integration + b = upper limit of integration + n = initial step number (step size = (b-a)/n) + te = convergence criteria threshold + ( te specifies the maximum relative correction + to the integral. ) + func = pointer to integrand evaluation function + ( called by: y = (*func)(x). ) + return value: I = value of integral + ( I = HUGE > convergence failure ) + + I = Intg(a to b){ func(x) dx } . + + ------------------------------------------------------------------ + +chintg + + Compute a Tchebycheff expansion supporting evaluation of an integral + as a function of its upper limit. + + #include + double chintg(double a[],int m,double (*func)()) + a = m+1 dimensional array of expansion coefficients + m = maximum degree of expansion + func = pointer to integrand evaluation function + ( called by: y = (*func)(x). ) + return value: h = maximum absolute value among last 3 coefficients + + The integral evaluation is given by: + + I(x) = Intg(y= -1 to x){ func(y)dy }= + Sum(i=0 to m){ a[i]*Ti(x) } . + + ---------------------------------------------------------------------- + +fchb + + Evaluate a Tchebycheff series, such as the chintg function's output. + + double fchb(double x,double a[],int m) + x = value of independent variable ( -1.0 <= x <= 1.0 ) + a = m+1 dimensional array of series coefficients + m = maximum degree of polynomial in the series + return value: S = value of the series + + S = Sum(i=0 to m){ a[i]*Ti(x)} , where Ti(x) is + the ith Tchebycheff polynomial. + +------------------------------------------------------------------------------- + + Differential Equations: +------------------------------------------------------------------------------- + +deqsy + + Solve a system of first order differential equations, + dy[k]/dx = f[k](x,y), using an extrapolation technique. + + int deqsy(double y[],int n,double a,double b,int nd,double te, \ + int (*fsys)()) + y = n-vector of system variables (dy[k]/dx = f[k](x,y)) + n = dimension of system + a = initial value of x + b = final value of x (solution target point) + nd = initial step number (step size = (b-a)/nd) + te = convergence criteria threshold + ( te is the maximum relative correction to the components + of y. ( |dr[k]| <= te*|y[k]| for all k ) + fsys = pointer to function which evaluates the derivatives + of system variables + ( (*fsys)(double x,double *y,double *dr) returns the + values of dy[k]/dx in the n dimensional array dr ) + return value: m = number of extrapolations + m<0 -> convergence failure diff --git a/manual/C03-geom b/manual/C03-geom new file mode 100644 index 0000000..b5c1bb8 --- /dev/null +++ b/manual/C03-geom @@ -0,0 +1,544 @@ + + Chapter 3 + + GEOMETRY and TRIGONOMETRY + + Summary + + + The geometry functions provide basic support for spatial + analysis in multiple dimensions. They are designed to be + effective in 3D graphics applications. The following + geometrical computations are covered: + + o Vector Operations + o Rotations + o Plane Trigonometry + o Spherical Trigonometry + o Hyperbolic Trigonometry + +----------------------------------------------------------------------------- + + Note on Contents + + The geometry and trigonometry functions in the library simplify many + elementary geometric computations. + + o Vector Operations: + + crossp ------- compute the cross-product of two 3-vectors. + dotp --------- compute the inner (dot) product of two vectors. + metpr -------- compute an inner product based on a metric matrix. + scalv -------- multiply a vector by a scalar. + trvec -------- translate a vector. + leng --------- compute the length of a vector or difference vector. + + Vector operations cover cross and scalar products as well as scaling + and translation operations. The dimensionality of the vector is restricted + only for the 3-dimensional cross-product. + + o Rotations: + + euler -------- rotate a set of 3-vectors using a rotation + specified by its Euler angles. + rotax -------- rotate a 3-vector about a specified axis. + + The function performing rotations about an axis has a mode in which + rotations through a fixed angular increment can be repeated efficiently. + This is useful in many 3D graphics applications. + + o Trigonometry: + + The trigonometry functions generate solutions for the unknown elements + of triangles and compute triangle areas. Functions are provided for + triangles in spaces with constant curvature zero (Euclidean), positive + (Spherical), and negative (Hyperbolic). + + Plane Trigonometry + + trgsas ------- solve a plane triangle given sas. + trgasa ------- solve a plane triangle given asa. + trgsss ------- solve a plane triangle given all sides (sss). + trgssa ------- solve for all feasible solutions given ssa. + trgarea ------ find the area of a plane triangle given its sides. + + Spherical Trigonometry + + strgsas ------ solve a spherical triangle given sas. + strgasa ------ solve a spherical triangle given asa. + strgsss ------ solve a spherical triangle given all sides (sss). + strgaaa ------ solve a spherical triangle given all angles (aaa). + strgarea ----- find the area of a spherical triangle given its + angles. + + Hyperbolic Trigonometry + + htgsas ------- solve a hyperbolic triangle given sas. + htgasa ------- solve a hyperbolic triangle given asa. + htgsss ------- solve a hyperbolic triangle given all sides (sss). + htgaaa ------- solve a hyperbolic triangle given all angles (aaa). + htgarea ------ find the area of a hyperbolic triangle given its + angles. + +------------------------------------------------------------------------------- + + General Technical Comments: + + Rotations + + Rotations may be parameterized either by a set of Euler angles or by the + axis and angle of rotation. The convention that positive rotations are right + handed (anticlockwise) is consistently adopted. In addition, the y-axis is + used as the rotation axis corresponding to the second Euler angle. These + conventions are widely adopted, but by no means universal. Thus, the user is + advised to identify the conventions employed, when an algorithm specified in + terms of rotations is used. + + Trigonometry + + Plane and spherical trigonometry have many well known applications, + including application to navigation problems. Spherical trigonometry can + also be applied to the composition of rotations in an intuitive geometric + fashion. Hyperbolic trigonometry is less common, but it has very + important applications in relativistic kinematics. The geometry of + velocities in special relativity is a three dimensional Lobachevsky space + of constant negative curvature. Thus, hyperbolic trigonometry is a natural + tool to use in analyzing transformations between inertial frames. + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + Vector Operations: +------------------------------------------------------------------------------- + +crossp + + Compute the cross product of two 3-vectors, h = u x v. + + void crossp(double *h,double *u,double *v) + h = pointer to array of output 3-vector + u = pointer to array of left factor 3-vector + v = pointer to array of left factor 3-vector + (the arrays have dimension 3 and components + are stored in [x,y,z] right handed order) + + ------------------------------------------------------------------ + +dotp + + Compute the dot product of two real vectors s = u~*v. + + double dotp(double *,double *v,int n) + u = pointer to array of vector u + v = pointer to array of vector v + n = dimension (dim(u)=dim(v)=n) + return value: s = u~*v. + + ------------------------------------------------------- + +metpr + + Compute the "metric" product s = u~*A*v of vectors u and v. + + double metpr(double *u,double *a,double *v,int n) + u = pointer to array of input vector u. + v = pointer to array of input vector v. + a = pointer to array of metric matrix A + n = dimension of vectors (dim(u)=dim(v)=n, dim(a)=n*n) + return value: s = u~*A*v. + + ------------------------------------------------------------ + +scalv + + Multiply all components of a vector v by a scalar s, v -> s*v. + + void scalv(double *v,double s,int n) + v = pointer to first component of vector (scaled in place, + with v' = s* v ) + s = isotropic scale factor + n = dimension of vector + + ----------------------------------------------------------------- + +trvec + + Compute a translated vector c = a + b. + + void trvec(double *c,double *a,double *b,int n) + c = pointer to first component of output vector + a = pointer to first component of vector-a + b = pointer to first component of vector-b + n = dimension of vectors + + ----------------------------------------------------------- + +leng + + Compute the length of a difference vector. + + #include + double leng(double *a,double *b,int n) + a = pointer to first component of vector-a + b = pointer to first component of vector-b + ( b=NULL -> vector-b has all components equal to zero ) + n = dimension of vectors + return value: d = length of difference vector |a - b| + +------------------------------------------------------------------------------- + + Rotations: +------------------------------------------------------------------------------- + +euler + + Rotate a set of vectors, using a rotation specified by Euler angles. + + void euler(double *pv,int m,double a,double b,double c) + pv = pointer to array containing a sequence of vector components + ( [x,y,z] order for each vector ) + m = number of vectors in array pv (dimension=3*m) + a,b,c = Euler angles of rotation R(a,b,c) about axes + z,y, and z. ( All angles in radians, with + positive angles -> anticlockwise rotations. ) + + ----------------------------------------------------------------- + +rotax + + Rotate a vector, using a rotation specified by axis and angle. + + void rotax(double *v,double az,double pa,double ang,int k) + v = pointer to array containing vector ( components in + [x,y,z] order, rotated in place ) + az = azimuthal angle of rotation axis + pa = polar angle of rotation axis + ang = angle of rotation + ( All angles in radians, with positive angles + -> anticlockwise rotations. ) + k = control flag, with: + k=0 -> compute rotation matrix from input angles + k>0 -> use rotation matrix computed at last k=0 call + + The k>0 mode is useful in creating a set of vectors to specify an + arc in three-dimensions. + +------------------------------------------------------------------------------- + Trigonometry: +------------------------------------------------------------------------------- + + Euclidean Plane Trigonometry: +------------------------------------------------------------------------------- + + Note: The angle inputs and outputs are assumed to be interior + angles of the triangles. The angular unit for input and + output is the radian. Ranges for sides and angles are: + + side > 0 ; and 0 < angle < pi . + + The solution of triangles with two sides and an angle + opposite to one of those sides given is potentially + ambiguous. Depending on the inputs, there may be two, + one, or no valid solutions. The function 'trgssa' + returns all valid solutions. + + ----------------------------------------------------------------- + +trgsas + + Find the remaining elements of a plane triangle given two sides + and the included angle. + + void trgsas(double a,double g,double b,double *ans) + a = side of triangle + g = angle of triangle between sides a and b (radians) + b = side of triangle + ans = pointer to three dimensional array to be loaded with + ans[0] = angle opposite side a (radians) + ans[1] = side opposite angle g + ans[2] = angle opposite side b (radians) + + -------------------------------------------------------------- + +trgasa + + Find the remaining elements of a plane triangle given two angles + and the included side. + + int trgasa(double a,double ss,double b,double *asn) + a = angle of triangle (radians) + ss = side of triangle between angles a and b + b = angle of triangle (radians) + asn = pointer to three dimensional array to be loaded with + asn[0] = side opposite angle a + asn[1] = angle opposite side ss (radians) + asn[2] = side opposite angle b + return value: input status flag with + 0 -> success + -1 -> inputs rejected (a or b < 0) + + -------------------------------------------------------------------- + +trgsss + + Find the angles of a plane triangle given its three sides. + + int trgsss(double a,double b,double c,double *ang) + double a,b,c,*ang; + a = side of triangle + b = side of triangle + c = side of triangle + ang = pointer to three dimensional array to be loaded with + ang[0] = angle opposite side a (radians) + ang[1] = angle opposite side b (radians) + ang[2] = angle opposite side c (radians) + return value: input status flag with + 0 -> success + -1 -> inputs rejected (sides violate + triangle inequality) + + ------------------------------------------------------------------ + +trgssa + + Find possible solutions for the remaining elements of a plane + triangle given two sides and an angle adjacent to only one side. + + int trgssa(double a,double b,double ba,double *an) + a = side of triangle + b = side of triangle + ba = angle of triangle opposite side b + an = pointer to six dimensional array to be loaded with + possible solutions + an[0] = third side of triangle (solution #1) + an[1] = angle of triangle opposite third side (radians) + an[2] = angle of triangle opposite side a (radians) + (solution #2) + an[3] = third side of triangle (solution #2) or 0 + an[4] = angle of triangle opposite third side (radians) + an[5] = angle of triangle opposite side a (radians) + return value: solution status flag with + 0 -> at least one solution + -1 -> no valid solutions + + Note: If only one valid solution exists, an[3]=an[4]=an[5]=0 + is return as the second solution. + + --------------------------------------------------------------- + +trgarea + + Find the area of a plane triangle given its three sides. + + double trgarea(double a,double b,double c) + a = side of triangle + b = side of triangle + c = side of triangle + return value: A = area of the plane triangle + +------------------------------------------------------------------------------- + + Spherical Trigonometry: +------------------------------------------------------------------------------- + + Note: The angle inputs and outputs are assumed to be interior + angles of the triangles. The angular unit for input and + output is the radian. Ranges for sides and angles are: + + 0 < side < pi ; and 0 < angle < pi or 0 > angle > -pi. + + Normally the angle inputs are assumed to be positive. + However, to permit use in applications where the + orientation of the triangle is significant, the + functions 'stgsas' and 'stgasa' can accept negative + angles as inputs provided that both angle inputs to + 'stgasa' have the same sign. This ensures that all + interior angles of the triangle will have identical + sign. Angle inputs to 'stgaaa' and 'stgarea' must be + positive. + + --------------------------------------------------------------------- + +stgsas + + Find the remaining elements of a spherical triangle given two sides + and the included angle. + + void stgsas(double a,double g,double b,double *ang) + a = side of the triangle (radians) + g = angle between sides a and b (radians) + b = side of triangle (radians) + ang = pointer to three dimensional array to be loaded with + ang[0] -> angle opposite side a (radians) + ang[1] -> side opposite angle g (radians) + ang[2] -> angle opposite side b (radians) + + ---------------------------------------------------------------- + +stgasa + + Find the remaining elements of a spherical triangle given two + angles and the included side. + + int stgasa(double a,double c,double b,double *ang) + a = angle of the triangle (radians) + c = side between angles a and b (radians) + b = angle of triangle (radians) + ang = pointer to three dimensional array to be loaded with + ang[0] -> side opposite angle a (radians) + ang[1] -> angle opposite side c (radians) + ang[2] -> side opposite angle b (radians) + return value: input status flag with + 0 -> success + -1 -> inputs rejected (angles have + opposite sign) + + ----------------------------------------------------------------- + +stgsss + + Find the angles of a spherical triangle given its three sides. + + int stgsss(double a,double b,double c,double *ang) + a = side of triangle (radians) + c = side of triangle (radians) + b = side of triangle (radians) + ang = pointer to three dimensional array to be loaded with + an[0] -> angle opposite side a (radians) + an[1] -> angle opposite side c (radians) + an[2] -> angle opposite side b (radians) + return value: input status flag with + 0 -> success + -1 -> inputs rejected (sides violate + triangle inequality) + + ------------------------------------------------------------- + +stgaaa + + Find the sides of a spherical triangle given its three angles. + + int stgaaa(double a,double b,double c,double *ang) + a = angle of triangle (radians > 0) + c = angle of triangle (radians > 0) + b = angle of triangle (radians > 0) + ang = pointer to three dimensional array to be loaded with + ang[0] -> side opposite angle a (radians) + ang[1] -> side opposite angle c (radians) + ang[2] -> side opposite angle b (radians) + return value: input status flag with + 0 -> success + -1 -> inputs rejected (angle sum <= pi) + + ---------------------------------------------------------------- + +stgarea + + Find the area of a spherical triangle given its three angles. + + double stgarea(double a,double b,double c) + a = angle of triangle (radians > 0) + b = angle of triangle (radians > 0) + c = angle of triangle (radians > 0) + return value: A = area of spherical triangle + + Note: Each spherical triangle has a dual triangle with sides + s and angles A related by + + s' = pi - A for sides and A' = pi - s for angles. + +------------------------------------------------------------------------------- + + Hyperbolic Trigonometry: +------------------------------------------------------------------------------- + + Note: The angle inputs and outputs are assumed to be interior + angles of the triangles. The angular unit for input and + output is the radian. Ranges for sides and angles are: + + side > 0 ; and 0 < angle < pi . + + ------------------------------------------------------------------- + +htgsas + + Solve for the remaining elements of a hyperbolic triangle given + two sides and the included angle. + + void htgsas(double a,double g,double b,double *an) + a = side of the triangle + g = angle between sides a and b (radians) + b = side of triangle + an = pointer to three dimensional array to be loaded with + an[0] -> angle opposite side a (radians) + an[1] -> side opposite angle g + an[2] -> angle opposite side b (radians) + + -------------------------------------------------------------- + +htgasa + + Solve for the remaining elements of a hyperbolic triangle given + two angles and the included side. + + int htgasa(double a,double cc,double b,double *ans) + a = angle of triangle (radians) + cc = side of triangle adjacent to angles a and b + b = angle of triangle (radians) + ans = pointer to three dimensional array to be loaded with + ans[0] -> side opposite angle a + ans[1] -> angle opposite side cc + ans[2] -> side opposite angle b + return value: input status flag with + 0 -> success + -1 -> input rejected (angle <0) + + ---------------------------------------------------------------- + +htgsss + + Solve for the angles of a hyperbolic triangle given its three angles. + + int htgsss(double a,double b,double c,double *ang) + a = side of triangle + b = side of triangle + c = side of triangle + ang = pointer to three dimensional array to be loaded with + ang[0] -> angle opposite side a + ang[1] -> angle opposite side b + ang[2] -> angle opposite side c + return value: input status flag with + 0 -> success + -1 -> inputs rejected (sides violate + triangle inequality) + + ------------------------------------------------------------- + +htgaaa + + Solve for the sides of a hyperbolic triangle given three angles. + + int htgaaa(double a,double b,double c,double *as) + a = angle of triangle (radians) + b = angle of triangle (radians) + c = angle of triangle (radians) + as = pointer to three dimensional array to be loaded with + as[0] -> side opposite angle a + as[1] -> side opposite angle b + as[2] -> side opposite angle c + return value: input status flag with + 0 -> success + -1 -> inputs rejected (angle sum >= pi) + + ----------------------------------------------------------------- + +htgarea + + Find the area of a hyperbolic triangle given three angles. + + double htgarea(double a,double b,double c) + a = angle of triangle (radians) + b = angle of triangle (radians) + c = angle of triangle (radians) + return value u = area of hyperbolic triangle diff --git a/manual/C04-cfit b/manual/C04-cfit new file mode 100644 index 0000000..5f5e16a --- /dev/null +++ b/manual/C04-cfit @@ -0,0 +1,872 @@ + + Chapter 4 + + CURVE FITTING and LEAST SQUARES + + Summary + + The curve fitting functions support a full + spectrum of techniques for fitting curves to + data. The areas covered are: + + o Rational Approximations + o Spline Curve Fits + o Least Square Fits + + Rational approximation functions use a + Tchebycheff Pade' method to obtain nearly optimal + approximations. Simple cubic and tensioned + splines are supported. The least square functions + estimate polynomial, general linear, and + nonlinear least square fits. + + + Notes on Contents + + This segment of the library covers methods for approximating functions + efficiently, computation of smooth spline approximation curves from a + discrete set of values, and a comprehensive set of least squares estimation + techniques. + + o Rational Approximations: + + The evaluation of elementary functions is typically implemented by using + an optimized rational approximation. + + chcof -------- compute Tchebycheff expansion coefficients. + chpade ------- compute a rational approximation. + ftch -------- evaluate a rational Tchebycheff approximation. + + The 'chpade' function fits a rational Tchebycheff Pade' approximation to + a specified function. This form is known to yield an approximation very + close to the optimal (ie. minimum error) rational approximation. Thus, it + provides a computationally efficient technique for generating function + values. + + o Spline Curve Fits: + + cspl -------- compute a cubic spline interpolation. + csplp ------- compute a cubic spline interpolation to a + periodic curve. + csfit ------- evaluate a cubic spline fit. + tnsfit ------ evaluate a "tensioned" spline fit. + dcspl ------- evaluate the derivatives of a cubic spline fit. + + Cubic splines are an excellent class of smooth interpolation functions. + These splines are continuous as are their first and second derivatives. + The library functions fit both open and closed or periodic curves. + Splines in tension can be substituted for cubic splines in cases where the + cubic spline interpolation introduces spurious oscillations in the fitted + curve. This technique is frequently useful in graphics applications such as + contour plotting. + + o Least Square Fits: + + Linear Least Squares + + qrlsq ------ linear least squares using QR reduction. + qrvar ------ compute the parameter variance matrix resulting + from a QR least squares solution. + lsqsv ------ perform a rank analysis on a singular value + decomposition of a linear least squares problem. + svdlsq ----- compute a SVD analysis of a linear least squares + system. + sv2lsq ----- compute SVD efficiently for measurements >> number + of parameters. + + The QR reduction is a numerically stable algorithm for computing a least + squares solution when the design matrix of the system is known to have full + rank. Singular value decomposition is the technique that should be applied + when this assumption of full rank breaks down. It provides the maximum + amount of information on the character of the system, and ensures a + reasonable solution in all cases. + + Polynomial Least Squares + + plsq ------ compute a least squares solution using orthogonal + polynomials. + pplsq ----- compute a least squares fit to a polynomial of + specified degree. + evpsq ----- evaluate the fit function of an orthogonal polynomial + fit. + evpsqv ---- evaluate the fit function and rms sigma of an + orthogonal polynomial fit. + psqcf ----- extract the polynomial coefficient vector of + specified degree from an orthogonal fit. + psqvar ---- compute the variance matrix of a polynomial + coefficient vector. + + The polynomial least square estimators are based on a numerically stable + approach. It returns a set of parameters that support fits + with polynomials of any degree up to the maximum specified. It also permits + computation of the parameter variance matrix and rms sigmas of fit functions, + in cases where this statistical data is desired. + + Nonlinear Least Squares + + seqlsq ------- perform a sequential iteration of least square + parameter estimation. + gnlsq -------- compute a batch Gauss-Newton least square fit from + specified initial parameter values. + fitval ------- evaluate the value and rms sigma of a nonlinear + least square fit function. + + The library supports a novel mix of sequential and batch mode (Gauss- + Newton) estimation of nonlinear least-square fits. The sequential fit is + highly effective in the initial parameter search phase of nonlinear least + squares estimation. A procedure that starts with a few sequential search + passes and refines the resulting estimate using the Gauss-Newton estimator, + is highly effective in nonlinear least square fits. + +------------------------------------------------------------------------------- + + General Technical Comments + + The availability of a nearly optimal rational approximation for function + evaluation is an important feature of the library. Efficient computation can + be based on the use of this approximation so that the code implemented for + initial evaluation can be biased towards accuracy and range of validity. + Use of this technique is recommended for any computationally intensive + application that requires frequent evaluations of a function. + + The main novelty in this segment is the implementation of a sequential + estimator for nonlinear least squares problems. Experience indicates that + this represents a powerful approach to searching parameter space in these + very difficult problems. The use of adaptive least squares techniques goes + back to Gauss, and it is also featured in the Kalman-Bucy filters employed + in modern control theory. Nonlinear estimation is yet another domain where + this approach is recommended. + +------------------------------------------------------------------------------ + FUNCTION SYNOPSES +------------------------------------------------------------------------------ + + Tchebycheff Polynomial Approximations: +------------------------------------------------------------------------------ + +chcof + + Compute the coefficients of a Tchebycheff expansion of the function + func(x). (These coefficients can be used as input to chpade.) + + chcof(double c[],int m,double (*func)()) + c = array containing m+1 values of computed coefficients + m = maximum degree of fit (polynomials 0 --- m used) + func = pointer to user supplied function + ( Range of (*func)(x) evaluation -1 <= x <= 1. ) + + The Tchebycheff expansion is given by + + f = c[0]/2 + Sum(i=1 to m) c[i]*Ti(x) , where + Ti(x) is the ith Tchebycheff polynomial. + + ----------------------------------------------------------- + +chpade + + Compute the coefficients of a rational Tchebycheff approximation. + + chpade(double c[],double a[],int m,double b[],int n) + c = array of dimension m+2*n+2 containing the coefficients of + a Tchebycheff series expansion of the function f + a = m+1 dimensional array of numerator coefficients + m = degree of numerator polynomial + b = n+1 dimensional array of denominator coefficients + ( b[0]=1.0 , by convention ) + n = degree of denominator polynomial + + + Here the input expansion gives + + f = c[0]/2 + Sum(i=1 to N) c[i]*Ti(x) , with N=m+2n+1. + + The output approximation to is: + + f = {Sum(i=0 to m) a[i]*Ti(x)}/{1+Sum(j=1 to m) b[i]Ti(x))} . + + ------------------------------------------------------------------- + +ftch + + Evaluate a rational Tchebycheff Pade approximation. + + double ftch(double x,double a[],int m,double b[],int n) + x = value of independent variable ( -1 <=x <= 1 ) + a = m+1 dimensional array of numerator coefficients + m = degree of numerator polynomial + b = n+1 dimensional array of denominator coefficients + n = degree of denominator polynomial + return value: f = rational approximation of f(x), with + + f = {Sum(i=0 to m) a[i]*Ti(x)}/{1+Sum(j=1 to m) b[i]Ti(x))} . + + +----------------------------------------------------------------------------- + Spline Curve Fits: +----------------------------------------------------------------------------- + +cspl + + Compute a cubic or tensioned spline fit to an open curve. + + cspl(double x[],double y[],double z[],int m,double tn) + x = array containing m+1 x-coordinates of the curve + y = array containing m+1 y-coordinates of the curve + z = output array of m+1 second derivatives + ( the boundary condition assumes z[0]=z[m]=0. ) + m = number of intervals (m+1 input points) + tn = tension parameter, with: + tn = 0. -> cubic spline + tn > 0. -> spline in tension + + ----------------------------------------------------------------- + +csplp + + Compute a cubic or tensioned spline approximation to a closed curve. + + csplp(double x[],double y[],double z[],int m,double tn) + x = array containing m+1 x-coordinates of the curve + y = array containing m+1 y-coordinates of the curve + z = output array of m+1 second derivatives + ( The boundary condition is periodic, with equal + first and second derivatives at x[0] and x[m]. ) + m = number of intervals (m+1 input points) + tn = tension parameter, with: + tn = 0. -> cubic spline + tn > 0. -> spline in tension + + --------------------------------------------------------------- + +csfit + + Evaluate a cubic spline curve at any interior point. + + double csfit(double w,double x[],double y[],double z[],int m) + w = value of the independent variable + x,y,z = m+1 dimensional arrays define a cubic spline + m = number of intervals + return value: cs(w) = cubic spline interpolation if x[0]<=w<=x[m] + ( 0.0 is returned for wx[m] ) + + This function is used to evaluate splines computed with tn=0.0. + + ------------------------------------------------------------------ + +dcspl + + Evaluate the derivative of a cubic spline fit at interior points. + + double dcspl(double x,double u[],double v[],double z[],int m) + x = value of the independent variable + u,v,z = m+1 dimensional arrays define a cubic spline + m = number of intervals + return value: dcs/dx = derivative of cubic spline + interpolation if u[0] <= x <=u[m] + ( 0.0 is returned for x < u[0] or x > u[m] ) + + -------------------------------------------------------------------- + +tnsfit + + Evaluate a tensioned spline curve at any interior point. + + double tnsfit(double w,double x[],double y[],double z[],int m,double tn) + w = value of independent variable + x,y,z = m+1 dimensional arrays of tensioned spline coefficients + m = number of intervals + tn = spline tension parameter (should match value tn > 0.0 used in + computing the spline parameters) + return value: tns(w) = value of tensioned spline interpolation + when x[0] <= w <= x[m] + ( 0.0 is returned if w < x[0] or w > x[m] ) + + + Increasing the tension parameter from tn=0 produces a sequence of + curve fits that varies continuously from the cubic spline (tn=0) + to a linear interpolation between anchor points (tn >> 1). + + +------------------------------------------------------------------------------ + + Linear Least Squares: +------------------------------------------------------------------------------ + +qrlsq + + Compute a linear least squares solution for A*x = b + using a QR reduction of the matrix A. + + double qrlsq(double *a,double *b,int m,int n,int *f) + a = pointer to m by n design matrix array A + This is altered to upper right triangular + form by the computation. + b = pointer to array of measurement values b + The first n components of b are overloaded + by the solution vector x. + m = number of measurements (dim(b)=m) + n = number of least squares parameters (dim(x)=n) + (dim(a)=m*n) + f = pointer to store of status flag, with + *f = 0 -> solution valid + *f = -1 -> rank of A < n (no solution) + return value: ssq = sum of squared fit residuals + + + The QR algorithm employs an orthogonal transformation to reduce + the matrix A to upper right triangular form, with + + A = Q*R and R = Q~*A . + + The matrix R has non-zero components confined to the range + 0 <= i <= j < n. The system vector b is transformed to + + b' = U~*b and Sum(k=j to n-1) R[j,k]*x[k] = b'*[j] + + is solved for x, using 'solvru' (see Chapter 1). The sum + of squared residuals is + + ssq = Sum(i=n to m-1){b~[i]^2} . + + ---------------------------------------------------------------- + +qrvar + + Compute the parameter variance matrix V for QR least squares. + + double qrvar(double *a,int m,int n,double ssq) + a = pointer to a-matrix output of qrlsq + Only the n by n upper right triangular portion R + is used. The first n rows are replaced by the + parameter variance matrix V. + m = number of measurements (m > n assumed) + n = number of parameters (dim(a)>=n*n) + ssq = sum of squared fit residuals + return value: s = ssq/(m-n), the estimated measurement + variance + + + The parameter variance matrix is computed by assuming that the + measurements are independent, with measurement variance + + sigsq = ssq/(m-n) and matrix V given by + V = sigsq*Inv(R~*R) , with R an upper right + triangular matrix whose non-zero elements are + equal to corresponding elements of the matrix A + output by qrlsq. + + -------------------------------------------------------------------- + + The singular value decomposition of the design matrix A can be + used to derive a least squares solution in cases where the QR + method breaks down because A does not have full rank. In this + sense, SVD is a sure-fire approach to linear least squares. + The method is based on the decomposition + + A = U*D*V~ , with U and V orthogonal matrices and + D an m by n matrix (m>=n) whose non-zero elements are + D[i,i]=d[i] for i=0 to n-1. + The resulting least squares solution for x is given by + + x = V*Inv(D)*U~*b for x[i] with i=0 to n-1. + + The function 'lsqsv' employs a threshold test to identify small + singular values that correspond to rank deficiency in the + design matrix. This threshold is specified as a user input. When + D[i,i] < th , the corresponding inverse element Inv(D)[i,i] + is replaced by zero, so that the ith measurement component + is not used in the solution. + ------------------------------------------------------------------ + +lsqsv + + Generate a SVD based solution for the linear least + squares system A*x = b. + + double lsqsv(double *x,int *pr,double *var,double *d,double *b, \ + double *v,int m,int n,double th) + x = pointer to array to be loaded with least squares + parameters x + pr = pointer to store for rank of system solution r + (r<=n, and if r normal exit + -1 -> input error m < n + + + This form of least squares SVD is designed for use when the number + of measurements m is comparable to the number of parameters n. + The quantities returned are the orthogonal matrix V, the modified + system vector b~, and the singular values d[i]. + + ------------------------------------------------------------------- + +sv2lsq + + Perform a singular value decomposition ot a linear least + squares system efficiently when m >> n. + + int sv2lsq(d,a,b,m,v,n) + + double *d,*a,*b,*v; int m,n; + d = pointer to array of computed singular values + a = pointer to array of design matrix A + This matrix is altered by the computation. + b = pointer to array of measurement values b + The computation replaces b by the vector b'=U~*b. + m = number of measurements (dim(b)=m) + n = number of fit parameters x (dim(d)=n,dim(a)=m*n) + return value: status flag 0 -> normal exit + -1 -> input error m < n + + + This algorithm is more efficient for SVD when m > (3/2)n, and + it should certainly be used in place of 'svdlsq' when m > 2n. + + + -------------------------------------------------------------------- + + Auxiliary function for linear least squares: + + Perform the QR part of the SVD least squares reduction. + (Called by both svdlsq and sv2lsq.) + + int qrbdbv(double *d,double *e,double *b,double *v,int n) + d = pointer to array of diagonal elements + The computation loads this array with + singular values. + e = pointer to array with superdiagonal elements + in the first n-1 positions. These values are altered. + b = pointer to array of system vector b + This vector is transformed by the QR rotations. + v = pointer to orthogonal transformation matrix V + This matrix is transformed by the QR rotations. + n = dimension (dim(d)=dim(e)=n,dim(v)=n*n,dim(b)>=n) + return value: N = number of QR iterations required + + +------------------------------------------------------------------------------- + + Polynomial Least Squares: +------------------------------------------------------------------------------- + + + Polynomial fits are one of the most common forms of least squares + analysis. A comprehensive set of functions, based on developing a set + of polynomials orthogonal on the set of measurements, is provided to + support this form of analysis. + + + The orthogonal polynomials op(x) satisfy the orthogonality relation + Sum(i=0 to n-1){opj(x[i])*opk(x[i])} = h[k] if j=k and 0 otherwise. + + Orthogonal polynomials are computed using the recurrence + + op{k+1}(x) = (x - f[k]*)opk(x)-(h[k]/h[k-1])*op{k-1}(x) , + + where op{-1} = 0 and op0 =1. The coefficients are determined by + + h[k] = Sum(i=0 to n-1){(opk(x[i]))^2} and + + f[k] = Sum(i=0 to n-1){x[i]*opk(x[i])^2} . + + The fit residuals e[i] are given by + + e[i] = y[i] - Sum(i=0 to m-1) c[k]*opk(x[i]) + + for a fit of degree n in x. The sum of squared residuals + + ssq = Sum(i=0 to n-1) e[i]^2 + + provides a measure of the fit, and can be used to estimate measurement + variance in cases where this statistic makes sense. The variance matrix + for the coefficients c[k] of the least squares polynomials takes the + form + + var(c[j]) = ssq/(h[j]*(n-m-1)) + + for an orthogonal polynomial fit of degree m. + + ------------------------------------------------------------------------ + +plsq + + Compute a polynomial least squares fits to data, using + polynomials orthogonal on the x-values. + + plsq(double *x,double *y,int n,Opol *cf,double *ssq,int m) + x = pointer to array of x-values + y = pointer to array of measurements converted to + array of fit residuals by the computation + n = number of measurements (dim(x)=dim(y)= n) + cf = pointer to array of structures specifying the + orthogonal polynomials + ssq = pointer to array of squared residuals for + fits of order 1 to m + m = maximum order of fit desired (dim(cf)=dim(ssq)=m) + (Fits with polynomials of degree 0 to m-1 are + computed by this function.) + + + The structure Opol is defined in the header file ccmath.h by the + following line. + + typedef struct orpol {double cf,hs,df;} Opol; + + This structure holds the coefficient of the polynomial in the + least squares fit, and the recurrence coefficients needed to + generate the polynomial. + + cf[k].cf = c[k], cf[k].hs = h[k], and cf[k].df = f[k] . + + The least squares fit for a polynomial of degree m is given by + the expansion + + fit_n(x) = Sum(k=0 to n){c[k]*opk(x)} + + for n = 0,1, - - ,m-1 . + + -------------------------------------------------------------------- + +pplsq + + Compute a least squares fit to a polynomial of degree m-1. + + double pplsq(double *x,double *y,int n,double *bc,int m) + x = pointer to array of x-values of measurements + y = pointer to array of measurements converted to + array of fit residuals by the computation + n = number of measurements (dim(x)=dim(y)= n) + bc = pointer to vector of polynomial coefficients + m = order of fit (dim(bc)= m) + (The fit polynomial is of degree m-1 in x.) + + + This function is used in cases where the fit is to be made + with a polynomial of known degree, and the output is to + be expressed in terms of coefficients of powers of x. + + fit(x) = Sum(i=0 to m-1) bc[i]*x^i . + + --------------------------------------------------------------- + +evpsq + + Evaluate a computed least squares polynomial fit function. + + double evpsq(double x,Opol *c,int m) + x = argument where fit function is to be evaluated + c = array of orthogonal polynomial coefficient structures + m = order of fit (dim(c)=m) + return value: y = fit(x) + + + The fit functions generated by a call of 'plsq' are evaluated + by this function, with + + fit(x) = Sum(i=0 to m-1) c[k]*opk(x) . + + --------------------------------------------------------------- + +evpsqv + + Evaluate a least squares polynomial fit function and + compute the standard deviation of the fit. + + double evpsqv(double x,Opol *c,int m,double *v,double sig) + x = argument where fit function is to be evaluated + c = array of orthogonal polynomial coefficient structures + sig = estimate of sigma squared for the measurements + v = pointer to store for rms sigma of returned value + ( y = fit(x) , v ) + m = order of fit (dim(c)=m) + return value: y = fit(x) + + + The input sig is an estimate of the variance of individual + measurements, based on the sum of squared fit residuals. + + sig = ssq(m)/(n-m-1) . + + The accuracy of the fit at a point is expressed as + + y(x) = fit(x) +- *v , with *v the one sigma rms variance. + + ---------------------------------------------------------------- + +psqcf + + Compute the polynomial coefficient vector for a fit + by a polynomial of degree m-1. + + psqcf(double *b,Opol *c,int m) + b = pointer to array for polynomial coefficient output + c = pointer to array of structures specifying the + polynomials orthogonal on x-values + m = order of fit (dim(cf)=dim(b)=m) + + This function expresses a fit obtained with 'plsq' in terms + of the coefficients of powers of x, with + + fit[m-1](x) = Sum(i=0 to m-1) b[i]*x^i . + + ---------------------------------------------------------------- + +psqvar + + Compute the variance matrix of the polynomial coefficients. + + psqvar(double *v,double sig,Opol *c,int m) + v = pointer to array for variance matrix output + sig = estimate of sigma squared for the measurements + c = pointer to array of structures specifying the + orthogonal polynomials + m = order of fit (dim(c)= m, dim(v)=m*m) + + + This function extracts the variance matrix of the coefficients + of powers of x from a least squares fit computed by 'plsq'. + The input sig is an estimated measurement variance + + sig = ssq(m)/(n-m-1) and the variance matrix V = b*b~ , + + where the components of the the vector b are computed by 'psqcf'. + +------------------------------------------------------------------------------- + + Nonlinear Least Squares: +------------------------------------------------------------------------------- + + + The basic problem encountered in nonlinear least squares is to minimize + + ssq = Sum(i=0 to n-1){y[i] - f(x[i],b[1] - b[m])}^2 , + + where the fit function f is not linear in the parameters b[k]. The range of + possible nonlinear functions is so large that a completely general solution + to this problem is unlikely. Nevertheless, experience with a combination + of sequential and batch estimation steps indicates that this approach is + suitable and efficient for a wide range of nonlinear estimation problems. + + The sequential method is one that was originally applied by Gauss to + the reduction of astronomical orbit data. Each measurement in a sequence is + used to update the current parameter estimate. These updates employ a + linearization of the nonlinear system about the current parameter estimate + and an error term of the form + + e[i] = y[i] - f(x[i],B'[i-1]) , + + where B'[i-1] is the parameter vector estimated at the previous update. + This algorithm is very effective in searching parameter space for a + parameter vector near the minimum of ssq. + +------------------------------------------------------------------------------- + +seqlsq + + Perform a sequential iteration of a least square fit to the function + y=(*func)(x,par). + + double seqlsq(double x[],double y[],int n,double par[],double var[],\ + int m,double de,double (*func)(),int kf) + x = n dimensional array of independent variables + y = n dimensional array of dependent variables + n = number of points fitted + m = dimension of parameter vector + par = m-vector of fit function parameters + (The input values represent an initial estimate.) + var = array containing the m by m matrix proportional to the + parameter variance matrix (constant of proportionality + = ssq/(n-m) ) + de = interval for derivative computation (dfunc/dpar) + func = pointer to the fit function (y=(*func)(x,par) ) + kf = control flag, with: + kf=0 -> initialize var as a unit matrix + kf>0 -> accept input values of var matrix + return value: ssq = sum of squares at fit points + + + This function can be used, in conjunction with the Gauss-Newton + estimator gnlsq, to estimate nonlinear least square fits. + Sequential iterations are effective in the initial search stage. + + The parameter vector estimate is updated for each measurement y[i] + in sequence, + + ssq = Sum(i=0 to n-1) (y[i] - f(x[i],par))^2 + + should be interpreted with this sequential variation of par in mind. + + Iterations of this function are used to search parameter space. + Normally the output of an iteration is employed as the input to + the next estimation stage. Several other options are outlined + below. Termination of a sequence of sequential estimation passes + should be based on the statistical significance of the decrease in + ssq in successive passes. + + Input options: + 1) The use of a unit matrix for initializing var is usually + acceptable. + 2) Parameter scale differences in components of par can be + addressed by using an initial pass through the Gauss_Newton + estimator to obtain an input var. + 3) The output matrix var can be multiplied by a scale factor, + with s >1 between iterations. This is used to avoid a search + with variance too 'stiff' to support significant changes + in the parameter vector. + + Numerical derivatives of the fit function with respect to the + parameters are used. The interval used to compute these derivatives + should be selected to ensure that + + (f(x,par'')-f(x,par'))/de , with de = par''[i]-par'[i] + + yields an effective approximation to the partial derivative. This + also applies to the function 'gnlsq'. + + ---------------------------------------------------------------------- + + The Gauss-Newton least squares estimator employs a batch process to + estimate a parameter vector, with the linearization performed at the + input point for each measurement. This estimator converges quite well when + the starting point in parameter space is fairly close to a minimum. Thus, + it can be used effectively in the final iterations of a nonlinear fit. + The output of the previous sequential or batch pass is used as input to + 'gnlsq'. + + +gnlsq + + Perform a Gauss-Newton iteration of a least square fit to the + function y=(*func)(x,par). + + double gnlsq(double x[],double y[],int n,double par[],double var[],\ + int m,double de,double (*func)()) + x = n dimensional array of independent variables + y = n dimensional array of dependent variables + n = number of points fitted + m = dimension of parameter vector + par = m-vector of fit function parameters + (The input values represent an initial estimate.) + var = array containing the m by m matrix proportional to the + parameter variance matrix (constant of proportionality + = ssq/(n-m) ) + de = interval for derivative computation (dfunc/dpar) + func = pointer to the fit function (y=(*func)(x,par) ) + return value: ssq = sum of squares at fit points + ssq > 0. -> normal exit + ssq = -1.0 -> singular matrix var detected + (ie. an input error) + + + A single iteration of this function can be used for well-posed + linear least square estimates, where it is equivalent to the + use of the normal equation method. In nonlinear problems it is + most effective in the final iterations, however, an initial + iteration is sometimes used to determine the relative scaling of + the variance matrix. + + The sum of squared residuals is given by + + ssq = Sum(i=0 to n-1) (y[i] - f(x[i],par))^2 , + + where the initial input parameter vector par is used at each + step. The estimated measurement variance, based on this sum, is + + sigsq = ssq/(n-m). + + This value should be used to scale the final variance matrix output + var when the statistical uncertainty in parameter estimates is of + interest. + + Termination of a sequence of Gauss-Newton iterations is best + based on the magnitude of changes in the estimated parameter + vector from pass to pass. + + ---------------------------------------------------------------- + +fitval + + Evaluate the value and rms sigma of a general least square fit at x. + + double fitval(double x,double *s,double *par,double (*fun)(),\ + double *v,int n) + x = value of independent variable + s = pointer to store for computed fit's rms sigma at x + par = pointer to estimated fit parameter vector + fun = pointer to fit function (y=(*fun)(x,par)) + v = pointer to estimated fit variance matrix + n = dimension of parameter vector + return value: f(x,par) = value of the estimated fit function at x + + + The variance matrix input to fitval must be scaled by the + estimated s2 of the fit so that a valid rms sigma can + returned in *s. + + y = f(x,par) +- *s . + + +setfval + + Allocate/free the storage required by fitval. + + void setfval(int i,int n) + int i,n; + i = control flag, with i=0 -> allocate internal storage + i=1 -> free storage + n = dimension of fit parameter vector + + + The function 'setfval' must be called with i=0 before any + calls to 'fitval' are made. diff --git a/manual/C05-roots b/manual/C05-roots new file mode 100644 index 0000000..8ac09a1 --- /dev/null +++ b/manual/C05-roots @@ -0,0 +1,207 @@ + Chapter 5 + + ROOTS and OPTIMA + + Summary + + The functions in this library segment are used to + find the roots of nonlinear equations and systems + of such equations and to locate local extrema of + functions. The areas covered are: + + o Roots of Equations + o Optimization + +------------------------------------------------------------------------------- + + Notes on Contents + + Functions in this section of the library are used to extract the roots of + nonlinear equations and to find local optima. + + o Roots of Equations: + + solnl -------- solve a system of nonlinear equations. + solnlx ------- solve a nonlinear system using an initial + Jacobian. + secrt -------- solve a nonlinear equation using the secant + method. + plrt --------- find the roots (real and complex) of a polynomial. + polyc -------- evaluate a polynomial for complex arguments. + + + o Optimization: + + optmiz ------- perform an unconstrained search for the + optimal parameter vector. + optsh -------- perform a golden section search for optima in + one dimension. + +------------------------------------------------------------------------------- + + General Technical Comments + + The general root finding functions employ a matrix update algorithm + developed by Broyden. The second form offers an enlarged domain of + convergence at the expense of requiring the Jacobian matrix of the system at + the initial point of the search. The secant method is a simple and standard + root extraction technique, provided for convenience. Roots of a polynomial + with real coefficients are computed by plrt. + + The nonlinear optimal search algorithm uses the BFGS matrix update + method. The robustness of this procedure has been confirmed in numerous tests + of optimization techniques. The golden section method is useful and efficient + for bounded search in one-dimension. + + Functions for finding the roots of a nonlinear system of equations + and for nonlinear optimization are based on efficient quasi-Newton matrix + update algorithms. This approach has been shown to combine high execution + efficiency (ie. a small number of function evaluations) with a large + convergence domain. Simplicity of use was also an important criterion in the + selection of the algorithms. The functions implemented do not require user + supplied procedures for computation of derivatives. Fortunately, this does + not entail a performance sacrifice, since the quasi-Newton procedures exhibit + excellent convergence properties when operating with numerical derivatives. + + The algorithms employed for finding roots and optima are iterative. + They require an initial estimate of the solution as input. While the + implemented algorithms have robust convergence, refinement of these initial + estimates is often the most effective way to improve algorithm performance. + A few hours spent estimating appropriate scales for variables and refining + initial point estimates may save days of agonizing search for a "golden + algorithm". Nonlinear analysis is a field so rich that vast bodies of code + are no substitute for a thoughtful understanding of the problem at hand. + + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + Roots of Equations: +------------------------------------------------------------------------------- + +solnl + + Solve a system of nonlinear equations. + + int solnl(double *x,double *f,double (*fvec[])(),int n,double test) + x = pointer to array containing initial solution estimate, + converted to solution vector at exit + f = pointer to array containing final values of the system functions + { f[k]=(*fvec[k])(x) } + fvec = array of pointers to the system functions + { (*fvec[k])(x)=0 for k=0,1,2,--,n-1 } + n = dimension of system + test = convergence threshold (f~*f normal exit + 0 -> convergence failure + + ------------------------------------------------------------------- + +solnx + + Variant of solnl, which permits input of an initial system + Jacobian. (Has an enlarged convergence domain.) + + int solnx(double *x,double *f,double (*fvec)(),double *jm,int n, \ + double *test) + x = pointer to array containing initial solution estimate, + converted to solution vector at exit + f = pointer to array containing final values of the system + functions { f[k]=(*fvec[k])(x) } + fvec = array of pointers to the system functions + { (*fvec[k])(x)=0 for k=0,1,2,--,n-1 } + jm = pointer to array of dimension n*n containing an initial system + Jacobian ( row order: JM[i,j] = df[i]/dx[j] ) + n = dimension of system + test = convergence threshold (f~*f normal exit + 0 -> convergence failure + + -------------------------------------------------------------------- + +plrt + + Find the real and complex roots of a polynomial with real + coefficients. + + typedef struct complex {double re,im;} Cpx; + int plrt(double *cof,int n,Cpx *root,double ra,double rb) + cof = pointer to array containing polynomial coefficients, with + the leading coefficient cof[n] != 0 + root = pointer to array of complex structures, containing the + polynomial roots at exit (dimension n) + n = degree of polynomial + ra,rb = initial root estimates, with + ( rb>0 -> real = ra, imag = rb and + rb<0 -> real roots ra+rb, ra-rb ) + return: 0 -> normal exit + m>0 -> convergence failure for roots k0 -> success (iteration count) + m=0 -> convergence failure + + --------------------------------------------------------------------- + +optsh + + Conduct a golden section line search for a function minima. + + double optsch(double (*func)(),double a,double b,double test) + func = pointer to function to be minimized + a,b = bounds on function argument (a<=x<=b) + test = convergence threshold (length of section + containing minima direct transform + inv!='d' -> inverse transform + + ----------------------------------------------------------------- + +fftgc + + Compute the general radix FFT of a complex input series with output + series order specified in a pointer array. + + void fftgc(Cpx **pc,Cpx *ft,int n,int *kk,int inv) + ft = pointer to input/output complex structure array + n = length of input and output series + pc = array of pointers specifying order of the elements in ft + kk = pointer to array of factors of n (see pfac below) + inv = control flag, with: + inv='d' -> direct transform + (pc initialized internally by shuffle) + inv='e' -> direct transform + (accept input order delivered in pc) + inv='i' -> inverse transformation + (pc shuffled by an internal call of pshuf) + + --------------------------------------------------------- + The correct input order for an inverse transformation is + generated by the function pshuf. + ---------------------------------------------------------- + --------------------------------------------------------------------- + +fft2 + + Compute, in place, the radix-2 FFT of a complex input series. + + void fft2(Cpx *ft,int m,int inv) + ft = pointer to input/output complex structure array + ( dimension=2^m ) + m = dimension parameter ( series length = 2^m ) + inv = control flag, with: + inv='d' -> direct Fourier transform + inv!='d' -> inverse transform + + ---------------------------------------------------------------- + +fft2_d + + Compute a two-dimensional radix-2 FFT transformation. + + void fft2_d(Cpx *a,int m,int n,int f) + a = pointer to complex input/output structure array + ( dimension= 2^m * 2^n ) + m = first dimension parameter + n = second dimension parameter + f = control flag, with: + f='d' -> direct Fourier transform + f='i' -> inverse transform + + + The input array contains complex matrix elements + + a[k,j] = a[k*2^m+j] , with 0 <= k <= 2^m -1 and + 0 <= j <= 2^n -1 . + + The output array is + + at[r,s] = { Sum(k=0 to 2^m -1){ Sum(j=0 to 2^n -1) + a[k,j]*exp(-i*(w[r]*k+w[s]*k))} }/N + + with N = 2^(m+n) , for the direct transform, and + + a[r,s] = { Sum(k=0 to 2^m -1){ Sum(j=0 to 2^n -1) + at[k,j]*exp(i*(w[r]*k+w[s]*j))} } + + for the inverse transform. + +------------------------------------------------------------------------------- + + FFT Support Functions: +------------------------------------------------------------------------------- + +pfac + + Factor an integer into its prime factors. + + int pfac(int n,int *kk,int fe) + n = input integer + kk = pointer to array containing factors of n, with + kk[0] = number of factors and the output returned + n' = kk[1]*kk[2]* -- *kk[kk[0]] + (The dimension of kk should be 32.) + fe = control flag, with: + fe = 'e' -> even integer output required + fe = 'o' -> odd integers allowed + return value: n' = integer factored (n' <= n) + + + All prime factors < 101 are considered, with n' decremented + if a factorization fails. The dimension 32 for the factor + array kk is sufficient to hold all factors of 32-bit integers. + + -------------------------------------------------------------------- + +pshuf + + Perform a pre-FFT shuffle of the pointer array. + + void pshuf(Cpx **pa,Cpx **pb,int *kk,int n) + n = array size + kk = pointer to array of factors of n (see pfac) + pb = pointer to n dimensional array of input pointers + pa = pointer to n dimensional array of output (shuffled) pointers + + + This function is used to support inversion of Fourier transforms, + since it can shuffle an array with any specified order. It is + called by fftgc when an inverse transformation is specified. + +------------------------------------------------------------------------------- + + Fourier Analysis Tools +------------------------------------------------------------------------------- + +ftuns + + Extract the FT of two real series from the FT of a complex composite + series f[k] = a[k] + i*b[k]. + + void ftuns(Cpx **pt,int n) + n = dimension of Fourier series + pt = pointer to n dimensional array of pointers to a complex + array containing the Fourier transform + ( This complex array is altered, with output: + pt[0]-> (real fta[0] , real ftb[0]) + pt[k]-> fta[k] and pt[n-k]-> ftb[k] + for k=1 to n/2-1 if n is even or + for k=1 to (n-1)/2 if n is odd + if n is even pt[n/2] -> + (real fta[n/2] , real ftb[n/2]) ) + + --------------------------------------------------------------- + +smoo + + Smooth a series, using a moving average window (specialized for + power spectra). + + void smoo(double *x,int n,int m) + x = pointer to array containing series (converted to a + smoothed version at exit) + n = dimension of input series + m = smoother control ( points in the smoothed series are + averaged over 2*m+1 points centered on the smoothed point ) + + + This procedure is designed for power spectra. The series + symmetries, periodicity with period n and reflection symmetry + x[-k]=x[k], are both exploited. In addition, the points x[0] + and x[n/2] are replaced by averages with the central point + omitted, because these points have chi-square-1 rather than + chi-square-2 distribution in power spectra. Smoothed points, + denoted by subscript s, are given by + + xs[j] = { Sum(i=j-m to j+m) x'[j] }/(2m+1) , where + + x'[0] = { Sum(j=1 to m) x[j] }/m , + x'[n/2] = { Sum(j=n/2-m to n/2-1) x[j] }/m , + and x'[j] = x[j] for all other j. + + ----------------------------------------------------------------- + +pwspec + + Compute the power spectrum of a series. + + int pwspec(double *x,int n,int m) + x = pointer to array containing input/output series + (converted to a power spectra at exit) + n = number of points in the series + m = control flag specifying order of smoothing, with: + m=0 -> no smoothing + m>0 -> smooth output power spectra, using + an order m average (see smoo) + return value: n = size of series used to compute power spectra + (n <= input n, even values required) + + + The output power spectra is defined by + + ps(w[j]) = | ft[j] |^2 / , where + + = { Sum(j=0 to n-1) x[j]^2 }/n . + + This normalization yields Sum(j=0 to n-1) ps(w[j]) = 1 . diff --git a/manual/C07-simu b/manual/C07-simu new file mode 100644 index 0000000..10bd915 --- /dev/null +++ b/manual/C07-simu @@ -0,0 +1,371 @@ + Chapter 7 + + SIMULATION SUPPORT + + Summary + + The functions in the simulation segment of the + library provide support for Monte Carlo + simulation analysis of physical systems in the + following areas: + + o Generation of Pseudorandom Numbers + o Random Sampling and Shuffling + o Simulation Output Analysis + + Several types of pseudorandom generator are + supplied for both the uniform and normal + distributions. Analysis tools compute histograms + and serial autocorrelations. + +------------------------------------------------------------------------------- + + Notes on Contents + + This library segment supports Monte Carlo simulation and the associated + statistical analysis. + + o Generation of Pseudorandom Numbers: + + lran1 -------- generate pseudorandom integers, with + 0 <= n < 2^32, using a one generator + shuffle. (The preferred method with + effectively unlimited period.) + lrand -------- generate pseudorandom integers, with + 0 < n < 2^31 - 1 . (Retained because it + is used on many mainframe computers.) + bran --------- generate a random integer in the range + 0 <= m < N , with specified N, using a + one generator shuffle. + bran2 -------- generate a random integer in the range + 0 <= m < N , with specified N, using a + two generator shuffle. + unfl --------- generate pseudorandom numbers uniformly + distributed on [0,1], using a one generator + shuffle. + unfl2 --------- uniform pseudorandom generator with a + two generator shuffle with effectively + unlimited period. + nrml --------- generate pseudorandom numbers with a + standard normal distribution, using a + one generator shuffle generator. (The + fastest normal generator.) + norm --------- generate pairs of pseudorandom standard + normals, using a one generator shuffle. + norm2 -------- generate pairs of pseudorandom standard + normals using a two generator shuffle. + + + o Random Sampling and Shuffling: + + sampl ------- select a random sample of specified size + from a set of N objects. + shuffl ------ perform a random shuffle of an array of data + pointers. + + Random sampling and random shuffling of a set are supported by a function + that produces random integers in the range 0 <= r < m, for a specified value + of m. Both of these algorithms operate on input pointer arrays, so that the + data records sampled or shuffled may be specified externally. + + o Statistical Analysis Tools: + + hist -------- compile a histogram of the values of an + input series. + autcor ------ compute the autocorrelation coefficients of + a series. + + The compilation of simulation statistics is supported by a histogram + function. In addition, a second utility performs direct computation of serial + correlation coefficients. These correlations play an important role in tests + of analytic model residuals. + +------------------------------------------------------------------------------- + + General Technical Comments + + Generators based on shuffling the output of one congruential generator + using the output of a second independent generator, with period relatively + prime to that of the first generator, (bran2, norm2 and unfl2) have an + effectively unlimited period. This form is well suited to multidimensional + Monte Carlo computations. The single shuffle generators are much faster + and also have very long or unlimited periods. Both forms are designed to + avoid the lattice structures observed in some congruential generators. + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + Pseudorandom Generators: +------------------------------------------------------------------------------- + +lran1 + + Generate pseudorandom unsigned int integers in the range + 0 =< r <= 2^32 -1. + + unsigned int lran1() + return value: r = random long integer + + This generator is initialized by setlran1. + + void setlran1(unsigned int s) + s = initializing seed for the generator. + + The generator uses a congruential method and shuffles its + output to obtain an effectively unlimited period. It is the + recommended integer generator. + + -------------------------------------------------------------- + +lrand + + Generate pseudorandom long integers in the range 0 < r < 2^31 - 1. + + long lrand() + return value: r = random long integer ( r > 0 ) + + This generator is initialized by setlrand. + + void setlrand(unsigned int s) + s = initializing seed for the generator (0 < s < 2^31 -1) + + + The generator is a simple multiplicative congruential one with + period 2^31 - 1. It is retained for use when replication of + the output produced on an mainframe using this standard IBM + GGL algorithm is desired. + + ----------------------------------------------------------------- + +bran + + Generate a random integer in the range 0 =< r < n. + + int bran(int n) + n = integer defining range of return (n > 0) + return value: r = random integer (0 <= r < n) + + The function setbran initializes the generator. + + void setbran(unsigned int s) + s = initializing seed for the generator + + The generator combines a congruential generator with a + buffer shuffle that yields an effectively unlimited period. + + ------------------------------------------------------------- + +bran2 + + Generate a random integer in the range 0 <= r < n. + + int bran2(n) + int n; + n = integer defining range of return (n > 0) + return value: r = random integer (0 <= r < n) + + The function setbran2 initializes the generator. + + void setbran2(s) + unsigned int s; + s = initializing seed for the generator + + The generator combines two congruential generators with a + buffer shuffle to produce an effectively unlimited period. + + ------------------------------------------------------------ + +unfl + + Generate pseudorandom numbers uniformly distributed on [0,1]. + + double unfl() + return value: u = variate uniformly distributed on [0,1] + + + The unfl generator is initialized by calling setunfl. + + + void setunfl(s) + unsigned int s; + s = initializing seed for the generator + + The generator combines a congruential generator with a + buffer shuffle that yields an effectively unlimited period. + + ---------------------------------------------------------------- + +unfl2 + + Generate pseudorandom numbers uniformly distributed on [0,1]. + + double unfl2() + return value: u = variate uniformly distributed on [0,1] + + + The unfl2 generator is initialized by calling setunfl2. + + + void setunfl2(unsigned int s) + + s = initializing seed for the generator + + The generator combines two congruential generators with a + buffer shuffle to produce an effectively unlimited period. + + ------------------------------------------------------------ + +nrml + + Generate normally distributed pseudorandom numbers. + + double nrml() + return value: e = normally distributed variate (zero mean + and unit variance) + + Initialize the nrml generator by calling setnrml. + + void setnrml(unsigned int s) + s = initializing seed for the generator + + + The generator combines a congruential generator with a + buffer shuffle that yields an effectively unlimited period. + + -------------------------------------------------------------- + + norm + + Generate q pair of pseudorandom normals with zero mean and unit + variance. + + void norm(double *err) + err = pointer to an array for output of an independent + pair of normally distributed pseudorandom numbers + (output has zero mean and unit variance) + + The norm generator is initialized by setnorm. + + void setnorm(unsigned int s) + s = initializing seed for the generator + + + This function combines a congruential method with a buffer + shuffle to generate a pair of random uniform values. The + The polar rejection method is used to obtain a pair of + standard normal values. This is an analytically "exact" method. + + ----------------------------------------------------------------- + +norm2 + + Generate q pair of pseudorandom normals with zero mean and unit + variance. + + void norm2(double *err) + err = pointer to array for output of an independent + pair of normally distributed pseudorandom numbers + (zero mean and unit variance) + + The norm generator is initialized by setnorm2. + + void setnorm2(unsigned int s) + s = initializing seed for the generator + + The generator combines two congruential generators with a + buffer shuffle to produce an effectively unlimited period. + + +------------------------------------------------------------------------------- + + Sampling and Shuffling: +------------------------------------------------------------------------------- + +sampl + + Select a random sample of size m from n objects. + + void sampl(void **s,int m,void **d,int n) + s = pointer to array of array of sample pointers (dimension m) + (loaded with a random sample of m pointers from d at exit) + d = pointer to an array of n data pointers + n = size of data base + m = size of requested sample + + + The sampling function calls bran, so it is essential to + initialize this generator with setbran, prior to use of + sampl. (see bran above) The pointers in d and s are + declared as generic (char *) to support sampling any + type of data record via pointers. + + --------------------------------------------------------------- + +shuffl + + Perform a random shuffle of an array of data pointers. + + void shuffl(void **s,int n) + s = pointer to an array of pointers to data records + (output s contains a random permutation of the + input pointers) + n = dimension of array s + + + This function calls bran, thus, it requires a call + to setbran prior to use. (see bran above) + +------------------------------------------------------------------------------- + + Statistical Analysis Tools: +------------------------------------------------------------------------------- + +autcor + + Compute the autocorrelation coefficients of a series. + + double *autcor(double *x,int n,int mlag) + x = pointer to array containing the input series + n = length of input series (dimension of x-array) + mlag = maximum lag (autocorrelations are computed up to mlag) + return value: pa = pointer to array allocated for storing + autocorrelation coefficients, with: + *pa = sum of squares over the series + (normalizer for autocorrelations) + *(pa+k) = autocorrelation at lag k, + k=1,2, -- ,mlag + + + The autocorrelations are defined by + + c[k] = { Sum(i=0 to n-k-1) x[i]*x[i+k] }/< x^2 > with + + < x^2 > = Sum(i=0 to n-1) x[i]^2 . + + The storage allocated by autcor is released by calling free(pa). + + -------------------------------------------------------------------- + +hist + + Compile a histogram of the values of an input series. + + int *hist(double *x,int n,double xmin,double xmax, \ + int kbin,double *bin) + x = pointer to array containing input series + n = size of input series + xmin = lower limit of histogram interval + xmax = upper limit of histogram interval + kbin = number of histogram intervals + bin = pointer to store for computed bin size + (*bin=(xmax-xmin)/kbin) + return value: ph = pointer to storage allocated for + histogram, with: + *(p-1) = number of values < xmin + *(p+kbin) = number of values >xmax + *(p+k) = number of values in kth bin, + k=0,1, --- ,kbin-1 + + + The storage allocated by hist is released by calling free(ph-1). diff --git a/manual/C08-statf b/manual/C08-statf new file mode 100644 index 0000000..97586d3 --- /dev/null +++ b/manual/C08-statf @@ -0,0 +1,281 @@ + Chapter 8 + + STATISTICAL FUNCTIONS + + Summary + + This library segment contains functions that + compute a cumulative distribution and percentage + points for the full range of probability + densities likely to arise in sampling from normal + populations. The distributions covered are: + + o Normal Distribution + o Gamma Distributions + o Beta Distributions + o Noncentral Gamma Distributions + o Noncentral Beta Distributions + + The functions are designed to produce high + accuracy over a large range of distribution + parameters for all valid function arguments. + +------------------------------------------------------------------------------- + + Notes on Contents + + The functions in this library segment compute cumulative distributions + and evaluate percentage points for the statistical distribution functions + encountered in sampling from normal populations. + + o Normal Distribution: + + qnorm ------- compute the tail of the cumulative standard + normal distribution. + pctn -------- compute percentage points of a standard + normal distribution. + + o Gamma Distribution: + + qgama ------- compute the cumulative gamma or chi-square + distribution. + pctg -------- compute percentage points of the gamma and + chi-square distributions. + + o Beta Distribution: + + qbeta ------- compute the cumulative beta, F, or Student-t + distribution. + pctb -------- compute percentage points of the beta, F, or + Student-t distribution. + + o Noncentral Gamma Distribution: + + qgnc -------- compute the cumulative noncentral gamma or + noncentral chi-square distribution. + pctgn ------- compute percentage points of the noncentral + gamma or noncentral chi-square distribution. + + o Noncentral Beta Distribution: + + qbnc -------- compute the cumulative noncentral beta or + noncentral chi-square distribution. + pctbn ------- compute percentage points of the noncentral + beta or noncentral chi-square distribution. + + + ----------------------------------------------------------------------------- + + General Technical Comments + + The gamma distribution is simply a generalization of the chi-square + distribution, while the beta distribution is related to the F-distribution + and the Student-t distribution by simple transformations. The specific + transformations are: + + o chi-square x^2 with n degrees of freedom -> gamma + distribution, with x^2 = 2z and n = 2a ; + + o F-distribution f with m and n degrees of freedom -> + beta distribution, with f = [a+(1-z)]/[b+z] + or z = 1/[1+(m/n)*f] , where n=2a and m=2b . + + o Student-t distribution t with n degrees of freedom -> + beta distribution, with t = 2a+sqrt(1-z^2)/z + or z = sqrt[1 - (t/n)^2] , when n=2a ,and b = 1/2 . + + The generalization of the parameters of these densities to all real values + facilitates the treatment of multidimensional problems. + + The noncentral distributions are used to determine the power of many + standard statistical hypothesis tests. The non-centrality parameter (dsq) + used in these functions is related to the form employed in noncentral F and + chi-square distributions by + + dsq = w/2 , with w = Sum(i=1 t0 n) q[i]^2 , and + q[i] = x[i] - x(avg). + + Thus, dsq represents the square distance from an assumed mean in the + multidimensional sample space. + + The standards of accuracy adopted for these library functions are: + + o cumulative distributions with 10 decimal accuracy; and + + o percentage points sufficiently accurate to reproduce the + desired probability with absolute error < 10^9 . + + This accuracy is maintained over a full argument range for parameter values + (a for the gamma distributions and, a,b for the beta distributions) less than + 100. It is possible to use larger parameter values, however pre-testing of + convergence is recommended in such applications. At these large values, + corresponding to sample sizes greater than 200, normal approximations to + gamma and beta distributions can be used with excellent accuracy. + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + Normal Distribution: +------------------------------------------------------------------------------- + + density: ro(x) = exp(-(x^2)/2)/sqrt(2*pi) + + Cumulative: Qn(z) = Intg(z to infinity) ro(x) dx . + ------------------------------------------------------------- + +qnorm + + Integral from x to infinity of the standard normal distribution. + + double qnorm(double x) + x = value of argument + return value: Qn(x) = integral of normal density from x to infinity + + --------------------------------------------------------------------- + +pctn + + Compute percentage points of the standard normal distribution. + + double pctn(double pc) + pc = probability argument (te< pc <1-te, with te=1.e-9) + return value: x = value for which Qn(x)=pc + x=HUGE -> pc outside limits + +------------------------------------------------------------------------------- + + Gamma Distribution: +------------------------------------------------------------------------------- + + gro(x,a) = x^(a-1)*exp(-x)/Gamma(a) , with + + Qg(z,a) = Intg(z to infinity) gro(x,a) dx . + --------------------------------------------------------- + +qgama + + Evaluate the cumulative gamma distribution function. + + double qgama(double x,double a) + x = value of argument (0 < x) + a = distribution parameter (a > 0) + return value: Qg(x) = integral of gamma density from x to infinity + + -------------------------------------------------------------------- + +pctg + + Evaluate the percentage points of the gamma distribution. + + double pctg(double pc,double a) + pc = probability argument (te< pc <1-te, with te=1.e-9) + a = distribution parameter (a > 0) + return value: x = value of x at which Qg(a,x)=pc + x=-1 -> pc outside limits + +------------------------------------------------------------------------------- + + Beta Distribution: +------------------------------------------------------------------------------- + + bro(x,a,b) = x^(a-1) * (1-x)^(b-1)/Beta(a,b) , where + + Beta(a,b) = Gamma(a)*Gamma(b)/Gamma(a+b) and + + Qb(z,a,b) = Intg(0 to z) bro(x,a,b) dx . + --------------------------------------------------------- + +qbeta + + Compute the cumulative beta distribution function. + + double qbeta(double x,double a,double b) + x = value of the argument (0 < x < 1) + a,b = distribution parameters (a,b > 0) + return value: Qb = integral of the beta density from 0 to x + + -------------------------------------------------------------- + +pctb + + Evaluate the percentage points of the beta distribution. + + double pctb(double pc,double a,double b) + double pc,a,b; + pc = probability argument (te< pc <1-te, with te=1.e-9) + a,b = distribution parameters (a,b > 0) + return value: x = value of x at which Qb(x,a,b)=pc + x=-1 -> pc outside limits + +------------------------------------------------------------------------------- + + Noncentral Gamma Distribution: +------------------------------------------------------------------------------- + + gro_nc(x,a,d) = (z/d)^{(a-1)/2}*exp{-(a+d)}*Ia(sqrt(z*d)) + + = exp(-d)*Sum(k=0 to infinity){(d^k/k!)*gro(x,a+k) + + Qg_nc(z,a,d) = Intg(z to infinity) gro_nc(x,a,d) dx . + -------------------------------------------------------------------- + +qgnc + + Compute the non-central gamma cumulative distribution function. + + double qgnc(double x,double a,double d) + x = value of argument (x > 0) + a = distribution parameter (a > 0) + d = non-centrality parameter (d >= 0) + return value: Qg_nc = integral of noncentral gamma density from + x to infinity + + ---------------------------------------------------------------------- +pctgn + + Evaluate percentage points of the noncentral gamma distribution. + + double pctgn(double pc,double a,double d) + pc = probability argument (te< pc <1-te, with te=1.e-9) + a = distribution parameter (a > 0) + d = non-centrality parameter (d >= 0) + return value: x = value of x at which Qg_nc(x,a,d)=pc + x=-1 -> pc outside limits + + +------------------------------------------------------------------------------- + + Noncentral Beta Distribution: +------------------------------------------------------------------------------- + + bro_nc(x,a,b,d) = exp(-d)*x^(a-1)*(1-x)^(b-1)* + F(a+b,b:d(1-x))/Beta(a,b) + + = exp(-d)* Sum(k=0 to infinity){ (d^k/k!)bro(x,a,b+k) , and + + Qb_nc(z,a,b,d) = Intg(0 t0 z) bro_nc(x,a,b,d) dx . + ----------------------------------------------------------------- + +qbnc + + Compute the cumulative non-central beta distribution function. + + double qbnc(double x,double a,double b,double d) + x = value of argument (0< x <1) + a,b = distribution parameters (a,b > 0) + d = non-centrality parameter (d >= 0) + return value: Qb_nc = integral of the noncentral beta density + from 0 to x + + ------------------------------------------------------------------- + +pctbn + + Evaluate percentage points of the noncentral beta distribution. + + double pctbn(double pc,double a,double b,double d) + pc = probability argument (te< pc <1-te, with te=1.e-9) + a,b = distribution parameters (a,b > 0) + d = non-centrality parameter (d >= 0) + return value: x = value of x at which Qb_nc(x,a,b,d)=pc diff --git a/manual/C09-sfunc b/manual/C09-sfunc new file mode 100644 index 0000000..7627904 --- /dev/null +++ b/manual/C09-sfunc @@ -0,0 +1,672 @@ + Chapter 9 + + SPECIAL FUNCTIONS + + Summary + + The special functions library segment contains + procedures for the evaluation of many of the + higher transcendental functions encountered in + applications. The functions covered are: + + o Factorial and Related Functions + o Elliptic Functions and Integrals + o Bessel Functions of General Order + o Spherical Bessel Functions + o Airy Functions + + The evaluation algorithms employ analytic + approximations in order to cover the widest + possible range of parameters for the functions. + The elliptic integral functions employ the Bartky + parameterization, which significantly simplifies + their use. All the library functions maintain a + high standard of accuracy over the full argument + range. + +------------------------------------------------------------------------------- + + Notes on Contents: + + Functions in this library segment compute the values of some frequently + used higher transcendental functions. The accuracy standards quoted below + all refer to relative rather than absolute precision. + + o Factorial and Related Functions: + + gaml -------- evaluate the natural logarithm of the Gamma function. + psi --------- evaluate the Psi-function for integer argument. + psih -------- evaluate the Psi-function for half-integer argument. + + The logarithm of the factorial function is computed to an accuracy of 12 + or more decimal digits for general positive arguments. Evaluation of the Psi + function is confined to the integer and half-integer arguments required in + the evaluation of other functions in the library. + + + o Elliptic Integrals and Functions: + + amelp ------- compute the elliptic amplitude function. + felp -------- compute complete and incomplete elliptic integrals + of the first and second kind. + gelp -------- compute a general elliptic integral. + g2elp ------- compute a general elliptic integral with nonzero + lower limit. + nome -------- evaluate the nome q(k) for elliptic functions of + modulus k. + theta ------- evaluate the Jacobian theta functions. + + Elliptic integrals are evaluated by using an extension of the Bartky + approach, using arithmetic and geometric means. The accuracy standard for + elliptic integrals is 14 or more decimal digits (ie. nearly full double + precision accuracy). + + Jacobian elliptic functions are evaluated with the aid of theta function + series. The accuracy standard for these evaluations is at least 14 decimal + digits. Rapid convergence of the series yields high execution efficiency. + + + o Bessel Functions of General Order: + + jbes -------- evaluate the Bessel function of the first kind. + nbes -------- evaluate the Bessel function of the second kind. + ibes -------- evaluate the Bessel function of the first kind + at imaginary argument values. + kbes -------- evaluate the Bessel function of the third kind + at imaginary argument values. + drbes ------- evaluate derivatives of the Bessel functions. + rcbes ------- compute a sequence of Bessel function values + via recurrence relations. + + The general Bessel functions maintain a standard of accuracy of at least + 12 decimal digits over the full argument range. Series of Bessel functions, + with orders differing by one, are computed using recurrence relations. The + library also contains a function that analytically computes Bessel function + derivatives. + + + o Spherical Bessel Functions: + + jspbes ------- evaluate the spherical Bessel function of the + first kind. + yspbes ------- evaluate the spherical Bessel function of the + second kind. + kspbes ------- evaluate spherical Bessel functions of the third + kind at imaginary argument values. + drspbes ------ compute the derivatives of spherical Bessel + functions. + rcspbes ------ compute a series of spherical Bessel function + values via recurrence relations. + + The accuracy standard and coverage provided for spherical Bessel + functions matches that used for the Bessel functions. + + + o Airy Functions: + + Airy functions of the first and second kind and their derivatives are + evaluated for all real arguments by a pair of library functions. + + airy -------- evaluate the Airy function of the first kind or + its derivative. + biry -------- evaluate the Airy function of the second kind + or its derivative. + + The standard of a minimum of 12 accurate decimal digits is maintained for + these functions. + + + ----------------------------------------------------------------------------- + + General Technical Comments: + + The primary criteria governing the selection of evaluation algorithms + was the ability to maintain a high standard of accuracy over a comprehensive + parameter range. This dictated the use of analytic approximations rather than + optimized rational approximations. The latter approach can yield highly + efficient execution, but it requires separate approximations for each order + covered. + + The range of orders for which Bessel function evaluation is efficient + extends from zero to one hundred. Efficiency declines as order increases, + however, and the use of asymptotic expansions in order is advised for the + rare application where many functions with order exceeding 100 must be + evaluated. + + General forms of both complete and incomplete elliptic integrals are + evaluated in a uniform manner, that does not require the user to identify + a combination of integrals of the first, second, and third kind. The method + has been extended to the case of singular integrands, by means of an + automatically evoked transformation function (gsing). This approach + represents a significant simplification in the use of this important class + of functions. Its rapid convergence ensures high efficiency. + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + Factorial Functions: +------------------------------------------------------------------------------- + +gaml + + Evaluate the natural logarithm of the Gamma function. + + double gaml(double x) + x = function argument + return value: y = log(Gamma(x)) (logarithm base = e) + + This function is also used in the statistical function library. + + ---------------------------------------------------------------------- + +psi + + Evaluate the psi function for integer and half-integer arguments. + + psi(x) = d {log(Gamma(x))} / dx + + double psi(int m) + m = integer function argument (m>0) + return value: y = psi(m) + + + double psih(double v) + v = half-integer function argument (v=n+.5 for integer n>=0) + return value: y = psi(v) + + The arguments of the psi functions are those needed to + support the other functions in the library. + +------------------------------------------------------------------------------- + + Elliptic Integrals and Functions: +------------------------------------------------------------------------------- + + F(x,k) = Intg(0 to x) 1/sqrt(1 - k^2*[sin(a)]^2) da , + + E(x,k) = Intg(0 to x) sqrt(1 - k^2*[sin(a)]^2) da , and + + I(x,r,k) = Intg(0 to x) da/{(1-r*[sin(a)]^2)*sqrt(1-k^2*[sin(a)]^2)} + + are the standard definitions of elliptic integrals of the first, second, + and third kind respectively. The parameter k is the modulus of the elliptic + integrals. Complete elliptic integrals are given by + + K = F(pi/2,k) and E = E(pi/2,k). + + The Bartky parameterization of elliptic integrals is outlined in the + discussion of gelp below. +------------------------------------------------------------------------------- + +amelp + + Compute the elliptic amplitude function phi = amp(u). + + double amelp(double u,double k) + u = argument of function (u=F(v,k), u>=0) + k = modulus of elliptic functions + return value: v = amp(u) + + + This is the inverse of the elliptic integral of the first kind. + If u = F(v,k) , then v = v(u,k) is the amplitude function. + Jacobian elliptic functions satisfy + + sn(u) = sin(v), cn(u) = cos(v), + and dn(u) = sqrt(1-k^2*[sin(v)]^2). + + -------------------------------------------------------------------- + +felp + + Compute complete and incomplete elliptic integrals of the first and + second kinds. + + double felp(double an,double k,double *pk,double *pz,double *ph) + an = upper limit of elliptic integrals (an > 0 in radians) + k = modulus of the elliptic integrals + pk = pointer to store for complete integral K + ( output of K, E and E(an,k) can be suppressed + by calling with pk=NULL ) + pz = pointer to store for function E(an,k) + ( pz=NULL will suppress output of E(an,k) and E ) + ph = pointer to store for complete integral E(k) + return value: f = F(an,k) the elliptic integral of the first kind + + + -------------------------------------------------------------------- + + The integrand of a general elliptic integral is parameterized by + Bartky in the following form: + + G(v,k:as,bs,cs) = Intg(0 to v) {M(as,bs,cs,k,y)/R(y,k)} dy , with + + R(y,k) = sqrt{[cos(y)]^2 + sqrt(1-k^2)*[sin(y)]^2} . + + M = N/D with, + + N = { as*[cos(y)]^2 + bs*cs[sin(y)]^2 } and + + D = { as*[cos(y)]^2 + cs*sqrt(1-k^2)*[sin(y)]^2 } . + + + The Bartky parameters B=[as,bs,cs] can be chosen to produce a + general elliptic integral. Integrals of the first, second, and + third kind result from the following initial choices: + + as = 1 and bs = cs = 1 for F(v,k) , + + as = 1 , bs = 1 - k^2 , and cs = sqrt(1 - k^2) for E(v,k) , and + + as = 1 , bs = 1/(1-r) , and cs = (1-r)/sqrt(1 - k^2) for I(v,r,k). + + ------------------------------------------------------------------------- + +gelp + + Compute a general elliptic integral G(an,k,B). + + double gelp(double an,double k,double as,double bs,double cs, \ + double *pg,double *pf,double *pk) + an = upper limit of integral (an > 0 in radians) + k = modulus of elliptic integral + as,bs,cs = Bartky parameters of integrand (see note above) + pg = pointer to store for complete integral G=G(pi/2,k,B) + ( output of G, K, and F(an,k) is suppressed by calling + with pg=NULL ) + pf,pk = pointers to store for F(an,k) and K respectively + (output of these integrals of the first kind + is suppressed when pf=0) + return value: g = G(an,k,B) the incomplete integral + + -------------------------------------------------------------------- + +g2elp + + Compute a general elliptic integral with nonzero lower limit + G2(an,bn,k,B). + + double g2elp(double an,double bn,double k,double as,double bs, \ + double cs) + an = lower limit of the integral (radians) + bn = upper limit of the integral (radians) + k = modulus of elliptic integral + as,bs,cs = Bartky parameters of integrand + return value: g2 = G2(an,bn,k,B) = G(bn,k,B)-G(an,k,B) + + + G2(a2,a1,k,B) = Intg(w=a1 to a2) { M(B,k,w)/R(w,k) dw} + + ------------------------------------------------------------------- + + + The following two functions are evoked automatically by gelp and g2elp + respectively when a singular integral (cs<0.) is involved. They are not + normally called directly by an application. + +gsng + + Convert a singular elliptic integral (*pc < 0.) to non-singular form. + + double gsng(double *pa,double *pb,double *pc,double b,double an) + pa,pb,pc = pointers to the stores for the integrand's Bartky + parameters (these parameters correspond to as,bs,cs + in the note above, with singularity -> cs<0.) + b = modulus parameter (b=sqrt(1-k*k)) + an = upper limit of integral (an > 0 in radians) + return value: I = increment to integral after transformation + (I=HUGE -> limit is coincident with the + singularity of the integrand) + + ----------------------------------------------------------------------- + +gsng2 + + Convert an elliptic integral with non-zero lower limit to non-singular + form. + + double gsng2(double *pa,double *pb,double *pc,double b, \ + double an,double bn) + double *pa,*pb,*pc,b,an; + pa,pb,pc = pointers to the stores for the integrand's Bartky + parameters (these parameters correspond to as,bs,ds + in the note above, with singularity -> ds<0.) + b = modulus parameter (b=sqrt(1-k*k)) + an = lower limit of integral (radians) + bn = upper limit of integral + return value: I2 = increment to integral after transformation + (I2=HUGE -> limit is coincident with the + singularity of the integrand) + + + The Bartky parameters *pa,*pb,*pc are altered by these + functions. The value of the integral is given by + + G(v,k:as,bs,cs) = I + G'(v,k:as',bs',cs') , + + or G2(v2,v1:as,bs,cs) = I2 + G'(v2,v1:as',bs',cs') , + + with as', bs', and cs' the transformed parameters + resulting from application of gsng or gsng2. If the + singularity of the integrand lies inside the region of + integration, this result must be interpreted as a Cauchy + principle value integral. + + ----------------------------------------------------------------------- + +nome + + Evaluate the nome q(k) for elliptic functions of modulus k. + + double nome(double k,double *pk,double *pkp) + k = modulus of elliptic functions + pk = pointer to store for K + pkp = pointer to store for K1 + return value: f = q(k) + + + The nome is defined by + + q(k) = exp( -pi*K1/K) , with K = F(pi/2,k), + + and K1 = F(pi/2,k1) , where k1 = sqrt(1 - k^2) . + + ----------------------------------------------------------- + +theta + + Evaluate the Jacobian theta functions. + + double theta(double u,int n) + u = argument of the theta function + n = index of the theta function = 0,1,2,or 3 + return value: theta(u,n) + + + The computation of theta functions must be initialized by + calling the function stheta to initialize the modulus. + + + void stheta(double k) + k = modulus of elliptic functions + + + The theta functions are related to elliptic functions by: + + sn(u) = theta1(u)/(sqrt(k)* theta0(u)) ; + + cn(u) = sqrt(k1/k)* theta2(u)/theta0(u); and + + dn(u) = sqrt(k1)* theta3(u)/theta0(u). + + k is the modulus and k1 = sqrt(1-k^2) . + + +------------------------------------------------------------------------------- + + Bessel Functions: +------------------------------------------------------------------------------- + + The Bessel functions evaluated by the library are defined by + + J(n,x) = {(x/2)^n}/Gamma(n)}* Sum(k=0 to infinity) { + (-x^2/4)^k / k!*Gamma(n+k) } , + + Y(n,x) = N(n,x) = {cos(pi*n)J(n,x) - J(-n,x)}/sin(pi*n) , + + I(n,x) = (i)^{-n} * J(n,i*x) , and + + K(n,x) = (i*pi/2)(i)^n *{ J(n,i*x) + i*Y(n,i*x) } . + + These definitions require the use of limit procedures for Y and K when the + order n is an integer. + +------------------------------------------------------------------------------- + +jbes + + Evaluate the Bessel function of the first kind J(n,x). + + double jbes(double v,double x) + v = order of the function (v>=0.) + x = function argument (x>=0.) + return value: f = J(n,x) + + ----------------------------------------------------------- + +nbes + + Evaluate the Bessel function of the second kind Y(n,x). + ( N(n,x) is an alternative notation.) + + double nbes(double v,double x) + v = order of the function (v>=0.) + x = function argument (x>=0.) + return value: f = Y(n,x) + + ------------------------------------------------------------ + +ibes + + Evaluate the modified Bessel function of the first kind I(n,x). + ( This is a Bessel function with imaginary argument. ) + + double ibes(double v,double x) + v = order of the function (v>=0.) + x = function argument (x>=0.) + return value: f = I(n,x) + + ------------------------------------------------------------------- + + kbes + + Evaluate the modified Bessel function of the third kind K(n,x). + + double kbes(double v,double x) + v = order of the function (v>=0.) + x = function argument (x>=0.) + return value: f = K(n,x) + + ------------------------------------------------------------------- + +drbes + + Evaluate the derivatives of Bessel functions. + + double drbes(double x,double v,int f,double *p) + x = argument of the function (x>=0.) + v = order of the function (v>=0.) + p = pointer to store for supplied function value Z(v,x) + (p=0 -> compute the required function value) + f = function type flag, with: + f='j' -> dJ(v,x)/dx + f='y' -> dY(v,x)/dx + f='i' -> dI(v,x)/dx + f='k' -> dK(v,x)/dx + return value: f = dZ(v,x)/dx , where Z=J,Y,I,or K + + ---------------------------------------------------------- + + rcbes + + Recurrence relations for the evaluation of a sequence of Bessel + functions. + + double rcbes() + return value: f = value of the next Bessel function in the + order of the recurrence (see setrcb below) + + + The recurrence sequence must be initialized by a call of + the function setrcb. This call determines the function + type, recursion direction, the starting order, and the + argument of the sequence. + + void setrcb(double u,double y,int fl,int dr,double *pf, \ + double *ph) + u = starting order of the Bessel functions (u>=0.) + y = argument of the functions (y>=0.) + fl = function type flag, with: + fl='j' -> J(v,x) + fl='y' -> Y(v,x) + fl='i' -> I(v,x) + fl='k' -> K(v,x) + dr = direction flag, with: + dr='u' -> increasing order + dr='d' -> decreasing order + pf,ph = pointers to store for first two function values + ( *pf=Z(u,y) , *ph=Z(u+1,y) if dr='u' and + *pf=Z(u,y) , *ph=Z(u-1,y) if dr='d' ) + + + The functions J and I are stable for decreasing recurrence, + while Y and K have stable increasing recurrence. + + +------------------------------------------------------------------------------- + + Spherical Bessel Functions: +------------------------------------------------------------------------------- + + The spherical Bessel functions are defined by + + j(n,x) = sqrt(pi/2x)*J(n+1/2,x) , + + y(n,x) = sqrt(pi/2x)*N(n+1/2,x) , and + + k(n,x) = {exp(-x)/x}* Sum(k=0 to n) { + [(n+k)! / (k!(n-k)!]*(2x)^k)] } . + +------------------------------------------------------------------------------- + +jspbes + + Evaluate the spherical Bessel function j(n,x). + + double jspbes(int n,double x) + x = argument of function (x>=0.) + n = order of function (n>=0) + return value: f = j(n,x) + + -------------------------------------------------------- + +yspbes + + Evaluate the spherical Bessel function of the second kind y(n,x). + + double yspbes(int n,double x) + x = argument of function (x>=0.) + n = order of function (n>=0) + return value: f = y(n,x) + + ----------------------------------------------------------- + +kspbes + + Evaluate the modified spherical Bessel functions k(n,x) and k(n,-x). + + double kspbes(int n,double x) + x = argument of function + ( x>0. -> exponentially decreasing solution, and + x<0. -> exponentially increasing solution) + n = order of function (n>=0) + return value: f = k(n,x) + + + The normalization chosen for k(n,x) yields a leading + asymptotic term = exp(-x)/x at large x. + + ------------------------------------------------------------------- + +drspbes + + Evaluate the derivatives of spherical Bessel functions. + + double drspbes(double x,int n,int f,double *p) + x = argument of function (x>=0. for j and y) + n = order of function (n>=0) + p = pointer to store for supplied function value + (p=0 -> compute the required function value) + f = function type flag, with: + f='j' -> dj(n,x)/dx + f='y' -> dy(n,x)/dx + f='k' -> dk(n,x)/dx + return value: d = dz(n,x)/dx for z=j,y,or k + + ---------------------------------------------------------------- + +rcspbes + + Recurrence relations for evaluating a sequence of spherical Bessel + functions. + + double rcspbs() + return value: f = value of the next spherical Bessel function + in the order of the recurrence (see setrcsb + below) + + + The recurrence sequence must be initialized by a call of + the function setrcsb. This call determines the function + type, recursion direction, the starting order, and the + argument of the sequence. + + setrcsb(int n,double y,int f,int dr,double *pf,double *ph) + n = starting order of the spherical Bessel function + sequence (n>=0) + y = argument of the functions (y>=0.) + f = function type flag, with: + f='j' -> dj(n,x)/dx + f='y' -> dy(n,x)/dx + f='k' -> dk(n,x)/dx + dr = direction flag, with: + dr='u' -> increasing order + dr='d' -> decreasing order + pf,ph = pointers to store for first two function values + ( *pf=z(n,y) , *ph=z(n+1,y) if dr='u' and + *pf=z(n,y) , *ph=z(n-1,y) if dr='d' ) + + +------------------------------------------------------------------------------- + + Airy Functions: +------------------------------------------------------------------------------- + + The Airy functions can be defined in terms of Bessel functions, with + + Ai(x) = {sqrt(x/3)/pi} K(1/3,u) for x >= 0 + + = {sqrt(-x)/3} { J(1/3,u) + J(-1/3,u) } for x < 0. + + Bi(x) = sqrt(x/3) { I(-1/3,u) + I(1/3,u) } for x >= 0 + + = sqrt(-x/3) { J(-1/3,u) - J1/3,u)) } for x < 0. + + Here u = (2/3)*(|x|)^1.5 . + +------------------------------------------------------------------------------- + +airy + + Evaluate the Airy function Ai(x) or its derivative Ai'(x). + + double airy(double x,int df) + x = argument of the function + df = derivative flag, with + 0 -> Ai and 1 -> Ai' + return value: f = Ai(x) if df=0 + f = Ai'(x) if df=1 + + ------------------------------------------------------------------- + +biry + + Evaluate the Airy function Bi(x) or its derivative Bi'(x). + + double biry(double x,int df) + x = argument of the function + df = derivative flag, with + 0 -> Bi and 1 -> Bi' + return value: f = Bi(x) if df=0 + f = Bi'(x) if df=1 diff --git a/manual/C10-sort b/manual/C10-sort new file mode 100644 index 0000000..e2dad7d --- /dev/null +++ b/manual/C10-sort @@ -0,0 +1,453 @@ + Chapter 10 + + SORTS and SEARCHES + + Summary + + This library segment contains a number of sort + functions, and functions that implement efficient + search capabilities using trees and scatter + storage (hashing). The specific areas covered + are: + + o Sort Functions + o Binary Trees + o Balanced (AVL) Binary Trees + o Hashing + + Search functions implement the standard operations + of node insertion, node deletion, and a search for + a specified node. + +------------------------------------------------------------------------------- + + Notes on Contents + + o Sort Functions: + + Each of the sorting functions is a general purpose algorithm that + operates on an array or list of pointers to the elements to be sorted, and + accepts a user specified comparison function. + + msort -------- execute a merged list sort. + qsrt -------- use the "quick-sort" algorithm. + hsort -------- use the "heap-sort" algorithm. + ssort -------- perform a Shell-sort. + + Both ordinary binary trees and the balanced (AVL) tree are supported by + library functions. + + + o Binary Tree Functions: + + btins -------- insert a node in a Binary tree. + btdel -------- delete a specified node from a Binary tree. + tsearch ------ search a tree for a node with a specified key. + tsort -------- sort the tree's nodes in ascending order. + prtree ------- print a map of the tree's node structure. + + + o Balanced (AVL) Trees: + + batins ------- insert a node in a balanced tree. + batdel ------- delete a specified node from a balanced tree. + btsearch ----- search a balanced tree for a node with a + specified key. + btsort ------- sort the nodes of a balanced tree in ascending + order. + prbtree ------ print a node map of a balanced tree. + + + o Hashing: + + hashins ------ insert a node into a hashed (scatter storage) + structure. + hashdel ------ delete a specified node from the hashed structure. + hfind -------- find the hashed node with a specified key. + hval --------- perform a simple hash array address computation. + + +------------------------------------------------------------------------------- + + General Technical Comments + + The sort techniques implemented include a Shell sort and a heap sort that + provide efficient and simple approaches to the internal sorting problem. In + addition, two high efficiency recursive algorithms, quicksort and merge sort, + are provided. The Shell, heap, and quicksort algorithms all operate on an + array of pointers to the actual list to be sorted, while merge sort sorts a + linked list. Use of the merge sort is advised in applications where the + linked list overhead is acceptable. + + All the sort and search functions accept a user defined function for + key comparison. The convention adopted in interpreting the values returned + by this comparison function are those adopted in the standard C library: + + 1 -> first key > second key; + 0 -> first key = second key; and + -1 -> first key < second key. + + The binary tree data structure supports high efficiency searches. The use + of balanced trees will ensure a specified bound on the number of nodes that + must be traversed in any search. Therefore, its use is preferred over the + simple binary tree unless storage limits prohibit the balance flag required + in each node of the AVL data structure. Each tree function package includes + functions to insert a node, delete a node, find the node corresponding to a + specified key, and sort the nodes in ascending order of keys. + + The hash storage utilities also provide an efficient data structure for + rapid searches. Collision is handled by using linked lists at each hash node. + This approach involves a lower overhead than the tree based structures at the + expense of somewhat less efficient storage utilization when nodes are sparse. + Considerable work has been done on hash key generation, and the user may wish + to replace the simple hval function supplied in the library with another + tailored to his application. + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + Sort Functions: +------------------------------------------------------------------------------- + +ssort + + Conduct a Shell sort of the array v[] with comparison function comp. + + void ssort(void *v,int n,int (*comp)()) + v = array of pointers to sort input + (pointers index sorted array at exit) + n = dimension of input array + comp = pointer to comparison function (see numcmp for example) + + ----------------------------------------------------------------- + +hsort + + Perform a heap sort with comparison function comp on the array v[]. + + void hsort(void *v,int n,int (*comp)()) + v = array of pointers to sort input + (pointers index sorted array at exit) + n = dimension of input array + comp = pointer to comparison function (see numcmp for example) + + ------------------------------------------------------------------- + +qsrt + + Quicksort algorithm for sorting array v[] with comparison function comp. + + void qsrt(void *v,int i,int j,int (*comp)()) + i = start index of array (normally i=0 at top level) + j = maximum index of array (= dimension-1) + v = array of pointers to sort array + (pointers index sorted array at exit) + comp = pointer to comparison function (see numcmp) + + + The quicksort function is recursive. It may require an increase + in stack size when a large array is sorted. + + --------------------------------------------------------------------- + +msort + + Merge sort a linked list using comparison function comp. + + struct llst *msort(struct llst *st,int dim,int (*comp)()) + st = pointer to head of linked list + dim = length of list + comp = pointer to comparison function (see numcmp) + return value: ps = pointer to head of sorted list + + The msort function generally yields the fastest internal + sorts. The function is recursive (see the note following + qsrt above). The linked list structure, used in msort, + is defined in the header files merge.h (listed below) + and ccmath.h. The list is terminated by a NULL pointer. + + merge.h + + #ifndef NULL + #define NULL 0L + #endif + struct llst {char *pls; struct llst *pt;}; + + ------------------------------------------------------------- + +numcmp + + Numcmp contains numeric comparison functions for double or float and + integer variables. (It can easily be extended to other types.) + The return convention is identical to that used by the standard + library function 'strcmp'. + ---------------------------------------------------------------- + +dubcmp + + Compare double or float values. + + int dubcmp(double *x,double *y) + x = pointer to first value + y = pointer to second value + return values: 0 -> *x = *y + 1 -> *x > *y + -1 -> *x < *y + + ------------------------------------- + +intcmp + + Compare signed integer variables. + + int intcmp(int *x,int *y) + x = pointer to first value + y = pointer to second value + return values: 0 -> *x = *y + 1 -> *x > *y + -1 -> *x < *y + +unicmp + + Compare unsigned integer values. + + int unicmp(unsigned *x,unsigned *y) + x = pointer to first value + y = pointer to second value + return values: 0 -> *x = *y + 1 -> *x > *y + -1 -> *x < *y + +------------------------------------------------------------------------------- + + Search Functions: +------------------------------------------------------------------------------- + + Trees + + The header file tree.h, whose contents are reproduced in ccmath.h, is + used by all the binary tree functions to define the basic node data + structure. A signal parameter BAL is used to distinguish balanced trees from + ordinary binary trees. If BAL is defined, a balanced tree is assumed. + Otherwise the tree structure is a simple binary tree. The header node of a + tree is assumed to contain a dummy key that is lexically less than any key + value in the tree. The search code assumes that this header node is present. + + tree.h + + #ifndef NULL + #define NULL 0L + #endif + #ifdef BAL + struct tnode {char *key,*rec; int bal; struct tnode *pr,*pl;}; + #else + struct tnode {char *key,*rec; struct tnode *pr,*pl;}; + #endif + -------------------------------------------------------------------- + +btins + + Insert a node in a binary tree structure. + + struct tnode *btins(char *kin,struct tnode *hd) + kin = pointer to input search key string + hd = pointer to head node of tree + return value: p = pointer to matching tree node + (may be a new node allocated by the function) + + ---------------------------------------------------------------- + +btdel + + Delete a node with a specified key from a binary tree structure. + + int btdel(char *kin,struct tnode *hd) + kin = pointer to input search key string + hd = pointer to head node of tree + return value: status flag, with + 0 -> no matching node in tree + 1 -> node found and deleted + + ------------------------------------------------------ + +tsearch + + Search a binary tree for a node with the specified key. + + struct tnode *tsearch(char *kin,struct tnode *hd) + kin = pointer to input search key string + hd = pointer to head node of tree + return value: p = pointer to matching node of tree + p = NULL -> no such node + + --------------------------------------------------------------- + +tsort + + Sort a binary tree's nodes in ascending key order. + + void tsort(struct tnode *hd,struct tnode **ar) + hd = pointer to the header node of the tree + ar = pointer to array loaded with sorted node list + + ---------------------------------------------------------- + +prtree + + Print a map of the node structure of a binary tree segment. + + void prtree(struct tnode *hd,int m) + hd = pointer to starting node of tree segment + m = depth to which tree structure is to be printed + (depth is relative to starting node) + + + This function is useful for displaying the structure of + relatively short tree subsegments in test code. + +------------------------------------------------------------------------------- + + Balanced (AVL) Trees: +------------------------------------------------------------------------------- + + The balanced (AVL) tree functions include a definition of BAL to signal + compilation with the proper node structure. The balance flag (int bal) must + be included in the structure for balanced trees. Thus, + + #define BAL 1 + + must appear before ccmath.h or tree.h is referenced to ensure a correct + definition of the tree structure. + +------------------------------------------------------------------------------- + +batins + + Insert a node with the specified key in a balanced tree. + + struct tnode *batins(char *kin,struct tnode *hd) + kin = pointer to input search key string + hd = pointer to head node of tree + return value: p = pointer to matching tree node + (may be a new node allocated by the function) + + ---------------------------------------------------------------- + +batdel + + Delete the node matching the specified tree from a balanced tree. + + int batdel(char *kin,struct tnode *hd) + kin = pointer to input search key string + hd = pointer to head node of tree + return value: status flag, with + 0 -> no matching node in tree + 1 -> node found and deleted + + ----------------------------------------------------- + +btsearch + + Search a balanced tree for the node matching a specified key. + + struct tnode *btsearch(char *kin,struct tnode *hd) + kin = pointer to input search key string + hd = pointer to head node of tree + return value: p = pointer to matching node of tree + p = NULL -> no such node + + ----------------------------------------------------------- + +btsort + + Sort the nodes of a balanced tree in ascending key order. + + void btsort(struct tnode *hd,struct tnode **ar) + hd = pointer to the header node of the tree + ar = pointer to array loaded with sorted node list + + ------------------------------------------------------------- + +prbtree + + Print the node map of a balanced tree segment. + + void prbtree(struct tnode *hd,int m) + hd = pointer to starting node of tree segment + m = depth to which tree structure is to be printed + (depth is relative to starting node) + + + This function is useful for displaying the structure of + relatively short tree subsegments. + + +------------------------------------------------------------------------------- + + Scatter Storage (Hashing): +------------------------------------------------------------------------------- + + The hash table structure used by scatter storage functions is defined + in the header files hash.h listed below, and in ccmath.h. + + hash.h + + #ifndef NULL + #define NULL 0L + #endif + struct tabl {char *key,*val; struct tabl *pt;}; + + Either hash.h or ccmath.h must be included when the hash functions are used. + +------------------------------------------------------------------------------- + +hashins + + Insert a node into a scatter storage (hashed) structure. + + struct tabl *hashins(char *kin,struct tabl *ha[],int mh) + kin = pointer to key string of insert + ha = hash array of pointers to struct tabl nodes + mh = dimension of hash array ha + return value: p = pointer to the inserted node + (storage for node is allocated by the function) + + -------------------------------------------------------------- + +hashdel + + Delete a node from a scatter storage structure. + + int hashdel(char *kin,struct tabl *ha[],int mh) + kin = pointer to key string of insert + ha = hash array of pointers to struct tabl nodes + mh = dimension of hash array ha + return value: status flag, with + 0 -> no such node + 1 -> node found and deleted + + -------------------------------------------------------- + +hfind + + Find the hashed node corresponding to a specified key. + + struct tabl *hfind(char *kin,struct tabl *ha[],int mh) + kin = pointer to key string to be located + ha = hash array of pointers to struct tabl nodes + mh = dimension of hash array ha + return value: p = pointer to record with key (kin) + p=NULL -> no such record + + -------------------------------------------------------------- + +hval + + Compute the hash array address of a key string. + + int hval(char *key,int mh) + char *key; + key = pointer to input key string + mh = dimension of hash array + return value: k = harray address of this key (0 <= k < mh) diff --git a/manual/C11-tseries b/manual/C11-tseries new file mode 100644 index 0000000..cc14fe2 --- /dev/null +++ b/manual/C11-tseries @@ -0,0 +1,725 @@ + Chapter 11 + + TIME SERIES ANALYSIS + + Summary + + Time series functions support the use of models + in practical applications requiring analysis + and/or forecasting of series. The basic + time-domain model is a series of the + autoregressive moving average (ARMA) type. The + software can successfully deal with + generalizations, such as integrated (ARIMA) + models and factor models. Specific areas covered + are: + + o Generation and Prediction of ARMA Time Series + o Estimation of ARIMA Model Parameters + o Estimation of Factor Model Parameters + o Model Identification and Evaluation + o Time Series Utility Operations + + Factor models are a powerful generalization of + the Box-Jenkins approach. They support the + extraction of meaningful quantitative measures + from series with highly correlated noise. + +------------------------------------------------------------------------------- + + Notes on Contents + + The functions of this library segment are used for the analysis and + estimation of Box Jenkins time series models. These models have been + applied to a wide range of problems in forecasting, process control, and + the characterization of time series. Both standard ARIMA models and an + important generalization to factor models can be identified and estimated. + + o Generation and Prediction of ARMA Time Series: + + sarma -------- generate successive terms in an ARMA series. + parma -------- predict the values of an ARMA time series. + + + o Estimate the Parameters of an ARIMA Model: + + evmod -------- compute the residual of an ARIMA series. + drmod -------- compute the model residual and the derivatives + with respect to model parameters. + seqts -------- perform a sequential update of model parameters. + fixts -------- perform a batch mode, Gauss-Newton update of + the ARIMA model parameters. + + + o Estimate the Parameters of a Factor Model: + + evfmod ------- compute the residual in a time series Factor model. + drfmod ------- compute the model residual and the derivatives + with respect to model parameters for a Factor model. + seqtsf ------- perform a sequential update of Factor model parameters. + fixtsf ------- compute a batch mode, Gauss-Newton, update of Factor + model parameters. + + + o Model Identification and Evaluation: + + sany -------- compute both direct and inverse autocorrelation + coefficients of a time series. + resid ------- analyze the residuals of a time series model. + + The residuals of a model should be consistent with the assumption that + the series is driven by "white" noise. Several tests of this hypothesis are + applied in the resid() function. + + + o Time Series Utility Operations: + + xmean ------- subtract the mean value of an input series from + each term. + sdiff ------- apply iterations of the sequential difference operator + to a series. + sintg ------- invert the sequential difference operation (ie. + integrate the series). + +------------------------------------------------------------------------------- + + General Technical Comments + + The fundamental ARMA model underlying such applications is a stationary + stochastic process driven by uncorrelated "white" noise. The model equation + takes the form + + x[i] = e[i] + Sum(j=1 to m) a[j]*x[i-la[j]] - + Sum(k=1 to n) b[k]*e[k-lm[k]] , + + where x[i] are the series values and e[i] are the values of the driving + noise. Nonstationary series can be addressed by employing differenced series, + with + + x[i] = D^d{ y[i] }, D is the difference operator + D{ y[i] } = y[i] - y[i-1] , + + and d is the order of difference. Models with d>0 are referred to as ARIMA + models, with the I standing for integrated. + + Factor models provide a powerful generalization of the time series model + in which a series has both a value y[i] and a condition code c(i) associated + with the "time" index i. The basic model equation takes the form + + y[i] = f[c[i]] + v[i] , + + where v[i] is an ARIMA model series. The condition index c[i] specifies a + factor parameter f, which represents a mean value corresponding to the coded + condition. This condition concept is quite general. The index c[i] can be + used to distinguish physical conditions at different times, effects periodic + in time, or epochs separated by a change in the environment. Factor models + are used to estimate a quantitative measure of the effect of changing + conditions from highly correlated input series. + + The estimation process for both ARIMA and Factor models employs a mix of + sequential and batch mode passes through the observed series. This + combination combines the powerful search capabilities of the sequential + technique with the refined estimates produced by using good initial + parameters in Gauss-Newton processing. Sequential estimation can also be used + to develop adaptive models. + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + External Variables for ARMA Models: +_______________________________________________________________________________ + + The header files arma.h and ccmath.h contain definitions of the basic + model specification structure used in the time series functions. One of + these header files must be included. + + arma.h + + #ifndef NULL + #define NULL 0L + #endif + struct mcof {double cf; int lag;}; + + The time series model's structure is specified in external arrays for + both autoregressive (par) and moving average (pma) parameters. Each element + of these structure arrays contains a model parameter (p->cf) and the lag + (p->lag) at which it acts. The external variables required for model + generation and estimation are listed below. Their declarations must appear + in any program that uses the ARMA model evaluation or estimation functions. + + struct mcof *par,*pma; + int nar,nma,np; + + par = pointer to store of structure array of autoregressive + parameters and lags (dimension=nar) + pma = pointer to store of structure array of moving average + parameters and lags (dimension=nma) + nar = number of autoregressive parameters + nma = number of moving average parameters + np = total number of parameters (np=nar+nma) + + The estimation functions assume that parameters are stored in a single + structure array. Allocation of this storage is illustrated by the the + following sequence. + + np=nar+nma; + par=(struct mcof *)calloc(np,sizeof(*par)); + pma=par+nar; + +------------------------------------------------------------------------------- + + ARMA Model Generation and Prediction: +------------------------------------------------------------------------------- + +sarma + + Generate successive terms in an autoregressive moving average (ARMA) + series. + + double sarma(double er) + double er; + er = value of the driving error input + return value: y = current term of series + + The model is generated by + + y[k] = er[k] + Sum(i=0 to nar-1){ par[i]->cf*y[k-par[i]->lag]} + - Sum(j=0 to nma-1){ pma[j]->cf*er[k-pma[j]->lag]} . + + The simulation must be initialized by a call of setsim. + +setsim + + void setsim(int k) + k = control flag, with + k=1 -> initialize simulation storage + k=0 -> free the storage allocated by setsim(1) + + + The storage initialized by setsim contains no history. + Lagged values of er and y are initially zero. The + generator is normally run through a number of initial + steps before storing simulated output. This serves to + eliminate transient startup effects. + + ----------------------------------------------------------------- + +parma + + Predict values of an ARMA time series. + + double parma(double *x,double *e) + x = pointer to storage of current series value + e = pointer to storage of current residual + return: xp = predicted value of series + + + Each call of parma generates a single step prediction. + Multi-step forward predictions are generated by multiple + calls with zeros loaded in the current residual. The + following code sequence generates a k-step prediction. + + for(i=0; icf*y[k-par[i]->lag]} + - Sum(j=0 to nma-1) {pma[j]->cf*ee[j-pma[j]->lag]} , + + where ee[k] = y[k] - yp[k] at "time" k. The lagged values of + observations and prediction error are automatically updated + by the function. + + A call of setev must be used to initialize storage for evmod. + +setev + + void setev(int k) + k = control flag, with + k=1 -> initialize storage + k=0 -> free storage initialized by setev(1) + + + The storage initialized by setev contains no history. + Lagged values of ee and y are initially zero. + + ----------------------------------------------------------------- + +drmod + + Compute the model residual and the derivatives of the predictor with + respect to model parameters (core function in model estimation). + + double drmod(double y,double *dr) + y = observed value of the time series + dr = pointer to array of derivatives of the predictor yp with + respect to model parameters (order nar-autoregressive + followed by nma-moving average, dimension = np) + return value: ee = y-yp, where yp is the value predicted by + the time series model + + + The derivatives evaluated by this function are + + dr[i] = Del(par[i]->cf){yp} for i=0 to nar-1 , and + + dr[nar+j] = Del(pma[j]->cf){yp} for j=0 to nma-1 , + + Here Del(t){x} denotes the partial derivative of x + with respect to the parameter t. The prediction + function yp is evaluated in the manner indicated + above (see evmod). + + A call to setdr must be used to initialize internal storage. + +setdr + + setdr(int k) + k = control flag, with + k=1 -> initialize internal storage + k=0 -> free storage initialized by setdr(1) + + + The storage initialized by setdr contains no history + Lagged values of ee and y are initially zero. + +------------------------------------------------------------------------------- + + ARMA Model Estimation: +------------------------------------------------------------------------------- + + The two estimation functions are complementary, since the sequential + form is an excellent search procedure while the Gauss-Newton algorithm + converges rapidly from a good estimate. In practice, the initial ARMA + parameters can normally be set to zero when estimation is started with + sequential passes. + +seqts + + Perform a sequential estimation update of the parameters of a + time series model. + + double seqts(double *x,int n,double *var,int kf) + x = pointer to input array containing observed values of the series + n = length of the input series + var = pointer to matrix array (np by np) proportional + to the updated parameter variance matrix at exit + (the constant of proportionality = ssq/(n-np), + index order nar autoregressive parameters + followed by nma moving average parameters) + kf = control flag, with + kf=0 -> initialize var to the identity matrix + kf=1 -> use the input var matrix + return value: ssq = sum of the squares of the model residuals + + + ssq = Sum(i=0 to n-1) { (yp[i] - x[i])^2 } , + + with yp[i] = prediction i-1 -> i + + --------------------------------------------------------------- + +fixts + + Perform a fixed Gauss-Newton estimation iteration to fit time series + model parameters. + + double fixts(double *x,int n,double *var,double *cr) + x = pointer to input array containing observed values of the series + n = length of the input series + var = pointer to matrix array (np by np) proportional + to the parameter variance matrix at exit + ( the constant of proportionality = ssq/(n-np) ) + cr = pointer to array of dimension np containing the parameter + corrections estimated by this function call + return value: ssq = sum of the squares of the model residuals + ssq = -1.0 -> singular var matrix + + + ssq = Sum(i=0 to n-1){ (yp[i] - x[i])^2 } + + with yp[i] = prediction i-1 -> i + + The index order for both cr and var is nar autoregressive + parameters followed by nma moving average parameters. + + +------------------------------------------------------------------------------- + + External Variables for Factor Models: +------------------------------------------------------------------------------- + + The basic factor model variables are delivered in a structure (of type + struct fmod), with components: + y.fac = integer encoding factor; and + y.val = corresponding value of series. + The structures employed in factor model estimation are defined in the + header files armaf.h and ccmath.h. One of these headers must be included. + + armaf.h + + #ifndef NULL + #define NULL 0L + #endif + struct mcof {double cf; int lag;}; + struct fmod {int fac; double val;}; + + The structure of the model is specified in an external structure array, + including factor parameters (pfc), autoregressive parameters (par), and + moving average parameters (pma). Coefficients (p->cf) and lags (p->lag) are + required for autoregressive and moving average parameters. Only the + coefficient is employed for factors. Model parameters are delivered to + estimation and evaluation functions by the following external variables. + Their declarations must appear in any program that calls the factor model + evaluation and estimation functions. + + struct mcof *pfc,*par,*pma; + int nfc,nar,nma,ndif,np; + + pfc = pointer to store of structure array containing + factor parameters (dimension=nfc) + par = pointer to store of structure array of autoregressive + parameters and lags (dimension=nar) + pma = pointer to store of structure array of moving average + parameters and lags (dimension=nma) + nfc = number of factor parameters + nar = number of autoregressive parameters + nma = number of moving average parameters + np = total number of parameters (np=nfc+nar+nma) + ndif = order of difference used + + The factor model estimation functions assume that the parameters are stored + in a single array. Allocation of external storage in the calling program + should employ a code sequence such as, + + np=nfc+nar+nma; + pfc=calloc(np,sizeof(*pfc)); + par=pfc+nfc; pma=par+nar; + + if the estimation functions are to be used. + +------------------------------------------------------------------------------- + + Factor Model Evaluation: +------------------------------------------------------------------------------- + +evfmod + + Compute the residual in a factor model. + + double evfmod(struct fmod y) + y = structure containing: + y.val = difference, of order ndif, of observed values + the of time series, and + y.fac = factor corresponding to current value + return value: ee = y.val - yp, where yp is the value predicted + by the model + + + The model prediction yp is based on the lagged values of the + observations and estimated errors computed by evfmod. The + prediction is simply an ARMA model prediction with a mean, + computed by differencing the factor averages, imposed. + + yp = D^d{f(k)} + Sum(i=0 to nar-1){ par[i]->cf*y[k-par[i]->lag] } + - Sum(j=0 to nma-1){ pma[j]->cf*ee[k-par[k]->lag] } . + + Here D denotes the difference operator (see sdiff), + pcf[m(t)]->cf = f(k) , y[t]->fac = m(t) , and d = ndif . + + The one-step prediction errors ee are identical to those we + would obtain without differencing the values of the input series. + + A call to setevf must be used to initialize internal storage. + +setevf + + void setevf(int k) + k = control flag, with + k=1 -> initialize storage + k=0 -> free storage initialized by setevf(1) + + The storage initialized by setevf contains no history. + Lagged values of er, y.val, and factor indices are + initially zero. + + ------------------------------------------------------------------- + +drfmod + + Compute the model residual and the derivatives of the predictor with + respect to model parameters (core estimation function). + + double drfmod(struct fmod y,double *dr) + y = structure containing: + y.val = difference, of order ndif, of observed values + the of time series, and + y.fac = factor corresponding to current value + dr = pointer to array of derivatives of the predictor yp + with respect to model parameters (order nfc-factor , + nar-autoregressive , nma-moving average) + return value: ee = y.val - yp, where yp is the value predicted + by the model + + + The derivatives computed by drfmod() are: + dr[m] = Del(par[m]->cf){ yp} for m=0 to nfc-1, + dr[nfc+i] = Del(par[i]->cf){ yp} for i=0 to nar-1, and + dr[nfc+nar+j] = Del(pma[j]->cf){ yp} for j=0 to nma-1 . + + Here Del(t){x} denotes the partial derivative of x + with respect to the parameter t. The prediction yp is + identical to that discussed above (see evfmod). + + The internal storage used by drfmod must be initialized by a + call of setdrf. + +setdrf + + setdrf(int k) + k = control flag, with + k=1 -> initialize storage + k=0 -> free storage initialized by setdrf(1) + + + The storage initialized by setdrf contains no history. + Lagged values of er, y.val and factor indices are + initially zero. + +------------------------------------------------------------------------------- + + Factor Model Estimation: +------------------------------------------------------------------------------- + + The two estimation functions are complementary, since the sequential + form is an excellent search procedure while the Gauss-Newton algorithm + converges rapidly from a good estimate. In practice, the initial ARMA + parameters can normally be set to zero and a series mean used for initial + factor parameters. The estimation starts with a sequential search, and + fixed estimation is employed for the final passes. + + +seqtsf + + Perform a sequential estimation update of the parameters of a time + series factor model. + + double seqtsf(struct fmod *x,int n,double *var,int kf) + x = pointer to input structure array containing + x[i].val = difference, of order ndif, of observed + values the of time series, and + x[i].fac = factor corresponding to "time" i + n = length of the input series + var = pointer to matrix array (np by np) proportional to + the updated parameter variance matrix at exit + (the constant of proportionality = ssq/(n-np), + index order nfc factor parameters, nar + autoregressive parameters, nma moving + average parameters) + kf = control flag, with + kf=0 -> initialize var to the identity matrix + kf=1 -> use the input var matrix + return value: ssq = sum of the squares of the model residuals + + + ssq = Sum(i=0 to n-1){ (yp[i] - x[i])^2 } + + yp[i] = prediction i-1 > i + + If ndif>0, the variance matrix, var, is constrained to be + orthogonal to the vector u, defined by: + u[i] = 1 for i=0 to nfc-1, and u[i] = 0 for i >= nfc. + Thus, V*u = 0 , where V[i,j] = var[np*i+j] , and the + computed variance matrix V is singular when ndif>0. + + --------------------------------------------------------------------- + +fixtsf + + Perform a fixed Gauss-Newton estimation iteration to update + parameters of a time series factor model. + + double fixtsf(struct fmod *x,int n,double *var,double *cr) + x = pointer to input structure array containing + x[i].val = difference, of order ndif, of observed values + the of time series, and + x[i].fac = factor corresponding to "time" i + n = length of the input series + var = pointer to matrix array (np by np) proportional to the + updated parameter variance matrix at exit + (the constant of proportionality = ssq/(n-np) ) + cr = pointer to array of dimension np containing the parameter + corrections estimated by this iteration + return value: ssq = sum of the squares of the model residuals + + + ssq = Sum(i=0 to n-1){ (yp[i] - x[i])^2 } + + yp[i] = prediction i-1 -> i + + The index order for both cr and var is nfc factor parameters + followed by nar autoregressive parameters followed by nma moving + average parameters. The constraint on var, defined above (see + seqtsf), applies when ndif>0. + + +------------------------------------------------------------------------------- + + Model Identification and Evaluation: +------------------------------------------------------------------------------- + +sany + + Compute the direct and inverse autocorrelation coefficients + of a time series to support model identification. + + int sany(double *x,int n,double *pm,double *cd,double *ci, \ + int nd,int ms,int lag) + x = pointer to start of input series + (The series values are altered by the function, at exit the + power spectra is stored in the array, starting at x+ndif. ) + n = length of input series + pm = pointer to store for mean value (xm) of series + cd = pointer to array to be loaded with direct + autocorrelation coefficients (i = 1 to lag) + cd[0] = 2nd moment of direct series + ci = pointer array to be loaded with inverse + autocorrelation coefficients (i = 1 to lag) + ci[0]= 2nd moment of inverse series + nd = order of differencing applied to input series + (If nd=0, the mean is subtracted.) + ms = order of smoothing of spectra + lag = maximum lag for which direct and inverse + autocorrelations are computed + return value: n = length of series used in Fourier + analysis of correlations + + + The direct and inverse autocorrelations are computed by applying + an inverse Fourier transform to the complex series + + { ps(w[j]) , 1./ps(w[j]) }, where ps(w[j]) + + is the power spectra of the input series. Direct autocorrelations + have a simple pattern for pure moving average series, while inverse + autocorrelations are simple for pure autoregressive series. + + ---------------------------------------------------------------------- + + resid + + Perform an analysis of the residuals of a time series model. + + int resid(double *x,int n,int lag,double **pac,int nbin, \ + double xa,double xb,int **phs,int *cks) + x = pointer to start of input series of model residuals + (one-step prediction errors). (This series is altered + to an unsmoothed power spectra by the function.) + n = length of input series + pac = pointer to array containing: + *pac = sum of squares over series + *(pac+k) = kth autocorrelation coefficient, for k=1 to lag + lag = maximum autocorrelation lag desired + nbin = number of histogram bins ( bin size = (xb-xa)/nbin ) + xa = lower limit of error histogram + xb = upper limit of error histogram + phs = pointer to store of error histogram, with + *(phs-1) = number of residuals xb + *(phs+i) = number in ith bin i=0,1, - ,nbin-1 + cks = pointer to array containing Kolmogorav-Smirnov statistics, + based on cumulative power spectra, with + cks[0] = points outside .25 significance threshold + cks[1] = points outside .05 significance threshold + return value: n = series length used in power spectra computation + + + The autocorrelations have an asymptotic large sample distribution + with variance ra2 = 1/(n-np) , where np is the number of + model parameters employed. The cumulative spectra is computed using + + I(j) = I(j-1) + ps(w[j]) + ps(w[j-1]) , + + for j = 1,2, -- ,n/2 , starting with I(0) = 0. Storage allocated + for autocorrelation and histograms may be released with free(pac) + and free(phs-1) respectively. + + +------------------------------------------------------------------------------- + + Utility Series Operations: +------------------------------------------------------------------------------- + +xmean + + Subtract the mean value of a series from each term. + + double xmean(double *x,int n) + x = pointer to start of input series + (at exit each term is modified by subtracting the mean xm) + n = length of the series + return value: xm = series mean + + + xm = { Sum(i=0 to n-1) x[i] }/n + + ----------------------------------------------------------------- + +sdiff + + Apply iterations of the sequential difference operator to a series. + + double sdiff(double y,int nd,int k) + y = current value of time series (in sequence) + nd = order of differencing (1 <= nd <= 6) + k = control flag, with + k=0 -> set initial differences to zero + k!=0 -> normal operation + return value: u = value of series with difference order nd + + ---------------------------------------------------------------- + +sintg + + Invert the differencing of a time series (integration). + + double sintg(double y,int ndint ,k) + y = current value of series + nd = order of integration (1<= nd <=6 + inverse of difference operation) + k = control flag, with + k=0 -> set initial sums to zero + k!=0 -> normal operation + return value: u = value of series integrated to order nd + + + The use of zeros for initialization implies that the first + correctly differenced (integrated) term in a sequence will + have index nd. The action of these operators is specified by + + D^m{x[j]} = Sum(i=0 to m) { [m!/i!*(m-i)!](-1)^i *x[j-i] } + + I^n{x[j]} = Sum(j=0 to n) { [n!/j!(n-j)!] *x[j-i] } diff --git a/manual/C12-complex b/manual/C12-complex new file mode 100644 index 0000000..51d3f46 --- /dev/null +++ b/manual/C12-complex @@ -0,0 +1,358 @@ + Chapter 12 + + COMPLEX ARITHMETIC + + Summary + + The complex arithmetic library contains functions + for: + + o Basic arithmetic Operations + o A Library of Elementary Functions + + The functions accept and return complex numbers + represented as an ordered pair of doubles. + +------------------------------------------------------------------------------- + + Notes on Contents + + o Basic Arithmetic Operations: + + carith ------- perform basic operations of multiplication, + division, addition, subtraction, multiplication + by a real or imaginary number, complex conjugation, + changing the sign, and computing the modulus or + its square. + + o Complex Elementary Functions: + + csqrt -------- compute the square root. + cexp --------- complex exponent function. + clog --------- complex natural logarithm. + ctrig -------- complex trigonometric functions sine, cosine and + tangent. + citrg -------- complex inverse trigonometric functions, on their + principal branches. + chypb -------- complex hyperbolic functions sinh, cosh, and tanh. + cihyp -------- complex inverse hyperbolic functions, on their + principal branches. + +------------------------------------------------------------------------------- + + General Technical Comments + + Complex arithmetic is supported by functions implementing the basic + operations and a library of elementary transcendental functions. The basic + form of a complex number is + + z = (re) + i*(im) , + + with both the real (re) and imaginary parts (im) taking double precision real + values. + + Conventions selected for the elementary functions that have branch cuts + in the complex z-plane conform to standards for principal branches recommended + in reference [a]. + + References + + [a]. W. Kahan, "Branch Cuts for Elementary Functions," in + "The State of the Art in Numerical Analysis," edited + by A. Iserles and M. J. D. Powell, Oxford Univ. Press, + 1987, pp. 165. + +_______________________________________________________________________________ + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + The header files complex.h (listed below) and ccmath.h define a complex + variable and contain declarations of the library functions. + + complex.h + + #ifndef CPX + struct complex {double re,im;}; + typedef struct complex Cpx; + #define CPX 1 + #endif + #include + struct complex cadd(),csub(),cmul(),cdiv(); + struct complex crmu(),cimu(),ccng(),cdef(); + double cabs(),cnrm(); + struct complex csqrt(),cexp(),clog(); + struct complex csin(),ccos(),ctan(); + struct complex casin(),cacos(),catan(); + + ------------------------------------------------------------------ + +carith + + Perform the basic arithmetic operations on complex variables. + + Multiplication c = s * t + + struct complex cmul(struct complex s,struct complex t) + s,t = complex arguments + return value: c = s*t + --------------------------------------------------------- + + Division c = s / t + + struct complex cdiv(stuct complex s,struct complex t) + s,t = complex arguments + return value: c = s/t + --------------------------------------------------------- + + Addition c = s + t + + struct complex cadd(struct complex s,struct complex t) + s,t = complex arguments + return value: c = s+t + --------------------------------------------------------- + + Subtraction c = s - t + + struct complex csub(struct complex s,struct complex t) + s,t = complex arguments + return value: c = s-t + ---------------------------------------------------------- + + Multiply by a real a, c = a * z + + struct complex crmu(double a,struct complex z) + a = real multiplier + z = complex input + return value: c = a*z + ----------------------------------------------------------- + + Multiply by an imaginary number i, c = i * z + + struct complex cimu(double i,struct complex z) + i = imaginary multiplier + z = complex input + return value: c = i*z + ------------------------------------------------------------ + + Take the complex conjugate c = z* + + struct complex ccng(struct complex z) + struct complex z; + z = complex input + return value: c = z* + ----------------------------------------------------- + Initialize a complex number c = r + i*s + + struct complex cdef(double r,double s) + r = real part of number + s = imaginary part of number + return value: c = r+i*s + ------------------------------------------------------ + + Compute the modulus r = | z | + + double cabs(struct complex z) + z = complex input + return value: r = |z| (real) + ------------------------------------------------------ + + Compute the squared modulus r^2 = z * z* + + double cnrm(struct complex z) + z = complex input + return value: r2 = z*z* (real) + +------------------------------------------------------------------------------- + +csqrt + + Compute the square root of a complex argument c = sqrt(z). + + struct complex csqrt(struct complex z) + z = complex input + return value: f = sqrt(z) + + + principal branch: z = r exp(i*a) with -pi < a <= pi + + f = sqrt(r) exp(i*a/2) . + + ----------------------------------------------------------- + +cexp + + cexp + + Compute exponent exp(z) of a complex argument. + + struct complex cexp(struct complex z) + z = complex input + return value: e = exp(z) + + clog + + Compute the natural logarithm of a complex argument. + + struct complex clog(struct complex z) + z = complex input + return value: f = log(z) + + + principal branches: e = r exp(i*a) with -pi < a <= pi + + f = log(r) + i*a + + --------------------------------------------------------------- + +ctrig + + Evaluate the trigonometric functions for a complex argument. + + csin + + struct complex csin(struct complex z) + z = complex input + return value: fs = sin(z) + + ccos + + struct complex ccos(struct complex z) + z = complex input + return value: fc = cos(z) + + ctan + + struct complex ctan(struct complex z) + z = complex input + return value: ft = tan(z) + + ------------------------------------------------------ + +citrg + + Evaluate the inverse trigonometric functions for complex arguments. + + casin + + struct complex casin(struct complex z) + z = complex input + return value: f = asin(z) + + + principal branch: z-plane cuts on real axis 1 to infinity + and -1 to -infinity. + + f = r + i*s with -pi/2 <= r < pi/2 for s >= 0 + and -pi/2 < r <= pi/2 for s < 0 + + cacos + + struct complex cacos(struct complex z) + z = complex input + return value: f = acos(z) + + + principal branch: z-plane cuts on real axis 1 to infinity + and -1 to -infinity + + f = r + i*s with 0 <= r < pi for s >= 0 + and 0 < r <= pi for s < 0 + + catan + + struct complex catan(struct complex z) + z = complex input + return value: f = atan(z) + + + principal branch: z-plane cuts on imaginary axis i to i*infinity + and -i to -i*infinity + + f = r + i*s with -pi/2 < r <= pi/2 for s >= 0 + and -pi/2 <= r < pi/2 for s < 0 + +------------------------------------------------------------------------------- + + The complex hyperbolic functions are defined by + + cosh(z) = cos(i*z) + acosh(z) = f = log(z + sqrt(z*z -1)) + sinh(z) = -i*sin(i*z) asinh(z) = i*asin(-i*z) + tanh(z) = -i*tan(i*z) atanh(z) = i*atan(-i*z) + +------------------------------------------------------------------------------- + +chypb + + Evaluate the hyperbolic functions for complex arguments. + + csinh + + struct complex csinh(struct complex z) + z = complex input + return value: f = sinh(z) + + ------------------------------------------------------------ + + ccosh + + struct complex ccosh(struct complex z) + z = complex input + return value: f = cosh(z) + + ------------------------------------------------------------- + + ctanh + + struct complex ctanh(struct complex z) + z = complex input + return value: f = tanh(z) + +------------------------------------------------------------------------------- + +cihyp + + Evaluate the inverse hyperbolic functions for complex arguments. + + casinh + + struct complex casinh(struct complex z) + z = complex input + return value: f = asinh(z) + + principal branch: z-plane cuts on imaginary axis i to i*infinity + and -i to -i*infinity + + f = r + i*s with -pi/2 < s <= pi/2 for r >= 0 + and -pi/2 <= s < pi/2 for r < 0 + + ------------------------------------------------------------------- + + cacosh + + struct complex cacosh(struct complex z) + z = complex input + return value: f = acosh(z) + + principal branch: z-plane cut on real axis 1 to -infinity + + f = r + i*s with -pi/2 < s <= pi/2 , r >= 0 for s >= 0 , + and r > 0 for s < 0 + + This choice makes acosh(z) single valued on the + real z-axis when z > 1. + + ---------------------------------------------------------------- + + catanh + + struct complex catanh(struct complex z) + z = complex input + return value: f = atanh(z) + + + principal branch: z-plane cuts on real axis 1 to infinity and + -1 to -infinity + + f = r + i*s with -pi/2 <= s < pi/2 for r >= 0 + and -pi/2 < s <= pi/2 for r < 0 diff --git a/manual/C13-xarm b/manual/C13-xarm new file mode 100644 index 0000000..2e7230b --- /dev/null +++ b/manual/C13-xarm @@ -0,0 +1,595 @@ + Chapter 13 + + HIGH PRECISION ARITHMETIC + + Summary + + The extended precision library implements a high + precision floating point arithmetic together with a + comprehensive set of support functions. The general + areas covered by these functions include: + + o Extended Precision Arithmetic + o Extended Precision Math Library + o Applications of High Precision Computation + + The math library support includes evaluation of + trigonometric, inverse trigonometric, hyperbolic, + logarithm, and exponential functions at the same + precision as the floating point math itself. + +------------------------------------------------------------------------------- + + Note on Contents + + o Extended Precision Floating Point Arithmetic: + + xadd -------- add/subtract two extended precision numbers. + xmul -------- multiply two extended precision numbers. + xdiv -------- divide two extended precision numbers. + xneg -------- change sign (xneg), compute absolute value (xabs), + extract exponent (xex), and test sign (neg) of + an extended precision number. + xpwr -------- raise an extended precision number to an integer + power (xpwr), or multiply it by a power of 2 (xpr2). + xprcmp ------ compare two extended precision numbers. + xtodub ------ convert an extended precision number to a double + (xtodub), a double to extended precision (dubtox), + or an integer to an extended precision number (inttox). + xfmod ------- analogs of standard library fmod (xfmod), and frexp + (xfrex) functions. + atox -------- convert a numerical string to an extended precision + number. + prxpr ------- print an extended precision number in scientific + format, or print the binary format as a string of + hexadecimal short integers (xprint). + + The arithmetic functions support the basic computation and input/output + operations needed for extended precision floating point mathematics. Some + of the operations supply capabilities designed to enhance the computational + efficiency of this arithmetic (e.g., 'xpwr'). + + o Extended Precision Math Library: + + xsqrt ------- compute the square root of an extended precision + number. + xexp -------- extended precision exponential function. + xlog -------- extended precision natural logarithm. + xtrig ------- extended precision sine (xsin), cosine (xcos), + and tangent (xtan) functions. + xivtrg ------ extended precision arcsine (xasin), arccosine + (xacos), and arctangent (xatan) functions. + xhypb ------- extended precision hyperbolic functions for + sinh (xsinh), cosh (xcosh), and tanh (xtanh). + + These functions provide the elementary function evaluations normally + supported in a C math library. They are designed to provide full precision + accuracy. + + o Applications of Extended Precision Arithmetic: + + xchcof ------- compute extended precision Tchebycheff expansion + coefficients. + xevtch ------- evaluate an extended precision Tchebycheff series. + + The Tchebycheff expansion supplied with the library can be used to + compute the Tchebycheff expansion coefficients of a function to an accuracy + of 32 digits. This ability is useful in developing high accuracy function + approximations, since the effect of rounding error on coefficients used in + double precision can effectively be eliminated with these inputs. + +------------------------------------------------------------------------------- + + General Technical Comments + + The full implementation of a floating point arithmetic is not commonly a + component included in a mathematical utility library. This enhancement is + included because we have found it invaluable in the analysis of problems that + may originate with the floating point arithmetic. The functions are all + implemented in a portable fashion in the C language. + + The IEEE 754 standard for floating point hardware and software is assumed + in the PC version of this library. The normal configuration of the library + employs a floating point mantissa of 102 bits, or approximately 32 decimal + digit precision. However, even higher precision is available as an option. + + An extended floating point number is represented as a combination of the + following elements: + + sign bit(s): 0 -> positive, 1 -> negative ; + exponent(e): 15-bit biased integer (bias=16383) ; + mantissa(m): 7 words of 16 bit length with the + leading 1 explicitly represented . + + Thus f = (-1)^s*2^[e-16383] *m , with 1 <= m < 2 . + + This format supports a dynamic range of: + + 2^16384 > f > 2^[-16383] or + + 1.19*10^4932 > f > 1.68*10^-[4932]. + + Special values of the exponent are: + + all ones -> infinity (floating point overflow) + all zeros -> number = zero. + + Underflow in operations is handled by a flush to zero. Thus, a number with + the exponent zero and nonzero mantissa is invalid (not-a-number). + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + The header files for extended precision arithmetic are xpre.h and + constant.h. The ccmath.h header file can be used in place of xpre.h and + constant.h if desired. The xpre.h file contains a definition of the basic + structure of an extended precision number (struct xpr), and declarations + for the library functions. Either ccmath.h or the pair xpre.h and + constant.h must be included in order to use high precision arithmetic. + + xpre.h + + #define XDIM 7 + struct xpr {unsigned short nmm[XDIM+1];}; + extern unsigned short m_sgn,m_exp; + extern short bias; + extern int itt_div,k_tanh; + extern int ms_exp,ms_trg,ms_hyp; + extern short max_p,k_lin; + extern short d_bias,d_max,d_lex; + extern struct xpr zero,one,two,ten; + extern struct xpr x_huge; + extern struct xpr pi,pi2,pi4; + extern struct xpr ee,srt2,ln2; + struct xpr xadd(),xmul(),xdiv(),atox(); + struct xpr dubtox(),inttox(),sfmod(),xpwr(),xpr2(); + struct xpr xneg(),xabs(),xfrex(),xfmod(); + double xtodub(); + struct xpr xtan(),xsin(),xcos(); + struct xpr xatan(),xasin(),xacos(),xatan2(); + struct xpr xsqrt(),xexp(),xlog(); + struct xpr xtanh(),xsinh(),xcosh(); + + The constant.h file defines constants used by the library functions. + Extended precision constants in this header file represent pi/4, pi/2, + pi, e, log(2), and sqrt(2) respectively. + + constant.h + + unsigned short m_sgn=0x8000,m_exp=0x7fff; + short bias=16383; + int itt_div=2,k_tanh=5; + int ms_exp=21,ms_hyp=25,ms_trg=31; + short max_p=16*XDIM,k_lin= -8*XDIM; + short d_bias=15360,d_max=2047,d_lex=12; + struct xpr zero={0x0,0x0}; + struct xpr one={0x3fff,0x8000}; + struct xpr two={0x4000,0x8000}; + struct xpr ten={0x4002,0xa000}; + struct xpr x_huge={0x7fff,0x0}; + struct xpr pi4={0x3FFE,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; + struct xpr pi2={0x3FFF,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; + struct xpr pi={0x4000,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; + struct xpr ee={0x4000,0xADF8,0x5458,0xA2BB,0x4A9A,0xAFDC,0x5620,0x273D}; + struct xpr ln2={0x3FFE,0xB172,0x17F7,0xD1CF,0x79AB,0xC9E3,0xB398,0x3F3}; + struct xpr srt2={0x3FFF,0xB504,0xF333,0xF9DE,0x6484,0x597D,0x89B3,0x754B}; + + The precision of extended precision arithmetic functions can be altered + by changing the parameters in these header files and recompiling the source + code. Changes required are indicated here. (It is assumed that the length + of the exponent field is not changed.) + + 1. In 'xpre.h' alter XDIM to the new length of the mantissa. + + 2. In 'constant.h' alter the following parameters: + itt_div , k_tanh , ms_exp , ms_hyp , and ms_trg + to values consistent with the new precision. + + Set the values of pi4, pi2, pi, ee, ln2, and srt2 to + values that provide full accuracy in the new mantissa. + + Alternative versions of these header files for mantissa lengths up to 31*16 + bits are available. + +------------------------------------------------------------------------------- + + Basic Operations: +------------------------------------------------------------------------------- + +xadd + + Add (subtract) two extended precision numbers. + + struct xpr xadd(struct xpr s,struct xpr t,int f) + s = structure containing first number + t = structure containing second number + f = control flag, with 0 -> add inputs (s+t) + 1 -> subtract inputs (s-t) + return value: x = structure containing result + + ------------------------------------------------------- + +xmul + + Multiply two extended precision numbers. + + struct xpr xmul(struct xpr s,struct xpr t) + s = structure containing first number + t = structure containing second number + return value: x = structure containing product (x=s*t) + + ------------------------------------------------------------- + +xdiv + + Divide one extended precision number by a second. + + struct xpr xdiv(struct xpr s,struct xpr t) + s = structure containing numerator + t = structure containing denominator + return value: x = structure containing quotient (x=s/t) + +------------------------------------------------------------------------------- + + Useful Floating Point Operations: +------------------------------------------------------------------------------- + +xneg + + Functions to change sign (unary minus), compute absolute value, + extract the exponent, and test the sign of an extended precision + number. + + struct xpr xneg(struct xpr s) + s = structure containing input number + return value: x = structure containing negative of input (x= -s) + + ---------------------------------------------------------------- + +xabs + + struct xpr xabs(struct xpr s) + struct xpr s; + s = structure containing input number + return value: x = structure containing absolute value of s + + ------------------------------------------------------------- + +xex + + int xex(unsigned short *ps) + ps = pointer to first word of extended precision number + return value: e = exponent (power of 2) of the input number + + --------------------------------------------------------------- + +neg + + int neg(unsigned short *ps) + ps = pointer to first word of extended precision number + return value: s = sign flag, with + 0 -> positive input + 1 -> negative input + + + Note that xex and neg do not alter the input number! + + ------------------------------------------------------------ + +xpwr + + Functions for integer powers and multiplication by a power of two. + + struct xpr xpwr(struct xpr s,int n) + s = structure containing input number + n = power desired + return value: x = structure containing nth power of input (s)^n. + + ------------------------------------------------------------------- + +xpr2 + + struct xpr xpr2(struct xpr s,int m) + s = structure containing input number + m = power of two desired + return value: x = structure containing product s*2^m. + + ------------------------------------------------------------------ + +xprcmp + + Compare two extended precision numbers. + + int xprcmp(unsigned short *pa,unsigned short *pb) + pa = pointer to first component of number a + pb = pointer to first component of number b + return value: comparison flag, with + 1 -> *pa > *pb + 0 -> *pa = *pb + -1 -> *pa < *pb + + The input numbers are not altered by xprcmp! + + --------------------------------------------------------- + +xtodub + + Convert doubles and integers to extended precision and cast + extended precision numbers to doubles. + + double xtodub(struct xpr s) + s = structure containing extended precision input + return value: x = double precision float = s + + struct xpr dubtox(double y) + y = double precision floating point input + return value: x = structure containing extended equivalent (x=y) + + struct xpr inttox(int n) + n = integer input + return value: x = structure containing extended equivalent (x=n) + + ------------------------------------------------------------------- + +xfmod + + These functions are extended precision analogs of the standard library + fmod and frexp functions. + + struct xpr xfmod(struct xpr s,struct xpr t,int *p) + s = structure containing operand of fmod + t = structure containing base number (t!=0) + p = pointer to store for output integer m + return value: x = structure of extended number with same sign as s + and absolute value less than that of t, satisfying + s = m*t + x if s*t>0, or + s = -m*t +x if s*t<0 + + ------------------------------------------------------------------- + +xfrex + + struct xpr xfrex(struct xpr s,int *p) + s = structure containing operand + p = pointer to store for output exponent e + return value: x = structure of extended number satisfying + x = s*2^(-e) with (-1 < x <1). + + ----------------------------------------------------------------------- + +atox + + Convert a floating point number, expressed as an decimal ASCII string + in a form consistent with C, into the extended precision format. + + struct xpr atox(char *s) + s = pointer to null terminated ASCII string expressing a + decimal number + return value: u = structure containing input number in the + extended precision format. + + --------------------------------------------------------------------- + +prxpr + + Print an extended precision number in scientific format. + + void prxpr(struct xpr u,int lim) + u = structure containing number to be printed + lim = number of decimal digits to the right of the + decimal point (lim+1=total digits displayed) + + ----------------------------------------------------------- + +xprint + + Print an extended precision number as a string of hexadecimal + numbers. + + void xprint(struct xpr u) + u = structure containing number to be printed + + + The 'xprint' function supports a bit oriented analysis of + rounding error effects. + +------------------------------------------------------------------------------- + + Auxiliary Functions Supporting High Precision Math: +------------------------------------------------------------------------------ + + These routines support functions in the high precision library. + They are not normally called by a user. + +sfmod + + Special modular function to extract integer part of a number. + + struct xpr sfmod(struct xpr s,int *p) + s = structure containing input number + p = pointer to store for integer part of s + ( *p= -1 -> integer part > 2^15 , overflow) + return value: u = structure containing fractional part of s + + ---------------------------------------------------------------- + +shift + + Functions to shift the bits of extended precision structures + left/right. + + void lshift(int n,unsigned short *pm,int m) + pm = pointer to initial word to be shifted + (output left shifted n bits and zero filled + on the right) + n = number of bits to left-shift + m = number of words in shift structure + + void rshift(int n,unsigned short *pm,int m) + pm = pointer to initial word to be shifted + (output right shifted n bits and zero filled + on the left) + n = number of bits to right-shift + m = number of words in shift structure + + + The m-word structures pointed to by pm are changed + by the shift functions! + + --------------------------------------------------------------------------- + + Extended Precision Math Library: +---------------------------------------------------------------------------- + +xsqrt + + Compute the square root of an extended precision number. + + struct xpr xsqrt(struct xpr z) + z = structure containing the input number (z>=0) + return value: x = structure containing square root of input + + Input of a negative argument results in a printed error message. + + ----------------------------------------------------------------------- + +xexp + + Compute the exponential function. + + struct xpr xexp(struct xpr z) + z = structure containing function argument + return value: structure x = exp(z) + + --------------------------------------------------------- + +xlog + + Compute natural (base e) logarithms. + + struct xpr xlog(struct xpr z) + z = structure containing function argument (z>0) + return value: structure x = log(z) + + Input of z<=0 results in a printed error message. + + ------------------------------------------------------------ + +xtrig + +xtan + + Compute the trigonometric functions tan, cos, and sin. + + struct xpr xtan(struct xpr z) + z = structure containing function argument + return value: structure f = tan(z) + + ---------------------------------------------------------- + +xcos + + struct xpr xcos(struct xpr z) + z = structure containing function argument + return value: structure f = cos(z) + + ------------------------------------------------------- + +xsin + + struct xpr xsin(struct xpr z) + z = structure containing function argument + return value: structure f = sin(z) + + -------------------------------------------------------------------- + +xivtrg + + Compute the inverse trigonometric functions. + +xatan + + struct xpr xatan(struct xpr z) + z = structure containing function argument + return value: structure f = atan(z) (-pi/2 <= f <= pi/2) + +xasin + + struct xpr xasin(struct xpr z) + z = structure containing function argument (|z|<=1) + return value: structure f = asin(z) (-pi/2 <= f <= pi/2) + +xacos + + struct xpr xacos(struct xpr z) + z = structure containing function argument (|z|<=1) + return value: structure f = acos(z) (0 <= f <= pi) + + + Out-of-range values of z in xsin and xcos will produce + a printed error message from the square root function. + + ----------------------------------------------------------------- + +xhypb + + Compute the hyperbolic functions tanh, sinh, and cosh. + +xtanh + + struct xpr xtanh(struct xpr z) + z = structure containing function argument + return value: structure f = tanh(z) + + ----------------------------------------------------- + +xsinh + + struct xpr xsinh(struct xpr z) + z = structure containing function argument + return value: structure f = sinh(z) + + ---------------------------------------------------- + +xcosh + + struct xpr xcosh(struct xpr z) + z = structure containing function argument + return value: structure f = cosh(z) + + +------------------------------------------------------------------------------- + + + Extended Precision Applications: +------------------------------------------------------------------------------- + +xchcof + + Compute the Tchebycheff expansion coefficients of a specified function. + + xchcof(struct xpr *c,int m,struct xpr (*xfunc)()) + c = pointer to array of extended precision structures for + computed coefficients + m = maximum index of coefficient array (dimension=m+1) + xfunc = pointer to user defined function returning extended + precision values of the function f + + f(x) = c[0]/2 + Sum(k=1 to m) c[k]*Tk(x) , with + + Tk(x) the kth Tchebycheff polynomial. + + ------------------------------------------------------------------ + +xevtch + + Evaluate an extended precision Tchebycheff expansion. + + struct xpr xevtch(struct xpr z,struct xpr *a,int m) + z = structure containing function argument + a = structure array containing expansion coefficients + m = maximum index of coefficient array (dimension=m+1) + return value: function value f, with + + f(x) = Sum(k=0 to m) a[k]*Tk(x) . diff --git a/manual/C14-util b/manual/C14-util new file mode 100644 index 0000000..424d752 --- /dev/null +++ b/manual/C14-util @@ -0,0 +1,188 @@ + Chapter 14 + + UTILITIES + + Summary + + The utility operation functions support access to + individual bits in variables, and the display of + bit patterns for each of the standard C data + types. An efficient integer power function, + based on bit access, is included. + +------------------------------------------------------------------------------- + + Notes on Contents + + The utility functions implement some useful capabilities involving bit + operations on binary data. + + bit -------- set (bset), test (bget), and count (bcnt) the + bits in a (16-bit) word. + lbit ------- set (lbset), test (lbget), and count (lbcnt) the + bits in a (32-bit) long word. + bpat ------- display the bit pattern of a byte (bitpc 8-bits), + word (bitpn 16-bits), long word (bitpl 32-bits), + or double (bitpd 64-bits). + bpatx ------ display the bit pattern of an extended precision + number used in the extended precision segment of the + Numerical Analysis Library. + pwr -------- efficiently compute an integer power of a double + precision number. + + +------------------------------------------------------------------------------- + + General Technical Comments + + The utility functions assume two's complement integers. This is + currently valid for most UNIX work stations and personal computers. Bit + display functions are often useful in the diagnosis of floating point + arithmetic anomalies. They may be used in conjunction with the extended + precision arithmetic of the CCM library to investigate the impact of + truncated precision arithmetic on computations. IEEE 754 floating point + formats used by a standard floating point processor and emulation software + is assumed for the PC version of this library. + +------------------------------------------------------------------------------- + FUNCTION SYNOPSES +------------------------------------------------------------------------------- + + Operate on Bits: +------------------------------------------------------------------------------- + +bit and lbit + + Set, test, and count bits in a specified word (long word). + +bset + + unsigned short bset(unsigned short x,unsigned short n) + x = input word + n = bit to be set (rightmost = 0) + return value: x' = word with bit n set + + ----------------------------------------------------------- + +lbset + + unsigned int lbset(unsigned int x,int n) + x = input long word + n = bit to be tested (rightmost = 0) + return value: x' = long word with bit n set + + ---------------------------------------------------------- + +bget + + int bget(unsigned short x,unsigned short n) + x = input word + n = bit to be tested (rightmost = 0) + return value: f = test flag, with + 0 -> bit n not set (=0) + 1 -> bit n set (=1) + + ----------------------------------------------------------- + +lbget + + int lbget(unsigned int x,int n) + x = input long word + n = bit to be tested (rightmost = 0) + return value: f = test flag, with + 0 > bit n not set (=0) + 1 > bit n set (=1) + + ----------------------------------------------------- + +bcnt + + int bcnt(unsigned short x) + x = input word + return value: m = count of bits set in x + + ------------------------------------------------ + +lbcnt + + int lbcnt(unsigned int x) + x = input long word + return value: m = count of bits set in x + + +------------------------------------------------------------------------------- + + Display Bits of Operand: +------------------------------------------------------------------------------- + + Print the bit pattern of the operand, starting at the current cursor + location. + +bitpc + + void bitpc(unsigned char x) + x = input character (length= one byte) + + ------------------------------------------------ + +bitpn + + void bitpn(unsigned short x) + x = input short integer (length= two bytes) + + ------------------------------------------------- + +bitpl + + void bitpl(unsigned int x) + x = input integer (length= four bytes) + + -------------------------------------------------- + +bitpf + + void bitpf(float x) + x = input float + ( 1 sign bit, 8 exponent bits, 23 bit mantissa ) + + -------------------------------------------------- + +bitpd + + void bitpd(double x) + x = input double + ( 1 sign bit, 11 exponent bits, 52 bit mantissa ) + + --------------------------------------------------------------- + + The exponent field in floats and doubles is separated from + the mantissa by the '^' character. + +------------------------------------------------------------------------------- + + Extended Precision Patterns: +------------------------------------------------------------------------------- + + The header file ccmath.h or xper.h must be included when this + function is used. + +bpatx + + void bpatx(struct xpr x) + x = structure containing extended precision real number + ( 1 sign bit, 15 exponent bits, 112 bit mantissa ) + + +------------------------------------------------------------------------------- + + Integer Power Function: +------------------------------------------------------------------------------- + +pwr + + Compute an integral power of a double precision number. + + double pwr(double y,int n) + y = input number + n = power desired + return value: z = y^n diff --git a/matrix/atou1.c b/matrix/atou1.c new file mode 100644 index 0000000..5a3ea8b --- /dev/null +++ b/matrix/atou1.c @@ -0,0 +1,34 @@ +/* atou1.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +void atou1(double *a,int m,int n) +{ double *p0,*p,*q,*w; + int i,j,k,mm; + double s,h; + w=(double *)calloc(m,sizeof(double)); + p0=a+n*n-1; i=n-1; mm=m-n; + if(mm==0){ *p0=1.; p0-=n+1; --i; ++mm;} + for(; i>=0 ;--i,++mm,p0-=n+1){ + if(*p0!=0.){ + for(j=0,p=p0+n; j=0 ;--i,p0-=n+1,q0-=n+1,++mm){ + if(i && *(p0-1)!=0.){ + for(j=0,p=p0,h=1.; j +#include "complex.h" +void chouse(Cpx *a,double *d,double *dp,int n) +{ double sc,x,y; Cpx cc,u,*q0; + int i,j,k,m,e; + Cpx *qw,*pc,*p; + q0=(Cpx *)calloc(2*n,sizeof(Cpx)); + for(i=0,p=q0+n,pc=a; i0.){ sc=sqrt(sc); p=pc+1; + y=sc+(x=sqrt(p->re*p->re+p->im*p->im)); + if(x>0.){ cc.re=p->re/x; cc.im=p->im/x;} + else{ cc.re=1.; cc.im=0.;} + x=1./sqrt(2.*sc*y); y*=x; + for(i=0,qw=pc+1; ire - (u.im=qw[i].im)*p->im; + q0[i].im+=u.re*p->im + u.im*p->re; ++p; + for(k=i+1; kre - qw[k].im*p->im; + q0[i].im+=qw[k].im*p->re + qw[k].re*p->im; + q0[k].re+=u.re*p->re + u.im*p->im; + q0[k].im+=u.im*p->re - u.re*p->im; + } + y+=u.re*q0[i].re + u.im*q0[i].im; + } + for(i=0; ire-=qw[i].re*q0[k].re + qw[i].im*q0[k].im + +q0[i].re*qw[k].re + q0[i].im*qw[k].im; + p->im-=qw[i].im*q0[k].re - qw[i].re*q0[k].im + +q0[i].im*qw[k].re - q0[i].re*qw[k].im; + } + } + } + d[j]=pc->re; dp[j]=sc; + } + d[j]=pc->re; d[j+1]=(pc+n+1)->re; + u= *(pc+1); dp[j]=sqrt(u.re*u.re+u.im*u.im); + for(j=0,pc=a,qw=q0+n; jre; pc[i].im= -p->im; + } + } + free(q0); +} diff --git a/matrix/chousv.c b/matrix/chousv.c new file mode 100644 index 0000000..8ec55fa --- /dev/null +++ b/matrix/chousv.c @@ -0,0 +1,81 @@ +/* chousv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +void chousv(Cpx *a,double *d,double *dp,int n) +{ double sc,x,y; Cpx cc,u,*qs; + int i,j,k,m,e; + Cpx *qw,*pc,*p,*q; + qs=(Cpx *)calloc(2*n,sizeof(Cpx)); q=qs+n; + for(j=0,pc=a; j0.){ sc=sqrt(sc); p=pc+1; + y=sc+(x=sqrt(p->re*p->re+p->im*p->im)); + if(x>0.){ cc.re=p->re/x; cc.im=p->im/x;} + else{ cc.re=1.; cc.im=0.;} + q->re= -cc.re; q->im= -cc.im; + x=1./sqrt(2.*sc*y); y*=x; + for(i=0,qw=pc+1; ire - (u.im=qw[i].im)*p->im; + qs[i].im+=u.re*p->im + u.im*p->re; ++p; + for(k=i+1; kre - qw[k].im*p->im; + qs[i].im+=qw[k].im*p->re + qw[k].re*p->im; + qs[k].re+=u.re*p->re + u.im*p->im; + qs[k].im+=u.im*p->re - u.re*p->im; + } + y+=u.re*qs[i].re + u.im*qs[i].im; + } + for(i=0; ire-=qw[i].re*qs[k].re + qw[i].im*qs[k].im + +qs[i].re*qw[k].re + qs[i].im*qw[k].im; + p->im-=qw[i].im*qs[k].re - qw[i].re*qs[k].im + +qs[i].im*qw[k].re - qs[i].re*qw[k].im; + } + } + } + d[j]=pc->re; dp[j]=sc; + } + d[j]=pc->re; cc= *(pc+1); d[j+1]=(pc+=n+1)->re; + dp[j]=sc=sqrt(cc.re*cc.re+cc.im*cc.im); + q->re=cc.re/=sc; q->im=cc.im/=sc; + for(i=0,m=n+n,p=pc; ire=p->im=0.; + pc->re=1.; (pc-=n+1)->re=1.; qw=pc-n; + for(m=2; mre=1.; jre-qw[i].im*q->im; + u.im+=qw[i].re*q->im+qw[i].im*q->re; + } + for(i=0,q=p,u.re+=u.re,u.im+=u.im; ire-=u.re*qw[i].re+u.im*qw[i].im; + q->im-=u.im*qw[i].re-u.re*qw[i].im; + } + } + for(i=0,p=qw+m-1; ire=p->im=0.; + (pc-=n+1)->re=1.; + } + for(j=1,p=a+n+1,q=qs+n,u.re=1.,u.im=0.; jre-u.im*q->im; u.im=u.im*q->re+u.re*q->im; u.re=sc; + for(i=1; ire-u.im*p->im; p->im=u.re*p->im+u.im*p->re; p->re=sc; + } + } + free(qs); +} diff --git a/matrix/cmattr.c b/matrix/cmattr.c new file mode 100644 index 0000000..eed1760 --- /dev/null +++ b/matrix/cmattr.c @@ -0,0 +1,13 @@ +/* cmattr.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +void cmattr(Cpx *a,Cpx *b,int m,int n) +{ Cpx *p; int i,j; + for(i=0; i +#include "complex.h" +int cminv(Cpx *a,int n) +{ int i,j,k,m,lc,*le; Cpx *ps,*p,*q,*pa,*pd; + Cpx z,h,*q0; double s,t,tq=0.,zr=1.e-15; + le=(int *)calloc(n,sizeof(int)); + q0=(Cpx *)calloc(n,sizeof(Cpx)); + pa=pd=a; + for(j=0; j0){ + for(i=0,p=pa,q=q0; ire*q->re-p->im*q->im; + z.im+=p->im*q->re+p->re*q->im; + } + q0[i].re-=z.re; q0[i].im-=z.im; + } + for(i=0,p=pa,q=q0; ire)+fabs(pd->im); lc=j; + for(k=j+1,ps=pd; kre)+fabs(ps->im))>s){ s=t; lc=k;} + } + tq=tq>s?tq:s; if(sre*pd->re+pd->im*pd->im; + h.re=pd->re/t; h.im= -(pd->im)/t; + for(k=j+1,ps=pd+n; kre*h.re-ps->im*h.im; + z.im=ps->im*h.re+ps->re*h.im; *ps=z; + } + *pd=h; + } + for(j=1,pd=ps=a; jre*pd->re-q->im*pd->im; + z.im=q->im*pd->re+q->re*pd->im; *q=z; + } + } + for(j=1,pa=a; jre*q->re-p->im*q->im; + h.im-=p->im*q->re+p->re*q->im; ++p; ++q; + } + q0[k]=h; + } + for(i=0,q=q0,p=pa; i=0 ;--j){ --pa; pd-=n+1; + for(i=0,m=n-j-1,q=q0,p=pd+n; ij ;--k,ps-=n){ + z.re= -ps->re; z.im= -ps->im; + for(i=j+1,p=ps+1,q=q0; ire*q->re-p->im*q->im; + z.im-=p->im*q->re+p->re*q->im; + } + q0[--m]=z; + } + for(i=0,m=n-j-1,q=q0,p=pd+n; ik){ h.re=h.im=0.; p=ps+j; i=j;} + else{ h=q0[j]; p=ps+k+1; i=k+1;} + for(; ire*q0[i].re-p->im*q0[i].im; + h.im+=p->im*q0[i].re+p->re*q0[i].im; + } + q0[j]=h; + } + for(i=0,q=q0,p=pa; i=0 ;--j){ + for(k=0,p=a+j,q=a+ *(--le); kre*q->re-p->im*q->im; + s.im+=p->im*q->re+p->re*q->im; ++p; ++q; + } + *c++ =s; + } + } + trncm(b,n); +} diff --git a/matrix/cmmult.c b/matrix/cmmult.c new file mode 100644 index 0000000..398d712 --- /dev/null +++ b/matrix/cmmult.c @@ -0,0 +1,24 @@ +/* cmmult.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +void cmmult(Cpx *cm,Cpx *a,Cpx *b,int n,int m,int l) +{ Cpx z,*q0,*p,*q; int i,j,k; + q0=(Cpx *)calloc(m,sizeof(Cpx)); + for(i=0; ire*q0[k].re-p->im*q0[k].im; + z.im+=p->im*q0[k].re+p->re*q0[k].im; + } + *q=z; + } + } + free(q0); +} diff --git a/matrix/cmprt.c b/matrix/cmprt.c new file mode 100644 index 0000000..ea13498 --- /dev/null +++ b/matrix/cmprt.c @@ -0,0 +1,15 @@ +/* cmprt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +void cmprt(Cpx *a,int m,int n,char *f) +{ int i,j; Cpx *p; + for(i=0,p=a; ire,p->im); + printf("\n"); + } +} diff --git a/matrix/complex.h b/matrix/complex.h new file mode 100644 index 0000000..d364755 --- /dev/null +++ b/matrix/complex.h @@ -0,0 +1,23 @@ +/* complex.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef CPX +struct complex {double re,im;}; +typedef struct complex Cpx; +#define CPX 1 +#endif +#include +struct complex cadd(Cpx a,Cpx b),csub(Cpx a,Cpx b); +struct complex cmul(Cpx a,Cpx b),cdiv(Cpx a,Cpx b); +struct complex crmu(double x,Cpx a),cimu(double y,Cpx a); +struct complex ccng(Cpx c),cdef(double r,double i); +double cabs(Cpx a),cnrm(Cpx a); +struct complex csqrt(Cpx a),cexp(Cpx a),clog(Cpx a); +struct complex csin(Cpx a),ccos(Cpx a),ctan(Cpx a); +struct complex casin(Cpx f),cacos(Cpx f),catan(Cpx f); +struct complex csinh(Cpx h),ccosh(Cpx h),ctanh(Cpx h); +struct complex casinh(Cpx g),cacosh(Cpx g),catanh(Cpx g); diff --git a/matrix/csolv.c b/matrix/csolv.c new file mode 100644 index 0000000..76bf8c6 --- /dev/null +++ b/matrix/csolv.c @@ -0,0 +1,63 @@ +/* csolv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +int csolv(Cpx *a,Cpx *b,int n) +{ int i,j,k,lc; Cpx *ps,*p,*q,*pa,*pd; + Cpx z,h,*q0; double s,t,tq=0.,zr=1.e-15; + q0=(Cpx *)calloc(n,sizeof(Cpx)); + pa=a; pd=a; + for(j=0; j0){ + for(i=0,p=pa,q=q0; ire*q->re-p->im*q->im; + z.im+=p->im*q->re+p->re*q->im; + } + q0[i].re-=z.re; q0[i].im-=z.im; + } + for(i=0,p=pa,q=q0; ire)+fabs(pd->im); lc=j; + for(k=j+1,ps=pd; kre)+fabs(ps->im))>s){ s=t; lc=k;} + } + tq=tq>s?tq:s; if(sre*pd->re+pd->im*pd->im; + h.re=pd->re/t; h.im= -(pd->im)/t; + for(k=j+1,ps=pd+n; kre*h.re-ps->im*h.im; + z.im=ps->im*h.re+ps->re*h.im; *ps=z; + } + } + for(j=1,ps=b+1; jre*q->re-p->im*q->im; + z.im+=p->im*q->re+p->re*q->im; ++p; ++q; + } + ps->re-=z.re; ps->im-=z.im; + } + for(j=n-1,--ps,pd=a+n*n-1; j>=0 ;--j,pd-=n+1){ + for(k=j+1,p=pd+1,q=b+j+1,z.re=z.im=0.; kre*q->re-p->im*q->im; + z.im+=p->im*q->re+p->re*q->im; ++p; ++q; + } + h.re=ps->re-z.re; h.im=ps->im-z.im; + t=pd->re*pd->re+pd->im*pd->im; + ps->re=(h.re*pd->re+h.im*pd->im)/t; + ps->im=(h.im*pd->re-h.re*pd->im)/t; --ps; + } + free(q0); return 0; +} diff --git a/matrix/cvmul.c b/matrix/cvmul.c new file mode 100644 index 0000000..d959a02 --- /dev/null +++ b/matrix/cvmul.c @@ -0,0 +1,27 @@ +/* cvmul.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "complex.h" +void cvmul(Cpx *u,Cpx *a,Cpx *v,int n) +{ Cpx *q; int i,j; + for(i=0; ire=u->im=0.; + for(j=0,q=v; jre+=a->re*q->re-a->im*q->im; + u->im+=a->im*q->re+a->re*q->im; + } + } +} +Cpx cvnrm(Cpx *u,Cpx *v,int n) +{ int k; Cpx z; + z.re=z.im=0.; + for(k=0; kre*v->re+u->im*v->im; + z.im+=u->re*v->im-u->im*v->re; + } + return z; +} diff --git a/matrix/eigen.c b/matrix/eigen.c new file mode 100644 index 0000000..c2e3631 --- /dev/null +++ b/matrix/eigen.c @@ -0,0 +1,16 @@ +/* eigen.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "matutl.h" +void eigen(double *a,double *ev,int n) +{ double *dp; + dp=(double *)calloc(n,sizeof(double)); + housev(a,ev,dp,n); + qrevec(ev,a,dp,n); trnm(a,n); + free(dp); +} diff --git a/matrix/eigval.c b/matrix/eigval.c new file mode 100644 index 0000000..39a6c56 --- /dev/null +++ b/matrix/eigval.c @@ -0,0 +1,16 @@ +/* eigval.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "matutl.h" +void eigval(double *a,double *ev,int n) +{ double *dp; + dp=(double *)calloc(n,sizeof(double)); + house(a,ev,dp,n); + qreval(ev,dp,n); + free(dp); +} diff --git a/matrix/evmax.c b/matrix/evmax.c new file mode 100644 index 0000000..fac1d95 --- /dev/null +++ b/matrix/evmax.c @@ -0,0 +1,27 @@ +/* evmax.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include +double evmax(double *a,double *u,int n) +{ double *p,*q,*qm,*r,*s,*t; + double ev,evm,c,h; int kc; + q=(double *)calloc(n,sizeof(double)); qm=q+n; + *(qm-1)=1.; ev=0.; + for(kc=0; kc<200 ;++kc){ h=c=0.; evm=ev; + for(p=u,r=a,s=q; sre=q->re; + (p++)->im= -q->im; *q=s; q+=n; + } + a->im= -a->im; + } +} diff --git a/matrix/heigval.c b/matrix/heigval.c new file mode 100644 index 0000000..5dad829 --- /dev/null +++ b/matrix/heigval.c @@ -0,0 +1,17 @@ +/* heigval.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +#include "matutl.h" +void heigval(Cpx *a,double *ev,int n) +{ double *dp; + dp=(double *)calloc(n,sizeof(double)); + chouse(a,ev,dp,n); + qreval(ev,dp,n); + free(dp); +} diff --git a/matrix/heigvec.c b/matrix/heigvec.c new file mode 100644 index 0000000..2087fa1 --- /dev/null +++ b/matrix/heigvec.c @@ -0,0 +1,17 @@ +/* heigvec.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +#include "matutl.h" +void heigvec(Cpx *a,double *ev,int n) +{ double *dp; + dp=(double *)calloc(n,sizeof(double)); + chousv(a,ev,dp,n); + qrecvc(ev,a,dp,n); hconj(a,n); + free(dp); +} diff --git a/matrix/hevmax.c b/matrix/hevmax.c new file mode 100644 index 0000000..6f819a8 --- /dev/null +++ b/matrix/hevmax.c @@ -0,0 +1,33 @@ +/* hevmax.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +double hevmax(Cpx *a,Cpx *u,int n) +{ Cpx *x,*p,h; + double e,ep,s,t,te=1.e-12; + int k,j; + x=(Cpx *)calloc(n,sizeof(Cpx)); + x[0].re=1.; e=0.; + do{ + for(k=0,p=a,s=t=0.; kre*x[j].re-p->im*x[j].im; + h.im+=p->im*x[j].re+p->re*x[j].im; + } + s+=h.re*h.re+h.im*h.im; + t+=h.re*x[k].re+h.im*x[k].im; + u[k]=h; + } + ep=e; e=s/t; s=1./sqrt(s); + for(k=0; kfabs(te*e)); + free(x); + return e; +} diff --git a/matrix/hmgen.c b/matrix/hmgen.c new file mode 100644 index 0000000..c835015 --- /dev/null +++ b/matrix/hmgen.c @@ -0,0 +1,23 @@ +/* hmgen.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +#include "matutl.h" +void hmgen(Cpx *h,double *ev,Cpx *u,int n) +{ Cpx *v,*p; + int i,j; double e; + v=(Cpx *)calloc(n*n,sizeof(Cpx)); + cmcpy(v,u,n*n); hconj(v,n); + for(i=0,p=v; ire*=e; p->im*=e; + } + } + cmmul(h,u,v,n); + free(v); +} diff --git a/matrix/house.c b/matrix/house.c new file mode 100644 index 0000000..9ccc1cd --- /dev/null +++ b/matrix/house.c @@ -0,0 +1,47 @@ +/* house.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include +void house(double *a,double *d,double *dp,int n) +{ double sc,x,y,h; + int i,j,k,m,e; + double *qw,*qs,*pc,*p; + qs=(double *)calloc(2*n,sizeof(double)); + for(j=0,qw=qs+n,pc=a; j0.){ sc=sqrt(sc); + if((x= *(pc+1))<0.){ y=x-sc; h=1./sqrt(-2.*sc*y);} + else{ y=x+sc; h=1./sqrt(2.*sc*y); sc= -sc;} + for(i=0,qw=pc+1; i +#include +void housev(double *a,double *d,double *dp,int n) +{ double sc,x,y,h; + int i,j,k,m,e; + double *qw,*qs,*pc,*p; + qs=(double *)calloc(n,sizeof(double)); + for(j=0,pc=a; j0.){ sc=sqrt(sc); + if((x= *(pc+1))<0.){ y=x-sc; h=1./sqrt(-2.*sc*y);} + else{ y=x+sc; h=1./sqrt(2.*sc*y); sc= -sc;} + for(i=0,qw=pc+1; i +void ldumat(double *a,double *u,int m,int n) +{ double *p0,*q0,*p,*q,*w; + int i,j,k,mm; + double s,h; + w=(double *)calloc(m,sizeof(double)); + for(i=0,mm=m*m,q=u; i=0 ;--i,++mm,p0-=n+1,q0-=m+1){ + if(*p0!=0.){ + for(j=0,p=p0+n,h=1.; j0 ;--i,p0-=n+1,q0-=n+1,++mm){ + if(*(p0-1)!=0.){ + for(j=0,p=p0,h=1.; j +void matprt(double *a,int n,int m,char *fmt) +{ int i,j; double *p; + for(i=0,p=a; i +#include +int minv(double *a,int n) +{ int lc,*le; double s,t,tq=0.,zr=1.e-15; + double *pa,*pd,*ps,*p,*q,*q0; + int i,j,k,m; + le=(int *)malloc(n*sizeof(int)); + q0=(double *)malloc(n*sizeof(double)); + for(j=0,pa=pd=a; j0){ + for(i=0,q=q0,p=pa; is){ s=t; lc=k;} + } + tq=tq>s?tq:s; if(s=0 ;--j){ --pa; pd-=n+1; + for(i=0,m=n-j-1,q=q0,p=pd+n; ij ;--k,ps-=n){ t= -(*ps); + for(i=j+1,p=ps,q=q0; ik){ t=0.; p=ps+j; i=j;} + else{ t=q0[j]; p=ps+k+1; i=k+1;} + for(; i=0 ;--j){ + for(k=0,p=a+j,q=a+ *(--le); k +static double tpi=6.28318530717958647; +void ortho(double *e,int n) +{ int i,j,k,m; + double *p,*q,c,s,a,unfl(); + for(i=0,p=e; i +void otrma(double *c,double *a,double *b,int n) +{ double z,*q0,*p,*s,*t; + int i,j,k; + q0=(double *)calloc(n,sizeof(double)); + for(i=0; i +void otrsm(double *sm,double *a,double *b,int n) +{ double z,*q0,*p,*s,*t; + int i,j,k; + q0=(double *)calloc(n,sizeof(double)); + for(i=0; i +#include "matutl.h" +int psinv(double *v,int n) +{ double z,*p,*q,*r,*s,*t; int j,k; + for(j=0,p=v; j +int qrbdi(double *dm,double *em,int m) +{ int i,j,k,n; + double u,x,y,a,b,c,s,t; + for(j=1,t=fabs(dm[0]); jt) t=s; + t*=1.e-15; n=100*m; + for(j=0; m>1 && j0 ;--k){ + if(fabs(em[k-1])0.){ + c=sqrt((u+a)/(u+u)); + if(c!=0.) s/=(c*u); else s=1.; + for(i=k; ik){ + a=s*em[i]; b*=c; + em[i-1]=u=sqrt(x*x+a*a); + c=x/u; s=a/u; + } + a=c*y+s*b; b=c*b-s*y; + s*=dm[i+1]; dm[i]=u=sqrt(a*a+s*s); + y=c*dm[i+1]; c=a/u; s/=u; + x=c*b+s*y; y=c*y-s*b; + } + } + em[m-2]=x; dm[m-1]=y; + if(fabs(x) +int qrbdu1(double *dm,double *em,double *um,int mm,double *vm,int m) +{ int i,j,k,n,jj,nm; + double u,x,y,a,b,c,s,t,w,*p,*q; + for(j=1,t=fabs(dm[0]); jt) t=s; + t*=1.e-15; n=100*m; nm=m; + for(j=0; m>1 && j0 ;--k){ + if(fabs(em[k-1])0.){ + c=sqrt((u+a)/(u+u)); + if(c!=0.) s/=(c*u); else s=1.; + for(i=k; ik){ + a=s*em[i]; b*=c; + em[i-1]=u=sqrt(x*x+a*a); + c=x/u; s=a/u; + } + a=c*y+s*b; b=c*b-s*y; + for(jj=0,p=vm+i; jj +int qrbdv(double *dm,double *em,double *um,int mm,double *vm,int m) +{ int i,j,k,n,jj,nm; + double u,x,y,a,b,c,s,t,w,*p,*q; + for (j=1,t=fabs(dm[0]); jt) t=s; + t*=1.e-15; n=100*m; nm=m; + for(j=0; m>1 && j0 ;--k){ + if(fabs(em[k-1])k){ + a=s*em[i]; b*=c; + em[i-1]=u=sqrt(x*x+a*a); + c=x/u; s=a/u; + } + a=c*y+s*b; b=c*b-s*y; + for(jj=0,p=vm+i; jj1 && fabs(dp[m-2])>fabs(ev[k])*tzr) break; + if((cc=sqrt((1.+x/h)/2.))!=0.) sc=dp[k]/(2.*cc*h); else sc=1.; + x+=ev[m]; ev[m--]=x-h; ev[m--]=x+h; + for(i=0,p=evec+n*(m+1); i0.) d=ev[m]+x-h; else d=ev[m]+x+h; + cc=1.; y=0.; ev[0]-=d; + for(k=0; k0) dp[k-1]=sc*h; + ev[k]=cc*h; cc=x/h; sc=dp[k]/h; ev[k+1]-=d; y*=sc; + ev[k]=cc*(ev[k]+y)+ev[k+1]*sc*sc+d; + for(i=0,p=evec+n*k; i +int qreval(double *ev,double *dp,int n) +{ double cc,sc,d,x,y,h,tzr=1.e-15; + int j,k,m,mqr=8*n; + for(j=0,m=n-1;;++j){ + while(1){ if(m<1) return 0; k=m-1; + if(fabs(dp[k])<=fabs(ev[m])*tzr) --m; + else{ x=(ev[k]-ev[m])/2.; h=sqrt(x*x+dp[k]*dp[k]); + if(m>1 && fabs(dp[m-2])>fabs(ev[k])*tzr) break; + x+=ev[m]; ev[m--]=x-h; ev[m--]=x+h; + } + } + if(j>mqr) return -1; + if(x>0.) d=ev[m]+x-h; else d=ev[m]+x+h; + cc=1.; y=0.; ev[0]-=d; + for(k=0; k0) dp[k-1]=sc*h; + ev[k]=cc*h; cc=x/h; sc=dp[k]/h; ev[k+1]-=d; y*=sc; + ev[k]=cc*(ev[k]+y)+ev[k+1]*sc*sc+d; + } + ev[k]=ev[k]*cc-y; dp[k-1]=ev[k]*sc; ev[k]=ev[k]*cc+d; + } + return 0; +} diff --git a/matrix/qrevec.c b/matrix/qrevec.c new file mode 100644 index 0000000..85de06b --- /dev/null +++ b/matrix/qrevec.c @@ -0,0 +1,40 @@ +/* qrevec.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int qrevec(double *ev,double *evec,double *dp,int n) +{ double cc,sc,d,x,y,h,tzr=1.e-15; + int i,j,k,m,mqr=8*n; + double *p; + for(j=0,m=n-1;;++j){ + while(1){ if(m<1) return 0; k=m-1; + if(fabs(dp[k])<=fabs(ev[m])*tzr) --m; + else{ x=(ev[k]-ev[m])/2.; h=sqrt(x*x+dp[k]*dp[k]); + if(m>1 && fabs(dp[m-2])>fabs(ev[k])*tzr) break; + if((cc=sqrt((1.+x/h)/2.))!=0.) sc=dp[k]/(2.*cc*h); else sc=1.; + x+=ev[m]; ev[m--]=x-h; ev[m--]=x+h; + for(i=0,p=evec+n*(m+1); imqr) return -1; + if(x>0.) d=ev[m]+x-h; else d=ev[m]+x+h; + cc=1.; y=0.; ev[0]-=d; + for(k=0; k0) dp[k-1]=sc*h; + ev[k]=cc*h; cc=x/h; sc=dp[k]/h; ev[k+1]-=d; y*=sc; + ev[k]=cc*(ev[k]+y)+ev[k+1]*sc*sc+d; + for(i=0,p=evec+n*k; i +void rmmult(double *rm,double *a,double *b,int n,int m,int l) +{ double z,*q0,*p,*q; int i,j,k; + q0=(double *)calloc(m,sizeof(double)); + for(i=0; itt) tt=z; + tt*=1.e-16; + for(j=0,p=a; j +int solvps(double *a,double *b,int n) +{ double *p,*q,*r,*s,t; + int j,k; + for(j=0,p=a; j=0 ;--j,p-=n+1){ + for(k=j+1,q=p+n; ks) s=t; + s*=1.e-16; + for(j=n-1,p=a+n*n-1; j>=0 ;--j,p-=n+1){ + for(k=j+1,q=p+1; k=0 ;--j){ + x[j]-=s*c[j]; s=(x[j]/=a[j]);} +} diff --git a/matrix/supp/README b/matrix/supp/README new file mode 100644 index 0000000..36a2398 --- /dev/null +++ b/matrix/supp/README @@ -0,0 +1,10 @@ + The linear system solver assembly code 'solv.s' used in the 'matrix' + segment of the library must be replaced by the corresponding C code + 'solv.c' when the target platform is not an Intel based processor. + + For some reason the GNU-C optimization of solv.c code produced + unnecessary saves and restores in the innermost loop of this + linear system solver code. This severly degraded performance, + so the assembly code 'solv.s' was introduced. I believe that + this problem is unique to Intel patforms using the GNU-C + compiler. diff --git a/matrix/supp/solv.c b/matrix/supp/solv.c new file mode 100644 index 0000000..d065650 --- /dev/null +++ b/matrix/supp/solv.c @@ -0,0 +1,44 @@ +/* solv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU general + * public license. ( See the gpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include +int solv(double *a,double *b,int n) +{ int i,j,k,lc; double *ps,*p,*q,*pa,*pd; + double *q0,s,t,tq=0.,zr=1.e-15; + q0=(double *)calloc(n,sizeof(double)); + for(j=0,pa=a,pd=a; js){ s=t; lc=k;} + } + tq=tq>s?tq:s; if(s=0 ;--j,pd-=n+1){ + for(k=j+1,p=pd,q=b+j,t=0.; k +#include +#include "matutl.h" +int sv2u1v(double *d,double *a,int m,double *v,int n) +{ double *p,*p1,*q,*pp,*w,*e; + double s,t,h,r,sv; + int i,j,k,mm,nm,ms; + if(m1){ sv=h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; t=1./(w[0]+=h); + sv=1.+fabs(*p/h); + for(k=1,ms=n-i; k1){ sv=h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; t=1./(w[0]+=h); + sv=1.+fabs(*p/h); + for(k=1,ms=n-i; k1){ sv=h=0.; + for(j=0,q=p1,s=0.; j0.){ + h=sqrt(s); if(*p1<0.) h= -h; + sv=1.+fabs(*p1/h); + s+= *p1*h; s=1./s; t=1./(*p1+=h); + for(k=n,ms=n*(n-i); k +#include +#include "matutl.h" +int sv2uv(double *d,double *a,double *u,int m,double *v,int n) +{ double *p,*p1,*q,*pp,*w,*e; + double s,t,h,r,sv; + int i,j,k,mm,nm,ms; + if(m1){ sv=h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; t=1./(w[0]+=h); + sv=1.+fabs(*p/h); + for(k=1,ms=n-i; k1){ sv=h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; t=1./(w[0]+=h); + sv=1.+fabs(*p/h); + for(k=1,ms=n-i; k1){ sv=h=0.; + for(j=0,q=p1,s=0.; j0.){ + h=sqrt(s); if(*p1<0.) h= -h; + sv=1.+fabs(*p1/h); + s+= *p1*h; s=1./s; t=1./(*p1+=h); + for(k=n,ms=n*(n-i); k +#include +#include "matutl.h" +int sv2val(double *d,double *a,int m,int n) +{ double *p,*p1,*q,*w,*v; + double s,h,u; + int i,j,k,mm,nm,ms; + if(m1 ;++i,--mm,p+=n+1){ + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; w[0]+=h; + for(k=1,ms=n-i; k1){ + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; w[0]+=h; + for(k=1,ms=n-i; k1){ + for(j=0,q=p1,s=0.; j0.){ + h=sqrt(s); if(*p1<0.) h= -h; + s+= *p1*h; s=1./s; *p1+=h; + for(k=n,ms=n*(m-i); k +#include +#include "matutl.h" +int svdu1v(double *d,double *a,int m,double *v,int n) +{ double *p,*p1,*q,*pp,*w,*e; + double s,h,r,t,sv; + int i,j,k,mm,nm,ms; + if(m1){ sv=h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; t=1./(w[0]+=h); + sv=1.+fabs(*p/h); + for(k=1,ms=n-i; k1){ + for(j=0,q=p1,s=0.; j0.){ + h=sqrt(s); if(*p1<0.) h= -h; + sv=1.+fabs(*p1/h); + s+= *p1*h; s=1./s; t=1./(*p1+=h); + for(k=n,ms=n*(m-i); k +#include +#include "matutl.h" +int svduv(double *d,double *a,double *u,int m,double *v,int n) +{ double *p,*p1,*q,*pp,*w,*e; + double s,h,r,t,sv; + int i,j,k,mm,nm,ms; + if(m1){ sv=h=0.; + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; t=1./(w[0]+=h); + sv=1.+fabs(*p/h); + for(k=1,ms=n-i; k1){ + for(j=0,q=p1,s=0.; j0.){ + h=sqrt(s); if(*p1<0.) h= -h; + sv=1.+fabs(*p1/h); + s+= *p1*h; s=1./s; t=1./(*p1+=h); + for(k=n,ms=n*(m-i); k +#include +#include "matutl.h" +int svdval(double *d,double *a,int m,int n) +{ double *p,*p1,*q,*w,*v; + double s,h,u; + int i,j,k,mm,nm,ms; + if(m1){ + for(j=0,q=p,s=0.; j0.){ + h=sqrt(s); if(*p<0.) h= -h; + s+= *p*h; s=1./s; w[0]+=h; + for(k=1,ms=n-i; k1){ + for(j=0,q=p1,s=0.; j0.){ + h=sqrt(s); if(*p1<0.) h= -h; + s+= *p1*h; s=1./s; *p1+=h; + for(k=n,ms=n*(m-i); kre=ev[i]; + if(ire=dp[i]; (p+n)->re=dp[i];} + } + printf(" td2:\n"); cmprt(h,n,n,fmt); + +/* check transformation matrix */ + cmcpy(u,a,n*n); hconj(u,n); + cmmul(h1,h,a,n); cmmul(a,u,h1,n); + printf(" evc^*ad*evc:\n"); cmprt(a,n,n,fmt); +} +/* Test output + + mat a-in: +( 2.232, -0.000)( -0.073, -0.075)( -0.321, 0.030)( 0.379, 0.031) +( -0.073, 0.075)( 1.673, 0.000)( -0.102, -0.006)( 0.266, -0.178) +( -0.321, -0.030)( -0.102, 0.006)( 1.284, 0.000)( 0.143, 0.048) +( 0.379, -0.031)( 0.266, 0.178)( 0.143, -0.048)( 1.812, 0.000) + evc: +( 1.000, 0.000)( 0.000, 0.000)( 0.000, 0.000)( 0.000, 0.000) +( 0.000, 0.000)( -0.143, -0.147)( -0.631, 0.059)( 0.743, 0.062) +( 0.000, 0.000)( 0.607, 0.269)( 0.474, -0.043)( 0.577, -0.019) +( 0.000, 0.000)( 0.142, 0.705)( -0.445, -0.417)( -0.153, -0.295) + td2: +( 2.232, 0.000)( 0.509, 0.000)( 0.000, 0.000)( 0.000, 0.000) +( 0.509, 0.000)( 1.340, 0.000)( 0.335, 0.000)( 0.000, 0.000) +( 0.000, 0.000)( 0.335, 0.000)( 1.900, 0.000)( 0.132, 0.000) +( 0.000, 0.000)( 0.000, 0.000)( 0.132, 0.000)( 1.528, 0.000) + evc^*ad*evc: +( 2.232, 0.000)( -0.073, -0.075)( -0.321, 0.030)( 0.379, 0.031) +( -0.073, 0.075)( 1.673, -0.000)( -0.102, -0.006)( 0.266, -0.178) +( -0.321, -0.030)( -0.102, 0.006)( 1.284, 0.000)( 0.143, 0.048) +( 0.379, -0.031)( 0.266, 0.178)( 0.143, -0.048)( 1.812, -0.000) +*/ diff --git a/matrix/test/tcminv.c b/matrix/test/tcminv.c new file mode 100644 index 0000000..43115f5 --- /dev/null +++ b/matrix/test/tcminv.c @@ -0,0 +1,59 @@ +/* tcminv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: cminv + + Uses: cmmul cmprt cmcpy unitary + + Input parameter: n -> size (complex matrix is n by n) +*/ +#include "ccmath.h" +char fm[]="(%8.5f,%8.5f)"; +void main(int na,char **av) +{ int n,m,k; Cpx *a,*b,*c; + unsigned int seed=123498765; + if(na!=2){ printf("para: dim\n"); exit(1);} + n=atoi(*++av); m=n*n; + a=(Cpx *)calloc(3*m,sizeof(Cpx)); + b=a+m; c=b+m; + setunfl(seed); + unitary(a,n); cmcpy(b,a,m); + printf(" mat a:\n"); + cmprt(a,n,n,fm); + +/* invert complex matrix */ + k=cminv(a,n); + + if(k==0){ + printf(" inv a:\n"); + cmprt(a,n,n,fm); +/* check inverse matrix */ + cmmul(c,a,b,n); + printf(" check inv(a)*a:\n"); + cmprt(c,n,n,fm); + } + else printf("matrix singular\n"); +} +/* Test output + + mat a: +(-0.39965,-0.04599)( 0.28884, 0.75524)(-0.17199,-0.17545)(-0.18556,-0.29926) +( 0.13874, 0.08869)(-0.39158, 0.18086)(-0.58589, 0.56577)(-0.33845, 0.09446) +( 0.26285,-0.63911)( 0.22703,-0.21969)( 0.04795, 0.19192)(-0.34543,-0.51399) +( 0.24143,-0.52461)( 0.21397, 0.12063)(-0.38404,-0.29942)( 0.10946, 0.59753) + inv a: +(-0.39965, 0.04599)( 0.13874,-0.08869)( 0.26285, 0.63911)( 0.24143, 0.52461) +( 0.28884,-0.75524)(-0.39158,-0.18086)( 0.22703, 0.21969)( 0.21397,-0.12063) +(-0.17199, 0.17545)(-0.58589,-0.56577)( 0.04795,-0.19192)(-0.38404, 0.29942) +(-0.18556, 0.29926)(-0.33845,-0.09446)(-0.34543, 0.51399)( 0.10946,-0.59753) + check inv(a)*a: +( 1.00000,-0.00000)( 0.00000, 0.00000)(-0.00000, 0.00000)( 0.00000,-0.00000) +(-0.00000, 0.00000)( 1.00000, 0.00000)(-0.00000,-0.00000)(-0.00000,-0.00000) +(-0.00000,-0.00000)(-0.00000,-0.00000)( 1.00000,-0.00000)( 0.00000,-0.00000) +(-0.00000,-0.00000)(-0.00000,-0.00000)( 0.00000,-0.00000)( 1.00000, 0.00000) +*/ diff --git a/matrix/test/tcmmul.c b/matrix/test/tcmmul.c new file mode 100644 index 0000000..66f0b3e --- /dev/null +++ b/matrix/test/tcmmul.c @@ -0,0 +1,56 @@ +/* tcmmul.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: cmmul + + Uses: unitary cmcpy cmprt + + Input parameter: n -> size (matrices are n by n) +*/ +#include "ccmath.h" +unsigned int seed=123456789; +void main(int na,char **av) +{ Cpx *u,*v,*c; + int n,m; + if(na!=2){ printf("para: size\n"); exit(1);} + n=atoi(*++av); m=n*n; + c=(Cpx *)calloc(3*m,sizeof(Cpx)); + u=c+m; v=u+m; + setunfl(seed); + unitary(u,n); + printf(" size= %d :\n",n); + cmprt(u,n,n," (%7.4f,%7.4f)"); + cmcpy(v,u,n*n); + +/* multiply complex square matrices */ + cmmul(c,u,v,n); + +/* check second matrix factor */ + printf(" v-out:\n"); + cmprt(v,n,n," (%7.4f,%7.4f)"); + printf(" matrix square\n"); + cmprt(c,n,n," (%7.4f,%7.4f)"); +} +/* Test output + + size= 4 : + ( 0.2956, 0.2530) (-0.2439, 0.0696) (-0.1821, 0.8027) (-0.0506, 0.3228) + (-0.6321, 0.2510) ( 0.4965,-0.1105) ( 0.2111, 0.4394) (-0.0399,-0.1987) + ( 0.4894, 0.3046) ( 0.3478, 0.3572) (-0.1526, 0.0178) ( 0.0184,-0.6286) + ( 0.1045, 0.2068) ( 0.5993, 0.2630) (-0.0805,-0.2341) ( 0.0057, 0.6758) + v-out: + ( 0.2956, 0.2530) (-0.2439, 0.0696) (-0.1821, 0.8027) (-0.0506, 0.3228) + (-0.6321, 0.2510) ( 0.4965,-0.1105) ( 0.2111, 0.4394) (-0.0399,-0.1987) + ( 0.4894, 0.3046) ( 0.3478, 0.3572) (-0.1526, 0.0178) ( 0.0184,-0.6286) + ( 0.1045, 0.2068) ( 0.5993, 0.2630) (-0.0805,-0.2341) ( 0.0057, 0.6758) + matrix square + (-0.2456, 0.4050) (-0.6684, 0.4147) (-0.2458,-0.0411) ( 0.2097, 0.2252) + (-0.5301, 0.3591) ( 0.3158,-0.1163) (-0.0163,-0.3963) ( 0.3233,-0.4637) + (-0.1901,-0.0243) ( 0.1885,-0.3215) (-0.5428, 0.6065) ( 0.3673, 0.1644) + (-0.5736, 0.0045) ( 0.1680, 0.3175) ( 0.0000, 0.3436) (-0.6490,-0.0523) +*/ diff --git a/matrix/test/tcmmult.c b/matrix/test/tcmmult.c new file mode 100644 index 0000000..04ac7ee --- /dev/null +++ b/matrix/test/tcmmult.c @@ -0,0 +1,72 @@ +/* tcmmult.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: cmmult + + Uses: cminv cmprt nrml + + Input parameters: n1 n2 n3 -> size with + matrix A n1 by n2 + matrix B n2 by n3 + product C n1 by n3 +*/ +#include "ccmath.h" +char fmt[]="(%7.3f,%7.3f)"; +void main(int na,char **av) +{ int n,m,k,i; Cpx *a,*b,*c,*d; + unsigned int seed; + if(na!=4){ printf("para: dim1 dim2 dim3\n"); exit(1);} + n=atoi(*++av); m=atoi(*++av); k=atoi(*++av); + a=(Cpx *)calloc(n*m,sizeof(Cpx)); + b=(Cpx *)calloc(m*k,sizeof(Cpx)); + c=(Cpx *)calloc(n*k,sizeof(Cpx)); + d=(Cpx *)calloc(n*k,sizeof(Cpx)); + seed=123456789; setnrml(seed); + for(i=0; ire),&(p->im)); + } + + printf(" Mat b:\n"); cmprt(b,n,m,cfmt); + +/* general complex transpose */ + cmattr(c,b,n,m); + + printf(" Mat b':\n"); cmprt(c,m,n,cfmt); + for(i=0,p=c; iim= -(p->im); + cmmult(a,b,c,n,m,n); + printf(" Mat a=b*b^:\n"); cmprt(a,n,n,cfmt); + +/* square matrix transpose */ + trncm(a,n); + + printf(" Mat a':\n"); cmprt(a,n,n,cfmt); +} +/* Test output + + Mat b: +( -0.542, 1.345)( -0.830, -1.434) +( -2.256, 0.567)( -1.018, -0.849) +( -0.832, 0.843)( -0.999, -1.059) +( 0.147, 0.758)( 0.673, -0.536) + Mat b': +( -0.542, 1.345)( -2.256, 0.567)( -0.832, 0.843)( 0.147, 0.758) +( -0.830, -1.434)( -1.018, -0.849)( -0.999, -1.059)( 0.673, -0.536) + Mat a=b*b^: +( 4.848, 0.000)( 4.048, -1.972)( 3.933, -0.109)( 1.150, -0.801) +( 4.048, 1.972)( 7.168, 0.000)( 4.271, 1.200)( -0.132, 0.676) +( 3.933, 0.109)( 4.271, -1.200)( 3.522, 0.000)( 0.412, -0.494) +( 1.150, 0.801)( -0.132, -0.676)( 0.412, 0.494)( 1.336, 0.000) + Mat a': +( 4.848, 0.000)( 4.048, 1.972)( 3.933, 0.109)( 1.150, 0.801) +( 4.048, -1.972)( 7.168, 0.000)( 4.271, -1.200)( -0.132, -0.676) +( 3.933, -0.109)( 4.271, 1.200)( 3.522, 0.000)( 0.412, 0.494) +( 1.150, -0.801)( -0.132, 0.676)( 0.412, -0.494)( 1.336, 0.000) +*/ diff --git a/matrix/test/tcsolv.c b/matrix/test/tcsolv.c new file mode 100644 index 0000000..e7d9045 --- /dev/null +++ b/matrix/test/tcsolv.c @@ -0,0 +1,54 @@ +/* tcsolv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: csolv + + Uses: cmprt cvmul unitary + + Input parameter: n -> size matrix is n by n and solution + is an n-vector +*/ +#include "ccmath.h" +void main(int na,char **av) +{ int n,k; Cpx *a,*u,*v; + unsigned int seed; + if(na!=2){ printf("para: dim\n"); exit(1);} + n=atoi(*++av); + u=(Cpx *)calloc(n*n+2*n,sizeof(Cpx)); + v=u+n*n; a=v+n; + seed=543216789; setunfl(seed); + for(k=0; k size of real Hilbert matrix + (defaults to n=5) +*/ +#include "ccmath.h" +int n=5; +void main(int na,char **av) +{ int i,j; double *p,*a,*evc,*u; + double ee; + if(na==2) n=atoi(*++av); + a=(double *)calloc(n*n+n+n,sizeof(double)); + evc=a+n*n; u=evc+n; + for(i=0,p=a; i dimension (matrix is n by n) +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ Cpx *h,*u,*v,*w,c; int i,n; + double *ev,e; void *calloc(); + unsigned int seed; + if(na!=2){ printf("para: dim\n"); exit(1);} + n=atoi(*++av); + seed=123456789; setunfl(seed); + ev=(double *)calloc(n,sizeof(double)); + h=(Cpx *)calloc(2*(n*n+n),sizeof(Cpx)); + u=h+n*n; v=u+n*n; w=v+n; + for(i=0,e=1.; i size of matrix is n by n +*/ +#include "ccmath.h" +unsigned int seed=123456789; +void main(int na,char **av) +{ Cpx *h,*u,*p; + int i,j,n; double *e,s; + if(na!=2){ printf("para: size\n"); exit(1);} + n=atoi(*++av); + h=(Cpx *)calloc(n*n,sizeof(Cpx)); + u=(Cpx *)calloc(n*n,sizeof(Cpx)); + e=(double *)calloc(n,sizeof(double)); +/* initialize real eigenvalues */ + for(i=0,s=1.; i size square matrices are n by n +*/ +#include "ccmath.h" +unsigned int seed=123456789; +void main(int na,char **av) +{ int i,n,m; + double *a,*b,*c,*p,*q; + if(na!=2){ printf("para: dim\n"); exit(1);} + n=atoi(*++av); m=n*n; + a=(double *)calloc(3*m,sizeof(double)); + b=a+m; c=b+m; + setnrml(seed); + for(i=0,p=a,q=b; i= %12.7f\n",s); +} +/* Test output + +Matrix Operations Test 1 + input matrix A: + 6.00000 4.00000 -2.00000 -3.00000 1.00000 -4.00000 + 3.00000 -7.00000 2.00000 4.00000 -2.00000 1.00000 + 0.00000 3.00000 5.00000 -4.00000 2.00000 -1.00000 + 2.00000 -1.00000 0.00000 4.00000 2.00000 -3.00000 + 1.00000 0.00000 2.00000 5.00000 -3.00000 4.00000 + -4.00000 2.00000 -6.00000 3.00000 0.00000 8.00000 + transpose B=A' + 6.00000 3.00000 0.00000 2.00000 1.00000 -4.00000 + 4.00000 -7.00000 3.00000 -1.00000 0.00000 2.00000 + -2.00000 2.00000 5.00000 0.00000 2.00000 -6.00000 + -3.00000 4.00000 -4.00000 4.00000 5.00000 3.00000 + 1.00000 -2.00000 2.00000 2.00000 -3.00000 0.00000 + -4.00000 1.00000 -1.00000 -3.00000 4.00000 8.00000 + product C=A*A' + 82.00000 -32.00000 20.00000 10.00000 -32.00000 -45.00000 + -32.00000 83.00000 -32.00000 22.00000 37.00000 -18.00000 + 20.00000 -32.00000 55.00000 -12.00000 -20.00000 -44.00000 + 10.00000 22.00000 -12.00000 34.00000 4.00000 -22.00000 + -32.00000 37.00000 -20.00000 4.00000 55.00000 31.00000 + -45.00000 -18.00000 -44.00000 -22.00000 31.00000 129.00000 + input vector v: + 1.00000 1.00000 1.00000 1.00000 1.00000 1.00000 + product u=C*v + 3.00000 60.00000 -33.00000 36.00000 75.00000 31.00000 + = 172.0000000 +*/ diff --git a/matrix/test/tmop2.c b/matrix/test/tmop2.c new file mode 100644 index 0000000..eb6a77d --- /dev/null +++ b/matrix/test/tmop2.c @@ -0,0 +1,66 @@ +/* tmop2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: smgen mattr otrma or otrsm + + Uses: matprt + + Input file: mop2.dat +*/ +#include "ccmath.h" +void main(int na,char **av) +{ int i,n; FILE *fp; + double *p,*a,*b,*c,*ev; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + fscanf(fp,"%d",&n); + a=(double *)calloc(3*n*n+n,sizeof(double)); + b=a+n*n; c=b+n*n; ev=b+n*n; + for(i=0,p=ev; i size of matrices is n by n +*/ +#include "ccmath.h" +char fmt[]=" %8.4f"; +void main(int na,char **av) +{ int n,m,k; double *a,*u,*v,*h; + double *q; unsigned int seed; + if(na!=2){ printf("para: dim\n"); exit(1);} + n=atoi(*++av); m=n*n; + a=(double *)calloc(4*m,sizeof(double)); + q=(double *)calloc(n,sizeof(double)); + h=a+m; u=h+m; v=u+m; + seed=123456789; setunfl(seed); + for(k=1; k<=n ;++k) q[k-1]=(double)k; + ortho(u,n); smgen(h,q,u,n); + printf(" matrix h:\n"); + matprt(h,n,n,fmt); + +/* set v to the transpose of u */ + mcopy(v,u,n*n); trnm(v,n); + +/* orthogonal transform of h by v */ + otrma(a,v,h,n); + + printf(" matrix vhv~:\n"); + matprt(a,n,n,fmt); + +/* orthogonal transform of symmetric h by v */ + otrsm(a,v,h,n); + + printf(" symmetric conjugate a=vhv~:\n"); + matprt(a,n,n,fmt); +/* check transform by inversion */ + otrsm(v,u,a,n); + printf(" symmetric conjugate uau~:\n"); + matprt(v,n,n,fmt); +} +/* Test output + + matrix h: + 2.2532 -0.6303 0.9402 0.7410 + -0.6303 2.6266 0.3221 0.1333 + 0.9402 0.3221 3.1949 0.3211 + 0.7410 0.1333 0.3211 1.9253 + matrix vhv~: + 1.0000 -0.0000 -0.0000 -0.0000 + -0.0000 2.0000 -0.0000 -0.0000 + -0.0000 -0.0000 3.0000 0.0000 + -0.0000 -0.0000 0.0000 4.0000 + symmetric conjugate a=vhv~: + 1.0000 -0.0000 -0.0000 -0.0000 + -0.0000 2.0000 -0.0000 -0.0000 + -0.0000 -0.0000 3.0000 0.0000 + -0.0000 -0.0000 0.0000 4.0000 + symmetric conjugate uau~: + 2.2532 -0.6303 0.9402 0.7410 + -0.6303 2.6266 0.3221 0.1333 + 0.9402 0.3221 3.1949 0.3211 + 0.7410 0.1333 0.3211 1.9253 +*/ diff --git a/matrix/test/tpsinv.c b/matrix/test/tpsinv.c new file mode 100644 index 0000000..a04a3eb --- /dev/null +++ b/matrix/test/tpsinv.c @@ -0,0 +1,57 @@ +/* tpsinv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: psinv + + Uses: mmul mcopy matprt + + Input file: spdm.dat +*/ +#include "ccmath.h" +void main(int na,char **av) +{ double *p,*a,*b,*c; + int i,n; FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + fscanf(fp,"%d",&n); + a=(double *)calloc(3*n*n,sizeof(double)); + b=a+n*n; c=b+n*n; + for(i=0,p=a; i matrix sizes + matrix A is n1 by n2 + matrix B is n2 by n3 + product C is n1 by n3 +*/ +#include "ccmath.h" +char fmt[]=" %8.4f"; +void main(int na,char **av) +{ int n,m,k,i; double *a,*b,*c,*d; + unsigned int seed; + if(na!=4){ printf("para: dim1 dim2 dim3\n"); exit(1);} + n=atoi(*++av); m=atoi(*++av); k=atoi(*++av); + a=(double *)calloc(n*m,sizeof(double)); + b=(double *)calloc(m*k,sizeof(double)); + c=(double *)calloc(n*k,sizeof(double)); + d=(double *)calloc(n*k,sizeof(double)); + seed=123456789; setnrml(seed); + for(i=0; i size of matrix is n by n +*/ +#include "ccmath.h" +unsigned int seed=123456789; +void main(int na,char **av) +{ double *sm,*om,*p; + int i,j,n; double *e,s; + if(na!=2){ printf("para: size\n"); exit(1);} + n=atoi(*++av); + sm=(double *)calloc(n*n,sizeof(double)); + om=(double *)calloc(n*n,sizeof(double)); + e=(double *)calloc(n,sizeof(double)); +/* initialize real eigenvalues */ + for(i=0,s=1.; i 1 to 7 +*/ +#include "ccmath.h" +#include +char fma[]=" %11.6f"; +char fmf[]=" %9.6f"; +char fme[]=" %14.8f"; +void main(int na,char **av) +{ int i,j,m,n; + double *a,*d,*u,*v; + double *a1,*a0,*u0,*us,*a2; + double *p,*q; + FILE *fin; + if(na!=2){ printf("para: file_in\n"); exit(-1);} + fin=fopen(*++av,"r"); + fscanf(fin,"%d %d",&m,&n); + if(m>n) */ + i=sv2u1v(d,a,m,v,n); + + if(i== -1){ printf(" error: m < n\n"); exit(-1);} + printf(" sval:"); matprt(d,1,n,fme); + printf(" u1:\n"); matprt(a,m,n,fmf); + printf(" v:\n"); matprt(v,n,n,fmf); +/* check decomposition by inversion */ + trnm(v,n); + for(i=0,p=v; i 1 to 7 +*/ +#include "ccmath.h" +#include +char fma[]=" %11.6f",fme[]=" %14.7f",fmf[]=" %9.6f"; +void main(int na,char **av) +{ int i,j,m,n; + double *a,*d,*u,*v; + double *a1,*a0,*u0,*us,*a2; + double *p,*q; + FILE *fin; + if(na!=2){ printf("para: file_in\n"); exit(-1);} + fin=fopen(*++av,"r"); + fscanf(fin,"%d %d",&m,&n); + if(m>n) */ + i=sv2uv(d,a,u,m,v,n); + + if(i== -1){ printf(" error: m < n\n"); exit(-1);} + printf(" sval:\n"); matprt(d,1,n,fme); + printf(" u:\n"); matprt(u,m,m,fmf); + printf(" v:\n"); matprt(v,n,n,fmf); +/* check decomposition by computing d */ + trnm(u,m); rmmult(a,u,a1,m,m,n); + rmmult(a1,a,v,m,n,n); + printf(" u'*a*v:\n"); matprt(a1,m,n,fme); +} +/* Test output + + dim: 7 x 5 + a-in: + 2.000000 0.400000 -1.000000 -3.200000 0.800000 + 0.300000 -2.000000 1.300000 2.700000 -1.600000 + -0.400000 0.500000 1.000000 -3.100000 1.500000 + 1.200000 0.380000 0.880000 -1.000000 0.700000 + -0.250000 2.000000 0.600000 -0.500000 -1.800000 + 0.750000 1.000000 -2.000000 3.500000 2.000000 + 1.000000 0.500000 1.000000 0.500000 6.000000 + sval: + 7.2554647 6.4588852 3.4706396 2.5914230 1.9733276 + u: + 0.271122 0.427936 0.343106 -0.653808 0.249396 0.197172 0.311612 + -0.328716 -0.348913 -0.546868 -0.314360 0.391614 0.455786 0.105908 + 0.293866 0.424266 -0.228978 0.252257 -0.200141 0.684595 -0.329925 + 0.166418 0.140431 -0.112043 -0.100491 0.588615 -0.320892 -0.693176 + -0.176523 0.192674 0.250787 0.612398 0.609670 0.145853 0.317522 + 0.187889 -0.612905 0.594907 -0.007430 0.070898 0.381587 -0.290587 + 0.798701 -0.287459 -0.318467 0.157780 0.145575 -0.121898 0.342165 + v: + 0.208055 -0.007013 0.156832 -0.626802 0.734294 + 0.166805 0.118164 0.579478 0.675843 0.407007 + 0.008114 0.111517 -0.789312 0.366225 0.479962 + -0.232556 -0.952540 0.012948 0.119083 0.155680 + 0.935276 -0.257330 -0.128170 0.045331 -0.201389 + u'*a*v: + 7.2554647 -0.0000000 -0.0000000 -0.0000000 0.0000000 + 0.0000000 6.4588852 0.0000000 -0.0000000 -0.0000000 + -0.0000000 -0.0000000 3.4706396 -0.0000000 -0.0000000 + 0.0000000 -0.0000000 -0.0000000 2.5914230 -0.0000000 + 0.0000000 -0.0000000 -0.0000000 0.0000000 1.9733276 + 0.0000000 0.0000000 -0.0000000 0.0000000 -0.0000000 + -0.0000000 -0.0000000 -0.0000000 0.0000000 0.0000000 +*/ diff --git a/matrix/test/tsv2val.c b/matrix/test/tsv2val.c new file mode 100644 index 0000000..0c502ad --- /dev/null +++ b/matrix/test/tsv2val.c @@ -0,0 +1,55 @@ +/* tsv2val.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: sv2val + + Uses: matprt + + Input file: svd?.dat with ? -> 1 to 7 +*/ +#include "ccmath.h" +#include +char fma[]=" %11.6f",fme[]=" %14.7f"; +void main(int na,char **av) +{ int i,j,m,n; + double *a,*d; + double *p,*q; + FILE *fin; + if(na!=2){ printf("para: file_in\n"); exit(-1);} + fin=fopen(*++av,"r"); + fscanf(fin,"%d %d",&m,&n); + if(m>n) */ + i=sv2val(d,a,m,n); + + if(i== -1){ printf("error: m < n\n"); exit(-1);} + printf(" sval:\n"); + matprt(d,1,n,fme); +} +/* Test output + + dim: 6 x 3 + a-in: + 1.500000 0.500000 8.200000 + 2.000000 1.000000 -3.000000 + 1.000000 -2.000000 -6.000000 + 4.500000 -3.000000 2.000000 + 0.700000 11.000000 -1.000000 + 1.200000 -0.500000 1.000000 + sval: + 11.7105726 10.8589905 5.3023406 +*/ diff --git a/matrix/test/tsvalS.c b/matrix/test/tsvalS.c new file mode 100644 index 0000000..7927d25 --- /dev/null +++ b/matrix/test/tsvalS.c @@ -0,0 +1,32 @@ +/* tsvalS.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Test for numerical instability in SVD code. The output + * will contain non-numeric values Inf (or possibly NaN) + * if the QR fix has not been installed correctly. + * This can be tested by piping the output into the shell + * command: grep -c 'Inf'. + * + * input integer N = number of test cases to generate. + * +*/ +#include +#include +#include +void main(int na,char **av) +{ double d[4], a[16], u[16], v[16]; + int i,j,nn; + unsigned int seed; + if(na<2){ printf("para N\n"); exit(1);} + nn=atoi(*++av); + seed=(unsigned int)time(NULL); setunfl(seed); + for(j=0; j 1 to 7 +*/ +#include "ccmath.h" +#include +char fma[]=" %11.6f"; +char fmf[]=" %9.6f"; +char fme[]=" %13.7f"; +void main(int na,char **av) +{ int i,j,m,n; + double *a,*d,*v; + double *a1; + double *p,*q; + FILE *fin; + if(na!=2){ printf("para: file_in\n"); exit(-1);} + fin=fopen(*++av,"r"); + fscanf(fin,"%d %d",&m,&n); + if(m 1 t0 7 +*/ +#include "ccmath.h" +#include +char fma[]=" %11.6f",fme[]=" %14.7f",fmf[]=" %9.6f"; +void main(int na,char **av) +{ int i,j,m,n; + double *a,*d,*u,*v; + double *a1; + double *p,*q; + FILE *fin; + if(na!=2){ printf("para: file_in\n"); exit(-1);} + fin=fopen(*++av,"r"); + fscanf(fin,"%d %d",&m,&n); + if(m +char fma[]=" %11.6f",fme[]=" %14.7f",fmf[]=" %9.6f"; +void main(int na,char **av) +{ int i,j,k,m,n,nn; + double *a,*d,*u,*v; + double *a1; + double *p,*q; + FILE *fin; + if(na<3){ printf("para: file_in #cases\n"); exit(-1);} + fin=fopen(*++av,"rb"); nn=atoi(*++av); + m=n=4; + a=(double *)calloc(m*n,sizeof(double)); + a1=(double *)calloc(m*n,sizeof(double)); + u=(double *)calloc(m*m,sizeof(double)); + v=(double *)calloc(n*n,sizeof(double)); + d=(double *)calloc(n,sizeof(double)); + for(k=0; k 1 to 7 +*/ +#include "ccmath.h" +#include +char fma[]=" %11.6f",fme[]=" %14.7f",fmf[]=" %9.6f"; +void main(int na,char **av) +{ int i,j,m,n; + double *a,*d; + double *p,*q; + FILE *fin; + if(na!=2){ printf("para: file_in\n"); exit(-1);} + fin=fopen(*++av,"r"); + fscanf(fin,"%d %d",&m,&n); + if(m size of unitary matrix is n by n +*/ +#include "ccmath.h" +unsigned int seed=123456789; +void main(int na,char **av) +{ Cpx *u,*v,*e; + int i,j,k,n; + if(na!=2){ printf("para: size\n"); exit(1);} + n=atoi(*++av); + u=(Cpx *)calloc(n*n,sizeof(Cpx)); + v=(Cpx *)calloc(n*n,sizeof(Cpx)); + e=(Cpx *)calloc(n*n,sizeof(Cpx)); + setunfl(seed); + +/* generate a unitary matrix */ + unitary(u,n); + + printf(" size= %d :\n",n); + cmprt(u,n,n," (%7.4f,%7.4f)"); + +/* compute the hermitian conjugate matrix */ + cmcpy(v,u,n*n); hconj(v,n); + + printf(" hconj:\n"); + cmprt(v,n,n," (%7.4f,%7.4f)"); +/* check the unitary propery of the matrix */ + cmmul(e,u,v,n); + printf(" test unitary property\n"); + cmprt(e,n,n," (%6.3f,%6.3f)"); +} +/* Test output + + size= 4 : + ( 0.2956, 0.2530) (-0.2439, 0.0696) (-0.1821, 0.8027) (-0.0506, 0.3228) + (-0.6321, 0.2510) ( 0.4965,-0.1105) ( 0.2111, 0.4394) (-0.0399,-0.1987) + ( 0.4894, 0.3046) ( 0.3478, 0.3572) (-0.1526, 0.0178) ( 0.0184,-0.6286) + ( 0.1045, 0.2068) ( 0.5993, 0.2630) (-0.0805,-0.2341) ( 0.0057, 0.6758) + hconj: + ( 0.2956,-0.2530) (-0.6321,-0.2510) ( 0.4894,-0.3046) ( 0.1045,-0.2068) + (-0.2439,-0.0696) ( 0.4965, 0.1105) ( 0.3478,-0.3572) ( 0.5993,-0.2630) + (-0.1821,-0.8027) ( 0.2111,-0.4394) (-0.1526,-0.0178) (-0.0805, 0.2341) + (-0.0506,-0.3228) (-0.0399, 0.1987) ( 0.0184, 0.6286) ( 0.0057,-0.6758) + test unitary property + ( 1.000, 0.000) ( 0.000, 0.000) (-0.000, 0.000) ( 0.000, 0.000) + ( 0.000,-0.000) ( 1.000, 0.000) ( 0.000,-0.000) ( 0.000,-0.000) + (-0.000,-0.000) ( 0.000, 0.000) ( 1.000, 0.000) (-0.000, 0.000) + ( 0.000,-0.000) ( 0.000, 0.000) (-0.000,-0.000) ( 1.000, 0.000) +*/ diff --git a/matrix/test/tutrncm.c b/matrix/test/tutrncm.c new file mode 100644 index 0000000..854cba0 --- /dev/null +++ b/matrix/test/tutrncm.c @@ -0,0 +1,69 @@ +/* tutrncm.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: utrncm utrnhm + + Uses: hconj unitary hmgen cmcpy cmprt + + Input parameter: n -> size of matrices is n by n +*/ +#include "ccmath.h" +void main(int na,char **av) +{ int n,m,k; Cpx *a,*u,*v,*h,*s; + double *q; unsigned int seed; + if(na!=2){ printf("para: dim\n"); exit(1);} + n=atoi(*++av); m=n*n; + a=(Cpx *)calloc(4*m,sizeof(Cpx)); + q=(double *)calloc(n,sizeof(double)); + h=a+m; u=h+m; v=u+m; + seed=123456789; setunfl(seed); + for(k=1; k<=n ;++k) q[k-1]=(double)k; + unitary(u,n); hmgen(h,q,u,n); + printf(" matrix h:\n"); + cmprt(h,n,n,"(%7.3f,%7.3f)"); + cmcpy(v,u,n*n); hconj(v,n); + +/* transform of h by the unitary matrix v */ + utrncm(a,v,h,n); + + printf(" matrix conjugate vhv^:\n"); + cmprt(a,n,n,"(%7.3f,%7.3f)"); + +/* transform Hermitian h by the unitary matrix v */ + utrnhm(a,v,h,n); + + printf(" hermitian conjugate a=vhv^:\n"); + cmprt(a,n,n,"(%7.3f,%7.3f)"); +/* check transform by inversion */ + utrnhm(v,u,a,n); + printf(" hermitian conjugate uau^:\n"); + cmprt(v,n,n,"(%7.3f,%7.3f)"); +} +/* Test output + + matrix h: +( 2.740, -0.000)( 0.313, 0.438)( -0.587, -0.205)( 0.179, -0.000) +( 0.313, -0.438)( 1.857, -0.000)( 0.457, -0.444)( -0.375, -0.091) +( -0.587, 0.205)( 0.457, 0.444)( 2.482, 0.000)( -0.955, 0.000) +( 0.179, 0.000)( -0.375, 0.091)( -0.955, -0.000)( 2.921, -0.000) + matrix conjugate vhv^: +( 1.000, -0.000)( -0.000, -0.000)( 0.000, -0.000)( 0.000, 0.000) +( -0.000, 0.000)( 2.000, -0.000)( 0.000, -0.000)( 0.000, 0.000) +( 0.000, 0.000)( 0.000, 0.000)( 3.000, -0.000)( 0.000, -0.000) +( -0.000, 0.000)( 0.000, -0.000)( 0.000, 0.000)( 4.000, 0.000) + hermitian conjugate a=vhv^: +( 1.000, -0.000)( -0.000, -0.000)( 0.000, -0.000)( 0.000, 0.000) +( -0.000, 0.000)( 2.000, -0.000)( 0.000, -0.000)( 0.000, 0.000) +( 0.000, 0.000)( 0.000, 0.000)( 3.000, -0.000)( 0.000, -0.000) +( 0.000, -0.000)( 0.000, -0.000)( 0.000, 0.000)( 4.000, 0.000) + hermitian conjugate uau^: +( 2.740, -0.000)( 0.313, 0.438)( -0.587, -0.205)( 0.179, -0.000) +( 0.313, -0.438)( 1.857, -0.000)( 0.457, -0.444)( -0.375, -0.091) +( -0.587, 0.205)( 0.457, 0.444)( 2.482, -0.000)( -0.955, 0.000) +( 0.179, 0.000)( -0.375, 0.091)( -0.955, -0.000)( 2.921, -0.000) +*/ diff --git a/matrix/test/util/cmatgen.c b/matrix/test/util/cmatgen.c new file mode 100644 index 0000000..08f0c83 --- /dev/null +++ b/matrix/test/util/cmatgen.c @@ -0,0 +1,22 @@ +/* cmatgen.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "ccmath.h" +void main(int na,char **av) +{ Cpx *a,*p; double nrml(); + int n,m,j; unsigned int seed; + FILE *fp; + if(na!=3){ printf("para: dim o_file\n"); exit(1);} + n=atoi(*++av); m=n*n; + fp=fopen(*++av,"wb"); + a=(Cpx *)calloc(m,sizeof(Cpx)); + seed=(unsigned int)time(NULL); setnrml(seed); + for(j=0,p=a; jre=nrml(); (p++)->im=nrml();} + fwrite((void *)&n,sizeof(int),1,fp); + fwrite((void *)a,sizeof(Cpx),m,fp); +} diff --git a/matrix/test/util/cmprt.c b/matrix/test/util/cmprt.c new file mode 100644 index 0000000..176308a --- /dev/null +++ b/matrix/test/util/cmprt.c @@ -0,0 +1,20 @@ +/* cmprt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "ccmath.h" +char fmt[]="(%7.3f,%7.3f)"; +void main(int na,char **av) +{ Cpx *a; int n; + FILE *fb; + if(na!=2){ printf("para: input_file\n"); exit(1);} + fb=fopen(*++av,"rb"); + fread((void *)&n,sizeof(int),1,fb); + a=(Cpx *)calloc(n*n,sizeof(Cpx)); + fread((void *)a,sizeof(Cpx),n*n,fb); + printf(" %d\n",n); + cmprt(a,n,n,fmt); +} diff --git a/matrix/test/util/hmatgen.c b/matrix/test/util/hmatgen.c new file mode 100644 index 0000000..3a639f4 --- /dev/null +++ b/matrix/test/util/hmatgen.c @@ -0,0 +1,24 @@ +/* hmatgen.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "ccmath.h" +void main(int na,char **av) +{ Cpx *h,*u; FILE *fp; + int i,n,m; unsigned int seed; double *e,s; + if(na!=3){ printf("para: size o_file\n"); exit(1);} + n=atoi(*++av); m=n*n; + fp=fopen(*++av,"wb"); + fwrite((void *)&n,sizeof(int),1,fp); + h=(Cpx *)calloc(2*m,sizeof(Cpx)); u=h+m; + e=(double *)calloc(n,sizeof(double)); + for(i=0,s=1.; i +#include "ccmath.h" +void main(int na,char **av) +{ double *a,*p; + int n,m,j; unsigned int seed; + FILE *fp; + if(na!=3){ printf("para: dim o_file\n"); exit(1);} + n=atoi(*++av); m=n*n; + fp=fopen(*++av,"wb"); + a=(double *)calloc(m,sizeof(double)); + seed=(unsigned int)time(NULL); setnrml(seed); + for(j=0,p=a; j +#include "complex.h" +static void ortho(); +static double tpi=6.283185307179586; +double unfl(); +void unitary(Cpx *u,int n) +{ int i,j,k,m; Cpx h,*v,*e,*p,*r; + double *g,*q,a; + m=n*n; + g=(double *)calloc(n*n,sizeof(double)); + v=(Cpx *)calloc(m+n,sizeof(Cpx)); + e=v+m; + h.re=1.; h.im=0.; + for(i=0; ire= *q++; + } + for(i=0,p=v; ire-h.im*p->im; + p->im=h.im*p->re+h.re*p->im; p->re=a; + } + } + ortho(g,n); + for(i=m=0,p=u; ire=p->im=0.; + for(k=0,q=g+m,r=v+j; kre+= *q*r->re; p->im+= *q++ *r->im; + } + } + } + free(g); free(v); +} +static void ortho(double *g,int n) +{ int i,j,k,m; + double *p,*q,c,s,a; + for(i=0,p=g; i +#include "complex.h" +void utrncm(Cpx *cm,Cpx *a,Cpx *b,int n) +{ Cpx z,*q0,*p,*s,*t; + int i,j,k; + q0=(Cpx *)calloc(n,sizeof(Cpx)); + for(i=0; ire*s->re+t->im*s->im; + z.im+=t->im*s->re-t->re*s->im; + } + q0[j]=z; + } + for(j=0,p=cm,t=a; jre*s->re-t->im*s->im; + z.im+=t->im*s->re+t->re*s->im; + } + *p=z; + } + } + free(q0); +} diff --git a/matrix/utrnhm.c b/matrix/utrnhm.c new file mode 100644 index 0000000..0eb72bd --- /dev/null +++ b/matrix/utrnhm.c @@ -0,0 +1,33 @@ +/* utrnhm.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "complex.h" +void utrnhm(Cpx *hm,Cpx *a,Cpx *b,int n) +{ Cpx z,*q0,*p,*s,*t; + int i,j,k; + q0=(Cpx *)calloc(n,sizeof(Cpx)); + for(i=0; ire*s->re+t->im*s->im; + z.im+=t->im*s->re-t->re*s->im; + } + q0[j]=z; + } + for(j=0,p=hm+i,t=a; j<=i ;++j,p+=n){ + z.re=z.im=0.; + for(k=0,s=q0; kre*s->re-t->im*s->im; + z.im+=t->im*s->re+t->re*s->im; + } + *p=z; if(j +struct complex cadd(Cpx a,Cpx b),csub(Cpx a,Cpx b); +struct complex cmul(Cpx a,Cpx b),cdiv(Cpx a,Cpx b); +struct complex crmu(double x,Cpx a),cimu(double y,Cpx a); +struct complex ccng(Cpx c),cdef(double r,double i); +double cabs(Cpx a),cnrm(Cpx a); +struct complex csqrt(Cpx a),cexp(Cpx a),clog(Cpx a); +struct complex csin(Cpx a),ccos(Cpx a),ctan(Cpx a); +struct complex casin(Cpx f),cacos(Cpx f),catan(Cpx f); +struct complex csinh(Cpx h),ccosh(Cpx h),ctanh(Cpx h); +struct complex casinh(Cpx g),cacosh(Cpx g),catanh(Cpx g); diff --git a/roots/optmiz.c b/roots/optmiz.c new file mode 100644 index 0000000..9912c95 --- /dev/null +++ b/roots/optmiz.c @@ -0,0 +1,58 @@ +/* optmiz.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#define Abs(x) ( ((x)<0.)?-(x):(x) ) +static double fev(double *x,double *py,double *ps, + double c,double (*func)()); +int optmiz(double *x,int n,double (*func)(),double de,double test,int max) +{ double fs,fp,fa,fb,fc,s,sa,sb,sc; int k,m; + double *pd,*ps,*py,*pg,*ph,*p,*q,*r; + pd=(double *)calloc(n*(n+4),sizeof(double)); + ps=pd+n; py=ps+n; pg=py+n; ph=pg+n; + for(p=ph,q=ph+n*n; pfb) break; + fa=fb; sa=sb; fb=fc; sb=sc; sc*=2.; } + if(sc==1.){ sb=.5; + for(;;){ if((fb=fev(x,py,ps,sb,func))f1){ if(s +#include "complex.h" +int plrt(double *cof,int n,Cpx *root,double ra,double rb) +{ double a,b,s,t,w; int itr,pat; struct complex *pr; + double *cs,*cf,*hf,*p,*q,*ul,test=1.e-28; + cs=cf=(double *)calloc(2*n,sizeof(double)); hf=cf+n; + pr=root+n-1; ul=hf+n-1; + if(rb<0.) rb=ra*ra-rb*rb; else rb=ra*ra+rb*rb; ra*= -2.; + q=cof+n; s= *q--; + for(p=cf; p2){ a=ra; b=rb;} + else if(n==2){ a= *cf++; b= *cf;} + else if(n==1){ pr->re= -(*cf); pr->im=0.; free(cs); return 0;} + } + s= -a/2.; t=s*s-b; + if(t>=0.){ t=sqrt(t); pr->re=s+t; (pr--)->im=0.; + pr->re=s-t; (pr++)->im=0.; } + else{ t=sqrt(-t); pr->re=s; (pr--)->im=t; + pr->re=s; (pr++)->im= -t; } + if(n==2){ free(cs); return 0;} + for(p=hf,q=cf; qre* *p; s=pr->im* *p; + if(t*t+s*s=0 ;--i){ + s=py.re*z.re-py.im*z.im; + py.im=py.im*z.re+py.re*z.im; py.re=s+cof[i]; + } + return py; +} diff --git a/roots/secrt.c b/roots/secrt.c new file mode 100644 index 0000000..c868452 --- /dev/null +++ b/roots/secrt.c @@ -0,0 +1,16 @@ +/* secrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +double secrt(double (*func)(),double x,double dx,double test) +{ double f,fp,y; int k; + y=x-dx; fp=(*func)(y); + for(k=0;;++k){ f=(*func)(x); + dx=f*(x-y)/(f-fp); fp=f; y=x; x-=dx; + if(((dx<0.)?-dx:dx) +int solnl(double *x,double *f,double (*fvec[])(), + int n,double test) +{ double sc,del,delp; int i,j,k; + double *p,*q,*r,*s,*pth,*py,*ps,*pb; + pth=(double *)calloc(n*n+3*n,sizeof(*pth)); + py=pth+n*n; ps=py+n; pb=ps+n; + for(i=0; i +int solnx(double *x,double *f,double (*fvec[])(),double *jm, + int n,double test) +{ double sc,del,delp; int i,j,k; + double *p,*q,*r,*s,*pth,*py,*ps,*pb; + pth=(double *)calloc(n*n+3*n,sizeof(*pth)); + py=pth+n*n; ps=py+n; pb=ps+n; + for(i=0; i +#define Tpi 6.283185308 +double fhv(double *x) +{ double r,an; extern int count; + ++count; + r=x[0]*x[0]+x[1]*x[1]; r=sqrt(r)-1.; + an=x[2]-10.*atan2(x[1],x[0])/Tpi; + return (100.*(an*an+r*r)+x[2]*x[2]); +} diff --git a/roots/test/op-test/frb.c b/roots/test/op-test/frb.c new file mode 100644 index 0000000..ed0aab6 --- /dev/null +++ b/roots/test/op-test/frb.c @@ -0,0 +1,16 @@ +/* frb.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Rosenbrock function: + minimum = 0 at x[0]=1.0 x[1]=1.0 +*/ +double frb(double *x) +{ double f,y; extern int count; + ++count; + y=x[0]; f=1.0-y; y=x[1]-y*y; + return 100.0*y*y+f*f; +} diff --git a/roots/test/op-test/topth.c b/roots/test/op-test/topth.c new file mode 100644 index 0000000..2b30ac6 --- /dev/null +++ b/roots/test/op-test/topth.c @@ -0,0 +1,50 @@ +/* topth.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#define ND 20 +double x[ND]; +int count,dim; +void main(int na,char **av) +{ double de,test,atof(),*pp,cc; + double frb(double *x),fchqad(double *x); + double f4d(double *x),fhv(double *x); + double (*func[4])(); + int n,max,it,kf,j; + func[0]=frb; func[1]=fhv; func[2]=f4d; func[3]=fchqad; + printf(" Test of Optimizer\n"); + if(na<2){ fprintf(stderr,"para func_flag range 0 to 3\n"); exit(1);} + max=60; de=1.e-9; test=1.e-14; + printf(" max= %d de= %8.2e\n",max,de); + printf(" convergence threshold = %8.2e\n",test); + kf=atoi(*++av); + if(kf==0){ n=2; printf("Rosenbrock\n\n");} + else if(kf==1){ n=3; printf("Helical Valley\n\n");} + else if(kf==2){ n=4; printf("4 Dimensional\n\n");} + else{ + fprintf(stderr," enter dimension "); scanf("%d",&dim); n=dim; + printf("Tchebycheff {dimension=%d}\n\n",dim); + } + if(kf<3){ + fprintf(stderr," enter %d components of initial vector\n",n); + for(j=0,pp=x; j +char dfn[]="1-sin(x) on 0 to Pi"; +void main(void) +{ double xopt,dx; + double ft(double x); + printf(" Test of Optimum Line Search\n"); + printf(" minimum of %s\n",dfn); + xopt=optsch(ft,0.,3.14159,1.e-14); + printf(" minimum at x = %10.6f\n",xopt); + dx=.0001; + printf(" test: f(x)= %e\n",ft(xopt)); + printf(" f(x+.0001)= %e\n",ft(xopt+dx)); + printf(" f(x-.0001)= %e\n",ft(xopt-dx)); +} +/* Function to be optimized */ +double ft(double x) +{ return 1.-sin(x); +} +/* Test output + + Test of Optimum Line Search + minimum of 1-sin(x) on 0 to Pi + minimum at x = 1.570796 + test: f(x)= 4.499439e-18 + f(x+.0001)= 4.999700e-09 + f(x-.0001)= 5.000300e-09 +*/ diff --git a/roots/test/tplrt.c b/roots/test/tplrt.c new file mode 100644 index 0000000..7a5b9d4 --- /dev/null +++ b/roots/test/tplrt.c @@ -0,0 +1,64 @@ +/* tplrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: plrt polyc + + To use an input data file call 'tplrt file'. + Input data files pol1.dat and pol2.dat +*/ +#include "ccmath.h" +#include +#define NN 10 +/* complex structure is defined by */ +/* struct complex {double re,im;}; */ +int n=7; +double cof[]={ 10., -4., 7., 8., -3., 7., -2., 1.}; +void main(int na,char **av) +{ struct complex py,root[NN]; + double ra,rb,s; int i,ns; + FILE *fp; + if(na==2){ + fp=fopen(*++av,"r"); + for(n=0; fscanf(fp,"%lf",cof+n)!=EOF ;++n); + } + printf(" Test of Polynomial Root Program\n"); + printf(" polynomial degree = %d\n",n); + printf(" coefficients:\n"); + for(i=n; i>=0 ;) printf(" %8.4f\n",cof[i--]); + ra=1.; rb=2.; + ns=plrt(cof,n,root,ra,rb); + printf(" return status = %d\n",ns); + printf(" roots and residuals\n"); + for(i=0; i +char fdn[]="cos(x)-x"; +void main(void) +{ double x,dx,fa(double x); + printf(" Test of Secant Root Function\n"); + printf(" input function: %s\n",fdn); +/* starting values x,x+dx defined here */ + x=1.; dx=.1; + printf(" input estimated root = %f increment = %f\n",x,dx); + x=secrt(fa,x,dx,1.e-14); + printf(" solution to F(x)=0 : x = %18.12f\n",x); + printf(" test F(x) = %e\n",fa(x)); +} +/* function for which root is desired */ +double fa(double x) +{ return cos(x)-x; +} +/* Test output + + Test of Secant Root Function + input function: cos(x)-x + input estimated root = 1.000000 increment = 0.100000 + solution to F(x)=0 : x = 0.739085133215 + test F(x) = -5.128276e-17 +*/ diff --git a/roots/test/tsolnl.c b/roots/test/tsolnl.c new file mode 100644 index 0000000..ddf7a5d --- /dev/null +++ b/roots/test/tsolnl.c @@ -0,0 +1,54 @@ +/* tsolnl.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: solnl +*/ +#include "ccmath.h" +#define NN 3 +void main(void) +{ double x[NN],f[NN],(*fv[NN])(),test=1.e-28; + double fa(double *x),fb(double *x),fc(double *); + int i,m; + fv[0]=fa; fv[1]=fb; fv[2]=fc; + printf(" Test of Nonlinear System Solver\n"); + fprintf(stderr," enter initial x-vector (%d components)\n",NN); + for(i=0; itt0 # extract sample output -> tt0 +a.out $* >tt1 # run test with output -> tt1 +diff tt0 tt1 # compare output to sample output diff --git a/sfunc/airy.c b/sfunc/airy.c new file mode 100644 index 0000000..6ed6dd7 --- /dev/null +++ b/sfunc/airy.c @@ -0,0 +1,38 @@ +/* airy.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double airy(double x,int df) +{ double f,y,a,b,s; int p; + double u=.258819403792807,v=.355028053887817; + if(x<=1.7 && x>= -6.9){ y=x*x*x/9.; + if(df){ b= -(a=2./3.); v*=x*x/2.; u= -u;} + else{ a= -(b=1./3.); u*= -x;} + for(p=1,f=u+v;;++p){ + v*=y/(p*(a+=1.)); u*=y/(p*(b+=1.)); + f+=(s=u+v); if(fabs(s)<1.e-14) break; } + } + else{ s=1./sqrt(v=3.14159265358979); y=fabs(x); + if(df) s*=pow(y,.25); else s/=pow(y,.25); + y*=2.*sqrt(y)/3.; + if(x>0.){ a=12./pow(y,.333); p=a*a; + if(df) a= -7./36.; else a=5./36.; + b=2.*(p+y); f=1.; u=x=0.; s*=exp(-y)/2.; + for(; p>0 ;--p,b-=2.){ + y=(b*f-(p+1)*x)/(p-1+a/p); x=f; u+=(f=y); } + if(df) f*= -s/u; else f*=s/u; + } + else{ x=y-v/4.; y*=2.; b=.5; f=s; v=0.; + if(df) a=2./3.; else a=1./3.; + for(p=1; (u=fabs(s))>1.e-14 ;++p,b+=1.){ + s*=(a+b)*(a-b)/(p*y); if(fabs(s)>=u) break; + if(!(p&1)){ s= -s; f+=s;} else v+=s; } + if(df) f=f*sin(x)+v*cos(x); else f=f*cos(x)-v*sin(x); + } + } + return f; +} diff --git a/sfunc/amelp.c b/sfunc/amelp.c new file mode 100644 index 0000000..da5aed0 --- /dev/null +++ b/sfunc/amelp.c @@ -0,0 +1,19 @@ +/* amelp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double amelp(double u,double k) +{ double a,b,cs[10]; int m,n=1; + a=1.; b=sqrt(1.-k*k); + for(m=0; (k=a-b)>4.e-15 ;++m){ + cs[m]=k/2.; k=a+b; b=sqrt(a*b); + a=k/2.; cs[m]/=a; n*=2; + } + for(u*=n*a,--m; m>=0 ;--m) + u=(u+asin(cs[m]*sin(u)))/2.; + return u; +} diff --git a/sfunc/biry.c b/sfunc/biry.c new file mode 100644 index 0000000..2afdb2f --- /dev/null +++ b/sfunc/biry.c @@ -0,0 +1,35 @@ +/* biry.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double biry(double x,int df) +{ double f,y,a,b,s; int p; + double u=.258819403792807,v=.355028053887817; + if(x<=7.6 && x>= -6.9){ y=x*x*x/9.; + if(df){ b= -(a=2./3.); u*=(f=sqrt(3.)); v*=f*x*x/2.;} + else{ a= -(b=1./3.); v*=(f=sqrt(3.)); u*=f*x;} + for(p=1,f=u+v;;++p){ + v*=y/(p*(a+=1.)); u*=y/(p*(b+=1.)); f+=(s=u+v); + if(fabs(s)<1.e-14*(1.+fabs(f))) break; } + } + else{ s=1./sqrt(v=3.14159265358979); y=fabs(x); + if(df) s*=pow(y,.25); else s/=pow(y,.25); + y*=2.*sqrt(y)/3.; b=.5; + if(df) a=2./3.; else a=1./3.; + if(x>0.){ s*=exp(y); f=s; y*= -2.; + for(p=1; (u=fabs(s))>1.e-14 ;++p,b+=1.){ + s*=(a+b)*(a-b)/(p*y); if(fabs(s)>=u) break; f+=s; } + } + else{ x=y-v/4.; y*=2.; f=s; v=0.; + for(p=1; (u=fabs(s))>1.e-14 ;++p,b+=1.){ + s*=(a+b)*(a-b)/(p*y); if(fabs(s)>=u) break; + if(!(p&1)){ s= -s; f+=s;} else v+=s; } + if(df) f=f*cos(x)-v*sin(x); else f= -(f*sin(x)+v*cos(x)); + } + } + return f; +} diff --git a/sfunc/drbes.c b/sfunc/drbes.c new file mode 100644 index 0000000..58e3582 --- /dev/null +++ b/sfunc/drbes.c @@ -0,0 +1,31 @@ +/* drbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double drbes(double x,double v,int f,double *p) +{ double y,jbes(double u,double s),nbes(double u,double s); + double ibes(double u,double s),kbes(double u,double s); + if(x==0.){ + switch(f){ + case 'j': + case 'i': if(v==1.) return .5; + if(v==0. || v>1.) return 0.; + default : break; } + return HUGE_VAL; + } + if(p!=0L) y= *p*v/x; else y=0.; + switch(f){ + case 'j': if(p==0L && v>0.) y=jbes(v,x)*v/x; + return y-jbes(v+1.,x); + case 'y': if(p==0L && v>0.) y=nbes(v,x)*v/x; + return y-nbes(v+1.,x); + case 'i': if(p==0L && v>0.) y=ibes(v,x)*v/x; + return y+ibes(v+1.,x); + case 'k': if(p==0L && v>0.) y=kbes(v,x)*v/x; + return y-kbes(v+1.,x); + } return 0.; +} diff --git a/sfunc/drspbes.c b/sfunc/drspbes.c new file mode 100644 index 0000000..629f4c0 --- /dev/null +++ b/sfunc/drspbes.c @@ -0,0 +1,31 @@ +/* drspbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef NULL +#define NULL ((void *)0) +#endif +#include +double drspbes(double x,int n,int f,double *p) +{ double y; + double jspbes(int m,double a),yspbes(int m,double a); + double kspbes(int m,double a); + if(x==0.){ + if(f=='j'){ if(n==1) return 1./3.; else return 0.;} + return HUGE_VAL; + } + if(p!=NULL) y= *p*n/x; else y=0.; + switch(f){ + case 'j': if(p==NULL && n) y=jspbes(n,x)*n/x; + return y-jspbes(++n,x); + case 'y': if(p==NULL && n) y=yspbes(n,x)*n/x; + return y-yspbes(++n,x); + case 'k': if(p==NULL && n) y=kspbes(n,x)*n/x; + y-=kspbes(++n,x); + if(x>0.) return y; else return -y; + } + return 0.; +} diff --git a/sfunc/felp.c b/sfunc/felp.c new file mode 100644 index 0000000..7923dc6 --- /dev/null +++ b/sfunc/felp.c @@ -0,0 +1,26 @@ +/* felp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#ifndef NULL +#define NULL ((void *)0) +#endif +double felp(double an,double k,double *pk,double *pz,double *ph) +{ double a,b,c,s,h; int m=1; + double pi=3.14159265358979; + a=1.; b=sqrt(1.-k*k); s=h=0.; + while((c=(a-b)/2.)>.5e-15){ m*=2; + if((k=atan(b*tan(an)/a))<0.) k+=pi; + if((k-=fmod(an,pi))>2.) k-=pi; + an+=an+k; k=a+b; b=sqrt(a*b); a=k/2.; + h+=c*a*m; s+=c*sin(an); + } + *pk=pi/(2.*a); an/=m*a; + if(pz!=NULL){ + *pz=s+(h=1.-h)*an; *ph=h* *pk;} + return an; +} diff --git a/sfunc/g2elp.c b/sfunc/g2elp.c new file mode 100644 index 0000000..e9f3397 --- /dev/null +++ b/sfunc/g2elp.c @@ -0,0 +1,37 @@ +/* g2elp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double g2elp(double an,double bn,double k,double as,double bs,double ds) +{ double a,b,d,s,r,f,h; int m=1,q=0; + double pi=3.14159265358979; + double gsng2(double *pa,double *pb,double *pc,double b,double an, + double bn); + a=1.; b=sqrt(1.-k*k); r=s=0.; + if(ds<0.) + if((r=gsng2(&as,&bs,&ds,b,an,bn))==HUGE_VAL) return r; + if(an<0.){ an= -an; q=1;} + while(a-b>1.e-15){ m*=2; + if((k=atan(b*tan(an)/a))<0.) k+=pi; + if((k-=fmod(an,pi))>2.) k-=pi; an+=an+k; + if((k=atan(b*tan(bn)/a))<0.) k+=pi; + if((k-=fmod(bn,pi))>2.) k-=pi; bn+=bn+k; + k=a+b; b=sqrt(a*b); a=k/2.; + d=(as-bs)/(2.*a*m); + k=as+bs; bs=as+ds*bs; as=k/2.; + bs/=(k=1.+ds); ds=b*k*k/(4.*a*ds); + if((f=1.-b*ds/a)>1.e-9){ + d/=2.*(f=sqrt(f)); h=f*sin(bn); f*=sin(an); + s+=d*log((1.+f)/(1.-f)); r+=d*log((1.+h)/(1.-h)); } + else if(f< -1.e-9){ + d/=(f=sqrt(-f)); h=f*sin(bn); f*=sin(an); + s+=d*atan(f); r+=d*atan(h); } + else{ s+=d*sin(an); r+=d*sin(bn);} + } + if(q) return as*(bn+an)/(m*a)+r+s; + return as*(bn-an)/(m*a)+r-s; +} diff --git a/sfunc/gaml.c b/sfunc/gaml.c new file mode 100644 index 0000000..060522d --- /dev/null +++ b/sfunc/gaml.c @@ -0,0 +1,15 @@ +/* gaml.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double gaml(double x) +{ double g,h; + for(g=1.; x<30. ;g*=x,x+=1.); h=x*x; + g=(x-.5)*log(x)-x+.918938533204672-log(g); + g+=(1.-(1./6.-(1./3.-1./(4.*h))/(7.*h))/(5.*h))/(12.*x); + return g; +} diff --git a/sfunc/gelp.c b/sfunc/gelp.c new file mode 100644 index 0000000..202cdbc --- /dev/null +++ b/sfunc/gelp.c @@ -0,0 +1,39 @@ +/* gelp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#ifndef NULL +#define NULL ((void *)0) +#endif +double gelp(double an,double k,double as,double bs,double ds, + double *pg,double *pf,double *pk) +{ double a,b,d,s,f; int m=1; + double pi=3.14159265358979; + double gsng(double *pa,double *pb,double *pc,double b,double an); + a=1.; b=sqrt(1.-k*k); s=0.; + if(ds<0.) + if((s=gsng(&as,&bs,&ds,b,an))==HUGE_VAL) return s; + while(a-b>1.e-15){ m*=2; + if((k=atan(b*tan(an)/a))<0.) k+=pi; + if((k-=fmod(an,pi))>2.) k-=pi; + an+=an+k; k=a+b; b=sqrt(a*b); + a=k/2.; d=(as-bs)/(2.*a*m); + k=as+bs; bs=as+ds*bs; as=k/2.; + bs/=(k=1.+ds); ds=b*k*k/(4.*a*ds); + if((f=1.-b*ds/a)>1.e-9){ + d/=2.*(f=sqrt(f)); f*=sin(an); + s+=d*log((1.+f)/(1.-f)); } + else if(f< -1.e-9){ + d/=(f=sqrt(-f)); f*=sin(an); s+=d*atan(f); } + else s+=d*sin(an); + } + f=an/(m*a); + if(pg!=NULL){ k=pi/(2.*a); *pg=as*k; + if(pf!=NULL){ *pf=f; *pk=k;} + } + return as*f+s; +} diff --git a/sfunc/gsng.c b/sfunc/gsng.c new file mode 100644 index 0000000..34413e7 --- /dev/null +++ b/sfunc/gsng.c @@ -0,0 +1,17 @@ +/* gsng.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double gsng(double *pa,double *pb,double *pc,double b,double an) +{ double r,s,t,u; + r= *pa- *pb; u=b* *pc; s=1.-u; t=b*b-u; + *pc= *pa; *pa= *pb+r/s; *pb= *pc+r*u/t; + *pc=(t/=s)/b; t=sqrt(-u*t); r*=(-u/(2.*s*t)); + s=sin(an); u=(1.-b*b)*s*s; t*=tan(an)/sqrt(1.-u); + if(fabs(1.-t)<1.e-15) return HUGE_VAL; + return r*log(fabs((1.+t)/(1.-t))); +} diff --git a/sfunc/gsng2.c b/sfunc/gsng2.c new file mode 100644 index 0000000..56ce4cb --- /dev/null +++ b/sfunc/gsng2.c @@ -0,0 +1,21 @@ +/* gsng2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static double ze=1.e-15; +double gsng2(double *pa,double *pb,double *pc,double b, + double an,double bn) +{ double r,s,t,ta,tb,u; + r= *pa- *pb; u=b* *pc; s=1.-u; t=b*b-u; + *pc= *pa; *pa= *pb+r/s; *pb= *pc+r*u/t; + *pc=(t/=s)/b; t=sqrt(-u*t); r*=(-u/(2.*s*t)); + u=1.-b*b; + s=sin(bn); tb=t*tan(bn)/sqrt(1.-u*s*s); + s=sin(an); ta=t*tan(an)/sqrt(1.-u*s*s); + if(fabs(1.-ta) +double ibes(double v,double x) +{ double y,s,t,tp,gaml(double w); int p,m; + y=x-9.; if(y>0.) y*=y; tp=v*v*.2+25.; + if(y0.) s=t=exp(v*log(x)-gaml(v+1.)); + else{ if(v>0.) return 0.; else if(v==0.) return 1.;} + for(p=1,x*=x;;++p){ t*=x/(p*(v+=1.)); s+=t; + if(p>m && t<1.e-13*s) break; + } + } + else{ double u,a0=1.57079632679490; + s=t=1./sqrt(x*a0); x*=2.; u=0.; + for(p=1,y=.5; (tp=fabs(t))>1.e-14 ;++p,y+=1.){ + t*=(v+y)*(v-y)/(p*x); if(y>v && fabs(t)>=tp) break; + if(!(p&1)) s+=t; else u-=t; + } + x/=2.; s=cosh(x)*s+sinh(x)*u; + } + return s; +} diff --git a/sfunc/jbes.c b/sfunc/jbes.c new file mode 100644 index 0000000..dd22c2a --- /dev/null +++ b/sfunc/jbes.c @@ -0,0 +1,28 @@ +/* jbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double jbes(double v,double x) +{ double y,s,t,tp,gaml(double z); int p,m; + y=x-8.5; if(y>0.) y*=y; tp=v*v/4.+13.69; + if(y0.) s=t=exp(v*log(x)-gaml(v+1.)); + else{ if(v>0.) return 0.; else if(v==0.) return 1.;} + for(p=1,x*= -x;;++p){ t*=x/(p*(v+=1.)); s+=t; + if(p>m && fabs(t)<1.e-13) break; + } + } + else{ double u,a0=1.57079632679490; + s=t=1./sqrt(x*a0); x*=2.; u=0.; + for(p=1,y=.5; (tp=fabs(t))>1.e-14 ;++p,y+=1.){ + t*=(v+y)*(v-y)/(p*x); if(y>v && fabs(t)>=tp) break; + if(!(p&1)){ t= -t; s+=t;} else u-=t; + } + y=x/2.-(v+.5)*a0; s=cos(y)*s+sin(y)*u; + } + return s; +} diff --git a/sfunc/jspbes.c b/sfunc/jspbes.c new file mode 100644 index 0000000..78c2926 --- /dev/null +++ b/sfunc/jspbes.c @@ -0,0 +1,27 @@ +/* jspbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double jspbes(int n,double x) +{ double y,s,t,v,u,a0=1.57079632679490; + double gaml(double a); int p,m; + if(x==0.){ if(n==0) return 1.; else return 0.;} + v=n+.5; y=1.+.68*n; + if(xm && fabs(t)<1.e-13*fabs(s)) break; } + } + else{ s=t=1./x; x*=2.; u=0.; + for(p=1,y=.5; y +double kbes(double v,double x) +{ double y,s,t,tp,f,a0=1.57079632679490; + double gaml(double u),psi(double u),modf(double u,double *v); + int p,k,m; + if(x==0.) return HUGE_VAL; + y=x-10.5; if(y>0.) y*=y; tp=25.+.185*v*v; + if(ym && fabs(y)<1.e-14) break; } + if(k>0){ x= -x; s+=(t=1./(tp*2.)); + for(p=1,--k; k>0 ;++p,--k) s+=(t*=x/(p*k)); } + } + else{ f=1./(t*v*2.); t*=a0/sin(2.*a0*v); s=f-t; + for(p=1,x*=x,tp=v;;++p){ + t*=x/(p*(v+=1.)); f*= -x/(p*(tp-=1.)); + s+=(y=f-t); if(p>m && fabs(y)<1.e-14) break; } + } + } + else{ double tq,h,w,z,r; + t=12./pow(x,.333); k=t*t; y=2.*(x+k); + m=v; v-=m; tp=v*v-.25; v+=1.; tq=v*v-.25; + for(s=h=1.,r=f=z=w=0.; k>0 ;--k,y-=2.){ + t=(y*h-(k+1)*z)/(k-1-tp/k); z=h; f+=(h=t); + t=(y*s-(k+1)*w)/(k-1-tq/k); w=s; r+=(s=t); } + t=sqrt(a0/x)*exp(-x); s*=t/r; h*=t/f; x/=2.; if(m==0) s=h; + for(k=1; k1.e-14 ;++p,y+=1.){ + t*=(v+y)*(v-y)/(p*x); if(y>v && fabs(t)>=tp) break; s+=t; } + s*=exp(-x/2.); + } + return s; +} diff --git a/sfunc/kspbes.c b/sfunc/kspbes.c new file mode 100644 index 0000000..845b1ad --- /dev/null +++ b/sfunc/kspbes.c @@ -0,0 +1,16 @@ +/* kspbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double kspbes(int n,double x) +{ double y,s,t,v; int p; + if(x==0.) return HUGE_VAL; + s=t=exp(-x)/x; x*=2.; v=n+.5; + for(p=1,y=.5; y +double nbes(double v,double x) +{ double y,s,t,tp,u,f,a0=3.14159265358979; + double gaml(double r),psi(double r),modf(double r,double *a); + int p,k,m; + y=x-8.5; if(y>0.) y*=y; tp=v*v/4.+13.69; + if(ym && fabs(y)<1.e-13) break; } + if(k>0){ x= -x; s-=(t=1./(u*a0)); + for(p=1,--k; k>0 ;++p,--k) s-=(t*=x/(p*k)); } + } + else{ f=1./(t*v*a0); t/=tan(a0*v); s=t-f; + for(p=1,x*=x,u=v;;++p){ + t*= -x/(p*(v+=1.)); f*=x/(p*(u-=1.)); + s+=(y=t-f); if(p>m && fabs(y)<1.e-13) break; } + } + } + else{ x*=2.; s=t=2./sqrt(x*a0); u=0.; + for(p=1,y=.5; (tp=fabs(t))>1.e-14 ;++p,y+=1.){ + t*=(v+y)*(v-y)/(p*x); if(y>v && fabs(t)>tp) break; + if(!(p&1)){ t= -t; s+=t;} else u+=t; + } + y=(x-(v+.5)*a0)/2.; s=sin(y)*s+cos(y)*u; + } + return s; +} diff --git a/sfunc/nome.c b/sfunc/nome.c new file mode 100644 index 0000000..68058ea --- /dev/null +++ b/sfunc/nome.c @@ -0,0 +1,18 @@ +/* nome.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double nome(double k,double *pk,double *pkp) +{ double a,b,s,r,pi2=1.57079632679490; + a=s=1.; b=sqrt(1.-k*k); + while(a-b>4.e-15 || s-k>4.e-15){ + r=a+b; b=sqrt(a*b); a=r/2.; + r=s+k; k=sqrt(s*k); s=r/2.; + } + *pk=pi2/a; a*=(*pkp=pi2/s); + return exp(-2.*a); +} diff --git a/sfunc/psi.c b/sfunc/psi.c new file mode 100644 index 0000000..d34698c --- /dev/null +++ b/sfunc/psi.c @@ -0,0 +1,17 @@ +/* psi.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +double psi(int m) +{ double s= -.577215664901533; int k; + for(k=1; k +static double f,h,v,x; +static int d,ty; +double rcbes(void) +{ double t; + if(d=='u'){ + switch(ty){ + case 'j': + case 'y': t=f*v/x-h; break; + case 'i': t=h-f*v/x; break; + case 'k': t=h+f*v/x; break; } + h=f; f=t; v+=1.; + } + else{ + switch(ty){ + case 'j': + case 'y': t=h*v/x-f; break; + case 'i': t=f+h*v/x; break; + case 'k': t=f-h*v/x; break; } + f=h; h=t; v-=1.; + } + return t; +} +void setrcb(double u,double y,int fl,int dr,double *pf,double *ph) +{ double jbes(double u,double x),ibes(double u,double x); + double nbes(double u,double x),kbes(double u,double x); + if(dr=='d') u-=1.; + switch(fl){ + case 'j': h=jbes(u,y); f=jbes(u+1.,y); break; + case 'y': h=nbes(u,y); f=nbes(u+1.,y); break; + case 'i': h=ibes(u,y); f=ibes(u+1.,y); break; + case 'k': h=kbes(u,y); f=kbes(u+1.,y); break; + } + x=y/2.; ty=fl; d=dr; + if(dr=='u'){ v=u+1.; *pf=h; *ph=f;} + else{ v=u; *pf=f; *ph=h;} +} diff --git a/sfunc/rcspbs.c b/sfunc/rcspbs.c new file mode 100644 index 0000000..fbbd10f --- /dev/null +++ b/sfunc/rcspbs.c @@ -0,0 +1,43 @@ +/* rcspbs.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static double f,h,v,x; +static int d,ty; +double rcspbs(void) +{ double t; + if(d=='u'){ + switch(ty){ + case 'j': + case 'y': t=f*v/x-h; break; + case 'k': t=h+f*v/x; break; + } + h=f; f=t; v+=1.; + } + else{ + switch(ty){ + case 'j': + case 'y': t=h*v/x-f; break; + case 'k': t=f-h*v/x; break; + } + f=h; h=t; v-=1.; + } + return t; +} +setrcsb(int n,double y,int fl,int dr,double *pf,double *ph) +{ double jspbes(int i,double a),yspbes(int i,double a); + double kspbes(int i,double a); + if(dr=='d') --n; + switch(fl){ + case 'j': h=jspbes(n,y); f=jspbes(n+1,y); break; + case 'y': h=yspbes(n,y); f=yspbes(n+1,y); break; + case 'k': h=kspbes(n,y); f=kspbes(n+1,y); break; + } + x=y/2.; ty=fl; d=dr; + if(dr=='u'){ v=n+1.5; *pf=h; *ph=f;} + else{ v=n+.5; *pf=f; *ph=h;} +} diff --git a/sfunc/test/README b/sfunc/test/README new file mode 100644 index 0000000..8cf49ae --- /dev/null +++ b/sfunc/test/README @@ -0,0 +1,28 @@ + This directory contains test code for the functions of the 'sfunc' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. Input data files, if any + are named in the test code header, are in the 'data' sub-directory. + + The following list specifies the command line or prompted inputs + required for the standard tests, whose outputs are appended as + comments to the test source code. + + tairy no input + tamelp modulus k (k=0.8) + tbes no input + tdrbes no input + tdrspbes no input + tfelp order k (k=0.8) + tg2elp data/g2elp.dat + tg2elps data/gel2a.dat + tgaml no input + tgelp angle a (a=60.) + tgsng data/gsng.dat + tgsng2 data/gel2c.dat + tjbes order max intv =(1.5 12. 0.5) + tnome no input + tpsi no input + trcbes no input + trcspbs no input + tspbes no input + ttheta prompted input: amp (amp=30.) diff --git a/sfunc/test/data/g2elp.dat b/sfunc/test/data/g2elp.dat new file mode 100644 index 0000000..6ac7bb7 --- /dev/null +++ b/sfunc/test/data/g2elp.dat @@ -0,0 +1,4 @@ + 0.7 + 20. 80. 0.6 + + \ No newline at end of file diff --git a/sfunc/test/data/gel2a.dat b/sfunc/test/data/gel2a.dat new file mode 100644 index 0000000..f6315c8 --- /dev/null +++ b/sfunc/test/data/gel2a.dat @@ -0,0 +1,4 @@ +0.5 +1. 1. 1. +0.392699 1.178097 +-0.392699 1.178097 diff --git a/sfunc/test/data/gel2b.dat b/sfunc/test/data/gel2b.dat new file mode 100644 index 0000000..30e003a --- /dev/null +++ b/sfunc/test/data/gel2b.dat @@ -0,0 +1,4 @@ +0.5 +1. 0.75 0.866025404 +0.392699 1.178097 +-0.392699 1.178097 diff --git a/sfunc/test/data/gel2c.dat b/sfunc/test/data/gel2c.dat new file mode 100644 index 0000000..1648662 --- /dev/null +++ b/sfunc/test/data/gel2c.dat @@ -0,0 +1,4 @@ +0.5 +1. -1.0 -1.154700538 +0.392699 1.178097 +-0.392699 1.178097 diff --git a/sfunc/test/data/gel2d.dat b/sfunc/test/data/gel2d.dat new file mode 100644 index 0000000..7606811 --- /dev/null +++ b/sfunc/test/data/gel2d.dat @@ -0,0 +1,4 @@ +0.5 +1. 2.0 .577350269 +0.392699 1.178097 +-0.392699 1.178097 diff --git a/sfunc/test/data/gsng.dat b/sfunc/test/data/gsng.dat new file mode 100644 index 0000000..62c2d0f --- /dev/null +++ b/sfunc/test/data/gsng.dat @@ -0,0 +1,3 @@ +20. .5 1. 2. 0. +25. .6 1. 2.5 -1. +30. .8 1. 3. 0. diff --git a/sfunc/test/tairy.c b/sfunc/test/tairy.c new file mode 100644 index 0000000..40b4836 --- /dev/null +++ b/sfunc/test/tairy.c @@ -0,0 +1,67 @@ +/* tairy.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: airy biry +*/ +#include "ccmath.h" +#include +void main(void) +{ double x,dx,fa,fb,fc,fd; + printf(" Test of Airy Functions\n"); + printf(" x Ai(x) Ai'(x)"); + printf(" Bi(x) Bi'(x)\n"); + x= -8.; dx=.5; + for(; x<8.01 ;x+=dx){ + +/* compute Airy functions of the first kind */ + fa=airy(x,0); fb=airy(x,1); + +/* compute Airy functions of the second kind */ + fc=biry(x,0); fd=biry(x,1); + + printf(" %5.2f %15.9f %15.9f %15.4f %15.4f\n",x,fa,fb,fc,fd); + } +} +/* Test output + + Test of Airy Functions + x Ai(x) Ai'(x) Bi(x) Bi'(x) + -8.00 -0.052705050 0.935560938 -0.3313 -0.1595 + -7.50 0.321775716 0.318809507 -0.1125 0.8778 + -7.00 0.184280835 -0.771008168 0.2938 0.4982 + -6.50 -0.238020302 -0.674952493 0.2610 -0.5972 + -6.00 -0.329145174 0.345935487 -0.1467 -0.8129 + -5.50 0.017781541 0.864197218 -0.3678 0.0251 + -5.00 0.350761009 0.327192819 -0.1384 0.7784 + -4.50 0.292152781 -0.523362532 0.2539 0.6347 + -4.00 -0.070265533 -0.790628575 0.3922 -0.1167 + -3.50 -0.375533823 -0.343443433 0.1689 -0.6931 + -3.00 -0.378814294 0.314583769 -0.1983 -0.6756 + -2.50 -0.112325068 0.678852734 -0.4324 -0.2204 + -2.00 0.227407428 0.618259021 -0.4123 0.2788 + -1.50 0.464256578 0.309186967 -0.1918 0.5579 + -1.00 0.535560883 -0.010160567 0.1040 0.5924 + -0.50 0.475728092 -0.204081670 0.3804 0.5059 + 0.00 0.355028054 -0.258819404 0.6149 0.4483 + 0.50 0.231693606 -0.224910533 0.8543 0.5446 + 1.00 0.135292416 -0.159147441 1.2074 0.9324 + 1.50 0.071749497 -0.097382013 1.8789 1.8862 + 2.00 0.034924130 -0.053090384 3.2981 4.1007 + 2.50 0.015725923 -0.026250881 6.4817 9.4214 + 3.00 0.006591139 -0.011912977 14.0373 22.9222 + 3.50 0.002584099 -0.005004414 33.0555 59.1643 + 4.00 0.000951564 -0.001958641 83.8471 161.9267 + 4.50 0.000330250 -0.000717867 227.5881 469.1351 + 5.00 0.000108344 -0.000247414 657.7920 1435.8191 + 5.50 0.000033685 -0.000080463 2016.5800 4632.5537 + 6.00 0.000009948 -0.000024765 6536.4461 15725.6026 + 6.50 0.000002796 -0.000007232 22340.6077 56062.4958 + 7.00 0.000000749 -0.000002008 80327.7907 209552.6709 + 7.50 0.000000192 -0.000000531 303229.6151 819987.8354 + 8.00 0.000000047 -0.000000134 1199586.0041 3354342.3127 +*/ diff --git a/sfunc/test/tamelp.c b/sfunc/test/tamelp.c new file mode 100644 index 0000000..3d822e2 --- /dev/null +++ b/sfunc/test/tamelp.c @@ -0,0 +1,44 @@ +/* tamelp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: amelp + + Input parameter: elliptic modulus k (real with 0 < k < 1) +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ double a,k,u,phi,rad=1.74532925199433e-2; + if(na!=2){ printf("para: modulus\n"); exit(1);} + printf(" Test of Elliptic Amplitude Function\n"); + k=atof(*++av); printf(" modulus k= %.2f\n",k); + printf(" a u amp(u) in deg.\n"); + for(a=0.; a<91. ;a+=10.){ + +/* compute elliptic amplitude function */ + u=a*rad; phi=amelp(u,k); + + printf(" %6.2f %9.6f %9.6f %6.2f\n",a,u,phi,phi/rad); + } +} +/* Test output + + Test of Elliptic Amplitude Function + modulus k= 0.80 + a u amp(u) in deg. + 0.00 0.000000 0.000000 0.00 + 10.00 0.174533 0.173970 9.97 + 20.00 0.349066 0.344654 19.75 + 30.00 0.523599 0.509204 29.18 + 40.00 0.698132 0.665534 38.13 + 50.00 0.872665 0.812471 46.55 + 60.00 1.047198 0.949739 54.42 + 70.00 1.221730 1.077830 61.76 + 80.00 1.396263 1.197828 68.63 + 90.00 1.570796 1.311233 75.13 +*/ diff --git a/sfunc/test/tbes.c b/sfunc/test/tbes.c new file mode 100644 index 0000000..7f29b03 --- /dev/null +++ b/sfunc/test/tbes.c @@ -0,0 +1,109 @@ +/* tbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: jbes, nbes, ibes, and kbes + + The order v for each can be altered within the switch + statement. + + The range and interval of evaluation are determined by + the variables xmx and dx. +*/ +#include "ccmath.h" +#include +void main(void) +{ double (*fun)(double a,double b); + double x,dx,f,v,xmx; int j; + printf(" Test of Bessel Functions\n"); + xmx=12.; dx=1.; + for(j=0; j<4 ;++j){ + switch(j){ + case 0: fun=jbes; printf(" J(v,x)\n"); + v=1.80; x=0.; break; + case 1: fun=nbes; printf(" N(v,x)\n"); + v=3.5; x=1.; break; + case 2: fun=ibes; printf(" I(v,x)\n"); + v=2.7; x=1.; break; + case 3: fun=kbes; printf(" K(v,x)\n"); + v=4.6; x=1.; break; + } + printf(" order v= %.2f\n",v); + for(; x<=xmx ; x+=dx){ + +/* compute Bessel function selected by switch */ + f=(*fun)(v,x); + printf(" %7.2f %17.10f\n",x,f); + } + printf("\n"); + } +} +/* Test output + + Test of Bessel Functions + J(v,x) + order v= 1.80 + 0.00 0.0000000000 + 1.00 0.1564953153 + 2.00 0.4096192323 + 3.00 0.4956809158 + 4.00 0.3044283399 + 5.00 -0.0411746941 + 6.00 -0.2907158917 + 7.00 -0.2746423137 + 8.00 -0.0395702153 + 9.00 0.1999476991 + 10.00 0.2461068874 + 11.00 0.0787106587 + 12.00 -0.1415053711 + + N(v,x) + order v= 3.50 + 1.00 -13.2794437122 + 2.00 -1.6749282998 + 3.00 -0.7020759742 + 4.00 -0.3489020979 + 5.00 -0.0275520680 + 6.00 0.2379492346 + 7.00 0.3224108545 + 8.00 0.1840993147 + 9.00 -0.0672543256 + 10.00 -0.2405238622 + 11.00 -0.2101775567 + 12.00 -0.0152197192 + + I(v,x) + order v= 2.70 + 1.00 0.0394595060 + 2.00 0.3118860810 + 3.00 1.2715236097 + 4.00 4.1546417707 + 5.00 12.3406324265 + 6.00 34.9860623925 + 7.00 96.7606070579 + 8.00 263.9019977303 + 9.00 713.8835083590 + 10.00 1921.6066961826 + 11.00 5156.9166970254 + 12.00 13813.9614128165 + + K(v,x) + order v= 4.60 + 1.00 151.5056564064 + 2.00 5.1315724152 + 3.00 0.5856692563 + 4.00 0.1052128995 + 5.00 0.0236907369 + 6.00 0.0060764387 + 7.00 0.0016924427 + 8.00 0.0004983860 + 9.00 0.0001526807 + 10.00 0.0000481574 + 11.00 0.0000155300 + 12.00 0.0000050955 + +*/ diff --git a/sfunc/test/tdrbes.c b/sfunc/test/tdrbes.c new file mode 100644 index 0000000..592774a --- /dev/null +++ b/sfunc/test/tdrbes.c @@ -0,0 +1,79 @@ +/* tdrbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: drbes + + Types: j -> dJ(v,x)/dx + y -> dN(v,x)/dx + i -> dI(v,x)/dx + k -> dK(v,x)/dx + Orders may be altered by changing values of v + within the switch statement. +*/ +#include "ccmath.h" +#include +void main(void) +{ double v,x,dx,f; int m; char t[2]; + printf(" Bessel Function Derivatives Test\n"); + for(m=0; m<4 ;++m){ + switch(m){ + case 0: printf(" dJ(v,x)/dx\n"); + t[0]='j'; v=0.; break; + case 1: printf(" dN(v,x)/dx\n"); + t[0]='y'; v=2.3; break; + case 2: printf(" dI(v,x)/dx\n"); + t[0]='i'; v=4.5; break; + case 3: printf(" dK(v,x)/dx\n"); + t[0]='k'; v=3.25; break; + } + printf(" order v= %.2f\n",v); + for(x=dx=1.; x<5.1 ;x+=dx){ + +/* compute Bessel function derivatives */ + f=drbes(x,v,t[0],NULL); + printf(" %6.2f %12.8f\n",x,f); + } + printf("\n"); + } +} +/* Test output + + Bessel Function Derivatives Test + dJ(v,x)/dx + order v= 0.00 + 1.00 -0.44005059 + 2.00 -0.57672481 + 3.00 -0.33905896 + 4.00 0.06604333 + 5.00 0.32757914 + + dN(v,x)/dx + order v= 2.30 + 1.00 4.23306040 + 2.00 0.56127971 + 3.00 0.41100314 + 4.00 0.34183666 + 5.00 0.11196541 + + dI(v,x)/dx + order v= 4.50 + 1.00 0.00405527 + 2.00 0.05547528 + 3.00 0.30962054 + 4.00 1.25491869 + 5.00 4.37349196 + + dK(v,x)/dx + order v= 3.25 + 1.00 -37.66688974 + 2.00 -1.70426458 + 3.00 -0.23443446 + 4.00 -0.04821152 + 5.00 -0.01202528 + +*/ diff --git a/sfunc/test/tdrspbes.c b/sfunc/test/tdrspbes.c new file mode 100644 index 0000000..6ae875f --- /dev/null +++ b/sfunc/test/tdrspbes.c @@ -0,0 +1,81 @@ +/* tdrspbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: drspbes + + j -> dj(v,x)/dx + k -> dk(v,x)/dx + y -> dy(v,x)/dx + + The order n for each derivative can be altered by + resetting n within the switch statement. +*/ +#include "ccmath.h" +#include +void main(void) +{ double x,dx,xmx,f; char t[2]; int n,m; + printf(" Sperical Bessel Function Derivative Test\n"); + xmx=11.; dx=2.; + for(m=0; m<4 ;++m){ + switch(m){ + case 0: printf(" dj(n,x)/dx\n"); + t[0]='j'; n=0; x=0.; break; + case 1: printf(" dy(n,x)/dx\n"); + t[0]='y'; n=3; x=2.; break; + case 2: printf(" dk(n,x)/dx\n"); + t[0]='k'; n=2; x=2.; break; + case 3: printf(" dk(n,x)/dx\n"); + t[0]='k'; n= -4; x=2.; break; + } + printf(" order = %d\n",n); + for(; x +void main(int na,char **av) +{ double a,k,f,kk,z,h,rad=1.74532925199433e-2; + if(na!=2){ printf("para: order\n"); exit(1);} + printf(" Test of Elliptic Integrals of 1st & 2nd Kind\n"); + k=atof(*++av); printf(" order k= %.2f\n",k); + printf(" a F(k,a) E(k,a)\n"); + for(a=0.; a<91. ;a+=10.){ + +/* compute elliptic integrals */ + f=felp(a*rad,k,&kk,&z,&h); + + printf(" %6.2f %9.6f %9.6f\n",a,f,z); + } + printf(" Complete Integrals\n"); + printf(" K= %f E= %f\n",kk,h); +} +/* Test output + + Test of Elliptic Integrals of 1st & 2nd Kind + order k= 0.80 + a F(k,a) E(k,a) + 0.00 0.000000 0.000000 + 10.00 0.175102 0.173968 + 20.00 0.353651 0.344587 + 30.00 0.539268 0.508729 + 40.00 0.735879 0.663720 + 50.00 0.947709 0.807603 + 60.00 1.178902 0.939455 + 70.00 1.432303 1.059747 + 80.00 1.706963 1.170698 + 90.00 1.995303 1.276350 + Complete Integrals + K= 1.995303 E= 1.276350 +*/ diff --git a/sfunc/test/tg2elp.c b/sfunc/test/tg2elp.c new file mode 100644 index 0000000..c23e9c1 --- /dev/null +++ b/sfunc/test/tg2elp.c @@ -0,0 +1,52 @@ +/* tg2elp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: g2elp + + Uses: gelp + + Input: Data File g2elp.dat + +*/ +#include "ccmath.h" +#include +void main(int na,char **av) +{ double a,b,k,af,bf,df,g,h,q; + FILE *fp; + double rad=1.74532925199433e-2; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Elliptic Integral with General Limits\n"); + fscanf(fp,"%lf",&k); + fscanf(fp,"%lf %lf %lf",&a,&b,&q); + printf(" k=%.2f l-lim= %.2f u-lim= %.2f q= %.2f\n",k,a,b,q); + af=1.; df=1.-q; bf=1./df; df/=sqrt(1.-k*k); + printf(" Bartky parameters: %f %f %f\n",af,bf,df); + a*=rad; b*=rad; + printf(" integrals:\n"); + +/* compute general elliptic integral with general limits */ + g=g2elp(a,b,k,af,bf,df); + printf(" a to b = %12.7f\n",g); + +/* check using elliptic integrals with zero lower limit */ + g=gelp(fabs(a),k,af,bf,df,&h,NULL,NULL); + printf(" 0 to |a| = %12.7f",g); + g=gelp(b,k,af,bf,df,&h,NULL,NULL); printf(" 0 to b = %12.7f\n",g); + printf(" 0 to pi/2 = %12.7f\n",h); +} +/* Test output + + Test of Elliptic Integral with General Limits + k=0.70 l-lim= 20.00 u-lim= 80.00 q= 0.60 + Bartky parameters: 1.000000 2.500000 0.560112 + integrals: + a to b = 2.0709474 + 0 to |a| = 0.3613756 0 to b = 2.4323230 + 0 to pi/2 = 3.0314573 +*/ diff --git a/sfunc/test/tg2elps.c b/sfunc/test/tg2elps.c new file mode 100644 index 0000000..f22cf40 --- /dev/null +++ b/sfunc/test/tg2elps.c @@ -0,0 +1,49 @@ +/* tg2elps.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: g2elp + + Uses: gelp (implicit) gsng gsng2 + + Input file: gel2?.dat +*/ +#include "ccmath.h" +#include +void main(int na,char **av) +{ double ap,bp,cp,k; FILE *fp; + double s1,s2,ga,gb,g2,cf; + if(na!=2){ printf("para: input_file\n"); exit(1);} + fp=fopen(*++av,"r"); + fscanf(fp,"%lf %lf %lf %lf",&k,&ap,&bp,&cp); + printf(" Parameters: k=%f\n",k); + printf(" Bartky a=%f b=%f c=%f\n\n",ap,bp,cp); + while(fscanf(fp,"%lf %lf",&s1,&s2)!=EOF){ + printf(" angles: s1=%f s2=%f\n",s1,s2); + +/* general elliptic integral with general limits */ + g2=g2elp(s1,s2,k,ap,bp,cp); + printf(" g2= %12.8f\n",g2); + +/* check using general elliptic integrals with zero lower limit */ + ga=gelp(s1,k,ap,bp,cp,&cf,NULL,NULL); + gb=gelp(s2,k,ap,bp,cp,&cf,NULL,NULL); + printf(" i1= %12.8f i2= %12.8f i2-i1= %12.8f\n",ga,gb,gb-ga); + } +} +/* Test output + + Parameters: k=0.500000 + Bartky a=1.000000 b=1.000000 c=1.000000 + + angles: s1=0.392699 s2=1.178097 + g2= 0.84079870 + i1= 0.39518719 i2= 1.23598590 i2-i1= 0.84079870 + angles: s1=-0.392699 s2=1.178097 + g2= 1.63117309 + i1= -0.39518719 i2= 1.23598590 i2-i1= 1.63117309 +*/ diff --git a/sfunc/test/tgaml.c b/sfunc/test/tgaml.c new file mode 100644 index 0000000..e425e95 --- /dev/null +++ b/sfunc/test/tgaml.c @@ -0,0 +1,49 @@ +/* tgaml.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: gaml +*/ +#include "ccmath.h" +#include +void main(void) +{ double x,y,z; + printf(" Test of Gamma Function Evaluation\n"); + printf(" x log(gamma(x)) gamma(x)\n"); + for(x=.5; x<10.1 ; x+=.5){ + +/* compute the logarithm of the gamma function and the gamma function */ + y=gaml(x); z=exp(y); + + printf(" %6.3f %16.12f %19.8f\n",x,y,z); + } +} +/* Test output + + Test of Gamma Function Evaluation + x log(gamma(x)) gamma(x) + 0.500 0.572364942925 1.77245385 + 1.000 0.000000000000 1.00000000 + 1.500 -0.120782237635 0.88622693 + 2.000 0.000000000000 1.00000000 + 2.500 0.284682870473 1.32934039 + 3.000 0.693147180560 2.00000000 + 3.500 1.200973602347 3.32335097 + 4.000 1.791759469228 6.00000000 + 4.500 2.453736570842 11.63172840 + 5.000 3.178053830348 24.00000000 + 5.500 3.957813967619 52.34277778 + 6.000 4.787491742782 120.00000000 + 6.500 5.662562059857 287.88527782 + 7.000 6.579251212010 720.00000000 + 7.500 7.534364236759 1871.25430580 + 8.000 8.525161361065 5040.00000000 + 8.500 9.549267257301 14034.40729348 + 9.000 10.604602902745 40320.00000000 + 9.500 11.689333420797 119292.46199461 + 10.000 12.801827480081 362880.00000000 +*/ diff --git a/sfunc/test/tgelp.c b/sfunc/test/tgelp.c new file mode 100644 index 0000000..e773338 --- /dev/null +++ b/sfunc/test/tgelp.c @@ -0,0 +1,50 @@ +/* tgelp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: gelp + + Input parameter: c order angle (in degrees) + with 0 < c < 90 and k=sin(c) +*/ +#include "ccmath.h" +#include +void main(int na,char **av) +{ double a,k,c,af,bf,df,g,gg,hh,zz,x; + double rad=1.74532925199433e-2; + if(na!=2){ printf("para: alpha(deg)\n"); exit(1);} + printf(" Test of General Elliptic Integral\n"); + k=atof(*++av); printf(" alpha= %.2f deg.\n",k); + c=k*rad; k=sin(c); c=cos(c); + printf(" x/ang"); + for(a=15.; a <91. ;a+=15.) printf(" %6.2f ",a); + printf("\n"); + for(x=.2; x<.9 ;x+=.2){ + af=1.; df=1.-x; bf=1./df; df/=c; + printf(" x=%4.2f",x); + for(a=15.; a <89. ;a+=15.){ + +/* compute general elliptic integral */ + g=gelp(rad*a,k,af,bf,df,&gg,&hh,&zz); + + printf(" %f",g); + } + printf(" %f\n",gg); + } + printf(" H= %f Z= %f at x=0.80\n",hh,zz); +} +/* Test output + + Test of General Elliptic Integral + alpha= 60.00 deg. + x/ang 15.00 30.00 45.00 60.00 75.00 90.00 + x=0.20 0.265272 0.552174 0.886292 1.300034 1.826431 2.457151 + x=0.40 0.266500 0.562785 0.926702 1.410981 2.074127 2.907615 + x=0.60 0.267748 0.574145 0.974057 1.558839 2.456235 3.685091 + x=0.80 0.269018 0.586352 1.030756 1.771454 3.168447 5.512061 + H= 1.649179 Z= 2.156516 at x=0.80 +*/ diff --git a/sfunc/test/tgsng.c b/sfunc/test/tgsng.c new file mode 100644 index 0000000..0847ef4 --- /dev/null +++ b/sfunc/test/tgsng.c @@ -0,0 +1,56 @@ +/* tgsng.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: gsng + + Input file: gsng.dat +*/ +#include "ccmath.h" +#include +void main(int na,char **av) +{ FILE *fp; + double h,k,b,an,as,bs,ds; + double rad=1.74532925199433e-2; + if(na!=2){ printf("para: input_file\n"); exit(1);} + fp=fopen(*++av,"r"); + printf(" Elliptic Integrals:\n"); + printf(" Test of Transform from Singular Case\n"); + while(fscanf(fp,"%lf %lf",&an,&k)!=EOF){ + printf(" input: ang= %.2f k= %.3f\n",an,k); + an*=rad; b=sqrt(1.-k*k); + fscanf(fp,"%lf %lf %lf",&as,&bs,&ds); + if(ds==0.){ bs=1.-bs*bs; ds=bs/b; bs=1./bs;} + printf( " a= %f b= %f c= %f\n",as,bs,ds); + +/* transform a singular elliptic integral to nonsingular form */ + h=gsng(&as,&bs,&ds,b,an); + + printf(" output: a= %f b= %f c= %f\n",as,bs,ds); + printf(" integral = %12.8f\n\n",h); + } +} +/* Test output + + Elliptic Integrals: + Test of Transform from Singular Case + input: ang= 20.00 k= 0.500 + a= 1.000000 b= -0.333333 c= -3.464102 + output: a= 0.000000 b= -0.066667 c= 1.082532 + integral = 0.43184736 + + input: ang= 25.00 k= 0.600 + a= 1.000000 b= 2.500000 c= -1.000000 + output: a= 1.666667 b= 1.833333 c= 1.000000 + integral = -0.33890034 + + input: ang= 30.00 k= 0.800 + a= 1.000000 b= -0.125000 c= -13.333333 + output: a= -0.000000 b= -0.076555 c= 1.548148 + integral = 0.24430963 + +*/ diff --git a/sfunc/test/tgsng2.c b/sfunc/test/tgsng2.c new file mode 100644 index 0000000..abe14ab --- /dev/null +++ b/sfunc/test/tgsng2.c @@ -0,0 +1,94 @@ +/* tgsng2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: gelp g2elp gsng gsng2 + + Input file: gel2c.dat +*/ +#include "ccmath.h" +#include +void main(int na,char **av) +{ double ap,bp,cp,k; FILE *fp; + double ax,bx,cx,b,ia,ib,i2; + double s1,s2,ss,h,dd,ga,gb,g2; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + fscanf(fp,"%lf %lf %lf %lf",&k,&ap,&bp,&cp); + b=sqrt(1.-k*k); + printf(" Parameters: k=%f\n",k); + printf(" Bartky a=%f b=%f c=%f\n\n",ap,bp,cp); + while(fscanf(fp,"%lf %lf",&s1,&s2)!=EOF){ + printf(" angles: aa=%f ab=%f\n",s1,s2); +/* evaluate first elliptic integral */ + ss=fabs(s1); ax=ap; bx=bp; cx=cp; + ga=gelp(ss,k,ax,bx,cx,NULL,NULL,NULL); + printf(" ga0= %12.8f\n",ga); h=ga; +/* check first integral */ + ia=gsng(&ax,&bx,&cx,b,ss); + printf(" T-Bartky: %f %f %f ia= %12.8f\n",ax,bx,cx,ia); + ga=gelp(ss,k,ax,bx,cx,NULL,NULL,NULL); + printf(" sa= %12.8f ia+sa= %12.8f\n",ga,ia+ga); +/* evaluate second elliptic integral */ + ax=ap; bx=bp; cx=cp; + gb=gelp(s2,k,ax,bx,cx,NULL,NULL,NULL); + printf(" gb0= %12.8f\n",gb); + +/* set dd equal to general limit integral integral */ + if(s1>0.) dd=gb-h; else dd=gb+h; + +/* check second integral */ + ib=gsng(&ax,&bx,&cx,b,s2); + printf(" T-Bartky: %f %f %f ib= %12.8f\n",ax,bx,cx,ib); + gb=gelp(s2,k,ax,bx,cx,NULL,NULL,NULL); + printf(" sb= %12.8f ib+sb= %12.8f\n",gb,ib+gb); + +/* evaluate elliptic integral using general limits */ + ax=ap; bx=bp; cx=cp; + g2=g2elp(s1,s2,k,ax,bx,cx); h=g2; + printf(" g20= %12.8f\n",g2); + +/* transform singular elliptic integral with general limits */ + i2=gsng2(&ax,&bx,&cx,b,s1,s2); +/* check general limit integral */ + printf(" T-Bartky: %f %f %f i2= %12.8f\n",ax,bx,cx,i2); + g2=g2elp(s1,s2,k,ax,bx,cx); + printf(" g2= %12.8f g2+i2= %12.8f\n",g2,i2+g2); + +/* compare direct general limit integral with result obtained by + combining single limit integrals */ + printf(" comparison: g2: %12.8f diff: %12.8f\n",h,dd); + } +} +/* Test output + + Parameters: k=0.500000 + Bartky a=1.000000 b=-1.000000 c=-1.154701 + + angles: aa=0.392699 ab=1.178097 + ga0= 0.44373891 + T-Bartky: 0.000000 -0.142857 1.010363 ia= 0.44624102 + sa= -0.00250212 ia+sa= 0.44373891 + gb0= 0.38362644 + T-Bartky: 0.000000 -0.142857 1.010363 ib= 0.44368679 + sb= -0.06006035 ib+sb= 0.38362644 + g20= -0.06011246 + T-Bartky: 0.000000 -0.142857 1.010363 i2= -0.00255423 + g2= -0.05755823 g2+i2= -0.06011246 + comparison: g2: -0.06011246 diff: -0.06011246 + angles: aa=-0.392699 ab=1.178097 + ga0= 0.44373891 + T-Bartky: 0.000000 -0.142857 1.010363 ia= 0.44624102 + sa= -0.00250212 ia+sa= 0.44373891 + gb0= 0.38362644 + T-Bartky: 0.000000 -0.142857 1.010363 ib= 0.44368679 + sb= -0.06006035 ib+sb= 0.38362644 + g20= 0.82736535 + T-Bartky: 0.000000 -0.142857 1.010363 i2= 0.88992781 + g2= -0.06256246 g2+i2= 0.82736535 + comparison: g2: 0.82736535 diff: 0.82736535 +*/ diff --git a/sfunc/test/tjbes.c b/sfunc/test/tjbes.c new file mode 100644 index 0000000..ab6e501 --- /dev/null +++ b/sfunc/test/tjbes.c @@ -0,0 +1,69 @@ +/* tjbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: jbes + + Prompted input: at prompt 'order ' + enter v + { real order v >=0) + + at prompt 'max-x interval ' + enter xmx dx + { real maximum x-value + and interval -> table + from x=0 to xmx at + intervals dx } +*/ +#include "ccmath.h" +#include +void main(void) +{ double x,dx,f,v,xmx; + printf(" Test of Bessel Functions\n"); + printf(" J(v,x)\n"); + fprintf(stderr,"order "); scanf("%lf",&v); + printf(" order= %.2f\n",v); + fprintf(stderr,"max-x interval "); + scanf("%lf %lf",&xmx,&dx); xmx+=dx/4.; + for(x=0.; x +void main(void) +{ double q,k,a,u,up; + double rad=1.74532925199433e-02; + printf(" Test of Nome Function\n"); + printf(" angle mod k nome q K K1\n"); + for(a=5.; a<89. ;a+=5.){ + k=sin(rad*a); + +/* elliptic nome function */ + q=nome(k,&u,&up); + + printf(" %5.2f %8.6f %10.8f %11.8f %11.8f\n",a,k,q,u,up); + } +} +/* Test output + + Test of Nome Function + angle mod k nome q K K1 + 5.00 0.087156 0.00047657 1.57379213 3.83174200 + 10.00 0.173648 0.00191359 1.58284280 3.15338525 + 15.00 0.258819 0.00433342 1.59814200 2.76806315 + 20.00 0.342020 0.00777468 1.62002590 2.50455008 + 25.00 0.422618 0.01229456 1.64899522 2.30878680 + 30.00 0.500000 0.01797239 1.68575035 2.15651565 + 35.00 0.573576 0.02491506 1.73124518 2.03471531 + 40.00 0.642788 0.03326526 1.78676913 1.93558110 + 45.00 0.707107 0.04321392 1.85407468 1.85407468 + 50.00 0.766044 0.05501993 1.93558110 1.78676913 + 55.00 0.819152 0.06904230 2.03471531 1.73124518 + 60.00 0.866025 0.08579573 2.15651565 1.68575035 + 65.00 0.906308 0.10605402 2.30878680 1.64899522 + 70.00 0.939693 0.13106182 2.50455008 1.62002590 + 75.00 0.965926 0.16303353 2.76806315 1.59814200 + 80.00 0.984808 0.20660976 3.15338525 1.58284280 + 85.00 0.996195 0.27517980 3.83174200 1.57379213 +*/ + diff --git a/sfunc/test/tpsi.c b/sfunc/test/tpsi.c new file mode 100644 index 0000000..ffd4b5c --- /dev/null +++ b/sfunc/test/tpsi.c @@ -0,0 +1,43 @@ +/* tpsi.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: psi psih +*/ +#include "ccmath.h" +void main(void) +{ double h,p,ph; int i; + printf(" Test of the psi Functions\n"); + for(i=1; i<=16 ;++i){ + h=(double)i+0.5; + +/* evaluate psi functions for integer and half-integer argument */ + p=psi(i); ph=psih(h); + + printf(" psi(%2d)= %12.8f psi(%4.1f)= %12.8f\n",i,p,h,ph); + } +} +/* Test output + + Test of the psi Functions + psi( 1)= -0.57721566 psi( 1.5)= 0.03648997 + psi( 2)= 0.42278434 psi( 2.5)= 0.70315664 + psi( 3)= 0.92278434 psi( 3.5)= 1.10315664 + psi( 4)= 1.25611767 psi( 4.5)= 1.38887093 + psi( 5)= 1.50611767 psi( 5.5)= 1.61109315 + psi( 6)= 1.70611767 psi( 6.5)= 1.79291133 + psi( 7)= 1.87278434 psi( 7.5)= 1.94675748 + psi( 8)= 2.01564148 psi( 8.5)= 2.08009082 + psi( 9)= 2.14064148 psi( 9.5)= 2.19773788 + psi(10)= 2.25175259 psi(10.5)= 2.30300103 + psi(11)= 2.35175259 psi(11.5)= 2.39823913 + psi(12)= 2.44266168 psi(12.5)= 2.48519565 + psi(13)= 2.52599501 psi(13.5)= 2.56519565 + psi(14)= 2.60291809 psi(14.5)= 2.63926973 + psi(15)= 2.67434666 psi(15.5)= 2.70823524 + psi(16)= 2.74101333 psi(16.5)= 2.77275137 +*/ diff --git a/sfunc/test/trcbes.c b/sfunc/test/trcbes.c new file mode 100644 index 0000000..f5349a3 --- /dev/null +++ b/sfunc/test/trcbes.c @@ -0,0 +1,95 @@ +/* trcbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: rcbes setrcb + + Uses: (implicit) jbes nbes ibes kbes + +*/ +#include "ccmath.h" +#include +void main(void) +{ double v,x,f[10]; int i,j; + char ty[2],dr[2]; + for(j=0; j<4 ;++j){ + switch(j){ + case 0: printf(" J(v,x)\n"); + ty[0]='j'; dr[0]='d'; x=2.; v=10.4; break; + case 1: printf(" I(v,x)\n"); + ty[0]='i'; dr[0]='d'; x=2.5; v=12.2; break; + case 2: printf(" Y(v,x)\n"); + ty[0]='y'; dr[0]='u'; x=5.1; v=1.4; break; + case 3: printf(" K(v,x)\n"); + ty[0]='k'; dr[0]='u'; x=3.5; v=2.3; break; + } + printf(" argument x= %.4f\n",x); + +/* initialize recursion */ + setrcb(v,x,ty[0],dr[0],f,f+1); + + for(i=0; i<9 ;++i){ + +/* recursive computation of Bessel functions */ + if(i>=2) f[i]=rcbes(); + printf(" %6.2f %20.12f\n",v,f[i]); + if(dr[0]=='u') v+=1.; else v-=1.; + } + printf("\n"); + } +} +/* Test output + + J(v,x) + argument x= 2.0000 + 10.40 0.000000097768 + 9.40 0.000001008154 + 8.40 0.000009378876 + 7.40 0.000077774404 + 6.40 0.000566151710 + 5.40 0.003545596542 + 4.40 0.018580069614 + 3.40 0.078206709761 + 2.40 0.247322743574 + + I(v,x) + argument x= 2.5000 + 12.20 0.000000021531 + 11.20 0.000000212165 + 10.20 0.000001922531 + 9.20 0.000015900019 + 8.20 0.000118946674 + 7.20 0.000796190200 + 6.20 0.004705002227 + 5.20 0.024133001245 + 4.20 0.105098287408 + + Y(v,x) + argument x= 5.1000 + 1.40 0.272244667311 + 2.40 0.329761926063 + 3.40 0.038119498395 + 4.40 -0.278935928203 + 5.40 -0.519420707843 + 6.40 -0.821013806054 + 7.40 -1.541162962252 + 8.40 -3.651380672638 + 9.40 -10.486914547616 + + K(v,x) + argument x= 3.5000 + 2.30 0.037839743370 + 3.30 0.073984294366 + 4.30 0.177352984175 + 5.30 0.509765912625 + 6.30 1.721215462410 + 7.30 6.706141577300 + 8.30 29.695406042003 + 9.30 147.547210233658 + 10.30 813.803437569441 + +*/ diff --git a/sfunc/test/trcspbs.c b/sfunc/test/trcspbs.c new file mode 100644 index 0000000..081ded5 --- /dev/null +++ b/sfunc/test/trcspbs.c @@ -0,0 +1,79 @@ +/* trcspbs.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: rcspbes setrcsb + + Uses: (implicit) jspbes yspbes kspbes + +*/ +#include "ccmath.h" +#include +void main(void) +{ double x,f[10]; int i,n,j; + char ty[2],dr[2]; + for(j=0; j<3 ;++j){ + switch(j){ + case 0: printf(" j(n,x)\n"); + ty[0]='j'; dr[0]='d'; x=2.; n=9; break; + case 1: printf(" y(n,x)\n"); + ty[0]='y'; dr[0]='u'; x=1.5; n=1; break; + case 2: printf(" k(n,x)\n"); + ty[0]='k'; dr[0]='u'; x=1.5; n=1; break; + } + printf(" argument x= %.4f\n",x); + +/* initialize spherical Bessel function recursion */ + setrcsb(n,x,ty[0],dr[0],f,f+1); + + for(i=0; i<8 ;++i){ + +/* recursive computation of spherical Bessel functions */ + if(i>=2) f[i]=rcspbs(); + + printf(" %3d %16.8f\n",n,f[i]); + if(dr[0]=='u') ++n; else --n; + } + printf("\n"); + } +} +/* Test output + + j(n,x) + argument x= 2.0000 + 9 0.00000071 + 8 0.00000668 + 7 0.00005610 + 6 0.00041404 + 5 0.00263517 + 4 0.01407939 + 3 0.06072210 + 2 0.19844795 + + y(n,x) + argument x= 1.5000 + 1 -0.69643541 + 2 -1.34571269 + 3 -3.78927356 + 4 -16.33756394 + 5 -94.23611009 + 6 -674.72724335 + 7 -5753.39999895 + 8 -56859.27274614 + + k(n,x) + argument x= 1.5000 + 1 0.24792240 + 2 0.64459824 + 3 2.39658320 + 4 11.82865318 + 5 73.36850229 + 6 549.86433663 + 7 4838.85941977 + 8 48938.45853433 + +*/ diff --git a/sfunc/test/tspbes.c b/sfunc/test/tspbes.c new file mode 100644 index 0000000..4a2f410 --- /dev/null +++ b/sfunc/test/tspbes.c @@ -0,0 +1,133 @@ +/* tspbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: Spherical Bessel Functions + jspbes yspbes kspbes + +*/ +#include "ccmath.h" +#include +void main(void) +{ double (*funs)(int,double); + double x,dx,xmx,f,s; char t[2]; int n,i; + printf(" Test of Spherical Bessel Functions\n"); + xmx=10.; dx=0.5; + for(i=0; i<4 ;++i){ + switch(i){ + case 0: t[0]='j'; x=0.; n=0; + funs=jspbes; printf(" j(n,x)\n"); break; + case 1: t[0]='y'; x=0.5; n=1; + funs=yspbes; printf(" y(n,x)\n"); break; + case 2: t[0]='k'; x=0.5; n=1; + funs=kspbes; printf(" k(n,x)\n"); break; + case 3: t[0]='e'; x=0.5; n=1; + funs=kspbes; printf(" k(n,-x)\n"); break; + } + if(t[0]=='e') s= -1; else s=1; + for(; x am > 0 } +*/ +#include "ccmath.h" +#include +void main(void) +{ double sn,cn,dn,dd,k,kp,kf,u,am,du; int j; + double rad=1.74532925199433e-2; + printf(" Test of Theta Functions\n"); + fprintf(stderr,"amplitude(deg.) "); scanf("%lf",&am); + k=sin(am*rad); kp=cos(am*rad); + u=felp(0.,k,&kf,0L,0L); du=kf/5.; + printf(" alpha= %.2f K= %f\n",am,kf); + +/* initialize theta function with modulus k */ + stheta(k); + + for(u=du,j=0; j<5 ;u+=du,++j){ + +/* use theta functions to compute Jacobian elliptic functions */ + am=amelp(u,k); dd=theta(u,0); + sn=theta(u,1)/(dd*sqrt(k)); + cn=sqrt(kp/k)*theta(u,2)/dd; + dn=sqrt(kp)*theta(u,3)/dd; + + printf(" u:%f sn:%f cn:%f dn:%f\n",u,sn,cn,dn); + kf=k*sin(am); kf=sqrt(1.-kf*kf); + printf(" check: %f %f %f\n",sin(am),cos(am),kf); + } +} +/* Test output + +Test of Theta Functions + alpha= 30.00 K= 1.685750 + u:0.337150 sn:0.329327 cn:0.944216 dn:0.986350 + check: 0.329327 0.944216 0.986350 + u:0.674300 sn:0.615232 cn:0.788346 dn:0.951511 + check: 0.615232 0.788346 0.951511 + u:1.011450 sn:0.828520 cn:0.559959 dn:0.910158 + check: 0.828520 0.559959 0.910158 + u:1.348600 sn:0.957283 cn:0.289153 dn:0.878010 + check: 0.957283 0.289153 0.878010 + u:1.685750 sn:1.000000 cn:0.000000 dn:0.866025 + check: 1.000000 0.000000 0.866025 +*/ diff --git a/sfunc/theta.c b/sfunc/theta.c new file mode 100644 index 0000000..72154e9 --- /dev/null +++ b/sfunc/theta.c @@ -0,0 +1,33 @@ +/* theta.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static double q,qq,kf; +double theta(double u,int n) +{ double c,s,c0,s0,f,r,z; + u*=kf; c0=cos(2.*u); s0=sin(2.*u); + switch(n){ + case 0: + case 3: f=1.; r=2.*q; z=q; + c=c0; s=s0; break; + case 1: + case 2: f=0.; r=2.*pow(q,.25); z=1.; + c=cos(u); s=sin(u); + } + if(n==0){ r= -r; z= -z;} if(n==1) z= -z; + while(fabs(r)>1.e-16){ + if(n==1) f+=r*s; else f+=r*c; + u=c*c0-s*s0; s=s*c0+c*s0; c=u; + z*=qq; r*=z; + } + return f; +} +void stheta(double k) +{ double nome(double k,double *pk,double *pkp); + double pi2=1.57079632679490; + q=nome(k,&kf,&qq); qq=q*q; kf=pi2/kf; +} diff --git a/sfunc/yspbes.c b/sfunc/yspbes.c new file mode 100644 index 0000000..eed2594 --- /dev/null +++ b/sfunc/yspbes.c @@ -0,0 +1,19 @@ +/* yspbes.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double yspbes(int n,double x) +{ double v,y,s,t,u,a0=1.57079632679490; int p; + v=n+.5; if(x==0.) return HUGE_VAL; + s=t=1./x; x*=2.; u=0.; + for(p=1,y=.5; y +double *autcor(double *x,int n,int lag) +{ double *p,*q,*pmax,*cf; int j; + cf=(double *)calloc(lag+1,sizeof(double)); + for(p=x,pmax=x+n; p=x ;) *(cf+j++)+= *p* *q--; + for(j=1; j<=lag ;) *(cf+j++)/= *cf; + return cf; +} diff --git a/simu/bran.c b/simu/bran.c new file mode 100644 index 0000000..d49e9cf --- /dev/null +++ b/simu/bran.c @@ -0,0 +1,24 @@ +/* bran.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +static unsigned int s,h,sbuf[256]; +static unsigned int a=1664525U,c=4098479U; +static unsigned int r=0xffff; +int bran(int n) +{ register int i,j; + i=(int)(s>>24); s=sbuf[i]; + h=h*a+c; sbuf[i]=h; + i=n*(s>>16); j=n*(s&r); i+=(j>>16); + return (i>>16); +} +void setbran(unsigned int sa) +{ int c; + for(h=sa,c=0; c<=256 ;++c){ + h=h*a+c; + if(c<256) sbuf[c]=h; else s=h; + } +} diff --git a/simu/bran2.c b/simu/bran2.c new file mode 100644 index 0000000..b107f23 --- /dev/null +++ b/simu/bran2.c @@ -0,0 +1,26 @@ +/* bran2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +static unsigned int s,h,sbuf[256]; +static unsigned int a=69069U,c=4098479U; +static unsigned int r=0xffff; +unsigned int lrana(unsigned int); +int bran2(int n) +{ register int i,j,k; + unsigned int u; + s=lrana(s); h=h*a+c; k=(h>>24); + u=sbuf[k]; sbuf[k]=s; + i=n*(u>>16); j=n*(u&r); i+=(j>>16); + return (i>>15); +} +void setbran2(unsigned int sa) +{ int k; + for(s=sa,k=0; k<=256 ;++k){ + s=lrana(s); + if(k<256) sbuf[k]=s; else h=s; + } +} diff --git a/simu/hist.c b/simu/hist.c new file mode 100644 index 0000000..b518d87 --- /dev/null +++ b/simu/hist.c @@ -0,0 +1,20 @@ +/* hist.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int *hist(double *x,int n,double xmin,double xmax,int kbin,double *bin) +{ int k,*p; double *pm,u; + p=(int *)calloc(kbin+2,sizeof(int)); ++p; + *bin=(xmax-xmin)/kbin; + for(pm=x+n; x xmax) k=kbin; + else if ((u=(*x-xmin))<0.) k= -1; + else k=u / *bin; + *(p+k)+=1; + } + return p; +} diff --git a/simu/lran1.c b/simu/lran1.c new file mode 100644 index 0000000..cda34c7 --- /dev/null +++ b/simu/lran1.c @@ -0,0 +1,22 @@ +/* lran1.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +static unsigned int s,h,sbuf[256]; +static unsigned int a=1664525U,c=244045795; +unsigned int lran1() +{ register int i; + i=(int)(s>>24); s=sbuf[i]; + h=h*a+c; sbuf[i]=h; + return s; +} +void setlran1(unsigned int sa) +{ int k; + for(h=sa,k=0; k<=256 ;++k){ + h=h*a+c; + if(k<256) sbuf[k]=h; else s=h; + } +} diff --git a/simu/lrana.s b/simu/lrana.s new file mode 100644 index 0000000..6bc0015 --- /dev/null +++ b/simu/lrana.s @@ -0,0 +1,23 @@ +.data + .align 4 + .type m,@object + .size m,4 +m: + .long 16807 +.text + .align 16 +.globl lrana + .type lrana,@function +lrana: + movl 4(%esp),%eax + movl m,%ecx + mull %ecx + shldl $1,%eax,%edx + btrl $31,%eax + addl %edx,%eax + btl $31,%eax + jnc .A + addl $1,%eax + btrl $31,%eax +.A: + ret diff --git a/simu/lranb.s b/simu/lranb.s new file mode 100644 index 0000000..b513051 --- /dev/null +++ b/simu/lranb.s @@ -0,0 +1,23 @@ +.data + .align 4 + .type m,@object + .size m,4 +m: + .long 48271 +.text + .align 16 +.globl lranb + .type lranb,@function +lranb: + movl 4(%esp),%eax + movl m,%ecx + mull %ecx + shldl $1,%eax,%edx + btrl $31,%eax + addl %edx,%eax + btl $31,%eax + jnc .A + addl $1,%eax + btrl $31,%eax +.A: + ret diff --git a/simu/lrand.c b/simu/lrand.c new file mode 100644 index 0000000..e2bd4c9 --- /dev/null +++ b/simu/lrand.c @@ -0,0 +1,15 @@ +/* lrand.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +static unsigned int s; +unsigned int lrana(unsigned int); +unsigned int lrand() +{ return (s=lrana(s)); +} +void setlrand(unsigned int u) +{ s=u; +} diff --git a/simu/norm.c b/simu/norm.c new file mode 100644 index 0000000..2f50b12 --- /dev/null +++ b/simu/norm.c @@ -0,0 +1,30 @@ +/* norm.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static unsigned int s,h,sbuf[256]; +static unsigned int a=69069,c=244045795; +static double g=4.6566128730773925e-10; +void norm(double *err) +{ double x,y,r; + register int i; + do{ i=(s>>24); s=sbuf[i]; + h=h*a+c; sbuf[i]=h; x=s*g-1.; + i=(s>>24); s=sbuf[i]; + h=h*a+c; sbuf[i]=h; y=s*g-1.; + r=x*x+y*y; + } while(r>=1.); + r=sqrt(-2.*log(r)/r); + err[0]=x*r; err[1]=y*r; +} +void setnorm(unsigned int sa) +{ int k; + for(h=sa,k=0; k<=256 ;++k){ + h=h*a+c; + if(k<256) sbuf[k]=h; else s=h; + } +} diff --git a/simu/norm2.c b/simu/norm2.c new file mode 100644 index 0000000..40ab7fb --- /dev/null +++ b/simu/norm2.c @@ -0,0 +1,31 @@ +/* norm2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static unsigned int s,h,ss[256]; +static unsigned int a=1664525U,c=244045795U; +static double rc=9.313225750491594e-10; +unsigned int lranb(unsigned int); +void norm2(double *err) +{ double x,y,r; + register int i; + do{ s=lranb(s); h=h*a+c; i=(h>>24); + x=rc*ss[i]-1.; ss[i]=s; + s=lranb(s); h=h*a+c; i=(h>>24); + y=rc*ss[i]-1.; ss[i]=s; + r=x*x+y*y; + } while(r>=1.); + r=sqrt(-2.*log(r)/r); + err[0]=x*r; err[1]=y*r; +} +void setnorm2(unsigned int sa) +{ int k; + for(s=sa,k=0; k<=256 ;++k){ + s=lranb(s); + if(k<256) ss[k]=s; else h=s; + } +} diff --git a/simu/nrml.c b/simu/nrml.c new file mode 100644 index 0000000..c5eb1e9 --- /dev/null +++ b/simu/nrml.c @@ -0,0 +1,36 @@ +/* nrml.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static unsigned int a=1664525U,c=907633387U; +static unsigned int s,h,sbuf[256]; +static int kf; +static double rc=4.6566128730773926e-10,e; +double nrml() +{ double x,y,r; int i; + if(kf){ + do{ i=(int)(s>>24); s=sbuf[i]; + h=a*h+c; sbuf[i]=h; + x=rc*s-1.; + i=(int)(s>>24); s=sbuf[i]; + h=a*h+c; sbuf[i]=h; + y=rc*s-1.; r=x*x+y*y; + } while(r>=1.); + r=sqrt(-2.*log(r)/r); + x*=r; e=y*r; + } + else x=e; + kf^=1; return x; +} +void setnrml(unsigned int sa) +{ int j; + for(h=sa,j=0; j<=256 ;++j){ + h=a*h+c; + if(j<256) sbuf[j]=h; else s=h; + } + kf=1; +} diff --git a/simu/sampl.c b/simu/sampl.c new file mode 100644 index 0000000..0ef7420 --- /dev/null +++ b/simu/sampl.c @@ -0,0 +1,12 @@ +/* sampl.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +sampl(void **s,int n,void **d,int m) +{ int k; + for(k=0; k0 ;){ + i=bran(j--); + t=s[i]; s[i]=s[j]; s[j]=t; + } +} diff --git a/simu/supp/README b/simu/supp/README new file mode 100644 index 0000000..08ed18e --- /dev/null +++ b/simu/supp/README @@ -0,0 +1,10 @@ + The functions 'lrana,c' and 'lranb.c' are c-code versions of + congruential generators that perform arithmetic modulo the + prime number 2^31 -1. The assembly code '.s' source modules + in the 'simu' directory should be replaced by this C code + when the installation target is a non-Intel platform. + + The '.asm' modules are an alternative for 80x86 platforms + that can be assembled with the 'nasm' assembler. This + assembler employs an Intel type code format, rather than + the odd AT&T format employed by GNU C.\ diff --git a/simu/supp/lrana.asm b/simu/supp/lrana.asm new file mode 100644 index 0000000..d7f0b9e --- /dev/null +++ b/simu/supp/lrana.asm @@ -0,0 +1,24 @@ + ;; unsigned long lrana(unsigned long s) + ;; generation employs a congruential method mod 2^31-1 + +[global lrana] + +[section .data] + mm dd 16807 + +[section .text] + + lrana + mov eax,dword [esp+4] + mul dword [mm] + shld edx,eax,1 + btr eax,31 + add eax,edx + bt eax,31 + jnc .A + add eax,1 + btr eax,31 + .A + ret + + end diff --git a/simu/supp/lrana.c b/simu/supp/lrana.c new file mode 100644 index 0000000..60267fc --- /dev/null +++ b/simu/supp/lrana.c @@ -0,0 +1,23 @@ +/* lrana.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + C version of the routine for a multiplicative + generator modulo 2^31-1. +*/ + +static unsigned int m=16807U,k=0xffffU,j=0xfffeU; +static unsigned int u=0x80000000U,v=0x7fffffffU; +unsigned int lrana(unsigned int s) +{ register unsigned int z,f; + z=m*(s&k); f=(s>>16)*m; f+=(z>>16); + z=(z&k)+(f<<16); f=(f>>15)&j; + if(z&u) f|=1L; + s=f+(z&v); + if(s&u) s=(s+1)&v; + return s; +} diff --git a/simu/supp/lrana.s b/simu/supp/lrana.s new file mode 100644 index 0000000..6bc0015 --- /dev/null +++ b/simu/supp/lrana.s @@ -0,0 +1,23 @@ +.data + .align 4 + .type m,@object + .size m,4 +m: + .long 16807 +.text + .align 16 +.globl lrana + .type lrana,@function +lrana: + movl 4(%esp),%eax + movl m,%ecx + mull %ecx + shldl $1,%eax,%edx + btrl $31,%eax + addl %edx,%eax + btl $31,%eax + jnc .A + addl $1,%eax + btrl $31,%eax +.A: + ret diff --git a/simu/supp/lranb.asm b/simu/supp/lranb.asm new file mode 100644 index 0000000..9721cd7 --- /dev/null +++ b/simu/supp/lranb.asm @@ -0,0 +1,24 @@ + ;; unsigned long lranb(unsigned long s) + ;; generation employs a congruential method mod 2^31-1 + +[global lranb] + +[section .data] + mm dd 48271 + +[section .text] + + lranb + mov eax,dword [esp+4] + mul dword [mm] + shld edx,eax,1 + btr eax,31 + add eax,edx + bt eax,31 + jnc .A + add eax,1 + btr eax,31 + .A + ret + + end diff --git a/simu/supp/lranb.c b/simu/supp/lranb.c new file mode 100644 index 0000000..092ada9 --- /dev/null +++ b/simu/supp/lranb.c @@ -0,0 +1,23 @@ +/* lranb.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + C version of the routine for a multiplicative + generator modulo 2^31-1. +*/ + +static unsigned int m=48271U,k=0xffffU,j=0xfffeU; +static unsigned int u=0x80000000U,v=0x7fffffffU; +unsigned int lranb(unsigned int s) +{ register unsigned int z,f; + z=m*(s&k); f=(s>>16)*m; f+=(z>>16); + z=(z&k)+(f<<16); f=(f>>15)&j; + if(z&u) f|=1L; + s=f+(z&v); + if(s&u) s=(s+1)&v; + return s; +} diff --git a/simu/supp/lranb.s b/simu/supp/lranb.s new file mode 100644 index 0000000..b513051 --- /dev/null +++ b/simu/supp/lranb.s @@ -0,0 +1,23 @@ +.data + .align 4 + .type m,@object + .size m,4 +m: + .long 48271 +.text + .align 16 +.globl lranb + .type lranb,@function +lranb: + movl 4(%esp),%eax + movl m,%ecx + mull %ecx + shldl $1,%eax,%edx + btrl $31,%eax + addl %edx,%eax + btl $31,%eax + jnc .A + addl $1,%eax + btrl $31,%eax +.A: + ret diff --git a/simu/test/README b/simu/test/README new file mode 100644 index 0000000..588d8f0 --- /dev/null +++ b/simu/test/README @@ -0,0 +1,34 @@ + This directory contains test code for the functions of the 'simu' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. Input data files, if any + are named in the test code header, are in the 'data' sub-directory. + + The 'timing' subdirectory contains code to time the execution of + the pseudorandom generators in this library segment. Input to + the timing functions is a sample size. + + The 'distribution' subdirectory contains code used to compute + and tabulate the distribution of values produced by the normal + and uniform ranom generators. Input to the distribution functions + is a random seed and a sample size. + + The command line input parameters for each of the standard tests + are specified in the following list. These inputs should reproduce + the results appended as a comment to the test source code. + + tbran 57a5387 10 20000 + tbran2 ef7bdb3 12 240000 + tlran1 3da1c1b8 25 + tlrand 75bcd15 50 + tnorm 7766805b 20 + tnorm2 a1b43111 20 + tnrml 11b6976b 20 + tprand 4c7605e3 + tsampl 5000 c1a34567 + tsamshf 10000 ae595c0e + tshuffl 571a5e98 20 + tunfl 378f3e50 20 + tunfl2 f53814d1 20 + + These arguments specify a random seeds and sample sizes + for the tests. diff --git a/simu/test/distribution/norm2dis.c b/simu/test/distribution/norm2dis.c new file mode 100644 index 0000000..786f083 --- /dev/null +++ b/simu/test/distribution/norm2dis.c @@ -0,0 +1,52 @@ +/* norm2dis.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: norm2() setnorm2() autcor() hist() + + Input parameters: n -> integer: sample size + s -> unsigned integer: pseudorandom seed +*/ +#include "ccmath.h" +int lag=20,nbin=18; +double xmin= -4.5,xmax=4.5; +void main(int na,char **av) +{ double *x,*p,xm,bin,dsq,c,*ac; + int n,i,k,*hs; unsigned int s; + if(na!=3){ printf("para: siz seed(hex)\n"); exit(-1);} + n=atoi(*++av); sscanf(*++av,"%x",&s); + printf(" sample size= %d\n",n); + printf(" seed= %x\n",s); + x=(double *)calloc(sizeof(double),n); +/* initialize random normal generator */ + setnorm2(s); xm=0.; +/* generate random normal sample */ + for(p=x,i=0; i %4.1f\n",hs[-1],xmin,hs[nbin],xmax); + for(i=0,xm=xmin,k=hs[-1],dsq=n; i integer: sample size + s -> unsigned integer: pseudorandom seed +*/ +#include "ccmath.h" +int lag=20,nbin=18; +double xmin= -4.5,xmax=4.5; +void main(int na,char **av) +{ double *x,*p,xm,bin,dsq,c,*ac; + int n,i,k,*hs; unsigned int s; + if(na!=3){ printf("para: siz seed(hex)\n"); exit(-1);} + n=atoi(*++av); sscanf(*++av,"%x",&s); + printf(" sample size= %d\n",n); + printf(" seed= %x\n",s); + x=(double *)calloc(sizeof(double),n); +/* initialize random normal generator */ + setnorm(s); xm=0.; +/* generate random normal sample */ + for(p=x,i=0; i %4.1f\n",hs[-1],xmin,hs[nbin],xmax); + for(i=0,xm=xmin,k=hs[-1],dsq=n; i integer: sample size + s -> unsigned integer: pseudorandom seed +*/ +#include "ccmath.h" +int lag=20,nbin=18; +double xmin= -4.5,xmax=4.5; +void main(int na,char **av) +{ double *x,*p,xm,bin,dsq,c,*ac; + int n,i,k,*hs; unsigned int s; + if(na!=3){ printf("para: siz seed(hex)\n"); exit(-1);} + n=atoi(*++av); sscanf(*++av,"%x",&s); + printf(" sample size= %d\n",n); + printf(" seed= %x\n",s); + x=(double *)calloc(sizeof(double),n); +/* initialize random normal generator */ + setnrml(s); xm=0.; +/* generate random normal sample */ + for(p=x,i=0; i %4.1f\n",hs[-1],xmin,hs[nbin],xmax); + for(i=0,xm=xmin,k=hs[-1],dsq=n; i integer: sample size + s -> unsigned integer: pseudorandom seed +*/ +#include "ccmath.h" +int lag=20,nbin=20; +double xmin=0.,xmax=1.; +void main(int na,char **av) +{ double *x,*p,xm,bin,dsq,c,*ac; + int n,i,k,*hs; unsigned int s; + if(na!=3){ printf("para: siz seed(hex)\n"); exit(-1);} + n=atoi(*++av); sscanf(*++av,"%x",&s); + printf(" sample size= %d\n",n); + printf(" seed= %x\n",s); + x=(double *)calloc(sizeof(double),n); + +/* initialize pseudorandom generator */ + setunfl2(s); xm=0.; +/* generate sample of pseudorandom numbers uniform on [0,1] */ + for(p=x,i=0; i %4.1f\n",hs[-1],xmin,hs[nbin],xmax); + for(i=0,xm=xmin,k=hs[-1],dsq=n; i integer: sample size + s -> unsigned integer: pseudorandom seed +*/ +#include "ccmath.h" +int lag=20,nbin=20; +double xmin=0.,xmax=1.; +void main(int na,char **av) +{ double *x,*p,xm,bin,dsq,c,*ac; + int n,i,k,*hs; unsigned int s; + if(na!=3){ printf("para: siz seed(hex)\n"); exit(-1);} + n=atoi(*++av); sscanf(*++av,"%x",&s); + printf(" sample size= %d\n",n); + printf(" seed= %x\n",s); + x=(double *)calloc(sizeof(double),n); + +/* initialize pseudorandom generator */ + setunfl(s); xm=0.; +/* generate sample of pseudorandom numbers uniform on [0,1] */ + for(p=x,i=0; i %4.1f\n",hs[-1],xmin,hs[nbin],xmax); + for(i=0,xm=xmin,k=hs[-1],dsq=n; i unsigned integer: pseudorandom generator seed + n -> integer parameter (output range [0,n-1]) + m -> sample size +*/ +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; int n,m,i,k,*nh; + if(na!=4){ printf("para: seed(hex) argument num_out\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); m=atoi(*++av); + printf(" seed= %x\n",s); + printf(" arg: n= %d\n",n); + printf(" sample sizw m= %d\n",m); + nh=(int *)calloc(sizeof(int),n+1); + +/* initialize pseudorandom integer generator */ + setbran(s); + + for(i=0; i unsigned integer: pseudorandom generator seed + n -> integer parameter + m -> sample size +*/ +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; int n,m,i,k,*nh; + if(na!=4){ printf("para: seed(hex) argument num_out\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); m=atoi(*++av); + printf(" seed= %x\n",s); + printf(" arg: n= %d\n",n); + printf(" sample size m= %d\n",m); + nh=(int *)calloc(sizeof(int),n+1); + +/* initialize pseudorandom integer generator */ + setbran2(s); + + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; + int i,n,m,k; clock_t st,en; + double dt,tms; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; m=256; + setbran(s); + st=clock(); + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; + int i,n,m,k; clock_t st,en; + double dt,tms; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; m=256; + setbran2(s); + st=clock(); + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; + int i,n; clock_t st,en; + double dt,tms; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; + setlran1(s); + st=clock(); + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; + int i,n; clock_t st,en; + double dt,tms; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; + setlrand(s); + st=clock(); + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; double err[2]; + int i,n; clock_t st,en; + double dt,tms; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; + setnorm(s); + st=clock(); + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; double err[2]; + int i,n; clock_t st,en; + double dt,tms; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; + setnorm2(s); + st=clock(); + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; double e; + int i,n; clock_t st,en; + double dt,tms; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; + setnrml(s); + st=clock(); + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; + int i,n; clock_t st,en; + double dt,tms,h; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; + setunfl(s); + st=clock(); + for(i=0; i +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s; + int i,n; clock_t st,en; + double dt,tms,h; + if(na!=2){ printf("para: count\n"); exit(1);} + n=atoi(*++av); + s=0x5a7d3b28; + setunfl2(s); + st=clock(); + for(i=0; i unsigned integer: pseudorandom generator seed + n -> integer: sample size +*/ +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s,r; int n,i; + if(na!=3){ printf("para: seed(hex) num_out\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); + printf(" seed= %x\n",s); + printf(" sample size= %d\n",n); + +/* initialize pseudorandom integer generator */ + setlran1(s); + + for(i=0; i unsigned integer: pseudorandom generator seed + n -> integer: sample size +*/ +#include "ccmath.h" +void main(int na,char **av) +{ unsigned int s,r; int n,i; + if(na!=3){ printf("para: seed(hex) num_out\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); + printf(" seed= %x\n",s); + printf(" sample size= %d\n",n); + +/* initialize pseudorandom integer generator */ + setlrand(s); + + for(i=0; i unsigned integer: pseudorandom generator seed + n -> integer: sample size +*/ +#include "ccmath.h" +void main(int na,char **av) +{ double err[2],xm,ssq; unsigned int s; + int n,i,p; + if(na!=3){ printf("para: seed size\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); + printf(" seed= %x\n",s); + printf(" sample size= %d\n",n); + if(n>1000) p=0; else p=1; +/* initialize generator */ + setnorm(s); xm=ssq=0.; + for(i=0; i unsigned integer: pseudorandom generator seed + n -> integer: sample size +*/ +#include "ccmath.h" +void main(int na,char **av) +{ double err[2],xm,ssq; unsigned int s; + int n,i,p; + if(na!=3){ printf("para: seed(hex) size\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); + printf(" seed= %x\n",s); + printf(" sample size= %d\n",n); + if(n>1000) p=0; else p=1; +/* initialize generator */ + setnorm2(s); xm=ssq=0.; + + for(i=0; i unsigned integer: pseudorandom seed + n -> integer: sample size +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ double x,xm,ssq; unsigned int s; + int n,i,p; + if(na!=3){ printf("para: seed(hex) size\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); + printf(" seed= %x\n",s); + printf(" sample size= %d\n",n); + if(n>1000) p=0; else p=1; +/* initialize pseudorandom normal generator */ + setnrml(s); + + xm=ssq=0.; + for(i=0; i unsigned int: random generator seed +*/ +#include "ccmath.h" +#include +void main(int na,char **av) +{ int n,f,k,i,j,lag,kb,*his; + unsigned int seed; + double *x,*p,a,b,h,bin,err[2]; + if(na!=2){ + printf("para: seed(hex)\n"); exit(1);} + sscanf(*++av,"%x",&seed); + lag=20; n=1000000; + x=(double *)calloc(sizeof(*x),n); + printf(" Test of Pseudorandom Generator Distributions\n\n"); + for(i=0; i<4 ;++i){ + switch(i){ + case 0: f=0; k=0; break; + case 1: f=1; k=0; break; + case 2: f=0; k=1; break; + case 3: f=1; k=1; break; + } + if(f) printf(" normal distribution "); + else printf(" uniform distribution "); + printf("generator type %d\n",k); printf(" seed = %x\n",seed); + +/* generate sample of requested type */ + if(f){ a= -(b=3.); kb=12; + if(k) setnorm2(seed); else setnrml(seed); + for(j=0,p=x; j integer: number of samples + seed -> unsigned integer: pseudorandom generator seed +*/ +#include "ccmath.h" +#define MM 30 +void main(int na,char **av) +{ int dat[MM],*bdf[MM],his[MM],*sam[6]; + int nt,ns,n,m,i,j,k,p; unsigned int seed; + n=MM; m=6; + if(na!=3){ printf("para: reps seed\n"); exit(-1);} + nt=atoi(*++av); + if(nt>30) p=0; else p=1; +/* initialize random generator */ + sscanf(*++av,"%x",&seed); setbran(seed); + printf(" Random Sample Generator Test\n"); + printf(" seed= %x\n",seed); + for(i=0,ns=0; i integer: number of samples generated + seed -> unsigned integer: pseudorandom generator seed +*/ +#include +#include "ccmath.h" +#define MM 20 +#define MS 5 +int his[MS][MM]; +void main(int na,char **av) +{ int dat[MM],*bdf[MM],*sam[MS]; + int nt,n,m,i,j,k; unsigned int ns,seed; + n=MM; m=MS; + if(na!=3){ printf("para: reps seed\n"); exit(-1);} + nt=atoi(*++av); +/* initialize pseudorandom generator */ + sscanf(*++av,"%x",&seed); setbran(seed); + printf(" Random Sample Test\n"); + printf(" seed= %x\n",seed); + for(i=0,ns=0; i unsigned integer: pseudorandom seed + m -> integer: number of shuffles +*/ +#include "ccmath.h" +void main(int na,char **av) +{ int base[12],*sh[12]; unsigned int s; + int n,m,i,j; + if(na!=3){ printf("para: seed msz\n"); exit(-1);} + printf(" Test of Shuffle\n"); +/* initialize pseudorandom generator */ + sscanf(*++av,"%x",&s); printf(" seed= %x\n",s); + setbran(s); + m=atoi(*++av); + for(i=0,n=12; i unsigned integer pseudorandom seed + + n -> integer sample size +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ double x,xm,ssq; unsigned int s; + int n,i,p; + if(na!=3){ printf("para: seed(hex) size\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); + printf(" seed= %x\n",s); + printf(" sample size= %d\n",n); + if(n>1000) p=0; else p=1; +/* initialize pseudorandom uniform generator */ + setunfl(s); + + xm=ssq=0.; + for(i=0; i unsigned integer: pseudorandom seed + n -> integer: sample size +*/ +#include +#include "ccmath.h" +void main(int na,char **av) +{ double x,xm,ssq; unsigned int s; + int n,i,p; + if(na!=3){ printf("para: seed(hex) size\n"); exit(-1);} + sscanf(*++av,"%x",&s); n=atoi(*++av); + printf(" seed= %x\n",s); + printf(" sample size= %d\n",n); + if(n>1000) p=0; else p=1; +/* initialize pseudorandom uniform generator */ + setunfl2(s); + + xm=ssq=0.; + for(i=0; i>24); s=sbuf[i]; + h=a*h+c; sbuf[i]=h; + return s*2.328306436538696e-10; +} +void setunfl(unsigned int k) +{ int j; + for(h=k,j=0; j<=256 ;++j){ + h=a*h+c; + if(j<256) sbuf[j]=h; else s=h; + } +} diff --git a/simu/unfl2.c b/simu/unfl2.c new file mode 100644 index 0000000..7cdbc2e --- /dev/null +++ b/simu/unfl2.c @@ -0,0 +1,23 @@ +/* unfl2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +static unsigned int s,h,ss[256]; +unsigned int lranb(unsigned int); +double unfl2() +{ register int i; unsigned int c; + s=lranb(s); + h=h*69069U+4098479U; + i=(h>>24); c=ss[i]; ss[i]=s; + return (double)c*4.656612875245797e-10; +} +void setunfl2(unsigned int sa) +{ int k; + for(s=sa,k=0; k<=256 ;++k){ + s=lranb(s); + if(k<256) ss[k]=s; else h=s; + } +} diff --git a/sort/batdel.c b/sort/batdel.c new file mode 100644 index 0000000..4dc459f --- /dev/null +++ b/sort/batdel.c @@ -0,0 +1,54 @@ +/* batdel.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define BAL 1 +#include "tree.h" +int batdel(char *kin,struct tnode *hd) +{ struct tnode *r,*s,**f,*pstk[20]; int ef,jc,k,astk[20]; + pstk[k=0]=hd; + while(hd!=NULL){ + if((ef=strcmp(kin,hd->key))==0) break; + else if(ef<0){ f= &(hd->pl); astk[k]= -1;} + else{ f= &(hd->pr); astk[k]=1;} + pstk[++k]=hd= *f; + } + if(hd==NULL) return 0; + jc=k; astk[k]=1; + if(hd->pr==NULL){ *f=hd->pl; --k;} + else if(hd->pl==NULL){ *f=hd->pr; --k;} + else if((r=hd->pr)->pl==NULL){ r->pl=hd->pl; *f=r;} + else{ pstk[++k]=r; astk[k]= -1; + for(s=r->pl; s->pl!=NULL ;){ pstk[++k]=r=s; s=r->pl; astk[k]= -1;} + s->pl=hd->pl; r->pl=s->pr; s->pr=hd->pr; *f=s; + } + if(k>=jc){ pstk[jc]= *f; (*f)->bal=hd->bal;} + free(hd); + while(k){ hd=pstk[k]; jc=astk[k--]; + if(hd->bal==0){ hd->bal= -jc; return 1;} + if(hd->bal==jc) hd->bal=0; + else{ if(jc<0){ s=r=hd->pr; + if((ef=r->bal)==0){ hd->pr=r->pl; r->pl=hd;} + else{ if(r->bal==jc){ s=r->pl; r->pl=s->pr; s->pr=r;} + hd->pr=s->pl; s->pl=hd; + } + } + else{ s=r=hd->pl; + if((ef=r->bal)==0){ hd->pl=r->pr; r->pr=hd;} + else{ if(r->bal==jc){ s=r->pl; r->pr=s->pl; s->pl=r;} + hd->pl=s->pr; s->pr=hd; + } + } + if(ef==0) hd->bal= -(r->bal=jc); + else if(s==r || s->bal==0) hd->bal=r->bal=0; + else if(s->bal== -jc){ hd->bal=jc; s->bal=r->bal=0;} + else{ r->bal= -jc; s->bal=hd->bal=0;} + if(astk[k]==1) pstk[k]->pr=s; else pstk[k]->pl=s; + if(ef==0) return 1; + } + } + return 1; +} diff --git a/sort/batins.c b/sort/batins.c new file mode 100644 index 0000000..e1b8b41 --- /dev/null +++ b/sort/batins.c @@ -0,0 +1,43 @@ +/* batins.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define BAL 1 +#include "tree.h" +#include +struct tnode *batins(char *kin,struct tnode *hd) +{ struct tnode *r,*s,*t,**v,*pt; int ef,avl; + t=hd; v= &(hd->pr); s=hd=hd->pr; + if(hd!=NULL){ + while(1){ + if((ef=strcmp(kin,hd->key))==0) return hd; + else if(ef<0) v= &(hd->pl); else v= &(hd->pr); + if(*v==NULL) break; + if((*v)->bal!=0){ t=hd; s= *v;} + hd= *v; + } + } + pt= *v=(struct tnode *)malloc(sizeof(*hd)); + pt->key=kin; pt->bal=0; pt->pr=pt->pl=NULL; + if(s==NULL) return *v; + if(strcmp(kin,s->key)<0){ r=hd=s->pl; avl= -1;} + else{ r=hd=s->pr; avl=1;} + while(hd!= *v){ if(strcmp(kin,hd->key)<0){ hd->bal= -1; hd=hd->pl;} + else{ hd->bal=1; hd=hd->pr;} + } + if(s->bal!=avl){ s->bal+=avl; return *v;} hd=r; + if(avl<0){ if(r->bal== -avl){ hd=r->pr; r->pr=hd->pl; hd->pl=r;} + s->pl=hd->pr; hd->pr=s; + } + else{ if(r->bal== -avl){ hd=r->pl; r->pl=hd->pr; hd->pr=r;} + s->pr=hd->pl; hd->pl=s; + } + if(hd==r || hd->bal==0) s->bal=r->bal=0; + else if(hd->bal==avl){ s->bal= -avl; r->bal=hd->bal=0;} + else{ r->bal=avl; s->bal=hd->bal=0;} + if(s==t->pr) t->pr=hd; else t->pl=hd; + return pt; +} diff --git a/sort/btdel.c b/sort/btdel.c new file mode 100644 index 0000000..6cf841c --- /dev/null +++ b/sort/btdel.c @@ -0,0 +1,24 @@ +/* btdel.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "tree.h" +int btdel(char *kin,struct tnode *hd) +{ struct tnode *r,*s,**f; int ef; + while(hd!=NULL){ + if((ef=strcmp(kin,hd->key))==0) break; + else if(ef<0) f= &(hd->pl); else f= &(hd->pr); + hd= *f; + } + if(hd==NULL) return 0; + if(hd->pr==NULL) *f=hd->pl; + else if(hd->pl==NULL) *f=hd->pr; + else if((r=hd->pr)->pl==NULL){ r->pl=hd->pl; *f=r;} + else{ for(s=r->pl; s->pl!=NULL ;){ r=s; s=r->pl;} + s->pl=hd->pl; r->pl=s->pr; s->pr=hd->pr; *f=s; + } + free(hd); return 1; +} diff --git a/sort/btins.c b/sort/btins.c new file mode 100644 index 0000000..717792e --- /dev/null +++ b/sort/btins.c @@ -0,0 +1,20 @@ +/* btins.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "tree.h" +#include +struct tnode *btins(char *kin,struct tnode *hd) +{ struct tnode **v; int ef; + while(hd!=NULL){ + if((ef=strcmp(kin,hd->key))==0) return hd; + else if(ef<0) v= &(hd->pl); else v= &(hd->pr); + hd= *v; + } + hd= *v=(struct tnode *)malloc(sizeof(*hd)); + hd->key=kin; hd->pr=hd->pl=NULL; + return hd; +} diff --git a/sort/btsearch.c b/sort/btsearch.c new file mode 100644 index 0000000..096cc06 --- /dev/null +++ b/sort/btsearch.c @@ -0,0 +1,17 @@ +/* btsearch.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define BAL 1 +#include "tree.h" +struct tnode *btsearch(char *kin,struct tnode *hd) +{ int ef; + while(hd!=NULL){ + if((ef=strcmp(kin,hd->key))==0) return hd; + if(ef<0) hd=hd->pl; else hd=hd->pr; + } + return hd; +} diff --git a/sort/btsort.c b/sort/btsort.c new file mode 100644 index 0000000..c7826e2 --- /dev/null +++ b/sort/btsort.c @@ -0,0 +1,17 @@ +/* btsort.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define BAL 1 +#include "tree.h" +static int k; +void btsort(struct tnode *hd,struct tnode **ar) +{ if(hd!=NULL){ + btsort(hd->pl,ar); + ar[k++]=hd; + btsort(hd->pr,ar); + } +} diff --git a/sort/hash.h b/sort/hash.h new file mode 100644 index 0000000..51aa216 --- /dev/null +++ b/sort/hash.h @@ -0,0 +1,12 @@ +/* hash.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef NULL +#define NULL ((void *)0) +#endif +struct tabl {char *key,*val; struct tabl *pt;}; +int hval(char *k,int m); diff --git a/sort/hashdel.c b/sort/hashdel.c new file mode 100644 index 0000000..6c00397 --- /dev/null +++ b/sort/hashdel.c @@ -0,0 +1,20 @@ +/* hashdel.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "hash.h" +int hashdel(char *kin,struct tabl **harr,int mh) +{ int hv,m; struct tabl *pe,*ps; + hv=hval(kin,mh); pe=harr[hv]; ps=NULL; + while(pe!=NULL){ + if((m=strcmp(kin,pe->key))==0) break; + if(m<0) return 0; + ps=pe; pe=pe->pt; + } + if(pe==NULL) return 0; + if(ps!=NULL) ps->pt=pe->pt; else harr[hv]=pe->pt; + free(pe); return 1; +} diff --git a/sort/hashins.c b/sort/hashins.c new file mode 100644 index 0000000..b02593d --- /dev/null +++ b/sort/hashins.c @@ -0,0 +1,21 @@ +/* hashins.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "hash.h" +#include +struct tabl *hashins(char *kin,struct tabl **harr,int mh) +{ int hv,m; struct tabl *pe,*ps,*pc; + hv=hval(kin,mh); pe=harr[hv]; ps=NULL; + while(pe!=NULL){ + if((m=strcmp(kin,pe->key))==0) return pe; + if(m<0) break; ps=pe; pe=pe->pt; + } + pc=(struct tabl *)malloc(sizeof(*pe)); + pc->key=kin; pc->pt=pe; + if(ps==NULL) harr[hv]=pc; else ps->pt=pc; + return pc; +} diff --git a/sort/hfind.c b/sort/hfind.c new file mode 100644 index 0000000..ba9b484 --- /dev/null +++ b/sort/hfind.c @@ -0,0 +1,17 @@ +/* hfind.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "hash.h" +struct tabl *hfind(char *kin,struct tabl **harr,int mh) +{ int hv,m; struct tabl *pe; + hv=hval(kin,mh); pe=harr[hv]; + while(pe!=NULL){ + if((m=strcmp(kin,pe->key))==0) return pe; + if(m<0) return NULL; pe=pe->pt; + } + return NULL; +} diff --git a/sort/hsort.c b/sort/hsort.c new file mode 100644 index 0000000..2bca284 --- /dev/null +++ b/sort/hsort.c @@ -0,0 +1,22 @@ +/* hsort.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define Swap(x,y) (tmp=(x),(x)=(y),(y)=tmp) +static void rheap(void **v,int k,int n,int (*comp)()); +void hsort(void **v,int n,int (*comp)()) +{ int k; char *tmp; + for(k=n/2-1; k>=0 ;) rheap(v,k--,n,comp); + for(--n; n>0 ;){ Swap(v[0],v[n]); rheap(v,0,n--,comp);} +} +static void rheap(void **v,int k,int n,int (*comp)()) +{ int m=n-1,j; char *tmp; + for(j=2*k+1; j0) ++j; + if((*comp)(v[j],v[k])>0) Swap(v[k],v[j]); + else break; + } +} diff --git a/sort/hval.c b/sort/hval.c new file mode 100644 index 0000000..51dffa5 --- /dev/null +++ b/sort/hval.c @@ -0,0 +1,12 @@ +/* hval.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +int hval(char *key,int mh) +{ int hv; + for(hv=0; *key!='\0' ;) hv+= *key++; + return hv%mh; +} diff --git a/sort/merge.h b/sort/merge.h new file mode 100644 index 0000000..4440d04 --- /dev/null +++ b/sort/merge.h @@ -0,0 +1,11 @@ +/* merge.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef NULL +#define NULL 0L +#endif +struct llst {char *pls; struct llst *pt;}; diff --git a/sort/msort.c b/sort/msort.c new file mode 100644 index 0000000..e264978 --- /dev/null +++ b/sort/msort.c @@ -0,0 +1,26 @@ +/* msort.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "merge.h" +static struct llst *merge(struct llst *a,struct llst *b,int (*comp)()); +struct llst *msort(struct llst *st,int dim,int (*comp)()) +{ struct llst *a,*b; int i,m=dim/2; + if(st->pt==NULL) return st; + a=st; for(i=1; ipt); + b=st->pt; st->pt=NULL; + return merge(msort(a,m,comp),msort(b,dim-m,comp),comp); +} +static struct llst *merge(struct llst *a,struct llst *b,int (*comp)()) +{ struct llst *t,hd; + if(b==NULL) return a; t= &hd; + while(1){ + if((*comp)(a->pls,b->pls)<=0){ + t->pt=a; t=a; if((a=a->pt)==NULL){ t->pt=b; break;} } + else{ t->pt=b; t=b; if((b=b->pt)==NULL){ t->pt=a; break;} } + } + return hd.pt; +} diff --git a/sort/numcmp.c b/sort/numcmp.c new file mode 100644 index 0000000..7aaf5c5 --- /dev/null +++ b/sort/numcmp.c @@ -0,0 +1,22 @@ +/* numcmp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +int dubcmp(double *x,double *y) +{ if(*x > *y) return 1; + if(*x < *y) return -1; + return 0; +} +int intcmp(int *x,int *y) +{ if(*x > *y) return 1; + if(*x < *y) return -1; + return 0; +} +int unicmp(unsigned *x,unsigned *y) +{ if(*x > *y) return 1; + if(*x < *y) return -1; + return 0; +} diff --git a/sort/prbtree.c b/sort/prbtree.c new file mode 100644 index 0000000..d4d9dd9 --- /dev/null +++ b/sort/prbtree.c @@ -0,0 +1,26 @@ +/* prbtree.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define BAL 1 +#include "tree.h" +static struct tnode *pspb[129]; +static char pstrb[131]; +int puts(char *s); +void prbtree(struct tnode *hd,int m) +{ int n=2,i,k,ks; + for(n<<=m,i=0; i<=n ;) pspb[i++]=NULL; + ks=n/2+1; pspb[ks]=hd; pstrb[n+1]='\n'; pstrb[n+2]='\0'; + for(k=ks/2,m=n; m>1 ;m/=2,k/=2){ + for(i=0; i<=n ;) pstrb[i++]=' '; + for(i=ks; i<=n ;i+=m){ + if(pspb[i]!=NULL){ pstrb[i]= *(pspb[i]->key); + if(k){ pspb[i-k]=pspb[i]->pl; pspb[i+k]=pspb[i]->pr;} + } + } + puts(pstrb); ks-=k; + } +} diff --git a/sort/prtree.c b/sort/prtree.c new file mode 100644 index 0000000..7ddf21a --- /dev/null +++ b/sort/prtree.c @@ -0,0 +1,25 @@ +/* prtree.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "tree.h" +static struct tnode *psp[129]; +static char pstr[131]; +int puts(char *c); +void prtree(struct tnode *hd,int m) +{ int n=2,i,k,ks; + for(n<<=m,i=0; i<=n ;) psp[i++]=NULL; + ks=n/2+1; psp[ks]=hd; pstr[n+1]='\n'; pstr[n+2]='\0'; + for(k=ks/2,m=n; m>1 ;m/=2,k/=2){ + for(i=0; i<=n ;) pstr[i++]=' '; + for(i=ks; i<=n ;i+=m){ + if(psp[i]!=NULL){ pstr[i]= *(psp[i]->key); + if(k){ psp[i-k]=psp[i]->pl; psp[i+k]=psp[i]->pr;} + } + } + puts(pstr); ks-=k; + } +} diff --git a/sort/qsrt.c b/sort/qsrt.c new file mode 100644 index 0000000..bc78559 --- /dev/null +++ b/sort/qsrt.c @@ -0,0 +1,21 @@ +/* qsrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define Swap(x,y) (tmp=(x),(x)=(y),(y)=tmp) +void qsrt(void **v,int i,int j,int (*comp)()) +{ int up=j,lw=i; char *tmp,*pa; + if(i>=j) return; + --i; pa=v[up]; + while(ii && (*comp)(v[j],pa)>0 ;--j); + if(iup-i){ qsrt(v,i+1,up,comp); qsrt(v,lw,i-1,comp);} + else{ qsrt(v,lw,i-1,comp); qsrt(v,i+1,up,comp);} +} diff --git a/sort/ssort.c b/sort/ssort.c new file mode 100644 index 0000000..c2de95f --- /dev/null +++ b/sort/ssort.c @@ -0,0 +1,18 @@ +/* ssort.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +void ssort(void **v,int n,int (*comp)()) +{ int gap,i,j; char *tem; + for(gap=1; gap<=n ; gap=3*gap+1); + for(gap/=3; gap>0 ;gap/=3){ + for(i=gap; i=0 && (*comp)(v[j],tem)>0 ;j-=gap) + v[j+gap]=v[j]; + v[j+gap]=tem; + } + } +} diff --git a/sort/test/README b/sort/test/README new file mode 100644 index 0000000..fc20910 --- /dev/null +++ b/sort/test/README @@ -0,0 +1,16 @@ + This directory contains test code for the functions of the 'sort' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. Input data files, if any + are named in the test code header, are in the 'data' sub-directory. + + The following list specifies the input for standard tests, whose + output is appended to the test source code as a comment. + + tbatree data/ttree.dat + tbtree data/ttree.dat + tbtree0 data/ttree.dat + thash data/hash.dat + thsort 25 + tmsort 25 + tqsrt 25 + tssort 25 diff --git a/sort/test/data/hash.dat b/sort/test/data/hash.dat new file mode 100644 index 0000000..3ef8cca --- /dev/null +++ b/sort/test/data/hash.dat @@ -0,0 +1 @@ +ab 15 cat -7 dmm 13 fc 99 gh 23 fik 123 mss 37 pff -22 diff --git a/sort/test/data/ttree.dat b/sort/test/data/ttree.dat new file mode 100644 index 0000000..5deb06b --- /dev/null +++ b/sort/test/data/ttree.dat @@ -0,0 +1 @@ +X T B F K M Q A C B H Z P J E R I D M S G U L U O Y P V diff --git a/sort/test/tbatree.c b/sort/test/tbatree.c new file mode 100644 index 0000000..60b5caa --- /dev/null +++ b/sort/test/tbatree.c @@ -0,0 +1,87 @@ +/* tbatree.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: batins batdel btsearch btsort prbtree + + Input file: ttree.dat +*/ +#define BAL 1 +#include "ccmath.h" +struct trec {char key[2]; char rec[2];} tstor[128]; +struct tnode head,*arp[28]; +void main(int na,char **av) +{ struct tnode *hd= &head,*pt; + int n; FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Balanced Tree Functions\n"); + +/* initialize tree head record */ + strcpy(tstor[0].key,"0"); + hd->key=tstor[0].key; hd->pl=hd->pr=NULL; + for(n=1; fscanf(fp,"%s",tstor[n].key)!=EOF ;++n){ + +/* insert node in balanced AVL tree */ + pt=batins(tstor[n].key,hd); + + } +/* print tree structure to level 5 */ + pt=hd->pr; prbtree(pt,5); + +/* delete nodes with keys I and T and print new tree */ + batdel("I",hd); batdel("T",hd); + pt=hd->pr; prbtree(pt,5); + +/* search tree for node with key P */ + pt=btsearch("P",hd); prbtree(pt,5); + +/* sort tree nodes */ + btsort(hd,arp); + for(n=0; arp[n]!=NULL ;) printf("%s",arp[n++]->key); printf("\n"); +} +/* Test output + + Test of Balanced Tree Functions + K + + F T + + B I P X + + A D H J M R U Z + + C E G L O Q S V Y + + + + K + + F U + + B H P X + + A D G J M R V Z + + C E L O Q S Y + + + + P + + M R + + L O Q S + + + + + + + +0ABCDEFGHJKLMOPQRSUVXYZ +*/ diff --git a/sort/test/tbtree.c b/sort/test/tbtree.c new file mode 100644 index 0000000..a13a165 --- /dev/null +++ b/sort/test/tbtree.c @@ -0,0 +1,118 @@ +/* tbtree.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: btins btdel tsearch tsort prtree + + Input file: ttree.dat +*/ +#include "ccmath.h" +struct trec {char key[2]; char rec[2];} tstor[128]; +struct tnode head,*arp[28]; +void main(int na,char **av) +{ struct tnode *hd= &head,*pt; + int n; FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Binary Tree Functions\n"); + +/* initialize head of binary tree */ + strcpy(tstor[0].key,"0"); + hd->key=tstor[0].key; hd->pl=hd->pr=NULL; + for(n=1; fscanf(fp,"%s",tstor[n].key)!=EOF ;++n){ + +/* insert a node in the binary tree */ + pt=btins(tstor[n].key,hd); + + } + +/* print the tree structure to level 5 */ + pt=hd->pr; prtree(pt,5); +/* print the left branch to level 5 */ + printf(" left branch\n"); prtree(pt->pl,5); + +/* search the tree for node with key K and print subtree K */ + pt=tsearch("K",hd); printf(" K-branch\n"); prtree(pt,5); + +/* delete nodes with keys H and T and print the new tree structure */ + btdel("H",hd); btdel("T",hd); pt=hd->pr; prtree(pt,5); + +/* search again for node K and print the subtree starting at K */ + pt=tsearch("K",hd); printf(" K-branch\n"); prtree(pt,5); + +/* sort the tree nodes */ + tsort(hd,arp); + for(n=0; arp[n]!=NULL ;) printf("%s",arp[n++]->key); printf("\n"); +} +/* Test output + + Test of Binary Tree Functions + X + + T Z + + B U Y + + A F V + + C K + + E H M + + left branch + T + + B U + + A F V + + C K + + E H M + + D G J L Q + + K-branch + K + + H M + + G J L Q + + I P R + + O S + + + + X + + U Z + + B V Y + + A F + + C K + + E I M + + K-branch + K + + I M + + G J L Q + + P R + + O S + + + +0ABCDEFGIJKLMOPQRSUVXYZ +*/ diff --git a/sort/test/tbtree0.c b/sort/test/tbtree0.c new file mode 100644 index 0000000..d4df8f5 --- /dev/null +++ b/sort/test/tbtree0.c @@ -0,0 +1,89 @@ +/* tbtree0.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: btins tsearch tsort + + Uses: prtree + + Input file: ttree.dat +*/ +#include "ccmath.h" +struct trec {char key[2]; char rec[2];} tstor[128]; +struct tnode head,*arp[28]; +void main(int na,char **av) +{ struct tnode *hd= &head,*pt; + int n; char sky[2]; FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Binary Tree Functions\n"); +/* initialize tree head */ + strcpy(tstor[0].key,"0"); + hd->key=tstor[0].key; hd->pl=hd->pr=NULL; + +/* insert tree nodes */ + for(n=1; fscanf(fp,"%s",tstor[n].key)!=EOF ;++n){ + pt=btins(tstor[n].key,hd); + } + + pt=hd->pr; prtree(pt,5); + printf(" left branch\n"); prtree(pt->pl,5); + +/* search for node with key K */ + pt=tsearch("K",hd); printf(" K-branch\n"); prtree(pt,5); + +/* search for keys and report success or failure */ + for(n=0; n<2 ;++n){ + if(n) strcpy(sky,"a"); else strcpy(sky,"A"); + pt=tsearch(sky,hd); printf(" %s : ",sky); + if(pt!=NULL) printf("%s found\n",pt->key); else printf("absent\n"); + } +} +/* Test output + + Test of Binary Tree Functions + X + + T Z + + B U Y + + A F V + + C K + + E H M + + left branch + T + + B U + + A F V + + C K + + E H M + + D G J L Q + + K-branch + K + + H M + + G J L Q + + I P R + + O S + + + + A : A found + a : absent +*/ diff --git a/sort/test/thash.c b/sort/test/thash.c new file mode 100644 index 0000000..620ff50 --- /dev/null +++ b/sort/test/thash.c @@ -0,0 +1,71 @@ +/* thash.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: hashins hfind hashdel hval + + Input file: hash.dat +*/ +#include "ccmath.h" +#define HD 11 +struct tabl *hashins(),*hfind(); +struct tabl *harray[HD]; +struct hrec {char key[8]; int val;} vv[30]; +void main(int na,char **av) +{ struct tabl **p,*ph; + int k,j,ns,mhash=HD; char kin[8]; + FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Hash Storage Functions\n"); + for(j=0,p=harray; jval=(char *)(vv+j); + + } + for(k=0; k<2 ;++k){ + for(ns=0; nskey,((struct hrec *)ph->val)->val); + + } + +/* delete the first three records in the table */ + for(ns=0; ns<3 ;++ns) + if(hashdel(vv[ns].key,harray,mhash)) printf("%d deleted\n",ns); + printf("\n"); + } +} +/* Test output + + Test of Hash Storage Functions + 0 ab 15 + 1 cat -7 + 2 dmm 13 + 3 fc 99 + 4 gh 23 + 5 fik 123 + 6 mss 37 + 7 pff -22 +0 deleted +1 deleted +2 deleted + + 3 fc 99 + 4 gh 23 + 5 fik 123 + 6 mss 37 + 7 pff -22 + */ diff --git a/sort/test/thsort.c b/sort/test/thsort.c new file mode 100644 index 0000000..f07639a --- /dev/null +++ b/sort/test/thsort.c @@ -0,0 +1,68 @@ +/* thsort.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: hsort dubcmp + + Uses: unfl surand + + Input parameter: n -> integer: size of sort list +*/ +#include "ccmath.h" +double *x,**v; +void main(int na,char **av) +{ int i,n; + if(na!=2){ printf("para: size\n"); exit(-1);} + n=atoi(*++av); setunfl(123456789); + x=(double *)calloc(n,sizeof(double)); + v=(double **)calloc(n,sizeof(double *)); + printf(" Test of Heap Sort\n"); +/* generate series of random values */ + for(i=0; i integer: size of sort list +*/ +#include "ccmath.h" +void main(int na,char **av) +{ struct llst *st,*t; int i,n; + double *x; struct llst *dat; + unsigned seed; + if(na!=2){ printf("para: size(<=50)\n"); exit(1);} + n=atoi(*++av); seed=123456789L; + x=(double *)calloc(n,sizeof(double)); + dat=(struct llst *)calloc(n,sizeof(struct llst)); + setunfl(seed); + printf(" Test of Merge Sort\n"); + printf(" %d input points\n",n); +/* generate sort list of random numbers */ + for(i=0; ipls=(char *)(x+i); t->pt=t+1; ++t; + } + (t-1)->pt=NULL; + +/* sort the linked list */ + st=msort(st,n,dubcmp); + + printf(" input series sorted series\n"); + for(i=0,t=st; t!=NULL ;++i,t=t->pt) + printf(" %7.3f %7.3f\n",x[i],*(double *)(t->pls)); +} +/* Test output + + Test of Merge Sort + 25 input points + input series sorted series + 0.550 0.009 + 0.071 0.071 + 0.905 0.139 + 0.779 0.152 + 0.009 0.209 + 0.688 0.311 + 0.152 0.328 + 0.209 0.379 + 0.757 0.416 + 0.838 0.418 + 0.790 0.493 + 0.493 0.550 + 0.931 0.688 + 0.963 0.716 + 0.311 0.757 + 0.418 0.779 + 0.821 0.790 + 0.379 0.809 + 0.416 0.821 + 0.920 0.838 + 0.861 0.861 + 0.139 0.905 + 0.328 0.920 + 0.716 0.931 + 0.809 0.963 +*/ diff --git a/sort/test/tqsrt.c b/sort/test/tqsrt.c new file mode 100644 index 0000000..7574609 --- /dev/null +++ b/sort/test/tqsrt.c @@ -0,0 +1,68 @@ +/* tqsrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: qsort dubcmp + + Uses: unfl surand + + Input parameter: n -> integer: size of sort list +*/ +#include "ccmath.h" +double *x,**v; +void main(int na,char **av) +{ int i,n; + if(na!=2){ printf("para: size\n"); exit(-1);} + n=atoi(*++av); setunfl(123456789); + x=(double *)calloc(n,sizeof(double)); + v=(double **)calloc(n,sizeof(double *)); + printf(" Test of Quick Sort\n"); +/* generate sort list of random numbers */ + for(i=0; i integer: size of sort list +*/ +#include "ccmath.h" +double *x,**v; +void main(int na,char **av) +{ int i,n; + if(na!=2){ printf("para: size\n"); exit(-1);} + n=atoi(*++av); setunfl(123456789); + x=(double *)calloc(n,sizeof(double)); + v=(double **)calloc(n,sizeof(double *)); + printf(" Test of Shell Sort\n"); + printf(" %d points input\n",n); +/* generate sort list of random values */ + for(i=0; ikey))==0) return hd; + if(ef<0) hd=hd->pl; else hd=hd->pr; + } + return hd; +} diff --git a/sort/tsort.c b/sort/tsort.c new file mode 100644 index 0000000..8e88428 --- /dev/null +++ b/sort/tsort.c @@ -0,0 +1,16 @@ +/* tsort.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "tree.h" +static int k; +void tsort(struct tnode *hd,struct tnode **ar) +{ if(hd!=NULL){ + tsort(hd->pl,ar); + ar[k++]=hd; + tsort(hd->pr,ar); + } +} diff --git a/statf/gaml.c b/statf/gaml.c new file mode 100644 index 0000000..ece443d --- /dev/null +++ b/statf/gaml.c @@ -0,0 +1,16 @@ +/* gaml.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double gaml(x) +double x; +{ double g,h; + for(g=1.; x<30. ;g*=x,x+=1.); h=x*x; + g=(x-.5)*log(x)-x+.918938533204672-log(g); + g+=(1.-(1./6.-(1./3.-1./(4.*h))/(7.*h))/(5.*h))/(12.*x); + return g; +} diff --git a/statf/pctb.c b/statf/pctb.c new file mode 100644 index 0000000..37ddb3e --- /dev/null +++ b/statf/pctb.c @@ -0,0 +1,34 @@ +/* pctb.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static double te=1.e-9; +double pctb(double pc,double a,double b) +{ double x,y,t,s; + double qbeta(double,double,double),gaml(double),pctn(double); + int nf,k; + if(pc1.-te) return -1.; + if(a>b){ nf= -1; t=a; a=b; b=t; pc=1.-pc;} else nf=1.; + if(a==.5 && b==.5){ y=sin(pc*asin(1.)); return y*y;} + else if(a<1.5){ + if(pc>b/(a+b)){ nf= -nf; t=a; a=b; b=t; pc=1.-pc;} + x=exp((gaml(a+1.)+gaml(b)-gaml(a+b)+log(pc))/a); + if(x==0.) return -1.; + } + else{ + x=pctn(pc); y=1./(a+a-1.); t=1./(b+b-1.); + s=2./(y+t); t-=y; y=(x*x-3.)/6.; x*=sqrt(s+y)/s; + x-=t*(y+(5.-4./s)/6.); x=a/(a+b*exp(2.*x)); + } + y=gaml(a)+gaml(b)-gaml(a+b); k=0; + do{ s=(a-1.)*log(x)+(b-1.)*log(1.-x)-y; + t=pc-qbeta(x,a,b); x+=t/exp(s); ++k; + } + while(fabs(t)>te && k<200); + if(k>=200) return -1.; + if(nf==1.) return x; else return 1.-x; +} diff --git a/statf/pctbn.c b/statf/pctbn.c new file mode 100644 index 0000000..744788f --- /dev/null +++ b/statf/pctbn.c @@ -0,0 +1,23 @@ +/* pctbn.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static double te=1.e-9,tb=1.e-12; +double pctbn(double pc,double a,double b,double d) +{ double x,y,t,df,dx; int k; + double qbnc(double,double,double,double),pctb(double,double,double); + if(pc1.-te) return -1.; + dx=df=b+d; df*=(dx/=b+2.*d); + y=pctb(pc,a,df); x=y/(y+(1.-y)/dx); + if((y=x+1.e-4)>1.) y=1.-te; + t=qbnc(y,a,b,d); dx=x-y; k=0; + do{ df=qbnc(x,a,b,d)-t; t+=df; + y=pc-t; dx*=y/df; x+=dx; ++k; + if(x<=0.) x=tb; else if(x>=1.) x=1.-tb; + }while(fabs(y)>te && k<200); + if(k>=200) return -1.; else return x; +} diff --git a/statf/pctg.c b/statf/pctg.c new file mode 100644 index 0000000..34f8344 --- /dev/null +++ b/statf/pctg.c @@ -0,0 +1,28 @@ +/* pctg.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static double te=1.e-9; +double pctg(double pc,double a) +{ double x,y,s,t; int k; + double qgama(double,double),gaml(double),pctn(double); + if(pc1.-te) return -1.; + if(a<.5){ + x=exp((gaml(a+1.)+log(1.-pc))/a); + if(x==0.) return -1.; + } + else{ + y=pctn(pc); s=1./(9.*a); + s=pow(1.-s+y*sqrt(s),3.); x=a*s; + if(xte && k<200); + if(k>=200) return -1.; else return x; +} diff --git a/statf/pctgn.c b/statf/pctgn.c new file mode 100644 index 0000000..23aa030 --- /dev/null +++ b/statf/pctgn.c @@ -0,0 +1,22 @@ +/* pctgn.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +static double te=1.e-9,tb=1.e-32; +double pctgn(double pc,double a,double d) +{ double x,y,t,df,dx; int k; + double qgnc(double,double,double),pctg(double,double); + if(pc1.-te) return -1.; + dx=df=a+d; df*=(dx/=a+2.*d); + y=pctg(pc,df); x=y/dx; dx=sqrt(a+2.*d)/4.; + if((y=x-dx)<=0.) y=te; + t=qgnc(y,a,d); dx=x-y; k=0; + do{ df=qgnc(x,a,d)-t; t+=df; y=pc-t; ++k; + dx*=y/df; x+=dx; if(x<=0.) x=tb; + }while(fabs(y)>te && k<200); + if(k>=200) return -1.; else return x; +} diff --git a/statf/pctn.c b/statf/pctn.c new file mode 100644 index 0000000..7f95587 --- /dev/null +++ b/statf/pctn.c @@ -0,0 +1,19 @@ +/* pctn.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double pctn(double pc) +{ double t,z,qnorm(double),te=1.e-9; int nf; + if(pc1.-te) return HUGE_VAL; + if(pc>.5){ pc=1.-pc; nf=0;} else nf=1; + t=sqrt(-log(pc*pc)); + z=t-(2.30753+.27061*t)/(1.+(.99229+.04481*t)*t); + do{ if(z>37.5) break; t=pc-qnorm(z); + z-=2.506628274631*t*exp(z*z/2.); } + while(fabs(t)>te); + if(nf) return z; else return -z; +} diff --git a/statf/qbeta.c b/statf/qbeta.c new file mode 100644 index 0000000..942dc0d --- /dev/null +++ b/statf/qbeta.c @@ -0,0 +1,17 @@ +/* qbeta.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double qbeta(double x,double a,double b) +{ double ro,t,ts,f,gaml(double); int nf; + ro=gaml(a)+gaml(b)-gaml(a+b); + if(x<.5) nf=1; else{ x=1.-x; t=a; a=b; b=t; nf=0;} + f=t=exp(a*log(x)+b*log(1.-x)-ro)/a; + for(ts=0.,b+=a-1.; t>1.e-12 || t>ts ;){ + b+=1.; a+=1.; ts=t; t*=x*b/a; f+=t; } + if(nf) return f; else return 1.-f; +} diff --git a/statf/qbnc.c b/statf/qbnc.c new file mode 100644 index 0000000..4d243be --- /dev/null +++ b/statf/qbnc.c @@ -0,0 +1,18 @@ +/* qbnc.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double qbnc(double x,double a,double b,double d) +{ double r,s,t,f,sp; int k; + double qbeta(double,double,double),gaml(double); + r=exp(-d); t=gaml(a)+gaml(b)-gaml(a+b); + t=exp(a*log(x)+b*log(1.-x)-t)/b; + f=s=qbeta(1.-x,b,a); a-=1.; + for(k=1,sp=0.; s*r>1.e-12 || s>sp ;++k){ + sp=s; s=d*(s-t)/k; f+=s; t*=d*(1.-x)*(1.+a/(b+k))/k; } + return 1.-r*f; +} diff --git a/statf/qgama.c b/statf/qgama.c new file mode 100644 index 0000000..d63d7ef --- /dev/null +++ b/statf/qgama.c @@ -0,0 +1,24 @@ +/* qgama.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double qgama(double x,double a) +{ double ap,ro,f,t,gaml(double); int k; + ro=a*log(x)-x-gaml(a); + ap=6.25; if(a>ap) ap=a; t=(x-ap)/(f=sqrt(2.*ap)); + if(x<4.5 || t< -1. || (t< -.5 && a<10.)){ + for(f=t=1.,ap=a; t>1.e-14 ;){ t*=x/(ap+=1.); f+=t;} + return 1.-exp(ro)*f/a; + } + else{ + if(t<0. && a<10.) k=18; + else if(t>3.){ k=ceil(19.-3.*t); if(k<4) k=4;} + else k=6+ceil(f*(2.05-.8*t+.091*t*t)); + for(f=x; k>0 ;){ t=k--; f=x+(t-a)/(1.+t/f);} + return exp(ro)/f; + } +} diff --git a/statf/qgnc.c b/statf/qgnc.c new file mode 100644 index 0000000..dba3f89 --- /dev/null +++ b/statf/qgnc.c @@ -0,0 +1,16 @@ +/* qgnc.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double qgnc(double x,double a,double d) +{ double r,s,t,f,sp,qgama(double,double),gaml(double); int k; + r=exp(-d); t=exp(a*log(x)-x-gaml(a))/a; + f=s=qgama(x,a); + for(k=1,sp=0.; s*r>1.e-12 || s>sp ;++k){ + sp=s; s=d*(t+s)/k; f+=s; t*=d*x/(k*(a+k)); } + return r*f; +} diff --git a/statf/qnorm.c b/statf/qnorm.c new file mode 100644 index 0000000..b13f862 --- /dev/null +++ b/statf/qnorm.c @@ -0,0 +1,20 @@ +/* qnorm.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +double qnorm(double x) +{ double y,ro,f,t; int k,nf; + if(x<0.){ x= -x; nf=0;} else nf=1; + y=x*x; ro=exp(-y/2.)/2.506628274631; + if(x<3.){ f=t=1.; + for(k=1; t>1.e-14 ;){ t*=y/(k+=2); f+=t;} + f=.5-x*ro*f; } + else{ f=x; k=ceil(250./y); if(k<3) k=3; + for(; k>0 ;) f=x+(k--)/f; + f=ro/f; } + if(nf) return f; else return 1.-f; +} diff --git a/statf/test/README b/statf/test/README new file mode 100644 index 0000000..d69da86 --- /dev/null +++ b/statf/test/README @@ -0,0 +1,14 @@ + This directory contains test code for the functions of the 'statf' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. + + The following list specifies the inputs used in the standard + tests, whose output is appended to the test source code as a + comment. + + tbetanc 1.5 3.2 2.0 + tdbeta 1.2 5.7 + tdgama 4.33 + tdnorm no input + tgamanc 3.1 4.2 + diff --git a/statf/test/tbetanc.c b/statf/test/tbetanc.c new file mode 100644 index 0000000..d741055 --- /dev/null +++ b/statf/test/tbetanc.c @@ -0,0 +1,54 @@ +/* tbetanc.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: qbnc pctbn + + Input parameters: a -> real: first distribution parameter + b -> real: second distribution parameter + dsq -> real: noncentrality parameter +*/ +#include "ccmath.h" +#define N 11 +double pct[]={.001,.01,.05,.1,.25,.5,.75,.9,.95,.99,.999}; +void main(int na,char **av) +{ double a,b,dsq,p,z,c; int k; + if(na!=4){ printf("para: pa pb dst\n"); exit(-1);} + printf(" Test of Noncentral Beta Distribution\n"); + a=atof(*++av); b=atof(*++av); dsq=atof(*++av); + printf(" parameters: a= %.3f b= %.3f\n",a,b); + printf(" noncentral dsq = %.3f\n",dsq); + printf(" p Z(p) check\n"); + for(k=0; k real: first distribution parameter + b -> real: second distribution parameter +*/ +#include "ccmath.h" +#define N 11 +double pct[]={.001,.01,.05,.1,.25,.5,.75,.9,.95,.99,.999}; +void main(int na,char **av) +{ double a,b,p,z,c; int k; + if(na!=3){ printf("para: pa pb\n"); exit(-1);} + printf(" Test of Beta Distribution\n"); + a=atof(*++av); b=atof(*++av); + printf(" parameters: a= %.3f b= %.3f\n",a,b); + printf(" p Z(p) check\n"); + for(k=0; k real: distribution parameter +*/ +#include "ccmath.h" +#define N 11 +double pct[]={.001,.01,.05,.1,.25,.5,.75,.9,.95,.99,.999}; +void main(int na,char **av) +{ double a,p,z,c; int k; + if(na!=2){ printf("para: pg\n"); exit(-1);} + printf(" Test of Gamma Distribution\n"); + a=atof(*++av); printf(" parameter = %.3f\n",a); + printf(" p Z(p) check\n"); + for(k=0; k real: gamma distribution parameter + dst -> real: noncentrality parameter +*/ +#include "ccmath.h" +#define N 11 +double pct[]={.001,.01,.05,.1,.25,.5,.75,.9,.95,.99,.999}; +void main(int na,char **av) +{ double a,dsq,p,z,c; int k; + if(na!=3){ printf("para: pg dst\n"); exit(-1);} + printf(" Test of Noncentral Gamma Distribution\n"); + a=atof(*++av); printf(" parameter a= %.3f\n",a); + dsq=atof(*++av); printf(" noncentral dsq = %.3f\n",dsq); + printf(" p Z(p) check\n"); + for(k=0; k){ + if($ln =~ m[Test output] ){ $pp=1; } + if($pp == 1){ print $ln; } +} diff --git a/tseries/arma.h b/tseries/arma.h new file mode 100644 index 0000000..69685af --- /dev/null +++ b/tseries/arma.h @@ -0,0 +1,11 @@ +/* arma.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef NULL +#define NULL ((void *)0) +#endif +struct mcof {double cf; int lag;}; diff --git a/tseries/armaf.h b/tseries/armaf.h new file mode 100644 index 0000000..2133fb5 --- /dev/null +++ b/tseries/armaf.h @@ -0,0 +1,13 @@ +/* armaf.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#ifndef NULL +#define NULL ((void *)0) +#endif +struct mcof {double cf; int lag;}; +struct fmod {int fac; double val;}; + diff --git a/tseries/drfmod.c b/tseries/drfmod.c new file mode 100644 index 0000000..0eba957 --- /dev/null +++ b/tseries/drfmod.c @@ -0,0 +1,53 @@ +/* drfmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "armaf.h" +#include +extern struct mcof *pfc,*par,*pma; +extern int nar,nma,nfc,np,ndif; +static int kst,kd,max,mxm,*kz; static double *pm,*pz; +double drfmod(struct fmod y,double *dr) +{ struct mcof *p,*q; double yp,*pf,*pd,*pl,sa; int j; + yp=sa=(pfc+y.fac)->cf; + for(j=0,pf=dr; jlag)%max)==j) *pf -= p->cf; + } + if(ndif){ pd=pz+2*max+np*mxm; pl=dr+nfc; + for(pf=dr; pflag)%max); + yp += p->cf * *pf++;} + for(p=pma,q=p+nma; plag)%max); + yp += p->cf * *pf++;} + if(nma){ pl=dr+np; + for(pf=dr,pd=pz+2*max; pfcf * *(pd+((kd+p->lag)%mxm)*np); + kd=(kd+mxm-1)%mxm; pd=pz+2*max+np*kd; + for(pf=dr; pflag+1; + if(nma && (mxm=(pma+nma-1)->lag+1)>max) max=mxm; + pz=(double *)calloc(2*max+np*mxm+ndif*(nfc+1),sizeof(double)); + kz=(int *)calloc(max,sizeof(int)); + pm=pz+max; } + else{ free(pz); free(kz);} +} diff --git a/tseries/drmod.c b/tseries/drmod.c new file mode 100644 index 0000000..1c2661c --- /dev/null +++ b/tseries/drmod.c @@ -0,0 +1,42 @@ +/* drmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "arma.h" +#include +extern struct mcof *par,*pma; +extern int nar,nma,np; +static int max,mxm,kst,kd; static double *pz,*pm; +double drmod(double y,double *dr) +{ struct mcof *p,*q; double yp,*pf,*pd,*pl; + yp=0.; pl=dr+np; + for(pf=dr,p=par,q=p+nar; plag)%max); + yp+= p->cf * *pf++; + } + for(p=pma,q=p+nma; plag)%max); + yp+= p->cf * *pf++; + } + if(nma){ + for(pf=dr,pd=pz+2*max; pfcf * *(pd+((kd+p->lag)%mxm)*np); + kd=(kd+mxm-1)%mxm; pd=pz+2*max+np*kd; + for(pf=dr; pflag+1; + if(nma && (mxm=(pma+nma-1)->lag+1)>max) max=mxm; + pz=(double *)calloc(2*max+np*mxm,sizeof(double)); + pm=pz+max; + } + else free(pz); +} diff --git a/tseries/evfmod.c b/tseries/evfmod.c new file mode 100644 index 0000000..aaab800 --- /dev/null +++ b/tseries/evfmod.c @@ -0,0 +1,37 @@ +/* evfmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "armaf.h" +#include +extern struct mcof *par,*pma,*pfc; +extern int nar,nma,nfc,np,ndif; +static int kst,max,*kz; static double *pm,*pz; +double evfmod(struct fmod y) +{ struct mcof *p,*q; double yp,sa,*pd; int j; + yp=sa=(pfc+y.fac)->cf; + if(ndif){ pd=pz+2*max; + for(j=0; jlag)%max) * p->cf; + for(p=pma,q=p+nma; plag)%max) * p->cf; + kst=(kst+max-1)%max; *(pm+kst)=(yp-=y.val); + *(pz+kst)=y.val-sa; *(kz+kst)=y.fac; + return -yp; +} +void setevf(int k) +{ int mxm; + if(k){ max=mxm=kst=0; np=nfc+nma+nar; + if(nar) max=(par+nar-1)->lag+1; + if(nma && (mxm=(pma+nma-1)->lag+1)>max) max=mxm; + pz=(double *)calloc(2*max+ndif,sizeof(double)); + kz=(int *)calloc(max,sizeof(int)); + pm=pz+max; } + else{ free(pz); free(kz);} +} diff --git a/tseries/evmod.c b/tseries/evmod.c new file mode 100644 index 0000000..8478c68 --- /dev/null +++ b/tseries/evmod.c @@ -0,0 +1,31 @@ +/* evmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "arma.h" +#include +extern struct mcof *par,*pma; +extern int nar,nma,np; +static int max,kst; static double *pz,*pm; +double evmod(double y) +{ struct mcof *p,*q; double yp; + for(yp=0.,p=par,q=p+nar; plag)%max) * p->cf; + for(p=pma,q=p+nma; plag)%max) * p->cf; + kst=(kst+max-1)%max; *(pm+kst)=(yp-=y); + *(pz+kst)=y; return -yp; +} +void setev(int k) +{ int mxm; + if(k){ max=mxm=kst=0; np=nma+nar; + if(nar) max=(par+nar-1)->lag+1; + if(nma && (mxm=(pma+nma-1)->lag+1)>max) max=mxm; + pz=(double *)calloc(2*max,sizeof(double)); + pm=pz+max; + } + else free(pz); +} diff --git a/tseries/fixts.c b/tseries/fixts.c new file mode 100644 index 0000000..277dd88 --- /dev/null +++ b/tseries/fixts.c @@ -0,0 +1,36 @@ +/* fixts.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "arma.h" +#include +void setdr(int k); +extern int np; extern struct mcof *par; +double fixts(double *x,int n,double *var,double *cr) +{ double *cp,*p,*q,*r,*s,*pmax; + struct mcof *pp; double e,ssq,drmod(double,double *); + int j,k,psinv(double *,int); + cp=(double *)calloc(np,sizeof(double)); + for(p=var,pmax=p+np*np; pcf += *s++; + } + } + else ssq= -1.; + free(cp); setdr(0); return ssq; +} diff --git a/tseries/fixtsf.c b/tseries/fixtsf.c new file mode 100644 index 0000000..6b96e6f --- /dev/null +++ b/tseries/fixtsf.c @@ -0,0 +1,46 @@ +/* fixtsf.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "armaf.h" +#include +void setdrf(int k); +extern struct mcof *pfc; +extern int nfc,np,ndif; +static void oprj(double *v,int i,int j); +double fixtsf(struct fmod *x,int n,double *var,double *cr) +{ double *cp,*p,*q,*r,*s,*pmax; + struct mcof *pp; double e,ssq,drfmod(struct fmod,double *); + int j,k,psinv(double *,int); + cp=(double *)calloc(np,sizeof(double)); + for(p=var,pmax=p+np*np; pcf += *s++; } } + else ssq= -1.; + free(cp); setdrf(0); return ssq; +} +static void oprj(double *var,int n,int m) +{ double s,*pd,*p; int i,j; + pd=(double *)calloc(n,sizeof(double)); + for(i=0,p=pd,s=0.; icf * *(x-(p->lag+1)); + for(p=pma,q=p+nma; pcf * *(e-(p->lag+1)); + *x=y; *e=0.; + return y; +} diff --git a/tseries/resid.c b/tseries/resid.c new file mode 100644 index 0000000..be9359f --- /dev/null +++ b/tseries/resid.c @@ -0,0 +1,25 @@ +/* resid.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +int resid(double *x,int n,int lag,double **pau,int nbin, + double xa,double xb,int **phs,int *cks) +{ int j,m,*hist(double *,int,double,double,int,double *); + double y,f,s,d,*autcor(double *,int,int),bin; + *pau=autcor(x,n,lag); + *phs=hist(x,n,xa,xb,nbin,&bin); + n=pwspec(x,n,0); + m=n/2; f=2./n; s=m-1; s=sqrt(s); + xa=1.02/s; xb=1.36/s; cks[0]=cks[1]=0; + for(s=y=0.,j=0; jxa){ + ++cks[0]; if(d>xb) ++cks[1]; + } + } + return n; +} diff --git a/tseries/sany.c b/tseries/sany.c new file mode 100644 index 0000000..0d6c572 --- /dev/null +++ b/tseries/sany.c @@ -0,0 +1,44 @@ +/* sany.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "../ccmath.h" +int sany(double *x,int n,double *pm,double *cd,double *ci, + int nd,int ms,int lag) +{ struct complex *pc,*p,**qc,**q; + int j,kk[16]; double *px,sd,si; + *pm=xmean(x,n); + if(nd){ + x[0]=sdiff(x[0],nd,0); + for(j=1,px=x+1; jre*p->re+p->im*p->im; + p=pc; + if(ms){ smoo(x,n,ms); + p->re=x[0]; p->im=1./x[0]; + } + else{ sd=.5*(x[1]+x[n-1]); + p->re=sd; p->im=1./sd; + } + for(j=1,++p; jre=x[j]; p->im=1./x[j]; + } + fftgc(qc,pc,n,kk,'d'); + q=qc; + sd=cd[0]=(*q)->re; si=ci[0]=(*q)->im; + for(j=1,++q; j<=lag ;++j,++q){ + cd[j]=(*q)->re/sd; ci[j]=(*q)->im/si; + } + free(pc); free(qc); + return n; +} diff --git a/tseries/sarma.c b/tseries/sarma.c new file mode 100644 index 0000000..07df984 --- /dev/null +++ b/tseries/sarma.c @@ -0,0 +1,31 @@ +/* sarma.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "arma.h" +#include +extern struct mcof *par,*pma; +extern int nar,nma; +static int kst,max; static double *pz,*pm; +double sarma(double er) +{ struct mcof *p,*q; double y; + for(y=er,p=par,q=p+nar; pcf * *(pz+(kst+p->lag)%max); + for(p=pma,q=p+nma; pcf * *(pm+(kst+p->lag)%max); + kst=(kst+max-1)%max; *(pm+kst)=er; *(pz+kst)=y; + return y; +} +void setsim(int k) +{ int m; + if(k){ kst=max=m=0; + if(nar) max=(par+nar-1)->lag+1; + if(nma && (m=(pma+nma-1)->lag+1)>max) max=m; + pz=(double *)calloc(2*max,sizeof(double)); + pm=pz+max; + } + else free(pz); +} diff --git a/tseries/sdiff.c b/tseries/sdiff.c new file mode 100644 index 0000000..178ec36 --- /dev/null +++ b/tseries/sdiff.c @@ -0,0 +1,23 @@ +/* sdiff.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define MXD 6 +static double f[MXD]; +double sdiff(double y,int nd,int k) +{ double s; + if(k==0) for(k=0; k=0 ;){ + s=f[k]; f[k--]+=y; y=s; } + return f[0]; +} diff --git a/tseries/seqts.c b/tseries/seqts.c new file mode 100644 index 0000000..b90ad7e --- /dev/null +++ b/tseries/seqts.c @@ -0,0 +1,33 @@ +/* seqts.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "arma.h" +#include +void setdr(int k); +extern int np; extern struct mcof *par; +double seqts(double *x,int n,double *var,int kf) +{ double *pd,*pg,*pmax,*p,*q,*h,*f; int j; + struct mcof *pp; + double e,ssq,sig,sqrt(double),drmod(double,double *); + pd=(double *)calloc(2*np,sizeof(double)); pg=pd+np; + if(!kf){ for(p=var,pmax=p+np*np; pcf +=e*(*p++/=sig); + for(kf=0,p=pg,h=var; p +#include +void setdrf(int k); +extern struct mcof *pfc; +extern int nfc,np,ndif; +double seqtsf(struct fmod *x,int n,double *var,int kf) +{ double *pd,*pg,*pmax,*p,*q,*h,*f; int i,j; + struct mcof *pp; + double e,ssq,sig,drfmod(struct fmod,double *); + pd=(double *)calloc(2*np,sizeof(double)); pg=pd+np; + if(kf==0){ e=1./nfc; + for(p=var,i=0; icf+=e*(*p++/=sig); + for(p=pg,h=var,kf=0; p integer: length of series + + control_file -> name of model definition file + + [ ts?.dat -> time series model ] + + outfile -> name of output file + [binary data -> a series size header + and the values of the series] +*/ +#include "ccmath.h" +double *y; +struct mcof *par,*pma; int nar,nma,np; +void main(int na,char **av) +{ double z; FILE *fp,*fo; + int n,i,j,k; unsigned int seed; + struct mcof *pa; char cfl[32],ofl[32]; + if(na!=4){ printf("para: n control_file outfile\n"); exit(-1);} + n=atoi(*++av); + y=(double *)calloc(n,sizeof(*y)); + fp=fopen(*++av,"r"); strcpy(cfl,*av); + fo=fopen(*++av,"wb"); strcpy(ofl,*av); + fscanf(fp,"%d %d",&nar,&nma); np=nar+nma; + par=(struct mcof *)calloc(np,sizeof(*pa)); pma=par+nar; + for(j=0,pa=par; jcf),&(pa->lag)); + pa->lag-=1; + } + fscanf(fp,"%u",&seed); + setnrml(seed); + +/* initialize series simulation */ + setsim(1); n+=25; + for(j=k=0; j=25) y[k++]=z; + + } + +/* write series to output file with size as a header record */ + n-=25; fwrite((void *)&n,sizeof(int),1,fo); + k=fwrite((void *)y,sizeof(double),n,fo); + if(k!=n){ printf("I/O error\n"); exit(1);} + +/* write model specification */ + printf(" control file = %s\n",cfl); + printf(" output file = %s\n",ofl); + printf(" %d points generated\n",n); + printf(" random seed= %u\n",seed); + if(nar){ + printf(" autoregressive parameters and lags\n"); + for(j=0,pa=par; jcf,pa->lag+1); + } + if(nma){ + printf(" moving average paramerers and lags\n"); + for(j=0,pa=pma; jcf,pa->lag+1); + } +} diff --git a/tseries/test/generators/gfarma.c b/tseries/test/generators/gfarma.c new file mode 100644 index 0000000..2760fe1 --- /dev/null +++ b/tseries/test/generators/gfarma.c @@ -0,0 +1,93 @@ +/* gfarma.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: sarma setsim sintg (generate an ARIMA factor model) + + Uses: nrml setnrml bran setbran + + Input parameters: n -> integer: length of generated series + + control_file -> name of input file specifing model + + [ tsf?.dat -> time series factor model ] + + outfile -> name of file for series output + [binary data -> a series size header + and the values of the generated + series] + +*/ +#include "ccmath.h" +struct mcof *pfc,*par,*pma; +int nfc,nar,nma,np,ndif; +struct fmod *y; +void main(int na,char **av) +{ struct mcof *pa; int n,np,i,j,k,m; + double sm,z; unsigned int seed; + FILE *fp,*fout; + char cfl[32],ofl[32]; + if(na!=4){ printf("para: n control_file outfile\n"); exit(-1);} + n=atoi(*++av); + y=(struct fmod *)calloc(n,sizeof(*y)); + fp=fopen(*++av,"r"); strcpy(cfl,*av); + fout=fopen(*++av,"wb"); strcpy(ofl,*av); +/* read model parameters from control file */ + fscanf(fp,"%d %d %d %d",&nfc,&nar,&nma,&ndif); + np=nma+nar+nfc; + pfc=(struct mcof *)calloc(np,sizeof(*pa)); + par=pfc+nfc; pma=par+nar; + for(j=0,pa=pfc; jcf),&(pa->lag)); + pa->lag-=1; + } + fscanf(fp,"%u",&seed); + setnrml(seed); setbran(seed); + +/* initialize series simulation */ + setsim(1); n+=25; + + for(j=0,k=0,sm=0.; j=25){ y[k].fac=m=bran(nfc); + sm+=( y[k++].val=z+(pfc+m)->cf);} + } + +/* write series size header and series values to output file */ + n-=25; fwrite((void *)&n,sizeof(int),1,fout); + k=fwrite((void *)y,sizeof(y[0]),n,fout); + if(k!=n){ printf("I/O error\n"); exit(1);} + +/* write model specification */ + printf(" control file = %s\n",cfl); + printf(" output file = %s\n",ofl); + printf(" %d points generated\n",n); + printf(" random seed= %u\n",seed); + printf(" factor parameters:\n"); + for(j=0,pa=pfc; jcf); + if(nar){ + printf(" autoregressive parameters and lags\n"); + for(j=0,pa=par; jcf,pa->lag+1); + } + if(nma){ + printf(" moving average paramerers and lags\n"); + for(j=0,pa=pma; jcf,pa->lag+1); + } + printf(" difference order = %d\n",ndif); + printf(" series mean = %.4f\n",sm/n); +} diff --git a/tseries/test/tdrfmod.c b/tseries/test/tdrfmod.c new file mode 100644 index 0000000..02811fc --- /dev/null +++ b/tseries/test/tdrfmod.c @@ -0,0 +1,131 @@ +/* tdrfmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: drfmod setdrf + + Uses: sarma setsim sintg sdiff nrml setnrml bran setbran + + Input parameters: n -> integer: length of test series + + model_file -> name of factor model specification + file [ tfs?.dat ] +*/ +#include "ccmath.h" +struct mcof *pfc,*par,*pma; +int nfc,nar,nma,np,ndif; +void main(int na,char **av) +{ struct mcof *pa; int n,i,j; unsigned int seed; + double e,ep,*dr; + FILE *fp; struct fmod y; + if(na!=3){ printf("para: n model_file\n"); exit(-1);} + printf("Test of Factor Model Derivative Computation\n\n"); + n=atoi(*++av); + fp=fopen(*++av,"r"); + printf(" model file: %s\n",*av); + +/* define model parameters */ + fscanf(fp,"%d %d %d %d",&nfc,&nar,&nma,&ndif); np=nfc+nma+nar; + pfc=(struct mcof *)calloc(np,sizeof(*pa)); + dr=(double *)calloc(np,sizeof(*dr)); + par=pfc+nfc; pma=par+nar; + for(j=0,pa=pfc; jcf),&(pa->lag)); + pa->lag-=1; + } + fscanf(fp,"%u",&seed); + printf("Model Definition\n"); + printf("factor parameters\n"); + for(j=0,pa=pfc; jcf); + printf("autoregressive parameters and lags\n"); + for(j=0,pa=par; jcf,pa->lag+1); + printf("moving average paramerers and lags\n"); + for(j=0,pa=pma; jcf,pa->lag+1); + printf("difference order = %d\n",ndif); + +/* initialize simulation */ + setnrml(seed); setbran(seed); + printf(" random seed= %u\n",seed); + printf(" y e ep\n"); + setdrf(1); setsim(1); + +/* generate series and print output */ + for(j=0; jcf; + printf("%8.4f %8.4f ",y.val,e); + if(ndif) y.val=sdiff(y.val,ndif,j); + +/* compute factor model residuals and their derivatives */ + ep=drfmod(y,dr); + + printf("%8.4f\n",ep); + printf(" deriv: "); + for(i=0; i integer: size of time series + + model_file -> name of ARMA model specification + file [ ts?.dat ] +*/ +#include "ccmath.h" +struct mcof *par,*pma; int nar,nma,np; +void main(int na,char **av) +{ struct mcof *pa; int n,i,j; unsigned int seed; + double y,*dr,e; + FILE *fp; + if(na!=3){ printf("para: n model_file\n"); exit(1);} + printf(" Test of Time Series Derivative Computation\n\n"); + n=atoi(*++av); + fp=fopen(*++av,"r"); + printf(" model file: %s\n",*av); + +/* load and print model parameters */ + fscanf(fp,"%d %d",&nar,&nma); np=nar+nma; + par=(struct mcof *)calloc(np,sizeof(*pa)); + dr=(double *)calloc(np,sizeof(*dr)); + pma=par+nar; + printf(" model inputs:\n"); + for(j=0,pa=par; jcf),&(pa->lag)); + printf(" %6.3f %2d ",pa->cf,pa->lag); + if(jlag-=1; + } + +/* initialize series simulation */ + fscanf(fp,"%u",&seed); + setnrml(seed); + printf(" random seed= %u\n",seed); + setdr(1); setsim(1); + +/* simulate series */ + printf(" y e ep derivatives\n"); + for(j=0; j integer: length of generated series + + model_file -> name of factor model specification + file [ tsf?.dat ] +*/ +#include "ccmath.h" +struct mcof *pfc,*pma,*par; +int nfc,nma,nar,np,ndif; +void main(int na,char **av) +{ struct mcof *pa; int n,i,j; unsigned int seed; + double ep,e; + FILE *fp; struct fmod y; + if(na!=3){ printf("para: n model_file\n"); exit(-1);} + printf("Test of Factor Model Residual Computation\n\n"); + n=atoi(*++av); + fp=fopen(*++av,"r"); + printf(" model file: %s\n",*av); + +/* load and print model parameters */ + fscanf(fp,"%d %d %d %d",&nfc,&nar,&nma,&ndif); + np=nfc+nma+nar; + pfc=(struct mcof *)calloc(np,sizeof(*pa)); + par=pfc+nfc; pma=par+nar; + for(j=0,pa=pfc; jcf),&(pa->lag)); + pa->lag-=1; + } + fscanf(fp,"%u",&seed); + printf("Model Definition\n"); + printf("factor parameters\n"); + for(j=0,pa=pfc; jcf); + printf("autoregressive parameters and lags\n"); + for(j=0,pa=par; jcf,pa->lag+1); + printf("moving average paramerers and lags\n"); + for(j=0,pa=pma; jcf,pa->lag+1); + printf("difference order = %d\n",ndif); + +/* initialize model simulation */ + setnrml(seed); setbran(seed); + printf(" random seed= %u\n",seed); + printf("\n y e ep\n"); + setevf(1); setsim(1); + +/* generate series */ + for(j=0; jcf; + printf("%8.4f %8.4f",y.val,e); + if(ndif) y.val=sdiff(y.val,ndif,j); + +/* compute factor model residual */ + ep=evfmod(y); + + printf(" %8.4f\n",ep); + } +} +/* Test output + +Test of Factor Model Residual Computation + + model file: data/tfs0.dat +Model Definition +factor parameters +0.000000 +1.000000 +autoregressive parameters and lags +0.800000 1 +-0.400000 2 +moving average paramerers and lags +-0.500000 1 +difference order = 0 + random seed= 123456789 + + y e ep + 0.4557 0.4557 0.4557 + 0.1390 -0.4533 -0.4533 + 1.3600 1.6577 1.6577 + 2.1398 -0.7214 -0.7214 + -0.7648 -0.7719 -0.7719 + -0.6631 -0.2094 -0.2094 + -1.2447 -1.1154 -1.1154 + -1.2243 -0.5361 -0.5361 + -0.0809 0.0687 0.0687 + 1.3078 1.2485 1.2485 + 1.8571 -0.2458 -0.2458 + 0.9831 0.1434 0.1434 + -0.9531 -1.0685 -1.0685 + -1.1122 0.5778 0.5778 + 1.1801 0.3996 0.3996 + 0.7392 -0.0495 -0.0495 + 2.8812 1.3866 1.3866 + 3.1287 0.2262 0.2262 + 1.2667 -0.7969 -0.7969 + -0.3193 0.7173 0.7173 + 1.8082 1.8117 1.8117 + 2.9950 -0.4851 -0.4851 + 1.6924 0.0622 0.0622 + 0.8790 1.0920 1.0920 + 0.4248 -1.5475 -1.5475 + -1.2122 -0.6268 -0.6268 + -3.2803 -1.4272 -1.4272 + -1.4864 0.9666 0.9666 + 1.4548 -0.1515 -0.1515 + 2.1863 1.3036 1.3036 +*/ diff --git a/tseries/test/tevmod.c b/tseries/test/tevmod.c new file mode 100644 index 0000000..b5b83a6 --- /dev/null +++ b/tseries/test/tevmod.c @@ -0,0 +1,100 @@ +/* tevmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: evmod setev + + Uses: sarma setsim nrml setnrml + + Input parameters: n -> integer: length of timseries + + model_file -> name of ARMA model specification + file [ ts?.dat ] +*/ +#include "ccmath.h" +struct mcof *par,*pma; int nar,nma,np; +void main(int na,char **av) +{ struct mcof *pa; int n,j; unsigned int seed; + double y,e; + FILE *fp; + if(na!=3){ printf("para: n model_file\n"); exit(-1);} + printf(" Test of Time Series Residual Computation\n\n"); + n=atoi(*++av); + fp=fopen(*++av,"r"); + printf(" model file: %s\n",*av); + +/* load and print model parameters */ + fscanf(fp,"%d %d",&nar,&nma); np=nar+nma; + par=(struct mcof *)calloc(np,sizeof(*pa)); + pma=par+nar; + printf(" model inputs:\n"); + for(j=0,pa=par; jcf),&(pa->lag)); + printf("%6.3f %2d ",pa->cf,pa->lag); + if(jlag-=1; + } + fscanf(fp,"%u",&seed); + +/* initialize model simulation */ + setnrml(seed); + printf(" random seed= %u\n",seed); + setev(1); setsim(1); + +/* generate series */ + printf(" y e ep\n"); + for(j=0; j name of file of model initialization data + + ser_fl -> name of binary factor model time series + data file [ created by gfarma ] + + Prompted input: at prompt ' (s,f) q->quit ' + enter s for a sequential parameter update + f for a gauss-newton parameter update + q to terminate estimation + + at prompt ' save residuals? (y/n) ' + enter y to save residuals to a file + n to exit without saving residuals +*/ +#include "ccmath.h" +#include +struct mcof *pfc,*par,*pma; +int nfc,nar,nma,np,ndif; +struct fmod *x; int nmax; +void main(int na,char **av) +{ double *var,*cr; + struct mcof *pp; + double ssq,sig,ev,*pe; + int n,j,k; FILE *fm,*fs; + char fnam[32],cs[4]; + if(na!=3){ printf("para: mod_fl ser_fl\n"); exit(-1);} + fm=fopen(*++av,"r"); + printf(" model file: %s\n",*av); + +/* enter model initialization data */ + fscanf(fm,"%d %d %d %d",&nfc,&nar,&nma,&ndif); + np=nfc+nar+nma; + +/* allocate store for madel parameters and variance */ + pfc=(struct mcof *)calloc(np,sizeof(*pfc)); + par=pfc+nfc; pma=par+nar; + var=(double *)calloc(np*np+np,sizeof(*var)); + cr=var+np*np; + for(j=0,pp=pfc; jcf); + } + for(; jlag); pp->lag-=1; + } + for(; jlag); pp->lag-=1; + } + fclose(fm); + printf(" Model Structure\n"); + printf(" %d initial factor parameters\n",nfc); + for(j=0,pp=pfc; jcf); + printf("\n"); + if(nar){ + printf(" %d ar para. at lags",nar); + for(j=0,pp=par; jlag+1); + printf("\n"); + } + if(nma){ + printf(" %d ma para. at lags",nma); + for(j=0,pp=pma; jlag+1); + printf("\n"); + } + printf(" difference order = %d\n",ndif); + +/* read factor model time series data */ + strcpy(fnam,*++av); fs=fopen(fnam,"rb"); + printf(" data file: %s\n",fnam); + fread((void *)&nmax,sizeof(int),1,fs); + x=(struct fmod *)calloc(nmax,sizeof(*x)); + n=fread((char *)x,sizeof(x[0]),nmax,fs); + +/* difference input series if required */ + if(ndif){ + for(j=k=0; j=0){ x[k].val=ev; x[k++].fac=x[j].fac;} + } + n-=ndif; + } + printf(" %d points used in fit\n\n",n); + +/* start interactive estimation sequence */ + for(j=0; ;++j){ + fprintf(stderr," (s/f) q->quit "); + if(*gets(cs)=='q') break; + +/* sequential estimation step */ + if(cs[0]=='s') ssq=seqtsf(x,n,var,j); + +/* gauss-newton estimation step */ + else ssq=fixtsf(x,n,var,cr); + + printf("%d ssq= %8.3f ",j,ssq); + if(cs[0]=='s') printf("seq.\n"); else printf("fix\n"); + printf(" p_vec: "); + for(pp=pfc,k=0; kcf); +/* compute maximum eigenvalue and vector of parameter variance */ + ev=evmax(var,cr,np)*sqrt(ssq/(n-np)); + printf("\n max ev and vector : %9.6f\n",ev); + matprt(cr,1,np," %.3f"); + printf("\n"); + } + printf(" final state:\n"); + printf(" ssq = %8.3f\n",ssq); + printf(" p_vec: "); + for(pp=pfc,k=0; kcf); + printf("\n"); + sig=sqrt(ssq/(n-np)); printf(" rms e = %8.5f\n",sig); + for(k=0; k name of input file + [ created by gfarma ] + + test output generated using data/tfs0.b +*/ +#include "ccmath.h" +void main(int na,char **av) +{ FILE *fin; int i,j,k,n,m; char xl[4]; + struct fmod y[20]; + if(na!=2){ printf("para: binary_input_file\n"); exit(1);} + fin=fopen(*++av,"rb"); + fread((void *)&n,sizeof(int),1,fin); + +/* read and print series in blocks of 20 */ + printf(" series length = %d\n",n); + fprintf(stderr,"enter: q or Q to quit\n"); + for(j=0,m=20;;){ + k=fread((void *)y,sizeof(struct fmod),m,fin); + for(i=0; i name of model initialization file + + ser_fl -> name of binary ARMA time series + data file [ created by garma ] + + Prompted input: at prompt ' (s,f) q->quit ' + enter s for a sequential parameter update + f for a gauss-newton parameter update + q to terminate estimation + + at prompt ' save residuals? (y/n) ' + enter y to save residuals to a file + n to exit without saving residuals +*/ +#include "ccmath.h" +#include +double *x,*var,*cr; +struct mcof *par,*pma; int nar,nma,np; +double *x; int nmax; +void main(int na,char **av) +{ struct mcof *pp; double ssq,sig,ev; + int n,j,k; FILE *fm,*fs; + char fnam[32],cs[4]; + if(na!=3){ printf("para: mod_fl ser_fl\n"); exit(-1);} + fm=fopen(*++av,"r"); printf(" model file: %s\n",*av); + +/* model initialization */ + fscanf(fm," %d %d",&nar,&nma); + np=nar+nma; +/* size model parameter and variance arrays */ + par=(struct mcof *)calloc(np,sizeof(*par)); pma=par+nar; +/* store for variance eigenvalues and vectors */ + var=(double *)calloc(np*np+np,sizeof(double)); + cr=var+np*np; + printf(" model structure:\n"); + for(j=0,pp=par; jlag)); + printf(" ar at lag %d\n",pp->lag); + pp->lag-=1; ++pp; + } + for(j=0; jlag)); + printf(" ma at lag %d\n",pp->lag); + pp->lag-=1; ++pp; + } + fclose(fm); + +/* read series file */ + strcpy(fnam,*++av); fs=fopen(fnam,"rb"); + printf(" data file: %s\n",fnam); + fread((void *)&nmax,sizeof(int),1,fs); + x=(double *)calloc(nmax,sizeof(double)); + n=fread((char *)x,sizeof(x[0]),nmax,fs); + printf(" %d points input\n\n",n); + +/* start interactive estimation of model parameters */ + for(j=0; ;++j){ + fprintf(stderr," (s,f) q->quit "); + if(*gets(cs)=='q') break; + +/* sequential estimation step */ + if(cs[0]=='s') ssq=seqts(x,n,var,j); +/* gauss-newton estimation step */ + else ssq=fixts(x,n,var,cr); + + printf(" step %d ssq= %8.3f %s\n",j,ssq,cs); + printf(" p_vec: "); + for(pp=par,k=0; kcf); + printf("\n"); +/* compute maximum eigenvalue and vector of parameter variance */ + ev=evmax(var,cr,np)*sqrt(ssq/(n-np)); + printf(" ev_max= %.9.6f and vector:\n",ev); + matprt(cr,1,np," %.3f"); + printf("\n"); + } + printf(" final state:\n"); + printf(" ssq= %8.3f\n",ssq); + printf(" final p_vec: "); + for(pp=par,k=0; kcf); + printf("\n"); + sig=sqrt(ssq/(n-np)); printf(" rms e= %8.5f\n",sig); + for(k=0; k name of file specifying an ARMA + time series model [ ts?.dat ] +*/ +#include "ccmath.h" +struct mcof *par,*pma; int nar,nma,np; +double x[50],e[50]; +void main(int na,char **av) +{ struct mcof *pa; int n,i,j,j1; + double y; unsigned int seed; + FILE *fp; + if(na!=2){ printf("para: model_file\n"); exit(-1);} + printf(" Test of Time Series Prediction\n\n"); + fp=fopen(*++av,"r"); + printf(" model file: %s\n",*av); + +/* load and print model data */ + fscanf(fp,"%d %d",&nar,&nma); np=nar+nma; + par=(struct mcof *)calloc(np,sizeof(*pa)); + pma=par+nar; + printf(" model inputs:\n"); + for(j=0,pa=par; jcf),&(pa->lag)); + printf(" %6.3f %2d ",pa->cf,pa->lag); + if(jlag-=1; + } + +/* initialize series simulation */ + fscanf(fp,"%u",&seed); + setnrml(seed); + printf(" random seed= %u\n",seed); + setsim(1); n=45; + printf(" x e p1"); + printf(" p2 p3\n"); + +/* generate series */ + for(j=0; j=25){ + printf(" %10.6f %10.6f",x[j],e[j]); + for(i=1,j1=j+i; i<4 ;++i){ + +/* compute one step predictions of the series */ + y=parma(x+j1,e+j1); ++j1; + + printf(" %10.6f",y); + } + printf("\n"); + } + } +} +/* Test output + + Test of Time Series Prediction + + model file: data/ts2.dat + model inputs: + 0.800 1 ar + 0.400 1 ma + random seed= 2137714571 + x e p1 p2 p3 + -0.175885 -0.140701 -0.084428 -0.067542 -0.054034 + 0.797082 0.881509 0.285062 0.228049 0.182439 + -0.930649 -1.215710 -0.258235 -0.206588 -0.165270 + 1.001739 1.259974 0.297402 0.237922 0.190337 + 0.769070 0.471668 0.426589 0.341271 0.273017 + -0.003327 -0.429916 0.169305 0.135444 0.108355 + -0.833684 -1.002989 -0.265752 -0.212601 -0.170081 + -1.325153 -1.059402 -0.636362 -0.509090 -0.407272 + -0.377461 0.258901 -0.405529 -0.324423 -0.259539 + 0.495890 0.901419 0.036144 0.028915 0.023132 + -1.701646 -1.737790 -0.666201 -0.532961 -0.426369 + -0.497855 0.168346 -0.465622 -0.372498 -0.297998 + 0.780821 1.246443 0.126079 0.100863 0.080691 + 0.034823 -0.091256 0.064361 0.051489 0.041191 + -0.284627 -0.348988 -0.088106 -0.070485 -0.056388 + -0.486986 -0.398880 -0.230037 -0.184030 -0.147224 + -0.563082 -0.333045 -0.317247 -0.253798 -0.203038 + -0.658024 -0.340776 -0.390108 -0.312087 -0.249669 + -0.229034 0.161074 -0.247657 -0.198126 -0.158500 + -3.308820 -3.061163 -1.422591 -1.138073 -0.910458 +*/ diff --git a/tseries/test/tresid.c b/tseries/test/tresid.c new file mode 100644 index 0000000..ec27b18 --- /dev/null +++ b/tseries/test/tresid.c @@ -0,0 +1,121 @@ +/* tresid.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: resid (analysis of time series model residuals) + + Input parameter: dfile -> name of binary file containing time + series model residual data + [created by tmest or tfmest] + + Prompted inputs: at prompt 'lags / ' + enter lag -> integer: maximum lag for + autocorrelation + computation + + at prompt 'xmin xmax bins ? ' + enter xmin -> minimum for residual histogram + xmax -> maximum for residual histogram + nb -> number of histogram bins + + at prompt ' Print Power Spectra ? (y/n) ' + enter y to print the power spectra + n for no power spectra output +*/ +#include "ccmath.h" +double *x; int nmax; +void main(int na,char **av) +{ int j,n,lag,nb,*ph,cks[2]; + double xa,xb,d,*pac; + FILE *fp; char cfg[4]; + if(na!=2){ printf("para: dfile\n"); exit(-1);} + fprintf(stderr,"lags ? "); scanf("%d",&lag); + fprintf(stderr,"xmin xmax bins ? "); + scanf("%lf %lf %d",&xa,&xb,&nb); + +/* read residual data file */ + fp=fopen(*++av,"rb"); + printf(" input file: %s\n",*av); + fread((void *)&nmax,sizeof(int),1,fp); + x=(double *)calloc(nmax,sizeof(*x)); + n=fread((void *)x,sizeof(double),nmax,fp); + printf(" series size= %d\n",n); + +/* perform analysis of model residuals */ + n=resid(x,n,lag,&pac,nb,xa,xb,&ph,cks); + + printf(" second moment= %10.5f\n",pac[0]); + printf(" lag autocorrelation\n"); + for(j=1; j<=lag ;++j) printf(" %2d %10.6f\n",j,pac[j]); + printf("\n series histogram\n"); + d=(xb-xa)/nb; + for(j=0; j\n\n",ph[-1],ph[nb]); + printf(" Kolmogorov-Smirnov Test\n"); + printf(" %d outside .25 bounds\n",cks[0]); + printf(" %d outside .05 bounds\n\n",cks[1]); + fprintf(stderr,"Print Power Spectra ? (y/n) "); + scanf("%s",cfg); + if(cfg[0]=='y'){ + printf("\n Power Spectra\n"); + for(j=0,n/=2; j + + Kolmogorov-Smirnov Test + 0 outside .25 bounds + 0 outside .05 bounds + +*/ diff --git a/tseries/test/tsany.c b/tseries/test/tsany.c new file mode 100644 index 0000000..2aefe5f --- /dev/null +++ b/tseries/test/tsany.c @@ -0,0 +1,93 @@ +/* tsany.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: sany (Time series structure analysis.) + + Input parameter: input_file -> name of binary input file containing + time series data + [ format identical to output files + of garma ] + + Prompted input: at prompt 'diff-order m_smoo lags ? ' + enter nd -> integer: order of time series + differencing + m_smoo -> integer: degree of spectral + smoothing + lags -> integer: maximum lag used in + autocorrelation analysis +*/ +#include "ccmath.h" +#include +double *x; +int nmax; +void main(int na,char **av) +{ int j,n,nd,ms,lag; double xm; + double *cd,*ci; FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + printf(" Time Series Autocorrelation Analysis\n"); + fp=fopen(*++av,"rb"); + printf(" input file: %s\n", *av); + fread((void *)&nmax,sizeof(int),1,fp); + x=(double *)calloc(nmax,sizeof(*x)); + n=fread((char *)x,sizeof(double),nmax,fp); + printf(" %d points input\n\n",n); +/* prompted input of analysis parameters */ + fprintf(stderr,"diff_ord m_smoo lags ? "); + scanf("%d %d %d",&nd,&ms,&lag); + cd=(double *)calloc(2*(lag+1),sizeof(*cd)); + ci=cd+lag+1; + +/* autocorrelation analysis (direct and inverse) of time series */ + n=sany(x,n,&xm,cd,ci,nd,ms,lag); + +/* print analysis output */ + printf(" difference order = %d\n",nd); + printf(" series mean = %11.6f\n",xm); + printf(" 2nd moments: d= %11.6f i= %11.6f\n",cd[0],ci[0]); + if(nd) printf(" difference order = %d\n",nd); + if(ms) printf(" degree of smoothing = %d\n",2*ms+1); + printf(" autocorrelation sigma = %.3f\n",sqrt(1./n)); + printf("direct and inverse autocorrelations:\n"); + printf(" lag ac iac\n"); + for(j=1; j<=lag ;++j) + printf(" %2d %6.3f %6.3f\n",j,cd[j],ci[j]); +} +/* Test output + + Time Series Autocorrelation Analysis + input file: data/ts0.b + 400 points input + + difference order = 0 + series mean = -0.076884 + 2nd moments: d= 0.004257 i= 842.337984 + degree of smoothing = 5 + autocorrelation sigma = 0.050 +direct and inverse autocorrelations: + lag ac iac + 1 0.406 -0.465 + 2 -0.316 0.287 + 3 -0.531 0.127 + 4 -0.233 -0.048 + 5 0.109 0.096 + 6 0.250 -0.077 + 7 0.141 0.065 + 8 0.016 -0.037 + 9 -0.083 0.034 + 10 -0.107 -0.062 + 11 -0.066 0.141 + 12 0.032 -0.132 + 13 0.011 0.085 + 14 -0.007 -0.004 + 15 0.016 -0.061 + 16 0.042 0.045 + 17 0.043 -0.069 + 18 -0.003 -0.015 + 19 -0.039 0.011 + 20 -0.010 -0.076 +*/ diff --git a/tseries/test/tsarma.c b/tseries/test/tsarma.c new file mode 100644 index 0000000..f64908b --- /dev/null +++ b/tseries/test/tsarma.c @@ -0,0 +1,84 @@ +/* tsarma.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: sarma setsim + + Uses: nrml setnrml + + Input parameters: n -> integer: length of series + + model_file -> name of ARMA model specification + file [ ts?.dat ] +*/ +#include "ccmath.h" +struct mcof *par,*pma; int nar,nma,np; +void main(int na,char **av) +{ struct mcof *pa; int n,i,j; + double y,e; unsigned int seed; + FILE *fp; + if(na!=3){ printf("para: n model_file\n"); exit(-1);} + printf(" Test of Time Series Simulation Generator\n"); + n=atoi(*++av); + fp=fopen(*++av,"r"); + printf(" model file: %s\n",*av); + +/* load and print model data */ + fscanf(fp,"%d %d",&nar,&nma); np=nar+nma; + par=(struct mcof *)calloc(np,sizeof(*pa)); + pma=par+nar; + printf(" inputs:\n"); + for(j=0,pa=par; jcf),&(pa->lag)); + printf(" %6.3f %2d ",pa->cf,pa->lag); + if(jlag-=1; + } + +/* initialize model generator */ + fscanf(fp,"%u",&seed); + setnrml(seed); + printf(" random seed= %u\n",seed); + setsim(1); + +/* generate ARMA series values */ + printf(" y e\n"); + for(j=0; j integer: order of differencing + and integration + bin_file -> name of binary series input file + [ created by garma ] +*/ +#include "ccmath.h" +void main(int na,char **av) +{ double *y,*d,z; + int j,n,nd; FILE *fp; + if(na!=3){ printf("para: n_diff bin_file\n"); exit(-1);} + nd=atoi(*++av); fp=fopen(*++av,"rb"); + printf(" Test of Time Series Differencing and Integration\n"); + printf(" model file: %s\n",*av); + printf(" difference/integration order= %d\n",nd); + fread((void *)&n,sizeof(int),1,fp); + y=(double *)calloc(2*n,sizeof(double)); d=y+n; + fread((void *)y,sizeof(double),n,fp); + +/* difference the series */ + for(j=0; j name of binary ARMA time series + file [ created by garma ] + + Test output from: data/ts0.b +*/ +#include "ccmath.h" +void main(int na,char **av) +{ FILE *fp; double y[20]; + int i,j,k,n,m; char lx[4]; + if(na!=2){ printf("para: binary_in_file\n"); exit(-1);} + fp=fopen(*++av,"rb"); + fread((void *)&n,sizeof(int),1,fp); + printf(" length of ARMA series = %d\n",n); + +/* read and display series in blocks of 20 */ + fprintf(stderr,"enter q or Q to quit\n"); + for(m=20,j=0;;){ + k=fread((void *)y,sizeof(y[0]),m,fp); + for(i=0; i name of binary ARMA series file + [ created by garma ] +*/ +#include "ccmath.h" +void main(int na,char **av) +{ double *x,*y,xm,x0; + int nm,n,j; FILE *fp; + if(na!=2){ printf("para: bin_file\n"); exit(-1);} + fp=fopen(*++av,"rb"); + fread((void *)&nm,sizeof(int),1,fp); + x=(double *)calloc(2*nm,sizeof(double)); + n=fread((char *)x,sizeof(double),nm,fp); + if(n!=nm){ printf("I/O error\n"); exit(1);} + printf(" Test of ARMA Series Mean Extraction\n"); + printf(" model file: %s\n",*av); + for(j=0,y=x+n,x0=0.; j>=1){ + if(x&t) printf("1"); else printf("0");} + printf("\n"); +} + +void bitps(unsigned short x) +{ unsigned short t; int j,m; + m=sizeof(short)<<3; t=1<<(m-1); + for(j=0; j>=1){ + if(x&t) printf("1"); else printf("0");} + printf("\n"); +} + +void bitpl(unsigned int x) +{ unsigned int t; int j,m; + m=sizeof(int)<<3; t=1L<<(m-1); + for(j=0; j>=1){ + if(x&t) printf("1"); else printf("0");} + printf("\n"); +} + +void bitpf(float x) +{ unsigned char t,u,*p; int j,m; + m=sizeof(float); t=u=0x80; + p=(unsigned char *)&x; + p+=m-1; m<<=3; + for(j=0; j>=1)==0){ t=u; --p;} + } + printf("\n"); +} + +void bitpd(double x) +{ unsigned char t,u,*p; int j,m; + m=sizeof(double); t=u=0x80; + p=(unsigned char *)&x; + p+=m-1; m<<=3; + for(j=0; j>=1)==0){ t=u; --p;} + } + printf("\n"); +} diff --git a/util/bpatx.c b/util/bpatx.c new file mode 100644 index 0000000..f21219a --- /dev/null +++ b/util/bpatx.c @@ -0,0 +1,20 @@ +/* bpatx.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +void bpatx(struct xpr x) +{ unsigned short t,u; int j,k,m; + m=sizeof(x)<<3; t=u=0x8000; + for(j=k=0; j>=1)==0){ t=u; ++k;} + } + printf("\n"); +} diff --git a/util/lbits.c b/util/lbits.c new file mode 100644 index 0000000..ad5df52 --- /dev/null +++ b/util/lbits.c @@ -0,0 +1,21 @@ +/* lbits.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +unsigned int lbset(unsigned int x,int n) +{ unsigned int t=01; + t<<=n; return (x|t); +} +int lbget(unsigned int x,int n) +{ unsigned int t=01L; + t<<=n; if(x&t) return 1; else return 0; +} +int lbcnt(unsigned int x) +{ int c=0; + if(x) ++c; + while((x=x&(x-1))!=0) ++c; + return c; +} diff --git a/util/pwr.c b/util/pwr.c new file mode 100644 index 0000000..8d02563 --- /dev/null +++ b/util/pwr.c @@ -0,0 +1,14 @@ +/* pwr.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +double pwr(double y,int n) +{ double s=1.; unsigned m,j; + if(n){ if(n<0){ m= -n; y=1./y;} else m=n; + for(j=1; j<=m ;j<<=1){ if(j&m) s*=y; y*=y;} + } + return s; +} diff --git a/util/test/README b/util/test/README new file mode 100644 index 0000000..b3e3052 --- /dev/null +++ b/util/test/README @@ -0,0 +1,5 @@ + This directory contains test code for the functions of the 'util' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. + + No command line parameters are required for these tests. diff --git a/util/test/tbits.c b/util/test/tbits.c new file mode 100644 index 0000000..2d286e8 --- /dev/null +++ b/util/test/tbits.c @@ -0,0 +1,35 @@ +/* tbits.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: bset bget bcnt +*/ +#include "ccmath.h" +void main(void) +{ unsigned short n,x,m; + m=sizeof(m)<<3; +/* set bits */ + for(x=n=0; n9) break; + if(pn[0]){ if(!pfg) ++dex; } + else{ + lshift(1,pn,m); + for(j=0; j=pn ;){ + n+= *pa; n+= *pb--; *pa-- = n; n>>=16; + } + if(pfg) --dex; + } + } + bex=bias+max_p-1; + for(j=0; j9) break; + j<<=1; m=j; j<<=2; j+=c+m; + } + if(sfg) j= -j; + dex+=j; + } + if(dex) s=xmul(s,xpwr(ten,dex)); + return s; +} diff --git a/xarm/constant.h b/xarm/constant.h new file mode 100644 index 0000000..a1d19f9 --- /dev/null +++ b/xarm/constant.h @@ -0,0 +1,24 @@ +/* constant.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=2,k_tanh=5; +int ms_exp=21,ms_hyp=25,ms_trg=31; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={0x0,0x0}; +struct xpr one={0x3fff,0x8000}; +struct xpr two={0x4000,0x8000}; +struct xpr ten={0x4002,0xa000}; +struct xpr x_huge={0x7fff,0x0}; +struct xpr pi4={0x3FFE,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; +struct xpr pi2={0x3FFF,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; +struct xpr pi={0x4000,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; +struct xpr ee={0x4000,0xADF8,0x5458,0xA2BB,0x4A9A,0xAFDC,0x5620,0x273D}; +struct xpr ln2={0x3FFE,0xB172,0x17F7,0xD1CF,0x79AB,0xC9E3,0xB398,0x3F3}; +struct xpr srt2={0x3FFF,0xB504,0xF333,0xF9DE,0x6484,0x597D,0x89B3,0x754B}; diff --git a/xarm/prxpr.c b/xarm/prxpr.c new file mode 100644 index 0000000..2e4e699 --- /dev/null +++ b/xarm/prxpr.c @@ -0,0 +1,36 @@ +/* prxpr.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include +#include "xpre.h" +static double ltn2=.3010299956639812; +static int q[5*XDIM+4]; +void prxpr(struct xpr u,int lim) +{ int *p=q,k,m=0; + unsigned short *pa=(unsigned short *)&u; + if((*pa&m_sgn)){ *pa^=m_sgn; printf(" -");} else printf(" "); + if(*pa==0){ printf("0."); for(k=0; k=5) ++(*p); + while(*p==10){ *p=0; ++(*--p);} } + p=q; if(*p==0) ++p; else ++m; printf("%d.",*p++); + for(k=0; k=0) printf("e+%d\n",m); else printf("e%d\n",m); +} +void xprint(struct xpr u) +{ int i; + printf("%04x.",u.nmm[0]); + for(i=0; i15){ *p= -1; return s;} else if(e<0){ *p=0; return s;} + *p= *pb>>(15-e); lshift(++e,pb,XDIM); *pa-=e; + for(e=0; *pb==0 && e>n;} + *pm++ = *pa<pm ;){ *pc=(*pa--)>>m; *pc-- |= *pa<>m; + } + while(pc>=pm) *pc-- =0; +} diff --git a/xarm/supp/big-end/README b/xarm/supp/big-end/README new file mode 100644 index 0000000..08063a8 --- /dev/null +++ b/xarm/supp/big-end/README @@ -0,0 +1,5 @@ + The C-code and header files in this directory is used + in the 'xarm' library segment on a platform with + big-endian byte ordering (such as most UNIX workstations). + Simply replace the little-endian source files with these + source files if your target is a big-endian machine. diff --git a/xarm/supp/big-end/xfmod.c b/xarm/supp/big-end/xfmod.c new file mode 100644 index 0000000..3c7f178 --- /dev/null +++ b/xarm/supp/big-end/xfmod.c @@ -0,0 +1,26 @@ +/* xfmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xfmod(struct xpr s,struct xpr t,int *p) +{ struct xpr h; unsigned short *q,*ph; short k; + h=xdiv(s,t); ph=(unsigned short *)&h; k=(*ph&m_exp)-bias; + if(k>=0){ rshift(31-k,ph+1,2); + q=(unsigned short *)p; + *q= *(ph+1); *(q+1)= *(ph+2); + } + else *p=0; + if(*p){ if(*ph&m_sgn) s=xadd(s,xmul(t,inttox(*p)),0); + else s=xadd(s,xmul(t,inttox(*p)),1); + } + return s; +} +struct xpr xfrex(struct xpr s,int *p) +{ unsigned short *ps=(unsigned short *)&s,u; + *p=(*ps&m_exp)-bias+1; u= *ps&m_sgn; + *ps=bias-1; *ps|=u; return s; +} diff --git a/xarm/supp/big-end/xpre.h b/xarm/supp/big-end/xpre.h new file mode 100644 index 0000000..810c9ec --- /dev/null +++ b/xarm/supp/big-end/xpre.h @@ -0,0 +1,52 @@ +/* xpre.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define XDIM 7 +struct xpr {unsigned short nmm[XDIM+1];}; +extern unsigned short m_sgn,m_exp; +extern short bias; +extern int itt_div,k_tanh; +extern int ms_exp,ms_trg,ms_hyp; +extern short max_p,k_lin; +extern short d_bias,d_max,d_lex; +extern struct xpr zero,one,two,ten; +extern struct xpr x_huge; +extern struct xpr pi,pi2,pi4; +extern struct xpr ee,srt2,ln2; +struct xpr xadd(struct xpr a,struct xpr b,int k); +struct xpr xmul(struct xpr s,struct xpr t); +struct xpr xdiv(struct xpr s,struct xpr t); +struct xpr atox(char *s); +struct xpr dubtox(double y); +struct xpr inttox(int n); +int xprcmp(struct xpr *p,struct xpr *q); +int neg(struct xpr *p); +int xex(struct xpr *p); +struct xpr sfmod(struct xpr t,int *p); +struct xpr xpwr(struct xpr s,int n); +struct xpr xpr2(struct xpr s,int n); +struct xpr xneg(struct xpr s); +struct xpr xabs(struct xpr s); +struct xpr xfrex(struct xpr s,int *p); +struct xpr xfmod(struct xpr s,struct xpr t,int *p); +double xtodub(struct xpr s); +struct xpr xtan(struct xpr x); +struct xpr xsin(struct xpr x); +struct xpr xcos(struct xpr x); +struct xpr xatan(struct xpr a); +struct xpr xasin(struct xpr a); +struct xpr xacos(struct xpr a); +struct xpr xsqrt(struct xpr u); +struct xpr xexp(struct xpr u); +struct xpr xlog(struct xpr u); +struct xpr xtanh(struct xpr v); +struct xpr xsinh(struct xpr v); +struct xpr xcosh(struct xpr v); +void prxpr(struct xpr u,int m); +void xprint(struct xpr u); +void lshift(int i,unsigned short *p,int k); +void rshift(int i,unsigned short *p,int k); diff --git a/xarm/supp/big-end/xtodub.c b/xarm/supp/big-end/xtodub.c new file mode 100644 index 0000000..7cfc9af --- /dev/null +++ b/xarm/supp/big-end/xtodub.c @@ -0,0 +1,38 @@ +/* xtodub.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +#include +double xtodub(struct xpr s) +{ unsigned short pe[4],*pc,u; short i,e; + pc=(unsigned short *)&s; + u= *pc&m_sgn; e=(*pc&m_exp)-d_bias; + if(e>=d_max) return HUGE_VAL; if(e<=0) return 0.; + for(i=0; i<4 ;) pe[i++]= *++pc; + pe[0]&=m_exp; rshift(d_lex-1,pe,4); + pe[0]|=(e<<(16-d_lex)); pe[0]|=u; + return *(double *)pe; +} +struct xpr dubtox(double y) +{ unsigned short pe[XDIM+1],*pc,u; short i,e; + pc=(unsigned short *)&y; + u= *pc&m_sgn; e=d_bias+((*pc&m_exp)>>(16-d_lex)); + for(i=1; i<5 ;) pe[i++]= *pc++; while(i<=XDIM) pe[i++]=0; + pc=pe+1; lshift(d_lex-1,pc,4); *pc|=m_sgn; + *pe=e; *pe|=u; return *(struct xpr *)pe; +} +struct xpr inttox(int n) +{ unsigned short pe[XDIM+1],*pc; short e; + unsigned k,h; + pc=(unsigned short *)&k; + for(e=0; e<=XDIM ;) pe[e++]=0; + if(n==0) return *(struct xpr *)pe; + k=abs(n); *(pe+1)= *pc; *(pe+2)= *(pc+1); + for(e=0,h=1; h<=k ;h<<=1,++e); + *pe=bias+e-1; if(n<0) *pe|=m_sgn; + lshift(32-e,pe+1,XDIM); return *(struct xpr *)pe; +} diff --git a/xarm/supp/data/README b/xarm/supp/data/README new file mode 100644 index 0000000..e0687d0 --- /dev/null +++ b/xarm/supp/data/README @@ -0,0 +1,8 @@ + The files in this directory support an increase in the precision + of the functions in the 'xarm' library segment. This is accomplished + by increasing the size of the mantissa. Possible enhanced mantissa + sizes are 11, 15, 19, 23, 27, and 31 sixteen bit words. First + redefine XDIM in 'xpre.h' to be equal to one of these values, + then replace the 'constant.h' header with the corresponding + 'const[nn].h' from this directory, and recompile the segment code + with these new header files. diff --git a/xarm/supp/data/const07.h b/xarm/supp/data/const07.h new file mode 100644 index 0000000..b195d58 --- /dev/null +++ b/xarm/supp/data/const07.h @@ -0,0 +1,26 @@ +/* const07.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Constants file for XDIM=7 +*/ +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=2,k_tanh=5; +int ms_exp=21,ms_hyp=25,ms_trg=31; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={0x0,0x0}; +struct xpr one={0x3fff,0x8000}; +struct xpr two={0x4000,0x8000}; +struct xpr ten={0x4002,0xa000}; +struct xpr x_huge={0x7fff,0x0}; +struct xpr pi4={0x3FFE,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; +struct xpr pi2={0x3FFF,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; +struct xpr pi={0x4000,0xC90F,0xDAA2,0x2168,0xC234,0xC4C6,0x628B,0x80DC}; +struct xpr ee={0x4000,0xADF8,0x5458,0xA2BB,0x4A9A,0xAFDC,0x5620,0x273D}; +struct xpr ln2={0x3FFE,0xB172,0x17F7,0xD1CF,0x79AB,0xC9E3,0xB398,0x3F3}; +struct xpr srt2={0x3FFF,0xB504,0xF333,0xF9DE,0x6484,0x597D,0x89B3,0x754B}; diff --git a/xarm/supp/data/const11.h b/xarm/supp/data/const11.h new file mode 100644 index 0000000..5f83872 --- /dev/null +++ b/xarm/supp/data/const11.h @@ -0,0 +1,32 @@ +/* const11.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Constants file for XDIM=11 +*/ +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=2,k_tanh=6; +int ms_exp=31,ms_hyp=35,ms_trg=43; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={0x0,0x0}; +struct xpr one={0x3fff,0x8000}; +struct xpr two={0x4000,0x8000}; +struct xpr ten={0x4002,0xa000}; +struct xpr x_huge={0x7fff,0x0}; +struct xpr pi4={0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a68}; +struct xpr pi2={0x3fff,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a68}; +struct xpr pi={0x4000,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a68}; +struct xpr ee={0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d, + 0x3cf1,0xd8b9,0xc583,0xce2d}; +struct xpr ln2={0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2, + 0xf6af,0x40f3,0x4326,0x7299}; +struct xpr srt2={0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a, + 0xbe9f,0x1d6f,0x60ba,0x893c}; diff --git a/xarm/supp/data/const15.h b/xarm/supp/data/const15.h new file mode 100644 index 0000000..d0c906a --- /dev/null +++ b/xarm/supp/data/const15.h @@ -0,0 +1,32 @@ +/* const15.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Constants file for XDIM=15 +*/ +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=3,k_tanh=6; +int ms_exp=39,ms_hyp=45,ms_trg=55; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={0x0,0x0}; +struct xpr one={0x3fff,0x8000}; +struct xpr two={0x4000,0x8000}; +struct xpr ten={0x4002,0xa000}; +struct xpr x_huge={0x7fff,0x0}; +struct xpr pi4={0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b, + 0x80dc,0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b17}; +struct xpr pi2={0x3fff,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b, + 0x80dc,0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b17}; +struct xpr pi={0x4000,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b, + 0x80dc,0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b17}; +struct xpr ee={0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620, + 0x273d,0x3cf1,0xd8b9,0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1449}; +struct xpr ln2={0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398, + 0x03f2,0xf6af,0x40f3,0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8b83}; +struct xpr srt2={0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3, + 0x754a,0xbe9f,0x1d6f,0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8338}; diff --git a/xarm/supp/data/const19.h b/xarm/supp/data/const19.h new file mode 100644 index 0000000..e81a94a --- /dev/null +++ b/xarm/supp/data/const19.h @@ -0,0 +1,38 @@ +/* const19.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Constants file for XDIM=19 +*/ +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=3,k_tanh=6; +int ms_exp=39,ms_hyp=45,ms_trg=55; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={0x0,0x0}; +struct xpr one={0x3fff,0x8000}; +struct xpr two={0x4000,0x8000}; +struct xpr ten={0x4002,0xa000}; +struct xpr x_huge={0x7fff,0x0}; +struct xpr pi4={0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34}; +struct xpr pi2={0x3fff,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34}; +struct xpr pi={0x4000,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34}; +struct xpr ee={0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d, + 0x3cf1,0xd8b9,0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93, + 0x9dce,0x249b}; +struct xpr ln2={0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2, + 0xf6af,0x40f3,0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8, + 0x7620,0x6dec}; +struct xpr srt2={0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a, + 0xbe9f,0x1d6f,0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc, + 0x8304,0x3ab9}; diff --git a/xarm/supp/data/const23.h b/xarm/supp/data/const23.h new file mode 100644 index 0000000..4c8aa9d --- /dev/null +++ b/xarm/supp/data/const23.h @@ -0,0 +1,38 @@ +/* const23.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Constants file for XDIM=23 +*/ +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=3,k_tanh=7; +int ms_exp=57,ms_hyp=65,ms_trg=75; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={0x0,0x0}; +struct xpr one={0x3fff,0x8000}; +struct xpr two={0x4000,0x8000}; +struct xpr ten={0x4002,0xa000}; +struct xpr x_huge={0x7fff,0x0}; +struct xpr pi4={0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a}; +struct xpr pi2={0x3fff,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a}; +struct xpr pi={0x4000,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a}; +struct xpr ee={0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d, + 0x3cf1,0xd8b9,0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93, + 0x9dce,0x249b,0x3ef9,0x7d2f,0xe363,0x630c}; +struct xpr ln2={0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2, + 0xf6af,0x40f3,0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8, + 0x7620,0x6deb,0xac98,0x5595,0x52fb,0x4afa}; +struct xpr srt2={0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a, + 0xbe9f,0x1d6f,0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc, + 0x8304,0x3ab8,0xa2c3,0xa8b1,0xfe6f,0xdc84}; diff --git a/xarm/supp/data/const27.h b/xarm/supp/data/const27.h new file mode 100644 index 0000000..93a7d1b --- /dev/null +++ b/xarm/supp/data/const27.h @@ -0,0 +1,38 @@ +/* const27.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Constants file for XDIM=27 +*/ +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=4,k_tanh=7; +int ms_exp=65,ms_hyp=73,ms_trg=85; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={0x0,0x0}; +struct xpr one={0x3fff,0x8000}; +struct xpr two={0x4000,0x8000}; +struct xpr ten={0x4002,0xa000}; +struct xpr x_huge={0x7fff,0x0}; +struct xpr pi4={0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f}; +struct xpr pi2={0x3fff,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f}; +struct xpr pi={0x4000,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f}; +struct xpr ee={0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d, + 0x3cf1,0xd8b9,0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93, + 0x9dce,0x249b,0x3ef9,0x7d2f,0xe363,0x630c,0x75d8,0xf681,0xb202,0xaec4}; +struct xpr ln2={0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2, + 0xf6af,0x40f3,0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8, + 0x7620,0x6deb,0xac98,0x5595,0x52fb,0x4afa,0x1b10,0xed2e,0xae35,0xc138}; +struct xpr srt2={0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a, + 0xbe9f,0x1d6f,0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc, + 0x8304,0x3ab8,0xa2c3,0xa8b1,0xfe6f,0xdc83,0xdb39,0x0f74,0xa85e,0x439c}; diff --git a/xarm/supp/data/const31.h b/xarm/supp/data/const31.h new file mode 100644 index 0000000..3aac910 --- /dev/null +++ b/xarm/supp/data/const31.h @@ -0,0 +1,44 @@ +/* const31.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* Constants file for XDIM=31 +*/ +unsigned short m_sgn=0x8000,m_exp=0x7fff; +short bias=16383; +int itt_div=4,k_tanh=7; +int ms_exp=73,ms_hyp=83,ms_trg=95; +short max_p=16*XDIM,k_lin= -8*XDIM; +short d_bias=15360,d_max=2047,d_lex=12; +struct xpr zero={0x0,0x0}; +struct xpr one={0x3fff,0x8000}; +struct xpr two={0x4000,0x8000}; +struct xpr ten={0x4002,0xa000}; +struct xpr x_huge={0x7fff,0x0}; +struct xpr pi4={0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f, + 0x1437,0x4fe1,0x356d,0x6d57}; +struct xpr pi2={0x3fff,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f, + 0x1437,0x4fe1,0x356d,0x6d57}; +struct xpr pi={0x4000,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc, + 0x1cd1,0x2902,0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a, + 0x0879,0x8e34,0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f, + 0x1437,0x4fe1,0x356d,0x6d57}; +struct xpr ee={0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d, + 0x3cf1,0xd8b9,0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93, + 0x9dce,0x249b,0x3ef9,0x7d2f,0xe363,0x630c,0x75d8,0xf681,0xb202,0xaec4, + 0x617a,0xd3df,0x1ed5,0xd5fd}; +struct xpr ln2={0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2, + 0xf6af,0x40f3,0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8, + 0x7620,0x6deb,0xac98,0x5595,0x52fb,0x4afa,0x1b10,0xed2e,0xae35,0xc138, + 0x2144,0x2757,0x3b29,0x1170}; +struct xpr srt2={0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a, + 0xbe9f,0x1d6f,0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc, + 0x8304,0x3ab8,0xa2c3,0xa8b1,0xfe6f,0xdc83,0xdb39,0x0f74,0xa85e,0x439c, + 0x7b4a,0x7804,0x8736,0x3dfa}; diff --git a/xarm/supp/data/xcon07.dat b/xarm/supp/data/xcon07.dat new file mode 100644 index 0000000..2e96061 --- /dev/null +++ b/xarm/supp/data/xcon07.dat @@ -0,0 +1,21 @@ + Constants with x_dim= 7 (correctly rounded) + + 7.8539816339744830961566084582e-1 +struct xpr pi4={ +0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc +}; + + 2.7182818284590452353602874714e+0 +struct xpr ee={ +0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d +}; + + 6.9314718055994530941723212146e-1 +struct xpr ln2={ +0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f3 +}; + + 1.4142135623730950488016887242e+0 +struct xpr srt2={ +0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754b +}; diff --git a/xarm/supp/data/xcon11.dat b/xarm/supp/data/xcon11.dat new file mode 100644 index 0000000..63f5a73 --- /dev/null +++ b/xarm/supp/data/xcon11.dat @@ -0,0 +1,25 @@ + Constants with x_dim= 11 (correctly rounded) + + 7.85398163397448309615660845819875721049292350e-1 +struct xpr pi4={ +0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc,0x1cd1,0x2902, +0x4e08,0x8a68 +}; + + 2.71828182845904523536028747135266249775724709e+0 +struct xpr ee={ +0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d,0x3cf1,0xd8b9, +0xc583,0xce2d +}; + + 6.93147180559945309417232121458176568075500134e-1 +struct xpr ln2={ +0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2,0xf6af,0x40f3, +0x4326,0x7299 +}; + + 1.41421356237309504880168872420969807856967188e+0 +struct xpr srt2={ +0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a,0xbe9f,0x1d6f, +0x60ba,0x893c +}; diff --git a/xarm/supp/data/xcon15.dat b/xarm/supp/data/xcon15.dat new file mode 100644 index 0000000..3f04e0a --- /dev/null +++ b/xarm/supp/data/xcon15.dat @@ -0,0 +1,25 @@ + Constants with x_dim= 15 (correctly rounded) + + 7.853981633974483096156608458198757210492923498437764552437361e-1 +struct xpr pi4={ +0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc,0x1cd1,0x2902, +0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b14 +}; + + 2.718281828459045235360287471352662497757247093699959574966968e+0 +struct xpr ee={ +0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d,0x3cf1,0xd8b9, +0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464 +}; + + 6.931471805599453094172321214581765680755001343602552541206800e-1 +struct xpr ln2={ +0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2,0xf6af,0x40f3, +0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8bab +}; + + 1.414213562373095048801688724209698078569671875376948073176680e+0 +struct xpr srt2={ +0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a,0xbe9f,0x1d6f, +0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8334 +}; diff --git a/xarm/supp/data/xcon19.dat b/xarm/supp/data/xcon19.dat new file mode 100644 index 0000000..8cb72d3 --- /dev/null +++ b/xarm/supp/data/xcon19.dat @@ -0,0 +1,25 @@ + Constants with x_dim= 19 (correctly rounded) + + 7.8539816339744830961566084581987572104929234984377645524373614807695410157155e-1 +struct xpr pi4={ +0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc,0x1cd1,0x2902, +0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a,0x0879,0x8e34 +}; + + 2.7182818284590452353602874713526624977572470936999595749669676277240766303535e+0 +struct xpr ee={ +0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d,0x3cf1,0xd8b9, +0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93,0x9dce,0x249b +}; + + 6.9314718055994530941723212145817656807550013436025525412068000949339362196969e-1 +struct xpr ln2={ +0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2,0xf6af,0x40f3, +0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8,0x7620,0x6dec +}; + + 1.4142135623730950488016887242096980785696718753769480731766797379907324784621e+0 +struct xpr srt2={ +0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a,0xbe9f,0x1d6f, +0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc,0x8304,0x3ab9 +}; diff --git a/xarm/supp/data/xcon23.dat b/xarm/supp/data/xcon23.dat new file mode 100644 index 0000000..868a741 --- /dev/null +++ b/xarm/supp/data/xcon23.dat @@ -0,0 +1,29 @@ + Constants with x_dim= 23 (correctly rounded) + + 7.85398163397448309615660845819875721049292349843776455243736148076954101571552249657008706336e-1 +struct xpr pi4={ +0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc,0x1cd1,0x2902, +0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a,0x0879,0x8e34, +0x04dd,0xef95,0x19b3,0xcd3a +}; + + 2.71828182845904523536028747135266249775724709369995957496696762772407663035354759457138217853e+0 +struct xpr ee={ +0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d,0x3cf1,0xd8b9, +0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93,0x9dce,0x249b, +0x3ef9,0x7d2f,0xe363,0x630c +}; + + 6.93147180559945309417232121458176568075500134360255254120680009493393621969694715605863326996e-1 +struct xpr ln2={ +0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2,0xf6af,0x40f3, +0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8,0x7620,0x6deb, +0xac98,0x5595,0x52fb,0x4afa +}; + + 1.41421356237309504880168872420969807856967187537694807317667973799073247846210703885038753433e+0 +struct xpr srt2={ +0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a,0xbe9f,0x1d6f, +0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc,0x8304,0x3ab8, +0xa2c3,0xa8b1,0xfe6f,0xdc87 +}; diff --git a/xarm/supp/data/xcon27.dat b/xarm/supp/data/xcon27.dat new file mode 100644 index 0000000..ce713fb --- /dev/null +++ b/xarm/supp/data/xcon27.dat @@ -0,0 +1,29 @@ + Constants with x_dim= 27 (correctly rounded) + + 7.853981633974483096156608458198757210492923498437764552437361480769541015715522496570087063355292669955370216e-1 +struct xpr pi4={ +0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc,0x1cd1,0x2902, +0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a,0x0879,0x8e34, +0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f +}; + + 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427427466392e+0 +struct xpr ee={ +0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d,0x3cf1,0xd8b9, +0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93,0x9dce,0x249b, +0x3ef9,0x7d2f,0xe363,0x630c,0x75d8,0xf681,0xb202,0xaec4 +}; + + 6.931471805599453094172321214581765680755001343602552541206800094933936219696947156058633269964186875420014810e-1 +struct xpr ln2={ +0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2,0xf6af,0x40f3, +0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8,0x7620,0x6deb, +0xac98,0x5595,0x52fb,0x4afa,0x1b10,0xed2e,0xae35,0xc138 +}; + + 1.414213562373095048801688724209698078569671875376948073176679737990732478462107038850387534327641572735013846e+0 +struct xpr srt2={ +0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a,0xbe9f,0x1d6f, +0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc,0x8304,0x3ab8, +0xa2c3,0xa8b1,0xfe6f,0xdc83,0xdb39,0x0f74,0xa85e,0x439c +}; diff --git a/xarm/supp/data/xcon31.dat b/xarm/supp/data/xcon31.dat new file mode 100644 index 0000000..5fe11f1 --- /dev/null +++ b/xarm/supp/data/xcon31.dat @@ -0,0 +1,33 @@ + Constants with x_dim= 31 (correctly rounded) + + 7.8539816339744830961566084581987572104929234984377645524373614807695410157155224965700870633552926699553702162832057666177346e-1 +struct xpr pi4={ +0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc,0x1cd1,0x2902, +0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a,0x0879,0x8e34, +0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f,0x1437,0x4fe1, +0x356d,0x6d57 +}; + + 2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174e+0 +struct xpr ee={ +0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d,0x3cf1,0xd8b9, +0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93,0x9dce,0x249b, +0x3ef9,0x7d2f,0xe363,0x630c,0x75d8,0xf681,0xb202,0xaec4,0x617a,0xd3df, +0x1ed5,0xd5fd +}; + + 6.9314718055994530941723212145817656807550013436025525412068000949339362196969471560586332699641868754200148102057068573368552e-1 +struct xpr ln2={ +0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2,0xf6af,0x40f3, +0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8,0x7620,0x6deb, +0xac98,0x5595,0x52fb,0x4afa,0x1b10,0xed2e,0xae35,0xc138,0x2144,0x2757, +0x3b29,0x1170 +}; + + 1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727350138462309122970249248e+0 +struct xpr srt2={ +0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a,0xbe9f,0x1d6f, +0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc,0x8304,0x3ab8, +0xa2c3,0xa8b1,0xfe6f,0xdc83,0xdb39,0x0f74,0xa85e,0x439c,0x7b4a,0x7804, +0x8736,0x3dfa +}; diff --git a/xarm/supp/data/xconz33.dat b/xarm/supp/data/xconz33.dat new file mode 100644 index 0000000..a91a570 --- /dev/null +++ b/xarm/supp/data/xconz33.dat @@ -0,0 +1,33 @@ + Constants with x_dim= 33 (not rounded) + + 7.853981633974483096156608458198757210492923498437764552437361480769541015715522496570087063355292669955370216283205766617734611523876e-1 +struct xpr pi4={ +0x3ffe,0xc90f,0xdaa2,0x2168,0xc234,0xc4c6,0x628b,0x80dc,0x1cd1,0x2902, +0x4e08,0x8a67,0xcc74,0x020b,0xbea6,0x3b13,0x9b22,0x514a,0x0879,0x8e34, +0x04dd,0xef95,0x19b3,0xcd3a,0x431b,0x302b,0x0a6d,0xf25f,0x1437,0x4fe1, +0x356d,0x6d51,0xc245,0xe48c +}; + + 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427427466391932003059921817413596629e+0 +struct xpr ee={ +0x4000,0xadf8,0x5458,0xa2bb,0x4a9a,0xafdc,0x5620,0x273d,0x3cf1,0xd8b9, +0xc583,0xce2d,0x3695,0xa9e1,0x3641,0x1464,0x33fb,0xcc93,0x9dce,0x249b, +0x3ef9,0x7d2f,0xe363,0x630c,0x75d8,0xf681,0xb202,0xaec4,0x617a,0xd3df, +0x1ed5,0xd5fd,0x6561,0x2405 +}; + + 6.931471805599453094172321214581765680755001343602552541206800094933936219696947156058633269964186875420014810205706857336855202357581e-1 +struct xpr ln2={ +0x3ffe,0xb172,0x17f7,0xd1cf,0x79ab,0xc9e3,0xb398,0x03f2,0xf6af,0x40f3, +0x4326,0x7298,0xb62d,0x8a0d,0x175b,0x8baa,0xfa2b,0xe7b8,0x7620,0x6deb, +0xac98,0x5595,0x52fb,0x4afa,0x1b10,0xed2e,0xae35,0xc138,0x2144,0x2757, +0x3b29,0x1169,0xb825,0x3e3c +}; + + 1.414213562373095048801688724209698078569671875376948073176679737990732478462107038850387534327641572735013846230912297024924836055851e+0 +struct xpr srt2={ +0x3fff,0xb504,0xf333,0xf9de,0x6484,0x597d,0x89b3,0x754a,0xbe9f,0x1d6f, +0x60ba,0x893b,0xa84c,0xed17,0xac85,0x8333,0x9915,0x4afc,0x8304,0x3ab8, +0xa2c3,0xa8b1,0xfe6f,0xdc83,0xdb39,0x0f74,0xa85e,0x439c,0x7b4a,0x7804, +0x8736,0x3dfa,0x2768,0xd229 +}; diff --git a/xarm/supp/data/xpre.h b/xarm/supp/data/xpre.h new file mode 100644 index 0000000..810c9ec --- /dev/null +++ b/xarm/supp/data/xpre.h @@ -0,0 +1,52 @@ +/* xpre.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define XDIM 7 +struct xpr {unsigned short nmm[XDIM+1];}; +extern unsigned short m_sgn,m_exp; +extern short bias; +extern int itt_div,k_tanh; +extern int ms_exp,ms_trg,ms_hyp; +extern short max_p,k_lin; +extern short d_bias,d_max,d_lex; +extern struct xpr zero,one,two,ten; +extern struct xpr x_huge; +extern struct xpr pi,pi2,pi4; +extern struct xpr ee,srt2,ln2; +struct xpr xadd(struct xpr a,struct xpr b,int k); +struct xpr xmul(struct xpr s,struct xpr t); +struct xpr xdiv(struct xpr s,struct xpr t); +struct xpr atox(char *s); +struct xpr dubtox(double y); +struct xpr inttox(int n); +int xprcmp(struct xpr *p,struct xpr *q); +int neg(struct xpr *p); +int xex(struct xpr *p); +struct xpr sfmod(struct xpr t,int *p); +struct xpr xpwr(struct xpr s,int n); +struct xpr xpr2(struct xpr s,int n); +struct xpr xneg(struct xpr s); +struct xpr xabs(struct xpr s); +struct xpr xfrex(struct xpr s,int *p); +struct xpr xfmod(struct xpr s,struct xpr t,int *p); +double xtodub(struct xpr s); +struct xpr xtan(struct xpr x); +struct xpr xsin(struct xpr x); +struct xpr xcos(struct xpr x); +struct xpr xatan(struct xpr a); +struct xpr xasin(struct xpr a); +struct xpr xacos(struct xpr a); +struct xpr xsqrt(struct xpr u); +struct xpr xexp(struct xpr u); +struct xpr xlog(struct xpr u); +struct xpr xtanh(struct xpr v); +struct xpr xsinh(struct xpr v); +struct xpr xcosh(struct xpr v); +void prxpr(struct xpr u,int m); +void xprint(struct xpr u); +void lshift(int i,unsigned short *p,int k); +void rshift(int i,unsigned short *p,int k); diff --git a/xarm/supp/little-end/README b/xarm/supp/little-end/README new file mode 100644 index 0000000..82b147f --- /dev/null +++ b/xarm/supp/little-end/README @@ -0,0 +1,5 @@ + The C-code and header files in this directory must be used + to install the 'xarm' library segment on a platform with + little-endian byte ordering (for example Intel 80x86). + This is the default configuration currently installed in + the 'xarm' directory. diff --git a/xarm/supp/little-end/xfmod.c b/xarm/supp/little-end/xfmod.c new file mode 100644 index 0000000..8632e07 --- /dev/null +++ b/xarm/supp/little-end/xfmod.c @@ -0,0 +1,26 @@ +/* xfmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xfmod(struct xpr s,struct xpr t,int *p) +{ struct xpr h; unsigned short *q,*ph; short k; + h=xdiv(s,t); ph=(unsigned short *)&h; k=(*ph&m_exp)-bias; + if(k>=0){ rshift(31-k,ph+1,2); + q=(unsigned short *)p; + *(q+1)= *(ph+1); *q= *(ph+2); + } + else *p=0; + if(*p){ if(*ph&m_sgn) s=xadd(s,xmul(t,inttox(*p)),0); + else s=xadd(s,xmul(t,inttox(*p)),1); + } + return s; +} +struct xpr xfrex(struct xpr s,int *p) +{ unsigned short *ps=(unsigned short *)&s,u; + *p=(*ps&m_exp)-bias+1; u= *ps&m_sgn; + *ps=bias-1; *ps|=u; return s; +} diff --git a/xarm/supp/little-end/xpre.h b/xarm/supp/little-end/xpre.h new file mode 100644 index 0000000..810c9ec --- /dev/null +++ b/xarm/supp/little-end/xpre.h @@ -0,0 +1,52 @@ +/* xpre.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define XDIM 7 +struct xpr {unsigned short nmm[XDIM+1];}; +extern unsigned short m_sgn,m_exp; +extern short bias; +extern int itt_div,k_tanh; +extern int ms_exp,ms_trg,ms_hyp; +extern short max_p,k_lin; +extern short d_bias,d_max,d_lex; +extern struct xpr zero,one,two,ten; +extern struct xpr x_huge; +extern struct xpr pi,pi2,pi4; +extern struct xpr ee,srt2,ln2; +struct xpr xadd(struct xpr a,struct xpr b,int k); +struct xpr xmul(struct xpr s,struct xpr t); +struct xpr xdiv(struct xpr s,struct xpr t); +struct xpr atox(char *s); +struct xpr dubtox(double y); +struct xpr inttox(int n); +int xprcmp(struct xpr *p,struct xpr *q); +int neg(struct xpr *p); +int xex(struct xpr *p); +struct xpr sfmod(struct xpr t,int *p); +struct xpr xpwr(struct xpr s,int n); +struct xpr xpr2(struct xpr s,int n); +struct xpr xneg(struct xpr s); +struct xpr xabs(struct xpr s); +struct xpr xfrex(struct xpr s,int *p); +struct xpr xfmod(struct xpr s,struct xpr t,int *p); +double xtodub(struct xpr s); +struct xpr xtan(struct xpr x); +struct xpr xsin(struct xpr x); +struct xpr xcos(struct xpr x); +struct xpr xatan(struct xpr a); +struct xpr xasin(struct xpr a); +struct xpr xacos(struct xpr a); +struct xpr xsqrt(struct xpr u); +struct xpr xexp(struct xpr u); +struct xpr xlog(struct xpr u); +struct xpr xtanh(struct xpr v); +struct xpr xsinh(struct xpr v); +struct xpr xcosh(struct xpr v); +void prxpr(struct xpr u,int m); +void xprint(struct xpr u); +void lshift(int i,unsigned short *p,int k); +void rshift(int i,unsigned short *p,int k); diff --git a/xarm/supp/little-end/xtodub.c b/xarm/supp/little-end/xtodub.c new file mode 100644 index 0000000..65a9bbc --- /dev/null +++ b/xarm/supp/little-end/xtodub.c @@ -0,0 +1,40 @@ +/* xtodub.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +#include +double xtodub(struct xpr s) +{ unsigned short pe[4],*pc,u; short i,e; + pc=(unsigned short *)&s; + u= *pc&m_sgn; e=(*pc&m_exp)-d_bias; + if(e>=d_max) return HUGE_VAL; if(e<=0) return 0.; + for(i=0; i<4 ;) pe[i++]= *++pc; + pe[0]&=m_exp; rshift(d_lex-1,pe,4); + pe[0]|=(e<<(16-d_lex)); pe[0]|=u; + u=pe[3]; pe[3]=pe[0]; pe[0]=u; + u=pe[2]; pe[2]=pe[1]; pe[1]=u; + return *(double *)pe; +} +struct xpr dubtox(double y) +{ unsigned short pe[XDIM+1],*pc,u; short i,e; + pc=(unsigned short *)&y; pc+=3; + u= *pc&m_sgn; e=d_bias+((*pc&m_exp)>>(16-d_lex)); + for(i=1; i<5 ;) pe[i++]= *pc--; while(i<=XDIM) pe[i++]=0; + pc=pe+1; lshift(d_lex-1,pc,4); *pc|=m_sgn; + *pe=e; *pe|=u; return *(struct xpr *)pe; +} +struct xpr inttox(int n) +{ unsigned short pe[XDIM+1],*pc; short e; + unsigned k,h; + pc=(unsigned short *)&k; + for(e=0; e<=XDIM ;) pe[e++]=0; + if(n==0) return *(struct xpr *)pe; + k=abs(n); *(pe+1)= *(pc+1); *(pe+2)= *pc; + for(e=0,h=1; h<=k ;h<<=1,++e); + *pe=bias+e-1; if(n<0) *pe|=m_sgn; + lshift(32-e,pe+1,XDIM); return *(struct xpr *)pe; +} diff --git a/xarm/test/README b/xarm/test/README new file mode 100644 index 0000000..8f18f35 --- /dev/null +++ b/xarm/test/README @@ -0,0 +1,28 @@ + This directory contains test code for the functions of the 'xarm' + segment of the CCM math library. Each test code file has a sample + of the correct output appended to it. Input data files, if any + are named in the test code header, are in the 'data' sub-directory. + + The list below specifies the test input parameters required + for the standard tests whose output is appended as a comment + to the test source code. The absence of an entry indicates + that no input parameters are required. + + + tatox data/atox.dat + txaop1 data/aop1.dat + txaop2 -1.24e-3 + txchser 12 + txconv data/xcvt.dat + txdiv + prompt sequence: 1 3 : 4 7 : 2 16 : 0 0 + txexp + txfmod 12.5 3 + txfrex data/xfrex.dat + txhypb + txivtrg + txlog + txprcmp data/xcmp.dat + txpwr -.7 6 + txsqrt + txtrig diff --git a/xarm/test/data/aop1.dat b/xarm/test/data/aop1.dat new file mode 100644 index 0000000..338371c --- /dev/null +++ b/xarm/test/data/aop1.dat @@ -0,0 +1,4 @@ +1. 4. +-2.3 3.147159 +27.5 -33.6 +-11.1 -0.4 diff --git a/xarm/test/data/atox.dat b/xarm/test/data/atox.dat new file mode 100644 index 0000000..463d4e8 --- /dev/null +++ b/xarm/test/data/atox.dat @@ -0,0 +1,6 @@ +1.25 +1.234567890123456789012345678901 +1.326457891245678800213456789012e+512 +-9.876543210123456789098765432108e-70 +0.3333333333333333333333333333333 +1.10e-3 diff --git a/xarm/test/data/xcmp.dat b/xarm/test/data/xcmp.dat new file mode 100644 index 0000000..d473aa2 --- /dev/null +++ b/xarm/test/data/xcmp.dat @@ -0,0 +1,4 @@ +1.25 27.3 +-12.1e-2 0.05431 +11.1 -27.654 +-1.03e-3 -0.00103 \ No newline at end of file diff --git a/xarm/test/data/xcvt.dat b/xarm/test/data/xcvt.dat new file mode 100644 index 0000000..8c7294f --- /dev/null +++ b/xarm/test/data/xcvt.dat @@ -0,0 +1,7 @@ +d 1.375 +d 1.5707963267948966 +d 2. +d 153.7e+23 +i 1 +i 123 +i 214675321 diff --git a/xarm/test/data/xfrex.dat b/xarm/test/data/xfrex.dat new file mode 100644 index 0000000..2bed130 --- /dev/null +++ b/xarm/test/data/xfrex.dat @@ -0,0 +1,2 @@ +1.2345 +-2.123450987654321 diff --git a/xarm/test/tatox.c b/xarm/test/tatox.c new file mode 100644 index 0000000..fcb04d6 --- /dev/null +++ b/xarm/test/tatox.c @@ -0,0 +1,52 @@ +/* tatox.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: atox prxpr xprint + + Input file: atox.dat +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(int na,char **av) +{ struct xpr f; + FILE *fp; + char num[64]; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + while(fscanf(fp,"%s",num)!=EOF){ + printf(" string in : %s\n",num); + +/* convert ascii string to extended precision */ + f=atox(num); + + printf(" f = "); prxpr(f,decd); + printf(" hex = "); xprint(f); + } +} +/* Test output + + string in : 1.25 + f = 1.250000000000000000000000000000e+0 + hex = 3fff.9ffffffffffffffffffffffffffa + string in : 1.234567890123456789012345678901 + f = 1.234567890123456789012345678901e+0 + hex = 3fff.9e06521462cfdb8d3df0b5b5b3dc + string in : 1.326457891245678800213456789012e+512 + f = 1.326457891245678800213456789011e+512 + hex = 46a4.969e8eb82353816d4739377f0d6f + string in : -9.876543210123456789098765432108e-70 + f = -9.876543210123456789098765432107e-70 + hex = bf19.da2117a8c6ec0619ba34035d5f84 + string in : 0.3333333333333333333333333333333 + f = 3.333333333333333333333333333333e-1 + hex = 3ffd.aaaaaaaaaaaaaaaaaaaaaaaaa8d5 + string in : 1.10e-3 + f = 1.100000000000000000000000000000e-3 + hex = 3ff5.902de00d1b71758e219652bd3c27 +*/ diff --git a/xarm/test/txaop1.c b/xarm/test/txaop1.c new file mode 100644 index 0000000..f00cc1b --- /dev/null +++ b/xarm/test/txaop1.c @@ -0,0 +1,110 @@ +/* txaop1.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xadd xmul xdiv + + Uses: atox prxpr xtodub + + Input file: data/aop1.dat +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(int na,char **av) +{ struct xpr s,t,f; + char nbx[64],nby[64]; + FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Elementary Operations\n"); + while(fscanf(fp,"%s %s",nbx,nby)!=EOF){ + s=atox(nbx); t=atox(nby); + printf(" x= "); prxpr(s,decd); + printf(" y= "); prxpr(t,decd); + +/* extended precision addition */ + printf("add\n"); + f=xadd(s,t,0); + printf(" %16.10f\n",xtodub(f)); prxpr(f,decd); + +/* extended precision subtraction */ + printf("subtract\n"); + f=xadd(s,t,1); + printf(" %16.10f\n",xtodub(f)); prxpr(f,decd); + +/* extended precision multiplication */ + printf("multiply\n"); + f=xmul(s,t); + printf(" %16.10f\n",xtodub(f)); prxpr(f,decd); + +/* extended precision division */ + printf("divide\n"); + f=xdiv(s,t); + printf(" %16.10f\n",xtodub(f)); prxpr(f,decd); + } +} +/* Test output + + Test of Elementary Operations + x= 1.000000000000000000000000000000e+0 + y= 4.000000000000000000000000000000e+0 +add + 5.0000000000 + 5.000000000000000000000000000000e+0 +subtract + -3.0000000000 + -3.000000000000000000000000000000e+0 +multiply + 4.0000000000 + 4.000000000000000000000000000000e+0 +divide + 0.2500000000 + 2.500000000000000000000000000000e-1 + x= -2.300000000000000000000000000000e+0 + y= 3.147159000000000000000000000000e+0 +add + 0.8471590000 + 8.471590000000000000000000000000e-1 +subtract + -5.4471590000 + -5.447159000000000000000000000000e+0 +multiply + -7.2384657000 + -7.238465700000000000000000000000e+0 +divide + -0.7308178583 + -7.308178582651845680501048723627e-1 + x= 2.750000000000000000000000000000e+1 + y= -3.360000000000000000000000000000e+1 +add + -6.1000000000 + -6.100000000000000000000000000000e+0 +subtract + 61.1000000000 + 6.110000000000000000000000000000e+1 +multiply + -924.0000000000 + -9.240000000000000000000000000000e+2 +divide + -0.8184523810 + -8.184523809523809523809523809524e-1 + x= -1.110000000000000000000000000000e+1 + y= -4.000000000000000000000000000000e-1 +add + -11.5000000000 + -1.150000000000000000000000000000e+1 +subtract + -10.7000000000 + -1.070000000000000000000000000000e+1 +multiply + 4.4400000000 + 4.440000000000000000000000000000e+0 +divide + 27.7500000000 + 2.775000000000000000000000000000e+1 +*/ diff --git a/xarm/test/txaop2.c b/xarm/test/txaop2.c new file mode 100644 index 0000000..38c49f6 --- /dev/null +++ b/xarm/test/txaop2.c @@ -0,0 +1,57 @@ +/* txaop2.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: neg xex xabs xneg xpr2 + + Uses: atox prxpr + + Input parameter: x -> extended precision: test number +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(int na,char **av) +{ struct xpr s,t; int k; + if(na!=2){ printf("para: test_num\n"); exit(-1);} + printf(" Test of Utility Operations\n"); + s=atox(*++av); + printf(" input x= "); prxpr(s,decd); + +/* t= -s */ + t=xneg(s); + printf(" t=xneg(x)= "); prxpr(t,decd); + +/* s -> -s */ + neg(&s); + printf(" neg(x) = "); prxpr(s,decd); + +/* extract exponent */ + k=xex(&s); printf(" x-exp= k = %d\n",k); + s=xpr2(s,-k); + printf(" = "); prxpr(s,decd); + +/* restore exponent */ + s=xpr2(s,k); + printf(" *2^k = "); prxpr(s,decd); + +/* s -> |s| */ + t=xabs(s); + printf(" t=abs(s) = "); prxpr(t,decd); +} +/* Test output + + + Test of Utility Operations + input x= -1.240000000000000000000000000000e-3 + t=xneg(x)= 1.240000000000000000000000000000e-3 + neg(x) = -1.240000000000000000000000000000e-3 + x-exp= k = -10 + = -1.269760000000000000000000000000e+0 + *2^k = -1.240000000000000000000000000000e-3 + t=abs(s) = 1.240000000000000000000000000000e-3 +*/ diff --git a/xarm/test/txchser.c b/xarm/test/txchser.c new file mode 100644 index 0000000..77b5d74 --- /dev/null +++ b/xarm/test/txchser.c @@ -0,0 +1,92 @@ +/* txchser.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xchcof xevtch + + Uses: xdiv xmul xadd inttox xpr2 xtodub prxpr + xsin xsqrt xex + + Input parameter: m -> integer: maximum degree of + Tchebycheff polynominal +*/ +#define XMATH 1 +#include "ccmath.h" +#include +struct xpr c[20]; +struct xpr isin(); +void main(int na,char **av) +{ struct xpr z,dz,u,h; int j,m; + struct xpr xevtch(); double y; + if(na!=2){ printf("para: ncof\n"); exit(-1);} + printf(" Test of Tchebycheff Expansion\n"); + m=atoi(*++av); + +/* compute Tchebycheff expansion coefficients */ + xchcof(c,m,isin); + + printf(" series coefficients\n"); + for(j=0; j<=m ;){ + printf(" %2d ",j); prxpr(c[j++],30); } + c[0]=xpr2(c[0],-1); + z=zero; dz=xdiv(one,inttox(10)); + printf(" z sin(z) Tchebycheff series\n"); + for(j=0; j<16 ;++j,z=xadd(z,dz,0)){ + +/* scale expansion variables */ + h=xdiv(z,pi2); u=xadd(xpr2(xmul(h,h),1),one,1); + +/* evaluate Tchebycheff series for sin(x) */ + u=xmul(h,xevtch(u,c,m)); + + y=xtodub(z); + printf(" %6.2f %17.15f ",y,sin(y)); prxpr(u,25); + } +} + +/* evaluate sin((pi/2)*y)/y with y=sqrt((1+z)/2) */ +struct xpr isin(z) +struct xpr z; +{ z=xsqrt(xpr2(xadd(z,one,0),-1)); + if(xex(&z)== -16383) return pi2; + else return xdiv(xsin(xmul(pi2,z)),z); +} +/* Test output + + Test of Tchebycheff Expansion + series coefficients + 0 2.552557924804531760415273944172e+0 + 1 -2.852615691810360095702940903036e-1 + 2 9.118016006651802497767922609504e-3 + 3 -1.365875135419666724364765329542e-4 + 4 1.184961857661690108290062477114e-6 + 5 -6.702791603827441236048376155605e-9 + 6 2.667278599019659364897350084318e-11 + 7 -7.872922121718594384361661445215e-14 + 8 1.792294735924872741814445918645e-16 + 9 -3.242712736631485672296795646963e-19 + 10 4.774743247331700352283058230130e-22 + 11 -5.833273589373253665487745391160e-25 + 12 6.008135424889910153613249185946e-28 + z sin(z) Tchebycheff series + 0.00 0.000000000000000 0.0000000000000000000000000e+0 + 0.10 0.099833416646828 9.9833416646828152306814198e-2 + 0.20 0.198669330795061 1.9866933079506121545941263e-1 + 0.30 0.295520206661340 2.9552020666133957510532075e-1 + 0.40 0.389418342308650 3.8941834230865049166631176e-1 + 0.50 0.479425538604203 4.7942553860420300027328794e-1 + 0.60 0.564642473395035 5.6464247339503535720094545e-1 + 0.70 0.644217687237691 6.4421768723769105367261435e-1 + 0.80 0.717356090899523 7.1735609089952276162717461e-1 + 0.90 0.783326909627483 7.8332690962748338846138232e-1 + 1.00 0.841470984807896 8.4147098480789650665250232e-1 + 1.10 0.891207360061435 8.9120736006143533995180258e-1 + 1.20 0.932039085967226 9.3203908596722634967013444e-1 + 1.30 0.963558185417193 9.6355818541719296470134863e-1 + 1.40 0.985449729988460 9.8544972998846018065947458e-1 + 1.50 0.997494986604054 9.9749498660405443094172337e-1 +*/ diff --git a/xarm/test/txconv.c b/xarm/test/txconv.c new file mode 100644 index 0000000..abafdfd --- /dev/null +++ b/xarm/test/txconv.c @@ -0,0 +1,59 @@ +/* txconv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: dubtox xtodub inttox + + Uses: prxpr + + Input file: xcvt.dat +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(int na,char **av) +{ char f[4]; double x,z; int k; + struct xpr s; + FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Conversion Functions\n"); + while(fscanf(fp,"%s",f)!=EOF){ + switch(*f){ + +/* convert between double and extended precision */ + case 'd': fscanf(fp,"%lf",&x); s=dubtox(x); z=xtodub(s); + printf(" in: x= %.15e out: z= %.15e\n",x,z); + prxpr(s,decd); + break; + +/* convert integer to extended precision */ + case 'i': fscanf(fp,"%d",&k); s=inttox(k); + printf(" k= %d\n",k); + prxpr(s,decd); + break; + } + } +} +/* Test output + + Test of Conversion Functions + in: x= 1.375000000000000e+00 out: z= 1.375000000000000e+00 + 1.375000000000000000000000000000e+0 + in: x= 1.570796326794897e+00 out: z= 1.570796326794897e+00 + 1.570796326794896557998981734272e+0 + in: x= 2.000000000000000e+00 out: z= 2.000000000000000e+00 + 2.000000000000000000000000000000e+0 + in: x= 1.537000000000000e+25 out: z= 1.537000000000000e+25 + 1.536999999999999915694489600000e+25 + k= 1 + 1.000000000000000000000000000000e+0 + k= 123 + 1.230000000000000000000000000000e+2 + k= 214675321 + 2.146753210000000000000000000000e+8 +*/ diff --git a/xarm/test/txdiv.c b/xarm/test/txdiv.c new file mode 100644 index 0000000..51d25d5 --- /dev/null +++ b/xarm/test/txdiv.c @@ -0,0 +1,53 @@ +/* txdiv.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xdiv xmul + + Uses: dubtox + + Prompted input: at prompt 'x y? : ' + enter x -> real: numerator + y -> real: denominator (y!=0) + y = 0 terminates session +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(void) +{ struct xpr f,s,t; + double x,y; int k; + while(1){ + fprintf(stderr,"x y? : "); + scanf("%lf %lf",&x,&y); + if(y==0.) break; + s=dubtox(x); t=dubtox(y); + printf(" inputs: s= "); prxpr(s,decd); + printf(" t= "); prxpr(t,decd); + +/* extended precision division */ + f=xdiv(s,t); printf("s/t: "); prxpr(f,decd); + +/* check division with a multiply */ + s=xmul(f,t); printf(" s: "); prxpr(s,decd); + } +} +/* Test output + + inputs: s= 1.000000000000000000000000000000e+0 + t= 3.000000000000000000000000000000e+0 +s/t: 3.333333333333333333333333333333e-1 + s: 1.000000000000000000000000000000e+0 + inputs: s= 4.000000000000000000000000000000e+0 + t= 7.000000000000000000000000000000e+0 +s/t: 5.714285714285714285714285714286e-1 + s: 4.000000000000000000000000000000e+0 + inputs: s= 2.000000000000000000000000000000e+0 + t= 1.600000000000000000000000000000e+1 +s/t: 1.250000000000000000000000000000e-1 + s: 2.000000000000000000000000000000e+0 +*/ diff --git a/xarm/test/txexp.c b/xarm/test/txexp.c new file mode 100644 index 0000000..e679b44 --- /dev/null +++ b/xarm/test/txexp.c @@ -0,0 +1,40 @@ +/* txexp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xexp + + Uses: atox xtodub xprcmp xadd prxpr +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(void) +{ struct xpr z,h,f,u; + printf(" Test of Exp Function\n"); + z=xneg(one); h=atox("0.5"); u=atox("3.01"); + for(; xprcmp(&z,&u)<0 ;z=xadd(z,h,0)){ + +/* compute extended precision exponential */ + f=xexp(z); + + printf(" %8.4f ",xtodub(z)); prxpr(f,decd); + } +} +/* Test output + + Test of Exp Function + -1.0000 3.678794411714423215955237701615e-1 + -0.5000 6.065306597126334236037995349912e-1 + -0.0000 1.000000000000000000000000000000e+0 + 0.5000 1.648721270700128146848650787814e+0 + 1.0000 2.718281828459045235360287471503e+0 + 1.5000 4.481689070338064822602055460119e+0 + 2.0000 7.389056098930650227230427460985e+0 + 2.5000 1.218249396070347343807017595117e+1 + 3.0000 2.008553692318766774092852965570e+1 +*/ diff --git a/xarm/test/txfmod.c b/xarm/test/txfmod.c new file mode 100644 index 0000000..abfec10 --- /dev/null +++ b/xarm/test/txfmod.c @@ -0,0 +1,58 @@ +/* txfmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xfmod xfrex xpr2 + + Uses: atox prxpr + + Input parameters: x -> extended precision: first argument + y -> extended precision: second argument +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(int na,char **av) +{ struct xpr s,t,f; int k; + if(na!=3){ printf("para: x y\n"); exit(-1);} + printf(" Test of FMOD functions\n"); + s=atox(*++av); t=atox(*++av); + printf(" inputs:\n"); + printf(" s="); prxpr(s,decd); + printf(" t="); prxpr(t,decd); + +/* extended precision modular divide */ + f=xfmod(s,t,&k); + + printf(" s mod t = "); prxpr(f,decd); + printf(" k = %d\n",k); + printf("\n s="); prxpr(s,decd); + +/* extended precision exponent extraction */ + s=xfrex(s,&k); + + printf(" exp= %d\n",k); + printf(" ="); prxpr(s,decd); + +/* extended precision power of two */ + s=xpr2(s,k); + printf(" s="); prxpr(s,decd); +} +/* Test output + + Test of FMOD functions + inputs: + s= 1.250000000000000000000000000000e+1 + t= 3.000000000000000000000000000000e+0 + s mod t = 5.000000000000000000000000000000e-1 + k = 4 + + s= 1.250000000000000000000000000000e+1 + exp= 4 + = 7.812500000000000000000000000000e-1 + s= 1.250000000000000000000000000000e+1 +*/ diff --git a/xarm/test/txfrex.c b/xarm/test/txfrex.c new file mode 100644 index 0000000..8156080 --- /dev/null +++ b/xarm/test/txfrex.c @@ -0,0 +1,49 @@ +/* txfrex.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xfrex xpr2 + + Uses: atox prxpr + + Input file: xfrex.dat +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(int na,char **av) +{ struct xpr s; int e; + char str[64]; FILE *fp; + if(na!=2){ printf("para: data_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + while(fscanf(fp,"%s",str)!=EOF){ + s=atox(str); + printf(" s-in="); prxpr(s,decd); + +/* extract exponent of extended precision number */ + s=xfrex(s,&e); + + printf(" exp= %d\n",e); + printf(" = "); prxpr(s,decd); + +/* restore exponent of extended precision number */ + s=xpr2(s,e); + + printf(" s1= "); prxpr(s,decd); + } +} +/* Test output + + s-in= 1.234500000000000000000000000000e+0 + exp= 1 + = 6.172500000000000000000000000000e-1 + s1= 1.234500000000000000000000000000e+0 + s-in= -2.123450987654321000000000000000e+0 + exp= 2 + = -5.308627469135802500000000000000e-1 + s1= -2.123450987654321000000000000000e+0 +*/ diff --git a/xarm/test/txhypb.c b/xarm/test/txhypb.c new file mode 100644 index 0000000..5a4fc5f --- /dev/null +++ b/xarm/test/txhypb.c @@ -0,0 +1,92 @@ +/* txhypb.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xtanh xsinh xcosh + + Uses: atox xprcmp xadd xtodub prxpr + +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(void) +{ struct xpr z,w,f,u; int k; char cf[3]; + cf[0]='s'; cf[1]='c'; cf[2]='t'; + for(k=0; k<3 ;++k){ + switch(cf[k]){ + case 't': printf(" Test of Tanh Function\n"); break; + case 's': printf(" Test of Sinh Function\n"); break; + case 'c': printf(" Test of Cosh Function\n"); break; + } + z=zero; w=atox("0.2"); u=atox("3.01"); + for(; xprcmp(&z,&u)<0 ;z=xadd(z,w,0)){ + +/* compute selected extended precision hyperbolic function */ + switch(cf[k]){ + case 't': f=xtanh(z); break; + case 's': f=xsinh(z); break; + case 'c': f=xcosh(z); break; + } + printf(" %8.4f ",xtodub(z)); prxpr(f,decd); + } + } +} +/* Test output + + Test of Sinh Function + 0.0000 0.000000000000000000000000000000e+0 + 0.2000 2.013360025410939876255682430103e-1 + 0.4000 4.107523258028155085402100138447e-1 + 0.6000 6.366535821482412711234543754651e-1 + 0.8000 8.881059821876230065747175731898e-1 + 1.0000 1.175201193643801456882381850596e+0 + 1.2000 1.509461355412172696442894911259e+0 + 1.4000 1.904301501451534055142123827697e+0 + 1.6000 2.375567953200229697584553544390e+0 + 1.8000 2.942174288095679772717109616299e+0 + 2.0000 3.626860407847018767668213983010e+0 + 2.2000 4.457105170535893521568816370519e+0 + 2.4000 5.466229213676094574431383774794e+0 + 2.6000 6.694732228393678258661307381207e+0 + 2.8000 8.191918354235915953251197311373e+0 + 3.0000 1.001787492740990189897459362002e+1 + Test of Cosh Function + 0.0000 1.000000000000000000000000000000e+0 + 0.2000 1.020066755619075846295503751629e+0 + 0.4000 1.081072371838454809284642938993e+0 + 0.6000 1.185465218242267703751913292698e+0 + 0.8000 1.337434946304844598004819958206e+0 + 1.0000 1.543080634815243778477905620822e+0 + 1.2000 1.810655567324374793087872518342e+0 + 1.4000 2.150898465393140532081985067531e+0 + 1.6000 2.577464471194885106069732812034e+0 + 1.8000 3.107473176317266311013914336731e+0 + 2.0000 3.762195691083631459562213477975e+0 + 2.2000 4.567908328898227404902960796369e+0 + 2.4000 5.556947166965507077806555994874e+0 + 2.6000 6.769005806608012139089517951377e+0 + 2.8000 8.252728416861133918246818699557e+0 + 3.0000 1.006766199577776584195393603567e+1 + Test of Tanh Function + 0.0000 0.000000000000000000000000000000e+0 + 0.2000 1.973753202249040007381573188110e-1 + 0.4000 3.799489622552248852677481238969e-1 + 0.6000 5.370495669980352858618253049269e-1 + 0.8000 6.640367702678489636848446564011e-1 + 1.0000 7.615941559557648881194582828631e-1 + 1.2000 8.336546070121552586740951218123e-1 + 1.4000 8.853516482022625075834176520256e-1 + 1.6000 9.216685544064712826832642230893e-1 + 1.8000 9.468060128462682896463983148048e-1 + 2.0000 9.640275800758168839464137241878e-1 + 2.2000 9.757431300314515204143066680301e-1 + 2.4000 9.836748576936802096397291499339e-1 + 2.6000 9.890274022010991893409624367582e-1 + 2.8000 9.926315202011280244806136325760e-1 + 3.0000 9.950547536867304513318801852555e-1 +*/ diff --git a/xarm/test/txivtrg.c b/xarm/test/txivtrg.c new file mode 100644 index 0000000..8c53c60 --- /dev/null +++ b/xarm/test/txivtrg.c @@ -0,0 +1,89 @@ +/* txivtrg.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xatan xasin xacos + + Uses: xtan xsin xcos dubtox prxpr +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(void) +{ struct xpr z,f,c; int k; + printf(" Test of Inverse Trig Functions\n"); + printf("\n Atan:\n"); + for(k=0; k<3 ;++k){ + switch(k){ + case 0: z=dubtox(.5); break; + case 1: z=dubtox(1.); break; + case 2: z=dubtox(-2.); break; + } + +/* compute extended precision arctangent and tangent */ + f=xatan(z); c=xtan(f); + + printf(" %8.4f ",xtodub(z)); prxpr(f,decd); + printf(" check tan= "); prxpr(c,decd); + } + printf("\n Asin:\n"); + for(k=0; k<3 ;++k){ + switch(k){ + case 0: z=dubtox(.5); break; + case 1: z=dubtox(.75); break; + case 2: z=dubtox(.25); break; + } + +/* compute extended precision arcsin and sine */ + f=xasin(z); c=xsin(f); + + printf(" %8.4f ",xtodub(z)); prxpr(f,decd); + printf(" check sin= "); prxpr(c,decd); + } + printf("\n Acos:\n"); + for(k=0; k<3 ;++k){ + switch(k){ + case 0: z=dubtox(.5); break; + case 1: z=dubtox(.75); break; + case 2: z=dubtox(.25); break; + } + +/* compute extended precision arccos and cosine */ + f=xacos(z); c=xcos(f); + + printf(" %8.4f ",xtodub(z)); prxpr(f,decd); + printf(" check cos= "); prxpr(c,decd); + } +} +/* Test output + + Test of Inverse Trig Functions + + Atan: + 0.5000 4.636476090008061162142562314612e-1 + check tan= 5.000000000000000000000000000000e-1 + 1.0000 7.853981633974483096156608458199e-1 + check tan= 1.000000000000000000000000000000e+0 + -2.0000 -1.107148717794090503017065460179e+0 + check tan= -2.000000000000000000000000000000e+0 + + Asin: + 0.5000 5.235987755982988730771072305466e-1 + check sin= 5.000000000000000000000000000000e-1 + 0.7500 8.480620789814810080529443389984e-1 + check sin= 7.500000000000000000000000000000e-1 + 0.2500 2.526802551420786534856574369937e-1 + check sin= 2.500000000000000000000000000000e-1 + + Acos: + 0.5000 1.047197551196597746154214461093e+0 + check cos= 5.000000000000000000000000000000e-1 + 0.7500 7.227342478134156111783773526413e-1 + check cos= 7.500000000000000000000000000000e-1 + 0.2500 1.318116071652817965745664254646e+0 + check cos= 2.500000000000000000000000000000e-1 +*/ diff --git a/xarm/test/txlog.c b/xarm/test/txlog.c new file mode 100644 index 0000000..8033337 --- /dev/null +++ b/xarm/test/txlog.c @@ -0,0 +1,66 @@ +/* txlog.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xlog xexp + + Uses: atox xprcmp xadd prxpr +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(void) +{ struct xpr z,h,f,w,u; + printf(" Test of Log Function\n"); + h=atox(".25"); z=h; w=atox("4.01"); + for(; xprcmp(&z,&w)<0 ;z=xadd(z,h,0)){ + +/* compute extended precision natural logarithm */ + f=xlog(z); + printf(" %8.4f ",xtodub(z)); prxpr(f,decd); + +/* check using exponential */ + u=xexp(f); + printf(" exp(z) "); prxpr(u,decd); + } +} +/* Test output + + Test of Log Function + 0.2500 -1.386294361119890618834464242916e+0 + exp(z) 2.500000000000000000000000000000e-1 + 0.5000 -6.931471805599453094172321214582e-1 + exp(z) 5.000000000000000000000000000000e-1 + 0.7500 -2.876820724517809274392190059938e-1 + exp(z) 7.500000000000000000000000000000e-1 + 1.0000 -3.948156385993833498764754782299e-33 + exp(z) 1.000000000000000000000000000000e+0 + 1.2500 2.231435513142097557662950903098e-1 + exp(z) 1.250000000000000000000000000000e+0 + 1.5000 4.054651081081643819780131154643e-1 + exp(z) 1.500000000000000000000000000000e+0 + 1.7500 5.596157879354226862708885005268e-1 + exp(z) 1.750000000000000000000000000000e+0 + 2.0000 6.931471805599453094172321214582e-1 + exp(z) 2.000000000000000000000000000000e+0 + 2.2500 8.109302162163287639560262309287e-1 + exp(z) 2.250000000000000000000000000001e+0 + 2.5000 9.162907318741550651835272117680e-1 + exp(z) 2.500000000000000000000000000019e+0 + 2.7500 1.011600911678479925227479335049e+0 + exp(z) 2.750000000000000000000000000000e+0 + 3.0000 1.098612288668109691395245236923e+0 + exp(z) 3.000000000000000000000000000000e+0 + 3.2500 1.178654996341646117219023198649e+0 + exp(z) 3.250000000000000000000000000000e+0 + 3.5000 1.252762968495367995688120621985e+0 + exp(z) 3.500000000000000000000000000000e+0 + 3.7500 1.321755839982319447161540327232e+0 + exp(z) 3.750000000000000000000000000000e+0 + 4.0000 1.386294361119890618834464242916e+0 + exp(z) 4.000000000000000000000000000000e+0 +*/ diff --git a/xarm/test/txprcmp.c b/xarm/test/txprcmp.c new file mode 100644 index 0000000..67cc999 --- /dev/null +++ b/xarm/test/txprcmp.c @@ -0,0 +1,59 @@ +/* txprcmp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xprcmp + + Uses: atox prxpr + + Input file: data/xcmp.dat +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(int na,char **av) +{ struct xpr s,t; int c; + char nbx[64],nby[64]; + FILE *fp; + if(na!=2){ printf("para: input_file\n"); exit(-1);} + fp=fopen(*++av,"r"); + printf(" Test of Extended Precision Comparison\n"); + while(fscanf(fp,"%s %s",nbx,nby)!=EOF){ + s=atox(nbx); t=atox(nby); + printf(" x= "); prxpr(s,decd); + printf(" y= "); prxpr(t,decd); + + printf("compare x and y\n"); + +/* extended precision comparison */ + c=xprcmp(&s,&t); + + if(c==1) printf(" x > y\n"); + else if(c== -1) printf(" x < y\n"); + else printf(" x = y\n"); + } +} +/* Test output + + Test of Extended Precision Comparison + x= 1.250000000000000000000000000000e+0 + y= 2.730000000000000000000000000000e+1 +compare x and y + x < y + x= -1.210000000000000000000000000000e-1 + y= 5.431000000000000000000000000000e-2 +compare x and y + x < y + x= 1.110000000000000000000000000000e+1 + y= -2.765400000000000000000000000000e+1 +compare x and y + x > y + x= -1.030000000000000000000000000000e-3 + y= -1.030000000000000000000000000000e-3 +compare x and y + x = y +*/ diff --git a/xarm/test/txpwr.c b/xarm/test/txpwr.c new file mode 100644 index 0000000..d0a504d --- /dev/null +++ b/xarm/test/txpwr.c @@ -0,0 +1,43 @@ +/* txpwr.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xpwr + + Uses: atox prxpr + + Input parameters: test_num -> extended precision: test number + max_pwr -> integer: maximum power computed +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(int na,char **av) +{ struct xpr s,t; + int i,m; + if(na!=3){ printf("para: test_num max_pwr\n"); exit(-1);} + printf(" Test of Extended Precision Integer Powers\n"); + s=atox(*++av); m=atoi(*++av); + printf(" input s= "); prxpr(s,decd); + for(i=2; i<=m ;++i){ + +/* compute ith power of input number */ + t=xpwr(s,i); + + printf(" s^%d = ",i); prxpr(t,decd); + } +} +/* Test output + + Test of Extended Precision Integer Powers + input s= -7.000000000000000000000000000000e-1 + s^2 = 4.900000000000000000000000000000e-1 + s^3 = -3.430000000000000000000000000000e-1 + s^4 = 2.401000000000000000000000000000e-1 + s^5 = -1.680700000000000000000000000000e-1 + s^6 = 1.176490000000000000000000000000e-1 +*/ diff --git a/xarm/test/txsqrt.c b/xarm/test/txsqrt.c new file mode 100644 index 0000000..27cf318 --- /dev/null +++ b/xarm/test/txsqrt.c @@ -0,0 +1,52 @@ +/* txsqrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xsqrt + + Uses: atox xprcmp xadd xtodub prxpr +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(void) +{ struct xpr z,w,f,u; + printf(" Test of Sqrt Function\n"); + z=zero; w=atox("0.2"); u=atox("4.01"); + for(; xprcmp(&z,&u)<0 ;z=xadd(z,w,0)){ + +/* compute extended precision square root */ + f=xsqrt(z); + + printf(" %8.4f ",xtodub(z)); prxpr(f,decd); + } +} +/* Test output + + Test of Sqrt Function + 0.0000 0.000000000000000000000000000000e+0 + 0.2000 4.472135954999579392818347337463e-1 + 0.4000 6.324555320336758663997787088865e-1 + 0.6000 7.745966692414833770358530799565e-1 + 0.8000 8.944271909999158785636694674925e-1 + 1.0000 1.000000000000000000000000000000e+0 + 1.2000 1.095445115010332226913939565602e+0 + 1.4000 1.183215956619923208513465658312e+0 + 1.6000 1.264911064067351732799557417773e+0 + 1.8000 1.341640786499873817845504201239e+0 + 2.0000 1.414213562373095048801688724210e+0 + 2.2000 1.483239697419132589742279488160e+0 + 2.4000 1.549193338482966754071706159913e+0 + 2.6000 1.612451549659709930473322646061e+0 + 2.8000 1.673320053068151095956344051570e+0 + 3.0000 1.732050807568877293527446341506e+0 + 3.2000 1.788854381999831757127338934985e+0 + 3.4000 1.843908891458577462000454856353e+0 + 3.6000 1.897366596101027599199336126660e+0 + 3.8000 1.949358868961792781367682639980e+0 + 4.0000 2.000000000000000000000000000000e+0 +*/ diff --git a/xarm/test/txtrig.c b/xarm/test/txtrig.c new file mode 100644 index 0000000..0a557b1 --- /dev/null +++ b/xarm/test/txtrig.c @@ -0,0 +1,92 @@ +/* txtrig.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +/* + Test: xtan xsin xcos + + Uses: atox xprcmp xadd xtodub prxpr + +*/ +#define XMATH 1 +#include "ccmath.h" +int decd=30; +void main(void) +{ struct xpr z,w,f,u; char cf[3]; int k; + cf[0]='s'; cf[1]='c'; cf[2]='t'; + for(k=0; k<3 ;++k){ + switch(cf[k]){ + case 't': printf(" Test of Tan Function\n"); break; + case 's': printf(" Test of Sin Function\n"); break; + case 'c': printf(" Test of Cos Function\n"); break; + } + z=zero; w=atox("0.2"); u=atox("3.01"); + for(; xprcmp(&z,&u)<0 ;z=xadd(z,w,0)){ + +/* compute trigonometric test function */ + switch(cf[k]){ + case 't': f=xtan(z); break; + case 's': f=xsin(z); break; + case 'c': f=xcos(z); break; + } + printf(" %8.4f ",xtodub(z)); prxpr(f,decd); + } + } +} +/* Test output + + Test of Sin Function + 0.0000 0.000000000000000000000000000000e+0 + 0.2000 1.986693307950612154594126271184e-1 + 0.4000 3.894183423086504916663117567957e-1 + 0.6000 5.646424733950353572009454456587e-1 + 0.8000 7.173560908995227616271746105814e-1 + 1.0000 8.414709848078965066525023216303e-1 + 1.2000 9.320390859672263496701344354948e-1 + 1.4000 9.854497299884601806594745788061e-1 + 1.6000 9.995736030415051643421138255462e-1 + 1.8000 9.738476308781951865323731788434e-1 + 2.0000 9.092974268256816953960198659117e-1 + 2.2000 8.084964038195901843040369104161e-1 + 2.4000 6.754631805511509265657715253413e-1 + 2.6000 5.155013718214642352577269352094e-1 + 2.8000 3.349881501559049195438537527124e-1 + 3.0000 1.411200080598672221007448028081e-1 + Test of Cos Function + 0.0000 1.000000000000000000000000000000e+0 + 0.2000 9.800665778412416311241965167482e-1 + 0.4000 9.210609940028850827985267320518e-1 + 0.6000 8.253356149096782972409524989554e-1 + 0.8000 6.967067093471654209207499816423e-1 + 1.0000 5.403023058681397174009366074430e-1 + 1.2000 3.623577544766735776383733556231e-1 + 1.4000 1.699671429002409386167480352036e-1 + 1.6000 -2.919952230128872620577046294650e-2 + 1.8000 -2.272020946930870553166743065306e-1 + 2.0000 -4.161468365471423869975682295008e-1 + 2.2000 -5.885011172553457085241426126549e-1 + 2.4000 -7.373937155412454996088222273348e-1 + 2.6000 -8.568887533689472337977021516452e-1 + 2.8000 -9.422223406686581525867881173662e-1 + 3.0000 -9.899924966004454572715727947313e-1 + Test of Tan Function + 0.0000 0.000000000000000000000000000000e+0 + 0.2000 2.027100355086724833213582716475e-1 + 0.4000 4.227932187381617619816354271653e-1 + 0.6000 6.841368083416923170709254174633e-1 + 0.8000 1.029638557050364012746361172820e+0 + 1.0000 1.557407724654902230506974807458e+0 + 1.2000 2.572151622126318935409994236033e+0 + 1.4000 5.797883715482889643707720243604e+0 + 1.6000 -3.423253273555741705801487543048e+1 + 1.8000 -4.286261674628063525451888952280e+0 + 2.0000 -2.185039863261518991643306102314e+0 + 2.2000 -1.373823056768795160140036763333e+0 + 2.4000 -9.160142896734105127308632475081e-1 + 2.6000 -6.015966130897587227360818926913e-1 + 2.8000 -3.555298316511758775773526036354e-1 + 3.0000 -1.425465430742778052956354105339e-1 +*/ diff --git a/xarm/xadd.c b/xarm/xadd.c new file mode 100644 index 0000000..b17b728 --- /dev/null +++ b/xarm/xadd.c @@ -0,0 +1,34 @@ +/* xadd.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xadd(struct xpr s,struct xpr t,int f) +{ unsigned short pe[XDIM+1],*pa,*pb,*pc,*pf=pe,h,u; + unsigned int n=0; short e,k; + pa=(unsigned short *)&s; pb=(unsigned short *)&t; + e= *pa&m_exp; k= *pb&m_exp; if(f) *pb^=m_sgn; + u=(*pb ^ *pa)&m_sgn; f=0; + if(e>k){ if((k=e-k)>=max_p) return s; rshift(k,pb+1,XDIM);} + else if(e=max_p) return t; + rshift(e,pa+1,XDIM); e=k; pc=pa; pa=pb; pb=pc;} + else if(u){ for(pc=pa,pf=pb; *++pc== *++pf && f=XDIM) return zero; if(*pc<*pf){ pc=pa; pa=pb; pb=pc;} + pf=pe+f; } + h= *pa&m_sgn; + if(u){ for(pc=pb+XDIM; pc>pb ;--pc) *pc= ~(*pc); n=1L;} + for(pc=pe+XDIM,pa+=XDIM,pb+=XDIM; pc>pf ;){ + n+= *pa--; n+= *pb--; *pc-- =n; n>>=16; + } + if(u){ for(; *++pc==0 ;++f); + for(k=0; !((*pc<n) i=2*n-i; + c[k]=xadd(c[k],xmul(a,cs[i]),0); + } + } + b=xpr2(xdiv(one,inttox(m)),1); + for(j=0; ja ;){ + f=xadd(*p--,xadd(xmul(w,t),tp,1),0); + tp=t; t=f; + } + return xadd(*p,xadd(xmul(z,t),tp,1),0); +} diff --git a/xarm/xexp.c b/xarm/xexp.c new file mode 100644 index 0000000..a942b55 --- /dev/null +++ b/xarm/xexp.c @@ -0,0 +1,22 @@ +/* xexp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xexp(struct xpr z) +{ struct xpr s,d,f; int m,k; + if(neg(&z)) m=1; else m=0; + z=sfmod(z,&k); if(m) k= -k; + if(xex(&z)> -bias){ + z=xpr2(z,-1); s=xmul(z,z); f=zero; + for(d=inttox(m=ms_exp); m>1 ;){ + f=xdiv(s,xadd(d,f,0)); d=inttox(m-=2); } + f=xdiv(z,xadd(d,f,0)); + f=xdiv(xadd(d,f,0),xadd(d,f,1)); + } + else f=one; + if(k) return xmul(f,xpwr(ee,k)); else return f; +} diff --git a/xarm/xfmod.c b/xarm/xfmod.c new file mode 100644 index 0000000..8632e07 --- /dev/null +++ b/xarm/xfmod.c @@ -0,0 +1,26 @@ +/* xfmod.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xfmod(struct xpr s,struct xpr t,int *p) +{ struct xpr h; unsigned short *q,*ph; short k; + h=xdiv(s,t); ph=(unsigned short *)&h; k=(*ph&m_exp)-bias; + if(k>=0){ rshift(31-k,ph+1,2); + q=(unsigned short *)p; + *(q+1)= *(ph+1); *q= *(ph+2); + } + else *p=0; + if(*p){ if(*ph&m_sgn) s=xadd(s,xmul(t,inttox(*p)),0); + else s=xadd(s,xmul(t,inttox(*p)),1); + } + return s; +} +struct xpr xfrex(struct xpr s,int *p) +{ unsigned short *ps=(unsigned short *)&s,u; + *p=(*ps&m_exp)-bias+1; u= *ps&m_sgn; + *ps=bias-1; *ps|=u; return s; +} diff --git a/xarm/xhypb.c b/xarm/xhypb.c new file mode 100644 index 0000000..a47d88c --- /dev/null +++ b/xarm/xhypb.c @@ -0,0 +1,31 @@ +/* xhypb.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xtanh(struct xpr z) +{ struct xpr s,d,f; int m,k; + if((k=xex(&z))>k_tanh){ + if(neg(&z)) return xneg(one); else return one;} + if(k0) z=xpr2(z,-k); s=xmul(z,z); f=zero; + for(d=inttox(m=ms_hyp); m>1 ;){ + f=xdiv(s,xadd(d,f,0)); d=inttox(m-=2); } + f=xdiv(z,xadd(d,f,0)); + for(; k>0 ;--k) f=xdiv(xpr2(f,1),xadd(d,xmul(f,f),0)); + return f; +} +struct xpr xsinh(struct xpr z) +{ int k; + if((k=xex(&z)) +struct xpr xatan(struct xpr z) +{ struct xpr s,f; int k,m; + if((k=xex(&z))=bias){ z=xdiv(one,z); m=1;} else m=0; + f=dubtox(atan(xtodub(z))); + s=xadd(one,xmul(z,z),0); + for(k=0; k -max_p ;){ + h=xmul(h,z); f=xadd(f,xdiv(h,inttox(k+=2)),0); + } + return xadd(f,xmul(ln2,dubtox(m-.5)),0); +} diff --git a/xarm/xmath.h b/xarm/xmath.h new file mode 100644 index 0000000..0df29f0 --- /dev/null +++ b/xarm/xmath.h @@ -0,0 +1,9 @@ +/* xmath.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +#include "constant.h" diff --git a/xarm/xmul.c b/xarm/xmul.c new file mode 100644 index 0000000..ba1bf24 --- /dev/null +++ b/xarm/xmul.c @@ -0,0 +1,25 @@ +/* xmul.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xmul(struct xpr s,struct xpr t) +{ unsigned short pe[XDIM+2],*pa,*pb,*pc,*q0,*q1,h; + unsigned int m,n,p; short k,e; + q0=(unsigned short *)&s; q1=(unsigned short *)&t; + e=(*q0&m_exp)-bias; k=(*q1&m_exp)+1; + if(e>(short)m_exp-k) return x_huge; if((e+=k)<=0) return zero; + h=(*q0 ^ *q1)&m_sgn; + for(++q1,k=XDIM,p=n=0L,pc=pe+XDIM+1; k>0 ;--k){ + for(pa=q0+k,pb=q1; pa>q0 ;){ + m= *pa--; m*= *pb++; n+=(m&0xffffL); p+=(m>>16); } + *pc-- =n; n=p+(n>>16); p=0L; + } + *pc=n; + if(!(*pc&m_sgn)){ --e; if(e<=0) return zero; lshift(1,pc,XDIM+1);} + if(e==(short)m_exp) return x_huge; + *pe=e; *pe|=h; return *(struct xpr *)pe; +} diff --git a/xarm/xneg.c b/xarm/xneg.c new file mode 100644 index 0000000..1c5fb17 --- /dev/null +++ b/xarm/xneg.c @@ -0,0 +1,24 @@ +/* xneg.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xneg(struct xpr s) +{ unsigned short *p=(unsigned short *)&s; + *p^=m_sgn; return s; +} +struct xpr xabs(struct xpr s) +{ unsigned short *p=(unsigned short *)&s; + *p&=m_exp; return s; +} +int xex(struct xpr *ps) +{ unsigned short *q=(unsigned short *)ps; + return (*q&m_exp)-bias; +} +int neg(struct xpr *ps) +{ unsigned short *q=(unsigned short *)ps; + return (*q&m_sgn); +} diff --git a/xarm/xprcmp.c b/xarm/xprcmp.c new file mode 100644 index 0000000..35981e9 --- /dev/null +++ b/xarm/xprcmp.c @@ -0,0 +1,20 @@ +/* xprcmp.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +int xprcmp(struct xpr *pa,struct xpr *pb) +{ unsigned short e,k,*p,*q; int m; + p=(unsigned short *)pa; e= *p&m_sgn; + q=(unsigned short *)pb; k= *q&m_sgn; + if(e && !k) return -1; if(!e && k) return 1; + if(e) m= -1; else m=1; + e= *p&m_exp; k= *q&m_exp; + if(e>k) return m; if(e *q) return m; else return -m;} + return 0; +} diff --git a/xarm/xpre.h b/xarm/xpre.h new file mode 100644 index 0000000..810c9ec --- /dev/null +++ b/xarm/xpre.h @@ -0,0 +1,52 @@ +/* xpre.h CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#define XDIM 7 +struct xpr {unsigned short nmm[XDIM+1];}; +extern unsigned short m_sgn,m_exp; +extern short bias; +extern int itt_div,k_tanh; +extern int ms_exp,ms_trg,ms_hyp; +extern short max_p,k_lin; +extern short d_bias,d_max,d_lex; +extern struct xpr zero,one,two,ten; +extern struct xpr x_huge; +extern struct xpr pi,pi2,pi4; +extern struct xpr ee,srt2,ln2; +struct xpr xadd(struct xpr a,struct xpr b,int k); +struct xpr xmul(struct xpr s,struct xpr t); +struct xpr xdiv(struct xpr s,struct xpr t); +struct xpr atox(char *s); +struct xpr dubtox(double y); +struct xpr inttox(int n); +int xprcmp(struct xpr *p,struct xpr *q); +int neg(struct xpr *p); +int xex(struct xpr *p); +struct xpr sfmod(struct xpr t,int *p); +struct xpr xpwr(struct xpr s,int n); +struct xpr xpr2(struct xpr s,int n); +struct xpr xneg(struct xpr s); +struct xpr xabs(struct xpr s); +struct xpr xfrex(struct xpr s,int *p); +struct xpr xfmod(struct xpr s,struct xpr t,int *p); +double xtodub(struct xpr s); +struct xpr xtan(struct xpr x); +struct xpr xsin(struct xpr x); +struct xpr xcos(struct xpr x); +struct xpr xatan(struct xpr a); +struct xpr xasin(struct xpr a); +struct xpr xacos(struct xpr a); +struct xpr xsqrt(struct xpr u); +struct xpr xexp(struct xpr u); +struct xpr xlog(struct xpr u); +struct xpr xtanh(struct xpr v); +struct xpr xsinh(struct xpr v); +struct xpr xcosh(struct xpr v); +void prxpr(struct xpr u,int m); +void xprint(struct xpr u); +void lshift(int i,unsigned short *p,int k); +void rshift(int i,unsigned short *p,int k); diff --git a/xarm/xpwr.c b/xarm/xpwr.c new file mode 100644 index 0000000..28d43cd --- /dev/null +++ b/xarm/xpwr.c @@ -0,0 +1,21 @@ +/* xpwr.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +struct xpr xpwr(struct xpr s,int n) +{ struct xpr t; unsigned k,m; + t=one; + if(n<0){ m= -n; s=xdiv(one,s);} else m=n; + if(m){ for(k=1; k<=m ;k<<=1){ + if((k&m)) t=xmul(s,t); s=xmul(s,s); } + } + return t; +} +struct xpr xpr2(struct xpr s,int m) +{ unsigned short *p=(unsigned short *)&s; + *p+=m; return s; +} diff --git a/xarm/xsqrt.c b/xarm/xsqrt.c new file mode 100644 index 0000000..b59ef8c --- /dev/null +++ b/xarm/xsqrt.c @@ -0,0 +1,22 @@ +/* xsqrt.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +#include +struct xpr xsqrt(struct xpr z) +{ struct xpr s,h; short m,e; unsigned short *pc; + if(neg(&z)){ printf("xsqrt range error\n"); return zero;} + pc=(unsigned short *)&z; + if(*pc==0) return zero; + e= *pc-bias; *pc=bias+(e%2); e/=2; + s=dubtox(sqrt(xtodub(z))); + for(m=0; m +double xtodub(struct xpr s) +{ unsigned short pe[4],*pc,u; short i,e; + pc=(unsigned short *)&s; + u= *pc&m_sgn; e=(*pc&m_exp)-d_bias; + if(e>=d_max) return HUGE_VAL; if(e<=0) return 0.; + for(i=0; i<4 ;) pe[i++]= *++pc; + pe[0]&=m_exp; rshift(d_lex-1,pe,4); + pe[0]|=(e<<(16-d_lex)); pe[0]|=u; + u=pe[3]; pe[3]=pe[0]; pe[0]=u; + u=pe[2]; pe[2]=pe[1]; pe[1]=u; + return *(double *)pe; +} +struct xpr dubtox(double y) +{ unsigned short pe[XDIM+1],*pc,u; short i,e; + pc=(unsigned short *)&y; pc+=3; + u= *pc&m_sgn; e=d_bias+((*pc&m_exp)>>(16-d_lex)); + for(i=1; i<5 ;) pe[i++]= *pc--; while(i<=XDIM) pe[i++]=0; + pc=pe+1; lshift(d_lex-1,pc,4); *pc|=m_sgn; + *pe=e; *pe|=u; return *(struct xpr *)pe; +} +struct xpr inttox(int n) +{ unsigned short pe[XDIM+1],*pc; short e; + unsigned k,h; + pc=(unsigned short *)&k; + for(e=0; e<=XDIM ;) pe[e++]=0; + if(n==0) return *(struct xpr *)pe; + k=abs(n); *(pe+1)= *(pc+1); *(pe+2)= *pc; + for(e=0,h=1; h<=k ;h<<=1,++e); + *pe=bias+e-1; if(n<0) *pe|=m_sgn; + lshift(32-e,pe+1,XDIM); return *(struct xpr *)pe; +} diff --git a/xarm/xtrig.c b/xarm/xtrig.c new file mode 100644 index 0000000..0d4cb3a --- /dev/null +++ b/xarm/xtrig.c @@ -0,0 +1,51 @@ +/* xtrig.c CCMATH mathematics library source code. + * + * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. + * This code may be redistributed under the terms of the GNU library + * public license (LGPL). ( See the lgpl.license file for details.) + * ------------------------------------------------------------------------ + */ +#include "xpre.h" +static struct xpr ctan(struct xpr u); +static struct xpr rred(struct xpr u,int i,int *p); +struct xpr xtan(struct xpr z) +{ int k,m; + z=rred(z,'t',&k); + if(xprcmp(&z,&pi4)==1){ m=1; z=xadd(pi2,z,1);} else m=0; + if(k&1) z=xneg(ctan(z)); else z=ctan(z); + if(m) return xdiv(one,z); else return z; +} +struct xpr xcos(struct xpr z) +{ int k; + z=rred(z,'c',&k); + if(xex(&z)1 ;){ + f=xdiv(s,xadd(d,f,0)); d=inttox(m-=2); } + return xdiv(z,xadd(d,f,0)); +} +static struct xpr rred(struct xpr z,int kf,int *ps) +{ int is; + if(neg(&z)){ z=xneg(z); is=1;} else is=0; + z=xfmod(z,pi,ps); + if(kf=='t') *ps=is; else if(kf=='s') *ps+=is; + if(xprcmp(&z,&pi2)==1){ + z=xadd(pi,z,1); + if(kf=='c' || kf=='t') ++(*ps); + } + return z; +}