11.9  Finishing touches with twoDG

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 notebooks  11_02.nb,  11_07.nb  and  11_08.nb  corresponding to sections 11.2, 11.7, and 11.8, 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];

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;\)

 (*\ 
      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];
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]];\)
 (*\ 
      Join\ and\ intersection\ *) \)
Point[x1_, y1_]⋁Point[x2_, y2_] ^:= 
        FullSimplify[lineq[y2 - y1, x1 - x2, x2*y1 - x1*y2]];
\(\(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]]];\)

 (*\ 
      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];\)\)
\(\(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]];\)

 (*\ 
      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];\)

 (*\ 
      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];\)

 (*\ 
      Exercise\ 2\ *) \)
between1Q[P_, Q_, R_] := 
        FullSimplify[
          distance[P, Q] + distance[Q, R] == 
            distance[P, R]];

\( (*\ Exercise\ 3\ *) 
 (*\ 
      This\ is\ isolated\ in\ its\ own\ cell\ to\ keep\ Mathematica\ from\ dinging\ and\ reporting\ an\ internal\ \(\(error\)\(.\)\)\ *) 
\(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]];

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

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

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

  
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]]);

bisector1[
          lineq[a1_, b1_, c1_], lineq[a2_, b2_, c2_]] ^:= 
        Module[{d1, d2}, 
d1 = 
            Sqrt[a1^2 + b1^2]; 
d2 = Sqrt[a2^2 + b2^2];  
          lineq[a1*d2 - a2*d1, b1*d2 - b2*d1, c1*d2 - c2*d1]];

End of initialization

Function  draw

draw[L_] := 
        Show[Graphics[L], 
          AspectRatio -> Automatic];
draw[L_, M_] := 
        Show[Graphics[L], 
          Append[{M}, AspectRatio -> Automatic]];

Drawing segments and polygons

Point[{x0_, y0_}] Point[{x1_, y1_}] ^:= 
        Line[{{x0, y0}, {x1, y1}}];

P = Point[0, 1.2];  Oh = Point[-0.8, 0];  
    Q = Point[0.7, 0];
OP = P⋁Oh;  
    OQ = Oh⋁Q;   h = bisector1[OP, OQ];
X = h ⋂ vertical[0.35];
Y = 
        OP ⋂ 
          pointPerpendicular[X, OP];
Z = 
        OQ ⋂ 
          pointPerpendicular[X, OQ];
L = {AbsolutePointSize[5], AbsoluteThickness[1], Oh, X, Y, Z, Oh P, 
          Oh Q, Oh X, X Y, X Z};
\(\(draw[
        L];\)
 (*\(Export["d:\M&M\Chapter11\11_09\11_09_01.eps", %];\)*) \)

polygon[L_] := 
        Line[Table[{c1[L[[k]]], c2[L[[k]]]}, {k, 1, 
              Length[L]}]];
filledPolygon[L_] := 
        Polygon[Table[{c1[L[[k]]], c2[L[[k]]]}, {k, 1, 
              Length[L]}]];

Append[L, filledPolygon[{X, Y, Z}]] // draw;

Clipping

PlotRange /. AbsoluteOptions[%]

Off[General::spell];

corners[G_] := 
        Module[{xMin, xMax, yMin, yMax}, {{xMin, xMax}, {yMin, yMax}} = 
            PlotRange /. AbsoluteOptions[G]; 
{Point[xMin, 
              yMin], Point[xMax, yMax]}];

corners[Graphics[L]]

