Оп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.

Procedure InQueue (x : element);beginFIN:=FIN+1; {на первое свободное место}Queue[FIN]:=x; {ставим элемент x}end;Procedure OutQueue (var x : element);beginx:=Queue[BEG]; {берем первый элемент}BEG:=BEG+1; {и изменяем указатель}{на следующий за ним}

end;

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

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

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

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

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

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

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

var Delta = array [1..4,1..2] of integer = ((0,1),(1,0),(-1,0),(0,-1));{Delta - возможные смещения соседних клеток от текущей клетки}Current, neighbor : element;z : integer;....{Будем обозначать то, что элемент в матрице уже просмотрен}{умножением его на -1}{минимальный ненулевой элемент матрицы имеет значение z}while BEG<>FIN+1 do beginOutQueue(Current);for i:=1 to 4 do beginneighbor.x:=Current.x+Delta[i,1], neighbor.y:=Current.y+Delta[i,2],if A[neighbor.x,neighbor.y]=zthen InQueue(neighbor)else p:=min(A[neighbor.x,neighbor.y],p); end;

end;

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

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

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

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

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

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

var A: array[0..N+1,0..M+1] of byte;{ввод и окаймление нулями}for i:=1 to N do beginA[i,0]:=0; A[i,M+1]:=0;for j:=1 to M do read(A[i,j]);end;for j:=0 to M+1 do beginA[0,j]:=0; A[N+1,j]:=0;end;

Задача №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АЗАД. Этими понятиями должен хорошо владеть каждый программист. Кроме того, переборные задачи составляют значительную долю всех школьных олимпиад по информатике.