(*^ ::[ 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; initialization; preserveAspect] *) <>"] ;[o] -Graphics- :[font = input; initialization; preserveAspect; startGroup] *) P[7] (* :[font = output; output; inactive; preserveAspect; endGroup] 2945/28 ;[o] 2945 ---- 28 :[font = input; initialization; preserveAspect] *) Problem 2 (* :[font = input; initialization; preserveAspect; startGroup] *) X={-4,2,5,11}; M=Table[X[[i]]^(j-1),{i,4},{j,4}]; Y=Transpose[{{112,70,-140,-128}}]; AppendRows[M,Y]; R=RowReduce[%] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{1, 0, 0, 0, 180}, {0, 1, 0, 0, -39}, {0, 0, 1, 0, -10}, {0, 0, 0, 1, 1}}] ;[o] 1 0 0 0 180 0 1 0 0 -39 0 0 1 0 -10 0 0 0 1 1 :[font = input; initialization; preserveAspect; startGroup] *) P[x_]:=Sum[R[[i,5]]x^(i-1),{i,1,4}]; P[x] Plot[P[x],{x,-4,11}] (* :[font = output; output; inactive; preserveAspect] 180 - 39*x - 10*x^2 + x^3 ;[o] 2 3 180 - 39 x - 10 x + x :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 282; pictureHeight = 174] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.277778 0.0634921 0.338939 0.0012429 [ [(-4)] .02381 .33894 0 2 Msboxa [(-2)] .15079 .33894 0 2 Msboxa [(2)] .40476 .33894 0 2 Msboxa [(4)] .53175 .33894 0 2 Msboxa [(6)] .65873 .33894 0 2 Msboxa [(8)] .78571 .33894 0 2 Msboxa [(10)] .9127 .33894 0 2 Msboxa [(-200)] .26528 .09036 1 0 Msboxa [(-100)] .26528 .21465 1 0 Msboxa [(100)] .26528 .46323 1 0 Msboxa [(200)] .26528 .58752 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 .33894 m .02381 .34519 L s P [(-4)] .02381 .33894 0 2 Mshowa p .002 w .15079 .33894 m .15079 .34519 L s P [(-2)] .15079 .33894 0 2 Mshowa p .002 w .40476 .33894 m .40476 .34519 L s P [(2)] .40476 .33894 0 2 Mshowa p .002 w .53175 .33894 m .53175 .34519 L s P [(4)] .53175 .33894 0 2 Mshowa p .002 w .65873 .33894 m .65873 .34519 L s P [(6)] .65873 .33894 0 2 Mshowa p .002 w .78571 .33894 m .78571 .34519 L s P [(8)] .78571 .33894 0 2 Mshowa p .002 w .9127 .33894 m .9127 .34519 L s P [(10)] .9127 .33894 0 2 Mshowa p .001 w .04921 .33894 m .04921 .34269 L s P p .001 w .0746 .33894 m .0746 .34269 L s P p .001 w .1 .33894 m .1 .34269 L s P p .001 w .1254 .33894 m .1254 .34269 L s P p .001 w .17619 .33894 m .17619 .34269 L s P p .001 w .20159 .33894 m .20159 .34269 L s P p .001 w .22698 .33894 m .22698 .34269 L s P p .001 w .25238 .33894 m .25238 .34269 L s P p .001 w .30317 .33894 m .30317 .34269 L s P p .001 w .32857 .33894 m .32857 .34269 L s P p .001 w .35397 .33894 m .35397 .34269 L s P p .001 w .37937 .33894 m .37937 .34269 L s P p .001 w .43016 .33894 m .43016 .34269 L s P p .001 w .45556 .33894 m .45556 .34269 L s P p .001 w .48095 .33894 m .48095 .34269 L s P p .001 w .50635 .33894 m .50635 .34269 L s P p .001 w .55714 .33894 m .55714 .34269 L s P p .001 w .58254 .33894 m .58254 .34269 L s P p .001 w .60794 .33894 m .60794 .34269 L s P p .001 w .63333 .33894 m .63333 .34269 L s P p .001 w .68413 .33894 m .68413 .34269 L s P p .001 w .70952 .33894 m .70952 .34269 L s P p .001 w .73492 .33894 m .73492 .34269 L s P p .001 w .76032 .33894 m .76032 .34269 L s P p .001 w .81111 .33894 m .81111 .34269 L s P p .001 w .83651 .33894 m .83651 .34269 L s P p .001 w .8619 .33894 m .8619 .34269 L s P p .001 w .8873 .33894 m .8873 .34269 L s P p .001 w .9381 .33894 m .9381 .34269 L s P p .001 w .96349 .33894 m .96349 .34269 L s P p .001 w .98889 .33894 m .98889 .34269 L s P p .002 w 0 .33894 m 1 .33894 L s P p .002 w .27778 .09036 m .28403 .09036 L s P [(-200)] .26528 .09036 1 0 Mshowa p .002 w .27778 .21465 m .28403 .21465 L s P [(-100)] .26528 .21465 1 0 Mshowa p .002 w .27778 .46323 m .28403 .46323 L s P [(100)] .26528 .46323 1 0 Mshowa p .002 w .27778 .58752 m .28403 .58752 L s P [(200)] .26528 .58752 1 0 Mshowa p .001 w .27778 .11522 m .28153 .11522 L s P p .001 w .27778 .14007 m .28153 .14007 L s P p .001 w .27778 .16493 m .28153 .16493 L s P p .001 w .27778 .18979 m .28153 .18979 L s P p .001 w .27778 .23951 m .28153 .23951 L s P p .001 w .27778 .26436 m .28153 .26436 L s P p .001 w .27778 .28922 m .28153 .28922 L s P p .001 w .27778 .31408 m .28153 .31408 L s P p .001 w .27778 .3638 m .28153 .3638 L s P p .001 w .27778 .38865 m .28153 .38865 L s P p .001 w .27778 .41351 m .28153 .41351 L s P p .001 w .27778 .43837 m .28153 .43837 L s P p .001 w .27778 .48809 m .28153 .48809 L s P p .001 w .27778 .51295 m .28153 .51295 L s P p .001 w .27778 .5378 m .28153 .5378 L s P p .001 w .27778 .56266 m .28153 .56266 L s P p .001 w .27778 .0655 m .28153 .0655 L s P p .001 w .27778 .04064 m .28153 .04064 L s P p .001 w .27778 .01578 m .28153 .01578 L s P p .001 w .27778 .61238 m .28153 .61238 L s P p .002 w .27778 0 m .27778 .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 .47814 m .04365 .51008 L .06349 .5369 L .08333 .55884 L .10317 .57612 L .1131 .58308 L .12302 .58897 L .13294 .5938 L .14286 .59762 L .14782 .59915 L .15278 .60043 L .15774 .60148 L .1627 .60229 L .16518 .6026 L .16766 .60286 L .17014 .60306 L .17138 .60314 L .17262 .6032 L .17386 .60325 L .1751 .60329 L .17634 .60331 L .17758 .60332 L .17882 .60331 L .18006 .60329 L .1813 .60326 L .18254 .60321 L .18502 .60307 L .1875 .60288 L .18998 .60264 L .19246 .60234 L .19742 .60158 L .20238 .60062 L .2123 .59807 L .22222 .59473 L .24206 .58577 L .2619 .57398 L .30159 .5428 L .34127 .503 L .38095 .45641 L .42063 .40483 L .46032 .3501 L .5 .29404 L .53968 .23846 L .57937 .18519 L .61905 .13604 L .65873 .09284 L .69841 .05741 L .71825 .04318 L .7381 .03157 L .74802 .02682 L Mistroke .75794 .02282 L .76786 .01958 L .77282 .01826 L .77778 .01714 L .78274 .01623 L .78522 .01585 L .7877 .01553 L .79018 .01526 L .79266 .01504 L .7939 .01495 L .79514 .01488 L .79638 .01482 L .79762 .01477 L .79886 .01474 L .8001 .01472 L .80134 .01472 L .80258 .01472 L .80382 .01475 L .80506 .01478 L .8063 .01483 L .80754 .0149 L .81002 .01507 L .8125 .0153 L .81746 .01594 L .82242 .01681 L .82738 .01792 L .8373 .02087 L .84722 .02482 L .85714 .02979 L .87698 .04293 L .89683 .06051 L .93651 .10992 L .97619 .17985 L Mfstroke P P % End of Graphics MathPictureEnd :[font = output; output; inactive; preserveAspect; endGroup] Graphics["<<>>"] ;[o] -Graphics- :[font = input; initialization; preserveAspect; startGroup] *) P[10] (* :[font = output; output; inactive; preserveAspect; endGroup] -210 ;[o] -210 :[font = input; initialization; preserveAspect] *) Problem 3 (* :[font = input; initialization; preserveAspect; startGroup] *) M=Table[i^(j-1),{i,18},{j,18}]; Y=Transpose[{{85,55,37,35,45,50,59,56,49,\ 53,57,59,55,51,44,54,61,63}}]; AppendRows[M,Y]; R=RowReduce[%]; R[[18]] (* :[font = output; output; inactive; preserveAspect; endGroup] {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1/6218311680} ;[o] {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1 ----------} 6218311680 :[font = input; initialization; preserveAspect] *) P[x_]:=Simplify[Sum[R[[i,19]](x-1970)^(i-1),{i,1,18}]] (* :[font = input; initialization; preserveAspect] *) Note: It is necessary to use reasonably small numbers (1-18 instead of 1971-1988) not for the integer cal- culations, but for the plot to come: in the Plot routine, 1988^17 is implicitely transformed into a floating point representation and truncated corres- pondingly. The truncations are important, in that they would render the value of the polynomial completely random. (* :[font = input; initialization; preserveAspect; startGroup] *) P[1995] (* :[font = output; output; inactive; preserveAspect; endGroup] 10122687145 ;[o] 10122687145 :[font = input; initialization; preserveAspect; startGroup] *) Plot[P[x],{x,1971,1988}] (* :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 282; pictureHeight = 174] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations -110.396 0.0560224 0.0625363 0.00532357 [ [(1972.5)] .10784 .06254 0 2 Msboxa [(1977.5)] .38796 .06254 0 2 Msboxa [(1980)] .52801 .06254 0 2 Msboxa [(1982.5)] .66807 .06254 0 2 Msboxa [(1985)] .80812 .06254 0 2 Msboxa [(1987.5)] .94818 .06254 0 2 Msboxa [(20)] .2354 .16901 1 0 Msboxa [(40)] .2354 .27548 1 0 Msboxa [(60)] .2354 .38195 1 0 Msboxa [(80)] .2354 .48842 1 0 Msboxa [(100)] .2354 .59489 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 .10784 .06254 m .10784 .06879 L s P [(1972.5)] .10784 .06254 0 2 Mshowa p .002 w .38796 .06254 m .38796 .06879 L s P [(1977.5)] .38796 .06254 0 2 Mshowa p .002 w .52801 .06254 m .52801 .06879 L s P [(1980)] .52801 .06254 0 2 Mshowa p .002 w .66807 .06254 m .66807 .06879 L s P [(1982.5)] .66807 .06254 0 2 Mshowa p .002 w .80812 .06254 m .80812 .06879 L s P [(1985)] .80812 .06254 0 2 Mshowa p .002 w .94818 .06254 m .94818 .06879 L s P [(1987.5)] .94818 .06254 0 2 Mshowa p .001 w .13585 .06254 m .13585 .06629 L s P p .001 w .16387 .06254 m .16387 .06629 L s P p .001 w .19188 .06254 m .19188 .06629 L s P p .001 w .21989 .06254 m .21989 .06629 L s P p .001 w .27591 .06254 m .27591 .06629 L s P p .001 w .30392 .06254 m .30392 .06629 L s P p .001 w .33193 .06254 m .33193 .06629 L s P p .001 w .35994 .06254 m .35994 .06629 L s P p .001 w .41597 .06254 m .41597 .06629 L s P p .001 w .44398 .06254 m .44398 .06629 L s P p .001 w .47199 .06254 m .47199 .06629 L s P p .001 w .5 .06254 m .5 .06629 L s P p .001 w .55602 .06254 m .55602 .06629 L s P p .001 w .58403 .06254 m .58403 .06629 L s P p .001 w .61204 .06254 m .61204 .06629 L s P p .001 w .64006 .06254 m .64006 .06629 L s P p .001 w .69608 .06254 m .69608 .06629 L s P p .001 w .72409 .06254 m .72409 .06629 L s P p .001 w .7521 .06254 m .7521 .06629 L s P p .001 w .78011 .06254 m .78011 .06629 L s P p .001 w .83613 .06254 m .83613 .06629 L s P p .001 w .86415 .06254 m .86415 .06629 L s P p .001 w .89216 .06254 m .89216 .06629 L s P p .001 w .92017 .06254 m .92017 .06629 L s P p .001 w .07983 .06254 m .07983 .06629 L s P p .001 w .05182 .06254 m .05182 .06629 L s P p .001 w .02381 .06254 m .02381 .06629 L s P p .001 w .97619 .06254 m .97619 .06629 L s P p .002 w 0 .06254 m 1 .06254 L s P p .002 w .2479 .16901 m .25415 .16901 L s P [(20)] .2354 .16901 1 0 Mshowa p .002 w .2479 .27548 m .25415 .27548 L s P [(40)] .2354 .27548 1 0 Mshowa p .002 w .2479 .38195 m .25415 .38195 L s P [(60)] .2354 .38195 1 0 Mshowa p .002 w .2479 .48842 m .25415 .48842 L s P [(80)] .2354 .48842 1 0 Mshowa p .002 w .2479 .59489 m .25415 .59489 L s P [(100)] .2354 .59489 1 0 Mshowa p .001 w .2479 .08383 m .25165 .08383 L s P p .001 w .2479 .10512 m .25165 .10512 L s P p .001 w .2479 .12642 m .25165 .12642 L s P p .001 w .2479 .14771 m .25165 .14771 L s P p .001 w .2479 .1903 m .25165 .1903 L s P p .001 w .2479 .2116 m .25165 .2116 L s P p .001 w .2479 .23289 m .25165 .23289 L s P p .001 w .2479 .25418 m .25165 .25418 L s P p .001 w .2479 .29677 m .25165 .29677 L s P p .001 w .2479 .31807 m .25165 .31807 L s P p .001 w .2479 .33936 m .25165 .33936 L s P p .001 w .2479 .36066 m .25165 .36066 L s P p .001 w .2479 .40325 m .25165 .40325 L s P p .001 w .2479 .42454 m .25165 .42454 L s P p .001 w .2479 .44583 m .25165 .44583 L s P p .001 w .2479 .46713 m .25165 .46713 L s P p .001 w .2479 .50972 m .25165 .50972 L s P p .001 w .2479 .53101 m .25165 .53101 L s P p .001 w .2479 .55231 m .25165 .55231 L s P p .001 w .2479 .5736 m .25165 .5736 L s P p .001 w .2479 .04124 m .25165 .04124 L s P p .001 w .2479 .01995 m .25165 .01995 L s P p .001 w .2479 .61619 m .25165 .61619 L s P p .002 w .2479 0 m .2479 .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 .51504 m 0 0 rlineto .02412 .61803 m .02381 .51504 L s s s s s s s s s s s s s s s s s s s .07202 .61803 m .07341 .55588 L s .07341 .55588 m .07589 .46763 L .07837 .39312 L .08333 .28137 L .08581 .24189 L .08829 .21178 L .09077 .18985 L .09201 .18161 L .09325 .17499 L .09449 .16985 L .09573 .16609 L .09697 .16355 L .09821 .16214 L .09945 .16173 L .10069 .16221 L .10193 .16348 L .10317 .16544 L .10565 .17107 L .10813 .17842 L .1131 .19602 L .11806 .21454 L .12302 .23146 L .12798 .24529 L .13294 .25538 L .13542 .25897 L .13666 .26042 L .1379 .26164 L .13914 .26265 L .14038 .26345 L .14162 .26405 L .14286 .26446 L .1627 .25542 L .16766 .25183 L .17014 .25026 L .17262 .24891 L .1751 .24782 L .17634 .24739 L .17758 .24703 L .17882 .24675 L .18006 .24655 L .1813 .24644 L .18254 .24641 L .18378 .24646 L .18502 .2466 L .18626 .24682 L .1875 .24713 L .18998 .24799 L .19246 .24917 L .19742 .25238 L .20238 .25659 L Mistroke .22222 .27843 L .23214 .2891 L .24206 .29793 L .25198 .30458 L .2619 .30938 L .28175 .31677 L .29167 .32123 L .30159 .3271 L .32143 .34344 L .34127 .36253 L .35119 .3709 L .35615 .37438 L .36111 .37724 L .36359 .37842 L .36607 .37941 L .36855 .38022 L .37103 .38083 L .37227 .38107 L .37351 .38125 L .37475 .38138 L .37599 .38146 L .37723 .38149 L .37847 .38147 L .37971 .38141 L .38095 .38129 L .42063 .35632 L .43056 .34703 L .44048 .33839 L .4504 .33125 L .45536 .32844 L .46032 .32621 L .46528 .32459 L .46776 .32401 L .469 .32379 L .47024 .32359 L .47148 .32344 L .47272 .32333 L .47396 .32325 L .4752 .32322 L .47644 .32322 L .47768 .32325 L .47892 .32333 L .48016 .32344 L .4814 .32358 L .48264 .32376 L .48512 .32421 L .49008 .3255 L .49504 .32723 L .5 .32934 L .51984 .34001 L Mistroke .53968 .35091 L .55952 .35925 L .56944 .36233 L .57937 .36489 L .59921 .36932 L .60913 .37147 L .61905 .37357 L .62401 .37453 L .62897 .37538 L .63145 .37574 L .63393 .37607 L .63641 .37634 L .63889 .37655 L .64013 .37663 L .64137 .3767 L .64261 .37674 L .64385 .37677 L .64509 .37677 L .64633 .37676 L .64757 .37672 L .64881 .37666 L .65005 .37658 L .65129 .37647 L .65377 .37619 L .65625 .3758 L .65873 .3753 L .66369 .37398 L .66865 .3722 L .67857 .36731 L .69841 .35357 L .70833 .34618 L .71825 .33974 L .72321 .33718 L .72569 .3361 L .72817 .33517 L .73065 .3344 L .73313 .33379 L .73438 .33355 L .73562 .33334 L .73686 .33318 L .7381 .33306 L .73934 .33297 L .74058 .33292 L .74182 .33291 L .74306 .33294 L .7443 .333 L .74554 .33309 L .74678 .33322 L .74802 .33337 L .75794 .33528 L Mistroke .7629 .33635 L .76538 .33679 L .76662 .33697 L .76786 .33712 L .7691 .33724 L .77034 .33731 L .77158 .33733 L .77282 .3373 L .77406 .33721 L .7753 .33705 L .77654 .33683 L .77778 .33654 L .77902 .33616 L .78026 .3357 L .78274 .33451 L .78522 .33294 L .7877 .33094 L .79266 .32558 L .79762 .3183 L .80754 .29816 L .81746 .27274 L .82242 .25972 L .82738 .2479 L .82986 .24285 L .83234 .23863 L .83358 .23689 L .83482 .23544 L .83606 .2343 L .8373 .2335 L .83854 .23306 L .83978 .23302 L .84102 .2334 L .84226 .23423 L .8435 .23555 L .84474 .23737 L .84722 .24263 L .84846 .24614 L .8497 .25026 L .85218 .26043 L .85714 .2891 L .8621 .32971 L .86706 .38259 L .87698 .52129 L Mfstroke .88295 .61803 m .87698 .52129 L s s s s s s s s s s s s s s s s s .91524 .61803 m .91667 .56382 L s .91667 .56382 m .91915 .44426 L .92163 .29764 L s .9255 0 m .92163 .29764 L s s s s s s s s s s s s s s s s s s s s s .97563 0 m .97619 .39792 L s .97619 .39792 m 0 0 rlineto P P % End of Graphics MathPictureEnd :[font = output; output; inactive; preserveAspect; endGroup] Graphics["<<>>"] ;[o] -Graphics- :[font = input; initialization; preserveAspect] *) The graph lets us conclude that although the prediction for 1995 gives the huge result shown above, this is not conclusive, since the hypothesis is most likely wrong: Even within our time domain, the 17th degree polynomial jumps to extreme negative values. (* :[font = input; initialization; preserveAspect] *) Problems on the Leontief Model (* :[font = input; initialization; preserveAspect] *) Problem 1 (* :[font = input; initialization; preserveAspect] *) K=1/100{{55,45,53,34}, \ {5,2,1,1}, \ {10,11,8,9}, \ {20,35,29,50}}; (* :[font = input; initialization; preserveAspect; startGroup] *) M=Table[If[i==j,1-K[[i,j]],-K[[i,j]]],{i,4},{j,4}] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{9/20, -9/20, -53/100, -17/50}, {-1/20, 49/50, -1/100, -1/100}, {-1/10, -11/100, 23/25, -9/100}, {-1/5, -7/20, -29/100, 1/2}}] ;[o] 9 9 53 17 -- -(--) -(---) -(--) 20 20 100 50 1 49 1 1 -(--) -- -(---) -(---) 20 50 100 100 1 11 23 9 -(--) -(---) -- -(---) 10 100 25 100 1 7 29 1 -(-) -(--) -(---) - 5 20 100 2 :[font = input; initialization; preserveAspect; startGroup] *) U=Transpose[1/10{{8,10,3,6}}] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{4/5}, {1}, {3/10}, {3/5}}] ;[o] 4 - 5 1 3 -- 10 3 - 5 :[font = input; initialization; preserveAspect; startGroup] *) R=RowReduce[AppendRows[M,U]] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{1, 0, 0, 0, 5103361/318831}, {0, 1, 0, 0, 1264615/637662}, {0, 0, 1, 0, 2151485/637662}, {0, 0, 0, 1, 6980975/637662}}] ;[o] 5103361 ------- 1 0 0 0 318831 1264615 ------- 0 1 0 0 637662 2151485 ------- 0 0 1 0 637662 6980975 ------- 0 0 0 1 637662 :[font = input; initialization; preserveAspect; startGroup] *) p=Table[R[[i,5]],{i,4}] (* :[font = output; output; inactive; preserveAspect; endGroup] {5103361/318831, 1264615/637662, 2151485/637662, 6980975/637662} ;[o] 5103361 1264615 2151485 6980975 {-------, -------, -------, -------} 318831 637662 637662 637662 :[font = input; initialization; preserveAspect; startGroup] *) N[p] (* :[font = output; output; inactive; preserveAspect; endGroup] {16.00647678550705546, 1.983205836320809457, 3.374021033086494099, 10.94776699881755538} ;[o] {16.0065, 1.98321, 3.37402, 10.9478} :[font = input; initialization; preserveAspect] *) Problem 2 (* :[font = input; initialization; preserveAspect; startGroup] *) F[i_,j_]:=Min[Mod[i+j,20],10]/100; K=Array[F,{10,10}]; M=Table[If[i==j,1-K[[i,j]],-K[[i,j]]],{i,10},{j,10}] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{49/50, -3/100, -1/25, -1/20, -3/50, -7/100, -2/25, -9/100, -1/10, -1/10}, {-3/100, 24/25, -1/20, -3/50, -7/100, -2/25, -9/100, -1/10, -1/10, -1/10}, {-1/25, -1/20, 47/50, -7/100, -2/25, -9/100, -1/10, -1/10, -1/10, -1/10}, {-1/20, -3/50, -7/100, 23/25, -9/100, -1/10, -1/10, -1/10, -1/10, -1/10}, {-3/50, -7/100, -2/25, -9/100, 9/10, -1/10, -1/10, -1/10, -1/10, -1/10}, {-7/100, -2/25, -9/100, -1/10, -1/10, 9/10, -1/10, -1/10, -1/10, -1/10}, {-2/25, -9/100, -1/10, -1/10, -1/10, -1/10, 9/10, -1/10, -1/10, -1/10}, {-9/100, -1/10, -1/10, -1/10, -1/10, -1/10, -1/10, 9/10, -1/10, -1/10}, {-1/10, -1/10, -1/10, -1/10, -1/10, -1/10, -1/10, -1/10, 9/10, -1/10}, {-1/10, -1/10, -1/10, -1/10, -1/10, -1/10, -1/10, -1/10, -1/10, 1}}] ;[o] 49 3 1 1 3 7 -- -(---) -(--) -(--) -(--) -(---) 50 100 25 20 50 100 2 9 1 1 -(--) -(---) -(--) -(--) 25 100 10 10 3 24 1 3 7 2 -(---) -- -(--) -(--) -(---) -(--) 100 25 20 50 100 25 9 1 1 1 -(---) -(--) -(--) -(--) 100 10 10 10 1 1 47 7 2 9 -(--) -(--) -- -(---) -(--) -(---) 25 20 50 100 25 100 1 1 1 1 -(--) -(--) -(--) -(--) 10 10 10 10 1 3 7 23 9 1 -(--) -(--) -(---) -- -(---) -(--) 20 50 100 25 100 10 1 1 1 1 -(--) -(--) -(--) -(--) 10 10 10 10 3 7 2 9 9 1 -(--) -(---) -(--) -(---) -- -(--) 50 100 25 100 10 10 1 1 1 1 -(--) -(--) -(--) -(--) 10 10 10 10 7 2 9 1 1 9 -(---) -(--) -(---) -(--) -(--) -- 100 25 100 10 10 10 1 1 1 1 -(--) -(--) -(--) -(--) 10 10 10 10 2 9 1 1 1 1 -(--) -(---) -(--) -(--) -(--) -(--) 25 100 10 10 10 10 9 1 1 1 -- -(--) -(--) -(--) 10 10 10 10 9 1 1 1 1 1 -(---) -(--) -(--) -(--) -(--) -(--) 100 10 10 10 10 10 1 9 1 1 -(--) -- -(--) -(--) 10 10 10 10 1 1 1 1 1 1 -(--) -(--) -(--) -(--) -(--) -(--) 10 10 10 10 10 10 1 1 9 1 -(--) -(--) -- -(--) 10 10 10 10 1 1 1 1 1 1 -(--) -(--) -(--) -(--) -(--) -(--) 10 10 10 10 10 10 1 1 1 -(--) -(--) -(--) 10 10 10 1 :[font = input; initialization; preserveAspect; startGroup] *) f[i_,j_]:=Abs[20-i^2]; U=Array[f,{10,1}] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{19}, {16}, {11}, {4}, {5}, {16}, {29}, {44}, {61}, {80}}] ;[o] 19 16 11 4 5 16 29 44 61 80 :[font = input; initialization; preserveAspect; startGroup] *) R=RowReduce[AppendRows[M,U]]; R[[10]] (* :[font = output; output; inactive; preserveAspect; endGroup] {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 41564409940069648810/138446606109292289} ;[o] 41564409940069648810 {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, --------------------} 138446606109292289 :[font = input; initialization; preserveAspect] *) System has unique solution. (* :[font = input; initialization; preserveAspect; startGroup] *) p=Table[R[[i,11]],{i,10}] (* :[font = output; output; inactive; preserveAspect; endGroup] {26309541971563908700/138446606109292289, 28512166644188657800/138446606109292289, 30033161327650557800/138446606109292289, 30898775183727577800/138446606109292289, 32519957819301189000/138446606109292289, 35200406937774711200/138446606109292289, 37848761516629542200/138446606109292289, 40473677694426452200/138446606109292289, 43090365418000060200/138446606109292289, 41564409940069648810/138446606109292289} ;[o] 26309541971563908700 28512166644188657800 {--------------------, --------------------, 138446606109292289 138446606109292289 30033161327650557800 30898775183727577800 --------------------, --------------------, 138446606109292289 138446606109292289 32519957819301189000 35200406937774711200 --------------------, --------------------, 138446606109292289 138446606109292289 37848761516629542200 40473677694426452200 --------------------, --------------------, 138446606109292289 138446606109292289 43090365418000060200 41564409940069648810 --------------------, --------------------} 138446606109292289 138446606109292289 :[font = input; initialization; preserveAspect; startGroup] *) N[p] (* :[font = output; output; inactive; preserveAspect; endGroup] {190.0338528399509767, 205.9434134606422258, 216.9295598618129335, 223.1818897700931593, 234.8916938680991437, 254.2525810274241366, 273.381649289048198, 292.34142195205413, 311.2417604804536398, 300.2197822549578543} ;[o] {190.034, 205.943, 216.93, 223.182, 234.892, 254.253, 273.382, 292.341, 311.242, 300.22} :[font = input; initialization; preserveAspect] *) Problems on Matrix Arithmetic / Incidence Matrices (* :[font = input; initialization; preserveAspect] *) Problem 1 (* :[font = input; initialization; preserveAspect] *) We construct a state matrix in which each row is a state. Within a row, the first position is 1 if the boat & she- pherd are present, 0 otherwise, the 2nd position stands for the wolf, the 3rd for the sheep, and the 4th for the cabbage: (* :[font = input; initialization; preserveAspect] *) S={{1,1,1,1},{1,1,1,0},{1,1,0,1},{1,0,1,1},{1,0,1,0}, \ {0,0,0,0},{0,0,0,1},{0,0,1,0},{0,1,0,0},{0,1,0,1}}; (* :[font = input; initialization; preserveAspect] *) Now, we can construct the incidence matrix by setting the conditions that only one occupant can travel at one time in addition to the shepherd, and that occupant has to leave, if the boat leaves, or come, if the boat comes. The incidence matrix could of course be set up manually, but this way is both faster and safer. (* :[font = input; initialization; preserveAspect; startGroup] *) p:=(S[[i,1]]-S[[j,1]])*(S[[i,k]]-S[[j,k]]); f:=If[p<0,-5,p]; Incidence=Table[If[1<=Sum[f,{k,1,4}]<=2,1,0],{i,10},{j,10}] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 1, 1, 0, 0, 0, 0, 0}, {0, 1, 1, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 1, 0, 0, 0, 0, 0, 0, 0}}] ;[o] 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 :[font = input; initialization; preserveAspect] *) The starting state is 1. The required final state is 6. We look therefore at the entry [[1,6]] (or, for that matter, [[6,1]]): as soon as it becomes nonzero while raising the incidence matrix to increasing powers, we have the minimum number of crossing for the shepherd to accomplish his task. (* :[font = input; initialization; preserveAspect] *) a) (* :[font = input; initialization; preserveAspect; startGroup] *) Print["1:",Incidence[[1]]]; For[i=2, \ MatrixPower[Incidence,i-1][[1,6]]==0, \ i++, \ Print[i,":",MatrixPower[Incidence,i][[1]]]]; (* :[font = print; inactive; preserveAspect; endGroup] 1:{0, 0, 0, 0, 0, 0, 0, 0, 0, 1} 2:{1, 0, 1, 0, 0, 0, 0, 0, 0, 0} 3:{0, 0, 0, 0, 0, 0, 1, 0, 1, 2} 4:{2, 1, 4, 1, 0, 0, 0, 0, 0, 0} 5:{0, 0, 0, 0, 0, 0, 5, 2, 5, 6} 6:{6, 7, 16, 7, 2, 0, 0, 0, 0, 0} 7:{0, 0, 0, 0, 0, 2, 23, 16, 23, 22} :[font = input; initialization; preserveAspect] *) 7 crossings are necessary. Note the actual order of actions in the For loop: what_to_do, increase_index, test_condition (post-test loop). By looking back to the 1st row after each crossing, as well as to the incidence matrix, we could actually determine the possible ways to proceed at each crossing. (There are 2 different paths, as the [[1,6]] entry indicates after 7 crossings.) (* :[font = input; initialization; preserveAspect] *) Clear[S,p,f] (* :[font = input; initialization; preserveAspect] *) b) (* :[font = input; initialization; preserveAspect] *) If it is possible to get from state i to state j in one crossing, then it is always possible to go from j to i by just crossing (back) with the same occupants. Therefore, the incidence matrix is symmetric. (* :[font = input; initialization; preserveAspect] *) Problem 2 (* :[font = input; initialization; preserveAspect] *) We generate the states S. For n=2, we may compare with the list in the textbook, and the algorithm to generate the 6n+2 states may prove useful for n=3. (* :[font = input; initialization; preserveAspect; startGroup] *) Sn[i_]:=Which[1<=i<=n+1,{1,n,n-i+1}, \ n+2<=i<=2n,{1,2n-i+1,2n-i+1}, \ 2n+1<=i<=3n+1,{1,0,3n-i+1}, \ 3n+2<=i<=6n+2,{0,Sn[i-3n-1][[2]],Sn[i-3n-1][[3]]}] n=2; S=Array[Sn,6n+2] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{1, 2, 2}, {1, 2, 1}, {1, 2, 0}, {1, 1, 1}, {1, 0, 2}, {1, 0, 1}, {1, 0, 0}, {0, 2, 2}, {0, 2, 1}, {0, 2, 0}, {0, 1, 1}, {0, 0, 2}, {0, 0, 1}, {0, 0, 0}}] ;[o] 1 2 2 1 2 1 1 2 0 1 1 1 1 0 2 1 0 1 1 0 0 0 2 2 0 2 1 0 2 0 0 1 1 0 0 2 0 0 1 0 0 0 :[font = input; initialization; preserveAspect] *) We use the restrictions of the problem to construct the incidence matrix automatically. It can be written in manually of course, deciding over the entries' values by the same token. Note also that recursive definitions are admissible (up to a certain limit); otherwise, the "Which" statement above would have had 6 parts instead of 4. (* :[font = input; initialization; preserveAspect; startGroup] *) p[k_]:=(S[[i,1]]-S[[j,1]])(S[[i,k]]-S[[j,k]]) f[k_]:=If[p[k]<0,-5,p[k]] IncidenceN:=Table[If[0S10->S2->S13->S4->S14 S1->S11->S2->S13->S5->S14 S1->S10->S2->S13->S4->S14 S1->S11->S2->S13->S5->S14 (* :[font = input; initialization; preserveAspect] *) Problem 3 (* :[font = input; initialization; preserveAspect; startGroup] *) n=3; S=Array[Sn,6n+2] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{1, 3, 3}, {1, 3, 2}, {1, 3, 1}, {1, 3, 0}, {1, 2, 2}, {1, 1, 1}, {1, 0, 3}, {1, 0, 2}, {1, 0, 1}, {1, 0, 0}, {0, 3, 3}, {0, 3, 2}, {0, 3, 1}, {0, 3, 0}, {0, 2, 2}, {0, 1, 1}, {0, 0, 3}, {0, 0, 2}, {0, 0, 1}, {0, 0, 0}}] ;[o] 1 3 3 1 3 2 1 3 1 1 3 0 1 2 2 1 1 1 1 0 3 1 0 2 1 0 1 1 0 0 0 3 3 0 3 2 0 3 1 0 3 0 0 2 2 0 1 1 0 0 3 0 0 2 0 0 1 0 0 0 :[font = input; initialization; preserveAspect; startGroup] *) Incidence=IncidenceN; Incidence//TableForm (* :[font = output; output; inactive; preserveAspect; endGroup] TableForm[{{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}] ;[o] 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 :[font = input; initialization; preserveAspect] *) a) (* :[font = input; initialization; preserveAspect; startGroup] *) Print["1:",Incidence[[1]]]; For[i=2, \ MatrixPower[Incidence,i-1][[1,6n+2]]==0, \ i++, \ Print[i,":",MatrixPower[Incidence,i][[1]]]]; (* :[font = print; inactive; preserveAspect; endGroup] 1:{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0} 2:{3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} 3:{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 5, 2, 5, 0, 0, 0, 0, 0} 4:{13, 12, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} 5:{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 13, 25, 14, 25, 2, 0, 0, 0, 0} 6:{63, 64, 16, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} 7:{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 63, 127, 80, 127, 18, 0, 2, 0, 0} 8:{317, 334, 98, 0, 20, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} 9:{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 317, 651, 432, 651, 118, 0, 22, 2, 0} 10:{1619, 1734, 550, 0, 140, 2, 24, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} 11:{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1619, 3353, 2284, 3353, 690, 0, 164, 28, 4} :[font = input; initialization; preserveAspect] *) There are a minimum of 11 one-way trips required and 4 different strategies to do the task. (* :[font = input; initialization; preserveAspect] *) b) (* :[font = input; initialization; preserveAspect] *) Looking at the incidence matrix and the 1st row of the power series, here are the strategies: S1->S13->S2->S14->S3->S16->S5->S18->S7->S19->S6->S20 S1->S15->S2->S14->S3->S16->S5->S18->S7->S19->S6->S20 S1->S13->S2->S14->S3->S16->S5->S18->S7->S19->S8->S20 S1->S15->S2->S14->S3->S16->S5->S18->S7->S19->S8->S20 (* :[font = input; initialization; preserveAspect] *) Problem 4 (* :[font = input; initialization; preserveAspect; startGroup] *) n=4; S=Array[Sn,6n+2] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{1, 4, 4}, {1, 4, 3}, {1, 4, 2}, {1, 4, 1}, {1, 4, 0}, {1, 3, 3}, {1, 2, 2}, {1, 1, 1}, {1, 0, 4}, {1, 0, 3}, {1, 0, 2}, {1, 0, 1}, {1, 0, 0}, {0, 4, 4}, {0, 4, 3}, {0, 4, 2}, {0, 4, 1}, {0, 4, 0}, {0, 3, 3}, {0, 2, 2}, {0, 1, 1}, {0, 0, 4}, {0, 0, 3}, {0, 0, 2}, {0, 0, 1}, {0, 0, 0}}] ;[o] 1 4 4 1 4 3 1 4 2 1 4 1 1 4 0 1 3 3 1 2 2 1 1 1 1 0 4 1 0 3 1 0 2 1 0 1 1 0 0 0 4 4 0 4 3 0 4 2 0 4 1 0 4 0 0 3 3 0 2 2 0 1 1 0 0 4 0 0 3 0 0 2 0 0 1 0 0 0 :[font = input; initialization; preserveAspect; startGroup] *) Incidence=IncidenceN; Incidence//TableForm (* :[font = output; output; inactive; preserveAspect; endGroup] TableForm[{{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}] ;[o] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 :[font = input; initialization; preserveAspect] *) We can check the accuracy of this incidence matrix against the textbook. (* :[font = input; initialization; preserveAspect] *) a) (* :[font = input; initialization; preserveAspect; startGroup] *) MPow=Array[0&,{6n+2,6n+2}]; MPow=Incidence; For[i=1, \ (MPow[[1,6n+2]]==0) && (i<6n+2), \ i++, \ MPow=MPow.Incidence]; Print[i,":",MPow[[1]]]; (* :[font = print; inactive; preserveAspect; endGroup] 26:{932383111, 1065989980, 577278606, 133606870, 0, 133606870, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0} :[font = input; initialization; preserveAspect] *) We conclude that, since in this case the task was not feasible over 6n+2=26 steps, it is not feasible at all. (* :[font = input; initialization; preserveAspect] *) b) - (* :[font = input; initialization; preserveAspect] *) Problem 5 (* :[font = input; initialization; preserveAspect; startGroup] *) A=Array[0&,{10,10}]; L={{1,2},{1,10},{2,3},{3,1},{4,5},{4,10},{5,6},{6,4}, \ {7,8},{7,10},{8,9},{8,10},{9,7},{10,1},{10,4},{10,7}}; Do[A[[L[[i,1]],L[[i,2]]]]=1,{i,1,Length[L]}]; A (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 1, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {1, 0, 0, 1, 0, 0, 1, 0, 0, 0}}] ;[o] 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 0 :[font = input; initialization; preserveAspect] *) a) (* :[font = input; initialization; preserveAspect; startGroup] *) Print["1:",A[[3]]]; For[i=2, \ MatrixPower[A,i-1][[3,7]]==0, \ i++, \ Print[i,":",MatrixPower[A,i][[3]]]]; (* :[font = print; inactive; preserveAspect; endGroup] 1:{1, 0, 0, 0, 0, 0, 0, 0, 0, 0} 2:{0, 1, 0, 0, 0, 0, 0, 0, 0, 1} 3:{1, 0, 1, 1, 0, 0, 1, 0, 0, 0} :[font = input; initialization; preserveAspect] *) There are a minimum of 3 flights required. (* :[font = input; initialization; preserveAspect; startGroup] *) SPow=Array[0&,{10,10}]; Do[SPow=(SPow+IdentityMatrix[10]).A,{i,1,10}]; SPow (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{263, 132, 68, 260, 128, 65, 260, 128, 65, 453}, {68, 34, 20, 65, 31, 16, 65, 31, 16, 112}, {132, 68, 34, 128, 65, 31, 128, 65, 31, 229}, {260, 128, 65, 263, 132, 68, 260, 128, 65, 453}, {65, 31, 16, 68, 34, 20, 65, 31, 16, 112}, {128, 65, 31, 132, 68, 34, 128, 65, 31, 229}, {388, 193, 96, 388, 193, 96, 391, 197, 99, 682}, {325, 159, 81, 325, 159, 81, 328, 162, 85, 565}, {193, 96, 47, 193, 96, 47, 197, 99, 50, 341}, {453, 229, 112, 453, 229, 112, 453, 229, 112, 799}}] ;[o] 263 132 68 260 128 65 260 128 65 453 68 34 20 65 31 16 65 31 16 112 132 68 34 128 65 31 128 65 31 229 260 128 65 263 132 68 260 128 65 453 65 31 16 68 34 20 65 31 16 112 128 65 31 132 68 34 128 65 31 229 388 193 96 388 193 96 391 197 99 682 325 159 81 325 159 81 328 162 85 565 193 96 47 193 96 47 197 99 50 341 453 229 112 453 229 112 453 229 112 799 :[font = input; initialization; preserveAspect] *) It is possible to get between any two states, since all the entries above are nonzero. (* :[font = input; initialization; preserveAspect; startGroup] *) SPow=Array[0&,{10,10}]; Do[SPow=(SPow+IdentityMatrix[10]).A;Print[SPow// \ MatrixForm],{i,1,10}]; (* :[font = print; inactive; preserveAspect; endGroup] 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 1 1 1 2 1 0 0 1 0 0 2 0 1 1 0 0 0 0 0 0 1 1 0 1 1 1 0 1 1 0 1 1 0 3 2 2 1 1 1 0 1 1 0 4 1 1 1 0 0 0 0 0 0 1 2 1 1 1 0 0 1 0 0 1 1 1 0 2 2 1 1 1 0 4 0 0 0 1 1 1 0 0 0 1 1 0 0 2 1 1 1 0 0 1 2 1 0 2 1 0 3 2 1 5 1 1 0 1 1 0 2 2 1 5 1 0 0 1 0 0 2 1 1 2 4 1 1 4 1 1 4 1 1 4 5 3 2 4 1 1 4 1 1 6 2 1 2 1 0 0 1 0 0 1 3 2 1 1 1 0 1 1 0 4 4 1 1 5 3 2 4 1 1 6 1 0 0 2 1 2 1 0 0 1 1 1 0 3 2 1 1 1 0 4 5 2 1 5 2 1 6 4 2 10 5 1 1 5 1 1 6 2 3 7 2 1 0 2 1 0 4 2 1 5 6 4 1 6 4 1 6 4 1 13 8 6 3 7 4 1 7 4 1 15 3 2 2 1 1 0 1 1 0 4 6 3 2 4 1 1 4 1 1 6 7 4 1 8 6 3 7 4 1 15 1 1 0 3 2 2 1 1 0 4 4 1 1 6 3 2 4 1 1 6 11 5 2 11 5 2 12 7 4 21 8 5 1 8 5 1 10 6 3 19 5 2 1 5 2 1 7 4 2 10 15 6 4 15 6 4 15 6 4 22 18 9 6 16 7 4 16 7 4 27 6 3 3 4 1 1 4 1 1 6 9 6 3 7 4 1 7 4 1 15 16 7 4 18 9 6 16 7 4 27 4 1 1 6 3 3 4 1 1 6 7 4 1 9 6 3 7 4 1 15 23 11 5 23 11 5 25 13 7 42 20 8 5 20 8 5 22 10 7 33 11 5 2 11 5 2 13 7 4 21 27 15 6 27 15 6 27 15 6 51 33 19 9 31 16 7 31 16 7 58 9 6 4 7 4 1 7 4 1 15 19 9 6 16 7 4 16 7 4 27 31 16 7 33 19 9 31 16 7 58 7 4 1 9 6 4 7 4 1 15 16 7 4 19 9 6 16 7 4 27 47 23 11 47 23 11 49 26 13 85 38 20 8 38 20 8 40 22 11 73 23 11 5 23 11 5 26 13 7 42 58 27 15 58 27 15 58 27 15 96 67 34 19 65 31 16 65 31 16 112 19 9 7 16 7 4 16 7 4 27 34 19 9 31 16 7 31 16 7 58 65 31 16 67 34 19 65 31 16 112 16 7 4 19 9 7 16 7 4 27 31 16 7 34 19 9 31 16 7 58 96 47 23 96 47 23 98 50 26 170 81 38 20 81 38 20 84 40 23 139 47 23 11 47 23 11 50 26 13 85 112 58 27 112 58 27 112 58 27 201 131 68 34 128 65 31 128 65 31 229 34 19 10 31 16 7 31 16 7 58 68 34 19 65 31 16 65 31 16 112 128 65 31 131 68 34 128 65 31 229 31 16 7 34 19 10 31 16 7 58 65 31 16 68 34 19 65 31 16 112 193 96 47 193 96 47 196 99 50 341 159 81 38 159 81 38 162 84 41 287 96 47 23 96 47 23 99 50 26 170 229 112 58 229 112 58 229 112 58 394 263 132 68 260 128 65 260 128 65 453 68 34 20 65 31 16 65 31 16 112 132 68 34 128 65 31 128 65 31 229 260 128 65 263 132 68 260 128 65 453 65 31 16 68 34 20 65 31 16 112 128 65 31 132 68 34 128 65 31 229 388 193 96 388 193 96 391 197 99 682 325 159 81 325 159 81 328 162 85 565 193 96 47 193 96 47 197 99 50 341 453 229 112 453 229 112 453 229 112 799 :[font = input; initialization; preserveAspect] *) 6 flights are the least number of flights large enough to get between any pair of states, since 6 is the least power-sum of A without any zero entries. (* :[font = input; initialization; preserveAspect] *) Problems on Coding Theory (* :[font = input; initialization; preserveAspect; startGroup] *) codeMtx=Array[Min,{5,5}] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{1, 1, 1, 1, 1}, {1, 2, 2, 2, 2}, {1, 2, 3, 3, 3}, {1, 2, 3, 4, 4}, {1, 2, 3, 4, 5}}] ;[o] 1 1 1 1 1 1 2 2 2 2 1 2 3 3 3 1 2 3 4 4 1 2 3 4 5 :[font = input; initialization; preserveAspect] *) Clear[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z]; S=" "; P="."; Q="?"; charLst={S,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o, \ p,q,r,s,t,u,v,w,x,y,z,P,Q}; (* :[font = input; initialization; preserveAspect] *) Problem 1 (* :[font = input; initialization; preserveAspect; startGroup] *) msgLst={w,h,a,t,S,i,s,S,t,h,e,S,o,p,e,n,i,n,g,S, \ l,i,n,e,S,o,f,S,m,o,b,y,S,d,i,c,k,Q,S,S}; msgMtx=Partition[msgLst,8] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{w, h, a, t, " ", i, s, " "}, {t, h, e, " ", o, p, e, n}, {i, n, g, " ", l, i, n, e}, {" ", o, f, " ", m, o, b, y}, {" ", d, i, c, k, "?", " ", " "}}] ;[o] w h a t i s t h e o p e n i n g l i n e o f m o b y d i c k ? :[font = input; initialization; preserveAspect; startGroup] *) Do[numeric[charLst[[ii+1]]]=ii,{ii,0,28}] nMsgMtx=Map[numeric,msgMtx,{2}] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{23, 8, 1, 20, 0, 9, 19, 0}, {20, 8, 5, 0, 15, 16, 5, 14}, {9, 14, 7, 0, 12, 9, 14, 5}, {0, 15, 6, 0, 13, 15, 2, 25}, {0, 4, 9, 3, 11, 28, 0, 0}}] ;[o] 23 8 1 20 0 9 19 0 20 8 5 0 15 16 5 14 9 14 7 0 12 9 14 5 0 15 6 0 13 15 2 25 0 4 9 3 11 28 0 0 :[font = input; initialization; preserveAspect; startGroup] *) cnMsgMtx=codeMtx.nMsgMtx (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{52, 49, 28, 23, 51, 77, 40, 44}, {81, 90, 55, 26, 102, 145, 61, 88}, {90, 123, 77, 29, 138, 197, 77, 118}, {90, 142, 92, 32, 162, 240, 79, 143}, {90, 146, 101, 35, 173, 268, 79, 143}}] ;[o] 52 49 28 23 51 77 40 44 81 90 55 26 102 145 61 88 90 123 77 29 138 197 77 118 90 142 92 32 162 240 79 143 90 146 101 35 173 268 79 143 :[font = input; initialization; preserveAspect] *) Problem 2 (* :[font = input; initialization; preserveAspect] *) cnMsgMtx={{24,29,54,38,6,27,36}, \ {48,58,88,68,7,54,72}, \ {60,78,108,93,8,72,89}, \ {72,98,128,118,9,90,106}, \ {81,117,136,131,10,95,118}}; (* :[font = input; initialization; preserveAspect; startGroup] *) nMsgMtx=Inverse[codeMtx].cnMsgMtx (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{0, 0, 20, 8, 5, 0, 0}, {12, 9, 14, 5, 0, 9, 19}, {0, 0, 0, 0, 0, 0, 0}, {3, 1, 12, 12, 0, 13, 5}, {9, 19, 8, 13, 1, 5, 12}}] ;[o] 0 0 20 8 5 0 0 12 9 14 5 0 9 19 0 0 0 0 0 0 0 3 1 12 12 0 13 5 9 19 8 13 1 5 12 :[font = input; initialization; preserveAspect; startGroup] *) Do[alpha[ii]=charLst[[ii+1]],{ii,0,28}] msgMtx=Map[alpha,nMsgMtx,{2}] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{" ", " ", t, h, e, " ", " "}, {l, i, n, e, " ", i, s}, {" ", " ", " ", " ", " ", " ", " "}, {c, a, l, l, " ", m, e}, {i, s, h, m, a, e, l}}] ;[o] t h e l i n e i s c a l l m e i s h m a e l :[font = input; initialization; preserveAspect; startGroup] *) msgLst={{""}}; Do[msgLst[[1]]=Join[msgLst[[1]],msgMtx[[ii]]],{ii,1,5}] msgLst//TableForm (* :[font = output; output; inactive; preserveAspect; endGroup] TableForm[{{"", " ", " ", t, h, e, " ", " ", l, i, n, e, "\ ", i, s, " ", " ", " ", " ", " ", " ", " ", c, a, l, l\ , " ", m, e, i, s, h, m, a, e, l}}] ;[o] t h e l i n e i s c a l l m e i s h m a e l :[font = input; initialization; preserveAspect] *) Problem 3 (* :[font = input; initialization; preserveAspect; startGroup] *) msgLst={t,h,i,s,S,i,s,S,t,h,e,S,e,n,d,S,o,f,S,t, \ h,e,S,c,h,a,p,t,e,r,P,S,k,e,e,p,S,g,o,i, \ n,g,",",S,i,t,S,g,e,t,s,S,e,v,e,n,S,b,e, \ t,t,e,r,P,S}; msgMtx=Partition[msgLst,13] (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{t, h, i, s, " ", i, s, " ", t, h, e, " ", e}, {n, d, " ", o, f, " ", t, h, e, " ", c, h, a}, {p, t, e, r, ".", " ", k, e, e, p, " ", g, o}, {i, n, g, ",", " ", i, t, " ", g, e, t, s, " "}, {e, v, e, n, " ", b, e, t, t, e, r, ".", " "}}] ;[o] t h i s i s t h e e n d o f t h e c h a p t e r . k e e p g o i n g , i t g e t s e v e n b e t t e r . :[font = input; initialization; preserveAspect; startGroup] *) numeric[","]=29; nMsgMtx=Map[numeric,msgMtx,{2}]; cnMsgMtx=codeMtx.nMsgMtx (* :[font = output; output; inactive; preserveAspect; endGroup] MatrixForm[{{64, 68, 26, 95, 33, 20, 75, 33, 57, 34, 46, 61, 21}, {108, 128, 43, 171, 66, 31, 131, 66, 94, 60, 87, 122, 37}, {138, 184, 60, 232, 93, 42, 167, 91, 126, 86, 125, 175, 52}, {152, 220, 72, 275, 93, 53, 192, 111, 153, 96, 163, 221, 52}, {157, 242, 77, 289, 93, 55, 197, 131, 173, 101, 181, 248, 52}}] ;[o] 64 68 26 95 33 20 75 33 57 34 46 61 21 108 128 43 171 66 31 131 66 94 60 87 122 37 138 184 60 232 93 42 167 91 126 86 125 175 52 152 220 72 275 93 53 192 111 153 96 163 221 52 157 242 77 289 93 55 197 131 173 101 181 248 52 ^*)