***************************************************
* PROCEDURE FRACT series startl endl fractseries outaxis
*
* OPTIONS:  [PRINT]/NOPRINT  Print output or not
*
*
* FRACT computes fractiles for a wider range
*       than the standard STATISTICS(fract) command in
*       RATS.  The results are saved to real numbers
*       FRACTxxx, where xxx =
*          MIN, 001, 0025, 005, 01, 025, 05, 10, 20, 25,
*          50, 75, 80, 90, 95, 975, 99, 995, 9975, 999, MAX
*       A decimal point is implied before the number, but
*       omitted; e.g., FRACT0025 is the value .0025
*       through the sample, that is, the 0.25%-ile.
*
* You can also save the fractiles to a series, as well
*  as a series storing the correspdonding percentiles
*  (.001., .0025, etc.), using the FRACTSERIES and OUTAXIS
*  parameters
*
* July 1998
*   Norman Morin, nmorin@frb.gov
*
* December 1998: Minor revisions (comments, defining
*                 additional variables as local) by
*                 Estima.
***************************************************

PROCEDURE FRACT series start end fractseries outaxis


TYPE series series *fractseries *outaxis
TYPE integer start end

OPTION SWITCH PRINT 1

LOCAL SERIES  depvar
LOCAL INTEGER startl endl b i
LOCAL VECT    alpha
LOCAL REAL    a g

INQUIRE(series=series) startl>>start endl>>end

SET depvar startl endl = series
ORDER depvar startl endl


DIMENSION alpha(19)


COMPUTE alpha(1) = .001
COMPUTE alpha(2) = .0025
COMPUTE alpha(3) = .005
COMPUTE alpha(4) = .01
COMPUTE alpha(5) = .025
COMPUTE alpha(6) = .05
COMPUTE alpha(7) = .1
COMPUTE alpha(8) = .2
COMPUTE alpha(9) = .25
COMPUTE alpha(10) = .5
COMPUTE alpha(11) = .75
COMPUTE alpha(12) = .8
COMPUTE alpha(13) = .9
COMPUTE alpha(14) = .95
COMPUTE alpha(15) = .975
COMPUTE alpha(16) = .99
COMPUTE alpha(17) = .995
COMPUTE alpha(18) = .9975
COMPUTE alpha(19) = .999

DO i = 1,19
   COMPUTE a = alpha(i)
   COMPUTE b = fix(a*(endl-startl))+1
   COMPUTE g = (depvar(b+startl)-depvar(b+startl-1))*(a*(endl-startl)+1-b)
   IF i.eq.1
      COMPUTE FRACT001 = depvar(startl+b-1)+g
   ELSE IF i.eq.2
      COMPUTE FRACT0025 = depvar(startl+b-1)+g
   ELSE IF i.eq.3
      COMPUTE FRACT005 = depvar(startl+b-1)+g
   ELSE IF i.eq.4
      COMPUTE FRACT01 = depvar(startl+b-1)+g
   ELSE IF i.eq.5
      COMPUTE FRACT025 = depvar(startl+b-1)+g
   ELSE IF i.eq.6
      COMPUTE FRACT05 = depvar(startl+b-1)+g
   ELSE IF i.eq.7
      COMPUTE FRACT10 = depvar(startl+b-1)+g
   ELSE IF i.eq.8
      COMPUTE FRACT20 = depvar(startl+b-1)+g
   ELSE IF i.eq.9
      COMPUTE FRACT25 = depvar(startl+b-1)+g
   ELSE IF i.eq.10
      COMPUTE FRACT50 = depvar(startl+b-1)+g
   ELSE IF i.eq.11
      COMPUTE FRACT75 = depvar(startl+b-1)+g
   ELSE IF i.eq.12
      COMPUTE FRACT80 = depvar(startl+b-1)+g
   ELSE IF i.eq.13
      COMPUTE FRACT90 = depvar(startl+b-1)+g
   ELSE IF i.eq.14
      COMPUTE FRACT95 = depvar(startl+b-1)+g
   ELSE IF i.eq.15
      COMPUTE FRACT975 = depvar(startl+b-1)+g
   ELSE IF i.eq.16
      COMPUTE FRACT99 = depvar(startl+b-1)+g
   ELSE IF i.eq.17
      COMPUTE FRACT995 = depvar(startl+b-1)+g
   ELSE IF i.eq.18
      COMPUTE FRACT9975 = depvar(startl+b-1)+g
   ELSE IF i.eq.19
      COMPUTE FRACT999 = depvar(startl+b-1)+g

