I, n: integer;
k: mas;
procedure input _ mas (var k: mas; n: integer);
var
j: integer;
begin
for j:=1 to n do
readln (k[ j ]);
end;
begin
writeln ('введите n'); readln (n);
Input _ mas (k, n);
for i:=1 to n do
writeln (k[i]);
end.
j - локальная переменная.
i, n, k - массив - глобальные переменные.
Пример 6.3 Выполнить упорядочение по возрастанию нескольких массивов вещественных чисел. В программе используется процедура сортировки методом «пузырька», алгоритм которой описан ранее.
Исходными данными для процедуры являются массив вещественных чисел и его размерность. Стандарт языка Паскаль, как отмечалось выше, требует описания массива в разделе Type (в программе это новый тип - MasReal). При использовании процедуры сортировки для согласования параметров необходимо в основной программе и процедуре ссылаться только на этот тип.
Program Sort;
Const
M = 200; { Максимальный размер массива }
Type
MasReal = Array [1..M] Of Real;
Var
A,B : MasReal;
I,n : Integer;
Procedure SortY (L:Integer; Var Y:MasReal);
{ Сортировка вещественных чисел методом "пузырька" }
{ L – размер массива; Y – массив вещественных чисел}
Var
I,k : Integer;
Z : Real;
Begin
For k:=1 To L-1 Do
For i:=1 To L-k Do
If Y[i]>Y[i+1]Then
Begin
Z := Y[i];
Y[i] := Y[i+1];
Y[i+1] := Z
End;
End; { SortY }
Begin {Основная программа}
Writeln(’ Введите размер массивов’);
ReadLn(n);
Writeln(’Введите первый массив’);
For i : =1 To n Do
ReadLn(A[i]);
Writeln (’Введите второй массив’);
For i := 1 To n Do
ReadLn(B[i]);
SortY (n,A); { Сортировка массива А }
SortY (n,B); { Сортировка массива В }
Writeln (’Первый массив’);
For i := 1 To n Do
Write (A[i]:8:3);
Writeln;
Writeln (’Второй массив’);
For i := 1 To n Do
Write(B[i]:8:3);
Readln; { Ожидание нажатия клавиши ENTER }
End.
Пример
6.4 Составить
программу нахождения палиндромов в
диапазоне 0
9999,
используя процедуру.
program palindrom;
var
f, i: integer;
procedure two (var f: integer; i: integer);
var
a, b: real;
begin
a: =int (i/10); b:=i-a*10;
if a=b then f:=1;
end;
procedure thr (var f: integer; i: integer);
var
a, c: real;
begin
a:= int(i/100); c:= i-int(i/10)*10;
if a=c then f:=1;
end;
procedure fo (var f: integer; i: integer);
var
a, b, c, d: real;
begin
a: =int (i/100); b: =int((i-a*1000)/100);
c: =int ((i-a*1000-b*100)/10);
d: =i-a*1000-b*100-c*10;
if (a=d) and (c=b) then f=1;
end;
begin
for i=0 then 9999 do
begin
f:=0
case i of
0 .. 9 : f:=1;
10 .. 99 : two (f, i);
100 .. 999 : thr (f, i);
1000 .. 9999 : fo (f, i);
end;
if f=1 then writeln (i);
end;
end.