This Mathematica notebook reproduces the figures include in the Handbook of Social Economics chapter "Econometric methods for the analysis of assignment problems in the presence of complementarity and social spillovers" by Bryan Graham.

<<ComputationalGeometry`
<<Graphics`FilledPlot`

mH[s_,αH_,βH_,γH_]:=αH+βH*s-((γH)/2)*(s^2);
mL[s_,αL_,βL_,γL_]:=αL+βL*s-((γL)/2)*(s^2);
m[s_,αL_,βL_,γL_,αH_,βH_,γH_]:=s*mH[s,αH,βH,γH]+(1-s)*mL[s,αL,βL,γL];
MMB[s_,βL_,γL_,βH_,γH_]:=(βH-βL)-(γH-γL)*s;
MSB[s_,βL_,γL_,βH_,γH_]:=(βH-βL)-(γH-γL)*s-(s*γH+(1-s)*γL);

Example 1: Efficient segregation

αH=0.05;
βH=1;
γH=1/4;

αL=0;
βL=1/2;
γL=1/4;

pH=0.5

mHmLPlotEx1=Plot[{mH[s,αH,βH,γH],mL[s,αL,βL,γL]},{s,0,1},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{GrayLevel[0.5],Thickness[0.005]}},Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["(Subscript[m, H])(s)  &  (Subscript[m, L])(s)",FontSize->12],StyleForm["Panel A.1",FontSize->12],""}]

mlist=Table[{s,m[s,αL,βL,γL,αH,βH,γH]},{s,0,1,0.01}];
t=Table[{s,m[0,αL,βL,γL,αH,βH,γH]},{s,0,1,0.01}];
u=Table[{1,m[0,αL,βL,γL,αH,βH,γH]+(m[s,αL,βL,γL,αH,βH,γH]-m[0,αL,βL,γL,αH,βH,γH])*s},{s,0,1,0.01}];
v=Drop[Sort[ConvexHull[Join[mlist,t,u]]],-199];
ConvHullm=mlist[[v]];

sL=mlist[[v[[1]]]]
sR=mlist[[v[[2]]]]

FilledListPlot[mlist,ConvHullm,t,Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["m(s)",FontSize->12],StyleForm["Panel C.1",FontSize->12],""},PlotJoined -> {True,True},PlotRange->{{0,1},{0,1}},SymbolShape->{None,None},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{Dashing[{0.0125,0.0125}],GrayLevel[0],Thickness[0.005]},{GrayLevel[1],Thickness[0.001]}},Fills->{{{1,3},GrayLevel[0.75]},{{1,2},GrayLevel[0.5]}}]

SocPlanPlotEx1=Show[%,Graphics[{{Thickness[0.005],GrayLevel[0],Dashing[{0.01,0.01}],Line[{{pH,0},{pH,1}}]},
		Text[StyleForm["A",FontSize->14],{pH+0.01,0.55},{-1,0}],Text[StyleForm["B",FontSize->14],sL+{0.01,0.06},{-1,0}],Text[StyleForm["C",FontSize->14],sR-{0.015,-0.015},{1,0}],Arrow[{{0.40,0.55},{0.46,0.44}}],	Text[StyleForm["M(s)",FontSize->14],{0.32,0.56},{-1,0}],Arrow[{{0.70,0.35},{0.61,0.455}}],	Text[StyleForm["m(s)",FontSize->14],{0.71,0.33},{-1,0}]}]]

MSPlotEx1=Plot[{MMB[s,βL,γL,βH,γH],MSB[s,βL,γL,βH,γH]},{s,0,1},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{GrayLevel[0.5],Thickness[0.005],Dashing[{0.01,0.01}]},{GrayLevel[0],Thickness[0.005],Dashing[{0.01,0.01}]}},Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["η(s) & η(s)+λ(s)",FontSize->12],StyleForm["Panel B.1",FontSize->12],""},PlotRange->{{0,1},{0,0.6}}]

Example 2: Inefficient segregation

αH=0.05;
βH=3/4;
γH=2/3;

αL=0;
βL=2/3;
γL=2/3;

pH=0.5

mHmLPlotEx2=Plot[{mH[s,αH,βH,γH],mL[s,αL,βL,γL]},{s,0,1},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{GrayLevel[0.5],Thickness[0.005]}},Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["(Subscript[m, H])(s)  &  (Subscript[m, L])(s)",FontSize->12],StyleForm["Panel A.2",FontSize->12],""}]

mlist=Table[{s,m[s,αL,βL,γL,αH,βH,γH]},{s,0,1,0.01}];
t=Table[{s,m[0,αL,βL,γL,αH,βH,γH]},{s,0,1,0.01}];
u=Table[{1,m[0,αL,βL,γL,αH,βH,γH]+(m[s,αL,βL,γL,αH,βH,γH]-m[0,αL,βL,γL,αH,βH,γH])*s},{s,0,1,0.01}];
v=Drop[Sort[ConvexHull[Join[mlist,t,u]]],-199];
ConvHullm=mlist[[v]];

sL=mlist[[v[[1]]]]
sR=mlist[[v[[2]]]]

FilledListPlot[mlist,ConvHullm,t,Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["m(s)",FontSize->12],StyleForm["Panel C.2",FontSize->12],""},PlotJoined -> {True,True},PlotRange->{{0,1},{0,0.5}},SymbolShape->{None,None},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{Dashing[{0.0125,0.0125}],GrayLevel[0],Thickness[0.005]},{GrayLevel[1],Thickness[0.001]}},Fills->{{{1,3},GrayLevel[0.75]},{{1,2},GrayLevel[0.5]}}]

SocPlanPlotEx2=Show[%,Graphics[{{Thickness[0.005],GrayLevel[0],Dashing[{0.01,0.01}],Line[{{pH,0},{pH,1}}]},
		Text[StyleForm["A",FontSize->14],{pH-0.035,0.31},{-1,0}],Text[StyleForm["B",FontSize->14],{0.01,0.04},{-1,0}],Text[StyleForm["C",FontSize->14],{0.99,0.43},{1,0}],Arrow[{{0.69,0.25},{0.6,0.33}}],	Text[StyleForm["m(s) = M(s)",FontSize->14],{0.7,0.25},{-1,0}]}]]

MSPlotEx2=Plot[{MMB[s,βL,γL,βH,γH],MSB[s,βL,γL,βH,γH]},{s,0,1},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{GrayLevel[0.5],Thickness[0.005],Dashing[{0.01,0.01}]},{GrayLevel[0],Thickness[0.005],Dashing[{0.01,0.01}]}},Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["η(s) & η(s)+λ(s)",FontSize->12],StyleForm["Panel B.2",FontSize->12],""},PlotRange->{{0,1},{-0.75,0.25}}]

Export["c:\Documents and Settings\\bsg1\\My Documents\\BSG_WORK_19W4th\\Research\\HandbookOfSocialEcon_10Spring\Figure_SocPlan1.eps",GraphicsGrid[{{mHmLPlotEx1,mHmLPlotEx2}, 
 {MSPlotEx1,MSPlotEx2},{SocPlanPlotEx1,SocPlanPlotEx2}},Frame->All,ImageSize->1000]]

Example 3: Complicated Example # 1

αH=0.25;
βH=1;
γH=3/4;

αL=0;
βL=1/8;
γL=-3/4;

pH=0.3

mHmLPlotEx3=Plot[{mH[s,αH,βH,γH],mL[s,αL,βL,γL]},{s,0,1},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{GrayLevel[0.5],Thickness[0.005]}},Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["(Subscript[m, H])(s)  &  (Subscript[m, L])(s)",FontSize->12],StyleForm["Panel A.1",FontSize->12],""}]

mlist=Table[{s,m[s,αL,βL,γL,αH,βH,γH]},{s,0,1,0.01}];
t=Table[{s,m[0,αL,βL,γL,αH,βH,γH]},{s,0,1,0.01}];
u=Table[{1,m[0,αL,βL,γL,αH,βH,γH]+(m[s,αL,βL,γL,αH,βH,γH]-m[0,αL,βL,γL,αH,βH,γH])*s},{s,0,1,0.01}];
v=Drop[Sort[ConvexHull[Join[mlist,t,u]]],-199];
ConvHullm=mlist[[v]];

sL=mlist[[v[[1]]]]
sR=mlist[[v[[2]]]]

FilledListPlot[mlist,ConvHullm,t,Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["m(s)",FontSize->12],StyleForm["Panel C.1",FontSize->12],""},PlotJoined -> {True,True},PlotRange->{{0,1},{0,1}},SymbolShape->{None,None},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{Dashing[{0.0125,0.0125}],GrayLevel[0],Thickness[0.005]},{GrayLevel[1],Thickness[0.001]}},Fills->{{{1,3},GrayLevel[0.75]},{{1,2},GrayLevel[0.5]}}]

SocPlanPlotEx3=Show[%,Graphics[{{Thickness[0.005],GrayLevel[0],Dashing[{0.01,0.01}],Line[{{pH,0},{pH,1}}]},{Thickness[0.005],GrayLevel[0],Dashing[{0.01,0.01}],Line[{{pH+0.6,0},{pH+0.6,1}}]},
		Text[StyleForm["A",FontSize->14],{pH+0.01,0.33},{-1,0}],Text[StyleForm["B",FontSize->14],sL+{0.01,0.06},{-1,0}],Text[StyleForm["C",FontSize->14],sR-{0.015,-0.015},{1,0}],Text[StyleForm["D",FontSize->14],{pH+0.59,0.83},{1,0}],Arrow[{{0.40,0.55},{0.46,0.44}}],	Text[StyleForm["M(s)",FontSize->14],{0.32,0.56},{-1,0}],Arrow[{{0.70,0.35},{0.61,0.5}}],	Text[StyleForm["m(s)",FontSize->14],{0.71,0.33},{-1,0}]}]]

MSPlotEx3=Plot[{MMB[s,βL,γL,βH,γH],MSB[s,βL,γL,βH,γH]},{s,0,1},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{GrayLevel[0.5],Thickness[0.005],Dashing[{0.01,0.01}]},{GrayLevel[0],Thickness[0.005],Dashing[{0.01,0.01}]}},Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["η(s) & η(s)+λ(s)",FontSize->12],StyleForm["Panel B.1",FontSize->12],""},PlotRange->{{0,1},{-1.5,1.5}}]

Example 4: Complicated Example # 2

αH=0.25;
βH=1/8;
γH=-3/4;

αL=0;
βL=1;
γL=1;

pH=0.8

mHmLPlotEx4=Plot[{mH[s,αH,βH,γH],mL[s,αL,βL,γL]},{s,0,1},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{GrayLevel[0.5],Thickness[0.005]}},Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["(Subscript[m, H])(s)  &  (Subscript[m, L])(s)",FontSize->12],StyleForm["Panel A.2",FontSize->12],""}]

mlist=Table[{s,m[s,αL,βL,γL,αH,βH,γH]},{s,0,1,0.01}];
t=Table[{s,m[0,αL,βL,γL,αH,βH,γH]},{s,0,1,0.01}];
u=Table[{1,m[0,αL,βL,γL,αH,βH,γH]+(m[s,αL,βL,γL,αH,βH,γH]-m[0,αL,βL,γL,αH,βH,γH])*s},{s,0,1,0.01}];
v=Drop[Sort[ConvexHull[Join[mlist,t,u]]],-199];
ConvHullm=mlist[[v]]

sL=mlist[[v[[30]]]]
sR=mlist[[v[[31]]]]

FilledListPlot[mlist,ConvHullm,t,Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["m(s)",FontSize->12],StyleForm["Panel C.2",FontSize->12],""},PlotJoined -> {True,True},PlotRange->{{0,1},{0,1}},SymbolShape->{None,None},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{Dashing[{0.0125,0.0125}],GrayLevel[0],Thickness[0.005]},{GrayLevel[1],Thickness[0.001]}},Fills->{{{1,3},GrayLevel[0.75]},{{1,2},GrayLevel[0.5]}}]

SocPlanPlotEx4=Show[%,Graphics[{{Thickness[0.005],GrayLevel[0],Dashing[{0.01,0.01}],Line[{{pH,0},{pH,1}}]},{Thickness[0.005],GrayLevel[0],Dashing[{0.01,0.01}],Line[{{pH+0.6,0},{pH+0.6,1}}]},{Thickness[0.005],GrayLevel[0],Dashing[{0.01,0.01}],Line[{{pH-0.6,0},{pH-0.6,1}}]},
		Text[StyleForm["A",FontSize->14],{pH+0.01,0.67},{-1,0}],Text[StyleForm["B",FontSize->14],sL+{0.01,0.06},{-1,0}],Text[StyleForm["C",FontSize->14],sR-{0.015,-0.015},{1,0}],Text[StyleForm["D",FontSize->14],{pH-0.605,0.23},{1,0}],Arrow[{{0.45,0.55},{0.52,0.44}}],	Text[StyleForm["M(s)",FontSize->14],{0.37,0.56},{-1,0}],Arrow[{{0.70,0.35},{0.59,0.43}}],	Text[StyleForm["m(s)",FontSize->14],{0.71,0.33},{-1,0}]}]]

MSPlotEx4=Plot[{MMB[s,βL,γL,βH,γH],MSB[s,βL,γL,βH,γH]},{s,0,1},PlotStyle->{{GrayLevel[0],Thickness[0.005]},{GrayLevel[0.5],Thickness[0.005],Dashing[{0.01,0.01}]},{GrayLevel[0],Thickness[0.005],Dashing[{0.01,0.01}]}},Frame->True,FrameLabel->{StyleForm["s",FontSize->12],StyleForm["η(s) & η(s)+λ(s)",FontSize->12],StyleForm["Panel B.2",FontSize->12],""},PlotRange->{{0,1},{-1.5,1.5}}]

Export["c:\Documents and Settings\\bsg1\\My Documents\\BSG_WORK_19W4th\\Research\\HandbookOfSocialEcon_10Spring\Figure_SocPlan2.eps",GraphicsGrid[{{mHmLPlotEx3,mHmLPlotEx4}, 
 {MSPlotEx3,MSPlotEx4},{SocPlanPlotEx3,SocPlanPlotEx4}},Frame->All,ImageSize->1000]]