The R Project SVN R

Rev

Rev 24068 | Rev 29441 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 24068 Rev 29423
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  Mathlib : A C Library of Special Functions
 2 
 *  Mathlib : A C Library of Special Functions
3 
 *  Copyright (C) 1998-2001 Ross Ihaka and the R Development Core Team
 3 
 *  Copyright (C) 1998-2004 Ross Ihaka and the R Development Core Team
4 
 *
 4 
 *
5 
 *  This program is free software; you can redistribute it and/or modify
 5 
 *  This program is free software; you can redistribute it and/or modify
6 
 *  it under the terms of the GNU General Public License as published by
 6 
 *  it under the terms of the GNU General Public License as published by
7 
 *  the Free Software Foundation; either version 2 of the License, or
 7 
 *  the Free Software Foundation; either version 2 of the License, or
8 
 *  (at your option) any later version.
 8 
 *  (at your option) any later version.
Line 20... Line 20...
20 
#ifdef HAVE_CONFIG_H
 20 
#ifdef HAVE_CONFIG_H
21 
# include <config.h>
 21 
# include <config.h>
22 
#endif
 22 
#endif
23 
#include "nmath.h"
 23 
#include "nmath.h"
24 
 
 24 
 
25 
#ifndef IEEE_754
 - 
 
26 
 
 - 
 
27 
void ml_error(int n)
 - 
 
28 
{
 - 
 
29 
    switch(n) {
 - 
 
30 
 
 - 
 
31 
    case ME_NONE:
 - 
 
32 
	errno = 0;
 - 
 
33 
	break;
 - 
 
34 
 
 - 
 
35 
    case ME_DOMAIN:
 - 
 
36 
    case ME_NOCONV:
 - 
 
37 
	errno = EDOM;
 - 
 
38 
	break;
 - 
 
39 
 
 - 
 
40 
    case ME_RANGE:
 - 
 
41 
	errno = ERANGE;
 - 
 
42 
	break;
 - 
 
43 
 
 - 
 
44 
    default:
 - 
 
45 
	break;
 - 
 
46 
    }
 - 
 
47 
}
 - 
 
48 
 
 - 
 
49 
#endif
 - 
 
50 
 
 - 
 
51 
#ifdef MATHLIB_STANDALONE
 25 
#ifdef MATHLIB_STANDALONE
52 
/*
 26 
/*
53 
 *  based on code in ../main/arithmetic.c
 27 
 *  based on code in ../main/arithmetic.c
54 
 */
 28 
 */
55 
 
 29 
 
56 
 
 - 
 
57 
#ifdef IEEE_754
 - 
 
58 
 
 - 
 
59 
int R_IsNaNorNA(double x)
 - 
 
60 
{
 - 
 
61 
/* NOTE: some systems do not return 1 for TRUE. */
 - 
 
62 
    return (isnan(x) != 0);
 - 
 
63 
}
 - 
 
64 
 
 - 
 
65 
/* Include the header file defining finite() */
 30 
/* Include the header file defining finite() */
66 
#ifdef HAVE_IEEE754_H
 31 
#ifdef HAVE_IEEE754_H
67 
# include <ieee754.h>		/* newer Linuxen */
 32 
# include <ieee754.h>		/* newer Linuxen */
68 
#else
 33 
#else
69 
# ifdef HAVE_IEEEFP_H
 34 
# ifdef HAVE_IEEEFP_H
Line 86... Line 51...
86 
    return (!isnan(x) & (x != ML_POSINF) & (x != ML_NEGINF));
 51 
    return (!isnan(x) & (x != ML_POSINF) & (x != ML_NEGINF));
87 
# endif
 52 
# endif
88 
#endif
 53 
#endif
89 
}
 54 
}
90 
 
 55 
 
91 
#else /* not IEEE_754 */
 - 
 
92 
 
 - 
 
93 
int R_IsNaNorNA(double x)
 - 
 
94 
{
 - 
 
95 
# ifndef HAVE_ISNAN
 - 
 
96 
    return (x == ML_NAN);
 - 
 
97 
# else
 - 
 
98 
    return (isnan(x) != 0 || x == ML_NAN);
 - 
 
99 
# endif
 - 
 
100 
}
 - 
 
101 
 
 - 
 
102 
int R_finite(double x)
 - 
 
103 
{
 - 
 
104 
# ifndef HAVE_FINITE
 - 
 
105 
    return (x !=  ML_NAN && x < ML_POSINF && x > ML_NEGINF);
 - 
 
106 
# else
 - 
 
107 
    int finite(double);
 - 
 
108 
    return finite(x);
 - 
 
109 
# endif
 - 
 
110 
}
 - 
 
111 
#endif /* IEEE_754 */
 - 
 
112 
 
 - 
 
113 
static double myfmod(double x1, double x2)
 56 
static double myfmod(double x1, double x2)
114 
{
 57 
{
115 
    double q = x1 / x2;
 58 
    double q = x1 / x2;
116 
    return x1 - floor(q) * x2;
 59 
    return x1 - floor(q) * x2;
117 
}
 60 
}