РЕДАКТИРОВАТЬ
Очевидно, у моего первого решения есть по крайней мере два серьезных недостатка: оно очень медленное и абсолютно нецелесообразное для списков, содержащих более 100 элементов, и содержит некоторые ошибкикоторого я пока не смог опознать - иногда не хватает некоторых групп.Итак, я предоставлю две (надеюсь, правильные) и гораздо более эффективные альтернативы, и ниже приведу некорректную для любого заинтересованного.
Решение на основе связанных списков
Вот решениена основе связанных списков.Это позволяет нам по-прежнему использовать шаблоны, но избегать неэффективности, вызванной шаблонами, содержащими __ или ___ (при многократном применении):
ClearAll[toLinkedList];
toLinkedList[x_List] := Fold[{#2, #1} &, {}, Reverse@x]
ClearAll[accumF];
accumF[llFull_List, acc_List, {h_, t_List}, ctr_, max_, min_, band_, rLen_] :=
With[{cmax = Max[max, h], cmin = Min[min, h]},
accumF[llFull, {acc, h}, t, ctr + 1, cmax, cmin, band, rLen] /;
Abs[cmax - cmin] < band];
accumF[llFull_List, acc_List, ll : {h_, _List}, ctr_, _, _, band_, rLen_] /; ctr >= rLen :=
accumF[ll, (Sow[acc]; {}), ll, 0, h, h, band, rLen];
accumF[llFull : {h_, t : {_, _List}}, _List, ll : {head_, _List}, _, _, _, band_, rLen_] :=
accumF[t, {}, t, 0, First@t, First@t, band, rLen];
accumF[llFull_List, acc_List, {}, ctr_, _, _, _, rLen_] /; ctr >= rLen := Sow[acc];
ClearAll[getBandsLL];
getBandsLL[lst_List, runLength_Integer, band_?NumericQ] :=
Block[{$IterationLimit = Infinity},
With[{ll = toLinkedList@lst},
Map[Flatten,
If[# === {}, #, First@#] &@
Reap[
accumF[ll, {}, ll, 0, First@ll, First@ll, band,runLength]
][[2]]
]
]
];
Вот примеры использования:
In[246]:= getBandsLL[{-1.2,-1.8,1.5,-0.6,-0.8,-0.1,1.4,-0.3,-0.1,-0.7},3,1]
Out[246]= {{-0.6,-0.8,-0.1},{-0.3,-0.1,-0.7}}
In[247]:= getBandsLL[{-1.2,-1.8,1.5,-0.6,-0.8,-0.1,-0.5,-0.3,-0.1,-0.7},3,1]
Out[247]= {{-0.6,-0.8,-0.1,-0.5,-0.3,-0.1,-0.7}}
Основная идея функции accumF состоит в том, чтобы обойти список номеров (преобразованный в связанный список до этого) и накопить полосу в другом связанном списке, который передается ему в качестве второго аргумента.Как только условие диапазона не выполняется, накопленный диапазон запоминается с помощью Sow (если он был достаточно длинным), и процесс начинается заново с оставшейся частью связанного списка.Параметр ctr может не понадобиться, если мы решим использовать вместо него Depth[acc].
В приведенном выше коде есть несколько неочевидных вещей.Один тонкий момент заключается в том, что попытка объединить два средних правила для accumF в одно правило (они выглядят очень похожими) и использовать CompoundExpression (что-то вроде (If[ctr>=rLen, Sow[acc];accumF[...])) на правой стороне приведет к не-хвостурекурсивный accumF (см. этот ответ для более подробного обсуждения этой проблемы. Именно поэтому я делаю строку (Sow[acc]; {}) внутри вызова функции - чтобы избежать верхнего уровня CompoundExpression вшк).Еще один тонкий момент заключается в том, что мне нужно сохранить копию связанного списка, содержащего оставшиеся элементы, сразу после того, как было найдено последнее успешное совпадение, поскольку в случае неудачной последовательности мне нужно откатиться к этому списку без его первого элемента и запуститьнад.Этот связанный список хранится в первом аргументе accumF.
Обратите внимание, что передача больших связанных списков не требует больших затрат, поскольку копируется только первый элемент (заголовок) и указатель на остальную часть (хвост).Это основная причина, по которой использование связанных списков значительно повышает производительность по сравнению со случаем таких шаблонов, как {___,x__,right___}, поскольку в последнем случае копируются полные последовательности x или right.Со связанными списками мы эффективно копируем только несколько ссылок, и поэтому наши алгоритмы ведут себя примерно так, как мы ожидаем (линейно по длине списка данных здесь).В этом ответе я также упомянул использование связанных списков в таких случаях как один из методов оптимизации кода (раздел 3.4).
Решение на основе компиляции
Вот простая, но не слишком элегантная функция, основанная на Compile, которая находит список позиций начальных и конечных полос в списке:
bandPositions =
Compile[{{lst, _Real, 1}, {runLength, _Integer}, {band, _Real}},
Module[{i = 1, j, currentMin, currentMax,
startEndPos = Table[{0, 0}, {Length[lst]}], ctr = 0},
For[i = 1, i <= Length[lst], i++,
currentMin = currentMax = lst[[i]];
For[j = i + 1, j <= Length[lst], j++,
If[lst[[j]] < currentMin,
currentMin = lst[[j]],
(* else *)
If[lst[[j]] > currentMax,
currentMax = lst[[j]]
]
];
If[Abs[currentMax - currentMin] >= band ,
If[ j - i >= runLength,
startEndPos[[++ctr]] = {i, j - 1}; i = j - 1
];
Break[],
(* else *)
If[j == Length[lst] && j - i >= runLength - 1,
startEndPos[[++ctr]] = {i, j}; i = Length[lst];
Break[];
];
]
]; (* inner For *)
]; (* outer For *)
Take[startEndPos, ctr]], CompilationTarget -> "C"];
Используется в конечной функции:
getBandsC[lst_List, runLength_Integer, band_?NumericQ] :=
Map[Take[lst, #] &, bandPositions[lst, runLength, band]]
Примеры использования:
In[305]:= getBandsC[{-1.2,-1.8,1.5,-0.6,-0.8,-0.1,1.4,-0.3,-0.1,-0.7},3,1]
Out[305]= {{-0.6,-0.8,-0.1},{-0.3,-0.1,-0.7}}
In[306]:= getBandsC[{-1.2,-1.8,1.5,-0.6,-0.8,-0.1,-0.5,-0.3,-0.1,-0.7},3,1]
Out[306]= {{-0.6,-0.8,-0.1,-0.5,-0.3,-0.1,-0.7}}
Тесты
In[381]:=
largeTest = RandomReal[{-5,5},50000];
(res1 =getBandsLL[largeTest,3,1]);//Timing
(res2 =getBandsC[largeTest,3,1]);//Timing
res1==res2
Out[382]= {1.109,Null}
Out[383]= {0.016,Null}
Out[384]= True
Очевидно, что если кто-то хочет производительности, Compile побеждает.Мои наблюдения за большими списками заключаются в том, что оба решения имеют приблизительно линейную сложность с размером списка номеров (как и должно быть), скомпилированный на моем компьютере примерно в 150 раз быстрее, чем тот, который основан на связанных списках.
Замечания
Фактически оба метода кодируют один и тот же алгоритм, хотя это может быть неочевидно.Тот, у которого есть рекурсия и шаблоны, возможно, несколько более понятен, но это вопрос мнения.
Простая, но медленная и глючная версия
Вот оригинальный код, который я написал первым, чтобы решить эту проблему. Это основано на довольно простом использовании шаблонов и повторном применении правил. Как уже упоминалось, одним из недостатков этого метода является его очень плохая производительность. На самом деле это еще один случай против использования таких конструкций, как {___,x__,y___} в сочетании с повторным применением правил, для чего-либо более длинного, чем несколько десятков элементов. В упомянутых рекомендациях по методам оптимизации кода это соответствует разделу 4.1.
В любом случае, вот код:
If[# === {}, #, First@#] &@
Reap[thisList //. {
left___,
Longest[x__] /;Length[{x}] >= runLength && Abs[Max[{x}] - Min[{x}]] < band,
right___} :> (Sow[{x}]; {right})][[2]]
Работает корректно для обоих оригинальных небольших тестовых списков. Кроме того, выглядит в целом корректно, но для больших списков часто пропускаются некоторые полосы, что видно по сравнению с двумя другими методами. Я не смог пока локализовать ошибку, так как код кажется довольно прозрачным.