Edinburgh Speech Tools  2.1-release
slib_math.cc
Go to the documentation of this file.
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 
15 LISP numberp(LISP x)
16 {if FLONUMP(x) return(truth); else return(NIL);}
17 
18 static 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 
30 static 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 
42 static 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 
47 static 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 
52 static 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 
58 static 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 
64 static 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 
82 static 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 
92 static LISP l_rand()
93 {
94  double r = (double)abs(rand())/(double)RAND_MAX;
95 
96  return flocons(r);
97 }
98 
99 static 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 
108 static 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 
117 static 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 
126 static 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 
135 static 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 
144 static 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 
153 static 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 
162 static 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 
171 static 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 
180 static 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 
190 static 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 
209 void 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.");
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 }
#define tc_symbol
Definition: siod_defs.h:106
#define NIL
Definition: siod_defs.h:92
void init_subr_2(const char *name, LISP(*fcn)(LISP, LISP), const char *doc)
Definition: slib.cc:900
#define tc_flonum
Definition: siod_defs.h:105
#define NFLONUMP(x)
Definition: siod_defs.h:159
void err(const char *message, LISP x) EST_NORETURN
Definition: slib.cc:608
const char * get_c_string(LISP x)
Definition: slib.cc:638
LISP cons(LISP x, LISP y)
Definition: slib_list.cc:97
#define RAND_MAX
Definition: EST_math.h:151
#define FLONUMP(x)
Definition: siod_defs.h:154
void init_subr_1(const char *name, LISP(*fcn)(LISP), const char *doc)
Definition: slib.cc:898
getString int
Definition: EST_item_aux.cc:50
#define TYPEP(x, y)
Definition: siod_defs.h:100
EST_Track difference(EST_Track &a, EST_Track &b)
void init_lsubr(const char *name, LISP(*fcn)(LISP), const char *doc)
Definition: slib.cc:906
void init_subrs_math(void)
Definition: slib_math.cc:209
LISP numberp(LISP x)
Definition: slib_math.cc:15
void init_subr_0(const char *name, LISP(*fcn)(void), const char *doc)
Definition: slib.cc:896
LISP flocons(double x)
Definition: slib.cc:673
LISP car(LISP x)
Definition: slib_list.cc:115
LISP truth
Definition: slib.cc:135
float sum(const EST_FMatrix &a)
sum of elements
Definition: vec_mat_aux.cc:147
LISP cdr(LISP x)
Definition: slib_list.cc:124
#define FLONM(x)
Definition: siod_defs.h:87