/**********************************************************************************************************
* Program allowing to estimate municipality fixed effects for the two types of exits
* The program also creates a dataset with the results of the estimations
***********************************************************************************************************/

new;

library pgraph,maxlik,optmum ;

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

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


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

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

fich1= spath $+ "panel";

open f1=^fich1 for read;
fhs=readr(f1,rowsf(f1));
nvar1=getname(fich1);
close(f1);

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;

makevars(fhs,0,nvar1);

age=age/100;
age2=age2/1000;
u=i;



/* Census data */

fich2= spath $+ "vcom";

open f2=^fich2 for read;
vc=readr(f2,rowsf(f2));
nvar2=getname(fich2);
close(f2);
clearg vcom, dc, pop90, pop99;
makevars(vc,0,nvar2);
rcom=rows(vcom);



/**********************************************************************************************************
* Explanatory variables
***********************************************************************************************************/

n=rows(fhs);
const=ones(n,1);
x=mins2~mins3~mins4~mins5~mins6~age~age2~sex2~mat2~enf1~enf2~enf3~enf4~enf5~nat2~nat3~nat4~nat5~edu2~edu3~edu4~handi;
cx=cols(x);



/**********************************************************************************************************
* Creation of a vector containing the number of observations by municipality
***********************************************************************************************************/

vcom=1|zeros(n-1,1);

com=1;
for k(2,n,1);
    if depcom[k,1] ne depcom[k-1,1]; com=com+1; endif;
    vcom[com,1]=vcom[com,1]+1;
    endfor;

vcom=vcom[1:sumc((vcom.>0)),1];
rcom=rows(vcom);

numcom=zeros(rcom,1); numcom[1,1]=depcom[1,1];
com=1;
for k(2,n,1);
    if depcom[k,1] ne depcom[k-1,1]; com=com+1; numcom[com,1]=depcom[k,1]; endif;    
endfor;



/**********************************************************************
* Computation of some quantities useful in the second-stage regression
***********************************************************************/

proc (2) = agreg(param,sortie,nb,p);
local i,j,tmc,tmax,xcom,tcom,pe,pa,size,pas,cumobs,debc,finc,s0,obsi,h,y;

cumobs=0;

h=zeros(rcom*nb,1);
y=zeros(rcom*nb,1);

tmax=maxc(t);

for j(1,rcom,1);

    debc=cumobs+1;
    finc=cumobs+vcom[j,1];

    xcom=x[debc:finc,.];
    tcom=t[debc:finc,.];
    
    tmc=maxc(tcom);      
    s0=zeros(rows(xcom),1);
    size=rows(xcom)|cols(xcom);
    
    dllcall soms0b(xcom,tcom,size,param,s0);

    for i(1,nb,1);               
        if i<nb; 
            pas=p; obsi=((i-1)*p+1 .le tcom).*(tcom .le i*p);
            h[(j-1)*nb+i,1]=((i-1)*p<tmc)*(minc(tmc|i*p)-(i-1)*p)/pas;             
        else;
            pas=tmax-(i-1)*p; obsi=((i-1)*p+1 .le tcom);
            h[(j-1)*nb+i,1]=((i-1)*p<tmc)*(tmc-(i-1)*p)/pas;             
        endif;        
        y[(j-1)*nb+i,1]=sumc( obsi.*(sortie[debc:finc,.] .eq 1) ./ s0 ) / pas;        
    endfor;

    cumobs=cumobs+vcom[j,1];
endfor;

retp(y,h);
endp;



/******************************************************************************************************
* Computation of integrated hazards for graphs when the hazard is of the form ai*lambda(t)
*******************************************************************************************************/

proc (1) = hcmulti(lambda,alpha,nb,p);
local j,i,tt,tmax,hc,yc;

tmax=maxc(t);
hc=zeros(tmax,rcom);

hc[1,.]=alpha';

for tt(2,p,1); hc[tt,.]=hc[tt-1,.]+alpha'; endfor;

for tt(p+1,tmax,1);
    i=((tt-1)/p<nb)*(trunc((tt-1)/p)+1)+((tt-1)/p>=nb)*nb;
    hc[tt,.]=hc[tt-1,.]+lambda[i-1,1]*alpha';
endfor;

retp(hc);
endp;



/***********************************************/
/* Computing sums and averages by municipality */
/***********************************************/

proc (1) = sumcom(x,vcom);
local i, rcom, cumobs, debc, finc, mx;
rcom=rows(vcom);
cumobs=0;
mx=zeros(rcom,cols(x));
for j(1,rcom,1);
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];
    mx[j,.]=sumc(x[debc:finc,.])';
    cumobs=cumobs+vcom[j,1];
endfor;
retp(mx); endp;

proc (1) = meancom(x,vcom);
local i, rcom, cumobs, debc, finc, mx;
rcom=rows(vcom);
cumobs=0;
mx=zeros(rcom,cols(x));
for j(1,rcom,1);
    if vcom[j,1]>0;
        debc=cumobs+1;
        finc=cumobs+vcom[j,1];
        mx[j,.]=meanc(x[debc:finc,.])';
        cumobs=cumobs+vcom[j,1];
    endif;
endfor;
retp(mx); endp;



/***************************************************************************************************************
* Computation of the baseline hazard and muncipality fixed effects when the hazard is of the form ai*lambda(t).
* In regressions, observations are weighted by the number of unemployed workers still at risk 
****************************************************************************************************************/

proc (4)=olsmultiw_v(y0,h0,nb,p,s,sols,covs,vcom);
local r0,y,yj,yk,h0j,y0j,h0k,y0k,myj,aj,ak,bj,bk,dumj,dumk,nbj,nbk,i,j,k,ss,tt,cumobs,debc,finc,xcom,tcom,scom,rxc,s0j,s0k,s0,
      a,b,ac,bc,tmc,hhc,vh,cvh,vv,vvj,vvk,som1,som2,som3,som4,som5,som6,binvsom1,alpha,lambda,vlambda,valpha,bvlambda,rcom,tmax,wj,wk,somvh;
rcom=rows(vcom);

tmax=maxc(t);

r0=rows(h0);

/* Creation of the dependent variable. It takes the value zero if there is no exit of no-one in the interval */

y=zeros(r0,1);
for i(1,r0,1); if h0[i,1]>0; if y0[i,1]>0; y[i,1]=ln(y0[i,1])-ln(h0[i,1]); endif; endif; endfor;

/*****************************************/
/* Computation of estimated coefficients */
/*****************************************/

som1=zeros(nb-1,nb-1);
som2=zeros(nb-1,1);

cumobs=0;

for j(1,rcom,1);
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];
    tcom=t[debc:finc,.];  
    rxc=rows(tcom);      
    s0j=zeros(nb,1);
    dllcall nbrisk(tcom,rxc,nb,p,s0j);

    h0j=h0[(j-1)*nb+1:j*nb,1];
    y0j=y0[(j-1)*nb+1:j*nb,1];
    yj=y[(j-1)*nb+1:j*nb,1];
    dumj=(h0j.>0).*(y0j.>0);
            
    s0j=s0j.*dumj; /* We impute a zero wieght for observations for which there is no exit or noone in the interval */
    nbj=sumc(s0j);

    if nbj>0;
        myj=yj-yj'*s0j/nbj*dumj;
        aj=diagrv(eye(nb),dumj)-dumj*s0j'/nbj;
    
        som1=som1+aj[.,2:nb]'*diagrv(eye(nb),s0j)*aj[.,2:nb];
        som2=som2+aj[.,2:nb]'*diagrv(eye(nb),s0j)*myj;
    endif;    

    cumobs=cumobs+vcom[j,1];
endfor;

lambda=inv(som1)*som2;

alpha=zeros(rcom,1);
cumobs=0;

for j(1,rcom,1);
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];
    tcom=t[debc:finc,.];  
    rxc=rows(tcom);      
    s0j=zeros(nb,1);
    dllcall nbrisk(tcom,rxc,nb,p,s0j);
    
    h0j=h0[(j-1)*nb+1:j*nb,1];
    y0j=y0[(j-1)*nb+1:j*nb,1];
    dumj=(h0j.>0).*(y0j.>0);
    
    s0j=s0j.*dumj;
    nbj=sumc(s0j);

    yj=y[(j-1)*nb+1:j*nb,1]-(0|lambda).*dumj;
    alpha[j,1]=yj'*s0j/nbj;

    cumobs=cumobs+vcom[j,1];
endfor;

lambda=exp(lambda);
alpha=exp(alpha);



