Quasi-homethetic preferences in a two-person exchange economy

Craig S. Marcott

University of St. Thomas

Abstract

This paper introduces a utility function that is a convex combination of constant elasticity of substitution (CES) and quasi-linear preferences. The quasi-linear preferences are chosen from among four types (i.e., two versions each of vertically- and horizontally-parallel utility functions).  Dynamic manipulation of the 15 parameters of this hybrid utility function reveals some unusual price-offer and demand curves. The preferences and initial endowments of the two goods are rotated to construct an Edgeworth exchange box. Sliders, locators and ButtonBars allow the user to interact with the model; specifically, the set of Pareto optimal allocations, the competitive equilibrium and the price-offer curves can be toggled on and off. There is an option of mapping points into a bargaining space in which the axes are the utilities of the two consumers. This construct allows the user to visually compare the competitive equilibrium with standard bargaining solutions (e.g., Nash bargaining, Kalai-Smorodinski).

CES function

The CES function:u(x,y)=(((α (x^ρ)+(1-α)(y^ρ)))^(1/ρ)) ; where 0<α<1, -∞<ρ≤1.

u[x_,y_]:=(((α (x^ρ)+(1-α)(y^ρ)))^(1/ρ))

This function becomes the familar Cobb-Douglas case as ρ approches 1.

Limit[(((α (x^ρ)+(1-α)(y^ρ)))^(1/ρ)),ρ->0]//Timing

CES function: Indifference map

The indiiference curves range from linear (i.e., perfect substitutes: ρ =1) to L-shaped (i.e., perfect complements: ρ →∞). The CES function is homothetic.

Manipulate[ContourPlot[(((α (x^ρ)+(1-α)(y^ρ)))^(1/ρ)),{x,.1,10},{y,.1,10},ColorFunction->"Pastel"],{{α,.4,"α"},.01,.99,Appearance->"Labeled"},
{{ρ,.01,"ρ"},-10,.99,Appearance->"Labeled"}]

CES function: price-offer, income-offer, demand and Engel curves

Since the function is homothetic the income-offer and Engel curves are rays eminating from the origin.

u[x_,y_]:=(((α (x^ρ)+(1-α)(y^ρ)))^(1/ρ))
x1Star[α_,ρ_,p1_,p2_,m_]:=(((((α/p1)))^((-1)/(ρ-1)))m)/(p1((((α/p1)))^((-1)/(ρ-1)))+p2(((((1-α)/p2)))^((-1)/(ρ-1))))
x2Star[α_,ρ_,p1_,p2_,m_]:=((((((1-α)/p2)))^((-1)/(ρ-1)))m)/(p1((((α/p1)))^((-1)/(ρ-1)))+p2(((((1-α)/p2)))^((-1)/(ρ-1))))
coordinateX1[α_,p2_,m_,scale_]:=pr/.Flatten@NSolve[(((((α/pr)))^((-1)/(.1-1)))m)/(pr((((α/pr)))^((-1)/(.1-1)))+p2(((((1-α)/p2)))^((-1)/(.1-1))))==.8 scale,pr];
y1=1;
Manipulate[
Show[GraphicsGrid[{{Show[Plot[(-p1/p2) x+m/p2,{x,0,scale},PlotRange->{{0,scale},{0,scale}},AxesLabel->{"(Subscript[x, 1])","(Subscript[x, 2])"}],
Plot[((α (((x1Star[α,ρ,p1,p2,m]))^ρ)+(1-α)(((x2Star[α,ρ,p1,p2,m]))^ρ)-α x^ρ)/(1-α))^(1/ρ),{x,1,scale},PlotRange->{{0,scale},{0,scale}},
AxesLabel->{"(Subscript[x, 1])","(Subscript[x, 2])"}],If[y1==0,ParametricPlot[{x1Star[α,ρ,price1,p2,m],x2Star[α,ρ,price1,p2,m]},{price1,.001,200},
PlotRange->{{0,scale},{0,scale}},PlotStyle->{Green,Thick},PerformanceGoal:>"Accuracy"],ParametricPlot[{x1Star[α,ρ,p1,p2,income],x2Star[α,ρ,p1,p2,income]},
{income,.001,200},PlotRange->{{0,scale},{0,scale}},PlotStyle->{Purple,Thick}]],
Graphics[{{Dashing[.02],Line[{{0,x2Star[α,ρ,p1,p2,m]},{x1Star[α,ρ,p1,p2,m],x2Star[α,ρ,p1,p2,m]}}],
Line[{{x1Star[α,ρ,p1,p2,m],0},{x1Star[α,ρ,p1,p2,m],x2Star[α,ρ,p1,p2,m]}}]},{PointSize[.02],Red,
Point[{x1Star[α,ρ,p1,p2,m],x2Star[α,ρ,p1,p2,m]}]},{If[y1==1,Text[Style["Income-Offer Curve",Bold,Italic,12],
{.6 scale,x2Star[α,ρ,p1,p2,m]+2}],Text[Style["Price-Offer Curve",Bold,Italic,12],{.6 scale,x2Star[α,ρ,p1,p2,m]+2}]]}}]]},
{Show[Plot[-x,{x,0,scale},PlotRange->{{0,scale},{0,p1scale}},AxesLabel->{"(Subscript[x, 1])","(Subscript[p, 1])"}],
ParametricPlot[{x1Star[α,ρ,price1,p2,m],price1},{price1,0.1,20},PlotRange->{{0,scale},{0,p1scale}},AxesLabel->{"(Subscript[x, 1])","(Subscript[p, 1])"},
PlotStyle->{Blue,Thick}],
Graphics[{{Dashing[.02],Line[{{0,p1},{x1Star[α,ρ,p1,p2,m],p1}}],Line[{{x1Star[α,ρ,p1,p2,m],0},{x1Star[α,ρ,p1,p2,m],p1scale}}]},
{PointSize[.02],Red,Point[{x1Star[α,ρ,p1,p2,m],p1}]},
{Text[Style["Demand",Bold,Italic,12],{.6 scale, 1.2(p1scale/(p1scale-1))coordinateX1[α,p2,m,scale]},{-1,0}]}}]]},
{Show[Plot[-x,{x,0,scale},PlotRange->{{0,scale},{0,mscale}},AxesLabel->{"(Subscript[x, 1])","m"}],
ParametricPlot[{x1Star[α,ρ,p1,p2,income],income},{income,0.1,50},PlotRange->{{0,scale},{0,mscale}},AxesLabel->{"(Subscript[x, 1])","m"},
PlotStyle->{Orange,Thick}],
Graphics[{{Dashing[.02],Line[{{0,m},{x1Star[α,ρ,p1,p2,m],m}}],Line[{{x1Star[α,ρ,p1,p2,m],0},{x1Star[α,ρ,p1,p2,m],mscale}}]},{
PointSize[.02],Red,Point[{x1Star[α,ρ,p1,p2,m],m}]},
{Text[Style["Engel Curve",Bold,Italic,12],{x1Star[α,ρ,p1,p2,m],m},{-1,0}]}}]]}}]],
Dynamic[ButtonBar[{Style["Income-Offer",Background->If[y1!=1,LightYellow,Yellow]]:> (y1=1;),
Style["Price-Offer",Background->If[y1≠0,LightYellow,Yellow]]:>(y1=0;)}]],{{α,.4,"α"},.01,.99,Appearance->"Labeled"},
{{ρ,.05,"ρ"},-10,.99,Appearance->"Labeled"},{{m,10,"income"},1,25,Appearance->"Labeled"},{{p2,1,"(Subscript[p, 2])"},.2,2.5,Appearance->"Labeled"},
{{p1,1,"(Subscript[p, 1])"},.2,2.5,Appearance->"Labeled"},{{scale,20,"\!\(\*SubscriptBox[\(x\), \(\(1\)\(\\ \)\)]\)scale"},10,100,Appearance->"Labeled"},
{{mscale,15,"m scale"},5,40,Appearance->"Labeled"},{{p1scale,4,"\!\(\*SubscriptBox[\(p\), \(\(1\)\(\\ \)\)]\)scale"},2,10,Appearance->"Labeled"},
ControlPlacement->Left
]

Quasi-linear preferences

I consider quasi-linear or parallel preferences of four forms:

Quasi-linear preferences: horizontally-parallel

u(x,y)=a x+b (1-(e^(-(y/c))))  ;where a,b,c>0  
u(x,y) = a x +b (y^c) ; where a,b>0, 0<c<1

Quasi-linear preferences: horizontally-parallel

u(x,y)=a x+b (1-(e^(-(y/c))))

x1StarParallel[a_,b_,c_,p1_,p2_,m_]:=(1/p1)(m-c p2 Log[((b p1)/(a c p2))])
x2StarParallel[a_,b_,c_,p1_,p2_,m_]:=-(1/p2)(m-c p2 Log[((b p1)/(a c p2))])+(m/p2)

y1=1;
Manipulate[
Show[GraphicsGrid[{{Show[Plot[(-p1/p2) x+m/p2,{x,0,scale},PlotRange->{{0,scale},{0,scale}},AxesLabel->{"(Subscript[x, 1])","(Subscript[x, 2])"}],
ContourPlot[a x1StarParallel[a,b,c,p1,p2,m]+b(1-Exp[-((x2StarParallel[a,b,c,p1,p2,m])/c)])==a x +b(1-Exp[((-y)/c)]),
{x,.1,20},{y,.1,20},PlotRange->{{0,scale},{0,scale}}],
If[y1==0,ParametricPlot[{x1StarParallel[a,b,c,price1,p2,m],x2StarParallel[a,b,c,price1,p2,m]},{price1,.001,200},
PlotRange->{{0,scale},{0,scale}},PlotStyle->{Green,Thick},PerformanceGoal:>"Accuracy"],
ParametricPlot[{x1StarParallel[a,b,c,p1,p2,income],x2StarParallel[a,b,c,p1,p2,income]},
{income,.001,200},PlotRange->{{0,scale},{0,scale}},PlotStyle->{Purple,Thick}]],
Graphics[{{Dashing[.02],Line[{{0,x2StarParallel[a,b,c,p1,p2,m]},{x1StarParallel[a,b,c,p1,p2,m],x2StarParallel[a,b,c,p1,p2,m]}}],
Line[{{x1StarParallel[a,b,c,p1,p2,m],0},{x1StarParallel[a,b,c,p1,p2,m],x2StarParallel[a,b,c,p1,p2,m]}}]},
{PointSize[.02],Red,Point[{x1StarParallel[a,b,c,p1,p2,m],x2StarParallel[a,b,c,p1,p2,m]}]},
{If[y1==1,Text[Style["Income-Offer Curve",Bold,Italic,12],
{.6 scale,x2StarParallel[a,b,c,p1,p2,m]+2}],Text[Style["Price-Offer Curve",Bold,Italic,12],
{.6 scale,x2StarParallel[a,b,c,p1,p2,m]+2}]]}}]]},
{Show[Plot[-x,{x,0,scale},PlotRange->{{0,scale},{0,p1scale}},AxesLabel->{"(Subscript[x, 1])","(Subscript[p, 1])"}],
ParametricPlot[{x1StarParallel[a,b,c,price1,p2,m],price1},{price1,0.1,20},PlotRange->{{0,scale},{0,p1scale}},
AxesLabel->{"(Subscript[x, 1])","(Subscript[p, 1])"},PlotStyle->{Blue,Thick}],
Graphics[{{Dashing[.02],Line[{{0,p1},{x1StarParallel[a,b,c,p1,p2,m],p1}}],Line[{{x1StarParallel[a,b,c,p1,p2,m],0},
{x1StarParallel[a,b,c,p1,p2,m],p1scale}}]},
{PointSize[.02],Red,Point[{x1StarParallel[a,b,c,p1,p2,m],p1}]},
{Text[Style["Demand",Bold,Italic,12],{x1StarParallel[a,b,c,p1,p2,m],p1},{-1,-1}]}}]]},
{Show[Plot[-x,{x,0,scale},PlotRange->{{0,scale},{0,mscale}},AxesLabel->{"(Subscript[x, 1])","m"}],
ParametricPlot[{x1StarParallel[a,b,c,p1,p2,income],income},{income,0.1,50},
PlotRange->{{0,scale},{0,mscale}},AxesLabel->{"(Subscript[x, 1])","m"},
PlotStyle->{Orange,Thick}],
Graphics[{{Dashing[.02],Line[{{0,m},{x1StarParallel[a,b,c,p1,p2,m],m}}],Line[{{x1StarParallel[a,b,c,p1,p2,m],0},
{x1StarParallel[a,b,c,p1,p2,m],mscale}}]},
{PointSize[.02],Red,Point[{x1StarParallel[a,b,c,p1,p2,m],m}]},
{Text[Style["Engel Curve",Bold,Italic,12],{x1StarParallel[a,b,c,p1,p2,m],m},{-1,0}]}}]]}}]],
Dynamic[ButtonBar[{Style["Income-Offer",Background->If[y1!=1,LightYellow,Yellow]]:> (y1=1;),
Style["Price-Offer",Background->If[y1≠0,LightYellow,Yellow]]:>(y1=0;)}]],{{a,1,"a"},.01,10,Appearance->"Labeled"},
{{b,20,"b"},1,200,Appearance->"Labeled"},{{c,10,"c"},1,200,Appearance->"Labeled"},
{{m,10,"income"},1,25,Appearance->"Labeled"},{{p2,1,"(Subscript[p, 2])"},.2,2.5,Appearance->"Labeled"},
{{p1,1,"(Subscript[p, 1])"},.2,2.5,Appearance->"Labeled"},{{scale,20,"\!\(\*SubscriptBox[\(x\), \(\(1\)\(\\ \)\)]\)scale"},10,100,Appearance->"Labeled"},
{{mscale,15,"m scale"},5,40,Appearance->"Labeled"},{{p1scale,2,"\!\(\*SubscriptBox[\(p\), \(\(1\)\(\\ \)\)]\)scale"},1,10,Appearance->"Labeled"},
ControlPlacement->Left
]

Quasi-linear preferences: vertically-parallel

u(x,y)=a y+b (1-(e^(-(x/c))))

x1StarParallel[a_,b_,c_,p1_,p2_,m_]:=-c Log[((a c)/b) (p1/p2)]
x2StarParallel[a_,b_,c_,p1_,p2_,m_]:=((m+c p1 Log[((a c p1)/(b p2))])/p2)

y1=1;
Manipulate[
Show[GraphicsGrid[{{Show[Plot[(-p1/p2) x+m/p2,{x,0,scale},PlotRange->{{0,scale},{0,scale}},AxesLabel->{"(Subscript[x, 1])","(Subscript[x, 2])"}],
ContourPlot[a x2StarParallel[a,b,c,p1,p2,m]+b(1-Exp[-((x1StarParallel[a,b,c,p1,p2,m])/c)])==a y +b(1-Exp[((-x)/c)]),
{x,.1,20},{y,.1,20},PlotRange->{{0,scale},{0,scale}}],
If[y1==0,ParametricPlot[{x1StarParallel[a,b,c,price1,p2,m],x2StarParallel[a,b,c,price1,p2,m]},{price1,.001,200},
PlotRange->{{0,scale},{0,scale}},PlotStyle->{Green,Thick},PerformanceGoal:>"Accuracy"],
ParametricPlot[{x1StarParallel[a,b,c,p1,p2,income],x2StarParallel[a,b,c,p1,p2,income]},
{income,.001,200},PlotRange->{{0,scale},{0,scale}},PlotStyle->{Purple,Thick}]],
Graphics[{{Dashing[.02],Line[{{0,x2StarParallel[a,b,c,p1,p2,m]},{x1StarParallel[a,b,c,p1,p2,m],x2StarParallel[a,b,c,p1,p2,m]}}],
Line[{{x1StarParallel[a,b,c,p1,p2,m],0},{x1StarParallel[a,b,c,p1,p2,m],x2StarParallel[a,b,c,p1,p2,m]}}]},
{PointSize[.02],Red,Point[{x1StarParallel[a,b,c,p1,p2,m],x2StarParallel[a,b,c,p1,p2,m]}]},
{If[y1==1,Text[Style["Income-Offer Curve",Bold,Italic,12],
{.6 scale,x2StarParallel[a,b,c,p1,p2,m]+2}],Text[Style["Price-Offer Curve",Bold,Italic,12],
{.6 scale,x2StarParallel[a,b,c,p1,p2,m]+2}]]}}]]},
{Show[Plot[-x,{x,0,scale},PlotRange->{{0,scale},{0,p1scale}},AxesLabel->{"(Subscript[x, 1])","(Subscript[p, 1])"}],
ParametricPlot[{x1StarParallel[a,b,c,price1,p2,m],price1},{price1,0.1,20},PlotRange->{{0,scale},{0,p1scale}},
AxesLabel->{"(Subscript[x, 1])","(Subscript[p, 1])"},PlotStyle->{Blue,Thick}],
Graphics[{{Dashing[.02],Line[{{0,p1},{x1StarParallel[a,b,c,p1,p2,m],p1}}],Line[{{x1StarParallel[a,b,c,p1,p2,m],0},
{x1StarParallel[a,b,c,p1,p2,m],p1scale}}]},
{PointSize[.02],Red,Point[{x1StarParallel[a,b,c,p1,p2,m],p1}]},
{Text[Style["Demand",Bold,Italic,12],{x1StarParallel[a,b,c,p1,p2,m],p1},{-1,-1}]}}]]},
{Show[Plot[-x,{x,0,scale},PlotRange->{{0,scale},{0,mscale}},AxesLabel->{"(Subscript[x, 1])","m"}],
ParametricPlot[{x1StarParallel[a,b,c,p1,p2,income],income},{income,0.1,50},
PlotRange->{{0,scale},{0,mscale}},AxesLabel->{"(Subscript[x, 1])","m"},
PlotStyle->{Orange,Thick}],
Graphics[{{Dashing[.02],Line[{{0,m},{x1StarParallel[a,b,c,p1,p2,m],m}}],Line[{{x1StarParallel[a,b,c,p1,p2,m],0},
{x1StarParallel[a,b,c,p1,p2,m],mscale}}]},
{PointSize[.02],Red,Point[{x1StarParallel[a,b,c,p1,p2,m],m}]},
{Text[Style["Engel Curve",Bold,Italic,12],{x1StarParallel[a,b,c,p1,p2,m],m},{-1,0}]}}]]}}]],
Dynamic[ButtonBar[{Style["Income-Offer",Background->If[y1!=1,LightYellow,Yellow]]:> (y1=1;),
Style["Price-Offer",Background->If[y1≠0,LightYellow,Yellow]]:>(y1=0;)}]],{{a,1,"a"},.01,10,Appearance->"Labeled"},
{{b,20,"b"},1,200,Appearance->"Labeled"},{{c,10,"c"},1,200,Appearance->"Labeled"},
{{m,10,"income"},1,25,Appearance->"Labeled"},{{p2,1,"(Subscript[p, 2])"},.2,2.5,Appearance->"Labeled"},
{{p1,1,"(Subscript[p, 1])"},.2,2.5,Appearance->"Labeled"},{{scale,20,"\!\(\*SubscriptBox[\(x\), \(\(1\)\(\\ \)\)]\)scale"},10,100,Appearance->"Labeled"},
{{mscale,15,"m scale"},5,40,Appearance->"Labeled"},{{p1scale,2,"\!\(\*SubscriptBox[\(p\), \(\(1\)\(\\ \)\)]\)scale"},1,10,Appearance->"Labeled"},
ControlPlacement->Left
]

Consider preferences that are a convex combination of CES and Quasi-linear preferences

With a differentiable utility function representing preferences the utility function needs to be strictly quasi-concave.

The sum of quasi-concave functions need not be quasi-concave, but a convex combination of strictly concave functions is strictly concave.
Since the CES and our Quasi-linear functions are strictly concave, the weighted average is strictly concave and, hence, strictly quasi-concave.

It is possible to generate some unusual demand functions with these preferences

But I want to explore these preferences in an Edgeworth box setting

Shapley Schubik example (JPE August 1977)

A dynamic Edgeworth box for the case of CES utility functions

u[x_,y_]:=(((α (x^ρ)+(1-α)(y^ρ)))^(1/ρ));
rho[ρ_]:=If[Abs[ρ]<.01,.01,ρ];

y1=1;
x1Star[α_,ρ_,p1_,p2_,omega1_,omega2_]:=(((((α/p1)))^((-1)/(ρ-1)))(p1 omega1+p2 omega2))/(p1((((α/p1)))^((-1)/(ρ-1)))+p2(((((1-α)/p2)))^((-1)/(ρ-1))))
x2Star[α_,ρ_,p1_,p2_,omega1_,omega2_]:=((((((1-α)/p2)))^((-1)/(ρ-1)))(p1 omega1+p2 omega2))/(p1((((α/p1)))^((-1)/(ρ-1)))+p2(((((1-α)/p2)))^((-1)/(ρ-1))))

gg[αA_,ρA_,omega1A_,omega2A_,αB_,ρB_,omega1B_,omega2B_]:=((omega2A+omega1A p1) (((((αA)/p1)))^(-(1/(-1+rho[ρA])))))/((((1-αA))^(-(1/(-1+rho[ρA]))))+p1 (((((αA)/p1)))^(-(1/(-1+rho[ρA])))))+((omega2B+omega1B p1) (((((αB)/p1)))^(-(1/(-1+rho[ρB])))))/((((1-αB))^(-(1/(-1+rho[ρB]))))+p1 (((((αB)/p1)))^(-(1/(-1+rho[ρB])))))-omega1A-omega1B
ff[αA_,ρA_,omega1A_,omega2A_,αB_,ρB_,omega1B_,omega2B_]:=((omega2A+omega1A p1) (((1-αA))^(-(1/(-1+rho[ρA])))))/((((1-αA))^(-(1/(-1+rho[ρA]))))+p1 (((((αA)/p1)))^(-(1/(-1+rho[ρA])))))+((omega2B+omega1B p1) (((1-αB))^(-(1/(-1+rho[ρB])))))/((((1-αB))^(-(1/(-1+rho[ρB]))))+p1 (((((αB)/p1)))^(-(1/(-1+rho[ρB])))))-omega2A-omega2B

