/usr/share/gnudatalanguage/astrolib/frebin.pro is in gdl-astrolib 2018.02.16+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | function frebin,image,nsout,nlout,total=total
;+
; NAME:
; FREBIN
;
; PURPOSE:
; Shrink or expand the size of an array an arbitrary amount using interpolation
;
; EXPLANATION:
; FREBIN is an alternative to CONGRID or REBIN. Like CONGRID it
; allows expansion or contraction by an arbitrary amount. ( REBIN requires
; integral factors of the original image size.) Like REBIN it conserves
; flux by ensuring that each input pixel is equally represented in the output
; array.
;
; CALLING SEQUENCE:
; result = FREBIN( image, nsout, nlout, [ /TOTAL] )
;
; INPUTS:
; image - input image, 1-d or 2-d numeric array
; nsout - number of samples in the output image, numeric scalar
;
; OPTIONAL INPUT:
; nlout - number of lines in the output image, numeric scalar
; If not supplied, then set equal to 1
;
; OPTIONAL KEYWORD INPUTS:
; /total - if set, the output pixels will be the sum of pixels within
; the appropriate box of the input image. Otherwise they will
; be the average. Use of the /TOTAL keyword conserves total counts.
;
; OUTPUTS:
; The resized image is returned as the function result. If the input
; image is of type DOUBLE or FLOAT then the resized image is of the same
; type. If the input image is BYTE, INTEGER or LONG then the output
; image is usually of type FLOAT. The one exception is expansion by
; integral amount (pixel duplication), when the output image is the same
; type as the input image.
;
; EXAMPLE:
; Suppose one has an 800 x 800 image array, im, that must be expanded to
; a size 850 x 900 while conserving the total counts:
;
; IDL> im1 = frebin(im,850,900,/total)
;
; im1 will be a 850 x 900 array, and total(im1) = total(im)
; NOTES:
; If the input image sizes are a multiple of the output image sizes
; then FREBIN is equivalent to the IDL REBIN function for compression,
; and simple pixel duplication on expansion.
;
; If the number of output pixels are not integers, the output image
; size will be truncated to an integer. The platescale, however, will
; reflect the non-integer number of pixels. For example, if you want to
; bin a 100 x 100 integer image such that each output pixel is 3.1
; input pixels in each direction use:
; n = 100/3.1 ; 32.2581
; image_out = frebin(image,n,n)
;
; The output image will be 32 x 32 and a small portion at the trailing
; edges of the input image will be ignored.
;
; PROCEDURE CALLS:
; None.
; HISTORY:
; Adapted from May 1998 STIS version, written D. Lindler, ACC
; Added /NOZERO, use INTERPOLATE instead of CONGRID, June 98 W. Landsman
; Fixed for nsout non-integral but a multiple of image size Aug 98 D.Lindler
; DJL, Oct 20, 1998, Modified to work for floating point image sizes when
; expanding the image.
; Improve speed by addressing arrays in memory order W.Landsman Dec/Jan 2001
;-
;----------------------------------------------------------------------------
On_error,2
compile_opt idl2
if N_params() LT 1 then begin
print,'Syntax = newimage = FREBIN(image, nsout, nlout, [/TOTAL])'
return,-1
endif
if n_elements(nlout) eq 0 then nlout=1
;
; determine size of input image
;
ns = n_elements(image[*,0])
nl = n_elements(image)/ns
;
; determine if we can use the standard rebin function
;
dtype = size(image,/TNAME)
if dtype EQ 'DOUBLE' then begin
sbox = ns/double(nsout)
lbox = nl/double(nlout)
end else begin
sbox = ns/float(nsout)
lbox = nl/float(nlout)
end
; Contraction by an integral amount
if (nsout eq long(nsout)) && (nlout eq long(nlout)) then begin
if ((ns mod nsout) EQ 0) && ((nl mod nlout) EQ 0) then $
if (dtype EQ 'DOUBLE') || (dtype EQ 'FLOAT') then begin
if keyword_set(total) then $
return,rebin(image,nsout,nlout)*sbox*lbox else $
return,rebin(image,nsout,nlout)
endif else begin
if keyword_set(total) then $
return,rebin(float(image),nsout,nlout)*sbox*lbox else $
return,rebin(float(image),nsout,nlout)
endelse
; Expansion by an integral amount
if ((nsout mod ns) EQ 0) && ((nlout mod nl) EQ 0) then begin
xindex = long(lindgen(nsout)/(nsout/ns))
if nl EQ 1 then begin
if keyword_set(total) then $
return,interpolate(image,xindex)*sbox else $
return,interpolate(image,xindex)
endif
yindex = long(lindgen(nlout)/(nlout/nl))
if keyword_set(total) then $
return,interpolate(image,xindex,yindex,/grid)*sbox*lbox else $
return,interpolate(image,xindex,yindex,/grid)
endif
endif
ns1 = ns-1
nl1 = nl-1
; Do 1-d case separately
if nl EQ 1 then begin
if dtype eq 'DOUBLE' then result = dblarr(nsout,/NOZERO) $
else result = fltarr(nsout,/NOZERO)
for i=0L,nsout-1 do begin
rstart = i*sbox ;starting position for each box
istart = long(rstart)
rstop = rstart + sbox ;ending position for each box
istop = long(rstop)<ns1
frac1 = rstart-istart
frac2 = 1.0 - (rstop-istop)
;
; add pixel values from istart to istop and subtract fraction pixel
; from istart to rstart and fraction pixel from rstop to istop
;
result[i] = total(image[istart:istop]) $
- frac1 * image[istart] $
- frac2 * image[istop]
endfor
if keyword_set(total) then return,result $
else return,temporary(result)/(sbox*lbox)
endif
; Now do 2-d case
; First, bin in second dimension
;
if dtype eq 'DOUBLE' then temp = dblarr(ns,nlout, /NOZERO) $
else temp = fltarr(ns,nlout, /NOZERO)
; loop on output image lines
;
for i=0L,nlout-1 do begin
rstart = i*lbox ;starting position for each box
istart = long(rstart)
rstop = rstart + lbox ;ending position for each box
istop = long(rstop)<nl1
frac1 = rstart-istart
frac2 = 1.0 - (rstop-istop)
;
; add pixel values from istart to istop and subtract fraction pixel
; from istart to rstart and fraction pixel from rstop to istop
;
if istart EQ istop then $
temp[0,i] = (1.0 - frac1 - frac2)*image[*,istart] $
else $
temp[0,i] = total(image[*,istart:istop],2) $
- frac1 * image[*,istart] $
- frac2 * image[*,istop]
endfor
temp = transpose(temp)
;
; bin in first dimension
;
if dtype eq 'DOUBLE' then result = dblarr(nlout,nsout,/NOZERO) $
else result = fltarr(nlout,nsout,/NOZERO)
;
; loop on output image samples
;
for i=0L,nsout-1 do begin
rstart = i*sbox ;starting position for each box
istart = long(rstart)
rstop = rstart + sbox ;ending position for each box
istop = long(rstop)<ns1
frac1 = rstart-istart
frac2 = 1.0 - (rstop-istop)
;
; add pixel values from istart to istop and subtract fraction pixel
; from istart to rstart and fraction pixel from rstop to istop
;
if istart eq istop then $
result[0,i] = (1.-frac1-frac2)*temp[*,istart] else $
result[0,i] = total(temp[*,istart:istop],2) $
- frac1 * temp[*,istart] $
- frac2 * temp[*,istop]
end
;
if keyword_set(total) then $
return, transpose(result) $
else return, transpose(result)/(sbox*lbox)
end
|