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

Колледж Экономики и информационных технологий

Отчет по учебной практике

Дисциплина: Основы алгоритмизации.

Выполнила: Гавриляченко Н.

Группа Г-121

Проверила: Абилова Ж.М.

Уральск, 2009

Одномерные массивы.

Организация ввода и вывода данных

Вариант- 6.

Задание 1.

Организовать ввод и вывод одномерного массива А1..А10 из вещественных чисел с помощью формулы А[i]:=cos(i+2i+1).

program p1;

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

i:integer;

begin

for i:=1 to 10 do a[i]:=cos(sqr(i)+2*i+1)

for i:=1 to 10 do

writeln ('a[',i,']=',a[i]);

readln;

end.

Задание 2.

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

Program p1;

Var a: array [1..15] of integer;

i,j,k,n:integer;

Begin

For i:=1 to 15 do

Read(a[i]);

For i:=1 to 15 do

Write(' ',a[i]);

For i:=1 to 15 do

Begin

If i mod 2=0 then k:=k+a[i];

If i mod 2=1 then n:=n+a[i];

End;

WriteLn('k=',k);

Writeln('n=',n);

Readln;

End.

Задание 3. Организовать одномерный массив из 20 целых чисел. Найти сумму всех квадратных элементов в массиве и вывести на экран.

program p2;

uses crt;

var a:array [1..20] of integer;

i,s:integer;

begin clrscr;

writeln ('vvedi 20 chisel');

for i:=1 to 20 do readln (a[i]);

for i:=1 to 20 do a[i]:=sqr(i);

for i:=1 to 20 do writeln ('a[','i',']=',a[i]);

for i:=1 to 20 do

s:=s+a[i];

writeln ('summa vsex kvadratnix elementov=',s);

readln;

end.

Задание 4.

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

Program p4;

Uses crt;

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

i,s:integer;

Begin

ClrScr;

Writeln('vvedite 10 chisel');

for i:=1 to 10 do Readln (a[i]);

for i:=1 to 10 do a[i]:=Sqr(i);

For i:=1 to 10 do WriteLn('a[',i,']=',a[i]);

For i:=1 to 10 do

if (a[i] mod 3=0) then

s:=s+a[i];

writeln('s=',s);

Readln;

End.

Задание 5.

Организовать одномерный массив из 20 чисел. Удвоить наибольший и наименьший элементы.

Program p6;

Uses crt;

Var a:array[1..20] of integer;

i,max,min:integer;

Begin

ClrScr;

WriteLn('Vvedite massiv');

For i:=1 to 20 do readln(a[i]);

max:=a[1];

For i:=1 to 20 do If a[i]>max then max:=a[i];

max:=max*2;

min:=a[1];

For i:=1 to 20 do If a[i]<min then min:=a[i];

min:=min*2;

Writeln('Maksimalnij element massiva=',max);

Writeln('Minimalnij element massiva=',min);

Readln; End.

Задание 6.

Организовать массив из 20 чисел. Отсортировать по возрастанию. Вывести массив до и после обработки.

Program sortirovka;

Uses crt;

Var a:array[1..20] of integer;

i,j,b,d:integer;

Begin

ClrScr;

Randomize;

For i:=1 to 20 do a[i]:=random(51);

For i:=1 to 20 do Write('a[',i,']=',a[i]:3);

For j:=1 to 19 do

For i:=1 to 19 do

If a[i]>a[i+1] then

Begin

b:=a[i];

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

a[i+1]:=b

End;

For i:=1 to 20 do Write('a[',i,']=',a[i]:3);

Readln;

End.

Задание 7

Организовать одномерный массив из 15 чисел. Первые 7 чисел отсортировать по возрастанию, последние 7 чисел по возрастанию. Вывести массив до и после обработки.

Program p8;

Uses crt;

Var a:array [1..15] of integer;

i,j,t,b:integer;

Begin

ClrScr;

For i:=1 to 15 do ReadLn(a[i]);

For j:=1 to 7 do

Begin

t:=j;

For i:=j to 7 do

If a[i]<a[t] then

t:=i;

b:=a[t];

a[t]:=a[j];

a[i]:=b;End;

For j:=9 to 15 do

Begin

t:=i;

For i:=j to 15 do

If a[i]<a[t] then

t:=i;b:=a[t];a[t]:=a[j];

a[j]:=b;End;

For i:=1 to 15 do

Write(' ',a[i]); End.

Задание 8.

В одномерном массиве целых чисел определить минимальный элемент, заменить его на 0. Стоящие за ним элементы на 6.

Program p2;

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

i,min,j,t:integer;

begin

Writeln ('vvedite massiv');

