/* revcons2.gau for Revenue-Constrained STIP Note 21-22/5/2003: Simulate welfare and profits as functions of R&D and output subsidies in R&D+Bertrand game and print Fig. 2*/ /*************************************************************************/ /* USER-SPECIFIED VARIABLES */ eta = 0.4; /* Relative Effectiveness of R&D */ alph=0.5; /* Demand intercept; equals free-trade market share when only price ratio matters */ stepsize=.005; /* stepsize in s1 (R&D Subsidy) loops: .005 for publication; .05 is coarsest valid for research */ stepsizeB=stepsize; /* stepsize in s2 (Output Subsidy) loops */ s1min=-0.5; s1max=1.0; n=1+(s1max-s1min)/stepsize; /* n: # of values of s1 considered (=31 for stepsize=.05)*/ s2min=-1.0; s2max=.5; m=1+(s2max-s2min)/stepsize; /* m: # of values of s2 considered */ /*************************************************************************/ /* INITIALISE VECTORS */ s1=zeros(1,n); /* R&D Subsidy */ s2=zeros(m,1); /* Output Subsidy */ Ppi=zeros(m,n); /* Home Profits */ W=zeros(m,n); /* Home Welfare */ s2PCW=zeros(1,n); /* Profit-Constrained Welfare Locus */ ccode=zeros(m,n); /*************************************************************************/ /* Preliminary calculations (independent of s1 and s2) */ Delt=3-(4/3)*eta; /* Det. of LHS Matrix of Generalised Reac. Funcs */ HH=1-(8/9)*eta; WFT=alph^2 *(1-(2/9)*eta); /* Welfare in free trade; q=.5 (=mkt share, alpha), x=(2/3)*eta*q */ /*************************************************************************/ sig0=(2/3)*alph; /* Specify parameters for PCW locus */ sig1=2*(1+(2/3)*eta/Delt); sig2=(5/3)/Delt; phi0=alph; phi1=(5/3)*eta/Delt; phi2=2/Delt; ome0=(HH/Delt-1/3)*alph; ome1=1+(1/3+HH/Delt)*eta/Delt; ome2=(2/3+HH/Delt)/Delt; psi0=HH*alph/Delt; psi1=(2/3+HH/Delt)*eta/Delt; psi2=(1+HH/Delt)/Delt; AAA=ome2*phi2-psi2*sig2; /*************************************************************************/ i=1; /* BEGIN i - s1 (R&D Subsidy) DO LOOP */ ss1=s1min-stepsize; /* ss1: Current value of s1 */ DO until i>n; ss1=ss1+stepsize; s1[1,i]=ss1; /*************************************************************************/ /* Calculate profit-constrained welfare (PCW) locus: W_1.S_2=W_2.S_1 */ sig3=sig0+sig1*ss1; phi3=phi0+phi1*ss1; ome3=ome0+ome1*ss1; psi3=psi0+psi1*ss1; BBB=(ome3*phi2+ome2*phi3)-(psi3*sig2+psi2*sig3); CCC=ome3*phi3-psi3*sig3; DDD=BBB^2-4*AAA*CCC; IF DDD<=0; s2PCW[1,i]=-10; GOTO ENDPCW; ENDIF; s2PCW[1,i]=(-BBB-DDD^0.5)/(2*AAA); /* Note: pick the negative root */ ENDPCW: /*************************************************************************/ /* BEGIN j - s2 (Output Subsidy) DO LOOP */ j=1; ss2=s2min-stepsizeB; /* ss2: Current value of s2 */ DO until j>m; ss2=ss2+stepsizeB; s2[j,1]=ss2; q= alph +(eta*ss1+ss2) / Delt; /*************************************************************************/ qstar= 2*alph - q; x = eta*((2/3)*q+ss1); w[j,i]= ( (q - ss2)*q - 0.5*eta*((2/3)*q+ss1)^2)/WFT; /* Welfare normalised by FT value */ ppi[j,i]=w[j,i]+(ss1*x+ss2*q)/WFT; /*************** Check for negative output, R&D or profit levels and set CODE accordingly ***/ IF q <0; ccode[j,i]=1; ENDIF; IF x <0; ccode[j,i]=1; ENDIF; IF ppi[j,i] <0; ccode[j,i]=1; ENDIF; IF ccode[j,i]>=1; GOTO W_EQ_0; ENDIF; GOTO ENDLOOP; W_EQ_0: W[j,i]=0; ppi[j,i]=0; /*************************************************************************/ ENDLOOP: j=j+1; /* END OF j LOOP */ endo; i=i+1; /* END OF i LOOP */ endo; /*************************************************************************/ library pgraph; /* COMPUTE AND PRINT FIGURES */ BEGWIND; MAKEWIND(7.69,6.27,.6,0,0); /*Create a transparent window that fills the page */ graphset; /******************** PRINT FIG. 2 **************************/ fonts("complex simgrma"); /* load fonts: \201, \202 */ xlabel("s]1["); ylabel("s]2["); _paxes=1; _ptitlht=0; xtics(-0.5,1.0,0.5,1); ytics(-1,0.5,0.5,1); _pcross=1; /* axes intersect at zero */ title("Fig. 2: Revenue-Constrained Optimal Subsidy Locus in R&D-Bertrand Game"); /* Home Profits (Contour) */ _pmsgctl= { 0.15 -0.30 .15 0 1 2 0 }; /* format control for label A */ _pmsgstr = "A" ; /* text of label A */ /* _pmsgctl= { 0.17 -0.28 .15 0 1 2 0 }; /* format control for label A */ _pmsgstr = "A" ; /* text of label A */ */ ztics (0, .4, 0.1,0) ; contour(s1,s2,Ppi); ztics (.6, 1.2, 0.2,0) ; contour(s1,s2,Ppi); ztics (1.5, 3.5, 0.5,0) ; contour(s1,s2,Ppi); ztics (.95,1.1,.05,0); contour(s1,s2,W); ztics (0,0.9,.1,0); contour(s1,s2,W); xy(s1',s2PCW'); xy ( s1', - alph * Delt - eta*s1' - 1.5 * Delt * s1'); /* Exact s2(s1) boundary corresponding to x=0 (R&D)*/ /* N.B. Exact s2(s1) boundary corresponding to q=0 is only binding for s1>0, s2<<-1 */ GOTO PRINTEND; _plev={-.2,0,.2,.4,.6,.7,.8,.9,1.0,1.1,1.2,1.25}; contour(s1,s2,W); GOTO PRINTEND; /*************************************************************************/ PRINTEND: ENDWIND; finish: end