Отправляет email-рассылки с помощью сервиса Sendsay

Олимпиадные задачи с решениями на Turbo Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.825 RSS
←   Июль 2003   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Открыта: 02-12-2001

Автор
Aslof

Статистика

3.825 подписчиков
0 за неделю
←   Все выпуски   →

Олимпиадные задачи с решениями на Turbo Pascal


Информационный Канал Subscribe.Ru
Здравствуйте, уважаемые подписчики. Долго был занят, поэтому задержался с выпуском. Я и сейчас занят (с завтрашнего дня :-), точнее, уже с сегодняшнего) моим новым проектом, но, забив на всё остальное, готовлю выпуск.


В прошлом выпуске поступил очень опрометчиво - дал текст задачи, даже не подумав над ней, не то что решив. В результате, как правильно заметили некоторые читатели, на олимпиадную она не потянула - слишком расплывчаты условия и ошибка в описании (девятка вместо "e"). Если кого это отпугнуло от решения, уточню заново условие.

Вводится строка типа
a?b?c?f?e=zz
где
a,b,c,....,z = числа типа byte, количество не превышает 20
zz = контрольный результат, умещается в типе Longint (как и все промежуточные результаты).

Требуется определить, что из множества (+,*,-,div) требуется подставить вместо знака ?, чтобы получить верный пример. (Именно верный, с учётом приоритета операций). Вывести все возможные варианты.

пример
3?2?1=6

вывод
3+2+1=6
3*2*1=6
3*2 div 1=6

Полагаю, многим было бы интересно авторское решение, но боясь, как бы меня не обвинили в плагиате :-), приводить его не буду. Типичный перебор, ничего больше (желающие уже могут начинать кидать камни). Приведу лучше решение Dmitry Akulov. Первое - это приведённое мной к виду, который можно скомпилировать в BP 7.0 (в оригинале комментариев тоже не было, с целью уменьшения размеров :-) ), второе - это с оригинальными комментариями автора решения (он прислал 2 варианта, с комментариями и без), но не приведённое (оригинал - Delphi).

Да большая просьба - пишите то, что можно скомпилировать в BP 7.0. Да, я могу преобразовать дельфийский код, дописать несуществующие в BP функции и пр., но всё же. Если хотите, можно изменить направленность рассылки. Перейти в среду Delphi. Или сменить язык на с++ или даже asm. Просьба написать все свои соображения по этому поводу. Кстати, судя по количеству присланных решений (чуть ли не на порядок меньше, чем на прошлую задачу), сложность этой - именно то, что нужно. Сложнее видимо не стоит предлагать. Да, на следующий раз пока не предлагаю задачу - решу сначала сам, потом вышлю отдельным выпуском.

И последнее. 2 просьбы - не надо мне присылать скомпилированные решения - скомпилировать я и сам могу и не надо в целях уменьшения размера убивать в решении оформление - оно, конечно, короткое, но читать намного труднее. 

const
     OP_ADD = 1;
     OP_SUB = 2;
     OP_MUL = 3;
     OP_DIV = 4;
     opchars:array[1..4] of string =
                    (' + ',' - ',' * ',' div ');

type
    intarray = array[1..128] of integer;

var
   nums,ops:intarray;
   res,nc,oc:integer;
   s:string;

procedure init;
var i:integer;
    t:string;
    cod:integer;
begin
     t:=''; nc:=1; oc:=1;

     for i:=1 to length(s) do
     begin
          if (s[i]='?') or (s[i]='=') then
          begin
               val(t,nums[nc],cod);
               Inc(nc);
               Inc(oc);
               t:='';
          end else t:=t+s[i];
     end;

     val(t,res,cod);
     Dec(nc);
     Dec(oc,2);
end;

function calc:integer;
var i,sum:integer;
    oldnums,oldops:intarray;
begin
     oldnums:=nums;
     oldops:=ops;

     for i:=1 to oc do
     begin
          if ops[i]=OP_SUB then
          begin
               ops[i]:=OP_ADD;
               nums[i+1]:=-nums[i+1];
          end;

          if ops[i]>OP_SUB then
          begin
               if ops[i]=OP_MUL then
                  nums[i+1]:=nums[i]*nums[i+1] else
                  nums[i+1]:=nums[i] div nums[i+1];

               ops[i]:=OP_ADD;
               nums[i]:=0;
          end;
     end;

     sum:=0;
     for i:=1 to nc do Inc(sum,nums[i]);

     nums:=oldnums;
     ops:=oldops;

     calc:=sum;
end;

