1. Написать программу,
печатающую код нажимаемой клавиши и заканчивающей работу после нажатия клавиши
ESC. Определить все клавиши, не генерирующие кода и генерирующие расширенный
код.

Решение.
Эта программа очень проста:

Program VKB;

Uses Crt;

Var c,c2:char;

Begin

Repeat

c:=ReadKey;

If c=#0 then begin c2:=ReadKey;WriteLn('0 ',ord(c2)) end

else WriteLn(ord(c))

Until c=#27 { 27 -код клавиши ESC }

End.

Не генерируют кода клавиши
смещения Shift, Alt, Ctrl и клавиши-переключатели Caps Lock, Num Lock, Break,
Scroll Lock, Print Screen. Генерируют расширенный код функциональные клавиши,
клавиши редактирования Ins и Del, клавиши передвижения курсора. Расширенный код
также генерируют некоторые комбинации клавиш, получаемые клавишами Alt и Ctrl.

2. Дана программа рисования
звездочки в центре экрана; при нажатии букв U, D, R, L рисуется звездочка выше,
ниже, правее, левее предыдущей звездочки соответственно. Программа заканчивает
работу по нажатии клавиши Esc.

Program Stars;

Uses Crt;

Var x,y:byte;

c: char;

Begin

ClrScr;
TextColor(7);

x:=40; y:=13; GotoXY(x,y); Write('*');

Repeat

c:=ReadKey;

Case c of

'R','r': Inc(x);

'L','l': Dec(x);

'D','d': Inc(y);

'U','u': Dec(y);

end;

GotoXY(x,y); Write('*')

Until c=#27

End.

Таким образом, программа
является очень упрощенной моделью графического редактора. Попытку выхода за
границу экрана она отрабатывает неправильно. Также не корректно она обрабатывает
нажатие некоторых клавиш. Например, нажатие клавиши F10 оказывает такой же
эффект, как и нажатие буквы D (так как 'D'=#68, а клавиша F10 генерирует
последовательность символов #0#68).

Усовеpшенствуйте программу так,
чтобы:

1. вместо клавиш U, D, R, L она реагировала на соответствующие клавиши
передвижения курсора...

2. ... и не реагировала бы на них при попытке выхода за границы экрана;

3. с помощью функциональных клавиш F1-F7 можно было бы менять цвет; номер цвета
вновь печатаемых звездочек должен устанавливаться в значение от 1 до 7
соответственно;

4. при нажатии на клавишу ESC должен очищаться экран;

5. при нажатии клавиш ALT+X программа заканчивает работу.

Решение.
Все усовершенствования касаются только основного цикла Repeat-Until. Главное
изменение заключается в том, чтобы обрабатывать правильно клавиши расширенного
кода. Тогда пункт 1) достигается заменой символов 'U' и 'u' на #0 и #72 во
внешнем и внутреннем операторах Case соответственно и т.д. Для пункта 2)
достаточно перед процедурами Inc и Dec поставить соответствующие условия. Пункты
3)-5) выполняются путем расширения списков обрабатываемых клавиш в операторах
Case. Вот как может выглядеть исправленная программа:

Program SuperStars;

Uses Сrt;

Var x,y:byte;

c,c2:char;

Begin

ClrScr;
TextColor(7);

x:=40; y:=13; GotoXY(x,y); Write('*');

Repeat

c:=ReadKey;

Case c of

#27: ClrScr;

#0: Begin

c2:=ReadKey;

Case c2 of

#77: If x<80 then Inc(x); { #0#77 -код клавиши -> }

#75: If x>1 then Dec(x);

#80: If y<25 then Inc(y);

#72: If y>1 then Dec(y);

#59: TextColor(1); { #0#59 -код клавиши F1 }

#60: TextColor(2);

#61: TextColor(3);

#62: TextColor(4);

#63: TextColor(5);

#64: TextColor(6);

#65: TextColor(7);

end {case c2}

end {c=#0}

end; {case c}

GotoXY(x,y); Write('*')

Until c2=#45 { #0#45 -код клавиш ALT+X }

End.

Семь строчек программы,
обрабатывающих клавиши F1-F7, можно заменить одной строкой #59..#65: TextColor(ord(c2)-58);

2. Задачи на рекурсию

3. В выражении

12894 * 4193 * 9510 * 8653 * 4381 * 2546 * 1158 * 8645 * 2587

заменить звездочки знаками "+" или "-" так, чтобы получившееся арифметическое
выражение равнялось 1989.

Решение.
Предположим, что k первых звездочек уже заменено знаками сложения и вычитания и
результат первых k операций (сумма s) нам известен (в начальный момент k=0, s=12894).
Тогда (k+1)-ю звездочку мы можем заменить двумя способами. Подсчитывая в обоих
случаях получающуюся сумму первых k+1 операций, мы приходим к исходной ситуации,
но с k, на единицу большим. Если же k=8, то надо проверить равенство s=1989 и
при его выполнении напечатать ответ. Запоминается k-ая операция в k-ом символе
строки z.



Program Sum_1989;

Const c:array[0..8] of integer =
(12894,4193,9510,8653,4381,2546,1158,8645,2587);

Var z: string[8];

Procedure ADD(s:longint; k: integer); { s -сумма после }

Var i: byte; { k первых операций }

Begin

If k = 8
then

If s = 1989 then begin

For i := 1 to 8 do Write(c[i-1],z[i]);

WriteLn(c[8],'=1989')

end

else

else begin

k:=k+1;

z[k]:='+'; ADD(s+c[k],k);

z[k]:='-'; ADD(s-c[k],k);

end

End;

Begin

ADD(c[0],0)

End.

4. В написанном выражении ((((1
? 2) ? 3) ? 4) ? 5) ? 6

вместо каждого знака "?"
вставить знак одного из четырех арифметических действий: +, -, *, / так, чтобы
результат вычислений равнялся 35 (при делении дробная часть в частном
отбрасывается).

Решение аналогично предыдущей
задаче.



Program Result_35;

Var z: string[5];

Procedure OPER(r,k: integer); { r -результат после }

Var i:byte; { k-1 операций }

Begin

If k = 6
then

If r = 35 then begin

Write('((((1 ',z[1],' ');

For i:=2 to 5 do Write(i,') ',z[i],' ');

WriteLn('6 = 35')

end

else

else begin

z[k]:='+'; OPER(r+k+1,k+1);

z[k]:='-'; OPER(r-k-1,k+1);

z[k]:='*'; OPER(r*(k+1),k+1);

z[k]:='/'; OPER(r div (k+1),k+1);

end

End;


Begin

OPER(1,1)

End.

5. Из заданных N предметов
выбрать такие, чтобы их суммарный вес был менее 30 кг, а стоимость - наибольшей.
Напечатать номера и суммарную стоимость выбранных предметов. Вес и стоимость
предметов заданы массивами A[1:N] и B[1:N].

Замечание.
Можно предполагать, что предметы уже расположены в порядке возрастания или
убывания веса A[i], стоимости B[i] или какого-либо иного признака.

Решение.
В отношении каждого предмета у нас два варианта действий: мы можем его выбрать
или не выбрать. Эта ситуация напоминает задачу 3: там тоже каждая звездочка
предоставляла два варианта действий. Но есть и отличия.

Во-первых, суммарная стоимость должна быть наибольшей. Чтобы ее
определить, надо перебрать всевозможные варианты выбора предметов с
одновременным запоминанием оптимального варианта. Лишь по окончании перебора
можно распечатать оптимальный вариант. (В третьей задаче приемлемость каждого
варианта расстановки знаков определялась независимо от других вариантов.)

Во-вторых и главных, чтобы выяснить, годится ли тот или иной набор
предметов, необязательно определять его до конца. Если несколько первых
предметов превысят 30 кг, то выбор остальных предметов можно прекратить.
Разумеется, можно составить алгоритм с полным определением каждого набора
предметов по аналогии с третьей задачей. Но в данной ситуации он может оказаться
неэффективным, особенно если будет много тяжелых предметов. Поэтому приведем
программу, в которой определение набора немедленно прерывается, как только вес
уже выбранных предметов превысит 30 кг. Набор кодируется в массиве M[1..N]
нулями и единицами, текущий самый тяжелый набор запоминается в массиве R[1..N].
Программа работает при любой упорядоченности предметов, но наиболее быстро при
упорядоченности их по убыванию веса. Алгоритм можно несколько усовершенствовать,
если предусмотреть предварительное изъятие из рассмотрения всех предметов
тяжелее 30 кг. Это усовершенствование мы оставим читателю.



Program Rukzak;

Const N = 5;

Var i: integer;

M,R: array[1..N] of integer;

A,B: array[1..N] of real;

Smax: real;

Procedure NABOR(k: integer; V,S: real);

Begin

If V>30
then M[k] := 0

else begin

If S>Smax then begin Smax := S; R := M end;

If k

M[k+1]:=1; NABOR(k+1,V+A[k+1],S+B[k+1]);

M[k+1]:=0; NABOR(k+1,V,S);

end end

End;

Begin

For i:=1 to
N do begin

Write('Введите вес и стоимость ',i,'-го предмета: ');

ReadLn(A[i],B[i]);

M[i]:=0 end;

Smax:=0;

NABOR(0,0,0);

Write('Номера выбранных предметов:');

For i:=1 to N do If R[i]=1 then Write(' ',i);

WriteLn; WriteLn('Суммарная стоимость: ',Smax);

End.

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

Решение.
Ядро простейшего алгоритма закраски составляет рекурсивная процедура, которая
проверяет цвет заданной точки и, если он отличен от цвета закраски, закрашивает
ее и вызывает себя для четырех соседних точек. В качестве примера реализации
алгоритма приводим программу, рисующую круг и закрашивающую его путем вызова
рекурсивной процедуры PAINT.



Program Painter;

Uses Graph;

Var d,r:integer;

Procedure PAINT(x,y,c:integer);

Begin

If GetPixel(x,y)<>c
then begin

PutPixel(x,y,c);

PAINT(x+1,y,c);

PAINT(x-1,y,c);

PAINT(x,y+1,c);

PAINT(x,y-1,c);

end

End;

Begin

d:=CGA;
r:=1; InitGraph(d,r,'BGI\');

SetColor(2);

Circle(120,100,24);

PAINT(120,100,2);

ReadLn

End.

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

7. Написать программу, рисующую
елочку с помощью рекурсивной процедуры.

Решение.
Общая схема рекурсивной процедуры может быть такой:

1. рисуется левая ветка снизу вверх;

2. если это была не самая верхняя ветка, то процедура обращается к себе;

3. рисуется правая ветка сверху вниз.

Таким образом, при выполнении
алгоритма сначала будут нарисованы все левые ветки елочки снизу вверх, а затем
все правые ветки сверху вниз. Условие определения верхней ветки может быть
различным. Например, по достижении определенного номера ветки или ее размера
процедура прерывает рекурсивное обращение к себе. Тем самым последняя
нарисованная левая ветка окажется верхней. Ниже приводится программа, в которой
заранее задано количество веток и размер веток в пикселях (n=3, R=100).



Program Tree;

Uses Graph;

Var d,r,n:integer;

Procedure VETKA(R,k:integer); {рисуется k-ая ветка размера R}

Begin

LineRel(-R,0);

LineRel(R,-R);

If k{ VETKA(2*R div 3, k+1) }

LineRel(R,R);

LineRel(-R,0);

End;

Begin

d:=VGA;
r:=2; InitGraph(d,r,'C:\TP5\BGI');

SetColor(2); MoveTo(240,400); n:=3;

VETKA(100,1);

End.

Если при вызове процедуры VETKA
первый параметр R заменить на 2*R div 3 (указано в комментариях), то только
первая ветка будет иметь размер 100, а каждая следующая ветка станет в полтора
раза меньше предыдущей.