(* Пример рекурсивной функции No.2 *)
(* Задача существования пути в лабиринте *)
(* *)
(* Исходные данные: LB : array [1..MI,1..MJ] of char; *)
(* Если LB[I,J] = '*', то переход в эту клетку закрыт *)
(* Если LB[I,J] = ' ', то переход в эту клетку разрешен *)
(* *)
(* Потенциальное множество переходов из клетки (I,J) : *)
(* (I-1,J), (I+1,J), (I,J-1), (I,J+1) *)
(* *)
(* Задача существования пути в лабиринте = *)
(* Задача существования непрерывной цепочки переходов *)
(* из клетки (1,1) в клетку (MI,MJ). *)
(* *)
(* Подход. Отметить знаком '+' те клетки, в которые *)
(* можно перейти за неск.шагов из клетки (1,1) *)
(* MARK : Отметить клетку (I,J) знаком '+', если это *)
(* возможно, и сделать из нее все переходы. *)
program Test142;
const MI = 5;
MJ = 5;
var LB : array [1..MI,1..MJ] of char;
procedure MARK(I,J : integer);
begin if (1 <= I) and (I <= MI) then
if (1 <= J) and (J <= MJ) then
if LB[I,J] = ' ' then begin
LB[I,J]:='+';
MARK(I+1,J);
MARK(I-1,J);
MARK(I,J+1);
MARK(I,J-1);
end end;
begin (* Пример лабиринта *)
LB[1]:=' * ';
LB[2]:=' * ';
LB[3]:=' * ';
LB[4]:='* ';
LB[5]:='*** ';
MARK(1,1);
if LB[MI,MJ] = '+' then writeln('Путь существует')
else writeln('Путь не существует');
end.
|
(* Пример функции-параметра *)
(* Вычислить среднее взвешенное SUM(Ai*Pi)/SUM(Pi) *)
(* Подход. Ai --> A[I], Pi --> P[I], *)
(* A,P - массивы вещественных чисел *)
(* Суммирование реализуется универсальной ф-цией Radd *)
(* I-е элементы сумм поставляются функциями RC и RZ *)
procedure Teast143;
type ArReal = array [1..40] of real;
var A,P : ArReal;
X : real;
function RC(I : integer) : real;
begin RC:=P[I]*A[I] end;
function RZ(I : integer) : real;
begin RZ:=P[I] end;
function Radd(function F(I : integer) : real; N : integer) : real;
var I : integer;
R : real;
begin R:=0;
for I:=1 to N do R:=R+F(I);
Radd:=R end;
begin (* Ввод N, A[1..N] и P[1..N] *)
X:=Radd(RC,N)/Radd(RZ,N); (* X:=Среднее взвешенное *)
(* ... *)
end.
|
(* Пример No.1 операций с множествами *)
(* Сформировать подмножество X нечетных целых *)
(* чисел заданного множества A. *)
(* Процедура OddSet: X = { y из A | y - нечетное } *)
program T160;
type BaseInt = 1..32; (* Для определенности *)
BaseSet = set of BaseInt;
var A,X : BaseSet;
Y : BaseInt;
procedure OddSet(var X,A : BaseSet);
var y : BaseInt;
begin X:=[];
for y:=1 to 32 do
if y in A then
if odd(y) then X:=X+[y] end;
begin A:=[1,4,6,8,29,30,32];
OddSet(X,A);
for Y:=1 to 32 do
if Y in X then write(Y,' '); writeln;
end.
(* Протокол: MS-DOS>T160 |
(* Пример No.2 операций с множествами *)
(* DelSet : альтернативная реализация разности множеств *)
(* A := B - C *)
program T157;
type BaseType = 'A'..'Z';
BaseSet = set of BaseType;
var A,B,C : BaseSet;
procedure DelSet(var A,B,C : BaseSet);
var Y : BaseType;
begin A:=[];
for Y:='A' to 'Z' do
if Y in B then
if Y in C then
else A:=A+[Y] end;
begin (* Пример *)
B:=['A','B','Z'];
C:=['A','D','Z'];
DelSet(A,B,C);
(* A = ['B'] *)
end.
|
(* Пример использования файловых переменных *)
(* Слияние двух файлов целых чисел: *)
(* Элемент(F):=max(Элемент(G),Элемент(H)) по всем элементам *)
program MaxFile(F,G,H);
var F,G,H : file of integer;
begin Rewrite(F);
Reset(G);
Reset(H);
while (not eof(G)) and (not eof(H)) do begin
if H^ < G^ then F:=G^
else F:=H^;
Put(F);
Get(H);
Get(G)
end
end.
|
(* Пример использования текстовых файлов *)
(* Вычислить количество строк в заданном текстовом файле. *)
program Test165(T);
var K : integer;
T : text;
begin K:=0;
Reset(T);
while not eof(T) do begin
Readln(T);
K:=K+1
end;
writeln('Количество строк =',K);
end.
|