Join sublists on condition

Question

I have a nested list of integers and want to join any sublist matching a condition to its left neighbouring sublist, iteratively. Conveniently, the joining condition is whether the length of the list is 1 or less. My naive attempt:
ClearAll[joinLeft];
joinLeft[list : {__List}, n_Integer : 1] := 
  Fold[FlattenAt[
     If[Length@#2 <= n, {Most@#1, Join[Last@#1, #2]}, {#1, #2}], 
     1] &, {First@list}, Rest@list];

In[1]:= joinLeft[{{}, {1, 2, 3}, {4}, {5, 6}, {7}, {}}, 1]

Out[1]= {{}, {1, 2, 3, 4}, {5, 6, 7}}

It can be easily converted to join-to-right.
I have the feeling that this functionality exists in Mathematica, but could not figure it out. Can this be made faster and/or more elegant? How to extend it to multiple levels of nesting (starting joining-to-the-left from the inside)?

István Zachar · Accepted Answer

@DanielHuber's comment turned out to be the most general and fast for nested lists, with some modifications:

(* helper to join singletons/nonlists to nearest list *)
join[a_List, b_List] := Join[a, b];
join[a_List, b_] := Join[a, {b}];
join[a_, b_List] := Join[{a}, b];

list = {{0, {1, 2}, {3}, 4, {5, 6}, {7}}, {8}, {{1}, {2}}, 3, {{4, 5, 6}}, {{7}}};

ReplaceRepeated[list,
   {a___, b_List, c : (_List?(Length@# <= n &) | Except[_List]), d___} :>
   {a, join[b, c], d}]

Output is:

{{0, {1, 2, 3, 4}, {5, 6, 7, 8}}, {{1, 2, 3}, {4, 5, 6, 7}}}

Even more easier to convert to join-to-right:

ReplaceRepeated[list,
   {a___, b : (_List?(Length@# <= n &) | Except[_List]), c_List, d___} :>
   {a, join[b, c], d}]

{{{0, 1, 2}, {3, 4, 5, 6}, {7}}, {{8, 1}, {2}}, {{3, 4, 5, 6}, {7}}}

Note, that short lists and singletons are not joined with a sublist of higher level, only with sublist of a deeper level.

kglr · Answer

lst = {{}, {1, 2, 3}, {4}, {5, 6}, {7}, {}}; We can use SequenceReplace: ClearAll[appendLeft1, appendRight1] appendLeft1[l_, n_: 1] := SequenceReplace[{a_, b__} /; (And @@ Thread[Length /@ {b} <= n]) :> Join[a, b]] @ l appendLeft1 @ lst {{}, {1, 2, 3, 4}, {5, 6, 7}} appendRight1[l_, n_: 1] := SequenceReplace[{a__, b_} /; (And @@ Thread[Length /@ {a} <= n]) :> Join[a, b]] @ l appendRight1 @ lst {{1, 2, 3}, {4, 5, 6}, {7}} We can also use Split + FixedPoint: ClearAll[appendLeft2, appendRight2] appendLeft2 = FixedPoint[Flatten /@ Split[#, Length[#2] <= 1 &] &, #] &; appendLeft2 @ lst {{}, {1, 2, 3, 4}, {5, 6, 7}} appendRight2 = FixedPoint[Flatten /@ Split[#, Length[#] <= 1 &] &, #] &; appendRight2 @ lst {{1, 2, 3}, {4, 5, 6}, {7}}

Join sublists on condition

2 Answers

Add your own answers!

Ask a Question