;+ ; ;
This code came mostly from Tom Bania's GBT_IDL work. Local ; modifications include: ;
; ; make a simple gauss ; x = lindgen(150) ; h = 400000. ; c = 75. ; w = 15. ; noise = 10000 ; data=h*exp(-4.0*alog(2)*(x-c)^2/w^2)+(randomn(seed,n_elements(x))*noise) ; ; make an initial guess to this guassian ; h = 400000. ; c = 75. ; w = 15. ; inits = [h,c,w] ; nregions = 1 ; regions = [[20,120]] ; ngauss = 1 ; max_iters = 500 ; yfit = gauss_fits(x,data,nregions,regions,inits,ngauss,max_iters,coefficients,errors,quiet=1) ; ; view the results ; plot, data ; gbtoplot, x[regions[0]:regions[1]], yfit, color=!red, /chan ;; ; complex examle: multiple gaussians in multiple regions ; ;
; ; create 5 gaussians in the same plot
; a1 = [400000.,35.,15.]
; a2 = [100000.,15,7.5]
; a3 = [200000.,110,8.0]
; a4 = [100000.,150,5.5]
; a5 = [100000.,170,5.5]
; a = [a1,a2,a3,a4,a5]
; x = lindgen(200)
; data = make_gauss(x,a,10000.)
; plot, data
;
; ; specify 3 regions
; nregions = 3
; regions = [[5,75],[90,130],[135,190]]
; inits = [[a1],[a2],[a3],[a4],[a5]]
; ngauss = 5
; max_iters = 500
; p = replicate({value:0.D, fixed:0, limited:[0,0], $
; limits:[0.D,0]}, 15)
; ; 15 = 5 gauss * 3 parameter per guass
; p[*].value = a
; ; hold the first gaussians height fixed
; p[0].fixed = 1
;
; ; find all the fits at once
; yfit = gauss_fits(x,data,nregions,regions,inits,ngauss,max_iters,coefficients,errors,parinfo=p,quiet=1)
;
; ; unwrap the results and plot them
; ystart = 0
; for i=0,(nregions-1) do begin
; b = regions[0,i]
; e = regions[1,i]
; yend = ystart + (e-b)
; y = yfit[ystart:yend]
; ystart = yend + 1
; gbtoplot, x[b:e], y, color=!red, /chan
; endfor
;
;
;
; @version $Id$
;-
function gauss_fits,xx,yy,nregions,regions,inits,ngauss,max_iters,coefficients,errors,parinfo=parinfo,_EXTRA=ex
compile_opt idl2
; argument checks
if (n_elements(xx) ne n_elements(yy)) then $
message, 'number of elements of xx is not equal to number of elements of yy'
if (nregions lt 0) then message, 'nregions must be >= 0'
sz = size(regions)
if (sz[1] ne 2 ) then message, 'regions must be of dimension [[x,y],[x,y],...]'
sz = size(inits)
if (sz[0] eq 1) then begin
n_inits = 1
endif else begin
n_inits = sz[2]
endelse
if (n_inits ne ngauss) then message, "ngauss is not consistent with the second dimension of inits"
!except=0 ; turn off underflow messages (and, alas, *all* math errors)
; build up the index given regions and nregions
; assumes regions are sorted and don't overlap
; we know there is at least one region
indx = lindgen(regions[1,0]-regions[0,0]+1) + regions[0,0]
if (nregions gt 1) then begin
for i=1,(nregions-1) do begin
indx = [indx,lindgen(regions[1,i]-regions[0,i]+1)+regions[0,i]]
endfor
endif
mask = where(finite(yy[indx]))
if mask[0] lt 0 then message, 'no unblanked data found in region to fit'
indx = indx[mask]
params = 0
; fit the guassians
if keyword_set(parinfo) then begin
params = parinfo[0:((ngauss*3)-1)]
endif
; convert the ginits 2-D array into a 1-D array
a = fltarr(n_elements(inits))
sigmaa = fltarr(n_elements(inits))
a = float(inits[0:(n_elements(inits)-1)])
; wieght is 1.0
weightf = fltarr(n_elements(indx))+1.0
; fit the gaussians!
if keyword_set(parinfo) then begin
yfit = mpcurvefit(xx[indx],yy[indx],$
weightf,a,sigmaa,function_name="gauss_fx",$
chisq=chisq,itmax=max_iters,parinfo=params,_EXTRA=ex)
endif else begin
yfit = mpcurvefit(xx[indx],yy[indx],$
weightf,a,sigmaa,function_name="gauss_fx",$
chisq=chisq,itmax=max_iters,_EXTRA=ex)
endelse
; will eventually need to correct degrees of freedom (dof) for
; parameters that have been held fixed in this fit
dof = n_elements(xx[indx]) - n_elements(a)
sigmaa *= sqrt(chisq/dof)
; translate the 1-D results into 2-D results
coefficients = fltarr(3,ngauss)
errors = fltarr(3,ngauss)
for i=0,(ngauss-1) do begin
coefficients[0,i] = a[(i*3)+0]
coefficients[1,i] = a[(i*3)+1]
coefficients[2,i] = a[(i*3)+2]
errors[0,i] = sigmaa[(i*3)+0]
errors[1,i] = sigmaa[(i*3)+1]
errors[2,i] = sigmaa[(i*3)+2]
endfor
; this clears it
d=check_math()
!except=1 ; return math error exceptions to default state
return, yfit
end