Вот набросок:
| Код |
program PermutationsProblem;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes,
Types, StrUtils,
ActiveX, ComObj, Variants;
type
TProblem = class
private
FCalculator: Variant;
FNumber: TStrings;
FOperator: TStrings;
procedure Permutation(const Value: String; Depth: Integer; Repetition: Boolean; List: TStrings);
procedure Generate(const Numbers, Operators: String);
procedure Search(Condition: Integer; FindAll: Boolean; Results: TStrings);
procedure Print(List: TStrings);
public
constructor Create;
destructor Destroy; override;
procedure Solve(const Numbers, Operators: String; Condition: Integer; FindAll: Boolean);
end;
constructor TProblem.Create;
begin
CoInitialize(nil);
FCalculator := CreateOleObject('MSScriptControl.ScriptControl');
FCalculator.Language := 'JScript';
FNumber := TStringList.Create;
FOperator := TStringList.Create;
end;
destructor TProblem.Destroy;
begin
FOperator.Free;
FNumber.Free;
FCalculator := Unassigned;
CoUnInitialize;
end;
procedure TProblem.Permutation;
procedure Permutation(const Value, Prefix: String; Depth: Integer);
var
I: Integer;
begin
if Depth = 0 then
List.Add(Prefix)
else
for I := 1 to Length(Value) do
if Repetition then
Permutation(Value, Prefix + Value[I], Depth - 1)
else
Permutation(LeftStr(Value, I - 1) + RightStr(Value, Length(Value) - I),
Prefix + Value[I], Depth - 1);
end;
begin
List.Clear;
Permutation(Value, '', Depth);
end;
procedure TProblem.Generate;
begin
Permutation(Numbers, Length(Numbers), False, FNumber);
Permutation(Operators, Length(Numbers) - 1, True, FOperator);
end;
procedure TProblem.Search;
function Combine(const Numbers, Operators: String): String;
var
I: Integer;
begin
SetLength(Result, Length(Numbers) + Length(Operators));
for I := 1 to Length(Result) do
if Odd(I) then
Result[I] := Numbers[I div 2 + 1]
else
Result[I] := Operators[I div 2];
end;
var
I, J: Integer;
Value: Single;
begin
for I := 0 to FNumber.Count - 1 do
for J := 0 to FOperator.Count - 1 do
if TryStrToFloat(FCalculator.Eval(Combine(FNumber[I], FOperator[J])), Value)
and (Value = Condition) then
begin
Results.Add(Combine(FNumber[I], FOperator[J]) + '=' + IntToStr(Condition));
if not FindAll then
Exit;
end;
end;
procedure TProblem.Print;
var
I: Integer;
begin
WriteLn('Results: ');
for I := 0 to List.Count - 1 do
WriteLn(List[I]);
WriteLn;
end;
procedure TProblem.Solve;
var
ResultList: TStrings;
begin
ResultList := TStringList.Create;
try
Generate(Numbers, Operators);
Search(Condition, FindAll, ResultList);
Print(ResultList);
finally
ResultList.Free;
end;
end;
var
Problem: TProblem;
begin
Problem := TProblem.Create;
try
// Показать первый найденный ответ
Problem.Solve('324681', '+-/*', 100, False);
// Показать все возможные
Problem.Solve('099154', '+-/*', 100, True);
finally
Problem.Free;
end;
ReadLn;
end.
|
Решение "в лоб" без оптимизаций и прочего. |
