/**********************************************************************************************************
* Program allowing to estimate the SPLE model
* The program is designed to load data by block so that there is no memory issue 
***********************************************************************************************************/

new;

library pgraph,maxlik,optmum ;

dlibrary -a c:\temp\sple3f.dll;

#include maxlik.ext;
#include optmum.ext;
maxset; graphset;


/**********************************************************************************************************
* Reading the data
***********************************************************************************************************/

/* Path of the directory in which the estimated quantities will be stored */

spath="C:\\dossiers\\SpatialM\\GMS_ANPE\\publication_JAE_doc\\";

/* File containing the number of unemployed worker by municipality */

fich1= spath $+ "vcom";
open f1=^fich1 for read;
fvcom=readr(f1,rowsf(f1));
nvar1=getname(fich1);
close(f1);
clearg vcom;
makevars(fvcom,0,nvar1);

rcom=rows(vcom);

/* File containing the data at the individual level */

fich2= spath $+ "panel";
nvar2=getname(fich2);
declare matrix sex2, enf1, enf2, enf3, enf4, enf5, nat2, nat3, nat4, nat5, edu2, edu3, edu4, age, age2, mat2, mat3, mat4, handi, 
               mins2, mins3, mins4, mins5, mins6, a, e, i, c, t, depcom;
clearg sex2, enf1, enf2, enf3, enf4, enf5, nat2, nat3, nat4, nat5, edu2, edu3, edu4, age, age2, mat2, mat3, mat4, handi, 
       mins2, mins3, mins4, mins5, mins6, a, e, i, c, t, depcom;
cx=22;

u=i;


/* Creation of the list of variables */

proc (3) = vliste(f2,nb);
local fh,x,sortie;
fh=readr(f2,nb);
makevars(fh,0,nvar2);
age=age/100; age2=age2/1000;
x=mins2~mins3~mins4~mins5~mins6~age~age2~sex2~mat2~enf1~enf2~enf3~enf4~enf5~nat2~nat3~nat4~nat5~edu2~edu3~edu4~handi;
sortie=e~a~i;
retp(x,t,sortie); endp;



/****************************************************
* Partial likelihood for a given type of exit s
*****************************************************/

proc flik(param,s);
local j,cumobs,debc,finc,clik,liktot,x,t,p,size,sortie,r,f2;

open f2=^fich2 for read; /* Opening the data file */
liktot=zeros(sumc(vcom),1);
cumobs=0;

/* Contribution to the likelihood computed for every municipality */
for j(1,rcom,1);

    /* Loading data for the jth municipality */
    {x,t,sortie}=vliste(f2,vcom[j,1]);
  
    /* Dfinition of variables used in the computation of the contribution to the likelihood of municipality j */
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];
    clik=zeros(vcom[j,1],1);
    size=vcom[j,1];
    
    /* Computing the contribution to likelihood of municipalities using C routines */
    /* The use of C routines makes the program faster                              */
    
    dllcall comlik(x,t,size,param,clik);
    
    liktot[debc:finc,1]=clik.*sortie[.,s]+(1-sortie[.,s]);
    cumobs=cumobs+vcom[j,1];
endfor;

close(f2); /* Closing  the data file */
retp(liktot);
endp;



/******************************************************************
* Computation of the partial likelihood for exit to job
*******************************************************************/

proc like(param,x);
local liktot,savepare_all;
savepare_all=param;
liktot=flik(param,1);
retp(ln(liktot));
endp;


/******************************************************************
* Computation of the partial likelihood for exit to non-employment
*******************************************************************/

proc lika(param,x);
local liktot,savepara_all;
savepara_all=param;
save path=C:\dossiers\SpatialM\GMS_ANPE\params\1st_stage savepara_all;
liktot=flik(param,2);
retp(ln(liktot));
endp;



/*************************************************************************************
* Commputation of the integrated hasard for every municipalities,
* as well as their covariance matrix
**************************************************************************************/

proc (2) = hccom(p,cov,s);
local j,tt,cumobs,debc,finc,som,exit,a,b,vb,hc,vhc,x,t,tmc,rxc,hcc,vhcc,tmax,f2,sortie;

open f2=^fich2 for read; /* Opening the data file */

cumobs=0;
j=1;

tmax=1;

hc=zeros(tmax,rcom);
vhc=zeros(tmax,rcom);