lineClipped[{LL_, UR_}, g_] := 
        Module[{xleft, xright, ybottom, ytop, left, right, bottom, top, L, R, 
            B, T, xB, xT}, 
          If[g == noLine, Return[{}]]; 
xleft = 
            c1[LL];  xright = c1[UR]; 
ybottom = c2[LL];  
          ytop = c2[UR]; 
left = vertical[LL];  
          right = vertical[UR]; 
bottom = horizontal[LL];  
          top = horizontal[UR]; 
L = 
            g ⋂ left;   R = 
            g ⋂ right; 
B = 
            g ⋂ bottom;   T = 
            g ⋂ top; 
xB = c1[B];   xT = 
            c1[T]; 
If[horizontalQ[g], 
            Return[If[ybottom ≤ c2[L] ≤ ytop, 
                L R, {}]]]; 
If[verticalQ[g], 
            Return[If[xleft ≤ xB ≤ xright, 
                B T, {}]]]; 
If[xT < xleft, 
            Return[If[xB < xleft, {}, 
                If[xB ≤ xright, L B, 
                  L R]]]]; 
If[xT ≤ xright, 
            Return[If[xB < xleft, T L, 
                If[xB ≤ xright, T B, 
                  T R]]]]; 
If[xB < xleft, L R, 
            If[xB ≤ xright, B R, {}]]];

lineClipped[G_, g_] := lineClipped[corners[G], g];

X = Point[1, 0];   Y = Point[0, 1];
U = X + Y;   V = U + X;   W = 2  X;
λ = {origin, U};
\(\(Table[
            lineClipped[λ, lineq[1, 3, k]], {k, \(-8\), 2, 
              0.1}] ⋃ 
          Table[lineClipped[λ, lineq[3, \(-1\), k]], {k, \(-4\), 2, 
              0.1}] ⋃ {polygon[{U, V, W, X}]} // 
        draw;\)
 (*\(Export["d:\M&M\Chapter11\11_09\11_09_02.eps", %];\)*) \)

X = Point[1, 0];   Y = Point[0, 1];
G = Graphics[{origin, X + Y}];
L = 
        Table[lineClipped[G, lineq[1, 3, k]], {k, -8, 2, 0.1}] ⋃ 
          Table[lineClipped[G, lineq[3, -1, k]], {k, -4, 2, 
              0.1}];
draw[L];

AppendTo[L, lineClipped[%, lineq[2, 2, -1]]] // 
        draw;

PlotRange /. AbsoluteOptions[%]

Arcs and circles

Unprotect[Circle];
Circle[Point[x_, y_], r_] ^:= 
If[r < 0, noCircle, 
          Circle[{x, y}, r]];
unitCircle = Circle[origin, 1];

Clear[r];
{unitCircle, Circle[origin, -1], 
      Circle[origin, r]}
draw[unitCircle];

Draw from direction  α  counterclockwise to direction  β,  where  0 ≤ α, β < 2π.

arc[Z_, r_, α_, β_] := 
        If[r < 0, noCircle, 
          Circle[{c1[Z], c2[Z]}, 
            r, {α, 
              If[α ≤ β, β, β + 
                  2  π]}]];

arc[origin, -1, 0, π]

Angle marks

Mark angle  POQ,  from ray  OP  counterclockwise to ray  OQ,  with  n  circular arcs, starting at radius  r  and stepping outward at intervals of width  dr.

angleMark[P_, O_, Q_, r_, dr_, n_] := 
        Module[{α, β}, α = direction[O, P];   β = 
            direction[O, Q]; 
Table[
            arc[O, r + k*dr, α, β], {k, 0, 
              n - 1}]];
angleMark[P_, O_, Q_, r_] := 
        angleMark[P, O, Q, r, 0, 1];

Mark angle  POQ  as a right angle, using a square with side  s.

rightAngle[P_, O_, Q_, s_] := 
        Module[{t, u, T, U, V}, 
          t = s/distance[O, P]; 
u = 
            s/distance[O, Q]; 
T = 
            t (P - O); 
U = 
            u (Q - O); 
polygon[{O + T, O + T + U, 
              O + U}]];

Ticks

Mark segment PQ with n ticks of length u, centered with an interval of width  t.

tick[P_, Q_, u_, t_, n_] := 
        Module[{M, d, T, U, dT, dU}, 
          M = midpoint[P, Q];               d = 
            distance[P, Q]; 
T = 
            Q - P;                                      dT = (t/(2  d)) T;  U = Point[-c2[T], c1[T]];  
          dU = (u/(2  d)) 
              U; 
Table[(M + k dT + dU) (M + k dT - 
                  dU), {k, -(n - 1), n - 1, 
              2}]];
