(*^
::[ 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;Clear[f1];Clear[f2];
$DefaultFont = {"Times-Roman",10};
Needs["Statistics`DataManipulation`"];
Needs["Graphics`Graphics`"];
cumulative = {312/545,413/545,487/545,522/545,537/545,1};
datapoints = {{0,0},{1,312/545},{2,413/545},
{3,487/545},{4,522/545},{5,537/545},{6,1}};
density = {312/545,101/545,74/545,35/545,15/545,8/545};
bound[z_,a_,b_]:= Which[zb,b,a<=z<=b,z];
F1[A_,c_,x_] = 4 A c x/(1 + A c^2) - A x^2;
F2[A_,c_,x_] = 1 - ((1 - A c^2)^2 (c/x)^(2A c^2/(1 - A c^2)))/(1 + A c^2);
f1[A_,c_,x_] = 2 A(c-x) + 2 A c(1 - A c^2)/(1 + A c^2);
f2[A_,c_,x_] = (2A c(1 - A c^2) (c/x)^((1 + A c^2)/(1 - A c^2)))/(1 + A c^2);
FF[a_,c_,x_] = Which[x<=1.5,F1[a,c,x],x>1.5,F2[a,c,x]];
error[a_,c_] = Evaluate[Apply[Plus,Table[(FF[a,c,n]-cumulative[[n]])^2,{n,1,6}]]];
unconstrainedminimizer[a_]:= c/.FindMinimum[error[a,c],{c,1.85,1.86,0,2}][[2]];
constrainedminimizer[a_]:= bound[unconstrainedminimizer[a],1.7,2];
Sstar[a_]:= error[a,constrainedminimizer[a]];
plot = Plot[Sstar[a],{a,0.12,0.15},PlotPoints->100];
ahat = a/.FindMinimum[Sstar[a],{a,0.13,0.131,0.12,0.15}][[2]]
Sstar[ahat]
Show[plot,PlotRange->{{0.12,0.15},{0.00655,0.00704}},
AxesOrigin->{0.119,0.00653},AxesLabel->{"A","z"},
PlotLabel->"Figure 24.8\n z = S*(A)"]
^*)