; square-sum puzzle
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
((3) (let ((le? (if (negative? (caddr args)) >= <=)))
(let loop ((x(car args)) (xs '()))
(if (le? (cadr args) x)
(reverse xs)
(loop (+ x (caddr args)) (cons x xs))))))
(else (error 'range "unrecognized arguments"))))
(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 (square? n)
(let ((s (isqrt n)))
(= (* s s) n)))
(define (adjacent n k)
(filter (lambda (i)
(and (not (= i k))
(square? (+ i k))))
(range 1 (+ n 1))))
(define (make-graph n)
(map (lambda (k) (cons k (adjacent n k)))
(range 1 (+ n 1))))
(define (square-sum n)
(let ((graph (make-graph n)))
(call-with-current-continuation
(lambda (return)
(do ((node n (- node 1))) ((zero? node) (list))
(let dfs ((node node) (neighbors (assoc node graph)) (path (list node)))
(when (= (length path) n) (return path))
(do ((neighbors neighbors (cdr neighbors)))
((null? neighbors))
(when (not (member (car neighbors) path))
(dfs (car neighbors) (assoc (car neighbors) graph) (cons (car neighbors) path))))))))))
(display (square-sum 15)) (newline)