Записать выражение. Опции

[reill]

Записать выражение :
1 операция 2 операция 3 операция 4 операция 5 операция 6 операция 7 операция 8 операция 9 операция =100, т.е. цифры, от 1 до 9 соединить арифметическими операциями +,-,*,/ так, чтобы результат получился равным 100.Есть восемь вариантов такой записи, например, 1*2+3*4*5-6+7+8-9=100.

[___ALex___]

а вот и сам код:

Код

program ForForum;
{$APPTYPE CONSOLE}
uses
SysUtils;

procedure WriteAllCombinations;
const
IndStr = '+-*/';
var
a, b, c, d, e, f, g, h: Byte;
S: String;

function Calc(S: String): Real;
var
i: Byte;
Res, PromRes: Real;
F, Fl: Boolean;
begin

Res := 0;
i := 1;
repeat
 F := False;
 Fl := False;
 while S[i] in ['*', '/'] do begin
  Fl := True;
  case S[i] of
   '*': if not F then begin
         PromRes := (Sqr(i) + i);
         if i > 1 then begin
          if S[i - 1] = '-' then PromRes := -1 * PromRes;
          S[i - 1] := ' ';
         end;
        end else PromRes := PromRes * (i + 1);
   '/': if not F then begin
         PromRes := i / (i + 1);
         if i > 1 then begin
          if S[i - 1] = '-' then PromRes := -1 * PromRes;
          S[i - 1] := ' ';
         end;
       end else PromRes := PromRes / (i + 1);
  end;
  Inc(i);
  F := True;
 end;
 Inc(i);
 if Fl then Res := Res + PromRes;
until i > 8;

for i := 1 to 8 do
case S[i] of
 '+': if i = 1 then begin
       Res := Res + 3;
      end else begin Res := Res + i + 1; end;
 '-': if i = 1 then begin
       Res := Res - 1;
      end else Res := Res - i - 1;
end;

if S[1] = ' ' then Result := Res + 1 else Result := Res

end;

begin

S := '12345678';
for a := 1 to 4 do begin
S[1] := IndStr[a];
for b := 1 to 4 do begin
S[2] := IndStr[b];
for c := 1 to 4 do begin
S[3] := IndStr[c];
for d := 1 to 4 do begin
S[4] := IndStr[d];
for e := 1 to 4 do begin
S[5] := IndStr[e];
for f := 1 to 4 do begin
S[6] := IndStr[f];
for g := 1 to 4 do begin
S[7] := IndStr[g];
for h := 1 to 4 do begin
S[8] := IndStr[h];
if Calc(S) = 100 then WriteLn(S);
end; end; end; end; end; end; end; end;

end;

begin

WriteAllCombinations;
WriteLn('With the best regards...');
ReadLn

end.

будут вопросы спрашивай(

Сообщение отредактировано: volvo - 17.12.2004 11:51