Viewing contents of file '../idllib/astron/contrib/bhill/rstat.pro'
PRO RSTAT, Data_in, Med, Hinge1, Hinge2, Ifence1, Ifence2, $
    Ofence1, Ofence2, Mind, Maxd, $
    TEXTOUT=textout, DESCRIP=descr, NOPRINT=noprint
;+
; NAME:
;   rstat
;
; PURPOSE:
;   Robust statistics on an array.  Results are output in terms of
;   "hinges" and "fences" as defined in Tukey's Exploratory Data
;   Analysis; these are the quantities that are typically used in
;   box-and-whisker plots.  These descriptive statistics are particularly
;   useful for telling whether a distribution has long tails or outliers.
;
; MAJOR TOPICS:
;   Statistics.
;
; CALLING SEQUENCE:
;   RSTAT, Data_in, Med, Hinge1, Hinge2, Ifence1, Ifence2, $
;       Ofence1, Ofence2, Mind, Maxd
;
; INPUT PARAMETERS:
;   data_in     Array of numbers to be characterized.
;
; INPUT KEYWORDS:
;   noprint     Flag.  Omit printing if set.
;   textout     The usual GSFC TEXTOUT parameter.
;   descrip     Descriptive line for hardcopy.
;                       
; OUTPUT PARAMETERS:
;   med         Median.
;   hinge1      Lower quartile.
;   hinge2      Upper quartile.
;   ifence1     Lower one of the inner fences =
;                   hinge1 - 1.5*(interquartile interval)
;   ifence2     Upper one of the inner fences =
;                   hinge2 + 1.5*(interquartile interval)
;   ofence1     Lower one of the outer fences =
;                   hinge1 - 3*(interquartile interval)
;   ofence2     Upper one of the outer fences =
;                   hinge2 + 3*(interquartile interval)
;   mind, maxd  Min and max.
;
; HISTORY:   2 Dec. 1996 - Written.  RSH, HSTX
;           15 Sep. 1999 - Spiffed up for usage similar to imlist.  RSH
;            1 June 2000 - Improved descriptive header for output.  RSH
;            3 July 2000 - IDL V5 and idlastro standards.  Check for
;                          existence of finite data.  RSH
;-

on_error, 2

IF n_params(0) LT 1 THEN BEGIN
    print, 'CALLING SEQUENCE:  RSTAT, Data_in, Med, '
    print, 'Hinge1, Hinge2, Ifence1, Ifence2, Ofence1, Ofence2, Mind, Maxd'
    print, 'KEYWORD PARAMETERS:  TEXTOUT, DESCRIP, NOPRINT'
    RETURN
ENDIF

nf = '(G9.3)'
itf = '(I9)'
IF NOT keyword_set(textout) THEN textout=!TEXTOUT

IF datatype( TEXTOUT ) NE 'STR' THEN BEGIN
    textout = textout > 2                  ;Don't use /MORE
    IF (textout GE 3) and (textout NE 5) THEN hardcopy = 1 ELSE hardcopy = 0
ENDIF ELSE hardcopy = 1

textopen, 'RSTAT', TEXTOUT = textout, /STDOUT  

IF hardcopy THEN BEGIN   ;Direct output to a disk file
    printf,!TEXTUNIT,'RSTAT: ' + systime(0)
    IF NOT keyword_set( DESCR ) THEN BEGIN
       descr = ''
       read,'Enter a brief description to be written to disk: ',descr
    ENDIF
    printf,!TEXTUNIT,descr
    printf,!TEXTUNIT,' '
ENDIF  

nin = n_elements(data_in)
wfin = where(finite(data_in), nfin)

IF nfin LE 0 THEN BEGIN
    printf, !TEXTUNIT, 'No finite numbers in data array.'
    textclose,textout=textout
    RETURN
ENDIF

data = data_in[wfin]

s = sort(data)
n = n_elements(data)

