Опpеделить объем невытекшей воды, если

a) Тело опускается полностью в воду, затем поднимается;

После подъема вода останется только во внутреннем углублении, над элементом А(2,2)=1.

Объем воды равен 1.

b) В позицию (i₀,j₀) выливается объем воды V.

Для реализации данного алгоритма нам понадобится структура данных "очередь". Очередь в программировании, как и очередь в магазине, имеет начало и конец. Если приходит новый элемент, то он становится в конец очереди, если необходимо взять элемент из очереди, то он берется из ее начала. Очередь будем представлять в виде массива. Пусть у нас есть индекс первого - BEG и последнего FIN элементов очереди (если очередь пуста, то BEG=FIN+1; сначала же BEG=1, FIN=0).

Очередь опишем так: var Queue=array[1..MaxQ] of element;

Тут MaxQ - максимальное число элементов в очереди, element какой-то тип данных. В задаче ниже в качестве element можно взять такой type element = record x: byte; y: byte; end; где element - это запись, состоящая из x-овой и y-овой координаты элемента матрицы A=array[0..M+1,0..N+1] of integer. Индексы матрицы принимают такое значение из-за того, что мы будем окаймлять матрицу нулевыми элементами (так будет проще проверять выливание за край фигуры).

С очередью можно проводить операции:

вставка в очередь InQueue,

удаление из очереди OutQueue.

end;

Находим максимальный элемент D в матрице A. Пока все элементы в матрице A не станут равны D, повторяем следующую последовательность действий:

а) Находим в матрице минимальный ненулевой элемент z (если их несколько, то берем любой из них), и заносим его в очередь (очередь сначала пустая). Если этот минимальный ненулевой элемент z=D, то СТОП.

Сначала считаем, что p=D - это минимальный граничный элемент области, заполненной элементами со значением z.

б) Для каждого еще не просмотренного элемента очереди (пусть в матрице этот элемент находится в позиции (i,j)) повторяем следующее:

Для каждого соседа (сверху, снизу, справа, слева) данного элемента (i,j) проводим проверку-просмотр:

ЕСЛИ (сосед <> z) ТО P=min{P,сосед} ИНАЧЕ ЕСЛИ сосед еще не просмотрен ТО координата соседа - в очередь (в очереди появился еще один непросмотренный элемент) т.е. мы ищем минимальный окаймляющий элемент области, заполненной элементами со значением z.

Фрагмент программы поиска:

end;

Если в очереди нет больше непросмотренных элементов, то, если p<z (случай, когда данная область имеет "слив" за границы матрицы) в матрице во все просмотренные элементы из очереди заносим значение D (делаем их равными накопленному значению, чтобы больше их не рассматривать).

Если же p>z, то высчитываем, сколько воды поместится в "бассейн" с глубиной дна z и с высотой ограждающего бордюра p:

Объем = (p-z)* количество просмотренных элементов в очереди.

Добавляем полученный объем к ранее найденному объему воды,заполняющему матрицу до высоты x. Заполняем в матрице элементы, соответствующие просмотренным элементам из очереди, значением p ("Доливаем" воды в "бассейн" до уровня p). Переход на пункт а).

Суммарный полученный объем воды и является искомым.

Окаймление матрицы, упомянутое выше, может выглядеть следующим образом: матрица [1..N, 1..M] окаймляется нулями так: вводятся дополнительные нулевые 0-ая и (N+1)-ая строки и 0-ой и (M+1)-ый столбцы

Задача №23

Ханойские башни

Есть три стержня A, B, и C. На стержень A надето N дисков, наверху самый маленький, каждый следующий диск больше предыдущего, а внизу самый большой. На другие стержни дисков не надето. Hеобходимо перенести диски со стержня A на стержень C, пользуясь стержнем B, как вспомогательным, так, чтобы диски на стержне C располагались в том же порядке, в каком они располагаются на диске A перед перемещением.

При перемещении никогда нельзя класть больший диск на меньший.

Рекурсивный метод

Для того, чтобы переложить всю пирамиду, надо сначала переложить все, что выше самого большого диска, с первого на вспомогательный стержень, потом переложить это самое большой диск с первого на третий стержень, а потом переложить оставшуюся пирамиду со второго на третий стержень, пользуясь первым стержнем, как вспомогательным.

/*

   данная процедура переносит N дисков со стержня A на стержень C

   пользуясь B как вспомогательным, соблюдая правила

*/

  процедура "Перенести" (A, B, C, N)

начало

   если N=1

   // Если диск всего один, то надо его перенести напрямую

   то

       снять диск со стержня A и положить на стержень C;

       возврат из процедуры;

   иначе

       // Переносим все диски, кроме самого большога со стежня

       // A на стержень B

       Перенести (A,C,B,N-1);

       // Переносим самый большой диск со стержня A на стержень C

       снять диск со стержня A и положить на стержень C;

       // Переносим все диски со стержня B на стержень C поверх

       // самого большого диска

       Перенести (B,A,C,N-1);

       возврат из процедуры;

   конец если;

конец процедуры "Перенести";

procedure Solve(n: integer; a,b,c: Char);

begin

 if n > 0 then

 begin

Solve(n-1, a, c, b);

Writeln('Переместить диск со стержня ', a, ' на стержень ',b);

Solve(n-1, c, b, a);

 end;

end;

begin

 Solve(4, '1','2','3');

end.

Нерекурсивный метод

Стержню, на котором диски находятся в начале, дадим номер 0; стержню, на который их надо перенести - номер 2; и, соответственно, оставшемуся стержню - номер 1. Пусть всего дисков N. Занумеруем диски в порядке увеличения радиуса числами 0,1,2,...,N-1. Как известно, задача решается за 2^N-1 ходов. Занумеруем ходы числами 1,2,...,2^N-1. Любое натуральное число i единственным образом представимо в виде i=(2t+1)*2^k, где t и k - целые (т.е. как произведение нечетного числа на некоторую степень двойки). Так вот, на i-ом ходе переносится диск номер k со стержня номер ((-1)^N-k*t mod 3) на стержень номер ((-1)^N-k*(t+1) mod 3).

Пример для N=4.

Ход k(диск) t Со_стержня Hа_стержень Стержни

                                     |)!'

 1 0 0 0       1  |)! '

 2    1 0 0       2  |) ' !

 3 0 1 1       2  |)  !'

 4 2 0 0       1  | ) !'

 5 0 2 2       0  |' ) !

 6 1 1 2       1  |' )!

 7 0 3 0       1  | )!'

 8 3 0 0       1       )!' |

 9 0 4 1       2       )! |'

10 1 2 1       0  ! ) |'

11 0 5 2       0  !' ) |

12 2 1 1       2  !'  |)

13 0 6 0       1  ! ' |)

14 1 3 0       2       ' |)!

15 0 7 1       2           |)!'

если пpедставить что стержни, на котоpые одеваются диски, pасположены в yглах pавностоpоннего тpеyгольника, то самый маленький диск каждым нечетным ходом движется по (или пpотив, это от пеpвоначального кол-ва дисков зависит) часовой стpелки.

Все четные ходы опpеделяются однозначно. Какой диск меньше - тот и перекладывать (иначе противоречит условию). Т.к. тpогать диск 0 нельзя и класть больший на меньший тоже нельзя.

Отметим две закономерности:

Hа каждом нечетном ходy происходит перенос наименьшего диска.

Hаименьший диск всегда переносится циклически: либо A-B-C-A-B-C-... (в слyчае четного количества дисков), либо A-C-B-A-C-B-... (в слyчае нечетного).

А посемy полyчаем алгоритм:

1. Определяем число дисков, откyда находим как бyдет перемещаться наименьший диск (данный шаг делается в начале, притом один раз).

2. Смотрим номер хода: если нечетный - переносим наименьший диск в направлении, определенном в п.1. если четный - то возможный ход один единственный - берем наименьший из двyх верхних дисков и переносим его.

Можно написать немного по другому:

Для N от 1 до 2^k-1 выполнять
1. В двоичном представлении N найти самый правый ненулевой разряд. Обозначим номер этого разряда t.

2. Обозначим номер стержня, на котором находится диск t через i. Переместить диск t со стержня i на стержень (i+(-1)^t) mod 3.

Кстати, по номеру хода легко можно восстановить положение дисков на стержнях: после i-ого хода диск номер j находится на стержне номер (-1)^n-j*((i div 2^j)-(i div 2^j+1)) mod 3.

Задача №24

Ребус. Написать программу, в которой требуется заменить буквы цифрами так, чтобы получилось верное равенство. Найти количество всех возможных вариантов решений и максимальное значение из них.

МУХА
+
МУХА
СЛОН

Формат выходного файла(Ребус.OUT):

4865
+
4865
9730

program muxa;
uses Crt;
var

i,a,b,c,d: integer;
m,s,max,kol: Integer;
f: text;
ss,as,bs,cs,ds: string;

label 1;
begin

ClrScr;
max := 0;
kol := 0;

for a:=1 to 4 do
begin

for b:=0 to 9 do
begin

for c:=0 to 9 do
begin

