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

[reill]

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

[reill]

Ну чего не у кого идей нет???

[___ALex___]

не решил ещё?
с чего ты взял что 8 вариантов решения?

[GLuk]

см. сабж "Генерация 9-значных чисел" примерно та же телега...

[trminator]

может, brute-force'ом? То бишь, взять эти числа и переставлять му ними операторы пока не получим 100. Только как долго это будет работать и какую ты за это получишь оценку  :-[ А к какому дню надо сделать?

[___ALex___]

есть решение
вот оно:
+++++++*
++-*+*+*
+-*+*++*
+-*-+*+*
+*+++++*
+*-*+*+*
+**+++*+
+**++-+*
-+**+*+-
-+**-+*-
**+++++*
**-*+*+*
***+++*+

13 комбинаций

[___ALex___]

сори
вот эти 15 комбинаций

+++++++*
++-*+*+*
+-*+*++*
+-*-+*+*
+*+*-++*
+***/++*
-+**+*+-
-+**-+*-
-*+*+++*
-*-+*++*
-*--+*+*
**+++++*
**-*+*+*
***+++*+
***++-+*

[___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 15:51

[reill]

2___ALex___ на счет вариантов не знаю так в задании было написанно...
Спасибко сейчас будем тестить...
2GLuk Да задания похожие... Вариант с подобным перебором я написал , но мне сказали надо что-то новенькое придумать....

[___ALex___]

как потестишь напишешь как ОНО

[___ALex___]

если интересно
средняя скорость данного алгоритма 81 миллисекунда
достаточно приемлемо на мой взгляд
придирок со стороны препода не должно быть
измерения проводил на 3-ем пне(800 MHz)

[AlaRic]

to All: просьба большие тексты помещать в код!

[Slam]

to All: просьба большие тексты помещать в код!

Странное совпадение - 5 минут назад я хотел тоже самое написать, а потом подумал, кто меня послушает...

[reill]

Потестил...
Уж твою среднюю скорость не удалос заценить так как нету у меня твоего модуля системутилс(((SysUtils)
Уж поделись....

[___ALex___]

она в Delphi писалась
завтра переделаю сегодня уже время поджимает
там совсем немного надо исправить

[___ALex___]

вот держи
как потестишь напишешь...

Код

program ForForum;
uses Crt;

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

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 Res := Res + 3 else Res := Res + i + 1;
 '-': if i = 1 then Res := Res - 1 else Res := Res - i - 1;
end;

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

end;

begin

S[0] := #8;
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

ClrScr;
WriteAllCombinations;
WriteLn('With the best regards...');
repeat until KeyPressed

end.

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

[Slam]

Блин, ___ALex___:

просьба большие тексты помещать в код!

[___ALex___]

to Slam
каким образом?

[reill]

А какой алгоритм проги??? Что в большом цикле происходит??? Ты пользуешься своей какой-то ормулой??? Напиши все сои рассчеты и алгоритм, желательно до завтра...

[AlaRic]

to Slam
каким образом?

Посмотри на кнопки во втором ряду при ответе!