Reversibly merging sets of $k$ adjacent elements in an array

Question

Say I have an array of the form:

ExampleArray = {{1}, {2}, {3}, {4}, {5}, {6}, {7}, {8}, {9}, {10}, {11}, {12}};

I'd like to be able to reversibly merge sets of $k$ adjacent elements together s.t. I can go back and forth from, for example, arrays of the form:

ExampleArray = {{1}, {2}, {3}, {4}, {5}, {6}, {7}, {8}, {9}, {10}, {11}, {12}, {13}};

And, for $k = 2$:

ExampleArray2Star = {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {13}};

Or, for $k = 3$:

ExampleArray3Star = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}, {10, 11, 12}, {13}};

As we can see here, "leftover" elements at the end of the array will strictly be in a subset of size $\leq k$.

Is there a name for this sort of operation, and is there an easy way to execute it in Mathematica 9.0?

score 7 · Accepted Answer · edited Apr 13 '17 at 12:55

Here's a way, using Partition:

func[l_, n_] := Partition[l, n, n, {1, 1}, {}]

(the key is to use proper padding, see also in documentation of Partition)

example:

func[Range@13, #] & /@ Range[5]

{
  {{1}, {2}, {3}, {4}, {5}, {6}, {7}, {8}, {9}, {10}, {11}, {12}, {13}},
  {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {13}}, 
  {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}, {10, 11, 12}, {13}}, 
  {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13}}, 
  {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {11, 12, 13}}
}

Note For generality, I assumed that the input (l that is) is "flat". In your case, you want to Flatten it, e.g. func[Flatten[ExampleArray], #] & /@ Range[5].

Addendum:

You might want to look at this question, especially at the dynP function there - it discusses varying partition lengths.

+1, but note that the OP input is not Range@13. – Jul 11 '13 at 14:02 — , Jul 11 '13 at 14:02
@ruebenko, good point, I added that as a note. Thank you! – Pinguin Dirk Jul 11 '13 at 14:06 — Pinguin Dirk, Jul 11 '13 at 14:06

score 3 · Answer 2 · answered Jul 11 '13 at 14:00

Perhaps something like this:

ExampleArray = {{1}, {2}, {3}, {4}, {5}, {6}, {7}, {8}, {9}, {10}, \
{11}, {12}, {13}};

k = 3;
res = Join @@@ Partition[ExampleArray, k, k, 1, {}]
(* {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}, {10, 11, 12}, {13}} *)

Going back:

Join @@ (Partition[#, 1] & /@ res)
(*{{1}, {2}, {3}, {4}, {5}, {6}, {7}, {8}, {9}, {10}, {11}, {12}, {13}}*)

score 3 · Answer 3 · edited Apr 13 '17 at 12:55

Two variations of using Partition have been presented. Let me compare their performance, and offer a third method.

For simplicity I shall assume that the input is a packed array. This can have a major impact on the ranking of methods as a described here.

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

a = {Range@500000}\[Transpose]; (*sample data, packed *)
k = 4;

Partition[Flatten @ a, k, k, 1, {}] // timeAvg  (* Pinguin Dirk *)
Join @@@ Partition[a, k, k, 1, {}]  // timeAvg  (* ruebenko *)

0.02496

0.1842

Flattening before partitioning is faster on this data.

From past experience I know that using non-default padding e.g. {} will slow Partition considerably when using packed arrays. Therefore we can speed this process by separating that operation.

merge[a_, k_Integer] := 
  Module[{b = Partition[Flatten @ a, k, k, 1]},
    b[[-1]] = b[[-1]] ~Drop~ Mod[Length @ a, k, 1 - k];
    b
  ]

merge[a, k] // timeAvg

0.003368

On the packed data this is ~ 7.4X faster. However, on unpackable data it is of no benefit, and in fact slightly slower:

a = List /@ RandomChoice["a" ~CharacterRange~ "z", 500000];
k = 7;

Partition[Flatten@a, k, k, 1, {}] // timeAvg

merge[a, k]                       // timeAvg

0.03056

0.03556

Reversibly merging sets of $k$ adjacent elements in an array

3 Answers3

Linked