For i:=1 to 10 do Readln(a[i]);

For j:=1 to 10 do

begin

min:=a[1];

t:=1;

for i:=2 to 10 do

If a[i] <min: =a[i];

t:=i;End;

a[t]:=0;

for i:=t+1 to 10 do

a[i]:=6;

for i:=1 to 10 do

Writeln('a[',i,']=',a[i]); Readln; End.

Задание 9.

Организовать одномерный массив целых положительных чисел. Найти среднее арифметическое, определить количество элементов, больших этого среднего.

Program p3;

Uses crt;

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

i,s,n:integer;

sa,sg:real;

Begin

ClrScr;

Writeln ('vvedite massiv');

Begin

For i:=1 to 10 do Readln(a[i]);

End;

For i: =1 to 10 do

s:=s+a[i];

sa:=s/5;

For i:=1 to 10 do

If a[i]>sa then

Begin

n:=n+1;

End;

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

Writeln ('V massive',n,'elementov bolshih sred.arifmetich'); Readln; End.

Задание 10.

Организовать массив. Определить среднее арифметическое и геометрическое, сравнить их между собой, если ср. арифметическое>ср. геометрического, то прибавить к каждому элементу массива 2, если ср. геометрическое>ср. арифметического, то умножить на 2.

Program p4;

Uses crt;

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

c,n:real;

i:integer;

Begin

ClrScr;

Writeln('vvedite massiv');

for i:=1 to 10 do readln(a[i]);

for i:=1 to 10 do

c:=(c+a[i]);

c:=c/10;

for i:=1 to 10 do

n:=sqr(10);

if c>n then for i:=1 to 10 do

a[i]:=a[i]+2 else if n>c then for i:=1 to 10 do a[i]:=a[i]*2;

Writeln('c=',c,' n=',n);

Readln;

End.

Задание 11.

Дан массив 10 целых чисел. Отсортируйте его, найдите в нем контрольное число. Все элементы до контрольного числа замените на противоположные.

Program p5;

Uses crt ;

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

c,b,i,t,j:integer;

begin

Writeln('vvedite massiv');

For i:=1 to 10 do Readln(a[i]);

For j:=1 to 10 do

Begin

t:=j;

For i:=j to 10 do

If a[i]<a[t] then t:=i;

b:=a[t];

a[t]:=a[j];

a[j]:=b;

End;

Write('vivesti kontrolnoe chislo b=');

readln(b);

c:=0;

For i:=1 to 10 do

if a[i]=b then c:=i;

If c:=0 then

WriteLn('ravnih b net')

else for i:=1 to c-1 do a[i]:=-a[i];

For i:=1 to 10 do write(a[i]:2);

Readln;

End.

Задание 12.

Дан массив, состоящий из 20 символов. Отсортировать его по возрастанию. Ввести 2 числа a и b от 0 до 255. Определить количество элементов, входящие в отрезок [char(a), char(b)].

Program p6;

Uses crt;

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

i,j,b,t,c,f:integer;

Begin

Writeln('vvedite 20 elemenyov');

for i:=1 to 20 do Readln(a[i]);

for j:=1 to 20 do

Begin

t:=j;

for i:=j to 20 do

if a[i]<a[t] then t:=i;

b:=a[t];

a[t]:=a[j];

a[j]:=b;

End;

writeln('vvedite 2 chisla c<f');

Readln(c,f);

Writeln('elementi vhodyachie v otrezok [c,f]');

for i:=1 to 20 do

if (a[i]>=c) and (a[i]<=f) then write(a[i]:3);

WriteLn;

For i:=1 to 20 do

Write(' ',a[i]);

Readln;

End.

Задание 13.

Дан одномерный массив из 10 целых чисел. Среди элементов массива найти корни квадратного уравнения x²
+5-6=0. Если таковые отсутствуют, то вывести сообщение об этом.

ProgramP8;

var m:array [1..5] of integer;

p, i:integer;

a,b,c,x1,x2:real;

D:real;

Begin

a:=1;

b:=5;

c:=-6;

D:=b*b-4*a*c;

If D>0 then

begin

x1:=(-b+sqrt(D))/(2*a);

x2:=(-b-sqrt(D))/(2*a);

Writeln('pervii koren yravneniya=',x1:1:1);

Writeln('vtoroi koren yravneniya=',x2:1:1);

Writeln('Vvedite massiv');

For i:=1 to 5 do Readln(m[i]); p:=0;

For i:=1 to 5 do

If x1=m[i] then

p:=i;

if p<>0 then Writeln (' ',x1:1:1,' est v massive'); end else

Writeln(' ',x1:1:1,' net v massive');

