Одномерные массивы. Организация ввода и вывода данных

Задание 23.

Дана матрица  вещественных чисел 3х3. Диагональные  элементы матрицы заменить на максимальные.

Program z;

uses crt;

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

    i,j,max:integer;

begin

clrscr;

    writeln('vvedite massiv');

For i:=1 to 3 do

For j:=1 to 3 do

     readln(a[i,j]);

For i:=1 to 3 do

For j:=1 to 3 do

if a[i,j]>max then max :=a[i,j];

writeln('max=',max);

For i:=1 to 3 do  begin

a[i,i]:=max;

a[i,3+1-i]:=max; end;

for i:=1 to 3 do begin

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

    writeln;

end; readln; end. 

Задание 24.

Написать программу, которая вводит по строкам с клавиатуры двумерный массив и вычисляет сумму его элементов:

а) По столбцам;

б) По строкам. 

Program P4;

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

    i,j,Sh1,Sh2,Sh3,Sd1,Sd2,Sd3:integer;

Begin

for i:=1 to 3 do

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

for i:=1 to 3 do begin

    Sd1:=a[i,1]+Sd1;

    Sd2:=a[i,2]+Sd2;

    Sd3:=a[i,3]+Sd3; end;

for j:=1 to 3 do begin

    Sh1:=a[1,j]+Sh1;

    Sh2:=a[2,j]+Sh2;

    Sh3:=a[3,j]+Sh3; end;

Writeln('Symma 1-i stroki=',Sh1);

Writeln('Symma 2-i stroki=',Sh2);

Writeln('Symma 3-i stroki=',Sh3);

Writeln('Symma 1-go stolbca=',Sd1);

Writeln('Symma 2-go stolbca=',Sd2);

Writeln('Symma 3-go stolbca=',Sd3); readln; End. 
 

Задание 25.

Организовать  двумерный массив (5х5) случайных  целых чисел из отрезка [0,60]. Найти  минимальный элемент среди элементов, расположенных выше главной диагонали. 

Program P5;

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

    i,j,min:integer;

Begin

randomize;

For i:=1 to 5 do

For j:=1 to 5 do a[i,j]:=random(61);

Writeln('Matrica do obrabotki');

For i:=1 to 5 do     begin

For j:=1 to 5 do write(a[i,j]:5); writeln;end;

min:=a[1,5];

For i:=1 to 5 do

For j:=1 to 5 do

    if (i<j) and (a[i,j]<min) then   min:=a[i,j];

Writeln('Minimym=',min);

Readln;

end. 
 

Организация подпрограмм с  помощью функций.

Задание 26.

Написать функцию, которая вычисляет объем цилиндра. Параметрами функции должны быть радиус и высота цилиндра. 

Program p1;

Var H,R,O:Real;

function Obem(R,H:real):real;

Begin

Obem:=Pi*Sqr(R)*H;

End;

Begin

Writeln('vvedite R i H');

Readln(R,H);

O:=obem(R,H);

Writeln('Obem=',O:2:2);

Readln;

End. 

Задание 27.

Написать фукцию, возвращающую:

  а) минимальное  среди двух;

  б) максимальное  среди двух;

Program p2;

Uses crt;

Var  a,b:integer;

min,max:integer;

Function maximum(a,b:integer):integer;

Begin

ClrScr;

if a>b then maximum:=a

else maximum:=b;

End;

Function minimum(a,b:integer):integer;

Begin

if a<b then minimum:=a

else minimum:=b;

End;

Begin

Read(a,b);

max:=maximum(a,b);

min:=minimum(a,b);

Write('mininimum=',min);

Write('maximum=',max); End. 

Задание 28.

Написать функцию  нахождения дискриминанта уравнения  и определяющая количество корней (т.е. принимает значения: 0,1, 2). 

Program Z3;

var a,b,c:integer;

Function D(a,b,c:integer):integer;

Begin

if Sqr(b)-4*a*c>0 then D:=2;

If Sqr(b)-4*a*c=0 then D:=1;

If Sqr(b)-4*a*c<0 then D:=0;

end;

Begin

Writeln('Vvedite a,b,c');

Readln(a,b,c);

Writeln('Yravnenie imeet' ,D(a,b,c),' kornei' );

Readln;

end. 

Задание 29.

Написать функцию  нахождения общего сопротивления при  параллельном соединении двух проводников.

R_общ.=  
 

Program Z4;

var R1,R2,rez:real;

function Sopr(R1,R2:real):real;

Begin

   Sopr:=1/R1+1/R2;

End;

Begin

Writeln('Vvedite R1 i R2');

Readln(R1,R2);

rez:=Sopr(R1,R2);

Writeln('Soprotivlenie=',Sopr(R1,R2):2:2);

Readln;

End. 
 

Задание 30.

Написать функцию,  вычисляющую процент от числа. Параметры- число и процент. 

Program Z5;

var N,P,rez:real;

function Procent (N,P:real):real;

Begin

    Procent:=(N*P)/100;

End;

begin

Writeln('Vvedite chislo i procent');

Readln(N,P);

rez:=Procent(N,P);

Writeln('Procent=',Procent(N,P):2:2);

Readln;

End. 

Вариант-9.

Задание 31.

Даны три стороны  треугольника. Написать функцию нахождения площади вписанной в треугольник  окружности. 

Program z1;

Var o,a,b,c,S,r,p:real;

Function Ploschad(a,b,c:real):real;

var p,s:real;

Begin

p:=(a+b+c)/2;

S:=Sqrt(p*(p-a)*(p-b)*(p-c));

r:=(2*S)/(a+b+c);

ploschad:=Pi*Sqr(r);

End;

Begin

Writeln('vvedite tri storoni treygolnika');

readln(a,b,c);

O:=Ploschad(a,b,c);

Writeln('ploschad ravna=',O:2:2);

Readln;

End. 

Задание 32.

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

Program p2;

Var v,v0,t,a:Real;

Function Skorost(v,v0,a:real):real;

Begin

Skorost:=v-a*t;

End;

Begin

Writeln('vvedite konech.skorost, vremya i yskorenie');

Readln(a,t,v);

v0:=Skorost(a,t,v);

Writeln('Nachalnaya skorost ravna=',v0:4:2);

Readln;

End. 

Задание 33.

Написать программу, которая вычисляет квадратный корень произведения трех вещественных чисел, введенных с клавиатуры. 

Program z3;

Var kor,a,b,c:real;

Function Koren(a,b,c:real):Real;

Begin

Koren:=Sqrt(a*b*c);

End;

Begin

Writeln('vvedite tri chisla');

Readln(a,b,c);

Kor:=Koren(a,b,c);

Writeln('koren chisel raven=',kor:2:2);

Readln;

End. 

Задание 34.

Написать функцию, которая вычисляет значение выражения от аргументов a и b. tg(a)+ctg(b). 

 Program p4;

Var arg,a,b:real;

Function Argymenti(a,b:real):real;

Begin

Argymenti:=sin(a)/cos(a)+cos(b)/sin(b);

End;

Begin

Writeln('vvedite dva chisla');

Readln(a,b);

Arg:=Argymenti(a,b);

Writeln('Znachenie virazheniya ravno=',Arg:2:2);

Readln;

End. 

Задание 35.

Написать функцию, определяющую среднее арифметическое среди элементов в массиве. 

Program p5;

uses crt;

Var a:array[1..4] of real;

i:integer;

sa:real;

Function Srednee(var a:array of real):real;

Var sum:real;

Begin

For i:=0 to 3 do

Sum:=sum+a[i];

Srednee:=sum/4;

End;

Begin

ClrScr;

Writeln('vvedite massiv');

For i:=1 to 4 do

Readln(a[i]);

sa:=Srednee(a);

Writeln('srednee arifmeticheskoe=',sa:4:2);

Readln;

End. 
 

              Организация подпрограмм с помощью процедур. 

Задание 36

Даны две точки  с координатами (х1, х2), (у1,у2). Найти  длину отрезка.

а) без параметра 

Procedure dlina;

Var x1,x2,y1,y2:integer;

d:real;

Begin

Writeln('vvedite koordinati');

Write('x1='); readln(x1);

Write('x2='); readln(x2);

Write('y1='); readln(y1);

Write('y2='); readln(y2);

d:=Sqrt(sqr(x1-x2)+sqr(y1-y2));

Writeln('dlina=',d);

End;

Begin

Dlina;

Readln;

End. 

б) с параметром

Program p2;

Procedure dlina(x1,x2,y1,y2:integer);

      Var d:real;

begin

d:=Sqrt(Sqr(x1-x2)+sqr(y1-y2));

Writeln(dlina=',d:2:2);

end;

begin

Writeln('vvedite koordinati');

Write('x1='); Readln(x1);

Write('x2='); Readln(x2);

Write('y1='); readln(y1);

write('y2='); Readln(y2);

Dlina(x1,x2,y1,y2);

Readln;

End. 
 
 
 
 
 

Вариант-9 

Задание 37.

Найдите x из пропорции .

Program p1;

    Var a,b,c:real;

Procedure proporciya(a,b,c:real);

    Var x:real;

    Begin

x:=((a+b)*(a+c))/(b-c);

Writeln('proporciya=',x:2:2);

End;

Begin

Writeln('vvedite znacheniya a,b,c');

Readln(a,b,c);

Proporciya(a,b,c);

Readln;