From f5bdf1084cd72ebb6556aa4df66f4191abc2b680 Mon Sep 17 00:00:00 2001
From: Mike Vink <mike1994vink@gmail.com>
Date: Sun, 7 May 2023 17:17:59 +0200
Subject: make rational generic

---
 coding-exercises/2/83/install-rational.rkt | 77 +++++++++++++++++++++---------
 coding-exercises/2/83/install.rkt          |  2 +-
 coding-exercises/2/93.rkt                  | 20 ++++++++
 3 files changed, 75 insertions(+), 24 deletions(-)
 create mode 100644 coding-exercises/2/93.rkt

(limited to 'coding-exercises')

diff --git a/coding-exercises/2/83/install-rational.rkt b/coding-exercises/2/83/install-rational.rkt
index 337f38b..d1c94fc 100644
--- a/coding-exercises/2/83/install-rational.rkt
+++ b/coding-exercises/2/83/install-rational.rkt
@@ -2,35 +2,65 @@
 (provide install-rational)
 (require "../../../shared/data-directed-programming.rkt")
 
-(define (install-rational put get)
-  ;; local methods
-  (define (tagme x) (attach-tag 'rational x))
+(define (install-rational get put apply-fn)
+  ;; import generic methods
+  (define (=zero? a)
+    (apply-fn '=zero? a))
+  (define (equ? a b)
+    (apply-fn 'equ? a b))
+  (define (add a b)
+    (apply-fn 'add a b))
+  (define (neg a)
+    (apply-fn 'neg a))
+  (define (sub a b)
+    (apply-fn 'sub a b))
+  (define (mul a b)
+    (apply-fn 'mul a b))
+  (define (div a b)
+    (apply-fn 'div a b))
+  (define (cos a)
+    (apply-fn 'cos a))
+  (define (sin a)
+    (apply-fn 'sin a))
+  (define (sqr a)
+    (apply-fn 'sqr a))
+  (define (sqrt a)
+    (apply-fn 'sqrt a))
+  (define (atan a b)
+    (apply-fn 'atan a b))
+
+  ;; constructor and selectors
+  (define (make-rat n d) (list n d))
   (define (numer x) (car x))
-  (define (denom x) (cdr x))
+  (define (denom x) (cadr x))
+
+  ;; ops
   (define (add-rat x y)
-    (make-rat (+ (* (numer x) (denom y))
-                 (* (numer y) (denom x)))
-              (* (denom x) (denom y))))
+    (make-rat (add (mul (numer x) (denom y))
+                   (mul (numer y) (denom x)))
+              (mul (denom x) (denom y))))
+
   (define (neg-rat rat)
-    (make-rat (- (numer rat))
+    (make-rat (neg (numer rat))
               (denom rat)))
   (define (sub-rat x y)
-    (make-rat (- (* (numer x) (denom y))
-                 (* (numer y) (denom x)))
-              (* (denom x) (denom y))))
+    (make-rat (sub (mul (numer x) (denom y))
+                   (mul (numer y) (denom x)))
+              (mul (denom x) (denom y))))
+
   (define (mul-rat x y)
-    (make-rat (* (numer x) (numer y))
-              (* (denom x) (denom y))))
+    (make-rat (mul (numer x) (numer y))
+              (mul (denom x) (denom y))))
   (define (div-rat x y)
-    (make-rat (* (numer x) (denom y))
-              (* (denom x) (numer y))))
-  (define (equ? x y)
-    (and (= (numer x) (numer y))
-         (= (denom x) (denom y))))
-  (define (=zero? x)
-    (equal? (numer x) 0))
+    (make-rat (mul (numer x) (denom y))
+              (mul (denom x) (numer y))))
+  (define (equ?-rat x y)
+    (and (equ? (numer x) (numer y))
+         (equ? (denom x) (denom y))))
+  (define (=zero?-rat x)
+    (=zero? (numer x)))
 
-  (define (make-rat n d)
+  (define (make-rat-reduce-lowest-terms n d)
     (define (sign x)
       (cond
         ((and (< x 0) (< d 0)) (* -1 x))
@@ -47,6 +77,7 @@
        (lambda (x y) (tagme (make-rat x y))))
 
   ;; interface
+  (define (tagme x) (attach-tag 'rational x))
   (put 'add '(rational rational)
        (lambda (x y) (tagme (add-rat x y))))
   (put 'neg '(rational)
@@ -69,7 +100,7 @@
 
   ;; predicates
   (put 'equ? '(rational rational)
-       (lambda (x y) (equ? x y)))
+       (lambda (x y) (equ?-rat x y)))
   (put '=zero? '(rational)
-       (lambda (x) (=zero? x)))
+       (lambda (x) (=zero?-rat x)))
   'done)
diff --git a/coding-exercises/2/83/install.rkt b/coding-exercises/2/83/install.rkt
index 0812405..5a4f72a 100644
--- a/coding-exercises/2/83/install.rkt
+++ b/coding-exercises/2/83/install.rkt
@@ -49,7 +49,7 @@
                    get))
 
 (install-integer put get)
-(install-rational put get)
+(install-rational get put apply-fn)
 (install-real put get)
 (install-complex apply-fn get put)
 (install-polynomial get put apply-fn)
diff --git a/coding-exercises/2/93.rkt b/coding-exercises/2/93.rkt
new file mode 100644
index 0000000..4fe754e
--- /dev/null
+++ b/coding-exercises/2/93.rkt
@@ -0,0 +1,20 @@
+#lang racket
+(require "../../shared/data-directed-programming.rkt")
+(require "./83/install.rkt")
+;; arithmetic package
+(define get-put-apply (install-arithmetic-package))
+(define get (car get-put-apply))
+(define put (cadr get-put-apply))
+(define apply-fn (caddr get-put-apply))
+
+;; something
+(define p1 (make-polynomial 'x (sparse-termlist
+                                 (term 2 1) (term 0 1))))
+(define p2 (make-polynomial 'x (sparse-termlist
+                                 (term 3 1) (term 0 1))))
+(define rf (make-rat p2 p1))
+((lambda ()
+   (newline)
+   (display rf)
+   (newline)
+   (display (add rf rf))))
-- 
cgit v1.2.3