Den tor. 21. jan. 2021 kl. 05.06 skrev Stuart Hungerford < [email protected]>:
> 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 [email protected]. To view this discussion on the web visit https://groups.google.com/d/msgid/racket-users/CABefVgwQWiZ6JOHFuoJpWozECSNDyat_J6b38tYOsdZWMs9uHQ%40mail.gmail.com.
