[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on May 23:
; big numbers: getting started

(define big-base 1000)

(define (integer->big int)
  (if (zero? int) (list 0)
    (if (negative? int)
        (let ((x (integer->big (- int))))
          (cons (- (car x)) (cdr x)))
        (let loop ((int int) (big '()))
          (if (< int big-base)
              (cons (+ (length big) 1)
                    (reverse (cons int big)))
              (loop (quotient int big-base)
                    (cons (modulo int big-base) big)))))))

(define (big->integer big)
  (if (zero? (car big)) 0
    (if (negative? (car big))
        (- (big->integer (cons (- (car big)) (cdr big))))
        (let loop ((bs (reverse (cdr big))) (n 0))
          (if (null? bs) n
            (loop (cdr bs) (+ (car bs) (* n big-base))))))))

(define (big-abs big)
  (if (positive? (car big)) big (cons (- (car big)) (cdr big))))
(define (big-negate big) (cons (* (car big) -1) (cdr big)))

(define (big-positive? big) (positive? (car big)))
(define (big-negative? big) (negative? (car big)))
(define (big-zero? big) (zero? (car big)))

(define (big-even? big)
  (or (big-zero? big) (even? (cadr big))))
(define (big-odd? big)
  (not (or (big-zero? big) (even? (cadr big)))))

(define (big-compare big1 big2)
  ; big1 < big2 => -1 ; big1 = big2 => 0 ; big1 > big2 => 1
  (cond ((< (car big1) (car big2)) -1)
        ((< (car big2) (car big1)) 1)
        (else (let loop ((b1 (reverse (cdr big1)))
                         (b2 (reverse (cdr big2))))
                (cond ((null? b1) 0)
                      ((< (car b1) (car b2)) -1)
                      ((< (car b2) (car b1)) 1)
                      (else (loop (cdr b1) (cdr b2))))))))

(define (big-eq? big1 big2)
  (zero? (big-compare big1 big2)))
(define (big-ne? big1 big2)
  (not (zero? (big-compare big1 big2))))
(define (big-lt? big1 big2)
  (negative? (big-compare big1 big2)))
(define (big-gt? big1 big2)
  (positive? (big-compare big1 big2)))
(define (big-le? big1 big2)
  (not (positive? (big-compare big1 big2))))
(define (big-ge? big1 big2)
  (not (negative? (big-compare big1 big2))))

(display (integer->big 12345678)) (newline)
(display (integer->big -87654321)) (newline)
(display (integer->big 1)) (newline)
(display (integer->big -1)) (newline)
(display (integer->big 0)) (newline)
(display (big->integer (integer->big 12345678))) (newline)
(display (big-abs (integer->big -87654321))) (newline)
(display (big-negate (integer->big -87654321))) (newline)
(display (big-even? (integer->big 12345678))) (newline)
(display (big-odd? (integer->big 12345678))) (newline)
(display (big-compare (integer->big 12345678) (integer->big -87654321))) (newline)
(display (big-lt? (integer->big 12345678) (integer->big -87654321))) (newline)


Output:
1
2
3
4
5
6
7
8
9
10
11
12
(3 678 345 12)
(-3 321 654 87)
(1 1)
(-1 1)
(0)
12345678
(3 321 654 87)
(3 321 654 87)
#t
#f
1
#f


Create a new paste based on this one


Comments: