[Wolfram Mathematica] Парсинг грамматики

[Mysterious Light]

Отчасти продолжение нерешенной задачи topic95339.html

Имеется такой язык, описанный неформально:
c-объект — _c (любое выражение вида c[...])
коэффициент — что угодно, что не содержит _c, т.е. x_ /; FreeQ[x, _c]
H-член — произведение двух линейных комбинаций c-объектов
H-выражение — линейная комбинация H-членов

Предлагаю такую формальную грамматику:

c-obj       ::= _c                       #
coeff       ::= x_ /; FreeQ[x, _c]       #
c-lin-term  ::= c-obj | coeff * c-lin    # слагаемое в линейной комбинации 
c-lin       ::= Plus[ c-lin-term .. ]    # сама линейная комбинация c-объектов
H-term      ::= c-lin * c-clin           #
H-lin-term  ::= H-term | coeff * H-expr  # слагаемое в линейной комбинации H-термов
H-expr      ::= Plus[ H-lin-term .. ]    #

В 3-й и 6-й строчках вместо coeff * c-obj и coeff * H-term написаны более общие шаблоны coeff * c-lin и coeff * H-expr, чтобы выражения вида a * (b * (c[1] + c[2]) + d * c[3]) были допустимыми для языки.

Интерпретация:
c-объект и коэффициенты интерпретируются как есть. По дистрибутивности все скобки должны быть раскрыты так, чтобы H-выражение было представлено в виде суммы слагаемых вида coeff * c-объект * c-объект.
Дополнительные неформализованные требования: в ответе-результате стоит заменить стандартные Plus и Times на List и T, соответственно, и позволить некоторым H-членам исходного выражения быть записанными в таком виде.

(Как-то так для списка в качестве знака суммы)

c-obj       ::= _c                       #
coeff       ::= x_ /; FreeQ[x, _c]       #
c-lin-term  ::= c-obj | coeff * c-lin    # слагаемое в линейной комбинации 
c-lin       ::= Plus[ c-lin-term .. ]    # сама линейная комбинация c-объектов
H-term      ::= c-lin * c-clin           #
H-lin-term  ::= H-term | coeff * H-expr  # слагаемое в линейной комбинации H-термов
H-expr      ::= Plus[ H-lin-term .. ] | List[ H-expr .. ] | Plus[ H-expr .. ]

Как такое реализовать по-проще в Wolfram Mathematica? 1) является ли введённое выражение допустимым для языка или нет по конкретной причине 2) унифицированный вид
Принципиальное решение я, конечно, вижу: для каждого понятия написать функцию, которая определяет, парсится ли выражение-аргумент, и другую функцию, сопоставляющую выражению его значение, — но оно имеющаяся реализация мне видится неоптимальной. Кстати, первый листинг может использоваться для парсинга выражения (правда, нужно контролировать, чтобы под .. понималось 2 и более членов, а коеффициент всегда был бы отличен от 1), второй же — нет из-за последней строчки, которая впадает в бесконечную рекурсию.

Как решаются такие задачи парсинга в WM?

[arseniiv]

Я опять немного плохих советов надаю, можно?

Mysterious Light в сообщении #1046631 писал(а):

для каждого понятия написать функцию, которая определяет, парсится ли выражение-аргумент, и другую функцию, сопоставляющую выражению его значение

Можно их объединить и возвращать, скажем, {значение} vs. Null или {}, если не парсится. В каком-то коде это может его и упростить. Но, как понимаю, акцент здесь не на улучшениях такого плана.

Раз вы не нашли функций для разбора, то наверняка их там и нет, и любой парсер придётся писать одинаково с нуля. Хотя можно было бы посмотреть код пакетов, оперирующих какими-нибудь сложными выражениями…

Вообще, если вам нужен только один конкретный парсер по такой небольшой грамматике, проще будет не писать что-то, разбирающее сначала грамматику и потом с этим работающее, а использовать разбор сверху вниз с помощью функций, как вы сделали. Нельзя сказать, что это хороший совет, но он хотя бы экономит время. Может, посмотреть, как улучшить ваш существующий код? (Кроме предложения в самом начале, которое от балды.)

[Vince Diesel]

А так не пойдет? Все коммутативно/ассоциативно, как я понимаю. Дать математике упростить исходное выражение командой Expand. Потом анализировать FullForm того, что получится. Должна быть либо сумма нужных выражений, заголовок Plus. Заменяем его на List и анализируем каждый элемент списка (имеет ли оно вид coeff * c-объект *(возм. еще c-объект)). Либо это будет одно слагаемое, тогда это произведение, должен быть заголовок Times, анализируем точно так же.

[Mysterious Light]

(используемый ныне код)

На входе H[H-выражение]. На выходе H[BondValue[Bond[c-объект, c-объект], коэффициент] ..]

CoeffQ[x_] := FreeQ[x, _c];
CoeffV[x_?CoeffQ] := x;

LinearCQ[_c] = True;
LinearCQ[x_Times] := 
  MatchQ[List @@ x, {Longest[(_?CoeffQ) ...], _?LinearCQ, Longest[(_?CoeffQ) ...]}];
LinearCQ[x_Plus] := VectorQ[List @@ x, LinearCQ];
LinearCQ[_] = False;
LinearCV[x_c] := {{1, x}};
LinearCV[x_Times] := 
  Replace[List @@ 
    x, {a1 : Longest[(_?CoeffQ) ...], b_?LinearCQ, 
     a2 : Longest[(_?CoeffQ) ...]} :> 
    Map[{Times[a1, a2, #[[1]]], #[[2]]} &, LinearCV[b]]];
LinearCV[x_Plus] := Join @@ (LinearCV /@ (List @@ x));

BondQ[Dot[_?LinearCQ, _?LinearCQ]] = True;
BondQ[_] = False;
BondV[Dot[a1_, a2_]] := 
  Join @@ Outer[{#1[[1]] #2[[1]], #1[[2]], #2[[2]]} &, LinearCV[a1], LinearCV[a2], 1];
BondV[Bond[a1_, a2_]] := {{1, a1, a2}};

TermQ[x__ /; Length[{x}] > 1 && VectorQ[{x}, TermQ]] = True;
TermQ[{(_?TermQ) ..}] = True;
TermQ[x_Plus] := TermQ[List @@ x];
TermQ[x_Times] := 
  MatchQ[List @@ x, {Longest[(_?CoeffQ) ...], _?BondQ, Longest[(_?CoeffQ) ...]}];
TermQ[_?BondQ] = True;
TermQ[_BondValue] = True;
TermQ[Ham[x__]] := TermQ[x];
TermQ[_] = False;
TermV[x__ /; Length[{x}] > 1] := TermV[{x}];
TermV[x_Plus] := TermV[List @@ x];
TermV[x_Times] := 
  Replace[List @@ 
    x, {a1 : Longest[(_?CoeffQ) ...], b_?BondQ, 
     a2 : Longest[(_?CoeffQ) ...]} :> 
    With[{k = Times[a1, a2], 
      bv = BondV[b]}, {k #[[1]], #[[2]], #[[3]]} & /@ bv]];
TermV[x_?BondQ] := BondV[x];
TermV[x_List] := Join @@ (TermV /@ x);
TermV[Ham[x__]] := TermV[x];
TermV[BondValue[Bond[a1_, a2_], v_]] := {{v, a1, a2}};
H[a1___, H[args___], a2___](*/;Length[{a1,a2}]>0*):= H[a1, args, a2];
H[args__] := (Ham @@ (BondValue[Bond[#2, #3], #1] & @@@ TermV[args])) /; 
   TermQ[args] && ! MatchQ[{args}, {BondValue[Bond[_, _], _] ..}];

Не универсальный. Требует костыли.

Забыл сказать о важной особенности: произведение с-объектов не коммутирует. Я использовал Dot вместо Times (не нашел, как запретить Times переставлять сомножители определённого вида) для произведения c-объектов c[1].c[2] или их линейных комбинаций (c[1]+c[2]).c[3]

Без неё решение сделал по мотивам Vince Diesel

PlusToList[x_List] = x;
PlusToList[x_] := If[MatchQ[x, _Plus], List @@ x, {x}];
TimesToT[Times[a___?CoeffQ, c[s1_], c[s2_]]] := T[c[s1], c[s2], Times[a]];
TimesToT[Times[a___?CoeffQ, c[s1_]^2]] := T[c[s1], c[s1], Times[a]];
TimesToT[x_T] = x;

ParseExpr[expr_] := 
  FixedPoint[TimesToT /@ Flatten[PlusToList[Expand[#]]] &, 
   expr /. T -> Times];

Попробовал заменить Expand на Distribute[Distribute[#, Plus, Dot], List, Dot] &, но вложенные выражения не распознаёт.
Одна из проблем связана с тем, что Plus, Times, Dot и List могут оказаться на любом уровне сложенности выражения, в т.ч. внутри c-объекта. Да и связку List-Dot я допускаю использовать для обозначения скалярного произведения, вроде ({kx, ky} . {x, y}) c[x].c[y], поэтому просто взять и глобально применить //. не получится.

[Vince Diesel]

Можно взять какую-либо команду математики без заданных свойств, например, CircleTimes $\otimes$ или хоть букву T, и определить нужные свойства:
дистрибутивность

CircleTimes[x___, y_ + z_, u___] := CircleTimes[x, y, u] + CircleTimes[x, z, u]

вынесение коэффициента

CircleTimes[a___, b_ c[d___], e___] := b CircleTimes[a, c[d], e] /; FreeQ[b, _c]

упрощение вложенных произведений

CircleTimes[a___, CircleTimes[d___] b_., e___] := b CircleTimes[a, d, e] /; FreeQ[b, _c]

Сложение ассоциативно, можно оставить операцию +. Далее анализируем, как предложено выше.
Например, выражение $7 (x c(1)+3 c(1) c(2))\otimes (y c(3)+z c(4)\otimes c(5))$

7 CircleTimes[x c[1] + 3 c[1] c[2], y c[3] + z CircleTimes[c[4], c[5]]]//Expand

раскрывается в

$$7 x y c(1)\otimes c(3)+7 x z c(1)\otimes c(4)\otimes c(5)+7 y (3 c(1) c(2))\otimes c(3)+7 z (3 c(1) c(2))\otimes c(4)\otimes c(5)$$

Произведение $c(1)c(2)$ не имеет нужного вида и не упрощается. Команда Expand здесь нужна из-за внешнего множителя.

[Mysterious Light]

Во! Вот это примерно то, что я долго искал! Просто и элегантно. Спасибо.

Что означает фраза b_. в данном контексте? Никогда Optional/Default не пользовался и плохо представляю, как оно работает.
В данном случае это должно означать что-то вроде «по умолчанию считать b равным 1, если не указан», но в каких случаях это может сработать?

CircleTimes не очень удобно набирать, даже Esc-последовательностью esc c * esc. Впрочем, только что нашел выход: обернуть тело «парсера» в Block[{Dot}, ... ]

[Vince Diesel]

Mysterious Light в сообщении #1046933 писал(а):

в каких случаях это может сработать?

В выражении CircleTimes[a___, CircleTimes[d___] , e___], оно не подходит под шаблон CircleTimes[a___, CircleTimes[d___]b_ , e___]. Этот Optional/Default аргумент придуман как раз для случаев, когда коэффициент или что другое равно единице/нулю (и явно в записи не присутствует), чтобы учесть этот вариант при сравнении шаблонов.

[arseniiv]

Vince Diesel в сообщении #1046925 писал(а):

Можно взять какую-либо команду математики без заданных свойств, например, CircleTimes $\otimes$ или хоть букву T, и определить нужные свойства:

Добавлю, в том числе ещё есть NonCommutativeMultiply, а в виде оператора просто **, но его тоже надо будет доопределять, ведь даже 1 ** a не упростится в a. У него только ассоциативность есть в виде атрибута Flat.

(Про код)

Mysterious Light
Хм, тут действительно было удобнее разделить эти функции на пары.