Skip to content

Commit e611ec0

Browse files
fingolfinfingolfin
committed
WIP: FOLD_LEFT_X
1 parent c9269ce commit e611ec0

File tree

3 files changed

+196
-28
lines changed

3 files changed

+196
-28
lines changed

‎lib/coll.gd‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2411,6 +2411,9 @@ DeclareGlobalFunction( "ForAnyX" );
24112411
DeclareGlobalFunction( "FilteredX" );
24122412
DeclareGlobalFunction( "NumberX" );
24132413
DeclareGlobalFunction( "PerformX" );
2414+
# FirstX
2415+
# LastX
2416+
# Last, LasstOp
24142417

24152418

24162419
#############################################################################

‎lib/coll.gi‎

Lines changed: 73 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -1678,11 +1678,11 @@ InstallMethod( ForAnyOp,
16781678
InstallGlobalFunction( ListX, function ( arg )
16791679
local f;
16801680
f := Remove(arg);
1681-
return FoldLeftX(arg,
1681+
return FOLD_LEFT_X(arg,
16821682
function(acc, x)
16831683
Add(acc, CallFuncList(f, x));
16841684
return acc;
1685-
end, []);
1685+
end, [], false);
16861686
end );
16871687

16881688

@@ -1778,8 +1778,24 @@ InstallOtherMethod( FoldLeftOp,
17781778
##
17791779
#M FoldLeftX(<obj>,...)
17801780
##
1781-
InstallGlobalFunction( FoldLeftX, function ( gens, f, init )
1782-
local acc, args, FoldLeftXHelp;
1781+
InstallGlobalFunction( FoldLeftX, function ( gens, f, init, extra... )
1782+
local abortFunc, acc, args, FoldLeftXHelp;
1783+
1784+
# TODO: add a way to do short circuiting / early abort.
1785+
#
1786+
# one approach is to use fp pattern, via IteratorX (tricky to do; overhead?)
1787+
# alternatively, allow optional extra argument:
1788+
# variant 1: extra arg is abortFunc(); called after each
1789+
# call to the foldFunc, return a bool
1790+
# variant 2: extra arg is a plain list abortList
1791+
1792+
# TODO: add abortFunc to FoldLeft / FoldLeftOp, too
1793+
1794+
if Length(extra) > 0 then
1795+
abortFunc := extra[1];
1796+
else
1797+
abortFunc := ReturnFalse;
1798+
fi;
17831799

17841800
acc := init;
17851801

@@ -1800,21 +1816,26 @@ InstallGlobalFunction( FoldLeftX, function ( gens, f, init )
18001816
if gen = true then
18011817
genIndex := genIndex + 1;
18021818
elif gen = false then
1803-
return;
1819+
return false;
18041820
elif IsListOrCollection( gen ) then
18051821
for val in gen do
18061822
args[valIndex] := val;
1807-
FoldLeftXHelp( genIndex+1, valIndex+1 );
1823+
if FoldLeftXHelp( genIndex+1, valIndex+1 ) then
1824+
return true;
1825+
fi;
18081826
od;
18091827
Unbind( args[valIndex] );
1810-
return;
1828+
return false;
18111829
else
18121830
Error( "gens[",genIndex,"] must be a collection, a list, a boolean, ",
18131831
"or a function" );
18141832
fi;
18151833
od;
18161834
acc := f( acc, args );
1835+
return false;
1836+
# return abortFunc( acc );
18171837
end;
1838+
# TODO: optimize the case where Length(gens) <= 1? <= 2? <= 3?
18181839

18191840
FoldLeftXHelp( 1, 1 );
18201841
return acc;
@@ -1831,6 +1852,38 @@ ForAllX(Primes, [1..10], {p,n} -> IsPrimePowerInt(p^n));
18311852
ForAllX([2..6], IsPrimeInt);
18321853
ForAllX([2..6], [1..10], {p,n} -> IsPrimePowerInt(p^n));
18331854

1855+
FoldLeftX([ [1..10], Primes ], {acc,args} -> acc+Sum(args), 0, false);
1856+
FOLD_LEFT_X([ [1..10], Primes ], {acc,args} -> acc+Sum(args), 0, false);
1857+
1858+
# timings
1859+
# ForAll([1..2^20], IsInt); time;
1860+
# ForAllX([1..2^20], IsInt); time;
1861+
# ForAllX([1..2^20], [1,2], {a,b}->IsInt(a+b)); time;
1862+
#
1863+
# gap> ForAllX([1..2^20], [1,2], {a,b}->IsInt(a+b)); time;
1864+
# true
1865+
# 1614
1866+
# gap> ForAllX([1..2^20], [1], {a,b}->IsInt(a+b)); time;
1867+
# true
1868+
# 1029
1869+
# gap> ForAllX([1..2^20], {a}->IsInt(a+a)); time;
1870+
# true
1871+
# 592
1872+
1873+
# gap> ForAll([1..2^20], {a}->IsInt(a+a)); time;
1874+
# true
1875+
# 103
1876+
1877+
1878+
# gap> ForAllX([1..2^20], [1], ReturnTrue); time;
1879+
# true
1880+
# 759
1881+
# gap> ForAllX([1..2^20], ReturnTrue); time;
1882+
# true
1883+
# 348
1884+
# gap> ForAll([1..2^20], ReturnTrue); time;
1885+
# true
1886+
# 24
18341887

18351888
fi;
18361889

@@ -1844,11 +1897,11 @@ fi;
18441897
InstallGlobalFunction( SetX, function ( arg )
18451898
local f;
18461899
f := Remove(arg);
1847-
return FoldLeftX(arg,
1900+
return FOLD_LEFT_X(arg,
18481901
function(acc, x)
18491902
AddSet(acc, CallFuncList(f, x));
18501903
return acc;
1851-
end, []);
1904+
end, [], false);
18521905
end );
18531906

18541907

@@ -1859,12 +1912,12 @@ end );
18591912
InstallGlobalFunction( SumX, function ( arg )
18601913
local f;
18611914
f := Remove(arg);
1862-
return FoldLeftX(arg,
1915+
return FOLD_LEFT_X(arg,
18631916
function(acc, x)
18641917
x := CallFuncList(f, x);
18651918
if acc = fail then return x; fi;
18661919
return acc + x;
1867-
end, fail);
1920+
end, fail, false);
18681921
end );
18691922

18701923

@@ -1875,12 +1928,12 @@ end );
18751928
InstallGlobalFunction( ProductX, function ( arg )
18761929
local f;
18771930
f := Remove(arg);
1878-
return FoldLeftX(arg,
1931+
return FOLD_LEFT_X(arg,
18791932
function(acc, x)
18801933
x := CallFuncList(f, x);
18811934
if acc = fail then return x; fi;
18821935
return acc * x;
1883-
end, fail);
1936+
end, fail, false);
18841937
end );
18851938

18861939

@@ -1889,16 +1942,10 @@ end );
18891942
#M ForAllX(<obj>,...)
18901943
##
18911944
InstallGlobalFunction( ForAllX, function ( arg )
1892-
# local f;
1893-
# f := Remove(args);
1894-
# return FoldLeftX(args, {acc,x} -> acc and CallFuncList(f, x), true);
1895-
local f, abort;
1896-
f := Remove(args);
1897-
abort := false;
1898-
Add(args, arg -> not abort);
1899-
# TODO: implement early abort
1900-
return FoldLeftX(args, {acc,x} -> acc and CallFuncList(f, x), true);
1901-
end;
1945+
local f;
1946+
f := Remove(arg);
1947+
return FOLD_LEFT_X(arg, {acc,x} -> acc and CallFuncList(f, x), true, acc -> acc = false);
1948+
end );
19021949

19031950

19041951
#############################################################################
@@ -1907,10 +1954,10 @@ end;
19071954
##
19081955
InstallGlobalFunction( ForAnyX, function ( arg )
19091956
local f;
1910-
f := Remove(args);
1957+
f := Remove(arg);
19111958
# TODO: implement early abort
1912-
return FoldLeftX(args, {acc,x} -> acc or CallFuncList(f, x), false);
1913-
end;
1959+
return FOLD_LEFT_X(arg, {acc,x} -> acc or CallFuncList(f, x), false, acc -> acc = true);
1960+
end );
19141961

19151962

19161963
#############################################################################

‎src/listfunc.c‎

Lines changed: 120 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,8 @@
2424
#include "permutat.h"
2525
#include "plist.h"
2626
#include "pperm.h"
27+
#include "precord.h"
28+
#include "records.h"
2729
#include "set.h"
2830
#include "stringobj.h"
2931
#include "sysfiles.h"
@@ -1524,6 +1526,123 @@ static Obj FuncLIST_WITH_IDENTICAL_ENTRIES(Obj self, Obj n, Obj obj)
15241526
return list;
15251527
}
15261528

1529+
1530+
static Obj FastCallFuncList(Obj func, Obj list)
1531+
{
1532+
switch (LEN_PLIST(list)) {
1533+
case 0:
1534+
return CALL_0ARGS(func);
1535+
case 1:
1536+
return CALL_1ARGS(func, ELM_PLIST(list, 1));
1537+
case 2:
1538+
return CALL_2ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2));
1539+
case 3:
1540+
return CALL_3ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
1541+
ELM_PLIST(list, 3));
1542+
case 4:
1543+
return CALL_4ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
1544+
ELM_PLIST(list, 3), ELM_PLIST(list, 4));
1545+
case 5:
1546+
return CALL_5ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
1547+
ELM_PLIST(list, 3), ELM_PLIST(list, 4),
1548+
ELM_PLIST(list, 5));
1549+
case 6:
1550+
return CALL_6ARGS(func, ELM_PLIST(list, 1), ELM_PLIST(list, 2),
1551+
ELM_PLIST(list, 3), ELM_PLIST(list, 4),
1552+
ELM_PLIST(list, 5), ELM_PLIST(list, 6));
1553+
default:
1554+
return CALL_XARGS(func, list);
1555+
}
1556+
}
1557+
1558+
1559+
extern Obj ITERATOR;
1560+
extern Obj IS_DONE_ITER;
1561+
extern Obj NEXT_ITER;
1562+
extern Obj STD_ITER;
1563+
1564+
static int FoldLeftXHelp(Obj gens,
1565+
Obj foldFunc,
1566+
Obj * acc,
1567+
Obj abortFunc,
1568+
Obj args,
1569+
int genIndex,
1570+
int valIndex)
1571+
{
1572+
while (genIndex <= LEN_PLIST(gens)) {
1573+
Obj gen = ELM_PLIST(gens, genIndex);
1574+
if (IS_FUNC(gen))
1575+
gen = FastCallFuncList(gen, args);
1576+
if (gen == True)
1577+
genIndex++;
1578+
else if (gen == False)
1579+
return 0;
1580+
else if (IS_LIST(gen)) {
1581+
const int len = LEN_LIST(gen);
1582+
for (int i = 1; i <= len; i++) {
1583+
Obj elm = ELM_LIST(gen, i);
1584+
AssPlist(args, valIndex, elm);
1585+
if (FoldLeftXHelp(gens, foldFunc, acc, abortFunc, args,
1586+
genIndex + 1, valIndex + 1))
1587+
return 1;
1588+
}
1589+
UNB_LIST(args, valIndex);
1590+
return 0;
1591+
}
1592+
else {
1593+
// get the iterator
1594+
Obj iter = CALL_1ARGS(ITERATOR, gen);
1595+
1596+
Obj nfun, dfun;
1597+
if (IS_PREC_OR_COMOBJ(iter) &&
1598+
CALL_1ARGS(STD_ITER, iter) == True) {
1599+
// this can avoid method selection overhead on iterator
1600+
dfun = ElmPRec(iter, RNamName("IsDoneIterator"));
1601+
nfun = ElmPRec(iter, RNamName("NextIterator"));
1602+
}
1603+
else {
1604+
dfun = IS_DONE_ITER;
1605+
nfun = NEXT_ITER;
1606+
}
1607+
1608+
// loop over the iterator
1609+
while (CALL_1ARGS(dfun, iter) == False) {
1610+
1611+
// get the element and assign it to the variable
1612+
Obj elm = CALL_1ARGS(nfun, iter);
1613+
1614+
AssPlist(args, valIndex, elm);
1615+
if (FoldLeftXHelp(gens, foldFunc, acc, abortFunc, args,
1616+
genIndex + 1, valIndex + 1))
1617+
return 1;
1618+
}
1619+
UNB_LIST(args, valIndex);
1620+
return 0;
1621+
}
1622+
}
1623+
*acc = CALL_2ARGS(foldFunc, *acc, args);
1624+
if (abortFunc == False)
1625+
return 0;
1626+
else
1627+
return True == CALL_1ARGS(abortFunc, *acc);
1628+
}
1629+
1630+
1631+
Obj FuncFOLD_LEFT_X(Obj self, Obj gens, Obj foldFunc, Obj init, Obj abortFunc)
1632+
{
1633+
// TOOD: argument validation
1634+
if (!IS_PLIST(gens))
1635+
return Fail;
1636+
if (!IS_FUNC(foldFunc))
1637+
return Fail;
1638+
if (abortFunc != False && !IS_FUNC(abortFunc))
1639+
return Fail;
1640+
1641+
Obj args = NEW_PLIST(T_PLIST, LEN_PLIST(gens));
1642+
FoldLeftXHelp(gens, foldFunc, &init, abortFunc, args, 1, 1);
1643+
return init;
1644+
}
1645+
15271646
/****************************************************************************
15281647
**
15291648
*F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
@@ -1575,6 +1694,7 @@ static StructGVarFunc GVarFuncs [] = {
15751694
GVAR_FUNC(COPY_LIST_ENTRIES, -1, "srclist,srcstart,srcinc,dstlist,dststart,dstinc,number"),
15761695
GVAR_FUNC(STRONGLY_CONNECTED_COMPONENTS_DIGRAPH, 1, "digraph"),
15771696
GVAR_FUNC(LIST_WITH_IDENTICAL_ENTRIES, 2, "n, obj"),
1697+
GVAR_FUNC(FOLD_LEFT_X, 4, "gens, foldFunc, init, abortFunc"),
15781698
{ 0, 0, 0, 0, 0 }
15791699

15801700
};
@@ -1596,8 +1716,6 @@ static Int InitKernel (
15961716
InitHdlrOpersFromTable( GVarOpers );
15971717
InitHdlrFuncsFromTable( GVarFuncs );
15981718

1599-
1600-
16011719
/* return success */
16021720
return 0;
16031721
}

0 commit comments

Comments
 (0)