Edinburgh Speech Tools  2.1-release
 All Classes Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Modules Pages
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 
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_sqrt(LISP n)
118 {
119  if (n && (TYPEP(n,tc_flonum)))
120  return flocons(sqrt(FLONM(n)));
121  else
122  err("sqrt: not a number",n);
123  return NIL;
124 }
125 
126 static LISP l_pow(LISP x, LISP y)
127 {
128  if (x && (TYPEP(x,tc_flonum)) &&
129  y && (TYPEP(y,tc_flonum)))
130  return flocons(pow(FLONM(x),FLONM(y)));
131  else
132  err("pow: x or y not a number",cons(x,cons(y,NIL)));
133  return NIL;
134 }
135 
136 static LISP l_mod(LISP x, LISP y)
137 {
138  if (x && (TYPEP(x,tc_flonum)) &&
139  y && (TYPEP(y,tc_flonum)))
140  {
141  int a,b;
142 
143  a = (int)FLONM(x);
144  b = (int)FLONM(y);
145  if (b == 0)
146  err("mod: y cannot be 0",cons(x,cons(y,NIL)));
147 
148  return flocons((float)(a%b));
149  }
150  else
151  err("mod: x or y not a number",cons(x,cons(y,NIL)));
152  return NIL;
153 }
154 
155 void init_subrs_math(void)
156 {
157  init_subr_1("number?",numberp,
158  "(number? DATA)\n\
159  Returns t if DATA is a number, nil otherwise.");
160  init_lsubr("+",lplus,
161  "(+ NUM1 NUM2 ...)\n\
162  Returns the sum of NUM1 and NUM2 ... An error is given is any argument\n\
163  is not a number.");
164  init_subr_2("-",difference,
165  "(- NUM1 NUM2)\n\
166  Returns the difference between NUM1 and NUM2. An error is given is any\n\
167  argument is not a number.");
168  init_lsubr("*",ltimes,
169  "(* NUM1 NUM2 ...)\n\
170  Returns the product of NUM1 and NUM2 ... An error is given is any\n\
171  argument is not a number.");
172  init_subr_2("/",quotient,
173  "(/ NUM1 NUM2)\n\
174  Returns the quotient of NUM1 and NUM2. An error is given is any\n\
175  argument is not a number.");
176  init_subr_2(">",greaterp,
177  "(> NUM1 NUM2)\n\
178  Returns t if NUM1 is greater than NUM2, nil otherwise. An error is\n\
179  given is either argument is not a number.");
180  init_subr_2("<",lessp,
181  "(< NUM1 NUM2)\n\
182  Returns t if NUM1 is less than NUM2, nil otherwise. An error is\n\
183  given is either argument is not a number.");
184  init_subr_1("nint",l_nint,
185  "(nint NUMBER)\n\
186  Returns nearest int to NUMBER.");
187  init_subr_1("log",l_log,
188  "(log NUM)\n\
189  Return natural log of NUM.");
190  init_subr_0("rand",l_rand,
191  "(rand)\n\
192  Returns a pseudo random number between 0 and 1 using the libc rand()\n\
193  function.");
194  init_subr_1("srand",l_srand,
195  "(srand SEED)\n\
196  Seeds the libc pseudo random number generator with the integer SEED.");
197  init_subr_1("exp",l_exp,
198  "(exp NUM)\n\
199  Return e**NUM.");
200  init_subr_1("sqrt",l_sqrt,
201  "(sqrt NUM)\n\
202  Return square root of NUM.");
203  init_subr_2("pow",l_pow,
204  "(pow X Y)\n\
205  Return X**Y.");
206  init_subr_2("%",l_mod,
207  "(% X Y)\n\
208  Return X%Y.");
209 
210 }