/usr/share/axiom-20170501/src/algebra/IDPAM.spad is in axiom-source 20170501-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | )abbrev domain IDPAM IndexedDirectProductAbelianMonoid
++ Author: Mark Botch
++ Description:
++ Indexed direct products of abelian monoids over an abelian monoid
++ \spad{A} of generators indexed by the ordered set S. All items have
++ finite support. Only non-zero terms are stored.
IndexedDirectProductAbelianMonoid(A,S) : SIG == CODE where
A : AbelianMonoid
S : OrderedSet
SIG ==> Join(AbelianMonoid,IndexedDirectProductCategory(A,S))
CODE ==> IndexedDirectProductObject(A,S) add
--representations
Term:= Record(k:S,c:A)
Rep:= List Term
x,y: %
r: A
n: NonNegativeInteger
f: A -> A
s: S
0 == []
zero? x == null 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.
qsetrest!: (Rep, Rep) -> Rep
qsetrest!(l: Rep, e: Rep): Rep == 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
if empty? x then end := y
else end := x
if empty? res then res := end
else qsetrest!(endcell, end)
res
n * x ==
n = 0 => 0
n = 1 => x
[[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
monomial(r,s) == (r = 0 => 0; [[s,r]])
map(f,x) == [[tm.k,a] for tm in x | (a:=f(tm.c)) ^= 0$A]
reductum x == (null x => 0; rest x)
leadingCoefficient x == (null x => 0; x.first.c)
|