/usr/share/gnudatalanguage/astrolib/remove.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 | pro remove,index, v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13, v14, $
v15, v16, v17, v18, v19, v20, v21, v22, v23, v24, v25
;+
; NAME:
; REMOVE
; PURPOSE:
; Contract a vector or up to 25 vectors by removing specified elements
; CALLING SEQUENCE:
; REMOVE, index, v1,[ v2, v3, v4, v5, v6, ... v25]
; INPUTS:
; INDEX - scalar or vector giving the index number of elements to
; be removed from vectors. Duplicate entries in index are
; ignored. An error will occur if one attempts to remove
; all the elements of a vector. REMOVE will return quietly
; (no error message) if index is !NULL or undefined.
;
; INPUT-OUTPUT:
; v1 - Vector or array. Elements specifed by INDEX will be
; removed from v1. Upon return v1 will contain
; N fewer elements, where N is the number of distinct values in
; INDEX.
;
; OPTIONAL INPUT-OUTPUTS:
; v2,v3,...v25 - additional vectors containing
; the same number of elements as v1. These will be
; contracted in the same manner as v1.
;
; EXAMPLES:
; (1) If INDEX = [2,4,6,4] and V = [1,3,4,3,2,5,7,3] then after the call
;
; IDL> remove,index,v
;
; V will contain the values [1,3,3,5,3]
;
; (2) Suppose one has a wavelength vector W, and three associated flux
; vectors F1, F2, and F3. Remove all points where a quality vector,
; EPS is negative
;
; IDL> bad = where( EPS LT 0, Nbad)
; IDL> if Nbad GT 0 then remove, bad, w, f1, f2, f3
;
; METHOD:
; If more than one element is to be removed, then HISTOGRAM is used
; to generate a 'keep' subscripting vector. To minimize the length of
; the subscripting vector, it is only computed between the minimum and
; maximum values of the index. Therefore, the slowest case of REMOVE
; is when both the first and last element are removed.
;
; REVISION HISTORY:
; Written W. Landsman ST Systems Co. April 28, 1988
; Cleaned up code W. Landsman September, 1992
; Major rewrite for improved speed W. Landsman April 2000
; Accept up to 25 variables, use SCOPE_VARFETCH internally
; W. Landsman Feb 2010
; Fix occasional integer overflow problem V. Geers Feb 2011
; Quietly return if index is !null or undefined W.L. Aug 2011
;
;-
On_error,2
compile_opt idl2,strictarrsubs
npar = N_params()
nvar = npar-1
if npar LT 2 then begin
print,'Syntax - remove, index, v1, [v2, v3, v4,..., v25]'
return
endif
if N_elements(index) EQ 0 then return
vv = 'v' + strtrim( indgen(nvar)+1, 2)
npts = N_elements(v1)
max_index = max(index, MIN = min_index)
if ( min_index LT 0 ) || (max_index GT npts-1) then message, $
'ERROR - Index vector is out of range'
if ( max_index Eq min_index ) then begin ;Remove only 1 element?
Ngood = 0
if npts EQ 1 then message, $
'ERROR - Cannot delete all elements from a vector'
endif else begin
; Begin case where more than 1 element is to be removed. Use HISTOGRAM
; to determine then indices to keep
nhist = max_index - min_index +1
hist = histogram( index) ;Find unique index values to remove
keep = where( hist EQ 0, Ngood ) + min_index
if ngood EQ 0 then begin
if ( npts LE nhist ) then message, $
'ERROR - Cannot delete all elements from a vector'
endif
endelse
imin = min_index - 1
imax = max_index + 1
i0 = (min_index EQ 0) + 2*(max_index EQ npts-1)
case i0 of
3: begin
for i=0, nvar-1 do $
(SCOPE_VARFETCH(vv[i],LEVEL=0)) = $
(SCOPE_VARFETCH(vv[i],LEVEL=0))[keep]
return
end
1: ii = Ngood EQ 0 ? imax + lindgen(npts-imax) : $
[keep, imax + lindgen(npts-imax) ]
2: ii = Ngood EQ 0 ? lindgen(imin+1) : $
[lindgen(imin+1), keep ]
0: ii = Ngood EQ 0 ? [lindgen(imin+1), imax + lindgen(npts-imax) ] : $
[lindgen(imin+1), keep, imax + lindgen(npts-imax) ]
endcase
for i=0,nvar-1 do $
(SCOPE_VARFETCH(vv[i],LEVEL=0)) = $
(SCOPE_VARFETCH(vv[i],LEVEL=0))[ii]
return
end
|