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

Статьи

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

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

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]=
Решение задачи о расстановке скобок и знаков арифметических операций в выражении
In[3]:=
Subtract[a, b]
Out[3]=
Решение задачи о расстановке скобок и знаков арифметических операций в выражении
  • Times — умножение,
In[4]:=
{Times[], Times[a], Times[a, b], Times[a, b, c]}
Out[4]=
Решение задачи о расстановке скобок и знаков арифметических операций в выражении
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) и т. д.
  • Решение задачи в различных системах счисления.
  • Использование других операторов, помимо рассмотренных.

Оценить статью
Блог о Wolfram Mathematica

Оставить комментарий

avatar
  Подписаться  
Уведомление о