gemma(2009/04/20 09:42:57 PDT)
(use srfi-1) (define (primes n) (cond ((<= n 1) '()) ((= n 2) '(2)) (else (let loop ((l (unfold (cut > <> n) values (cut + <> 2) 3)) (prime-list '(2))) (let1 m (car l) (if (> (expt m 2) n) (append (reverse prime-list) l) (loop (remove (lambda (x) (zero? (modulo x m))) l) (cons m prime-list)))))))) (define (factorize n) (map (lambda (x) (cons x (let loop ((n n) (c 0)) (if (not (zero? (modulo n x))) c (loop (quotient n x) (+ c 1)))))) (filter (lambda (x) (and (<= x n) (zero? (modulo n x)))) (primes n))))
(factorize 60) outputs ((2 . 2) (3 . 1) (5 . 1))
ストリーム版。素数ストリームは遅くて、せいぜい5万以下の素数までしか実用にならない。一度5万まで計算してしまえば(これがしんどい)、次からは速い。
(use srfi-1) (use util.stream) (define (sieve xs) (stream-delay (stream-cons (stream-car xs) (sieve (stream-remove (lambda (n) (zero? (modulo n (stream-car xs)))) (stream-cdr xs)))))) (define primes (stream-cons 2 (sieve (stream-iota -1 3 2)))) (define (factorize n) (map (lambda (x) (cons x (let loop ((n n) (c 0)) (if (not (zero? (modulo n x))) c (loop (quotient n x) (+ c 1)))))) (filter (lambda (x) (zero? (modulo n x))) (stream->list (stream-take-while (cut <= <> n) primes)))))
sasagawa?(2010/10/08 17:39:14 PDT)
;;nを素因数分解して標準形式にして返す。p^a + q^b + r^c ((p a)(q b)(r c)) (define (prime-factors n) (define (iter ls p n mult) (cond ((null? ls) (cons (list p n) mult)) ((eq? (car ls) p) (iter (cdr ls) p (+ n 1) mult)) (else (iter (cdr ls) (car ls) 1 (cons (list p n) mult))))) (let ((ls (prime-factors2 n))) (iter (cdr ls) (car ls) 1 '()))) ;;mがnで割り切れるかどうか。割り切れれば#t そうでなければ#f ;; n|m 相当 (define (devidable m n) (= (modulo m n) 0)) ;;nを素因数分解する。指数形式ではなく単純に素数を並べたリストで返す。 ;;prime-factorsの下請け (define (prime-factors2 n) (define (iter p x ls z) (cond ((= x 1) ls) ((> p z) (cons x ls)) ((devidable x p) (iter1 p (/ x p) (cons p ls))) ((= p 2) (iter 3 x ls z)) (else (iter (+ p 2) x ls z)))) (define (iter1 p x ls) (if (devidable x p) (iter1 p (/ x p) (cons p ls)) (iter p x ls (sqrt x)))) (iter 2 n '() (sqrt n))) gosh> (time (prime-factors 12345678901234567890)) ;(time (prime-factors 12345678901234567890)) ; real 0.000 ; user 0.000 ; sys 0.000 ((2 1) (3 2) (5 1) (101 1) (3541 1) (3607 1) (3803 1) (27961 1))
Tags: Puzzle, util.stream