for d:=0 to 9 do
begin
if (a=b) or (a=c) or (a=d) or (b=c) or (b=d) or (c=d) then goto 1;
s:=2*(d+c*10+b*100+a*1000);
str(s,ss);
str(a,as);
str(b,bs);
str(c,cs);
str(d,ds);
if (ss[1]<>ss[2]) and (ss[1]<>ss[3]) and (ss[1]<>ss[4])
and (ss[2]<>ss[3]) and (ss[2]<>ss[4]) and(ss[3]<>ss[4])
then begin

for i:=1 to 4 do
begin
if (ss[i]=as) or (ss[i]=bs) or (ss[i]=cs) or
(ss[i]=ds) then goto 1;
end;
if s>max then begin max:=s; end;
kol:=kol+1;
end;

1:
end;

end;

end;

end;
m:=max div 2;
Assign(f,'Ребус.out');
Rewrite(f);
WriteLn(' ',m);
WriteLn('+');
WriteLn(' ',m);
WriteLn('-------');
WriteLn(' ',max);
Writeln('Общее количество решений: ',kol);
WriteLn(f,' ',m);
WriteLn(f,'+');
WriteLn(f,' ',m);
WriteLn(f,'-------');
WriteLn(f,' ',max);
Writeln(f,'Общее количество решений: ',kol);
Close(f);
readln;

end.

Сортировка

{ сортировка пузырьковым методом}

  procedure Bubble(var item: DataArray; count:integer);

  var

    i,j: integer;

    x: DataItem;

  begin

    for i := 2 to count do

       begin

      for j := count downto i do

        if item[j-1]>item[j] then

        begin

          x := item[j-1];

          item[j-1] := item[j];

          item[j] := x;

        end;

     end;

  end; {конец сортировки пузырьковым методом}

program SortDriver;

----------------------------------------------------------------------

{эта программа будет считывать 80 или меньше символов с

дискового файла "test.dat", отсортирует их и выдаст

pезультат на экран дисплея }

type

  DataItem = char;

  DataArray = array [1..80] of char;

var

  test: DataArray;

  t, t2: integer;

  testfile: file of char;

{ сортировка пузырьковым методом}

procedure Bubble(var item: DataArray; count:integer);

var

  i,j: integer;

  x: DataItem;

begin

  for i := 2 to count do

  begin

    for j := count downto i do

      if item[j-1]>item[j] then

      begin

        x := item[j-1];

        item[j-1] := item[j];

        item[j] := x;

      end;

  end;

end;

begin

  Assign(testfile, 'test.dat');

  Reset(testfile);

  t := 1;

{ считывание символов,которые будут сортироваться.}

while not Eof(testfile) do begin

    read(testfile, test[t]);

    t := t+1;

  end;

t := t-2; {скорректировать число считанных элементов }

Bubble(test, t); { сортировать массив }

{ выдать отсортированный массив символов }

for t2 := 1 to t do write(test[t2]);

WriteLn;

end.

---------------------------------------------------------------

{ челночная сортировка является улучшенной версией сортиров-

            ки пузырьковым методом }

  procedure Shaker(var item: DataArray; count:integer);

  var

    j, k, l, r: integer;

    x: DataItem;

  begin

    l := 2; r := count; k := count;

    repeat

      for j := r downto l do

        if item[j-1] then

        begin { обмен }

          x := item[j-1];

          item[j-1] := item[j];

          item[j] := x;

          k := j;

        end;

      l := k+1;

      for j := l to r do

        if item[j-1]>item[j] then

        begin { обмен }

          x := item[j-1];

          item[j-1] := item[j];

          item[j] := x;

          k := j;

        end;

      r := k-1;

    until l>r

  end; { конец челночной сортировки }

------------------------------------------------------------------

  { сортировка выбором }

  procedure Selekt(var item: DataArray; count:integer);

  var

    i, j, k: integer;

    x: DataItem;

  begin

    for i := i to count-1 do

    begin

      k := i;

      x := item[i];

      for j := i+1 to count do { найти элемент с наименьшим

                значением }

      if item[j]<x then

      begin

          k := j;

          x := item[j];

        end;

      item[k] := item[i]; { обмен }

      item[i] := x;

    end;

end; { конец сортировки выбором }

------------------------------------------------------------------

    { сортировка вставкой }

  procedure Inser(var item: DataArray; count:integer);

  var

    i, l: integer;

    x: DataItem;

  begin

    for i := 2 to count do

    begin

      x := item[i];

      j := i-1;

      while (x<item[j]) and (j>0) do

      begin

        item[j+1] := item[j];

        j := j-1;

      end;

      item[j+1] := x;

    end;

end; { конец сортировки вставкой }

