Blame view

src/idl_extern/CMTotal_for_Dustemwrap/chebfit.pro 8.58 KB
517b8f98   Annie Hughes   first commit
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
;+
; NAME:
;   CHEBFIT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Fit Chebyshev polynomial coefficients to a tabulated function
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   p = CHEBFIT(X, Y, ERR, INTERVAL=interval, NMAX=nmax,
;               PRECISION=prec, /EVEN, /ODD, REDUCE_ALGORITHM=)
;
; DESCRIPTION:
;
;   CHEBFIT fits a series of Chebyshev polynomials to a set of
;   tabulated and possibly noisy data points.  The functions MPFIT and
;   CHEBEVAL, available from the above web page, must also be in your
;   IDL path for this function to work properly.  The user can choose
;   the desired precision and maximum number of chebyshev
;   coefficients.
;
;   This function is intended for use on already-tabulated data which
;   are potentially noisy.  The user should never expect more than
;   NPOINTS terms, where NPOINTS is the number of (x,y) pairs.  For
;   functions which can be evaluated to full machine precision at
;   arbitrary abcissae, the routine CHEBCOEF should be used instead.
;   For exact data tabulated on a regular grid, the routine CHEBGRID
;   should be tried.
;
;   The user can also specify that the function is even or odd, using
;   the keywords EVEN or ODD.  This saves computation time because
;   certain terms in the expansion can be ignored.  For the purposes
;   of this function even and odd refer to the symmetry about the
;   center of the interval.
;
;   The algorithm is employed in three steps.  In the first step, the
;   coefficients are estimated at a crude level.  In the second step,
;   it is determined whether certain coefficients are deemed
;   "ignoreable", i.e., they do not contribute significantly to the
;   function and are discarded.  The operation of this step is
;   determined by the REDUCE_ALGORITHM keyword.  Finally, the
;   remaining "good" coefficients are re-fitted to achieve the best
;   fit.
;
; INPUTS:
;
;   X, Y - the x- and y- tabulated values to be fitted.
;
;   ERR - (optional) the y-error bar associated with each (x,y) pair.
;         Default: 1
;
; RETURNS:
;
;   An array of Chebyshev coefficients which can be passed to
;   CHEBEVAL.  NOTE: the convention employed here is such that the
;   constant term in the expansion is P(0)*T0(x) (i.e., the convention
;   of Luke), and not P(0)/2 * T0(x).
;
; KEYWORD PARAMETERS:
;
;   EVEN, ODD - if set, then the fitting routine assumes the function
;               is even or odd, about the center of the interval.
;
;   INTERVAL - a 2-element vector describing the interval over which
;              the polynomial is to be evaluated.
;              Default: [-1, 1]
;
;   NMAX - a scalar, the maximum number of polynomial terms to be
;          fitted at one time.
;          Default: 16
;
;   PRECISION - a scalar, the requested precision in the fit.  Any
;               terms which do not contribute significantly, as
;               defined by this threshold, are discarded.  If the
;               function to be fitted is not well-behaved, then the
;               precision is not guaranteed to reach the desired
;               level.
;               Default: 1E-7
;
;   REDUCE_ALGORITHM - a scalar integer, describes how insignificant
;               terms are removed from the fit.  If 0, then all terms
;               are kept, and none are dicarded.  If 1, then only
;               trailing terms less than PRECISION are discarded.  If
;               2, then both trailing and intermediate terms less than
;               PRECISION are discarded.
;               Default: 2
;
; EXAMPLE:
;
;   x = dindgen(1000)/100     ; Range of 0 to 10
;   y = cos(x) + randomn(seed,1000)*0.01  ; Function with some noise
;   p = chebfit(x, y, interval=[0d,10d])
;   plot, x, y - chebeval(x,p, interval=[0d,10d])
;
; REFERENCES:
;
;   Abramowitz, M. & Stegun, I., 1965, *Handbook of Mathematical
;     Functions*, 1965, U.S. Government Printing Office, Washington,
;     D.C. (Applied Mathematical Series 55)
;   CERN, 1995, CERN Program Library, Function E407
;   Luke, Y. L., *The Special Functions and Their Approximations*,
;     1969, Academic Press, New York
;
; MODIFICATION HISTORY:
;   Written and documented, CM, June 2001
;   Copyright license terms changed, CM, 30 Dec 2001
;   Added usage message, CM, 20 Mar 2002
;   Slight docs change, CM, 25 Mar 2002
;
;  $Id: chebfit.pro,v 1.7 2003/07/20 05:53:44 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-

