Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Записать выражение.

Автор: reill 16.04.2003 14:19

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

Автор: reill 19.04.2003 15:37

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

Автор: ___ALex___ 20.04.2003 20:46

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

Автор: GLuk 20.04.2003 20:50

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

Автор: trminator 20.04.2003 21:09

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

Автор: ___ALex___ 20.04.2003 23:12

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

13 комбинаций

Автор: ___ALex___ 20.04.2003 23:34

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

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

Автор: ___ALex___ 20.04.2003 23:55

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

Код
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.


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

Автор: reill 21.04.2003 14:48

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

Автор: ___ALex___ 21.04.2003 20:45

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

Автор: ___ALex___ 21.04.2003 21:17

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

Автор: AlaRic 21.04.2003 21:25

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

Автор: Slam 21.04.2003 21:47

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

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

Автор: reill 22.04.2003 0:27

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

Автор: ___ALex___ 22.04.2003 1:12

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

Автор: ___ALex___ 22.04.2003 15:59

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

Код
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.

Автор: Slam 22.04.2003 22:53

Блин, ___ALex___:

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

Автор: ___ALex___ 22.04.2003 23:15

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

Автор: reill 29.04.2003 17:53

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

Автор: AlaRic 29.04.2003 22:35

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

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

Автор: ___ALex___ 30.04.2003 0:40

to reill
Тебе ещё надо?
P.S. только щас увидел этот твой пост :-/

Автор: reill 30.04.2003 8:33

Да надо.... Я её решел в след раз здавать, когда разберусь.... Так что жду....

Автор: ___ALex___ 30.04.2003 19:54

to reill
Итак начнём!Много писать не хочется, но посмотрим как уж выйдет в конце.
Когда я увидел условие этой задачи я подумал что тут что-то с рекурсией замешано...
Но решил эту задачу итерационно. В рекурсии тут не вижу смысла - медленней будет так как
каждое промежуточное состояние(значение локальных переменных подпрограммы)
как известно сохраняется в стеке(при "погружении в глубь")
потом восстанавливается(при "всплытии")
Так ближе к делу:
сама идея решения естественна - обычный перебор.
Вот как это делается:
в основной проге - всё примитивно - там идёт перебор всех комбинаций
типа "++++++++", "+++++++-", "+++++++*", "+++++++/", "++++++-+", "++++++--" и тд
всего 65536 таких вариантов!
(из них только 15 будут равны сотне!)
(Это же 64K!Размер сегмента в реальном режиме работы проца...чистое совпадение)
вот идёт перебор и соответственно нужно иметь подпрограммку вычисляющую значение
таких комбинаций, то есть "+-*+-*/*" есть 1+2-3*4+5-6*7/8*9 = -17,5
это делает функция Calc, то есть Calc('+-*+-*/*') = -17,5
(Реализацию Calc не знаю даже как описывать...очень долго получится...возможно ты напишешь
свою реализацию такой подпрограммки - главно что общая идея решения уже должна быть ясна)
"if Calc(S) = 100 then WriteLn(S);"
и если значение комбинации равно сотне - выводим эту комбинацию на консоль
Вот в общем и всё!
P.S. Спрашивай если захочешь ещё что-нибудь узнать