Перечислить все разбиения N на целые положительные слагаемые

 

Пример: N=4, разбиения: 1+1+1+1, 2+1+1, 2+2, 3+1, 4.

First = (1,1,...,1) - N единиц Last = (N)

Чтобы разбиения не повторялись, договоримся перечислять слагаемые в невозрастающем порядке. Сказать, сколько их будет всего, не так-то просто (см.следующий пункт). Для составления алгоритма Next зададимся тем же вопросом: в каком случае i-ый член разбиения можно увеличить, не меняя предыдущих?

Во-первых, должно быть X[i-1]>X[i] или i=1. Во-вторых, i должно быть не последним эле ментом (увеличение i надо компенсировать уменьшением следующих). Если такого i нет, то данное разбиение последнее. Увеличив i, все следующие элементы надо взять минимально возможными, т.е. равными единице:

procedure Next; begin {найти i: (i<L) and ((X[i-1]>X[i]) or (i=1))} X[i]:=X[i]+1; { L:= i + X[i+1]+...+X[L] - 1 } X[i+1]:=...:=X[L]:=1 end;

Через L мы обозначили количество слагаемых в текущем разбиении (понятно, что 1<=L<=N). Программа будет выглядеть так:

program Razbieniya; type Razb=array [byte] of byte; var N,i,L:byte; X:Razb; procedure Next(var X:Razb;var L:byte); var i,j:byte; s:word; begin i:=L-1;s:=X[L]; {поиск i} while (i>1)and(X[i-1]<=X[i]) do begin s:=s+X[i];dec(i) end; inc(X[i]); L:=i+s-1; for j:=i+1 to L do X[j]:=1 end; begin write('N=');readln(N); L:=N; for i:=1 to L do X[i]:=1; for i:=1 to L do write(X[i]);writeln; repeat Next(X,L); for i:=1 to L do write(X[i]);writeln until L=1 end.

Задача №5

 

Перечислить все расстановки 8-ми ферзей на шахматной доске, при которых они не бьют друг друга

 

Классической задачей, которая решается методом перебора с отходом назад считается задача о восьми ферзях: требуется перечислить все способы расстановки 8-ми ферзей на шахматной доске 8 на 8, при которых они не бьют друг друга. Эту задачу решил больше 200 лет тому назад великий математик Леонард Эйлер. Заметьте, что у него не было компьютера, но тем не менее он абсолютно верно нашел все 92 таких расстановки!

Очевидно, на каждой из 8 вертикалей должно стоять по ферзю. Каждую такую расстановку можно закодировать одномерным массивом

X[1],...,X[8],

где X[i] - номер горизонтали для i-го ферзя. Поскольку никакие два ферзя не могут стоять на одной горизонтали (тогда они бьют друг друга), то все X[i] различны, т.е. образуют перестановку из чисел 1..8. Можно, конечно, перебрать все 8! таких перестановок и выбрать среди них те 92, которые нас интересуют. Hо число 8!=40320 довольно большое.

Поэтому мы воспользуемся алгоритмом перебора с отходом назад, который позволит значительно сократить перебор и даст ответ намного быстрее:

program Queens; const N=8; type Index=1..N; Rasstanovka=array [Index] of 0..N; var X:Rasstanovka; Count:word; function P(var X:Rasstanovka;k,y:Index):boolean; var i:Index; begin i:=1; while (i<k)and(y<>X[i])and(abs(k-i)<>abs(y-X[i])) do inc(i); P:=i=k end; procedure Backtracking(k:Index); var i,y:Index; begin for y:=1 to N do if P(X,k,y) then begin X[k]:=y; if k=N then begin for i:=1 to N do write(X[i]);writeln;inc(Count) end; Backtracking(k+1) end end; begin Count:=0; writeln('Расстановки ',N,' ферзей:'); Backtracking(1); writeln('Всего ',Count,' расстановок') end.

Задача №6

На двумерной плоскости задано N точек с координатами (X₁,Y₁), (X₂,Y₂),..., (X_n,Y_n). Написать программу, которая из этих точек выделяет вершины квадрата, содержащего максимальное число заданных точек.

ПРИМЕЧАНИЕ: предполагается, что точки, расположенные на сторонах квадрата, принадлежат ему.

