GNU Info
(slib.info)Commutative Rings
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.
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*
Contain the ruleset to distribute multiplication over addition and
subtraction.
- Constant: distribute/
Contain 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))))))
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 (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 (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)))
automatically generated by info2www version 1.2.2.9