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

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

Название документа Чолокоглы_Программирование.doc


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

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

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

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

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

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


СОДЕРЖАНИЕ


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


Задача 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 рублей. Составить программу, которая могла бы подсчитать стоимость всей покупки.

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

2.1 Условный оператор 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 таким образом, чтобы оказалось ABC.

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


2.2 Условный оператор 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;

End;

2: Begin

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

GoTo R2;

End;

Else

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

GoTo R1;

End;

R2:End.

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

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

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

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

  1. Площадь параллелограмма

  2. Периметр параллелограмма

  3. Выход

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

  1. номер дня недели по формуле, где 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-суббота, []-целая часть)

  1. день недели по его номеру

  2. выход

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

3.1 Оператор цикла 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;

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

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

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. В ЭВМ вводятся результаты соревнований по прыжкам в высоту. Число участников произвольно. Напечатать сообщение о победителе.

3.2 Оператор цикла 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 систему счисления.

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

a)

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.

b)

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. Лягушка каждый последующий прыжок делает в два раза короче предыдущего. Достигнет ли она болота и за сколько прыжков. Длину первого прыжка задайте самостоятельно.


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

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

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

Задача 1. Составить программу обработки массива размерностью n, заполненного целыми числами, введенными с клавиатуры. Вывести индексы и значения положительных элементов массива.

USES Crt;

CONST N=10;

VAR

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

I:BYTE;

BEGIN

ClrScr;

{ Заполнение массива }

FOR I:=1 TO N DO Begin

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

End;

{ Обработка элементов массива }

FOR I:=1 TO N DO

IF A[I]>0 THEN WriteLn('Положительный элемент = ',A[I],' его индекс = ',I);

END.

Задача 2.Составить программу обработки массива K, состоящего из 20 элементов. Заполнить массив случайными числами в диапазоне от -5 до 25. Все элементы массива К, значения которых находятся в интервале от -2 до 20 возвести в квадрат. Измененный массив вывести на экран.

USES Crt;

VAR

K:ARRAY[0..20] OF INTEGER;

I:BYTE;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO 20 DO Begin

K[I]:=Random(30)-5; Write(K[I]:3);

End; WriteLn;

FOR I:=1 TO 20 DO

IF (K[I]<20) AND (K[I]>-2) THEN K[I]:=K[I]*K[I];

WriteLn('Измененный массив');

FOR I:=1 TO 20 DO

Write(K[I]:4);

END.

Задача 3. Составить программу вычисления и печати значений функции Y=sin(x-1)/2x. Значения аргументов задать в массиве X, состоящего из 6 элементов. Значения функции записать в массив Y.

USES Crt;

VAR

X,Y:ARRAY[0..6] OF REAL;

I: BYTE;

BEGIN

ClrScr;

FOR I:=1 TO 6 DO Begin

Write('Введите ',I,' значение аргумента '); ReadLn(X[I]);

End;

FOR I:=1 TO 6 DO Begin

Y[I]:=SIN(X[I]-1)/(2*X[I]);

WriteLn(' X= ',X[I]:4:1,' Y=',Y[I]:5:2);

End;

END.

Задача 4. Дан массив M, состоящий из 30 элементов. Элементы массива - произвольные целые числа. Выдать на экран значение каждого пятого и положительного элемента. Указанные элементы выдать в строку.

USES Crt;

VAR

M:ARRAY[0..30] OF INTEGER;

I: BYTE;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO 30 DO Begin

M[I]:=Random(20)-4; Write(M[I]:3);

End; WriteLn;

I:=5;

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

While I<=30 DO Begin

IF M[I] > 0 THEN Write(M[I]:3);

I:=I+5;

End;

END.

Задача 5.Из элементов массива Р сформировать массив М той же размерности по правилу: если номер четный, то М[I]=I*P[I],если нечетный, то M[I]=-P[I].

USES Crt;

CONST N=15;

VAR

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

I: BYTE;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO N DO Begin

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

End; WriteLn;

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

FOR I:=1 TO N DO Begin

IF I mod 2 =0 Then M[I]:=P[I]*I Else M[I]:=-P[I];

Write(M[I]:4);

End;

END.

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

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

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

  1. Дан одномерный массив размерностью 10, заполненный целыми числами, введенными с клавиатуры, и величина N. Отрицательные элементы заменить на N. Измененный массив вывести на экран одной строкой.

  2. Дан одномерный массив размерностью N, заполненный случайными числами в интервале от -15 до 20. Вывести на экран значения элементов массива, абсолютное значение которых >10.

  3. Дан одномерный массив размерностью N, заполненный случайными числами. Каждый третий элемент массива возвести в квадрат, если элемент отрицательный. Измененный массив вывести на экран.

  4. Составить программу вычисления и печати значений функции Y=(sinx+1)cos4x. Значения аргументов задать в массиве X, состоящего из 10 элементов. Значения функции записать в массив Y.

  5. Заменить первые К элементов массива на противоположные по знаку.

  6. Из элементов массива А, состоящего из 25 элементов, сформировать массив D той же размерности по правилу: первые 10 элементов находятся по формуле Di=Ai+i, остальные - по формуле Di=Ai-i.


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

Задача 1. Определить сумму элементов массива Р(n), значения которых > заданного Т

USES Crt;

CONST N=30;

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 элементов. Заполнить его с клавиатуры. Найти:

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

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

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

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

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

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

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

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

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

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

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

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

Задача 1. Дан массив K, состоящий из 45 элементов. Элементы массива - произвольные целые числа. Определить минимальный элемент массива и его индекс.

USES Crt;

VAR

K:ARRAY[0..45] OF INTEGER;

I,IND: BYTE; MIN:INTEGER;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO 45 DO Begin

K[I]:=Random(35)+6; Write(K[I]:3);

End; WriteLn;

MIN:=K[1]; IND:=1;

{ нахождение минимального значения и его индекса }

FOR I:=2 TO 45 DO

IF K[I]

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

WriteLn(' Индекс минимального значения = ',IND);

END.

Задача 2. Дан массив B, состоящий из N элементов. Элементы массива - произвольные целые числа. Определить сумму элементов, расположенных до максимального элемента массива.

USES Crt;

CONST N=20;

VAR

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

I,IND: BYTE; MAX,S:INTEGER;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO N DO Begin

B[I]:=Random(35); Write(B[I]:3);

End; WriteLn;

MAX:=B[1]; IND:=1;

{ нахождение максимального значения и его индекса }

FOR I:=2 TO N DO

IF B[I]>MAX THEN Begin MAX:=B[I]; IND:=I; End;

WriteLn(' Максимальное значение = ',MAX);

{ нахождение суммы элементов, расположенных до максимального элемента }

S:=0;

FOR I:=1 TO IND-1 DO

S:=S+B[I];

WriteLn(' Cумма элементов, расположенных до максимального элемента =',S);

END.

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

USES Crt;

CONST N=15;

VAR

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

I,IND: BYTE; MIN:INTEGER;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO N DO Begin

A[I]:=Random(400); Write(A[I]:4);

End; WriteLn;

MIN:=A[1]; IND:=1;

{ нахождение минимального значения и его индекса }

FOR I:=2 TO N DO

IF A[I]

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

{ замена нулями элементов, расположенных за минимальным значением }

FOR I:=IND+1 TO N DO

A[I]:=0;

WriteLn(' Измененный массив');

FOR I:=1 TO N DO

Write(A[I]:4);

END.

Задача 4. Дан массив A, состоящий из N элементов. Элементы массива - произвольные целые числа. Заменить нулями все элементы массива, расположенные между минимальным и максимальным элементами массива, кроме их самих. Измененный массив вывести на экран.

USES Crt;

CONST N=15;

VAR

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

I, IMIN, IMAX, k1, k2: BYTE; MIN, MAX:INTEGER;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO N DO Begin

A[I]:=Random(270); Write(A[I]:4);

end; WriteLn;

MIN:=A[1]; MAX:=A[1]; IMIN:=1; IMAX:=1;

{ нахождение минимального и максимального значения и их индексов }

FOR I:=2 TO N DO Begin

IF A[I]

IF A[I]>MAX THEN Begin MAX:=A[I]; IMAX:=I; End;

End;

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

WriteLn(' Максимальное значение = ',MAX);

{ замена нулями элементов, расположенных между минимальным и максимальным

значением }

IF IMIN

ELSE Begin K1:=IMAX+1; K2:=IMIN-1; End;

FOR I:=K1 TO K2 DO

A[I]:=0;

WriteLn(' Измененный массив');

FOR I:=1 TO N DO

Write(A[I]:4);

END.

Задача 5. Дан массив чисел. Найти наибольший элемент, поставить его первым.

USES Crt;

CONST M=100;

VAR

MAS: ARRAY[1..100] OF INTEGER;

I,K,N,NEW: INTEGER;

BEGIN

ClrScr;

Write(' Введите размер массива N= '); ReadLn(N);

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

FOR I:=1 TO N DO Begin

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

End;

NEW:=MAS[N]; K:=N;

{ Нахождение наибольшего элемента и его индекса }

FOR I:=N DOWNTO 1 DO

IF MAS[I]>NEW THEN Begin NEW:=MAS[I]; K:=I; End;

{ Перестановка местами первого и наибольшего элементов }

MAS[K]:=MAS[1]; MAS[1]:=NEW;

WriteLn(' Измененный массив');

FOR I:=1 TO N DO

Write(MAS[I]:4);

END.

Задача 6. Известны данные о среднемесячной температуре за год. Определить, какая была самая высокая температура летом и самая низкая зимой.

USES Crt;

VAR

MAS: ARRAY[1..12] OF REAL;

I: INTEGER; MIN,MAX:REAL;

BEGIN

ClrScr;

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

FOR I:=1 TO 12 DO Begin

Write(' Введите среднюю температуру за ',I,' месяц '); ReadLn(MAS[I]);

End;

MAX:=MAS[6]; MIN:=MAS[12];

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

FOR I:=7 TO 8 DO

IF MAX

{ Определение самой низкой температуры зимой }

FOR I:=1 TO 2 DO

IF MIN>MAS[I] THEN MIN:=MAS[I];

WriteLn(' Самая высокая температура летом ',MAX);

WriteLn(' Самая низкая температура зимой ',MIN);