Это переборная задача. Обратите внимание, что стороны квадрата могут и не быть параллельны осям координат! Каждую из N точек мы последовательно рассматриваем в качестве верхнего левого угла квадрата, каждую из оставшихся N-1 - как нижнюю правую вершины и смотрим, есть ли для них в этом множестве из N точек точки, соответствующие верхнему правому и нижнему левому углу. Если да, то подсчитываем, сколько точек лежат в данном квадрате.

Пусть координата левого верхнего угла (x₁,y₁), нижнего правого (x₂,y₂), тогда координата пересечения диагоналей четырехугольника ((x₁+x₂)/2,(y₁+y₂)/2); координата верхнего правого угла

((x₁+x₂)/2+[y₁-(y₁+y₂)/2],(y₁+y₂)/2+[x₁-(x₁+x₂)/2])= =((x₁+x₂+y₁-y₂)/2, (x₁-x₂+y₁+y2)/2), нижнего левого - ((x₁+x₂-y₁+y₂)/2,(-x₁+x₂+y₁+y₂)/2)

(Постройте чертеж и проверьте!).

Для (x₁,y₂) и (x₂,y₂) должны выполняться следующие неравенства: x₁<=x₂, y₁>=y₂ (иначе это будут уже не левый верхний и правый нижний углы квадрата).

Программа:

{В исходном множестве поочередно перебираются все пары точек.}{Предполагая, что отрезок, соединяющий эти точки, является ребром}{квадрата строим квадрат и смотрим, все ли его вершины имеются в}{исходном множестве. Если все, то определяем, сколько точек из}{исходного множества лежит внутри этого квадрата. Если это число}{превосходит старый рекорд то запоминаем найденный квадрат.}{ }{$A-,B-,D-,E+,F-,I+,L-,N-,O-,R-,S-,V-}{$M 65520,0,655360}uses crt;constmaxn = 100;{ Максимальное число точек }type xy = record x,y: real end; { Тип для записи координат точек }var m: array[1..maxn] of xy; { Координаты точек множества } i,j,g,k,n,p: word; { вспомогательные переменные } num: word; { для записи числа точек в текущем квадрате } rec: word; { для записи числа точек в лучшем квадрате } a1,b1,c1: real; { вспомогательные переменные } r,c: array[1..5] of xy;{ для записи вершин квадратов } f1,f2: boolean; o: array[1..4] of shortint;Function sign(a: real): shortint;{ Функция signum }begin if a<0 then sign:=-1 else if a>0 then sign:=1 else sign:=0end;{ нахождение коэффициентов прямой, проходящей через точки x1,y1 и x2,y2 }procedure getabc(x1,y1,x2,y2:real; var a,b,c:real);begina:=y2-y1; b:=x1-x2; c:=-(a*x1+b*y1)end;begin write('Введите число точек...'); readln(n); for i:=1 to n do begin write('Введите координаты ',i,'-ой точки...'); readln(m[i].x,m[i].y); end; rec:=0;{ Обнуление рекорда }for i:=1 to n do { Перебор всех квадратов, для которых отрезок m[i]-m[j] } for j:=1 to n do { является ребром } if i<>j then beginc[1]:=m[i]; c[2]:=m[j]; { Определение вершин квадрата } c[3].x:=c[2].x+(c[1].y-c[2].y); c[3].y:=c[2].y+(c[2].x-c[1].x); c[4].x:=c[1].x+(c[1].y-c[2].y); c[4].y:=c[1].y+(c[2].x-c[1].x); c[5]:=c[1]; num:=0;{ Проверка на наличие всех вершин квадрата в исходном множестве точек }f1:=false; f2:=false; for g:=1 to n do if (m[g].x=c[3].x) and (m[g].y=c[3].y) then f1:=true; for g:=1 to n do if (m[g].x=c[4].x) and (m[g].y=c[4].y) then f2:=true; if (c[1].x=c[2].x) and (c[1].y=c[2].y) then f1:=false;if f1 and f2 then {Если все вершины квадрата есть в исходном множестве}for k:=1 to n do { то определяем число точек в квадрате} begin for g:=1 to 4 do begingetabc(c[g].x,c[g].y,c[g+1].x,c[g+1].y,a1,b1,c1); o[g]:=sign(a1*m[k].x+b1*m[k].y+c1); end; if ((o[1]=o[2]) and (o[2]=o[3]) and (o[3]=o[4])) or((o[1]=o[2]) and (o[2]=o[3]) and (o[4]=0)) or ((o[1]=o[2]) and (o[2]=o[4]) and (o[3]=0)) or ((o[1]=o[3]) and (o[3]=o[4]) and (o[2]=0)) or ((o[2]=o[3]) and (o[3]=o[4]) and (o[1]=0)) or ((m[k].x=c[1].x) and (m[k].y=c[1].y)) or ((m[k].x=c[2].x) and (m[k].y=c[2].y)) or ((m[k].x=c[3].x) and (m[k].y=c[3].y)) or ((m[k].x=c[4].x) and (m[k].y=c[4].y)) then inc(num); end; if rec<num then begin r:=c; rec:=num end; end; if rec=0 then { Не найдено ни одного квадрата } begin writeln('Не найдено ни одного квадрата.'); halt end; { Вывод результатов } write('Лучший квадрат: ');for i:=1 to 3 do write('(',r[i].x:2:2,

Задача №7

Задан набор неповторяющихся пар (A_i,A_j), A_i, A_j принадлежат множеству А={A₁, A₂,..., A_n}. Необходимо составить цепочку максимальной длины по правилу (A_i,A_j)+(A_j,Ak)=(A_i,A_j,A_k).

При образовании этой цепочки любая пара может быть использована не более одного раза.

 

Для более удобного хранения информации заведем матрицу

C[1...n,1..n] (так называемую матрицу смежности) в которой C[i,j]=1, если в наборе есть пара (A_i,A_j) и C[i,j]=0 иначе. Будем строить все возможные цепочки (по правилу, данному в условии) и искать среди них ту, которая имеет максимальную длину. В качестве начального символа цепочки можно взять любой символ из A. Пусть это символ Ai. Ищем, просматривая строку i матрицы C слева направо элемент C[i,j]=1 (другими словами, ищем пару с первым элементом Ai). Если такого элемента не существует, то берем в качестве начала строки другой элемент множества A. Если элемент C[i,j]=1 найден, то ему соответствует пара (A_i,A_j). Помечаем ее как уже использованную полагая, например, C[i,j]=-1. Далее просматриваем слева направо строку j матрицы C в поисках еще не использованной пары (A_j,A_k) (C[j,k]=1). Присоединяем элемент Ak к имеющейся цепочке, полагаем C[j,k]=-1, ищем единичный элемент в строке k и т.д. Предположим, на некотором шаге мы получили цепочку A_i A_j A_k... A_s A_l A_p и в строке p матрицы больше нет ни одного единичного элемента. Это означает, что при таком подборе предыдущих элементов мы нашли максимальную по длине строку. Если ее длина больше длин всех найденных ранее строк, запоминаем эту строку как рекорд. После этого "отщепляем" от строки последний элемент Ap и смотрим, есть ли еще в строке l единичный элемент с индексом, большим p. Если да, то приписываем уже этот элемент к строке и пытаемся затем снова увеличить длину полученной строки, если же нет, то "отщепляем" от строки элемент A₁, в строке S ищем единичный элемент с индексом, большим l и т.д.

Останов осуществляется тогда, когда мы должны "отщепить" от строки A_i. Перебираем цепочки, начинающиеся со всех возможных элементов множества A. Находим строку максимальной длины:

const M=10; {максимально число элементов в A}{будем считать, что A состоит из чисел от 1 до N} var c:array[1..M,1..M] of integer;curstr, maxstr: array[0..M] of integer;{в этих переменных хранятся текущая цепочка и}{цепочка максимальной длины.}{В нулевом элементе хранится длина цепочки}N,E: integer; {N - число элементов в A}i,j,k: integer; {E - число пар в наборе}procedure find;var l,j: integer;beginl:=curstr[curstr[0]]; {l = последний элемент цепочки}for j:=1 to N do {просмотр строки l}if C[l,j]=1then begincurstr[0]:=curstr[0]+1;curstr[curstr[0]]:=j; {j -> в цепочку}c[l,j]:=-1; {пара использована}find;c[l,j]:=1; {пару снова разрешено использовать}curstr[0]:=curstr[0]-1;end;if curstr[0]>maxstr[0] {если нашли более}then maxstr:=curstr {длинную строку}end;beginreadln(N); readln(E);for i:=1 to N dofor j:=1 to N doC[i,j]:=0;for k:=1 to E do beginwrite('очередная пара: ',i,j);c[i,j]:=1end;for i:=1 to N do begincurr[0]:=1; {поиск цепочки}curr[1]:=i; {начинающейся элементом i}find;end;for i:=1 to maxstr[0] dowrite(maxstr[i]); {печать максимальной строки} end.

Задача № 8

Имеется N городов. Для каждой пары городов (I,J) можно построить дорогу, соединяющую эти два города и не заходящие в другие города. Стоимость такой дороги A(I,J). Вне городов дороги не пересекаются.Написать алгоритм для нахождения самой дешевой системы дорог, позволяющей попасть из любого города в любой другой. Результаты задавать таблицей B[1:N,1:N], где B[I,J]=1 тогда и только тогда, когда дорогу, соединяющую города I и J, следует строить.

Легко понять, что сеть дорог будет реализовывать некоторый связный (так как можно проехать из любого города в любой) граф без циклов (так как одно ребро из цикла можно выбросить, а связный граф останется связным). Поэтому алгоритм построения сети дорог минимальной суммарной стоимости очень прост. На каждой итерации необходимо находить дорогу минимальной стоимости, которая не образует цикла с уже выбранными дорогами на предыдущих итерациях. Основную трудность такого решения составляет проверка условия, образуют ли ребра цикл. Однако решение существенно упрощается, если рассматривать только минимальные ребра только между двумя множествами: множеством помеченных вершин и множеством непомеченных вершин. Понятно, что эти множества должно соединять хотя бы одно ребро, чтобы граф был связным. Ясно, что оно должно быть минимальным по длине. В описываемом ниже алгоритме это делается следующим образом. Для каждой вершины к из множества непомеченных вершин (а на начальном этапе это все вершины, кроме первой) определяется ближайшая вершина из множества помеченных вершин БЛИЖ[к]. На каждой итерации определяется кратчайшее ребро (i,j) между множеством помеченных вершин и множеством непомеченных вершин, используя массив БЛИЖ. Найденное ребро выбирается для системы дорог, а соответствующая вершина j считается помеченной. После этого пересчитывается массив БЛИЖ. При этом учитывается, что к изменение некоторой величины БЛИЖ[k] может произойти только тогда, когда расстояние от k до j меньше, чем от k до БЛИЖ[k].

Алгоритм

для i от 1 до N выполнятьнцфлаг[i]:=0;БЛИЖ[i]:=1кцфлаг[1]:=1;для k от 1 до N-1 выполнятьнцминрас:=бесконечность;для i от 2 до N выполнятьесли флаг[i]=0 и минрас > C[БЛИЖ[i],i]то минрас:=C[БЛИЖ[i],i];j:=i;всеВывод ребра (БЛИЖ[j],j)флаг[j]:=1;для i от 2 до N выполнятьесли флаг[i]=0 и C[БЛИЖ[i],i]>C[i,j]то БЛИЖ[i]:=j;всекц

Задача № 9

Элементами массива a[1..n] являются неубывающие массивы [1..m] целых чисел (a: array [1..n] of array [1..m] of integer; a[1][1] <=... <= a[1][m],..., a[n][1] <=... <= a[n][m]). Известно, что существует число, входящее во все массивы a[i] (существует такое х, что для всякого i из [1..n] найдётся j из [1..m], для которого a[i][j]=x). Найти одно из таких чисел х.

 

Введем массив b[1]..b[n], отмечающий начало "остающейся части" массивов a[1]..a[n].

for k:=1 to n do begin | b[k]:=1; end; eq:= true; for k:= 2 to n do begin | eq:= eq and (a[1][b[1]] = a[k][b[k]]); end; {инвариант: оставшиеся части пересекаются, т.е. существует такое х, что для всякого i из [1..n] найдётся j из [1..m], не меньшее b[i], для которого a[i][j] = х; eq <=> первые элементы оставшихся частей равны} while not eq do begin | s:= 1; k:= 1; | {a[s][b[s]] - минимальное среди a[1][b[1]]..a[k][b[k]]} | while k <> n do begin | | k:= k + 1; | | if a[k][b[k]] < a[s][b[s]] then begin | | | s:= k; | | end; | end; | {a[s][b[s]] - минимальное среди a[1][b[1]]..a[n][b[n]]} | b [s]:= b [s] + 1; | for k:= 2 to n do begin | | eq:= eq and (a[1][b[1]] = a[k][b[k]]); | end; end; writeln (a[1][b[1]]);

Задача №10