runLengthEncode rewrite

Author: pzinn

M2/Macaulay2/m2/indeterminates.m2

@@ -63,40 +63,59 @@ succ(Symbol,Symbol) := (x,y) -> (
      isUserSymbol(s,x) and isUserSymbol(t,y) and succS#?s and succS#s === t)
 succ(Subscript,Subscript) := (x,y) -> x#0 === y#0 and succ(x#1,y#1)
 succ(Thing,Thing) := x -> false
+
+-- Blocks contain an encoded item, its number of original entries, and the
+-- original items if it is a provisional two-entry range.
+runLengthEncodeDuplicates = blocks -> (
+    i := 0;
+    while i < #blocks list (
+	j := i + 1;
+	weight := blocks#i#1;
+	while j < #blocks and blocks#j#0 === blocks#i#0 do (
+	    weight += blocks#j#1;
+	    j += 1);
+	count := j - i;
+	block := if count === 1 then blocks#i else
+	    (hold count : expression blocks#i#0, weight, null);
+	i = j;
+	block))
+
+runLengthRangeStart = x -> if instance(x, BinaryOperation) then x#1 else expression x
+runLengthRangeEnd   = x -> if instance(x, BinaryOperation) then x#2 else expression x
+
+runLengthEncodeSuccessors = blocks -> (
+    i := 0;
+    while i < #blocks list (
+	j := i + 1;
+	weight := blocks#i#1;
+	while j < #blocks and succ(blocks#(j-1)#0, blocks#j#0) do (
+	    weight += blocks#j#1;
+	    j += 1);
+	block := if j - i > 1 then (
+		runLengthRangeStart(blocks#i#0) .. runLengthRangeEnd(blocks#(j-1)#0),
+		weight,
+		if weight === 2 then apply(i..j-1, k -> hold blocks#k#0))
+	    else blocks#i;
+	i = j;
+	block))
+
+runLengthEncodeOutput = blocks -> splice apply(blocks,
+    block -> if block#2 === null then hold block#0 else block#2)
+
+runLengthEncode1 = x -> (
+    blocks := apply(x, item -> (item, 1, null));
+    done := false;
+    while not done do (
+	next := runLengthEncodeSuccessors runLengthEncodeDuplicates blocks;
+	done = #next === #blocks;
+	blocks = next);
+    new class x from runLengthEncodeOutput blocks)
+
 runLengthEncode = method(Dispatch => Thing)
-runLengthEncode VisibleList := x -> (
-    local xx;
-    while (xx=runLengthEncode0 x; #x =!= #xx) do x=xx;
-    xx
-    )
-runLengthEncode0 = x -> (
-     if #x === 0 then return x;
-     dupout := true;
-     while first(dupout,dupout = false) do x = new class x from (
-	  i0 := null;
-	  lastout := oi := symbol oi;
-	  m := 0;
-	  dupin := null;
-	  for i in append(x,symbol x) list 
-	  (o -> (if lastout === o then dupout = true else lastout = o; o))(
-	       if i === oi and dupin =!= false then (dupin = true; m = m+1; continue)
-	       else if succ(oi,i) and dupin =!= true then (
-		    if dupin === null then i0 = oi;
-		    dupin = false; 
-		    oi = i;
-		    m = m+1; 
-		    continue)
-	       else first(
-		    if oi === symbol oi then (oi = i; m = 1 ; continue) else
-		    if m === 1 then hold oi else if dupin === true then hold m : expression oi else (if instance(i0,BinaryOperation) then i0#1 else expression i0) .. (if instance(oi,BinaryOperation) then oi#2 else expression oi),
-		    (dupin = null; oi = i; m = 1))));
-     x)
-
-rle = method(Dispatch => Thing)
-rle VisibleList := x -> apply(runLengthEncode x, rle)
-rle Holder := x -> rle x#0
-rle Option := x -> x#0 => rle x#1
-rle Thing := identity
+runLengthEncode VisibleList := x -> apply(runLengthEncode1 x, runLengthEncode)
+runLengthEncode Holder := x -> hold unsequence runLengthEncode x#0
+runLengthEncode Option := x -> x#0 => runLengthEncode x#1
+runLengthEncode Thing := identity
 
 -- Local Variables:
 -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 "

M2/Macaulay2/m2/monoids.m2

@@ -318,7 +318,7 @@ monoidParts = M -> (
     D := runLengthEncode if opts.DegreeRank === 1 then flatten opts.Degrees else opts.Degrees / (deg -> VerticalList deg);
     L := nonnull splice ( G, if not isDefault(opts, Degrees) then Degrees => D,
 	apply(( DegreeGroup, Heft, Join, MonomialOrder, WeylAlgebra, SkewCommutative, Inverses, Local, Global ),
-	    key -> if opts#?key and not isDefault(opts, key) then key => rle opts#key)))
+	    key -> if opts#?key and not isDefault(opts, key) then key => runLengthEncode opts#key)))
 
 expressionMonoid = M -> (
     T := if (options M).Local === true then List else Array;

M2/Macaulay2/packages/Varieties/tests-varieties.m2

@@ -32,7 +32,7 @@ TEST /// -- twisted cubic curve
 
 TEST ///
   X = Spec ZZ/101[x,y]/(y^2-x^3)
-  assert(toString ring X == "(ZZ/101)[x..y]/(-x^3+y^2)")
+  assert(toString ring X == "(ZZ/101)[x, y]/(-x^3+y^2)")
 ///
 
 TEST ///

M2/Macaulay2/tests/normal/runLengthEncode.m2

@@ -0,0 +1,32 @@
+-- runLengthEncode prefers repeated entries and avoids two-entry ranges.
+assert(toString runLengthEncode {1,2} == "{1, 2}")
+assert(toString runLengthEncode {1,2,3} == "{1..3}")
+assert(toString runLengthEncode {7,2,5,6} == "{7, 2, 5, 6}")
+assert(toString runLengthEncode {1,2,2,2,3,3,3} == "{1, 3:2, 3:3}")
+assert(toString runLengthEncode {1,1,2,2,3,3} == "{2:1, 2:2, 2:3}")
+assert(toString runLengthEncode {1,2,3,1,2,3} == "{2:1..3}")
+
+assert(toString runLengthEncode {a,b} == "{a, b}")
+assert(toString runLengthEncode {a,b,c} == "{a..c}")
+
+R22 = QQ[m_(1,1)..m_(2,2)]
+assert(toString runLengthEncode(expression \ gens R22) == "{m_(1,1)..m_(2,2)}")
+
+-- Recursive encoding subsumes the former private rle helper.
+assert(toString runLengthEncode {{1,2,3},{4,4,4}} == "{{1..3}, {3:4}}")
+assert(toString runLengthEncode (1,(2,2),(3,3)) == "(1,2:2,2:3)")
+assert(instance(first runLengthEncode {{1,2,3}}, Holder))
+assert(toString runLengthEncode {Degrees => {1,1,1}, Heft => {1,2}} ==
+    "{Degrees => {3:1}, Heft => {1, 2}}")
+assert(class(runLengthEncode (1,2,3)) === Sequence)
+assert(class(runLengthEncode [1,2,3]) === Array)
+assert(class(runLengthEncode {1,2,3}) === List)
+
+-- Singleton holders are needed for the documented value round trip.
+x = {1,2,3,a,b,c,a,b,c,4,4,4,"asdf"}
+y = runLengthEncode x
+assert(x === deepSplice(value \ y))
+
+-- Local Variables:
+-- compile-command: "make -C $M2BUILDDIR/Macaulay2/tests/normal runLengthEncode.out"
+-- End: