Сборник задач по программированию на языке Паскаль

Сборник задач по программированию на языке Паскаль

Автор: Чолокоглы Алина Олеговна, учитель информатики и ИКТ МАОУ СОШ №44 г.Томска

Описание материала: Сборник задач посвящен вопросам программирования на языке программирования Pascal 7.0. В нем подробно рассматриваются решения большого количества задач, от простых до достаточно сложных.

Сборник адресован учащимся, преподавателям, ведущим занятия по информатике и программированию, а также всем желающим самостоятельно овладеть искусством программирования на языке Pascal 7.0.

Сборник содержит условия задач и одно или два варианта их решения на языке программирования Pascal 7.0.

Задачи в сборнике классифицированы по основным разделам: линейные алгоритмы, разветвляющиеся алгоритмы, циклические алгоритмы, обработка массивов, обработка строк и создание графических изображений. После каждого раздела предлагаются задачи для самостоятельного решения. Внутри каждого раздела задачи по мере возможности расположены по возрастанию степени трудности.

СОДЕРЖАНИЕ

1. Линейные алгоритмы.......................................................................... 4

2. Разветвляющиеся алгоритмы.............................................................. 5

2.1 Условный оператор IF..................................................................... 5

2.2 Условный оператор CASE.............................................................. 6

3. Циклические алгоритмы...................................................................... 8

3.1 Оператор цикла FOR....................................................................... 8

3.2 Оператор цикла WHILE.................................................................. 9

4. Обработка массивов........................................................................... 12

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

4.1.1 Алгоритмы поиска и присвоения значений элементам массива 12

4.1.2 Алгоритмы нахождения суммы, произведения и количества элементов массива. Работа с индексами элементов массива........................................... 14

4.1.3 Алгоритмы нахождения наибольшего или наименьшего элемента массива и его индекса.............................................................................................. 18

4.1.4 Алгоритмы удаления, вставки и перестановки элементов..... 21

4.1.5 Алгоритмы сортировки числового массива........................... 22

4.2 Двумерные массивы..................................................................... 23

4.2.1 Алгоритмы действий над элементами двумерного массива.. 23

4.2.2 Алгоритмы формирования одномерного массива................. 28

4.2.3 Алгоритмы нахождения наибольшего и наименьшего элементов двумерного массива.............................................................................................. 31

4.2.4 Алгоритмы удаления, вставки и перестановки элементов..... 33

5. Обработка строк................................................................................ 34

5.1 Подсчет и вывод символов............................................................ 34

5.2 Удаление символов........................................................................ 35

5.3 Вставка символов.......................................................................... 36

5.4 Сложные варианты........................................................................ 37

6. Создание графических изображений. Модуль Graph...................... 39

Линейные алгоритмы

Задача 1. Даны две целые переменные A, B. Составить фрагмент программы, после исполнения которого, значения переменных поменялись бы местами (новое значение A равно старому значению B и наоборот).

USES Crt;

VAR

A, B, T: INTEGER;

BEGIN

ClrScr; { Чистка экрана }

Write(‘ Введите два значения ‘);

ReadLn(A, B);

{Введем дополнительную целую переменную T}

T: = A; A: = B; B: = T;

Write(A, B);

END.

Задача 2. Решить предыдущую задачу, не используя дополнительных переменных (и предполагая, что значениями целых переменных могут быть произвольные целые числа).

USES Crt;

VAR

A, B: INTEGER;

BEGIN

ClrScr;

Write(‘ Введите два значения ‘);

ReadLn(A, B);

A: = A + B; B: = A - B; A: = A - B;

Write(A, B);

END.

Задача 3. Задан радиус окружности. Найти площадь и длину окружности.

USES Crt;

VAR

R: INTEGER;

S, L: REAL;

BEGIN

ClrScr;

Write(‘ Введите радиус окружности ‘);

ReadLn(R);

{Pi - зарезервированное значение}

S: =Pi*R*R; {Вычисление площади окружности}

L: =2*Pi*R; {Вычисление длины окружности}

WriteLn(‘ Площадь окружности = ’, S: 4: 2);

WriteLn(‘ Длина окружности = ‘, L: 4: 2);

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Даны три действительных положительных числа. Найти среднее геометрическое и среднее арифметическое этих чисел.

2. Даны катеты прямоугольного треугольника. Найти его гипотенузу и площадь.

3. Мальчик купил несколько тетрадей по сто рублей и несколько обложек по 50 рублей. Составить программу, которая могла бы подсчитать стоимость всей покупки.

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

Условный оператор IF

Задача 1. Определить является ли данное целое число R четным. Дать словесный ответ.

USES Crt;

VAR

R: INTEGER;

BEGIN

ClrScr;

WriteLn('Введите число');

ReadLn(R);

IF R MOD 2 = 0 Then WriteLn('Число четное')

Else WriteLn('Число не четное');

END.

Задача 2. Даны три целых числа. Выбрать из них те, которые принадлежат интервалу [1, 3]

USES Crt;

VAR

X, Y, Z: INTEGER;

BEGIN

ClrScr;

WriteLn('Введите три целых числа');

ReadLn(X, Y, Z);

IF (X> =1) AND (X< =3) Then WriteLn('Первое число принадлежит заданному интервалу')

Else WriteLn('Первое число не принадлежит заданному интервалу');

IF (Y> =1) AND (Y< =3) Then WriteLn('Второе число принадлежит заданному интервалу')

Else WriteLn('Второе число не принадлежит заданному интервалу');

IF (Z> =1) AND (Z< =3) Then WriteLn('Третье число принадлежит заданному интервалу')

Else WriteLn('Третье число не принадлежит заданному интервалу');

END.

Задача 3. Даны положительные целые числа A, B, C. Выяснить существует ли треугольник с длинами сторон A, B, C.

USES Crt;

VAR

A, B, C: INTEGER;

BEGIN

ClrScr;

WriteLn('Введите три числа');

ReadLn(A, B, C);

IF (A+B> C) AND (A+C> B) AND (B+C> A) Then WriteLn('Треугольник построить можно')

Else WriteLn('Треугольник построить нельзя');

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Заданы два числа X, Y. Меньшее из двух значений заменить на 0. Если же они равны – заменить нулями оба.

2. Поменять местами значения целых переменных A, B, C таким образом, чтобы оказалось A³ B³ C.

3. Заданы три числа X, Y, Z. Найти min(XYZ, X+Y+Z).

Условный оператор CASE

Задача 1. Составить программу, которая по введенному значению 1, 2, 3, 4 вычисляет площадь треугольника:

1. По основанию и высоте

2. По трем сторонам

3. По двум сторонам и углу между ними

4. Выход

USES Crt;

LABEL M1, M2;

VAR

X: INTEGER; A, H, S, B, L, C, P: REAL;

BEGIN

M1: ClrScr;

WriteLn('Вычисление площади треугольника'); WriteLn;

WriteLn('1.По основанию и высоте');

WriteLn('2.По трем сторонам');

WriteLn('3.По двум сторонам и углу между ними');

WriteLn('4.Выход');

WriteLn;

WriteLn('Введите номер пункта'); ReadLn(X);

CASE X OF

1: Begin

ClrScr;

Write('Введите основание и высоту треугольника '); ReadLn(A, H);

S: =A*H/2;

WriteLn('Площадь треугольника = ', S: 5: 2); ReadLn;

GOTO M1;

End;

2: Begin

ClrScr;

Write('Введите значения сторон треугольника ');

ReadLn(A, B, C);

P: =(A+B+C)/2;

S: =Sqrt(P*(P-A)*(P-B)*(P-C));

WriteLn('Площадь треугольника = ', S: 5: 2); ReadLn;

GOTO M1

End;

3: Begin

ClrScr;

Write('Введите значения двух сторон и угол между ними ');

ReadLn(A, B, L);

S: =A*B*Sin(L*Pi/180)/2;

WriteLn('Площадь треугольника = ', S: 5: 2); ReadLn;

GoTo M1;

End;

4: Begin

ClrScr;

WriteLn('Программа закончила свою работу'); ReadLn;

GoTo M2;

End;

ELSE

ClrScr;

WriteLn('Номер пункта ввели неверно'); ReadLn;

GoTo M1;

End;

M2: END.

Задача 2. Составить программу, которая по введенному значению выводит оценки по математике, физике, информатике.

USES Crt;

LABEL R1, R2;

VAR X: INTEGER; M: CHAR;

BEGIN

R1: ClrScr;

WriteLn('ПРГ выводит оценки по математике, физике и химии');

WriteLn('1.Вывод оценок по предметам');

WriteLn('2.Выход');

WriteLn('Введите номер пункта');

ReadLn (X);

CASE X OF

1: Begin

ClrScr;

WriteLn(' По какому предмету Вы хотите увидеть оценки');

WriteLn(' М - математика');

WriteLn(' Ф - физика');

WriteLn(' Х - химия');

ReadLn(M);

CASE M OF

'М', 'м': WriteLn('5 5 4 4 5 5 3 5 5 ');

'Ф', 'ф': WriteLn('5 4 5 3 5 4 5 5 5 ');

'Х', 'х': WriteLn('4 3 5 3 4 4 4 5 ');

End;

2: Begin

WriteLn('Программа закончена');

GoTo R2;

End;

Else

WriteLn('Номер неверен'); ReadLn;

GoTo R1;

End;

R2: End.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Составить программу, которая по введенному значению 1, 2, 3 вычисляет:

Площадь параллелограмма
Периметр параллелограмма
Выход

2. Составить программу «Календарь XX столетия», которая определяет день недели любого дня XX-го столетия. По введенному значению 1, 2, 3 вычисляет

номер дня недели по формуле, где D- день, М-месяц, G-год:

¨ S=[(12-M)/10]

¨ K=[(G-1900-S)*365, 25]+[(M+12*S-2)*30, 59]+D+29

¨ N=K-7[K/7] (N-вычисляется от 0-воскресенье до 6-суббота, []-целая часть)

день недели по его номеру
выход

Циклические алгоритмы

Оператор цикла FOR

Задача 1. Найти произведение положительных, сумму и количество отрицательных из 10 введенных целых значений.

USES Crt;

VAR

X: INTEGER; S, K, P: INTEGER; I: BYTE;

Begin

P: =1; S: =0; K: =0;

FOR I: =1 TO 10 DO Begin

WriteLn(‘Введите ‘, I, ’ -е значение’); ReadLn(x);

IF X> 0 Then P: =P*X; { произведение положительных }

IF X< 0 Then Begin

S: =S+X; { сумма отрицательных }

K: =K+1; { количество отрицательных }

End;

WriteLn(‘ Произведение положительных значений = ‘, p);

WriteLn(‘ Сумма отрицательных значений = ‘, s);

WriteLn(‘ Количество отрицательных значений = ‘, k);

END.

Задача 2. Из N целых чисел найти минимальное значение.

USES Crt;

VAR MI, X: INTEGER; I, N: BYTE;

BEGIN

WriteLn('Введите количество значений'); ReadLn(n);

WriteLn('Введите первое значение'); ReadLn(mi);

FOR I: =2 TO N DO Begin

WriteLn(‘Введите ‘, I, ’ -е значение’); ReadLn(x);

IF X< MI Then MI: =X;

End;

WriteLn(‘Минимальное значение = ‘, MI);

END.

Задача 3. Из N целых чисел найти минимальное среди положительных и максимальное среди отрицательных значений.

USES Crt;

VAR

MI, MA, N, I, X: INTEGER; FL, FL1: BYTE;

BEGIN

WriteLn('Введите количество значений'); ReadLn(N);

FL: =0; FL1: =0;

FOR I: =1 TO N DO Begin

WriteLn('Введите ', I, ' значение'); ReadLn(X);

IF (FL=0) AND (X< 0) Then Begin

MA: =X; FL: =1;

End;

IF (FL1=0) AND (X> 0) Then Begin

MI: =X; FL1: =1;

End;

IF (X< 0) AND (X> MA) Then MA: =X;