For i:=1 to 5 do If x2=m[i] then p:=i;

if p<>0 then begin Writeln ('',x2:1:1,' est v massive');end else

Writeln(' ',x2:1:1,' net v massive');

Readln;End.

Вариант
12
.

Задание 14.

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

Рrogram p1;

Uses crt;

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

c,b,i,j,t:integer;

Begin

ClrScr;

Writeln('vvedite 10 chisel');

For i:=1 to 10 do ReadLn(a[i]);

For j:=1 to 10 do

Begin

t:=j;

for i:=j to 10 do

If a[i]<a[t] then t:=i;

b:=a[t];

a[t]:=a[j];

a[j]:=b;

End;

Write('vvedite kontrolnoe chislo b=');

Readln(b);

a[t]:=0;

for i:=t+1 to 10 do

a[i]:=sqr(a[i]);

For i:=1 to 10 do

if a[i]=b then c:=i;

If c=0 then

Writeln('a[',i,']=',a[i]); Readln; End.

Задание 15.

Напишите программу, которая вводит с клавиатуры 30 целых чисел, определяет среднее арифметическое первых десяти чисел, вторых десяти и последних десяти. После этого определяется максимальное и минимальное среднее арифметическое и выводится сообщение.

Program p2;

Uses crt;

Var a:array[1..30]of integer;

i,max,min:integer;

s,sa[1],sa[2],sa[3]:real;

Begin

Writeln('vvedite massiv');

for i:=1 to 30 do Readln(a[i]);

Begin

for i:=1 to 10 do

s:=s+a[i];

sa[1]:=s/10;

Writeln('srednee arifmeticheskoe pervih 10 chisel=',sa[1]:2:2);

for i:=11 to 20 do

s:=s+a[i];

sa[2]:=s/10;

Writeln('srednee arifmeticheskoe vtorih 10 chisel=',sa[2]:2:2);

for i:=21 to 30 do

s:=s+a[i];

sa[3]:=s/10;

Writeln('srednee arifmeticheskoe tretih 10 chisel=',sa[3]:2:2);

End;

max:=sa[1];

for i:=1 to 3 do

if sa[i]>max then

Begin

max:=sa[i];

End;

min:=a[1];

for i:=1 to 3 do

if sa[i]<min then

Begin

min:=sa[i];

End;

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

Задание 16.

Организовать два массива a[i] и b[i] целых чисел. Окружность задана уравнением (х-1)²
+(у+2)²
=16. Среди соответствующих пар (a[i], b[i]) вывести те, которые являются координатами внешних точек окружности.

Program p3;

Uses crt;

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

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

i:integer;

x,y:real;

Begin

ClrScr;

Writeln('Vvedite massiv a');

For i:=1 to 10 do Readln(a[i]);

Writeln('Vvedite massiv b');

For i:=1 to 10 do Readln(b[i]);

Writeln(' koordinati vneshnih tochek okrugnosti (x-1)^2+(y+2)^2');

For I:=1 to 10 do

If Sqr(a[i]-1)+Sqr(b[i]+2)>16 then

Writeln('[',a[i],',',b[i],']');

Readln;

End.

Задание 17.

Дана функция Z=6x²
+7y. Организовать двумерный массив, значений функции Z от индексов i, j.

а)Определить максимум, минимум функции;

б) Найти среднее арифметическое.

Program p1;

Uses crt;

Var z:array[1..3,1..3] of integer;

i,j,min,max:integer;

sa,s:real;

Begin

ClrScr;

for i:=1 to 3 do

For j:=1 to 3 do

Begin

z[i,j]:=6*Sqr(i)+7*j;

Writeln('z[',i,',',j,']=',z[i,j]); End;

max:=z[1,1];

for i:=1 to 3 do

For j:=1 to 3 do

If z[i,j]>max then

max:=z[i,j];

writeln('maksimalnoe znachenie=',max);

min:=z[1,1];

for i:=1 to 3 do

For j:=1 to 3 do

If z[i,j]<min then

min:=z[i,j];

writeln('Minimalnoe znachenie=',min);

For i:=1 to 3 do

For j:=1 to 3 do

s:=s+z[i,j];

sa:=s/9;

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

Readln;

End.

Задание 17.

Дана матрица целых чисел размером 5х6 (random). Отсортировать каждую строку матрицы по возрастанию. Вывести матрицу до и после обработки.

Program p2;

Uses crt;

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

i,j,n,t:integer;

Begin

ClrScr;

Randomize;

For i:=1 to 5 do

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

For i:=1 to 5 do begin

For j:=1 to 6 do Write(a[i,j]:3);

Writeln;

End;

Writeln;

For i:=1 to 5 do

For n:=1 to 5 do

For j:=1 to 5 do

If a[i,j]>a[i,j+1] then

Begin

t:=a[i,j];

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

a[i,j+1]:=t;

End;

For i:=1 to 5 do

Begin

For j:=1 to 6 do

Write(a[i,j]:3);

Writeln;

End;

Readln;

end.

Задание 18.

Дана матрица целых чисел размером 3х5. Заменить все положительные элементы на 5, все отрицательные на 3, все нули на нуль.

Program p3;

Uses crt;

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

i,j:integer;

Begin

ClrScr;

Writeln('vvedite elementi massiva');

For i:=1 to 3 do

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

For i:=1 to 3 do

For j:=1 to 5 do

Begin

If a[i,j]>0 then a[i,j]:=5;

If a[i,j]<0 then a[i,j]:=3 end;

For i:=1 to 3 do begin

For j:=1 to 5 do

Write(a[i,j]:2);

Writeln;End;

readln;

End.

Задание 19.

Даны две матрицы А и В размером 4х4. Вычислить и вывести на экран матрицу С=А+В. Найти сумму элементов матрицы С, кратных 3, но не кратных 2.

Program p4;

Uses crt;

Var A,B,C:array[1..4,1..4] of integer;

i,j,sum:integer;

begin

ClrScr;

Writeln('vvedite elementi massiva A');

For i:=1 to 4 do

For j:=1 to 4 do Read(A[i,j]);

Writeln('vvedite elementi massiva B');

For i:=1 to 4 do

For j:=1 to 4 do Read(B[i,j]);

Writeln;

For i:=1 to 4 do

For j:=1 to 4 do

C[i,j]:=A[i,j]+B[i,j];

Write('C[i,j]=',C[i,j]);

for i:=1 to 4 do

For j:=1 to 4 do

Writeln(c[i,j]);

for i:=1 to 4 do

For i:=1 to 4 do

For j:=1 to 4 do

If (C[i,j] mod 3=0) and (c[i,j] mod 2<>0) then

sum:=sum+c[i,j];

Writeln('symma elementov matrici C=',sum:2);

For i:=1 to 4 do

For j:=1 to 4 do

Writeln('C[',i,', ',j,']=',C[i,j]);writeln; Readln; End.

Задание 20.

Даны две матрицы А и В. Сравнить матрицы поэлементно. Найти количество элементов матрицы А, больших, чем элементы матрицы В и наоборот. Сравнить их. Вывести сообщение: А>В или В>А.

Program p5;

Uses crt;

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

i,j,t,k:integer;

Begin

ClrScr;

Writeln('vvedite elementi matrici a');

For i:=1 to 4 do

For j:=1 to 4 do Read(a[i,j]);

Writeln('vvedite elementi massiva b');

For i:=1 to 4 do

For j:=1 to 4 do Read(b[i,j]);

For i:=1 to 4 do

For j:=1 to 4 do

Begin

If a[i,j]>b[i,j] then t:=t+1;

If b[i,j]>a[i,j] then k:=k+1;

end;

Writeln('t=',t);

Writeln('k=',k);

If t>k then Writeln('elementi massiva a bolshe b') else

Writeln('elementi massiva b bolshe a');

If t=k then Writeln('elementi massiva a i b ravni');

Writeln;

Readln;

End.

Задание 21.

Организовать двумерный массив (размерность 3х3). Вывести на экран в виде матрицы.

Program p1;

Uses crt;

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

i,j:integer;

Begin

ClrScr;

Writeln('vvedite elementi matrici: a[',i,' ',j,']');

For i:=1 to 3 do

For j:=1 to 3 do

Readln(a[i,j]);

For i:=1 to 3 do begin

For j:=1 to 3 do

Write(a[i,j]:3);

Writeln;end;

Readln;

End.

Задание 22.

Дана матрица 4х3 целых чисел. Найти сумму элементов, сумма индексов которых является:

а) Четным числом;

б) Кратно 3.

Program P2;

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

i,j,S:integer;

Begin

For i:=1 to 4 do

For j:=1 to 3 do

read(a[i,j]);

For i:=1 to 4 do

for j:=1 to 3 do

If (i+j) mod 2 =0 then

S:=S+a[i,j];

Writeln('Summa elementov,sum indeksov kot chetnaya=',S);

For i:=1 to 4 do

for j:=1 to 3 do

if (i+j) mod 3 =0 then

S:=S+a[i,j];

Writeln('Summa el-v,sum indeksov kratna 3=',S);

Readln;

End.

Задание 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]. Найти минимальный элемент среди элементов, расположенных выше главной диагонали.

ProgramP5;

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 из пропорции .

