На этой странице решаем примеры Array37, Array38, Array39 из задачника Абрамяна.
Array37. Дан массив размера N. Найти количество участков, на которых его элементы возрастают.
var
A: array[1..200] of integer;
i, N, Q: integer;
Up: boolean; { Индикатор возрастания элементов массива:
Up = true - "числа возрастают",
Up = false - "числа не возрастают". }
begin
///ВВОД ДАННЫХ
randomize;
N := 2 + random(49); //количество чисел в массиве
writeln('Массив ', N, ' случайных целых чисел:');
writeln;
for i := 1 to N do
begin
a[i] := -100 + random(201); //случайное число от -100 до 100
write(' ', a[i]); //выводим элементы массива
end;
writeln;
writeln;
{write(' N = ');
readln(N);
writeln('Введите ', N, ' целых чисел:');
writeln;
for i := 1 to N do
read(a[i]); //вводим элементы массива
writeln;}
///ОСНОВНАЯ ПРОГРАММА
Q := 0; //сначала количество возрастающих участков равно 0
{ Инициализация индикатора возрастания Up: }
if a[1] < a[2] then Up := true //первые два элемента возрастают
else Up := false; //не возрастают
i := 1; //начальный номер элемента массива
while i < N do
begin
if Up then //числа возрастают
begin
{ Заходим в цикл, если соседние i-е и (i + 1)-е числа
строго возрастают, и номер элемента не больше N: }
while (a[i] < a[i + 1])and(i < N) do
begin
i := i + 1 //увеличиваем индекс на 1
end;
Q := Q + 1; //увеличиваем количество возраст. участков на 1
Up := false //меняем индикатор на "числа не возрастают"
end
else //числа не возрастают
begin
{ Заходим в цикл, если соседние i-е и (i + 1)-е числа
не возрастают, и номер элемента не больше N: }
while (a[i] >= a[i + 1])and(i < N) do
begin
i := i + 1 //увеличиваем индекс на 1
end;
Up := true //меняем индикатор на "числа возрастают"
end
end;
writeln('Количество возрастающих участков: ', Q)
end.
**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** boolean;: Представляет логическое значение.
**procedure** Randomize;: Инициализирует датчик псевдослучайных чисел.2)**procedure** Randomize(seed: integer);: Инициализирует датчик псевдослучайных чисел, используя значение seed. При одном и том же seed генерируются одинаковые псевдослучайные последовательности.**function** Random(maxValue: integer): integer;: Возвращает случайное целое в диапазоне от 0 до maxValue - 1.2)**function** Random(a,b: integer): integer;: Возвращает случайное целое в диапазоне от a до b.3)**function** Random: real;: Возвращает случайное вещественное в диапазоне [0..1).**function** Random(maxValue: integer): integer;: Возвращает случайное целое в диапазоне от 0 до maxValue - 1.2)**function** Random(a,b: integer): integer;: Возвращает случайное целое в диапазоне от a до b.3)**function** Random: real;: Возвращает случайное вещественное в диапазоне [0..1).**const** true = True;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** true = True;: Представляет логическое значение. * * *
А вот задача Array37 немного другим способом, без использования цикла while. Она оказалась намного проще:
var
A: array[1..200] of integer;
i, N, Q: integer;
Up: boolean; { Индикатор возрастания элементов массива:
Up = true - "числа возрастают",
Up = false - "числа не возрастают". }
begin
///ВВОД ДАННЫХ
write(' N = ');
readln(N);
writeln('Введите ', N, ' целых чисел:');
writeln;
for i := 1 to N do
read(a[i]); //вводим элементы массива
writeln;
///ОСНОВНАЯ ПРОГРАММА
Q := 0; //сначала количество участков возрастания равно 0
Up := false; //элементы ещё не возрастают
for i := 1 to N - 1 do
if (a[i] < a[i + 1]) then //если числа возрастают, то
begin //если индикатор не переключен на "числа возрастают":
if Up = false then
begin
Up := true; //то меняем индикатор на "числа возрастают"
Q := Q + 1; //и увеличиваем кол. участков возраст. на 1
end
end //Если числа не возрастают, то соответственно
else Up := false; //меняем индикатор на "числа не возрастают"
writeln('Количество участков возрастания: ', Q)
end.
**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** boolean;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** true = True;: Представляет логическое значение.**const** false = False;: Представляет логическое значение. Array38. Дан массив размера N. Найти количество участков, на которых его элементы убывают.
var
A: array[1..200] of integer;
i, N, Q: integer;
Down: boolean; { Индикатор убывания элементов массива:
Down = true - "числа убывают",
Down = false - "числа не убывают". }
begin
///ВВОД ДАННЫХ
randomize;
N := 2 + random(199); //количество чисел в массиве
writeln('Массив ', N, ' случайных целых чисел:');
writeln;
for i := 1 to N do
begin
a[i] := -100 + random(201); //случайное число от -100 до 100
write(' ', a[i]); //выводим элементы массива
end;
writeln;
writeln;
///ОСНОВНАЯ ПРОГРАММА
Q := 0; //сначала количество убывающих участков равно 0
{ Инициализация индикатора возрастания Down: }
if a[1] > a[2] then Down := true //первые два элемента убывают
else Down := false; //не убывают
i := 1; //начальный номер элемента массива
while i < N do
begin
if Down then //числа убывают
begin
{ Заходим в цикл, если соседние i-е и (i + 1)-е числа
строго убывают, и номер элемента не больше N: }
while (a[i] > a[i + 1])and(i < N) do
begin
i := i + 1 //увеличиваем индекс на 1
end;
Q := Q + 1; //увеличиваем количество убывающих участков на 1
Down := false //меняем индикатор на "числа не убывают"
end
else //числа не убывают
begin
{ Заходим в цикл, если соседние i-е и (i + 1)-е числа
не убывают, и номер элемента не больше N: }
while (a[i] <= a[i + 1])and(i < N) do
begin
i := i + 1 //увеличиваем индекс на 1
end;
Down := true //меняем индикатор на "числа убывают"
end
end;
writeln('Количество убывающих участков: ', Q)
end.
**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** boolean;: Представляет логическое значение.
**procedure** Randomize;: Инициализирует датчик псевдослучайных чисел.2)**procedure** Randomize(seed: integer);: Инициализирует датчик псевдослучайных чисел, используя значение seed. При одном и том же seed генерируются одинаковые псевдослучайные последовательности.**function** Random(maxValue: integer): integer;: Возвращает случайное целое в диапазоне от 0 до maxValue - 1.2)**function** Random(a,b: integer): integer;: Возвращает случайное целое в диапазоне от a до b.3)**function** Random: real;: Возвращает случайное вещественное в диапазоне [0..1).**function** Random(maxValue: integer): integer;: Возвращает случайное целое в диапазоне от 0 до maxValue - 1.2)**function** Random(a,b: integer): integer;: Возвращает случайное целое в диапазоне от a до b.3)**function** Random: real;: Возвращает случайное вещественное в диапазоне [0..1).**const** true = True;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** true = True;: Представляет логическое значение. * * *
Как и в предыдущем случае, задача Array38 может быть решена другим способом, без использования цикла while:
var
A: array[1..200] of integer;
i, N, Q: integer;
Down: boolean; { Индикатор убывания элементов массива:
Down = true - "числа убывают",
Down = false - "числа не убывают". }
begin
///ВВОД ДАННЫХ
write(' N = ');
readln(N);
writeln('Введите ', N, ' целых чисел:');
writeln;
for i := 1 to N do
read(a[i]); //вводим элементы массива
writeln;
///ОСНОВНАЯ ПРОГРАММА
Q := 0; //сначала количество участков убывания равно 0
Down := false; //элементы ещё не убывают (ничего не известно)
for i := 1 to N - 1 do
if (a[i] > a[i + 1]) then //если числа убывают, то
begin //если индикатор не переключен на "числа убывают":
if Down = false then
begin
Down := true; //то меняем индикатор на "числа убывают"
Q := Q + 1; //и увеличиваем кол. участков убывания на 1
end
end //Если числа не убывают, то соответственно
else Down := false; //меняем индикатор на "числа не убывают"
writeln('Количество участков убывания: ', Q)
end.
**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** boolean;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** true = True;: Представляет логическое значение.**const** false = False;: Представляет логическое значение. Array39. Дан массив размера N. Найти количество его промежутков монотонности (т. е. участков, на которых его элементы возрастают или убывают).
var
A: array[1..200] of integer;
i, N, Q, j: integer;
UpDown: boolean; { Индикатор убывания и возрастания элементов:
UpDown = true - "числа возрастают",
UpDown = false - "числа убывают". }
begin
///ВВОД ДАННЫХ
write(' N = ');
readln(N);
writeln('Введите ', N, ' целых чисел:');
writeln;
for i := 1 to N do
read(a[i]); //вводим элементы массива
writeln;
///ОСНОВНАЯ ПРОГРАММА
Q := 0; //сначала количество монотонных участков равно 0
{ Инициализация индикатора монотонности UpDown: }
j := 0; //начальный номер элементов
{ Увеличиваем номер элементов до тех пор пока два
последовательных элемента не станут разными: }
repeat
j := j + 1
until (a[j] <> a[j + 1]); //условие выхода: разные элементы
{ Инициализация индикатора UpDown: }
if (a[j] < a[j + 1]) then UpDown := false //ещё не возрастают
else UpDown := true; //ещё не убывают
{ Проверяем элементы от j до N - 1
(элементы с номерами 1..j-1 одинаковые): }
for i := j to N - 1 do
begin { соседние i-е и (i + 1)-е числа строго возрастают: }
if (a[i] < a[i + 1]) then
begin //если индикатор не переключен на "числа возрастают":
if UpDown = false then
begin
UpDown := true; //то меняем индикатор на "числа убывают"
Q := Q + 1; //и увеличиваем кол. участков монот. на 1
end
end
else { соседние i-е и (i + 1)-е числа строго убывают: }
if (a[i] > a[i + 1]) then
begin //если индикатор не переключен на "числа убывают":
if UpDown then
begin
UpDown := false; //то меняем индикатор на "числа убывают"
Q := Q + 1; //и увеличиваем кол. участков монот. на 1
end
end
end;
writeln('Количество участков монотонности: ', Q)
end.
**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** integer;: Представляет 32-битовое целое число со знаком.Диапазон значений: -2 147 483 648 .. 2 147 483 647**type** boolean;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** true = True;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.**const** true = True;: Представляет логическое значение.**const** false = False;: Представляет логическое значение.