END.

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

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

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

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

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

  3. Дан массив чисел. Определить количество элементов, находящихся в интервале от1 до 12 и расположенных до максимального элемента массива.

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

Задача 1. Дан массив A, состоящий из 12 элементов. Элементы массива - произвольные целые числа. Поменять местами значения 1 и 2 элементов, 3 и 4 и т.д. Измененный массив вывести на экран.

USES Crt;

VAR

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

I: BYTE; PP:INTEGER;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO 12 DO Begin

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

End; WriteLn;

I:=1;

WHILE I<=12 DO Begin

{перестановка элементов местами, используя промежуточную переменную PP }

PP:=A[I]; A[I]:=A[I+1]; A[I+1]:=PP;

I:=I+2;

End;

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

FOR I:=1 TO 12 DO

Write(A[I]:3);

END.

Задача 2. Дан массив целых чисел из 15 элементов, заполненный случайным образом числами из промежутка [-20,50].

  1. Удалить из него все элементы, в записи которых есть цифра 5.

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

  3. Поменять местами первый положительный и последний отрицательный элементы.}

USES Crt;

VAR

P,P1:ARRAY[0..15] OF INTEGER; P2:ARRAY[0..30] OF INTEGER;

I,J,E,D,PP,PO,FL: BYTE; K,PRP:INTEGER;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO 15 DO Begin

P[I]:=Random(70)-20; Write(P[I]:4);

End; WriteLn;

J:=1;

{ 1. Удаление }

FOR I:=1 TO 15 DO Begin

E:=ABS(P[I]) mod 10; {Выделение единиц}

D:=ABS(P[I]) div 10; {Выделение десятков}

{ формирование нового массива }

IF (E<>5) AND (D<>5) THEN Begin P1[J]:=P[I]; J:=J+1; End;

End;

WriteLn(' Массив, в котором нет элементов с цифрой 5');

FOR I:=1 TO J-1 DO

Write(P1[I]:4);

WriteLn;

{ 2. Вставка }

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

J:=1;

FOR I:=1 TO 15 DO Begin

P2[J]:=P[I]; J:=J+1;

IF ABS(P[I]) mod I = 0 THEN Begin P2[J]:=K; J:=J+1; End;

End;

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

For I:=1 TO J-1 DO

Write(P2[I]:4);

WriteLn;

{ 3. Перестановка }

{ Нахождение первого положительного и последнего отрицательного элемента }

FL:=0;

FOR I:=1 TO 15 DO Begin

IF (P[I]>0) AND (FL=0) THEN Begin PP:=I; FL:=1; End;

IF P[I]<0 THEN PO:=I;

End;

{ перестановка местами первого положительного и последнего отрицательного'}

PRP:=P[PP]; P[PP]:=P[PO]; P[PO]:=PRP;

WriteLn(' Массив, в котором первый положительный и последний отрицательный');

WriteLn(' поменяли местами');

FOR I:=1 TO 15 DO

Write(P[I]:4);

END.

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

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

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

Дан массив целых чисел из 10 элементов, заполненный случайным образом из промежутка [-40, 30].

  1. Удалить из него все элементы, которые состоят из одинаковых цифр ( включая однозначные числа).

  2. Вставить число К перед всеми элементами, в которых есть цифра 1 (К вводится с клавиатуры)

  3. Переставить первые три и последние три элемента местами, сохраняя порядок их следования.

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

Задача 1. Отсортировать числовой массив. Первый способ.

USES Crt;

CONST N=30;

VAR

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

I,J: BYTE; PP:INTEGER;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO N DO Begin

A[I]:=Random(50); Write(A[I]:4);

End; WriteLn;

{ Сортировка массива }

FOR I:=2 TO N DO

FOR J:=N DOWNTO I DO

IF A[J-1]>A[J] THEN Begin PP:=A[J]; A[J]:=A[J-1]; A[J-1]:=PP; End;

WriteLn(' Отсортированный массив ');

FOR I:=1 TO N DO

Write(A[I]:4);

END.

Задача 2. Отсортировать числовой массив. Второй способ.

USES Crt;

CONST N=30;

VAR

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

I,J: BYTE; PP:INTEGER;

BEGIN

ClrScr; Randomize;

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

FOR I:=1 TO N DO Begin

A[I]:=Random(50); Write(A[I]:4);

End; WriteLn;

{ Сортировка массива }

FOR I:=1 TO N-1 DO

FOR J:=I+1 TO N DO

IF A[I]>A[J] THEN Begin PP:=A[I]; A[I]:=A[J]; A[J]:=PP; End;

WriteLn(' Отсортированный массив ');

FOR I:=1 TO N DO

Write(A[I]:4);

END.

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

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

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

Даны два упорядоченных массива целых чисел М1 и М2. Слить их в упорядоченный массив. Рассмотреть случаи, когда массивы М1 и М2 упорядочены одинаково и когда по-разному.

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

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

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

USES Crt;

VAR

T:ARRAY[0..7,0..3] OF INTEGER;

I,J:BYTE; S:INTEGER; ST:REAL; A:STRING[12];

BEGIN

ClrScr; WriteLn;

{ Заполнение таблицы }

FOR I:=1 TO 7 DO Begin

WriteLn(' Введите показания за ',I,' день');

FOR J:=1 TO 3 DO Begin

CASE J OF

1: A:=' Утром - ';

2: A:=' В обед - ';

3: A:=' Вечером - ';

End;

Write(A); ReadLn(T[I,J]);

End;

End; WriteLn;

{ Подсчет средней температуры за каждый день }

FOR I:=1 TO 7 DO Begin

S:=0;

FOR J:=1 TO 3 DO

S:=S+T[I,J];

ST:=S/3;

WriteLn('Средняя температура за ',I,' день = ',ST:4:1);

End;

END.

Задача 2. Группа из 10 учащихся сдавала экзамен по 4 предметам. Результаты экзаменов записали в таблицу размерностью 10х4. Определить средний балл по каждому предмету.

USES Crt;

VAR

E:ARRAY[0..10,0..4] OF INTEGER;

I,J:BYTE; S:INTEGER; SB:REAL; A:STRING[16];

BEGIN

ClrScr; WriteLn;

{ Заполнение таблицы }

FOR I:=1 TO 10 DO Begin

WriteLn(' Введите оценки ',I,' учащегося');

FOR J:=1 TO 4 DO Begin

CASE J OF

1: A:=' Математика - ';

2: A:=' Физика - ';

3: A:=' Химия - ';

4: A:=' Информатика - ';

End;

Write(A); ReadLn(E[I,J]);

End;

End; WriteLn;

{ Подсчет среднего балла по каждому предмету. Циклы меняются местами.' }

FOR J:=1 TO 4 DO Begin

S:=0;

FOR I:=1 TO 10 DO

S:=S+E[I,J];

SB:=S/10;

CASE J OF

1: A:=' математике - ';

2: A:=' физике - ';

3: A:=' химии - ';

4: A:=' информатике - ';

End;

WriteLn(' Средний балл по ',A,' = ',SB:4:1);

End;

END.

Задача 3. Поменять местами значения К-ого и Р-ого столбцов матрицы В, размерностью MхM, заполненную случайным образом.

USES Crt;

LABEL M1;

CONST M=8;

VAR

A:ARRAY[0..M,0..M] OF INTEGER;

I,J,K,P:BYTE; PP:INTEGER;

BEGIN

ClrScr;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

WriteLn(' Значения двумерного массива');

FOR I:=1 TO M DO Begin

FOR J:=1 TO M DO Begin

A[I,J]:=Random(23); Write(A[I,J]:3);

End; WriteLn;

End; WriteLn;

WriteLn(' Введите номера столбцов, которые необходимо поменять');

WriteLn(' Их значения не должны превышать ',M);

M1:ReadLn(K,P);

IF (K>M) OR (P>M) THEN GOTO M1;

{ Перестановка значений введенных столбцов }

FOR I:=1 TO M DO Begin

PP:=A[I,K]; A[I,K]:=A[I,P]; A[I,P]:=PP;

End;

WriteLn(' Измененный двумерный массив');

FOR I:=1 TO M DO Begin

FOR J:=1 TO M DO Begin

Write(A[I,J]:3);

End; WriteLn;

End;

END.

Задача 4. Дан двумерный массив размерностью 6х3, заполненный целыми числами. Подсчитать количество строк, в которых первый элемент строки меньше нуля.

USES Crt;

VAR

M:ARRAY[0..6,0..3] OF INTEGER;

I,J,K:BYTE;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

WriteLn(' Значения двумерного массива');

FOR I:=1 TO 6 DO Begin

FOR J:=1 TO 3 DO Begin

M[I,J]:=Random(23)-10; Write(M[I,J]:3);

End; WriteLn;

End; WriteLn; K:=0;

{ Подсчет количества строк, в которых первый элемент строки меньше 0 }

FOR I:=1 TO 6 DO

IF M[I,1]<0 THEN Inc(K);

Write(' Количество строк, в которых первый элемент строки меньше 0 = ',K);

END.

Задача 5. Дан двумерный массив размерностью Nх2N, заполненный целыми числами. Найти среднее арифметическое элементов, имеющие четные номера строк.

USES Crt;

CONST N=5;

VAR

H:ARRAY[0..N,0..2*N] OF INTEGER;

I,J,K:BYTE; S:LongInt; SA:REAL;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO N DO Begin

FOR J:=1 TO 2*N DO Begin

H[I,J]:=Random(23); Write(H[I,J]:3);

End; WriteLn;

End; WriteLn;

{ Нахождение суммы значений элементов, имеющих четные номера строк }

I:=2; K:=0;

WHILE I<=N DO Begin

FOR J:=1 TO 2*N DO Begin

S:=S+H[I,J]; Inc(K);

End; I:=I+2;

End;

SA:=S/K;

Write(' Среднее арифметическое элементов, имеющих четные номера строк =',SA:4:1);

END.

Задача 6. Дан двумерный массив размерностью NхM, заполненный случайным образом. Определить, есть ли в данном массиве столбец, в котором равное количество положительных и отрицательных элементов.

USES Crt;

CONST N=6; M=8;

VAR

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

I,J,KO,KP,FL:BYTE;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO N DO Begin

FOR J:=1 TO M DO Begin

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

End; WriteLn;

End; WriteLn;

FOR J:=1 TO M DO Begin

KP:=0; KO:=0;

FOR I:=1 TO N DO Begin

IF A[I,J]>0 THEN Inc(KP);

IF A[I,J]<0 THEN Inc(KO);

End;

IF KP=KO THEN Begin

WriteLn(' В ',J,' столбце равное количество положительных и отрицательных элементов'); FL:=1;

End;

End;

IF FL=0 THEN WriteLn(' Нет столбцов, в которых равное количество положительных и отрицательных элементов');

END.

Задача 7. Дан двумерный массив размерностью NхM, заполненный случайным образом. Определить, есть ли в данном массиве строка, в которой ровно два отрицательных элемента.

USES Crt;

CONST N=6; M=8;

VAR

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

I,J,K,FL:BYTE;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO N DO Begin

FOR J:=1 TO M DO Begin

A[I,J]:=Random(40)-15; Write(A[I,J]:3);

End; WriteLn;

End; WriteLn; FL:=0;

{ Определение строк, в которых ровно два отрицательных элемента }

FOR I:=1 TO N DO Begin

K:=0;

FOR J:=1 TO M DO

IF A[I,J]<0 THEN Inc(K);

IF K=2 THEN Begin WriteLn('В ',I,' строке ровно два отрицательных элемента');FL:=1; End;

End;

IF FL=0 THEN Writeln(' Нет строк, в которых ровно два отрицательных элемента');

END.

Задача 8. Дан двумерный массив размерностью 4х6 и величина N. Подсчитать количество строк, в которых есть элемент равный N.

USES Crt;

LABEL M1;

VAR

M:ARRAY[0..4,0..6] OF INTEGER;

I,J,K:BYTE; N:INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO 4 DO Begin

FOR J:=1 TO 6 DO Begin

M[I,J]:=Random(50); Write(M[I,J]:3);

End; WriteLn;

End; WriteLn;

Write(' Введите значение величины N '); ReadLn(N);

K:=0;

{ Нахождение строк, в которых имеется величина N }

FOR I:=1 TO 4 DO Begin

FOR J:=1 TO 6 DO

IF M[I,J]=N THEN Begin K:=K+1; GOTO M1; End;

M1: End;

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

END.

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

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

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

  1. Найти произведение элементов К-го и Р-го столбцов квадратной матрицы, размерностью 6х6.

  2. Дан двумерный массив размерностью 5х3, заполненный целыми числами. Найти произведение элементов нечетных строк матрицы.

  3. Дан двумерный массив размерностью 5х6, заполненный целыми числами и величина К. Найти количество элементов, равных К и их сумму.

  4. Дан двумерный массив размерностью NхM, заполненный целыми числами. Определить, есть ли в данном массиве столбец, в котором имеются одинаковые элементы.

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

Задача 1. Дан двумерный массив размерностью 5х6, заполненный целыми числами. Сформировать одномерный массив, каждый элемент которого соответственно равен сумме элементов строк. Оба массива вывести на экран.

USES Crt;

VAR

H:ARRAY[0..5,0..6] OF INTEGER; K:ARRAY[0..5] OF INTEGER;

I,J:BYTE; S:INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

WriteLn(' Значения двумерного массива');

FOR I:=1 TO 5 DO Begin

FOR J:=1 TO 6 DO Begin

H[I,J]:=Random(23); Write(H[I,J]:3);

End; WriteLn;

End; WriteLn;

{ Нахождение суммы элементов строк и заполнение одномерного массива }

WriteLn(' Значения одномерного массива');

FOR I:=1 TO 5 DO Begin

S:=0;

FOR J:=1 TO 6 DO

S:=S+H[I,J];

K[I]:=S; Write(K[I]:4);

End;

END.

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

USES Crt;

LABEL M1;

CONST N=5;

VAR

H:ARRAY[0..N,0..N] OF INTEGER; B:ARRAY[0..N] OF INTEGER;

I,J:BYTE;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

WriteLn;

FOR I:=1 TO N DO Begin

FOR J:=1 TO N DO Begin

H[I,J]:=Random(25)-10; Write(H[I,J]:3);

End; WriteLn;

End; WriteLn;

WriteLn(' Значения первых положительных элементов соответствующих строк');

WriteLn;

FOR I:=1 TO N DO Begin

FOR J:=1 TO N DO

IF H[I,J]>0 THEN Begin B[I]:=H[I,J]; GOTO M1; End;

M1: Write(B[I]:3);

End;

END.

Задача 3. Дан двумерный массив размерностью NхM, заполненная целыми числами. Получить одномерный массив, элементами которого являются сумма первого и последнего элементов соответствующих строк двумерного массива.

USES Crt;

CONST N=5; M=7;

VAR

A:ARRAY[0..N,0..M] OF INTEGER; B:ARRAY[0..N] OF INTEGER;

I,J:BYTE;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

WriteLn;

FOR I:=1 TO N DO Begin

FOR J:=1 TO M DO Begin

A[I,J]:=Random(30); Write(A[I,J]:3);

End; WriteLn;

End; WriteLn;

WriteLn(' Cумма первого и последнего элементов соответствующих строк');

WriteLn;

FOR I:=1 TO N DO Begin

B[I]:=A[I,1]+A[I,M]; Write(B[I]:3);

End;

END.

Задача 4. Дан двумерный массив размерностью 5х6, заполненный целыми числами. Сформировать одномерный массив каждый элемент которого равен произведению четных положительных элементов соответствующего столбца.

USES Crt;

VAR

M:ARRAY[0..5,0..6] OF INTEGER; F:ARRAY[0..6] OF INTEGER;

I,J:BYTE; P:LongInt;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO 5 DO Begin

FOR J:=1 TO 6 DO Begin

M[I,J]:=Random(20)-5; Write(M[I,J]:3);

End; WriteLn;

End; WriteLn;

{ Формирование одномерного массива}

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

FOR J:=1 TO 6 DO Begin

P:=1;

FOR I:=1 TO 5 DO

IF (M[I,J]>0) AND (M[I,J] mod 2 =0) THEN P:=P*M[I,J];

IF P=1 THEN F[J]:=0 ELSE F[J]:=P;

Write(F[J]:4);

End;

END.

Задача 5. Дан двумерный массив размерностью 4х6, заполненный целыми числами. Сформировать одномерный массив, каждый элемент которого равен количеству элементов соответствующей строки, больших данного числа N.

USES Crt;

VAR

A:ARRAY[0..4,0..6] OF INTEGER; G:ARRAY[0..6] OF INTEGER;

I,J,K:BYTE; N:INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO 4 DO Begin

FOR J:=1 TO 6 DO Begin

A[I,J]:=Random(45); Write(A[I,J]:3);

End; WriteLn;

End; WriteLn;

Write(' Введите значение числа '); ReadLn(N);

{ Формирование одномерного массива}

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

FOR I:=1 TO 4 DO Begin

K:=0;

FOR J:=1 TO 6 DO

IF A[I,J] > N THEN K:=K+1;

G[I]:=K; Write(G[I]:2);

End;

END.

Задача 6. Дан двумерный массив размерностью 4х5, заполненный целыми числами. Сформировать одномерный массив, каждый элемент которого равен количеству отрицательных элементов, кратных 3 или 5, соответствующей строки.

USES Crt;

VAR

A:ARRAY[0..4,0..5] OF INTEGER; G:ARRAY[0..6] OF INTEGER;

I,J,K:BYTE;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO 4 DO Begin

FOR J:=1 TO 5 DO Begin

A[I,J]:=Random(45)-20; Write(A[I,J]:3);

End; WriteLn;

End; WriteLn;

{ Формирование одномерного массива}

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

FOR I:=1 TO 4 DO Begin

K:=0;

FOR J:=1 TO 5 DO

IF (A[I,J] < 0) AND ((A[I,J] mod 3=0) OR (A[I,J] mod 5 =0)) THEN K:=K+1;

G[I]:=K; Write(G[I]:2);

End;

END.

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

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

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

  1. Дан двумерный массив размерностью 6х5, заполненный целыми числами, введенными с клавиатуры. Сформировать одномерный массив, каждый элемент которого равен первому четному элементу соответствующего столбца, если такого нет, то равен нулю.

  2. Дан двумерный массив размерностью 5х6, заполненный целыми числами. Сформировать одномерный массив, каждый элемент которого равен произведению четных положительных элементов соответствующего столбца.

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

  4. Дан двумерный массив размерностью 6х8, заполненный целыми числами, введенными с клавиатуры. Сформировать одномерный массив, каждый элемент которого равен количеству элементов соответствующих строк матрицы, значения которых находятся в интервале( -2, 10).


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

Задача 1. В соревнованиях по плаванию принимали участие 5 спортсменов. Соревнования состояли из 3 заплывов. Результаты заплывов записали в таблицу размерностью 3х5. Получить одномерный массив размером 3, элементами которого будут лучшие результаты в каждом из заплывов.

USES Crt;

VAR

RZ:ARRAY[0..3,0..5] OF INTEGER; LR:ARRAY[0..3] OF INTEGER;

I,J:BYTE;

BEGIN

ClrScr; WriteLn;

{ Заполнение таблицы }

FOR I:=1 TO 3 DO Begin

WriteLn(' Введите результаты ',I,' заплыва');

FOR J:=1 TO 5 DO Begin

Write(J,' участник - '); ReadLn(RZ[I,J]);

End;

End; WriteLn;

{ Определение лучшего результата в каждом из заплывов }

FOR I:=1 TO 3 DO Begin

LR[I]:=RZ[I,1];

FOR J:=2 TO 5 DO

IF RZ[I,J]

WriteLn(' Лучший результат ',I,' заплыва = ',LR[I]);

End;

END.

Задача 2. Дан двумерный массив размерностью 5х6, заполненный целыми числами. Сформировать одномерный массив, каждый элемент которого равен наибольшему по модулю элементу соответствующего столбца.

USES Crt;

VAR

M:ARRAY[0..5,0..6] OF INTEGER; MAX:ARRAY[0..6] OF INTEGER;

I,J:BYTE;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO 5 DO Begin

FOR J:=1 TO 6 DO Begin

M[I,J]:=Random(20)-8; Write(M[I,J]:3);

End; WriteLn;

End; WriteLn;

{ Формирование одномерного массива}

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

FOR J:=1 TO 6 DO Begin

MAX[J]:=ABS(M[1,J]);

FOR I:=2 TO 5 DO

IF ABS(M[I,J]) > MAX[J] THEN MAX[J]:=ABS(M[I,J]);

Write(MAX[J]:3);

End;

END.

Задача 3. Дан двумерный массив размерностью NхM, заполненный случайным образом. Определить, есть ли в данном массиве строка, в которой имеется два элемента массива, имеющие наибольшее значение.

USES Crt;

CONST N=6; M=8;

VAR

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

I,J,K,FL:BYTE; MAX:INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO N DO Begin

FOR J:=1 TO M DO Begin

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

End; WriteLn;

End; WriteLn;

{ Нахождение наибольшего значения }

MAX:=A[1,1];

FOR I:=1 TO N DO

FOR J:=1 TO M DO

IF A[I,J]>MAX THEN MAX:=A[I,J];

WriteLn(' Максимальное значение = ',MAX);

{ Нахождение строки, в которой два элемента имеют наибольшее значение }

FL:=0;

FOR I:=1 TO N DO Begin

K:=0;

FOR J:=1 TO M DO

IF A[I,J]=MAX THEN Inc(K);

IF K=2 THEN Begin WriteLn('В ',I,' строке два элемента имеют наибольшее значение');

FL:=1;

End;

End;

IF FL=0 THEN WriteLn(' Нет строк, в которых два элемента имеют наибольшее значение');

END.

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

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

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

  1. Дан двумерный массив размерностью 5x7, заполненный случайным образом. Найти наименьший и наибольший элементы двумерного массива, поменять их местами.

  2. Дан двумерный массив размерностью NxM, заполненный случайным образом. Получить одномерный массив, элементами которого являются сумма наименьшего и наибольшего элементов соответственной строки двумерного массива.

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

Задача 1. Дан двумерный массив размерностью 8х7, заполненный случайным образом.

  • Поменять местами средние строки с первой и последней.

  • Вставить между средними строками первую строку.

  • Удалить все столбцы, в которых первый элемент больше последнего.

  • Заменить все элементы первых трех столбцов на их квадраты.

USES Crt;

VAR

A:ARRAY[0..8,0..7] OF INTEGER; A1:ARRAY[0..9,0..7] OF INTEGER;

A2:ARRAY[0..8,0..7] OF INTEGER;

I,J,K:BYTE; PP:INTEGER;

BEGIN

ClrScr; Randomize;

{ Заполнение двумерного массива случайным образом и вывод в виде прямоугольной матрицы }

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

FOR I:=1 TO 8 DO Begin

FOR J:=1 TO 7 DO Begin

A[I,J]:=Random(15); Write(A[I,J]:3);

End; WriteLn;

End; WriteLn;

{ 1. Поменять местами строки }

WriteLn(' Средние строки поменялись местами с первой и последней');

FOR J:=1 TO 7 DO Begin

PP:=A[1,J]; A[1,J]:=A[4,J]; A[4,J]:=PP;

PP:=A[5,J]; A[5,J]:=A[8,J]; A[8,J]:=PP;

End;

{ Вывод измененного массива }

FOR I:=1 TO 8 DO Begin

FOR J:=1 TO 7 DO

Write(A[I,J]:3);

WriteLn;

End; ReadLn;

{ 2. Вставка }

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

K:=0;

FOR I:=1 TO 8 DO Begin

Inc(K);

FOR J:=1 TO 7 DO Begin

A1[K,J]:=A[I,J]; Write(A1[K,J]:3);

End; WriteLn;

IF I=4 THEN Begin

Inc(K);

FOR J:=1 TO 7 DO Begin

A1[K,J]:=A[1,J]; Write(A1[K,J]:3);

End; WriteLn;

End;

End; Writeln; ReadLn;

{ 3. Удаление}

WriteLn(' Столбцы, в которых первый элемент > последнего, удалены');

K:=0;

FOR J:=1 TO 7 DO

IF A[1,J]<=A[8,J] THEN Begin

Inc(K);

FOR I:=1 TO 8 DO

A2[I,K]:=A[I,J];

End;

{ Вывод измененного массива }

FOR I:=1 TO 8 DO Begin

FOR J:=1 TO K DO

Write(A2[I,J]:3);

WriteLn;

End; ReadLn;

{ 4. Замена }

WriteLn(' Элементы первых трех столбцов заменены на их квадраты');

FOR I:=1 TO 8 DO Begin

FOR J:=1 TO 7 DO Begin

IF J<=3 THEN A[I,J]:=Sqr(A[I,J]); Write(A[I,J]:4);

End; WriteLn;

End;

End.

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

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

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

Дан двумерный массив размером 5х6, заполненный случайным образом.

  • Поменять местами средние строки.

  • Вставить после столбцов, содержащих максимальный элемент массива, столбец из нулей.

  • Удалить все столбцы, в которых первый элемент больше заданного числа А.

  • Заменить максимальный элемент каждой строки на противоположный.

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

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

Задача 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. Подсчитать, сколько раз встречается в тексте слово “кот”.

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

Задача 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;

End;

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. Удалить все символы «!», следующие за вторым предложением

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

Задача 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

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. В тексте найти и подсчитать количество слов, у которых первый и последний символы совпадают между собой (слова разделены пробелами).


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

Задача 1. Построить различные геометрические фигуры.

Uses Graph, Crt;

VAR

Gd,Gm : INTEGER;

Radius, I, Width, K : INTEGER;

Y0, Y1, Y2, X1, X2 : INTEGER;

Pattern : FillPatternType;

Points : ARRAY[1..6] OF PointType;

BEGIN

Gd:=vga; Gm:=1;

{ Инициализация графического режима }

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

SetBkColor(0); SetColor(2); {Цвет фона и изображения}

I:=0;

FOR Radius:=1 TO 5 DO Begin {Построение окружностей }

SetColor(Radius+4);

Circle(150,150,Radius*25);

Inc(I); IF I=4 THEN I:=0;

End;

ReadLn;

ClearDevice; SetBkColor(1); SetColor(5); SetLineStyle(0,0,3);

Ellipse(130,130,0,360,30,50); {эллипс}

ReadLn;

ClearDevice; SetColor(4); Ellipse(130,130,0,180,100,70); { эллиптическая дуга}

ReadLn;

ClearDevice; K:=4;

FOR Radius:=1 TO 5 DO Begin

SetColor(K);

Arc(300,100,0,90,Radius*20); {дуги}

Inc(K);

end;

ReadLn;

ClearDevice; Width:=20; SetColor(1); SetBkColor(11);

FOR I:=1 TO 5 DO Begin

SetFillStyle(7,I+4); {определение стиля заполнения}

Bar(I*Width,I*20,Succ(I)*Width,200); {построение прямоугольников}

end;

SetFillStyle(5,12); Bar(150,150,250,250);

ReadLn;

{Построение параллелепипеда с верхней плоскостью}

SetFillStyle(8,4); ClearDevice;

Y1:=100; Y2:=200; X1:=230; X2:=300;

SetLineStyle(3,0,3); {Определение стиля линии}

Bar3d(x1,y1,x2,y2,10,topon);

ReadLn;

{Построение параллелепипеда без верхней плоскости}

ClearDevice;

SetLineStyle(0,0,1); setfillstyle(11,1); bar3d(x1,y1,x2,y2,10,topoff);

ReadLn;

{Пользовательский шаблон заполнения}

CleardDevice; SetColor(6); SetLineStyle(0,0,3); { Стиль линии}

{заполнение массива}

Pattern[1]:=31; Pattern[2]:=62; Pattern[3]:=124; Pattern[4]:=248;

Pattern[5]:=124; Pattern[6]:=62; Pattern[7]:=31; Pattern[8]:=0;

SetFillPattern(pattern,12); {Задание шаблона пользователя}

Bar(10,10,GetMaxX Div 2,GetMaxY Div 2);

Rectangle(10,10,GetMaxX Div 2,GetMaxY Div 2);

ReadLn;

{Построение закрашенного сектора эллипса}

ClearDevice; SetBkColor(3); SetColor(4); SetFillStyle(7,14);

Sector(100,100,0,90,50,70);

ReadLn;

ClearDevice; SetFillStyle(1,14); {Построение закрашенного сектора круга}

Pieslice(150,150,90,360,100);

ReadLn;

{Построение эллипса, заполненного текущим цветом}

ClearDevice; SetFillStyle(6,13); SetLineStyle(3,0,1);

FillEllipse(200,200,50,100);

ReadLn;

{Построение закрашенного многоугольника}

ClearDevice; Randomize; SetLineStyle(0,0,1); SetFillStyle(11,1);

{Определение случайных координат вершин}

FOR I:=1 TO 5 DO Begin

Points[I].X:=Random(GetMaxX); Points[I].Y:=Random(GetMaxY);

End;

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

Fillpoly(6,Points);

ReadLn;

CloseGraph;

END.

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

USES Graph, Crt;

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;

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

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;

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.

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

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

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

  1. Построить семейство одинаковых окружностей, центры которых лежат на окружности большего диаметра.

  2. По периметру экрана построить семейство разноцветных квадратов, а в середине – множество разноцветных точек.

  3. Построить движущиеся изображения двух прямоугольников и круга, на которых помещены слова из фразы “ КТО СКАЗАЛ МЯУ?”.

  4. Построить движущиеся НЛО на фоне звездного неба.

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


uses crt;

var

i:byte;

CH:CHAR;

begin

clrscr;

for i:=0 to 255 do write (chr(i):2);

REPEAT

CH:=READKEY;

WRITE(ORD(CH):4);

UNTIL CH='D';

end.


Сборник задач по программированию на языке Паскаль
  • Информатика
Описание:


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

Содержание

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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





save.png Архив с задачами в формате DOC, объемом 55 Кб (3-14-7.zip)



12.03.2014
Автор Чолокоглы Алина Олеговна
Дата добавления 12.03.2014
Раздел Информатика
Подраздел
Просмотров 23034
Номер материала 789
Скачать свидетельство о публикации

Оставьте свой комментарий:

Введите символы, которые изображены на картинке:

Получить новый код
* Обязательные для заполнения.


Комментарии:

↓ Показать еще коментарии ↓