Основные приемы работы в среде ТР

Актюбинский Политехнический колледж

Отчет

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

по программированию

Выполнила:

Волоснова А. С

учащаяся

группы 202АС

Проверила:

Гайсагалеева Б. М

Актобе 2010

ДНЕВНИК.

1. Линейная программа на Паскаль.

2. Программа с ветвлениями.

3. Циклическая программа.

4. Массивы.

5. Процедуры и функции.

6. Файловые данные в Паскале.

7. Записи в Паскале.

8. Строки.

9. Графика в Турбо-Паскале.

Раздел: Линейные алгоритмы

1.Описание: Программа вычисления периметра треугольника.

program one;

uses crt;

var a, b, P:integer;

begin clrscr;

writeln ('a=');

readln (a);

writeln ('b=');

readln (b);

P:=(a+b)*2;

writeln ('P=', P);

end.

2.Описание: Программа вычисления площади треугольника.

program one;

uses crt;

var a, b, h, s: real;

begin clrscr;

writeln ('A= B= H= ');

readln (a, b, h);

s:=h*(a+b)/2;

writeln ('S=', s:0:4);

readln;

end.

3.Описание: Программа вычисления количества теплоты по формуле 'Q=c*m*(t2-t1)

program one;

uses crt;

var Q, c, m, t2, t1:integer;

begin clrscr; textcolor (10);

writeln ('c=');

readln (c);

writeln ('m=');

readln (m);

writeln ('t2=');

readln (t2);

writeln ('t1=');

readln (t1);

Q:=c*m*(t2-t1);

writeln ('Q=c*m*(t2-t1)=', Q);

end

4.Описание: Программа вычисления величины силы тока I на участке цепи с R Ом и U В.

program one;

uses crt;

var I, U, R:real;

begin clrscr; textcolor (10);

writeln ('U='); readln (U);

writeln ('R=');

readln ®;

I:=U/R;

writeln ('I=', I:5:0);

end.

5.Описание: Программа вычисления расстояния между двумя точками с данными координатами x1,y1,x2,y2

program one;

uses crt;

var r: real; x1, x2,y1,y2:integer;

begin clrscr;

writeln ('znachenie x1=');

readln (x1);

writeln ('znachenie x2=');

readln (x2);

writeln ('znachenie y1=');

readln (y1);

writeln ('znachenie y2=');

readln (y2);

r:=sqrt (sqr (x2-x1)+sqr (y2-y1));

writeln ('rasstoyanie=', r);

end.

6.Описание: Известна сумма денег, имеющаяся у покупателя и стоимость одной ед. товара. Сколько ед. товара может купить покупатель и какова его сдача?

program one;

uses crt; var a, b, c:real; begin clrscr;

writeln ('summa deneg=');

readln (a);

writeln ('cena ed. tovara=');

readln (b);

c:=a/b;

writeln ('ostatok=', c);

end.7.Описание: Сумма цыфр введенного трехзначного натурального числа.

program one;

uses crt;

var a: integer; s, d, e, f: real;

begin clrscr;

writeln ('vvedi 3-hznachnoe chislo');

readln (a);

s:=a div 100;

d:=a mod 100 div 10;

e:=a mod 100 mod 10;

writeln (d:5:0); writeln (s:5:0); writeln (e:5:0);

f:=d+s+e; writeln (f:5:0);

end.

8.Описание: Найти площадь по известной стороне равностороннего треугольника.

program one;

uses crt;

var a, S: real;

begin clrscr;

writeln ('Vvedite storonu treugolnika');

readln (a);

S:=0;

S:=a*a*sqrt (3)/4;

writeln ('Ploshad ravna:', S:3:1);

readln;

end.

9.Описание: Бабушка вяжет в неделю 3 пары детских носков, пару женских и пару мужских и продает их. Считая, что в месяце 4 недели, определить, какую прибыль бабушка имеет за месяцю.

program one;

uses crt; var det, jen, muj, ned, mes: integer;

begin clrscr;

writeln ('det:=');

readln (det);

writeln ('jen:=');

readln (jen);

writeln ('muj:=');

readln (muj);

ned:=muj+jen+det;

mes:=4*ned;

writeln ('dohod=', mes);

end

10.Описание: Пирамида из звездочек

program one;

uses crt;

var j, i: integer;

begin clrscr;textcolor (9+5);

for i:=1 to 25 do begin gotoxy (40-i, i);

for j:=2 to 2*i do write ('*');

end;

readln;

end.

11.Описание:Вычислить произведение

Program one;

Uses crt;

Var a, b, p:integer;

begin clrscr;textcolor (9+5);

writeln ('a= b=');

readln (a, b);

p:=a*b;

textcolor (9+16);

writeln (`p=, p');

end.

12.Описание: Вычисление радиуса

Program one;

Uses crt;

Var l: real; r: integer;

begin clrscr;textcolor (5);

writeln ('R=');

readln ®;

l:=2*pi*r;

writeln (`radius=, r');

end.

13.Описание: Вычисление периметра квадрата

Program one;

Uses crt;Var а: integer;

begin clrscr;textcolor (5);

writeln ('a=');

readln (a);

p:=4*a;

writeln (`perimetr=, р');

end.

14.Описание: Выведение введенного числа

Program one;

Uses crt;Var s: integer;

begin clrscr;textcolor (5);

writeln ('s=');

readln (s);

writeln (`вы ввели число, s');

end.

15.Описание: Вычисление плотности по количеству жителей и площади.

Program one;

Uses crt;Var k, s: integer; p: real;

begin clrscr;textcolor (5);

writeln ('число жителей=');

readln (k);

writeln (`plosh=');

readln (s);

p:=s/k;

writeln (`plotnost=', p);

end.

Раздел: Разветвляющиеся алгоритмы

1.Описание: Вычисление уравнения

program one;

var x, y: integer;; begin write ('x='); readln (x); if x>0 then y:=sqr (sin (x)) else y:=1−2*sin (sqr (x)); writeln (y); end.

2.Описание: Деление нацело

Program ch;

Uses crt;

Var a, m, n:integer;

Begin clrscr;

Writeln (`m= n=');

Readln (m, n);

a:=m mod n;

If a=0 then write (m div n)

Else write (`net resh')

End.

3 .Описание: Написать программу на языке Pascal для реализации разветвляющегося алгоритма, где x — известные величины.

program one;

var x, y: real;

begin writeln ('');

write ('Vvedite x=');

readln (x); if x<=0.8 then

y:=exp (x-1)+3.14 else if (0.8<=5.27) then

y:=ln (x+5.96) else y:=2*x;

writeln ('y=', y:4:2); readln;end.

4. Описание: Написать программу на языке Pascal для реализации разветвляющегося алгоритма, где x — известные величины.

program one; var x, y, z:real; begin writeln (''); write ('Vvedite x='); readln (x); write ('Vvedite y='); readln (y);

if x-y>0 then z:=1/(x*y) else z:=sqr (x)*sqr (y); writeln ('z=', z:4:2); readln; end.

5 .Описание: Написать программу на языке Pascal для реализации разветвляющегося алгоритма, где x=ln a², y=1/arctg b; a, b — известные величины. program one; var x, y, z, a, b:real; begin writeln (''); write ('Vvedite a='); readln (a); write ('Vvedite b='); readln (b); x:=ln (sqr (a)); y:=1/arctan (b); if x-y>0 then z:=1/(x*y) else z:=sqr (x)*sqr (y); writeln ('z=', z:4:2); readln; end.

6. Описание: Заданы два прямоугольных параллелепипеда. Можно ли разместить их один в другом?program one; var a1, a2,b1,b2,c1,c2:integer; begin writeln ('vvedite shiriny, dliny, vusoty 1');

readln (a1,b1,c1); writeln ('vvedite shiriny, dliny, vusoty 2'); readln (a2,b2,c2); if ((a1<=a2) and (b1<=b2) and (c1<=c2)) or ((a1>a2) and (b1>b2) and (c1>c2)) then writeln ('mogno') else writeln ('nelzya'); readln; end.

7. Описание: номер клетки на шахматной доске 8×8 определяется двумя целыми числами — номер вертикали и номер горизонтали. Даны 4 целых положительных числа a, b, c, d. Выяснить, бьет ли ферзь, находящийся на клетке (a, b) клетку (c, d)

program one; var a, b, c, d: integer; begin read (a, b); read (c, d); if (a=c) or (b=d) or (abs (c-a)=abs (d-b))

then write ('ga') else write ('HeT');

readln

end

8. Описание: Возможно, ли построить треугольник с данными сторонами

program one;

uses crt;

var a, b, c:real;

begin clrscr;

writeln ('Стороны треугольника= ');

readln (a, b, c);

if (a

and (c

program one; var a, b, c:real; begin read (a, b, c); if (a>b) and (a>c) then write ('a²= ', a*a:1:4); if (b>a) and (b>c) then write ('b²= ', b*b:1:4); if (c>a) and (c>b) then write ('c²= ', c*c:1:4); readln end.

10.Описание:Вычисление большего из двух чиселProgram b_ch;

Uses crt;

Var a, b: integer;

Max:integer;

Begin clrscr;

Writeln (`a= b=');

Readln (a, b);

If a>b then max:=a else max:=b

Writeln (`max=', max);

End.

11.Описание:Вычисление меньшего из двух чисел

Program m_ch;

Uses crt;

Var a, b: integer;

Min:integer;

Begin clrscr;

Writeln (`a= b=');

Readln (a, b);

If a

Writeln (`min=', min);

End.

12.Описание:Деление нацело

Program ch;

Uses crt;

Var a, b, c:integer;

Begin clrscr;

Writeln (`a= b=');

Readln (a, b);

C:=a mod b;

If c=0 then write (a div b)

Else write (`net resh')

End.

13.Описание: Сравнение чисел трехзначного числа

Program ch;

Uses crt;

Var a, b, c, d, e, i: integer;

Begin clrscr;

Writeln (`a=');

Readln (a);

D:=a div 100;

E:=b mod 100 div 10;

C:=I mod 10;

writeln (d, e, c);

if (a

else writeln (`ne ravny');

End.

14.Описание: Принадлежит ли число интервалу

Program ch;

Uses crt;

Var a: integer;

Begin clrscr;

Writeln (`a=');

Readln (a);

if (a>=(-5)) and (a<=3) then writeln (`prinadl')

else writeln (` ne prinadl');

End.

15.Описание:Сравнить 3 стороны треугольника

Program ch;

Uses crt;

Var a, b, c:integer;

Begin clrscr;

Writeln (`a= b= c=');

Readln (a, b, c);

if (a=c) or (a=b) then writeln (`ravnobedr')

else writeln (` ne ravnobedr');

End.

Раздел: Алгоритмы циклической структуры:

1.Описание: Написать программу на языке Pascal для реализации циклического алгоритма n, х — известные величины.

var i, j, fact, n: integer;

s, x: real;

begin

writeln;

write ('Vvedite n=');

readln (n);

write ('Vvedite x=');

readln (x);

s:=0;

for i:=1 to n do begin fact:=1;

for j:=1 to i do Fact:=fact*j;

s:=s+(1/fact+sqrt (abs (x)));

end;

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

readln;

end.

2.Описание: Написать программу на языке Pascal для реализации циклического алгоритма

n — известные величины. program one;

var i, j, n, zn, factorial: integer; s, x: real; begin writeln; write ('Vvedite n='); readln (n); s:=0; factorial:=1; zn:=1; for i:=1 to n do begin zn:=zn*(-1); factorial:=factorial*i; s:=s+(zn*(i+1)/factorial); end; writeln ('s=', s:4:3); readln; end.

3.Описание: Написать программу на языке Pascal для реализации циклического алгоритма

s=1/1*2−½*3+…+(-1)ⁿ⁺¹/n (n+1) n — известные величины.

program one;

var i, j, n, zn: intege r; s, x: real; begin writeln; write ('Vvedite n='); readln (n); s:=0; zn:=-1; for i:=1 to n do begin zn:=zn*(-1); s:=s+zn/(i*(i+1)); end; writeln ('s=', s:4:2); readln; end.

4.Описание: Написать программу на языке Pascal для реализации циклического алгоритма

n — известные величины. program one;

var i, j, n:integer; stepen: integer; s: real; begin writeln; write ('Vvedite n='); readln (n); s:=0; for i:=1 to n do begin stepen:=1; for j:=1 to 5 do begin stepen:=stepen*i; end; s:=s+1/stepen; end; writeln ('s=', s:4:2); readln; end.

5. Описание: Написать программу, которая выводит целые четные числа с клавиатуры и складывает их, пока не будет введено число 0.

Program 5;

Uses crt;

Var n, s: integer.;

Begin clrscr;

S:=0;

Repeat;

Writeln (vvedi chislo);

Readln (n);

S:=s+n;

Until n=0;

Writeln (s=, s);

Readln;

End.

6. Описание: Составить программу, подсчета суммы S первых 1000 членов гармонического ряда 1+½+1/3+…+1/N

Program 1;

Uses crt;

Var s: real; n;integer;

Begin clrscr;

S:=0; n:=0;

Repeat;

N:=n+1;

S:=s+1/n;

Until n=1000;

Writeln (s);

End.

7. Описание: Напечатать 20 первых степеней числа 2.

Program 2;

Uses crt;

Var n, s: longint;

Begin clrscr;

S:=1;

N:=1;

Repeat S:=s*2;

Writeln (s,);

N:=n+1;

Until n>20; Readln;

End.

8. Описание:Известны оценки по информатике каждого из 20 учеников класса. В начале списка Перечислены все «5», затем остальные оценки. Сколько учеников имеют оценку «5»?

Program 5;

Uses crt;

Var x, n: word;

Begin clrscr;

Writeln (vvedi ocenki);

Readln (x);

N:=0;

While x=5 do begin n:=n+1;

Writeln (vvedi ocenki);

Readln (x);

End;

Writeln (imeyut 5, n, uchenikov);

Readln;

End.

9. Описание: Вычислить наибольший общий делитель двух натуральных чисел, А и В, использую для этого алгоритм Евклида. Будем уменьшать каждый раз большее из чисел на величину меньшего до тех пор, пока оба числа не станут равными.

Program nod;

Uses crt;

Var a, b: integer;

Begin clrscr;

Writeln (vvedi 2 chisla);

Readln (a, b);

While a<>b do if a>b then a:=a-b else b:=b-a;

Writeln (nod=, a);Readln;

End.

10.Описание: Программа подсчета суммы S первых 1000 членов гармонического ряда 1+½+1/3+¼+…+1/N

Program S;

Uses crt;

Var s: real;n:integer;

Begin clrscr;

S:=0; N:=0;

While n<1000 do begin N:=n+1;

S:=s+1/n;

End;

Writeln (s);

Readln;

End.

11.Описание:Имеется четыре (A, B, C, D) числа. Необходимо ответить на вопрос:«Правда ли что все среди этих чисел есть равные?"Ответ вывести в виде текста:«Правда», или «Неправда».

Program z1;

var a, b, c, d: integer; {описываем имеющиеся переменные}

begin writeln ('vvedite chislo a'); {вводим все числа по очереди}

readln (a);

writeln ('vvedite chislo b');

readln (b);

writeln ('vvedite chislo c');

readln (c);

writeln ('vvedite chislo d');

readln (d);

if (a=b)or (a=c) or (a=d)or (b=c) or (b=d) or (d=c) then writeln ('pravda') else writeln ('nepravda');

readln;

end.

12.Описание: Составить программу вычисления и выдачи на печать суммы (произведения) N элементов бесконечного ряда. Оформить проверку задания. Y=(-512)*256*(-128)*64… Общая формула имеет вид: y=2^10-i

program z2;

var i, j, zn, n: integer; s: real;

begin writeln;

writeln ('vvedite kolichestvo elementov ryada');

write ('N='); {вводим количество элементов ряда}

readln (n);

s:=1;

for i:=1 to n do begin zn:=1;

for j:=1 to i+1 do begin zn:=zn*(-1);

end;

s:=s*(-zn)*(exp ((10-i)*ln (2))); {вводим формулу}

end;

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

readln;

end.

13.Описание: Дана функция Y=1-[x-2]^2/10 вычислить и напечатать значения этой функции для последовательных значений x=c,x=c+(b+1), x=c+2(b+1),x=c+3(b+1) где а=1; b=9;с=2. Считать до тех пор пока сумма Y+6 не станет отрицательной.

program zad3;

const b=9; c=2;

var x, n: integer; f, s: real; function y (x:integer):real;

begin y:=1-(sqr (x-c)) / (b+1);

end;

begin writeln ('Y=1-[x-2]^2/10');

n:=0;

repeat x:=c+n*(b+1);

inc (n);

f:=y (x);

write ('x', n,'= ', x,' ');

writeln ('y', n,'= ', f:6:5)

until f+6<0;

readln

end.

14.Описание: Имеется массив, А из N произвольных чисел (A(n)), среди которых есть положительные, отрицательные и равные нулю. Напечатать только те числа из массива которые больше предыдущего числа.

program z4;

uses Crt;

const MAX = 100;

var mas: array[1.MAX] of integer; n, i: byte; k, p: integer;

begin ClrScr;

Write ('N:=');

Readln (n);

for i:=1 to n do begin Write ('vvedite ', i,' element massiva:>');Readln (mas[i]); end;

begin k := 0;

for i := 1 to n do begin if mas[i]>mas[(i-1)] then writeln (mas[i]); end;

readln; end;

end.

15.Описание: Составить программу вычисления числового ряда для известного числа членов ряда N. Y=(7+3⁵/1)(8−3^-4/2)(9+3³/3)…

program z5;

var i, j, zn, n: integer; s: real;

begin writeln;

writeln ('vvedite kolichestvo elementov ryada');

write ('N=');

readln (n);

s:=1;

for i:=1 to n do begin zn:=1;

for j:=1 to i+1 do begin zn:=zn*(-1);end;

s:=s*((6+i)+exp ((zn*(6-i))*ln (3))/i);end;

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

readln;

end.

Раздел : Массивы

1 Описание: Найти, сколько раз каждый элемент встречается в массиве

Дополнительных массивов не создавать.

Program msv;

Const Size=10; Diap=10;

var a: array [1.Size] of integer; i, n, k, j: integer;

begin writeln;

repeat write ('Введите размерность 1 массива (от 2 до ', Size,'):');

Read (n);

Until (n>1) and (n<=Size); Randomize;

a [1]: =Random (Diap);

Write ('A= ', a[1],' ');

For i: =2 to n do begin A[i]: =Random (Diap);

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

writeln;

k:=0;

For i: =1 to n do if a[i]=0 then Inc (k);

If k>0 then writeln ('0: ', k);

For i: =1 to n-1 do if a[i]<>0 then begin K: =1;

For j: =i+1 to n do if a[i]=a[j] then begin A[j]: =0;

Inc (k); End;

writeln (a[i],': ', k); end;

end.

2. Описание: Объединить 2 упорядоченных массива по возрастанию.

Program msv;

const Size=10; Step=5;

var a, b: array [1.Size] of integer; c: array [1.2*Size] of integer; i, n1, n2,ia, ib, ic: integer;

begin writeln;

repeat write ('Введите размерность 1 массива (от 2 до ', Size,'):');

read (n1);

until (n1>1) and (n1<=Size);

Randomize;

a[1]: =Random (Step);

write ('A= ', a[1],' ');

for i:=2 to n1 do begin a[i]: =a[i-1]+Random (Step);

write (a[i],' '); end;

writeln;

repeat

write ('Введите размерность 2 массива (от 2 до ', Size,'):');

read (n2);

until (n2>1) and (n2<=Size);

b[1]: =Random (Step);

write ('B= ', b[1],' ');

for i:=2 to n2 do begin b[i]: =b[i-1]+Random (Step);

write (b[i],' ');

end;

writeln;

ia:=1; ib:=1;

write ('C= ');

for i:=1 to n1+n2 do begin if a[ia]<=b[ib] then begin c[i]: =a[ia];

if ia

if ib

else begin c[i]: =b[ib];

if ib

if ia

write (c[i],' ');

end;

writeln;

end.

3. Описание: Дан массив чисел. Найти наибольшее.

Program msv;

Uses crt;

Var i, n, max:integer; a: array[1.100] of integer;

begin clrscr;

read (n);

for i:=1 to n do read (a[i]); {ввод чисел в массив}

max:=a[1];

for i:=2 to n do if a[i] > max then max:=a[i]; {сравнивается с уже найденным наибольшим,}

write ('maksimalnoe chislo = ', max);

readln;

end.

4. Описание: Найти сумму элементов числового массива

Program msv;

uses crt;

Var i, n, s:integer; a: array[1.1000] of integer;

begin clrscr;

read (n);

for i:=1 to n do read (a[i]); {ввод значений в массив}

s:=0;

for i:=1 to n do s:=s+a[i];

write ('Summa = ', s); readln;

readln;

end.

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

Program msv;

Uses crt;

type mas=array[1.100] of integer;

Var a: mas; i, n: integer; function calc (b:mas;m:integer):integer;

var i, s: integer;

begin s:=0;

for i:=1 to m do;

if i mod 2=0 then s:=s+b[i];

calc:=s;

end;

begin clrscr;

read (n);

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

write ('Сумма каждого второго элемента = ', calc (a, n));

readln;

readln;

end.

6. Описание: Дан массив символов. Вычислить, сколько в нем элементов 'a'

Program msv;

Uses crt;

Var i, n, s:integer; a: array[1.100] of char;

begin clrscr;

readln (n); {Объявление а: array[1.1000] of char означает,}

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

s:=0;

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

s:=0;

for i:=1 to n do if a[i]='a' then s:=s+1;

write ('Kolichestvo elementov ravnyh «a» = ', s);

readln;

end.

7. Описание: Дан двумерный массив целых чисел размерностью NxN. Найти сумму его элементов

Program msv;

Uses crt;

Var s, i, j, n: integer; a: array[1.10,1.10] of integer;

begin clrscr;

read (n);

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

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

write ('Сумма элементов = ', s);

readln;

readln;

end.

8. Описание: По заданному массиву X[7] сформировать массив Y, элементы которого вычисляются по формуле

Y[i]= |X[i]-B|, где B — максимальный элемент массива X

program msv;

const Size=7; { Размерность массива }

var x: array [1.Size] of real; b: real; i: integer;

begin writeln;

writeln ('Жду ввода элементов массива размерностью ', Size,':');

for i:=1 to Size do begin write ('x[', i,']=');

readln (x[i]); end;

b:=x[1];

for i:=2 to Size do if x[i]>b then b:=x[i];

writeln ('Максимальный элемент=', b:10:3);

writeln ('Исходный Новый');

writeln ('массив массив');

for i:=1 to Size do begin write (x[i]: 10:4);

x[i]: =abs (x[i]-b);

writeln (x[i]: 10:4); end;

end.

9. Описание: Найти максимальный элемент в линейном массиве.

Вывести результат на экран

program msv;

uses crt;

const

nn = 10; var max, i: integer; a: array[1.nn] of integer; begin clrscr;

for i := 1 to nn do a[i] := random (500);

max := a[1];

for i := 2 to nn do if a[i] > max then max := a[i];

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

writeln ('Max = ', max);

readkey;

end.

10. Описание: Отсев. Удалить в заданном массиве x(n) лишние (кроме первого) элементы так, чтобы оставшиеся образовывали возрастающую последовательность (за один просмотр массива)

program msv;

uses crt;

const n = 10; {dlina massiva}

var a: array[1.n] of integer; i, max, j, k, mi: integer; begin clrscr; randomize;

for i := 1 to n do begin a[i] := random (51);

write (a[i], ' '); end;

max := a[1];

k := 2; {t.k. uslovie zadachi «preobarzovat' za odin prosmotr massiva», to}

{k ne mozhet bit' bol’she N, chem mi vospol’zuemsya v cikle}

for i := 2 to n do begin if k > n then break;

if a[i] <= max then {esli a[i] <= max to udalyaem etot element}

begin for j := i to n — 1 do {etogo cikl mog bi ne viiti, no u nas est' K}

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

dec (i); end;

if a[i] > max then begin max := a[i];

mi := i; {MI — poziciya maksimuma v massive} end;

inc (k); {uvelichivaem K, k = [2.n]} End;

Write (#10#13, a[1], ' ');

For i: = 2 to mi do Write (a[i], ' ');

readkey;

end.

11. Описание: В массиве X из n элементов каждый из элементов равен 0, 1 или 2. Переставить элементы массива так, чтобы сначала располагались нули, затем единицы и двойки. Дополнительный массив не использовать.

Программа расширена для возможности переставлять элементы массива, являющимися любыми числами (не только 0, 1, 2)

Program msv;

Const n = 10; {кол-вл элементов массива}

var a, b, t: integer; X: array[1.n] of integer; {сам массив из n элементов}

BEGIN For a := 1 to n do {ввод массива X} Begin Write ('Введите X [', a, ']: ');

Readln (X[a]); End;

for a := 1 to n do begin t := X[a];

b := a — 1;

While (b>=0) and (t

B: = b — 1; End;

X [b+1]: = t; end;

for a := 1 to n do {вывод результата}

Write (X[a]: 2);

END. {конец программы}

12. Описание: Операции с массивом, сортировка суммирование. В одномерном массиве, состоящем из N вещественных элементов, вычислить:1) количество элементов массива, равных 0;2) сумму элементов массива, расположенных после минимального элемента.

Упорядочить элементы массива по возрастанию модулей элементов.

Program msv;

Uses CRT;

Const N = 10; {сколько всего элементов}

Var a: Array[1.N] of Real; i, j: Byte; Zero: Byte; Min: Real; Summ: Real;

Procedure Print;

Begin For i := 1 to N do Write (a[i]: 0:1,' ');

Writeln;End;

Procedure CreateMassive;

BeginWriteln ('Исходная последовательность');

For i := 1 to N do Begin a[i] := Random (4);

a[i] := a[i] - 2; {Этот и предыдущий операторы можно объединить}

End;

Print;

Writeln;End;

Begin ClrScr;Randomize;

CreateMassive;

Min := a[1];

For i := 2 to N do Begin Summ := Summ + a[i];

If (a[i] < Min) then Begin Min := a[i];

Summ := 0; End; End;

Writeln ('Минимальный элемент ', Min:0:1,'. Сумма элементов после: ', Summ:0:1);

For i := 1 to N do Begin For j := i + 1 to N do If (abs (a[j]) < abs (a[i])) then Begin a[i] := a[i] + a[j];

a[j] := a[i] - a[j];

a[i] := a[i] - a[j]; End; End;

Writeln (#13#10,'Отсортировання последовательность'); Print;

For i := 1 to N do If a[i] = 0 then Inc (Zero);

Write (#13#10,'Нулевых элементов: ', Zero);ReadKey;

End.

13. Описание: Вычислить угол между двумя заданными векторами размерности 8, используя функцию скалярного произведения a = arccos((x,y)/((x,x)*(y,y)))

program msv;

uses crt;

type TVector = array[1.8] of Real;

function scal (var Vec1, Vec2: TVector):real; var p: Real; i: integer;

begin p:=0;

for i:=1 to 8 do p:=p+(Vec1[i]*Vec2[i]);

scal := p;end;

var Vec1, Vec2: TVector; i: integer; sc, a, angle: Real;

BEGIN writeln ('Условие:');

writeln (' вычислить угол между двумя заданными векторами размерности 8,');

writeln (' используя функцию скалярного произведения');

writeln;

Writeln ('Ввод первого вектора');

for i := 1 to 8 do begin Write ('Vec1[', i, ']: ');

Readln (Vec1[i]); end;

Writeln ('Ввод второго вектора');

for i := 1 to 8 do begin Write ('Vec2[', i, ']: ');

Readln (Vec2[i]); end;

sc := scal (Vec1, Vec2);

a:= sc/sqrt (scal (Vec1,Vec1)*scal (Vec2,Vec2)); {Вычисляется косинус}

if a=0 then angle:=90 else angle:=arctan (sqrt (1-a*a)/a)*180/pi;

if a=-1 then angle:=180;

if angle<0 then angle:=180+angle;

writeln ('Угол между векторами: ', angle:7:3,' градусов');

END.

14. Описание: Вычислить сумму двух векторов, первый из которых вводится, а элементы второго вычисляются по формуле b[i]: =sin(i*x), где 0<=x<=3.14

program msv;

const Nm = 10; {размерность вектора}

var Vec1, Vec2, ResVec: array[1.Nm] of Real; i: integer; x: Real; N: integer;

BEGIN writeln ('Условие :');

writeln (' вычислить сумму двух векторов, первый из которых вводится, а элементы');

writeln (' второго вычисляются по формуле b[i]: =sin (i*x), где 0<=x<=3.14');

writeln;

Write ('введите размерность вектора (N<', Nm, '): ');

Readln (N);

if n <= Nm then begin Writeln ('Ввод вектора');

for i := 1 to N do begin Write ('Vec1[', i, ']: ');

Readln (Vec1[i]); end;

Write ('Введите X (от 0 до 3.14): '); Readln (x);

if (X <= 3.14) and (X >= 0) then begin for i := 1 to N do begin Vec2[i] := sin (Vec1[i]*X); ResVec[i] := Vec1[i]*Vec2[i]; {сразу же вычисляем произведние} end;

Write ('Результирующий вектор: '); {выводим на экран результат}

for i := 1 to N do Write (ResVec[i]: 6:2); end else Writeln ('Введено неверное X');

end else Writeln ('неверная размерность');

END.

15. Описание: Создается случайный массив из 5 элементов. Заменить все четные значения на 1, нечетные — на 0.

Program msv;

uses crt;

const n=5;

var a: array[1.n] of integer; i: integer;

begin clrscr; randomize;

for i:=1 to n do begin a[i]: =random (9);

write (a[i]); end;

writeln;

for i:=1 to n do begin if odd (a[i])=false then a[i]: =1 else a[i]: =0;

write (a[i]);

end;

readkey;

end.

Раздел: Процедуры и функции

1.Описание: Найти последовательности целых чисел те, которые встречаются в ней ровно два раза.

program one;

uses crt;

type mas=array[1.100]of integer; func=function (var x: mas):integer; var a: mas; j, n, m, x: integer;

function kolichestvo (var c: mas):integer; var k, i: integer;

begin k:=0;

for i:=1 to n do if c[i]>m then k:=k+1;

kolichestvo:=k; end;

procedure deist (var b: mas; operation: func);

begin writeln ('b[j]');

for j:=1 to n do readln (b[j]);

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

x:=operation (a); end;

begin clrscr;

writeln ('vvedite celoe chislo m i razmer massiva (n)');

readln (m, n);

deist (a, kolichestvo);

writeln ('kolichestvo=', x);

readkey;

end.

2.Описание: Процедура отображения рамки в текстовом режиме

program frame;

uses Crt;

procedure Frm (l:integer; t: integer; w: integer; h: integer);

var x, y: integer; i: integer; c1, c2,c3,c4,c5,c6:char;

begin clrscr;

c1:=chr (218); c2:=chr (196);

c3:=chr (191); c4:=chr (179);

c5:=chr (192); c6:=chr (217); GoToXY (l, t);

write (c1);

for i:=1 to w-2 do write (c2);

write (c3);

y:=t+1;

x:=l+w-1;

for i:=1 to h-2 do begin GoToXY (l, y);

write (c4);

GoToXY (x, y);

write (c4);

y:=y+1; end;

GoToXY (l, y);

write (c5);

for i:=1 to w-2 do write (c2);

write (c6);

end;

begin Frm (2,2,15,10);

readln;

end.

3.Описание: Произведение нечетных элементов

Program one;

type massiv= array [1.100] of integer;

var A1, A2:massiv; i, j: integer; n1, n2:integer; function pr_nec (m:massiv; n: integer):integer;

var i, j, pr:integer;

begin pr:=1;

for i:=1 to n do if odd (m[i]) then pr:=pr*m[i];

pr_nec:=pr;

end;

begin writeln ('Vvedite PERVYI massiv:');

write ('ego razmer «n»: '); readln (n1);

for i:=1 to n1 do begin write ('A1[', i,']='); readln (A1[i]); end;

writeln ('_______________________');

writeln ('Vvedite VTOROI massiv:');

write ('ego razmer «n»: '); readln (n2);

for i:=1 to n2 do begin write ('A2[', i,']='); readln (A2[i]); end;

writeln ('_______________________');

writeln;

writeln ('Vi vveli:');

write ('A1: '); for i:=1 to n1 do write (A1[i],' '); writeln;

write ('A2: '); for i:=1 to n2 do write (A2[i],' '); writeln;

writeln;

writeln ('Proizvedenie iz A1= ', pr_nec (A1,n1));

writeln ('Proizvedenie iz A2= ', pr_nec (A2,n2));

readln;

end.

4.Описание: Нахождение тангенса tg и котангенса ctg угла, используя выражения sin (x)cos (x) и обратное ему.

Program one;

uses crt;

var y1, y2,z: real; function tg (x: real): real;

begin tg := sin (x)/cos (x);

end;

function ctg (x: real): real;

begin ctg := cos (x)/sin (x);

end;

Begin clrscr;

write ('input x: ');

readln (z);

y1:=tg (z); y2:=ctg (z);

writeln ('tg (', z:0:2,')=', y1:0:2);

writeln ('ctg (', z:0:2,')=', y2:0:2);readln;

End.

5. Описание: Определить максимальное число из четырех введенных, путем сравнения их сначала попарно, а затем результат между собой.

program one;

uses crt;

var a, b, c, d, z, x, y, x1, y1:integer; function max (x, y: integer):integer;

begin if x>y then max:=x else max:=y;

end;

begin clrscr;

writeln ('Vvedite chisla');

readln (a, b, c, d);

x1:=max (a, b); y1:=max (c, d); z:=max (x1,y1);

writeln ('max=', z);

readkey;

end.

6.Описание: Вычислить день недели по дате

program Kalendar;

uses crt; var y, d, m, c, w: integer; {m-mesiac, d-den, y-god }Procedure WriteDay (d, m, y:Integer);

constDays_of_week: rray [0.6] of String =('Voskresen`e','Ponedelnik','Vtornik', ' Sreda', ' Chetverg', ' Piatnica', ' Subbota') ;

Begin if m <3 then begin m := m + 10;

y := y — 1;end else m := m — 2;c := y div 100;y := y mod 100;w := (d+(13*m-1) div 5+y+y div 4+c div 4−2*c+777) mod 7;

WriteLn (Days_of_week[w]);end;

Procedure InputDate (var d, m, y: Integer);

Begin Write ('Vvedite datu v formate DD MM GG ');

ReadLn (d, m, y);

if (d>=1)and (d<=31) and (m>=1) and (m<=12) and (y>=1582) and (y<=4903) then Writeday (d, m, y) else begin writeln ('Nekorrektnyj vvod!');end;end;

BEGIN clrscr;

InputDate (d, m, y);

readkey;

End.

7. Описание: Нахождение процента от числа

Program one;

uses crt;

var k, n: byte; x: real; function procent (n, m: byte):real;

begin procent:=m*100/n;

end;

begin clrscr;

writeln ('Vvedite chisla');

readln (k, n);

x:=procent (k, n);

writeln ('x=', x:5:2);

readkey;

end.

8. Вывести заданное число звездочек.

program one;;

uses crt;

var n: byte; function zvezda (n:byte):real; var i: integer; s: string;

begin i:=1;

s:='';

while i<=n do begin s:=s+'*';

inc (i); end;

writeln (s); end;

begin clrscr;

writeln ('Vvedite chislo'); readln (n);

zvezda (n); readkey;

end.

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

program one;

Uses crt;

var x, y, z:real; Function Pow (A, B: Real):Real; Var T, R: Real; L: integer;

Begin T := Abs (A);

If A < 0 Then R := (-1)*Exp (B*Ln (T)) else if A > 0 Then R := Exp (B*Ln (T)) else R:=0;

L := round (B);

If (L mod 2 = 0) Then R:=Abs®;

If (B=0) Then R:=1;

Pow:=R;

End;

BEGIN clrscr;

Writeln ('vvedite chislo:');

readln (x);

Writeln ('vvedite stepen:');

readln (y);

z:=Pow (x, y);

Writeln (z:0:2);

readkey;

END.

10. Описание: Вывести заданный символ заданное количество раз

program one;

uses crt;

var n: byte; l: string; function zvezda (n:byte;l:string):real; var i: integer; s: string;

begin i:=1;

s:='';

while i<=n do begin s:=s+l;

inc (i); end;

writeln (s); end;

begin clrscr;

writeln ('Vvedite chislo'); readln (n);

writeln ('Vvedite simvol'); readln (l);

zvezda (n, l);

readkey;

end.

11.Описание: Определить к чему ближе меньшее из двух чисел: к их среднему арифметическому или среднему геометрическому.

Program one;

vara, b: real; average: real; geometricmean: real; minstr: string;function min (a, b: real) :real;

begin min := a;

minstr := 'Pervoe';

if (b < a) then begin min := b;

minstr := 'Vtoroe';end;end;

beginwrite ('Vvedite 1-e chslo: ');readln (a);

write ('Vvedite 2-e chslo: ');readln (b);

average := (a + b) / 2;

geometricmean := sqrt (a*a + b*b);

a := min (a, b);

writeln ('Naimenshee chislo — ', minstr,' (', a:0:3,')');

write ('Blize k srednemu ');

if (abs (average — a) < abs (geometricmean — a)) thenbegin writeln ('arifmeticheskomu (', average:0:3,')');

end else begin writeln ('geometricheskomu (', geometricmean:0:3,')');end;

readln;

end.

12.Описание:Возведение в степень для целого показателя, вычисляемого за время log2(степень).

Program power_maximal;

Uses crt;

Var a, b, c: integer; function power (x, pow: integer):integer; var res: integer;

begin res := 1;

while (pow > 0) do beginif (pow and 1 = 1) then res:= res * x;

x := x * x;

pow := pow shr 1;end;

power := res; end;

Begin Clrscr;

Writeln ('input a, b: ');

Readln (a, b);

c:=power (a, b);

Writeln ('a^b = ', c);

Readkey;

End.ъ

13.Описание:Арккосинус числа. Нахождение из математических соображений

var ca, al, albeg: real; function ArcCos (arg:real):real;

var r: real;

begin if (abs (arg)>1) then begin writeln (' Unavailable argument ');

halt; end;

if abs (arg)<0.1 then r := pi/2 else r := ArcTan (sqrt (1/arg/arg-1)); { arccos }

if arg<0 then r:=pi-r;

ArcCos := r; end;

begin albeg:=pi/2+0.2;

ca := cos (albeg);

al := arccos (ca);

writeln ('ArcCos (', ca:10:7,')=', al:10:7,' AlBeg=', albeg:10:7,

' ChekSum =', al-albeg,' Must be sero');

readln;

end.

14.Описание:Есть ли в строке числовые значения

Function NumInStr (S: String): Boolean;

VAR C, I: INTEGER; N: BOOLEAN;

BEGIN; I:=0;

Repeat;

I:=I+1;

C:=Ord (S[I]);

N:=((C >= 48) AND (C <= 57));

Until (NOT N) OR (I=Length (S));

NumInStr:=N;

END;

15.Описание:Нахождение функции методом половинного деления

program half_del;

uses crt;

type ms=array[1.100] of real; { [x, y] }

var Eps, XH, DX, Y, z, X, YH, P, S, A, B:real; N, U, Er:integer; masx, masy: ms;Function F (X:real):real;

beginF:=exp (x)+x*x-2

end;

Function FuncA (Eps, s, p, YH: real):real;

begin if F (p)*F (s)<0 then begin YH:=0.5*(p+s);

while abs (F (YH)) > EPS do begin If F (p)*F (YH) <0 then S:=YH else P:=YH;

YH:=0.5*(P+S) end; end else er:=1;

FuncA:=YH; end;

procedure P1(a, b, XH:real; N: integer); var z, q: real; u: integer;

begin if x>1 then begin Z:=sqrt (X*sqrt (X-1));

a:=FuncA (Eps, s, p, YH);

for U:=1 to N do begin masx[U]: =X;

masy[U]: =sin (x)/z;

X:=X+DX; end;

{else writeln (' Error: x<1 ');} end; end;

Begin clrscr;

write ('vvedite eps: '); readln (eps);

Write ('vvedite dx: '); readln (DX);

write ('vvedite N: '); readln (N);

write ('vvedite x>1 :'); readln (x);

if x1; writeln;

Writeln ('——————————');

Writeln (' | X | Y ');

writeln ('——————————');

P1(a, b, XH, N);

for U:=1 to N do writeln ('', masx[u]: 10:7,' ', masy[u]: 10:7);readln;

end.

Раздел: Файлы

1.Описание: Решает простейшие арифметические примеры записанные в файл.

program pn12;

var f: text; s, sa, sb: string; c: char; i, a, b, o, j, code: integer; m, op: set of char;

begin m:=['1','2','3','4','5','6','7','8','9','0'];

op:=['+','-','*','/'];

assign (f,'file.txt');reset (f);

while not (eof (f)) do begin readln (f, s);

writeln (s);

for i:=2 to length (s)-1 do if (s[i] in op) and (s[i-1]in m) and (s[i+1]in m) then begin j:=1;

sa:='';

while (s[i-j] in m) and (i-j>0) do begin sa:=s[i-j]+sa;

j:=j+1 end;

j:=1;

sb:='';

while (s[i+j] in m) and (i+j<=length (s)) do begin sb:=sb+s[i+j];

j:=j+1 end;

val (sa, a, code);val (sb, b, code);

case s[i] of '+':O:=a+b;

'-':O:=a-b;

'*':O:=a*b;

'/':O:=a div b; end;

writeln (a, s[i], b,'=', O,' ')

end;end; close (f);

readln;

end.

2.Описание: Работа с текстовыми файлами предусматривает собой: создание, редактирование, добавление, удаление.

Program one;

uses Dos, Crt;

var f: text;

FileName :string[9];

st :string; ch: char; vibor: byte;

procedure Head;

begin Writeln ('esli vy otkazyvaetes ot deistviya, to naberite v nazvanii faila simvola" «');

Write ('vvedite imya faila:>');

Readln (FileName);

if FileName='~' then halt (1) else Assign (f, FileName); end;

procedure TextEdit;

begin Writeln ('Seichas vy smojetedobavlyat informaciyu v file.');

Writeln ('esli vyzahotite prekratit vvod, to naberite sleduschuyu posledovatelnost:" ~~" ');

repeat Write ('>');Readln (st);

if st<>'~~' then Writeln (f, st);

until st='~~'; end;

procedure WriteToFile;

begin Head;

ReWrite (f);

TextEdit;

Close (f);

Writeln ('Vy okonchili vvodit info v file. Najmite lubuyu knopku…');

ReadKey; end;

procedure ReadFromFile;

Head;

Reset (f);

if IOresult<>0 then begin Writeln ('file ', FExpand (filename),' ne sushestvuet.');

Writeln ((Y/N).');

ch:=ReadKey;

if (ch='Y') or (ch='y') then ReadFromFile;

end else begin Writeln ('Soderjimoe faila:');Writeln;

while not eof (f) do begin Readln (f, st);

Writeln ('>', st); end;

Close (f);

Writeln;

Writeln ('Najmite lubuyu knopku');

ReadKey; end;end;

procedure AddToFile;

begin Head;

Append (f);

if IOresult<>0 then begin

Writeln ('faila ', FExpand (filename),' ne sushestvuet.');

Writeln ('hotite vvesti drugoe imya faila?(Y/N).');

ch:=ReadKey;

if (ch='Y') or (ch='y') then AddToFile; end else begin TextEdit; Close (f);

Writeln ('Vy okon4ili vvodit info v file. Najmite lubuyu knopku…');

ReadKey; end; end;

procedure DelFile;

begin Head;

Reset (f);

if IOresult<>0 then begin Writeln ('file ', FExpand (filename),' ne sushestvuet.');

Writeln ('hotite vvesti drugoe imya file??(Y/N).');

ch:=ReadKey; if (ch='Y') or (ch='y') then DelFile; end else begin Writeln ('vy uvereny 4to hotite udalit etot file?(Y/N)');

ch:=ReadKey; if (ch='Y') or (ch='y') then Erase (f);

Writeln ('vy tolko 4to udalili file. Najmite lubuyu klavishu.');

Readkey; end; end;

procedure Menu;

begin repeat repeat ClrScr;

Writeln ('1. record file / sozdanie faila');

Writeln ('2. read file');

Writeln ('3. Dobavlenie info v file');

Writeln ('4. delet file');

Writeln ('5. Exit');

Write ('Vash vybor:>');Readln (vibor);

until (vibor>0) and (vibor<6);

Writeln;

Write ('‚л ўлЎа «Ё: ');

case vibor of 1: begin Writeln (' record file / sozdanie faila');

WriteToFile; end;

2:begin Writeln ('read file');

ReadFromFile; end;

3:begin Writeln (' Dobavlenie info v file');

AddToFile; end;

4:begin Writeln ('delet file');

DelFile; end; end;

until vibor=5; end;

begin Menu;

end.

3.Описание: Дан файл, содержащий текст и арифметические выражения вида, а*в, где * - один из знаков +, -, *, /.Выписать все арифметические выражения и вычислить их значения

program pn12;

var f: text; s, sa, sb: string; c: char; i, a, b, o, j, code: integer; m, op: set of char;

begin m:=['1','2','3','4','5','6','7','8','9','0'];

op:=['+','-','*','/'];

assign (f,'e:tptp6Arif.dat');reset (f);

while not (eof (f)) do begin readln (f, s);

writeln (s);

for i:=2 to length (s)-1 do if (s[i] in op) and (s[i-1]in m) and (s[i+1]in m) then begin j:=1;

sa:='';

while (s[i-j] in m) and (i-j>0) do begin sa:=s[i-j]+sa;

j:=j+1 end;

j:=1; sb:='';

while (s[i+j] in m) and (i+j<=length (s)) do begin sb:=sb+s[i+j];

j:=j+1 end;

val (sa, a, code);val (sb, b, code);

case s[i] of '+':O:=a+b;

'-':O:=a-b; '*':O:=a*b; '/':O:=a div b; end;

writeln (a, s[i], b,'=', O,' ')

end; end;

close (f);

end.

4.Описание: Вывести максимальное число из файла in.txt

Program one;

var t: text; i, p, code:integer; s: string; m: array[1.100] of real; max: real;

begin assign (t,'in.txt'); reset (t);

read (t, s);

i:=0;

repeat p:=pos (' ', s);

inc (i);

val (copy (s, 1, p-1), m[i], code);

delete (s, 1, p);

until p=0;

max:=m[1];

for p:=2 to i do if m[p]>max then max:=m[p];

writeln ('MAX= ', max);

close (t);

readln;

end.

5.Описание: Перекодирование файла из формата DOS в формат Windows.

Program one;

var f, g: text; i, p, n:integer; m: array [1.100] of string; s: string;

begin assign (f,'in.txt'); reset (f);

assign (g,'out.txt'); rewrite (g);

while not eof (f) do begin readln (f, s); {считываем очередную строку}

i:=0; {ставим счётчик слов на 0}

repeat inc (i); {увеличиваем счётчик текущего ПРЕДЛОЖЕНИЯ}

p:=pos (' ', s); {смотрим где находится пробел}

m[i]: =copy (s, 1, p-1); {записываем текущее слово в массив}

delete (s, 1, p); {то слово, которое заприсали в массив — удаляем}

until p=0; {****************}

n:=i+1; {конец массива}

if s[length (s)]='.' then begin m[n]: =copy (s, 1, length (s)-1); m[1]: =m[1]+'.' {то эту точку перемещаем на 1 слово}

end else m[n]: =s; {а если нет точки — то просто его записываем в массив}

writeln (g);;

for i:=n downto 1 do write (g, m[i],' '); {идём с конца массива в начало и записываем слова в обратном порядке}end;

writeln ('PEREZAPISANO…');readln;

close (f); close (g);

end.

6.Описание: Удаление следующих друг за другом нескольких пробелов из файла.

Program one;

const

FileName: String = 'Strings.txt';

VAR f: Text; S: String;

BEGIN Assign (f, FileName); {$I-}Reset (f); {$I+}

if IOResult = 0 then begin ReadLn (f, S); Close (f) end;

WriteLn ('input string: ', S);

while (POS (' ', S) > 0) do delete (S, POS (' ', S), 1);

if (length (S) > 1) and (S[1] = ' ') then Delete (S, 1, 1);

if (length (S)>1) and (S[length (S)] = ' ') then Delete (S, length (S), 1);

writeln ('output string: ', s);

readln;

END.

7.Описание: Вывести содержимое файла в обратном порядке в новый файл.

program one;

uses crt;

var fl1, fl2:text;a, b: string; i, l: longint;

begin clrscr;