;; Compute residuals for MPFIT
function chebfit_eval, p, interval=interval, nterms=nterms, igood=igood, $
                       _EXTRA=extra

  common chebfit_common, x, y, err

  if n_elements(igood) EQ 0 then begin
      p1 = p
  endif else begin
      p1 = replicate(p(0)*0, nterms)
      p1(igood) = p
  endelse

  ;; Compute the Chebyshev polynomial
  f = chebeval(x, p1, interval=interval)

  ;; Compute the deviates, applying either errors or weights
  if n_elements(err) GT 0 then begin
      result = (y-f)/err
  endif else if n_elements(wts) GT 0 then begin
      result = (y-f)*wts
  endif else begin
      result = (y-f)
  endelse
  
  ;; Make sure the returned result is one-dimensional.
  result = reform(result, n_elements(result), /overwrite)
  return, result
end

function chebfit, x, y, err, nmax=nterms0, interval=interval, $
                  precision=prec, even=even, odd=odd, quiet=quiet, $
                  initialize=init, reduce_algorithm=redalg0, $
                  indices=igood, nocatch=nocatch, $
                  yfit=yfit, perror=perror, bestnorm=bestnorm, dof=dof

  if n_params() EQ 0 then begin
      message, 'USAGE:', /info
      message, 'P = CHEBFIT(X, Y, ERR, INTERVAL=[a,b], NMAX=, ...)', /info
      return, !values.d_nan
  endif

  if n_elements(nterms0) EQ 0 then nterms = 16L $
  else                             nterms = floor(nterms0(0)) > 2L
  nterms = nterms < n_elements(x)
  if n_elements(interval) LT 2 then interval = [-1., 1.]
  if n_elements(prec) EQ 0 then prec = 1.e-7
  if n_elements(redalg0) EQ 0 then redalg = 2 else redalg = floor(redalg0(0))
  if n_elements(quiet) EQ 0 then quiet = 1

  ;; Handle error conditions gracefully
  if NOT keyword_set(nocatch) then begin
      catch, catcherror
      if catcherror NE 0 then begin
          catch, /cancel
          message, 'Error detected while fitting', /info
          message, !err_string, /info
          ier = -1L
          return, 0L
      endif
  endif

  if n_elements(p) LT nterms OR keyword_set(init) then begin
      p = replicate(x(0)*0 + 1, nterms) / (findgen(nterms)+1)^2
      p(0) = total(y)/n_elements(y)
      ;; If mean is *exactly* zero, then shift it off slightly
      if p(0) EQ 0 then p(0) = sqrt(total(y^2))/n_elements(y)/10
  endif
  p0 = p
  igood = lindgen(nterms)

  if keyword_set(even) OR keyword_set(odd) then $
    igood = lindgen(n_elements(p)/2)*2 + keyword_set(odd)
  nt = min([nterms, max(igood)+1])

  ;; Cancel out old common entries
  common chebfit_common, xc, yc, errc
  xc   = 0 & dummy = temporary(xc)
  yc   = 0 & dummy = temporary(yc)
  errc = 0 & dummy = temporary(errc)
  
  xc = x
  yc = y
  if n_elements(err) GT 0 then begin
      errc = err
  endif

  fa = {interval: interval, igood: igood, nterms: nt}
  p1 = mpfit('CHEBFIT_EVAL', p0(igood), functargs=fa, maxiter=5, quiet=quiet)
  p0(igood) = p1

  ;; Look for and remove the insignificant terms from the fit
  if redalg GT 0 then begin
      wh = where(abs(p1) GT prec(0), ct)
      if ct EQ 0 then begin
          ALL_ZERO:
          message, 'WARNING: no significant Chebyshev terms were detected', $
            /info
          p = p0*0
          return, 0L
      endif
      if max(wh) LT n_elements(igood)-1 then begin
          imax = max(wh)
          igood = igood(0:imax)
          p1 = p1(0:imax)
      endif

      if redalg EQ 2 then begin
          wh = where(abs(p1) GT 0.1*prec, ct)
          if ct EQ 0 then goto, ALL_ZERO
          igood = igood(wh)
          p1 = p1(wh)
      endif
  endif

  nt = min([nterms, max(igood)+1])
  fa = {interval: interval, igood: igood, nterms: nt}
  p2 = mpfit('CHEBFIT_EVAL', p1, functargs=fa, maxiter=10, quiet=quiet, $
             perror=dp2, bestnorm=bestnorm, dof=dof)

  xc = 0 & yc = 0 & errc = 0
  p = p0*0 
  perror = p
  p(igood) = p2
  perror(igood) = dp2

  if arg_present(yfit) then $
    yfit = chebeval(x, p, interval=interval)

  return, p
end