-----------------------------------------------------------------

  { сортировка Шелла }

  procedure Shell(var item: DataArray; count:integer);

  const

    t = 5;

  var

    i, j, k, s, m: integer;

    h: array[1..t] of integer;

    x: DataItem;

  begin

     h[1]:=9; h[2]:=5; h[3]:=3; h[4]:=2; h[5]:=1;

    for m := 1 to t do

      begin

    k:=h[m];

    s:=-k;

    for i := k+1 to count do

    begin

      x := item[i];

      j := i-k;

      if s=0 then

      begin

        s := -k;

        s := s+1;

        item[s] := x;

      end;

      while (x<item[j]) and (j<count) do

        begin

          item[j+k] := item[j];

          j := j-k;

        end;

        item[j+k] := x;

      end;

    end;

end; { конец сортировки Шелла }

-----------------------------------------------------------------

{ быстрая сортировка }

procedure QuickSort(var item: DataArray; count:integer);

  procedure qs(l, r: integer; var it: DataArray);

    var

    i, j: integer;

    x, y: DataItem;

  begin

    i:=l; j:=r;

    x:=it[(l+r) div 2];

    repeat

      while it[i]<x do i := i+1;

      while x<it[j] do j := j-1;

        if y<=j then

      begin

        y := it[i];

        it[i] := it[j];

        it[j] := y;

        i := i+1; j := j-1;

      end;

    until i>j;

    if l<j then qs(l, j, it);

    if l<r then qs(i, r, it)

  end;

begin

  qs(1, count, item);

end; { конец быстрой сортировки }

-----------------------------------------------------------------

type

  DataItem = string[80];

  DataArray = array [1..80] of DataItem;

{ алгоритм быстрой сортировки для символьных строк }

procedure QsString(var item: DataArray; count:integer);

  procedure qs(l, r: integer; var it:DataArray);

    var

    i, l: integer;

    x, y: DataItem;

  begin

    i := l; j := r;

    x := it[(l+r) div 2];

    repeat

      while it[i] < x do i := i+1;

      while x < it[j] do j := j-1;

      if i<=j then

      begin

        y := it[i];

        it[i] := it[j];

        it[j] := y;

        i := i+1; j := j-1;

      end;

    until i>j;

    if l<j then qs(l, j, it);

    if l<r then qs(i, r, it);

  end;

begin

  qs(1, count, item);

end; { конец быстрой сортировки }

-----------------------------------------------------------------

  { быстрая сортировка записей с почтовым адресом }

  procedure QsRecord(var item: DataArray; count:integer);

    procedure qs(l, r:integer; var it:DataArray);

      var

        i, j: integer;

        x, y: DataItem;

      begin

        i := l; j := r;

        x := it[(l+r) div 2];

        repeat

          while it[i].name < x.name do i := i+1;

          while x.name < it[j].name do j := j-1;

        if i<=j then

        begin

          y := it[i];

          it[i] := it[j];

          it[j] := y;

          i := i+1; j := j-1;

        end;

      until i>j;

      if l<j then qs(l, j, it);

      if l<r then qs(i, r, it)

    end;

begin

     qs(1, count, item);

end; {конец быстрой сортировки записей}

-----------------------------------------------------------------

{ пример программы сортировки списка почтовых адресов }

      programm MlistSort;

      type

        address = record

          name: string[30];

          street: string[40];

          sity: string[20];

          state: string[2];

          zip: string[9];

        end;

        str80 = string[80];

        DataItem = addres;

        DataArray = array [1..80] of DataItem

        recfil = file of DataItem

        var

          test: DataItem;

          t, t2:integer;

          testfile: recfil;

                    { найти запись в файле }

      function Find(var fp:recfil; i:integer): str80

      var

        t:address;

      begin

        i := i-1;

        Seek(fp, i)

        Read(fp, t)

        Find := t.name;

      end;

      procedure QsRand(var var fp:recfil; count:integer)

        procedure Qs(l, r:integer)

          var

            i, j, s:integer ;

            x, y, z:DataItem;

            begin

              i := l; j := r;

              s := (l+r) div 2;

              Seek(fp,s-1); { получить запись }

              Reed(fp,x);

              repeat

                while Find(fp, i) < x.name do i := i+1;

                while x.name < Find(fp, j) do j := j-1;

                if i<=j then

                begin

                  Seek(fp,i-1); Reed(fp,y);

                  Seek(fp,j-1); Reed(fp,z);

                  Seek(fp,j-1); Write(fp,y);

                  Seek(fp,i-1); Write(fp,z);

                  i := i+1; j := j-1;

                end;

              until i>y;

              if l<j then qs(l, j)

              if l<r then qs(i, r)

        end;

      begin

        qs(1,count);

      end; {конец быстрой сортировки файла произвольного доступа}

      begin

        Assign(testfile, 'rectest.dat');

        Reset(testfile);

        t := 1;

        while not EOF(testfile) do begin

          Read(testfile,test); { подсчет числа записей в файле}

        t := t+1;

        end;

        t := t-1;

        QsRand(testfile,t)

      end.

-----------------------------------------------------------------

{ функция "Find" используется в сортировке методом

   слияния для считывания из файла конкретной записи.}

  function Find(var fp:filtype; i:integer):DataItem;

  var

    t:DataItem;

  begin

    Seek(fp, i-1);

    Read(fp, t);

    Find := t;

  end;

  procedure Mergesort(var fp: filetype; count:integer);

     var

       i, j, k, l, t, h, m, p, q, r: integer;

      ch1, ch2:DataItem

      up: Boolean;

    begin

      up := TRUE;

      p := 1;

      repeat

           h := 1; m := count;

        if up then

        begin

          i := 1; j := count; k := count+1; l := 2*count;

        end else

        begin

          k := 1; l := count; i := count+1; j := 2*count;

        end;

        repeat

          if m>=p then q := p else q := m;

          m := m-q;

          if m>=p then r := p else r := m;

          m := m-r;

          while (q<>0) and (r<>0) do

          begin

            if Find(fp,i) < Find(fp,j) then

            begin

              Seek(fp, i-1); Read(fp,ch2);

              Seek(fp, k-1); Write(fp,ch2);

              k := k+h; i := i+1; q := q-1;

            end else

            begin

              Seek(fp, j-1); Read(fp,ch2);

              Seek(fp, k-1); Write(fp,ch2);

              k := k+h; j := j-1; r := r-1;

            end;

          end;

          while r<>0 do

          begin

              Seek(fp, j-1); Read(fp,ch2);

              Seek(fp, k-1); Write(fp,ch2);

              k := k+h; j := j-1; r := r-1;

          end;

          while q<>0 do

          begin

              Seek(fp, i-1); Read(fp,ch2);

              Seek(fp, k-1); Write(fp,ch2);

              k := k+h; i := i+1; q := q-1;

          end;

             h := -1; t := k;

             k := l;

             l := t;

         until m = 0:

         up := not up;

         p := p*2;

       until p >= count;

       if not up then

         for i := 1 to count do

         begin

           Seek(fp, i-1+count); Read(fp,ch2);

           Seek(fp, i-1); Write(fp,ch2);

         end;

        end; { кoнец сортировки методом слияния }

-----------------------------------------------------------------

function SeqSearch(item: DataArray; count:integer;

                         key:DataItem):integer;

var

  t:integer;

begin

  t:=1;

  while (key<>item[t]) and (t<=count) t:=t+1;

  if t>count then SeqSearch:=0

  else SeqSearch:=t;

end; { конец последовательного поиска }

-----------------------------------------------------------------

function BSearch (item: DataArray; count:integer;

                        key:DataItem):integer;

var

  low, high, mid: integer;

  found:boolean;

begin

  low:=1; high:=count;

  found:=false;    { не найден }

  while (low<=high) and (not found) do

  begin

    mid:=(low+high) div 2;

    if key<item[mid] then high:=mid-1

    else if key>item[mid] then low:=mid+1

    else found:=true; { найден }

  end;

  if found then BSearch:=mid

  else BSearch:=0; { не найден }

end; { конец поиска }

Методы программрования: переборные алгоритмы

Данная статья открывает цикл работ, посвященных не особенностям какого-то отдельного языка программирования (например Паскаля), а общим ИДЕЯМ и МЕТОДАМ разработки алгоритмов. Тем не менее, опираться мы все равно будем на теория, числа, оптимальные алгоритмы, вычислительная, определение, который вы уже знаете. Первоначальный вариант любого алгоритма мы будем записывать на псевдокоде - языке, который занимает промежуточное положение между нашим обычным языком и языками программирования. Он не имеет каких-то жестких правил и требований, т.к. предназначен прежде всего для человека, а не компьютера. Это позволит нам избавиться от излишней детализации алгоритма на раннем этапе разработки и сразу выразить его основную идею. Превратить этот псевдокод в программу на Паскале задача совсем несложная - как это делать вы быстро поймете.

Основные идеи первого задания - ПЕРЕБОР, РЕКУРСИЯ, ПЕРЕБОР С ОТХОДОМ HАЗАД. Этими понятиями должен хорошо владеть каждый программист. Кроме того, переборные задачи составляют значительную долю всех школьных олимпиад по информатике.