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

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

Отчет

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

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

Выполнила:

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

учащаяся

группы 202АС

Проверила:

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

Актобе 2010

ДНЕВНИК.

ДАТА	ТЕМА	ПРОДЕЛАННАЯ РАБОТА	ПРОВЕРКА
14.06.10	Виды загрузки. Основные приемы работы в среде ТР. Редактирование текста программы, процесс отладки.	Изучили основные виды загрузки и приемы работы в ТР и процесс отладки.
14.06.10	Изучение команд редактирования отладки программ с помощью командного меню Pascal.	Изучили команды редактирования отладки программ с помощью командного меню Pascal.
14.06.10	Оформление программы. Разделы. Описание разделов. Назначение каждой части программы.	Изучили, как оформлять программы, а также назначение каждой части программы.
15.06.10	Разработка постановки задачи. Разработка простейших программ с использованием команд присваивания, ввода, вывода.	Научились составлять программы с использованием простейших операторов ввода, вывода, присваивания.
15.06.10	Форматы ввода, вывода. Команды Read, Readln, Write, Writeln.	Изучили форматы ввода и вывода и команды Read, Readln, Write, Writeln.
15.06.10	Определение типов данных. Объявление данных. Константы. Метки. Комментарии. Разделители. Признаки концов строк на Pascale	Изучили различные типы данных и признаки концов строки на Pascal
16.06.10	Команды ветвления. Полные и не полные команды ветвления.	Изучили полную и не полную формы команд ветвления.
16.06.10	Составные операторы. Служебные скобки. Использование собственных операторов команды ветвления.	Изучили различные виды составных операторов.
16.06.10	Виды выражения. Сравнения с текстовых и числовых условий.	Изучили виды выражений и сравнения с текстовыми и числовыми условиями.
17.06.10	Составные условия. Оформления составных условий. Союзы составных условий. Примеры применения составных условий.	Изучили составные условия их оформление и применение.
17.06.10	Решение задач по выбору функции по значению аргумента. Команда выбора. Определение принадлежности точки к фигуре, к функции. Словесные условия.	Решали задачи по выбору функции по значению аргумента, определяли принадлежность точки к фигуре, к функции.
17.06.10	Решение задач. Применения. Ограничения отладки.	Решали задачи по ограничению отладки
18.06.10	Организация цикла с условием продолжения. Составные операторы в цикле WHILE DO. Применение. Решение задач. Блок-схема. Отладка.	Изучали составные операторы в цикле WHILE DO. Решали задачи.
18.06.10	Оператор цикла с условием окончания UNTIL, REPEAT. Правила применения.	Изучили оператор цикла с условием окончания UNTIL, REPEAT. Решали задачи.
18.06.10	Решения задач. Блок-схема. Отладка. Результаты.	Решение задач.
19.06.10	Оператор цикла с параметром FOR TO DO. Правила применения. Составные операторы в цикле. Решение задач с использованием оператора цикла с параметром.	Изучили оператор цикла с параметром FOR TO DO. Решение задач.
19.06.10	Нахождение суммы, произведения элементов ряда. Параметр цикла.	Научились находить сумму и произведение элементов ряда.
19.06.10	Цикл с параметром, с выборкой конца. Применение.	Изучили оператор цикла с параметром
21.06.10	Производные типы. Одномерные массивы. Типы индекса. Использование значений регулярного типа.	Рассмотрели одномерные массивы, производные типы. Выполнили практическую работу.
21.06.10	Многомерные массивы.	Рассмотрели многомерные массивы. Выполнили практическую работу.
21.06.10	Синтаксис задания регулярного типа.	Изучили синтаксис регулярного типа
22.06.10	Двумерный массивы. Матрица матриц. Создание формирование и работа с двумерными массивами. Поиск элементов в матрицах.	Изучили двумерный массив и работу с двумерным массивом.
22.06.10	Упорядочивание и сортировка элементов. Решение задач на матрицы.	Научились сортировать элементы массива. Решали задач на матрицы.
22.06.10	Составление программ с использованием матриц.	Составляли программы с использованием матриц.
23.06.10	Процедуры без параметров. Процедуры с параметрами. Параметры - значение. Параметры- переменные	Изучили разные виды процедур: с параметрами, без параметров, параметры- значение, параметр- переменные.
23.06.10	Параметры произвольных типов. Синтаксис процедур.	Рассмотрели параметры произвольных типов. И синтаксис процедур.
23.06.10	Определение оператора процедуры. Примеры использования процедур	Изучили оператора процедуры и его применение.
24.06.10	Описание процедуры- функции. Вызов функции. Побочные эффекты. Рекурсивные функции.	Изучили описание процедуры- функции, её вызов. Побочные эффекты.
24.06.10	Параметры- функции и параметры- процедуры.	Изучили параметры- функции и параметры- процедуры.
24.06.10	Процедуры и шаговая детализация.	Рассмотрели шаговую детализацию.
25.06.10	Строковые величины. Работа со строковыми величинами. Формирование строк с учетом конца строки. Подсчет, замена элементов. Удаление символов, ведущих, ведомых пробелов. Поиск нужного символа.	Научились работать со строковыми величинами.
25.06.10	Работа со стандартными функциями строк- Concat, Copy, Insert, Delete, POS, Length.	Научились работать со стандартными строковыми функциями: Concat, Copy, Insert, Delete, POS, Length.
25.06.10	Функции STR, Val, UpCase.	Изучили функции: STR, Val, UpCase.
26.06.10	Простейшие комбинированные типы. Описание комбинированных типов. Работа с элементами комбинированного типа. Выборка элементов.	Изучили простейшие комбинированные типы, их описание, принцип работы.
26.06.10	Многоуровневые записи.	Изучили многоуровневые записи
26.06.10	Оператор присоединения.	Изучили оператор присоединения.
28.06.10	Обозначение множеств в Паскале. Задание множественного типа и множественная переменная. Операции над множествами.	Изучили множества в Паскале.
28.06.10	Процедуры работы с множествами.	Изучили процедуры работы с множествами.
28.06.10	Примеры использования множественного типа	Рассмотрели примеры множественного типа
29.06.10	Файлы и работа с ними. Доступ к файлам. Имена файлов. Файлы логических устройств. Инициация файла.	Изучили файлы, доступ к ним, их имена.
29.06.10	Процедуры и функции для работы с файлами Reset, Rewrite, Append, Assign	Изучили процедуры и функции для работы с файлами: Reset, Rewrite, Append, Assign
29.06.10	Процедуры и функции для работы с файлами Reset, Rewrite, Append, Assign	Изучили процедуры и функции для работы с файлами: Reset, Rewrite, Append, Assign
30.06.10	Текстовые файлы. Их объявление. Работа с ними.	Изучили текстовые файлы, и работу с ними.
30.06.10	Буферная переменная и её использование.	Изучили буферную переменную.
30.06.10	Буферная переменная и её использование.	Изучили буферную переменную.
01.07.10	Работа с графикой в Паскале. Графический режим. Установка драйверов графики. Инициализация драйверов графики. Описание драйверов.	Выполняли работы в графическом режиме Паскаль.
01.07.10	Команды вычеркивания точек, линей, окружностей, дуг, секторов и простых геометрических фигур.	Изучили команды вычеркивания простых геометрических фигур.
01.07.10	Команды вычеркивания точек, линей, окружностей, дуг, секторов и простых геометрических фигур.	Изучили команды вычеркивания простых геометрических фигур.
02.07.10	Модуль Граф. Модули установки цветов. Модули выбора стилей заливок- SetLineStile, SetFileStile, FlodFileStile.	Изучили модуль Граф. И различные модули заливки и стилей.
02.07.10	Вычеркивание геометрических фигур с анимацией и организация движения и перемещения фигур по экрану.	Изучили вычеркивание геометрических фигур с анимацией и организацией движения и перемещения фигур по экрану.
03.07.10	Разработка программы графики с использованием всех модулей Граф.	Изучили разработку программ с использованием модуля Граф.
03.07.10	Разработка программы графики с использованием всех модулей Граф.	Изучили разработку программ с использованием модуля Граф.
03.07.10	Модули работы с текстом в графическом режиме. Модуль CRT. Системный модуль System.	Изучили принцип работы в графическом режиме.

СОДЕРЖАНИЕ.

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 (R);

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 (r);

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<x) and (X<=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<b+c) and (b<a+c)

and(c<a+b) then write('можно')

else write('невозможно');

readkey;

end.

9 .Описание: Даны три неравных числа a, b, c. Составить программу нахождения квадрата большего из этих чисел.

program one; var a,b,c:real; begin read(a,b,c); if (a>b) and (a>c) then write('a^2= ',a*a:1:4); if (b>a) and (b>c) then write('b^2= ',b*b:1:4); if (c>a) and (c>b) then write('c^2= ',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<b then min:=a else min:=b

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<b) and (b<i) then writeln (`ravny')

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-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/2+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/2+1/3+1/4+…+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<n1 then Inc(ia) else begin a[n1]:=b[ib];

if ib<n2 then Inc (ib); end; end

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

if ib<n2 then Inc(ib) else begin b[n2]:=a[ia];

if ia<n1 then Inc(ia); end; end;

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<X[b]) do Begin X [b+1]:= X[b];

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 [11] =('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(R);

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.000001 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:\tp\tp6\Arif.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;