Den tor. 21. jan. 2021 kl. 05.06 skrev Stuart Hungerford < stuart.hungerf...@gmail.com>:
> My project is really aimed at supporting self-directed learning of > concepts from abstract algebra. > I was taught many years ago that to really understand something to try > implementing it in a high level language. > That will soon expose any hidden assumptions or misunderstandings. > > An early attempt (in Rust) is at: > https://gitlab.com/ornamentist/un-algebra > > By using the Rust trait system (and later Haskell typeclasses) I could > create structure traits/typeclasses that don't clash with the builtin > numeric types or with the larger more production oriented libraries in > those languages in the same general area of math. > > Once I added generative testing of the structure axioms I could experiment > with, e.g. finite fields and ensure all the relevant axioms and laws were > (at least probabilistically) met. > Not knowing Rust nor traits, I have amused myself writing a very simple version of traits. #lang racket (require (for-syntax syntax/parse racket/syntax)) ;;; ;;; TRAITS ;;; ; This file contains a minimal implementation of traits. ; Overview: ; (define-trait trait (method ...) ; A trait is defined as list of methods names. ; (implementation trait structure body ...) ; An implementation of a trait for a given structure types, ; associates functions to each of the methods suitable ; for that structure type. ; Within body, the method names can be used. ; (with ([id trait structure expression] ...) . body) ; Similar to (let ([id expression] ...) . body), ; but within the body, one can use id.method ; to call a method. ; Expansion time helpers (begin-for-syntax ; These functions produce new identifiers. The context is taken from stx. (define (identifier:structure-method stx s m) (format-id stx "~a-~a" s m)) (define (identifier:id.method stx id m) (format-id #'stx "~a.~a" id m)) ; get-methods : identifier -> list-of-identifiers (define (get-methods trait) (syntax-local-value (format-id trait "~a-methods" trait)))) ; SYNTAX (define-trait Name (name ...)) ; This declares a new trait with the name Name having the methods name .... (define-syntax (define-trait stx) (syntax-parse stx [(_define-trait Name (id ...)) (with-syntax ([trait-methods (format-id #'Name "~a-methods" #'Name)]) (syntax/loc stx (define-syntax trait-methods (list #'id ...))))] [(_define-trait Name (super-trait ...) (id ...)) (displayln (list 'dt stx)) (define ids (syntax->list #'(id ...))) (define supers (syntax->list #'(super-trait ...))) (with-syntax ([trait-methods (format-id #'Name "~a-methods" #'Name)] [((super-method ...) ...) (map get-methods supers)]) (syntax/loc stx (define-syntax trait-methods (list #'id ... #'super-method ... ...))))])) ; SYNTAX (implementation trait structure . body) ; Defines structure-method for each method of the trait. ; The structure-method is bound to method. ; If method is defined in body, then that binding is used. ; If method is not bound in body, but bound outside, the outside binding is used. ; If method is not bound at all, an error is signaled. (define-syntax (implementation stx) (syntax-parse stx [(_implementation trait structure body ...) (define methods (get-methods #'trait)) (with-syntax* ([(method ...) ; These short names are used by the user (for/list ([method methods]) (syntax-local-introduce (format-id #'stx "~a" method)))] [(structure-method ...) ; Used in the output of the `with` form. (for/list ([method methods]) (identifier:structure-method #'trait #'structure method))]) (syntax/loc stx (define-values (structure-method ...) (let () body ... (values method ...)))))])) (define-syntax (with stx) (syntax-parse stx [(_with ([id trait structure expression] ...) . body) (define traits (syntax->list #'(trait ...))) (define ids (syntax->list #'(id ...))) (define structures (syntax->list #'(structure ...))) (define methodss (map get-methods traits)) (define (map-methods f id t s ms) (for/list ([m ms]) (f id t s m))) (define (map-clauses f) (for/list ([id ids] [t traits] [s structures] [ms methodss]) (map-methods f id t s ms))) (with-syntax ([((id.method ...) ...) ; names used inside `with` (map-clauses (λ (id t s m) (syntax-local-introduce (identifier:id.method #'stx id m))))] [((structure-method ...) ...) ; names used outside `with` (map-clauses (λ (id t s m) (syntax-local-introduce (identifier:structure-method t s m))))] [((it ...) ...) ; all id (in the right shape) (map-clauses (λ (id t s m) id))]) (syntax/loc stx (let* ([id expression] ...) (let-syntaxes ([(id.method ...) ; we need a macro in other to pass id (values ; to the associated structure-method (λ (call-stx) (syntax-parse call-stx [(_ . args) (syntax/loc call-stx (structure-method it . args))])) ...)] ...) . body))))])) ;;; ;;; Test ;;; ; Let's test the traits with a silly fish example. (struct herring (size color) #:transparent) (define-trait Fish (grow swim shrink)) (define (shrink f) (displayln (~a "This type of fish can't swim: " f))) (implementation Fish herring ; swim : herring -> void (define (swim h) (match h [(herring s c) (displayln (~a "A " c " herring swims."))])) ; grow : fish integer -> fist ; Add the amount a to the size of of the fish. (define (grow h a) (match h [(herring s c) (herring (+ s a) c)]))) (define a-herring (herring 2 "gray")) (with ([h Fish herring a-herring]) (h.shrink) ; picks up default definition (h.grow 3)) ; uses the herring implementation of Fish ;; ; => (let ([h a-herring]) (herring-shrink h) (herring-grow h 3)) ;;; ;;; A simple implementation of rings using traits. ;;; (define-trait Set (member? size)) ; a Set has the methods member? and size (define-trait Monoid (Set) ($)) ; a Monoid is a Set with an operation $ (define-trait Group (Monoid) (inv)) ; a Group is a Monoid with an operation inv (define-trait Ring (Group) (+ |0| * |1|)) ; a Ring is an additive Group with an multiplicative monoid (require (prefix-in + (only-in racket/base +)) ; ++ is now standard + (prefix-in * (only-in racket/base *))) ; ** is now standard * (struct Z ()) (implementation Ring Z (define (member? R x) (integer? x)) (define (size R) +inf.0) ; Ring (define (+ R a b) (++ a b)) (define (* R a b) (** a b)) (define |0| 0) (define |1| 1) ; Group (define (inv R a) (- a)) ; Additive Monoid (define $ +)) (struct Zn (n)) (implementation Ring Zn (define (modulus R) (Zn-n R)) ; Set (define (member? R x) (and (integer? x) (<= x (modulus R)))) (define (size R) (modulus R)) ; Ring (define (+ R a b) (modulo (++ a b) (modulus R))) (define (* R a b) (modulo (** a b) (modulus R))) (define |0| 0) (define |1| 1) ; Group (define (inv R a) (modulo (- a) (modulus R))) ; Additive Monoid (define $ +)) (struct Zx (x p)) ; p(x) belongs to Z[x], the ring of polynomials over Z (require (prefix-in cas: racket-cas)) (implementation Ring Zx (define (var R) (Zx-x R)) ; Set (define (member? R f) (cas:polynomial? f (var R))) ; approximate (define (size R) +inf.0) ; Ring ; Note: We are assuming a and b are normalized. ; If a and b are normalized, the return values from + and * will ; automatically be normalized. (define (+ R a b) (cas:plus a b)) (define (* R a b) (cas:expand (cas:times a b))) (define |0| 0) (define |1| 1) ; Group (define (inv R a) (cas:times -1 a)) ; Additive Monoid (define $ +)) (struct Zx/I (x I)) ; the ideal I is represented by a polynomial p ; The ring of single variable polynomials over Z modulo an ideal I. ; Note: We are using racket-cas to compute, and it supports polynomials ; over Z, Q and floating points. It does support polynomials ; in several variables, so Zxy/I can be implemented in the same ; manner. (implementation Ring Zx/I (define (var R) (Zx/I-x R)) (define (I R) (Zx/I-I R)) ; a polynomial (define (inject R p) (cas:polynomial-remainder p (I R) (var R))) ; Set (define (member? R f) (cas:polynomial? f (var R))) ; approximate (define (size R) +inf.0) ; Ring (define (+ R a b) (inject R (cas:plus a b))) (define (* R a b) (inject R (cas:expand (cas:times a b)))) (define |0| 0) (define |1| 1) ; Group (define (inv R a) (cas:times -1 a)) ; Additive Monoid (define $ +)) (with ([R Ring Z (Z)]) (R.* (R.+ 1 2) 3)) ; => 9 (with ([R Ring Zn (Zn 5)]) (R.* (R.+ 1 2) 3)) ; => 4 (with ([R Ring Zx Zx]) (R.* (R.+ 'x 1) (R.+ 'x 1))) (with ([R Ring Zx/I (Zx/I 'x (cas:normalize '(+ (* x x) 1)))]) (R.* 'x 'x)) ; => -1 (with ([R Ring Zx/I (Zx/I 'x (cas:normalize '(+ (* x x) 1)))]) (R.* (R.+ 'x 1) (R.+ 'x 1))) ; => 2x -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. To view this discussion on the web visit https://groups.google.com/d/msgid/racket-users/CABefVgwQWiZ6JOHFuoJpWozECSNDyat_J6b38tYOsdZWMs9uHQ%40mail.gmail.com.