procedure next(k:integer);
var i,r:integer;
begin
     if k>oc then
     begin
          r:=calc;

          if r=res then
          begin
               for i:=1 to oc do
                   write(nums[i],opchars[ops[i]]);
               writeln(nums[nc],' = ',r);
          end;

     end else
     begin
          for i:=OP_ADD to OP_DIV do
          begin
               ops[k]:=i;
               next(k+1);
          end;
     end;
end;

begin
  write('s = '); readln(s);
  init;
  next(1);
  writeln('end');
  readln;
end.





с комментариями:




const
     OP_ADD = 1; // +
     OP_SUB = 2; // -
     OP_MUL = 3; // *
     OP_DIV = 4; // div

     opchars:array[1..4] of string = (' + ',' - ',' * ',' div ');

type
    intarray = array[1..128] of integer;

var
   numbers,operations:intarray;
   res,numcount,opcount,varcount:integer;
   s:string;

procedure PrepareString;
var i:integer;
    t:string;
begin
     t:=''; numcount:=1; opcount:=1;

     for i:=1 to length(s) do
     begin
          if (s[i]='?') or (s[i]='=') then // если встретили ? или =
                                           // то начинается новое число
          begin
               numbers[numcount]:=StrToInt(t);
                // записываем старое число в массив

               Inc(numcount);
               Inc(opcount);
               t:='';
          end else t:=t+s[i]; //
     end;

     res:=StrToInt(t); //то что осталось после = - это то что должно
получится
     Dec(numcount);
     Dec(opcount,2);
end;

function CalcString:integer;
var i,sum:integer;
    oldnumbers,oldoperations:intarray;
begin
{
     Вычисление значения строки с учетом порядка действий

     Основная идея в том, чтобы преобразовать последовательность  любых
     действий в последовательность только сложений, такое можно достичь
     следующим образом: a+b*c = a+0+b*c

     Например, 2+3*4 = 2+0+(3*4) = 2+0+12 = 14
     Т.е. часть выражения 3*4 мы преобразовали в сумму 0+12
}

     oldnumbers:=numbers;       // сохранение старых данных нужно, т.к.
     oldoperations:=operations; // числа и действия могут измениться

     for i:=1 to opcount do
     begin
          if operations[i]=OP_SUB then // преобразование вычитания в
сложение
                                       // a-b = a+(-b)
          begin
               operations[i]:=OP_ADD;
               numbers[i+1]:=-numbers[i+1];
          end;

          if operations[i]>OP_SUB then  // если встретили умножение или
деление
          begin
               if operations[i]=OP_MUL then
                  numbers[i+1]:=numbers[i]*numbers[i+1] else
                  numbers[i+1]:=numbers[i] div numbers[i+1];

                  // то преобразовываем в сложение

               operations[i]:=OP_ADD;
               numbers[i]:=0;
          end;
     end;

     // подсчет суммы полученной последовательности чисел
     sum:=0;
     for i:=1 to numcount do Inc(sum,numbers[i]);

     numbers:=oldnumbers;       // восстановление исходных данных
     operations:=oldoperations;

     CalcString:=sum;
end;

procedure ChooseNextOp(k:integer);
var i,r:integer;
begin
     if k>opcount then
     begin
          // если выбрали все действия, то подсчитываем результат
          // и сравниваем с нужным
          r:=CalcString;

          if r=res then
          begin
               Inc(varcount);
               // распечатка полученной цепочки действий
               write('Variant ',varcount,':     ');
               for i:=1 to opcount do
                   write(numbers[i],opchars[operations[i]]);
               writeln(numbers[numcount],' = ',r);
          end;

     end else
     begin
          // выбираем дейсвие
          for i:=OP_ADD to OP_DIV do
          begin
               operations[k]:=i;
               ChooseNextOp(k+1); // и переходим к выбору след. действия
          end;
     end;
end;

begin
  write('Enter mask: '); readln(s); writeln;
  PrepareString; // подготовка данных

  varcount:=0;
  ChooseNextOp(1); // выбираем действия

  // распечатка количества вариантов
  if varcount>0 then
                begin
                     writeln;
                     writeln('Total: ',varcount,' variants');
                     // Всего N вариантов
                end
                else writeln('No variants found');
                // Варианты не найдены

  writeln;
  writeln('Press ENTER to exit...');
  readln;
end.
"Final Fantasy. The Spirits Within" - рассылка "Ищешь фильм?"
http://subscribe.ru/catalog/rest.cinema.filmforyou
Aslof aslof@mail.ru
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное