* algebra/indexedp.spad.pamphlet (IndexedDirectProductObject)

	[indexedDirectProductObject]: New.
	(IndexedDirectProductAbelianMonoid): Rework implementation.
	[construct]: Likewise.

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