codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; gaussian integers, part 1 (define (gs a b) (cons a b)) (define (re x) (car x)) (define (im x) (cdr x)) (define (gauss a b) (when (not (integer? a)) (error 'gauss "must be integer")) (when (not (integer? b)) (error 'gauss "must be integer")) (gs a b)) (define (gauss-from-complex x) (gauss (real-part x) (imag-part x))) (define (gauss-to-complex x) (make-rectangular (re x) (im x))) (define (gauss-zero? x) (and (zero? (re x)) (zero? (im x)))) (define (gauss-unit? x) (or (and (= (abs (re x)) 1) (zero? (im x))) (and (zero? (re x)) (= (abs (im x)) 1)))) (define (gauss-conjugate x) (gs (re x) (- (im x)))) (define (gauss-norm x) (define (square x) (* x x)) (+ (square (re x)) (square (im x)))) (define (gauss-eql? x y) (and (= (re x) (re y)) (= (im x) (im y)))) (define (gauss-add . xs) (define (add x y) (gs (+ (re x) (re y)) (+ (im x) (im y)))) (let loop ((xs xs) (zs (gs 0 0))) (if (null? xs) zs (loop (cdr xs) (add (car xs) zs)))) (define (gauss-negate x) (gs (- (re x)) (- (im x)))) (define (gauss-sub . xs) (define (sub x y) (gs (- (re x) (re y)) (- (im x) (im y)))) (cond ((null? xs) (error 'gauss-sub "no operands")) ((null? (cdr xs)) (gauss-negate (car xs))) (else (let loop ((xs (cdr xs)) (zs (car xs))) (if (null? xs) zs (loop (cdr xs) (sub zs (car xs)))))))) (define (gauss-mul . xs) (define (mul x y) (gs (- (* (re x) (re y)) (* (im x) (im y))) (+ (* (re x) (im y)) (* (im x) (re y))))) (let loop ((xs xs) (zs (gs 1 0))) (if (null? xs) zs (loop (cdr xs) (mul (car xs) zs))))) (define (gauss-quotient num den) (let ((n (gauss-norm den)) (r (+ (* (re num) (re den)) (* (im num) (im den)))) (i (- (* (re den) (im num)) (* (re num) (im den))))) (gs (round (/ r n)) (round (/ i n))))) (define (gauss-remainder num den quo) (gauss-sub num (gauss-mul den quo)))
Private
[
?
]
Run code
Submit