IF (X> 0) AND (X< MI) Then MI: =X;

End;

IF FL=1 Then WriteLn('максимальное среди отрицательных = ', ma)

Else WriteLn('отрицательных нет');

IF FL1=1 Then WriteLn('минимальное среди положительных = ', mi)

Else WriteLn('положительных нет');

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Найти среднее арифметическое минимального и максимального элементов из 10 введенных.

2. Напечатать лучший результат заплыва среди 8 участников.

3. Из n введенных чисел найти максимальное значение среди положительных элементов.

4. В группе определить самого высокого мальчика и самую маленькую девочку.

5. В ЭВМ вводятся результаты соревнований по прыжкам в высоту. Число участников произвольно. Напечатать сообщение о победителе.

Оператор цикла WHILE

Задача 1. Дано целое число а и натуральное (целое неотрицательное) число n. Вычислить а в степени n. {Введем целую переменную k, которая меняется от 0 до n, причем поддерживается такое свойство: b = (a в степени k).}

USES Crt;

VAR

A, N, B, K: INTEGER;

BEGIN

ClrScr;

Write(‘ Введите два значения ‘); ReadLn(A, N);

K: = 0; B: = 1;

While K < > N DO Begin

K: = K + 1; B: = B * A;

End;

Write(‘ A в степени N = ’, B);

END.

Другое решение той же задачи:

USES Crt;

VAR

A, N, B, K: INTEGER;

BEGIN

ClrScr; { Чистка экрана }

Write(‘ Введите два значения ‘); ReadLn(A, N);

K: = N; B: = 1;

{A в степени N = B * (A в степени K)}

While K < > 0 DO Begin

K: = K - 1; B: = B * A;

End;

Write(‘ A в степени N = ’, B);

END.

Задача 2. Даны натуральные числа а, b. Вычислить произведение а*b, используя в программе лишь операции +, -, =, < >.

USES Crt;

VAR

A, B, C, K: INTEGER;

BEGIN

Write(‘ Введите два значения ‘); ReadLn(A, B);

K: = 0; C: = 0;

While K < > B DO Begin

K: = K + 1; C: = C + A;

End;

{C = A * K и K = B, следовательно, C = A * B}

Write(‘ A*B= ‘, C);

END.

Задача 3. Дано натуральное (целое неотрицательное) число A и целое положительное число D. Вычислить частное Q и остаток R при делении A на D, не используя операций DIV и MOD. (Согласно определению, А = Q * D + R, 0 < = R < D.)

USES Crt;

VAR

A, D, R, Q: INTEGER;

BEGIN

ClrScr;

Write(‘ Введите два значения ‘); ReadLn(a, d);

R: = A; Q: = 0;

While Not (R < D) DO Begin

R: = R - D; {R > = 0}

Q: = Q + 1;

End;

WriteLn(‘ Частное = ’, Q);

WriteLn(‘ Остаток = ’, R);

END.

Задача 4. Каждый год урожайность повышается на 5%. Через сколько лет урожай удвоится?

USES Crt;

VAR

YR, KL: BYTE; YRG: REAL;

Begin

ClrScr;

Write('Введите урожайность '); ReadLn(YR);

YRG: =YR;

While (YRG < 2*YR) Do Begin

YRG: =YRG+0.05*YRG;

KL: =KL+1;

End;

WriteLn('Новый урожай ', YRG: 5: 0);

Write('Через ', KL, ' лет урожай удвоится');

END.

Задача 5. Деду M лет, а внуку N лет. Через сколько лет дед станет вдвое старше внука. И сколько при этом лет будет деду и внуку.

USES Crt;

VAR

M, N: BYTE; Kl: BYTE;

BEGIN

ClrScr;

Write('Введите количество лет деда '); ReadLn(m);

Write('Введите количество лет внука '); ReadLn(n);

KL: =0;

While (M> 2*N) DO Begin

M: =M+1; N: =N+1; KL: =KL+1;

End;

WriteLn(M, ' лет деду');

WriteLn(N, ' лет внуку');

WriteLn('Через ', KL, ' лет дед вдвое станет старше внука');

END.

Задача 6. Поле засеяли цветами двух сортов на площади S1 и S2. Каждый год площадь цветов первого сорта увеличивается вдвое, а площадь второго сорта увеличивается втрое. Через сколько лет площадь первых сортов будет составлять меньше 10% от площади вторых сортов.

USES Crt;

VAR

S1, S2: WORD; KL: BYTE;

BEGIN

ClrScr;

Write('Введите площадь, которую засеяли цветами 1-го сорта '); ReadLn(S1);

Write('Введите площадь, которую засеяли цветами 2-го сорта '); ReadLn(S2);

KL: =1;

While (S1> 0.1*S2) DO Begin

S1: =S1*2; S2: =S2*3; KL: =KL+1;

End;

WriteLn('Площадь, которую засеяли цветами 1-го сорта ', S1);

WriteLn('Площадь, которую засеяли цветами 2-го сорта ', S2);

WriteLn('Через ', kl, ' лет');

END.

Задача 7. Составить программу перевода числа из 10 системы счисления в 2 систему счисления.

Для этой задачи представлено два решения.

USES Crt;

VAR

DES, OST, I, DW: INTEGER;

BEGIN

ClrScr;

Write('Введите десятичное число '); ReadLn(DES);

I: =1;

While (DES> =2) DO Begin

OST: =DES mod 2;

DES: =DES div 2;

DW: =DW+OST*I;

I: =I*10;

End;

DW: =DW+DES*I;

Write('Двоичная запись числа ', DW);

END.

USES Crt;

Const A=10;

VAR

DES, OST, I: INTEGER;

DW: Array[1..100] OF INTEGER;

BEGIN

ClrScr;

Write('Введите десятичное число '); ReadLn(des);

I: =1;

While (des> =2) DO Begin

OST: =DES mod 2;

DES: =DES div 2;

DW[I]: =OST;

I: =I+1;

End;

DW[I]: =DES;

FOR I: =I DownTo 1 DO

Write(DW[I]);

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Составить программу, печатающую квадраты всех натуральных чисел от 0 до заданного натурального n.

2. Дано натуральное n, вычислить n! (0! =1, n! = n * (n-1)! ).

3. Последовательность Фибоначчи определяется так: a(0)= 1, a(1) = 1, a(k) = a(k-1) + a(k-2) при k > = 2. Дано n, вычислить a(n).

4. К старушке на обед ходят кошки. Каждую неделю две кошки приводят свою подружку. В доме у старушки 100 мисок. Через какое время появятся лишние кошки, и сколько кошек при этом останется голодными.

5. Известна сумма номеров страниц, определить номер страницы.

6. Лягушка каждый последующий прыжок делает в два раза короче предыдущего. Достигнет ли она болота и за сколько прыжков. Длину первого прыжка задайте самостоятельно.

Обработка массивов

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

VAR

P: ARRAY[0..N] OF INTEGER;

I, T: BYTE; S: INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение массива случайными числами }

WriteLn(' Значения элементов массива');

FOR I: =1 TO N DO Begin

P[I]: =Random(30); Write(P[I]: 3);

End; WriteLn;

Write(' Введите значение переменной '); ReadLn(T);

S: =0;

FOR I: =1 TO N DO

IF P[I]> T THEN S: =S+P[I]; { сумма элементов массива > T }

WriteLn(' Сумма элементов массива > заданного значения = ', S);

END.

Задача 2. Дан массив целых чисел, состоящий из 25 элементов. Подсчитать сумму элементов массива, произведение положительных и количество нулевых элементов. Результат вычисления вывести на экран.

USES Crt;

VAR

A: ARRAY[0..25] OF INTEGER;

I: BYTE; S, K: INTEGER; P: REAL;

BEGIN

ClrScr; Randomize;

{ Заполнение массива случайными числами }

WriteLn(' Значения элементов массива');

FOR I: =1 TO 25 DO Begin

A[I]: =Random(10)-3; Write(A[I]: 3);

End; WriteLn;

S: =0; K: =0; P: =1;

FOR I: =1 TO 25 DO Begin

S: =S+A[I]; { сумма элементов массива }

IF A[I]> 0 THEN P: =P*A[I]; { произведение положительных элементов массива }

IF A[I]=0 THEN K: =K+1; { количество нулевых элементов массива }

End;

WriteLn(' Сумма элементов массива = ', S);

WriteLn(' Произведение положительных элементов массива = ', P: 0: 0);

WriteLn(' Количество нулевых элементов массива = ', K);

END.

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

· сумму элементов, имеющих нечетные индексы;

· подсчитать количество элементов массива, значения которых больше заданного числа T и кратны 5;

· номер первого отрицательного элемента, делящегося на 5 с остатком 2.

USES Crt;

CONST T=11;

VAR

A: ARRAY[0..15] OF INTEGER;

I, NP, FL: BYTE; S, K: INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение массива с клавиатуры }

FOR I: =1 TO 15 DO Begin

Write('Введите ', I, ' злемент массива '); ReadLn(A[I]);

End; WriteLn;

S: =0; K: =0; FL: =0;

FOR I: =1 TO 15 DO Begin

IF I mod 2 =0 THEN S: =S+A[I]; { сумма элементов, имеющих четные индексы }

IF (A[I]> T) AND (A[I] mod 5 =0) THEN K: =K+1; { количество }

IF (A[I]< 0) AND (A[I] mod 5 =-2) AND (FL=0) THEN Begin NP: =I; FL: =1; End;

End;

WriteLn(' Сумма элементов, имеющих четные индексы = ', S);

WriteLn(' Количество элементов, значения которых > ', T, ' и кратны 5 = ', K);

WriteLn(' Номер первого отрицательного элемента, делящегося на 5 с остатком 2 = ', NP);

END.

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

· сумму положительных элементов, значения которых меньше 10;

· вывести индексы тех элементов, значения которых кратны 5 и 3;

· количество пар соседних элементов с суммой равной заданному числу.

USES Crt;

CONST T=21;

VAR

A: ARRAY[0..10] OF INTEGER;

I: BYTE; S, K: INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение массива с клавиатуры }

FOR I: =1 TO 10 DO Begin

Write('Введите ', I, ' злемент массива '); ReadLn(A[I]);

End; WriteLn;

S: =0; K: =0;

WriteLn(' Индексы элементов, значения которых кратны 3 и 5');

FOR I: =1 TO 10 DO Begin

IF (A[I]> 0) AND (A[I]< 10) THEN S: =S+A[I];

IF (A[I] mod 3 =0) AND (A[I] mod 5 =0) THEN Write(I: 3);

IF I< > 10 THEN IF A[I]+A[I+1]=T THEN K: =K+1;

End; WriteLn;

WriteLn(' Сумма положительных элементов, значения которых < 10 = ', S);

WriteLn(' Количество пар соседних элементов с суммой равной ', T, ' = ', K);

END.

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

· удвоенную сумму положительных элементов;

· вывести индексы тех элементов, значения которых больше значения предыдущего элемента (начиная со второго);

· количество пар соседних элементов с одинаковыми знаками.

USES Crt;

VAR

A: ARRAY[0..10] OF INTEGER;

I: BYTE; S, K: INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение массива с клавиатуры }

FOR I: =1 TO 10 DO Begin

Write('Введите ', I, ' злемент массива '); ReadLn(A[I]);

End; WriteLn;

S: =0; K: =0;

WriteLn(' Индексы элементов, значения которых > значения предыдущего элемента');

FOR I: =1 TO 10 DO Begin

IF (A[I]> 0) THEN S: =S+A[I];

IF I< > 1 THEN IF A[I] > A[I-1] THEN Write(I: 3);

IF I< > 10 THEN IF (A[I] * A[I+1])> 0 THEN K: =K+1;

End; WriteLn;

WriteLn(' Удвоенная сумма положительных элементов = ', S*2);

WriteLn(' Количество пар соседних элементов с одинаковыми знаками = ', K);

END.

