Mathematica Asked by István Zachar on February 27, 2021
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)?
@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.
Correct answer by István Zachar on February 27, 2021
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}}
Answered by kglr on February 27, 2021
Get help from others!
Recent Questions
Recent Answers
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP