Думаю, каждый встречал в своей жизни задачу, которая звучала примерно так:
Одно из решений может быть таким:
(5 - 4 -3+ 2) * 1
Сразу встает вопрос: а единственное ли решение у данной задачи?
Ответу на этот вопрос и рассмотрению подобного типа задач как раз посвещен этот пост.
Упрощенная задача: последовательное применение операций
Рассмотрим более простую задачу:
В Mathematica каждой арифметической операции соответствует встроенная функция:
Plus— сложение,
{Plus[], Plus[a], Plus[a, b], Plus[a, b, c]}
Subtract— вычитание,
Subtract[a, b]
Times— умножение,
{Times[], Times[a], Times[a, b], Times[a, b, c]}
Divide— деление.
Divide[a, b]
Простейший подход может состоять из пары шагов:
- получить все возможные наборы из 4-х операций по n-1, где n — количество элементов между которыми нужно расставить знаки операций, это можно сделать с помощью функции
Tuples, например при n=2 получим:
Tuples[{Plus, Subtract, Times, Divide}, 2]
- для каждого полученного набора расставить знаки операций между элементами набора, это можно сделать с помощью функции
Fold.
Fold[f, x, {a, b, c, d}]
Скажем, пусть у нас есть набор элементов {a, b, c, d, e} и список операций {Times, Plus, Subtract, Plus}, получить желаемую конструкцию из них можно так:
objects={a, b, c, d, e};
operations={Times, Plus, Subtract, Plus};
Fold[(#2[[1]][#1, #2[[2]]])&, objects[[1]], Transpose[{operations, Rest[objects]}]]
По сути, все решение задачи заключается в конструкции, которая только что была приведена выше. Теперь, сделаем функцию, которая будет из списка объектов и операций выдавать на выходе все возможные выражения рассматриваемого типа.
Функция possibleExpressions имеет несколько опций:
- опция Operations позволяет задать список произвольных операций, которые могут быть расставлены между объектами, по умолчанию эта опция, ясно, имеет значение {Plus, Subtract, Times, Divide}.
- опция Colored позволяет раскрасить объекты, это может понадобиться в том случае, если они все одинаковы, по умолчанию объекты не раскрашиваются, т. е. опция имеет значение False.
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) выражение с расставленными операциями в полной форме.
Результат вычислений (в укороченной форме):
Short[result[1]=possibleExpressions[{5, 4, 3, 2, 1}, Colored->True], 15]
Мы видим, что из списка {5, 4, 3, 2, 1} можно получить с помощью простой расстановки знаков арифметических операций следующие числа:
results[1]=Union[result[1][[;;, 1]]]
ListPlot[results[1], ImageSize->500]
Среди них есть также и интересующее нас число 0. Мы можем выбрать все те результаты, которые его дают, среди них мы увидим уже знакомое нам решение, которое было приведено выше:
Grid[Cases[result[1], {0, expr_, fullExpr_}:>{expr, fullExpr}], Frame->All]
Продвинемся дальше — возьмем произвольные перестановки рассматриваемого списка элементов, таким образом мы получим решение следующей задачи:
С помощью построенной ранее функции possibleExpressions построим новую функцию possibleExpressionsWithPermutations:
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]]]Посмотрим, какие числа мы можем получить из рассматриваемого списка таким путем:
ShortBold[Boldresult[2]Bold=BoldpossibleExpressionsWithPermutationsBold[Bold{5, 4, 3, 2, 1}Bold, BoldColoredBold->BoldTrue]Bold, Bold15Bold]Bold
results[2]=Union[result[2][[;;, 1]]]
ListPlot[results[2], ImageSize->500, PlotRange->All]
Как видим, количество возможных вариантов выросло почти в 7 раз:
{Length[results[1]], Length[results[2]], N@Length[results[2]]/Length[results[1]]}
А вместе с ним и количество возможных вариантов получения числа 0 резко возросло, уже до 812:
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}]
Расстановка скобок между элементами всеми возможными способами
Теперь решим не очень тривиальную задачу, которая заключается в том, чтобы расставить скобки между элементами набора всеми возможными способами.
SetAttributes[transformer, HoldFirst];
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}]]]]PS[]:=Sequence[];
PS[x___Integer]:=If[Length[{x}]<=2, P[x], transformer[PS[x]]]P[x___, {y___}, z___]:=P[x, #, z]&/@{y}P[P[x_]]:=P[x];
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)]]Решение можно посмотреть с помощью манипулятора:
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]
Решение задачи в самой общей формулировке
После того, как была создана процедура расставляющая скобки между элементами выражения всеми возможными способами, можно перейти к решению нашей задачи в наиболее общей формулировке:
Решим её несколько необычным способом: воспользуемся функцией преобразования выражения с образом скобок (оператором P), которая была создана для манипулятора выше, а именно, функцией:
Row[{"(", Row[{##}, "▫"], ")"}]&;После этого символ ▫ будем заменять на один из символов арифметических операций всеми возможными способами, получим функцию:
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]]]На ёё основе легко сконструировать функцию для решения нашей задачи:
possibleExpressionsWithParentheses[list_List]:=Block[{result=Flatten[PReplacement/@allPossibleParentheses[list]]}, Transpose[{Quiet@ToExpression[result], result}]]Легко показать, что результат, выдаваемый функцией possibleExpressions является подмножеством множества результатов, выдаваемых функцией possibleExpressionsWithParentheses:
Complement[possibleExpressions[{a}][[;;, 1]], possibleExpressionsWithParentheses[{a}][[;;, 1]]]
Complement[possibleExpressions[{a, b}][[;;, 1]], possibleExpressionsWithParentheses[{a, b}][[;;, 1]]]Complement[possibleExpressions[{a, b, c, d, e}][[;;, 1]], possibleExpressionsWithParentheses[{a, b, c, d, e}][[;;, 1]]]С помощью функции possibleExpressionsWithParentheses найдем все решения поставленной нами задачи, как видно их существует 94:
{Length[#], #}&@Cases[possibleExpressionsWithParentheses[{5, 4, 3, 2, 1}], {0, expr_}:>expr]
Создадим аналог функции possibleExpressionsWithParentheses:
possibleExpressionsWithParenthesesWithPermutations[list_List]:=Block[{allPossibleLists=Permutations[list]}, DeleteDuplicates[Flatten[possibleExpressionsWithParentheses[#]&/@allPossibleLists, 1]]]Как видно, даже для случая списка из 4 элементов, количество возможностей составляет 9696:
Length@possibleExpressionsWithParenthesesWithPermutations[{1, 2, 3, 4}]
Что касается решения нашей задачи, то их уже не 812, как было, а 11046, при этом количество возможных комбинаций составляет 597600:
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}]
Где можно применить полученный результат?
Один из примеров применения полученных решений, может служить, скажем, создание интересных задач, например, по тригонометрии:
TableForm[If[ByteCount[#]>2ByteCount[fs=FullSimplify[#]], Row[{#, "=", fs}], Unevaluated[Sequence[]]]&/@DeleteDuplicates[possibleExpressionsWithParentheses[{1, "Cos[x]", "Sin[x]", "Cos[2x]", "Sin[2x]"}][[;;, 1]]]]
Или же отображение всех дробно-рациональных функций, которые могут быть получены из данных полиномов 1, x и \(x^2\):
functions=DeleteDuplicates[possibleExpressionsWithParenthesesWithPermutations[{1, "x", "x^2"}][[;;, 1]]]
Plot[functions, {x, -2, 2}, PlotStyle->Thick, ImageSize->600, AspectRatio->Automatic, PlotRange->{-2, 2}]
Вполне можно придумать еще массу приложений, скажем в теории вероятностей.
Возможное продолжение темы: задачи для читателя
- Дана последовательность цифр, скажем, 1144152. Требуется узнать, можно ли расставить между цифрами знаки скобок и арифметических операций так, чтобы получилось некоторое число.
Примеры:
11+44/152; 1-(1+4*4)/(1+5-2) и т. д. - Решение задачи в различных системах счисления.
- Использование других операторов, помимо рассмотренных.
Оставить комментарий