END DO

COMPUTE FRACTMIN = depvar(startl)
COMPUTE FRACTMAX = depvar(endl)

IF PRINT.eq.1 {
   DISP " "
   DISP "  Fractiles of" %LABEL(series)
   DISP "  ---------------------------"
   DISP "  Minimum"  @18 #####.##### FRACTMIN
   DISP "  0.1%-ile" @18 #####.##### FRACT001
   DISP "  0.25%-ile" @18 #####.##### FRACT0025
   DISP "  0.5%-ile" @18 #####.##### FRACT005
   DISP "  1%-ile" @18 #####.##### FRACT01
   DISP "  2.5%-ile" @18 #####.##### FRACT025
   DISP "  5%-ile" @18 #####.##### FRACT05
   DISP "  10%-ile" @18 #####.##### FRACT10
   DISP "  20%-ile" @18 #####.##### FRACT20
   DISP "  25%-ile" @18 #####.##### FRACT25
   DISP "  50%-ile" @18 #####.##### FRACT50
   DISP "  75%-ile" @18 #####.##### FRACT75
   DISP "  80%-ile" @18 #####.##### FRACT80
   DISP "  90%-ile" @18 #####.##### FRACT90
   DISP "  95%-ile" @18 #####.##### FRACT95
   DISP "  97.5%-ile" @18 #####.##### FRACT975
   DISP "  99%-ile" @18 #####.##### FRACT99
   DISP "  99.5%-ile" @18 #####.##### FRACT995
   DISP "  99.75%-ile" @18 #####.##### FRACT9975
   DISP "  99.9%-ile" @18 #####.##### FRACT999
   DISP "  Maximum" @18 #####.##### FRACTMAX
   DISP "  ---------------------------"

  }

if %defined(fractseries)
{
set fractseries 1 19 = 0.
COMPUTE fractseries(1) = FRACT001
COMPUTE fractseries(2) = FRACT0025
COMPUTE fractseries(3) = FRACT005
COMPUTE fractseries(4) = FRACT01
COMPUTE fractseries(5) = FRACT025
COMPUTE fractseries(6) = FRACT05
COMPUTE fractseries(7) = FRACT10
COMPUTE fractseries(8) = FRACT20
COMPUTE fractseries(9) = FRACT25
COMPUTE fractseries(10) = FRACT50
COMPUTE fractseries(11) = FRACT75
COMPUTE fractseries(12) = FRACT80
COMPUTE fractseries(13) = FRACT90
COMPUTE fractseries(14) = FRACT95
COMPUTE fractseries(15) = FRACT975
COMPUTE fractseries(16) = FRACT99
COMPUTE fractseries(17) = FRACT995
COMPUTE fractseries(18) = FRACT9975
COMPUTE fractseries(19) = FRACT999
}
if %defined(outaxis)
{
set outaxis 1 19 = 0.
COMPUTE outaxis(1) = 0.1
COMPUTE outaxis(2) = 0.25
COMPUTE outaxis(3) = 0.5
COMPUTE outaxis(4) = 1
COMPUTE outaxis(5) = 2.5
COMPUTE outaxis(6) = 5
COMPUTE outaxis(7) = 10
COMPUTE outaxis(8) = 20
COMPUTE outaxis(9) = 25
COMPUTE outaxis(10) = 50
COMPUTE outaxis(11) = 75
COMPUTE outaxis(12) = 80
COMPUTE outaxis(13) = 90
COMPUTE outaxis(14) = 95
COMPUTE outaxis(15) = 97.5
COMPUTE outaxis(16) = 99
COMPUTE outaxis(17) = 99.5
COMPUTE outaxis(18) = 99.75
COMPUTE outaxis(19) = 99.9
}
END

