Scheme provides a consistent and capable set of numeric functions. Inexacts implement a field; integers a commutative ring (and Euclidean domain). This package allows one to use basic Scheme numeric functions with symbols and non-numeric elements of commutative rings.

`(require 'commutative-ring)`

The commutative-ring package makes the procedures `+`

,
`-`

, `*`

, `/`

, and `^`

careful in the sense
that any non-numeric arguments they do not reduce appear in the
expression output. In order to see what working with this package is
like, self-set all the single letter identifiers (to their corresponding
symbols).

(define a 'a) ... (define z 'z)

Or just `(require 'self-set)`

. Now try some sample expressions:

(+ (+ a b) (- a b)) ⇒ (* a 2) (* (+ a b) (+ a b)) ⇒ (^ (+ a b) 2) (* (+ a b) (- a b)) ⇒ (* (+ a b) (- a b)) (* (- a b) (- a b)) ⇒ (^ (- a b) 2) (* (- a b) (+ a b)) ⇒ (* (+ a b) (- a b)) (/ (+ a b) (+ c d)) ⇒ (/ (+ a b) (+ c d)) (^ (+ a b) 3) ⇒ (^ (+ a b) 3) (^ (+ a 2) 3) ⇒ (^ (+ 2 a) 3)

Associative rules have been applied and repeated addition and multiplication converted to multiplication and exponentiation.

We can enable distributive rules, thus expanding to sum of products form:

(set! *ruleset* (combined-rulesets distribute* distribute/)) (* (+ a b) (+ a b)) ⇒ (+ (* 2 a b) (^ a 2) (^ b 2)) (* (+ a b) (- a b)) ⇒ (- (^ a 2) (^ b 2)) (* (- a b) (- a b)) ⇒ (- (+ (^ a 2) (^ b 2)) (* 2 a b)) (* (- a b) (+ a b)) ⇒ (- (^ a 2) (^ b 2)) (/ (+ a b) (+ c d)) ⇒ (+ (/ a (+ c d)) (/ b (+ c d))) (/ (+ a b) (- c d)) ⇒ (+ (/ a (- c d)) (/ b (- c d))) (/ (- a b) (- c d)) ⇒ (- (/ a (- c d)) (/ b (- c d))) (/ (- a b) (+ c d)) ⇒ (- (/ a (+ c d)) (/ b (+ c d))) (^ (+ a b) 3) ⇒ (+ (* 3 a (^ b 2)) (* 3 b (^ a 2)) (^ a 3) (^ b 3)) (^ (+ a 2) 3) ⇒ (+ 8 (* a 12) (* (^ a 2) 6) (^ a 3))

Use of this package is not restricted to simple arithmetic expressions:

(require 'determinant) (determinant '((a b c) (d e f) (g h i))) ⇒ (- (+ (* a e i) (* b f g) (* c d h)) (* a f h) (* b d i) (* c e g))

Currently, only `+`

, `-`

, `*`

, `/`

, and `^`

support non-numeric elements. Expressions with `-`

are converted
to equivalent expressions without `-`

, so behavior for `-`

is
not defined separately. `/`

expressions are handled similarly.

This list might be extended to include `quotient`

, `modulo`

,
`remainder`

, `lcm`

, and `gcd`

; but these work only for
the more restrictive Euclidean (Unique Factorization) Domain.

The commutative-ring package allows control of ring properties through the use of rulesets.

— Variable: ***ruleset***

Contains the set of rules currently in effect. Rules defined by

`cring:define-rule`

are stored within the value of *ruleset* at the time`cring:define-rule`

is called. If*ruleset*is`#f`

, then no rules apply.

— Function: **make-ruleset**` rule1 ...`

— Function:**make-ruleset**` name rule1 ...`

— Function:

Returns a new ruleset containing the rules formed by applying

`cring:define-rule`

to each 4-element list argumentrule. If the first argument to`make-ruleset`

is a symbol, then the database table created for the new ruleset will be namedname. Calling`make-ruleset`

with no rule arguments creates an empty ruleset.

— Function: **combined-rulesets**` ruleset1 ...`

— Function:**combined-rulesets**` name ruleset1 ...`

— Function:

Returns a new ruleset containing the rules contained in each ruleset argument

ruleset. If the first argument to`combined-ruleset`

is a symbol, then the database table created for the new ruleset will be namedname. Calling`combined-ruleset`

with no ruleset arguments creates an empty ruleset.

Two rulesets are defined by this package.

— Constant: **distribute***

Contains the ruleset to distribute multiplication over addition and subtraction.