tick[P_, Q_, u_] := tick[P, Q, u, 0, 1];

P = Point[0, 1.2];  Oh = Point[-0.8, 0];  
    Q = Point[0.7, 0];
OP = P⋁Oh;  
    OQ = Oh⋁Q;   h = bisector1[OP, OQ];
X = h ⋂ vertical[0.35];
Y = 
        OP ⋂ 
          pointPerpendicular[X, OP];
Z = 
        OQ ⋂ 
          pointPerpendicular[X, OQ];
L = {AbsolutePointSize[5], AbsoluteThickness[1], Oh, X, Y, Z, Oh P, 
          Oh Q, Oh X, X Y, X Z};
t =  .05;   u =  .03;
AppendTo[
        L, {angleMark[Q, Oh, X, 0.1], angleMark[X, Oh, P, 0.12], 
          rightAngle[Oh, Y, X, t], rightAngle[X, Z, Oh, t], tick[X, Y, t], 
          tick[Oh, Y, t, u, 2], tick[X, Z, t], 
          tick[Oh, Z, t, u, 2]}];
\(\(draw[
        L];\)
 (*\(Export["d:\M&M\Chapter11\11_08\11_08_01.eps", %];\)*) \)

Arrows

Arrowhead at  V  pointed in direction  θ  with length  d .

arrowhead[V_, θ_, d_] := 
        Module[{P, Q}, 
P = 
            V + d*cis[θ + 5  π/4];   Q = 
            V + d*cis[θ + 3  π/4]; 
{V P, 
            V Q}];

draw[arrowhead[origin, 1, 1]];

Exercise 1

α = 1.2;   β = -0.8;   γ = 
      1.3;
A = Point[0, α];  
    B = Point[β, 0];   𝒞 = 
      Point[γ, 0];
a = B⋁𝒞;   b = 𝒞⋁A;   c = 
      A⋁B;
g = bisector1[b, c];   h = bisector1[c, a];   j = 
      bisector1[a, b];
Ia = g ⋂ a;   Ib = h ⋂ b;   Ic = 
      j ⋂ c;   ℐ = 
      g ⋂ h;
L = {AbsoluteThickness[1], 
          polygon[{A, B, 𝒞, 
              A}], 
   𝒞 Ic, 
   AbsolutePointSize[20], 
          GrayLevel[
            1], ℐ, 
   AbsolutePointSize[
            5], GrayLevel[
            0], ℐ, 
   A Ia, 
          B Ib, 
   A, 
          B, 𝒞};
draw[L];

The first four lines of this code were adapted from that in section 11.8.    The first line, though, gives specific numerical values to coordinates  α,  β,  γ  instead of ensuring that they’re undefined.  They were adjusted experimentally to look best.  The next line defines some points that are ends of segments in the figure.  Now the display list is constructed.  First, the line thickness, determined by experiment.  Then the three edges.
	The next four lines in the display list provide for the interruption of the bisector of angle  C  at  I.  The list is set up to
	
     •	draw that bisector first,
     •	set the point size and draw a big white (gray-scale value  1) point at  I  to erase a 		chunk of the bisector,
     •	set the point size again, and draw a little black point at  I,  and
     •	draw the other bisectors through the erased region.

Appropriate point sizes were determined experimentally.  Finally, the three vertices are included in the display list.

r = 0.1;   dr = 0.03;   s = r + dr/2;
\(\(Append[
          L, {angleMark[B, A, Ia, 
              r], 
	\ \ \ \ \ \ angleMark[Ia, 
              A, 𝒞, 
              s], 
	\ \ \ \ \ \ angleMark[𝒞, B, Ib, r, dr, 
              2], 
	\ \ \ \ \ \ angleMark[Ib, B, A, s, dr, 
              2], 
	\ \ \ \ \ \ angleMark[
              A, 𝒞, Ic, r, dr, 
              3], 
	\ \ \ \ \ \ angleMark[
              Ic, 𝒞, B, s, dr, 3]}]\ \  // 
        draw;\)
 (*\(Export["d:\M&M\Chapter11\11_08\11_08_02.eps", %];\)*) \)