eqp1[αA_,ρA_,omega1A_,omega2A_,αB_,ρB_,omega1B_,omega2B_]:=p1/.FindRoot[((omega2A+omega1A p1) (((((αA)/p1)))^(-(1/(-1+rho[ρA])))))/((((1-αA))^(-(1/(-1+rho[ρA]))))+p1 (((((αA)/p1)))^(-(1/(-1+rho[ρA])))))+((omega2B+omega1B p1) (((((αB)/p1)))^(-(1/(-1+rho[ρB])))))/((((1-αB))^(-(1/(-1+rho[ρB]))))+p1 (((((αB)/p1)))^(-(1/(-1+rho[ρB])))))-omega1A-omega1B,{p1,.9}];
pt[p_,pB_,uA_,uB_]:=EuclideanDistance[{p[[1]]-1,p[[2]]},y/.Flatten@Solve[(((uA[[2]])/(1-uA[[2]])))((p[[1]]-1)/y)^(rho[uA[[1]]-1])==(((uB[[2]])/(1-uB[[2]])))((p[[1]]+pB[[1]]-1.8 12-(p[[1]]-1))/(p[[2]]+pB[[2]]-y))^(rho[uB[[1]]-1]),y]]



moveIt[θ_]:=If[θ<π,0,-1/2+θ/(2 π)]

gr[p_,pB_,uA_,uB_,scale_,sc_,θ_,r_,pareto_,pC_,ce_]:=Magnify[Show[Plot[-x-10,{x,1,2 scale},PlotRange->{{-5,2.5 scale},{-5, 1.4 scale}},PlotStyle->{Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]},Axes->False,AspectRatio->1,Epilog->{If[θ<π,{{Dashing[.01],Rotate[Line[{{1.8 12,pB[[2]]},{pB[[1]],pB[[2]]}}],Min[θ,π],{pB[[1]],pB[[2]]}],Rotate[Line[{{pB[[1]],0},{pB[[1]],pB[[2]]}}],Min[θ,π],{pB[[1]],pB[[2]]}]},{Rotate[Rotate[Text[Style["(Subscript[O, B])",Bold,11],{1.8 12 -1-(θ-π)/π,-1},{1,0}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style["(Subscript[ω, 2]^B)",Blue,Bold,10],{1.8 12 -.25(*-(θ-π)/π*),pB[[2]]},{1,0}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style["(Subscript[ω, 1]^B)",Blue,Bold,10],{pB[[1]] (*-(θ-π)/π*),-.75}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style[If[θ<π/2,"(Subscript[X, 1]^B)→","←(Subscript[X, 1]^B)"],Bold,Italic,9],{1.8 12 +2-(θ-π)/π,-.75}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style[If[θ<π/2,"(Overscript[(Subscript[X, 2]^B), ↑])","(Overscript[↓, (Subscript[X, 2]^B)])"],Bold,Italic,9],{1.8 12 -1,1.5}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ]},{PointSize[.02],Red,Point[{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})]}},{PointSize[.02],Red,Point[{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})]}],If[θ<π,{Arrowheads[{{0.03,1}}],Rotate[Arrow[{{-1+1.8 12,0},{1.8 12+.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]],0}}],Min[θ,π],{pB[[1]],pB[[2]]}],Rotate[Arrow[{{1.8 12,-1},{1.8 12,.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]]}}],Min[θ,π],{pB[[1]],pB[[2]]}]}, {Arrowheads[{{0.03,1}}],If[θ==3 π,Arrow[{{-1,0},{p[[1]]+pB[[1]]-1.8 12 +3,0}}],Arrow[{{-1,0},{.9 Max[scale,1.8 Max[p[[1]],p[[2]]]],0}}]],If[θ==3 π,Arrow[{{0,-1},{0,p[[2]]+pB[[2]]+2}}],Arrow[{{0,-1},{0,.9 Max[scale,1.8 Max[p[[1]],p[[2]]]]}}]],If[θ==3 π,Arrow[{{p[[1]]+pB[[1]]-1.8 12+1.5,p[[2]]+pB[[2]]},{-3,p[[2]]+pB[[2]]}}],Arrow[{{1+-1.8 12+2 pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{1+-1.8 12+2 pB[[1]]+(-1+1.8 12-(1.8 12+.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]])),2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]],If[θ==3 π,Arrow[{{-1.8 12+pB[[1]]+p[[1]],pB[[2]]+p[[2]]+2},{-1.8 12+pB[[1]]+p[[1]],-2}}],Arrow[{{-1.8 12+2 pB[[1]],1+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1.8 12+2 pB[[1]],1+2pB[[2]]-(.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]]+1)}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]]}]}],Plot[((uA[[2]] (((p[[1]]))^(rho[uA[[1]]]))+(1-uA[[2]])(((p[[2]]))^(rho[uA[[1]]]))-uA[[2]] x^uA[[1]])/(1-uA[[2]]))^(1/rho[uA[[1]]]),{x,.2,If[θ==3 π,p[[1]]+pB[[1]]-1.8 12,If[θ>π/3,1.1Max[scale,1.8 p[[1]]],.9 Max[scale,1.8 p[[1]]]]]},PlotRange->{{-5, If[θ==3,p[[1]]+pB[[1]]-1.8 12,Max[scale,1.8 p[[1]]]]},{-5, .9 Max[scale,1.8p[[2]]]}},PlotStyle->{Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]},Axes->False,AspectRatio->1,Exclusions->{-.01<uA[[1]]<.01,-.01<uA[[1]]<.01,.99<uA[[2]]<1.01}],Graphics[{{If[θ>π,{Dashing[.01],Line[{{0,p[[2]]},{p[[1]],p[[2]]}}],Line[{{p[[1]],0},{p[[1]],p[[2]]}}],If[θ==3π,Line[{{p[[1]],p[[2]]+pB[[2]]},{p[[1]],p[[2]]}}],Line[{{pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]],Line[{{-1.8 12+2 pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]}]},{Dashing[.01],Line[{{0,p[[2]]},{p[[1]],p[[2]]}}],Line[{{p[[1]],0},{p[[1]],p[[2]]}}]},If[θ<π,{{PointSize[.02],Red,Point[p]}},{{PointSize[.02],Red,Point[p]}}],{Arrowheads[{{0.03,1}}],If[θ==3 π,Arrow[{{-1,0},{p[[1]]+pB[[1]]-1.8 12 +3,0}}],Arrow[{{-1,0},{.9 Max[scale,1.8 Max[p[[1]],p[[2]]]],0}}]],If[θ==3 π,Arrow[{{0,-1},{0,p[[2]]+pB[[2]]+2}}],Arrow[{{0,-1},{0,.9 Max[scale,1.8 Max[p[[1]],p[[2]]]]}}]]},If[θ≥π,{Text[Style["(Subscript[O, A])",Bold,11],{-1,-1}],Text[Style["(Overscript[(Subscript[X, 2]^A), ↑])",Bold,Italic,9],{-1,1.5}],Text[Style["(Subscript[X, 1]^A)→",Bold,Italic,9],{2.5,-.75}],Text[Style["(Subscript[ω, 1]^A)",Blue,Bold,10],{p[[1]],-.25},{0,1}],Text[Style["(Subscript[O, B])",Bold,11],{-1.8 12+2 pB[[1]]+.5,1+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["←(Subscript[X, 1]^B)",Bold,Italic,9],{-1.8 12+2 pB[[1]]-3.5,.7+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Overscript[↓, (Subscript[X, 2]^B)])",Bold,Italic,9],{-1.8 12+2 pB[[1]]+.3,-1.65+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Subscript[ω, 2]^B)",Blue,Bold,10],{-1.8 12+2 pB[[1]]+.5,pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Subscript[ω, 1]^B)",Blue,Bold,10],{pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{0,-1}]},{Text[Style["(Subscript[O, A])",Bold,11],{-1,-1}],Text[Style["(Subscript[X, 1]^A)→",Bold,Italic,9],{2.5,-.75}],Text[Style["(Overscript[(Subscript[X, 2]^A), ↑])",Bold,Italic,9],{-1,1.5}]}],Text[Style["(Subscript[ω, 1]^A)",Blue,Bold,10],{p[[1]],-.25},{0,1}],Text[Style["(Subscript[ω, 2]^A)",Blue,Bold,10],{-.5,p[[2]]},{1,0}]}],If[θ==3π&&pareto==True,If[ce==True,{ParametricPlot[{(x Cos[Min[θ,π]]-((((1/(1-uB[[2]]))(((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])-(((-21.6`+x))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]+(((-21.6`+pB[[1]]))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]])))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]]))) Sin[Min[θ,π]]+(pB[[1]]-Cos[Min[θ,π]] pB[[1]]+pB[[2]] Sin[Min[θ,π]])),(Cos[Min[θ,π]] ((((1/(1-uB[[2]]))(((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])-(((-21.6`+x))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]+(((-21.6`+pB[[1]]))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]])))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))+x Sin[Min[θ,π]]+(pB[[2]]-Cos[Min[θ,π]] pB[[2]]-pB[[1]] Sin[Min[θ,π]]))}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{x,1.05 1.8 12,.9 Max[scale,1.8 (pB[[1]])]},PlotRange->{{-5, Max[scale,1.8 pB[[1]]]},{-5, .5scale}},PlotStyle->{Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]},Axes->False,AspectRatio->1,Exclusions->True],ContourPlot[{(((uA[[2]])/(1-uA[[2]])))(x/y)^(rho[uA[[1]]-1])==(((uB[[2]])/(1-uB[[2]])))((p[[1]]+pB[[1]]-1.8 12-x)/(p[[2]]+pB[[2]]-y))^(rho[uB[[1]]-1])},{x,.05,p[[1]]+pB[[1]]-1.8 12},{y,.1,p[[2]]+pB[[2]]},PlotRange->{{-5, Max[scale,1.8 pB[[1]]]},{-5, .5scale}},Axes->False,AspectRatio->1,Exclusions->{rho[uB[[1]]]==1,rho[uA[[1]]]==1}],Plot[-eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]x+p[[2]]+eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] p[[1]],{x,0,90},Axes->False,AspectRatio->1,PlotRange->{{-5, 100},{-5, 100}}],(*
eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]
*)
Graphics[{{PointSize[.018],Point[{((eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] p[[1]]+p[[2]]) (((uA[[2]]/eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]))^(-(1/(-1+rho[uA[[1]]])))))/((((1-uA[[2]]))^(-(1/(-1+rho[uA[[1]]]))))+eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] (((uA[[2]]/eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]))^(-(1/(-1+rho[uA[[1]]]))))),((eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] p[[1]]+p[[2]]) (((1-uA[[2]]))^(-(1/(-1+rho[uA[[1]]])))))/((((1-uA[[2]]))^(-(1/(-1+rho[uA[[1]]]))))+eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] (((uA[[2]]/eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]))^(-(1/(-1+rho[uA[[1]]])))))}]}}]},{ParametricPlot[{(x Cos[Min[θ,π]]-((((1/(1-uB[[2]]))(((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])-(((-21.6`+x))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]+(((-21.6`+pB[[1]]))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]])))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]]))) Sin[Min[θ,π]]+(pB[[1]]-Cos[Min[θ,π]] pB[[1]]+pB[[2]] Sin[Min[θ,π]])),(Cos[Min[θ,π]] ((((1/(1-uB[[2]]))(((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])-(((-21.6`+x))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]+(((-21.6`+pB[[1]]))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]])))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))+x Sin[Min[θ,π]]+(pB[[2]]-Cos[Min[θ,π]] pB[[2]]-pB[[1]] Sin[Min[θ,π]]))}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{x,1.05 1.8 12,.9 Max[scale,1.8 (pB[[1]])]},PlotRange->{{-5, Max[scale,1.8 pB[[1]]]},{-5, .5scale}},PlotStyle->{Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]},Axes->False,AspectRatio->1,Exclusions->True],ContourPlot[{(((uA[[2]])/(1-uA[[2]])))(x/y)^(rho[uA[[1]]-1])==(((uB[[2]])/(1-uB[[2]])))((p[[1]]+pB[[1]]-1.8 12-x)/(p[[2]]+pB[[2]]-y))^(rho[uB[[1]]-1])},{x,.05,p[[1]]+pB[[1]]-1.8 12},{y,.1,p[[2]]+pB[[2]]},PlotRange->{{-5, Max[scale,1.8 pB[[1]]]},{-5, .5scale}},Axes->False,AspectRatio->1,Exclusions->{rho[uB[[1]]]==1,rho[uA[[1]]]==1}]
}],If[ce==True,{ParametricPlot[{(x Cos[Min[θ,π]]-((((1/(1-uB[[2]]))(((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])-(((-21.6`+x))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]+(((-21.6`+pB[[1]]))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]])))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]]))) Sin[Min[θ,π]]+(pB[[1]]-Cos[Min[θ,π]] pB[[1]]+pB[[2]] Sin[Min[θ,π]])),(Cos[Min[θ,π]] ((((1/(1-uB[[2]]))(((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])-(((-21.6`+x))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]+(((-21.6`+pB[[1]]))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]])))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))+x Sin[Min[θ,π]]+(pB[[2]]-Cos[Min[θ,π]] pB[[2]]-pB[[1]] Sin[Min[θ,π]]))}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{x,1.05 1.8 12,.9 Max[scale,1.8 (pB[[1]])]},PlotRange->{{-5, Max[scale,1.8 pB[[1]]]},{-5, .5scale}},PlotStyle->{Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]},Axes->False,AspectRatio->1,Exclusions->True],Plot[-eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]x+p[[2]]+eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] p[[1]],{x,0,90},Axes->False,AspectRatio->1,PlotRange->{{-5, 100},{-5, 100}}],
Graphics[{{PointSize[.018],Point[{((eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] p[[1]]+p[[2]]) (((uA[[2]]/eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]))^(-(1/(-1+rho[uA[[1]]])))))/((((1-uA[[2]]))^(-(1/(-1+rho[uA[[1]]]))))+eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] (((uA[[2]]/eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]))^(-(1/(-1+rho[uA[[1]]]))))),((eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] p[[1]]+p[[2]]) (((1-uA[[2]]))^(-(1/(-1+rho[uA[[1]]])))))/((((1-uA[[2]]))^(-(1/(-1+rho[uA[[1]]]))))+eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]] (((uA[[2]]/eqp1[uA[[2]],uA[[1]],p[[1]],p[[2]],uB[[2]],uB[[1]],pC[[1]]-p[[1]],pC[[2]]-p[[2]]]))^(-(1/(-1+rho[uA[[1]]])))))}]}}]},ParametricPlot[{(x Cos[Min[θ,π]]-((((1/(1-uB[[2]]))(((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])-(((-21.6`+x))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]+(((-21.6`+pB[[1]]))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]])))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]]))) Sin[Min[θ,π]]+(pB[[1]]-Cos[Min[θ,π]] pB[[1]]+pB[[2]] Sin[Min[θ,π]])),(Cos[Min[θ,π]] ((((1/(1-uB[[2]]))(((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])-(((-21.6`+x))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]+(((-21.6`+pB[[1]]))^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]])))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))+x Sin[Min[θ,π]]+(pB[[2]]-Cos[Min[θ,π]] pB[[2]]-pB[[1]] Sin[Min[θ,π]]))}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{x,1.05 1.8 12,.9 Max[scale,1.8 (pB[[1]])]},PlotRange->{{-5, Max[scale,1.8 pB[[1]]]},{-5, .5scale}},PlotStyle->{Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]},Axes->False,AspectRatio->1,Exclusions->True]]]],r]

p={4,6};pB={1.8 12+6,6};pC={15,18};
DynamicModule[{p={4,6},pB={1.8 12+6,9},pC={4+6,9+6},uA={.05,.4},uB={.15,.6}},Manipulate[If[θ==3π,gr[p,{pC[[1]]+12 1.8-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce],gr[p,{pC[[1]]+12 1.8-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce]],
Delimiter,{{scale,20,"scale"},6,40},{{r,1,"Magnification"},.2,2},{{θ,0,"θ"},0, 3π},{{pB,{1.8 12+6,9}},{1.8 12+1,1},{1.8 18+12,18},Locator,Appearance->None},{{p,{4,6}},{1,1},{44,34},Locator,Appearance->None},{{pC,{30,25}},{4,4},{45,35},Locator,Appearance->Graphics[{Text[If[θ≥.5π,"⊕","⊕"]]}]},{{pareto,False,"Show Contract Curve"},{False,True}},
{{ce,False,"Show Competitive Equilibrium"},{False,True}},OpenerView[{"CES Utility Function Parameters",Column[{Control[{{uA,{.05,.4},"Mr. A"},{-5,.05},{.99,.95},Exclusions->{uA=={0.,__}}}],Control[{{uB,{.15,.6},"Aunt Bee"},{-2,.05},{.99,.95},Exclusions->{uB[[1]]==0}}]},Right]}],ControlPlacement->{Top,Top,Top,Top,Left,Left},SaveDefinitions->True]]

A dynamic Edgeworth box for a case of “quasi-homothetic” utility functions

Off[Power::infy]; Off[Infinity::indet];

f1[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[y==-(x ((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB))/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (y^(-1+c/50)) γB)+(((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB) ωx)/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (y^(-1+c/50)) γB)+ωy,{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Green,Thickness[.005]]];
f1Orange[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[y==-(x ((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB))/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (y^(-1+c/50)) γB)+(((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB) ωx)/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (y^(-1+c/50)) γB)+ωy,{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Orange,Thickness[.005]]];
f1B[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_,ωyB_,ωxTotal_,ωyTotal_]:=ContourPlot[ωyTotal-y==-((ωxTotal-x )((((ωxTotal-x))^(-1+ρ)) α ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB))/((((ωyTotal-y))^(-1+ρ)) (1-α) ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (((ωyTotal-y))^(-1+c/50)) γB)+(((((ωxTotal-x))^(-1+ρ)) α ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB) (ωxTotal-ωx))/((((ωyTotal-y))^(-1+ρ)) (1-α) ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (((ωyTotal-y))^(-1+c/50)) γB)+(ωyTotal-ωy),{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Orange,Thickness[.005]],Exclusions->{x==ωxTotal}];
f2[α_,ρ_,a_,b_,c_,γ_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[y==-((x ((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γ)+a γ))/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γ)+((b (E^(-(y/c))) γ)/c)))+((((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γ)+a γ) ωx)/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γ)+((b (E^(-(y/c))) γ)/c)))+ωy,{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Green,Thickness[.005]]];
f2Orange[α_,ρ_,a_,b_,c_,γ_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[y==-((x ((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γ)+a γ))/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γ)+((b (E^(-(y/c))) γ)/c)))+((((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γ)+a γ) ωx)/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γ)+((b (E^(-(y/c))) γ)/c)))+ωy,{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Orange,Thickness[.005]]];

f2B[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_,ωyB_,ωxTotal_,ωyTotal_]:=ContourPlot[ωyTotal-y==-((ωxTotal-x )((((ωxTotal-x))^(-1+ρ)) α ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB))/((((ωyTotal-y))^(-1+ρ)) (1-α) ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+((b (E^(-((ωyTotal-y)/c))) γB)/c))+(((((ωxTotal-x))^(-1+ρ)) α ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB) (ωxTotal-ωx))/((((ωyTotal-y))^(-1+ρ)) (1-α) ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+((b (E^(-((ωyTotal-y)/c))) γB)/c))+(ωyTotal-ωy),{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Orange,Thickness[.005]],Exclusions->{x==ωxTotal}];


