TriangCentres.cljs

(ns basic
(:refer-clojure
  :exclude [+ - * / zero? compare divide numerator denominator
            infinite? abs ref partial =])
(:require
  [emmy.clerk :as ec]
  [emmy.env :as e :refer :all]
  [emmy.generic :as g]
  [emmy.mafs :as mafs]
  [emmy.viewer :as ev]
  ))

(def halfpi (/ pi 2))

(def tau (* 2 pi))

(def average "average of a vector of values" (/ sum count))

(defn r2d [r] (* r 360 (/ (* 2 pi))))

;; ***Q&D support functions:***
;; 
;; Lines represented as vector \[a b c\] corresponding to standard form, ax+by+c=0
;; 
;; a normalized to 1 ; b = -1/slope ; c = b\*y_intercept

(defn segment-angle [pt1 pt2]
  "the angle of slope of the given segment"
  (let [[x1 y1] pt1
        [x2 y2] pt2]
    (atan (- y1 y2) (- x1 x2))))

(defn line-angle [a b c]
  "the angle of the slope of a line in standard form"
  (if (zero? b) halfpi
      (atan (/ (- b)))))

(defn line-through
  "get standard equation of line through two points"
  [pt1 pt2]
  (if (= pt1 pt2) "error - identical"
    (let [[x1 y1] pt1
          [x2 y2] pt2]
      (cond
        (= x1 x2) [1 0 x1]      ; vertical
    ;    (= y1 y2) [0 1 y1]      ; horizontal
        :else
        (let                    ; convert to standard form  
          [slope (/ (- y1 y2) (- x1 x2))
           y_intercept (- y2 (* slope x2))
           b (/ -1 slope)
           c (* b y_intercept)]
          [1 b c])))))

(defn line-from
  "line through a point at a given angle" 
  [point angle]
  (let [[x y] point]
    (if (= angle halfpi) [1 0 x] ; vertical
        (let [slope (tan angle)
              y_intercept (- y (* slope x))
              b (/ -1 slope)
              c (* b y_intercept)]
           [1 b c]))))

(defn intersection
  "Return the intersection point of two lines"
  [line1 line2]
  (let [[a1 b1 c1] line1
        [a2 b2 c2] line2
        y (/ (- c1 c2) (- b1 b2))
        x (- c1 (* b1 y))]
    [x y]))

(defn bisector-angle-pts
  "the bisector of the segments [pt1 pt2] and [pt1 pt3] - 
  used by rendering, hence separated from bisector-line, below" 
  [pt1 pt2 pt3]
  (let [angle1 (segment-angle pt1 pt2)
        angle2 (segment-angle pt1 pt3)]
    (average [angle1 angle2])))

(defn bisector-line
  "The line bisecting the segments [pt1 pt2] and [pt1 pt3]" 
  [pt1 pt2 pt3]
  (line-from pt1 (bisector-angle-pts pt1 pt2 pt3)))

(defn incenter
  "the intersection of any two angle bisectors of a triangle" 
  [pt1 pt2 pt3]
  (intersection (bisector-line pt1 pt2 pt3)
                (bisector-line pt2 pt3 pt1)))

(defn heron [a b c]
  (let [s (/ (+ a b c) 2)] ; half perimeter
    (sqrt (* s (- s a) (- s b) (- s c)))))

(defn inradius-from-points
  "Inradius using Heron's method, thank you mr. Heron" 
  [pt1 pt2 pt3]
  (let [a (abs (- pt2 pt3))
        b (abs (- pt1 pt3))
        c (abs (- pt1 pt2))        
        A (heron a b c)
        s (/ (+ a b c) 2)]
    (/ A s)))

(defn bisect-segment
  "Return a point halfway between the two given ones"
  [pt1 pt2]
  (let [[p1x p1y] pt1 [p2x p2y] pt2]
    [(average [p1x p2x]) (average [p1y p2y])]))

(defn median [pt1 pt2 pt3]
  (line-through pt1 (bisect-segment pt2 pt3)))

(defn centroid
  "center of mass of the triangle, intersection of the medians" 
  [pt1 pt2 pt3]
  (let [[x1 y1] pt1
        [x2 y2] pt2
        [x3 y3] pt3]
    [(average [x1 x2 x3]) (average [y1 y2 y3])]))

(defn midpoint-perp
  "returns vector of the midpoint and perpendicular of a given segment" 
  [pt1 pt2]
  (let [midpoint (bisect-segment pt1 pt2)
        angle (segment-angle pt1 pt2)
        perp-angle (modulo (+ angle halfpi) tau)]
    [midpoint perp-angle]))

