Hendecagon

.gitignore

*.svg
*.txt
*.gif

hendecagon.lisp

;; On a regular hendecagon in just two dimensions, how many
;; non-symmetric ways can you draw a maximal set of non-intersecting
;; diagonals?
;;   Source: http://yworld.com/puzzle/

;; Verified my computation below with: http://oeis.org/A000207

;; Label the vertices 0 - n. A diagonal is an ordered pair of vertex
;; points. A solution is a list of pairs of points,
;; i.e. ((0 . 2) (0 . 3) (0 . 4)).

(ql:quickload "lisp-unit")
(ql:quickload "cl-svg")

(defpackage :hendecagon
  (:use :common-lisp :lisp-unit :cl-svg)
  (:export :solve-for))

(in-package :hendecagon)

(defun diag (a b)
  "Create a diagonal connecting vertices A and B."
  (if (< a b)
      (cons a b)
      (cons b a)))

(defun diag-< (a b)
  "Return T if diagonal A connects lower-numbered vertices than B."
  (or (< (car a) (car b))
      (and (= (car a) (car b)) (< (cdr a) (cdr b)))))

(defun cross-p (a b)
  "Return T if A and B intersect."
  (or (equal a b)
      (< (car a) (car b) (cdr a) (cdr b))
      (< (car b) (car a) (cdr b) (cdr a))))

(defun diag-rotate (sides diag p)
  "Rotate diagonal DIAG by P positions."
  (labels ((rot (n) (mod (- n p) sides)))
    (diag (rot (car diag)) (rot (cdr diag)))))

(defun diag-rotate-all (sides set p)
  "Rotate an entire SET of diagonals."
  (sort (mapcar (lambda (d) (diag-rotate sides d p)) set) #'diag-<))

(defun diag-reflect (sides diag)
  "Reflect DIAG about vertex 1."
  (labels ((refl (n) (mod (- sides n) sides)))
    (diag (refl (car diag)) (refl (cdr diag)))))

(defun diag-reflect-all (sides set)
  "Reflect an entire SET of diagonals."
  (sort (mapcar (lambda (d) (diag-reflect sides d)) set) #'diag-<))

;; Generator functions

(defun contains-p (sides set sets)
  "Return T if SETS contains SET, accounting for rotations and reflections."
  (dolist (set (list set (diag-reflect-all sides set)))
    (dotimes (i sides)
      (if (gethash (diag-rotate-all sides set i) sets)
        (return-from contains-p t)))))

(defun gen (sides &optional (report #'print) (n (- sides 3)) diags)
  "Generate N diagonals, starting with existing DIAGS."
  (if (= n 0)
      (let ((set (sort (copy-list diags) #'diag-<)))
        (funcall report set))
      (loop for a from 0 to (- sides 3) do
           (loop for b from (+ a 2) to (min (1- sides) (+ a (- sides 2))) do
                (let ((diag (cons a b)))
                  (if (not (member diag diags :test 'cross-p))
                      (gen sides report (1- n) (cons diag diags))))))))

(defun set->svg (sides count set)
  "Draw the SET of diagonals out to an SVG."
  (let* ((size      600)
         (radius    290)
         (thickness 5)
         (font-size 44))
    (labels ((xpos (i) (+ (/ size 2) (* radius (cos (* 2 pi (/ i sides))))))
             (ypos (i) (+ (/ size 2) (* radius (sin (* 2 pi (/ i sides)))))))
      (with-svg-to-file
          (scene 'svg-1.1-toplevel :height size :width size)
          ((format nil "~d-agon-~8,'0d.svg" sides count) :if-exists :supersede)
        (text scene (:x 15 :y (- size 15))
          (tspan (:font-size font-size) (format nil "~d" count)))
        (dotimes (i sides)
          (draw scene (:line :x1 (xpos i)      :y1 (ypos i)
                             :x2 (xpos (1+ i)) :y2 (ypos (1+ i)))
                :stroke-width thickness :stroke "rgb(0, 0, 0)"
                :stroke-linecap "round"))
        (dolist (diag set)
          (draw scene (:line :x1 (xpos (car diag)) :y1 (ypos (car diag))
                             :x2 (xpos (cdr diag)) :y2 (ypos (cdr diag)))
                :stroke-width thickness :stroke "rgb(0, 0, 0)"))))))

;; Use it:

(defun solve-for (sides)
  (let ((all (make-hash-table :test 'equal)))
    (with-open-file (out (format nil "~d-agon.txt" sides)
                         :direction :output :if-exists :supersede)
      (gen sides
           (lambda (set)
             (unless (contains-p sides set all)
               (print set out)
               (setf (gethash set all) t)
               (set->svg sides (hash-table-count all) set)))))
    (hash-table-count all)))

;; Test

(define-test diag
  (assert-equal (cons 1 4) (diag 1 4))
  (assert-equal (cons 2 6) (diag 6 2)))

(define-test diag-<
  (assert-true  (diag-< (diag 1 3) (diag 1 4)))
  (assert-true  (diag-< (diag 2 5) (diag 3 5)))
  (assert-false (diag-< (diag 1 3) (diag 1 2)))
  (assert-false (diag-< (diag 1 3) (diag 1 3)))
  (assert-false (diag-< (diag 4 6) (diag 3 7)))
  (assert-true  (diag-< (diag 3 7) (diag 4 6))))

(define-test cross-p
  (assert-false (cross-p '(3 . 5) '(1 . 6)))
  (assert-false (cross-p '(1 . 4) '(1 . 6)))
  (assert-true  (cross-p '(2 . 5) '(1 . 4))))

(define-test diag-rotate
  (assert-equal (diag 2 4) (diag-rotate 6 (diag 0 4) 2))
  (assert-equal (diag 1 3) (diag-rotate 6 (diag 1 3) 0))
  (assert-equal (diag 3 5) (diag-rotate 6 (diag 1 3) -2)))

(define-test diag-reflect
  (assert-equal (diag 3 4) (diag-reflect 6 (diag 2 3)))
  (assert-equal (diag 1 5) (diag-reflect 6 (diag 1 5))))

(define-test contains-p
  (assert-true
   (contains-p 6 (list (diag 0 2) (diag 2 5) (diag 3 5))
               (list (list (diag 0 2) (diag 0 3) (diag 3 5)))))
  (assert-true
   (contains-p 6 (list (diag 0 2) (diag 0 3) (diag 0 4))
               (list (list (diag 0 2) (diag 0 3) (diag 0 4)))))
  (assert-true
   (contains-p 6 (list (diag 0 2)) (list (list (diag 0 4)))))
  (assert-false
   (contains-p 6 (list (diag 0 2)) (list (list (diag 0 3)))))
  (assert-true
   (contains-p 8 '((0 . 2) (0 . 3) (3 . 6) (3 . 7) (4 . 6))
                '(((0 . 2) (0 . 3) (3 . 6) (3 . 7) (4 . 6))))))

;(run-tests)

to-gif

#!/bin/bash

## Usage example:
##    ls 9-agon-*.svg | ./togif > 9-agon.gif

xargs -I{} convert {} {}.tmp.gif
gifsicle --loop --delay 100 -O3 --colors 8 *.tmp.gif
rm -f *.tmp.gif