f3[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[y==-(x ((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (x^(-1+c/50)) γB))/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB)+(((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (x^(-1+c/50)) γB) ωx)/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB)+ωy,{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Green,Thickness[.005]]];
f3Orange[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[y==-(x ((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (x^(-1+c/50)) γB))/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB)+(((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (x^(-1+c/50)) γB) ωx)/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB)+ωy,{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Orange,Thickness[.005]]];
f3B[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_,ωyB_,ωxTotal_,ωyTotal_]:=ContourPlot[(ωyTotal-y)==-((ωxTotal-x) ((((ωxTotal-x))^(-1+ρ)) α ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (((ωxTotal-x))^(-1+c/50)) γB))/((((ωyTotal-y))^(-1+ρ)) (1-α) ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB)+(((((ωxTotal-x))^(-1+ρ)) α ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+b c/50 (((ωxTotal-x))^(-1+c/50)) γB) (ωxTotal-ωx))/((((ωyTotal-y))^(-1+ρ)) (1-α) ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB)+(ωyTotal-ωy),{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Orange,Thickness[.005],Exclusions->{x==ωxTotal}]];
f4[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[y==-((x ((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+((b (E^(-(x/c))) γB)/c)))/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB))+((((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+((b (E^(-(x/c))) γB)/c)) ωx)/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB))+ωy,{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Green,Thickness[.005]]];
f4Orange[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[y==-((x ((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+((b (E^(-(x/c))) γB)/c)))/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB))+((((x^(-1+ρ)) α ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+((b (E^(-(x/c))) γB)/c)) ωx)/((y^(-1+ρ)) (1-α) ((((y^ρ) (1-α)+(x^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB))+ωy,{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Orange,Thickness[.005]]];
f4B[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_,ωyB_,ωxTotal_,ωyTotal_]:=ContourPlot[(ωyTotal-y)==-((ωxTotal-x) ((((ωxTotal-x))^(-1+ρ)) α ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+((b (E^(-(((ωxTotal-x))/c))) γB)/c)))/((((ωyTotal-y))^(-1+ρ)) (1-α) ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB)+(((((ωxTotal-x))^(-1+ρ)) α ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+((b (E^(-(((ωxTotal-x))/c))) γB)/c)) (ωxTotal-ωx))/((((ωyTotal-y))^(-1+ρ)) (1-α) ((((((ωyTotal-y))^ρ) (1-α)+(((ωxTotal-x))^ρ) α))^(-1+(1/ρ))) (1-γB)+a γB)+(ωyTotal-ωy),{x,.1,60},{y,.1,60},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Orange,Thickness[.005]]];
hh1[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[γB(a ωx + b(((ωy ))^((c/50))))+(1-γB)(((α ((ωx )^ρ)+(1-α)(((ωy ) )^ρ)))^(1/ρ))== γB(a x + b (y^(( c/50 ))) )+(1-γB)(((α (x^( ρ))+(1-α)(y^( ρ)) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},Frame->None,ContourStyle->Directive[Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]]];
hh1Brown[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[γB(a ωx + b(((ωy ))^((c/50))))+(1-γB)(((α ((ωx )^ρ)+(1-α)(((ωy ) )^ρ)))^(1/ρ))==γB(a (x-1.8 12)+ b (y^(( c/50 ))) )+(1-γB)(((α (((x-1.8 12))^( ρ))+(1-α)(y^( ρ)) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{0,2.5 scale+5},{0, 1.4 scale+5}},(*Frame->None,*)ContourStyle->Directive[Thickness[.005],Brown]];

hh1B[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_,ωyB_,ωxTotal_,ωyTotal_]:=ContourPlot[γB(a (ωxTotal-ωx)+ b(((ωyTotal-ωy ))^(c/50)) )+(1-γB)(((α (((ωxTotal-ωx ))^( ρ))+(1-α)(((ωyTotal-ωy ))^ρ)))^(1/ρ))== γB(a (ωxTotal-x) + b(((ωyTotal-y ))^(c/50)))+(1-γB)(((α (((ωxTotal-x ))^ρ)+(1-α)(((ωyTotal-y ))^ρ) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],Brown]];


hh2[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[γB(a ωx + b(1-Exp[((-(ωy ))/c)]))+(1-γB)(((α ((ωx)^( ρ))+(1-α)((ωy )^(ρ ))) )^(1/ρ))== γB(a x + b(1-Exp[((-y)/c)]))+(1-γB)(((α (x^( ρ))+(1-α)(y^ρ) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]]];
hh2Brown[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[γB(a ωx + b(1-Exp[((-(ωy ))/c)]))+(1-γB)(((α ((ωx)^( ρ))+(1-α)((ωy )^(ρ ))) )^(1/ρ))==γB(a (x-1.8 12) + b(1-Exp[((-y)/c)]))+(1-γB)(((α (((x-1.8 12))^( ρ))+(1-α)(y^ρ) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{0,2.5 scale+5},{0, 1.4 scale+5}},Frame->None,ContourStyle->Directive[Thickness[.005],Brown]];

hh2B[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_,ωyB_,ωxTotal_,ωyTotal_]:=ContourPlot[γB(a (ωxTotal-ωx )+ b(1-Exp[((-(ωyTotal-ωy) )/c)]))+(1-γB)(((α (((ωxTotal-ωx ))^( ρ))+(1-α)(((ωyTotal-ωy ))^ρ) ))^(1/ρ))== γB(a (ωxTotal-x) + b(1-Exp[((-(ωyTotal-y))/c)]))+(1-γB)(((α (((ωxTotal-x ) )^ρ)+(1-α)(((ωyTotal-y ))^ρ) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],Brown]];

hh3[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[γB(a ωy + b ((ωx)^( c/50)) )+(1-γB)(((α ((ωx)^(  ρ))+(1-α)(((ωy ))^ρ) ))^(1/ρ))== γB(a y + b (x^( c/50)) )+(1-γB)(((α (x^ρ)+(1-α)(y^( ρ)) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]]];
hh3Brown[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[γB(a ωy + b ((ωx)^( c/50)) )+(1-γB)(((α ((ωx)^(  ρ))+(1-α)(((ωy ))^ρ) ))^(1/ρ))== γB(a y + b (x^( c/50)) )+(1-γB)(((α (x^ρ)+(1-α)(y^( ρ)) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],Brown]];
hh3B[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_,ωyB_,ωxTotal_,ωyTotal_]:=ContourPlot[γB(a (ωyTotal-ωy)+ b(((ωxTotal-ωx ))^( c/50)) )+(1-γB)(((α (((ωxTotal-ωx ))^ρ)+(1-α)(((ωyTotal-ωy ))^ρ) ))^(1/ρ))== γB(a (ωyTotal-y) + b(((ωxTotal-x ))^(c/50)))+(1-γB)(((α (((ωxTotal-x ))^ρ)+(1-α)(((ωyTotal-y) )^ρ) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],Brown]];

hh4[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[γB(a ωy + b(1-Exp[((-ωx)/c)]))+(1-γB)(((α ((ωx)^( ρ))+(1-α)(((ωy ) )^ρ)))^(1/ρ))== γB(a y + b(1-Exp[((-x)/c)]))+(1-γB)(((α (x^ρ)+(1-α)(y^ρ) ))^(1/( ρ))),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]]];
hh4Brown[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_]:=ContourPlot[γB(a ωy + b(1-Exp[((-ωx)/c)]))+(1-γB)(((α ((ωx)^( ρ))+(1-α)(((ωy ) )^ρ)))^(1/ρ))== γB(a y + b(1-Exp[((-x)/c)]))+(1-γB)(((α (x^ρ)+(1-α)(y^ρ) ))^(1/( ρ))),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],Brown]];
hh4B[α_,ρ_,a_,b_,c_,γB_,ωx_,ωy_,scale_,ωxB_,ωyB_,ωxTotal_,ωyTotal_]:=ContourPlot[γB(a (ωyTotal-ωy)+ b(1-Exp[((-(ωxTotal-ωx))/c)]))+(1-γB)(((α (((ωxTotal-ωx ))^ρ)+(1-α)(((ωyTotal-ωy ))^( ρ)) ))^(1/ρ))== γB(a (ωyTotal-y) + b(1-Exp[((-(ωxTotal-x))/c)]))+(1-γB)(((α (((ωxTotal-x ))^ρ)+(1-α)(((ωyTotal-y ))^ρ) ))^(1/ρ)),{x,.1,50},{y,.1,50},PlotRange->{{-5, 1.0 scale},{-5, .5scale}},ContourStyle->Directive[Thickness[.005],Brown]];
u[x_,y_]:=(((α (x^ρ)+(1-α)(y^ρ)))^(1/ρ));
x1Star[α_,ρ_,p1_,p2_,omega1_,omega2_]:=(((((α/p1)))^((-1)/(ρ-1)))(p1 omega1+p2 omega2))/(p1((((α/p1)))^((-1)/(ρ-1)))+p2(((((1-α)/p2)))^((-1)/(ρ-1))))
gr[p_,pB_,uA_,uB_,scale_,sc_,θ_,r_,pareto_,pC_,ce_,z_,px_,zpx_,γA_,cA_,aA_,bA_,γB_,cB_,aB_,bB_,z2A_,zOfferA_,z2B_,zOfferB_,z3_,z4_,z5_,u_,u2_,u3_,op_]:=If[z==True,Grid[{{Magnify[Show[Plot[-x-10,{x,1,2 scale},PlotRange->{{-5,2.5 scale},{-5, 1.4 scale}},PlotStyle->{Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]},Axes->False,AspectRatio->1,Epilog->{If[θ<π,{{Dashing[.01],Rotate[Line[{{1.8 12,pB[[2]]},{pB[[1]],pB[[2]]}}],Min[θ,π],{pB[[1]],pB[[2]]}],Rotate[Line[{{pB[[1]],0},{pB[[1]],pB[[2]]}}],Min[θ,π],{pB[[1]],pB[[2]]}]},{Rotate[Rotate[Text[Style["(Subscript[O, B])",Bold,11],{1.8 12 -1-(θ-π)/π,-1},{1,0}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style["(Subscript[ω, 2]^B)",Blue,Bold,10],{1.8 12 -.25(*-(θ-π)/π*),pB[[2]]},{1,0}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style["(Subscript[ω, 1]^B)",Blue,Bold,10],{pB[[1]] (*-(θ-π)/π*),-.75}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style[If[θ<π/2,"(Subscript[X, 1]^B)→","←(Subscript[X, 1]^B)"],Bold,Italic,9],{1.8 12 +2-(θ-π)/π,-.75}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style[If[θ<π/2,"(Overscript[(Subscript[X, 2]^B), ↑])","(Overscript[↓, (Subscript[X, 2]^B)])"],Bold,Italic,9],{1.8 12 -1,1.5}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ]},{PointSize[.02],Red,Point[{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})]}},{{PointSize[.02],Red,Point[{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})]}}],If[θ<π,{Arrowheads[{{0.03,1}}],Rotate[Arrow[{{-1+1.8 12,0},{1.8 12+.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]],0}}],Min[θ,π],{pB[[1]],pB[[2]]}],Rotate[Arrow[{{1.8 12,-1},{1.8 12,.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]]}}],Min[θ,π],{pB[[1]],pB[[2]]}]}, {Arrowheads[{{0.03,1}}],If[θ==3 π,Arrow[{{-1,0},{p[[1]]+pB[[1]]-1.8 12 +3,0}}],Arrow[{{-1,0},{.9 Max[scale,1.8 Max[p[[1]],p[[2]]]],0}}]],If[θ==3 π,{Arrow[{{0,-1},{0,p[[2]]+pB[[2]]+2}}],Arrow[{{p[[1]]+pB[[1]]-1.8 12+1.5,p[[2]]+pB[[2]]},{-3,p[[2]]+pB[[2]]}}],Arrow[{{-1.8 12+pB[[1]]+p[[1]],pB[[2]]+p[[2]]+2},{-1.8 12+pB[[1]]+p[[1]],-2}}]},{Arrow[{{0,-1},{0,.9 Max[scale,1.8 Max[p[[1]],p[[2]]]]}}],Arrow[{{1+-1.8 12+2 pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{1+-1.8 12+2 pB[[1]]+(-1+1.8 12-(1.8 12+.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]])),2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}],Arrow[{{-1.8 12+2 pB[[1]],1+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1.8 12+2 pB[[1]],1+2pB[[2]]-(.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]]+1)}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]}]}]}],If[zOfferB==True,Which[z2B==1,f1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,f2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,f3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,f4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Graphics[{{Point[{0,0}]}}]],
If[zOfferA==True,Which[z2A==1,f1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,f2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,f3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,f4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],Graphics[{{Point[{0,0}]}}]],If[θ<2 π,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],Graphics[{{Point[{0,0}]}}]],

(* Turning on and off the indifference curves throught the endowment *)

(*Which[z5==1,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],
Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]
},z5==2,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],z5==3,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],True,Graphics[{{PointSize[.004],Point[{1,1}]}}] ],*)
(* Indifference curves passing through the one, two, or three budget lines 

This obviously needs to be simplified and done as a separate function.

*)
Which[z4==2,Which[z3==2,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],z3==3,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]]]},z3==4,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]]]},True,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]]],z4==3,
(* xxx *)Which[z3==2,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],z3==3,{Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]},z3==4,{Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]},True,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]]],z4==4,Which[z3==2,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]},z3==3,{{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]]]},{Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]}},z3==4,{{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]]]},{Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]}},True,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]]],True,Graphics[{Text[Style["no curves",6],{4,4}]}]]
,
Graphics[{{If[θ>π,{Dashing[.01],Line[{{0,p[[2]]},{p[[1]],p[[2]]}}],Line[{{p[[1]],0},{p[[1]],p[[2]]}}],If[θ==3π,Line[{{p[[1]],p[[2]]+pB[[2]]},{p[[1]],p[[2]]}}],Line[{{pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]],Line[{{-1.8 12+2 pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]}]},{Dashing[.01],Line[{{0,p[[2]]},{p[[1]],p[[2]]}}],Line[{{p[[1]],0},{p[[1]],p[[2]]}}]},If[θ<π,{{Red,PointSize[.02],Point[p]}},{{PointSize[.02],Red,Point[p]}}],{Arrowheads[{{0.03,1}}],If[θ==3 π,Arrow[{{-1,0},{p[[1]]+pB[[1]]-1.8 12 +3,0}}],Arrow[{{-1,0},{.9 Max[scale,1.8 Max[p[[1]],p[[2]]]],0}}]],If[θ==3 π,Arrow[{{0,-1},{0,p[[2]]+pB[[2]]+2}}],Arrow[{{0,-1},{0,.9 Max[scale,1.8 Max[p[[1]],p[[2]]]]}}]]},If[θ≥π,{Text[Style["(Subscript[O, A])",Bold,11],{-1,-1}],Text[Style["(Overscript[(Subscript[X, 2]^A), ↑])",Bold,Italic,9],{-1,1.5}],Text[Style["(Subscript[X, 1]^A)→",Bold,Italic,9],{2.5,-.75}],Text[Style["(Subscript[ω, 1]^A)",Blue,Bold,10],{p[[1]],-.25},{0,1}],Text[Style["(Subscript[O, B])",Bold,11],{-1.8 12+2 pB[[1]]+.5,1+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["←(Subscript[X, 1]^B)",Bold,Italic,9],{-1.8 12+2 pB[[1]]-3.5,.7+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Overscript[↓, (Subscript[X, 2]^B)])",Bold,Italic,9],{-1.8 12+2 pB[[1]]+.3,-1.65+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Subscript[ω, 2]^B)",Blue,Bold,10],{-1.8 12+2 pB[[1]]+.5,pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Subscript[ω, 1]^B)",Blue,Bold,10],{pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{0,-1}]},{Text[Style["(Subscript[O, A])",Bold,11],{-1,-1}],Text[Style["(Subscript[X, 1]^A)→",Bold,Italic,9],{2.5,-.75}],Text[Style["(Overscript[(Subscript[X, 2]^A), ↑])",Bold,Italic,9],{-1,1.5}]}],Text[Style["(Subscript[ω, 1]^A)",Blue,Bold,10],{p[[1]],-.25},{0,1}],Text[Style["(Subscript[ω, 2]^A)",Blue,Bold,10],{-.5,p[[2]]},{1,0}]}],If[θ==3π,(* Turning on and off the indifference curves throught the endowment *)
{Which[z5==1,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],
Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]
},z5==2,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],z5==3,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],True,Graphics[{{PointSize[.004],Point[{1,1}]}}] ],Plot[Take[{-x-5,p[[2]]-(p[[2]]-u[[2]])/(p[[1]]-u[[1]])p[[1]]+(p[[2]]-u[[2]])/(p[[1]]-u[[1]]) x,p[[2]]-(p[[2]]-u2[[2]])/(p[[1]]-u2[[1]])p[[1]]+(p[[2]]-u2[[2]])/(p[[1]]-u2[[1]]) x,p[[2]]-(p[[2]]-u3[[2]])/(p[[1]]-u3[[1]])p[[1]]+(p[[2]]-u3[[2]])/(p[[1]]-u3[[1]]) x},z3],{x,0,70},PlotStyle->Directive[Opacity[op]]],Graphics[{Take[{PointSize[.017],Point[u],Point[u2],Point[u3]},z3]}]},Graphics[{{PointSize[.004],Point[{1,1}]}}]],
If[θ==3π&&pareto==True,
ContourPlot[{Which[z2A==1,((x^(-1+uA[[1]])) uA[[2]] ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[1]] γA)/((y^(-1+uA[[1]])) (1-uA[[2]]) ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[2]] cA/50 (y^(-1+cA/50)) γA),z2A==2,((x^(-1+uA[[1]])) uA[[2]] ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[1]] γA)/((y^(-1+uA[[1]])) (1-uA[[2]]) ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+((abA[[2]] (E^(-(y/cA))) γA)/cA)),z2A==3,((x^(-1+uA[[1]])) uA[[2]] ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[2]] cA/50 (x^(-1+cA/50)) γA)/((y^(-1+uA[[1]])) (1-uA[[2]]) ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[1]] γA),True,((x^(-1+uA[[1]])) uA[[2]] ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+((abA[[2]] (E^(-(x/cA))) γA)/cA))/((y^(-1+uA[[1]])) (1-uA[[2]]) ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[1]] γA)]==Which[z2B==1,((((p[[1]]+pB[[1]]-1.8 12-x))^(-1+uB[[1]])) uB[[2]] ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[1]] γB)/((((p[[2]]+pB[[2]]-y))^(-1+uB[[1]])) (1-uB[[2]]) ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[2]] cB/50 (((p[[2]]+pB[[2]]-y))^(-1+cB/50)) γB),z2B==2,((((p[[1]]+pB[[1]]-1.8 12-x))^(-1+uB[[1]])) uB[[2]] ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[1]] γB)/((((p[[2]]+pB[[2]]-y))^(-1+uB[[1]])) (1-uB[[2]]) ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+((abB[[2]] (E^(-(((p[[2]]+pB[[2]]-y))/cB))) γB)/cB)),z2B==3,
((((p[[1]]+pB[[1]]-1.8 12-x))^(-1+uB[[1]])) uB[[2]] ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[2]] cB/50 (((p[[1]]+pB[[1]]-1.8 12-x))^(-1+cB/50)) γB)/((((p[[2]]+pB[[2]]-y))^(-1+uB[[1]])) (1-uB[[2]]) ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[1]] γB),True,((((p[[1]]+pB[[1]]-1.8 12-x))^(-1+uB[[1]])) uB[[2]] ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+((abB[[2]] (E^(-(((p[[1]]+pB[[1]]-1.8 12-x))/cB))) γB)/cB))/((((p[[2]]+pB[[2]]-y))^(-1+uB[[1]])) (1-uB[[2]]) ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[1]] γB)]},{x,.05,p[[1]]+pB[[1]]-1.8 12},{y,.1,p[[2]]+pB[[2]]},PlotRange->{{-5, Max[scale,1.8 pB[[1]]]},{-5, .5scale}},Axes->False,AspectRatio->1,PlotPoints->ControlActive[5,50],Exclusions->{rho[uB[[1]]]==1,rho[uA[[1]]]==1},PerformanceGoal->"Quality"]
,Graphics[{PointSize[.005],Point[{1,1}]}]]],r]},{Show[Plot[-x-1x,{x,0,1},AspectRatio->1,PlotRange->{{0,35},{0,35}},Ticks->None,AxesLabel->{"(Subscript[u, A])","(Subscript[u, B])"}],Graphics[{{Dashing[{.01}],Arrow[{{(((((p[[1]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) (1-uA[[2]])+((p[[2]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) uA[[2]]))^(1/(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]]))),(((((pB[[1]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])+((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))},{(((((p[[1]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) (1-uA[[2]])+((p[[2]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) uA[[2]]))^(1/(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]]))),35}}],Arrow[{{(((((p[[1]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) (1-uA[[2]])+((p[[2]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) uA[[2]]))^(1/(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]]))),(((((pB[[1]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])+((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))},{35,(((((pB[[1]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])+((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))}}]},{Red,PointSize[.02],Point[{(((((p[[1]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) (1-uA[[2]])+((p[[2]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) uA[[2]]))^(1/(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]]))),(((((pB[[1]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])+((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))}]},{Red,Style[Text[d,{-1+(((((p[[1]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) (1-uA[[2]])+((p[[2]])^(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]])) uA[[2]]))^(1/(If[Abs[uA[[1]]]<0.01`,0.01`,uA[[1]]]))),-1+(((((pB[[1]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) (1-uB[[2]])+((pB[[2]])^(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])) uB[[2]]))^(1/(If[Abs[uB[[1]]]<0.01`,0.01`,uB[[1]]])))},{1,1}],12,Red,Bold,Italic]}}]]}}],Magnify[Show[Plot[-x-10,{x,1,2 scale},PlotRange->{{-5,2.5 scale},{-5, 1.4 scale}},PlotStyle->{Thickness[.005],RGBColor[0.745098, 0.294118, 0.988235]},Axes->False,AspectRatio->1,Epilog->{If[θ<π,{{Dashing[.01],Rotate[Line[{{1.8 12,pB[[2]]},{pB[[1]],pB[[2]]}}],Min[θ,π],{pB[[1]],pB[[2]]}],Rotate[Line[{{pB[[1]],0},{pB[[1]],pB[[2]]}}],Min[θ,π],{pB[[1]],pB[[2]]}]},{Rotate[Rotate[Text[Style["(Subscript[O, B])",Bold,11],{1.8 12 -1-(θ-π)/π,-1},{1,0}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style["(Subscript[ω, 2]^B)",Blue,Bold,10],{1.8 12 -.25(*-(θ-π)/π*),pB[[2]]},{1,0}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style["(Subscript[ω, 1]^B)",Blue,Bold,10],{pB[[1]] (*-(θ-π)/π*),-.75}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style[If[θ<π/2,"(Subscript[X, 1]^B)→","←(Subscript[X, 1]^B)"],Bold,Italic,9],{1.8 12 +2-(θ-π)/π,-.75}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ],Rotate[Rotate[Text[Style[If[θ<π/2,"(Overscript[(Subscript[X, 2]^B), ↑])","(Overscript[↓, (Subscript[X, 2]^B)])"],Bold,Italic,9],{1.8 12 -1,1.5}],Min[θ,π],{pB[[1]],pB[[2]]}],-θ]},{PointSize[.02],Red,Point[{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})]}},{{PointSize[.02],Red,Point[{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})]}}],If[θ<π,{Arrowheads[{{0.03,1}}],Rotate[Arrow[{{-1+1.8 12,0},{1.8 12+.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]],0}}],Min[θ,π],{pB[[1]],pB[[2]]}],Rotate[Arrow[{{1.8 12,-1},{1.8 12,.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]]}}],Min[θ,π],{pB[[1]],pB[[2]]}]}, {Arrowheads[{{0.03,1}}],If[θ==3 π,Arrow[{{-1,0},{p[[1]]+pB[[1]]-1.8 12 +3,0}}],Arrow[{{-1,0},{.9 Max[scale,1.8 Max[p[[1]],p[[2]]]],0}}]],If[θ==3 π,{Arrow[{{0,-1},{0,p[[2]]+pB[[2]]+2}}],Arrow[{{p[[1]]+pB[[1]]-1.8 12+1.5,p[[2]]+pB[[2]]},{-3,p[[2]]+pB[[2]]}}],Arrow[{{-1.8 12+pB[[1]]+p[[1]],pB[[2]]+p[[2]]+2},{-1.8 12+pB[[1]]+p[[1]],-2}}]},{Arrow[{{0,-1},{0,.9 Max[scale,1.8 Max[p[[1]],p[[2]]]]}}],Arrow[{{1+-1.8 12+2 pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{1+-1.8 12+2 pB[[1]]+(-1+1.8 12-(1.8 12+.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]])),2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}],Arrow[{{-1.8 12+2 pB[[1]],1+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1.8 12+2 pB[[1]],1+2pB[[2]]-(.9 Max[scale,1.8 Max[pB[[1]]-1.8 12,pB[[2]]]]+1)}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]}]}]}],If[zOfferB==True,If[θ==3π ,(* First attempt at putting Ms. B's offer curve on her graph *)Which[z2B==1,f1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,f2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,f3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,f4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,f1Orange[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,pB[[1]],pB[[2]],scale,pB[[1]]],z2B==2,f2Orange[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,pB[[1]],pB[[2]],scale,pB[[1]]],z2B==3,f3Orange[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,pB[[1]],pB[[2]],scale,pB[[1]]],True,f4Orange[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,pB[[1]],pB[[2]],scale,pB[[1]]]]],Graphics[{{Point[{0,0}]}}]],
If[zOfferA==True,Which[z2A==1,f1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,f2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,f3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,f4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],Graphics[{{Point[{0,0}]}}]],
If[θ<3 π,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],Graphics[{{Point[{0,0}]}}]],
(*
Which[z2B==1,hh1Brown[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,pB[[1]],pB[[2]],scale,pB[[1]]],z2B==2,
(* adding Ms. B's indifference curve*)hh2Brown[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,pB[[1]],pB[[2]],scale,pB[[1]]],z2B==3,hh3Brown[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,pB[[1]],pB[[2]],scale,pB[[1]]],True,hh4Brown[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,pB[[1]],pB[[2]],scale,pB[[1]]]],
*)
(* Omit the inset graphic and just use the rotated diagram *)
(*
Graphics[{{Rotate[Which[z2B==1,Inset[hh1Brown[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,pC[[1]]-p[[1]],pC[[2]]-p[[2]],scale,pB[[1]]],{0,0},{-2.75,-2.75},2.5 scale],True,Inset[hh1Brown[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,pC[[1]]-p[[1]],pC[[2]]-p[[2]],scale,pB[[1]]],{0,0},{-2.75,-2.75},2.5 scale]],θ,{pB[[1]],pB[[2]]}]},{PointSize[.015],Green,Rotate[Point[{1.8 12,0}],Min[θ,π],{pB[[1]],pB[[2]]}]}}]
*)


(* Indifference curves passing through the one, two, or three budget lines 

This obviously needs to be simplified and done as a separate function.

*)
Which[z4==2,Which[z3==2,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],z3==3,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]]]},z3==4,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]]]},True,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]]],z4==3,
(* xxx *)Which[z3==2,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],z3==3,{Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]},z3==4,{Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]},True,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]]],z4==4,Which[z3==2,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]},z3==3,{{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]]]},{Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]}},z3==4,{{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u[[1]],u[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u2[[1]],u2[[2]],scale,pB[[1]]]],Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,u3[[1]],u3[[2]],scale,pB[[1]]]]},{Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u[[1]],u[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u2[[1]],u2[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,u3[[1]],u3[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]}},True,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]]],True,Graphics[{Text[Style["no curves",6],{4,4}]}]]
,
Graphics[{{If[θ>π,{Dashing[.01],Line[{{0,p[[2]]},{p[[1]],p[[2]]}}],Line[{{p[[1]],0},{p[[1]],p[[2]]}}],If[θ==3π,Line[{{p[[1]],p[[2]]+pB[[2]]},{p[[1]],p[[2]]}}],Line[{{pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]],Line[{{-1.8 12+2 pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{pB[[1]],pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]})}]}]},{Dashing[.01],Line[{{0,p[[2]]},{p[[1]],p[[2]]}}],Line[{{p[[1]],0},{p[[1]],p[[2]]}}]},If[θ<π,{{Red,PointSize[.02],Point[p]}},{{PointSize[.02],Red,Point[p]}}],{Arrowheads[{{0.03,1}}],If[θ==3 π,Arrow[{{-1,0},{p[[1]]+pB[[1]]-1.8 12 +3,0}}],Arrow[{{-1,0},{.9 Max[scale,1.8 Max[p[[1]],p[[2]]]],0}}]],If[θ==3 π,Arrow[{{0,-1},{0,p[[2]]+pB[[2]]+2}}],Arrow[{{0,-1},{0,.9 Max[scale,1.8 Max[p[[1]],p[[2]]]]}}]]},If[θ≥π,{Text[Style["(Subscript[O, A])",Bold,11],{-1,-1}],Text[Style["(Overscript[(Subscript[X, 2]^A), ↑])",Bold,Italic,9],{-1,1.5}],Text[Style["(Subscript[X, 1]^A)→",Bold,Italic,9],{2.5,-.75}],Text[Style["(Subscript[ω, 1]^A)",Blue,Bold,10],{p[[1]],-.25},{0,1}],Text[Style["(Subscript[O, B])",Bold,11],{-1.8 12+2 pB[[1]]+.5,1+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["←(Subscript[X, 1]^B)",Bold,Italic,9],{-1.8 12+2 pB[[1]]-3.5,.7+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Overscript[↓, (Subscript[X, 2]^B)])",Bold,Italic,9],{-1.8 12+2 pB[[1]]+.3,-1.65+2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Subscript[ω, 2]^B)",Blue,Bold,10],{-1.8 12+2 pB[[1]]+.5,pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{-1,0}],Text[Style["(Subscript[ω, 1]^B)",Blue,Bold,10],{pB[[1]],2pB[[2]]}+moveIt[θ]({p[[1]],p[[2]]}-{pB[[1]],pB[[2]]}),{0,-1}]},{Text[Style["(Subscript[O, A])",Bold,11],{-1,-1}],Text[Style["(Subscript[X, 1]^A)→",Bold,Italic,9],{2.5,-.75}],Text[Style["(Overscript[(Subscript[X, 2]^A), ↑])",Bold,Italic,9],{-1,1.5}]}],Text[Style["(Subscript[ω, 1]^A)",Blue,Bold,10],{p[[1]],-.25},{0,1}],Text[Style["(Subscript[ω, 2]^A)",Blue,Bold,10],{-.5,p[[2]]},{1,0}]}],If[θ==3π,(* Turning on and off the indifference curves throught the endowment *)
{Which[z5==1,{Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],
Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]]
},z5==2,Which[z2A==1,hh1[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==2,hh2[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],z2A==3,hh3[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]],True,hh4[uA[[2]],uA[[1]],abA[[1]],abA[[2]],cA,γA,p[[1]],p[[2]],scale,pB[[1]]]],z5==3,Which[z2B==1,hh1B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==2,hh2B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],z2B==3,hh3B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]],True,hh4B[uB[[2]],uB[[1]],abB[[1]],abB[[2]],cB,γB,p[[1]],p[[2]],scale,pB[[1]],pB[[2]],pC[[1]],pC[[2]]]],True,Graphics[{{PointSize[.004],Point[{1,1}]}}] ],Plot[Take[{-x-5,p[[2]]-(p[[2]]-u[[2]])/(p[[1]]-u[[1]])p[[1]]+(p[[2]]-u[[2]])/(p[[1]]-u[[1]]) x,p[[2]]-(p[[2]]-u2[[2]])/(p[[1]]-u2[[1]])p[[1]]+(p[[2]]-u2[[2]])/(p[[1]]-u2[[1]]) x,p[[2]]-(p[[2]]-u3[[2]])/(p[[1]]-u3[[1]])p[[1]]+(p[[2]]-u3[[2]])/(p[[1]]-u3[[1]]) x},z3],{x,0,70},PlotStyle->Directive[Opacity[op]]],Graphics[{Take[{PointSize[.017],Point[u],Point[u2],Point[u3]},z3]}]},Graphics[{{PointSize[.004],Point[{1,1}]}}]],
If[θ==3π&&pareto==True,
ContourPlot[{Which[z2A==1,((x^(-1+uA[[1]])) uA[[2]] ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[1]] γA)/((y^(-1+uA[[1]])) (1-uA[[2]]) ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[2]] cA/50 (y^(-1+cA/50)) γA),z2A==2,((x^(-1+uA[[1]])) uA[[2]] ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[1]] γA)/((y^(-1+uA[[1]])) (1-uA[[2]]) ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+((abA[[2]] (E^(-(y/cA))) γA)/cA)),z2A==3,((x^(-1+uA[[1]])) uA[[2]] ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[2]] cA/50 (x^(-1+cA/50)) γA)/((y^(-1+uA[[1]])) (1-uA[[2]]) ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[1]] γA),True,((x^(-1+uA[[1]])) uA[[2]] ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+((abA[[2]] (E^(-(x/cA))) γA)/cA))/((y^(-1+uA[[1]])) (1-uA[[2]]) ((((y^(uA[[1]])) (1-uA[[2]])+(x^(uA[[1]])) uA[[2]]))^(-1+(1/(uA[[1]])))) (1-γA)+abA[[1]] γA)]==Which[z2B==1,((((p[[1]]+pB[[1]]-1.8 12-x))^(-1+uB[[1]])) uB[[2]] ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[1]] γB)/((((p[[2]]+pB[[2]]-y))^(-1+uB[[1]])) (1-uB[[2]]) ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[2]] cB/50 (((p[[2]]+pB[[2]]-y))^(-1+cB/50)) γB),z2B==2,((((p[[1]]+pB[[1]]-1.8 12-x))^(-1+uB[[1]])) uB[[2]] ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[1]] γB)/((((p[[2]]+pB[[2]]-y))^(-1+uB[[1]])) (1-uB[[2]]) ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+((abB[[2]] (E^(-(((p[[2]]+pB[[2]]-y))/cB))) γB)/cB)),z2B==3,
((((p[[1]]+pB[[1]]-1.8 12-x))^(-1+uB[[1]])) uB[[2]] ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[2]] cB/50 (((p[[1]]+pB[[1]]-1.8 12-x))^(-1+cB/50)) γB)/((((p[[2]]+pB[[2]]-y))^(-1+uB[[1]])) (1-uB[[2]]) ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[1]] γB),True,((((p[[1]]+pB[[1]]-1.8 12-x))^(-1+uB[[1]])) uB[[2]] ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+((abB[[2]] (E^(-(((p[[1]]+pB[[1]]-1.8 12-x))/cB))) γB)/cB))/((((p[[2]]+pB[[2]]-y))^(-1+uB[[1]])) (1-uB[[2]]) ((((((p[[2]]+pB[[2]]-y))^(uB[[1]])) (1-uB[[2]])+(((p[[1]]+pB[[1]]-1.8 12-x))^(uB[[1]])) uB[[2]]))^(-1+(1/(uB[[1]])))) (1-γB)+abB[[1]] γB)]},{x,.05,p[[1]]+pB[[1]]-1.8 12},{y,.1,p[[2]]+pB[[2]]},PlotRange->{{-5, Max[scale,1.8 pB[[1]]]},{-5, .5scale}},Axes->False,AspectRatio->1,PlotPoints->ControlActive[5,50],Exclusions->{rho[uB[[1]]]==1,rho[uA[[1]]]==1},PerformanceGoal->"Quality"]
,Graphics[{PointSize[.005],Point[{1,1}]}]]],r]];