dmed = 0.5*(n+1)
fdmed = floor(dmed)
IF (n MOD 2) EQ 0 THEN BEGIN
    end1 = fdmed-1
    end2 = fdmed
    med = 0.5*(data[s[end1]] + data[s[end2]])
    dlet = 'h'
ENDIF ELSE BEGIN
    end1 = fdmed-1
    end2 = fdmed-1
    med = data[s[end1]]
    dlet = ' '
ENDELSE
                 
n1 = end1 + 1
dhinge = 0.5*(n1+1)
fdhinge = floor(dhinge)
IF (fdmed MOD 2) EQ 0 THEN BEGIN
    hinge1 = 0.5*(data[s[fdhinge-1]] + data[s[fdhinge]])
    hinge2 = 0.5*(data[s[n-fdhinge]] + data[s[n-fdhinge-1]])
    hlet = 'h'
ENDIF ELSE BEGIN
    hinge1 = data[s[fdhinge-1]]
    hinge2 = data[s[n-fdhinge]]
    hlet = ' '
ENDELSE

mind = data[s[0]]
maxd = data[s[n-1]]

hspread = hinge2-hinge1
step = 1.5*hspread
ifence1 = hinge1 - step
ifence2 = hinge2 + step
ofence1 = ifence1 - step
ofence2 = ifence2 + step

wo1 = where(data LT ifence1 AND data GE ofence1, co1) 
wo2 = where(data GT ifence2 AND data LE ofence2, co2) 
wf1 = where(data LT ofence1, cf1) 
wf2 = where(data GT ofence2, cf2) 
wcen = where(data GE ifence1 AND data LE ifence2, ccen)

IF NOT keyword_set(noprint) THEN BEGIN

    printf, !TEXTUNIT, "Tukey's Descriptive Statistics: "
    printf, !TEXTUNIT, 'HINGES  = 1st and 3rd quartiles; SPREAD = interquartile; '
    printf, !TEXTUNIT, 'STEP = 1.5*spread; INNER FENCES are 1 step outside the'
    printf, !TEXTUNIT, 'hinges; OUTER FENCES are 2 steps outside the hinges'
    printf, !TEXTUNIT, ' '
    printf, !TEXTUNIT, 'N finite = ' + strn(n) $
        +'               (N total = '  +strn(nin) + ')'
    printf, !TEXTUNIT, ' '

    printf, !TEXTUNIT, '    Min         Hinge       Median      Hinge        Max'
    printf, !TEXTUNIT, string(mind,form=nf) + '   ' + string(hinge1,form=nf) $
        + '   ' + string(med,form=nf) + '   ' + string(hinge2,form=nf) $
        + '   ' + string(maxd,form=nf)
    printf, !TEXTUNIT, ' '
    printf, !TEXTUNIT, 'RANGE = '+strn(maxd-mind,form=nf) $
       + '; SPREAD = '+strn(hspread,form=nf) $
       + '; STEP = '+strn(step,form=nf) 
    printf, !TEXTUNIT, ' '

    bl = string(replicate(32b,12))
    printf, !TEXTUNIT, 'CENSUS OF OUTLIERS:'
    printf, !TEXTUNIT, bl+'count ' + string(cf2,form=itf)
    printf, !TEXTUNIT, bl+'                 -------- O.F. = ' + strn(ofence2)
    printf, !TEXTUNIT, bl+'count ' + string(co2,form=itf)
    printf, !TEXTUNIT, bl+'                 -------- I.F. = ' + strn(ifence2)
    printf, !TEXTUNIT, bl+'count ' + string(ccen,form=itf)
    printf, !TEXTUNIT, bl+'                 -------- I.F. = ' + strn(ifence1)
    printf, !TEXTUNIT, bl+'count ' + string(co1,form=itf)
    printf, !TEXTUNIT, bl+'                 -------- O.F. = ' + strn(ofence1)
    printf, !TEXTUNIT, bl+'count ' + string(cf1,form=itf)
    printf, !TEXTUNIT, bl+' '

ENDIF

textclose,textout=textout

RETURN
END