1;;; Extension of arithmetic operators to complex and rational numbers 2;;; under construction 3 4;; complex-number 5(defclass <complex> () 6 ((r :accessor real-part :initform 0.0 :initarg r) 7 (i :accessor imag-part :initform 0.0 :initarg i))) 8 9;; ratinal-number 10(defclass <rational> () 11 ((n :accessor numerator :initform 0.0 :initarg n) 12 (d :accessor denominator :initform 0.0 :initarg d))) 13 14(defun make-rectangler (r i) 15 (create (class <complex>) 'r r 'i i)) 16 17(defun make-rational (n d) 18 (create (class <rational>) `n n `d d)) 19 20(defun complexp (x) 21 (eql (class-of x) (class <complex>))) 22 23(defun rationalp (x) 24 (eql (class-of x) (class <rational>))) 25 26(defgeneric display (x)) 27 28(defmethod display ((x <complex>)) 29 (if (>= (imag-part x) 0) 30 (format (standard-output) "~A+~Ai~%" (real-part x) (imag-part x)) 31 (format (standard-output) "~A~Ai~%" (real-part x) (imag-part x)))) 32 33(defmethod display ((x <rational>)) 34 (format (standard-output) "~A/~A~%" (numerator x) (denominator x))) 35 36(defmethod display ((x <number>)) 37 (format (standard-output) "~A~%" x)) 38 39;;; generic-function 40(defgeneric e+ (x y)) 41 42(defmethod e+ ((x <complex>) (y <complex>)) 43 (let ((r (+ (real-part x) (real-part y))) 44 (i (+ (imag-part x) (imag-part y)))) 45 (create (class <complex>) 'r r 'i i))) 46 47(defmethod e+ ((x <rational>) (y <rational>)) 48 (let* ((d (lcm (denominator x) (denominator y))) 49 (n1 (* (numerator x) (div d (denominator x)))) 50 (n2 (* (numerator y) (div d (denominator y)))) 51 (n3 (+ n1 n2)) 52 (d1 (div d (gcd n3 d))) 53 (n4 (div n3 (gcd n3 d)))) 54 (create (class <rational>) 'n n4 'd d1))) 55 56(defmethod e+ ((x <number>) (y <number>)) 57 (+ x y)) 58 59 60(defgeneric e- (x y)) 61 62(defmethod e- ((x <complex>) (y <complex>)) 63 (let ((r (- (real-part x) (real-part y))) 64 (i (- (imag-part x) (imag-part y)))) 65 (create (class <complex>) 'r r 'i i))) 66 67(defmethod e- ((x <rational>) (y <rational>)) 68 (let* ((d (lcm (denominator x) (denominator y))) 69 (n1 (* (numerator x) (div d (denominator x)))) 70 (n2 (* (numerator y) (div d (denominator y)))) 71 (n3 (- n1 n2)) 72 (d1 (div d (gcd n3 d))) 73 (n4 (div n3 (gcd n3 d)))) 74 (create (class <rational>) 'n n4 'd d1))) 75 76(defmethod e- ((x <number>) (y <number>)) 77 (- x y)) 78 79 80 81(defgeneric e* (x y)) 82 83(defmethod e* ((x <complex>) (y <complex>)) 84 (let* ((a (real-part x)) 85 (b (imag-part x)) 86 (c (real-part y)) 87 (d (imag-part y)) 88 (r (- (* a c) (* b d))) 89 (i (- (* a d) (* b c)))) 90 (create (class <complex>) 'r r 'i i))) 91 92(defmethod e* ((x <rational>) (y <rational>)) 93 (let* ((d (* (denominator x) (denominator y))) 94 (n (* (numerator x) (numerator y))) 95 (d1 (div d (gcd n d))) 96 (n1 (div n (gcd n d)))) 97 (create (class <rational>) 'n n1 'd d1))) 98 99(defmethod e* ((x <number>) (y <number>)) 100 (* x y)) 101 102 103 104(defgeneric e/ (x y)) 105 106(defmethod e/ ((x <complex>) (y <complex>)) 107 (let* ((a (real-part x)) 108 (b (imag-part x)) 109 (c (real-part y)) 110 (d (imag-part y)) 111 (e (+ (* c c) (* d d))) 112 (r (quotient (- (* a c) (* b d)) e)) 113 (i (quotient (- (* a d) (* b c)) e))) 114 (create (class <complex>) 'r r 'i i))) 115 116(defmethod e/ ((x <rational>) (y <rational>)) 117 (let* ((d (* (denominator x) (numerator y))) 118 (n (* (numerator x) (denominator y))) 119 (d1 (div d (gcd n d))) 120 (n1 (div n (gcd n d)))) 121 (create (class <rational>) 'n n1 'd d1))) 122 123(defmethod e/ ((x <number>) (y <number>)) 124 (quotient x y)) 125 126 127 128