xref: /csrg-svn/usr.bin/spline/spline.c (revision 1099)
1*1099Sbill static char *sccsid = "@(#)spline.c	4.1 (Berkeley) 10/01/80";
2*1099Sbill #include <stdio.h>
3*1099Sbill 
4*1099Sbill #define NP 1000
5*1099Sbill #define INF 1.e37
6*1099Sbill 
7*1099Sbill struct proj { int lbf,ubf; float a,b,lb,ub,quant,mult,val[NP]; } x,y;
8*1099Sbill float *diag, *r;
9*1099Sbill float dx = 1.;
10*1099Sbill float ni = 100.;
11*1099Sbill int n;
12*1099Sbill int auta;
13*1099Sbill int periodic;
14*1099Sbill float konst = 0.0;
15*1099Sbill float zero = 0.;
16*1099Sbill 
17*1099Sbill /* Spline fit technique
18*1099Sbill let x,y be vectors of abscissas and ordinates
19*1099Sbill     h   be vector of differences h9i8=x9i8-x9i-1988
20*1099Sbill     y"  be vector of 2nd derivs of approx function
21*1099Sbill If the points are numbered 0,1,2,...,n+1 then y" satisfies
22*1099Sbill (R W Hamming, Numerical Methods for Engineers and Scientists,
23*1099Sbill 2nd Ed, p349ff)
24*1099Sbill 	h9i8y"9i-1988+2(h9i8+h9i+18)y"9i8+h9i+18y"9i+18
25*1099Sbill 
26*1099Sbill 	= 6[(y9i+18-y9i8)/h9i+18-(y9i8-y9i-18)/h9i8]   i=1,2,...,n
27*1099Sbill 
28*1099Sbill where y"908 = y"9n+18 = 0
29*1099Sbill This is a symmetric tridiagonal system of the form
30*1099Sbill 
31*1099Sbill 	| a918 h928               |  |y"918|      |b918|
32*1099Sbill 	| h928 a928 h938            |  |y"928|      |b928|
33*1099Sbill 	|    h938 a938 h948         |  |y"938|  =   |b938|
34*1099Sbill 	|         .           |  | .|      | .|
35*1099Sbill 	|            .        |  | .|      | .|
36*1099Sbill It can be triangularized into
37*1099Sbill 	| d918 h928               |  |y"918|      |r918|
38*1099Sbill 	|    d928 h938            |  |y"928|      |r928|
39*1099Sbill 	|       d938 h948         |  |y"938|  =   |r938|
40*1099Sbill 	|          .          |  | .|      | .|
41*1099Sbill 	|             .       |  | .|      | .|
42*1099Sbill where
43*1099Sbill 	d918 = a918
44*1099Sbill 
45*1099Sbill 	r908 = 0
46*1099Sbill 
47*1099Sbill 	d9i8 = a9i8 - h9i8829/d9i-18	1<i<_n
48*1099Sbill 
49*1099Sbill 	r9i8 = b9i8 - h9i8r9i-18/d9i-1i8	1<_i<_n
50*1099Sbill 
51*1099Sbill the back solution is
52*1099Sbill 	y"9n8 = r9n8/d9n8
53*1099Sbill 
54*1099Sbill 	y"9i8 = (r9i8-h9i+18y"9i+18)/d9i8	1<_i<n
55*1099Sbill 
56*1099Sbill superficially, d9i8 and r9i8 don't have to be stored for they can be
57*1099Sbill recalculated backward by the formulas
58*1099Sbill 
59*1099Sbill 	d9i-18 = h9i8829/(a9i8-d9i8)	1<i<_n
60*1099Sbill 
61*1099Sbill 	r9i-18 = (b9i8-r9i8)d9i-18/h9i8	1<i<_n
62*1099Sbill 
63*1099Sbill unhappily it turns out that the recursion forward for d
64*1099Sbill is quite strongly geometrically convergent--and is wildly
65*1099Sbill unstable going backward.
66*1099Sbill There's similar trouble with r, so the intermediate
67*1099Sbill results must be kept.
68*1099Sbill 
69*1099Sbill Note that n-1 in the program below plays the role of n+1 in the theory
70*1099Sbill 
71*1099Sbill Other boundary conditions_________________________
72*1099Sbill 
73*1099Sbill The boundary conditions are easily generalized to handle
74*1099Sbill 
75*1099Sbill 	y908" = ky918", y9n+18"   = ky9n8"
76*1099Sbill 
77*1099Sbill for some constant k.  The above analysis was for k = 0;
78*1099Sbill k = 1 fits parabolas perfectly as well as stright lines;
79*1099Sbill k = 1/2 has been recommended as somehow pleasant.
80*1099Sbill 
81*1099Sbill All that is necessary is to add h918 to a918 and h9n+18 to a9n8.
82*1099Sbill 
83*1099Sbill 
84*1099Sbill Periodic case_____________
85*1099Sbill 
86*1099Sbill To do this, add 1 more row and column thus
87*1099Sbill 
88*1099Sbill 	| a918 h928            h918 |  |y918"|     |b918|
89*1099Sbill 	| h928 a928 h938            |  |y928"|     |b928|
90*1099Sbill 	|    h938 a948 h948         |  |y938"|     |b938|
91*1099Sbill 	|                     |  | .|  =  | .|
92*1099Sbill 	|             .       |  | .|     | .|
93*1099Sbill 	| h918            h908 a908 |  | .|     | .|
94*1099Sbill 
95*1099Sbill where h908=_ h9n+18
96*1099Sbill 
97*1099Sbill The same diagonalization procedure works, except for
98*1099Sbill the effect of the 2 corner elements.  Let s9i8 be the part
99*1099Sbill of the last element in the i8th9 "diagonalized" row that
100*1099Sbill arises from the extra top corner element.
101*1099Sbill 
102*1099Sbill 		s918 = h918
103*1099Sbill 
104*1099Sbill 		s9i8 = -s9i-18h9i8/d9i-18	2<_i<_n+1
105*1099Sbill 
106*1099Sbill After "diagonalizing", the lower corner element remains.
107*1099Sbill Call t9i8 the bottom element that appears in the i8th9 colomn
108*1099Sbill as the bottom element to its left is eliminated
109*1099Sbill 
110*1099Sbill 		t918 = h918
111*1099Sbill 
112*1099Sbill 		t9i8 = -t9i-18h9i8/d9i-18
113*1099Sbill 
114*1099Sbill Evidently t9i8 = s9i8.
115*1099Sbill Elimination along the bottom row
116*1099Sbill introduces further corrections to the bottom right element
117*1099Sbill and to the last element of the right hand side.
118*1099Sbill Call these corrections u and v.
119*1099Sbill 
120*1099Sbill 	u918 = v918 = 0
121*1099Sbill 
122*1099Sbill 	u9i8 = u9i-18-s9i-18*t9i-18/d9i-18
123*1099Sbill 
124*1099Sbill 	v9i8 = v9i-18-r9i-18*t9i-18/d9i-18	2<_i<_n+1
125*1099Sbill 
126*1099Sbill The back solution is now obtained as follows
127*1099Sbill 
128*1099Sbill 	y"9n+18 = (r9n+18+v9n+18)/(d9n+18+s9n+18+t9n+18+u9n+18)
129*1099Sbill 
130*1099Sbill 	y"9i8 = (r9i8-h9i+18*y9i+18-s9i8*y9n+18)/d9i8	1<_i<_n
131*1099Sbill 
132*1099Sbill Interpolation in the interval x9i8<_x<_x9i+18 is by the formula
133*1099Sbill 
134*1099Sbill 	y = y9i8x9+8 + y9i+18x9-8 -(h8299i+18/6)[y"9i8(x9+8-x9+8839)+y"9i+18(x9-8-x9-8839)]
135*1099Sbill where
136*1099Sbill 	x9+8 = x9i+18-x
137*1099Sbill 
138*1099Sbill 	x9-8 = x-x9i8
139*1099Sbill */
140*1099Sbill 
141*1099Sbill float
142*1099Sbill rhs(i){
143*1099Sbill 	int i_;
144*1099Sbill 	double zz;
145*1099Sbill 	i_ = i==n-1?0:i;
146*1099Sbill 	zz = (y.val[i]-y.val[i-1])/(x.val[i]-x.val[i-1]);
147*1099Sbill 	return(6*((y.val[i_+1]-y.val[i_])/(x.val[i+1]-x.val[i]) - zz));
148*1099Sbill }
149*1099Sbill 
150*1099Sbill spline(){
151*1099Sbill 	float d,s,u,v,hi,hi1;
152*1099Sbill 	float h;
153*1099Sbill 	float D2yi,D2yi1,D2yn1,x0,x1,yy,a;
154*1099Sbill 	int end;
155*1099Sbill 	float corr;
156*1099Sbill 	int i,j,m;
157*1099Sbill 	if(n<3) return(0);
158*1099Sbill 	if(periodic) konst = 0;
159*1099Sbill 	d = 1;
160*1099Sbill 	r[0] = 0;
161*1099Sbill 	s = periodic?-1:0;
162*1099Sbill 	for(i=0;++i<n-!periodic;){	/* triangularize */
163*1099Sbill 		hi = x.val[i]-x.val[i-1];
164*1099Sbill 		hi1 = i==n-1?x.val[1]-x.val[0]:
165*1099Sbill 			x.val[i+1]-x.val[i];
166*1099Sbill 		if(hi1*hi<=0) return(0);
167*1099Sbill 		u = i==1?zero:u-s*s/d;
168*1099Sbill 		v = i==1?zero:v-s*r[i-1]/d;
169*1099Sbill 		r[i] = rhs(i)-hi*r[i-1]/d;
170*1099Sbill 		s = -hi*s/d;
171*1099Sbill 		a = 2*(hi+hi1);
172*1099Sbill 		if(i==1) a += konst*hi;
173*1099Sbill 		if(i==n-2) a += konst*hi1;
174*1099Sbill 		diag[i] = d = i==1? a:
175*1099Sbill 		    a - hi*hi/d;
176*1099Sbill 		}
177*1099Sbill 	D2yi = D2yn1 = 0;
178*1099Sbill 	for(i=n-!periodic;--i>=0;){	/* back substitute */
179*1099Sbill 		end = i==n-1;
180*1099Sbill 		hi1 = end?x.val[1]-x.val[0]:
181*1099Sbill 			x.val[i+1]-x.val[i];
182*1099Sbill 		D2yi1 = D2yi;
183*1099Sbill 		if(i>0){
184*1099Sbill 			hi = x.val[i]-x.val[i-1];
185*1099Sbill 			corr = end?2*s+u:zero;
186*1099Sbill 			D2yi = (end*v+r[i]-hi1*D2yi1-s*D2yn1)/
187*1099Sbill 				(diag[i]+corr);
188*1099Sbill 			if(end) D2yn1 = D2yi;
189*1099Sbill 			if(i>1){
190*1099Sbill 				a = 2*(hi+hi1);
191*1099Sbill 				if(i==1) a += konst*hi;
192*1099Sbill 				if(i==n-2) a += konst*hi1;
193*1099Sbill 				d = diag[i-1];
194*1099Sbill 				s = -s*d/hi;
195*1099Sbill 			}}
196*1099Sbill 		else D2yi = D2yn1;
197*1099Sbill 		if(!periodic) {
198*1099Sbill 			if(i==0) D2yi = konst*D2yi1;
199*1099Sbill 			if(i==n-2) D2yi1 = konst*D2yi;
200*1099Sbill 			}
201*1099Sbill 		if(end) continue;
202*1099Sbill 		m = hi1>0?ni:-ni;
203*1099Sbill 		m = 1.001*m*hi1/(x.ub-x.lb);
204*1099Sbill 		if(m<=0) m = 1;
205*1099Sbill 		h = hi1/m;
206*1099Sbill 		for(j=m;j>0||i==0&&j==0;j--){	/* interpolate */
207*1099Sbill 			x0 = (m-j)*h/hi1;
208*1099Sbill 			x1 = j*h/hi1;
209*1099Sbill 			yy = D2yi*(x0-x0*x0*x0)+D2yi1*(x1-x1*x1*x1);
210*1099Sbill 			yy = y.val[i]*x0+y.val[i+1]*x1 -hi1*hi1*yy/6;
211*1099Sbill 			printf("%f ",x.val[i]+j*h);
212*1099Sbill 			printf("%f\n",yy);
213*1099Sbill 			}
214*1099Sbill 		}
215*1099Sbill 	return(1);
216*1099Sbill 	}
217*1099Sbill readin() {
218*1099Sbill 	for(n=0;n<NP;n++){
219*1099Sbill 		if(auta) x.val[n] = n*dx+x.lb;
220*1099Sbill 		else if(!getfloat(&x.val[n])) break;
221*1099Sbill 		if(!getfloat(&y.val[n])) break; } }
222*1099Sbill 
223*1099Sbill getfloat(p)
224*1099Sbill 	float *p;{
225*1099Sbill 	char buf[30];
226*1099Sbill 	register c;
227*1099Sbill 	int i;
228*1099Sbill 	extern double atof();
229*1099Sbill 	for(;;){
230*1099Sbill 		c = getchar();
231*1099Sbill 		if (c==EOF) {
232*1099Sbill 			*buf = '\0';
233*1099Sbill 			return(0);
234*1099Sbill 		}
235*1099Sbill 		*buf = c;
236*1099Sbill 		switch(*buf){
237*1099Sbill 			case ' ':
238*1099Sbill 			case '\t':
239*1099Sbill 			case '\n':
240*1099Sbill 				continue;}
241*1099Sbill 		break;}
242*1099Sbill 	for(i=1;i<30;i++){
243*1099Sbill 		c = getchar();
244*1099Sbill 		if (c==EOF) {
245*1099Sbill 			buf[i] = '\0';
246*1099Sbill 			break;
247*1099Sbill 		}
248*1099Sbill 		buf[i] = c;
249*1099Sbill 		if('0'<=c && c<='9') continue;
250*1099Sbill 		switch(c) {
251*1099Sbill 			case '.':
252*1099Sbill 			case '+':
253*1099Sbill 			case '-':
254*1099Sbill 			case 'E':
255*1099Sbill 			case 'e':
256*1099Sbill 				continue;}
257*1099Sbill 		break; }
258*1099Sbill 	buf[i] = ' ';
259*1099Sbill 	*p = atof(buf);
260*1099Sbill 	return(1); }
261*1099Sbill 
262*1099Sbill getlim(p)
263*1099Sbill 	struct proj *p; {
264*1099Sbill 	int i;
265*1099Sbill 	for(i=0;i<n;i++) {
266*1099Sbill 		if(!p->lbf && p->lb>(p->val[i])) p->lb = p->val[i];
267*1099Sbill 		if(!p->ubf && p->ub<(p->val[i])) p->ub = p->val[i]; }
268*1099Sbill 	}
269*1099Sbill 
270*1099Sbill 
271*1099Sbill main(argc,argv)
272*1099Sbill 	char *argv[];{
273*1099Sbill 	extern char *malloc();
274*1099Sbill 	int i;
275*1099Sbill 	x.lbf = x.ubf = y.lbf = y.ubf = 0;
276*1099Sbill 	x.lb = INF;
277*1099Sbill 	x.ub = -INF;
278*1099Sbill 	y.lb = INF;
279*1099Sbill 	y.ub = -INF;
280*1099Sbill 	while(--argc > 0) {
281*1099Sbill 		argv++;
282*1099Sbill again:		switch(argv[0][0]) {
283*1099Sbill 		case '-':
284*1099Sbill 			argv[0]++;
285*1099Sbill 			goto again;
286*1099Sbill 		case 'a':
287*1099Sbill 			auta = 1;
288*1099Sbill 			numb(&dx,&argc,&argv);
289*1099Sbill 			break;
290*1099Sbill 		case 'k':
291*1099Sbill 			numb(&konst,&argc,&argv);
292*1099Sbill 			break;
293*1099Sbill 		case 'n':
294*1099Sbill 			numb(&ni,&argc,&argv);
295*1099Sbill 			break;
296*1099Sbill 		case 'p':
297*1099Sbill 			periodic = 1;
298*1099Sbill 			break;
299*1099Sbill 		case 'x':
300*1099Sbill 			if(!numb(&x.lb,&argc,&argv)) break;
301*1099Sbill 			x.lbf = 1;
302*1099Sbill 			if(!numb(&x.ub,&argc,&argv)) break;
303*1099Sbill 			x.ubf = 1;
304*1099Sbill 			break;
305*1099Sbill 		default:
306*1099Sbill 			fprintf(stderr, "Bad agrument\n");
307*1099Sbill 			exit(1);
308*1099Sbill 		}
309*1099Sbill 	}
310*1099Sbill 	if(auta&&!x.lbf) x.lb = 0;
311*1099Sbill 	readin();
312*1099Sbill 	getlim(&x);
313*1099Sbill 	getlim(&y);
314*1099Sbill 	i = (n+1)*sizeof(dx);
315*1099Sbill 	diag = (float *)malloc((unsigned)i);
316*1099Sbill 	r = (float *)malloc((unsigned)i);
317*1099Sbill 	if(r==NULL||!spline()) for(i=0;i<n;i++){
318*1099Sbill 		printf("%f ",x.val[i]);
319*1099Sbill 		printf("%f\n",y.val[i]); }
320*1099Sbill }
321*1099Sbill numb(np,argcp,argvp)
322*1099Sbill 	int *argcp;
323*1099Sbill 	float *np;
324*1099Sbill 	char ***argvp;{
325*1099Sbill 	double atof();
326*1099Sbill 	char c;
327*1099Sbill 	if(*argcp<=1) return(0);
328*1099Sbill 	c = (*argvp)[1][0];
329*1099Sbill 	if(!('0'<=c&&c<='9' || c=='-' || c== '.' )) return(0);
330*1099Sbill 	*np = atof((*argvp)[1]);
331*1099Sbill 	(*argcp)--;
332*1099Sbill 	(*argvp)++;
333*1099Sbill 	return(1); }
334*1099Sbill 
335