(*SUPPLEMENTAL MATHEMATICA CODE TO "EXPERIMENTATION AND PERSUASION IN POLITICAL ORGANIZATIONS", 02-21-2015*)

(*------------------------------------BEGIN CODE----------------------------------*)

(*----------Threshold Parameters------------------------*) 
(*-------------------------------------------------------*)

lLbar:=.23505
lbar:=.684660
lfig:=.653
lhat=l/.Solve[l*(1+l)*(1+(l/2))==1,l][[1]]

(*----------Posterior Beliefs After Failure-------------*)
(*-------------------------------------------------------*)
h[e_,p_]:=(1-e)*p/(1-p*e)
k[e_,p_]:=(1-h[e,p])^2

(*---------------The Agent's Problem--------------------*)
(*-------------------------------------------------------*)

(*objective function*)
U2[e_,t2_,pS_,pF_,l_]:=(t2*e-e^2/(2*l))+(l/2)*(pF*t2*(e+(1-e)*h[e,t2])+(1-pF)*(1-t2)*(1-h[e,t2]))+(pS-pF)*(l/2)*t2*e

(*optima*)
eStar[t2_,d_,l_]:=Root[(#1-l*t2*(1+(l/2)*(k[#1,t2]+d)))&,1]
eR[t2_,l_]:=eStar[t2,0,l]
eE[t2_,l_]:=eStar[t2,1,l]

(*---------------The Principal's Problem--------------------*)
(*-------------------------------------------------------*)

(*Equation 10*)
U1[e_,t1_,t2_,pS_,pF_,l_]:=t1*(e+l*(e*pS+(1-e)*pF*h[e,t2]))+(1-t1)*(1-pF)*l*(1-h[e,t2])

(*Pure Strategy Payoffs with agent best-responses - from Proposition 3*)
V1R[t1_,t2_,l_]:=U1[eR[t2,l],t1,t2,1,1,l]
V1E[t1_,t2_,l_]:=U1[eE[t2,l],t1,t2,1,0,l]

(*Threshold for experimentation for a given e1*)
thetaBar[t2_,e_]:=((1-t2)/(1-2 e *t2+(e^2)*t2))

(*Indifference Belief Thresholds for Principal*)
bEaR[t2_,l_]:=t1/.Solve[V1E[1-t1,1-t2,l]==V1R[t1,t2,l],t1][[1]]
bEaE[t2_,l_]:=t1/.Solve[V1E[1-t1,1-t2,l]==V1E[t1,t2,l],t1][[1]]
bRaE[t2_,l_]:=t1/.Solve[V1R[1-t1,1-t2,l]==V1E[t1,t2,l],t1][[1]]
aEaR[t2_,l_]:=If[V1E[1,t2,l]≥V1R[1,t2,l],1,t1/.Solve[V1E[t1,t2,l]==V1R[t1,t2,l],t1][[1]]]

(*------------------------------------END CODE----------------------------------*)

(*------------------------------------BEGIN FIGURES----------------------------------*)

(*-------------PLOTS FOR FIGURE 2------------------*)
Manipulate[Plot[{l*t2,l*(1-t2),eR[t2,l],eR[1-t2,l],eE[t2,l],eE[1-t2,l]},{t2,0,.5},PlotRange->{0,1}],{l,lfig,lfig}]

(*-------------PLOT FOR FIGURE 3------------------*)

Manipulate[
Show[

Plot[aEaR[t2,l],{t2,0,1},PlotRange->{0,1},PlotStyle->Directive[Blue,Thick]],

Plot[bEaR[t2,l],{t2,0,1},PlotRange->{0,1},PlotStyle->Directive[Red,Thick]],
Plot[thetaBar[t2,eE[t2,l]],{t2,0,1},PlotRange->{0,1},PlotStyle->Directive[Black,Dashed]],
Plot[{1-t2,.5,1,1000*(t2-.5)},{t2,0,1},PlotRange->{0,1},PlotStyle->Directive[Gray,Dashed]],
Plot[bEaE[t2,l],{t2,0,1},PlotRange->{0,1},PlotStyle->Directive[Orange,Thick]],

RegionPlot[t1<1-t2,{t2,0,1},{t1,0,1},PlotStyle->Gray]
],{l,lfig,lfig}]

(*------------------------------------END FIGURES----------------------------------*)

(*------------------------------------BEGIN PROOF SUPPLEMENTS----------------------------------*)

(*--------For Proof of Lemma 1 (Good Behavior)-----------------*)
(*The following plots verify that the agent's utility for the interior solution exceeds his utility at boundary solution for all t2 \in [0,1] when \lambda \approx .68466. The first plot illustrates the entire parameter space. The second plot focuses on the range t2 \in [.92,.96]*)

Manipulate[Plot[{U2[eE[t2,l],t2,1,0,l]-U2[1,t2,1,0,l]},{t2,0,1},PlotRange->{-.1,.8}],{l,.684660,0}]
Manipulate[Plot[{1000*(U2[eE[t2,l],t2,1,0,l]-U2[1,t2,1,0,l])},{t2,.92,.96},PlotRange->{0,.7}],{l,.684660,0}]

(*-------------For Proof of Lemma 4 -----------------*)

t2hat[l_]:=t2/.NSolve[thetaBar[1-t2,eE[1-t2,l]]==1/2,t2][[1]]

(*To verify the condition, observe that the blue line is higher than the purple line for all \theta_2 to the left of \hat{\theta}_2(\lambda) for any value of \lambda in [lUbar,lbar] in the slider *)
Manipulate[Show[
Plot[{
thetaBar[1-t2,eE[1-t2,l]]*(V1R[1,1-t2,l]-V1E[0,t2,l]),(1-thetaBar[1-t2,eE[1-t2,l]])*V1E[1,t2,l]},{t2,0,.5},PlotStyle->{Blue, Purple}],
Plot[Evaluate[10000*(t2-t2hat[l])],{t2,0,.5},PlotStyle->{Green}]
]
,{l,lLbar,lbar}]

(*-------------For Proof of Proposition 3, Part 2 -----------------*)
(*To verify the condition, observe that the function is <0 for for all \theta_2 \in [0,1] and any value of \lambda \in [0,lbar] in the slider *)

Manipulate[Plot[{V1E[0,1-t2,l]/(t2*l)-V1R[1,t2,l]/(t2*l)},{t2,0,1},PlotRange->{-1.5,0}],{l,.001,lhat}]

(*------------------------------------END PROOF SUPPLEMENTS----------------------------------*)