3
$\begingroup$

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)?

$\endgroup$
  • 3
    $\begingroup$ You ma e.g. use ReplaceRepeated: dat = {{}, {1, 2, 3}, {4}, {5, 6}, {7}, {}}; dat //. {a___, b : {}, c : ({} | {}), d} -> {a, Join[b, c], d} $\endgroup$ – Daniel Huber Oct 19 at 16:04
2
$\begingroup$
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}}
| improve this answer | |
$\endgroup$
0
$\begingroup$

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

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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