— Constant: **distribute/**

Contains the ruleset to distribute division over addition and subtraction.

Take care when using both

distribute*anddistribute/simultaneously. It is possible to put`/`

into an infinite loop.

You can specify how sum and product expressions containing non-numeric
elements simplify by specifying the rules for `+`

or `*`

for
cases where expressions involving objects reduce to numbers or to
expressions involving different non-numeric elements.

— Function: **cring:define-rule**` op sub-op1 sub-op2 reduction`

Defines a rule for the case when the operation represented by symbol

opis applied to lists whose`car`

s aresub-op1andsub-op2, respectively. The argumentreductionis a procedure accepting 2 arguments which will be lists whose`car`

s aresub-op1andsub-op2.

— Function: **cring:define-rule**` op sub-op1 'identity reduction`

Defines a rule for the case when the operation represented by symbol

opis applied to a list whose`car`

issub-op1, and some other argument.Reductionwill be called with the list whose`car`

issub-op1and some other argument.If

reductionreturns`#f`

, the reduction has failed and other reductions will be tried. Ifreductionreturns a non-false value, that value will replace the two arguments in arithmetic (`+`

,`-`

, and`*`

) calculations involving non-numeric elements.The operations

`+`

and`*`

are assumed commutative; hence both orders of arguments toreductionwill be tried if necessary.The following rule is the definition for distributing

`*`

over`+`

.(cring:define-rule '* '+ 'identity (lambda (exp1 exp2) (apply + (map (lambda (trm) (* trm exp2)) (cdr exp1))))))

The first step in creating your commutative ring is to write procedures to create elements of the ring. A non-numeric element of the ring must be represented as a list whose first element is a symbol or string. This first element identifies the type of the object. A convenient and clear convention is to make the type-identifying element be the same symbol whose top-level value is the procedure to create it.

(define (n . list1) (cond ((and (= 2 (length list1)) (eq? (car list1) (cadr list1))) 0) ((not (term< (first list1) (last1 list1))) (apply n (reverse list1))) (else (cons 'n list1)))) (define (s x y) (n x y)) (define (m . list1) (cond ((neq? (first list1) (term_min list1)) (apply m (cyclicrotate list1))) ((term< (last1 list1) (cadr list1)) (apply m (reverse (cyclicrotate list1)))) (else (cons 'm list1))))

Define a procedure to multiply 2 non-numeric elements of the ring.
Other multiplicatons are handled automatically. Objects for which rules
have *not* been defined are not changed.

(define (n*n ni nj) (let ((list1 (cdr ni)) (list2 (cdr nj))) (cond ((null? (intersection list1 list2)) #f) ((and (eq? (last1 list1) (first list2)) (neq? (first list1) (last1 list2))) (apply n (splice list1 list2))) ((and (eq? (first list1) (first list2)) (neq? (last1 list1) (last1 list2))) (apply n (splice (reverse list1) list2))) ((and (eq? (last1 list1) (last1 list2)) (neq? (first list1) (first list2))) (apply n (splice list1 (reverse list2)))) ((and (eq? (last1 list1) (first list2)) (eq? (first list1) (last1 list2))) (apply m (cyclicsplice list1 list2))) ((and (eq? (first list1) (first list2)) (eq? (last1 list1) (last1 list2))) (apply m (cyclicsplice (reverse list1) list2))) (else #f))))

Test the procedures to see if they work.

;;; where cyclicrotate(list) is cyclic rotation of the list one step ;;; by putting the first element at the end (define (cyclicrotate list1) (append (rest list1) (list (first list1)))) ;;; and where term_min(list) is the element of the list which is ;;; first in the term ordering. (define (term_min list1) (car (sort list1 term<))) (define (term< sym1 sym2) (string<? (symbol->string sym1) (symbol->string sym2))) (define first car) (define rest cdr) (define (last1 list1) (car (last-pair list1))) (define (neq? obj1 obj2) (not (eq? obj1 obj2))) ;;; where splice is the concatenation of list1 and list2 except that their ;;; common element is not repeated. (define (splice list1 list2) (cond ((eq? (last1 list1) (first list2)) (append list1 (cdr list2))) (else (slib:error 'splice list1 list2)))) ;;; where cyclicsplice is the result of leaving off the last element of ;;; splice(list1,list2). (define (cyclicsplice list1 list2) (cond ((and (eq? (last1 list1) (first list2)) (eq? (first list1) (last1 list2))) (butlast (splice list1 list2) 1)) (else (slib:error 'cyclicsplice list1 list2)))) (N*N (S a b) (S a b)) ⇒ (m a b)

Then register the rule for multiplying type N objects by type N objects.

(cring:define-rule '* 'N 'N N*N))

Now we are ready to compute!

(define (t) (define detM (+ (* (S g b) (+ (* (S f d) (- (* (S a f) (S d g)) (* (S a g) (S d f)))) (* (S f f) (- (* (S a g) (S d d)) (* (S a d) (S d g)))) (* (S f g) (- (* (S a d) (S d f)) (* (S a f) (S d d)))))) (* (S g d) (+ (* (S f b) (- (* (S a g) (S d f)) (* (S a f) (S d g)))) (* (S f f) (- (* (S a b) (S d g)) (* (S a g) (S d b)))) (* (S f g) (- (* (S a f) (S d b)) (* (S a b) (S d f)))))) (* (S g f) (+ (* (S f b) (- (* (S a d) (S d g)) (* (S a g) (S d d)))) (* (S f d) (- (* (S a g) (S d b)) (* (S a b) (S d g)))) (* (S f g) (- (* (S a b) (S d d)) (* (S a d) (S d b)))))) (* (S g g) (+ (* (S f b) (- (* (S a f) (S d d)) (* (S a d) (S d f)))) (* (S f d) (- (* (S a b) (S d f)) (* (S a f) (S d b)))) (* (S f f) (- (* (S a d) (S d b)) (* (S a b) (S d d)))))))) (* (S b e) (S c a) (S e c) detM )) (pretty-print (t)) -| (- (+ (m a c e b d f g) (m a c e b d g f) (m a c e b f d g) (m a c e b f g d) (m a c e b g d f) (m a c e b g f d)) (* 2 (m a b e c) (m d f g)) (* (m a c e b d) (m f g)) (* (m a c e b f) (m d g)) (* (m a c e b g) (m d f)))