Viewing contents of file '../idllib/astron/contrib/freudenreich/chainsaw.pro'
FUNCTION CHAINSAW,MAP,WIDTH, FLOOR=MINV
;
;+
; NAME:
; CHAINSAW
;
; PURPOSE:
; Remove isolated HIGH elements from a 2D array, replacing them with a
; local surface fit.
;
; CALLING SEQUENCE:
; NewMap = CHAINSAW( Map, Width,( FLOOR = ] )
; INPUT ARGUMENT:
; MAP = the array to de-point
;
;INPUT ARGUMENT:
; WIDTH = the width of the square moving neighborhood centered on the
; pixel in question. If there are too few non-empty pixels
; within this neighborhood, nothing is done.
;
; OPTIONAL INPUT KEYWORS:
; FLOOR = the value representing an empty pixel. Default = 0.0
;
; OUTPUT:
; NEWMAP - The input array, with point sources (or just exceptionally
; bright pixels) removed.
;
; METHOD:
; Divides the neighborhood into 4 rectangular areas, finds the minimum
; of each, and fits a plane to the 4 points. The central pixel is
; replaced by the value of the plane at its location, unless it is
; already fainter. The end result is much like that of EROSION+DILATION,
; but does not have mask-shaped artifacts. Edges of width WIDTH/2-1 are
; unaffected.
;
; SUBROUTINES CALLED:
; Planefit, Med
;
; REVISIONS HISTORY:
; Written, H.T. Freudenreich, HSTX, 10/94
;-
ON_ERROR,2
IF KEYWORD_SET(MINV) THEN EMPTY=MINV ELSE EMPTY=0.0
; Set some needed constants:
SYZ=SIZE(MAP)
NX=SYZ(1) & NY=SYZ(2)
OFF=FIX(WIDTH)/2
TOP=1.0E37
; Get coordinates of the neighborhood pixels:
U=FINDGEN(WIDTH) & V=FINDGEN(WIDTH)
XX=FLTARR(WIDTH,WIDTH) & YY=FLTARR(WIDTH,WIDTH)
FOR I=0,WIDTH-1 DO XX(*,I)=U & U=0
FOR I=0,WIDTH-1 DO YY(I,*)=V & V=0
X1=XX(OFF+1:WIDTH-1,OFF:WIDTH-1)
X2=XX(0 :OFF, OFF+1:WIDTH-1)
X3=XX(0 :OFF-1, 0 :OFF)
X4=XX(OFF :WIDTH-1,0 :OFF-1)
Y1=YY(OFF+1:WIDTH-1,OFF:WIDTH-1)
Y2=YY(0 :OFF, OFF+1:WIDTH-1)
Y3=YY(0 :OFF-1, 0 :OFF)
Y4=YY(OFF :WIDTH-1,0 :OFF-1)
QUADNUM=(WIDTH^2-1)/4
U=FLTARR(4) & V=U & Z=U
AMAP = MAP
FOR I=OFF,NX-OFF-1 DO BEGIN
FOR J=OFF,NY-OFF-1 DO BEGIN
; Extract the neighborhood:
AA=MAP(I-OFF:I+OFF,J-OFF:J+OFF)
; Are there enough non-zero points? Is there at least 1 in each quadrant of
; the neighborhood?
AA(OFF,OFF)=EMPTY
Q=WHERE(AA GT EMPTY,N)
IF N GT 3 THEN BEGIN
A1=AA(OFF+1:WIDTH-1,OFF:WIDTH-1)
A2=AA(0 :OFF, OFF+1:WIDTH-1)
A3=AA(0 :OFF-1, 0 :OFF)
A4=AA(OFF :WIDTH-1,0 :OFF-1)
Q1=WHERE(A1 GT EMPTY,N1)
Q2=WHERE(A2 GT EMPTY,N2)
Q3=WHERE(A3 GT EMPTY,N3)
Q4=WHERE(A4 GT EMPTY,N4)
IF (N1 GT 0) AND (N2 GT 0) AND (N3 GT 0) AND (N4 GT 0) THEN BEGIN
IF N1 LT QUADNUM THEN A1(WHERE(A1 LE EMPTY))=TOP
IF N2 LT QUADNUM THEN A2(WHERE(A2 LE EMPTY))=TOP
IF N3 LT QUADNUM THEN A3(WHERE(A3 LE EMPTY))=TOP
IF N4 LT QUADNUM THEN A4(WHERE(A4 LE EMPTY))=TOP
Q=WHERE(A1 EQ MIN(A1))
Z(0)=A1(Q(0)) & U(0)=X1(Q(0)) & V(0)=Y1(Q(0))
Q=WHERE(A2 EQ MIN(A2))
Z(1)=A2(Q(0)) & U(1)=X2(Q(0)) & V(1)=Y2(Q(0))
Q=WHERE(A3 EQ MIN(A3))
Z(2)=A3(Q(0)) & U(2)=X3(Q(0)) & V(2)=Y3(Q(0))
Q=WHERE(A4 EQ MIN(A4))
Z(3)=A4(Q(0)) & U(3)=X4(Q(0)) & V(3)=Y4(Q(0))
WT=[N1,N2,N3,N4]/(FLOAT(N1+N2+N3+N4))
CC=PLANEFIT( U,V,Z, WT )
IF N_ELEMENTS(CC) LT 3 THEN BCK=MED(Z) ELSE $
BCK=CC(0)+CC(1)*XX(OFF,OFF)+CC(2)*YY(OFF,OFF)
IF (AMAP(I,J) LE EMPTY) OR (AMAP(I,J) GT BCK) THEN AMAP(I,J) = BCK
; Now, take care of the edges:
if j eq off then begin
if n_elements(cc) eq 3 then $
amap(i,0:off-1)=cc(0)+cc(1)*xx(off,0:off-1)+cc(2)*yy(off,0:off-1) $
else amap(i,0:off-1)=bck
endif else if j eq ny-off-1 then begin
if n_elements(cc) eq 3 then $
amap(i,ny-off:ny-1)=cc(0)+cc(1)*xx(off,off+1:width-1) + $
cc(2)*yy(off,off+1:width-1) $
else amap(i,ny-off:ny-1)=bck
endif
if i eq off then begin
if n_elements(cc) eq 3 then $
amap(0:off-1,j)=cc(0)+cc(1)*xx(0:off-1,off)+cc(2)*yy(0:off-1,off) $
else amap(0:off-1,j)=bck
if j eq off then begin
if n_elements(cc) eq 3 then $
amap(0:off-1,0:off-1)=cc(0)+cc(1)*xx(0:off-1,0:off-1) + $
cc(2)*yy(0:off-1,0:off-1) $
else amap(0:off-1,0:off-1)=bck
endif else if j eq ny-off-1 then begin
if n_elements(cc) eq 3 then $
amap(0:off-1,ny-off:ny-1)=cc(0)+ $
cc(1)*xx(0:off-1,off+1:width-1)+ $
cc(2)*yy(0:off-1,off+1:width-1) $
else amap(0:off-1,ny-off:ny-1)=bck
endif
endif else if i eq nx-off-1 then begin
if n_elements(cc) eq 3 then $
amap(nx-off:nx-1,j)=cc(0)+cc(1)*xx(off+1:width-1,off) + $
cc(2)*yy(off+1:width-1,off) $
else amap(nx-off:nx-1,j)=bck
if j eq ny-off-1 then begin
if n_elements(cc) eq 3 then $
amap(nx-off:nx-1,ny-off:ny-1)=cc(0)+$
cc(1)*xx(off+1:width-1,off+1:width-1) + $
cc(2)*yy(off+1:width-1,off+1:width-1) $
else amap(nx-off:nx-1,ny-off:ny-1)=bck
endif else if j eq off then begin
if n_elements(cc) eq 3 then $
amap(nx-off:nx-1,0:off-1)=cc(0)+$
cc(1)*xx(off+1:width-1,0:off-1) + $
cc(2)*yy(off+1:width-1,0:off-1) $
else amap(nx-off:nx-1,0:off-1)=bck
endif
endif
ENDIF ELSE $
PRINT,'CHAINSAW: Failed at ',i,',',j,'. Poor coverage.'
ENDIF
ENDFOR
ENDFOR
RETURN,AMAP
END