У меня нет доступа к Mathematica прямо сейчас, так что то, что следует, не проверено.Я предполагаю, что Cases распаковывает здесь, потому что он ищет в глубину, и поэтому сначала видит упакованный массив.Если это правильно, то вы могли бы вместо этого использовать правила (ReplaceAll, а не Replace) и выдавать исключение при первом совпадении:
Module[{tag},
Catch[
nb /. r_RasterBox :> Block[{}, Throw[First[r], tag] /; True];
$Failed,
tag]
]
Как я уже сказал, это всего лишь непроверенное предположение.
Редактировать 2: подход, основанный на экранировании частей выражения из сопоставителя шаблонов
Преамбула
В первом редактировании (ниже) представлен довольно тяжелый подход.Во многих случаях можно выбрать альтернативный маршрут.В этой конкретной проблеме (и многим другим она нравится) главная проблема заключается в том, чтобы каким-то образом защитить определенные подвыражения от сопоставителя шаблонов.Это может быть достигнуто также с помощью правил, чтобы временно заменить интересующие части некоторыми фиктивными символами.
Код
Вот модификация Cases, которая делает именно это:
Clear[casesShielded];
casesShielded[expr_,pt_,shieldPattern_,levspec_,n_,opts:OptionsPattern[]]:=
Module[{dummy,inverseShieldingRules, shielded, i=0},
inverseShieldingRules =
If[#==={},#,Dispatch@First@#]&@
Reap[shielded= expr/.(p:shieldPattern):>
With[{eval = With[{ind = ++i},Sow[dummy[ind]:>p];dummy[ind]]},
eval/;True];
][[2]];
Cases[shielded,pt,levspec,n,opts]/.inverseShieldingRules];
Эта версия Cases имеет один дополнительный параметр shieldPattern (третийодин), который указывает, какие подвыражения должны быть защищены от сопоставления с образцом.
Преимущества и возможности применения
Приведенный выше код довольно легок (по сравнению с предложением edit1 ниже), и , что позволяет полностью использовать и эффективно использовать существующиеCases функциональность.Это будет работать в случаях, когда основной шаблон (или правило) нечувствителен к экранированию соответствующих частей, что является довольно распространенной ситуацией (и, в частности, охватывает шаблоны типа _h, включая рассматриваемый случай).Это также может быть быстрее, чем применение myCases (описано ниже).
Дело под рукой
Здесь нам нужен этот вызов:
In[55]:=
(d4=First@casesShielded[nb,x_RasterBox:>First@x,
p_List/;Developer`PackedArrayQ[p],Infinity,1]);//Timing
Out[55]= {0.,Null}
, и результат, конечно, такой же, как и раньше:
In[61]:= d2===d4
Out[61]= True
Редактировать: альтернативная функция типа Cases
Мотивация и код
Мне потребовалось некоторое время, чтобы создать эту функцию, и я не уверен на 100 процентов, что она всегда работает правильно, но вотверсия Cases, которая, все еще работая в глубину, анализирует выражение в целом перед подвыражениями:
ClearAll[myCases];
myCases[expr_, lhs_ :> rhs_, upToLevel_: 1, max : (_Integer | All) : All,
opts : OptionsPattern[]] :=
Module[{tag, result, f, found = 0, aux},
With[{
mopts = FilterRules[{opts}, {Heads -> False}],
frule =
Apply[
RuleDelayed,
Hold[lhs, With[{eval = aux}, Null /; True]] /.
{aux :> Sow[rhs, tag] /; max === All,
aux :> (found++; Sow[rhs, tag])}
]
},
SetAttributes[f, HoldAllComplete];
If[max =!= All,
_f /; found >= max := Throw[Null, tag]
];
f[x_, n_] /; n > upToLevel := Null;
f[x_, n_] :=
Replace[
HoldComplete[x],
{
frule,
ex : _[___] :>
With[{ev =
Replace[
HoldComplete[ex],
y_ :> With[{eval = f[y, n + 1]}, Null /; True],
{2},
Sequence @@ mopts
]},
Null /; True
]
},
{1}
]
]; (* external With *)
result =
If[# === {}, #, First@#] &@
Reap[Catch[f[expr, 0], tag], tag, #2 &][[2]];
(* For proper garbage-collection of f *)
ClearAll[f];
result
]
Как это работает
Это не самая тривиальная частькода, поэтому вот несколько замечаний.Эта версия Cases основана на той же идее, которую я предложил в первую очередь, а именно - использовать семантику подстановки правил для первой попытки сопоставления с шаблоном для всего выражения и только в случае неудачи переходить к подвыражениям.Я подчеркиваю, что это все еще обход в глубину, но он отличается от стандартного (который используется в большинстве функций обхода выражений, таких как Map, Scan, Cases и т. Д.).Я использую Reap и Sow для сбора промежуточных результатов (совпадений).Самая хитрая часть здесь состоит в том, чтобы предотвратить оценку подвыражений, и мне пришлось заключить подвыражения в HoldComplete.Следовательно, мне пришлось использовать (вложенную версию) технику Тротта-Стшебонского (возможно, есть более простые способы, но я не смог их увидеть), чтобы позволить эвакуацию сторон правил внутри удерживаемых (под) выражений,и использовал Replace с надлежащим уровнем спецификации, с учетом дополнительных добавленных HoldComplete оболочек.Я возвращаю Null в правилах, поскольку основное действие - Sow частей, поэтому не имеет значения, что вводится в исходное выражение в конце.Некоторая дополнительная сложность была добавлена кодом для поддержки спецификации уровня (я поддерживаю только один целочисленный уровень, указывающий максимальный уровень, до которого можно искать, а не полный диапазон возможных lev.specs), максимальное количество найденных результатов иопция Heads.Код для frule служит для того, чтобы не вводить накладные расходы на подсчет найденных элементов в тех случаях, когда мы хотим найти их все.Я использую один и тот же Module -генерированный тег и как тег для Sow, и как тег для исключений (который я использую для остановки процесса, когда найдено достаточно совпадений, как в моем первоначальном предложении).
Тесты и тесты
Чтобы провести нетривиальный тест этой функции, мы можем, например, найти все символы в DownValues из myCases и сравнить с Cases:
In[185]:=
And@@Flatten[
Outer[
myCases[DownValues[myCases],s_Symbol:>Hold[s],#1,Heads->#2] ===
Cases[DownValues[myCases],s_Symbol:>Hold[s],#1,Heads->#2]&,
Range[0,20],
{True,False}
]]
Out[185]= True
* myCases функция примерно в 20-30 раз медленнее, чем Cases, хотя:
In[186]:=
Do[myCases[DownValues[myCases],s_Symbol:>Hold[s],20,Heads->True],{500}];//Timing
Out[186]= {3.188,Null}
In[187]:= Do[Cases[DownValues[myCases],s_Symbol:>Hold[s],20,Heads->True],{500}];//Timing
Out[187]= {0.125,Null}
Под рукой
Легко проверить, что myCases решает исходную проблему распаковки
In[188]:= AbsoluteTiming[d3=First@myCases[nb,r_RasterBox:>First[r],Infinity,1];]
Out[188]= {0.0009766,Null}
In[189]:= d3===d2
Out[189]= True
Есть надежда, что myCases может быть в целом полезен в подобных ситуациях, хотя снижение производительности при использовании его вместо Cases является существенным и должно быть принято во внимание.