Решение задачи о расстановке скобок и знаков арифметических операций в выражении

Думаю, каждый встречал в своей жизни задачу, которая звучала примерно так:

Одно из решений может быть таким:

In[1]:=

(5 - 4 -3+ 2) * 1

Out[1]=

Решение задачи о расстановке скобок и знаков арифметических операций в выражении

Сразу встает вопрос: а единственное ли решение у данной задачи?

Ответу на этот вопрос и рассмотрению подобного типа задач как раз посвещен этот пост.

Упрощенная задача: последовательное применение операций

Рассмотрим более простую задачу:

В Mathematica каждой арифметической операции соответствует встроенная функция:

Plus — сложение,

In[2]:=

{Plus[], Plus[a], Plus[a, b], Plus[a, b, c]}

Out[2]=

Subtract — вычитание,

In[3]:=

Subtract[a, b]

Out[3]=

Times — умножение,

In[4]:=

{Times[], Times[a], Times[a, b], Times[a, b, c]}

Out[4]=

Divide — деление.

In[5]:=

Divide[a, b]

Out[5]=

Простейший подход может состоять из пары шагов:

получить все возможные наборы из 4-х операций по n-1, где n — количество элементов между которыми нужно расставить знаки операций, это можно сделать с помощью функции Tuples, например при n=2 получим:

In[6]:=

Tuples[{Plus, Subtract, Times, Divide}, 2]

Out[6]=

для каждого полученного набора расставить знаки операций между элементами набора, это можно сделать с помощью функции Fold.

In[7]:=

Fold[f, x, {a, b, c, d}]

Out[7]=

Скажем, пусть у нас есть набор элементов {a, b, c, d, e} и список операций {Times, Plus, Subtract, Plus}, получить желаемую конструкцию из них можно так:

In[8]:=

objects={a, b, c, d, e};

operations={Times, Plus, Subtract, Plus};

