Group Abstract

Message Boards

WOLFRAM COMMUNITY

2.9K Views

3 Replies

1 Total Like

View groups...

Follow this post

Share this post:

GROUPS:

Wolfram Language

Use Fold instead of nested Do loops?

Tobias Bouma

Posted 6 years ago

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.

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.

POSTED BY: Tobias Bouma

3 Replies

Sort By:

Tobias Bouma

Posted 6 years ago

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

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

POSTED BY: Tobias Bouma

Tobias Bouma

Posted 6 years ago

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.

POSTED BY: Tobias Bouma

Bill Nelson

Posted 6 years ago

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}

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}

POSTED BY: Bill Nelson

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Feedback