; diophantine reciprocals
(define (xy-pairs n)
(let loop ((x (+ n 1)) (xys (list)))
(if (< (+ n n) x)
(reverse xys)
(let ((y (/ (* x n) (- x n))))
(if (integer? y)
(loop (+ x 1) (cons (list x y) xys))
(loop (+ x 1) xys))))))
(define (last-pair xs)
(let ((tail (cdr xs)))
(if (pair? tail) (last-pair tail) xs)))
(define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)
(define factors
(let ((wheel (cons 1 (cons 2 (cons 2 (cycle 4 2 4 2 4 6 2 6))))))
(lambda (n)
(let loop ((n n) (f 2) (wheel wheel) (fs (list)))
(if (< n (* f f))
(reverse (cons n fs))
(if (zero? (modulo n f))
(loop (/ n f) f wheel (cons f fs))
(loop n (+ f (car wheel)) (cdr wheel) fs)))))))
(define (numdiv2 n)
(let ((fs (factors n)))
(let loop ((prev (car fs)) (fs (cdr fs)) (f 2) (d 1))
(cond ((null? fs) (* d (+ f 1)))
((= (car fs) prev) (loop prev (cdr fs) (+ f 2) d))
(else (loop (car fs) (cdr fs) 2 (* d (+ f 1))))))))
(define (xy-count n) (/ (+ (numdiv2 n) 1) 2))
(time
(display (let loop ((n 1)) (if (<= 1000 (xy-count n)) n (loop (+ n 1)))))
(newline))
(time (display (xy-pairs 180180)) (newline))
(display (= (+ (/ 180181) (/ 32465012580)) (/ 180180)))
programmingpraxis
-
Scheme,
pasted
on Sep 18: