/usr/share/axiom-20170501/src/algebra/IDPAG.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 | )abbrev domain IDPAG IndexedDirectProductAbelianGroup
++ Author: Mark Botch
++ Description:
++ Indexed direct products of abelian groups over an abelian group \spad{A} of
++ generators indexed by the ordered set S.
++ All items have finite support: only non-zero terms are stored.
IndexedDirectProductAbelianGroup(A,S) : SIG == CODE where
A : AbelianGroup
S : OrderedSet
SIG ==> Join(AbelianGroup,IndexedDirectProductCategory(A,S))
CODE ==> IndexedDirectProductAbelianMonoid(A,S) add
--representations
Term:= Record(k:S,c:A)
Rep:= List Term
x,y: %
r: A
n: Integer
f: A -> A
s: S
-x == [[u.k,-u.c] for u in x]
n * x ==
n = 0 => 0
n = 1 => x
[[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
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.k,-y.first.c], 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
|