Fold[(#2[[1]][#1, #2[[2]]])&, objects[[1]], Transpose[{operations, Rest[objects]}]]

Out[10]=

По сути, все решение задачи заключается в конструкции, которая только что была приведена выше. Теперь, сделаем функцию, которая будет из списка объектов и операций выдавать на выходе все возможные выражения рассматриваемого типа.

Функция possibleExpressions имеет несколько опций:

опция Operations позволяет задать список произвольных операций, которые могут быть расставлены между объектами, по умолчанию эта опция, ясно, имеет значение {Plus, Subtract, Times, Divide}.
опция Colored позволяет раскрасить объекты, это может понадобиться в том случае, если они все одинаковы, по умолчанию объекты не раскрашиваются, т. е. опция имеет значение False.

In[11]:=

possibleExpressions[objects_List, 
OptionsPattern[
{Operations->{Plus, Subtract, Times, Divide}, 
Colored->False}]]:=Module[
{operationsFake, length, sequenceOfOperations, sequenceOfOperationsFake, objectsTemp, objectsRules, objectsFakeRules, expressions, operationsRules, result, index}, 

operationsFake=Symbol/@ToLowerCase/@ToString/@OptionValue[Operations];

length=Length[objects]-1;

sequenceOfOperations=Tuples[OptionValue[Operations], {length}];

sequenceOfOperationsFake=Tuples[operationsFake, {length}];

objectsTemp=Table[Unique[x], {length+1}];

objectsRules=Thread[objectsTemp->objects];

index=1;

objectsFakeRules=Thread[objectsTemp->(If[OptionValue[Colored], Style[ToString[#], ColorData[1, "ColorList"][[index++]], Bold], ToString[#]]&/@objects)];

operationsRules=Thread[operationsFake->OptionValue[Operations]];

expressions=Fold[(#2[[1]][#1, #2[[2]]])&, objectsTemp[[1]], Transpose[{#, Rest[objectsTemp]}]]&/@sequenceOfOperationsFake;

ClearAttributes[#, Orderless]&/@OptionValue[Operations];

result=Transpose[{expressions/.operationsRules/.objectsRules, HoldForm/@Evaluate[expressions/.operationsRules/.objectsFakeRules], expressions/.objectsRules}];

SetAttributes[#, Orderless]&/@OptionValue[Operations];

result]

Проиллюстрируем работу программы на списке {5, 4, 3, 2, 1}, как видно из результата её работы, показанного ниже, для каждой последовательности операций генерируется список из трех объектов:

1) полученный в результате проведения вычислений над выражением с расставленными операциями результат;

2) выражение с расставленными операциями между элементами;

3) выражение с расставленными операциями в полной форме.

Результат вычислений (в укороченной форме):

In[12]:=

Short[result[1]=possibleExpressions[{5, 4, 3, 2, 1}, Colored->True], 15]

Out[12]//Short=

Мы видим, что из списка {5, 4, 3, 2, 1} можно получить с помощью простой расстановки знаков арифметических операций следующие числа:

In[13]:=

results[1]=Union[result[1][[;;, 1]]]
ListPlot[results[1], ImageSize->500]

Out[13]=

Out[14]=

Среди них есть также и интересующее нас число 0. Мы можем выбрать все те результаты, которые его дают, среди них мы увидим уже знакомое нам решение, которое было приведено выше:

In[15]:=

Grid[Cases[result[1], {0, expr_, fullExpr_}:>{expr, fullExpr}], Frame->All]

Out[15]=

Продвинемся дальше — возьмем произвольные перестановки рассматриваемого списка элементов, таким образом мы получим решение следующей задачи:

С помощью построенной ранее функции possibleExpressions построим новую функцию possibleExpressionsWithPermutations:

In[16]:=

possibleExpressionsWithPermutations[objects_List, OptionsPattern[
{Operations->{Plus, Subtract, Times, Divide}, 
Colored->False}]]Bold:=BoldBlock[{allPossibleLists=Permutations[objects]}, DeleteDuplicates[Flatten[possibleExpressions[#, 
Operations->OptionValue[Operations], 
Colored->OptionValue[Colored]]&/@allPossibleLists, 1]]]

Посмотрим, какие числа мы можем получить из рассматриваемого списка таким путем:

In[17]:=

ShortBold[Boldresult[2]Bold=BoldpossibleExpressionsWithPermutationsBold[Bold{5, 4, 3, 2, 1}Bold, BoldColoredBold->BoldTrue]Bold, Bold15Bold]Bold

Out[17]//Short=

In[18]:=

results[2]=Union[result[2][[;;, 1]]]
ListPlot[results[2], ImageSize->500, PlotRange->All]

Out[18]=

Out[19]=

Как видим, количество возможных вариантов выросло почти в 7 раз:

In[20]:=

{Length[results[1]], Length[results[2]], N@Length[results[2]]/Length[results[1]]}

Out[20]=

А вместе с ним и количество возможных вариантов получения числа 0 резко возросло, уже до 812:

In[21]:=

possibleZero=Cases[result[2], {0, expr_, fullExpr_}:>{expr, fullExpr}];

Manipulate[Style[Row[{possibleZero[[i, fullForm]], "=0"}], 25], {{i, 1, "Номер представления:"}, 1, Length[possibleZero], 1, Appearance->"Labeled"}, 
{{fullForm, 1, "Полная форма:"}, {1, 2}, Checkbox}, SaveDefinitions->True, ContentSize->{500, 120}]

Out[22]=

Расстановка скобок между элементами всеми возможными способами

Теперь решим не очень тривиальную задачу, которая заключается в том, чтобы расставить скобки между элементами набора всеми возможными способами.

In[23]:=

SetAttributes[transformer, HoldFirst];

In[24]:=

transformer[PS[list___Integer]]:=Which[
Length[{list}]==0, 
{{}}, 
Length[{list}]<=2, 
{P[list]}, 
True, 
DeleteDuplicates[Flatten[({list}/.{x___, Sequence@@#, y___}:>P[PS[x], PS[Sequence@@#], PS[y]])&/@#&/@Table[Partition[{list}, n, 1], {n, 1, Length[{list}]-1}]]]]

In[25]:=

PS[]:=Sequence[];

In[26]:=

PS[x___Integer]:=If[Length[{x}]<=2, P[x], transformer[PS[x]]]

In[27]:=

P[x___, {y___}, z___]:=P[x, #, z]&/@{y}

In[28]:=

P[P[x_]]:=P[x];

In[29]:=

allPossibleParentheses[objects_List]:=Module[{transforamtionRules, n}, 
n=Length[objects];

transforamtionRules=Thread[Range[n]->objects];

DeleteDuplicates[{P@@objects}~Join~(ToExpression["transformer[PS["~~ToString[Row[ToString/@Range[n], ", "]]~~"]]"]/.transforamtionRules)]]

Решение можно посмотреть с помощью манипулятора:

In[30]:=

Manipulate[Grid[Transpose[{Range[Length[#]], #}&@(allPossibleParentheses[Range[n]]//.P[x___]:>f[x])], Alignment->{Left, Center}], {{n, 4, "Кол-во базовых элементов:"}, 1, 6, 1, Setter}, 
{{f, Framed[Row[{##}, "▫"]]&, "Формы отображения:"}, {Framed[Row[{##}, "▫"]]&->Framed["..."], Row[{"(", Row[{##}, "▫"], ")"}]&->"(...)", 
P[##]&->"P[...]"}}, ContentSize->{600, 400}, SaveDefinitions->True]

Out[30]=

Решение задачи в самой общей формулировке

После того, как была создана процедура расставляющая скобки между элементами выражения всеми возможными способами, можно перейти к решению нашей задачи в наиболее общей формулировке:

Решим её несколько необычным способом: воспользуемся функцией преобразования выражения с образом скобок (оператором P), которая была создана для манипулятора выше, а именно, функцией:

In[31]:=

Row[{"(", Row[{##}, "▫"], ")"}]&;

После этого символ ▫ будем заменять на один из символов арифметических операций всеми возможными способами, получим функцию:

In[32]:=

PReplacement[expr_]:=Block[{expression, positions}, 
expression=expr//.P[x___]:>If[Length[{x}]==1, Row[{x}], Row[{"(", Row[{x}, "▫"], ")"}]];

positions=Position[expression, "▫"];

ToString[ReplacePart[expression, Thread[positions->#]]]&/@Tuples[{"+", "-", "*", "/"}, Length[positions]]]

На ёё основе легко сконструировать функцию для решения нашей задачи:

In[33]:=

possibleExpressionsWithParentheses[list_List]:=Block[{result=Flatten[PReplacement/@allPossibleParentheses[list]]}, Transpose[{Quiet@ToExpression[result], result}]]

Легко показать, что результат, выдаваемый функцией possibleExpressions является подмножеством множества результатов, выдаваемых функцией possibleExpressionsWithParentheses:

In[34]:=

Complement[possibleExpressions[{a}][[;;, 1]], possibleExpressionsWithParentheses[{a}][[;;, 1]]]

Out[34]=

In[35]:=

Complement[possibleExpressions[{a, b}][[;;, 1]], possibleExpressionsWithParentheses[{a, b}][[;;, 1]]]

Out[35]=

In[36]:=

Complement[possibleExpressions[{a, b, c, d, e}][[;;, 1]], possibleExpressionsWithParentheses[{a, b, c, d, e}][[;;, 1]]]

Out[36]=

С помощью функции possibleExpressionsWithParentheses найдем все решения поставленной нами задачи, как видно их существует 94:

In[37]:=

{Length[#], #}&@Cases[possibleExpressionsWithParentheses[{5, 4, 3, 2, 1}], {0, expr_}:>expr]

Out[37]=

Создадим аналог функции possibleExpressionsWithParentheses:

In[38]:=

possibleExpressionsWithParenthesesWithPermutations[list_List]:=Block[{allPossibleLists=Permutations[list]}, DeleteDuplicates[Flatten[possibleExpressionsWithParentheses[#]&/@allPossibleLists, 1]]]

Как видно, даже для случая списка из 4 элементов, количество возможностей составляет 9696:

In[39]:=

Length@possibleExpressionsWithParenthesesWithPermutations[{1, 2, 3, 4}]

Out[39]=

Что касается решения нашей задачи, то их уже не 812, как было, а 11046, при этом количество возможных комбинаций составляет 597600:

In[40]:=

allPossibleZero=Cases[possibleExpressionsWithParenthesesWithPermutations[{1, 2, 3, 4, 5}], {0, expr_}:>expr];

Manipulate[Style[Row[{allPossibleZero[[i]], "=0"}], 25], {{i, 1, "Номер представления:"}, 1, Length[allPossibleZero], 1, Appearance->"Labeled"}, SaveDefinitions->True, ContentSize->{500, 80}]

Out[41]=

Где можно применить полученный результат?

Один из примеров применения полученных решений, может служить, скажем, создание интересных задач, например, по тригонометрии:

In[42]:=

TableForm[If[ByteCount[#]>2ByteCount[fs=FullSimplify[#]], Row[{#, "=", fs}], Unevaluated[Sequence[]]]&/@DeleteDuplicates[possibleExpressionsWithParentheses[{1, "Cos[x]", "Sin[x]", "Cos[2x]", "Sin[2x]"}][[;;, 1]]]]

Out[42]//TableForm=

Или же отображение всех дробно-рациональных функций, которые могут быть получены из данных полиномов 1, x и \(x^2\):

In[43]:=

functions=DeleteDuplicates[possibleExpressionsWithParenthesesWithPermutations[{1, "x", "x^2"}][[;;, 1]]]
Plot[functions, {x, -2, 2}, PlotStyle->Thick, ImageSize->600, AspectRatio->Automatic, PlotRange->{-2, 2}]

Out[43]=

Out[44]=

Вполне можно придумать еще массу приложений, скажем в теории вероятностей.

Возможное продолжение темы: задачи для читателя

Дана последовательность цифр, скажем, 1144152. Требуется узнать, можно ли расставить между цифрами знаки скобок и арифметических операций так, чтобы получилось некоторое число.
Примеры:
11+44/152; 1-(1+4*4)/(1+5-2) и т. д.
Решение задачи в различных системах счисления.
Использование других операторов, помимо рассмотренных.