; searching for hypotenuses
(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 (mappend f . xss) (apply append (apply map f xss)))
(define sort #f)
(define merge #f)
(let ()
(define dosort
(lambda (pred? ls n)
(if (= n 1)
(list (car ls))
(let ((i (quotient n 2)))
(domerge pred?
(dosort pred? ls i)
(dosort pred? (list-tail ls i) (- n i)))))))
(define domerge
(lambda (pred? l1 l2)
(cond
((null? l1) l2)
((null? l2) l1)
((pred? (car l2) (car l1))
(cons (car l2) (domerge pred? l1 (cdr l2))))
(else (cons (car l1) (domerge pred? (cdr l1) l2))))))
(set! sort
(lambda (pred? l)
(if (null? l) l (dosort pred? l (length l)))))
(set! merge
(lambda (pred? l1 l2)
(domerge pred? l1 l2))))
(define (unique eql? xs)
(cond ((null? xs) '())
((null? (cdr xs)) xs)
((eql? (car xs) (cadr xs))
(unique eql? (cdr xs)))
(else (cons (car xs) (unique eql? (cdr xs))))))
(define (hypotenuse? qs n2)
(let loop ((rs (reverse qs)) (qs qs))
(cond ((or (null? qs) (null? rs)) #f)
((= (+ (car qs) (car rs)) n2) #t)
((< (+ (car qs) (car rs)) n2)
(loop (cdr rs) qs))
(else (loop rs (cdr qs))))))
(define (hypotenuses n)
(let loop ((h 1) (qs (list)) (hs (list)))
(if (= h n) (reverse hs)
(let* ((h2 (* h h)) (qs (cons h2 qs)))
(if (hypotenuse? qs h2)
(loop (+ h 1) qs (cons h hs))
(loop (+ h 1) qs hs))))))
(display (hypotenuses 100)) (newline)
(define (pyth n)
(let loop ((a 3) (b 4) (c 5))
(if (< n c) (list)
(append
(list (if (< a b) (list a b c) (list b a c)))
(loop (+ a (- b) (- b) c c)
(+ a a (- b) c c)
(+ a a (- b) (- b) c c c))
(loop (+ a b b c c)
(+ a a b c c)
(+ a a b b c c c))
(loop (+ (- a) b b c c)
(+ (- a) (- a) b c c)
(+ (- a) (- a) b b c c c))))))
(define (hypotenuses n)
(unique = (sort <
(mappend (lambda (z) (range z n z))
(unique = (sort < (map caddr (pyth n))))))))
(display (hypotenuses 100)) (newline)
(time (display (length (hypotenuses 10000))))