(************** 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[     12667,        362]*)
(*NotebookOutlinePosition[     13373,        386]*)
(*  CellTagsIndexPosition[     13329,        382]*)
(*WindowFrame->Normal*)



Notebook[{

Cell[CellGroupData[{
Cell["Parallel Mapping to Any Plane Using a Linear Transformation ", "Title"],

Cell[CellGroupData[{

Cell[TextData[{
  "Review from Calculus on 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["\<The number of domain and image points is \>", 
      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, {"\<x coordinates\>", "\<y coordinates\>", "\<z \
coordinates\>"}];\)\), "\n", 
    \(Print["\<The first ten image points are: \>", 
      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[{
  "What happens to the above mapping when ",
  Cell[BoxData[
      \(TraditionalForm\`x\_0\)]],
  "moves out along the ",
  StyleBox["x-axis",
    FontSlant->"Italic"],
  " further, namely as ",
  Cell[BoxData[
      \(TraditionalForm\`x\_0\)]],
  "\[Rule]\[Infinity] ?\nStay tuned and you will find out."
}], "Text"]
}, Closed]],

Cell[CellGroupData[{

Cell["\<\
Exploration of a Linear Transformation by Creating and Identifying the Image \
Numerically\
\>", "Section"],

Cell[TextData[{
  "The above mapping is not a linear transformation. Why?\nWe now consider \
parallel projections onto a plane, which is the type of mapping you would get \
in the above example if you let ",
  Cell[BoxData[
      \(TraditionalForm\`x\_0\)]],
  "\[Rule]\[Infinity]",
  ". Indicate why this would become a linear transformation.\n\nYour 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[{
    \(Off[General::spell]\ \), "\n", 
    \(Off[General::spell1]\ 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["\<The number of domain and image points is \>", 
      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, {"\<x coordinates\>", "\<y coordinates\>", "\<z \
coordinates\>"}];\)\), "\n", 
    \(Print["\<The first ten image points are: \>"]\), "\[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["\<The normal to the plane is \>", 
      normaltoplane = normal/normal[\([1]\)]]\), "\n", 
    \(Clear[x, y, z]\), "\n", 
    \(Print["\<The equation of the plane onto which the points are projected \
is \>", 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["Linear Algebra Analysis of a Linear Transformation ", "Section"],

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["\<The eigenvalues and corresponding eigenvectors for the given \
matrix are: \>", 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["\<\
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["You Try It", "Section"],

Cell["\<\
Try out some of your own mappings and see what happens. Don't restrict \
yourself to the ones that map only to a plane. Bring your results to class \
tomorrow.\
\>", "Text"]
}, Closed]]
}, Open  ]]
},
FrontEndVersion->"4.1 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 695}},
WindowSize->{582, 599},
WindowMargins->{{0, Automatic}, {Automatic, 23}},
PrintingCopies->1,
PrintingPageRange->{Automatic, Automatic}
]

(*******************************************************************
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->{}
*)

(*CellTagsIndex
CellTagsIndex->{}
*)

(*NotebookFileOutline
Notebook[{

Cell[CellGroupData[{
Cell[1727, 52, 77, 0, 170, "Title"],

Cell[CellGroupData[{
Cell[1829, 56, 158, 5, 86, "Section"],
Cell[1990, 63, 1133, 32, 153, "Text"],
Cell[3126, 97, 1262, 26, 430, "Input"],
Cell[4391, 125, 213, 6, 52, "Text"],
Cell[4607, 133, 72, 1, 30, "Input"],
Cell[4682, 136, 106, 2, 30, "Input"],
Cell[4791, 140, 333, 11, 52, "Text"]
}, Closed]],

Cell[CellGroupData[{
Cell[5161, 156, 117, 3, 66, "Section"],
Cell[5281, 161, 770, 14, 166, "Text"],
Cell[6054, 177, 1077, 21, 162, "Text"],
Cell[7134, 200, 1283, 27, 410, "Input"],
Cell[8420, 229, 282, 5, 71, "Text"],
Cell[8705, 236, 569, 10, 230, "Input"],
Cell[9277, 248, 230, 4, 52, "Text"],
Cell[9510, 254, 243, 6, 90, "Input"],
Cell[9756, 262, 113, 3, 33, "Text"],
Cell[9872, 267, 125, 3, 33, "Text"],
Cell[10000, 272, 72, 1, 30, "Input"],
Cell[10075, 275, 104, 2, 30, "Input"]
}, Closed]],

Cell[CellGroupData[{
Cell[10216, 282, 70, 0, 39, "Section"],
Cell[10289, 284, 546, 12, 250, "Input"],
Cell[10838, 298, 264, 7, 90, "Text"],
Cell[11105, 307, 154, 3, 70, "Input"],
Cell[11262, 312, 121, 3, 33, "Text"],
Cell[11386, 317, 76, 2, 50, "Input"],
Cell[11465, 321, 171, 3, 52, "Text"],
Cell[11639, 326, 146, 2, 50, "Input"],
Cell[11788, 330, 85, 2, 33, "Text"],
Cell[11876, 334, 299, 7, 110, "Input"],
Cell[12178, 343, 209, 4, 52, "Text"]
}, Closed]],

Cell[CellGroupData[{
Cell[12424, 352, 29, 0, 39, "Section"],
Cell[12456, 354, 183, 4, 52, "Text"]
}, Closed]]
}, Open  ]]
}
]
*)



(*******************************************************************
End of Mathematica Notebook file.
*******************************************************************)