What is the best way to flatten a linked list with lists as values?

Question

By following the advice on this site I have ended up with a linked list like the following:

acc = {{1, 2}, {{2, 3}, {{3, 4}, {{4, 5}, {{5, 6}, {}}}}}};

This was obtained by accumulating the values {i,j} during a recursion. What is the most efficient way to flatten the list to get the following:

flatAcc = {{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 6}}

Right now I am cheating by doing the following:

flatAcc = Partition[Flatten[acc], 2];

But I feel that Mathematica must have a better paradigm for this task.

Thanks in advance for your help.

Answer 1

I think your method is good but I also would suggest the following:

Cases[acc, {x_?NumberQ, y_?NumberQ} :> {x, y}, -1]

or easier:

Cases[acc, {__}, {-2}]                (*@ Alexey Popkov*)

This would be better but if you don't have empty list at the end.

Level[acc, {-2}]

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

in this case you may delete the empty list using any method. for example :

Most@Level[acc, {-2}]

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

Answer 2

A different head

You can avoid the problem from the outset by using a different head for your linked "list" e.g. AngleBracket:

flatAcc = {{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 6}}

x = Fold[〈#2, #〉 &, 〈〉, Reverse @ flatAcc]

〈{1,2}, 〈{2,3}, 〈{3,4}, 〈{4,5}, 〈{5,6}, 〈〉〉〉〉〉〉

Now Flatten can be used:

Flatten[x, ∞, AngleBracket]

〈{1, 2}, {2, 3}, {3, 4}, {4, 5}, {5, 6}〉

• You can Apply List as needed at this point.

• There is nothing special about AngleBracket; I just used it because it looks rather nice.

Bag functionality

One may use the undocumented Internal`Bag functionality in place of linked lists in many applications.

bag = Internal`Bag[];                          (* create bag *)

Scan[Internal`StuffBag[bag, #] &, flatAcc];    (* incrementally fill bag *)

Internal`BagPart[bag, All]                     (* get flat bag contents *)

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

Performance

m_goldberg asserted that a Flatten and Partition is the fastest method available. This is not borne out in my testing.

I could not include Algohi's Level method as Mathematica 10.0.1 crashed when the linked list grew longer.

(* timing function *)
SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

(* random pairs common to all tests *)
rand = RandomInteger[99, {2000000, 2}];

(* build each "linked list" or equivalent *)
linked = Fold[List, rand];
linked2 = Fold[AngleBracket, rand];
bag = Internal`Bag[rand];

(* timings *)
Flatten[linked] ~Partition~ 2      // timeAvg
Flatten[linked2, ∞, AngleBracket]  // timeAvg
Internal`BagPart[bag, All]         // timeAvg

1.529

0.131

0.0187

We see that in this test using AngleBracket and Flatten alone is more than an order of magnitude faster than using Flatten and Partition, and the Bag method is nearly two orders of magnitude faster than the original.

Notes:

• Lest it confuse anyone the two-argument from of Fold is used; see: Shorter syntax for Fold and FoldList?

• The linked list format used is different as I used e.g. bare List rather than {#2, #} & but I tried both ways and the timings were unaffected.

---

Addendum

Algohi wrote that I should provide a method to convert the OP's acc format to another head. I agree.

rule = {a_, b_} :> 〈a, b /. rule〉;

acc /. rule

〈{1,2}, 〈{2,3}, 〈{3,4}, 〈{4,5}, 〈{5,6}, {}〉〉〉〉〉

This misses {} but that can be dropped later with Most. A more general replacement function:

convert[_[a_, b_], h_] := h[a, convert[b, h]]
convert[_[], h_] := h[]

Now:

convert[〈{1,2}, 〈{2,3}, 〈{3,4}, 〈{4,5}, 〈{5,6}, {}〉〉〉〉〉, foo]

foo[{1, 2}, foo[{2, 3}, foo[{3, 4}, foo[{4, 5}, foo[{5, 6}, foo[]]]]]]

It would of course be more efficient to construct the linked "list" in this format to begin with.

Answer 3

A generalization

acc = {{a, b, c}, {{2}, {{"a", 4}, {{4, 5}, {{5, 6}, {}}}}}};

Cases[acc, {x__?AtomQ} :> {x}, -1]

{{a, b, c}, {2}, {"a", 4}, {4, 5}, {5, 6}}

Answer 4

Nest combined with FlattenAt / ReplacePart / MapAt:

ClearAll[f1, f2, f3]
f1 = Nest[FlattenAt[#, {-1}] &, #, Depth[#] - 3] /. {} ->(##&[]) &;
f2 = Nest[ReplacePart[#, {-1, 0} -> Sequence] &, #, Depth[#] - 3] /. {} -> (##&[]) &;
f3 = Nest[MapAt[Sequence @@ # &, #, {-1}] &, #, Depth[#] - 3] /. {} -> (## &[]) &;

Examples:

acc1 = {{1, 2}, {{2, 3}, {{3, 4}, {{4, 5}, {{5, 6}, {}}}}}};
acc2 = {{1, 2}, {x, y}, {{2, 3, 4}, {{3, 4}, {{4, 5, 6}, {{5, 6}, {}, {u, v, w}}}}}};
acc3 = {{a, b, c}, {{2}, {{"a", 4}, {{4, 5}, {{5, 6}, {}}}}}};

f1 @ acc1

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

f1 @ acc2

{{1, 2}, {x, y}, {2, 3, 4}, {3, 4}, {4, 5, 6}, {5, 6}, {u, v, w}}

f1 @ acc3

{{a, b, c}, {2}, {"a", 4}, {4, 5}, {5, 6}}

Equal @@ (# /@ {acc1, acc2, acc3} & /@ {f1, f2, f3})

True