Use Fold instead of nested Do loops?

Questions
1

For my application I see no other alternative than to use nested Do loops. My idea was to use Fold to get it done. I have produced code that appears to give the expected output, but with errors.

The below code attempts to illustrate the problem:

\[CapitalNu] = 40;
progress = 0;

Do[
  Do[
   progress++
   , {l\[LetterSpace]1, 
    1 + l\[LetterSpace]0, \[CapitalNu]}]
  , {l\[LetterSpace]0, Range[\[CapitalNu]]}];

(* *)
Print["Nest level 2, manual"]
Print[progress]
progress = 0;

Do[
  Do[
   Do[
    progress++,
    {l\[LetterSpace]2, 1 + l\[LetterSpace]1, \[CapitalNu]}
    ]
   , {l\[LetterSpace]1, 1 + l\[LetterSpace]0, \[CapitalNu]}]
  , {l\[LetterSpace]0, Range[\[CapitalNu]]}];

(* *)
Print["Nest level 3, manual"]
Print[progress]
progress = 0;

intrnl\[LetterSpace]DoFoldList := 
  Reverse[{ToExpression["l\[LetterSpace]" <> ToString[#]], 
      ToExpression["l\[LetterSpace]" <> ToString[# - 1]] + 
       1, \[CapitalNu]} & /@ 
    Range[1, curr\[LetterSpace]n\[LetterSpace]h - 1]];

curr\[LetterSpace]n\[LetterSpace]h = 2;
intrnl\[LetterSpace]DoFoldList
Do[
  Fold[Do, Unevaluated[progress++], intrnl\[LetterSpace]DoFoldList]
  , {l\[LetterSpace]0, Range[\[CapitalNu]]}];

(* *)
Print["Nest level 2, automatic"]
Print[progress]
progress = 0;

curr\[LetterSpace]n\[LetterSpace]h = 3;
intrnl\[LetterSpace]DoFoldList
Do[
  Fold[Do, Unevaluated[progress++], intrnl\[LetterSpace]DoFoldList]
  , {l\[LetterSpace]0, Range[\[CapitalNu]]}];

(* *)
Print["Nest level 3, automatic"]
Print[progress]
progress = 0;

The first nested Do loop increments the progress value correctly to 780 over the half triangle in state space. The second manual loop increments it to 9880.

The Do loops created using Fold appear to create the same loops, but with errors: do::iterb “Iterator {l[LetterSpace]2,1+l[LetterSpace]1,40} does not have
appropriate bounds”. The value of progress appears to give the correct value regardless. I could suppress these errors with Quiet perhaps, but my first choice would be to fix them to reduce the amount of wasted computations.

2

If you are looking for an alternative to nested Do loops and saving computation then perhaps you might consider this.

This

seq1=Table[ progress = 0; Do[ Do[ progress++, {l\\[LetterSpace]1, 1 +
l\\[LetterSpace]0, \\[CapitalNu]}], {l\\[LetterSpace]0,
Range[\\[CapitalNu]]}];progress,{\\[CapitalNu],0,20}]

returns

{0, 0, 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136,
153, 171, 190}

and this

fun1=FindSequenceFunction[seq1];

Table[fun1[x],{x,1,21}]

returns

{0, 0, 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190}

This

seq2=Table[progress = 0; Do[Do[Do[progress++,{l\\[LetterSpace]2, 1 +
l\\[LetterSpace]1, \\[CapitalNu]}], {l\\[LetterSpace]1, 1 +
l\\[LetterSpace]0, \\[CapitalNu]}], {l\\[LetterSpace]0,
Range[\\[CapitalNu]]}];progress,{\\[CapitalNu],0,20}]

returns

{0, 0, 0, 1, 4, 10, 20, 35, 56, 84, 120, 165, 220, 286, 364, 455, 560, 680, 816, 969, 1140}

and this

fun2=FindSequenceFunction[seq2];

Table[fun2[x],{x,1,21}]

returns

{0, 0, 0, 1, 4, 10, 20, 35, 56, 84, 120, 165, 220, 286, 364, 455, 560, 680, 816, 969, 1140}

This

seq3=Table[progress = 0;curr\\[LetterSpace]n\\[LetterSpace]h = 2;
intrnl\\[LetterSpace]DoFoldList :=
Reverse[{ToExpression["l\\[LetterSpace]" <> ToString[#]],
ToExpression["l\\[LetterSpace]" <> ToString[# - 1]] + 1, \\[CapitalNu]}
& /@ Range[1, curr\\[LetterSpace]n\\[LetterSpace]h - 1]];
intrnl\\[LetterSpace]DoFoldList;Do[Fold[Do, Unevaluated[progress++],
intrnl\\[LetterSpace]DoFoldList], {l\\[LetterSpace]0,
Range[\\[CapitalNu]]}];progress,{\\[CapitalNu],0,20}]

returns

{0, 0, 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190}

and this

fun3=FindSequenceFunction[seq3];

Table[fun3[x],{x,1,21}]

returns

{0, 0, 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190}
3

Many thanks for your reply.

The values produced indeed correctly reproduce the values shown in my OP (the actual value is quite obviously the binomial coefficient, as preduced by FindSequenceFunction[.]).

But, full functionality as in the explicit Do loops is not reproduced. Example: l_1, … l_{n_h} cannot be dynamically updated inside the loop. (I could have chosen “Table” if this wasn’t a constraint.)

If this behaviour can be reproduced I’m very much open to your suggestion of using outputs from FindSequenceFunction, I think my use case can be adapted to it.

4

The following does the job and is based on a post by Carl Woll:

SetAttributes[iteratedTable, HoldAll]
iteratedTable[e_, g_, iter_, max_] := 
 ReleaseHold@
  Hold[Table][Hold[e], 
   Sequence @@ 
    Table[{g[i], If[i == 1, 1, g[i - 1] + 1], max}, {i, iter}]]

progress = 0;
iteratedTable[progress++, l, 3, 40]; // AbsoluteTiming
Print@progress