(************** Content-type: application/mathematica ************** Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 38758, 1100]*) (*NotebookOutlinePosition[ 39731, 1136]*) (* CellTagsIndexPosition[ 39638, 1129]*) (*WindowFrame->Normal*) Notebook[{ Cell["\<\ Go through Parts I and II of this notebook. Answer all the questions posed. On the You Try It for Parts I and II, you MUST insert your own NEW values or \ functions. Print out your results and attach to a 1-page summary of what you learned \ from this lab. Go through Parts III and IV and be prepared to discuss what you observe in \ class. Go through Part V and think back on what you learned last year about \ eigenvalues and eigenvectors. Don't worry about understanding all of it, but \ consider how different this linear algebra approach is from the numerical \ approach. We will revisit that part next semester.\ \>", "Subsubtitle"], Cell[CellGroupData[{ Cell["\<\ Putting a Scene in Three Dimensions onto a Two-Dimensional Canvas\ \>", "Title"], Cell[TextData[{ StyleBox["Chapter 10, Section 3, Exercise 61 and extension\n", FontFamily->"Arial", FontSize->16, FontWeight->"Bold"], StyleBox["Perspectives in Computer Graphics:\nIn computer graphics and \ perspective drawing, we need to represent objects seen by the eye in space as \ images on a two-dimensional plane. Suppose that the eye is at ", FontFamily->"Times New Roman", FontVariations->{"CompatibilityType"->0}], StyleBox["E", FontFamily->"Arial", FontSlant->"Italic", FontVariations->{"CompatibilityType"->0}], StyleBox["(", FontFamily->"Arial", FontVariations->{"CompatibilityType"->0}], Cell[BoxData[ \(TraditionalForm\`x\_0\)], FontSlant->"Italic", FontVariations->{"CompatibilityType"->0}], StyleBox[", 0, 0) and that we want to represent a point ", FontVariations->{"CompatibilityType"->0}], Cell[BoxData[ \(TraditionalForm\`P\_1\)]], "(", Cell[BoxData[ \(TraditionalForm\`x\_1\)]], ", ", Cell[BoxData[ \(TraditionalForm\`y\_1\)]], ", ", Cell[BoxData[ \(TraditionalForm\`z\_1\)]], ") as a point on the yz-plane. We do this by projecting ", Cell[BoxData[ \(TraditionalForm\`P\_1\)]], "onto the plane with a ray from E. The point ", Cell[BoxData[ \(TraditionalForm\`P\_1\)]], "will be portrayed as the point ", StyleBox["P ", FontSlant->"Italic"], "(0", StyleBox[", y, z", FontSlant->"Italic"], ")", StyleBox[". ", FontSlant->"Italic"], "The problem for us a graphics designers is to find y and z given ", StyleBox["E", FontSlant->"Italic"], " and ", Cell[BoxData[ \(TraditionalForm\`P\_1\)]], ".\nWrite a vector equation that holds between the vector ", StyleBox["EP", FontWeight->"Bold", FontSlant->"Italic"], " and the vector ", StyleBox["E", FontWeight->"Bold", FontSlant->"Italic"], Cell[BoxData[ \(TraditionalForm\`P\_1\)]], ". Use the equation to express ", StyleBox["y", FontSlant->"Italic"], " and ", StyleBox["z", FontSlant->"Italic"], " in terms of ", Cell[BoxData[ \(TraditionalForm\`x\_0\)], FontSlant->"Italic", FontVariations->{"CompatibilityType"->0}], ", ", Cell[BoxData[ \(TraditionalForm\`x\_1\)]], ", ", Cell[BoxData[ \(TraditionalForm\`y\_1\)]], ", ", Cell[BoxData[ \(TraditionalForm\`z\_1\)]], ".\nTest the formulas obtained for ", StyleBox["y", FontSlant->"Italic"], " and ", StyleBox["z", FontSlant->"Italic"], " by investigating their behavior at ", Cell[BoxData[ \(TraditionalForm\`x\_1\)]], " = 0 and at ", Cell[BoxData[ \(TraditionalForm\`x\_1\)]], "= ", Cell[BoxData[ \(TraditionalForm\`x\_0\)], FontSlant->"Italic", FontVariations->{"CompatibilityType"->0}], "\n", "See what happens when ", Cell[BoxData[ \(TraditionalForm\`x\_0\)], FontSlant->"Italic", FontVariations->{"CompatibilityType"->0}], "\[Rule]\[Infinity]." }], "Text"], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell["\<\ OBJECTIVE: Learn to use linear transformations to map points from three \ dimensions onto a two-dimensional space.\ \>", "Text"], Cell["\<\ Since time immemorial, artists have faced a problem that computer graphics \ artists are facing today, and that is how to picture three-dimensional \ objects on a two-dimensional plane. The representation of the objects may \ vary, depending on the position of the \"eye of the beholder.\" In the \ project that follows, we analyze two aspects of this problem. Both involve \ mapping points in three-dimensional space to a plane. Part I addresses a \ problem suggested in the text (Section 10.3, Exercise 61) in which the \ viewpoint belongs to a single beholder. The remainder of the lab focuses on \ parallel projections that resemble a situation in which the results of X-rays \ demonstrate the need for a CAT-Scan. The linear algebra behind such mappings \ is introduced in Part V.\ \>", "Text"], Cell[CellGroupData[{ Cell["Technology Guidelines", "Subsection", CellDingbat->"\[LightBulb]"], Cell[TextData[{ StyleBox["NOTE: If you have just finished a module, restart ", CellFrame->True, Background->None], StyleBox["Mathematica", CellFrame->True, FontSlant->"Italic", Background->None], StyleBox[ " before executing a new module.\nTO OPEN CELLS, put your cursor on the \ right cell bracket and double click.", CellFrame->True, Background->None], "\nTO STOP AN EXECUTION\n\tSelect the ", StyleBox["Kernel", FontSlant->"Italic"], " pull-down menu and click on ", StyleBox["Abort Evaluation.\n", FontSlant->"Italic"], "ORDER OF EXECUTION\n\tExecute cells in the order given. Do not skip any \ Input cells within a given notebook.\nSAVING NOTEBOOKS\n\tYou can save \ anytime to any directory you choose, and it is wise to save often.\n\t\ However, before you do your final save, delete all your output by selecting \ the \n\t ", StyleBox["Delete All Output", FontSlant->"Italic"], " selection under the ", StyleBox["Kernel", FontSlant->"Italic"], " pull-down menu.\nEXPERIENCING MAJOR PROBLEMS\n\tSave if appropriate, and \ then shut down ", StyleBox["Mathematica", FontSlant->"Italic"], " and start it up again." }], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Part I: Mapping to the ", Cell[BoxData[ \(TraditionalForm\`Y - Z\)]], " Plane from a Single Point" }], "Section"], Cell[TextData[{ "\nFirst, consider the problem from the text, where all points are mapped \ to the y-z plane. The viewer is at the point (", Cell[BoxData[ \(x\_0\)]], ", 0, 0), and any point (", Cell[BoxData[ \(TraditionalForm\`x, \ y, \ z\)]], ") between the viewer and the ", Cell[BoxData[ \(TraditionalForm\`y - z\)]], " plane appears at the point ", Cell[BoxData[ \(TraditionalForm\`\(\((0, \ t\ y, \ t\ z)\)\(\ \)\)\)]], "on the ", Cell[BoxData[ \(TraditionalForm\`\(\(y\)\(-\)\(z\)\(\ \)\)\)]], "plane, where", StyleBox[" t ", FontSlant->"Italic"], "will be a function of the viewer's position and the ", StyleBox["x", FontSlant->"Italic"], "-coordinate of the point in 3-space. Verify that ", Cell[BoxData[ \(TraditionalForm\`t\ = \ x\_0\/\(x\_0\ - \ x\)\)]], ".\nThe following commands demonstrate this mapping by computing image \ points as specified after randomly generating points in the domain that lie \ between the observer and the", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(\(y\)\(-\)\(z\)\(\ \)\)\)\)]], "plane." }], "Text"], Cell[BoxData[{ \(Off[General::spell]\ \), "\n", \(Off[General::spell1]\ \), "\n", \(Clear[x, y, z, x0, t, newx, newy, newz, domain, image]\), "\n", \(Print["\", numberofpoints = 1000]\), "\n", \(\(x0 = 500;\)\), "\n", \(t[x_, x0_] := x0/\((x0 - x)\)\), "\n", \(newx[x_, y_, z_] := 0\), "\n", \(newy[x_, y_, z_] := t[x, x0]\ y\), "\n", \(newz[x_, y_, z_] := t[x, x0]\ z\), "\n", \(\(domain = Table[{Random[Real, {0, 100}], Random[Real, {\(-100\), 100}], Random[Real, {\(-100\), 100}]}, {i, 1, numberofpoints}];\)\), "\n", \(\(image = Table[{newx[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newy[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newz[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]]}, {i, 1, Length[domain]}];\)\), "\n", \(\(partimage = Table[image[\([i]\)], {i, 1, 10}];\)\), "\n", \(\(PrependTo[ partimage, {"\", "\", "\"}];\)\), "\n", \(Print["\", partimage // TableForm]\)}], "Input"], Cell[TextData[{ "To view the points in the image, first load a graphics package. This \ command must be executed before using the ", StyleBox["ScatterPlot3D ", FontWeight->"Bold"], "command." }], "Text"], Cell[BoxData[ \(\(\(<< Graphics`Graphics3D`\)\(\ \ \)\)\)], "Input"], Cell[BoxData[ \(\(sp = ScatterPlot3D[image, PlotStyle -> PointSize[ .01]]\ \ ;\)\)], "Input"], Cell[TextData[{ "Let's suppose that there is an object in the region bounded approximately \ by ", Cell[BoxData[ FormBox[ RowBox[{"z", "=", RowBox[{"100", "-", RowBox[{"0.5", FormBox[\(\@\(x\^2 + y\^2\)\), "TraditionalForm"]}]}]}], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ RowBox[{"z", "=", RowBox[{"0", FormBox[\( .005 \((x\^2 + y\^2\)\), "TraditionalForm"]}]}], ")"}], "."}], TraditionalForm]]], " We will first plot the object in three-space and then separate out the \ image points that have been mapped from that region and plot them in pink. We \ must first load a different graphing package." }], "Text"], Cell[BoxData[ \(<< Graphics`ParametricPlot3D`\)], "Input"], Cell[BoxData[{ \(Clear[r]\), "\n", \(\(p1 = CylindricalPlot3D[100 - .5 r, {r, 0, 100}, {\[Theta], 0, 2 \[Pi]}, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(p2 = CylindricalPlot3D[ .005 r\^2, {r, 0, 100}, {\[Theta], 0, 2 \[Pi]}, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(Show[p1, p2, DisplayFunction \[Rule] $DisplayFunction, ViewPoint -> {\(-0.637\), \ \(-0.917\), \ \(-0.018\)}];\)\), "\n", \(\(listout = {};\)\), "\n", \(\(listin = {};\)\), "\n", \(Do[\ If[domain[\([i, 3]\)] < 100 - .5 Sqrt[\((domain[\([i, 1]\)])\)\^2 + \((domain[\([i, \ 2]\)])\)\^2]\ && domain[\([i, 3]\)] > .005 \((\((domain[\([i, 1]\)])\)\^2 + \ \((domain[\([i, 2]\)])\)\^2)\), AppendTo[ listin, {image[\([i, 1]\)], image[\([i, 2]\)], image[\([i, 3]\)]}], AppendTo[ listout, {image[\([i, 1]\)], image[\([i, 2]\)], image[\([i, 3]\)]}]], {i, 1, Length[domain]}]\), "\n", \(\(pout = ScatterPlot3D[listout, DisplayFunction -> Identity];\)\), "\n", \(\(pin = ScatterPlot3D[listin, PlotStyle -> {RGBColor[1, 0, 1], PointSize[ .02]}, DisplayFunction -> Identity];\)\), "\n", \(\(Show[pin, pout, DisplayFunction -> $DisplayFunction];\)\)}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Part I", "Section"], Cell[TextData[{ "If you had a parallel projection onto the ", Cell[BoxData[ \(TraditionalForm\`y - z\)]], " plane, any (", Cell[BoxData[ \(TraditionalForm\`x, \ y, \ z\)]], ") would map to (", Cell[BoxData[ \(TraditionalForm\`0, \ y, \ z\)]], "). In the above problem, let ", Cell[BoxData[ FormBox[ StyleBox[\(x\_0\), FontSlant->"Italic"], TraditionalForm]]], " get larger and larger, and compare your image points to your domain \ points to see if you are approaching this state. Do this by making the number \ in red bigger and bigger." }], "Text"], Cell[BoxData[{ RowBox[{\(Off[General::spell]\), " "}], "\n", RowBox[{\(Off[General::spell1]\), " "}], "\n", \(Clear[x, y, z, x0, t, newx, newy, newz, domain, image]\), "\n", \(Print["\", numberofpoints = 100]\), "\n", RowBox[{ RowBox[{"x0", "=", StyleBox["10000", FontColor->RGBColor[1, 0, 0]]}], ";", "\n", \(t[x_, x0_] := x0/\((x0 - x)\)\)}], "\n", \(newx[x_, y_, z_] := 0\), "\n", \(newy[x_, y_, z_] := t[x, x0]\ y\), "\n", \(newz[x_, y_, z_] := t[x, x0]\ z\), "\n", \(domain = Table[{Random[Real, {0, 100}], Random[Real, {\(-100\), 100}], Random[Real, {\(-100\), 100}]}, {i, 1, numberofpoints}];\), "\n", \(image = Table[{newx[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newy[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newz[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]]}, {i, 1, Length[domain]}];\), "\n", \(Clear[ list]\), "\n", \(list = Table[{domain[\([i, j]\)], image[\([i, j]\)]}, {i, 1, 10}, {j, 1, 3}];\), "\n", \(PrependTo[ list, {"\", "\", "\"}];\), "\n", \(Print["\", list // TableForm\ ]\)}], "Input"], Cell[TextData[{ "Are your image values for ", StyleBox["y", FontSlant->"Italic"], " and ", StyleBox["z", FontSlant->"Italic"], " close to your domain values for ", StyleBox["y", FontSlant->"Italic"], " and ", StyleBox["z", FontSlant->"Italic"], " respectively?" }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Part II: Parallel Mapping to Any Plane Using a Linear Transformation - \ Identifying the Image\ \>", "Section"], Cell[TextData[{ "We now consider another type of linear mapping onto a plane. Instead of \ projections from a single point, we consider parallel projections onto a \ plane. You could think of this as a generalization of the above case, where \ the beholder moves farther and farther away (", Cell[BoxData[ \(TraditionalForm\`x\_0\)]], "\[Rule]\[Infinity]). Your domain is the set of all points in \ three-dimensional space. Begin by finding the image for several points in \ your domain, and use any three of these distinct noncollinear points in your \ image to write the equation of the plane in which they lie. Verify that other \ image points you found satisfy the equation of this plane, and then plot the \ image to verify visually that the image is a plane. " }], "Text"], Cell[TextData[{ "The transformation described below is defined as follows: \n", Cell[BoxData[ \(TraditionalForm\`newx\ \ \ = \ \ \ \ \(x\ + \ \ \ y\ + \ 2 z\ \tnewy\ \ = \ \ \(2 x\ + \ \ \ y\ \ - \ \ \ z\ \tnewz\ \ = \ \ 3 x\ + \ 2 y\ \ + \ \ z\)\)\)]], "\nOther transformations will work, provided that exactly one of the \ right-hand functions can be written as a linear combination of the other two. \ In this case, the first right-hand side function equals the third one minus \ the second one. This restriction guarantees that all your image points will \ lie in a plane.\nWithout loss of generality, we focus on domain points with \ integer coordinates between ", Cell[BoxData[ \(TraditionalForm\`\(-100\)\)]], " and ", Cell[BoxData[ \(TraditionalForm\`100\)]], ". We use integers to avoid making roundoff errors when we check to see \ that image points lie on the plane. One-thousand image points are computed, \ and all are plotted, but only the first 10 are listed." }], "Text"], Cell[BoxData[{ \(Clear[x, y, z, newx, newy, newz, domain, image]\), "\n", \(newx[x_, y_, z_] := x + y + 2 z\), "\n", \(newy[x_, y_, z_] := 2 x + y - z\), "\n", \(newz[x_, y_, z_] := 3 x + 2 y + z\), "\n", \(Print["\", numberofpoints = 1000]\), "\n", \(\(domain = Table[{Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}]}, {i, 1, numberofpoints}];\)\), "\n", \(\(image = Table[{newx[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newy[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newz[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]]}, {i, 1, Length[domain]}];\)\), "\n", \(Clear[partimage]\), "\n", \(\(partimage = Table[image[\([i]\)], {i, 1, 10}];\)\), "\n", \(\(PrependTo[ partimage, {"\", "\", "\"}];\)\), "\n", \(Print["\"]\), "\[IndentingNewLine]", \ \(Print[partimage // TableForm]\)}], "Input"], Cell["\<\ To determine the equation of the plane in which the first three image points \ lie, we specify two vectors in the plane and compute their cross product. \ Knowing that one point in the image is {0, 0, 0} guarantees that the plane \ passes through the origin.\ \>", "Text"], Cell[BoxData[{ \(\(vector1 = image[\([1]\)] - image[\([2]\)];\)\), "\n", \(\(vector2 = image[\([1]\)] - image[\([3]\)];\)\), "\n", \(\(normal = Cross[vector1, vector2];\)\), "\n", \(Print["\", normaltoplane = normal/normal[\([1]\)]]\), "\n", \(Clear[x, y, z]\), "\n", \(Print["\", equationofplane[x_, y_, z_] = normaltoplane[\([1]\)] x + normaltoplane[\([2]\)] y + normaltoplane[\([3]\)] z == 0]\t\)}], "Input"], Cell["\<\ Check to see if all points you found in the domain satisfy the equation of \ the plane. We start our iterator at 0 and then increase it by one each time \ an image point satisfies the equation of the plane.\ \>", "Text"], Cell[BoxData[{ \(\(works = 0;\)\), "\n", \(Do[If[ equationofplane[image[\([i, 1]\)], image[\([i, 2]\)], image[\([i, 3]\)]], works = works + 1], {i, 1, Length[image]}]\ \), "\n", \(works\ \)}], "Input"], Cell["\<\ It looks as though, as predicted, every point in the image lies on the \ specified plane.\ \>", "Text"], Cell["\<\ To view the points in the image, first load a graphics package if you have \ not done so previously. \ \>", "Text"], Cell[BoxData[ \(\(\(<<\)\(Graphics`Graphics3D`\)\(\ \ \)\)\)], "Input"], Cell[BoxData[ \(\(sp = ScatterPlot3D[image, PlotStyle -> PointSize[ .01]]\ ;\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Part II", "Section"], Cell[TextData[{ "Try the transformation described below: \n\t", Cell[BoxData[ \(TraditionalForm\`newx\ \ \ = \ \ \(2 x\ + \ 2 y\ + \ \ \ z\ \tnewy\ \ = \ \ \(4 x\ + \ 4 y\ \ - \ 7 z\ \tnewz\ \ = \ \ 3 x\ + \ 3 y\ \ + \ 9 z\)\)\)]], "\nChange the expressions in red." }], "Text"], Cell[BoxData[{\(Clear[x, y, z, newx, newy, newz, domain, image]\), "\n", RowBox[{\(newx[x_, y_, z_]\), ":=", StyleBox[\(x + y + 2 z\), FontColor->RGBColor[1, 0, 0]]}], "\n", RowBox[{\(newy[x_, y_, z_]\), ":=", StyleBox[\(2 x + y - z\), FontColor->RGBColor[1, 0, 0]]}], "\n", RowBox[{\(newz[x_, y_, z_]\), ":=", StyleBox[\(3 x + 2 y + z\), FontColor->RGBColor[1, 0, 0]]}], "\n", \(Print["\", numberofpoints = 1000]\), "\n", \(domain = Table[{Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}]}, {i, 1, numberofpoints}];\), "\n", \(image = Table[{newx[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newy[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newz[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]]}, {i, 1, Length[domain]}];\), "\n", \(Clear[ partimage]\), "\n", \(partimage = Table[image[\([i]\)], {i, 1, 10}];\), "\n", \(PrependTo[ partimage, {"\", "\", "\"}];\), "\n", \(Print["\"]\), \ "\[IndentingNewLine]", \(Print[partimage // TableForm]\)}], "Input"], Cell["Find the plane in which the image points lie.", "Text"], Cell[BoxData[{ \(\(vector1 = image[\([1]\)] - image[\([2]\)];\)\), "\n", \(\(vector2 = image[\([1]\)] - image[\([3]\)];\)\), "\n", \(\(normal = Cross[vector1, vector2];\)\), "\n", \(Print["\", normaltoplane = normal/normal[\([1]\)]]\), "\n", \(Clear[x, y, z]\), "\n", \(Print["\", equationofplane[x_, y_, z_] = normaltoplane[\([1]\)] x + normaltoplane[\([2]\)] y + normaltoplane[\([3]\)] z == 0]\t\)}], "Input"], Cell["\<\ Check to see if all points you found in the domain satisfy the equation of \ the plane. Start your iterator at 0 and then increase it by one each time an \ image point satisfies the equation of the plane.\ \>", "Text"], Cell[BoxData[{ \(\(works = 0;\)\), "\n", \(Do[If[ equationofplane[image[\([i, 1]\)], image[\([i, 2]\)], image[\([i, 3]\)]], works = works + 1], {i, 1, Length[image]}]\ \), "\n", \(works\ \)}], "Input"], Cell["Does every point in the image lie on the plane specified?", "Text"], Cell["\<\ To view the points in the image, load a graphics package if you have not done \ so previously. \ \>", "Text"], Cell[BoxData[ \(\(\(<<\)\(Graphics`Graphics3D`\)\(\ \ \)\)\)], "Input"], Cell[BoxData[ \(\(sp = ScatterPlot3D[image, PlotStyle -> PointSize[ .01]]\ ;\)\)], "Input"], Cell["\<\ Do your points look as though they lie on a plane? If not, can you see where \ there is a problem?\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Part III: Analyzing the Mapping", "Section"], Cell[TextData[{ "We return to the first mapping defined in Part II. Identify the points in \ the domain that map to the origin ", Cell[BoxData[ \(TraditionalForm\`\(\(O {0, \ 0, \ 0}\)\(,\)\)\)]], " and verify that they all lie along the same line. Write the equations for \ this line. " }], "Text"], Cell[BoxData[{ \(Off[Solve::svars]\), "\n", \(Clear[x, y, z, newx, newy, newz, domain, image]\), "\n", \(newx[x_, y_, z_] := x + y + 2 z\), "\n", \(newy[x_, y_, z_] := 2 x + y - z\), "\n", \(newz[x_, y_, z_] := 3 x + 2 y + z\), "\n", \(maptoO = Solve[{newx[x, y, z] == 0, newy[x, y, z] == 0, newz[x, y, z] == 0}, {x, y, z}]\)}], "Input"], Cell[TextData[{ "Now select another point in the image, say ", Cell[BoxData[ \(TraditionalForm\`\(\(P {10, \(-20\), \(-10\)}\)\(,\)\)\)]], " and find the domain points that map to P. Note that they all fall along a \ line, and observe how this line is related to the line of points that map to \ the origin." }], "Text"], Cell[BoxData[ \(maptoP = Solve[{newx[x, y, z] == 10, newy[x, y, z] == \(-20\), newz[x, y, z] == \(-10\)}, {x, y, z}]\)], "Input"], Cell[TextData[{ "Check this out for another point in the image ", Cell[BoxData[ \(TraditionalForm\`Q \((\(-40\), 70, 30)\)\)]], " and see if you can make a generalization about the mapping in terms of \ sets of points in the domain that map to a given point in the image." }], "Text"], Cell[BoxData[ \(maptoQ = Solve[{newx[x, y, z] == \(-40\), newy[x, y, z] == 70, newz[x, y, z] == 30}, {x, y, z}]\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Part IV: Application to Medical X-Ray and CAT-Scan Technologies\ \>", "Section"], Cell["\<\ We will now demonstrate how points within a tumor would show on an X-ray \ slide.\ \>", "Text"], Cell[BoxData[{ \(Clear[x, y, z, newx, newy, newz, domain, image, listin, listout, pin, pout]\), "\n", \(newx[x_, y_, z_] := x + y + 2 z\), "\n", \(newy[x_, y_, z_] := 2 x + y - z\), "\n", \(newz[x_, y_, z_] := 3 x + 2 y + z\), "\n", \(Print["\", numberofpoints = 1000]\), "\n", \(\(domain = Table[{Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}]}, {i, 1, numberofpoints}];\)\), "\n", \(\(image = Table[{newx[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newy[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newz[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]]}, {i, 1, Length[domain]}];\)\), "\n", \(Clear[partimage]\), "\n", \(\(partimage = Table[image[\([i]\)], {i, 1, 10}];\)\), "\n", \(\(PrependTo[ partimage, {"\", "\", "\"}];\)\), "\n", \(Print["\"]\), "\[IndentingNewLine]", \ \(Print[partimage // TableForm]\)}], "Input"], Cell[TextData[{ "Let's suppose that there is a tumor in the region bounded approximately by \ ", Cell[BoxData[ FormBox[ RowBox[{"z", " ", "=", " ", RowBox[{"100", " ", "-", RowBox[{"0.5", FormBox[\(\@\(x\^2 + y\^2\)\), "TraditionalForm"]}]}]}], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ RowBox[{"z", " ", "=", " ", FormBox[\( .005 \((x\^2 + y\^2\)\), "TraditionalForm"]}], ")"}], "."}], TraditionalForm]]], " We will first plot the object in three-space and then separate out the \ image points that have been mapped to that region and plot them in green. We \ must first load two graphing packages if not already loaded." }], "Text"], Cell[BoxData[ \(<< Graphics`ParametricPlot3D`\)], "Input"], Cell[BoxData[ \(\(\(<<\)\(Graphics`Graphics3D`\)\(\ \ \)\)\)], "Input"], Cell[BoxData[{ \(Clear[r]\), "\n", \(\(p1 = CylindricalPlot3D[100 - .5 r, {r, 0, 100}, {\[Theta], 0, 2 \[Pi]}, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(p2 = CylindricalPlot3D[ .005 r\^2, {r, 0, 100}, {\[Theta], 0, 2 \[Pi]}, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(Show[p1, p2, DisplayFunction \[Rule] $DisplayFunction, ViewPoint -> {\(-0.637\), \ \(-0.917\), \ \(-0.018\)}];\)\), "\n", \(\(listout = {};\)\), "\n", \(\(listin = {};\)\), "\n", \(Do[\ If[domain[\([i, 3]\)] < 100 - .5 Sqrt[\((domain[\([i, 1]\)])\)\^2 + \((domain[\([i, \ 2]\)])\)\^2]\ && domain[\([i, 3]\)] > .005 \((\((domain[\([i, 1]\)])\)\^2 + \ \((domain[\([i, 2]\)])\)\^2)\), AppendTo[ listin, {image[\([i, 1]\)], image[\([i, 2]\)], image[\([i, 3]\)]}], AppendTo[ listout, {image[\([i, 1]\)], image[\([i, 2]\)], image[\([i, 3]\)]}]], {i, 1, Length[domain]}]\), "\n", \(\(pout = ScatterPlot3D[listout, DisplayFunction -> Identity];\)\), "\n", \(\(pin = ScatterPlot3D[listin, PlotStyle -> {RGBColor[0, 1, 0], PointSize[ .02]}, DisplayFunction -> Identity];\)\), "\n", \(\(Show[pin, pout, DisplayFunction -> $DisplayFunction];\)\)}], "Input"], Cell[TextData[{ "Suppose, for example, that a spot is found at the image point T1 (", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox[Cell[""], FontSlant->"Italic"], "10"}], ",", "20", ",", "30"}], TraditionalForm]]], Cell[BoxData[ \(TraditionalForm\`)\)]], ". What does that tell you about the location of the possible growth? Based \ on this image, you cannot precisely identify the placement of the tumor, \ because this mapping is NOT one-to-one." }], "Text"], Cell[BoxData[ \(maptoT1 = Solve[{newx[x, y, z] == 10, newy[x, y, z] == 20, newz[x, y, z] == 30}, {x, y, z}]\)], "Input"], Cell["\<\ Since this result gives you some information, but not enough, you must take \ another X-ray from a different angle. We will set up a mapping from a different perspective. In the example given \ below, we plot the new perspective and verify that the points all map to a \ plane.\ \>", "Text"], Cell[BoxData[{ \(Clear[x, y, z, newx, newy, newz, domain, image, listin, listout, pin, pout]\), "\n", \(newx[x_, y_, z_] := \(-x\) + y\), "\n", \(newy[x_, y_, z_] := 2 x - 3 y + 2 z\), "\n", \(newz[x_, y_, z_] := \(-y\) + 2 z\), "\n", \(Print["\", numberofpoints = 1000]\), "\n", \(\(domain = Table[{Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}]}, {i, 1, numberofpoints}];\)\), "\n", \(\(image = Table[{newx[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newy[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]], newz[domain[\([i, 1]\)], domain[\([i, 2]\)], domain[\([i, 3]\)]]}, {i, 1, Length[domain]}];\)\), "\n", \(\(listout = {};\)\), "\n", \(\(listin = {};\)\), "\n", \(Do[\ If[domain[\([i, 3]\)] < 100 - .5 Sqrt[\((domain[\([i, 1]\)])\)\^2 + \((domain[\([i, \ 2]\)])\)\^2]\ && domain[\([i, 3]\)] > .005 \((\((domain[\([i, 1]\)])\)\^2 + \ \((domain[\([i, 2]\)])\)\^2)\), AppendTo[ listin, {image[\([i, 1]\)], image[\([i, 2]\)], image[\([i, 3]\)]}], AppendTo[ listout, {image[\([i, 1]\)], image[\([i, 2]\)], image[\([i, 3]\)]}]], {i, 1, Length[domain]}]\), "\n", \(\(pout = ScatterPlot3D[listout, DisplayFunction -> Identity];\)\), "\n", \(\(pin = ScatterPlot3D[listin, PlotStyle -> {RGBColor[0, 1, 0], PointSize[ .02]}, DisplayFunction -> Identity];\)\), "\n", \(\(Show[pin, pout, DisplayFunction -> $DisplayFunction];\)\)}], "Input"], Cell[TextData[{ "If you were somehow able to detect that the SAME spot now shows up on the \ image at ", Cell[BoxData[ \(TraditionalForm\`T2 \((\(-90\), 250, 70)\)\)]], ", would that tell you about the possible location of the tumor? As before, \ we can get information on the point in the domain that mapped to this image \ point." }], "Text"], Cell[BoxData[ \(maptoT2 = Solve[{newx[x, y, z] == \(-90\), newy[x, y, z] == 250, newz[x, y, z] == 70}, {x, y, z}]\)], "Input"], Cell["\<\ If we put this information together with the previous information, we can \ locate the point on the organ identified. Essentially, we are finding the \ intersection of two straight lines in three-dimensional space.\ \>", "Text"], Cell[BoxData[ \(var = Solve[{maptoT1[\([1, 1, 2]\)] == maptoT2[\([1, 1, 2]\)], maptoT1[\([1, 2, 2]\)] == maptoT2[\([1, 2, 2]\)]}, z]\)], "Input"], Cell[TextData[{ "Let's put this result for ", StyleBox["z", FontSlant->"Italic"], " into the specifications for the first line we found." }], "Text"], Cell[BoxData[{ \(Print["\", \((maptoT1[\([1, 1, 2]\)] /. var)\)[\([1]\)]]\), "\n", \(Print["\", \((maptoT1[\([1, 2, 2]\)] /. var)\)[\([1]\)]]\), "\n", \(Print["\", var[\([1, 1, 2]\)]]\)}], "Input"], Cell["\<\ This specifies one of the points in the three-dimensional object where the \ tumor is present. You should notice in the analysis above how difficult it is to identify the \ point in the second mapping that is the image of the SAME point as the one we \ first found. Because of this problem, many more than simply two X-rays would \ need to be taken to determine the precise location of a tumor The technology \ that makes this process feasible is called a CT-Scan, commonly referred to as \ a CAT-Scan. The procedure above reflects the fundamental mathematics used to \ interpret CAT-Scans.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Part V: Linear Algebra Approach (optional; not in calculus text)\ \>", "Section"], Cell[BoxData[ ButtonBox[ ButtonBox[ RowBox[{ StyleBox["\[MathematicaIcon]", FontWeight->"Bold", FontColor->RGBColor[0.792981, 0.777356, 0.144533], FontVariations->{"CompatibilityType"->0}], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["About", FontWeight->"Bold", FontColor->RGBColor[0.500008, 0, 0.500008]], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Mathematica", FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[0.500008, 0, 0.500008]]}], ButtonStyle->"Paste"], ButtonData:>"h1", ButtonStyle->"Hyperlink"]], "Input", Evaluatable->False, CellTags->"hb1"], Cell[BoxData[{ \(Clear[m, eig]\), "\n", \(\(m = {{1, 1, 2}, {2, 1, \(-1\)}, {3, 2, 1}};\)\), "\n", \(MatrixForm[m]\), "\n", \(\(eig = Eigensystem[m];\)\), "\n", \(Print["\", N[eig]]\), "\n", \(\(image = {};\)\), "\n", \(Do[{new = m . {Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}], Random[Integer, {\(-100\), 100}]}, AppendTo[image, new]}, {1000}]\ \)}], "Input"], Cell[TextData[{ "Note the presence of the 0 eigenvalue.\n\nThe kernel of a linear \ transformation is the set of elements in the domain that map to the 0 element \ ", Cell[BoxData[ \(TraditionalForm\`\((0, \ 0, \ 0)\)\)]], " in the image. " }], "Text"], Cell[BoxData[{ \(Clear[a, b, c]\), "\n", \(\(kernel = {a, b, c};\)\), "\n", \(solk = Solve[m . kernel == {0, 0, 0}, {a, b, c}]\)}], "Input"], Cell["\<\ If c = 1, note how this vector compares to the eigenvector associated with \ the eigenvalue of 0.\ \>", "Text"], Cell[BoxData[{ \(c = 1\), "\n", \(kernel /. solk\)}], "Input"], Cell["\<\ You can find the normal to the plane formed by the image by taking the cross \ product of the eigenvectors associated with the nonzero eigenvalues.\ \>", "Text"], Cell[BoxData[{ \(\(norm = Cross[eig[\([2, 2]\)], eig[\([2, 3]\)]];\)\), "\n", \(scalednorm = norm/norm[\([1]\)] // Simplify\)}], "Input"], Cell[TextData[StyleBox[ "Check to see if all the points in the image lie in the plane."]], "Text"], Cell[BoxData[{ \(\(works = 0;\)\), "\n", \(Do[If[ scalednorm[\([1]\)] image[\([i, 1]\)] + scalednorm[\([2]\)] image[\([i, 2]\)] + scalednorm[\([3]\)] image[\([i, 3]\)] == 0, works = works + 1], {i, 1, 1000}]\ \), "\n", \(works\ \)}], "Input"], Cell["\<\ What do you suppose the existence of a 0 eigenvalue has to do with the fact \ that the image points all lie in a plane, even though the domain consists of \ points in three dimensions?\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["\[MathematicaIcon]", FontWeight->"Bold", FontColor->RGBColor[0.792981, 0.777356, 0.144533], FontVariations->{"CompatibilityType"->0}], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["About", FontWeight->"Bold", FontColor->RGBColor[0.500008, 0, 0.500008]], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Mathematica", FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[0.500008, 0, 0.500008]] }], "Section", CellDingbat->None], Cell[TextData[{ "If you have studied linear algebra, you can learn in this section some of \ the behind-the-scenes mathematics in the study of linear transformations and \ how ", StyleBox["Mathematica", FontSlant->"Italic"], " can help you with this analysis.\nThe command ", StyleBox["Eigensystem[m]", FontWeight->"Bold"], " in ", StyleBox["Mathematica", FontSlant->"Italic"], " gives a list consisting of two parts. The first part contains the \ eigenvalues of the matrix for", StyleBox[" m", FontWeight->"Bold"], " and the second part gives the set of eigenvectors for the eigenvalues in \ corresponding order. \n ", ButtonBox["Go back.", ButtonData:>"hb1", ButtonStyle->"Hyperlink"] }], "Text", CellTags->"h1"] }, Closed]] }, Open ]] }, FrontEndVersion->"4.1 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 695}}, WindowSize->{577, 590}, WindowMargins->{{4, Automatic}, {Automatic, 8}}, PrintingCopies->1, PrintingPageRange->{Automatic, Automatic}, StyleDefinitions -> "Default.nb" ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{ "hb1"->{ Cell[34413, 959, 851, 25, 40, "Input", Evaluatable->False, CellTags->"hb1"]}, "h1"->{ Cell[37970, 1074, 760, 22, 109, "Text", CellTags->"h1"]} } *) (*CellTagsIndex CellTagsIndex->{ {"hb1", 39441, 1118}, {"h1", 39545, 1122} } *) (*NotebookFileOutline Notebook[{ Cell[1705, 50, 650, 13, 233, "Subsubtitle"], Cell[CellGroupData[{ Cell[2380, 67, 90, 2, 225, "Title"], Cell[2473, 71, 3020, 109, 227, "Text"], Cell[CellGroupData[{ Cell[5518, 184, 31, 0, 59, "Section"], Cell[5552, 186, 138, 3, 52, "Text"], Cell[5693, 191, 809, 12, 204, "Text"], Cell[CellGroupData[{ Cell[6527, 207, 74, 1, 47, "Subsection"], Cell[6604, 210, 1209, 34, 242, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[7862, 250, 142, 5, 39, "Section"], Cell[8007, 257, 1133, 32, 191, "Text"], Cell[9143, 291, 1262, 26, 570, "Input"], Cell[10408, 319, 213, 6, 52, "Text"], Cell[10624, 327, 72, 1, 30, "Input"], Cell[10699, 330, 106, 2, 50, "Input"], Cell[10808, 334, 806, 22, 98, "Text"], Cell[11617, 358, 62, 1, 30, "Input"], Cell[11682, 361, 1391, 31, 558, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[13110, 397, 37, 0, 39, "Section"], Cell[13150, 399, 610, 18, 90, "Text"], Cell[13763, 419, 1425, 27, 590, "Input"], Cell[15191, 448, 307, 14, 52, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[15535, 467, 122, 3, 66, "Section"], Cell[15660, 472, 790, 13, 185, "Text"], Cell[16453, 487, 1077, 21, 219, "Text"], Cell[17533, 510, 1214, 25, 510, "Input"], Cell[18750, 537, 282, 5, 90, "Text"], Cell[19035, 544, 569, 10, 250, "Input"], Cell[19607, 556, 230, 4, 71, "Text"], Cell[19840, 562, 243, 6, 110, "Input"], Cell[20086, 570, 113, 3, 33, "Text"], Cell[20202, 575, 125, 3, 52, "Text"], Cell[20330, 580, 75, 1, 30, "Input"], Cell[20408, 583, 104, 2, 50, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[20549, 590, 38, 0, 39, "Section"], Cell[20590, 592, 335, 7, 88, "Text"], Cell[20928, 601, 1397, 25, 510, "Input"], Cell[22328, 628, 61, 0, 33, "Text"], Cell[22392, 630, 569, 10, 250, "Input"], Cell[22964, 642, 228, 4, 71, "Text"], Cell[23195, 648, 243, 6, 110, "Input"], Cell[23441, 656, 73, 0, 33, "Text"], Cell[23517, 658, 119, 3, 52, "Text"], Cell[23639, 663, 75, 1, 30, "Input"], Cell[23717, 666, 104, 2, 50, "Input"], Cell[23824, 670, 122, 3, 52, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[23983, 678, 50, 0, 39, "Section"], Cell[24036, 680, 311, 7, 71, "Text"], Cell[24350, 689, 388, 8, 170, "Input"], Cell[24741, 699, 332, 7, 71, "Text"], Cell[25076, 708, 151, 3, 70, "Input"], Cell[25230, 713, 296, 6, 71, "Text"], Cell[25529, 721, 146, 3, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[25712, 729, 90, 2, 39, "Section"], Cell[25805, 733, 105, 3, 33, "Text"], Cell[25913, 738, 1249, 26, 530, "Input"], Cell[27165, 766, 809, 21, 117, "Text"], Cell[27977, 789, 62, 1, 30, "Input"], Cell[28042, 792, 75, 1, 30, "Input"], Cell[28120, 795, 1391, 31, 558, "Input"], Cell[29514, 828, 538, 14, 90, "Text"], Cell[30055, 844, 142, 3, 70, "Input"], Cell[30200, 849, 302, 6, 90, "Text"], Cell[30505, 857, 1815, 40, 796, "Input"], Cell[32323, 899, 356, 8, 90, "Text"], Cell[32682, 909, 148, 3, 70, "Input"], Cell[32833, 914, 238, 4, 71, "Text"], Cell[33074, 920, 167, 3, 50, "Input"], Cell[33244, 925, 159, 5, 33, "Text"], Cell[33406, 932, 258, 5, 70, "Input"], Cell[33667, 939, 615, 11, 185, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[34319, 955, 91, 2, 39, "Section"], Cell[34413, 959, 851, 25, 40, "Input", Evaluatable->False, CellTags->"hb1"], Cell[35267, 986, 546, 12, 270, "Input"], Cell[35816, 1000, 264, 7, 90, "Text"], Cell[36083, 1009, 154, 3, 70, "Input"], Cell[36240, 1014, 121, 3, 52, "Text"], Cell[36364, 1019, 71, 2, 50, "Input"], Cell[36438, 1023, 171, 3, 52, "Text"], Cell[36612, 1028, 146, 2, 50, "Input"], Cell[36761, 1032, 98, 1, 33, "Text"], Cell[36862, 1035, 299, 7, 150, "Input"], Cell[37164, 1044, 208, 4, 71, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[37409, 1053, 558, 19, 39, "Section"], Cell[37970, 1074, 760, 22, 109, "Text", CellTags->"h1"] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)