Programp1;

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;

End.

Задание 38.

Даны координаты вершин треугольника. Найти его периметр.

Program p6;

Var x1,y1,x2,y2,x3,y3:real;

Procedure Perimetr(x1,y1,x2,y2,x3,y3:real);

Var P,d1,d2,d3:real;

Begin

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

Writeln('dlina1=',d1:2:2);

d2:=Sqrt(sqr(x2-x3)+sqr(y2-y3));

Writeln('dlina2=',d2:2:2);

d3:=Sqrt(sqr(x1-x3)+sqr(y1-y3));

Writeln('dlina3=',d3:2:2);

If (d1+d2>d3) and (d2+d3>d1) and (d1+d3>d2) then

P:=d1+d2+d3 else

Writeln('Takogo treygolnika ne sychestvyet');

Writeln('Perimetr=',P:2:2);

End;

Begin

Writeln('vvedite koordinati');

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

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

Write('x3='); Readln(x3);

Write('y1='); Readln(y1);

Write('y2='); Readln(y2);

Write('y3='); Readln(y3);

Perimetr(x1,y1,x2,y2,x3,y3);

Readln;

End.

Задание 39.

Определить среднесуточную температуру, если показания термометра: утром-n^o
C, вечером- k^o
C, днем- m^o
C.

Program p3;

Var n,k,m:real;

Procedure Temperatyra(n,k,m:real);

Var sst:real;

Begin

sst:=(n+k+m)/3;

Writeln('Temperatyra=',sst:2:2);

End;

Begin

Writeln('vvedite pokazaniya termometra ytrom,vecherom i dnem');

Readln(n,k,m);

Temperatyra(n,k,m);

readln;

End.

Задание 40.

За какое время пешеход доберется до соседнего города, если его скорость равна V(км/ч), а расстояние- S(км).

Program p2;

Var S,v:real;

Procedure Vremya(s,v:real);

Var t:real;

Begin

t:=s/v;

Writeln('Vremya=',t:2:2);

End;

Begin

Writeln('vvedite skorost i rasstoyanie');

readln(s,v);

Vremya(s,v);

Readln;

End.

Задание 41.

Найти площадь круга S, вписанного в квадрат со стороной a.

Program p5;

Var a:real;

Procedure Ploschad(a:real);

Var s:real;

Begin

S:=pi*sqr(a/2);

Writeln('ploschad=',s:2:2);

End;

Begin

Writeln('vvedite dliny storoni a');

Readln(a);

Ploschad(a); Readln; End.

Задание 42.

Найти значение выражения y= (a+b+c)²
.

Program p4;

Var a,b,c,d:real;

Procedure Virazhenie(a,b,c,d:real);

Var y:real;

Begin

d:=3;

a:=2*d;

b:=3*d;

c:=d/2;

y:=sqr(a+b+c);

Writeln('Virazhenie=',y:2:2);

End;

Begin

Virazhenie(a,b,c,d);

Readln;

End.

Вариант- 5.

Задание 43.

Дан одномерный массив. Найти и вывести на экран значения и номера элементов не превосходящих контрольное число. Оформить процедурой.

Program p2;

Var a:array[1..5] of integer; i,n:integer;

Procedure Massiv(a:array of integer;n:integer);

Var i:integer;

begin

for i:=0 to 5 do

If a[i]<=n then begin

Writeln('a[',i,']=' ,a[i]);

end;end;

Begin

Writeln('vvedite kontrolnoe chislo');

Readln(n);

Writeln('vvedite massiv');

For i:=1 to 5 do

Readln(a[i]);

Massiv(a,n);

Readln;

End.

Задание 44.

Дана функция y=ax³
+bx²
+cx+d. Вывести в виде таблицы значения функции на отрезке [-k,k]. Вычисления оформить функцией y(a,b,c,d,k).

Program p3;

Var a,b,c,d,y:real;

x,k:integer;

Function Tablica(a,b,c,d:real; x:integer):real;

Begin

Tablica:=a*x*x*x+b*sqr(x)+c*x+d;

End;

Begin

Writeln('vvedite znacheniya fynccii');

Readln(a,b,c,d,k);

For x:=-k to k do

begin

y:=Tablica(a,b,c,d,x);

Writeln('y=',y:2:2);

End;

Readln;

End.

Задание 45.

Даны 4 числа a,b,c,d. Найти объемы параллелепипедов на отрезках a,b,c,d. Среди объемов найти наименьший. Вычисление объемов оформить функцией V(a,b,c).

Program p4;

Var v:array[1..4] of integer;

min,i, a,b,c,d,v1,v2,v3,v4:integer;

Function Obem(a,b,c,d:integer):integer;