DynamicModule[{γA=.1,γB=.2,p={4,6},pB={1.8 12+6,9},pC={4+6,9+6},uA={.05,.4},uB={.15,.6},cA=.25,cB=.5,abA={1,10},abB={1,10},u={2,2},u2={3,2},u3={5,2},z2=2,z3=1},Manipulate[If[θ==3π,gr[p,{pC[[1]]+12 1.8-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,γA,cA,abA[[1]],abA[[2]],γB,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,z3,z4,z5,u,u2,u3,op],gr[p,{pC[[1]]+12 1.8-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,γA,cA,abA[[1]],abA[[2]],γB,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,z3,z4,z5,u,u2,u3,op]],Row[{Control[{{θ,3π,"θ"},0, 3π,ImageSize -> Tiny,Appearance->"Small"}],Style[" Endowment Indifference Curves",Bold,9],Checkbox[Dynamic[z5],{1,2,3,4}]}],Row[{Dynamic[ButtonBar[{Style[ "Contract curve",Bold,9,Background->If[pareto==True,Yellow,LightYellow]]:>(pareto=If[pareto==True,False,True];),Style[ "Bargaining Space",Bold,9,Background->If[z==True,Yellow,LightYellow]]:>(z=If[z==True,False,True];)}]],PopupMenu[Dynamic[z3],{1->Style["No Budget Lines",Bold],2->Style["One Budget Line",Bold],3->Style["Two Budget Lines",Bold],4->Style["Three Budget Lines",Bold]},FrameMargins->-2.5]}],Row[{Style["op",Bold,9],Checkbox[Dynamic[op],{1,.2}],Style["Indifference Curves",Bold,9],Checkbox[Dynamic[z4],{1,2,3,4}],Dynamic[ButtonBar[{Style["Price-offer: A",Bold,9,Background->If[zOfferA==True,Yellow,LightYellow]]:>(zOfferA=If[zOfferA==True,False,True];),Style["Price-offer: B",Bold,9,Background->If[zOfferB==True,Yellow,LightYellow]]:>(zOfferB=If[zOfferB==True,False,True];)},Appearance->"Row"]]}],
Row[{Control[{{scale,20,"scale"},6,40,ImageSize -> Tiny,Appearance->"Small"}],Control[{{r,1,"Magnification"},.2,2,ImageSize -> Tiny,Appearance->"Small"}]}],Delimiter,{{pB,{1.8 12+40,0}},{1.8 12+0,0},{1.8 18+18,28},Locator,Appearance->None},{{p,{5,20}},{0,0},{50,55},Locator,Appearance->None},{{pC,{30,25}},{4,4},{60,60},Locator,Appearance->Graphics[{Text[If[θ≥.5π,"⊕","⊕"]]}]},Delimiter,{{u,{2,2}},{0,0},{40,50},Locator,Appearance->None},{{u2,{3,2}},{0,0},{40,50},Locator,Appearance->None},{{u3,{5,2}},{0,0},{40,50},Locator,Appearance->None},OpenerView[{"Mr. A Utility Function Parameters",Column[{Row[{Grid[{{Panel[Grid[{{"γ",Manipulator[Dynamic[γA],{0,1,.1},ImageSize -> Small,AppearanceElements->All]}}],"weight on parallel preferences"],Grid[{{Style["Parallel Preferences",Bold,12]}}]}}]}],Row[{Grid[{{Invisible[Slider[ImageSize -> Tiny,Appearance->"None"]]},{Control[{{uA,{.05,.4},"Mr. A"},{-150,.1},{.99,.95},Exclusions->{uA=={0.,__}}}]}}],Grid[{{Control[{{cA,10,"c"},.05,50,5,ImageSize -> Tiny,Appearance->"Small"}]},{Control[{{abA,{1,100},"  "},{.02,1},{20,150}}]}}],PopupMenu[Dynamic[z2A],{1->Grid[{{Style["Horizontal",Blue,Bold,14]},{"u(x,y) = a x + b (y^c)"}}],2->Grid[{{Style["Horizontal",Blue,Bold,14]},{"u(x,y) = a x + b (1- \!\(TraditionalForm\`\*SuperscriptBox[\(e\), \(-\*FractionBox[\(\(\\ \)\(y\)\), \(c\)]\)]\))"}}],3->Grid[{{Style["Vertical",Blue,Bold,14]},{"u(x,y) = a y + b (x^c)"}}],4->Grid[{{Style["Vertical",Blue,Bold,14]},{"u(x,y) = a y + b (1- (e^(-(x/c))))"}}]},Style["Parallel Preferences",Bold,12],Appearance->Medium,AutoAction->True]}]},Right]}],OpenerView[{"Ms. B Utility Function Parameters",Column[{Row[{Grid[{{Panel[Grid[{{"γ",Manipulator[Dynamic[γB],{0,1,.2},ImageSize -> Small,AppearanceElements->All]}}],"weight on parallel preferences"],Grid[{{Style["Parallel Preferences",Bold,12]}}]}}]}],Row[{Grid[{{Invisible[Slider[ImageSize -> Tiny,Appearance->"None"]]},{Control[{{uB,{.05,.4},"Ms. B"},{-150,.1},{.99,.95},Exclusions->{uB=={0.,__}}}]}}],Grid[{{Control[{{cB,10,"c"},.05,50,5,ImageSize -> Tiny,Appearance->"Small"}]},{Control[{{abB,{1,110},"  "},{.02,1},{20,150}}]}}],PopupMenu[Dynamic[z2B],{1->Grid[{{Style["Horizontal",Blue,Bold,14]},{"u(x,y) = a x + b (y^c)"}}],2->Grid[{{Style["Horizontal",Blue,Bold,14]},{"u(x,y) = a x + b (1- (e^(-(y/c))))"}}],3->Grid[{{Style["Vertical",Blue,Bold,14]},{"u(x,y) = a y + b (x^c)"}}],4->Grid[{{Style["Vertical",Blue,Bold,14]},{"u(x,y) = a y + b (1- (e^(-(x/c))))"}}]},Style["Parallel Preferences",Bold,12],Appearance->Medium,AutoAction->True]}]},Right]}],ControlPlacement->Left,SaveDefinitions->True,SynchronousUpdating->False]]

A near contiuum of equilibria plus two more discrete equilibria

(*DynamicModule[{abA={2.06`,150.`},abB={1.12`,126.4`},cA=1.52`,cB=2.1`,pB={61.6`,0},pC={45.7`,34.6`},p={0.5`,34.300000000000004`},r=1,scale=26.5`,u2={5.5`,22.900000000000002`},u3={31.75`,30.5`},uA={-112.4`,0.818`},uB={-48.`,0.47`},u={4.7`,20.5`},θ=3 π},If[θ==3 π,gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,FE`γA$$59,cA,abA[[1]],abA[[2]],FE`γB$$59,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,FE`z3$$59,z4,z5,u,u2,u3,op],gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,FE`γA$$59,cA,abA[[1]],abA[[2]],FE`γB$$59,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,FE`z3$$59,z4,z5,u,u2,u3,op]]]*)

Five equilibria

(*DynamicModule[{abA={1.19`,149.1`},abB={1.02`,141.70000000000002`},cA=3.2`,cB=5.05`,pB={61.6`,0},pC={50.35`,48.7`},p={50.`,0.5`},r=1,scale=40.`,u2={3,2},u3={5,2},uA={-100.05`,0.6849999999999999`},uB={0.99`,0.74`},u={2,2},θ=9.42477796076938`},If[θ==3 π,gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,FE`γA$$59,cA,abA[[1]],abA[[2]],FE`γB$$59,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,FE`z3$$59,z4,z5,u,u2,u3,op],gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,FE`γA$$59,cA,abA[[1]],abA[[2]],FE`γB$$59,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,FE`z3$$59,z4,z5,u,u2,u3,op]]]*)

Vertical and horizontal regions of the set of Pareto optimal allocations

(*
DynamicModule[{abA={9.6`,113.`},abB={17.200000000000003`,77.`},cA=0.3`,cB=10.05`,pB={61.6`,0},pC={36.65`,25.3`},p={26.150000000000002`,5.2`},r=1,scale=24.3`,u2={3,2},u3={5,2},uA={-128.5`,0.88`},uB={-65.5`,0.5`},u={2,2},θ=3 π},If[θ==3 π,gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,γA,cA,abA[[1]],abA[[2]],γB,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,z3,z4,z5,u,u2,u3,op],gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,γA,cA,abA[[1]],abA[[2]],γB,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,z3,z4,z5,u,u2,u3,op]]]
*)

Off[Power::infy]
Off[Infinity::indet]

Three distinct regions in which Coase-like results would hold

(*
DynamicModule[{abA={16.3`,22.`},abB={8.8`,84.`},cA=5.05`,cB=5.05`,pB={61.6`,0},pC={60.`,28.200000000000003`},p={17.`,21.1`},r=1,scale=31.400000000000002`,u2={3,2},u3={5,2},uA={-77.`,0.67`},uB={-77.5`,0.74`},u={2,2},θ=3 π},If[θ==3 π,gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,γA,cA,abA[[1]],abA[[2]],γB,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,z3,z4,z5,u,u2,u3,op],gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,γA,cA,abA[[1]],abA[[2]],γB,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,z3,z4,z5,u,u2,u3,op]]]
*)

Seven equilibria

It is difficult to do, but if you thread the needle it is possible to generate examples with as many as seven Walrasian equilibria.

Another example with seven equilibria

(*DynamicModule[{abA={1.03`,147.70000000000002`},abB={1.05`,150.`},cA=3.2`,cB=3.1`,pB={61.6`,0},pC={57.35`,50.6`},p={0,50.5`},r=1,scale=40.`,u2={3,2},u3={5,2},uA={-149.5`,0.42000000000000004`},uB={-12.75`,0.95`},u={2,2},θ=3 π},If[θ==3 π,gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,FE`γA$$64,cA,abA[[1]],abA[[2]],FE`γB$$64,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,FE`z3$$64,z4,z5,u,u2,u3,op],gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,FE`γA$$64,cA,abA[[1]],abA[[2]],FE`γB$$64,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,FE`z3$$64,z4,z5,u,u2,u3,op]]]*)

(*DynamicModule[{abA={1.03`,147.70000000000002`},abB={1.05`,150.`},cA=3.2`,cB=3.1`,pB={61.6`,0},pC={57.35`,50.6`},p={0,50.5`},r=1,scale=40.`,u2={3,2},u3={5,2},uA={-149.5`,0.42000000000000004`},uB={-12.75`,0.95`},u={2,2},θ=3 π},If[θ==3 π,gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,FE`γA$$64,cA,abA[[1]],abA[[2]],FE`γB$$64,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,FE`z3$$64,z4,z5,u,u2,u3,op],gr[p,{pC[[1]]+12 1.8`-p[[1]],pC[[2]]-p[[2]]},uA,uB,scale,20,θ,r,pareto,pC,ce,z,px,zpx,FE`γA$$64,cA,abA[[1]],abA[[2]],FE`γB$$64,cB,abB[[1]],abB[[2]],z2A,zOfferA,z2B,zOfferB,FE`z3$$64,z4,z5,u,u2,u3,op]]]*)

Thanks!