Add FoldLeft, FoldLeftOp, FoldLeftX

Author: fingolfin

lib/coll.gd

@@ -2451,6 +2451,52 @@ DeclareOperation( "AsSSortedListNonstored", [IsListOrCollection] );
 DeclareGlobalFunction( "Elements" );
 
 
+#############################################################################
+##
+#O  FoldLeft( <C>, <func>[, <init>] )
+##
+##  <ManSection>
+##  <Func Name="FoldLeft" Arg='C, func[, init]'/>
+##
+##  <Description>
+##  TODO
+##  </Description>
+##  </ManSection>
+##
+##  TODO: explain in docs that to imitate the behavior of
+##    x := Sum(list, func, init);
+##  one can do this:
+##    x := FoldLeft(list, {x,y} -> x + func(y), func(init));
+##  or of course also this (but requires more memory)
+##    x := FoldLeft(List(list, func), \+);
+##
+##  There is no good way to imitate `Sum(list, func)` without
+##  an initial value.
+##
+DeclareGlobalFunction( "FoldLeft" );
+DeclareOperation( "FoldLeftOp", [ IsListOrCollection, IsFunction ] );
+DeclareOperation( "FoldLeftOp", [ IsListOrCollection, IsFunction, IsObject ] );
+
+
+#############################################################################
+##
+#O  FoldLeftX( <gens>, <func>, <init>[, <abortValue>] )
+##
+##  <#GAPDoc Label="FoldLeftX">
+##  <ManSection>
+##  <Func Name="FoldLeftX" Arg='gens, func, init[, abortValue]'/>
+##
+##  <Description>
+##  TODO
+##  </Description>
+##  </ManSection>
+##  <#/GAPDoc>
+##
+##  TODO: document FoldLeftX (based on ListX documentation?)
+##
+DeclareGlobalFunction( "FoldLeftX" );
+
+
 #############################################################################
 ##
 #F  Sum( <list>[, <init>] ) . . . . . . . . . . sum of the elements of a list

lib/coll.gi

@@ -1798,6 +1798,102 @@ InstallGlobalFunction( ListX, function ( arg )
 end );
 
 
+#############################################################################
+##
+#F  FoldLeft( <coll>, <func> )
+#F  FoldLeft( <coll>, <func>, <init> )
+##
+InstallGlobalFunction( FoldLeft,
+    function( arg )
+    local tnum, C, func, result, i, l;
+    l := Length( arg );
+    if l < 2 or l > 3 or not IsFunction(arg[2]) then
+      Error( "usage: FoldLeft( <C>, <func>[, <init>] )" );
+    fi;
+    tnum:= TNUM_OBJ( arg[1] );
+    # handle built-in lists directly, to avoid method dispatch overhead
+    if FIRST_LIST_TNUM <= tnum and tnum <= LAST_LIST_TNUM then
+      C:= arg[1];
+      func:= arg[2];
+      if l = 2 then
+        if IsEmpty( C ) then
+          Error("folding an empty collection without initial value is not supported");
+        else
+          result:= C[1];
+          for i in [ 2 .. Length( C ) ] do
+            result:= func( result, C[i] );
+          od;
+        fi;
+      else
+        result:= arg[3];
+        for i in C do
+          result:= func( result, i );
+        od;
+      fi;
+      return result;
+    else
+      return CallFuncList( FoldLeftOp, arg );
+    fi;
+end );
+
+
+#############################################################################
+##
+#M  FoldLeftOp( <C>, <func> )  . . . . . . . for a list/collection, and a function
+##
+InstallMethod( FoldLeftOp,
+    "for a list/collection, and a function",
+    [ IsListOrCollection, IsFunction ],
+    function ( C, func )
+    local iter, result, x;
+    iter := Iterator( C );
+    if IsDoneIterator( iter ) then
+      Error("folding an empty collection without initial value is not supported");
+    fi;
+    result := NextIterator( iter );
+    for x in iter do
+      result := func( result, x );
+    od;
+    return result;
+    end );
+
+
+#############################################################################
+##
+#M  FoldLeftOp( <C>, <func>, <init> )  . for a list/coll., a func., and init. val.
+##
+InstallMethod( FoldLeftOp,
+    "for a list/collection, and a function, and an initial value",
+    [ IsListOrCollection, IsFunction, IsObject ],
+    function ( C, func, init )
+    local result, x;
+    result := init;
+    for x in C do
+      result := func( result, x );
+    od;
+    return result;
+    end );
+
+
+#############################################################################
+##
+#M  FoldLeftX(<obj>,...)
+##
+InstallGlobalFunction( FoldLeftX, function ( gens, f, init, extra... )
+    local abortValue;
+
+    if Length(extra) > 0 then
+        abortValue := extra[1];
+    else
+        # assign a globally unique bag: here, we take a new empty
+        # string, which is guaranteed to be different from any
+        # other string object
+        abortValue := "";
+    fi;
+    return FOLD_LEFT_X(gens, f, init, abortValue);
+end );
+
+
 #############################################################################
 ##
 #M  SetX(<obj>,...)

