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;

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:=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

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

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

Program p5;

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.