Viewing contents of file '../idllib/contrib/buie/avgclip.pro'
;+
; NAME:
; avgclip
; PURPOSE:
; Average over a 3-D array, clipping unusual deviants.
; DESCRIPTION:
; Calculate the average value of an array, or calculate the average
; value over one dimension of an array as a function of all the other
; dimensions.
; CATEGORY:
; CCD data processing
; CALLING SEQUENCE:
; avgclip,array,average,SCALE=scale,NORMALIZE=normalize
; INPUTS:
; array = 3-D input array. May be any type except string.
; OPTIONAL INPUT PARAMETERS:
; KEYWORD PARAMETERS:
; SCALE - 4 element vector which, if provide, defines the region of the
; array dimensions that are used to scale the mean
; of the arrays before combining. If combined in this
; manner, the arrays are combined weighted by the means.
; [x1,x2,y1,y2]
;
; NORMALIZE - Flag, if set and SCALE used, leaves the output average
; normalized by the SCALE region.
;
; SILENT - Flat, if set will suppress all messages to screen.
;
; OUTPUTS:
; average - 2-D array that is the robust average of the stack.
; COMMON BLOCKS:
; SIDE EFFECTS:
; RESTRICTIONS:
; PROCEDURE:
; MODIFICATION HISTORY:
; 1992 Dec 30, Marc W. Buie, Lowell Observatory, cloned from AVG
; and added average sigma clipping.
; 95/03/10, MWB, extensive re-write to optimize.
; 97/06/19, MWB, added SILENT keyword
;-
pro avgclip,arr,average,scale=scale,NORMALIZE=normalize,SILENT=silent
;on_error,2
s = size(arr)
;Verify correct number of parameters.
if n_params() ne 2 then begin
print,'avgclip,arr,result,[SCALE=region],[/NORMALIZE]'
return
endif
;Verify correct type of input array.
if s[0] ne 3 then message,'Error *** Array must be 3-D.'
nimg=s[3]
if nimg le 2 then message,'Error *** There must be at least 3 images in cube.'
;Verify the scaling region, if passed.
if keyword_set(scale) then begin
prescale = 1
if n_elements(scale) ne 4 then begin
print,'AVGCLIP: Error *** scaling region must be a four element vector'
return
endif
x1 = scale[0]
x2 = scale[1]
y1 = scale[2]
y2 = scale[3]
if scale[0] lt 0 then message,'Start of X region is less than zero.'
if scale[0] ge s[1] then message,'Start of X region is greater than array size.'
if scale[1] lt 0 then message,'End of X region is less than zero.'
if scale[1] ge s[1] then message,'End of X region is greater than array size.'
if scale[2] lt 0 then message,'Start of Y region is less than zero.'
if scale[2] ge s[2] then message,'Start of Y region is greater than array size.'
if scale[3] lt 0 then message,'End of Y region is less than zero.'
if scale[3] ge s[2] then message,'End of Y region is greater than array size.'
if scale[0] gt scale[1] then message,'Start of X region is greater than end.'
if scale[2] gt scale[3] then message,'Start of Y region is greater than end.'
endif else begin
prescale = 0
endelse
average = fltarr( s[1], s[2], /nozero)
cr = string("15b) ;"
form='($,a,a,i4,a,g,f6.1,1x,f6.1)'
;cputime,utimez,stimez
;Do scaled robust averaging
if prescale then begin
means = fltarr( nimg )
for i=0,nimg-1 do begin
robomean,arr[x1:x2,y1:y2,i],3.0,0.5,meanval,dummy,sigma
means[i] = meanval
; means[i] = mean(arr[x1:x2,y1:y2,i])
arr[*,*,i]=arr[*,*,i]/means[i]
IF not keyword_set(silent) THEN $
print,'Frame ',i,' scaled by ',means[i]
endfor
endif
IF not keyword_set(silent) THEN $
print,'First pass median average of stack.'
medarr,arr,avg
;return
;IF not keyword_set(silent) THEN $
; print,'create minmax clipped average image'
;low = arr[*,*,0]
;hi = arr[*,*,1]
;z = where(low gt hi, count)
;if count ne 0 then begin
; tmp = low[z]
; low[z] = hi[z]
; hi[z] = tmp
;endif
;accum=fltarr(s[1],s[2])
;for i=2,nimg-1 do begin
; new = arr[*,*,i]
; z = where(new lt low, count)
; if count ne 0 then begin
; tmp = low[z]
; low[z] = new[z]
; new[z] = tmp
; endif
; z = where(new gt hi, count)
; if count ne 0 then begin
; tmp = hi[z]
; hi[z] = new[z]
; new[z] = tmp
; endif
; accum = accum + new
;endfor
;setwin,2,xsize=s[1],ysize=s[2]
;tvscl,accum
;avg=median(accum/(nimg-2),11)
;setwin,3,xsize=s[1],ysize=s[2]
;tvscl,avg
IF not keyword_set(silent) THEN print,'create sigma array'
;sig=fltarr(s[1],s[2])
;for i=0,nimg-1 do $
; sig = sig + (arr[*,*,i]-avg)^2
sigma=sqrt(avg)
;sigma=replicate(1.0,s[1],s[2])
;z = where(sigma gt 0.,count)
;if count ne 0 then sigma[z] = sqrt(avg[z])
;sigall = total(sqrt(sig)/sigma)/sqrt(nimg-1.0)/n_elements(sig)
;sigma = sigma*sigall
;setwin,4,xsize=s[1],ysize=s[2]
;tvscl,sigma
;setwin,4,xsize=s[1],ysize=s[2]
;ans=''
thresh=3.0
IF not keyword_set(silent) THEN $
print,'create residual image, ',thresh,' sigma clipping threshold.'
asum = fltarr(s[1],s[2])
acnt = fltarr(s[1],s[2])
npts = s[1] * s[2]
average = fltarr(s[1],s[2])
for i=0,nimg-1 do begin
new = arr[*,*,i]
resid = (new-avg)/sigma
skysclim,resid,lowval,hival,rmean,rsig
resid = resid/rsig
IF not keyword_set(silent) THEN $
print,i,rsig
;print,minmax(new),minmax(sigma),minmax(resid)
;tvscl,new/sigma > thresh
;asdf
;read,prompt='continue? ',ans
z = where(abs(resid) lt thresh,count)
if count ne 0 then begin
asum[z] = asum[z]+arr[z+npts*i]
acnt[z] = acnt[z] + 1.0
endif
endfor
z = where(acnt ne 0,count)
if count ne 0 then begin
average[z]= asum[z]/acnt[z]
endif
if prescale and not keyword_set(normalize) then average = average*means[0]
IF not keyword_set(silent) THEN $
print,cr,' done '
end