src/listfunc.c

@@ -24,7 +24,10 @@
 #include "permutat.h"
 #include "plist.h"
 #include "pperm.h"
+#include "precord.h"
+#include "records.h"
 #include "set.h"
+#include "stats.h"
 #include "stringobj.h"
 #include "sysfiles.h"
 #include "trans.h"
@@ -1460,6 +1463,121 @@ static Obj FuncLIST_WITH_IDENTICAL_ENTRIES(Obj self, Obj n, Obj obj)
     return list;
 }
 
+static Obj FastCallFuncList(Obj func, Obj list)
+{
+    switch (LEN_PLIST(list)) {
+    case 0:
+        return CALL_0ARGS(func);
+    case 1:
+        return CALL_1ARGS(func, ELM_PLIST(list, 1));
+    case 2:
+        return CALL_2ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2));
+    case 3:
+        return CALL_3ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
+                          ELM_PLIST(list, 3));
+    case 4:
+        return CALL_4ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
+                          ELM_PLIST(list, 3), ELM_PLIST(list, 4));
+    case 5:
+        return CALL_5ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
+                          ELM_PLIST(list, 3), ELM_PLIST(list, 4),
+                          ELM_PLIST(list, 5));
+    case 6:
+        return CALL_6ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
+                          ELM_PLIST(list, 3), ELM_PLIST(list, 4),
+                          ELM_PLIST(list, 5), ELM_PLIST(list, 6));
+    default:
+        return CALL_XARGS(func, list);
+    }
+}
+
+static Obj IsListOrCollection;
+
+// TODO: document this a bit
+static int FoldLeftXHelp(Obj   gens,
+                         Obj   foldFunc,
+                         Obj * acc,
+                         Obj   abortValue,
+                         Obj   args,
+                         int   genIndex,
+                         int   valIndex)
+{
+    while (genIndex <= LEN_PLIST(gens)) {
+        Obj gen = ELM_PLIST(gens, genIndex);
+        if (IS_FUNC(gen))
+            gen = FastCallFuncList(gen, args);
+        if (gen == True)
+            genIndex++;
+        else if (gen == False)
+            return 0;
+        else if (IS_LIST(gen)) {
+            const int len = LEN_LIST(gen);
+            for (int i = 1; i <= len; i++) {
+                Obj elm = ELM0_LIST(gen, i);
+                if (!elm)
+                    continue; // skip holes
+                AssPlist(args, valIndex, elm);
+                if (FoldLeftXHelp(gens, foldFunc, acc, abortValue, args,
+                                  genIndex + 1, valIndex + 1))
+                    return 1;
+            }
+            UNB_LIST(args, valIndex);
+            return 0;
+        }
+        else if (CALL_1ARGS(IsListOrCollection, gen) == True) {
+            // get the iterator
+            Obj iter = CALL_1ARGS(ITERATOR, gen);
+
+            Obj nfun, dfun;
+            if (IS_PREC_OR_COMOBJ(iter) &&
+                CALL_1ARGS(STD_ITER, iter) == True) {
+                // this can avoid method selection overhead on iterator
+                dfun = ElmPRec(iter, RNamName("IsDoneIterator"));
+                nfun = ElmPRec(iter, RNamName("NextIterator"));
+            }
+            else {
+                dfun = IS_DONE_ITER;
+                nfun = NEXT_ITER;
+            }
+
+            // loop over the iterator
+            while (CALL_1ARGS(dfun, iter) == False) {
+
+                // get the element and assign it to the variable
+                Obj elm = CALL_1ARGS(nfun, iter);
+
+                AssPlist(args, valIndex, elm);
+                if (FoldLeftXHelp(gens, foldFunc, acc, abortValue, args,
+                                  genIndex + 1, valIndex + 1))
+                    return 1;
+            }
+            UNB_LIST(args, valIndex);
+            return 0;
+        }
+        else {
+            ErrorMayQuit("gens[%d] must be a collection, a list, a boolean, "
+                         "or a function",
+                         genIndex, 0);
+        }
+    }
+    *acc = CALL_2ARGS(foldFunc, *acc, args);
+    return abortValue == *acc;
+}
+
+// TODO: document this a bit
+Obj FuncFOLD_LEFT_X(
+    Obj self, Obj gens, Obj foldFunc, Obj init, Obj abortValue)
+{
+    if (!IS_PLIST(gens))
+        return Fail;
+    if (!IS_FUNC(foldFunc))
+        return Fail;
+
+    Obj args = NEW_PLIST(T_PLIST, LEN_PLIST(gens));
+    FoldLeftXHelp(gens, foldFunc, &init, abortValue, args, 1, 1);
+    return init;
+}
+
 /****************************************************************************
 **
 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
@@ -1488,7 +1606,7 @@ static StructGVarOper GVarOpers [] = {
 **
 *V  GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
 */