{AbsoluteThickness[1], 
          polygon[{A, B, 𝒞, 
              A}], 
A ℐ, 
          B ℐ, 𝒞 ℐ, 
AbsolutePointSize[
            5], 
ℐ, A, 
          B, 𝒞, 
Circle[ℐ, 
            distance[ℐ, a]]}   // draw;

Exercise 2

α = 1.2;   β = -0.8;   γ = 
      1.3;
A = Point[0, α];  
    B = Point[β, 0];   𝒞 = 
      Point[γ, 0];
a = B⋁𝒞;   b = 𝒞⋁A;   c = 
      A⋁B;
A1 = midpoint[B, 𝒞];   B1 = 
      midpoint[𝒞, A];   C1 = 
      midpoint[A, B];
g =  pointPerpendicular[A1, a];
h = pointPerpendicular[B1, b];
Oh = g ⋂ h;
r = distance[Oh, A];
s = 0.06;
t = 0.06;
u = 0.03;
L = {AbsoluteThickness[1], 
          polygon[{A, B, 𝒞, 
              A}], 
   Oh A1,  Oh B1,  
          Oh C1, 
   AbsolutePointSize[
            5], 
   A, B, 𝒞, A1, B1, C1, 
          Oh, 
   rightAngle[Oh, A1, B, s], 
          rightAngle[Oh, B1, 𝒞, 
            s], 
   rightAngle[Oh, C1, A, 
            s], 
   tick[B, A1, t], 
          tick[A1, 𝒞, 
            t], 
   tick[𝒞, B1, t, u, 
            2], tick[B1, A, t, u, 2], 
   tick[A, C1, t, 
            u, 3], tick[C1, B, t, u, 3], 
   Circle[Oh, 
            r]};
draw[L];

Exercise 3

X = Point[1, 0];
Y = Point[0, 1];
Z = X + Y;
V = midpoint[origin, Y];
W = midpoint[Y, Z];
S = (origin⋁W) ⋂ (V⋁X);
T = (origin⋁W) ⋂ (V⋁Z);
U = (W⋁X) ⋂ (V⋁Z);
\(\({AbsoluteThickness[2], 
GrayLevel[0.75], 
          filledPolygon[{S, T, U, X}], GrayLevel[0], 
          polygon[{origin, X, W, origin, Y, Z, V, X, Z}]}\ \  // 
        draw;\)
 (*\(Export["d:\M&M\Chapter11\11_09\11_09_03.eps", %];\)*) \)

Exercise 4

α = π/6;
β = π/3;
γ = 2  π/3;
δ = 5  π/6;
ϵ = 11  π/6;
VtoU = 0.5  cis[β];
V = cis[δ];
U = V + VtoU;
W = cis[ϵ];
X = W + VtoU;
g = pointPerpendicular[X, W⋁X];
Z = g ⋂ vertical[30];
r = distance[Z, X];
Y = Z + r cis[γ];
\(\({AbsoluteThickness[3], U\ V, 
          arc[origin, 1, δ, ϵ], 
W\ X, 
          arc[Z, r, γ, δ], arrowhead[Y, α, 0.8]} // 
        draw;\)
 (*\(Export["d:\M&M\Chapter11\11_09\11_09_04.eps", %];\)*) \)

Exercise 5

