лекции / Пример 1

Пример 1. Найти сумму и количество положительных элементов массива

program summa_massiv;

var

a : array [1..10] of integer;

I : byte; S: integer;

begin

Write('Введите массив');

for i:= 1 to 10 do Read(a[i]); // ввод элементов массива

S:=0;n:=0; // переменной S и n присваивается значе­ние 0

for i:=1 to 10 do if a[i]>0 then

begin

S:=S+ a[i];

n:=n+1;

End;

WriteLn ('S =', S:6:3, ' n =', n );

end.

Пример 2. Найти максимальный и минимальный элементы массива

program max-min;

var

a : array [1..10] of integer;

i : byte; max, min: integer;

begin

write('введите массив');

for i:= 1 to 10 do read(a[i]); // ввод элементов массива

max:=a[1]; // переменной max присваивается значение первого элемента массива

for i:=2 to 10 do if max < a[i] then max:= a[i];

min:= a[1]; // переменной min присваивается значение первого элемента массива

for i:=2 to 10 do if min > a[i] then min:= a[i];

writeln ('максимальный элемент массива =', max);

writeln ('минимальный элемент массива =', min);

end.

Р ис.2. Блок – схема программы max-min.

Пример 3. Сортировка элементов массива по возрастанию (методом "пузырька").

program sortirovka;

var x: array [1..10] of real;

i, j: byte; buffer : real;

begin

writeln('Введите массив'); // вывод комментария

for i:=1 to 10 do read(x[i]); // ввод элементов массива

for i:= 1 to 9 do

for j:= i+1 to 10 do if x[i] >= x[j] then

begin

buffer:= x[i];

x[i]:= x[j];

x[j]:= buffer;

end;

for i:=1 to 10 do write(‘ ’,x[i]:6:3); // вывод отсортированного массива

e nd.

Пример 4. Создать массив В их положительных элементов массива А

program massiv;

var

a, в : array [1..10] of integer; i, n : byte;

begin

write('введите массив')

for i:= 1 to 10 do read(a[i]); // ввод элементов массива

n:=0;

for i:=1 to 10 do if a[i]>0 then

begin

n:=n+1;

b [n]:= a[i];

end;

