### 5.15 Commutative Rings ¶

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.

### 5.16 Rules and Rulesets ¶

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 … ¶

  Returns a new ruleset containing the rules formed by applying `cring:define-rule` to each 4-element list argument rule. If the first argument to `make-ruleset` is a symbol, then the database table created for the new ruleset will be named name. Calling `make-ruleset` with no rule arguments creates an empty ruleset.

Function: combined-rulesets ruleset1 … ¶
Function: combined-rulesets name ruleset1 … ¶

  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 named name. 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* and distribute/ 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 op is applied to lists whose `car`s are sub-op1 and sub-op2, respectively. The argument reduction is a procedure accepting 2 arguments which will be lists whose `car`s are sub-op1 and sub-op2.

Function: cring:define-rule op sub-op1 ’identity reduction ¶

  Defines a rule for the case when the operation represented by symbol op is applied to a list whose `car` is sub-op1, and some other argument. Reduction will be called with the list whose `car` is sub-op1 and some other argument.

  If reduction returns `#f`, the reduction has failed and other reductions will be tried. If reduction returns 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 to reduction will 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))))))

### 5.17 How to Create a Commutative Ring ¶

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)))