Added MACS source
[htsworkflow.git] / htswanalysis / MACS / lib / gsl / gsl-1.11 / roots / steffenson.c
1 /* roots/steffenson.c
2  * 
3  * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Reid Priedhorsky, Brian Gough
4  * 
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
7  * the Free Software Foundation; either version 3 of the License, or (at
8  * your option) any later version.
9  * 
10  * This program is distributed in the hope that it will be useful, but
11  * WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13  * General Public License for more details.
14  * 
15  * You should have received a copy of the GNU General Public License
16  * along with this program; if not, write to the Free Software
17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18  */
19
20 /* steffenson.c -- steffenson root finding algorithm 
21
22    This is Newton's method with an Aitken "delta-squared"
23    acceleration of the iterates. This can improve the convergence on
24    multiple roots where the ordinary Newton algorithm is slow.
25
26    x[i+1] = x[i] - f(x[i]) / f'(x[i])
27
28    x_accelerated[i] = x[i] - (x[i+1] - x[i])**2 / (x[i+2] - 2*x[i+1] + x[i])
29
30    We can only use the accelerated estimate after three iterations,
31    and use the unaccelerated value until then.
32
33  */
34
35 #include <config.h>
36
37 #include <stddef.h>
38 #include <stdlib.h>
39 #include <stdio.h>
40 #include <math.h>
41 #include <float.h>
42
43 #include <gsl/gsl_math.h>
44 #include <gsl/gsl_errno.h>
45 #include <gsl/gsl_roots.h>
46
47 #include "roots.h"
48
49 typedef struct
50   {
51     double f, df;
52     double x;
53     double x_1;
54     double x_2;
55     int count;
56   }
57 steffenson_state_t;
58
59 static int steffenson_init (void * vstate, gsl_function_fdf * fdf, double * root);
60 static int steffenson_iterate (void * vstate, gsl_function_fdf * fdf, double * root);
61
62 static int
63 steffenson_init (void * vstate, gsl_function_fdf * fdf, double * root)
64 {
65   steffenson_state_t * state = (steffenson_state_t *) vstate;
66
67   const double x = *root ;
68
69   state->f = GSL_FN_FDF_EVAL_F (fdf, x);
70   state->df = GSL_FN_FDF_EVAL_DF (fdf, x) ;
71
72   state->x = x;
73   state->x_1 = 0.0;
74   state->x_2 = 0.0;
75
76   state->count = 1;
77
78   return GSL_SUCCESS;
79
80 }
81
82 static int
83 steffenson_iterate (void * vstate, gsl_function_fdf * fdf, double * root)
84 {
85   steffenson_state_t * state = (steffenson_state_t *) vstate;
86   
87   double x_new, f_new, df_new;
88
89   double x_1 = state->x_1 ;
90   double x = state->x ;
91
92   if (state->df == 0.0)
93     {
94       GSL_ERROR("derivative is zero", GSL_EZERODIV);
95     }
96
97   x_new = x - (state->f / state->df);
98   
99   GSL_FN_FDF_EVAL_F_DF(fdf, x_new, &f_new, &df_new);
100
101   state->x_2 = x_1 ;
102   state->x_1 = x ;
103   state->x = x_new;
104
105   state->f = f_new ;
106   state->df = df_new ;
107
108   if (!gsl_finite (f_new))
109     {
110       GSL_ERROR ("function value is not finite", GSL_EBADFUNC);
111     }
112
113   if (state->count < 3)
114     {
115       *root = x_new ;
116       state->count++ ;
117     }
118   else 
119     {
120       double u = (x - x_1) ;
121       double v = (x_new - 2 * x + x_1);
122
123       if (v == 0)
124         *root = x_new;  /* avoid division by zero */
125       else
126         *root = x_1 - u * u / v ;  /* accelerated value */
127     }
128
129   if (!gsl_finite (df_new))
130     {
131       GSL_ERROR ("derivative value is not finite", GSL_EBADFUNC);
132     }
133       
134   return GSL_SUCCESS;
135 }
136
137
138 static const gsl_root_fdfsolver_type steffenson_type =
139 {"steffenson",                          /* name */
140  sizeof (steffenson_state_t),
141  &steffenson_init,
142  &steffenson_iterate};
143
144 const gsl_root_fdfsolver_type  * gsl_root_fdfsolver_steffenson = &steffenson_type;