for i:= 1 to n do write (' ‘,b[i] );

end.

Рис.4. Блок – схема программы massiv.

Найдите максимальные элементы каждой строки матрицы и выведите их на экран.

program max_strok;

var i,j,m,n,imax,jmax: byte;

a: array[1..10,1..10] of integer;

begin

Read(n,m);

for i:=1 to n do

for j:=1 to m do Read(a[i,j]);

for i:=1 to n do

begin

imax:=i; jmax:=1;

for j:=2 to m do

begin

if a[imax,jmax]<a[i,j] then

begin

imax:=i;

jmax:=j;

end;

end;

Writeln (‘ max[’,I,’]=’,a[imax,jmax]);

end;

end.

Минимальные элементы строк массива находятся аналогично, только в условии меняется знак a[imin,jmin]>a[i,j].

Найдите суммы элементов строк матрицы и выведите их на экран в виде одномерного массива.

program sum_strok;

var i,j,m,n: byte;

a: array[1..10,1..10] of integer;

s: array[1..10] of integer;

begin

Read(m,n);

for i:=1 to n do

for j:=1 to m do Read(a[i,j]);

for i:=1 to n do

begin

s[i]:=o;

for j:=1 to m do s[i]:= s[i]+ a[i,j];

end;

for i:=1 to n do Write(‘ ‘,s[i]);

end.

Произведение элементов строк матрицы находится аналогично, только начальным значениям произведений присваивается p[i]:=1.

Транспонируйте матрицу (n,m) и выведите ее на экран:

program transport;

var i,j,n,m : byte;

a: array[1..3,1..3] of integer;

begin

for i:=1 to n do

for j:=1 to m do Read(a[i,j]);

for j:=1 to m do

begin

for i:=1 to n do Write(a[i,j],’ ‘);

WriteLn;

end;

end.

Выведите элементы главной диагонали квадратичной мат­рицы (3х3) на экран.

Квадратная матрица- матрица с равным количеством строк и столб­цов. Работая с квадратными матрицами, всегда следует искать какие-либо определенные закономерности в индексах, чтобы облегчить решение по­ставленной задачи.

На пример:

- у элементов главной диагонали i=j ;

-у элементов выше главной диагонали i<j;

-у элементов ниже главной диагонали i>j;

-у элементов побочной диагонали i+j=n+1

(n - порядок матрицы);

Program diagon;

Var i,j :byte;

a: array[1..3,1..3] of integer;

begin

for i:=1 to 3 do

for j:=1 to 3 do Read(a[i,j]);

for i:=1 to 3 do

for j:=1 to 3 do If i=j then Write(a[i,j],’ ‘);

end.

Написать программу, которая в каждой строке матрицы сортирует элементы по возрастанию.

program sort;

var a:array[1..5,1..5] of real;

c: real;I,j,k:byte;

begin

writeln(‘ Введите матрицу ’);

for i:=1 to 5 do

for j:=1 to 5 do read(a[i,j]);

for i:=1 to 5 do

begin

for j:=5 downto 1 do

begin

for k:=2 to i do

begin

c:=A[i,k-1];

if c>A[i,k] then begin

A[i,k-1]:=A[i,k];

A[i,k]:=c;

end

end;

end;

end;

for i:=1 to 5 do

begin

for j:=1 to 5 do write(A[i,j],’ ‘);

writeln;

end;

end.

Пример 1. Посчитайте количество символов ‘о’ в строке, выведите на экран позиции, на которых они находятся. Затем замените эти символы на ‘!’.

program stroka;

var str : string;

i : integer;

begin

writeln('введите строку');

readln(str);

n:=0;

for i:=1 to length(str) do if str[i]='o' then

begin

n:=n+1;

write(‘ ‘,i);

str[i]='!';

end;

writeln(str);

writeln(‘n=’,n);

end.

Пример 2. Найдите все цифры в строке, укажите их позиции и удалите их из строки.

program stroka;

var str: string;

i : byte;

begin

read(str);

for i:=1 to length(str) do if (ord(str[i])>=48) and (ord(str[i])<=57) then begin

write(‘ ‘,i);

delete(str,i,1);

end;

writeln(str);

end.

Пример 3. Определите количество слов в строке, в котором одно сло­во от другого отделяется пробелом. Выведите слова на экран.

program stroka;

var str,str1: string;

i,n,n1,n2 : byte;

begin

read(str);

n:=0;

n2:=1;

for i:=1 to length(str) do if (str[i]=' ') or ( str[i]='.') then

begin

n:=n+1;

n1:=n2+1;

n2:=i;

str1:=copy(str,n1, n2-n1);

writeln(str1);

end;

writeln(‘n=’,n);

end.

Пример 1. Вычислить, используя функцию

program logar;

var z, x, y, b: real;

function l (a, c: real): real;

begin

l:=ln(c)/ln(a);

end;

begin

read (x, y, b);

write (‘z=’, z : 6 :3);

end.

Пример 2. Вычислить

program func;

var x, y, z: integer; s: real;

function f (a, b: integer): real;

begin

f:=sqrt(a*a+b*b+sqr(sin(a*b)));

end;

begin

read (x, y, z);

s:=f (x, y)+f (z, x)+f (y, z);

write (‘s=’, s : 6 : 3); end.

Пример. Подсчитать сумму десяти введенных целых положительных чисел. Если будет введено отрицательное число, то необходимо прервать выполнение программы.

program primer6;

var i,c,Sum:integer;

procedure St(M:string);

begin

writeln('Ошибка:',M);

halt(1);

end;

begin

c:=0;

Sum:=0;

while c<10 do

begin

c:=c+1;

write('введите ',c,'-e число: ');

readln(i);

if i<0 then St('введено отрицательное число');

Sum:=Sum+i;

end;

writeln('Сумма чисел равна ',Sum);

end.

Пример. Найдите суммы элементов массивов A(5) и B(7).

program primer1;

type mas=array [1..100] of integer;

var sumA,sumB,y:integer;

a,b:mas;

procedure VVOD(n:byte; var x:mas);

var i:integer;

begin

writeln('Введите ',n,' чисел);

for i:=1 to n do read(x[i]);

end;

procedure Summa(n:byte; x:mas; var sum: integer);

var i,S:integer;

begin

S:=0;

for i:=1 to n do S:=S+x[i];

Sum:=S;

end;

begin

VVOD(5,a);

VVOD(7,b);

Summa(5,a,sumA);

Summa(7,b,sumB);

writeln('Sa= ',sumA);

writeln('Sb= ',sumB);

end.

Пример. Вычислить суммы всех элементов матриц А(n,n), B(m,m).

program primer2;

uses crt;

var T: array [1..10,1..10] of integer;

n,m: byte;

s: integer;

procedure VV(l: byte);

var i,j: byte;

begin

writeln('Vvedite massiv ',l,'x',l);

for i:=1 to l do

for j:=1 to l do read(T[i,j]);

end;

procedure Summa(l: byte; var s: integer);

var i,j: byte;

begin

S:=0;

for i:=1 to l do

for j:=1 to l do S:=S+T[i,j];

writeln('S= ',S);

end;

begin

clrscr;

writeln(Введите n,m');

readln(n,m);

VV(n);

VV(m);

Summa(n,s);

Summa(m,s);

end.