(defn midpoint-perp-line
  "returns the line indicated by (midpoint-perp pt1 pt2) -
  used for finding intersections"   
  [pt1 pt2]
  (let [[midpoint perp-angle] (midpoint-perp pt1 pt2)]
    (line-from midpoint perp-angle)))

(defn circumcenter [pt1 pt2 pt3]
  "center of circumcircle"
  (intersection (midpoint-perp-line pt1 pt3)
                (midpoint-perp-line pt2 pt3)))

(defn circumradius
  "using Heron, again"  
  [pt1 pt2 pt3]
  (let [a (abs (- pt2 pt3))
        b (abs (- pt1 pt3))
        c (abs (- pt1 pt2))
        AA (* 4 (heron a b c))]
    (/ (* a b c) AA)))

(defn orthonormal-angle
  "find the angle of the line normal to segment [pt1 pt2]" 
  [pt1 pt2]
  (let [base-angle (segment-angle pt1 pt2)
        normal-angle (modulo (+ base-angle halfpi) tau)]
    normal-angle))

(defn orthonormal-line
  "line from first point, normal to segment opposite"
  [pt1 pt2 pt3]
  (line-from pt1 (orthonormal-angle pt2 pt3)))

(defn orthocenter
  [pt1 pt2 pt3]
  (intersection (orthonormal-line pt1 pt2 pt3)
                (orthonormal-line pt2 pt3 pt1)))

;; ***Drawing Routine***

