;+ ; ;

This code came mostly from Tom Bania's GBT_IDL work. Local ; modifications include: ;

; Extra parameters are passed to mpcurvefit. ; ; @param xx {in}{required}{type=array} The x-values to use in the fit. ; @param yy {in}{required}{type=array} The data to be fit at xx. ; @param nregions {in}{required}{type=long} The number of regions in which to fit gaussians ; @param regions {in}{required}{type=2-D array} 2-D array marking ends of each region. ; @param inits {in}{required}{type=2-D array} 2-D array of the form [[h,c,w],[h,c,w],[h,c,w],...], ; where h = height, c = center, w = full width half maximum. Each [h,c,w] corresponds to a gaussian to fit. ; @param ngauss {in}{required}{type=integer} The total number of ; gaussians to fit. ; @param max_iters {in}{required}{type=long} max interations ; @param coefficients {out}{required}{type=2-D array} 2-D array of the form [[h,c,w],[h,c,w],[h,c,w],...], ; where h, c, w are the results for the fit of the height, center, and width. If one of these was specified ; as fixed, it will return identical to its value in the inits param. ; @param errors {out}{required}{type=2-D array} 2-D array of the form [[h,c,w],[h,c,w],[h,c,w],...], ; where h, c, w are the 1-sigma errors for the results returned in the coefficients parameter ; ; @keyword parinfo {in}{optional}{type=array} Array of structures for placing different constraints on each parameter: ; Each parameter is associated with one element of the array, in ; numerical order. The structure can have the following entries ; (none are required): ; ; @keyword _EXTRA {in}{optional}{type=record} Extra keywords are ; passed to mpcurvefit. ; ; @returns fits array: the fit for each region, back to back. Use nregions and regions parameters to ; unwrap this result. ; ; @uses mpcurvefit.pro ; ; @examples ; ; simple example: one gaussian ; ;
; ; 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