Begin

obem:=a*b*c;

end;

Begin

Writeln('vvedite znacheniya peremennih');

readln(a,b,c,d);

v[1]:=obem(a,b,c,d);

v[2]:=obem(d,c,b,a);

v[3]:=obem(b,a,d,c);

v[4]:=obem(c,d,a,b);

for i:=1 to 4 do Writeln('obem',i,'parallelepipeda=',v[i]:2);

min:=v[1];

for i:=1 to 4 do

if v[i]<min then

min:=v[i];

writeln('min=',min);

Readln;

End.

Комбинированный тип.

Объявление записи.

Задание 46.

Дан список учащихся из 10 записей. Каждая запись имеет поле фамилия, имя, номер класса, буква.

а) Найти однофамильцев из одного класса;

б) Найти двух учащихся тезок.

Program z;

type ycheniki=record

fam:string[15];

imya:string[10];

class:record

bykva:char;

god:integer;

end;

end;

var spisok:array [1..6] of ycheniki;

i,j:integer;

begin

for i:=1 to 6 do begin

with spisok[i] do begin

writeln('vvedite familiu ychenika',i);

readln(fam);

writeln('vvedite imya',i);

readln(imya);

writeln('vvedite ego klass',i);

readln(class.god);

writeln('vvedite bykvy klassa');

readln(class.bykva);

end;end;

writeln;

writeln('spisok odnofamilcev v odnom klasse:');

for i:=1 to 5 do

for j:=i+1 to 6 do

if (spisok[i].fam=spisok[j]. fam) and

(spisok[i].class.god=spisok[j].class.god)

and (spisok[i].class.bykva=spisok[j].class.bykva)

then writeln(spisok[j].fam, ' ',spisok[i].imya, ' ',

spisok[i].class.god.bykva,' ',

spisok[j].imya, ' ',spisok[j].class.god.bykva);

writeln('Ychashiesya tezki:');

for i:=1 to 5 do

for j:=i+1 to 6 do

if (Spisok[i].fam=spisok[j].fam)and(spisok[i].imya=spisok[j].imya)

then

writeln(spisok[j].fam, ' ', spisok[i].imya, ' ',spisok[i].class.god.bykva,' ',

spisok[j].imya, ' ', spisok[j].class.god.bykva);

writeln('Spisok ychashixsya s odinakovoi bykvoi klassa:');

for i:=1 to 5 do

for j:=i+1 to 6 do

if spisok[i].class.bykva=spisok[j].class.bykva

then

writeln(spisok[i].fam, ' ',spisok[i].imya, ' ',spisok[i].class.god, ' ',

(spisok[j].fam, ' ',spisok[j].imya, ' ',spisok[j].class.god);

readln;

Задание 47.

Написать программу, выдающую сведения об ассортименте игрушек в магазине. Структура записи: название игрушки, цена, количество, возрастные границы.

А)вывести названия игрушек, которые подходят детям до 3 лет;

Б)самая дорогая игрушка;

В)название игрушки, которая по стоимости не превышает х тг и подходит ребенку в возрасте до а лет.

Program Assortiment;

type Igryshki=record

name:string[15];

cena:integer;

kol:integer;

vozr:integer;

end;

var Magazin:array [1..6] of Igryshki;

i,j,max,x,a,b:integer;

Begin

for i:=1 to 6 do begin

with igryshki[i] do begin

writeln('Vvedite nazvanie igryshki',i);

readln(name);

writeln('Cena:');

readln(cena);

writeln('Kolichestvo:');

readln(kol);

writeln('Vozrastnie granici:');

readln(vozr);

end;end;

Writeln;

Writeln('Samaya dorogaya igryshka:');

max:=igryshki[1].cena;

For i:=1 to 6 do

if igryshki[i].cena>max then begin

max:=igryshki[i].cena;

Writeln(igryshki[i].name, ' ', max); end;

Writeln('Igryshki dlya detei v vozraste 3 let:');

For i:=1 to 6 do

if igryshki[i].vozr=3 then begin

Writeln(igryshki[i].name, ' stoimostu ',igryshki[i].cena, 'tg'); end;

writeln('vvedite stoimost');

readln(x);

For i:=1 to 6 do

if (igryshki[i].cena<x) then begin

writeln('Igryshki ' ,igryshki[i].name, 'stoimostu ' ,igryshki[i].cena,' ne previshaut ',x,' tg' ); end;

writeln('vvedite vozrast ');

readln(a);

For i:=1 to 6 do

if igryshki[i].vozr=a then begin

writeln(igryshki[i].name , 'podxodyat dlya vozrasta' , igryshki[i].vozr); end;

readln;

