source: sasview/sansmodels/src/libigor/winFuncs.c @ e72db38

ESS_GUIESS_GUI_DocsESS_GUI_batch_fittingESS_GUI_bumps_abstractionESS_GUI_iss1116ESS_GUI_iss879ESS_GUI_iss959ESS_GUI_openclESS_GUI_orderingESS_GUI_sync_sascalccostrafo411magnetic_scattrelease-4.1.1release-4.1.2release-4.2.2release_4.0.1ticket-1009ticket-1094-headlessticket-1242-2d-resolutionticket-1243ticket-1249ticket885unittest-saveload
Last change on this file since e72db38 was 6e93a02, checked in by Jae Cho <jhjcho@…>, 15 years ago

updated libigor files from NIST svn

  • Property mode set to 100644
File size: 3.9 KB
RevLine 
[6e93a02]1/* winFuncs.c
2   Adding functions missing from windows math library
3   Andrew Jackson, October 2007
4   */
5
6#include <stdio.h>
7#include <math.h>
8
9#include "winFuncs.h"
10
11
12double fmax(double x, double y){
13        //Doesn't exactly match BSD as if one or other value is NaN behaviour is undefined
14        //BSD returns the other value if one is NaN and NaN if both are NaN
15        //probably wouldn't want to rely on that in any case.
16        if (x > y) {
17                //x is greater than y
18                return x;
19        } else if (y > x) {
20                //y is greater than x
21                return y;
22        } else {
23                //equal
24                return x;
25        }
26}
27
28double fmin(double x, double y){
29        //Doesn't exactly match BSD as if one or other value is NaN behaviour is undefined
30        //BSD returns the other value if one is NaN and NaN if both are NaN
31        //probably wouldn't want to rely on that in any case.
32        if (x < y) {
33                //x is less than y
34                return x;
35        } else if (y < x) {
36                //y is less than x
37                return y;
38        } else {
39                //equal
40                return x;
41        }
42}
43
44double trunc(double x){
45        //This is probably slow as hell
46        if (x > 0){
47                //positive - need floor
48                return floor(x);
49        } else if (x < 0) {
50                //negative - need ceiling
51                return ceil(x);
52        } else {
53                //x is zero or infinity, return x
54                return x;
55        }
56
57}
58
59
60/* erf.c  - public domain implementation of error function erf(3m)
61
62reference - Haruhiko Okumura: C-gengo niyoru saishin algorithm jiten
63            (New Algorithm handbook in C language) (Gijyutsu hyouron
64            sha, Tokyo, 1991) p.227 [in Japanese]                 */
65
66
67#ifdef _WIN32
68# include <float.h>
69# if !defined __MINGW32__ || defined __NO_ISOCEXT
70#  ifndef isnan
71#   define isnan(x) _isnan(x)
72#  endif
73#  ifndef isinf
74#   define isinf(x) (!_finite(x) && !_isnan(x))
75#  endif
76#  ifndef finite
77#   define finite(x) _finite(x)
78#  endif
79# endif
80#endif
81
82static double q_gamma(double, double, double);
83
84/* Incomplete gamma function
85   1 / Gamma(a) * Int_0^x exp(-t) t^(a-1) dt  */
86static double p_gamma(double a, double x, double loggamma_a)
87{
88    int k;
89    double result, term, previous;
90
91    if (x >= 1 + a) return 1 - q_gamma(a, x, loggamma_a);
92    if (x == 0)     return 0;
93    result = term = exp(a * log(x) - x - loggamma_a) / a;
94    for (k = 1; k < 1000; k++) {
95        term *= x / (a + k);
96        previous = result;  result += term;
97        if (result == previous) return result;
98    }
99    fprintf(stderr, "erf.c:%d:p_gamma() could not converge.", __LINE__);
100    return result;
101}
102
103/* Incomplete gamma function
104   1 / Gamma(a) * Int_x^inf exp(-t) t^(a-1) dt  */
105static double q_gamma(double a, double x, double loggamma_a)
106{
107    int k;
108    double result, w, temp, previous;
109    double la = 1, lb = 1 + x - a;  /* Laguerre polynomial */
110
111    if (x < 1 + a) return 1 - p_gamma(a, x, loggamma_a);
112    w = exp(a * log(x) - x - loggamma_a);
113    result = w / lb;
114    for (k = 2; k < 1000; k++) {
115        temp = ((k - 1 - a) * (lb - la) + (k + x) * lb) / k;
116        la = lb;  lb = temp;
117        w *= (k - 1 - a) / k;
118        temp = w / (la * lb);
119        previous = result;  result += temp;
120        if (result == previous) return result;
121    }
122    fprintf(stderr, "erf.c:%d:q_gamma() could not converge.", __LINE__);
123    return result;
124}
125
126#define LOG_PI_OVER_2 0.572364942924700087071713675675 /* log_e(PI)/2 */
127
128double erf(double x)
129{
130    if (!finite(x)) {
131        if (isnan(x)) return x;      /* erf(NaN)   = NaN   */
132        return (x>0 ? 1.0 : -1.0);   /* erf(+-inf) = +-1.0 */
133    }
134    if (x >= 0) return   p_gamma(0.5, x * x, LOG_PI_OVER_2);
135    else        return - p_gamma(0.5, x * x, LOG_PI_OVER_2);
136}
137
138double erfc(double x)
139{
140    if (!finite(x)) {
141        if (isnan(x)) return x;      /* erfc(NaN)   = NaN      */
142        return (x>0 ? 0.0 : 2.0);    /* erfc(+-inf) = 0.0, 2.0 */
143    }
144    if (x >= 0) return  q_gamma(0.5, x * x, LOG_PI_OVER_2);
145    else        return  1 + p_gamma(0.5, x * x, LOG_PI_OVER_2);
146}
Note: See TracBrowser for help on using the repository browser.