
#include tobit95;
#include optmum.prc;


clear xxx1,yyy1;

PROC fc(b);
    RETP(f_hp_c1(yyy1,xxx1,b));
ENDP;

PROC dfc(b);
    RETP(df_hp_d1(yyy1,xxx1,b));
ENDP;

PROC(1)=calv(y,x,b,f1);
local s,aa1,aa2,aa,xb,n,k,r,v,h,db,h1,shat,ee,nn;

format /re 16,8;
aa=meanc(x);

xb=x*b;
k=cols(x);
n=rows(x);
r=x*0;
v=zeros(k,k); h=v;

ee=selif(y-xb,y);
nn=rows(ee);
aa1=stdc(ee);
ee=sortc(ee,1);
aa2=(ee[round(3*nn/4),1]-ee[round(nn/4),1])/1.34;

if aa1 > aa2; aa=aa2; else; aa=aa1; endif;

f1=f1*0.9*1.83*aa*(nn.^(-.2));

format /rd 16,3;
" ";
db=f1./stdc(x);
dllcall  bopo1_v(y,xb,x,n,k,db,r,v,h);
h1=(h+h')/2;
s=sqrt(diag((inv(h1)*v*inv(h1)/n)));


RETP(s);
ENDP;


PROC jimbo(y,x,bst);

local t1,f1,it,tra,maxsec,ftol,maxit,tt,t_a,b_a,f_a,b;

xxx1=x;
yyy1=y;
begy:

maxsec=3600*12;
ftol=0.00001;
tt=hsec;
maxit=100;
{b,f1,it,tra}=dfpmin(bst,ftol,maxsec,maxit,&fc,&dfc,&linmin);

RETP(b);
ENDP;



PROC(2)=est_poho(y1,x1);
local par,bst,b,i,n,nb,nboot,nx,bb,ib,t1,i1,yy1,yy2,xx1,xx2;


par=200|0.0001|0.5;
bst=y1/(ones(rows(y1),1)~x1);
bst=bst[2:rows(bst)];
b=jimbo(y1,x1,bst);
"STARTING VALUE"; bst';
"ESTIMATE"; b';
bb=calv(y1,x1,b,1);

RETP(b,bb);
ENDP;

PROC(2)=est_clad(y1,x1);
local par,bst,b,i,n,nb,nboot,nx,bb,ib,t1,i1,yy1,yy2,xx1,xx2,s,ee;

par=200|0.0001|0.5;
"OLS FIRST DIFFERENCE";
call ols(0,y1,x1);
bst=y1/x1;
{b,i}=clad(y1,x1,bst,par);
"STARTING VALUE"; bst';
"ESTIMATE"; b';


rndseed 1014;

n=rows(x1);
nb=n;
nboot=1000;
/* number of bootstrap replications */
nx=cols(x1);
bb=zeros(nx,nboot);

ib=1;
t1=hsec;
do while ib<=nboot;
    i1=int(n*rndu(nb,1)+1);
       yy1=y1[i1,.]; xx1=x1[i1,.];
       {bb[.,ib],i}=clad(yy1,xx1,bst,par);
       ib=ib+1;

/* Print out bootstrap results:

    "BOOT NUMBER:";; ib-1;
    if (ib.gt 20);
    "BETA       std err";
    b~stdc(bb[.,1:ib-1]');
"Time so far:     ";;(hsec-t1)/100;; "sec";;
"till finish:";;(nboot-ib+1)*(hsec-t1)/(100*(ib-1));; "sec";
endif;
*/
endo;
s=0*bst;

ib=1;
do while ib <= rows(b);
ee=bb[ib,.]';
ee=sortc(ee,1);
s[ib]=(ee[round(3*nboot/4)]-ee[round(nboot/4)])/1.34;
ib=ib+1;
endo;


RETP(b,s);
ENDP;


PROC(2)=est_fix(y1,x1,y2,x2);
local par,bst,b,i,n,nb,nboot,nx,bb,ib,t1,i1,yy1,yy2,xx1,xx2,s,ee;

par=0;
bst=(y1-y2)/(x1-x2);

{b,i}=fixef(y1,y2,x1,x2,bst,par);

"STARTING VALUE"; bst';
"ESTIMATE"; b';

rndseed 1014;

n=rows(x1);
nb=n;
nboot=1000;
/* number of bootstrap replications */
nx=cols(x1);
bb=zeros(nx,nboot);

ib=1;
t1=hsec;
do while ib<=nboot;
    i1=int(n*rndu(nb,1)+1);
       yy1=y1[i1,.]; xx1=x1[i1,.];
       yy2=y2[i1,.]; xx2=x2[i1,.];
       {bb[.,ib],i}=fixef(yy1,yy2,xx1,xx2,b,par);
       ib=ib+1;

/* Print out bootstrap results:

    "BOOT NUMBER:";; ib-1;
    if (ib.gt 20);
    "BETA       std err";
    b~stdc(bb[.,1:ib-1]');
"Time so far:     ";;(hsec-t1)/100;; "sec";;
"till finish:";;(nboot-ib+1)*(hsec-t1)/(100*(ib-1));; "sec";
endif;
*/
endo;
s=0*bst;

ib=1;
do while ib <= rows(b);
ee=bb[ib,.]';
ee=sortc(ee,1);
s[ib]=(ee[round(3*nboot/4)]-ee[round(nboot/4)])/1.34;
ib=ib+1;
endo;


RETP(b,s);
ENDP;



PROC(2)=est_scls(y1,x1);
local par,bst,b,i,n,nb,nboot,nx,bb,ib,t1,i1,c,d,xx1,ee,uhat,xb;

par=200|0.0001;
"OLS DIFFERENCE";
call ols(0,y1,x1);
bst=y1/x1;
{b,i}=stls(y1,x1,bst,par);
"STARTING VALUE"; bst';
"ESTIMATE"; b';
if (i.eq 0); "we have a problem"; stop; endif;
xb=x1*b;
uhat=2*xb;
ee=(y1.gt 0).*(y1.lt uhat); xx1=ee*~x1;
c=xx1'xx1;
c=invpd(c);
uhat=y1-xb;
ee=(xb.gt 0).*sqrt(minc( ((uhat.^2)~(xb.^2))'));
xx1=ee*~x1;
d=xx1'xx1;
bb=c*d*c;
RETP(b,sqrt(diag(bb)));
ENDP;
