(*^ ::[ 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, M7, bold, L12, 24, "Helvetica"; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, M7, bold, L12, 18, "Helvetica"; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, M7, L12, 14, "Helvetica"; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M22, bold, L12, 14, "Helvetica"; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M19, bold, L12, 12, "Helvetica"; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L12, 12, "Helvetica"; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 9, "Times"; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, e12, 10, "Courier"; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, e12, 10, "Courier"; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, e12, 10, "Courier"; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, e12, 10, "Courier"; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, e12, 10, "Courier"; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l48, w216, h219, 12, "Courier"; fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 10, "Geneva"; fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = leftheader, inactive, 10, "Palatino"; fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 10, "Palatino"; fontset = leftfooter, inactive, 10, "Palatino"; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; automaticGrouping; currentKernel; ] :[font = title; inactive; preserveAspect; center; fontSize = 18; startGroup] Chapter Fifteen; Robust Regression: An Application of Mathematica to Data Analysis ;[s] 3:0,0;55,1;66,0;84,-1; 2:2,30,14,Helvetica,1,18,0,0,0;1,30,14,Helvetica,3,18,0,0,0; :[font = section; inactive; preserveAspect; startGroup] 15.1 Fit and Its Problems :[font = input; preserveAspect; startGroup] lindata = Table[{x, 2 + x + 0.1*Random[ ]}, {x, 0, 5, 0.5}] :[font = output; output; inactive; preserveAspect; endGroup] {{0, 2.070145717256340781}, {0.5, 2.575102553370156136}, {1., 3.030240841567014541}, {1.5, 3.595845172955410059}, {2., 4.087508285088622721}, {2.5, 4.514907404495718527}, {3., 5.043772660647845119}, {3.5, 5.594158435799352755}, {4., 6.022849836528044026}, {4.5, 6.552829288966077482}, {5., 7.06270062334384336}} ;[o] {{0, 2.07015}, {0.5, 2.5751}, {1., 3.03024}, {1.5, 3.59585}, {2., 4.08751}, {2.5, 4.51491}, {3., 5.04377}, {3.5, 5.59416}, {4., 6.02285}, {4.5, 6.55283}, {5., 7.0627}} :[font = input; preserveAspect; startGroup] quaddata = Table[{x, 2 + x + 0.2 x^2 + 0.1*Random[ ]}, {x, 0, 5, 0.5}] :[font = output; output; inactive; preserveAspect; endGroup] {{0, 2.027066708156245085}, {0.5, 2.591931027179452022}, {1., 3.217798297520418213}, {1.5, 4.048142775713608524}, {2., 4.836062108144543178}, {2.5, 5.783289409676834496}, {3., 6.861723564571088731}, {3.5, 7.989349310271972644}, {4., 9.278716294407758152}, {4.5, 10.55691753959720211}, {5., 12.04427046619852636}} ;[o] {{0, 2.02707}, {0.5, 2.59193}, {1., 3.2178}, {1.5, 4.04814}, {2., 4.83606}, {2.5, 5.78329}, {3., 6.86172}, {3.5, 7.98935}, {4., 9.27872}, {4.5, 10.5569}, {5., 12.0443}} :[font = input; preserveAspect; startGroup] linfit = Fit[lindata, {1, x}, x] :[font = output; output; inactive; preserveAspect; endGroup] 2.067987376412975295 + 0.9964436247082071732*x ;[o] 2.06799 + 0.996444 x :[font = input; preserveAspect; startGroup] quadfit = Fit[quaddata, {1, x, x^2}, x] :[font = output; output; inactive; preserveAspect; endGroup] 2.028958829345778978 + 1.018647600485258865*x + 0.1964042739250853191*x^2 ;[o] 2 2.02896 + 1.01865 x + 0.196404 x :[font = input; preserveAspect; startGroup] plotfit[fn_, data_] := Module[{minind, maxind, mindep, maxdep}, minind = Min[Transpose[data][[1]]]; maxind = Max[Transpose[data][[1]]]; mindep = Min[Transpose[data][[2]]]; maxdep = Max[Transpose[data][[2]]]; Plot[fn, {x, Floor[minind], Ceiling[maxind]}, AxesOrigin -> {0, 0}, PlotRange -> {Min[0, Floor[mindep]], Ceiling[maxdep] + 1}, Evaluate[Epilog -> {PointSize[0.03], Map[Point, data]}]]] plotfit[linfit, lindata]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 48; pictureWidth = 216; pictureHeight = 133; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.190476 0 0.0686704 [ [(0)] .02381 0 0 2 Msboxa [(1)] .21429 0 0 2 Msboxa [(2)] .40476 0 0 2 Msboxa [(3)] .59524 0 0 2 Msboxa [(4)] .78571 0 0 2 Msboxa [(5)] .97619 0 0 2 Msboxa [(2)] .01131 .13734 1 0 Msboxa [(4)] .01131 .27468 1 0 Msboxa [(6)] .01131 .41202 1 0 Msboxa [(8)] .01131 .54936 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .02381 0 m .02381 .00625 L s P [(0)] .02381 0 0 2 Mshowa p .002 w .21429 0 m .21429 .00625 L s P [(1)] .21429 0 0 2 Mshowa p .002 w .40476 0 m .40476 .00625 L s P [(2)] .40476 0 0 2 Mshowa p .002 w .59524 0 m .59524 .00625 L s P [(3)] .59524 0 0 2 Mshowa p .002 w .78571 0 m .78571 .00625 L s P [(4)] .78571 0 0 2 Mshowa p .002 w .97619 0 m .97619 .00625 L s P [(5)] .97619 0 0 2 Mshowa p .001 w .0619 0 m .0619 .00375 L s P p .001 w .1 0 m .1 .00375 L s P p .001 w .1381 0 m .1381 .00375 L s P p .001 w .17619 0 m .17619 .00375 L s P p .001 w .25238 0 m .25238 .00375 L s P p .001 w .29048 0 m .29048 .00375 L s P p .001 w .32857 0 m .32857 .00375 L s P p .001 w .36667 0 m .36667 .00375 L s P p .001 w .44286 0 m .44286 .00375 L s P p .001 w .48095 0 m .48095 .00375 L s P p .001 w .51905 0 m .51905 .00375 L s P p .001 w .55714 0 m .55714 .00375 L s P p .001 w .63333 0 m .63333 .00375 L s P p .001 w .67143 0 m .67143 .00375 L s P p .001 w .70952 0 m .70952 .00375 L s P p .001 w .74762 0 m .74762 .00375 L s P p .001 w .82381 0 m .82381 .00375 L s P p .001 w .8619 0 m .8619 .00375 L s P p .001 w .9 0 m .9 .00375 L s P p .001 w .9381 0 m .9381 .00375 L s P p .002 w 0 0 m 1 0 L s P p .002 w .02381 .13734 m .03006 .13734 L s P [(2)] .01131 .13734 1 0 Mshowa p .002 w .02381 .27468 m .03006 .27468 L s P [(4)] .01131 .27468 1 0 Mshowa p .002 w .02381 .41202 m .03006 .41202 L s P [(6)] .01131 .41202 1 0 Mshowa p .002 w .02381 .54936 m .03006 .54936 L s P [(8)] .01131 .54936 1 0 Mshowa p .001 w .02381 .02747 m .02756 .02747 L s P p .001 w .02381 .05494 m .02756 .05494 L s P p .001 w .02381 .0824 m .02756 .0824 L s P p .001 w .02381 .10987 m .02756 .10987 L s P p .001 w .02381 .16481 m .02756 .16481 L s P p .001 w .02381 .19228 m .02756 .19228 L s P p .001 w .02381 .21975 m .02756 .21975 L s P p .001 w .02381 .24721 m .02756 .24721 L s P p .001 w .02381 .30215 m .02756 .30215 L s P p .001 w .02381 .32962 m .02756 .32962 L s P p .001 w .02381 .35709 m .02756 .35709 L s P p .001 w .02381 .38455 m .02756 .38455 L s P p .001 w .02381 .43949 m .02756 .43949 L s P p .001 w .02381 .46696 m .02756 .46696 L s P p .001 w .02381 .49443 m .02756 .49443 L s P p .001 w .02381 .5219 m .02756 .5219 L s P p .001 w .02381 .57683 m .02756 .57683 L s P p .001 w .02381 .6043 m .02756 .6043 L s P p .002 w .02381 0 m .02381 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p .004 w .02381 .14201 m .06349 .15627 L .10317 .17052 L .14286 .18478 L .18254 .19903 L .22222 .21329 L .2619 .22754 L .30159 .2418 L .34127 .25605 L .38095 .27031 L .42063 .28456 L .46032 .29882 L .5 .31308 L .53968 .32733 L .57937 .34159 L .61905 .35584 L .65873 .3701 L .69841 .38435 L .7381 .39861 L .77778 .41286 L .81746 .42712 L .85714 .44137 L .89683 .45563 L .93651 .46989 L .97619 .48414 L s P P p .03 w .02381 .14216 Mdot .11905 .17683 Mdot .21429 .20809 Mdot .30952 .24693 Mdot .40476 .28069 Mdot .5 .31004 Mdot .59524 .34636 Mdot .69048 .38415 Mdot .78571 .41359 Mdot .88095 .44999 Mdot .97619 .485 Mdot P % End of Graphics MathPictureEnd :[font = input; preserveAspect; startGroup] plotfit[quadfit, quaddata]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 48; pictureWidth = 216; pictureHeight = 133; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.190476 0 0.0441453 [ [(0)] .02381 0 0 2 Msboxa [(1)] .21429 0 0 2 Msboxa [(2)] .40476 0 0 2 Msboxa [(3)] .59524 0 0 2 Msboxa [(4)] .78571 0 0 2 Msboxa [(5)] .97619 0 0 2 Msboxa [(2)] .01131 .08829 1 0 Msboxa [(4)] .01131 .17658 1 0 Msboxa [(6)] .01131 .26487 1 0 Msboxa [(8)] .01131 .35316 1 0 Msboxa [(10)] .01131 .44145 1 0 Msboxa [(12)] .01131 .52974 1 0 Msboxa [(14)] .01131 .61803 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .02381 0 m .02381 .00625 L s P [(0)] .02381 0 0 2 Mshowa p .002 w .21429 0 m .21429 .00625 L s P [(1)] .21429 0 0 2 Mshowa p .002 w .40476 0 m .40476 .00625 L s P [(2)] .40476 0 0 2 Mshowa p .002 w .59524 0 m .59524 .00625 L s P [(3)] .59524 0 0 2 Mshowa p .002 w .78571 0 m .78571 .00625 L s P [(4)] .78571 0 0 2 Mshowa p .002 w .97619 0 m .97619 .00625 L s P [(5)] .97619 0 0 2 Mshowa p .001 w .0619 0 m .0619 .00375 L s P p .001 w .1 0 m .1 .00375 L s P p .001 w .1381 0 m .1381 .00375 L s P p .001 w .17619 0 m .17619 .00375 L s P p .001 w .25238 0 m .25238 .00375 L s P p .001 w .29048 0 m .29048 .00375 L s P p .001 w .32857 0 m .32857 .00375 L s P p .001 w .36667 0 m .36667 .00375 L s P p .001 w .44286 0 m .44286 .00375 L s P p .001 w .48095 0 m .48095 .00375 L s P p .001 w .51905 0 m .51905 .00375 L s P p .001 w .55714 0 m .55714 .00375 L s P p .001 w .63333 0 m .63333 .00375 L s P p .001 w .67143 0 m .67143 .00375 L s P p .001 w .70952 0 m .70952 .00375 L s P p .001 w .74762 0 m .74762 .00375 L s P p .001 w .82381 0 m .82381 .00375 L s P p .001 w .8619 0 m .8619 .00375 L s P p .001 w .9 0 m .9 .00375 L s P p .001 w .9381 0 m .9381 .00375 L s P p .002 w 0 0 m 1 0 L s P p .002 w .02381 .08829 m .03006 .08829 L s P [(2)] .01131 .08829 1 0 Mshowa p .002 w .02381 .17658 m .03006 .17658 L s P [(4)] .01131 .17658 1 0 Mshowa p .002 w .02381 .26487 m .03006 .26487 L s P [(6)] .01131 .26487 1 0 Mshowa p .002 w .02381 .35316 m .03006 .35316 L s P [(8)] .01131 .35316 1 0 Mshowa p .002 w .02381 .44145 m .03006 .44145 L s P [(10)] .01131 .44145 1 0 Mshowa p .002 w .02381 .52974 m .03006 .52974 L s P [(12)] .01131 .52974 1 0 Mshowa p .002 w .02381 .61803 m .03006 .61803 L s P [(14)] .01131 .61803 1 0 Mshowa p .001 w .02381 .01766 m .02756 .01766 L s P p .001 w .02381 .03532 m .02756 .03532 L s P p .001 w .02381 .05297 m .02756 .05297 L s P p .001 w .02381 .07063 m .02756 .07063 L s P p .001 w .02381 .10595 m .02756 .10595 L s P p .001 w .02381 .12361 m .02756 .12361 L s P p .001 w .02381 .14126 m .02756 .14126 L s P p .001 w .02381 .15892 m .02756 .15892 L s P p .001 w .02381 .19424 m .02756 .19424 L s P p .001 w .02381 .2119 m .02756 .2119 L s P p .001 w .02381 .22956 m .02756 .22956 L s P p .001 w .02381 .24721 m .02756 .24721 L s P p .001 w .02381 .28253 m .02756 .28253 L s P p .001 w .02381 .30019 m .02756 .30019 L s P p .001 w .02381 .31785 m .02756 .31785 L s P p .001 w .02381 .3355 m .02756 .3355 L s P p .001 w .02381 .37082 m .02756 .37082 L s P p .001 w .02381 .38848 m .02756 .38848 L s P p .001 w .02381 .40614 m .02756 .40614 L s P p .001 w .02381 .42379 m .02756 .42379 L s P p .001 w .02381 .45911 m .02756 .45911 L s P p .001 w .02381 .47677 m .02756 .47677 L s P p .001 w .02381 .49443 m .02756 .49443 L s P p .001 w .02381 .51209 m .02756 .51209 L s P p .001 w .02381 .5474 m .02756 .5474 L s P p .001 w .02381 .56506 m .02756 .56506 L s P p .001 w .02381 .58272 m .02756 .58272 L s P p .001 w .02381 .60038 m .02756 .60038 L s P p .002 w .02381 0 m .02381 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p .004 w .02381 .08957 m .06349 .09931 L .10317 .10981 L .14286 .12106 L .18254 .13306 L .22222 .14582 L .2619 .15933 L .30159 .17359 L .34127 .1886 L .38095 .20437 L .42063 .22088 L .46032 .23816 L .5 .25618 L .53968 .27496 L .57937 .29449 L .61905 .31477 L .65873 .3358 L .69841 .35759 L .7381 .38013 L .77778 .40342 L .81746 .42746 L .85714 .45226 L .89683 .47781 L .93651 .50411 L .97619 .53117 L s P P p .03 w .02381 .08949 Mdot .11905 .11442 Mdot .21429 .14205 Mdot .30952 .17871 Mdot .40476 .21349 Mdot .5 .2553 Mdot .59524 .30291 Mdot .69048 .35269 Mdot .78571 .40961 Mdot .88095 .46604 Mdot .97619 .5317 Mdot P % End of Graphics MathPictureEnd :[font = input; preserveAspect; startGroup] badlindata = lindata; badlindata[[5]] = {2, 7}; badlindata[[11]] = {5, 1}; badquaddata = quaddata; badquaddata[[5]] = {2, 15}; badquaddata[[11]] = {5, 1}; badlinfit = Fit[badlindata, {1, x}, x] :[font = output; output; inactive; preserveAspect; endGroup] 3.291877240720505383 + 0.3923346277694690989*x ;[o] 3.29188 + 0.392335 x :[font = input; preserveAspect; startGroup] badquadfit = Fit[badquaddata, {1, x, x^2}, x] :[font = output; output; inactive; preserveAspect; endGroup] 0.4255414722329129241 + 5.823751834654384685*x - 1.00238126462818744*x^2 ;[o] 2 0.425541 + 5.82375 x - 1.00238 x :[font = input; preserveAspect; startGroup] plotfit[badlinfit, badlindata]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 48; pictureWidth = 216; pictureHeight = 133; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.190476 0 0.0772542 [ [(0)] .02381 0 0 2 Msboxa [(1)] .21429 0 0 2 Msboxa [(2)] .40476 0 0 2 Msboxa [(3)] .59524 0 0 2 Msboxa [(4)] .78571 0 0 2 Msboxa [(5)] .97619 0 0 2 Msboxa [(1)] .01131 .07725 1 0 Msboxa [(2)] .01131 .15451 1 0 Msboxa [(3)] .01131 .23176 1 0 Msboxa [(4)] .01131 .30902 1 0 Msboxa [(5)] .01131 .38627 1 0 Msboxa [(6)] .01131 .46353 1 0 Msboxa [(7)] .01131 .54078 1 0 Msboxa [(8)] .01131 .61803 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .02381 0 m .02381 .00625 L s P [(0)] .02381 0 0 2 Mshowa p .002 w .21429 0 m .21429 .00625 L s P [(1)] .21429 0 0 2 Mshowa p .002 w .40476 0 m .40476 .00625 L s P [(2)] .40476 0 0 2 Mshowa p .002 w .59524 0 m .59524 .00625 L s P [(3)] .59524 0 0 2 Mshowa p .002 w .78571 0 m .78571 .00625 L s P [(4)] .78571 0 0 2 Mshowa p .002 w .97619 0 m .97619 .00625 L s P [(5)] .97619 0 0 2 Mshowa p .001 w .0619 0 m .0619 .00375 L s P p .001 w .1 0 m .1 .00375 L s P p .001 w .1381 0 m .1381 .00375 L s P p .001 w .17619 0 m .17619 .00375 L s P p .001 w .25238 0 m .25238 .00375 L s P p .001 w .29048 0 m .29048 .00375 L s P p .001 w .32857 0 m .32857 .00375 L s P p .001 w .36667 0 m .36667 .00375 L s P p .001 w .44286 0 m .44286 .00375 L s P p .001 w .48095 0 m .48095 .00375 L s P p .001 w .51905 0 m .51905 .00375 L s P p .001 w .55714 0 m .55714 .00375 L s P p .001 w .63333 0 m .63333 .00375 L s P p .001 w .67143 0 m .67143 .00375 L s P p .001 w .70952 0 m .70952 .00375 L s P p .001 w .74762 0 m .74762 .00375 L s P p .001 w .82381 0 m .82381 .00375 L s P p .001 w .8619 0 m .8619 .00375 L s P p .001 w .9 0 m .9 .00375 L s P p .001 w .9381 0 m .9381 .00375 L s P p .002 w 0 0 m 1 0 L s P p .002 w .02381 .07725 m .03006 .07725 L s P [(1)] .01131 .07725 1 0 Mshowa p .002 w .02381 .15451 m .03006 .15451 L s P [(2)] .01131 .15451 1 0 Mshowa p .002 w .02381 .23176 m .03006 .23176 L s P [(3)] .01131 .23176 1 0 Mshowa p .002 w .02381 .30902 m .03006 .30902 L s P [(4)] .01131 .30902 1 0 Mshowa p .002 w .02381 .38627 m .03006 .38627 L s P [(5)] .01131 .38627 1 0 Mshowa p .002 w .02381 .46353 m .03006 .46353 L s P [(6)] .01131 .46353 1 0 Mshowa p .002 w .02381 .54078 m .03006 .54078 L s P [(7)] .01131 .54078 1 0 Mshowa p .002 w .02381 .61803 m .03006 .61803 L s P [(8)] .01131 .61803 1 0 Mshowa p .001 w .02381 .01545 m .02756 .01545 L s P p .001 w .02381 .0309 m .02756 .0309 L s P p .001 w .02381 .04635 m .02756 .04635 L s P p .001 w .02381 .0618 m .02756 .0618 L s P p .001 w .02381 .09271 m .02756 .09271 L s P p .001 w .02381 .10816 m .02756 .10816 L s P p .001 w .02381 .12361 m .02756 .12361 L s P p .001 w .02381 .13906 m .02756 .13906 L s P p .001 w .02381 .16996 m .02756 .16996 L s P p .001 w .02381 .18541 m .02756 .18541 L s P p .001 w .02381 .20086 m .02756 .20086 L s P p .001 w .02381 .21631 m .02756 .21631 L s P p .001 w .02381 .24721 m .02756 .24721 L s P p .001 w .02381 .26266 m .02756 .26266 L s P p .001 w .02381 .27812 m .02756 .27812 L s P p .001 w .02381 .29357 m .02756 .29357 L s P p .001 w .02381 .32447 m .02756 .32447 L s P p .001 w .02381 .33992 m .02756 .33992 L s P p .001 w .02381 .35537 m .02756 .35537 L s P p .001 w .02381 .37082 m .02756 .37082 L s P p .001 w .02381 .40172 m .02756 .40172 L s P p .001 w .02381 .41717 m .02756 .41717 L s P p .001 w .02381 .43262 m .02756 .43262 L s P p .001 w .02381 .44807 m .02756 .44807 L s P p .001 w .02381 .47898 m .02756 .47898 L s P p .001 w .02381 .49443 m .02756 .49443 L s P p .001 w .02381 .50988 m .02756 .50988 L s P p .001 w .02381 .52533 m .02756 .52533 L s P p .001 w .02381 .55623 m .02756 .55623 L s P p .001 w .02381 .57168 m .02756 .57168 L s P p .001 w .02381 .58713 m .02756 .58713 L s P p .001 w .02381 .60258 m .02756 .60258 L s P p .002 w .02381 0 m .02381 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p .004 w .02381 .25431 m .06349 .26063 L .10317 .26694 L .14286 .27325 L .18254 .27957 L .22222 .28588 L .2619 .2922 L .30159 .29851 L .34127 .30483 L .38095 .31114 L .42063 .31746 L .46032 .32377 L .5 .33009 L .53968 .3364 L .57937 .34271 L .61905 .34903 L .65873 .35534 L .69841 .36166 L .7381 .36797 L .77778 .37429 L .81746 .3806 L .85714 .38692 L .89683 .39323 L .93651 .39954 L .97619 .40586 L s P P p .03 w .02381 .15993 Mdot .11905 .19894 Mdot .21429 .2341 Mdot .30952 .27779 Mdot .40476 .54078 Mdot .5 .3488 Mdot .59524 .38965 Mdot .69048 .43217 Mdot .78571 .46529 Mdot .88095 .50623 Mdot .97619 .07725 Mdot P % End of Graphics MathPictureEnd :[font = input; preserveAspect; startGroup] plotfit[badquadfit, badquaddata]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 48; pictureWidth = 216; pictureHeight = 133; endGroup; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.190476 0 0.0386271 [ [(0)] .02381 0 0 2 Msboxa [(1)] .21429 0 0 2 Msboxa [(2)] .40476 0 0 2 Msboxa [(3)] .59524 0 0 2 Msboxa [(4)] .78571 0 0 2 Msboxa [(5)] .97619 0 0 2 Msboxa [(2)] .01131 .07725 1 0 Msboxa [(4)] .01131 .15451 1 0 Msboxa [(6)] .01131 .23176 1 0 Msboxa [(8)] .01131 .30902 1 0 Msboxa [(10)] .01131 .38627 1 0 Msboxa [(12)] .01131 .46353 1 0 Msboxa [(14)] .01131 .54078 1 0 Msboxa [(16)] .01131 .61803 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .02381 0 m .02381 .00625 L s P [(0)] .02381 0 0 2 Mshowa p .002 w .21429 0 m .21429 .00625 L s P [(1)] .21429 0 0 2 Mshowa p .002 w .40476 0 m .40476 .00625 L s P [(2)] .40476 0 0 2 Mshowa p .002 w .59524 0 m .59524 .00625 L s P [(3)] .59524 0 0 2 Mshowa p .002 w .78571 0 m .78571 .00625 L s P [(4)] .78571 0 0 2 Mshowa p .002 w .97619 0 m .97619 .00625 L s P [(5)] .97619 0 0 2 Mshowa p .001 w .0619 0 m .0619 .00375 L s P p .001 w .1 0 m .1 .00375 L s P p .001 w .1381 0 m .1381 .00375 L s P p .001 w .17619 0 m .17619 .00375 L s P p .001 w .25238 0 m .25238 .00375 L s P p .001 w .29048 0 m .29048 .00375 L s P p .001 w .32857 0 m .32857 .00375 L s P p .001 w .36667 0 m .36667 .00375 L s P p .001 w .44286 0 m .44286 .00375 L s P p .001 w .48095 0 m .48095 .00375 L s P p .001 w .51905 0 m .51905 .00375 L s P p .001 w .55714 0 m .55714 .00375 L s P p .001 w .63333 0 m .63333 .00375 L s P p .001 w .67143 0 m .67143 .00375 L s P p .001 w .70952 0 m .70952 .00375 L s P p .001 w .74762 0 m .74762 .00375 L s P p .001 w .82381 0 m .82381 .00375 L s P p .001 w .8619 0 m .8619 .00375 L s P p .001 w .9 0 m .9 .00375 L s P p .001 w .9381 0 m .9381 .00375 L s P p .002 w 0 0 m 1 0 L s P p .002 w .02381 .07725 m .03006 .07725 L s P [(2)] .01131 .07725 1 0 Mshowa p .002 w .02381 .15451 m .03006 .15451 L s P [(4)] .01131 .15451 1 0 Mshowa p .002 w .02381 .23176 m .03006 .23176 L s P [(6)] .01131 .23176 1 0 Mshowa p .002 w .02381 .30902 m .03006 .30902 L s P [(8)] .01131 .30902 1 0 Mshowa p .002 w .02381 .38627 m .03006 .38627 L s P [(10)] .01131 .38627 1 0 Mshowa p .002 w .02381 .46353 m .03006 .46353 L s P [(12)] .01131 .46353 1 0 Mshowa p .002 w .02381 .54078 m .03006 .54078 L s P [(14)] .01131 .54078 1 0 Mshowa p .002 w .02381 .61803 m .03006 .61803 L s P [(16)] .01131 .61803 1 0 Mshowa p .001 w .02381 .01545 m .02756 .01545 L s P p .001 w .02381 .0309 m .02756 .0309 L s P p .001 w .02381 .04635 m .02756 .04635 L s P p .001 w .02381 .0618 m .02756 .0618 L s P p .001 w .02381 .09271 m .02756 .09271 L s P p .001 w .02381 .10816 m .02756 .10816 L s P p .001 w .02381 .12361 m .02756 .12361 L s P p .001 w .02381 .13906 m .02756 .13906 L s P p .001 w .02381 .16996 m .02756 .16996 L s P p .001 w .02381 .18541 m .02756 .18541 L s P p .001 w .02381 .20086 m .02756 .20086 L s P p .001 w .02381 .21631 m .02756 .21631 L s P p .001 w .02381 .24721 m .02756 .24721 L s P p .001 w .02381 .26266 m .02756 .26266 L s P p .001 w .02381 .27812 m .02756 .27812 L s P p .001 w .02381 .29357 m .02756 .29357 L s P p .001 w .02381 .32447 m .02756 .32447 L s P p .001 w .02381 .33992 m .02756 .33992 L s P p .001 w .02381 .35537 m .02756 .35537 L s P p .001 w .02381 .37082 m .02756 .37082 L s P p .001 w .02381 .40172 m .02756 .40172 L s P p .001 w .02381 .41717 m .02756 .41717 L s P p .001 w .02381 .43262 m .02756 .43262 L s P p .001 w .02381 .44807 m .02756 .44807 L s P p .001 w .02381 .47898 m .02756 .47898 L s P p .001 w .02381 .49443 m .02756 .49443 L s P p .001 w .02381 .50988 m .02756 .50988 L s P p .001 w .02381 .52533 m .02756 .52533 L s P p .001 w .02381 .55623 m .02756 .55623 L s P p .001 w .02381 .57168 m .02756 .57168 L s P p .001 w .02381 .58713 m .02756 .58713 L s P p .001 w .02381 .60258 m .02756 .60258 L s P p .002 w .02381 0 m .02381 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p .004 w .02381 .01644 m .06349 .06162 L .10317 .10345 L .14286 .14191 L .18254 .17701 L .22222 .20875 L .2619 .23713 L .30159 .26215 L .34127 .28381 L .38095 .30211 L .42063 .31704 L .46032 .32862 L .48016 .33314 L .5 .33683 L .51984 .33968 L .52976 .34078 L .53968 .34168 L .5496 .34237 L .55456 .34264 L .55952 .34285 L .56448 .34301 L .56696 .34307 L .56944 .34312 L .57192 .34315 L .57316 .34316 L .5744 .34317 L .57564 .34318 L .57688 .34318 L .57813 .34318 L .57937 .34317 L .58061 .34317 L .58185 .34316 L .58433 .34312 L .58681 .34308 L .58929 .34302 L .59425 .34287 L .59921 .34266 L .60913 .34209 L .61905 .3413 L .63889 .33911 L .65873 .33607 L .69841 .32748 L .7381 .31553 L .77778 .30022 L .81746 .28154 L .85714 .25951 L .89683 .23411 L .93651 .20535 L .97619 .17323 L s P P p .03 w .02381 .0783 Mdot .11905 .10012 Mdot .21429 .12429 Mdot .30952 .15637 Mdot .40476 .57941 Mdot .5 .22339 Mdot .59524 .26505 Mdot .69048 .30861 Mdot .78571 .35841 Mdot .88095 .40778 Mdot .97619 .03863 Mdot P % End of Graphics MathPictureEnd :[font = section; inactive; preserveAspect; startGroup] 15.2 Least Median of Squares :[font = input; preserveAspect] Median[list_] := Sort[list][[(Length[list]+1)/2]] /; OddQ[Length[list]] Median[list_] := Block[{s, n}, s = Sort[list] ; n = Length[list] ; (s[[n/2]] + s[[n/2 + 1]]) / 2 ] /; EvenQ[Length[list]] :[font = subsection; inactive; preserveAspect; startGroup] 15.2.1 Conceptual Approach: 2 Dimensions :[font = input; preserveAspect] lmsfita[data_, x_] := Module[ {l, v, i, j, w, h, a, sl, dx}, l = Length[data]; v = Flatten[Table[{data[[i]], data[[j]]}, {i,1,l-1}, {j,i+1,l}], 1]; w = Union[Map[ Module[{dx}, dx = #[[1, 1]] - #[[2, 1]]; If[dx !=0, {(#[[1, 2]]-#[[2, 2]])/dx, (#[[1, 1]] #[[2, 2]] - #[[1, 2]] #[[2, 1]])/dx}, {Infinity, #[[1, 1]]}] ]&, v]]; h = Function[a, {Median[Map[ (If[a[[1]] != Infinity, (#[[2]] - a[[1]] #[[1]] - a[[2]])^2, (a[[2]] - #[[1]])^2])&, data]], a[[1]], a[[2]]}]; sl = Sort[Map[h, w]][[1]]; If[sl[[2]] != Infinity, sl[[2]] x + sl[[3]], Print["x = ",sl[[3]]]] ] :[font = input; preserveAspect; startGroup] DefineTheLines[data_] := Module[ {l, v, i, j}, l = Length[data]; v = Flatten[Table[{data[[i]], data[[j]]}, {i,1,l-1}, {j,i+1,l}], 1]; v] DefineTheLines[{{1, 2}, {2, 3}, {4, 5}}] :[font = output; output; inactive; preserveAspect; endGroup] {{{1, 2}, {2, 3}}, {{1, 2}, {4, 5}}, {{2, 3}, {4, 5}}} ;[o] {{{1, 2}, {2, 3}}, {{1, 2}, {4, 5}}, {{2, 3}, {4, 5}}} :[font = input; preserveAspect; startGroup] lmslinfit = lmsfita[badlindata, x] :[font = output; output; inactive; preserveAspect; endGroup] 2.070145717256340781 + 0.9881760298179258113*x ;[o] 2.07015 + 0.988176 x :[font = input; preserveAspect; startGroup] plotfit[lmslinfit, badlindata]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 48; pictureWidth = 216; pictureHeight = 133; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.190476 0 0.0772542 [ [(0)] .02381 0 0 2 Msboxa [(1)] .21429 0 0 2 Msboxa [(2)] .40476 0 0 2 Msboxa [(3)] .59524 0 0 2 Msboxa [(4)] .78571 0 0 2 Msboxa [(5)] .97619 0 0 2 Msboxa [(1)] .01131 .07725 1 0 Msboxa [(2)] .01131 .15451 1 0 Msboxa [(3)] .01131 .23176 1 0 Msboxa [(4)] .01131 .30902 1 0 Msboxa [(5)] .01131 .38627 1 0 Msboxa [(6)] .01131 .46353 1 0 Msboxa [(7)] .01131 .54078 1 0 Msboxa [(8)] .01131 .61803 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .02381 0 m .02381 .00625 L s P [(0)] .02381 0 0 2 Mshowa p .002 w .21429 0 m .21429 .00625 L s P [(1)] .21429 0 0 2 Mshowa p .002 w .40476 0 m .40476 .00625 L s P [(2)] .40476 0 0 2 Mshowa p .002 w .59524 0 m .59524 .00625 L s P [(3)] .59524 0 0 2 Mshowa p .002 w .78571 0 m .78571 .00625 L s P [(4)] .78571 0 0 2 Mshowa p .002 w .97619 0 m .97619 .00625 L s P [(5)] .97619 0 0 2 Mshowa p .001 w .0619 0 m .0619 .00375 L s P p .001 w .1 0 m .1 .00375 L s P p .001 w .1381 0 m .1381 .00375 L s P p .001 w .17619 0 m .17619 .00375 L s P p .001 w .25238 0 m .25238 .00375 L s P p .001 w .29048 0 m .29048 .00375 L s P p .001 w .32857 0 m .32857 .00375 L s P p .001 w .36667 0 m .36667 .00375 L s P p .001 w .44286 0 m .44286 .00375 L s P p .001 w .48095 0 m .48095 .00375 L s P p .001 w .51905 0 m .51905 .00375 L s P p .001 w .55714 0 m .55714 .00375 L s P p .001 w .63333 0 m .63333 .00375 L s P p .001 w .67143 0 m .67143 .00375 L s P p .001 w .70952 0 m .70952 .00375 L s P p .001 w .74762 0 m .74762 .00375 L s P p .001 w .82381 0 m .82381 .00375 L s P p .001 w .8619 0 m .8619 .00375 L s P p .001 w .9 0 m .9 .00375 L s P p .001 w .9381 0 m .9381 .00375 L s P p .002 w 0 0 m 1 0 L s P p .002 w .02381 .07725 m .03006 .07725 L s P [(1)] .01131 .07725 1 0 Mshowa p .002 w .02381 .15451 m .03006 .15451 L s P [(2)] .01131 .15451 1 0 Mshowa p .002 w .02381 .23176 m .03006 .23176 L s P [(3)] .01131 .23176 1 0 Mshowa p .002 w .02381 .30902 m .03006 .30902 L s P [(4)] .01131 .30902 1 0 Mshowa p .002 w .02381 .38627 m .03006 .38627 L s P [(5)] .01131 .38627 1 0 Mshowa p .002 w .02381 .46353 m .03006 .46353 L s P [(6)] .01131 .46353 1 0 Mshowa p .002 w .02381 .54078 m .03006 .54078 L s P [(7)] .01131 .54078 1 0 Mshowa p .002 w .02381 .61803 m .03006 .61803 L s P [(8)] .01131 .61803 1 0 Mshowa p .001 w .02381 .01545 m .02756 .01545 L s P p .001 w .02381 .0309 m .02756 .0309 L s P p .001 w .02381 .04635 m .02756 .04635 L s P p .001 w .02381 .0618 m .02756 .0618 L s P p .001 w .02381 .09271 m .02756 .09271 L s P p .001 w .02381 .10816 m .02756 .10816 L s P p .001 w .02381 .12361 m .02756 .12361 L s P p .001 w .02381 .13906 m .02756 .13906 L s P p .001 w .02381 .16996 m .02756 .16996 L s P p .001 w .02381 .18541 m .02756 .18541 L s P p .001 w .02381 .20086 m .02756 .20086 L s P p .001 w .02381 .21631 m .02756 .21631 L s P p .001 w .02381 .24721 m .02756 .24721 L s P p .001 w .02381 .26266 m .02756 .26266 L s P p .001 w .02381 .27812 m .02756 .27812 L s P p .001 w .02381 .29357 m .02756 .29357 L s P p .001 w .02381 .32447 m .02756 .32447 L s P p .001 w .02381 .33992 m .02756 .33992 L s P p .001 w .02381 .35537 m .02756 .35537 L s P p .001 w .02381 .37082 m .02756 .37082 L s P p .001 w .02381 .40172 m .02756 .40172 L s P p .001 w .02381 .41717 m .02756 .41717 L s P p .001 w .02381 .43262 m .02756 .43262 L s P p .001 w .02381 .44807 m .02756 .44807 L s P p .001 w .02381 .47898 m .02756 .47898 L s P p .001 w .02381 .49443 m .02756 .49443 L s P p .001 w .02381 .50988 m .02756 .50988 L s P p .001 w .02381 .52533 m .02756 .52533 L s P p .001 w .02381 .55623 m .02756 .55623 L s P p .001 w .02381 .57168 m .02756 .57168 L s P p .001 w .02381 .58713 m .02756 .58713 L s P p .001 w .02381 .60258 m .02756 .60258 L s P p .002 w .02381 0 m .02381 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p .004 w .02381 .15993 m .06349 .17583 L .10317 .19174 L .14286 .20764 L .18254 .22354 L .22222 .23945 L .2619 .25535 L .30159 .27126 L .34127 .28716 L .38095 .30307 L .42063 .31897 L .46032 .33488 L .5 .35078 L .53968 .36668 L .57937 .38259 L .61905 .39849 L .65873 .4144 L .69841 .4303 L .7381 .44621 L .77778 .46211 L .81746 .47801 L .85714 .49392 L .89683 .50982 L .93651 .52573 L .97619 .54163 L s P P p .03 w .02381 .15993 Mdot .11905 .19894 Mdot .21429 .2341 Mdot .30952 .27779 Mdot .40476 .54078 Mdot .5 .3488 Mdot .59524 .38965 Mdot .69048 .43217 Mdot .78571 .46529 Mdot .88095 .50623 Mdot .97619 .07725 Mdot P % End of Graphics MathPictureEnd :[font = input; preserveAspect; startGroup] vertdata = {{1, 1}, {1, 2}, {1, 3}, {4, 5}}; lmslinfit = lmsfita[vertdata, x] :[font = print; inactive; preserveAspect; endGroup; endGroup; endGroup] x = 1 :[font = section; inactive; preserveAspect; startGroup] 15.3 Higher Dimensions :[font = input; preserveAspect] KSubsets[l_List,0] := { {} } KSubsets[l_List,1] := Partition[l,1] KSubsets[l_List,k_Integer?Positive] := {l} /; (k == Length[l]) KSubsets[l_List,k_Integer?Positive] := {} /; (k > Length[l]) KSubsets[l_List,k_Integer?Positive] := Join[ Map[(Prepend[#,First[l]])&, KSubsets[Rest[l],k-1]], KSubsets[Rest[l],k] ] :[font = input; preserveAspect; startGroup] KSubsets[{1, 2, 4, 3}, 1] :[font = output; output; inactive; preserveAspect; endGroup] {{1}, {2}, {4}, {3}} ;[o] {{1}, {2}, {4}, {3}} :[font = input; preserveAspect; startGroup] Vertices = Table[{Cos[2 Pi i/20], Sin[2 Pi i/20]}, {i, 1, 20}]; Show[Graphics[{ {Thickness[0.002], RGBColor[0, 0, 1], Map[Line, KSubsets[Vertices, 2]]}, {PointSize[0.03], RGBColor[1, 0, 0], Map[Point, Vertices]}}, AspectRatio -> 1]]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 48; pictureWidth = 216; pictureHeight = 216; endGroup] %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.5 0.47619 0.5 0.47619 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1 L 0 1 L closepath clip newpath p p 0 0 1 r p .002 w .95288 .64715 m .88525 .7799 L s .95288 .64715 m .7799 .88525 L s .95288 .64715 m .64715 .95288 L s .95288 .64715 m .5 .97619 L s .95288 .64715 m .35285 .95288 L s .95288 .64715 m .2201 .88525 L s .95288 .64715 m .11475 .7799 L s .95288 .64715 m .04712 .64715 L s .95288 .64715 m .02381 .5 L s .95288 .64715 m .04712 .35285 L s .95288 .64715 m .11475 .2201 L s .95288 .64715 m .2201 .11475 L s .95288 .64715 m .35285 .04712 L s .95288 .64715 m .5 .02381 L s .95288 .64715 m .64715 .04712 L s .95288 .64715 m .7799 .11475 L s .95288 .64715 m .88525 .2201 L s .95288 .64715 m .95288 .35285 L s .95288 .64715 m .97619 .5 L s .88525 .7799 m .7799 .88525 L s .88525 .7799 m .64715 .95288 L s .88525 .7799 m .5 .97619 L s .88525 .7799 m .35285 .95288 L s .88525 .7799 m .2201 .88525 L s .88525 .7799 m .11475 .7799 L s .88525 .7799 m .04712 .64715 L s .88525 .7799 m .02381 .5 L s .88525 .7799 m .04712 .35285 L s .88525 .7799 m .11475 .2201 L s .88525 .7799 m .2201 .11475 L s .88525 .7799 m .35285 .04712 L s .88525 .7799 m .5 .02381 L s .88525 .7799 m .64715 .04712 L s .88525 .7799 m .7799 .11475 L s .88525 .7799 m .88525 .2201 L s .88525 .7799 m .95288 .35285 L s .88525 .7799 m .97619 .5 L s .7799 .88525 m .64715 .95288 L s .7799 .88525 m .5 .97619 L s .7799 .88525 m .35285 .95288 L s .7799 .88525 m .2201 .88525 L s .7799 .88525 m .11475 .7799 L s .7799 .88525 m .04712 .64715 L s .7799 .88525 m .02381 .5 L s .7799 .88525 m .04712 .35285 L s .7799 .88525 m .11475 .2201 L s .7799 .88525 m .2201 .11475 L s .7799 .88525 m .35285 .04712 L s .7799 .88525 m .5 .02381 L s .7799 .88525 m .64715 .04712 L s .7799 .88525 m .7799 .11475 L s .7799 .88525 m .88525 .2201 L s .7799 .88525 m .95288 .35285 L s .7799 .88525 m .97619 .5 L s .64715 .95288 m .5 .97619 L s .64715 .95288 m .35285 .95288 L s .64715 .95288 m .2201 .88525 L s .64715 .95288 m .11475 .7799 L s .64715 .95288 m .04712 .64715 L s .64715 .95288 m .02381 .5 L s .64715 .95288 m .04712 .35285 L s .64715 .95288 m .11475 .2201 L s .64715 .95288 m .2201 .11475 L s .64715 .95288 m .35285 .04712 L s .64715 .95288 m .5 .02381 L s .64715 .95288 m .64715 .04712 L s .64715 .95288 m .7799 .11475 L s .64715 .95288 m .88525 .2201 L s .64715 .95288 m .95288 .35285 L s .64715 .95288 m .97619 .5 L s .5 .97619 m .35285 .95288 L s .5 .97619 m .2201 .88525 L s .5 .97619 m .11475 .7799 L s .5 .97619 m .04712 .64715 L s .5 .97619 m .02381 .5 L s .5 .97619 m .04712 .35285 L s .5 .97619 m .11475 .2201 L s .5 .97619 m .2201 .11475 L s .5 .97619 m .35285 .04712 L s .5 .97619 m .5 .02381 L s .5 .97619 m .64715 .04712 L s .5 .97619 m .7799 .11475 L s .5 .97619 m .88525 .2201 L s .5 .97619 m .95288 .35285 L s .5 .97619 m .97619 .5 L s .35285 .95288 m .2201 .88525 L s .35285 .95288 m .11475 .7799 L s .35285 .95288 m .04712 .64715 L s .35285 .95288 m .02381 .5 L s .35285 .95288 m .04712 .35285 L s .35285 .95288 m .11475 .2201 L s .35285 .95288 m .2201 .11475 L s .35285 .95288 m .35285 .04712 L s .35285 .95288 m .5 .02381 L s .35285 .95288 m .64715 .04712 L s .35285 .95288 m .7799 .11475 L s .35285 .95288 m .88525 .2201 L s .35285 .95288 m .95288 .35285 L s .35285 .95288 m .97619 .5 L s .2201 .88525 m .11475 .7799 L s .2201 .88525 m .04712 .64715 L s .2201 .88525 m .02381 .5 L s .2201 .88525 m .04712 .35285 L s .2201 .88525 m .11475 .2201 L s .2201 .88525 m .2201 .11475 L s .2201 .88525 m .35285 .04712 L s .2201 .88525 m .5 .02381 L s .2201 .88525 m .64715 .04712 L s .2201 .88525 m .7799 .11475 L s .2201 .88525 m .88525 .2201 L s .2201 .88525 m .95288 .35285 L s .2201 .88525 m .97619 .5 L s .11475 .7799 m .04712 .64715 L s .11475 .7799 m .02381 .5 L s .11475 .7799 m .04712 .35285 L s .11475 .7799 m .11475 .2201 L s .11475 .7799 m .2201 .11475 L s .11475 .7799 m .35285 .04712 L s .11475 .7799 m .5 .02381 L s .11475 .7799 m .64715 .04712 L s .11475 .7799 m .7799 .11475 L s .11475 .7799 m .88525 .2201 L s .11475 .7799 m .95288 .35285 L s .11475 .7799 m .97619 .5 L s .04712 .64715 m .02381 .5 L s .04712 .64715 m .04712 .35285 L s .04712 .64715 m .11475 .2201 L s .04712 .64715 m .2201 .11475 L s .04712 .64715 m .35285 .04712 L s .04712 .64715 m .5 .02381 L s .04712 .64715 m .64715 .04712 L s .04712 .64715 m .7799 .11475 L s .04712 .64715 m .88525 .2201 L s .04712 .64715 m .95288 .35285 L s .04712 .64715 m .97619 .5 L s .02381 .5 m .04712 .35285 L s .02381 .5 m .11475 .2201 L s .02381 .5 m .2201 .11475 L s .02381 .5 m .35285 .04712 L s .02381 .5 m .5 .02381 L s .02381 .5 m .64715 .04712 L s .02381 .5 m .7799 .11475 L s .02381 .5 m .88525 .2201 L s .02381 .5 m .95288 .35285 L s .02381 .5 m .97619 .5 L s .04712 .35285 m .11475 .2201 L s .04712 .35285 m .2201 .11475 L s .04712 .35285 m .35285 .04712 L s .04712 .35285 m .5 .02381 L s .04712 .35285 m .64715 .04712 L s .04712 .35285 m .7799 .11475 L s .04712 .35285 m .88525 .2201 L s .04712 .35285 m .95288 .35285 L s .04712 .35285 m .97619 .5 L s .11475 .2201 m .2201 .11475 L s .11475 .2201 m .35285 .04712 L s .11475 .2201 m .5 .02381 L s .11475 .2201 m .64715 .04712 L s .11475 .2201 m .7799 .11475 L s .11475 .2201 m .88525 .2201 L s .11475 .2201 m .95288 .35285 L s .11475 .2201 m .97619 .5 L s .2201 .11475 m .35285 .04712 L s .2201 .11475 m .5 .02381 L s .2201 .11475 m .64715 .04712 L s .2201 .11475 m .7799 .11475 L s .2201 .11475 m .88525 .2201 L s .2201 .11475 m .95288 .35285 L s .2201 .11475 m .97619 .5 L s .35285 .04712 m .5 .02381 L s .35285 .04712 m .64715 .04712 L s .35285 .04712 m .7799 .11475 L s .35285 .04712 m .88525 .2201 L s .35285 .04712 m .95288 .35285 L s .35285 .04712 m .97619 .5 L s .5 .02381 m .64715 .04712 L s .5 .02381 m .7799 .11475 L s .5 .02381 m .88525 .2201 L s .5 .02381 m .95288 .35285 L s .5 .02381 m .97619 .5 L s .64715 .04712 m .7799 .11475 L s .64715 .04712 m .88525 .2201 L s .64715 .04712 m .95288 .35285 L s .64715 .04712 m .97619 .5 L s .7799 .11475 m .88525 .2201 L s .7799 .11475 m .95288 .35285 L s .7799 .11475 m .97619 .5 L s .88525 .2201 m .95288 .35285 L s .88525 .2201 m .97619 .5 L s .95288 .35285 m .97619 .5 L s P P p 1 0 0 r p .03 w .95288 .64715 Mdot .88525 .7799 Mdot .7799 .88525 Mdot .64715 .95288 Mdot .5 .97619 Mdot .35285 .95288 Mdot .2201 .88525 Mdot .11475 .7799 Mdot .04712 .64715 Mdot .02381 .5 Mdot .04712 .35285 Mdot .11475 .2201 Mdot .2201 .11475 Mdot .35285 .04712 Mdot .5 .02381 Mdot .64715 .04712 Mdot .7799 .11475 Mdot .88525 .2201 Mdot .95288 .35285 Mdot .97619 .5 Mdot P P P % End of Graphics MathPictureEnd :[font = input; preserveAspect; startGroup] RandomPermutation[n_Integer?Positive] := Map[Last, Sort[Map[({Random[], #})&, Range[n]]]] myperm = RandomPermutation[5] :[font = output; output; inactive; preserveAspect; endGroup] {4, 3, 1, 2, 5} ;[o] {4, 3, 1, 2, 5} :[font = input; preserveAspect; startGroup] mylist = {a, b, c, d, e}; mylist[[myperm]] :[font = output; output; inactive; preserveAspect; endGroup] {d, c, a, b, e} ;[o] {d, c, a, b, e} :[font = input; preserveAspect] Unprotect[Table]; Table[expr_, {l__List}] := Table[expr, l]; Protect[Table]; :[font = input; preserveAspect; startGroup] PSubsets[l_List, n_Integer?Positive] := Module[{itlist, expr,a}, a[0] = 0; itlist = Table[{a[j], a[j-1] + 1, Length[l] + j - n}, {j, 1, n}]; expr = Table[l[[Array[a, {n}]]], Evaluate[itlist]]; expr = Flatten[expr, n-1] ] /; ( n <= Length[l]) mylist = {a, b, c, d, e}; PSubsets[mylist, 2] :[font = output; output; inactive; preserveAspect; endGroup] {{a, b}, {a, c}, {a, d}, {a, e}, {b, c}, {b, d}, {b, e}, {c, d}, {c, e}, {d, e}} ;[o] {{a, b}, {a, c}, {a, d}, {a, e}, {b, c}, {b, d}, {b, e}, {c, d}, {c, e}, {d, e}} :[font = input; preserveAspect; startGroup] averes[data_] := Sum[Timing[KSubsets[data, n];][[1]], {n, 2, 5}]/ Sum[Timing[PSubsets[data, n];][[1]], {n, 2, 5}]; {averes[Range[10]], averes[Range[20]]} :[font = output; output; inactive; preserveAspect; endGroup] {1.100000000000000711, 1.101056803170409541} ;[o] {1.1, 1.10106} :[font = input; preserveAspect] Fitlms[data_List, fns_List, vbls_List, thoroughness_:1] := Module[{makelinear, lineardata, vlen, flen, calcmedian, aa, hyperplane, hyperplanes, numplanes, eqn, solver, solns, coeffs, sl}, vlen = Length[vbls]; flen = Length[fns]; (* makelinear takes a function list like {1,x,x y}, together with a variable list --- in this instance {x,y} --- to create the function {1,#1, #1 #2, #3}& *) makelinear = Evaluate[Join[ fns /. Table[vbls[[i]] -> Slot[i], {i, 1, vlen}], {Slot[vlen + 1]}] ]&; (* now we generate all hyperplane, see how many there are and take a random subset if thoroughness < 1 *) lineardata = Apply[makelinear, data, 1]; hyperplanes = KSubsets[lineardata, flen]; numplanes = Length[hyperplanes]; hyperplanes = If[thoroughness < 1, Take[hyperplanes[[RandomPermutation[numplanes]]], Ceiling[thoroughness*numplanes]], hyperplanes]; (* eqn takes a hyperplane and constructs the relevant linear equations to determine the associated values of the parameters *) coeffs = Array[aa, flen]; eqn = Function[hyperplane, Dot[coeffs, Drop[hyperplane, -1]] == Last[hyperplane]]; (* Now construct the parameters for all the hyperplanes chosen above *) solver = coeffs /. Solve[Map[eqn, #], coeffs]&; solns = Flatten[Map[solver, hyperplanes], 1]; (* finally for each hyperplane, the median-square-deviation is computed, and the hyperplane for which this is a minimum is returned *) calcmedian = Function[coeffset, {Median[Map[(Last[#] - Dot[coeffset, Drop[#, -1]])^2&,lineardata]], coeffset}]; sl = Sort[Map[calcmedian, solns]][[1]]; Dot[sl[[2]], fns] ] :[font = input; preserveAspect; startGroup] lms = Fitlms[badquaddata, {1, x, x^2}, {x}, 0.2] :[font = output; output; inactive; preserveAspect; endGroup] 2.027066708156245085 + 1.034098525239114875*x + 0.1912602256145979997*x^2 ;[o] 2 2.02707 + 1.0341 x + 0.19126 x :[font = input; preserveAspect; startGroup] plotfit[lms, badquaddata]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 48; pictureWidth = 216; pictureHeight = 133; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.190476 0 0.0386271 [ [(0)] .02381 0 0 2 Msboxa [(1)] .21429 0 0 2 Msboxa [(2)] .40476 0 0 2 Msboxa [(3)] .59524 0 0 2 Msboxa [(4)] .78571 0 0 2 Msboxa [(5)] .97619 0 0 2 Msboxa [(2)] .01131 .07725 1 0 Msboxa [(4)] .01131 .15451 1 0 Msboxa [(6)] .01131 .23176 1 0 Msboxa [(8)] .01131 .30902 1 0 Msboxa [(10)] .01131 .38627 1 0 Msboxa [(12)] .01131 .46353 1 0 Msboxa [(14)] .01131 .54078 1 0 Msboxa [(16)] .01131 .61803 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .02381 0 m .02381 .00625 L s P [(0)] .02381 0 0 2 Mshowa p .002 w .21429 0 m .21429 .00625 L s P [(1)] .21429 0 0 2 Mshowa p .002 w .40476 0 m .40476 .00625 L s P [(2)] .40476 0 0 2 Mshowa p .002 w .59524 0 m .59524 .00625 L s P [(3)] .59524 0 0 2 Mshowa p .002 w .78571 0 m .78571 .00625 L s P [(4)] .78571 0 0 2 Mshowa p .002 w .97619 0 m .97619 .00625 L s P [(5)] .97619 0 0 2 Mshowa p .001 w .0619 0 m .0619 .00375 L s P p .001 w .1 0 m .1 .00375 L s P p .001 w .1381 0 m .1381 .00375 L s P p .001 w .17619 0 m .17619 .00375 L s P p .001 w .25238 0 m .25238 .00375 L s P p .001 w .29048 0 m .29048 .00375 L s P p .001 w .32857 0 m .32857 .00375 L s P p .001 w .36667 0 m .36667 .00375 L s P p .001 w .44286 0 m .44286 .00375 L s P p .001 w .48095 0 m .48095 .00375 L s P p .001 w .51905 0 m .51905 .00375 L s P p .001 w .55714 0 m .55714 .00375 L s P p .001 w .63333 0 m .63333 .00375 L s P p .001 w .67143 0 m .67143 .00375 L s P p .001 w .70952 0 m .70952 .00375 L s P p .001 w .74762 0 m .74762 .00375 L s P p .001 w .82381 0 m .82381 .00375 L s P p .001 w .8619 0 m .8619 .00375 L s P p .001 w .9 0 m .9 .00375 L s P p .001 w .9381 0 m .9381 .00375 L s P p .002 w 0 0 m 1 0 L s P p .002 w .02381 .07725 m .03006 .07725 L s P [(2)] .01131 .07725 1 0 Mshowa p .002 w .02381 .15451 m .03006 .15451 L s P [(4)] .01131 .15451 1 0 Mshowa p .002 w .02381 .23176 m .03006 .23176 L s P [(6)] .01131 .23176 1 0 Mshowa p .002 w .02381 .30902 m .03006 .30902 L s P [(8)] .01131 .30902 1 0 Mshowa p .002 w .02381 .38627 m .03006 .38627 L s P [(10)] .01131 .38627 1 0 Mshowa p .002 w .02381 .46353 m .03006 .46353 L s P [(12)] .01131 .46353 1 0 Mshowa p .002 w .02381 .54078 m .03006 .54078 L s P [(14)] .01131 .54078 1 0 Mshowa p .002 w .02381 .61803 m .03006 .61803 L s P [(16)] .01131 .61803 1 0 Mshowa p .001 w .02381 .01545 m .02756 .01545 L s P p .001 w .02381 .0309 m .02756 .0309 L s P p .001 w .02381 .04635 m .02756 .04635 L s P p .001 w .02381 .0618 m .02756 .0618 L s P p .001 w .02381 .09271 m .02756 .09271 L s P p .001 w .02381 .10816 m .02756 .10816 L s P p .001 w .02381 .12361 m .02756 .12361 L s P p .001 w .02381 .13906 m .02756 .13906 L s P p .001 w .02381 .16996 m .02756 .16996 L s P p .001 w .02381 .18541 m .02756 .18541 L s P p .001 w .02381 .20086 m .02756 .20086 L s P p .001 w .02381 .21631 m .02756 .21631 L s P p .001 w .02381 .24721 m .02756 .24721 L s P p .001 w .02381 .26266 m .02756 .26266 L s P p .001 w .02381 .27812 m .02756 .27812 L s P p .001 w .02381 .29357 m .02756 .29357 L s P p .001 w .02381 .32447 m .02756 .32447 L s P p .001 w .02381 .33992 m .02756 .33992 L s P p .001 w .02381 .35537 m .02756 .35537 L s P p .001 w .02381 .37082 m .02756 .37082 L s P p .001 w .02381 .40172 m .02756 .40172 L s P p .001 w .02381 .41717 m .02756 .41717 L s P p .001 w .02381 .43262 m .02756 .43262 L s P p .001 w .02381 .44807 m .02756 .44807 L s P p .001 w .02381 .47898 m .02756 .47898 L s P p .001 w .02381 .49443 m .02756 .49443 L s P p .001 w .02381 .50988 m .02756 .50988 L s P p .001 w .02381 .52533 m .02756 .52533 L s P p .001 w .02381 .55623 m .02756 .55623 L s P p .001 w .02381 .57168 m .02756 .57168 L s P p .001 w .02381 .58713 m .02756 .58713 L s P p .001 w .02381 .60258 m .02756 .60258 L s P p .002 w .02381 0 m .02381 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p .004 w .02381 .0783 m .06349 .08694 L .10317 .09623 L .14286 .10615 L .18254 .11672 L .22222 .12792 L .2619 .13977 L .30159 .15226 L .34127 .1654 L .38095 .17917 L .42063 .19358 L .46032 .20864 L .5 .22433 L .53968 .24067 L .57937 .25765 L .61905 .27527 L .65873 .29353 L .69841 .31244 L .7381 .33198 L .77778 .35217 L .81746 .373 L .85714 .39446 L .89683 .41657 L .93651 .43932 L .97619 .46272 L s P P p .03 w .02381 .0783 Mdot .11905 .10012 Mdot .21429 .12429 Mdot .30952 .15637 Mdot .40476 .57941 Mdot .5 .22339 Mdot .59524 .26505 Mdot .69048 .30861 Mdot .78571 .35841 Mdot .88095 .40778 Mdot .97619 .03863 Mdot P % End of Graphics MathPictureEnd :[font = input; preserveAspect] RandomKSubset[n_Integer,k_Integer] := RandomKSubset[Range[n],k] RandomKSubset[set_List,k_Integer] := Module[{s=Range[Length[set]],i,n=Length[set],x}, set [[ Sort[ Table[ x=Random[Integer,{1,i}]; {s[[i]],s[[x]]} = {s[[x]],s[[i]]}; s[[i]], {i,n,n-k+1,-1} ] ] ]] ] :[font = input; preserveAspect] Fitlms[data_List, fns_List, vbls_List, thoroughness_:1, method_Integer:1] := Module[{makelinear, lineardata, vlen, flen, calcmedian, aa, hyperplane, hyperplanes, numplanes, eqn, solver, solns, coeffs, sl}, vlen = Length[vbls]; flen = Length[fns]; makelinear = Evaluate[Join[ fns /. Table[vbls[[i]] -> Slot[i], {i, 1, vlen}], {Slot[vlen + 1]}] ]&; lineardata = Apply[makelinear, data, 1]; datano = Length[lineardata]; numplanes = datano!/(flen! (datano-flen)!); If[method == 1, hyperplanes = KSubsets[lineardata, flen]; hyperplanes = If[thoroughness < 1, Take[hyperplanes[[RandomPermutation[numplanes]]], Ceiling[thoroughness*numplanes]], hyperplanes], (* method 2 *) hyperplanes = Table[RandomKSubset[lineardata,flen], {thoroughness*numplanes}] ]; coeffs = Array[aa, flen]; eqn = Function[hyperplane, Dot[coeffs, Drop[hyperplane, -1]] == Last[hyperplane]]; solver = coeffs /. Solve[Map[eqn, #], coeffs]&; solns = Flatten[Map[solver, hyperplanes], 1]; calcmedian = Function[coeffset, {Median[Map[(Last[#] - Dot[coeffset, Drop[#, -1]])^2&,lineardata]], coeffset}]; sl = Sort[Map[calcmedian, solns]][[1]]; Dot[sl[[2]], fns] ] :[font = input; preserveAspect; startGroup] Timing[Fitlms[badquaddata, {1, x, x^2}, {x}, 0.2,2]] :[font = output; output; inactive; preserveAspect; endGroup] {12.78333333333333499*Second, 2.027066708156245085 + 1.011197422634931296*x + 0.1965166631893217873*x^2} ;[o] 2 {12.7833 Second, 2.02707 + 1.0112 x + 0.196517 x } :[font = input; preserveAspect; startGroup] Timing[Fitlms[badquaddata,{1,x,x^2},{x},0.2,1]] :[font = output; output; inactive; preserveAspect; endGroup] {12.5*Second, 2.027066708156245085 + 0.9851168873504982608*x + 0.2069488773030950015*x^2} ;[o] 2 {12.5 Second, 2.02707 + 0.985117 x + 0.206949 x } :[font = text; inactive; preserveAspect] Nothing in it! What about a larger data set? :[font = input; preserveAspect; startGroup] big = Table[{x, 2 + x + 0.2 x^2 + 0.1*Random[ ]}, {x, 0, 15, 0.5}]; Timing[Fitlms[big, {1, x, x^2}, {x}, 0.01,2]] :[font = output; output; inactive; preserveAspect; endGroup] {20.64999999999999858*Second, 1.994213622137312565 + 1.023542209147554988*x + 0.1985890252525316443*x^2} ;[o] 2 {20.65 Second, 1.99421 + 1.02354 x + 0.198589 x } :[font = input; preserveAspect; startGroup] Timing[Fitlms[big, {1, x, x^2}, {x}, 0.01,1]] :[font = output; output; inactive; preserveAspect; endGroup; endGroup; endGroup] {41.43333333333333357*Second, 2.019867126715595952 + 1.010564269535436412*x + 0.1994121480769905253*x^2} ;[o] 2 {41.4333 Second, 2.01987 + 1.01056 x + 0.199412 x } ^*)