home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / octa21ep.zip / octave / SOURCE.ZIP / liboctave / lo-mappers.cc < prev   
C/C++ Source or Header  |  1999-05-30  |  5KB  |  344 lines
  1. /*
  2.  
  3. Copyright (C) 1996, 1997 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. /* Modified by Klaus Gebhardt, 1997 - 1999 */
  24.  
  25. #ifdef HAVE_CONFIG_H
  26. #include <config.h>
  27. #endif
  28.  
  29. #include <cfloat>
  30. #include <cmath>
  31.  
  32. #include "lo-error.h"
  33. #include "lo-ieee.h"
  34. #include "lo-mappers.h"
  35. #include "lo-specfun.h"
  36. #include "lo-utils.h"
  37. #include "oct-cmplx.h"
  38.  
  39. #include "f77-fcn.h"
  40.  
  41. #if defined (_AIX) && defined (__GNUG__)
  42. #undef finite
  43. #define finite(x) ((x) < DBL_MAX && (x) > -DBL_MAX)
  44. #endif
  45.  
  46. extern "C"
  47. {
  48.   double F77_FCN (dacosh, DACOSH) (const double*);
  49.   double F77_FCN (dasinh, DASINH) (const double*);
  50.   double F77_FCN (datanh, DATANH) (const double*);
  51.  
  52.   double F77_FCN (derf, DERF) (const double&);
  53.   double F77_FCN (derfc, DERFC) (const double&);
  54. }
  55.  
  56. #ifndef M_LOG10E
  57. #define M_LOG10E 0.43429448190325182765
  58. #endif
  59.  
  60. #ifndef M_PI
  61. #define M_PI 3.14159265358979323846
  62. #endif
  63.  
  64. // Double -> double mappers.
  65.  
  66. double
  67. arg (double x)
  68. {
  69.   if (x < 0.0)
  70.     return M_PI;
  71.   else
  72. #if defined (HAVE_ISNAN)
  73.     return xisnan (x) ? octave_NaN : 0.0;
  74. #else
  75.     return 0.0;
  76. #endif
  77. }
  78.  
  79. double
  80. conj (double x)
  81. {
  82.   return x;
  83. }
  84.  
  85. double
  86. fix (double x)
  87. {
  88.   return x > 0 ? floor (x) : ceil (x);
  89. }
  90.  
  91. double
  92. imag (double x)
  93. {
  94. #if defined (HAVE_ISNAN)
  95.   return xisnan (x) ? octave_NaN : 0.0;
  96. #else
  97.   return 0.0;
  98. #endif
  99. }
  100.  
  101. double
  102. real (double x)
  103. {
  104.   return x;
  105. }
  106.  
  107. double
  108. round (double x)
  109. {
  110.   return D_NINT (x);
  111. }
  112.  
  113. double
  114. signum (double x)
  115. {
  116.   double tmp = 0.0;
  117.   if (x < 0.0)
  118.     tmp = -1.0;
  119.   else if (x > 0.0)
  120.     tmp = 1.0;
  121.  
  122. #if defined (HAVE_ISNAN)
  123.   return xisnan (x) ? octave_NaN : tmp;
  124. #else
  125.   return tmp;
  126. #endif
  127. }
  128.  
  129. double
  130. xacosh (double x)
  131. {
  132. #if defined (HAVE_ACOSH)
  133.   return acosh (x);
  134. #else
  135.   double y;
  136.   F77_YXFCN (dacosh, DACOSH, y, (&x));
  137.   return y;
  138. #endif
  139. }
  140.  
  141. double
  142. xasinh (double x)
  143. {
  144. #if defined (HAVE_ASINH)
  145.   return asinh (x);
  146. #else
  147.   double y;
  148.   F77_YXFCN (dasinh, DASINH, y, (&x));
  149.   return y;
  150. #endif
  151. }
  152.  
  153. double
  154. xatanh (double x)
  155. {
  156. #if defined (HAVE_ATANH)
  157.   return atanh (x);
  158. #else
  159.   double y;
  160.   F77_YXFCN (datanh, DATANH, y, (&x));
  161.   return y;
  162. #endif
  163. }
  164.  
  165. double
  166. xerf (double x)
  167. {
  168. #if defined (HAVE_ERF)
  169.   return erf (x);
  170. #else
  171.   double y;
  172.   F77_YXFCN (derf, DERF, y, (x));
  173.   return y;
  174. #endif
  175. }
  176.  
  177. double
  178. xerfc (double x)
  179. {
  180. #if defined (HAVE_ERFC)
  181.   return erfc (x);
  182. #else
  183.   double y;
  184.   F77_YXFCN (derfc, DERFC, y, (x));
  185.   return y;
  186. #endif
  187. }
  188.  
  189. double
  190. xisnan (double x)
  191. {
  192. #if defined (HAVE_ISNAN)
  193.   return isnan (x) != 0;
  194. #else
  195.   return 0;
  196. #endif
  197. }
  198.  
  199. double
  200. xfinite (double x)
  201. {
  202. #if defined (HAVE_FINITE)
  203.   return finite (x) != 0;
  204. #elif defined (HAVE_ISINF) && defined (HAVE_ISNAN)
  205.   return (! isinf (x) && ! isnan (x));
  206. #else
  207.   return 1;
  208. #endif
  209. }
  210.  
  211. double
  212. xisinf (double x)
  213. {
  214. #if defined (HAVE_ISINF)
  215.   return isinf (x);
  216. #elif defined (HAVE_FINITE) && defined (HAVE_ISNAN)
  217.   return (! (finite (x) || isnan (x)));
  218. #else
  219.   return 0;
  220. #endif
  221. }
  222.  
  223. // Complex -> double mappers.
  224.  
  225. double
  226. xisnan (const Complex& x)
  227. {
  228. #if defined (HAVE_ISNAN)
  229.   return (isnan (real (x)) || isnan (imag (x)));
  230. #else
  231.   return 0;
  232. #endif
  233. }
  234.  
  235. double
  236. xfinite (const Complex& x)
  237. {
  238.   return (xfinite (real (x)) && xfinite (imag (x)));
  239. }
  240.  
  241. double
  242. xisinf (const Complex& x)
  243. {
  244.   return (xisinf (real (x)) || xisinf (imag (x)));
  245. }
  246.  
  247. // Complex -> complex mappers.
  248.  
  249. Complex
  250. acos (const Complex& x)
  251. {
  252.   static Complex i (0, 1);
  253.  
  254.   return (real (x) * imag (x) < 0.0) ? i * acosh (x) : -i * acosh (x);
  255. }
  256.  
  257. Complex
  258. acosh (const Complex& x)
  259. {
  260.   return log (x + sqrt (x*x - 1.0));
  261. }
  262.  
  263. Complex
  264. asin (const Complex& x)
  265. {
  266.   static Complex i (0, 1);
  267.  
  268.   return -i * log (i*x + sqrt (1.0 - x*x));
  269. }
  270.  
  271. Complex
  272. asinh (const Complex& x)
  273. {
  274.   return log (x + sqrt (x*x + 1.0));
  275. }
  276.  
  277. Complex
  278. atan (const Complex& x)
  279. {
  280.   static Complex i (0, 1);
  281.  
  282.   return i * log ((i + x) / (i - x)) / 2.0;
  283. }
  284.  
  285. Complex
  286. atanh (const Complex& x)
  287. {
  288.   return log ((1.0 + x) / (1.0 - x)) / 2.0;
  289. }
  290.  
  291. Complex
  292. ceil (const Complex& x)
  293. {
  294.   return Complex (ceil (real (x)), ceil (imag (x)));
  295. }
  296.  
  297. Complex
  298. fix (const Complex& x)
  299. {
  300.   return Complex (fix (real (x)), fix (imag (x)));
  301. }
  302.  
  303. Complex
  304. floor (const Complex& x)
  305. {
  306.   return Complex (floor (real (x)), floor (imag (x)));
  307. }
  308.  
  309. Complex
  310. log10 (const Complex& x)
  311. {
  312.   return M_LOG10E * log (x);
  313. }
  314.  
  315. Complex
  316. round (const Complex& x)
  317. {
  318.   return Complex (D_NINT (real (x)), D_NINT (imag (x)));
  319. }
  320.  
  321. Complex
  322. signum (const Complex& x)
  323. {
  324.   return x / abs (x);
  325. }
  326.  
  327. Complex
  328. tan (const Complex& x)
  329. {
  330.   return sin (x) / cos (x);
  331. }
  332.  
  333. Complex
  334. tanh (const Complex& x)
  335. {
  336.   return sinh (x) / cosh (x);
  337. }
  338.  
  339. /*
  340. ;;; Local Variables: ***
  341. ;;; mode: C++ ***
  342. ;;; End: ***
  343. */
  344.