home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / src / mappers.cc < prev    next >
C/C++ Source or Header  |  1996-09-28  |  9KB  |  431 lines
  1. // mappers.cc                                             -*- C++ -*-
  2. /*
  3.  
  4. Copyright (C) 1992, 1993 John W. Eaton
  5.  
  6. This file is part of Octave.
  7.  
  8. Octave is free software; you can redistribute it and/or modify it
  9. under the terms of the GNU General Public License as published by the
  10. Free Software Foundation; either version 2, or (at your option) any
  11. later version.
  12.  
  13. Octave is distributed in the hope that it will be useful, but WITHOUT
  14. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16. for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with Octave; see the file COPYING.  If not, write to the Free
  20. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. */
  23.  
  24. #ifdef HAVE_CONFIG_H
  25. #include "config.h"
  26. #endif
  27.  
  28. #include <math.h>
  29. #include <float.h>
  30. #include <Complex.h>
  31.  
  32. #include "missing-math.h"
  33. #include "variables.h"
  34. #include "mappers.h"
  35. #include "error.h"
  36. #include "utils.h"
  37. #include "defun.h"
  38.  
  39. #if defined (_AIX) && defined (__GNUG__)
  40. #undef finite
  41. #define finite(x) ((x) < DBL_MAX && (x) > -DBL_MAX)
  42. #endif
  43.  
  44. #ifndef M_LOG10E
  45. #define M_LOG10E 0.43429448190325182765
  46. #endif
  47.  
  48. #ifndef M_PI
  49. #define M_PI 3.14159265358979323846
  50. #endif
  51.  
  52. #if defined (HAVE_LGAMMA) && ! defined (SIGNGAM_DECLARED)
  53. extern int signgam;
  54. #endif
  55.  
  56. // Double -> double mappers.
  57.  
  58. double
  59. arg (double x)
  60. {
  61.   if (x < 0.0)
  62.     return M_PI;
  63.   else
  64.     return 0.0;
  65. }
  66.  
  67. double
  68. conj (double x)
  69. {
  70.   return x;
  71. }
  72.  
  73. double
  74. fix (double x)
  75. {
  76.   int tmp;
  77.   tmp = (int) x;
  78.   return (double) tmp;
  79. }
  80.  
  81. double
  82. imag (double x)
  83. {
  84.   return 0.0;
  85. }
  86.  
  87. double
  88. real (double x)
  89. {
  90.   return x;
  91. }
  92.  
  93. double
  94. round (double x)
  95. {
  96.   return D_NINT (x);
  97. }
  98.  
  99. double
  100. signum (double x)
  101. {
  102.   double tmp = 0.0;
  103.   if (x < 0.0)
  104.     tmp = -1.0;
  105.   else if (x > 0.0)
  106.     tmp = 1.0;
  107.   return tmp;
  108. }
  109.  
  110. double
  111. xerf (double x)
  112. {
  113. #if defined (HAVE_ERF)
  114.   return erf (x);
  115. #else
  116.   error ("erf(x) not available on this system");
  117. #endif
  118. }
  119.  
  120. double
  121. xerfc (double x)
  122. {
  123. #if defined (HAVE_ERFC)
  124.   return erfc (x);
  125. #else
  126.   error ("erfc(x) not available on this system");
  127. #endif
  128. }
  129.  
  130. double
  131. xisnan (double x)
  132. {
  133. #if defined (HAVE_ISNAN)
  134.   return (double) isnan (x);
  135. #else
  136.   return 0;
  137. #endif
  138. }
  139.  
  140. double
  141. xfinite (double x)
  142. {
  143. #if defined (HAVE_FINITE)
  144.   return (double) finite (x);
  145. #elif defined (HAVE_ISINF) && defined (HAVE_ISNAN)
  146.   return (double) (! isinf (x) && ! isnan (x));
  147. #else
  148.   return (double) (x > -DBL_MAX && x < DBL_MAX);
  149. #endif
  150. }
  151.  
  152. double
  153. xgamma (double x)
  154. {
  155. #if defined (HAVE_LGAMMA)
  156.   double y = lgamma (x);
  157.   return signgam * exp (y);
  158. #else
  159.   error ("gamma(x) not available on this system");
  160. #endif
  161. }
  162.  
  163. double
  164. xisinf (double x)
  165. {
  166. #if defined (HAVE_ISINF)
  167.   return (double) isinf (x);
  168. #elif defined (HAVE_FINITE) && defined (HAVE_ISNAN)
  169.   return (double) (! (finite (x) || isnan (x)));
  170. #else
  171.   return (double) (x == DBL_MAX || x == -DBL_MAX);
  172. #endif
  173. }
  174.  
  175. double
  176. xlgamma (double x)
  177. {
  178. #if defined (HAVE_LGAMMA)
  179.   return lgamma (x);
  180. #else
  181.   error ("lgamma (x) not available on this system");
  182. #endif
  183. }
  184.  
  185. // Complex -> double mappers.
  186.  
  187. double
  188. xisnan (const Complex& x)
  189. {
  190. #if defined (HAVE_ISNAN)
  191.   double rx = real (x);
  192.   double ix = imag (x);
  193.   return (double) (isnan (rx) || isnan (ix));
  194. #else
  195.   return 0;
  196. #endif
  197. }
  198.  
  199. double
  200. xfinite (const Complex& x)
  201. {
  202.   double rx = real (x);
  203.   double ix = imag (x);
  204.   return (double) (! ((int) xisinf (rx) || (int) xisinf (ix)));
  205. }
  206.  
  207. double
  208. xisinf (const Complex& x)
  209. {
  210.   return (double) (! (int) xfinite (x));
  211. }
  212.  
  213. // Complex -> complex mappers.
  214.  
  215. Complex
  216. acos (const Complex& x)
  217. {
  218.   static Complex i (0, 1);
  219.   Complex retval = -i * log (x + sqrt (x*x - 1.0));
  220.   return retval;
  221. }
  222.  
  223. Complex
  224. acosh (const Complex& x)
  225. {
  226.   Complex retval = log (x + sqrt (x*x - 1.0));
  227.   return retval;
  228. }
  229.  
  230. Complex
  231. asin (const Complex& x)
  232. {
  233.   static Complex i (0, 1);
  234.   Complex retval = -i * log (i*x + sqrt (1.0 - x*x));
  235.   return retval;
  236. }
  237.  
  238. Complex
  239. asinh (const Complex& x)
  240. {
  241.   Complex retval = log (x + sqrt (x*x + 1.0));
  242.   return retval;
  243. }
  244.  
  245. Complex
  246. atan (const Complex& x)
  247. {
  248.   static Complex i (0, 1);
  249.   Complex retval = i * log ((i + x) / (i - x)) / 2.0;
  250.   return retval;
  251. }
  252.  
  253. Complex
  254. atanh (const Complex& x)
  255. {
  256.   static Complex i (0, 1);
  257.   Complex retval = log ((1 + x) / (1 - x)) / 2.0;
  258.   return retval;
  259. }
  260.  
  261. Complex
  262. ceil (const Complex& x)
  263. {
  264.   int re = (int) ceil (real (x));
  265.   int im = (int) ceil (imag (x));
  266.   return Complex (re, im);
  267. }
  268.  
  269. Complex
  270. fix (const Complex& x)
  271. {
  272.   int re = (int) real (x);
  273.   int im = (int) imag (x);
  274.   return Complex (re, im);
  275. }
  276.  
  277. Complex
  278. floor (const Complex& x)
  279. {
  280.   int re = (int) floor (real (x));
  281.   int im = (int) floor (imag (x));
  282.   return Complex (re, im);
  283. }
  284.  
  285. Complex
  286. log10 (const Complex& x)
  287. {
  288.   return M_LOG10E * log (x);
  289. }
  290.  
  291. Complex
  292. round (const Complex& x)
  293. {
  294.   double re = D_NINT (real (x));
  295.   double im = D_NINT (imag (x));
  296.   return Complex (re, im);
  297. }
  298.  
  299. Complex
  300. signum (const Complex& x)
  301. {
  302.   return x / abs (x);
  303. }
  304.  
  305. Complex
  306. tan (const Complex& x)
  307. {
  308.   Complex retval = sin (x) / cos (x);
  309.   return retval;
  310. }
  311.  
  312. Complex
  313. tanh (const Complex& x)
  314. {
  315.   Complex retval = sinh (x) / cosh (x);
  316.   return retval;
  317. }
  318.  
  319. void
  320. install_mapper_functions (void)
  321. {
  322.   DEFUN_MAPPER ("abs", Sabs, 0, 0.0, 0.0, fabs, abs, 0,
  323.     "abs (X): compute abs (X) for each element of X");
  324.  
  325.   DEFUN_MAPPER ("acos", Sacos, 1, -1.0, 1.0, acos, 0, acos,
  326.     "acos (X): compute acos (X) for each element of X");
  327.  
  328.   DEFUN_MAPPER ("acosh", Sacosh, 1, 1.0, DBL_MAX, acosh, 0, acosh,
  329.     "acosh (X): compute acosh (X) for each element of X");
  330.  
  331.   DEFUN_MAPPER ("angle", Sangle, 0, 0.0, 0.0, arg, arg, 0,
  332.     "angle (X): compute arg (X) for each element of X");
  333.  
  334.   DEFUN_MAPPER ("arg", Sarg, 0, 0.0, 0.0, arg, arg, 0,
  335.     "arg (X): compute arg (X) for each element of X");
  336.  
  337.   DEFUN_MAPPER ("asin", Sasin, 1, -1.0, 1.0, asin, 0, asin,
  338.     "asin (X): compute asin (X) for each element of X");
  339.  
  340.   DEFUN_MAPPER ("asinh", Sasinh, 0, 0.0, 0.0, asinh, 0, asinh,
  341.     "asinh (X): compute asinh (X) for each element of X");
  342.  
  343.   DEFUN_MAPPER ("atan", Satan, 0, 0.0, 0.0, atan, 0, atan,
  344.     "atan (X): compute atan (X) for each element of X");
  345.  
  346.   DEFUN_MAPPER ("atanh", Satanh, 1, -1.0, 1.0, atanh, 0, atanh,
  347.     "atanh (X): compute atanh (X) for each element of X");
  348.  
  349.   DEFUN_MAPPER ("ceil", Sceil, 0, 0.0, 0.0, ceil, 0, ceil,
  350.     "ceil (X): round elements of X toward +Inf");
  351.  
  352.   DEFUN_MAPPER ("conj", Sconj, 0, 0.0, 0.0, conj, 0, conj,
  353.     "conj (X): compute complex conjugate for each element of X");
  354.  
  355.   DEFUN_MAPPER ("cos", Scos, 0, 0.0, 0.0, cos, 0, cos,
  356.     "cos (X): compute cos (X) for each element of X");
  357.  
  358.   DEFUN_MAPPER ("cosh", Scosh, 0, 0.0, 0.0, cosh, 0, cosh,
  359.     "cosh (X): compute cosh (X) for each element of X");
  360.  
  361.   DEFUN_MAPPER ("erf", Serf, 0, 0.0, 0.0, xerf, 0, 0,
  362.     "erf (X): compute erf (X) for each element of X");
  363.  
  364.   DEFUN_MAPPER ("erfc", Serfc, 0, 0.0, 0.0, xerfc, 0, 0,
  365.     "erfc (X): compute erfc (X) for each element of X");
  366.  
  367.   DEFUN_MAPPER ("exp", Sexp, 0, 0.0, 0.0, exp, 0, exp,
  368.     "exp (X): compute exp (X) for each element of X");
  369.  
  370.   DEFUN_MAPPER ("finite", Sfinite, 0, 0.0, 0.0, xfinite, xfinite, 0,
  371.     "finite (X): return 1 for finite elements of X");
  372.  
  373.   DEFUN_MAPPER ("fix", Sfix, 0, 0.0, 0.0, fix, 0, fix,
  374.     "fix (X): round elements of X toward zero");
  375.  
  376.   DEFUN_MAPPER ("floor", Sfloor, 0, 0.0, 0.0, floor, 0, floor,
  377.     "floor (X): round elements of X toward -Inf");
  378.  
  379.   DEFUN_MAPPER ("gamma", Sgamma, 0, 0.0, 0.0, xgamma, 0, 0,
  380.     "gamma (X): compute gamma (X) for each element of X");
  381.  
  382.   DEFUN_MAPPER ("isinf", Sisinf, 0, 0.0, 0.0, xisinf, xisinf, 0,
  383.     "isinf (X): return 1 for elements of X infinite");
  384.  
  385.   DEFUN_MAPPER ("imag", Simag, 0, 0.0, 0.0, imag, imag, 0,
  386.     "imag (X): return imaginary part for each elements of X");
  387.  
  388.   DEFUN_MAPPER ("isnan", Sisnan, 0, 0.0, 0.0, xisnan, xisnan, 0,
  389.     "isnan (X): return 1 where elements of X are NaNs");
  390.  
  391.   DEFUN_MAPPER ("lgamma", Slgamma, 0, 0.0, 0.0, xlgamma, 0, 0,
  392.     "lgamma (X): compute log gamma (X) for each element of X");
  393.  
  394.   DEFUN_MAPPER ("log", Slog, 1, 0.0, DBL_MAX, log, 0, log,
  395.     "log (X): compute log (X) for each element of X");
  396.  
  397.   DEFUN_MAPPER ("log10", Slog10, 1, 0.0, DBL_MAX, log10, 0, log10,
  398.     "log10 (X): compute log10 (X) for each element of X");
  399.  
  400.   DEFUN_MAPPER ("real", Sreal, 0, 0.0, 0.0, real, real, 0,
  401.     "real (X): return real part for each element of X");
  402.  
  403.   DEFUN_MAPPER ("round", Sround, 0, 0.0, 0.0, round, 0, round,
  404.     "round (X): round elements of X to nearest integer");
  405.  
  406.   DEFUN_MAPPER ("sign", Ssign, 0, 0.0, 0.0, signum, 0, signum,
  407.     "sign (X): apply signum function to elements of X");
  408.  
  409.   DEFUN_MAPPER ("sin", Ssin, 0, 0.0, 0.0, sin, 0, sin,
  410.     "sin (X): compute sin (X) for each element of X");
  411.  
  412.   DEFUN_MAPPER ("sinh", Ssinh, 0, 0.0, 0.0, sinh, 0, sinh,
  413.     "sinh (X): compute sinh (X) for each element of X");
  414.  
  415.   DEFUN_MAPPER ("sqrt", Ssqrt, 1, 0.0, DBL_MAX, sqrt, 0, sqrt,
  416.     "sqrt (X): compute sqrt (X) for each element of X");
  417.  
  418.   DEFUN_MAPPER ("tan", Stan, 0, 0.0, 0.0, tan, 0, tan,
  419.     "tan (X): compute tan (X) for each element of X");
  420.  
  421.   DEFUN_MAPPER ("tanh", Stanh, 0, 0.0, 0.0, tanh, 0, tanh,
  422.     "tanh (X): compute tanh (X) for each element of X");
  423. }
  424.  
  425. /*
  426. ;;; Local Variables: ***
  427. ;;; mode: C++ ***
  428. ;;; page-delimiter: "^/\\*" ***
  429. ;;; End: ***
  430. */
  431.