Next: Matrix Algebra, Previous: The Limit, Up: Mathematical Packages [Contents][Index]
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.
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.
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.
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.
Contains the ruleset to distribute multiplication over addition and subtraction.
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.
Defines a rule for the case when the operation represented by symbol
op is applied to lists whose cars are sub-op1 and
sub-op2, respectively. The argument reduction is a
procedure accepting 2 arguments which will be lists whose cars
are sub-op1 and sub-op2.
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))))))
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)))
Next: Matrix Algebra, Previous: The Limit, Up: Mathematical Packages [Contents][Index]