for j(1,rcom,1);
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];

    /* Loading data for the jth municipality */
    {x,t,sortie}=vliste(f2,vcom[j,1]);

    if t[vcom[j,1],1]>tmax;
        hc = hc|zeros(t[vcom[j,1],1]-tmax,rcom);
        vhc=vhc|zeros(t[vcom[j,1],1]-tmax,rcom);
        tmax=t[vcom[j,1],1];
    endif;

    tmc=t[vcom[j,1],1]; rxc=vcom[j,1]; hcc=zeros(tmc,1); vhcc=zeros(tmc,1); exit=sortie[.,s];    
    a=zeros(tmc,cx); b=zeros(tmc,1);

    dllcall hazc(x,t,exit,rxc,p,hcc,a,b);

    for tt(1,tmc,1); vhcc[tt,1]=b[tt,1]+a[tt,.]*cov*a[tt,.]'; endfor;
    hc[1:tmc,j]=hcc;
    vhc[1:tmc,j]=vhcc;
    cumobs=cumobs+vcom[j,1];
endfor;

close(f2); /* Closing  the data file */

retp(hc,vhc);
endp;



/****************************************************************************************
* Kaplan-Meier estimators of municipality survival functions, as well as their variances 
*****************************************************************************************/

proc (2) = kapcom(s);
local j,cumobs,debc,finc,kap,vkap,kapc,vkapc,tmax,tmc,tt,tcom,ncom,scom,f2,x,t,sortie;

tmax=1;
kap=zeros(tmax,rcom); vkap=zeros(tmax,rcom);
open f2=^fich2 for read; /* Opening the data file */

cumobs=0;
for j(1,rcom,1);
    /* Loading data for the jth municipality */
    {x,t,sortie}=vliste(f2,vcom[j,1]);

    if t[vcom[j,1],1]>tmax;
        kap = kap|zeros(t[vcom[j,1],1]-tmax,rcom);
        vkap=vkap|zeros(t[vcom[j,1],1]-tmax,rcom);
        tmax=t[vcom[j,1],1];
    endif;

    ncom=vcom[j,1];    

    scom=sortie[.,s]; tmc=t[vcom[j,1],1];
    kapc=zeros(tmc,1); vkapc=zeros(tmc,1);
    
    dllcall kaplan(t, ncom, tmc, scom, kapc, vkapc);
    
    kap[1:tmc,j]=kapc; vkap[1:tmc,j]=vkapc; 
endfor;

close(f2); /* Closing  the data file */

retp(kap,vkap);
endp;






/**********************************************************************************************************
* Partial likelihood maximization
***********************************************************************************************************/

/* Gradient tolerance*/
_Max_GradTol=1e-7;

/* Computation of the covariance matrix using score product */
_Max_CovPar=2;

/* Maximization Algorithm: BHHH */
_Max_Algorithm=5;

/* Label of parameters */
_Max_ParNames= "February" | "March   " | "April   " | "May     " | "June    " 
             | "Age     " | "Age    " | "Female  " | "Couple  " | "1 child " | "2 childn" | "3 childn" 
             | "4 childn" | "5+ child" | "European" | "North Af" | "Afr. Sub" | "Other   " | "High Sch"
             | "Technic." | "No dip. " | "Disabled";

/* Maximization using maxlik */

parinite=zeros(cx,1);
parinita=zeros(cx,1);
null=ones(sumc(vcom),1);

{sole,fe,grae,cove,coe}=maxlik(null,0,&like,parinite);
save path=^spath savepare_all=sole cove_all=cove;

{sola,fa,graa,cova,coa}=maxlik(null,0,&lika,parinita);
save path=^spath savepara_all=sola cova_all=cova;

call maxprt(sole,fe,grae,cove,coe);
call maxprt(sola,fa,graa,cova,coa);

__title = "Exit to job : Wald confidence Limits";
cle=maxtlimits(sole,cove);
call maxclprt(sole,fe,grae,cle,coe);

__title = "Other exit : Wald confidence Limits";
cla=maxtlimits(sola,cova);
call maxclprt(sola,fa,graa,cla,coa);



/* Computation of the integrated hazards of the model */

load path=^spath, sole="savepare_all.fmt";
load path=^spath, cove="cove_all.fmt";

{hc,vhc}=hccom(sole,cove,1);
save path=^spath, hce=hc vhce=vhc;

load path=^spath, sola="savepara_all.fmt";
load path=^spath, cova="cova_all.fmt";

{hc,vhc}=hccom(sola,cova,2);
save path=^spath, hca=hc vhca=vhc;



/* Computation of the Kaplan Meier estimators */

{kap,vkap}=kapcom(1);
save path=^spath, kape=kap vkape=vkap;

{kap,vkap}=kapcom(2);
save path=^spath, kapa=kap vkapa=vkap;






