РЕКУРСИЯ. РЕШЕНИЕ ОЛИМПИАДНЫХ ЗАДАЧ. Рекурсия — это такой способ организации вспомогательного алгоритма (подпрограммы), при котором эта подпрограмма (процедура или функция) в ходе выполнения ее операторов обращается сама к себе. Вообще, рекурсивным называется любой объект, который частично определяется через себя. Вообще, в рекурсивном определении должно присутствовать ограничение, граничное условие, при выходе на которое дальнейшая инициация рекурсивных обращений прекращается. Приведём примеры рекурсивных определений. Пример 1. Классический пример, без которого не обходятся ни в одном рассказе о рекурсии, — определение факториала. С одной стороны, факториал определяется так: 1 ,при n 1 n!=1*2*3*...*n. С другой стороны, n ! n ( n 1 )! ,при n 1 Граничным условием в данном случае является n=1. Без рекурсии Var n,x: integer; f: real; begin f:=1; readln(n); for x:=1 to n do f:=f*x; writeln(f); end. Рекурсией. Var n: integer; Function fa(x: integer): real; Begin If x=1 then fa:=1 else fa:=x*fa(x-1); End; begin readln(n); writeln(fa(n)); end. 123... n Без рекурсии Var n,x: integer; f: real; begin f:=0; readln(n); for x:=1 to n do f:=f+x; writeln(f); end. Рекурсией в примере 2а. 1 3 ... ( 2 * n 1 ) Без рекурсии Var n,x: integer; f: real; begin f:=0; readln(n); for x:=1 to n+1 do f:=f+2*x-1; writeln(f); 1 end. Рекурсией в примере 2б. Числа Фибоначчи. Без рекурсии Var a: array[1..100] of real; x: integer; begin a[1]:=1; a[2]:=1; for x:=3 to 100 do begin a[x]:=a[x-1]+a[x-2]; writeln('x= ',x,' a= ',a[x]); end; end. Рекурсией в примере 4. Пример 2. Программу этого примера легко переделать в программы, которые вычисляют n а) 123... б) 1 3 ... ( 2 * n 1 ) а)Var n: integer; Function sum1(x: integer): integer; Begin If x=1 then sum1:=1 else sum1:=x+sum1(x-1); End; Begin Readln(n); End. Writeln(‘Summa= ‘,sum1(n)); б) Var n: integer; Function sum2(x: integer): integer; Begin If x=0 then sum2:=1 else sum2:=2*x+1+sum2(x-1); End; Begin Readln(n); End. Writeln(‘Summa= ‘,sum2(n)); Пример 3. Теперь примеры посложней: а) вычислить а)Var n: integer; Function step(x: integer): integer; Begin If x=1 then step:=2 else step:=2*step(x-1); End; Begin Readln(n); Writeln(‘Stepen= ‘,step(n)); End. б)Var a,n: integer; Function step(b,x: integer): integer; Begin 2 2n б) вычислить an If x=1 then step:=b else step:=b*step(b,x-1); End; Begin Readln(a,n); Writeln(‘Stepen= ‘,step(a,n)); End. Пример 4. Тоже классический: числа Фибоначчи. Первые два равны 1, а у остальные равны сумме двух предыдущих. Var n,i: integer; Function fib(x: integer): real; Begin If (x=1) or (x=2) then fib:=1 else fib:=fib(x-1)+fib(x-2); End; Begin Readln(n); for i:=1 to n do Writeln(‘fib ‘,i,’=’,fib(i)); End. Var n: integer; Function fa(x: integer): real; Begin If x<=2 then fa:=1 else fa:=fa(x-1)+fa(x-2); End; Begin for n:=1 to 100 do Writeln(n,' ',fa(n)); End. Основной недостаток – долго работает при больших значениях N. Пример 5. Разложить натуральное число N на несколько натуральных слагаемых. Перестановка местами слагаемых нового варианта не дает. Например, при N=4, получаем 4=1+1+1+1 4=1+1+2 4=1+3 4=2+2 Теперь удобней использовать не функцию, а процедуру. Var v:integer; t: string; procedure rasklad(sl,m:integer; rez: string); var a:integer; t1,t2,tt: string; begin for a:=sl to m div 2 do begin str(a,t1); str(m-a,t2); tt:=rez+'+'+t1+'+'+t2+'='+t; delete(tt,1,1); writeln(tt); rasklad(a,m-a,rez+'+'+t1); end; end; begin readln(v); str(v,t); rasklad(1,v,''); readln end. Пример 6. Примерно на эту же тему: между некоторыми из цифр 123456789 нужно поставить знак плюс, чтобы получилась сумма равная 99. 3 Знак плюс можно поставить на какое-то из 8 мест, но можно и не поставить, значит вариантов получается Но даже 99 можно получить не единственным образом, поэтому возникают вопросы: а) сколько разных чисел можно получить таким образом? б) какие числа будут встречаться чаще (и сколько раз)? в) а что если разрешить ставить кроме плюса еще и минус? Можно получить число 100? procedure pr(s,k,sl:integer;t:string); var vr: string; x: integer; begin if k=9 then begin x:=s+sl; if x=99 then begin str(sl,vr); vr:=t+'+'+vr+'=99'; delete(vr,1,1); writeln(vr); end; end else begin str(sl,vr); pr(s,k+1,sl*10+k+1,t); pr(s+sl,k+1,k+1,t+'+'+vr); end; end; begin pr(0,1,1,''); end. На остальные вопросы этого примера отвечает «усиленная программа»: var l,l1,m:longint; ff: text; c,kolvo: array[1..256] of integer;max:real;i,p:integer; procedure pr(s,k,sl:integer;t:string); var i,x,kol: integer; t1: string; begin if k=9 then begin x:=s+sl; for i:=1 to m do if x<>c[i] then kol:=kol+1 else kolvo[i]:=kolvo[i]+1; if kol=m then begin m:=m+1; c[m]:=x; end; end else begin str(sl,t1); pr(s,k+1,sl*10+k+1,t); pr(s+sl,k+1,k+1,t+'+'+t1); end; end; begin assign(ff,'1.txt'); rewrite(ff); m:=0; max:=0; pr(0,1,1,''); for i:=1 to m do if kolvo[i]>max then begin p:=i; max:=kolvo[i]; end; writeln('всего разных чисел= ',m,' чаще встречается ',c[p], ' ',max,' раза '); for i:=1 to m div 4 do begin for l:=1 to 4 do write(c[i]:12); writeln; 4 28 256. end; close(ff); end. Но пока это все примеры «прямой» рекурсии. А всю мощь этого приема демонстрирует «рекурсия с возвратом». В следующем примере – это возврат в лабиринте из тупика. Пример 7. Найти выход из лабиринта. const n=10; type massiv=array[1..n,1..n] of integer; const lab: massiv=((1,1,1,0,1,1,1,1,1,1), (1,1,1,0,1,1,1,1,1,1), (1,1,1,0,0,1,1,1,1,1), (1,1,1,1,0,1,1,1,1,1), (1,1,1,1,0,1,1,1,1,1), (1,1,1,1,0,0,0,0,0,1), (1,1,1,1,0,1,1,1,1,1), (1,1,0,0,0,1,1,1,1,1), (1,1,1,1,0,0,0,1,1,1), (1,1,1,1,1,1,1,1,1,1)); procedure otvet; var i,j: integer; begin for i:=1 to n do begin for j:=1 to n do write(lab[i,j]); writeln; end; readln; end; procedure step(x,y: integer); begin if (x=1) or (x=n) or (y=1) or (y=n) then otvet else if lab[x,y]=0 then begin lab[x,y]:=5; otvet; step(x+1,y); step(x-1,y); step(x,y+1); step(x,y-1); lab[x,y]:=0; otvet; end; end; BEGIN step(7,5); END. Пример 8. Обойти шахматную доску ходом коня, побывав на каждом поле по одному разу. const n=5; type massiv=array[1..n,1..n] of integer; move=array[1..8] of integer; const mx: move=(2,1,-1,-2,-2,-1,1,2); my: move=(-1,-2,-2,-1,1,2,2,1); var tabl,ot: massiv; k: integer; fin: boolean; so: longint; procedure otvet(t: massiv); 5 var i,j: integer; begin clrscr; for i:=1 to n do begin for j:=1 to n do write(t[i,j]:3); writeln; end; readln; end; procedure step(x,y: integer; var k: integer); var l,xx,yy: integer; begin if (x>0) and (x<=n) and (y>0) and (y<=n) then if (tabl[x,y]=0) then begin tabl[x,y]:=k if k=n*n then begin ot:=tabl; fin:=true; end; otvet(tabl); k:=k+1; for l:=1 to 8 do begin xx:=x+mx[l]; yy:=y+my[l]; step(xx,yy,k); {otvet(x,y);} end; k:=k-1; tabl[x,y]:=0; otvet(tabl); s:=s+1; end; end; BEGIN clrscr; fin:=false; s:=0; k:=1; step(1,1,k); if fin then otvet(ot) else writeln('n= ',n,' - net'); {writeln('s= ',s);} readln; END. Пример 9. Продолжая шахматную тему: расставить на шахматной доске 8 ладей так, чтобы они не били друг друга. const n=3; var a: array[1..n,1..n] of 0..1; i,j: byte; procedure otvet; begin for i:=1 to n do begin for j:=1 to n do write(a[i,j]); writeln; end; readln; end; function mozno(i,j: byte): boolean; var k: byte; begin mozno:=true; for k:=i-1 downto 1 do if a[k,j]=1 then mozno:=false; end; procedure step(x: byte); 6 var y: byte; begin for y:=1 to n do if mozno(x,y) then begin a[x,y]:=1; if x=n then otvet else step(x+1); a[x,y]:=0; end; end; begin step(1); readln; end. Пример 10. А теперь то же самое, но с ферзями (достаточно «доработать» функцию mozno). А теперь уже не примеры конкретных олимпиадных задач. Определение 1. Латинский квадрат порядка N состоит из N различных элементов (пусть это будут числа от 1 до N), причем в каждой строке и каждом столбце элемент встречается только один раз. Задача 1а. "Латинский квадрат" (Мордовская республиканская олимпиада, 1994 год). В таблице NxN первая строка заполняется числами 1, 2, ... , N. Остальные строки заполняются так, чтобы получился латинский квадрат. Сколько существует способов заполнения таблицы? const n=4; var t: array[1..n,1..n] of byte; x,y: byte; nn: longint; function mozno(k,x,y: byte): boolean; var i,j: byte; powtor: boolean; begin i:=x; powtor:=false; while (i>1) and not powtor do begin i:=i-1; if t[i,y]=k then powtor:=true end; j:=y; while (j>1) and not powtor do begin j:=j-1; if t[x,j]=k then powtor:=true end; mozno:=not powtor end; procedure otvet; var i,j: byte; begin for i:=1 to n do begin for j:=1 to n do write(t[i,j]:3); writeln end; readln end; procedure step(x,y: byte); 7 var k: byte; begin k:=0; repeat k:=k+1; if mozno(k,x,y) then begin t[x,y]:=k; if (x=n) and (y=n) then begin {otvet;} nn:=nn+1; end else if y=n then step(x+1,1) else step(x,y+1); end until (k=n) end; begin for y:=1 to n do t[1,y]:=y; step(2,1); writeln(nn); end. Определение 2. Два латинских квадрата порядка N называются ортогональными, если при наложении одного из них на другой каждая из N2 упорядоченных пар встретится один (и только один раз). Кстати, получившаяся из упорядоченных пар элементов таблица называется "эйлеровым" или "греколатинским" квадратом (см. [2]). Пример. При N=4 1234 1234 А= 3 4 1 2 В= 4 3 2 1 4321 2143 2143 3412 Квадраты А и В ортогональны, причем они являются решением задачи Озанама: расположить в форме квадрата шестнадцать игральных карт таким образом, чтобы ни в одной строке и ни в одном столбце и ни на одной диагонали не было более двух карт одной масти или одного достоинства. Задача 1б. "Ортогональные латинские квадраты". Среди полученных в задаче 1а латинских квадратов сколько будет неупорядоченных ортогональных пар (т.е. А и В, В и А считаются одним решением). Решение задачи 1б находится в конце файла среди сложных задач. Задача «Делители». (Всероссийская олимпиада школьников, региональный этап, второй тур, 2010-11 уч.год). Натуральное число a называется делителем натурального числа b, если b = ac для некоторого натурального числа c. Например, делителями числа 6 являются числа 1, 2, 3 и 6. Два числа называются взаимно простыми, если у них нет общих делителей кроме 1. Например, 16 и 27 взаимно просты, а 18 и 24 — нет. Будем называть нормальным набор из k чисел (a1, a2, …, ak), если выполнены следующие условия: 1) каждое из чисел ai является делителем числа n; 2) выполняется неравенство a1 < a2 < … < ak; 3) числа ai и ai+1 для всех i от 1 до k – 1 являются взаимно простыми; 4) произведение a1a2…ak не превышает n. Например, набор (2, 9, 10) является нормальным набором из 3 делителей числа 360. Требуется написать программу, которая по заданным значениям n и k определяет количество нормальных наборов из k делителей числа n. Формат входного файла Первая строка входного файла содержит два целых числа: n и k (2 ≤ n ≤ 108, 2 ≤ k ≤ 10). Формат выходного файла В выходном файле должно содержаться одно число — количество нормальных наборов из k делителей числа n. Пример входных и выходных данных divisors.in divisors.out 90 3 16 8 10 2 4 var m,d : array[1..10000] of integer; n,k,s,w,h: integer; t : boolean; function prost(x,y : integer): boolean; begin While x<>y do begin if x>y then x:=x-y else y:=y-x; end; if x=1 then prost:=true else prost:=false; end; procedure pr(i,q,p : integer); var z,qq: integer; begin if q=k+1 then begin s:=s+1; for qq:=1 to k do write(d[qq],' '); writeln; end else begin z:=i; while z<=w do begin if q>1 then begin while (z<w) and not prost(m[z],d[q-1]) do z:=z+1; if (p*m[z]<=n) and prost(m[z],d[q-1]) then begin d[q]:=m[z]; pr(z+1,q+1,p*m[z]); end; end else begin d[q]:=m[z];pr(z+1,q+1,p*m[z]); end; z:=z+1; end; end; end; begin Read(n,k); For h:=1 to (n div 2) +1 do if n mod h =0 then begin w:=w+1; m[w]:=h; end; w:=w+1; m[w]:=n; Pr(1,1,1); Write('s=',s); end. Рассмотрим решение задачи 1б. Переменные t, t1, t2 типа tabl - числовые массивы для получения латинских квадратов. Сами латинские квадраты будем записывать в файл (файловая переменная f). Проверку на ортогональность квадратов t1 и t2 сделаем булевской функцией orto таким образом: все пары чисел из t1 и t2 будем рассматривать как индексы булевской таблицы m. Если эти пары принимают все возможные значения, то таблица m будет вся заполнена значениями true, иначе попадется хотя бы одно значение false. А теперь переходим к основному: заполнению таблицы t процедурой step, которая находит на место x (строка), y (столбец) число k (простым перебором - цикл repeat), при этом булевская функия mozno проверяет подходит ли число k на это место (нет ли повторов в строке и столбце). Если вся таблица t уже заполнена - записываем ее в f, а иначе делаем рекурсивный шаг либо вдоль строки на место (x,y+1), либо на новую строку (x+1,1). Рекурсивный возврат здесь происходит автоматически взятием следующего числа k. Если бы нам был нужен только один латинский квадрат, то в процедуре step достаточно было использовать дополнительную булевскую переменную, с помощью которой цикл repeat можно прервать сразу же при получении одного решения. А в таком виде процедура step запишет в f все возможные латинские квадраты. 9 И в основной программе остается теперь только читать из f пары квадратов t1, t2 и проверять их на ортогональность (nn - длина f, а значит ответ задачи 1а, пременная wsego - ответ задачи 1б). program ORTOGONAL5; const n=5; type tabl=array[1..n,1..n] of byte; prover=array [1..n,1..n] of boolean; var t,t1,t2: tabl; nul: prover; x,y,nn,wsego: longint; f: file of tabl; function mozno(var t: tabl; k,x,y: byte): boolean; (* функция проверки: можно ли поставить число К на место Х,Y *) var i,j: byte; powtor: boolean; begin i:=x; powtor:=false; while (i>1) and not powtor do begin i:=i-1; if t[i,y]=k then powtor:=true end; j:=y; while (j>1) and not powtor do begin j:=j-1; if t[x,j]=k then powtor:=true end; mozno:=not powtor end; (* конец процедуры проверки числа К *) function orto(var t1,t2: tabl): boolean; var i,j: byte; m: prover; da: boolean; begin m:=nul; for i:=1 to n do for j:=1 to n do m[t1[i,j],t2[i,j]]:=true; da:=true; i:=0; while da and (i<n) do begin i:=i+1; j:=0; while da and (j<n) do begin j:=j+1; if m[i,j]=false then da:=false end end; orto:=da end; (* конец проверки на ортогональность таблиц t1 и t2 *) procedure step(var t: tabl; x,y: byte); (* процедура находит число на место Х,Y *) var k: byte; begin k:=0; repeat k:=k+1; if mozno(t,k,x,y) then begin t[x,y]:=k; if (x=n) and (y=n) then write (f,t) else if y=n then step(t,x+1,1) else step(t,x,y+1) end 10 until (k=n) end; (* конец процедуры установки числа К на место Х,Y *) (* начало основной программы *) begin assign (f,'d:\tp\kwadrat5.dat'); rewrite (f); for y:=1 to n do begin t[1,y]:=y; for x:=1 to n do nul[x,y]:=false end; step(t,2,1); wsego:=0; nn:=filesize(f); writeln(' латинск. квадратов - ',nn); for x:=0 to (nn-2) do begin seek(f,x); read(f,t1); for y:=(x+1) to (nn-1) do begin seek(f,y); read(f,t2); if orto(t1,t2) then wsego:=wsego+1 end end; writeln(' среди них ортог. пар - ',wsego); readln; close(f) end. Результаты при начальных значениях N: N кол-во латинсих квадратов 3 2 4 24 5 1344 6 1128960 кол-во ортогональных пар 1 6 216 0 Кстати, последняя шестая пара ортогональных квадратов четвертого порядка являются решением задачи Озанама (А - это квадрат номер 14, В- квадрат номер 21). Как видно из приведенной таблицы результатов количество латинских квадратов стремительно растет с увеличением размерности. Чтобы проверить ортогональность квадратов пятого порядка машине пришлось рассмотреть 902 496 пар квадратов, а уже для шестого порядка нахождение ответа на машине представляет только чисто спортивный интерес, так как еще Эйлер в 1782 году предположил, что "невозможно в каре 6х6 расставить 36 офицеров, каждый из которых имеет одно из 6 воинских званий и служит в одном из 6 различных полков так, чтобы в каждом ряду и в каждой шеренге было по одному офицеру каждого звания и по одному офицеру каждого полка". Лишь спустя 118 лет это предположение было доказано. Правда, Эйлер предполагал еще, что ортогональных квадратов не будет и при N=10, 14. Однако оказалось, что ортогональных квадратов нет только при N=6 ! [см. 2] Задача 2. "Ломаная" (на тему задачи I тура IV Всероссийской олимпиады,1992 год). ([3]) На плоскости дана ломаная такая, что: 1) каждое звено параллельно или оси OX, или оси OY; 2) нет касаний и самопересечений; 3) все координаты целочислены; 4) ломаная замкнута; Известны координаты вершин (не обязательно в последовательном порядке). Требуется восстановить порядок вершин, найти длину ломаной и площадь, ограниченную ею. Для наглядности исходные координаты запишем в типизированную константу tabstar: первая строка - хкоординаты, вторая - y-координаты (в основной процедуре step - это t1), а результатом будет таблица упорядоченных координат tabnow ( в процедуре step - это t2). Так как начинать можно с любой точки, то "отправимся в путь" из первой вершины вдоль оси OY (значит вернемся в нее вдоль оси OX; поэтому условие окончания работы - совпадение y-координаты последней точки с первой и, естественно, s=n, где s - номер вершины из которой будем "двигаться" (иначе ответа вообще не существует, значение булевской переменной fin так и останется "ложным"); таким образом при нечетном s мы должны искать точку вдоль оси OY (х=t1[1,j]), а при четном s - вдоль оси OX (y=t1[2,j])). Булевская функция mozno проверяет нет ли пересечений и касаний звена М1М2 с предыдущими звеньями А1А2. Для определенности пусть звено А1А2 расположено вдоль оси OX, а звено М1М2 - вдоль OY. А1(х1,y1) А2(x2,y2) М1(u1.v1) М2(u2,v2). Для самопересечения требуется выполнение условий: х1<=u1 x2>=u1 11 y1<=v2 y1>=v1 В общем случае (с учетом касаний) условия записаны в функции mozno с помощью функций max и min. Условие u2=x1, v2=y1 необходимо, чтобы второй раз не взять уже пройденную вершину. Ну а если двигаться "вперед" все-таки можно, то делается это рекурсивно. Шаг "назад" получается при выходе из рекурсии командой s:=s-1. Найти площадь, а тем более длину, когда восстановлен порядок обхода вершин - это уже просто. program LOMAN; const n=12; type tab=array[1..2,1..n] of integer; const tabstar: tab=((30,70,120,140,30,70,70,120,140,70,120,120), (20,40,60,90,90,20,60,40,20,90,20,90)); var tabnow: tab; x,y,s: integer; fin: boolean; procedure otvet(t: tab); var i,j: byte; begin for j:=1 to n do begin write(j,' '); for i:=1 to 2 do write(t[i,j],' '); writeln end; readln end; (* конец процедуры печати ответа *) function max(var x,y: integer): integer; begin if x<y then max:=y else max:=x end; function min(var x,y: integer): integer; begin if x<y then min:=x else min:=y end; function mozno(var u2,v2,s: integer; t: tab): boolean; var j,x1,y1,x2,y2,u1,v1: integer; begin mozno:=true; u1:=t[1,s]; v1:=t[2,s]; for j:=1 to (s-2) do begin x1:=t[1,j]; y1:=t[2,j]; x2:=t[1,j+1]; y2:=t[2,j+1]; if ( (min(x1,x2)<=max(u1,u2)) and (max(x1,x2)>=min(u1,u2)) and (min(y1,y2)<=max(v1,v2)) and (max(y1,y2)>=min(v1,v2)) ) or ( (u2=x1) and (v2=y1) ) then mozno:=false; end end; (* конец процедуры проверки *) procedure step(var x,y,s: integer; var t1,t2: tab; var fin: boolean); (* процедура нахождения следующей точки после X,Y "вдоль ОY", *) (* если s нечетное и "вдоль OX" если s четное *) var j,u,v: integer; begin t2[1,s]:=x; t2[2,s]:=y; if (s=n) and (y=t2[2,1]) then fin:=true; for j:=1 to n do begin if ( (s/2<>int(s/2)) and (x=t1[1,j]) and (y<>t1[2,j]) ) or ( (s/2=int(s/2)) and (y=t1[2,j]) and (x<>t1[1,j]) ) then begin u:=t1[1,j]; v:=t1[2,j]; if mozno(u,v,s,t2) then begin 12 s:=s+1; (* рекурсивный шаг вперед *) step(u,v,s,t1,t2,fin); (* шаг назад в рекурсии *) s:=s-1 end end end end; (* конец процедуры "шаг вдоль ОХ или OY" *) (* начало основной программы *) begin x:=tabstar[1,1]; y:=tabstar[2,1]; s:=1; fin:=false; step(x,y,s,tabstar,tabnow,fin); if fin then otvet(tabnow) else writeln(' нет решения '); readln end. Задача 3. "Паркет". (на тему задачи I тура VI Всероссийской олимпиады, 1994 год). ([5]) Пол комнаты размером МхN требуется выложить одинаковыми плитками 2х1 без пропусков и наложений. Найти количество возможных способов укладки. "Укладывать" плитки будем записывая в таблицу tab намер плитки s. При достижении s значения (m*n)/2 увеличиваем переменную ss (кол-во вариантов укладки). Процедура nachalo находит место, от которого будем "наращивать" плитку. Место находится так: ищется первое нулевое число при стандартном обходе таблицы по строчкам слева направо (v – номер столбика, u - номер строчки). Так как укладывать плитку можно только в двух направлениях ("вправо" и "вниз"), то делать это будем типизированными массивами mvi, mvj (они при значении индекса l=1 обеспечивают движение "вниз" (увеличивается номер строки), при l=2 двигаемся "вправо" (увеличивается номер столбца)). Опять же и здесь требуется булевская функция mozno, которая проверяет свободна ли вторая клетка, которую "собирается" накрыть плитка. Если "двигаться" можно, то опять же делаем это рекурсивно. Причем здесь придется побеспокоиться о "шаге назад": при возврате из рекурсивного "шага вперед" надо "стереть" последнюю плитку (на ее "место" записываем нули). program PARKET; const m=2; n=2; finish=(m*n)/2; type massiv=array[1..m,1..n] of byte; move=array[1..2] of 0..1; var tab: massiv; i,j,s: byte; ss: longint; const mvi: move=(1,0); mvj: move=(0,1); function mozno(var tab: massiv; i,j: byte): boolean; (* функция проверки: свободно ли место I,J *) begin if (tab[i,j]=0) and (i>0) and (i<=m) and (j>0) and (j<=n) then mozno:=true else mozno:=false end; (* конец процедуры проверки *) procedure nachalo(var tab: massiv; var u,v: byte); var i,j: byte; nul: boolean; begin nul:=false; i:=0; while (i<m) and not nul do begin i:=i+1; j:=0; while (j<n) and not nul do begin j:=j+1; if tab[i,j]=0 then nul:=true end end; v:=j; u:=i end; (* конец процедуры нахождения начальной точки *) 13 procedure step(var tab: massiv; var s: byte; var ss: longint); (* процедура ставит плитку *) var l,u,v,uu,vv: byte; begin nachalo(tab,u,v); l:=0; repeat l:=l+1; uu:=u+mvi[l]; vv:=v+mvj[l]; if mozno(tab,uu,vv) then begin tab[u,v]:=s; tab[uu,vv]:=s; s:=s+1; if s>finish then ss:=ss+1; else step(tab,s,ss); (* рекурсивный шаг вперёд *) s:=s-1; tab[u,v]:=0; tab[uu,vv]:=0; (* шаг назад *) end; until (l=2) end; (* конец процедуры установки плитки *) (* начало основной программы *) begin for i:=1 to m do for j:=1 to n do tab[i,j]:=0; ss:=0; s:=1; step(tab,s,ss); writeln('всего способов укладки паркета - ',ss); readln end. Задача 4. "Острова в море" (на тему задачи I тура IV Международной олимпиады, 1992 год). ([4]) Расположение островов в море представлено в виде таблицы nxn. Каждый остров - символ '*', пустое место - символ '.'. По закодированной информации о распределении островов по горизонталям и вертикалям восстановить карту островов. *.**.. 12 .***.* 31 *.*.*. 111 .***** 5 **.*.* 211 ...*.. 1 114221 12 3 2 1 Постановка задачи: Искомую карту островов будем записывать в булевскую таблицу m размера nxn (true - остров, false - пустое место), а условия представим в такой форме: условия по строкам - таблица nx(n+1), где первое число (из нулевого столбца) количество островов в строке, а затем уже и длины этих островов (лишние места заполняем нулями); аналогично и условия по столбцам. Для наглядности запишем их в типизированные константы uslstr (условия по строкам), uslstl (условия по столбцам). Процедура otvet печатает на экране номер решения (переменная wsego) и саму таблицу (остров символом '*', пустое место символом '.'). Сама процедура step установки острова номер i в строке х делается перебором столбца y, записи на это место острова (процедура zapis при значении соответствующей булевской переменной true) и проверки можно ли его туда ставить (булевская функция mozno). Если да, то происходит увеличение y и i до тех пор пока не заполнится вся строка х, после чего происходит рекурсивный шаг на следующую строку (х+1). Если нет, то процедурой zapis (булевская переменная - false) "стирается" этот остров и продолжается поиск для него нового значения y. Здесь тоже надо побеспокоиться о "шаге назад" при возвращении из рекурсии (делает это все та же процедура zapis, которая "сотрет" последний остров, чтобы затем "двинуться" дальше вдоль строки х, взяв следующее значение y). Если бы решение было одно, то вполне можно было обойтись и без рекурсии (простым циклом перебрать номера строчек х). Но в случае нескольких решений или отсутствия их вообще как раз и пригодится эта возможность рекурсии делать "шаг назад" (кстати, "шаг назад" нужно будет сделать и после получения ответа для дальнейшего поиска других возможных решений). По сути - это "усиленный" вариант задачи "Восемь ферзей" ([1]), только там требовалось в каждой строке поставить одного ферзя, а здесь - несколько "ферзей разной длины". И функция проверки mozno здесь более изощренная: в тех столбцах, которые занял новый остров i, требуется проверить соответствуют ли длины островов вдоль столбцов условию задачи, причем при достижениипоследней строки проверка делается более тщательно. 14 program ISLAND; const n=6; type usl=array[1..n,0..n] of byte; map=array[1..n,1..n] of boolean; const uslstr: usl=((2,1,2,0,0,0,0), (2,3,1,0,0,0,0), (3,1,1,1,0,0,0), (1,5,0,0,0,0,0), (3,2,1,1,0,0,0), (1,1,0,0,0,0,0)); uslstl: usl=((3,1,1,1,0,0,0), (2,1,2,0,0,0,0), (1,4,0,0,0,0,0), (2,2,3,0,0,0,0), (1,2,0,0,0,0,0), (2,1,2,0,0,0,0)); var m: map; x,y: byte; (* х - номер строки, y - номер столбца *) wsego: word; procedure otvet(var m: map; wsego: word); var k,l: byte; begin writeln(' решение номер ',wsego); writeln; for k:=1 to n do begin for l:=1 to n do if m[k,l] then write ('*') else write('.'); writeln end; writeln end; (* конец процедуры - печать ответа *) function mozno(var m: map; x,y,i: byte): boolean; (* можно ли поставить остров номер i в строку х, столбец y *) var k,l,dlx,dly,j,s: byte; (* k - текущий номер строки, l - текущий номер столбца *) (* dlx - длина острова номер i в строке х *) (* dly - длина острова номер j в столбце l по условию *) (* s - длина острова номер j в столбце l фактически *) da,flag: boolean; begin dlx:=uslstr[x,i]; l:=y; da:=true; if (dlx<1) and (x=n) then dlx:=1; (* для последней строки x=n проверку сделаем обязательно *) while (l<=(y+dlx-1)) and da do (* начало перебора столбцов l *) begin k:=1; j:=1; while (k<=x) and da do (*начало перебора внутри столбца l*) begin flag:=true; s:=0; dly:=uslstl[l,j]; while flag and (k<=n) do begin if m[k,l] then begin s:=s+1; k:=k+1 end else flag:=false end; if s>0 then if (dly=s) or ((dly>s) and (k>=x)) then j:=j+1 (* проверка "прошла", проверяем дальше *) else da:=false (* проверка в столбце l для острова номер j "не прошла" *) 15 else if (k>=n) and (dly>s) then da:=false; (* для последней строки проверка требует особой тщательности *) k:=k+1 end; l:=l+1 end; mozno:=da; end; (* конец функции можно *) procedure zapis(var m: map; x,y,i: byte; zap: boolean); (* записать в строке х, начиная со столбца y остров номер i, *) (* если zap=true и стереть если zap=false *) var v,l: byte; begin v:=y+uslstr[x,i]-1; for l:=y to v do m[x,l]:=zap end; (* конец процедуры записи *) procedure step(var m: map; x,i: byte; var wsego: word); var y,f: byte; (* y - номер столбца до записи острова в таблицу m, *) (* f - кол-во групп островов в строке х, *) begin y:=0; f:=uslstr[x,0]; repeat y:=y+1; zapis(m,x,y,i,true); if mozno(m,x,y,i) then begin if (x=n) and (i>=f) then begin wsego:=wsego+1; otvet(m,wsego); readln; (* шаг назад для поиска других решений *) zapis(m,x,y,i,false) end else begin if i>=f then begin (* рекурсия вперед *) step(m,x+1,1,wsego); (* шаг назад *) zapis(m,x,y,i,false) end else begin y:=y+uslstr[x,i]; i:=i+1 end end end else zapis(m,x,y,i,false); (* шаг назад в случае невозможности сделать запись *) if f=0 then y:=n; until (y>=n) end; (* конец процедуры ставить остров i в строку х, столбик y *) begin (* основная программа *) for x:=1 to n do for y:=1 to n do m[x,y]:=false; wsego:=0; step(m,1,1,wsego); if wsego=0 then writeln('решений нет') else writeln('всего решений',wsego,' работа закончена' ); readln end. 16 В случае n=8, uslstr=((1,1,0,0,0,0,0,0,0), uslstl=((1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0), (1,1,0,0,0,0,0,0,0)) (1,1,0,0,0,0,0,0,0)) получаем задачу расстановки восьми шахматных ладей, каждая из которых не бьет другую. Количество решений - 8! = 8*7*6*5*4*3*2*1 = 40 320 Задачи, которые полезно решить рекурсией. 1. Задача «Определитель». Вычислить определитель, используя рекуррентную формулу разложения по первой строке. 2. "Словарик". Упорядочить строковый массив в алфавитном порядке (при совпадении первой буквы надо рассматривать следующие). 3. "Вычислитель". Основные арифметические операции записываются в таком виде: x+y (x,y)a (addition) x-y (x,y)s (subtraction) x*y (x,y)m (multiplication) x/y (x,y)d (division) Арифметическое выражение, записанное таким образом помещено в строковую переменную. Вычислить соответствующее число. Например, по значению х='((5.0,6.0)m,(10.0,8.0)s)d' требуется получить число (5*6)/(10-8)=15. 4. "Расписание". (задача Киркмана о школьницах) ([2]). Учительница ежедневно выводит своих учениц на прогулку. Девочек 15, и учительница выстраивает их в пять рядов по три девочки в каждом, так что у каждой из них на прогулке две спутницы. Как следует расставлять девочек, чтобы в течение недели ни одна ученица не оказывалась ни с одной своей одноклассницей в одной тройке более чем один раз? Литература: [1] В.А.Дагене, Г.К.Григас, К.Ф.Аугутис "100 задач по программированию" (г. Москва, "Просвещение", 1993 год, 38 тыс. экз.). [2] У.Болл, Г.Коксетер "Математические эссе и развлечения" (г.Москва, "Мир", 1986 год, 100 тыс. экз.). [3] "Информатика и образование" N3 1993 г. [4] "Информатика и образование" N1 1993 г. [5] "Информатика и образование" N3 1994 г. Задача «Определитель». Вычислить определитель, используя рекуррентную формулу разложения по первой строке. const n=4; type mas= array[1..n,1..n] of integer; const t: mas=((1,0,0,0), (1,2,3,4), (1,2,3,0), (1,2,3,4)); function det(a: mas; k: integer): integer; var s,l,z,i,j: integer; b: mas; begin if k=2 then det:=a[1,1]*a[2,2]-a[1,2]*a[2,1] else begin s:=0; z:=1; for l:=1 to k do begin for i:=2 to k do for j:=1 to k do begin 17 if j<l then b[i-1,j]:=a[i,j]; if j>l then b[i-1,j-1]:=a[i,j]; end; s:=s+z*a[1,l]*det(b,k-1); z:=-z; end; det:=s; end; end; begin writeln(det(t,n)); readln; end. Задача. «Телебашня». Город Обломов представляет собой прямоугольник кварталов. Все кварталы имеют форму квадрата равной площади, а ширина улиц незначительна по сравнению с размерами квартала. Требуется установить в центре некоторых кварталов передатчики, чтобы они «охватили» своей работой весь город. Задача усложняется тем, что некоторые кварталы – небоскребы: на них нельзя устанавливать передающие и принимающие антенны и сигнал доходит до принимающей антенны если он только касается небоскреба или проходит мимо. Сигнал распространяется по прямой. Принимающие антенны находятся в центре кварталов. Координаты кварталов отсчитываются от 1 до не более 14. Требуется найти минимально возможное количество передатчиков и указать их координаты. const m=14; n=14; mn=m*n; neb=10; type mas= array[1..m,1..n] of integer; otv= array[1..mn] of integer; masneb= array[1..neb] of integer; const a: mas=((0,0,0,0,0,0,0,0,0,0,0,0,0,0), (0,0,0,0,0,0,0,0,0,-1,0,0,0,0), (0,0,-1,0,0,0,0,0,0,0,0,0,0,0), (0,0,0,0,0,0,0,0,0,0,0,0,0,0), (0,0,0,-1,0,0,0,0,-1,0,0,0,0,0), (0,0,0,0,0,0,0,0,0,0,0,0,0,0), (0,0,0,0,0,0,0,0,0,0,0,0,0,0), (0,0,0,-1,0,0,0,0,0,0,0,0,0,0), (0,0,0,0,0,0,0,-1,0,0,-1,0,0,0), (0,0,0,0,0,0,0,0,0,0,0,0,0,0), (0,0,0,-1,0,0,-1,0,0,0,0,0,0,0), (0,0,0,0,0,0,0,0,0,0,0,0,0,0), (0,0,0,0,0,0,0,-1,0,0,0,0,0,0), (0,0,0,0,0,0,0,0,0,0,0,0,0,0)); pn: masneb=(2,3,5,5,8,9,9,11,11,13); qn: masneb=(10,3,4,9,4,8,11,4,7,8); var min: integer; amin: mas; pp,qq,otvp, otvq: otv; procedure otvet(x: integer; y: mas); var c,d: integer; begin writeln('Наимeньшее количество пeредатчиков равно ',x div 2); for c:=1 to x div 2 do begin write(otvp[c]:3,otvq[c]:3); writeln end; writeln; for c:=1 to m do begin for d:=1 to n do write(y[c,d]:3); writeln end; end; 18 procedure nazad (k:integer); var c,d: integer; begin for c:=1 to m do for d:=1 to n do if (a[c,d]=k) or (a[c,d]=k-1) then a[c,d]:=0 end; function gotov: boolean; var c,d: integer; f: boolean; begin f:=true; for c:=1 to m do for d:=1 to n do if a[c,d]=0 then f:=false; gotov:=f; end; function daneb(x1,y1,x2,y2,nom: integer): boolean; var xneb,yneb,ur: array[1..4] of longint; xn,yn,i,j,r1,r2: integer; f: boolean; begin r1:=sqr(x2-x1)+sqr(y2-y1); xn:=2*pn[nom]-1; yn:=2*qn[nom]-1; xneb[1]:=xn-1; yneb[1]:=yn-1; xneb[2]:=xn-1; yneb[2]:=yn+1; xneb[3]:=xn+1; yneb[3]:=yn-1; xneb[4]:=xn+1; yneb[4]:=yn+1; r2:=sqr(xn-1-x1)+sqr(yn-1-y1); f:=true; for i:=1 to 4 do ur[i]:=(xneb[i]-x1)*(y2-y1)-(yneb[i]-y1)*(x2-x1); if r1>r2 then for i:=1 to 3 do for j:=(i+1) to 4 do if ur[i]*ur[j]<0 then f:=false; daneb:=f; end; procedure kogo(p,q,k: integer); var nn,c,d,xc,yd,xp,yq: integer; u,r1,r2: real; signal: boolean; begin xp:=2*p-1; yq:=2*q-1; for c:=1 to m do for d:=1 to n do if a[c,d]=0 then begin signal:=true; xc:=2*c-1; yd:=2*d-1; nn:=1; while (nn<=neb) and signal do begin if not daneb(xp,yq,xc,yd,nn) then signal:=false; nn:=nn+1; end; if signal then a[c,d]:=k-1; end end; procedure step(k: integer); var p,q,l: integer; begin if k<min then begin 19 for p:=1 to m do for q:=1 to n do begin if a[p,q]=0 then begin a[p,q]:=k; l:=k div 2; pp[l]:=p; qq[l]:=q; kogo(p,q,k); if gotov then if k<min then begin min:=k; amin:=a; otvp:=pp; otvq:=qq; end else begin end else step(k+2); nazad(k); end; end; end; end; begin min:=m*n; step(2); otvet(min,amin); readln; end. 20