codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; perfect power predicate (define (iroot k n) (let loop ((u n)) (let* ((s u) (t (+ (* (- k 1) s) (quotient n (expt s (- k 1))))) (u (quotient t k))) (if (< u s) (loop u) s)))) (define (ilog b n) (let loop1 ((lo 0) (b^lo 1) (hi 1) (b^hi b)) (if (< b^hi n) (loop1 hi b^hi (* hi 2) (* b^hi b^hi)) (let loop2 ((lo lo) (b^lo b^lo) (hi hi) (b^hi b^hi)) (if (<= (- hi lo) 1) (if (= b^hi n) hi lo) (let* ((mid (quotient (+ lo hi) 2)) (b^mid (* b^lo (expt b (- mid lo))))) (cond ((< n b^mid) (loop2 lo b^lo mid b^mid)) ((< b^mid n) (loop2 mid b^mid hi b^hi)) (else mid)))))))) (define (primes n) (let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t))) (let loop ((i 0) (p 3) (ps (list 2))) (cond ((< n (* p p)) (do ((i i (+ i 1)) (p p (+ p 2)) (ps ps (if (vector-ref bits i) (cons p ps) ps))) ((= i len) (reverse ps)))) ((vector-ref bits i) (do ((j (+ (* 2 i i) (* 6 i) 3) (+ j p))) ((<= len j) (loop (+ i 1) (+ p 2) (cons p ps))) (vector-set! bits j #f))) (else (loop (+ i 1) (+ p 2) ps)))))) (define (perfect-power? n) (if (not (and (integer? n) (positive? n))) (error 'perfect-power? "must be positive integer") (let loop ((ps (primes (ilog 2 n)))) (if (null? ps) #f (let ((x (iroot (car ps) n))) (if (= (expt x (car ps)) n) x (loop (cdr ps)))))))) (display (map perfect-power? '(32768 205442259656281392806087233013 213)))
Private
[
?
]
Run code
Submit