rayClipped[{LL_, UR_}, O_, P_] := 
        Module[{g, Q, xO, yO, xP, yP, left, right, bottom, top, xB, xT, 
            xleft, xright}, 
If[O == P, 
            Return[O P]];  
          g = O⋁P; 
{xO, yO} = {c1[O], 
              c2[O]}; 
{xP, yP} = {c1[P], 
              c2[P]}; 
left = vertical[LL];  
          right = vertical[UR]; 
bottom = horizontal[LL];  
          top = horizontal[UR]; 
xleft = c1[LL];  
          xright = c1[UR]; 
If[horizontalQ[g], 
            Q = g ⋂ If[xO > xP, left, right];   Return[
              O Q]]; 
If[verticalQ[g], 
            Q = g ⋂ If[yO > yP, bottom, top];   Return[
              O Q]]; 
xB = 
            c1[g ⋂ bottom];   xT = 
            c1[g ⋂ 
                top]; 
If[(xB < xleft && 
                  xT > xright) ∨ (xT < xleft && xB > xright), 
            Q = g ⋂ If[xO > xP, left, right];   Return[
              O Q]]; 
If[
            xleft ≤ xB ≤ xright && 
              xleft ≤ xT ≤ xright, 
            Q = g ⋂ If[yO > yP, bottom, top];   Return[
              O Q]]; 
If[
            xleft ≤ xB ≤ xright, 
            Q = g ⋂ 
                If[yO > yP, bottom, 
                  If[xO > xP, left, right]]; 
Return[
              O Q]]; 
Q = 
            g ⋂ 
              If[yO > yP, If[xO > xP, left, right], 
                top]; 
Return[O Q]];

rayClipped[G_, O_, P_] := rayClipped[corners[G], O, P];

X = Point[1, 0];   Y = Point[0, 1];
U = X + Y;   G = Graphics[{origin, U}];
M = Point[1/5, 2/5];
\(\(Table[rayClipped[G, M, M + cis[k\ π/32.0]], {k, 0, 63}]\  // 
        draw;\)
 (*\(Export["d:\M&M\Chapter11\11_09\11_09_05.eps", %];\)*) \)

Use of floating-point here, forced by  32.0,  seems mandatory.  The  FullSimplify  in the join operation gets hung up otherwise somewhere around  k = 60.  I decided to leave the  FullSimplify  in because it's useful for algebraic computation, and rely on the client's good sense to force floating-point arithmetic for drawing.

Exercise 6

B = Point[1, 0];
𝒞 = Point[0, 1];
𝒟 = cis[148  °];
ℰ = 𝒟 + 
          cis[232  °];
AO = 
        pointSlope[origin, Tan[60  °]];
AB = pointSlope[B, Tan[35  °]];
A = AO ⋂ AB;
t = 0.08;   dt = 0.03;
L = {AbsoluteThickness[1], 
          polygon[{origin, B, 𝒞, 
              origin, 𝒟, 𝒞}], 
          polygon[{𝒟, ℰ, origin, A, 
              B}]};
\(\(draw[
        L];\)
 (*\(Export["d:\M&M\Chapter11\11_09\11_09_06.eps", %];\)*) \)

Append[
          L, {tick[origin, B, t], 
            tick[origin, 𝒞, t], 
tick[
              origin, 𝒟, t], 
            tick[𝒟, ℰ, 
              t], 
rightAngle[B, origin, 𝒞, 
              t], 
angleMark[𝒞, B, origin, 
              t], 
angleMark[origin, 𝒞, B, 
              t], 
angleMark[𝒟, 𝒞, origin, t, dt, 2], 
angleMark[
              origin, 𝒟, 𝒞, t, dt, 2], 
            angleMark[origin, ℰ, 𝒟, t, dt, 
              3], 
angleMark[𝒟, 
              origin, ℰ, t, dt, 3]}] // 
        draw;

{angle[A, origin, ℰ], 
          angle[A, ℰ, origin], 
          angle[ℰ, A, origin]}/°   // N

Exercise 7

Circle[{x_, y_}, r_] ⋂ lineq[a_, b_, c_] ^:= 
        Module[{Z, g, d, P, V, s, Q}, 
Z = 
            Point[x, y];   g = lineq[a, b, c]; 
d = 
            distance[Z, g]; 
If[d > r, 
            Return[{}]]; 
P = 
            pointPerpendicular[Z, g] ⋂ g; 
If[
            FullSimplify[d == r], Return[{P}]]; 
V = 
            Point[b, -a];   s = 
            norm[V]; 
Q = (Sqrt[(r^2) - (d^2)]/s) 
              V; 
{P + Q, P - Q}];

c = Sqrt[2] - 1/10;   g = 
      lineq[1, 1, -c];
P = unitCircle ⋂ g;
L = {unitCircle, origin, P, P[[1]] origin, 
          P[[2]] origin};