/******************************************************************************************************************
* Computation of the covariance matrices of the baseline pieces and the municipality fixed effects
******************************************************************************************************************/

a = arrayalloc(rcom|cx|nb,0); 
b = zeros(rcom,nb);

cumobs=0;

for j(1,rcom,1);
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];
    xcom=x[debc:finc,.];
    tcom=t[debc:finc,.];
    scom=s[debc:finc,.];
    tmc=t[finc,1];
    rxc=vcom[j,1];
    hhc=zeros(tmc,1);
    ac=zeros(tmc,cx);
    bc=zeros(tmc,1);
    dllcall hazc(xcom,tcom,scom,rxc,sols,hhc,ac,bc);   

    /* "a" contains the integral for t up to s1/so and "b" contains the integral of t de 1/s0 */ 
    
    if tmc<=p;
        a[j,1:cx,1]=ac[tmc,.]'/tmc;
        b[j,1]=bc[tmc,1]/tmc^2;
    else;
        a[j,1:cx,1]=ac[p,.]'/p;
        b[j,1]=bc[p,1]/p^2;
        tt=2;
        /* Computation of the differences in a and b over some intervals */
        do while ((tt*p<tmc).*(tt<nb));
            a[j,1:cx,tt]=(ac[tt*p,.]-ac[(tt-1)*p,.])'/p;
            b[j,tt]=(bc[tt*p,1]-bc[(tt-1)*p,1])/p^2;
            tt=tt+1;
        endo;
        /* Last interval for which we need to consider the maximum duration of the municipality even if there is no unemployed worker at the end of the period */
        a[j,1:cx,tt]=(ac[tmc,.]-ac[(tt-1)*p,.])'/(tmc-(tt-1)*p);
        b[j,tt]=(bc[tmc,1]-bc[(tt-1)*p,1])/(tmc-(tt-1)*p)^2;
    endif;

    cumobs=cumobs+vcom[j,1];
endfor;

/* Computation of the covariance matrix of coefficients */

/* For some given j and k... computation of V(j,k) */
/* The variable vh contains the matrix V(j,k)      */
/***************************************************/

vh=zeros(nb,nb);
som3=zeros(nb-1,nb-1);
som4=zeros(rcom,rcom);
som5=zeros(rcom,rcom);
som6=zeros(rcom,rcom);

cumobs=0;
s0=zeros(nb,rcom);
for j(1,rcom,1);
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];
    tcom=t[debc:finc,.];  
    rxc=rows(tcom);      
    s0j=zeros(nb,1);
    dllcall nbrisk(tcom,rxc,nb,p,s0j);
    s0[.,j]=s0j;
    cumobs=cumobs+vcom[j,1];
endfor;

binvsom1=zeros(1,nb)|(zeros(nb-1,1)~inv(som1));
       
