The first patch fixes the problem that "construct" may modify
its argument subtly.
The second patch uses "construct" to greatly simplify "*" in MRING.
The third patch does some cleanup for MRING.
--
You received this message because you are subscribed to the Google Groups
"FriCAS - computer algebra system" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
To view this discussion on the web visit
https://groups.google.com/d/msgid/fricas-devel/CAGBJN91PfWw_bZdJE7tU-qF%2BfEkQU7ani74rbWs%3DsfmxF0a-mQ%40mail.gmail.com.
diff --git a/src/algebra/mring.spad b/src/algebra/mring.spad
index a4900be7..74bd09fc 100644
--- a/src/algebra/mring.spad
+++ b/src/algebra/mring.spad
@@ -96,8 +96,7 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
r = 0 => empty()
[[m, r]]
- monomial?(x) ==
- #(rep(x)) <= 1
+ monomial?(x) == empty? x or empty? rest x
if (R has Finite and M has Finite) then
size() == size()$R ^ size()$M
@@ -140,7 +139,8 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
0 == empty()
1 == [[1, 1]]
--- terms a == (copy a) pretend List(Term)
+ zero? a == empty? a
+ one? a == size?(a, 1) and one?(a.first.Cf) and one?(a.first.Mn)
terms a == copy rep a
monomials a == [[t] for t in a]
coefficients a == [t.Cf for t in a]
@@ -158,19 +158,23 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
then
(r : R) * (a : %) ==
r = 0 => 0
+ one? r => a
[[t.Mn, r*t.Cf] for t in a]
else
(r : R) * (a : %) ==
r = 0 => 0
+ one? r => a
[[t.Mn, rt] for t in a | (rt := r*t.Cf) ~= 0]
if R has noZeroDivisors
then
(n : Integer) * (a : %) ==
n = 0 => 0
+ n = 1 => a
[[t.Mn, n*t.Cf] for t in a]
else
(n : Integer) * (a : %) ==
n = 0 => 0
+ n = 1 => a
[[t.Mn, nt] for t in a | (nt := n*t.Cf) ~= 0]
map(f, a) == [[t.Mn, ft] for t in a | (ft := f(t.Cf)) ~= 0]
numberOfMonomials a == #a
@@ -186,11 +190,9 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
if R has noZeroDivisors then
if M has Group then
recip a ==
- lt := terms a
- #lt ~= 1 => "failed"
- (u := recip lt.first.Cf) case "failed" => "failed"
- --(u::R) * inv lt.first.Mn
- monomial((u::R), inv lt.first.Mn)$%
+ not size?(a, 1) => "failed"
+ (u := recip a.first.Cf) case "failed" => "failed"
+ monomial((u::R), inv a.first.Mn)
else
recip a ==
#a ~= 1 or a.first.Mn ~= 1 => "failed"
@@ -213,7 +215,7 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
leadingSupport a == (empty? a => 1; a.first.Mn)
leadingMonomial a ==
empty? rep a => error "empty support"
- monomial((first rep a).Cf, (first rep a).Mn)
+ [first a]
leadingTerm a ==
empty? a => error "empty support"
@@ -269,6 +271,8 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
true
a + b ==
+ zero? a => b
+ zero? b => a
repa:Rep := rep a
repb:Rep := rep b
res : Rep := empty()
@@ -297,11 +301,13 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
construct! concat! [[[ta.Mn*tb.Mn, ta.Cf*tb.Cf]$Term
for tb in b] for ta in a]
- else -- M hasn't OrderedSet
+ else -- M hasn't Comparable
-- Terms are stored in random order.
a = b ==
#a ~= #b => false
- set(a pretend List(Term)) =$Set(Term) set(b pretend List(Term))
+ for t in a repeat
+ not member?(t, b) => return false
+ true
coefficient(a, m) ==
for t in a repeat
diff --git a/src/algebra/mring.spad b/src/algebra/mring.spad
index 0a1e9704..a4900be7 100644
--- a/src/algebra/mring.spad
+++ b/src/algebra/mring.spad
@@ -229,8 +229,8 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
termless(t1:Term, t2:Term):Boolean == smaller?(t1.k, t2.k)
- construct(x : List Term) : % ==
- xs : List Term := sort(termless, x)
+ construct!(x : List Term) : % ==
+ xs : List Term := sort!(termless, x)
res : List Term := empty()
-- find duplicates
while not empty? xs repeat
@@ -249,6 +249,8 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
cons([newc, t1.k], res)
res
+ construct(x : List Term) : % == construct! copy x
+
if R has CommutativeRing then
f : M -> R
x : %
@@ -288,60 +290,12 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
if smaller?(t.Mn, m) then return 0
0
-
- if M has OrderedMonoid then
-
- -- we use that multiplying an ordered list of monoid elements
- -- by a single element respects the ordering
-
- if R has noZeroDivisors then
- a : % * b : % ==
- +/[[[ta.Mn*tb.Mn, ta.Cf*tb.Cf]$Term
- for tb in b ] for ta in reverse a]
- else
- a : % * b : % ==
- +/[[[ta.Mn*tb.Mn, r]$Term
- for tb in b | not zero?(r := ta.Cf*tb.Cf)]
- for ta in reverse a]
- else -- M hasn't OrderedMonoid
-
- -- we cannot assume that mutiplying an ordered list of
- -- monoid elements by a single element respects the ordering:
- -- we have to order and to collect equal terms
- ge : (Term, Term) -> Boolean
- ge(s, t) == not smaller? (s.Mn, t.Mn)
-
- sortAndAdd : List Term -> List Term
- sortAndAdd(liTe) == -- assume liTe not empty
- liTe := sort(ge, liTe)
- m : M := (first liTe).Mn
- cf : R := (first liTe).Cf
- res : List Term := []
- for te in rest liTe repeat
- if m = te.Mn then
- cf := cf + te.Cf
- else
- if not zero? cf then res := cons([m, cf]$Term, res)
- m := te.Mn
- cf := te.Cf
- if not zero? cf then res := cons([m, cf]$Term, res)
- reverse res
-
-
- if R has noZeroDivisors then
- a : % * b : % ==
- zero? a => a
- zero? b => b -- avoid calling sortAndAdd with []
- +/[sortAndAdd [[ta.Mn*tb.Mn, ta.Cf*tb.Cf]$Term
- for tb in b ] for ta in reverse a]
- else
- a : % * b : % ==
- zero? a => a
- zero? b => b -- avoid calling sortAndAdd with []
- +/[sortAndAdd [[ta.Mn*tb.Mn, r]$Term
- for tb in b | not zero?(r := ta.Cf*tb.Cf)]
- for ta in reverse a]
-
+ a : % * b : % ==
+ zero? a or zero? b => 0
+ one? a => b
+ one? b => a
+ construct! concat! [[[ta.Mn*tb.Mn, ta.Cf*tb.Cf]$Term
+ for tb in b] for ta in a]
else -- M hasn't OrderedSet
-- Terms are stored in random order.
diff --git a/src/algebra/mring.spad b/src/algebra/mring.spad
index 7fd7244a..0a1e9704 100644
--- a/src/algebra/mring.spad
+++ b/src/algebra/mring.spad
@@ -236,14 +236,17 @@ MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition wher
while not empty? xs repeat
t1:= first xs
xs := rest xs
+ newc := t1.c
while not empty? xs repeat
t2:= first xs
if t1.k = t2.k then
- t1.c:= t1.c+t2.c
- xs:= rest xs
+ newc := newc + t2.c
+ xs := rest xs
else break
- if not zero? t1.c then
- res := cons (t1, res)
+ if not zero? newc then
+ res :=
+ newc = t1.c => cons(t1, res)
+ cons([newc, t1.k], res)
res
if R has CommutativeRing then
diff --git a/src/input/bugs2019.input b/src/input/bugs2019.input
index 441aff4a..e5bf158c 100644
--- a/src/input/bugs2019.input
+++ b/src/input/bugs2019.input
@@ -29,4 +29,14 @@ testcase "simplification of square root in 'radicalSolve'"
testEquals("rhs first radicalSolve(x^2+2*a*x+2*b,x)", "-sqrt(a^2-2*b)-a")
testEquals("rhs first radicalSolve(x^2+2*a*c*x+2*b*c^2,x)", "-c*sqrt(a^2-2*b)-a*c")
+testcase "fix 'construct' in MRING"
+
+T := MonoidRing(Integer, Integer)
+R := Record(k : Integer, c : Integer)
+x1 := construct([[2, 5]::R])$T
+x2 := construct([[2, 5]::R])$T
+l := terms x1
+construct(concat(l,l))$T
+testEquals("x1", "x2")
+
statistics()