(ev/with-let
  [!points {:pt1 [-4 -1] :pt2 [0 3] :pt3 [3 -3]}]
  (let [pt_A (ev/get !points :pt1)
        pt_B (ev/get !points :pt2)
        pt_C (ev/get !points :pt3)
        triangle-color :blue
        incenter-color :green
        centroid-color :pink
        circumcenter-color :darkgray
        orthocenter-color :tan
        ]
    (comment ; Wouldn't it be nice to have something like...
        CC (ev/with-params {:atom !points :params [:pt1 :pt2 :pt3]}
                           circumcenter)
        CR (ev/with-params {:atom !points :params [:pt1 :pt2 :pt3]}
                           circumradius)
         ; etc, etc... 
         ; Then we wouldn't have to resort to client-side acrobatics, 
         ; like the backquoted constructions below.
         ; It would save a whole lot of recomputation, too.
      ) ; end comment
    (mafs/mafs
      (mafs/cartesian)
      (mafs/segment {:point1 pt_A :point2 pt_B :color triangle-color :weight 3.5})
      (mafs/segment {:point1 pt_B :point2 pt_C :color triangle-color :weight 3.5})
      (mafs/segment {:point1 pt_C :point2 pt_A :color triangle-color :weight 3.5})
      (comment
        ; =============== draw bisectors of the angles of the triangle
      `(let [~'bisect_A (bisector-angle-pts ~pt_A ~pt_B ~pt_C)]
         ~(mafs/point-angle {:point pt_A
                             :angle 'bisect_A
                             :color incenter-color
                             :style :dashed :weight 1}))
      `(let [~'bisect_B (bisector-angle-pts ~pt_B ~pt_C ~pt_A)]
         ~(mafs/point-angle {:point pt_B
                             :angle 'bisect_B
                             :color incenter-color
                             :style :dashed :weight 1}))
      `(let [~'bisect_C (bisector-angle-pts ~pt_C ~pt_A ~pt_B)]
         ~(mafs/point-angle {:point pt_C
                             :angle 'bisect_C
                             :color incenter-color
                             :style :dashed :weight 1}))
        )
      ;(comment
      ; draw incircle
      `(let [~'ic (incenter ~pt_A ~pt_B ~pt_C)
             ~'ir (inradius-from-points ~pt_A ~pt_B ~pt_C)]
         ~(mafs/circle {:center 'ic :radius 'ir :weight 1.5
                        :color incenter-color :fill-opacity 0.0}))
        ;)
      (comment
        ; draw incenter
        `(let [~'ic (incenter ~pt_A ~pt_B ~pt_C)
             ~'icx (~'ic 0)
             ~'icy (~'ic 1)]
         ~(mafs/point {:x 'icx :y 'icy :color incenter-color}))
        ) ; end comment
; ===============
      (comment
      ;draw medians (for centroid)
      `(let [~'median_BC (bisect-segment ~pt_B ~pt_C)]
         ~(mafs/through-points {:point1 pt_A
                                :point2 'median_BC
                                :color centroid-color
                                :style :dashed :weight 1}))
      `(let [~'median_CA (bisect-segment ~pt_C ~pt_A)]
         ~(mafs/through-points {:point1 pt_B
                                :point2 'median_CA
                                :color centroid-color
                                :style :dashed :weight 1}))
      `(let [~'median_AB (bisect-segment ~pt_A ~pt_B)]
         ~(mafs/through-points {:point1 pt_C
                                :point2 'median_AB
                                :color centroid-color
                                :style :dashed :weight 1}))
      )
      ;(comment
      ; draw centroid
      `(let [~'ce (centroid ~pt_A ~pt_B ~pt_C)
             ~'cex (~'ce 0)
             ~'cey (~'ce 1)]
         ~(mafs/point {:x 'cex :y 'cey :color centroid-color}))
      ;)
      ; =============== draw midpoint perpendicular circumcenter constructors
      (comment
      `(let [~'mp_BC (midpoint-perp ~pt_B ~pt_C)
               ~'cc (circumcenter ~pt_A ~pt_B ~pt_C)
               ~'midpoint (~'mp_BC 0)]
               ~(mafs/through-points {:point1 'midpoint
                                      :point2 'cc
                             :color circumcenter-color
                             :style :dashed :weight 1}))
      `(let [~'mp_CA (midpoint-perp ~pt_C ~pt_A)
               ~'cc (circumcenter ~pt_A ~pt_B ~pt_C)
             ~'midpoint (~'mp_CA 0)]
               ~(mafs/through-points {:point1 'midpoint
                                      :point2 'cc
                             :color circumcenter-color
                             :style :dashed :weight 1}))
      `(let [~'mp_AB (midpoint-perp ~pt_A ~pt_B)
               ~'cc (circumcenter ~pt_A ~pt_B ~pt_C)
             ~'midpoint (~'mp_AB 0)]
               ~(mafs/through-points {:point1 'midpoint
                                      :point2 'cc
                             :color circumcenter-color
                             :style :dashed :weight 1}))
      )
      ; draw circumcenter
      `(let [~'cc (circumcenter ~pt_A ~pt_B ~pt_C)
             ~'ccx (~'cc 0)
             ~'ccy (~'cc 1)]
         ~(mafs/point {:x 'ccx :y 'ccy :color circumcenter-color}))
      
      ; draw circumcircle
      ; ---------
      ; see comment "wouldn't it be nice"
      ; then all we'd have to do is...
      ; (mafs/circle {:center CC :radius CR :weight 1.5
      ;              :color circumcenter-color :fill-opacity 0.0})
 
      `(let [~'cc (circumcenter ~pt_A ~pt_B ~pt_C)
             ~'cr (circumradius ~pt_A ~pt_B ~pt_C)]
         ~(mafs/circle {:center 'cc :radius 'cr :weight 1.5
                        :color circumcenter-color :fill-opacity 0.0}))
      
      ; ==========  Draw the orthonormals and orthocenter
      ;(comment
      `(let [~'on_A (orthonormal-angle ~pt_B ~pt_C)]
         ~(mafs/point-angle {:point pt_A
                             :angle 'on_A
                             :color orthocenter-color
                             :style :dashed :weight 1}))
      `(let [~'on_B (orthonormal-angle ~pt_C ~pt_A)]
         ~(mafs/point-angle {:point pt_B
                             :angle 'on_B
                             :color orthocenter-color
                             :style :dashed :weight 1}))
      `(let [~'on_C (orthonormal-angle ~pt_A ~pt_B)]
         ~(mafs/point-angle {:point pt_C
                             :angle 'on_C
                             :color orthocenter-color
                             :style :dashed :weight 1}))
      ; draw orthocenter
      `(let [~'oc (orthocenter ~pt_A ~pt_B ~pt_C)
             ~'ocx (~'oc 0)
             ~'ocy (~'oc 1)]
         ~(mafs/point {:x 'ocx :y 'ocy :color orthocenter-color}))
      ;)
      
      
      ; draw the Euler line
      ;(comment
      `(let [~'cc (circumcenter ~pt_A ~pt_B ~pt_C)
             ~'ce (centroid ~pt_A ~pt_B ~pt_C)]
         ~(mafs/through-points {:point1 'cc :point2 'ce :weight 1.5
                                :color :cyan :style :dashed}))
      ;)
      ; put these last, so they're topmost
      (mafs/movable-point {:atom !points :path :pt1 :color :cyan})
      (mafs/movable-point {:atom !points :path :pt2 :color :cyan})
      (mafs/movable-point {:atom !points :path :pt3 :color :cyan})
      
      )))