Я буду толковать это больше как вопрос об автоматизации и разработке программного обеспечения, а не о конкретной проблеме, с учетом большого количества уже опубликованных решений.Reap и Sow являются хорошими средствами (возможно, лучшими в символической настройке) для сбора промежуточных результатов.Давайте сделаем это вообще, чтобы избежать дублирования кода.
Нам нужно написать функцию высшего порядка.Я не буду делать ничего радикально нового, но просто упакую ваше решение, чтобы сделать его более общеприменимым:
Clear[tableGen];
tableGen[f_, iter : {i_Symbol, __}, addif : Except[_List] : (True &)] :=
Module[{sowTag},
If[# === {}, #, First@#] &@
Last@Reap[Do[If[addif[#], Sow[#,sowTag]] &[f[i]], iter],sowTag]];
Преимущества использования Do над For в том, что переменная цикла локализуется динамически (таким образом, глобальные модификации для него не входят в область действия Do), а также синтаксис итератора Do ближе к синтаксису Table (Do также немного быстрее).
Теперь, здесь используется
In[56]:= tableGen[Prime, {i, 10}, PrimeQ[# + 2] &]
Out[56]= {3, 5, 11, 17, 29}
In[57]:= tableGen[Prime, {i, 3, 10}, PrimeQ[# + 1] &]
Out[57]= {}
In[58]:= tableGen[Prime, {i, 10}]
Out[58]= {2, 3, 5, 7, 11, 13, 17, 19, 23, 29}
РЕДАКТИРОВАТЬ
Эта версия ближе к синтаксису, который вы упомянули (он принимает выражение, а не функцию):
ClearAll[tableGenAlt];
SetAttributes[tableGenAlt, HoldAll];
tableGenAlt[expr_, iter_List, addif : Except[_List] : (True &)] :=
Module[{sowTag},
If[# === {}, #, First@#] &@
Last@Reap[Do[If[addif[#], Sow[#,sowTag]] &[expr], iter],sowTag]];
Дополнительным преимуществом является то, что у вас могут даже быть символы итератора, определенные глобально, поскольку они передаются без оценки и динамически локализуются.Примеры использования:
In[65]:= tableGenAlt[Prime[i], {i, 10}, PrimeQ[# + 2] &]
Out[65]= {3, 5, 11, 17, 29}
In[68]:= tableGenAlt[Prime[i], {i, 10}]
Out[68]= {2, 3, 5, 7, 11, 13, 17, 19, 23, 29}
Обратите внимание, что поскольку синтаксис теперь другой, нам пришлось использовать атрибут Hold, чтобы предотвратить преждевременную оценку переданного выражения expr.
РЕДАКТИРОВАТЬ 2
В соответствии с запросом @ Саймона, здесь обобщение для многих измерений:
ClearAll[tableGenAltMD];
SetAttributes[tableGenAltMD, HoldAll];
tableGenAltMD[expr_, iter__List, addif : Except[_List] : (True &)] :=
Module[{indices, indexedRes, sowTag},
SetDelayed @@ Prepend[Thread[Map[Take[#, 1] &, List @@ Hold @@@ Hold[iter]],
Hold], indices];
indexedRes =
If[# === {}, #, First@#] &@
Last@Reap[Do[If[addif[#], Sow[{#, indices},sowTag]] &[expr], iter],sowTag];
Map[
First,
SplitBy[indexedRes ,
Table[With[{i = i}, Function[Slot[1][[2, i]]]], {i,Length[Hold[iter]] - 1}]],
{-3}]];
Это значительно менее тривиально, поскольку мне пришлось Sowиндексы вместе с добавленными значениями, а затем разбить получившийся плоский список в соответствии с индексами.Вот пример использования:
{i, j, k} = {1, 2, 3};
tableGenAltMD[i + j + k, {i, 1, 5}, {j, 1, 3}, {k, 1, 2}, # < 7 &]
{{{3, 4}, {4, 5}, {5, 6}}, {{4, 5}, {5, 6}, {6}}, {{5, 6}, {6}}, {{6}}}
Я присвоил значения i,j,k переменным итератора, чтобы проиллюстрировать, что эта функция локализует переменные итератора и нечувствительна к возможным глобальным значениям для них.Чтобы проверить результат, мы можем использовать Table, а затем удалить элементы, не удовлетворяющие условию:
In[126]:=
DeleteCases[Table[i + j + k, {i, 1, 5}, {j, 1, 3}, {k, 1, 2}],
x_Integer /; x >= 7, Infinity] //. {} :> Sequence[]
Out[126]= {{{3, 4}, {4, 5}, {5, 6}}, {{4, 5}, {5, 6}, {6}}, {{5, 6}, {6}}, {{6}}}
Обратите внимание, что я не проводил подробные проверки, поэтому текущая версия может содержать ошибки и нуждается в дополнительном тестировании..
РЕДАКТИРОВАТЬ 3 - ИСПРАВЛЕНИЕ ОШИБКИ
Обратите внимание на важное исправление ошибки: во всех функциях теперь я использую Sow с пользовательским уникальным тегом и Reap также.Без этого изменения функции не будут работать должным образом, когда вычисляемое выражение также использует Sow.Это общая ситуация с Reap - Sow, и она напоминает ситуацию для исключений (Throw - Catch).
EDIT 4 - SyntaxInformation
Поскольку это такая потенциально полезная функция, было бы неплохо заставить ее вести себя больше как встроенная функция.Сначала мы добавляем подсветку синтаксиса и базовую проверку аргументов через
SyntaxInformation[tableGenAltMD] = {"ArgumentsPattern" -> {_, {_, _, _., _.}.., _.},
"LocalVariables" -> {"Table", {2, -2}}};
Затем добавление сообщения об использовании позволяет пункту меню «Создать шаблон» (Shift+Ctrl+k) работать:
tableGenAltMD::usage = "tableGenAltMD[expr,{i,imax},addif] will generate \
a list of values expr when i runs from 1 to imax, \
only including elements if addif[expr] returns true.
The default of addiff is True&."
Более полное и отформатированное сообщение об использовании можно найти в этом гисте .