G = 
        draw[L, DisplayFunction -> 
            Identity];
AppendTo[L, lineClipped[G, g]] // draw;

c = Sqrt[2];   g = lineq[1, 1, -c];
{P} = unitCircle ⋂ g;
L = {unitCircle, origin, P, P origin};
G = 
        draw[L, DisplayFunction -> 
            Identity];
AppendTo[L, lineClipped[G, g]] // draw;

c = 3/2;   g = lineq[1, 1, -c];
P = unitCircle ⋂ g
L = {unitCircle, origin, P};
G = 
        draw[L, DisplayFunction -> 
            Identity];
AppendTo[L, lineClipped[G, g]] // draw;

{Circle[origin, 0] ⋂ 
        lineq[1, 1, 1], 
Circle[origin, 0] ⋂ 
        lineq[1, 1, 0], 
Circle[origin, 1] ⋂ 
        lineq[0, 0, 1], 
Circle[
          origin, -1] ⋂ 
        lineq[1, 1, 1], 
Circle[
          origin, -1] ⋂ lineq[0, 0, 1]}

{Circle[{0, 0}, 1] ⋂ 
        lineq[1, 
          1, -1], 
Circle[{0, 
            0}, -1] ⋂ lineq[1, 1, -1]}

Circle[{x1_, y1_}, r1_] ⋂ 
          Circle[{x2_, y2_}, 
            r2_] ^:= 
If[{x1, y1} == {x2, y2}, 
          If[r1 == r2, Circle[{x1, y1}, r1], {}], 
          Circle[{x1, y1}, r1] ⋂ 
lineq[
              2 (x1 - x2), 2 (y1 - y2), 
              (x1^2) + (x2^2) - (y1^2) + (y2^2) + (r1^2) - (r2^2)]];

Z = Point[2, 2];   r = 2  Sqrt[2] - 1;
K = Circle[Z, r];
{P} = unitCircle ⋂ K

L = {unitCircle, K, P, Z, origin};
G = 
        draw[L, DisplayFunction -> 
            Identity];
h = 
        lineClipped[G, 
          pointPerpendicular[P, origin⋁Z]];
Append[L, h]   // draw;

r = 1;
K = Circle[Z, r];
unitCircle ⋂ K

draw[{unitCircle, K, Z, origin}];

r = 2;
K = Circle[Z, r];
P = unitCircle⋂K

L = {unitCircle, K, P, origin, Z};
G = 
        draw[L, DisplayFunction -> 
            Identity];
h = 
        lineClipped[G, 
          P[[1]]⋁P[[2]]];
Append[L, h]   // draw;

{unitCircle ⋂ 
        Circle[Z, -1], 
unitCircle ⋂ 
        Circle[Z, 0], 
unitCircle ⋂ 
        Circle[origin, 0]}

{unitCircle ⋂ 
        unitCircle, 
unitCircle ⋂ 
        Circle[origin, 2], 
unitCircle ⋂ 
        Circle[Z, 100]}

Exercise 8

P = Point[3, 2];
M = midpoint[origin, P];   r = 
      distance[origin, P];
K = Circle[M, r/2];
Q = unitCircle ⋂ K;   Q1 = 
      1.2  Q;
s = 0.1;
L = {AbsolutePointSize[3], origin, P, Q, 
          M, 
rightAngle[1.1  Q[[1]] - 0.1  P, 
            Q[[1]], Q1[[1]], s], 
rightAngle[
            1.1  Q[[2]] - 0.1  P, Q[[2]], Q1[[2]], 
            s], 
{AbsoluteThickness[1], 
            unitCircle}, 
AbsoluteDashing[{3, 
              3}], 
origin  Q1[[1]], 
          origin Q1[[2]], origin P};
G = 
        draw[L, DisplayFunction -> 
            Identity];
PR = PlotRange /. AbsoluteOptions[G];
PrependTo[
        L, {AbsoluteThickness[1], rayClipped[G, P, Q[[1]]], 
          rayClipped[G, P, Q[[2]]]}];
AppendTo[L, K] ;
draw[L, PlotRange -> PR];