Разработка системы задач (алгоритмы-программы) по дискретной математике — страница 13

варианты хода из неё в другую клетку} 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. 4 Задача о футболистах. uses crt; Const k=100; Type mas=array[1..k]of Integer; Var m,q:integer; A,B:mas; procedure Init(z:string); {инициализация исходных данных} var i:integer; f:text; begin Assign(f,z); Reset(f); ReadLn(f,m,q); For i:=1 to m do Read(f,A[i]); ReadLn(f); For i:=1 to q do Read(f,B[i]); Close(f); end; procedure Solve; var i,j,t:integer; D:mas; begin i:=1; j:=1; t:=1; While (i<=m)and(j<=q)do {пока не вышли футболисты хотя бы из одного автобуса} Begin {сравниваем номера футболистов в разных автобусах,