(* Пример использования массива *)
(* Программа, которая: *)
(* -1- запрашивает у пользователя коэффициенты полинома; *)
(* -2- вычисляет значения полинома для заданных аргументов. *)
(* *)
(* Полином степени n задается коэффициентами *)
(* A[0], A[1], ..., A[n] <= по убыванию степеней от n до 0 *)
program BRAIN;
Label 999;
Const MXA = 20; (* Max степень полинома *)
Type Coef = array [0..MXA] of real;
Var I,N : integer;
R,X : real;
Y : char;
A : Coef;
begin write('Степень полинома =');
Readln(N);
if (N < 1) or (MXA < N) then begin
writeln('Не могу');
goto 999
end;
for I:=0 to N do begin (* Ввод коэффициентов *)
write(I:2,'-й коэффициент =');
Readln(A[I])
end;
repeat (* Вычисления *)
writeln;
write(' Аргумент =');
Readln(X);
R:=0.; (* ;;;;;; Схема ;;;;;; *)
for I:=0 to N do R:=R*X+A[I]; (* ;;;;; Горнера ;;;;; *)
writeln('Результат =',R:16:4);
write('Продолжать |
(* Пример использования строк *)
(* Программа, которая: *)
(* -1- запрашивает у пользователя даты в формате YYMMDD; *)
(* -2- сортирует даты; *)
(* -3- выводит (на экран) упорядоченную послед-ть дат *)
program DATE;
Label 999;
Const MXA = 20;
Type DaType = packed array [1..6] of char;
Var I,J,N,R : integer;
DT : array [1..MXA] of DaType;
Y : DaType;
begin write('Количество дат =');
Readln(N);
if (N < 1) or (MXA < N) then begin
writeln('Не могу');
goto 999
end;
for I:=1 to N do begin (* Ввод дат *)
write(I:2,'-я дата =');
for J:=1 to 6 do Read(DT[I,J]);
Readln
end;
for I:=1 to N-1 do begin (* Сортировка *)
R:=I;
for J:=I+1 to N do
if DT[J] < DT[R] then R:=J; {<== Сравнение строк *)
Y:=DT[R]; (* ;;;;;Поменять;;;;; *)
DT[R]:=DT[I]; (* ;;;;;местами;;;;;; *)
DT[I]:=Y (* ;;DT[R] и DT[I];;; *)
end;
writeln('Результат');
for I:=1 to N do writeln(I:2,'. ',DT[I]);
999: end.
|
(* Пример процедуры No.1 *)
(* Процедура, которая: *)
(* преобразует дату в формате YYMMDD в формат DD-MM-20YY *)
(* *)
(* Считаем, что типы alfa06 и alfa12 определены заранее. *)
(* type alfa06 = packed array [1.. 6] of char; *)
(* alfa10 = packed array [1..10] of char; *)
procedure RECO(var FD : alfa06; var TD : alfa10);
begin TD:='dd-mm-20yy';
TD[1]:=FD[5]; TD[ 2]:=FD[6]; (* dd *)
TD[4]:=FD[3]; TD[ 5]:=FD[4]; (* mm *)
TD[9]:=FD[1]; TD[10]:=FD[2]; (* yy *)
end;
|
(* Пример процедуры No.2 *)
(* SortInt : Программа сортировки целых чисел. *)
(* Считаем, что: *)
(* Целое число ::= последовательность цифр, в которой *)
(* - первым знаком могут быть '+' или '-' *)
(* - правым ограничителем является '.' *)
(* Примеры целых: nnn. | +nnnnnn. | -nn. и т.д. *)
program SortInt;
Label 999;
Const MAXY =20;
Type MACC = array [1..MAXY] of integer;
var I,J,M,N : integer;
F : MACC;
W : boolean;
(* InpInt : принимает из входного потока (с клавиатуры) *)
(* последовательность знаков и преобразует ее в целое V.*)
(* Если последовательность не удовлетворяет соглашению *)
(* о представлении целых чисел, то P = false *)
procedure InpInt(var V : integer; var P : boolean);
var A,Z : char;
N,K : integer;
begin N:=0; (* Количество прочитанных знаков *)
K:=0; (* Количество прочитанных цифр *)
Z:='+'; (* Первый знак числа *)
V:=0;
P:=true; (* Посл.знаков есть целое число *)
repeat
Read(A);
N:=N+1;
if ( A ='+') and (N = 1 ) then
else if ( A ='-') and (N = 1 ) then Z:='-'
else if ('0' <= A) and (A <= '9') then begin
K:=K+1;
V:=10*V+ord(A)-ord('0')
end
else if ( A = '.') and (0 < K ) then
else P:=false;
until (A = '.') or (not P);
Readln; (* Enter *)
P:=P and (1 <= K);
if Z = '-' then V:=-V
end;
begin write('Количество целых =');
InpInt(N,W); (* Первое использование InpInt *)
if (not W) or (N < 1) or (MAXY < N) then begin
writeln('Ошибка ввода.');
goto 999
end;
for I:=1 to N do begin
write(I:3,'-е число =');
InpInt(F[I],W); (* Второе использование InpInt *)
if not W then begin
writeln('Неправильное число.');
goto 999
end
end;
(* Сортировка *)
for I:=1 to N-1 do begin
M:=I;
for J:=I+1 to N do
if F[J] < F[M] then M:=J;
J:=F[M];
F[M]:=F[I];
F[I]:=J
end;
writeln('Результат:');
for I:=1 to N do writeln(I:3,'-е число =',F[I]);
999: end.
(* Протокол: MS-DOS>InpInt<Enter>
Количество целых = 4.<Enter>
1-е число =8.<Enter>
2-е число =-6.<Enter>
3-е число =199.<Enter>
4-е число =50.<Enter>
Результат:
1-е число =-6
2-е число =8
3-е число =50
4-е число =199
Конец протокола. *)
|
(* Побочный эффект - действия, определенные в процедуре или функции, *)
(* которые: *)
(* - либо изменяют глобальные переменные; *)
(* - либо производят ввод/вывод и т.п. *)
program EFF;
var A,B : real; (* Глобальные переменные *)
function FCX(X : real) : real;
var A1 : real;
begin A:=0.7*X+0.6; (* Изменение глобальных переменных *)
FCX:=A*X+0.3
end;
begin A:=1.;
B:=FCX(1.0);
writeln(A:10:2, B:10:2);
(* A = 1.30 <== Результат побочного эффекта *)
(* B = 1.60 *)
end.
|
(* Пример рекурсивной процедуры Rsin *)
(* вычисления значения sin(X) по заданному аргументу X. *)
(* *)
(* Подход: sin(X) = X при малых X /первый замечательный предел/ *)
(* sin(X) = 2*sin(X/2)*(1-2*sqr(sin(X/2))) иначе *)
(* /тригонометрическое тождество/*)
program ReqSin;
var X,Yr,Ys : real;
I : integer;
function Rsin(X : real) : real;
begin if abs(X) < 0.0001
then Rsin:=X
else Rsin:=2*Rsin(X/2)*(1 - 2*sqr(Rsin(X/4))) end;
begin writeln('X':5,'sin(X)':13,'Rsin(X)':15,'Погрешность':16);
X:=0;
for I:=1 to 20 do begin
Yr:=Rsin(X);
Ys:= sin(X);
writeln(X:7:3,Ys:14:9,Yr:14:9,abs(Ys-Yr):14:9);
X:=X+0.35;
end
end.
(* Протокол: MS-DOS>ReqSin
X sin(X) Rsin(X) Погрешность
0.000 0.000000000 0.000000000 0.000000000
0.350 0.342897807 0.342897808 0.000000000
0.700 0.644217687 0.644217688 0.000000001
1.050 0.867423226 0.867423226 0.000000000
1.400 0.985449730 0.985449730 0.000000000
1.750 0.983985947 0.983985947 0.000000000
2.100 0.863209367 0.863209366 0.000000001
2.450 0.637764702 0.637764700 0.000000002
2.800 0.334988150 0.334988147 0.000000003
3.150 -0.008407247 -0.008407252 0.000000005
3.500 -0.350783228 -0.350783229 0.000000002
3.850 -0.650625137 -0.650625139 0.000000002
4.200 -0.871575772 -0.871575774 0.000000001
4.550 -0.986843859 -0.986843859 0.000000001
4.900 -0.982452613 -0.982452612 0.000000001
5.250 -0.858934493 -0.858934491 0.000000003
5.600 -0.631266638 -0.631266633 0.000000005
5.950 -0.327054815 -0.327054807 0.000000008
6.300 0.016813900 0.016813910 0.000000010
6.650 0.358643853 0.358643856 0.000000003
Конец протокола. *)
|
(* Усовершенствованная функция Rsin *)
(* Недостаток функции Rsin состоит в том, что для каждого *)
(* фиксированного аргумента (большего 0.0002) Rsin(X/4) *)
(* вычисляется дважды: *)
(* - cначала как Rsin(X/2) половинного аргумента, а *)
(* - затем как Rsin(X/4) полного аргумента. *)
(* *)
(* Для устранения этого недостатка введем процедуру Csin, *)
(* которая по заданному аргументу X (рекурсивно) вычисляет *)
(* Y = sin(X) и Y2 = sin(X/2). *)
procedure Csin(var Y,Y2 : real; X : real);
var Y4 : real; (* Y4 = sin(X/4) *)
begin if abs(X) <= 0.0001 then begin
Y:=X;
Y2:=X/2
end else begin
Csin(Y2,Y4,X/2);
Y:=2*Y2*(1-2*sqr(Y4))
end end;
(* С помощью Csin функция Rsin определяется просто. *)
function Rsin(X : real) : real;
var Y,Y2 : real;
begin Csin(Y,Y2,X);
Rsin:=Y end;
|
(* Пример рекурсивной процедуры *)
(* IncOne : К положительному двоичному числу D длины N *)
(* прибавить единицу. *)
(* Подход: *)
(* Если N = 0, *)
(* то IncOne('') = '1', *)
(* иначе либо IncOne('d...d0') = 'd...d1', *)
(* либо IncOne('d...d1') = IncOne('d...d')+'0' { рек }*)
(* *)
program TEST14;
type alfa10 = packed array [1..10] of char;
var X : alfa10;
N : integer;
procedure IncOne(var D : alfa10; var N : integer);
begin if N = 0 then begin N:=1; D[N]:='1' end
else if D[N] = '0' then D[N]:='1'
else begin
N:=N-1;
IncOne(D,N); (* рекурсивный вызов *)
N:=N+1;
D[N]:='0'
end
end;
begin (* Пример обращения к IncOne *)
X:='10111 '; N:=5;
IncOne(X,N);
writeln('Результат = ',X);
end.
(* Протокол: MS-DOS>TEST14<Enter>
Результат = 11000
Конец протокола. *)
|
(* Пример рекурсивной процедуры (продолжение) *)
(* Как работает IncOne ? *)
(* Trace - процедура (отладочной) печати *)
(* двоичного числа D длины N *)
program TEST14m;
type alfa10 = packed array [1..10] of char;
var X : alfa10;
N : integer;
procedure Trace(var D : alfa10; N : integer);
var I : integer;
begin write(' Длина=',N,' Строка=''');
for I:=1 to N do write(D[I]);
writeln('''') end;
procedure IncOne(var D : alfa10; var N : integer);
begin write('Вход IncOne');
Trace(D,N);
if N = 0 then begin N:=1; D[N]:='1' end
else if D[N] = '0' then D[N]:='1'
else begin
N:=N-1;
IncOne(D,N); (* рекурсивный вызов *)
N:=N+1;
D[N]:='0'
end;
write('Exit IncOne');
Trace(D,N);
end;
begin (* Пример обращения к IncOne *)
X:='10111 '; N:=5;
IncOne(X,N);
writeln('Результат = ',X);
end.
(* Протокол: MS-DOS>TEST14m<Enter>
Вход IncOne Длина=5 Строка='10111'
Вход IncOne Длина=4 Строка='1011'
Вход IncOne Длина=3 Строка='101'
Вход IncOne Длина=2 Строка='10'
Exit IncOne Длина=2 Строка='11'
Exit IncOne Длина=3 Строка='110'
Exit IncOne Длина=4 Строка='1100'
Exit IncOne Длина=5 Строка='11000'
Результат = 11000
Конец протокола. *)
|
(* Факультативно. *)
(* IntSeq : процедура, которая преобразует (символьную) строку *)
(* входных данных в массив целых чисел ISQ[1..N] из *)
(* диапазона [-9999..+9999]. *)
(* Считается, что число задается последовательность *)
(* цифр (со знаком). *)
(* Правой границей числа являются: *)
(* - конец строки (eoln) ; или *)
(* - символ, отличный от цифры; или *)
(* - цифра, если ее появление в числе приводит к *)
(* выходу за пределы диапазона [-9999..+9999]. *)
(* Примеры: 10;20;-17;66 ISQ[1..4] = 10, 20, -17 и 66 *)
(* 31 -54 -54 ISQ[1..3] = 31, -54 и -54 *)
(* 4444444444 ISQ[1..3] = 4444, 4444 и 44 *)
(* Полагаем, что предельный размер массива задается константой *)
(* MSQ. Если во входном потоке содержится более MSQ *)
(* чисел, то числа с номерами > MSQ игнорируются. *)
const MSQ = 200;
var ISQ : array [1..MSQ] of integer;
procedure IntSeq(var N : integer);
var K,R,Z : integer;
A : char;
procedure BISQ;
begin N:=N+1;
if (N <= MSQ) and (0 < K) then ISQ[N]:=R
else N:=N-1; (* Откат *)
K:=0; R:=0; Z:=1;
end;
begin K:=0; R:=0; Z:=1;
N:=0;
while not eoln do begin
Read(A);
if ('0' <= A) and (A <= '9') then begin
R:=10*R+Z*(ord(A)-ord('0'));
K:=K+1;
if 1000 <= abs(R) then BISQ
end else BISQ;
if A = '-' then Z:=-1
end;
BISQ;
Readln end;
(* Конец факультативного примера. *)
|