Задача 6. Дан массив C, состоящий из N элементов. Элементы массива - произвольные целые числа. Вывести на экран элементы массива в обратном порядке.

USES Crt;

CONST N=20;

VAR

C: ARRAY[0..N] OF INTEGER;

I: BYTE;

BEGIN

ClrScr; Randomize;

WriteLn(' Значения элементов массива');

FOR I: =1 TO N DO Begin

C[I]: =Random(20); Write(C[I]: 3);

End; WriteLn;

WriteLn(' Значения элементов массива в обратном порядке');

FOR I: =N DOWNTO 1 DO

Write(C[I]: 3);

END.

Задача 7. Дан массив A, состоящий из N элементов. Элементы массива - произвольные целые числа. Распечатать элементы в две строки: в первой строке элементы с нечетными индексами, а во второй - элементы с четными индексами.

USES Crt;

CONST N=25;

VAR

A: ARRAY[0..N] OF INTEGER;

I: BYTE;

BEGIN

ClrScr; Randomize;

WriteLn(' Значения элементов массива');

FOR I: =1 TO N DO Begin

A[I]: =Random(20); Write(A[I]: 3);

end; WriteLn;

I: =1;

WriteLn(' Элементы с нечетными индексами');

WHILE I< =N DO Begin

Write(A[I]: 3); I: =I+2;

End; WriteLn;

I: =2;

WriteLn(' Элементы с четными индексами');

WHILE I< =N DO Begin

Write(A[I]: 3); I: =I+2;

End;

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Дан массив целых чисел, состоящий из 10 элементов. Заполнить его с клавиатуры. Найти:

· сумму отрицательных элементов;

· количество тех элементов, значения которых положительны и не превосходят заданного числа А;

· номер последней пары соседних элементов с разными знаками.

2. Дан массив целых чисел, состоящий из 10 элементов. Заполнить его с клавиатуры. Найти:

· сумму элементов, имеющих нечетное значение;

· вывести индексы тех элементов, значения которых больше заданного числа А;

· количество положительных элементов, кратных К. ( К вводится с клавиатуры ).

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

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

5. Оценки, полученные учащимися за урок, занесены в массив. Подсчитать количество «5» и «2», полученных учащимися за урок и средний балл.

6. В очереди за билетами стоят мужчины и женщины. Какое количество мужчин стоит в начале очереди до первой женщины.

Двумерные массивы

Обработка строк

Подсчет и вывод символов

Задача 1. Подсчитать сколько букв «о» в тексте

USES Crt;

VAR

A: STRING [255]; KB N, I: BYTE;

BEGIN

ClrScr;

Write('Введите тест '); ReadLn(A);

N: =Length(A);

KB: =0;

FOR I: =1 TO N DO

IF (A[I]=’o’) OR (A[I]=’O’) THEN KB: =KB+1;

WritLn(‘ Количество букв «о» =’, KB);

END.

Задача 2. Определить среднюю длину слова в тексте.

USES Crt;

VAR

A: STRING [240]; KS, KB, N, I: INTEGER;

BEGIN

ClrScr;

Write('Введите тест '); ReadLn(A);

N: =Length(A);

KS: =0; KB: =0;

FOR I: =1 TO N DO

IF (A[I]=' ') OR (A[I]=', ') OR (A[I]='.') THEN KS: =KS+1 ELSE KB: =KB+1;

IF (A[N]< > ' ') AND (A[N]< > '.') AND (A[N]< > ', ') THEN KS: =KS+1;

WriteLn('Средняя длина слова = ', KB/KS: 3: 0);

END.

Задача 3. Подсчитать, сколько слов в тексте начинается на букву «а» (слова разделены пробелом).

USES Crt;

VAR

A: STRING [240]; KS, N, I: INTEGER;

BEGIN

ClrScr;

Write('Введите тест '); ReadLn(A);

N: =Length(A);

IF A[1]=’А’ THEN KS: =1 ELSE KS: =0;

FOR I: =2 THEN N

