[ create a new paste ] login | about

Link: http://codepad.org/Yl7mpAmO    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Sep 18:
; diophantine reciprocals

(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))


Output:
1
2
180180
cpu time: 1224 real time: 1243 gc time: 97


Create a new paste based on this one


Comments: