(*^
::[ Information =
"This is a Mathematica Notebook file. It contains ASCII text, and can be
transferred by email, ftp, or other text-file transfer utility. It should
be read or edited using a copy of Mathematica or MathReader. If you
received this as email, use your mail application or copy/paste to save
everything from the line containing (*^ down to the line containing ^*)
into a plain text file. On some systems you may have to give the file a
name ending with ".ma" to allow Mathematica to recognize it as a Notebook.
The line below identifies what version of Mathematica created this file,
but it can be opened using any other version as well.";
FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2";
MacintoshStandardFontEncoding;
fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8, 24, "Times";
fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times";
fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6, 14, "Times";
fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 18, "Times";
fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 14, "Times";
fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 12, "Times";
fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-5, 12, "Courier";
fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier";
fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5, 12, "Courier";
fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier";
fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5, 12, "Courier";
fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier";
fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 10, "Geneva";
fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = leftheader, inactive, L2, 12, "Times";
fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 12, "Times";
fontset = leftfooter, inactive, L2, 12, "Times";
fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
paletteColors = 128; automaticGrouping; currentKernel;
]
:[font = input; preserveAspect]
ClearAll;
$DefaultFont = {"Times-Roman",10};
Needs["Graphics`Graphics`"];
njags = 100;
a = 1; b = 4; M = (a+b)/2; mu = (a+b)/2; Mpl = 3.2; Mm = 1.8;
coeff = 2;
scale = NIntegrate[Exp[-coeff(x-mu)^2],{x,a,b}];
lp1 = Graphics[{Dashing[0.001,0.01],Line[{{Mpl,0},{Mpl,f1[Mpl]}}]}];
lm1 = Graphics[{Dashing[0.001,0.01],Line[{{Mm,0},{Mm,f1[Mm]}}]}];
poly[a_,b_,f_]:= Join[Table[{a+i(b-a)/njags,f[a+i(b-a)/njags]},
{i,0,njags}],{{b,0},{a,0}}];
shade[a_,b_,c_,f_]:= Graphics[{GrayLevel[c],Polygon[poly[a,b,f]]}];
f1[x_]:= 1/(b-a);
f2[x_]:= 2/(b-a) - Abs[4x - 2(a+b)]/((b-a)^2);
f3[x_]:= Exp[-coeff(x-mu)^2]/scale;
lp1 = Graphics[{Dashing[{0.001,0.01}],Line[{{Mpl,0},{Mpl,f1[Mpl]}}]}];
lm1 = Graphics[{Dashing[{0.001,0.01}],Line[{{Mm,0},{Mm,f1[Mm]}}]}];
lp2 = Graphics[{Dashing[{0.001,0.01}],Line[{{Mpl,0},{Mpl,f2[Mpl]}}]}];
lm2 = Graphics[{Dashing[{0.001,0.01}],Line[{{Mm,0},{Mm,f2[Mm]}}]}];
lp3 = Graphics[{Dashing[{0.001,0.01}],Line[{{Mpl,0},{Mpl,f3[Mpl]}}]}];
lm3 = Graphics[{Dashing[{0.001,0.01}],Line[{{Mm,0},{Mm,f3[Mm]}}]}];
shading1 = Show[shade[a,mu,0.65,f1],shade[mu,b,0.35,f1],Axes->True,
Ticks->{{{a,"a"},{Mm,"M-t"},{M,"M"},{Mpl,"M+t"},
{b,"b"}},{0}}, PlotRange->{{0,5},Automatic},
PlotLabel->"Uniform distribution",
AxesLabel->{"x","f"}];
plot1 = Plot[f1[x],{x,a,b}];
shading2 = Show[shade[a,mu,0.65,f2],shade[mu,b,0.35,f2],Axes->True,
Ticks->{{{a,"a"},{Mm,"M-t"},{M,"M"},{Mpl,"M+t"},
{b,"b"}},{0}}, PlotRange->{{0,5},Automatic},
PlotLabel->"Triangular distribution",
AxesLabel->{"x","f"}];
plot2 = Plot[f2[x],{x,a,b}];
shading3 = Show[shade[a,mu,0.65,f3],shade[mu,b,0.35,f3],Axes->True,
Ticks->{{{a,"a"},{Mm,"M-t"},{M,"M"},{Mpl,"M+t"},
{b,"b"}},{0}}, PlotRange->{{0,5},Automatic},
PlotLabel->"Bell-shaped distribution",
AxesLabel->{"x","f"}];
plot3:= Plot[f3[x],{x,a,b}];
panel1 = Show[shading1,plot1,lp1,lm1];
panel2 = Show[shading2,plot2,lp2,lm2];
panel3 = Show[shading3,plot3,lp3,lm3];
Show[GraphicsArray[{{panel1},{panel2},{panel3}}],
PlotLabel->" Figure 28.1\n
Symmetric distributions with decreasing variance"]
^*)