11.7  Analytic geometry with 2DGeometry

This Mathematica notebook supports the corresponding section of M&M.  It's intended to be executed in sequence.  It may include some tests not shown in the book.  It contains code for exercise solutions, but usually little discussion of them.  The version distributed with the book will contain solutions only for odd-numbered exercises.
	Any  Export  commands that produced figures for the book are commented out, so that they won't reference nonexistent folders.  They always duplicate figures rendered just previously by  Show.
	Many items from this notebook are incorporated in the twoDG package.

Initialization

	This cell group contains definitions from notebook  11_02.nb  corresponding to section 11.2, which are required for this notebook to function.  It will be executed automatically when you answer affirmatively the question posed when you first attempt to execute any cell in this notebook.

Off[
        General::spell1];
Unprotect[Point];
Point[x_, y_] := Point[{x, y}]; 
origin := Point[0, 0];
cis[θ_] := Point[Cos[θ], Sin[θ]];
c1[Point[{x_, y_}]] ^:= x;
c2[Point[{x_, y_}]] ^:= y;
Point[P_] == Point[Q_] ^:= 
        FullSimplify[P == Q];
Point[P_] ≠  Point[Q_] ^:= 
        Not[Point[P] == Point[Q]];
distance[Point[{x1_, y1_}], 
          Point[{x2_, 
              y2_}]] ^:= 
Sqrt[(x1 - x2)^2 + (y1 - 
                  y2)^2];

  
Point[P_] + Point[Q_] ^:= Point[P + Q];
t_*Point[P_] ^:= Point[t*P];
midpoint[P_, 
          Q_] := (1/2) (P + 
              Q);

  
slope[Point[{x1_, y1_}], Point[{x2_, y2_}]] ^:= 
        Module[{dx, dy}, 
          dx = x2 - x1;   dy = y2 - y1; 
If[
            FullSimplify[dx == 0], noSlope, dy/dx]];
direction[O_, Q_] := 
        Module[{dx, dy, θ}, 
dx = c1[Q] - c1[O]; 
          dy = c2[Q] - c2[O]; 
If [
            dx == 0, 
If[dy == 0, 
              noDirection, 
If[dy < 0, 
                3  π/2, π/2]], 
θ = 
              ArcTan[dy/dx];                
If [
              dx < 0, θ + π, 
If[
                dy < 0, θ + 2  π, θ]]]];
directedAngle[Q_, O_, R_] := 
        Module[{θ}, 
θ = 
            Mod[direction[O, R] - direction[O, Q], 
              2  π]; 
If[θ > π, θ = θ - 2  π, θ]];
angle[Q_, O_, R_] := 
        Abs[directedAngle[Q, O, 
            R]];

  
norm[P_] := distance[origin, P];

End of initialization

The  lineq  ADT

lineq[0, 0, c_] := 
        noLine;

c1[lineq[a_, b_, c_]] ^:= a;
c2[lineq[a_, b_, c_]] ^:= b;
\(\(c3[lineq[a_, b_, c_]] ^:= c;\)
\)
lineq[a0_, b0_, c0_] == 
          lineq[a1_, b1_, c1_] ^:= 
FullSimplify[
          a0*b1 == a1*b0  && 
b0*c1 == b1*c0 && 
            c0*a1 == c1*a0];
lineq[a0_, b0_, c0_] ≠ lineq[a1_, b1_, c1_] ^:= 
        Not[lineq[a0, b0, c0] == 
            lineq[a1, b1, c1]];
noLine == noLine ^= badEquation;
noLine ≠ noLine ^= badEquation;

g = lineq[1, 2, 3];   h = lineq[2, 4, 6];
j = lineq[2, 4, 7];   k = lineq[0, 0, 1];
{g == h, h == j, 
      j ≠ j}
{j == k, k == k, k ≠ k}

h[[1]]
k[[1]]

Constructing  lineq  objects

pointSlope[P_, m_] := 
        lineq[m, -1, c2[P] - m*c1[P]];

horizontal[y_] :=  lineq[0, 1, -y];
horizontal[Point[x_, y_]] ^:=  horizontal[y];
vertical[x_] := lineq[1, 0, -x];
vertical[Point[x_, y_]] ^:= vertical[x];

P = Point[1, 2];
{pointSlope[P, 1], horizontal[P], vertical[1]}

pointParallel[P_, g_] := 
        lineq[c1[g], 
          c2[g], -c1[g] c1[P] - 
            c2[g] c2[P]];
pointPerpendicular[P_, g_] := 
        lineq[-c2[g], c1[g], c2[g] c1[P] - c1[g] c2[P]];

P = Point[1, 2];
g = lineq[3, 4, 5];
h = lineq[0, 0, 1];
{pointParallel[P, g], 
      pointPerpendicular[P, g]}
{pointParallel[P, h], pointPerpendicular[P, h]}

Join and intersection

Point[x1_, y1_]⋁Point[x2_, y2_] ^:= 
        FullSimplify[lineq[y2 - y1, x1 - x2, x2*y1 - x1*y2]];

P = Point[1, 2];   Q = Point[3, 4];
{P⋁Q, Q⋁P, P⋁P}

The following example won't work without  FullSimplify:

Point[Sqrt[2] + Sqrt[3], 0]⋁Point[1/(Sqrt[3] - Sqrt[2]), 
        0]

lineq[a1_, b1_, c1_] ⋂ lineq[a2_, b2_, c2_] ^:= 
        Module[{d}, 
          d = a1*b2 - a2*b1; 
If[
            FullSimplify[d == 0], 
            badIntersection,  (1/d)  Point[b1*c2 - b2*c1, 
                c1*a2 - c2*a1]]];

g = lineq[1, -1, 0];   h = 
      lineq[1, 1, -1];
j = lineq[1, -1, 1];   k = 
      lineq[0, 0, 1];
{g ⋂ h, g ⋂ g, g ⋂ j, 
      g ⋂ k}

Testing for concurrence

\(\(concurrentQ[
          lineq[a1_, b1_, c1_], 
		\ \ lineq[a2_, b2_, 
            c2_], 
		\ \ lineq[a3_, b3_, c3_]] ^:= 
        FullSimplify[
          Det[{{a1, b1, c1}, 
\ \ \ \ \ {a2, b2, 
                  c2}, 
\ \ \ \ \ {a3, b3, c3}}] == 
            0];\)\)

g = lineq[1, 2, 3];   h = lineq[4, 5, 6];
P = g ⋂ h;  
    j = pointPerpendicular[P, g];
k = pointParallel[origin, j];
l = pointParallel[2  P, j];
m = lineq[0, 0, 1];
{concurrentQ[g, h, j], concurrentQ[g, h, k]}
{concurrentQ[j, k, l], concurrentQ[j, k, k]}
concurrentQ[k, l, m]

g = lineq[0.9, 2, 3];   h = lineq[4, 5, 6];
P = g ⋂ h;  j = pointPerpendicular[P, g];
concurrentQ[g, h, j]

\(\(concurrentQT[
          lineq[a1_, b1_, c1_], 
		\ \ \ \ \ lineq[a2_, 
            b2_, c2_], 
		\ \ \ \ \ lineq[a3_, b3_, 
            c3_]] ^:= Module[{d}, 
          d = Det[{{a1, b1, c1}, 
\ \ \ \ \ \ \ {a2, b2, 
                  c2}, 
\ \ \ \ \ \ \ {a3, b3, 
                  c3}}]; 
Print["Det = ", 
            d]; 
FullSimplify[d == 0]];\)\)

concurrentQT[g, h, j]

Additional operations

distance[Point[x_, y_], lineq[a_, b_, c_]] ^:= 
        Abs[a*x + b*y + c]/
          Sqrt[a^2 + b^2];

slope[lineq[a_, b_, c_]] ^:= 
If[
          FullSimplify[b == 0], noSlope, -a/b];

{h, k}
{distance[origin, h], distance[origin, k]}
{slope[h], slope[line[1, 0, 0]], slope[k]}

j = lineq[0, 0, 1] ;
{distance[origin, j], slope[j]}

Exercise 1

horizontalQ[g_] := c1[g] == 0;
verticalQ[g_] := c2[g] == 0;

onQ[P_, g_] := 
        FullSimplify[
          c1[P] c1[g] + c2[P] c2[g] + c3[g] == 0];
throughQ[g_, P_] := onQ[P, g];

g = lineq[1, 0, 0];   h = lineq[0, 1, 0];   j = 
      lineq[0, 0, 1];
{horizontalQ[g], horizontalQ[h], 
      horizontalQ[j]}
{verticalQ[g], verticalQ[h], verticalQ[j]}
P = Point[ .1, 0];
{onQ[P, g], onQ[P, h], onQ[P, j]}
{throughQ[g, P], throughQ[h, P], throughQ[j, P]}

g = pointSlope[origin, 1];
h = pointSlope[P,  .99999];
Q = g ⋂ h
{onQ[origin, g], onQ[P, g], onQ[Q, g]}
{onQ[origin, h], onQ[P, h], onQ[Q, h]}

Exercise 2

between1Q[P_, Q_, R_] := 
        FullSimplify[
          distance[P, Q] + distance[Q, R] == 
            distance[P, R]];

P = Point[1, 2];   Q = Point[3, 4];
{between1Q[P, 3  P, 7  P], 
      between1Q[P, 7  P, 3  P]}
{between1Q[P, Q, 3  P], between1Q[P, Q, Q]}

P = Point[a, 2];   Q = Point[3, 4];
{between1Q[P, 3  P, 7  P], 
      between1Q[P, 7  P, 3  P]}
{between1Q[P, Q, 3  P], between1Q[P, Q, Q]}

Exercise 3

perpendicularQ[g_, h_] := 
      FullSimplify[c1[g] c1[h] + c2[g] c2[h] == 0]; 
    parallelQ[g_, h_] := 
      FullSimplify[c1[g] c2[h] == c1[h] c2[g]];

g = lineq[1, 1, -1];   h = lineq[1, -1, 0];
j = lineq[1, 1, 1];   k = lineq[0, 0, 1];
{perpendicularQ[g, h], 
      perpendicularQ[g, g], 
perpendicularQ[g, 
        k]}
{parallelQ[g, g], parallelQ[g, h], parallelQ[g, j], 
      parallelQ[g, k]}

Exercise 4

θ1 = π/5;   P = cis[θ1]
θ2 = 3  π/4;  Q = cis[θ2]

R = P + Q;
g = origin⋁R;   h = P⋁Q;
perpendicularQ[g, h]

θ1 = 1;   P = cis[θ1]
θ2 = 12/10;  Q = cis[θ2]
R = P + Q;
g = origin⋁R;   h = P⋁Q;
perpendicularQ[g, h]

θ1 = 1.0;   P = cis[θ1]
θ2 = 12/10;  Q = cis[θ2]
R = P + Q;
g = origin⋁R;   h = P⋁Q;
perpendicularQ[g, h]

Exercise 5

Points  < (Subscript[x, 1]),(Subscript[y, 1])>  to  < (Subscript[x, 3]),(Subscript[y, 3])>  are collinear if and only if there's a nontrivial solution <a, b, c>  of the equations  a(Subscript[x, i]) + b(Subscript[y, i]) + c = 0  for  i = 1  to  3.  You can rewrite these as  (Subscript[x, i])a + (Subscript[y, i])b + 1c = 0,  so such a solution exists if and only if the determinant in the next cell is zero.

collinearQ[
          Point[x1_, 
            y1_], 
                   Point[x2_, 
            y2_], 
                   Point[x3_, y3_]] := 
        FullSimplify[
          Det[{{x1, y1, 1}, 
     {x2, y2, 
                  1}, 
     {x3, y3, 1}}] == 
            0];

P = Point[1, 2];   Q = Point[3, 4];
R = 5  P - 4  Q;  S = 5  P - 3  Q;
{collinearQ[P, Q, R], collinearQ[P, Q, S],   collinearQ[P, Q, P], 
      collinearQ[P, P, P]}

t = 5.1;   R = t P - (1 - t) Q;   collinearQ[P, Q, 
      R]

Exercise 6

The determinant is positive if and only if the points are noncollinear and the path from the first point to the second to the third proceeds around the triangle counterclockwise.

counterclockwiseQ[
          Point[x1_, 
            y1_], 
                                   Point[x2_, 
            y2_], 
                                   Point[x3_, y3_]] := 
        FullSimplify[
          Det[{{x1, y1, 1}, 
     {x2, y2, 
                  1}, 
     {x3, y3, 1}}] > 
            0];

X = Point[1, 0];   Y = Point[0, 1];
{counterclockwiseQ[origin, X, Y], 
      counterclockwiseQ[origin, Y, X]}
{counterclockwiseQ[origin, X, X], 
      counterclockwiseQ[X, X, 2  X]}

Exercise 7

betweenQ[s_, t_, u_] := 
        FullSimplify[(s ≤ t ≤ 
                u) ∨ (u ≤ t ≤ 
                s)];

{betweenQ[1, 2, 3], betweenQ[2, 3, 1]}
{betweenQ[1, 1, 2], betweenQ[1, 2, 2], betweenQ[2, 2, 2]}

Exercise 8

between2Q[P_, Q_, 
          R_] := 
collinearQ[P, Q, 
            R] && ((FullSimplify[c2[P] == c2[Q]] && 
                  betweenQ[c1[P], c1[Q], c1[R]]) ∨     betweenQ[
                c2[P], c2[Q], c2[R]]);

P = Point[1, 2];   Q = Point[3, 4];
{between2Q[P, 3  P, 7  P], 
      between2Q[P, 7  P, 3  P]}
{between2Q[P, Q, 3  P], between2Q[P, Q, Q]}

P = Point[a, 2];   Q = Point[3, 4];
{between2Q[P, 3  P, 7  P], 
      between2Q[P, 7  P, 3  P]}
{between2Q[P, Q, 3  P], between2Q[P, Q, Q]}