end.

Задание 48.

Список книг состоит из 10 записей:

Поля: Фамилия автора;

Название книги;

Год издания;

Количество страниц;

а) Найти название книг данного автора, изданных с 1960 года.

б) Определить имеются ли книги с названием «Информатика», если да, то сообщить фамилию авторов, год издания и количество страниц.

в) Вывести название книг и их авторов, если количество страниц превосходит среднее количество страниц по всему списку.

PROGRAM P1;

Type knigi=record

fam:string;

name:string;

page:integer;

god:integer;

End;

Var Spisok:array[1..5] of knigi;

i,o,summa:integer; m:string;

Sr:real;

Begin

For i:=1 to 5 do

Begin

With Spisok[i] do

Begin

Writeln('Vvedite familiu avtora', i);

Readln(fam);

Writeln('Vvedite nazvanie knigi', i);

Readln(name);

Writeln('vvedite god izdaniya');

Readln(god);

Writeln('Vvedite kolichestvo stranic');

Readln(page);

End;

End;

Writeln;

Writeln('Spisok knig izdannih s 1960 goda');

Writeln('Vvedite imya avtora');

Readln(m);

For i:=1 to 5 do

If (m=spisok[i].fam) and (spisok[i].god>=1960) then

Writeln(spisok[i].fam,' ',spisok[i].name,' ',spisok[i].god);

Writeln('Imeutsya li knigi s nazvaniem "Informatika"?');

For i:=1 to 5 do

begin

If spisok[i].name='Informatika' then

Writeln(Spisok[i].fam,' ',spisok[i].god,' ',spisok[i].page); o:=o+1 end;

if o=0 then Writeln('Takih knig net');

Summa:=0;

For i:=1 to 5 do

Summa:=Summa+Spisok[i].page;

Sr:=Summa/5;

Writeln('Srednee kolichestvo stranic=',Sr:2:2);

For i:=1 to 5 do

If Spisok[i].page>Sr THEN

Writeln('Stranici prevoshodyawie srednee kolichestvo stranic po spisky ',Spisok[i].fam,' ',Spisok[i].name);

Readln;

End.

Файловая переменная.

Типизированные файлы.

Задание 49.

а) Организовать файл CHISLA.dat с целыми числами.

Program p1;

Var f:file of integer;

n,i,c:integer;

Begin

Writeln('sozdat fail iz celih chisel');

Assign (f,'c:\ucheba\CHISLA.dat');

Rewrite(f);

Readln(n);

For i:=1 to n do

Begin

Read(c);

Write(f,c);

End;

End.

б) Составить программу, подсчитывающую количество элементов в файле, их сумму, среднее арифметическое.

program p3;

var

f:file of integer;

i,n,s:integer;

elem,k:integer; sum:integer;sa:real;

begin

assign(f,'c:\ucheba\kolichestvo.txt');

reset(f);

sum:=0; k:=0;

while not eof (f) do

begin

read(f,elem); k:=k+1;

sum:=sum+elem;

end;

writeln('summa elementov=',sum);

sa:=sum/k;

writeln('sa=',sa:4:2);

readln;

end.

Вариант 4в.

Задание 50.

Организовать символьный файл f из Nкомпонент. После этого организовать файл g, содержащий все компоненты файла f в обратном порядке. Вывести содержимое файлов на экран.

Program p1;

Var f,g:file of char;

n,i:integer;

c:char;

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

Begin

Assign(f,'c:\ucheba\Simvoli.txt');

Rewrite(f);

Writeln('Vvedite kolichestvo komponent ');

Readln(n); writeln;

writeln('vvedite komponenti');

For i:=1 to n do

Begin

Readln(c);

Write(f,c);

End;

Close(f);

Reset(f);

Assign(g,'c:\ucheba\Simvol_.txt');

Rewrite(g);

i:=1;

While not eof (f) do

Begin

read(f,c);

a[i]:=c;

i:=i+1;

end;

for i:=n downto 1 do

Write(g,a[i]);

Close(f);

Close(g);

Reset(g);

Writeln('simvoli faila g');

While not eof(g) do

Begin

Read(g,c);

Writeln(c,' ');

End;

Close(g);

Readln;End.

Задание 51.

Организовать файл символов из N компонент. Определить символ, встречающийся в файле наиболее часто. Вывести на экр ан этот символ и его количество в файле.

Program z3;

var f:file of char;

i,n,k,j,max:integer;

c:char;

a:array [1..100] of char;

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

Begin

writeln('Sozdat fail iz simvolov');

assign(f,'c:\docume~1\3193~1\0016~1\ucheba\baza4.txt');

rewrite(f);

