diff options
| -rw-r--r-- | coding-exercises/2/78.rkt | 70 | ||||
| -rw-r--r-- | coding-exercises/2/78/complex-polar.rkt | 8 | ||||
| -rw-r--r-- | coding-exercises/2/78/complex-rectangular.rkt | 3 | ||||
| -rw-r--r-- | coding-exercises/2/78/install-complex-package.rkt | 73 | ||||
| -rw-r--r-- | coding-exercises/2/78/install-rational-package.rkt | 58 | ||||
| -rw-r--r-- | coding-exercises/2/78/scheme-number.rkt | 18 | ||||
| -rw-r--r-- | flake.lock | 30 | ||||
| -rw-r--r-- | flake.nix | 1 | ||||
| -rw-r--r-- | shared/data-directed-programming.rkt | 22 |
9 files changed, 261 insertions, 22 deletions
diff --git a/coding-exercises/2/78.rkt b/coding-exercises/2/78.rkt index 637ea10..1043e66 100644 --- a/coding-exercises/2/78.rkt +++ b/coding-exercises/2/78.rkt @@ -1,7 +1,8 @@ #lang racket (require "../../shared/data-directed-programming.rkt") -(require "./78/complex-rectangular.rkt") -(require "./78/complex-polar.rkt") +(require "./78/scheme-number.rkt") +(require "./78/install-rational-package.rkt") +(require "./78/install-complex-package.rkt") ;; We are basically making a data directed framework for arithmethic operations in this module (define pkg (make-dispatch-table)) (define put (putter pkg)) @@ -9,5 +10,66 @@ (define print-tbl (printer pkg)) (define apply-generic (make-apply put get)) -(install-rectangular-package put) -(install-polar-package put) +(install-scheme-number-package put) +(install-rational-package put) +(install-complex-package apply-generic get put) + +;; test running +;; num +(define (make-scheme-number n) + ((get 'make 'scheme-number) n)) +(define test-num (make-scheme-number 3)) + +;; rational +(define (make-rat n d) + ((get 'make 'rational) n d)) +(define test-rat (make-rat 1 2)) + +;; complex +(define (make-complex x y) + ((get 'make-from-real-imag 'complex) x y)) +(define test-complex (make-complex 1 2)) + +((lambda () + (println "add sub mul div") + (print (apply-generic 'add test-num test-num)) + (print (apply-generic 'add test-rat test-rat)) + (print (apply-generic 'add test-complex test-complex)) + (newline) + (print (apply-generic 'sub test-num test-num)) + (print (apply-generic 'sub test-rat test-rat)) + (print (apply-generic 'sub test-complex test-complex)) + (newline) + (print (apply-generic 'div test-num test-num)) + (print (apply-generic 'div test-rat test-rat)) + (print (apply-generic 'div test-complex test-complex)) + (newline) + (print (apply-generic 'mul test-num test-num)) + (print (apply-generic 'mul test-rat test-rat)) + (print (apply-generic 'mul test-complex test-complex)))) + +;; 78 +((lambda () + (newline) + ;; Should be represented just as a scheme number + (display test-num))) + +;; 79 +(define (equ? a b) + (apply-generic 'equ? a b)) +((lambda () + (newline) + (display "testing equ?") + (newline) + (println (equ? test-num test-num)) + (println (equ? test-rat test-rat)) + (println (equ? test-complex test-complex)))) + +;; 80 +(define (=zero? n) + (apply-generic '=zero? n)) +((lambda () + (newline) + (println (=zero? test-num)) + (println (=zero? test-rat)) + (println (=zero? test-complex)))) diff --git a/coding-exercises/2/78/complex-polar.rkt b/coding-exercises/2/78/complex-polar.rkt index 661627d..3c8cfe8 100644 --- a/coding-exercises/2/78/complex-polar.rkt +++ b/coding-exercises/2/78/complex-polar.rkt @@ -1,7 +1,8 @@ #lang racket (provide install-polar-package) +(require "../../../shared/data-directed-programming.rkt") -(define (install-polar-package) +(define (install-polar-package put) (define (magnitude z) (car z)) (define (angle z) @@ -21,4 +22,7 @@ (put 'real-part '(polar) real-part) (put 'imag-part '(polar) imag-part) (put 'magnitude '(polar) magnitude) - (put 'angle '(polar))) + (put 'angle '(polar) angle) + (put 'make-from-real-imag 'polar (lambda (x y) (typtag (make-from-real-imag x y)))) + (put 'make-from-mag-ang 'polar (lambda (r a) (typtag (make-from-mag-ang r a)))) + 'done) diff --git a/coding-exercises/2/78/complex-rectangular.rkt b/coding-exercises/2/78/complex-rectangular.rkt index 41e93b6..bbc2b8c 100644 --- a/coding-exercises/2/78/complex-rectangular.rkt +++ b/coding-exercises/2/78/complex-rectangular.rkt @@ -26,4 +26,5 @@ (put 'make-from-real-imag 'rectangular (lambda (x y) (typtag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'rectangular - (lambda (r a) (typtag (make-from-mag-ang r a))))) + (lambda (r a) (typtag (make-from-mag-ang r a)))) + 'done) diff --git a/coding-exercises/2/78/install-complex-package.rkt b/coding-exercises/2/78/install-complex-package.rkt new file mode 100644 index 0000000..a656495 --- /dev/null +++ b/coding-exercises/2/78/install-complex-package.rkt @@ -0,0 +1,73 @@ +#lang racket +(provide install-complex-package) +(require "../../../shared/data-directed-programming.rkt") +(require "./complex-rectangular.rkt") +(require "./complex-polar.rkt") + + +(define (install-complex-package apply-generic get put) + ;; install and import methods + (install-rectangular-package put) + (install-polar-package put) + (define (make-from-real-imag x y) + ((get 'make-from-real-imag 'rectangular) x y)) + (define (make-from-mag-ang r a) + ((get 'make-from-mag-ang 'polar) r a)) + + (define (real-part z) + (apply-generic 'real-part z)) + (define (imag-part z) + (apply-generic 'imag-part z)) + (define (magnitude z) + (apply-generic 'magnitude z)) + (define (angle z) + (apply-generic 'angle z)) + + ;; internal + (define (add-complex z1 z2) + (make-from-real-imag (+ (real-part z1) (real-part z2)) + (+ (imag-part z1) (imag-part z2)))) + (define (sub-complex z1 z2) + (make-from-real-imag (- (real-part z1) (real-part z2)) + (- (imag-part z1) (imag-part z2)))) + (define (mul-complex z1 z2) + (make-from-mag-ang (* (magnitude z1) (magnitude z2)) + (+ (angle z1) (angle z2)))) + (define (div-complex z1 z2) + (make-from-mag-ang (/ (magnitude z1) (magnitude z2)) + (- (angle z1) (angle z2)))) + + ;; predicates (...) -> bool + (define (equ? z1 z2) + (and (equal? (real-part z1) (real-part z2)) + (equal? (imag-part z1) (imag-part z2)))) + (define (=zero? z) + (and (= (real-part z)) (= (imag-part z)))) + + ;; interface + (define (typetag z) (attach-tag 'complex z)) + (put 'real-part '(complex) real-part) + (put 'imag-part '(complex) imag-part) + (put 'magnitude '(complex) magnitude) + (put 'angle '(complex) angle) + + (put 'add '(complex complex) + (lambda (z1 z2) (typetag (add-complex z1 z2)))) + (put 'sub '(complex complex) + (lambda (z1 z2) (typetag (sub-complex z1 z2)))) + (put 'mul '(complex complex) + (lambda (z1 z2) (typetag (mul-complex z1 z2)))) + (put 'div '(complex complex) + (lambda (z1 z2) (typetag (div-complex z1 z2)))) + + (put 'equ? '(complex complex) + (lambda (z1 z2) (equ? z1 z2))) + (put '=zero? '(complex) + (lambda (z1) (=zero? z1))) + + (put 'make-from-real-imag 'complex + (lambda (x y) (typetag (make-from-real-imag x y)))) + (put 'make-from-mag-ang 'complex + (lambda (r a) (typetag (make-from-mag-ang r a)))) + 'done) + diff --git a/coding-exercises/2/78/install-rational-package.rkt b/coding-exercises/2/78/install-rational-package.rkt new file mode 100644 index 0000000..db4475e --- /dev/null +++ b/coding-exercises/2/78/install-rational-package.rkt @@ -0,0 +1,58 @@ +#lang racket +(provide install-rational-package) +(require "../../../shared/data-directed-programming.rkt") + + +(define (install-rational-package put) + ;; internal + (define (numer x) (car x)) + (define (denom x) (cdr x)) + (define (make-rat n d) + (define (sign x) + (cond + ((and (< x 0) (< d 0)) (* -1 x)) + ((and (< 0 x) (< d 0)) (* -1 x)) + (else x))) + (let ((g (gcd n d))) + (cons (sign (/ n g)) (abs (/ d g))))) + (define (add-rat x y) + (make-rat (+ (* (numer x) (denom y)) + (* (numer y) (denom x))) + (* (denom x) (denom y)))) + (define (sub-rat x y) + (make-rat (- (* (numer x) (denom y)) + (* (numer y) (denom x))) + (* (denom x) (denom y)))) + (define (mul-rat x y) + (make-rat (* (numer x) (numer y)) + (* (denom x) (denom y)))) + (define (div-rat x y) + (make-rat (* (numer x) (denom y)) + (* (denom x) (numer y)))) + + ;; predicates + (define (equ? x y) + (and (equal? (numer x) (numer y)) + (equal? (denom x) (denom y)))) + (define (=zero? x) + (equal? (numer x) 0)) + + ;; interface + (define (typetag x) (attach-tag 'rational x)) + (put 'add '(rational rational) + (lambda (x y) (typetag (add-rat x y)))) + (put 'sub '(rational rational) + (lambda (x y) (typetag (sub-rat x y)))) + (put 'mul '(rational rational) + (lambda (x y) (typetag (mul-rat x y)))) + (put 'div '(rational rational) + (lambda (x y) (typetag (div-rat x y)))) + + (put 'equ? '(rational rational) + (lambda (x y) (equ? x y))) + (put '=zero? '(rational) + (lambda (x) (=zero? x))) + + (put 'make 'rational + (lambda (x y) (typetag (make-rat x y)))) + 'done) diff --git a/coding-exercises/2/78/scheme-number.rkt b/coding-exercises/2/78/scheme-number.rkt new file mode 100644 index 0000000..fa9c0ec --- /dev/null +++ b/coding-exercises/2/78/scheme-number.rkt @@ -0,0 +1,18 @@ +#lang racket +(provide install-scheme-number-package) +(require "../../../shared/data-directed-programming.rkt") + + +(define (install-scheme-number-package put) + ;; interface part + (define (typtag x) + (attach-tag 'scheme-number x)) + + (put 'add '(scheme-number scheme-number) (lambda (x y) (typtag (+ x y)))) + (put 'sub '(scheme-number scheme-number) (lambda (x y) (typtag (- x y)))) + (put 'mul '(scheme-number scheme-number) (lambda (x y) (typtag (* x y)))) + (put 'div '(scheme-number scheme-number) (lambda (x y) (typtag (/ x y)))) + (put 'equ? '(scheme-number scheme-number) (lambda (x y) (= x y))) + (put '=zero? '(scheme-number) (lambda (x) (= 0 x))) + (put 'make 'scheme-number (lambda (x) (typtag x))) + 'done) @@ -1,12 +1,15 @@ { "nodes": { "flake-utils": { + "inputs": { + "systems": "systems" + }, "locked": { - "lastModified": 1667395993, - "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "lastModified": 1681202837, + "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", "owner": "numtide", "repo": "flake-utils", - "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "rev": "cfacdce06f30d2b68473a46042957675eebb3401", "type": "github" }, "original": { @@ -17,11 +20,11 @@ }, "nixpkgs": { "locked": { - "lastModified": 1668326430, - "narHash": "sha256-fJEsHe+lzFf3qcQVTTdK9jqRtUUVXH71tdfgjcKJNpA=", + "lastModified": 1682181988, + "narHash": "sha256-CYWhlNi16cjGzMby9h57gpYE59quBcsHPXiFgX4Sw5k=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "fc07622617a373a742ed96d4dd536849d4bc1ec6", + "rev": "6c43a3495a11e261e5f41e5d7eda2d71dae1b2fe", "type": "github" }, "original": { @@ -36,6 +39,21 @@ "flake-utils": "flake-utils", "nixpkgs": "nixpkgs" } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } } }, "root": "root", @@ -16,7 +16,6 @@ in { devShell = pkgs.mkShell { buildInputs = with pkgs; [ - mitscheme racket ]; }; diff --git a/shared/data-directed-programming.rkt b/shared/data-directed-programming.rkt index 6cecaf1..7566e30 100644 --- a/shared/data-directed-programming.rkt +++ b/shared/data-directed-programming.rkt @@ -15,15 +15,21 @@ ;; Type tagged data (define (attach-tag type-tag contents) - (cons type-tag contents)) + (cond ((number? contents) contents) + ((symbol? contents) contents) + (else (cons type-tag contents)))) (define (type-tag datum) - (if (pair? datum) - (car datum) - (error "Bad tagged datum -- TYPE-TAG" datum))) + (cond + ((pair? datum) (car datum)) + ((number? datum) 'scheme-number) + ((symbol? datum) 'symbol) + (else (error "Bad tagged datum -- TYPE-TAG" datum)))) (define (contents datum) - (if (pair? datum) - (cdr datum) - (error "Bad tagged datum -- CONTENTS" datum))) + (cond + ((pair? datum) (cdr datum)) + ((number? datum) datum) + ((symbol? datum) datum) + (else (error "Bad tagged datum -- CONTENTS" datum)))) (define (find-type type seq) (define (rec items) @@ -39,7 +45,7 @@ (define dispatch-table '()) (define (printer) (newline) - (display dispatch-table)) + (println dispatch-table)) (define (get op types) (let ((op-datum (find-type op dispatch-table))) (if op-datum |