IF (COPY(A, I, 2) =’ а’) OR (COPY(A, I, 2)=’ А’ THEN KS: =KS+1;

WriteLn(‘Количество слов, начинающихся на букву «а» =’, KS);

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Подсчитать, сколько слов в тексте оканчивается на букву “а”.

2. Подсчитать, сколько букв “т” в последнем предложении.

3. Подсчитать, сколько раз встречается в тексте слово “кот”.

Удаление символов

Задача 1. Удалить лишние пробелы между словами, оставив по одному.

USES Crt;

VAR

S: STRING[255]; I, K: INTEGER;

BEGIN

ClrScr;

Write('Введите текст '); ReadLn(S);

I: =1;

While(I< =Length(s)) DO Begin

IF Copy(S, I, 2)=' ' THEN Begin

Delete (S, I, 1);

I: =I-1;

End;

I: =I+1;

End;

Write(S);

END.

Задача 2. В тексте удалить все слова, заканчивающиеся на букву " e".

USES Crt;

VAR

S: STRING [250]; PS, N, I: INTEGER;

BEGIN

ClrScr;

Write('Введите текст '); ReadLn(S);

S: = ' '+S+' ';

FOR I: =1 TO Length(S) DO Begin

IF S[I]=' ' THEN Begin

PS: =I-1;

IF S[PS]='E' THEN WHILE(S[PS]< > ' ') DO Begin

Delete(S, PS, 1); PS: =PS-1;

End;

WriteLn(‘ Измененный текст: ’); Write(S);

END.

Задача 3. Из текста удалить каждое второе слово. Слова разделены пробелом.

USES Crt;

Type MAS= STRING [20];

VAR

A: MAS;

I, K: INTEGER;

BEGIN

ClrScr;

Write('Введите текст '); ReadLn(A);

i: =1;

While (I< =Length(A)) DO Begin

IF A[I]=' ' THEN Begin

K: =I+1;

While (A[K]< > ' ') DO Delete(A, K, 1);

I: =I+1;

End;

I: =I+1;

End;

WriteLn(‘Измененный текст: ’); Write(A);

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. В третьем предложении текста удалить все слова «мир»

2. Из строки символов удалить все гласные буквы

3. Из строки символов удалить заданное слово

4. Удалить все символы «! », следующие за вторым предложением

Вставка символов

Задача 1. В текст вставить символ пробел после каждого имеющегося символа пробел.

USES Crt;

VAR

A: STRING [255]; I: INTEGER;

BEGIN

ClrScr;

WriteLn('Введите текст'); ReadLn(A);

I: =1;

While (I< =Length(A)) DO Begin

IF A[I]=' ' THEN Begin Insert (' ', A, I); I: =I+1; End;

I: =I+1;

End;

WriteLn(‘Измененный текст: ’); WriteLn(A);

END.

Задача 2. Третье предложение в тексте заключить в скобки.

USES Crt;

VAR

A: STRING [200]; I, K, F: INTEGER;

BEGIN

ClrScr;

Write('Введите текст '); ReadLn(A);

I: =1; K: =0; F: =0;

While (I< =Length(A)) DO Begin

IF A[I]='.' THEN K: =K+1;

IF (K=2) AND (F=0) THEN Begin Insert('(', A, I+1); F: =1; End;

IF (K=3) AND (F=1) THEN Begin Insert(')', A, I+1); F: =0; End;

I: =I+1;

End;

WriteLn(‘Измененный текст: ’); WriteLn(A);

END.

Задача 3. Исправить ошибки в тексте. Во все слова " длиный" вставить букву " н".

USES Crt;

VAR

S: STRING [50]; PZ, I: INTEGER;

BEGIN

ClrScr;

WriteLn(‘Введите текст’); ReadLn(S);

FOR I: =1 TO Length(S) DO

IF Copy(S, I, 6)='длиный' THEN Insert('н', S, I+3);

WriteLn(‘Измененный текст: ’); WriteLn(S);

END.

.....................................................................................................................................

Практические задания

..................................................................................................................................

1. Исправить ошибки в тексте: в словах “рож”, “мыш”, “доч” в конце поставить “ь”.

2. В тексте в последнем предложении после слова «мама» вставить «и папа».

3. В тексте после слов «например» поставить «, ».

4. В тексте во втором предложении после слов «Ура» поставить «!!! ».

5.4 Сложные варианты

Задача 1. Определить, является введенное слово " перевертышем" (потоп, казак).

USES Crt;

VAR

A, B: STRING [20]; I, N: BYTE;

BEGIN

ClrScr;

Write('Введите слово '); ReadLn(A);

N: =Length(A);

FOR I: =N DownTo 1 DO

B: =B+A[I];

IF B=A THEN Write('Перевертыш') ELSE Write('Не перевертыш');

END.

Задача 2. Подсчитать количество слов, в которых буква " а" входит не менее двух раз. (слова разделены пробелом).

USES Crt;

VAR

A: STRING [255]; KS, KB, I, N: INTEGER;

BEGIN

ClrScr;

WriteLn('Введите текст '); ReadLn(A);

A: =A+' ';

N: =Length(A);

KB: =0; KS: =0; I: =1;

While (I< =N) DO Begin

While (A[I]< > ' ') DO Begin

IF (A[I]='a') OR (A[I]='A') THEN KB: =KB+1;

I: =I+1;

End;

IF KB> 2 THEN KS: =KS+1;

KB: =0;

I: =I+1;

End;

WriteLn(' Количество слов, в которых буква " а" встречается не менее двух раз = ', ks)

END.

Задача 3. Найти слово в тексте, содержащее наибольшее количество букв " м".

USES Crt;

VAR

A, D: STRING [255]; I, KB, MKB, K, MK, NP, MNP: INTEGER;

BEGIN

ClrScr;

WriteLn('Введите текст'); ReadLn(A);

I: =1; KB: =0; MKB: =0; NP: =1;

While(I< =Length(A)) DO Begin

While(A[I]< > ' ') DO Begin

IF A[I]='м' THEN KB: =KB+1;

K: =K+1; I: =I+1;

End;

IF MKB< KB THEN Begin MKB: =KB; MNP: =NP; MK: =K; End;

NP: =I+1; KB: =0; K: =0;

I: =I+1;

End;

D: =Copy(A, MNP, MK);

WriteLn('Слово с максимальным количеством букв " м" - ', D);

END.

Задача 4. Проверить правильность написания круглых скобок.

Var

A: String[50];

K, I, N: Integer;

BEGIN

WriteLn(‘Введите тест’);

ReadLn(A);

N: =Length(A);

FOR I: =1 TO N DO Begin

IF A[I]=’(‘ THEN=N+1;

IF A[I]=’)‘ THEN N: =N-1;

IF N< 0 THEN Begin WriteLn(‘Неверно’); Break; End;

End;

IF N=0 THEN WriteLn(‘Верно’) ELSE WriteLn(‘Неверно’);

END.

.....................................................................................................................................

Практические задания

.....................................................................................................................................

1. Вывести на экран самое длинное слово из введенного текста.

2. Определить, имеются ли в строке символов все буквы, входящие в введенное слово.

3. Из текста удалить все слова, начинающиеся и оканчивающиеся на одну и ту же букву.

4. В тексте найти и подсчитать количество слов, у которых первый и последний символы совпадают между собой (слова разделены пробелами).

VAR

Dr, Md, M, X, Y, I: INTEGER; Ch: CHAR;

BEGIN

Dr: =Detect;

InitGraph(Dr, Md, 'c: \tp7\bgi'); IF GraphResult< > 0 then HALT(1);

REPEAT

SetBkColor(1); SetColor(6); SetTextStyle(0, 0, 2);

ClearDevice;

{ Вывод меню }

OutTextXY(50, 140, 'Пробел - Красим экран');

OutTextXY(50, 170, 'Стрелка вверх - Столбик поднимается');

OutTextXY(50, 200, 'Стрелка вниз - Столбик опускается');

OutTextXY(50, 230, 'ESC - Выход');

REPEAT

Ch: =ReadKey; {разветвление программы по нажатию клавиши}

CASE Ch OF

#32: Begin { Красим экран }

ClearDevice;

SetBkColor(0); SetFillStyle(1, 15);

Bar(0, 0, GetMaxX div 2, GetMaxY);

SetFillStyle(1, 0);

Bar(GetMaxX div 2, 0, GetMaxX, GetMaxY);

OutTextXY(70, GetMaxY-25, 'Нажмите DEL');

End;

#72: Begin { Ртутный столбик поднимается }

ClearDevice; SetLineStyle(0, 0, 1); SetBkColor(1); SetColor(4);

X: =GetMaxX div 2; Y: =GetMaxY div 2;

Rectangle(X, Y, X+40, GetMaxY-20);

FOR I: =1 TO120 DO Begin

SetColor(4); SetLineStyle(0, 0, 3);

Line(X, GetMaxY-20-I, X+40, GetMaxY-20-i);

Delay(250);

End;

OutTextXY(70, GetMaxY-25, 'Нажмите DEL');

End;

#80: Begin { Ртутный столбик опускается }

ClearDevice; SetLineStyle(0, 0, 1); SetBkColor(1); SetColor(4);

X: =GetMaxX div 2; Y: =GetMaxY div 2;

Rectangle(x, y, x+40, GetMaxY-20);

SetFillStyle(1, 4);

Bar(x, GetMaxY-140, x+40, GetMaxY-20);

FOR I: =1 TO 117 DO Begin

SetColor(1); SetLineStyle(0, 0, 3);

Line(x+1, GetMaxY-140+i, x+39, GetMaxY-140+i);

Delay(250);

End;

SetColor(4); OutTextXY(70, GetMaxY-25, 'Нажмите DEL');

End;

UNTIL (Ch=#83) or (Ch=#27);

UNTIL (Ch=#27);

CloseGraph;

END.

Задача 3. Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран день и ночь.

USES Crt, Graph;

LABEL Ex, New;

VAR Gd, Gm: INTEGER; Av: CHAR;

PROCEDURE DAY; {процедура-солнечное затмение}

VAR X, Y, X1, Y1: INTEGER; U: REAL;

BEGIN

ClearDevice; SetFillStyle(1, 14); SetColor(14);

X: =GetMaxX DIV 2; Y: =GetMaxY DIV 2;

FillEllipse(X, Y, 50, 50); {солнце}

FOR Gm: =1 TO 150 DO Begin

U: =Random(359);

X1: =Trunc(Random (200)*COS(U))+X; Y1: = Trunc (Random (200)*SIN(U))+Y;

Line(X, Y, X1, Y1); {солнечные лучи}

End;

SetFillStyle(1, 8); SetColor(8);

FillEllipse(X-15, Y, 50, 50); {тень луны}

REPEAT

UNTIL KeyPressed; {задержка до нажатия любой клавиши}

END;

PROCEDURE NOCH; {процедура - лунная ночь со звездами}

VAR R, X, Y, I: INTEGER;

BEGIN

ClearDevice; SetFillStyle (1, 15); SetColor (15);

FOR I: =1 TO 50 DO Begin

R: = Random (2);

PutPixel(Random (GetMaxX), Random (GetMaxY), 15);

FillEllipse(Random (GetMaxX), Random (GetMaxY), R, R);

End;

SetFillStyle (1, 15); SetColor (15); FillEllipse (200, 100, 50, 50);

SetFillStyle (1, 0); SetColor (0); FillEllipse (180, 100, 50, 50); {луна}

REPEAT

UNTIL KeyPressed; {задержка до нажатия любой клавиши}

END;

BEGIN{основная программа}

Gd: =Detect; InitGraph(Gd, Gm, 'C: \tp7\BGI');

WHILE true DO Begin

SetFillStyle (1, 1); FloodFill(10, 10, 1); SetFillStyle (1, 0);

Bar(215, 115, 415, 365);

SetColor (5); SetFillStyle (1, 5);

Bar(200, 100, 400, 350); {меню}

SetTextStyle(7, 0, 5); SetColor (0);

OutTextXY(237, 117, 'MENU'); OutTextXY (237, 287, 'EXIT');

SetColor (12); OutTextXY (235, 115, 'MENU');

SetColor (4); OutTextXY (235, 285, 'EXIT');

SetTextStyle (0, 0, 3); SetColor (0);

OutTextXY (227, 207, 'D: ДЕНЬ'); OutTextXY (227, 247, 'N: НОЧЬ');

SetColor (3); OutTextXY (225, 205, 'D: ДЕНЬ'); OutTextXY (225, 245, 'N: НОЧЬ');

SetColor (15); SetTextStyle (0, 0, 2);

OutTextXY (100, 450, 'использовать клавиши D, N, ESC');

Av: =ReadKey;

CASE Av OF {разветвление программы по нажатию клавиши}

'D', 'd': DAY;

'N', 'n': NOCH;

CHR(27): GOTO Ex;

End;

Ex: CloseGraph;

END.

Задача 4. Построить график функции.

USES Crt, Graph;

VAR

Gd, Gm: INTEGER;

X0, Y0: INTEGER; { Начало осей координат }

X, Y: INTEGER; Mx, My, I: INTEGER;

A, B, H, F: REAL;

BEGIN

WriteLn('Введите интервал и шаг изменения функции'); ReadLn(A, B, H);

WriteLn('Введите масштаб по X и Y'); ReadLn(Mx, My);

Gd: =Detect; Gm: =1;

InitGraph(Gd, Gm, 'c: \tp7\bgi'); IF GraphResult< > 0 THEN HALT(1);

{ Построение осей координат }

X0: =GetMaxX div 2; Y0: =GetMaxY div 2;

Line(10, Y0, GetMaxX, Y0); Line(X0, 10, X0, GetMaxY);

{ Построение стрелок }

Line(X0, 10, X0-10, 20); Line(X0, 10, X0+10, 20);

Line(GetMaxX, Y0, GetMaxX-10, Y0-10);

Line(GetMaxX, Y0, GetMaxX-10, Y0+10);

OutTextXY(X0-25, 10, 'X'); OutTextXY(GetMaxX-20, Y0+20, 'Y');

{ Разметка осей координат }

I: =X0;

REPEAT

I: =I+Mx;

PutPixel(I, Y0-1, 15); PutPixel(2*X0-I, Y0-1, 15);

UNTIL I> GetMaxX;

I: =Y0;

REPEAT

I: =I+My;

PutPixel(X0+1, I, 15); PutPixel(X0+1, 2*Y0-I, 15);

UNTIL I> GetMaxY;

{ Построение графика функции }

REPEAT

F: =A*A; { функция }

X: =Trunc(X0+A*Mx); Y: =Trunc(Y0-F*My);

PutPixel(X, Y, 15); A: =A+H;

UNTIL A> B;

ReadLn;

END.

Задача 5. Построить круговую диаграмму.

USES Сrt, Graph;

VAR

Gd, Gm: INTEGER; I, N, S, C: INTEGER;

M: ARRAY[1..10] OF INTEGER;

Nk, Kk: INTEGER; P: REAL;

BEGIN

WriteLn('Введите количество значений'); ReadLn(N);

S: =0;

FOR I: =1 TO N DO Begin

Writeln('Введите ', I, ' значение'); ReadLn(M[I]);

S: =S+M[I];

end;

P: =360/S; {приходится радиан на 1% }

Gd: =Detect; Gm: =1;

InitGraph(Gd, Gm, 'c: \tp7\bgi'); IF GraphResult< > 0 THEN HALT(1);

S: =0; C: =1;

FOR I: =1 TO N DO Begin

Nk: =Trunc(P*S); { Начальный угол }

Kk: =Trunc(P*(S+M[I])); { Конечный угол }

SetFillStyle(1, C);

PieSlice(GetMaxX div 2, GetMaxY div 2, nk, kk, 100);

S: =S+m[i];

C: =C+1; IF C=14 THEN C: =1; { Изменение цвета }

End;

ReadLn;

CloseGraph;

END.

Задача 6. Построить пятиконечную звезду.

USES Crt, Graph;

VAR

Gd, Gm: INETEGER; X, Y, Rb, Rm: INETEGER;

Points: ARRAY [1..11] OF PointType; {Массив вершин }

I, A: REAL;

BEGIN

Gd: =Detect; Gm: =1;

InitGraph(Gd, Gm, 'c: \tp7\bgi'); IF GraphResult< > 0 THEN HALT(1);

Rb: =150; Rm: =70;

ClearDevice; SetBkColor(3); SetColor(4); SetFillStyle(1, 4);

I: =1; A: =0.94;

{ Определение координат вершин звезды }

WHILE (I< =10) DO Begin

X: =Trunc(Rb*COS(A))+300; Points[I].X: =X;

Y: =Trunc(Rb*SIN(A))+200; Points[I].Y: =Y;

Inc(I); A: =A+0.628;

X: =Trunc(Rm*COS(A))+300; Points[I].X: =X;

Y: =Trunc(RM*SIN(A))+200; Points[I].Y: =Y;

Inc(I); A: =A+0.628;

End;

{ Связь координат первой и последней вершин }

Points[11].X: =Points[1].X; Points[11].Y: =Points[1].Y;

FillPoly(11, Points); { Построение звезды }

ReadLn;

CloseGraph;

END.

Задача 7. Построить объект, который передвигается с помощью навигационных клавиш.

USES Crt, Graph;

VAR

Gd, Gm: INTEGER; Av: CHAR;

X, Y, I, T, Z, K: INTEGER; St: STRING[225];

BEGIN

Gd: =Detect; InitGraph(Gd, Gm, 'C: \tp7\BGI');

ClearDevice;

X: =GetMaxX DIV 2; Y: =GetMaxY DIV 2;

T: =0; I: =0; K: =500;

REPEAT

SetColor(15);

{ Построение объекта }

Line(X, Y-10, X, Y-3); Line (X, Y+10, X, Y+3);

Line (X-10, Y, X-3, Y); Line (X+10, Y, X+3, Y);

Circle(X, Y, 7);

Av: =ReadDKey;

{ Изменение координат при нажатии клавиши }

IF CHR(75)=Av THEN T: =-10; IF CHR(77)=Av THEN T: =10;

IF CHR(72)=Av THEN I: =-10; IF CHR(80)=Av THEN I: =10;

SetColor (0);

Line (X, Y-10, X, Y-3); Line (X, Y+10, X, Y+3);

Line (X-10, Y, X-3, Y); Line (X+10, Y, X+3, Y);

Circle(X, Y, 7);

X: =X+T; Y: =Y+I; I: =0; T: =0;

IF X> (GetMaxX-2) THEN X: =GetMaxX-2; IF X< 2 THEN X: =2;

IF Y> (GetMaxY-2) THEN Y: =GetMaxY-2; IF Y< 2 THEN Y: =2;

UNTIL ORD(Av)=27; { Пока не нажата клавиша Esc }

END.

Задача 8. Построить орнамент.

USES Crt, Graph;

VAR

Gd, Gm: INTEGER; Av: CHAR;

X1, Y1, X, Y: INTEGER; U, H: REAL;

BEGIN

Gd: =Detect; InitGraph(Gd, Gm, 'C: \tp7\BGI');

SetFillStyle(1, 14); SetBkColor(5); SetColor(14);

X: =GetMaxX DIV 2; Y: =GetMaxY DIV 2;

U: =2*Pi;

While U> =0 DO Begin

X1: =Trunc(100*COS(U))+X; Y1: =Tunc(100*SIN(U))+Y;

Circle(X1, Y1, 3);

Delay(1000); U: =U-0.1;

End;

H: =-5;

While H< =45 DO Begin

X: =Trunc(100+H*10); Y: =Trunc(100-SIN(H)*10);

Circle(X, Y, 2);

Delay(500); H: =H+0.5;

End;

H: =-5;

While H< =45 DO Begin

X: =Trunc(100+H*10); Y: =Trunc(380-SIN(H)*10);

Circle(X, Y, 2);

Delay(500); H: =H+0.5;

End;

ReadLn;

END.

.....................................................................................................................................

12 3 4 5 Следующая ⇒