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