Dołącz do podlist pod warunkiem

Oct 19 2020

Mam zagnieżdżoną listę liczb całkowitych i chcę dołączyć iteracyjnie każdą podlistę spełniającą warunek do jej lewej sąsiedniej listy podrzędnej. Dogodnie warunkiem dołączenia jest to, czy długość listy jest równa 1 lub mniejsza. Moja naiwna próba:

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

Można go łatwo przekonwertować na łączenie w prawo.

Mam wrażenie, że ta funkcjonalność istnieje w Mathematica , ale nie mogłem tego rozgryźć. Czy można to zrobić szybciej i / lub bardziej elegancko? Jak rozszerzyć go na wiele poziomów zagnieżdżenia (rozpoczynając łączenie w lewo od wewnątrz)?

Odpowiedzi

2 kglr Oct 20 2020 at 00:20
lst = {{}, {1, 2, 3}, {4}, {5, 6}, {7}, {}};

Możemy użyć 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}}

Możemy również użyć 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}}
IstvánZachar Oct 20 2020 at 18:35

Komentarz @ DanielHubera okazał się najbardziej ogólny i szybki w przypadku list zagnieżdżonych, z pewnymi modyfikacjami:

(* 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}]

Wynik to:

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

Jeszcze łatwiejsze do konwersji na łączenie w prawo:

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

Zwróć uwagę, że krótkie listy i singletony nie są łączone z podlistą wyższego poziomu, a jedynie z podlistą wyższego poziomu.