writeln('vvesti kolichestvo komponentov');

readln(n);

for i:=1 to n do

begin

readln(c);

write(f,c);

end;

close(f);

reset(f);

i:=1;

while not eof(f) do

begin

read(f,c);

a[i]:=c;

i:=i+1;

end;

for k:=1 to i do S[k]:=1;

for k:=1 to i do

for j:=k+1 to i do

if a[k]=a[j] then s[k]:=s[k]+1;

max:=s[1];

n:=1;

for k:=1 to i do

if max<s[k] then begin

max:=s[k];n:=k;end;

for k:=1 to i do

if s[k]=max then

writeln('simvol ', a[n],' vstrechaetsya ',n,' raz');

readln;end

.

Задание 52.

Напишите программу организующую хранение в файле нескольких записей (до 10) о результатах экзамена. Каждая запись содержит 3 поля: номер записи, фамилия, оценка. Организуйте вывод всей информации по форме: {1 Иванов 3}

Program Z1;

type ekzamen=record

n:integer;

fam:string [15];

oc:integer;

end;

var baza1:file of ekzamen;

rez:array [1..10] of ekzamen;

i:integer; y:integer;f:string[100];

begin

write('vvedite chislo ychenikov');readln(y);

f:='c:\docume~1\3193~1\0016~1\ucheba\baza1.txt';assign(baza1,f);rewrite(baza1);

for i:=1 to 10 do begin

with rez[i] do begin

Writeln('Familiya');

readln(fam);

Writeln('Ocenka');

readln(oc);

end;end;

writeln;

reset(baza1);

Writeln('Rezyltati ekzamena:');

for i:=1 to 10 do

Writeln(i,' ', rez[i].fam, ' ', rez[i].oc);

Readln;end.

Текстовые файлы.

Задание 53

Организовать файл из Nстрок (текстовый) text.txt.

Program p1;

Uses Crt;

Var f:text;

i,n:integer;

c:string;

Begin

ClrScr;

Writeln('sozdanie tekstovogo faila ');

Writeln('vvedite kolichestvi strok');

Readln(n);

Assign(f,'c:\ucheba\text.txt');

Rewrite(f);

For i:=1 to n do

Begin

Readln(c);

Writeln(f,c);

End;

Close(f);

Readln;

End.

Задание 54

Подсчитать среднюю длину строк из файла text.txt.

Program p2;

Uses crt;

Var f:text;

i,n,d:integer;

c:string;

Sa:real;

Begin

ClrScr;

Writeln('Nahozhdenie srednej dlini stroki');

Writeln;

Assign(f,'c:\ucheba\text.txt');

Reset(f);

d:=0;

While not eof(f) do

begin

Readln(f,c);

n:=n+1;

d:=d+length(c);

End;

Sa:=d/n;

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

Repeat Until Keypressed;

End.

Задание 55

Удалить из текстового файла все пробелы(delete (St, n, 1).

St - строка, n- позиция, 1-количество удаляемых символов.

Program p3;

Var f:text;

i,n:integer;

c:string;

Begin

Assign(f,'c:\ucheba\text.txt');

Reset(f);

While not eof(f) do

Begin

Readln(f,c);

for i:=1 to length(c) do

if c[i]=' ' then delete(c,i,1);

Writeln('Vivod faila bez probelov:',c);

End;

Readln;

End.

Задание 56

В текстовом файле text.txt определить максимальную длину строки.

Program p2;

Uses crt;

Var f:text;

i,n,max:integer;

c:string;

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

Begin

ClrScr;

Assign(f,'c:\ucheba\text.txt');

Reset(f);

i:=1;

While not eof(f) do

Begin

Readln(f,c);

a[i]:=length(c);

i:=i+1;

End;

n:=i;

max:=a[1];

for i:=1 to n do

Begin

If a[i]>max then max:=a[i]; end;

Writeln('maksimalnaya dlina stroki=',max);

End.

Задание 57

Строки из файла text.txt разбить на части нечетные по счету строки. Записать в файл text.txt, четные- в text2.txt

Programp5;

Uses crt;

var f,g,h:text;

c:string;

i,n:integer;

Begin

ClrScr;

Writeln('Sortirovka strok faila na chetnie i nechetnie');

Writeln;

Assign(f,'c:\ucheba\text.txt');

Reset(f);

Assign(g,'c:\ucheba\text1.txt');

Rewrite(g);

Assign(h,'c:\ucheba\text2.txt');

Rewrite(h);

i:=0;

While not eof(f) do

Begin

Readln(f,c);

i:=i+1;

If(i mod 2)=0 then

Writeln(g,c) else

Writeln(h,c);

End;

Close(h); Close(g); End.