# Join sublists on condition

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:= joinLeft[{{}, {1, 2, 3}, {4}, {5, 6}, {7}, {}}, 1]

Out= {{}, {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)?

• You ma e.g. use ReplaceRepeated: dat = {{}, {1, 2, 3}, {4}, {5, 6}, {7}, {}}; dat //. {a___, b : {}, c : ({} | {}), d} -> {a, Join[b, c], d} Oct 19 '20 at 16:04

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}}


@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.