/usr/share/axiom-20170501/src/algebra/DIRPROD.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 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | )abbrev domain DIRPROD DirectProduct
++ Author: Mark Botch
++ Description:
++ This type represents the finite direct or cartesian product of an
++ underlying component type. This contrasts with simple vectors in that
++ the members can be viewed as having constant length. Thus many
++ categorical properties can by lifted from the underlying component type.
++ Component extraction operations are provided but no updating operations.
++ Thus new direct product elements can either be created by converting
++ vector elements using the \spadfun{directProduct} function
++ or by taking appropriate linear combinations of basis vectors provided
++ by the \spad{unitVector} operation.
DirectProduct(dim,R) : SIG == CODE where
dim : NonNegativeInteger
R : Type
SIG ==> DirectProductCategory(dim, R)
CODE ==> Vector R add
Rep := Vector R
coerce(z:%):Vector(R) == copy(z)$Rep pretend Vector(R)
coerce(r:R):% == new(dim, r)$Rep
parts x == VEC2LIST(x)$Lisp
directProduct z ==
size?(z, dim) => copy(z)$Rep
error "Not of the correct length"
if R has SetCategory then
same?: % -> Boolean
same? z == every?(x +-> x = z(minIndex z), z)
x = y == _and/[qelt(x,i)$Rep = qelt(y,i)$Rep for i in 1..dim]
retract(z:%):R ==
same? z => z(minIndex z)
error "Not retractable"
retractIfCan(z:%):Union(R, "failed") ==
same? z => z(minIndex z)
"failed"
if R has AbelianSemiGroup then
u:% + v:% == map(_+ , u, v)$Rep
if R has AbelianMonoid then
0 == zero(dim)$Vector(R) pretend %
if R has Monoid then
1 == new(dim, 1)$Vector(R) pretend %
u:% * r:R == map(x +-> x * r, u)
r:R * u:% == map(x +-> r * x, u)
x:% * y:% == [x.i * y.i for i in 1..dim]$Vector(R) pretend %
if R has CancellationAbelianMonoid then
subtractIfCan(u:%, v:%):Union(%,"failed") ==
w := new(dim,0)$Vector(R)
for i in 1..dim repeat
(c:=subtractIfCan(qelt(u, i)$Rep, qelt(v,i)$Rep)) case "failed" =>
return "failed"
qsetelt_!(w, i, c::R)$Rep
w pretend %
if R has Ring then
u:% * v:% == map(_* , u, v)$Rep
recip z ==
w := new(dim,0)$Vector(R)
for i in minIndex w .. maxIndex w repeat
(u := recip qelt(z, i)) case "failed" => return "failed"
qsetelt_!(w, i, u::R)
w pretend %
unitVector i ==
v:= new(dim,0)$Vector(R)
v.i := 1
v pretend %
if R has OrderedSet then
x < y ==
for i in 1..dim repeat
qelt(x,i) < qelt(y,i) => return true
qelt(x,i) > qelt(y,i) => return false
false
if R has OrderedAbelianMonoidSup then sup(x, y) == map(sup, x, y)
--)bo $noSubsumption := false
|