for j(1,rcom,1);
    somvh=zeros(nb,nb);
    for k(1,rcom,1);

        h0j=h0[(j-1)*nb+1:j*nb,1];
        y0j=y0[(j-1)*nb+1:j*nb,1];
        h0k=h0[(k-1)*nb+1:k*nb,1];
        y0k=y0[(k-1)*nb+1:k*nb,1];
        yj =y[(j-1)*nb+1:j*nb,1];
        yk =y[(k-1)*nb+1:k*nb,1];
        dumj=(h0j.>0).*(y0j.>0);
        dumk=(h0k.>0).*(y0k.>0);

        /* We give a zero weight to observations for which therer is no exit or no-one in the interval which is considered */
        s0j=s0[.,j].*dumj;
        s0k=s0[.,k].*dumk;

        nbj=sumc(s0j);
        nbk=sumc(s0k);

        if nbj>0; aj=diagrv(eye(nb),dumj)-dumj*s0j'/nbj; else; aj=zeros(nb,nb); endif; 
        if nbk>0; ak=diagrv(eye(nb),dumk)-dumk*s0k'/nbk; else; ak=zeros(nb,nb); endif; 

        for ss(1,nb,1); 
            for tt(1,nb,1);
                vvj=a[j,.,ss]; vvj=arraytomat(vvj);
                vvk=a[k,.,tt]; vvk=arraytomat(vvk);          
                vh[ss,tt]=vvj'*covs*vvk;
            endfor;
            if (j eq k); vh[ss,ss]=vh[ss,ss]+b[j,ss]; endif;          
        endfor;

        /* We apply the delta method to the covariance of errors in levels to obtain the covariance matrix of errors in logs */
        vh=diagrv(eye(nb),(dumj./exp(yj)))*vh*diagrv(eye(nb),(dumk./exp(yk)));
 
        wj=diagrv(eye(nb),s0j);
        wk=diagrv(eye(nb),s0k);
        
        som3=som3+aj[.,2:nb]'*wj*vh*wk*ak[.,2:nb];
        som4[j,k]=(s0j'/nbj)*vh*(s0k/nbk);

        if nbk>0; cvh=vh-ones(nb,1)*(vh*s0k)'/nbk; else; cvh=zeros(nb,nb); endif;
       
        somvh=somvh+cvh*wk;             
    endfor;

    for k(1,rcom,1); som5[j,k]=(s0j'/nbj)*(somvh*binvsom1)*(s0k/nbk); endfor;
endfor;

vlambda=inv(som1)*som3*inv(som1);

bvlambda=zeros(1,nb)|(zeros(nb-1,1)~vlambda);

for j(1,rcom,1);
    for k(1,rcom,1);
        h0j=h0[(j-1)*nb+1:j*nb,1];
        y0j=y0[(j-1)*nb+1:j*nb,1];
        h0k=h0[(k-1)*nb+1:k*nb,1];
        y0k=y0[(k-1)*nb+1:k*nb,1];
        dumj=(h0j.>0).*(y0j.>0);
        dumk=(h0k.>0).*(y0k.>0);
        s0j=s0[.,j].*dumj;
        s0k=s0[.,k].*dumk;
        nbj=sumc(s0j);
        nbk=sumc(s0k);
        som6[j,k]=(s0j'/nbj)*bvlambda*(s0k/nbk);
    endfor;
endfor;

valpha=som4+som6-(som5+som5');
valpha=missrv(valpha,0);
valpha=diagrv(eye(rcom),alpha)*valpha*diagrv(eye(rcom),alpha);
vlambda=diagrv(eye(nb-1),lambda)*vlambda*diagrv(eye(nb-1),lambda);
retp(lambda,alpha,vlambda,valpha);
endp;



/**********************************************************************************************************
* * Computation of municipality fixed effects and their covariance matrix
***********************************************************************************************************/

proc (4) = fecom_v(ss,nb,p);
local sol, cov, ycom, hcom, lambda, alpha, vlambda, valpha, s;

if ss eq 1;
    s=e;
    load path=^spath sol="savepare_all.fmt" cov="cove_all.fmt";
endif; 

if ss eq 2;
    s=a;
    load path=^spath sol="savepara_all.fmt" cov="cova_all.fmt";
endif;

{ycom,hcom} = agreg(sol,s,nb,p);
{lambda,alpha,vlambda,valpha}=olsmultiw_v(ycom,hcom,nb,p,s,sol,cov,vcom);

retp(lambda,alpha,vlambda,valpha); endp;



/*****************************************************/
/***** COMPUTATION OF MUNICIPALITY FIXED EFFECTS *****/
/*****************************************************/

/* Number of intervals and interval width */
nb=9; p=90;


{lambdae_9_90,alphae_9_90,vlambdae_9_90,valphae_9_90}=fecom_v(1,nb,p);
save path=^spath lambdae_9_90 alphae_9_90 vlambdae_9_90 valphae_9_90;

{lambdaa_9_90,alphaa_9_90,vlambdaa_9_90,valphaa_9_90}=fecom_v(2,nb,p);
save path=^spath lambdaa_9_90 alphaa_9_90 vlambdaa_9_90 valphaa_9_90;




/********************************************************/
/* Creating a dataset which should be exported to stata */
/* It contains some results at the municipality level   */
/********************************************************/

load path=^spath sole="savepare_all.fmt" sola="savepara_all.fmt";

load path=^spath s="hce.fmt"; s=exp(-s');
sme1=s[.,30]; sme3=s[.,90]; sme6=s[.,180]; sme12=s[.,360]; sme24=s[.,720]; 

load path=^spath s="hca.fmt"; s=exp(-s');
sma1=s[.,30]; sma3=s[.,90]; sma6=s[.,180]; sma12=s[.,360]; sma24=s[.,720]; 

load path=^spath s="kape.fmt"; s=s'; 
ske1=s[.,30]; ske3=s[.,90]; ske6=s[.,180]; ske12=s[.,360]; ske24=s[.,720]; 

load path=^spath s="kapa.fmt"; s=s';
ska1=s[.,30]; ska3=s[.,90]; ska6=s[.,180]; ska12=s[.,360]; ska24=s[.,720]; 

load path=^spath lambdae_9_90="lambdae_9_90.fmt" alphae_9_90="alphae_9_90.fmt";
{yc,hc} = agreg(sole,e,nb,p);
hcme = hcmulti(lambdae_9_90,alphae_9_90,nb,p);

load path=^spath lambdaa_9_90="lambdaa_9_90.fmt" alphaa_9_90="alphaa_9_90.fmt";
{yc,hc} = agreg(sola,a,nb,p);
hcma = hcmulti(lambdaa_9_90,alphaa_9_90,nb,p);

smulte=exp(-hcme); smulta=exp(-hcma);

smulte1=smulte[30,.]'; smulte3=smulte[90,.]'; smulte6=smulte[180,.]'; smulte12=smulte[360,.]'; smulte24=smulte[720,.]'; 
smulta1=smulta[30,.]'; smulta3=smulta[90,.]'; smulta6=smulta[180,.]'; smulta12=smulta[360,.]'; smulta24=smulta[720,.]'; 



/* Computation of mean effect of explanatory variables */

xbe=meancom(x,vcom)*sole;
xba=meancom(x,vcom)*sola;

nbe=sumcom(e,vcom);
nba=sumcom(a,vcom);

/* Considering two months on each side around t */

inde4_8=(t .gt 120).*(t .le 240).*(e .eq 1);
nbe4_8=sumcom(inde4_8,vcom);

inda4_8=(t .gt 120).*(t .le 240).*(a .eq 1);
nba4_8=sumcom(inda4_8,vcom);

inde10_14=(t .gt 300).*(t .le 420).*(e .eq 1);
nbe10_14=sumcom(inde10_14,vcom);

inda10_14=(t .gt 300).*(t .le 420).*(a .eq 1);
nba10_14=sumcom(inda10_14,vcom);

inde22_26=(t .gt 660).*(t .le 780).*(e .eq 1);
nbe22_26=sumcom(inde22_26,vcom);

inda22_26=(t .gt 660).*(t .le 780).*(a .eq 1);
nba22_26=sumcom(inda22_26,vcom);

xbe4_8=meancom(selif(x,inde4_8),nbe4_8)*sole;
xba4_8=meancom(selif(x,inda4_8),nba4_8)*sola;

xbe10_14=meancom(selif(x,inde10_14),nbe10_14)*sole;
xba10_14=meancom(selif(x,inda10_14),nba10_14)*sola;

xbe22_26=meancom(selif(x,inde22_26),nbe22_26)*sole;
xba22_26=meancom(selif(x,inda22_26),nba22_26)*sola;




fich2= spath $+ "alpha";

vnames={ dc xbe xba nbe nba alphae alphaa
            sme6 sme12 sme24 sma6 sma12 sma24
            smulte6 smulte12 smulte24 smulta6 smulta12 smulta24 
            nbcho pop90 pop99 ske6 ske12 ske24 ska6 ska12 ska24 
            nbe4_8 xbe4_8 nbe10_14 xbe10_14 nbe22_26 xbe22_26
            nba4_8 xba4_8 nba10_14 xba10_14 nba22_26 xba22_26 };

create -v92 f2=^fich2 with ^vnames,0,8;

wtp=writer(f2,missrv(dc~xbe~xba~nbe~nba~alphae_9_90~alphaa_9_90
                       ~sme6~sme12~sme24~sma6~sma12~sma24
                       ~smulte6~smulte12~smulte24~smulta6~smulta12~smulta24
                       ~vcom~pop90~pop99~ske6~ske12~ske24~ska6~ska12~ska24
                       ~nbe4_8~xbe4_8~nbe10_14~xbe10_14~nbe22_26~xbe22_26
                       ~nba4_8~xba4_8~nba10_14~xba10_14~nba22_26~xba22_26,100000)); /* missrv used to avoid issues when transferring data into stata format */
close(f2);

/*************************************************************************
* The dataset "alpha" must then be transformed into a stata dataset
*************************************************************************/




/******************************************
* Second-stage variance analysis
*******************************************/

load path=^spath sole="savepare_all.fmt" lambdae="lambdae_9_90.fmt" alphae="alphae_9_90.fmt";

nb=9; p=90;

{yce,hce} = agreg(sole,e,nb,p);

lyhe=zeros(rows(yce),1);

for i(1,rows(yce),1); if yce[i,1]>0; if hce[i,1]>0; lyhe[i,1]=ln(yce[i,1])-ln(hce[i,1]); endif; endif; endfor;
for i(1,rows(alphae),1); if alphae[i,1]>0; alphae[i,1]=ln(alphae[i,1]); else; alphae[i,1]=0; endif; endfor;
for i(1,rows(lambdae),1); if lambdae[i,1]>0; lambdae[i,1]=ln(lambdae[i,1]); else; lambdae[i,1]=0; endif; endfor;

weight=zeros(nb*rcom,1);
cumobs=0;
for j(1,rcom,1);
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];
    tcom=t[debc:finc,.];  
    rxc=rows(tcom);      
    s0j=zeros(nb,1);
    dllcall nbrisk(tcom,rxc,nb,p,s0j);
    weight[(j-1)*nb+1:j*nb,1]=s0j;
    cumobs=cumobs+vcom[j,1];
endfor;

alpha=alphae.*.ones(nb,1);
lambda=ones(rcom,1).*.(0|lambdae);

alpha=selif(alpha,((yce.>0).*(hce.>0)));
lambda=selif(lambda,((yce.>0).*(hce.>0)));
lyhe=selif(lyhe,((yce.>0).*(hce.>0)));
weight=selif(weight,((yce.>0).*(hce.>0)));

weight=weight/sumc(weight);

alpha=alpha-alpha'*weight;
lambda=lambda-lambda'*weight;
lyhe=lyhe-lyhe'*weight;

r2e=1-((lyhe-alpha-lambda).*weight)'*(lyhe-alpha-lambda)/((lyhe.*weight)'*lyhe);

load sola    = C:\dossiers\SpatialM\GMS_ANPE\params\1st_stage\savepara_all.fmt;
load lambdaa = C:\dossiers\SpatialM\GMS_ANPE\params\2nd_stage\lambdaa_9_90.fmt;
load alphaa  = C:\dossiers\SpatialM\GMS_ANPE\params\2nd_stage\alphaa_9_90.fmt;

nb=9; p=90;

{yca,hca} = agreg(sola,a,nb,p);

lyha=zeros(rows(yca),1);

for i(1,rows(yca),1); if yca[i,1]>0; if hca[i,1]>0; lyha[i,1]=ln(yca[i,1])-ln(hca[i,1]); endif; endif; endfor;
for i(1,rows(alphaa),1); if alphaa[i,1]>0; alphaa[i,1]=ln(alphaa[i,1]); else; alphaa[i,1]=0; endif; endfor;
for i(1,rows(lambdaa),1); if lambdaa[i,1]>0; lambdaa[i,1]=ln(lambdaa[i,1]); else; lambdaa[i,1]=0; endif; endfor;

weight=zeros(nb*rcom,1);
cumobs=0;
for j(1,rcom,1);
    debc=cumobs+1;
    finc=cumobs+vcom[j,1];
    tcom=t[debc:finc,.];  
    rxc=rows(tcom);      
    s0j=zeros(nb,1);
    dllcall nbrisk(tcom,rxc,nb,p,s0j);
    weight[(j-1)*nb+1:j*nb,1]=s0j;
    cumobs=cumobs+vcom[j,1];
endfor;

alpha=alphaa.*.ones(nb,1);
lambda=ones(rcom,1).*.(0|lambdaa);

alpha=selif(alpha,((yca.>0).*(hca.>0)));
lambda=selif(lambda,((yca.>0).*(hca.>0)));
lyha=selif(lyha,((yca.>0).*(hca.>0)));
weight=selif(weight,((yca.>0).*(hca.>0)));

weight=weight/sumc(weight);

alpha=alpha-alpha'*weight;
lambda=lambda-lambda'*weight;
lyha=lyha-lyha'*weight;

r2a=1-((lyha-alpha-lambda).*weight)'*(lyha-alpha-lambda)/((lyha.*weight)'*lyha);

print "R for exit to job:";
print r2e;
print "R for exit to non-employment:";
print r2a;


