28
$\begingroup$

Mathematica provides functions that perform a depth-first traversal, or which use such a traversal, including: Scan, Count, Cases, Replace, and Position. It is also the standard evaluation order therefore functions Mapped (Map, MapAll) will evaluate in a depth-first order.

It is quite direct to do this:

expr = {{1, {2, 3}}, {4, 5}};

Scan[Print, expr, {0, -1}]

1

2

3

{2,3}

{1,{2,3}}

4

5

{4,5}

{{1,{2,3}},{4,5}}

How can one do a Scan-type operation breadth-first? (Simply storing then reordering the output is not adequate as it doesn't change the order in which expressions are visited.)

Scan has the property that it does not build an output expression the way that e.g. Map does, which is quite appropriate for breadth-first scans, and conserves memory.

$\endgroup$
3
  • $\begingroup$ What do you mean that Map and MapAll perform a df traversal? $\endgroup$
    – Rojo
    Commented Aug 8, 2012 at 11:05
  • 2
    $\begingroup$ Convert expression to Graph, then do BreadthFirstScan. $\endgroup$ Commented Aug 8, 2012 at 11:08
  • $\begingroup$ @Rojo A little late but I rewrote the question to hopefully rectify the inaccurate statements. $\endgroup$
    – Mr.Wizard
    Commented Jul 28, 2014 at 11:09

7 Answers 7

17
$\begingroup$

Here is an expressly iterative solution:

bf[f_, x_] := ((f~Scan~#; #~Level~{2})& ~FixedPoint~ {x};)

(*
In[2]:= bf[Print, {{1, {2, 3}}, {4, 5}}]

{{1,{2,3}},{4,5}}
{1,{2,3}}
{4,5}
1
{2,3}
4
5
2
3
*)

Incorporating Rojo's advice to Hold expressions gathered by Level:

bf[f_, x_] := ( Level[f~Scan~#; #, {2}, Hold] & ~FixedPoint~ {x} ;) 
$\endgroup$
6
  • 3
    $\begingroup$ As they always say, Know Your Audience ;) $\endgroup$
    – WReach
    Commented Aug 8, 2012 at 19:34
  • $\begingroup$ I may have to Accept this. :-) $\endgroup$
    – Mr.Wizard
    Commented Aug 8, 2012 at 20:32
  • $\begingroup$ hmm... you start out with a sad face, but end with a winkey $\endgroup$
    – rm -rf
    Commented Aug 8, 2012 at 21:42
  • $\begingroup$ +1, you forgot to put the ;) in the next line. Wink not intended but appropriate $\endgroup$
    – Rojo
    Commented Aug 8, 2012 at 22:42
  • 4
    $\begingroup$ bf[Hold, Hold[Print@2]] leaks. It could be fixed by letting down the audience and changing infix Level to Level[#, {2}, Hold] $\endgroup$
    – Rojo
    Commented Aug 9, 2012 at 0:44
18
$\begingroup$
breadthFirst[expr_] := Flatten[Table[Level[expr, {j}], {j, 0, Depth[expr]}], 1]

Running example:

expr = {{1, {2, 3}}, {4, 5}};

breadthFirst[expr]

(* Out[14]= {{{1, {2, 3}}, {4, 5}}, {1, {2, 3}}, {4, 5}, 1, {2, 
  3}, 4, 5, 2, 3} *)
$\endgroup$
17
$\begingroup$

Here is a simple implementation of a breadth first traversal. It simply maps the function onto each element on the current level and then collects all non-atomic entries into the next level, rinse and repeat.

breadthFirstApply[{}, call_] := Null
breadthFirstApply[list_, call_] := (call /@ list;breadthFirstApply[Level[list,{2}], call])

Output with your data structure:

      breadthFirstApply[{{1, {2, 3}}, {4, 5}}, Print]
{1,{2,3}}(*level 1*)
{4,5} (*level 1*)
1 (*level 2*)
{2,3} (*level 2*)
4 (*level 2*)
5 (*level 2*)
2 (*level 3*)
3 (*level 3*)

Edit: Updated code based on feedback from Rojo

$\endgroup$
4
  • 2
    $\begingroup$ +1. 2 small comments/questions. 1) Any reason to use call[#]& instead of plain call? 2) Any difference between Join@@Select... and Level[list, {2}] apart from Join@@... requiring all the sublists to have the same head? $\endgroup$
    – Rojo
    Commented Aug 8, 2012 at 13:29
  • 1
    $\begingroup$ @Rojo I can't say there was any particular reason for the call[#]& just did it in a hurry, as for Level, I'm just in a mindeset where I didn't consider Level. Thanks for the great feedback, I added the changes to the code. $\endgroup$
    – jVincent
    Commented Aug 9, 2012 at 0:11
  • $\begingroup$ :). Now with level I think you don't even need the inner Select, because the atoms simply won't be extracted by Level since they belong to level 1 $\endgroup$
    – Rojo
    Commented Aug 9, 2012 at 0:16
  • 1
    $\begingroup$ @Rojo I'm rapidly running out of code for you to hack away at. :) $\endgroup$
    – jVincent
    Commented Aug 9, 2012 at 0:30
13
$\begingroup$
expr = {{1, {2, 3}}, {4, 5}};

Do[Scan[Print, expr, {i}], {i, 0, Depth@expr}]

{{1,{2,3}},{4,5}}
{1,{2,3}}
{4,5}
1
{2,3}
4
5
2
3

$\endgroup$
7
  • $\begingroup$ If I'm not mistaken ReplaceAll doesn't do breadth first, but depth first pre-order. And apart from it (and maybe Pick which I would have to think if it offers something new to the issue) I also don't know how to do . $\endgroup$
    – Rojo
    Commented Aug 8, 2012 at 10:07
  • $\begingroup$ @Rojo Would you explain what you wrote about ReplaceAll? $\endgroup$
    – Mr.Wizard
    Commented Aug 8, 2012 at 10:26
  • 4
    $\begingroup$ I meant that ReplaceAll does a recursive "first the expression and then the arguments` traversal (depth first, pre-order), while most of the other functions do a depth first post-order (first the arguments, then the whole expression). But breath-first I think is different, it would mean traverse one level at a time, upload.wikimedia.org/wikipedia/commons/4/46/Animated_BFS.gif $\endgroup$
    – Rojo
    Commented Aug 8, 2012 at 10:37
  • 3
    $\begingroup$ @Rojo just for reference, this would be a BF traversal, correct?: Table[Scan[Print, expr, {i}], {i, 0, Depth@expr}]; $\endgroup$
    – Mr.Wizard
    Commented Aug 8, 2012 at 10:49
  • 1
    $\begingroup$ @Mr.Wizard Yes, that is a breadth-first traversal. $\endgroup$ Commented Aug 8, 2012 at 14:38
9
$\begingroup$

I meant my comment above as a joke, but here's the implementation anyway.

Some ugly recursive code to convert the expression to a Graph:

ClearAll[treeBuild]
treeBuild[expr_[ops___]] := treeBuild[expr, #] & /@ {ops}
treeBuild[name_, expr_[ops___]] := 
   Module[{node = Unique[expr]}, {name \[DirectedEdge] node,treeBuild[node, #] & /@ {ops}}]
treeBuild[node_, a_] := node \[DirectedEdge] Unique["L" <> ToString[a] <> "$"]

Build the Graph

g = treeBuild[expr] // Flatten;

Graph[g, VertexLabels -> "Name", PlotRangePadding -> 0.25, 
         VertexSize -> Large, VertexStyle -> {List -> Green}]

Mathematica graphics

And now the breadth first scan:

HighlightGraph[ 
  Graph[g, VertexSize -> Large, VertexStyle -> {List -> Green}], {#}] & /@ 
  Reap[
     BreadthFirstScan[Graph@g,List, {"PrevisitVertex" -> (Sow[#1] &)}];
  ][[2, 1]]//ListAnimate

enter image description here

$\endgroup$
0
7
$\begingroup$

A package-ready breadth-first position search, returning positions of a pattern in an expression. It allows top-down and bottom-up breadth-first traversals by setting level specification. It is not exactly the one Mr.Wizard was looking for, as it checks absolute levels rigorously (i.e. all level 4 subparts are checked before any level 3 subpart is visited). Deals with the usual level specifications and can return a limited number of cases if asked for.

Options[bfPosition] = {Heads -> True};
bfPosition[expr_, patt_, opts : OptionsPattern[]] := 
   bfPosition[expr, patt, {0, ∞}, ∞, opts];
bfPosition[expr_, patt_, level_, opts : OptionsPattern[]] :=
   bfPosition[expr, patt, level, ∞, opts];
bfPosition[expr_, patt_, level_, 0 | 0., opts : OptionsPattern[]] = {};
bfPosition[expr_, patt_, level_, n_, opts : OptionsPattern[]] /; 
   If[MatchQ[level, {_Integer | Infinity, _Integer | Infinity} |
       {_Integer | Infinity} | _Integer | Infinity], True, 
    Message[bfPosition::level, level]; False] := Module[
   {lev, max = Depth@expr, range, c = 0, found, reap},

   (* Normalize level specification *)
   lev = Switch[level /. Infinity -> max,
     {_Integer, _Integer}, level,
     {_Integer}, {First@level, First@level},
     _Integer, {1, level}];
   lev = (Min[#, max] & /@ (lev /. x_?Negative :> Max[(max + 1 + x), 0]));
   range = Range[First@lev, Last@lev, If[Greater @@ lev, -1, 1]];

   (* Check each level until the required amount of matches are found *)
   reap = Last@Reap@Do[
       found = Position[expr, patt, {i, i}, n - c, Heads -> OptionValue@Heads];
       c = c + Length@found;
       Sow@found;
       If[c >= n, Return[]];,
       {i, range}];

   If[reap === {}, {}, Join @@ (First@reap)]
   ];

bfPosition[expr, pattern] gives a list of the positions at which objects matching pattern appear in expr by performing a breadth-first search of subparts. Position[expr, pattern, levelspec] finds only objects that appear on levels specified by levelspec. Position[expr, pattern, levelspec, n] gives the positions of the first n objects found. bfPosition effectively accepts reverse-ordered level specifications that define the order of search in expr: for example bfPosition[expr, pattern, {∞, 0}] performs a bottom-up while bfPosition[expr, pattern, {0, ∞}] performs a top-down breadth-first search.

Test it:

 expr = {{1, {2, 3}}, {4, 5}};
 pos = bfPosition[expr, _, {∞, 0}, Heads -> False];
 If[# === {}, expr, Extract[expr, #]] & /@ pos
{2, 3, 1, {2, 3}, 4, 5, {1, {2, 3}}, {4, 5}, {{1, {2, 3}}, {4, 5}}}

Note that all level-3 objects (2, 3) are visited before encountering a level-2 leaf (1).

bfPosition is not like Position (Position does a depth-first postorder search):

bfPosition[expr, _, Heads -> False]
Position[expr, _, Heads -> False]
{{}, {1}, {2}, {1, 1}, {1, 2}, {2, 1}, {2, 2}, {1, 2, 1}, {1, 2, 2}}

{{1, 1}, {1, 2, 1}, {1, 2, 2}, {1, 2}, {1}, {2, 1}, {2, 2}, {2}, {}}

Find positions using bottom-up or top-down search:

bfPosition[expr, _, {∞, 0}, Heads -> False]
bfPosition[expr, _, {0, ∞}, Heads -> False]
{{1, 2, 1}, {1, 2, 2}, {1, 1}, {1, 2}, {2, 1}, {2, 2}, {1}, {2}, {}}

{{}, {1}, {2}, {1, 1}, {1, 2}, {2, 1}, {2, 2}, {1, 2, 1}, {1, 2, 2}}

Find a limited number of occurrences only:

bfPosition[expr, _, {∞, 0}, 4, Heads -> False]
bfPosition[expr, _, {0, ∞}, 4, Heads -> False]
{{1, 2, 1}, {1, 2, 2}, {1, 1}, {1, 2}}

{{}, {1}, {2}, {1, 1}}
$\endgroup$
1
  • $\begingroup$ Thanks very much for this Istvan. However I believe it doesn't work with patterns with Alternatives in them. For example if the '4' in 'expr' is changed to '4->6', then: bfPosition[expr,(Rule|List)[___]] does not give the same result (after sorting) as Position does. $\endgroup$ Commented Sep 4, 2018 at 0:22
5
$\begingroup$

I don't sure this will look as a duplicated version with Sjoerd C. de Vries in here,but there are some trick function can make you life ease and simplify that answer.So I post this answer still.

Build graph by GraphComputation`ExpressionGraph from any expression

expr = Hold[
   Plot[{Sin[x], Sin[2 x], Sin[3 x]}, {x, 0, 2 Pi}, 
    PlotLegends -> "Expressions"]];
exprGraph = 
 GraphComputation`ExpressionGraph[expr, VertexSize -> Large]

Experimental`ListAnimator can make a animate without that control.

Experimental`ListAnimator[
 HighlightGraph[exprGraph, #, GraphHighlightStyle -> "Thick"] & /@ 
  Reap[BreadthFirstScan[
     exprGraph, {"PrevisitVertex" -> (Sow[#1] &)}]][[2, 1]]]

enter image description here

$\endgroup$
1
  • $\begingroup$ This even works in v10.1. Cool. :-) $\endgroup$
    – Mr.Wizard
    Commented Mar 23, 2017 at 15:15

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.