Edinburgh Speech Tools 2.4-release
slib_math.cc
1/*
2 * COPYRIGHT (c) 1988-1994 BY *
3 * PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
4 * See the source file SLIB.C for more information. *
5
6 * Reorganization of files (Mar 1999) by Alan W Black <awb@cstr.ed.ac.uk>
7
8 * math functions
9
10*/
11#include <cstdio>
12#include "siod.h"
13#include "siodp.h"
14
15LISP numberp(LISP x)
16{if FLONUMP(x) return(truth); else return(NIL);}
17
18static LISP lplus(LISP args)
19{
20 LISP l;
21 double sum;
22 for (sum=0.0,l=args; l != NIL; l=cdr(l))
23 {
24 if (NFLONUMP(car(l))) err("wrong type of argument to plus",car(l));
25 sum += FLONM(car(l));
26 }
27 return flocons(sum);
28}
29
30static LISP ltimes(LISP args)
31{
32 LISP l;
33 double product;
34 for (product=1.0,l=args; l != NIL; l=cdr(l))
35 {
36 if (NFLONUMP(car(l))) err("wrong type of argument to times",car(l));
37 product *= FLONM(car(l));
38 }
39 return flocons(product);
40}
41
42static LISP difference(LISP x,LISP y)
43{if NFLONUMP(x) err("wrong type of argument(1st) to difference",x);
44 if NFLONUMP(y) err("wrong type of argument(2nd) to difference",y);
45 return(flocons(FLONM(x) - FLONM(y)));}
46
47static LISP quotient(LISP x,LISP y)
48{if NFLONUMP(x) err("wrong type of argument(1st) to quotient",x);
49 if NFLONUMP(y) err("wrong type of argument(2nd) to quotient",y);
50 return(flocons(FLONM(x)/FLONM(y)));}
51
52static LISP greaterp(LISP x,LISP y)
53{if NFLONUMP(x) err("wrong type of argument(1st) to greaterp",x);
54 if NFLONUMP(y) err("wrong type of argument(2nd) to greaterp",y);
55 if (FLONM(x)>FLONM(y)) return(truth);
56 return(NIL);}
57
58static LISP lessp(LISP x,LISP y)
59{if NFLONUMP(x) err("wrong type of argument(1st) to lessp",x);
60 if NFLONUMP(y) err("wrong type of argument(2nd) to lessp",y);
61 if (FLONM(x)<FLONM(y)) return(truth);
62 return(NIL);}
63
64static LISP l_nint(LISP number)
65{
66 if (TYPEP(number,tc_flonum))
67 {
68 int iii = (int)(FLONM(number)+0.5);
69 return flocons(iii);
70 }
71 else if (TYPEP(number,tc_symbol))
72 {
73 int iii = (int)(atof(get_c_string(number))+0.5);
74 return flocons(iii);
75 }
76 else
77 err("nint: argument not a number",number);
78
79 return NIL;
80}
81
82static LISP l_log(LISP n)
83{
84 if (n && (TYPEP(n,tc_flonum)))
85 return flocons(log(FLONM(n)));
86 else
87 err("log: not a number",n);
88
89 return NIL;
90}
91
92static LISP l_rand()
93{
94 double r = (double)abs(rand())/(double)RAND_MAX;
95
96 return flocons(r);
97}
98
99static LISP l_srand(LISP seed)
100{
101 if (seed && (TYPEP(seed,tc_flonum)))
102 srand((int) FLONM(seed));
103 else
104 err("srand: not a number", seed);
105 return NIL;
106}
107
108static LISP l_exp(LISP n)
109{
110 if (n && (TYPEP(n,tc_flonum)))
111 return flocons(exp(FLONM(n)));
112 else
113 err("exp: not a number",n);
114 return NIL;
115}
116
117static LISP l_sin(LISP n)
118{
119 if (n && (TYPEP(n,tc_flonum)))
120 return flocons(sin(FLONM(n)));
121 else
122 err("sin: not a number",n);
123 return NIL;
124}
125
126static LISP l_cos(LISP n)
127{
128 if (n && (TYPEP(n,tc_flonum)))
129 return flocons(cos(FLONM(n)));
130 else
131 err("cos: not a number",n);
132 return NIL;
133}
134
135static LISP l_tan(LISP n)
136{
137 if (n && (TYPEP(n,tc_flonum)))
138 return flocons(tan(FLONM(n)));
139 else
140 err("tan: not a number",n);
141 return NIL;
142}
143
144static LISP l_asin(LISP n)
145{
146 if (n && (TYPEP(n,tc_flonum)))
147 return flocons(asin(FLONM(n)));
148 else
149 err("asin: not a number",n);
150 return NIL;
151}
152
153static LISP l_acos(LISP n)
154{
155 if (n && (TYPEP(n,tc_flonum)))
156 return flocons(acos(FLONM(n)));
157 else
158 err("acos: not a number",n);
159 return NIL;
160}
161
162static LISP l_atan(LISP n)
163{
164 if (n && (TYPEP(n,tc_flonum)))
165 return flocons(atan(FLONM(n)));
166 else
167 err("atan: not a number",n);
168 return NIL;
169}
170
171static LISP l_sqrt(LISP n)
172{
173 if (n && (TYPEP(n,tc_flonum)))
174 return flocons(sqrt(FLONM(n)));
175 else
176 err("sqrt: not a number",n);
177 return NIL;
178}
179
180static LISP l_pow(LISP x, LISP y)
181{
182 if (x && (TYPEP(x,tc_flonum)) &&
183 y && (TYPEP(y,tc_flonum)))
184 return flocons(pow(FLONM(x),FLONM(y)));
185 else
186 err("pow: x or y not a number",cons(x,cons(y,NIL)));
187 return NIL;
188}
189
190static LISP l_mod(LISP x, LISP y)
191{
192 if (x && (TYPEP(x,tc_flonum)) &&
193 y && (TYPEP(y,tc_flonum)))
194 {
195 int a,b;
196
197 a = (int)FLONM(x);
198 b = (int)FLONM(y);
199 if (b == 0)
200 err("mod: y cannot be 0",cons(x,cons(y,NIL)));
201
202 return flocons((float)(a%b));
203 }
204 else
205 err("mod: x or y not a number",cons(x,cons(y,NIL)));
206 return NIL;
207}
208
209void init_subrs_math(void)
210{
211 init_subr_1("number?",numberp,
212 "(number? DATA)\n\
213 Returns t if DATA is a number, nil otherwise.");
214 init_lsubr("+",lplus,
215 "(+ NUM1 NUM2 ...)\n\
216 Returns the sum of NUM1 and NUM2 ... An error is given is any argument\n\
217 is not a number.");
218 init_subr_2("-",difference,
219 "(- NUM1 NUM2)\n\
220 Returns the difference between NUM1 and NUM2. An error is given is any\n\
221 argument is not a number.");
222 init_lsubr("*",ltimes,
223 "(* NUM1 NUM2 ...)\n\
224 Returns the product of NUM1 and NUM2 ... An error is given is any\n\
225 argument is not a number.");
226 init_subr_2("/",quotient,
227 "(/ NUM1 NUM2)\n\
228 Returns the quotient of NUM1 and NUM2. An error is given is any\n\
229 argument is not a number.");
230 init_subr_2(">",greaterp,
231 "(> NUM1 NUM2)\n\
232 Returns t if NUM1 is greater than NUM2, nil otherwise. An error is\n\
233 given is either argument is not a number.");
234 init_subr_2("<",lessp,
235 "(< NUM1 NUM2)\n\
236 Returns t if NUM1 is less than NUM2, nil otherwise. An error is\n\
237 given is either argument is not a number.");
238 init_subr_1("nint",l_nint,
239 "(nint NUMBER)\n\
240 Returns nearest int to NUMBER.");
241 init_subr_1("log",l_log,
242 "(log NUM)\n\
243 Return natural log of NUM.");
244 init_subr_0("rand",l_rand,
245 "(rand)\n\
246 Returns a pseudo random number between 0 and 1 using the libc rand()\n\
247 function.");
248 init_subr_1("srand",l_srand,
249 "(srand SEED)\n\
250 Seeds the libc pseudo random number generator with the integer SEED.");
251 init_subr_1("exp",l_exp,
252 "(exp NUM)\n\
253 Return e**NUM.");
254 init_subr_1("sin",l_sin,
255 "(sin NUM)\n\
256 Return sine of NUM.");
257 init_subr_1("cos",l_cos,
258 "(cos NUM)\n\
259 Return cosine of NUM.");
260 init_subr_1("tan",l_tan,
261 "(tan NUM)\n\
262 Return tangent of NUM.");
263 init_subr_1("asin",l_asin,
264 "(asin NUM)\n\
265 Return arcsine of NUM.");
266 init_subr_1("acos",l_acos,
267 "(acos NUM)\n\
268 Return arccosine of NUM.");
269 init_subr_1("atan",l_atan,
270 "(atan NUM)\n\
271 Return arctangent of NUM.");
272 init_subr_1("sqrt",l_sqrt,
273 "(sqrt NUM)\n\
274 Return square root of NUM.");
275 init_subr_2("pow",l_pow,
276 "(pow X Y)\n\
277 Return X**Y.");
278 init_subr_2("%",l_mod,
279 "(% X Y)\n\
280 Return X%Y.");
281
282}