Комнаты музея

1 Комнаты музея.

Uses crt;

Const n=100;

X:array[0..3]of -1..1=(0,-1,0,1); {массив координат перемещения по

Y:array[0..3]of -1..1=(-1,0,1,0); клеткам. Индекс элемента массива

Type Mas=array[0..n,0..n]of Integer; соответствует степени двойки}

 var A:mas;

B:array[0..n,0..n]of Boolean;

m,p,col,rooms,indexX,indexY:integer;

 procedure Init(Z:string); {заполнение из входного файла массива, представляющего цифровую карту музея}

Var f:text;

i,j:integer;

Begin

Assign(f,z);

Reset(f);

ReadLn(f,m,p);

For i:=1 to m do

begin

For j:=1 to p do

Read(f,A[i,j]);

ReadLn(f);

end;

FillChar(B,SizeOf(B),true);

For i:=1 to m do

For j:=1 to p do

B[i,j]:=false;

Close(f);

end;

 function Degree2(i:integer):integer; {функция, вычисляющая i–ую степень двойки}

var j,t:integer;

begin

t:=1;

For j:=1 to i do

t:=t*2;

Degree2:=t;

end;

 Procedure Solve(i,j:integer);

Var k:integer;

begin

k:=3;

While k>=0 do

begin

If A[i,j]<Degree2(k)then {смотрим имеет ли клетка стену в заданном направлении}

begin

If not B[i+X[k],j+Y[k]] then {определяем, заходили ли мы в клетку ранее}

begin

Inc(col); {учитываем клетку в общей площади комнаты}

B[i,j]:=true; {отмечаем, что в текущей клетке мы уже были}

Solve(i+X[k],j+Y[k]); {переходим в следующую клетку}

B[i,j]:=False; {делаем клетку, в которой последний раз были не просмотренной, чтобы рассмотреть другие варианты хода из неё в другую клетку}

end;

end

Else A[i,j]:=A[i,j]-Degree2(k);

Dec(k);

end;

end;

 procedure Prosmotr; {данная процедура отмечает уже просмотренную комнату}

var i,j:integer;

begin

For i:=1 to m do

For j:=1 to p do

If A[i,j]=0 then B[i,j]:=True;

end;

 begin

 clrscr;

 Init('A:museum.txt');

 rooms:=0;

 For indexX:=1 to m do {ищем ранее не просмотренную клетку}

For indexY:=1 to p do

If not B[indexX,indexY] Then

begin

 col:=1;

 Inc(rooms);

 Solve(indexX,indexY);

 Write(Col,' '); {вывод площади только что просмотренной комнаты}

 Prosmotr;

end;

WriteLn;

WriteLn(rooms); {вывод количества комнат}

 readkey;

 end.

 2 Пират в подземелье.

uses crt;

 Const k=100;

dx:array[1..4] of Integer=(1,0,-1,0); {массив координат перемещения пирата}

dy:array[1..4] of Integer=(0,1,0,-1);

 Type mas=array[0..k,0..k]of Integer;

mas2=array[0..k,0..k]of boolean; {массив логического типа для пометки комнат, в которых пират уже побывал}

var n,m,sum1,sum,col:integer;

A:mas;

B:mas2;

Procedure Init(z:string); {инициализация входных данных}

Var f:text;

i,j:integer;

Begin

Assign(f,z);

Reset(f);

FillChar(A,SizeOf(A),0);

FillChar(B,SizeOf(B),true);

ReadLn(f,n,m,col);

for i:=1 to n do

begin

for j:=1 to m do

Read(f,A[i,j]);

ReadLn(f);

end;

Close(f);

End;

Procedure Solve(x,y,p:integer);

 var i,j:integer;

begin

 If p=0 then begin

If sum>sum1 then {сравниваем текущую стоимость набранных камней со стоимотью набранных ранее, с целью увеличения стоимости}

sum1:=sum;

end

Else begin

For i:=1 to 4 do

If (A[x+dx[i],y+dy[i]]>0)and B[x+dx[i],y+dy[i]] then {просматриваем варианты перехода пирата в другую комнату, проверяя не был ли пират в ней до этого}

begin

sum:=sum+A[x+dx[i],y+dy[i]]; {прибавляем стоимость камня, находящегося в данной комнате к суммарной стоимости}

B[x+dx[i],y+dy[i]]:=false; {отмечаем, что в данной комнате мы уже были}

Solve(x+dx[i],y+dy[i],p-1);

sum:=sum-A[x+dx[i],y+dy[i]];

B[x+dx[i],y+dy[i]]:=true;

end;

end;

end;

 begin

clrscr;

Init('A:241.txt');

sum1:=0; sum:=A[1,1];

Solve(1,1,col);

WriteLn('Result= ',sum1);

readkey;

 end.

3 Диспетчер и милиция.

Uses crt;

Const n=100;

Type mas=array[1..n,1..n]of Integer;

mas1=array[1..n]of Integer;

mn=Set of 1..n;

 Var m,first,last:integer;

D:mas1;

A:mas;

 procedure Init(z:string); {инициализация входных данных}

Var i,j:integer;

f:text;

begin

Assign(f,z);

Reset(f);

ReadLn(f,m);

 For i:=1 to m do

begin

For j:=1 to m do

Read(f,A[i,j]);

ReadLn(f);

end;

Close(f);

end;

function MinZn(R:mn):integer; {вычисляет номер района, путь до которого из района отправления минимален}

var i,minn:integer;

Begin

minn:=MaxInt;

For i:=1 to m do

If (D[i]<minn)and(D[i]>0)and(i in R) then

begin

MinZn:=i;

minn:=D[i];

end;

End;

 Function Min(i,j:integer):integer;{возвращает минимальное значение из двух возможных}

Begin

If i<>0 then

begin

If j<>0 then

begin

If j<i then Min:=j else Min:=i;

end Else Min:=i;

end Else Min:=j;

End;

 procedure Milicia(s:integer);

var v,u:integer;

T:mn;

Begin

for v:=1 to m do D[v]:=A[s,v];

D[s]:=0; T:=[1..m]-[s];

While T<>[] do

Begin

u:=MinZn(T);

T:=T-[u];

For v:=1 to m do

If v in T then

If A[u,v]<>0 Then

D[v]:=Min(D[v],D[u]+A[u,v]);

end;

End;

 Begin

 clrscr;

 Init('A:milicia.txt');

 WriteLn('Введите пункт отправления и пункт назначения');

 ReadLn(first,last);

 Milicia(first);

 WriteLn(D[last]);

readkey;

 End.