ДОПОЛНИТЕЛЬНАЯ ЧАСТЬ
Одномерные массивы
program Dop1;
const Nmass=100;
var A:array[1..Nmass] of integer;
i,N,k: byte;
y:integer;
begin
k:=0;
cls;
writeLn('Ââåäèòå ÷èñëî ýëåìåíòîâ â ìàññèâå A');
readLn(N);
writeLn('Ââîäèì ýëåìåíòû ìàññèâà A:');
for i:=1 to N do
begin
write('A[',i,']=');
readLn(A[i]);
end;
writeLn('Èñõîäíûé ìàññèâ A:');
for i:=1 to N do
write(A[i]:5);
writeLn;
// ìîäèôèêàöèÿ ìàññèâà
for i:=2 to N do
if A[i] < A[i-1] then
k:=K+1;;
writeLn;
if k>0 then
begin
y:=A[n];
A[n]:=A[1];
A[1]:=y
end else begin a[1]:=sqr(a[1]); a[n]:=sqr(a[n]); end;
writeLn('ìàññèâ A ïîñëå èçìåíåíèÿ:');
for i:=1 to N do
write(A[i]:5);
end.
Двумерные массивы.
9. Ввести двумерный массив A N ´ N, вывести его. Найти среднее арифметическое диагональных элементов (главной и побочной). Все элементы большие найденного значения, расположенные над побочной диагональю возвести в квадрат, а расположенные под ней увеличить на минимум всего массива.
program dop2;
const Nmass=10;
var A:array[1..Nmass,1..Nmass] of integer;
N,i,j,i1: byte;
SA1:real;
min:integer;
Begin
cls;
writeLn('Ââåäèòå ÷èñëî còðîê/ñòîëáöîâ â ìàññèâå A');
readLn(N);
writeLn('Ââîäèì ýëåìåíòû ìàññèâà A:');
for i:=1 to N do
for j:=1 to N do
Begin
write('A[',i,',',j,']=');
readLn(A[i,j]);
end;
min:=9999;
writeLn('Èñõîäíûé ìàññèâ A:');
for i:=1 to N do
Begin
for j:=1 to N do
Begin
write(A[i,j]:5);
if A[i,j]<min then min:=A[i,j];
end;
writeLn;
end;
SA1:=0;
j:=N;
i1:=1;
for i:=1 to N do
Begin
SA1:=A[i,j] +SA1;
if i1<>j then SA1:=A[i,i1] +SA1;
j:=j-1;
i1:=i1+1;
end;
SA1:=SA1/((N*2)-1);
Writeln('Ñð.Àðèô äèàãîíàëè: ',SA1);
Writeln('Ìèíèìóì: ',min);
writeLn;
for i:=1 to N do
for j:=i+1 to N do
if A[i,j]>SA1 then A[i,j]:=sqr(A[i,j]);
for i:=1 to N do
for j:=1 to i-1 do
if A[i,j]>SA1 then A[i,j]:=A[i,j]+min;
writeLn('ìàññèâ A ïîñëå èçìåíåíèÿ:');
for i:=1 to N do
Begin
for j:=1 to N do
write(A[i,j]:5);
writeLn;
end;
End.
Вычисления с использованием подпрограмм.
Дважды вычислить значение выражения, первый раз используя процедуру,
а второй – функцию.
Program Z18_Fun;
Var x1,x2,x3,x4,x5,x6,S:real;
Function F(const y,z,x1,x2:real):real;
Var a1, a2: real;
Const p=3.14;
Begin
a1:= sin(x1+y*p/z);
a2:= cos(x2+y*p/z);
F:=a1+a2;
End;
Begin
cls;
writeLn('ââîä x1,x2,x3,x4,x5,x6');
readLn(x1,x2,x3,x4,x5,x6);
S:=(F(1,4,x1,x2))/(F(1,3,x3,x4))*sqrt(abs(F(2,5,x5,x6)));
writeLn('S=',S:8:2);
End.
Program Z18_Fun;
Var x1,x2,x3,x4,x5,x6,S:real;
v1,v2,v3: real;
Procedure Fpr(const y,z,x1,x2:real; var F:real);
Var a1, a2: real;
Const p=3.14;
Begin
a1:= sin(x1+y*p/z);
a2:= cos(x2+y*p/z);
F:=a1+a2;
End;
Begin
cls;
writeLn('ââîä x1,x2,x3,x4,x5,x6');
readLn(x1,x2,x3,x4,x5,x6);
Fpr(1,4,x1,x2,v1);
Fpr(1,3,x3,x4,v2);
Fpr(2,5,x5,x6,v3);
S:=(v1)/(v2)*sqrt(abs(v3));
writeLn('S=',S:8:2);
End.
Обработка массивов с использованием подпрограмм.
program Z19;
const MaxRazm = 10;
type T1m=array[1..sqr(MaxRazm)] of real;
TName=string[5];
var X1,X2,X3:T1m;
N:byte;
max1,max2:real;
procedure Vvod1m(var A:T1m; const N:byte; Name:TName);
var i:byte;
begin
writeLn('ââåäèòå ìàññèâ ', Name,':');
for i:=1 to N do
begin
write(Name,'[',i,']=');
readLn(A[i]);
end;
end;
procedure Vivod1m(const A:T1m; const N:byte; const
Name:TName);
var i:byte;
begin
writeLn('âûâîäèì ìàññèâ ', Name,':');
for i:=1 to N do write(A[i]:5:2);
writeln;
end;
function MaxOtr(const A:T1m; N:byte):real;
var max:real;
i:byte;
begin
max:=A[1];
for i:=1 to N do
if A[i]>max then max:=A[i];
MaxOtr:=max;
end;
procedure Delenie(var A:T1m; const N:byte; const Chislo:real);
var i:byte;
begin
for i:=1 to N do
A[i]:=A[i]/Chislo;
end;
procedure Form(const A:T1m; C:T1m; var B:T1m; const N:byte);
var i:byte;
begin
for i:=1 to N do
B[i]:=A[i]+C[i];
end;
begin
cls;
write('ðàçìåðíîñòü ìàññèâîâ N=');
readLn(N);
Vvod1m(X1,N,'X1');
Vvod1m(X2,N,'X2');
max1:=MaxOtr(X1,N);
writeLn('max1=',max1:5:2);
max2:=MaxOtr(X2,N);
writeLn('max2=',max2:5:2);
Delenie(X1,N,max1);
Delenie(X2,N,max2);
Vivod1m(X1,N,'X1');
Vivod1m(X2,N,'X2');
form(X1,X2,X3,N);
Vivod1m(X3,N,'X3');
end.
Файлы
program Z20;
var b,i,k,n:integer;
f:file of integer;
begin
cls;
assign(f,'f.dat');
writeLn('ââåäèòå ïåðâóþ êîìïîíåíòó ôàéëà f (ïðèçíàê êîíöà ââîäà: "777")');
//ââîä ôàéëà
rewrite(f);
readLn(b);
i:=1; //íîìåð êîìïîíåíòû ôàéëà
while b<>777 do
begin
write(f,b);
i:=i+1;
writeLn('ââåäèòå ',i,'-þ êîìïîíåíòó ôàéëà f');
readLn(b);
end;
//âûâîä ôàéëà äî èçìåíåíèÿ
reset(f);
n:=0;
writeLn('ôàéë f äî èçìåíåíèÿ:');
while not EOF(f) do
begin
read(f,b);
write(b:5);
n:=n+1;
end;
writeLn;
// ïîèñê ïîçèöèè
k:=0;
i:=0;
reset(f);
for i:=1 to n do
begin
seek(f,i-1);
read(f,b);
if (b>0) and (i mod 3 = 0) then k:=k+1;
i:=i+1;
end;
// ïðîâåðêà âîçìîæíîñòè ïåðåñòàíîâêè â ôàéëå
if k=0 then
writeLn('â ôàéëå íåò ïîäõîäÿùèõ äàííûõ')
else
K:=K+2;
begin
// çàìåíà
reset(f);
while not EOF(f) do
begin
seek(f,k-1);
writeln(k);
write(f,1);
k:=k+1;
end;
//âûâîä ôàéëà ïîñëå èçìåíåíèÿ
reset(f);
writeLn('ôàéë f ïîñëå èçìåíåíèÿ:');
while not EOF(f) do
begin
read(f,b);
write(b:5);
end;
writeLn;
end;
close(f);
end.