THEILDECPG.fjg

/*
     THEIL INEQUALITY INDEX DECOMPOSITION             March/96 - R7: November/2014
*/
COM [STRING] %%THEILDECPG =                'THEILDECPG - Version R7: November/2014'

PROC   THEILDECPG  Y  A  TBEGP  TENDP   OUTEXT   OUTINT
TYPE   SER         Y  A
TYPE   INT               TBEGP  TENDP
TYPE   REAL                            *OUTEXT  *OUTINT
*
LOCAL  VEC[LAB]  GROUP
LOCAL  INTEGER   TBEG  TEND  I  N  NG
LOCAL  SERIES    S  W  SMPL  B  SM TY TP P
LOCAL  VEC[SER]  TH
LOCAL  REAL      TG TE TI
*
OPTION SWITCH    PRINT   1
OPTION REAL      BETA    0.
OPTION SERIES    WEIGHT
OPTION SERIES    SMPLL
OPTION VEC[LAB]  GROUPL

INQUIRE(REG) TBEG>>TBEGP TEND>>TENDP
# Y A
IF %DEFINED(SMPLL)
   SET SMPL TBEG TEND = %IF(SMPLL!=0.AND.%VALID(Y).AND.%VALID(A),1,0)
ELSE
   SET SMPL TBEG TEND =                  %VALID(Y).AND.%VALID(A)

IF %DEFINED(WEIGHT)
   SET P TBEG TEND = WEIGHT
ELSE
   SET P TBEG TEND = 1

SAM(SMPL=SMPL) Y  TBEG TEND S 1
SAM(SMPL=SMPL) P  TBEG TEND W 1
SAM(SMPL=SMPL) A  TBEG TEND B 1
INQ(SER=S) *   N

SET          TY 1 N = S*W
@S%(NOPRINT) TY 1 N   TY
@S%(NOPRINT) W  1 N   TP
COM NG = FIX(%MAXVALUE(B))
DIM GROUP(NG) TH(5)
IF %DEFINED(GROUPL)
   COM GROUP    =  GROUPL
ELSE
   EWI GROUP(I) = %CONCAT('Sub-Group_',%STRING(I))

*   Indexes
DO I=1,5
   SET TH(I) 1 NG = %NA
END DO I
DO I=1,NG
   CLE SM
   SET SM 1 N  = %IF(FIX(B)==I,1,0)
   @THEIL(NOPRINT,SMPL=SM,WEI=W,BETA=BETA) S 1 N TH(3)(I)
   COM TH(1)(I) = %MEAN, TH(2)(I) = %DOT(SM,W),  TH(5)(I) = FLOAT(%NOBS),  $
       TH(4)(I) = %IF(BETA==0,%DOT(SM,TP),%IF(BETA==1,%DOT(SM,TY),%DOT(SM,TP)**(1-BETA)*%DOT(SM,TY)**BETA))
END DO I
COM TG = %THEIL_INEQ(S,W,BETA), TE = %THEIL_INEQ(TH(1),TH(2),BETA), TI = %DOT(TH(4),TH(3))

IF PRINT
   {
   DIS 'Theil Inequality Index decomposition by population subgroups' %L(Y)   $
        %IF(%DEFINED(WEIGHT),'weigthed by '+%LABEL(WEIGHT),'')
   DIS 'Observations' N @+5 '(' @-1 TEND-TBEG+1 'Total -' (TEND-TBEG+1)-N 'Skipped/Missing)'
   DIS 'Sample period: From' %DATELABEL(TBEG) 'to' %DATELABEL(TEND)
   DIS 'Inequality parameter' ###.## BETA
   DIS '   Global Index            External Index (%)          Internal Index (%)'
   DIS     TG  @+9 TE '(' @-1 ##.## 100*TE/TG @-1 '%)'   @+6 * TI '(' @-1 ##.## 100*TI/TG @-1 '%)'
   DIS
   DIS 'Decomposition of the Internal Index - Agreggated groups =' NG
   DIS '                            Internal      Weight         Value'
   DIS '   Group    Observations     Index     in the index   in the index' 
   DO I = 1,NG
      DIS  GROUP(I) @18 FIX(TH(5)(I)) @23 TH(3)(I) TH(4)(I) TH(4)(I)*TH(3)(I)
   END DO I
   IF .NOT.(BETA==1.OR.BETA==0)
      DIS 'WARNING: Weights DO NOT sum unity - Weights sum' ###.## %SUM(TH(4))*100 @-1 '%'
   DIS;DIS
   }

IF %DEFINED(OUTEXT);   COM OUTEXT = TE
IF %DEFINED(OUTINT);   COM OUTINT = TI

CLE S  W  SMPL  B  SM  TY  TP  P  TH
END PROC THEILDECPG