Common lisp rotated ellipse as two hulls

This turned out to be just a tiny bit tricky to do off the top of my head! Skip to the end for the assembled single function if you are in a rush.

First, I wrote line-by-line eev eepitch emacs <F8>able single use special scope expressions, then I put them all in lexical scope of a single function in a simple transformation.

The ellipse generation ends up returning a list of two lists of points, where points are (x y), one list being the upper hull and the other the lower hull of the specified ellipse.

The car and carlast of the upper hull are overwritten to be the car and carlast of the lower hull, so that the ellipse joins up.

The x axis is coarsely resampled in order to separate the two hulls after rotation.

This approach results in a two-halfed true function (one input results in one output - one for the upper hull and one for the lower hull).

The lower hull would fill to the lower of either its left or right brim with water if water were poured anywhere into it. The upper hull is concave downwards and the lower hull is concave upwards.

They were made to work nicely with my gnuplot-in-lisp article’s simple line plot run-program. Scroll down.

Setting up eepitch in emacs for slime

 (setq inferior-lisp-program "sbcl")
 (slime)
 (setq eepitch-buffer-name "*slime-repl sbcl*")

Let us use cl-series here too actually

Remember that cl-series generates down to pure lisp in the macroexpansion step (by performing prolog-like static analysis).

(require :series)
(series::install)

Rotated parametric ellipse

note that because eepitch enters text like-I-typed-it, this is like entering this series expression line-by-line into the repl (though obviously we just tap <F8>).

(let* ((radianses (scan-range :upto (* 2 pi) :by 1/360))
       (cos-angle (#Mcos radianses))
       ;;set major axis
       (major-axis (series 4))
       (x-normed (#M* major-axis cos-angle))
       (sin-angle (#Msin radianses))
       ;;set minor axis
       (minor-axis (series 3))
       (y-normed (#M* minor-axis sin-angle))
       ;;set rotation radians
       (rot-radians (series (/ pi 6)))
       ;;rotated x.
       (x-rot-x (#M* x-normed (#Mcos rot-radians)))
       (x-rot-y (#M- (#M* y-normed (#Msin rot-radians))))
       ;;summing and coarsening x.
       (x (#M/ (#Mfround (#M+ x-rot-x x-rot-y)
			 (series 0.1))
	       (series 10.0)))
       ;;rotated y.
       (y-rot-x (#M* x-normed (#Msin rot-radians)))
       (y-rot-y (#M* y-normed (#Mcos rot-radians)))
       ;;summing y
       (y (#M+ y-rot-x y-rot-y))
       ;;translating
       (tx (#M+ x (series 6.2)))
       (ty (#M+ y (series -3)))
       )
  
  (defparameter *rotated*
    (collect
	(#Mlist tx ty))))

What occured to me is that coarse-graining in x will give us a clear top and bottom of the rotated ellipse.

Separate top and bottom coarse ellipse arcs

(defparameter *rotated*
  (sort *rotated* '< :key 'car))

(loop
  :with results := (list)
  :for prev-x := nil :then x
  :for pair :in *rotated*
  :for (x y) := pair
  :if (equal prev-x x)
    :do
       (push pair (car results))
  :else
    :do
       (push`(,pair) results)
  :finally
     (return
       (defparameter *coarse-x* results)))

And, taking only the tops and bottoms of the bins while manually linking the first bins and last bins of the surfaces:

(loop
  :for bin :in *coarse-x*
  :for (binmin bimmax)
    := (loop :with min := nil
	     :with max := nil
	     :for pair :in bin
	     :for (x y) := pair
	     :do 
		(cond ((null min)
		       (setq min pair))
		      ((< y (cadr min))
		       (setq min pair)))
		(cond ((null max)
		       (setq max pair))
		      ((> y (cadr max))
		       (setq max pair)))
	     :finally (return (list min max)))
  :collect binmin :into bin-mins
  :collect bimmax :into bin-maxes
  :finally
     (setf (car bin-maxes) (car bin-mins)
	   (car (last bin-maxes)) (car (last bin-mins)))
     (return
       (values 
	(defparameter *lower-arc* bin-mins)
	(defparameter *upper-arc* bin-maxes))))

As one function


(require :series)
(series::install)

(defun get-ellipse-hulls
    (major-axis minor-axis rotation dx dy
     &aux
       rotated coarse-x)
  "get-ellipse-hulls (major-radius minor-radius rotation-radians translation-x translation-y)
Returns a list of two lists of points: First the lower hull, then the upper hull to make up the rotated, translated ellipse.
"
  (let* ((radianses (scan-range :upto (* 2 pi) :by 1/360))
	 (cos-angle (#Mcos radianses))
	 ;;set major axis
	 (major-axis (series major-axis))
	 (x-normed (#M* major-axis cos-angle))
	 (sin-angle (#Msin radianses))
	 ;;set minor axis
	 (minor-axis (series minor-axis))
	 (y-normed (#M* minor-axis sin-angle))
	 ;;set rotation radians
	 (rot-radians (series rotation))
	 ;;rotated x.
	 (x-rot-x (#M* x-normed (#Mcos rot-radians)))
	 (x-rot-y (#M- (#M* y-normed (#Msin rot-radians))))
	 ;;summing and coarsening x.
	 (x (#M/ (#Mfround (#M+ x-rot-x x-rot-y)
			   (series 0.1))
		 (series 10.0)))
	 ;;rotated y.
	 (y-rot-x (#M* x-normed (#Msin rot-radians)))
	 (y-rot-y (#M* y-normed (#Mcos rot-radians)))
	 ;;summing y
	 (y (#M+ y-rot-x y-rot-y))
	 ;;translating
	 (tx (#M+ x (series dx)))
	 (ty (#M+ y (series dy))))
    (setq rotated
	  (collect
	      (#Mlist tx ty)))
    (setq rotated
	  (sort rotated '< :key 'car))

    (loop
      :with results := (list)
      :for prev-x := nil :then x
      :for pair :in rotated
      :for (x y) := pair
      :if (equal prev-x x)
	:do
	   (push pair (car results))
      :else
	:do
	   (push`(,pair) results)
      :finally
	 (return
	   (setq coarse-x results)))

    (loop
      :for bin :in coarse-x
      :for (binmin bimmax)
	:= (loop :with min := nil
		 :with max := nil
		 :for pair :in bin
		 :for (x y) := pair
		 :do 
		    (cond ((null min)
			   (setq min pair))
			  ((< y (cadr min))
			   (setq min pair)))
		    (cond ((null max)
			   (setq max pair))
			  ((> y (cadr max))
			   (setq max pair)))
		 :finally (return (list min max)))
      :collect binmin :into bin-mins
      :collect bimmax :into bin-maxes
      :finally
	 (setf (car bin-maxes) (car bin-mins)
	       (car (last bin-maxes)) (car (last bin-mins)))
	 (return
	   (list bin-mins bin-maxes)))))

Example

Using my common lisp simple gnuplot

(apply 'gnuplot "Some random ellipses."
       (loop :repeat (random 10)
	     :for maj := (1+ (1+ (random 5)))
	     :for min :=  (1+ (random maj))
	     :for deg := (random 360)
	     :for rad := (* deg 2 pi 1/360)
	     :for tx := (random 10)
	     :for ty := (random 10)
	     :nconc
	     (get-ellipse-hulls maj min rad tx ty)))

Fin.

See you space cowboy!

I feel like writing this was so much work for what we got. At least the pictures are kind of idiosyncratically pretty!