https://github.com/oldk1331/fricas/commit/1e58b16c42867b8218439bf1fbbfc6976fe6fb40.patch

The original implementation is unnecessarily complicated.

diff --git a/src/algebra/fr.spad b/src/algebra/fr.spad
index 8d6547cb..8486cf2b 100644
--- a/src/algebra/fr.spad
+++ b/src/algebra/fr.spad
@@ -413,37 +413,20 @@
         (expand((u exquo u1)::%) + expand((v exquo u1)::%)) * u1

       gcd(u, v) ==
-        (u = 1) or (v = 1) => 1
-        zero? u => v
-        zero? v => u
-        f1 := empty()$List(Integer)  -- list of used factor indices in x
-        f2 := f1      -- list of indices corresponding to a given factor
-        f3 := empty()$List(List Integer)    -- list of f2-like lists
-        x := concat(factorList u, factorList v)
-        for i in minIndex x .. maxIndex x repeat
-          if not member?(i, f1) then
-            f1 := concat(i, f1)
-            f2 := [i]
-            for j in i+1..maxIndex x repeat
-              if x.i.factor = x.j.factor then
-                  f1 := concat(j, f1)
-                  f2 := concat(j, f2)
-            f3 := concat(f2, f3)
-        x1 := empty()$List(FF)
-        while not empty? f3 repeat
-          f1 := first f3
-          if #f1 > 1 then
-            i  := first f1
-            y  := copy x.i
-            f1 := rest f1
-            while not empty? f1 repeat
-              i := first f1
-              if x.i.exponent < y.exponent then y.exponent := x.i.exponent
-              f1 := rest f1
-            x1 := concat(y, x1)
-          f3 := rest f3
-        if comparableR? then x1 := sort!(LispLessP, x1)
-        mkFF(1, x1)
+          one? u or one? v => u
+          zero? u => v
+          zero? v => u
+          lu := factorList u; lv := factorList v
+          res : List FF := []
+          while not empty? lu and not empty? lv repeat
+              u1 := first lu; v1 := first lv
+              u1.factor = v1.factor =>
+                  res := concat([stricterFlag(u1.flag, v1.flag), u1.factor, _
+                                 min(u1.exponent, v1.exponent)], res)
+                  lu := rest lu; lv := rest lv
+              LispLessP(u1, v1) => lu := rest lu
+              lv := rest lv
+          mkFF(1, reverse! res)

     else   -- R not a GCD domain
       u + v ==

-- 
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 fricas-devel+unsubscr...@googlegroups.com.
To post to this group, send email to fricas-devel@googlegroups.com.
Visit this group at https://groups.google.com/group/fricas-devel.
For more options, visit https://groups.google.com/d/optout.

Reply via email to