; the trapped knight
(import (rnrs hashtables (6)))
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
(let loop ((x n))
(let ((y (quotient (+ x (quotient n x)) 2)))
(if (< y x) (loop y) x)))))
(define-syntax define-memoized
(syntax-rules ()
((define-memoized (f arg ...) body ...)
(define f
(let ((cache (make-eq-hashtable)))
(lambda (arg ...)
(cond ((hashtable-ref cache `(,arg ...) #f) => car)
(else (let ((val (begin body ...)))
(hashtable-set! cache `(,arg ...) val)
val)))))))))
(define-memoized (n->point n)
(if (= n 1) (cons 0 0)
(let* ((k (modulo (isqrt (+ (* (- n 2) 4) 1)) 4))
(half-pi (* (atan 1) 2))
(k-half-pi (* k half-pi))
(prev (n->point (- n 1)))
(prev-x (car prev))
(prev-y (cdr prev)))
(cons (+ prev-x (inexact->exact (round (sin k-half-pi))))
(- prev-y (inexact->exact (round (cos k-half-pi))))))))
(display (n->point 10)) (newline)
(define max-n 0)
(define (hash p) (+ (* (car p) 10000) (cdr p)))
(define points (make-hashtable hash equal?))
(define (point->n point)
(cond ((hashtable-ref points point #f)
=> (lambda (n) n))
(else (let loop ((n (+ max-n 1)))
(set! max-n n)
(let ((p (n->point n)))
(hashtable-set! points p n)
(if (equal? point p) n
(loop (+ n 1))))))))
(display (point->n '(2 . -1))) (newline)
(define (k-moves n)
(let* ((p (n->point n)) (x (car p)) (y (cdr p)))
(sort (list
(point->n (cons (+ x 2) (+ y 1)))
(point->n (cons (+ x 2) (- y 1)))
(point->n (cons (- x 2) (+ y 1)))
(point->n (cons (- x 2) (- y 1)))
(point->n (cons (+ x 1) (+ y 2)))
(point->n (cons (+ x 1) (- y 2)))
(point->n (cons (- x 1) (+ y 2)))
(point->n (cons (- x 1) (- y 2)))) <)))
(display (k-moves 10)) (newline)
(define (knight)
(let loop ((tour (list 1)))
(let ((moves (filter (lambda (n) (not (member n tour)))
(k-moves (car tour)))))
(if (null? moves) (reverse tour)
(loop (cons (car moves) tour))))))
(define tour (knight))
(display (length tour)) (newline)
(display (car (reverse tour))) (newline)
(display tour)