[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/KC3nkLTk    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Apr 4:
; last non-zero digit of a factorial

(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 (expm b e m)
  (define (m* x y) (modulo (* x y) m))
  (cond ((zero? e) 1)
        ((even? e) (expm (m* b b) (/ e 2) m))
        (else (m* b (expm (m* b b) (/ (- e 1) 2) m)))))

(define (factorial n)
  (let loop ((n n) (f 1))
    (if (zero? n) f
      (loop (- n 1) (* f n)))))

(define (lnz1 n)
  (let loop ((f (factorial n)))
    (if (zero? (modulo f 10))
        (loop (quotient f 10))
        (modulo f 10))))

(display (lnz1 15)) (newline)

(define (lnz2 n) ; doesn't work
  (let loop ((i 2) (f 1))
    (cond ((zero? (modulo f 10)) (loop i (/ f 10)))
          ((< 9 f) (loop i (modulo f 10)))
          ((< n i) f)
          (else (loop (+ i 1) (* f i))))))

(display (lnz2 15)) (newline)

(define (lnz3 n)
  (let loop1 ((n n) (z 1) (two 0) (five 0))
    (if (zero? n)
        (modulo (* z (expm 2 (- two five) 10)) 10)
        (let loop2 ((m n) (two two) (five five))
          (cond ((zero? (modulo m 2))
                  (loop2 (/ m 2) (+ two 1) five))
                ((zero? (modulo m 5))
                  (loop2 (/ m 5) two (+ five 1)))
                (else (loop1 (- n 1) (* z m) two five)))))))

(display (lnz3 15)) (newline)

(define (lnz4 n)
  (define (p k)
    (if (< k 1) 1
      (vector-ref '#(6 2 4 8) (modulo k 4))))
  (define (l n)
    (if (< n 5) (vector-ref '#(1 1 2 6 4) n)
      (let ((q (quotient n 5)) (r (remainder n 5)))
        (modulo (* (p q) (l q) (l r)) 10))))
  (l n))

(display (lnz4 15)) (newline)
(display (lnz4 1000000)) (newline)


Output:
1
2
3
4
5
8
3
8
8
4


Create a new paste based on this one


Comments: