*====STONE AIDS====;

options nosource nonotes; 
		%let seed1=123;
		%let seed2=456;
		%let seed3=789;
		%let seed4=147;

/*IMPORTING THE DATA*/

PROC IMPORT OUT= WORK.tabcases DATAFILE= "C:\JAEOFF\casesf.xls" DBMS=EXCEL REPLACE;
     SHEET="Sheet1$"; 
     GETNAMES=YES;
     MIXED=NO;
     SCANTEXT=YES;
     USEDATE=YES;
     SCANTIME=YES;
RUN;

PROC IMPORT OUT= WORK.seeds DATAFILE= "C:\JAEOFF\seedsbase.xls" DBMS=EXCEL REPLACE;
     SHEET="Sheet1$"; 
     GETNAMES=YES;
     MIXED=NO;
     SCANTEXT=YES;
     USEDATE=YES;
     SCANTIME=YES;
RUN;



%MACRO CASES;
%DO casenumber=1 %TO 9;

proc sql noprint;
select a0KQ1, a0KQ2, a0KQ3, a0m1, a11, a12, a22, rho, b11, b12, b22,delta, ac1, ac2, ac3,
p1, p2, p3, q1, q2, q3, m into :a0KQ1, :a0KQ2, :a0KQ3, :a0m1, :a11, :a12, :a22, :rho, :b11,
:b12, :b22, :delta, :ac1, :ac2, :ac3, :cp1, :cp2, :cp3, :cq1, :cq2, :cq3, :cm
from work.tabcases where tabcases.case=&casenumber;
quit;

data final0; 
    retain seed1 &seed1;
    retain seed2 &seed2;
    retain seed3 &seed3;
	retain seed4 &seed4;
  	kq1_1=10;
  	kq2_1=3;
  	km1_1=15;
  	kq3_1=6;
do i=1 to 71;
    er1 = normal(seed1);
	er2= normal(seed2);
	er3 = normal(seed3);
	er4 = normal(seed4);
    KQ1 = 3 + .89*kq1_1 + er1;
	KQ2 = 5 + .79*kq2_1 + er2;
	KQ3 = 9 + .9*kq3_1 + er3;
    m1 = 125 + .865*km1_1 + er4;
    kq1_1=KQ1;
    kq2_1=KQ2;
    km1_1=m1;
    kq3_1=KQ3;
	c = (&a11*KQ1**(2*&rho-1) + &a12*(KQ2**&rho)*(KQ1**(&rho-1)))
  	/(&a22*KQ2**(2*&rho-1) + &a12*(KQ1**&rho)*(KQ2**(&rho-1)));
					p2 = m1/(c*KQ1 + KQ2);
					p1=c*m1/(c*KQ1 + KQ2);
	Q12 = (&a11*KQ1**(2*&rho) + 2*&a12*(KQ1**&rho)*(KQ2**&rho)
    + &a22*KQ2**(2*&rho))**(1/(2*&rho));
					
	KC = (&b11*Q12**(2*&delta -1) + &b12*(KQ3**&delta)*(Q12**(&delta-1)))
   /(&b22*KQ3**(2*&delta-1) + &b12*(Q12**&delta)*(KQ3**(&delta-1)));
					P=(p1*KQ1+p2*KQ2)/Q12;
					p3 = P/KC;
					q1 = KQ1 + &ac1;
					q2 = KQ2 + &ac2;
					q3 = KQ3 + &ac3;
					m = p1*q1 + p2*q2 + p3*q3;
					lp1 = log(p1);                                                                                                  
        			lp2 = log(p2);
					lp3 = log(p3); 
                    lq1 = log(q1);                                                                                                  
                    lq2 = log(q2);
					lq3 = log(q3); 
                    lm  = log(m);                                                                                                    
                    w_q1 = p1*q1/m;                                                                                                 
                    w_q2 = p2*q2/m;
					w_q3 = p3*q3/m;
					Dp1 = lp1 - lag(lp1);
					Dp2 = lp2 - lag(lp2);
					Dp3 = lp3 - lag(lp3);
					Dq1 = lq1 - lag(lq1);
					Dq2 = lq2 - lag(lq2);
					Dq3 = lq3 - lag(lq3);
					w1t  = 0.5*(w_q1 + lag(w_q1));
					w2t  = 0.5*(w_q2 + lag(w_q2));
					w3t  = 0.5*(w_q3 + lag(w_q3));
					DQt  = w1t*Dq1 + w2t*Dq2 + w3t*Dq3;
					lhs1 = w1t*Dq1;
					lhs2 = w2t*Dq2;
					lhs3 = w3t*Dq3;
					if i > 10 then output;                                                                                                        
            drop i ;                                                                                                        
         end ;                                                                                                                      
      run ; 



proc sort data=final0 out=final1;
by m;
by descending m;
quit;

data final2;
set final1;
jj=_n_;
run;

proc sql noprint;
select w_q1, w_q2, w_q3, lm, lp1, lp2, lp3, p1, p2, p3, q1, q2, q3, m 
into :m0w1, :m0w2, :m0w3, :m0lm, :m0lp1, :m0lp2, :m0lp3, :m0p1, :m0p2,
:m0p3, :m0q1, :m0q2, :m0q3, :m0m from final2
where jj=31;
quit;


*===========; *===NORMALIZE THE DATA===;


*==== WE CALL &cpi (&cqi)the values at the points we calculated the ===;
*==== elasticities, &m0p or m0q the values at the median ===; 
data final;
	set final2;
					p1=&cp1*p1/&m0p1;
					p2=&cp2*p2/&m0p2;
					p3=&cp3*p3/&m0p3;
					q1=&cq1*q1/&m0q1;
					q2=&cq2*q2/&m0q2;
					q3=&cq3*q3/&m0q3;
					m = p1*q1 + p2*q2 + p3*q3;
					lp1 = log(p1);                                                                                                  
        			lp2 = log(p2);
					lp3 = log(p3); 
                    lq1 = log(q1);                                                                                                  
                    lq2 = log(q2);
					lq3 = log(q3); 
                    lm  = log(m);                                                                                                    
                    w_q1 = p1*q1/m;                                                                                                 
                    w_q2 = p2*q2/m;
					w_q3 = p3*q3/m;
					lp = w_q1*lp1 + w_q2*lp2 + w_q3*lp3;         *=== STONE PRICE INDEX ===;
					Dp1 = lp1 - lag(lp1);
					Dp2 = lp2 - lag(lp2);
					Dp3 = lp3 - lag(lp3);
					Dq1 = lq1 - lag(lq1);
					Dq2 = lq2 - lag(lq2);
					Dq3 = lq3 - lag(lq3);
					w1t  = 0.5*(w_q1 + lag(w_q1));
					w2t  = 0.5*(w_q2 + lag(w_q2));
					w3t  = 0.5*(w_q3 + lag(w_q3));
					DQt  = w1t*Dq1 + w2t*Dq2 + w3t*Dq3;
					lhs1 = w1t*Dq1;
					lhs2 = w2t*Dq2;
					lhs3 = w3t*Dq3;
      run ;
 
proc sql noprint;
select w_q1, w_q2, w_q3, lp1, lp2, lp3, lp into :m0w1, :m0w2, :m0w3, :mlp1, :mlp2, :mlp3, :mlp
from final where jj=31;
quit;                                                                                                                                      

%MACRO boot(dsn, samples);
    %DO i = 1 %to &samples;

		proc sql  noprint;
		select  sd1 format=10., 
       			sd2 format=10.,
       			sd3 format=10.,
				sd4 format=10. into :seed1,:seed2, :seed3, :seed4
		from seeds
		where row=&i;
		quit;

        DATA bootfinal;
			do i=1 to 61;
			choice1=normal(&seed1);
			choice2=normal(&seed2);
			choice3=normal(&seed3);
			choice4=normal(&seed4);
            SET &dsn ;
			q1 = q1 + choice1;
			q2 = q2 + choice2;
			q3 = q3 + choice3;
			lq1 = log(q1);
			lq2 = log(q2);
			lq3 = log(q3);
			m= p1*q1 + p2*q2 + p3*q3;  *=== MODIFY TO SET THE ERROR ON INCOME ===;
*=== Fixing the budget constraint====;
			lm=log(m);
			w_q1 = p1*q1/m;
			w_q2 = p2*q2/m;
			w_q3 = p3*q3/m;
			lpp = w_q1*(lp1-&m0lp1) + w_q2*(lp2-&m0lp2) + w_q3*(lp3-&m0lp3);     *=== PAASCHE PRICE INDEX ===;
			output;
			drop i;
         end;
       RUN;


        /* Place your estimation rutine here */
proc model data=bootfinal NOPRINT NOITPRINT;                                                                                                                  
                                                                                                                                        
restrict          g11 + g12 + g13 = 0 ,                                                                                                       
                  g12 + g22 + g23 = 0 ,
				  g13 + g23 + g33 = 0, 
                  a1  +  a2 + a3 = 1 ;                                                                                                       
                                                                                                                                        
parms a1=.45 a2=.35 a3=.2 g11=.25 g12=-.25 g13=.1 g23=.3 g33=.4 g22=.25 b1=.3 b2=.4 b3=.4;                                                                                                
                a0 = 0;                                                                                                                 
                                                        

    w_q1 = a1 + g11*lp1 + g12*lp2 + g13*lp3+ b1*(lm-lpp) ;
    w_q2 = a2 + g12*lp1 + g22*lp2 + g23*lp3+ b2*(lm-lpp);                                                                                     
                                                                                                                                        
fit w_q1 w_q2 / fiml outest=fin;                                                                                                   
      parms a1 a2 b1 b2 g11 g12 g13 g22 g23;                                                                                                              
    

	 estimate 'med1' &m0w1, /outest=med1;
	 estimate 'med2' &m0w2, /outest=med2;
	 estimate 'med3' &m0w3, /outest=med3;
     estimate 'a11'  -1 +g11/&m0w1 -b1, /outest=a11;
     estimate 'a12'  g12/&m0w1 - b1*&m0w2/&m0w1, /outest=a12;
     estimate 'a13'  g13/&m0w1 - b1*&m0w3/&m0w1 , /outest=a13;
     estimate 'a21' g12/&m0w2 - b2*&m0w1/&m0w2, /outest=a21;
     estimate 'a22' -1 + g22/&m0w2 - b2, /outest=a22;
     estimate 'a23' g23/&m0w2 - b2*&m0w3/&m0w2, /outest=a23;
     estimate 'a31' g13/&m0w3 -(-b1-b2)*&m0w1/&m0w3, /outest=a31;
     estimate 'a32' g23/&m0w3 -(-b1-b2)*&m0w2/&m0w3, /outest=a32;
     estimate 'a33' -1 +(-g13-g23)/&m0w3 -(-b1-b2), /outest=a33;
     estimate 'k1' b1/&m0w1, /outest=k1;
     estimate 'k2' b2/&m0w2, /outest=k2;
     estimate 'k3' (-b1-b2)/&m0w3, /outest=k3;
     estimate 'cst1' &m0w1*(&m0lp1-&m0lp1), /outest=cst1;
     estimate 'cst2' &m0w2*(&m0lp2-&m0lp2), /outest=cst2;
     estimate 'cst3' &m0w3*(&m0lp3-&m0lp3), /outest=cst3;



DATA morishfin;
SET fin;
SET med1;
SET med2; 
SET med3; 
SET a11;
SET a12;
SET a13;
SET a21;
SET a22; 
SET a23;
SET a31; 
SET a32;
SET a33;
SET k1;  
SET k2; 
SET k3;
SET cst1;
SET cst2;
SET cst3;  
run;

        DATA morishfin2;
          SET morishfin;
		  IF _N_ = 1;

	 
 /* Add results to bootstrap data. */
        %IF &i=1 %THEN %DO;
            DATA bootres;
                SET morishfin2;
		%END;
        %ELSE %DO;
          PROC APPEND BASE =bootres DATA = morishfin2;
        %END;
        RUN;        
        %END;
   %MEND;
%boot(final, 1000);



proc export data=work.bootres 
outfile='C:\ARJAE\PAASCHEAIDS\PAIDS&casenumber..xls';
run;
%END;
%MEND;
%CASES;
quit;
