Примеры
ВСЕ ПРИМЕРЫ ВЫПОЛНЯТЬ ПО ШАГАМ, ПРОСЛЕЖИВАЯ ИЗМЕНЕНИЕ ЗНАЧЕНИЙ В ОКНЕ ОТЛАДКИ.
Пример 2. Вычислить количество цифр в заданном натуральном числе a.
var n:longint;
Function K(a: longint): byte;
Begin
If a < 10 Then k := 1
Else K := 1 + K(a Div 10)
End;
begin
writeln ('vvedite chislo');
readln (n);
writeln ('v chisle ' ,n,' ', K(n),' chisel' );
end.
Пример 3. Составить программу для расчета n-го члена заданной арифметической прогрессии.
program progres;
var a1, d: real; n:byte;
Function Ar_n(a1, d: real; n:byte): real;
Begin
If n = 1 Then Ar_n := a1
Else Ar_n := Ar_n(a1, d, n-1) + d
End;
BEGIN
Writeln ('введите первый член прогрессии ');
readln (a1);
Writeln ('введите разность прогрессии ');
readln (d);
Writeln ('введите № члена прогрессии ');
readln (n);
Writeln ('значение ',Ar_n(a1, d, n));
END.
Пример 4. Вычислить k-й член последовательности Фибоначчи, первые два члена которой равны 1, каждый последующий есть сумма двух предыдущих (1, 1, 3, 5, 8, …).
var n:longint;
Function F(k: byte): longint;
Begin
If (k = 1) Or (k = 2) Then F := 1
Else
F := F(k - 1) + F(k - 2)
End;
begin
writeln ('vvedite ¹ chisla progressii ');
readln (n);
writeln ('chislo Fibonachi s nomerom ' ,n,' = ', F(n) );
end.
Пример 5. Рекурсивный и нерекурсивный поиск наибольшего общего делителя двух чисел.
PROGRAM NOD;
var X,Y: Integer;
{ ------------------------------------------------ }
FUNCTION RecursiveNOD (n,m: Integer): Integer;
BEGIN { Рекурсивное вычисление НОД чисел n и m }
If n=m
then RecursiveNOD:=n
else If n>m
then RecursiveNOD:=RecursiveNOD (n-m,m)
else RecursiveNOD:=RecursiveNOD (n,m-n)
END;
{ ------------------------------------------------ }
FUNCTION NonRecursiveNOD (n,m: Integer): Integer;
BEGIN { Алгоритм, использующий вместо рекурсии повторение }
While n<>m do
If n>m
then n:=n-m
else m:=m-n;
NonRecursiveNOD:=n
END;
{ ---- }
BEGIN
Write ('Введите два целых числа, отличных от 0: '); Read (X); ReadLn (Y);
Write ('Результат, полученный рекурсивно: ');
WriteLn (RecursiveNOD(Abs(X),Abs(Y)));
Write ('Результат, полученный нерекурсивно: ');
WriteLn (NonRecursiveNOD(Abs(X),Abs(Y)))
END.
Пример 6. Определить сумму элементов заданного числового массива a, элементами которого являются целые числа.
Комментарии: Параметр функции: k — количество элементов массива, сумма которых рассчитывается при каждом вызове функции. Когда k = 1, то значение функции равно единственному элементу такого массива, иначе — сумме последнего элемента и значения этой же функции для массива без учета последнего элемента.
Задание: В приведенном виде функция может быть использована для решения задачи только применительно к массиву с именем a. Создайте функцию, которая может “обрабатывать” любые массивы одного типа (следует обрабатываемый массив сделать параметром функции).
var a: array [1..10] of integer;
n:longint; i:integer;
Function S(k: byte): longint;
Begin
If k = 1 Then S := a[k]
Else S := a[k] + S(k - 1)
End;
begin
writeln ('vvedite kolichestvo elementov massiva');
readln (n);
writeln ('vvedite elementy massiva');
for i:=1 to n do
readln (a[i]);
write (' massiv imeet vid: ');
for i:=1 to n do
write(a[i]:5); writeln;
writeln ('summa elementov massiva = ', S(n) );
end.
Пример 7. Процедура вывода цифр p-ичного представления заданного десятичного натурального числа (2≤p≤9).
Решение: Необходимо вспомнить, как происходит перевод целых десятичных чисел в систему счисления с другим основанием.
Обозначим заданное десятичное число — n. Для его перевода в p-ичную систему счисления требуется определение остатка от деления на p числа n и затем промежуточных частных до тех пор, пока не получится частное, меньшее p. Но если процедуру, обеспечивающую определение и вывод остатков (имя величины — remin), оформить в виде:
Procedure From10(a: longint; p: byte);
Var remin: byte;
Begin
{Определяем остаток}
remin := a mod p;
{Выводим его}
write(remin);
{Если нужно, делаем то же самое для промежуточного частного}
If a >= p Then From10(a div p, p)
End;
— то цифры будут выведены, начиная с последней. Для получения требуемого результата необходимо определение и вывод остатков проводить после рекурсивного вызова процедуры:
Procedure From10(a: longint; p: byte);
Var remin: byte;
Begin
{Если нужно, вызываем процедуру From10 для промежуточного частного}
If a >= p Then From10(a div p, p);
{Определяем остаток для текущих значений параметров процедуры}
remin := a mod p;
{Выводим его}
write(remin)
End;
Примечание: Последний вариант рекурсивной процедуры называется “Форма с выполнением действий после рекурсивного вызова (или с выполнением действий на рекурсивном возврате)”.
var
n:longint; i:integer;
Procedure From10(a: longint; p: byte);
Var remin: byte;
Begin
{Если нужно, вызываем процедуру From10 для промежуточного частного}
If a >= p Then From10(a div p, p);
{Определяем остаток для текущих значений параметров процедуры}
remin := a mod p;
{Выводим его}
write(remin)
End;
begin
writeln ('vvedite chislo');
readln (n);
writeln ('vvedite sistemu schisleniya');
readln (i); write ('chislo ',n,' v ',i,' ichnoy sisteme schisleniya = ' );
From10(n,i);
writeln
end.
Пример 8. Мой богатый дядюшка подарил мне один доллар в мой первый день рождения. В каждый следующий день рождения он удваивал свой подарок и прибавлял к нему столько долларов, сколько лет мне исполнилось. Написать программу, подсчитывающую общую сумму денег, подаренных к N-му дню рождения и указывающую, к какому дню рождения сумма подарка превысит 100$.
Решение: Вначале напишем программу, сколько денег получит племянник к n-му дню рождения.
Введем обозначения: k - число лет племянника, p - количество денег, которые дает дядя на каждом дне рождения, s - общая сумма денег, полученных племянником за все годы, n - счетчик числа дней рождения, который считает в обратном порядке от n (введенного пользователем) до 1.
Задаются первоначальные значения формальным параметрам процедуры: n - вводится пользователем из основной программы (вы обратили внимание, что в этой, как и в предыдущей процедуре нет выходных параметров и нет переменных в самой процедуре, хотя возможны и другие варианты).
Увеличивается число лет: k := k + 1; вычисляется подарок к k-тому дню рождения: p:= 2*p + k; вызывается процедура, в которой увеличивается на p общая сумма полученных денег s и уменьшается на 1 число дней рождения:
uncle(k, p, s + p, n - 1)
Далее весь процесс повторяется, до тех пор, пока n не станет равным 1.
program Rich_man1; { rich man - богатый}
uses Crt;
var
n : integer;
{-----------------------------------------------}
Procedure uncle(k, p, s, n : longint); {uncle - дядя}
begin
if n = 1
then write(s)
else
begin
k := k + 1;
p := 2*p + k;
uncle(k, p, s + p, n - 1)
end
end;
{----------------------------------------------------------}
begin
write(' Введите число лет племянника '); readln(n);
write(' Я получу к ', n, ' -ому дню рождения ');
uncle(1, 1, 1, n);
writeln(' долларов ')
end.
Во второй части условия требуется определить число лет, когда сумма полученных денег будет равна или превысит 100 долларов. Для этого в процедуре меняется опорное условие: if s >= 100 then write(n), а все остальное остается без изменений.
Program Rich_man2;
uses Crt;
var
n : integer;
{-------------------------------------------------------}
Procedure uncle1(k, p, s, n : longint);
begin
if s >= 100
then write(n)
else
begin
k := k + 1;
p := 2*p + k;
uncle1(k, p, s + p, n + 1)
end
end;
{---------------------------------------------------------}
begin
write(' Сумма подарка превысит 100 долларов к ');
uncle1(1, 1, 1, 1);
writeln(' -ому дню рождения')
end.
Пример 9. Над цепью озер летела стая белых гусей. На каждом озере садилось половина гусей и еще полгуся, а остальные летели дальше. Все гуси сели на семи озерах. Сколько гусей было в стае?
Решение: Математически задача решается устно очень остроумным способом.
Пусть вместе со стаей белых гусей все время летит еще один, Серый гусь. Если к некоторому озеру подлетит m белых гусей и Серый, то на этом озере садится - ровно половина всех гусей вместе с серым. Поэтому после каждого озера число летящих гусей уменьшается ровно вдвое. После семи озер оно уменьшится в 27 = 128 раз, а остается летящим один Серый гусь. Значит, вначале было 128 гусей, из них 127 - белых.
А теперь выполним, образно говоря, прямые рассуждения для решения задачи.
Обозначим через xk количество летящих белых гусей, когда впереди еще k озер.
В процедуру вводятся всего две переменные: x - искомое число гусей; k - число озер. Процедура устроена с расчетом, что гуси уже пролетели все 7 озер, значит надо вводить значение для x - один (1), а для k - семь (7). В процедуре устроено, что число k уменьшается на 1 и тогда опорным условием ("якорем") завершения процедуры является условие равенства 1 значений k и после этого на экран надо выдать значение числа гусей:
if k = 1 then writeln(x)
Опорное условие может быть и другим, если первоначальным значением k будет 1, тогда при повторном обращении к процедуре значение k надо не уменьшать, а увеличивать на 1 (k + 1), опорным условием, в этом случае, будет k = 7.
Program Problem11;
uses Crt;
var
k : integer;
{---------------------------------------------------------}
Procedure goose(x, k : integer);
begin
if k = 1 then write(x)
else goose(2*x + 1, k - 1)
end;
{---------------------------------------------------------}
begin
write(' Введите число озер'); readln(k);
write(' В стае было ');
goose(1, k);
writeln(' гусей')
end.
Пример 10. Перемножая большие числа, можно быстро получить переполнение. Поэтому, для того чтобы напечатать произведение, превышающее наибольшее допустимое для данного целого типа (integer или longint) числа, надо применить искусственные средства.
Составим программу для печати произведения двух чисел, которое может превышать максимально допустимое целое число.
Решение: Процедура multiplication умножает число a на каждую цифру числа b, начиная с цифры единиц. Последняя цифра полученного произведения, сложенная с последней цифрой имеющегося в памяти частичного произведения, печатается, а все прочие цифры запоминаются - передаются как параметры при рекурсивном обращении к процедуре multiplication. В самом конце производится умножение на первую (левую) цифру числа b. На этом умножение заканчивается. Тогда печатается начало результата - накопившееся частичное произведение без последней цифры (s div 10), а после него при возвращении из рекурсии - все остальные цифры произведения (s mod 10) в обратном порядке по сравнению с тем, как они вычислялись при входе в рекурсию.
Program Problem13; { Большое произведение}
uses Crt;
var
x, y : longint;
{---------------------------------------------------------}
Procedure multiplication(a, b, s : longint);
begin
if b <> 0
then
begin
s := s+a*(b mod 10);
multiplication(a, b div 10, s div 10);
write(s mod 10:1)
end
else if s <> 0 then write(s)
end;
{-------------------------------------------------------}
begin
write(' Введите первый множитель '); readln(x);
write(' Введите второй множитель '); readln(y);
write(x,'*',y:1,' = ');
if ((x < 0) and (y > 0)) or ((x > 0) and (y < 0)) then write('-');
multiplication(abs(x), abs(y), 0);
writeln
end.
Пример 11. Имеется некоторая сумма денег S и набор монет с номиналами a1, …, an. Монета каждого номинала имеется в единственном экземпляре. Необходимо найти все возможные способы разменять сумму S при помощи этих монет.
const n = 6; {число монет}
s = 33; {требуемая сумма}
a : array[1..n]of integer =(1,2,3,5,10,15); {номиналы монет}
var kol : array[1..n] of integer; {сколько взято таких монет -0 или 1}
found : boolean; { признак, что хотя бы одно решение найдено}
s:integer; {сумма денег}
procedure rec(k,s1:integer);
{k – число уже использовавшихся монет, s1 – набранная сумма}
var i : integer;
begin
if s=s1 then begin {вывод найденного решения}
found:=true;
for i:=1 to n do
if kol[i]>0 then write(a[i],' ');
writeln; exit
end;
for i:=k+1 to n do {цикл по всем еще неиспользовавшимся монетам}
begin
{самое критичное место рекурсивного перебора –
«взять-проверить-вернуть обратно, чтобы взять следующую»}
kol[i]:=1; {взять i-ю монету}
rec(i,s1+a[i]); {проверить, годится ли}
kol[i]:=0; {вернуть i-ю обратно, чтобы взять следующую}
end;
end;
begin
writeln ('введите сумму денег'); readln (s);
found:=false;
rec(0,0);
if not found then writeln(‘Разменять невозможно’)
end.
Пример 12. В одной из древних легенд говорится следующее. «В храме Бенареса находится бронзовая плита с тремя алмазными стержнями. На один из стержней бог при сотворении мира нанизал 64 диска разного диаметра из чистого золота так, что наибольший диск лежит на бронзовой плите, а остальные образуют пирамиду, сужающуюся кверху. Это – башня Брамы. Работая день и ночь, жрецы переносят диски с одного стержня на другой, следуя законам Брамы:
1. диски можно перемещать с одного стержня на другой только по одному;
2. нельзя класть больший диск на меньший.
Когда все 64 диска будут перенесены с одного стержня на другой, и башня, и храмы, и жрецы-брамины превратятся в прах, и наступит конец света».
Эта древняя легенда породила задачу о Ханойской башне: переместить m дисков с одного из трех стержней на другой, соблюдая «законы Брамы».
Назовем стержни левым (left), средним (middle) и правым (right). Задача состоит в переносе m дисков с левого стержня на правый.
Задача может быть решена одним перемещением только для одного (m = 1) диска. В общем случае потребуется 2m-1 перемещений.
Построим рекурсивное решение задачи, состоящее из трех этапов:
перенести башню, состоящую из m – 1 диска, с левого стержня на средний;
перенести один оставшийся диск с левого стержня на правый;
перенести башню, состоящую из m – 1 диска, со среднего стержня на правый.
Таким образом, задача о перемещении m дисков сводится к задаче о перемещении m – 1 диска. Обращаясь опять к этому же алгоритму, сведем задачу к перемещению m – 2 дисков. Продолжая этот процесс, получим, в конце концов, задачу о перемещении одного диска. Эта задача решается за один ход. Таким образом, в процессе решения возникают промежуточные задачи: переместить башню из нескольких n дисков с одного стержня на другой.
Обозначим тот стержень, с которого следует снять диски, через s1, на который надеть – через sk, а вспомогательный стержень через sw.
Оформим алгоритм решения задачи о переносе башни из n дисков с s1 на sk в виде процедуры move с 4-мя параметрами: n, s1, sw, sk; алгоритм для n = 1 выделим в отдельную процедуру step, которая перемещает один диск со стержня s1 на sk.