Reddit dailyprogrammer [2015-08-10] Challenge #227 [Easy] Square Spirals

square-spirals.lisp

; https://www.reddit.com/r/dailyprogrammer/comments/3ggli3/20150810_challenge_227_easy_square_spirals/
; [2015-08-10] Challenge #227 [Easy] Square Spirals

; Rainer Joswig, [email protected], 2015
; portable Common Lisp code

; 'math' version based on Java version by 9speedy


;;; ================================================================
;;; Recursive Version

(defun next-xy (x y dir)
  "compute the next position"
  (check-type x (integer 1))
  (check-type y (integer 1))
  (ecase dir
    (:left  (values (1- x) y))
    (:right (values (1+ x) y))
    (:up    (values x (1- y)))
    (:down  (values x (1+ y)))))

(defun next-dir (dir ndir dir-len f)
  "compute the next direction and its parameters"
  (if (= ndir dir-len)
      (values (ecase dir
                (:right :up)
                (:up    :left)
                (:left  :down)
                (:down  :right))
              0
              (+ dir-len (funcall f)))
    (values dir (1+ ndir) dir-len)))

(defun make-0-1-function (&aux (i 1))
  (lambda ()
    "returns 0, then 1, then 0, then 1, ..."
    (setf i (if (zerop i) 1 0))))

(defun walk-spiral (size f &aux (f01 (make-0-1-function)))
  "Walks a spiral and calls function f on each number/position combination."
  (declare (optimize (speed 3) (debug 1))
           (type (integer 1) size))
  (labels ((walk-spiral-aux (n1 x y dir ndir dir-len)
             (declare (type (integer 1) n1 x y))
             (funcall f n1 x y)
             (multiple-value-bind (next-x next-y)
                 (next-xy x y dir)
               (multiple-value-bind (next-dir next-ndir next-dir-len)
                   (next-dir dir ndir dir-len f01)
                 (walk-spiral-aux (1+ n1) next-x next-y next-dir next-ndir next-dir-len)))))
    (walk-spiral-aux 1 (ceiling size 2) (ceiling size 2) :right 0 0)))


(defun where-is-n? (size n)
  "Given a number, computer the x y position of the number in the spiral"
  (check-type n (integer 1))
  (check-type size (integer 1))
  (assert (oddp size))
  (walk-spiral size (lambda (n1 x y)
                      (when (= n n1)
                        (return-from where-is-n? (values x y))))))

(defun which-n-is-x-y? (size gx gy)
  "Given an x y position, return the number on the spiral"
  (check-type gx (integer 1))
  (check-type gy (integer 1))
  (check-type size (integer 1))
  (assert (oddp size))
  (walk-spiral size (lambda (n1 x y)
                      (when (and (= x gx) (= y gy)
                        (return-from which-n-is-x-y? (values n1)))))))


;;; ================================================================
;;; 'Math' Version

(defun math-where-is-n? (size n)
  "Given a number, computer the x y position of the number in the spiral"
  (check-type n (integer 1))
  (check-type size (integer 1))
  (assert (oddp size))
  (let* ((root   (ceiling (sqrt n)))
         (diff   (- (* root root) n))
         (center (ceiling size 2)))
    (multiple-value-bind (x y)
        (if (oddp root)
            (if (< diff root)
                (values (+ (/ (1- root) 2) (- diff))
                        (+ (/ (1- root) 2)))
              (values (+ (/ (1- root) 2))
                      (+ (/ (* (1- root) 3) 2) (- diff))))
          (if (< diff root)
              (values (+ (- (/ (1- root) 2)) 1 diff)
                      (+ (- (/ (1- root) 2))))
            (values (+ (/ (1- root) 2) 1)
                    (+ (- (/ (* (1- root) 3) 2)) diff))))
      (values (truncate (+ center x)) (truncate (+ center y))))))

(defun math-which-n-is-x-y? (size x y)
  (check-type x (integer 1))
  (check-type y (integer 1))
  (check-type size (integer 1))
  (assert (oddp size))
  "Given an x y position, return the number on the spiral"
  (let* ((off  (* (+ x y (- (1+ size))) (if (plusp (- x y)) 1 -1)))
         (root (if (> off 0)
                   (- (* 2 x) (1+ size))
                 (- (1+ size) (* 2 y)))))
    (- (* root root) (+ off root -1))))


;;; ================================================================
;;; Tests

(defun test-square-spirals ()
  (flet ((test1 (size n x y)
           (assert (and (equal (multiple-value-list (math-where-is-n? size n))
                               (multiple-value-list (where-is-n?      size n)))
                        (equal (multiple-value-list (math-where-is-n? size n))
                               (list x y)))))
         (test2 (size x y n)
           (assert (= (math-which-n-is-x-y? size x y)
                      (which-n-is-x-y?      size x y)
                      n))))
    (print (test1 3 8 2 3))
    (print (test1 11 50 10 9))
    (print (test1 1024716039 557614022 512353188 512346213))
    (print (test2 7 1 1 37))
    (print (test2 9 6 8 47))
    t))
    
;;; ================================================================
;;; End of File