-static StructGVarFunc GVarFuncs [] = {
+static StructGVarFunc GVarFuncs[] = {
 
     GVAR_FUNC_2ARGS(APPEND_LIST_INTR, list1, list2),
     GVAR_FUNC_2ARGS(POSITION_SORTED_LIST, list, obj),
@@ -1511,6 +1629,9 @@ static StructGVarFunc GVarFuncs [] = {
     GVAR_FUNC(COPY_LIST_ENTRIES, -1, "srclist,srcstart,srcinc,dstlist,dststart,dstinc,number"),
     GVAR_FUNC_1ARGS(STRONGLY_CONNECTED_COMPONENTS_DIGRAPH, digraph),
     GVAR_FUNC_2ARGS(LIST_WITH_IDENTICAL_ENTRIES, n, obj),
+
+    GVAR_FUNC_4ARGS(FOLD_LEFT_X, gens, foldFunc, init, abortValue),
+
     { 0, 0, 0, 0, 0 }
 
 };
@@ -1532,8 +1653,8 @@ static Int InitKernel (
     InitHdlrOpersFromTable( GVarOpers );
     InitHdlrFuncsFromTable( GVarFuncs );
 
+    ImportFuncFromLibrary("IsListOrCollection", &IsListOrCollection);
 
-    
     return 0;
 }
 

src/stats.c

@@ -340,7 +340,7 @@ static UInt ExecIfElifElse(Stat stat)
 Obj ITERATOR;
 Obj IS_DONE_ITER;
 Obj NEXT_ITER;
-static Obj STD_ITER;
+Obj STD_ITER;
 
 static ALWAYS_INLINE UInt ExecForHelper(Stat stat, UInt nr)
 {

src/stats.h

@@ -134,6 +134,7 @@ void ClearError(void);
 extern Obj ITERATOR;
 extern Obj IS_DONE_ITER;
 extern Obj NEXT_ITER;
+extern Obj STD_ITER;
 
 
 /****************************************************************************

tst/testinstall/coll.tst

@@ -315,6 +315,21 @@ gap> List(iter);
 gap> List(iter, x -> x+1);
 [ 43 ]
 
+#############################################################################
+#
+# FoldLeft
+#
+gap> FoldLeft([1..10], \*) = Factorial(10);
+true
+gap> FoldLeft([1..10], \+) = Sum([1..10]);
+true
+gap> FoldLeft([1..10], \+, 5) = Sum([1..10], 5);
+true
+gap> FoldLeft([1..3], \-);
+-4
+gap> FoldLeft([1..3], \-, 0);
+-6
+
 #############################################################################
 #
 # List