Miniproject
For The 
Mathematica Workshop

Debra Woods

Possible Intersections of Three Planes

Brief Description:

This project shows the three possibilities for the intersections of three planes by drawing the planes, and animating a rotation to show several views.

Planes and Their Intersections

In this lesson, given the equations of any three planes in three variables, the program will solve the system, and display graphically the solution.

Initialization

<< "LinearAlgebra`GaussianElimination`"<< "Statistics`DescriptiveStatistics`"Off[General::"spell1"]; Clear[x, y, z1, z2, z3];

Let's begin by solving the system
2x -  y +  z = 5
x + 3y + 2z = 4
x + 2y - 4z = -6
											  
First, we will investigate the Mathematica solution.

a = {{2, -1, 1}, {1, 3, 2}, {1, 2, -4}}; m = a; b = {5, 4, -6}; sol = LinearSolve[m, b]

We see that the solution is a point!

Let's look at the point graphically, as the intersection of the planes.

Clear[v]v = {x, y, z}; a . v; zv = 
      Table[Solve[
          (a . v)[[i]] == 
            b[[i]], z], {i, 1, 3}]; 
    f1[x_, y_] = zv[[1, 1, 1, 2]]; 
    f2[x_, y_] = zv[[2, 1, 1, 2]]; 
    f3[x_, y_] = zv[[3, 1, 1, 2]]; 
    n1 = sol[[1]]; 
    n2 = sol[[2]]; 
    n3 = sol[[3]]; h = Max[n1, n2, n3] + Mean[{n1, n2, n3}]; spacer = h +  .2; threedims = 
      Graphics3D[{{Line[{{-h, 0, 0}, {2 h, 0, 0}}]}, 
          Text["x", {spacer, 0, 0}], {Line[{{0, -h, 0}, {0, h, 0}}]}, 
          Text["y", {0, spacer, 0}], {Line[{{0, 0, -h}, {0, 0, h}}]}, 
          Text["z", {0, 0, spacer}]}, Boxed -> False, 
        Axes -> False, ViewPoint -> {1.75, 1.224, 1.7}, 
        AspectRatio -> Automatic]; plane[1] = 
      Plot3D[f1[x, y], {x, -2 n1, 2 n1}, {y, -2 n2, 2 n2}, 
        Boxed -> False, PlotPoints -> {2, 2}, 
        DisplayFunction -> Identity]; plane[2] = 
      Plot3D[f2[x, y], {x, -2 n1, 2 n1}, {y, -2 n2, 2 n2}, 
        Boxed -> False, PlotPoints -> {2, 2}, 
        DisplayFunction -> Identity]; plane[3] = 
      Plot3D[f3[x, y], {x, -2 n1, 2 n1}, {y, -2 n2, 2 n2}, 
        Boxed -> False, PlotPoints -> {2, 2}, 
        DisplayFunction -> Identity]; graphs = Table[plane[a], {a, 1, 3}]; Show[
      GraphicsArray[graphs, DisplayFunction -> $DisplayFunction]]; 
    Show[threedims, graphs, 
      PlotRange -> {{-h, h}, {-h, h}, {-h, h}}, 
      DisplayFunction -> $DisplayFunction];

You can see the point where the planes intersect.
Now, you can see it from several angles.

Do[
      Show[%, ViewPoint -> {Cos[j], Sin[j], 1.7}], {j, 0, 2 π, 
        (π/8)}];

Select the above cells and press command-y to animate.

Let's investigate the solution of the system
x + 2y - 3z = -1
3x -  y + 2z =  7
5x + 3y - 4z = 30

Clear[a, b, sol, x, y, z, f1, f2, f3, zv, n1, n2, n3, spacer, h]; 
    a := {{1, 2, -3}, {3, -1, 2}, {5, 3, -4}};

b = {-1, 7, 30}; sol = LinearSolve[a, b];

From the message, we can see that there is no solution to this system.  Let's see what the planes look like.

Clear[v]v = {x, y, z}; a . v; zv = 
      Table[Solve[
          (a . v)[[i]] == 
            b[[i]], z], {i, 1, 3}]; 
    f1[x_, y_] = zv[[1, 1, 1, 2]]; 
    f2[x_, y_] = zv[[2, 1, 1, 2]]; 
    f3[x_, y_] = zv[[3, 1, 1, 2]]; 
    n1 = 5; n2 = 6; n3 = 6; h = Max[n1, n2, n3] + Mean[{n1, n2, n3}]; spacer = h +  .2; threedims = 
      Graphics3D[{{Line[{{-h, 0, 0}, {2 h, 0, 0}}]}, 
          Text["x", {spacer, 0, 0}], {Line[{{0, -h, 0}, {0, h, 0}}]}, 
          Text["y", {0, spacer, 0}], {Line[{{0, 0, -h}, {0, 0, h}}]}, 
          Text["z", {0, 0, spacer}]}, Boxed -> False, 
        Axes -> False, ViewPoint -> {1.75, 1.224, 1.7}, 
        AspectRatio -> Automatic]; plane[1] = 
      Plot3D[f1[x, y], {x, -h, h}, {y, -h, h}, Boxed -> False, 
        PlotPoints -> {2, 2}, DisplayFunction -> Identity]; plane[2] = 
      Plot3D[f2[x, y], {x, -h, h}, {y, -h, h}, Boxed -> False, 
        PlotPoints -> {2, 2}, DisplayFunction -> Identity]; plane[3] = 
      Plot3D[f3[x, y], {x, -h, h}, {y, -h, h}, Boxed -> False, 
        PlotPoints -> {2, 2}, DisplayFunction -> Identity]; graphs = Table[plane[a], {a, 1, 3}]; Show[
      GraphicsArray[graphs, DisplayFunction -> $DisplayFunction]]; 
    Show[threedims, graphs, 
      PlotRange -> {{-h, h}, {-h, h}, {-h, h}}, 
      DisplayFunction -> $DisplayFunction];

Do[
      Show[%, ViewPoint -> {Cos[j], Sin[j], 1}], {j, 0, 2 π, 
        (π/8)}];

Select the above cells and press command-y to animate.

You can see that there is no solution by the triangle that they create between them.  This is not the only way in which three planes do not intersect,but it is an interesting one.  See if you can figure out other ways in which the intersection of three planes produces no intersection.

Another possibility for the intersection of three planes is the case in which there are infinite solutions.

Let's investigate the solution of the system
x +  y -  z =  1
2x + 3y + 2z =  3
x + 2y + 3z =  2

Clear[m, b, a, c, aug, at, naug, redform, z1, z2, z3, x, y, z, sol]; 
    m = {{1, 1, -1}, {2, 3, 2}, {1, 2, 3}}; b = {1, 3, 2}; sol = LinearSolve[m, b]

It appears as though Mathematica has given us a unique solution.  We must be very careful though.  Let's see what the graphs of the planes produce.

Clear[v]a := m; v = {x, y, z}; a . v; zv = 
      Table[Solve[
          (a . v)[[i]] == 
            b[[i]], z], {i, 1, 3}]; 
    f1[x_, y_] = zv[[1, 1, 1, 2]]; 
    f2[x_, y_] = zv[[2, 1, 1, 2]]; 
    f3[x_, y_] = zv[[3, 1, 1, 2]]; 
    n1 = sol[[1]]; 
    n2 = sol[[2]]; 
    n3 = sol[[3]]; h = Max[n1, n2, n3] + Mean[{n1, n2, n3}]; spacer = h +  .2; threedims = 
      Graphics3D[{{Line[{{-h, 0, 0}, {2 h, 0, 0}}]}, 
          Text["x", {spacer, 0, 0}], {Line[{{0, -h, 0}, {0, h, 0}}]}, 
          Text["y", {0, spacer, 0}], {Line[{{0, 0, -h}, {0, 0, h}}]}, 
          Text["z", {0, 0, spacer}]}, Boxed -> False, 
        Axes -> False, ViewPoint -> {1.75, 1.224, 1.7}, 
        AspectRatio -> Automatic]; plane[1] = 
      Plot3D[f1[x, y], {x, -2 n1 - 1, 2 n1 + 1}, {y, -2 n2 - 1, 
          2 n2 + 1}, Boxed -> False, PlotPoints -> {2, 2}, 
        DisplayFunction -> Identity]; plane[2] = 
      Plot3D[f2[x, y], {x, -2 n1 - 1, 2 n1 + 1}, {y, -2 n2 - 1, 
          2 n2 + 1}, Boxed -> False, PlotPoints -> {2, 2}, 
        DisplayFunction -> Identity]; plane[3] = 
      Plot3D[f3[x, y], {x, -2 n1 - 1, 2 n1 + 1}, {y, -2 n2 - 1, 
          2 n2 + 1}, Boxed -> False, PlotPoints -> {2, 2}, 
        DisplayFunction -> Identity]; graphs = Table[plane[a], {a, 1, 3}]; Show[
      GraphicsArray[graphs, DisplayFunction -> $DisplayFunction]]; 
    Show[threedims, graphs, 
      PlotRange -> {{-h, h}, {-h, h}, {-h, h}}, 
      DisplayFunction -> $DisplayFunction];

Do[
      Show[%, ViewPoint -> {Cos[j], 1, Sin[j]}], {j, 0, π, 
        (π/8)}];

Select the above cells and press command-y to animate.

We can see from the animation, that the three planes seem to intersect along a line.  This means there must me infinite solutions.  Let's see if we can find an equation for the line.

Using LinearSolve in this case gives what looks like an answer, but this system in fact has infinite solutions.  Let's investigate further.  The following calculation will eliminate the y variable and solve in terms of x and z.  This is the equation of a line.  In fact, it is the line of intersection.

Eliminate[{z == f1[x, y], z == f2[x, y], z == f3[x, y]}, y]