diff options
Diffstat (limited to 'src/algebra')
| -rw-r--r-- | src/algebra/indexedp.spad.pamphlet | 141 | ||||
| -rw-r--r-- | src/algebra/mkrecord.spad.pamphlet | 16 |
2 files changed, 89 insertions, 68 deletions
diff --git a/src/algebra/indexedp.spad.pamphlet b/src/algebra/indexedp.spad.pamphlet index 34b61d1f..59b76a81 100644 --- a/src/algebra/indexedp.spad.pamphlet +++ b/src/algebra/indexedp.spad.pamphlet @@ -65,7 +65,10 @@ IndexedDirectProductCategory(A:SetCategory,S:OrderedSet): Category == IndexedDirectProductObject(A,S): Public == Private where A: SetCategory S: OrderedSet - Public == IndexedDirectProductCategory(A,S) + Public == IndexedDirectProductCategory(A,S) with + indexedDirectProductObject: List Pair(S,A) -> % + ++ \spad{indexedDirectProductObject l} constructs an indexed + ++ direct product object with support-value pairs given in \spad{l}. Private == add Term == Pair(S,A) Rep == List Term @@ -105,6 +108,8 @@ IndexedDirectProductObject(A,S): Public == Private where termIndex first rep x terms x == rep x + indexedDirectProductObject l == + per sort((x,y) +-> termIndex x > termIndex y, l) @ \section{domain IDPAM IndexedDirectProductAbelianMonoid} @@ -114,77 +119,93 @@ IndexedDirectProductObject(A,S): Public == Private where ++ generators indexed by the ordered set S. All items have finite support. ++ Only non-zero terms are stored. IndexedDirectProductAbelianMonoid(A:AbelianMonoid,S:OrderedSet): - Join(AbelianMonoid,IndexedDirectProductCategory(A,S)) + Join(AbelianMonoid,IndexedDirectProductCategory(A,S)) with + construct: List Pair(A,S) -> % + ++ \spad{l} returns an IndexedDirectProductAbelianMonoid object + ++ with support and value as specified in the list of pairs \spad{l}. == IndexedDirectProductObject(A,S) add --representations - Term:= Record(k:S,c:A) - Rep:= List Term - x,y: % + Term == Pair(S,A) + termIndex(t: Term): S == first t + termValue(t: Term): A == second t + r: A n: NonNegativeInteger f: A -> A s: S - 0 == [] - zero? x == null x + 0 == per indexedDirectProductObject [] + zero? x == null terms x - -- PERFORMANCE CRITICAL; Should build list up - -- by merging 2 sorted lists. Doing this will - -- avoid the recursive calls (very useful if there is a - -- large number of vars in a polynomial. --- x + y == --- null x => y --- null y => x --- y.first.k > x.first.k => cons(y.first,(x + y.rest)) --- x.first.k > y.first.k => cons(x.first,(x.rest + y)) --- r:= x.first.c + y.first.c --- r = 0 => x.rest + y.rest --- cons([x.first.k,r],(x.rest + y.rest)) - qsetrest!: (Rep, Rep) -> Rep - qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp + qsetrest!: (List Term, List Term) -> List Term + qsetrest!(l, e) == RPLACD(l, e)$Lisp - x + y == - null x => y - null y => x - endcell: Rep := empty() - res: Rep := empty() - while not empty? x and not empty? y repeat - newcell := empty() - if x.first.k = y.first.k then - r:= x.first.c + y.first.c - if not zero? r then - newcell := cons([x.first.k, r], empty()) - x := rest x - y := rest y - else if x.first.k > y.first.k then - newcell := cons(x.first, empty()) - x := rest x - else - newcell := cons(y.first, empty()) - y := rest y - if not empty? newcell then - if not empty? endcell then - qsetrest!(endcell, newcell) - endcell := newcell - else - res := newcell; - endcell := res - end := - empty? x => y - x - if empty? res then res := end - else qsetrest!(endcell, end) - res + -- PERFORMANCE CRITICAL; Should build list up + -- by merging 2 sorted lists. Doing this will + -- avoid the recursive calls (very useful if there is a + -- large number of vars in a polynomial. + x + y == + x' := terms x + y' := terms y + null x' => y + null y' => x + endcell: List Term := nil + res: List Term := nil + while not empty? x' and not empty? y' repeat + newcell: List Term := nil + if termIndex x'.first = termIndex y'.first then + r := termValue x'.first + termValue y'.first + if not zero? r then + newcell := cons([termIndex x'.first, r], empty()) + x' := rest x' + y' := rest y' + else if termIndex x'.first > termIndex y'.first then + newcell := cons(x'.first, empty()) + x' := rest x' + else + newcell := cons(y'.first, empty()) + y' := rest y' + if not empty? newcell then + if not empty? endcell then + qsetrest!(endcell, newcell) + endcell := newcell + else + res := newcell; + endcell := res + end := + empty? x' => y' + x' + if empty? res then res := end + else qsetrest!(endcell, end) + res pretend % n * x == - n = 0 => 0 - n = 1 => x - [[u.k,a] for u in x | (a:=n*u.c) ~= 0$A] + n = 0 => 0 + n = 1 => x + [[termIndex u,a] for u in terms x + | not zero?(a:=n * termValue u)] pretend % + + monomial(r,s) == + zero? r => 0 + per indexedDirectProductObject [[s,r]] + + map(f,x) == + [[termIndex tm,a] for tm in terms x + | not zero?(a:=f termValue tm)] pretend % + + reductum x == + null terms x => 0 + rest(terms x) pretend % + + leadingCoefficient x == + null terms x => 0 + termValue terms(x).first - monomial(r,s) == (r = 0 => 0; [[s,r]]) - map(f,x) == [[tm.k,a] for tm in x | (a:=f(tm.c)) ~= 0$A] + pair2Term(t: Pair(A,S)): Term == + [second t, first t] - reductum x == (null x => 0; rest x) - leadingCoefficient x == (null x => 0; x.first.c) + construct l == + per indexedDirectProductObject + [pair2Term t for t in l | not zero? first t] @ \section{domain IDPOAM IndexedDirectProductOrderedAbelianMonoid} diff --git a/src/algebra/mkrecord.spad.pamphlet b/src/algebra/mkrecord.spad.pamphlet index ea6e3795..0b0bc331 100644 --- a/src/algebra/mkrecord.spad.pamphlet +++ b/src/algebra/mkrecord.spad.pamphlet @@ -42,12 +42,11 @@ import SetCategory ++ Description: This domain provides a very simple representation ++ of the notion of `pair of objects'. It does not try to achieve ++ all possible imaginable things. -Pair(S: Type, T: Type): Public == Private where - Public ==> Type with +Pair(S: Type,T: Type): Public == Private where + Public == Type with if S has CoercibleTo OutputForm and T has CoercibleTo OutputForm then CoercibleTo OutputForm - if S has SetCategory and T has SetCategory then SetCategory pair: (S,T) -> % @@ -59,20 +58,20 @@ Pair(S: Type, T: Type): Public == Private where second: % -> T ++ second(p) extracts the second components of `p'. - Private ==> add - Rep := Record(fst: S, snd: T) + Private == add + Rep == Record(fst: S, snd: T) pair(s,t) == - [s,t]$Rep + per [s,t]$Rep construct(s,t) == pair(s,t) first x == - x.fst + rep(x).fst second x == - x.snd + rep(x).snd if S has CoercibleTo OutputForm and T has CoercibleTo OutputForm then coerce x == @@ -81,6 +80,7 @@ Pair(S: Type, T: Type): Public == Private where if S has SetCategory and T has SetCategory then x = y == first(x) = first(y) and second(x) = second(y) + @ |