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

Задача 391. Perfect Rectangle ^[1]

Given N axis-aligned rectangles where N > 0, determine if they all together form an exact cover of a rectangular region.
Each rectangle is represented as a bottom-left point and a top-right point. For example, a unit square is represented as [1,1,2,2]. (coordinate of bottom-left point is (1, 1) and top-right point is (2, 2)).

Example 1: rectangles = [
[1,1,3,3],
[3,1,4,2],
[3,2,4,4],
[1,3,2,4],
[2,3,3,4]]
Return true. All 5 rectangles together form an exact cover of a rectangular region.
…
Example 3:rectangles =
[ [1,1,3,3],
[3,1,4,2],
[1,3,2,4],
[3,2,4,4]]
Return false. Because there is a gap in the top center.

В раздумьях над формулировкой проходит второй день, это конечно не недельные занятия над включением винтажных ламп ^[2], но все же хочу представить результаты работы над задачей. Понадобилось несколько попыток, чтобы решить все имеющиеся тесты.
Исходные данные представлены списком, напомню коротко, список это — [Голова|Хвост], где Хвост- список, также список бывает пустым [].

Формулируем 1

Нужно подсчитать общую площадь всех прямоугольников, найти максимальный размер описывающего их всех прямоугольника и сверить эти две суммы, если равно значит все прямоугольники накрыли равномерно площадь. В это же время проверим, что прямоугольники не пересекаются, каждый новый прямоугольник будем добавлять в список, он по условию не должен накладываться и пересекать все предыдущие.
Для этого применяю хвостовую рекурсию(она же, рекурсия на спуске), самый "императивный" способ представить цикл. В одном таком "цикле", найдем сразу общую сумму площадей и минимальный левый и максимальный правый угол описывающего прямоугольника, походу, накапливая общий список фигур, проверяя, чтобы не было пересечений.
Вот так:

findsum([], Sres,Sres,LConerRes,LConerRes,RConerRes,RConerRes,_).
findsum([[Lx,Ly,Rx,Ry]|T], Scur,Sres,LConerCur,LConerRes,RConerCur,RConerRes,RectList):-
 mincon(Lx:Ly,LConerCur,LConerCur2),
 maxcon(Rx:Ry,RConerCur,RConerCur2),
 Scur2 is Scur+(Rx-Lx)*(Ry-Ly),
 not(chekin([Lx,Ly,Rx,Ry],RectList)),
 findsum(T, Scur2,Sres,LConerCur2,LConerRes,RConerCur2,RConerRes,[[Lx,Ly,Rx,Ry]|RectList]).

У Пролога переменные — это неизвестные, их нельзя изменить, они или пусты или приняли значение, отсюда требуется пара переменных, начальная и результирующая, когда добираемся до конца списка, текущее значение станет результирующим (первая строка правила). В отличие от императивных языков, для поддержки понимания строки программы надо вообразить весь путь, который к ней привел, и все переменные могут иметь свою "историю" накопления, тут же, каждая строка программы только в контексте текущего правила, всё состояние, которое на нее повлияло налицо вход правила.
Итак:

%самый левый угол
mincon(X1:Y1,X2:Y2,X1:Y1):-X1=<X2,Y1=<Y2,!.
mincon(_,X2:Y2,X2:Y2).
%самый правый
maxcon(X1:Y1,X2:Y2,X1:Y1):-X1>=X2,Y1>=Y2,!.
maxcon(_,X2:Y2,X2:Y2).

Тут для представления угла использован "структурированный терм" вида X:Y, это возможность соединить несколько значений в структуру, так сказать кортеж, только функтором может выступать любая операция. А отсечение "!", позволяет во второй строке правила не указывать условие, это способ повысить эффективность вычислений.
И как оказалось далее, самое важно — проверка непересечения прямоугольников, накапливаются они в списке:

%обход всех элементов списка
chekin(X,[R|_]):-cross(X,R),!.
chekin(X,[_|T]):-chekin(X,T).
%пересечение одного с другим или наоборот, или накладываются полностью 
cross(X,X):-!.
cross(X,Y):-cross2(X,Y),!.
cross(X,Y):-cross2(Y,X).
%пересекаются, если вершина одного прямоугольника внутри другого
cross2([X11,Y11,X12,Y12],[X21,Y21,X22,Y22]):-X11<X22,X22=<X12,Y11<Y22,Y22=<Y12,!.%rt
cross2([X11,Y11,X12,Y12],[X21,Y21,X22,Y22]):-X11=<X21,X21<X12,Y11<Y22,Y22=<Y12,!.%lt
cross2([X11,Y11,X12,Y12],[X21,Y21,X22,Y22]):-X11<X22,X22=<X12,Y11=<Y21,Y21<Y12,!.%rb
cross2([X11,Y11,X12,Y12],[X21,Y21,X22,Y22]):-X11=<X21,X21<X12,Y11=<Y21,Y21<Y12.  %lb

Пересечение прямоугольников, это четыре варианта попадания вершины первого внутрь другого.

И финальное высказывание:

isRectangleCover(Rects):-
    [[Lx,Ly,Rx,Ry]|_]=Rects,
    findsum(Rects,0,S,Lx:Ly,LconerX:LconerY,Rx:Ry,RconerX:RconerY,[]),!,
    S=:= (RconerX-LconerX)*(RconerY-LconerY).

На входе список фигур, первую берем для начальных значений левого и правого угла, выполняем обход всех, подсчитав общую площадь, и сверяем полученные суммы. Замечу, если произошло пересечение прямоугольников, то поиск суммы "откажет", вернет "фолс", это значит что и сверять суммы нечего. То же происходит, если во входном списке не будет ни одной фигуры, будет отказ, нечего сверять...

Далее эту реализацию, запускаю на имеющихся тестах, привожу первые 40:

%unit-tests framework
assert_are_equal(Goal, false):-get_time(St),not(Goal),!,get_time(Fin),Per is round(Fin-St),writeln(Goal->ok:Per/sec).
assert_are_equal(Goal, true):- get_time(St),Goal,     !,get_time(Fin),Per is round(Fin-St),writeln(Goal->ok:Per/sec).
assert_are_equal(Goal, Exp):-writeln(Goal->failed:expected-Exp).

:-assert_are_equal(isRectangleCover([[1,1,3,3],[3,1,4,2],[3,2,4,4],[1,3,2,4],[2,3,3,4]]),true).
:-assert_are_equal(isRectangleCover([[1,1,2,3],[1,3,2,4],[3,1,4,2],[3,2,4,4]]),false).
:-assert_are_equal(isRectangleCover([[1,1,3,3],[3,1,4,2],[1,3,2,4],[3,2,4,4]]),false).
:-assert_are_equal(isRectangleCover([[1,1,3,3],[3,1,4,2],[1,3,2,4],[2,2,4,4]]),false).
:-assert_are_equal(isRectangleCover([[0,0,4,1],[0,0,4,1]]),false).

:-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[6,2,8,3],[5,1,6,3],[4,0,5,1],[6,0,7,2],[4,2,5,3],[2,1,4,3],[0,1,2,2],[0,2,2,3],[4,1,5,2],[5,0,6,1]]),true).
:-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[5,1,6,3],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),true).
:-assert_are_equal(isRectangleCover([[0,0,4,1]]),true).
:-assert_are_equal(isRectangleCover([[0,0,3,3],[1,1,2,2]]),false).
:-assert_are_equal(isRectangleCover([[1,1,2,2],[1,1,2,2],[2,1,3,2]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[0,1,3,2],[1,0,2,2]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[0,1,1,2],[0,2,1,3],[0,3,1,4]]),true).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[1,0,2,1],[2,0,3,1],[3,0,4,1]]),true).
:-assert_are_equal(isRectangleCover([[0,0,2,2],[1,1,3,3],[2,0,3,1],[0,3,3,4]]),false).
:-assert_are_equal(isRectangleCover([[0,0,3,1],[0,1,2,3],[1,0,2,1],[2,2,3,3]]),false).

:-assert_are_equal(isRectangleCover([[1,1,3,3],[2,2,4,4],[4,1,5,4],[1,3,2,4]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[0,0,2,1],[1,0,2,1],[0,2,2,3]]),false).
:-assert_are_equal(isRectangleCover([[0,0,2,1],[0,1,2,2],[0,2,1,3],[1,0,2,1]]),false).
:-assert_are_equal(isRectangleCover([[1,1,2,2],[0,1,1,2],[1,0,2,1],[0,2,3,3],[2,0,3,3]]),false).

:-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[6,2,8,3],[5,1,6,3],[6,0,7,2],[4,2,5,3],[2,1,4,3],[0,1,2,2],[0,2,2,3],[4,1,5,2],[5,0,6,1]]),false).
:-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[5,1,6,4],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),false).
:-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,3],[5,1,6,3],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),false).
:-assert_are_equal(isRectangleCover([[0,0,5,1],[7,0,8,2],[5,1,6,3],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[0,0,1,1],[0,2,1,3]]),false).
:-assert_are_equal(isRectangleCover([[0,0,3,3],[1,1,2,2],[1,1,2,2]]),false).
:-assert_are_equal(isRectangleCover([[1,1,4,4],[1,3,4,5],[1,6,4,7]]),false).
:-assert_are_equal(isRectangleCover([[0,0,3,1],[0,1,2,3],[2,0,3,1],[2,2,3,3]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[0,0,1,1],[1,1,2,2],[1,1,2,2]]),false).
:-assert_are_equal(isRectangleCover([[1,1,2,2],[1,1,2,2],[1,1,2,2],[2,1,3,2],[2,2,3,3]]),false).
:-assert_are_equal(isRectangleCover([[1,1,2,2],[2,1,3,2],[2,1,3,2],[2,1,3,2],[3,1,4,2]]),false).
:-assert_are_equal(isRectangleCover([[0,1,2,3],[0,1,1,2],[2,2,3,3],[1,0,3,1],[2,0,3,1]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[0,2,1,3],[1,1,2,2],[2,0,3,1],[2,2,3,3],[1,0,2,3],[0,1,3,2]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1],[2,2,3,3]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[0,1,1,2],[0,2,1,3],[1,0,2,1],[1,0,2,1],[1,2,2,3],[2,0,3,1],[2,1,3,2],[2,2,3,3]]),false).
:-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[5,1,6,3],[6,0,7,2],[2,1,4,3],[0,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1]]),false).
:-assert_are_equal(isRectangleCover([[0,0,4,1],[7,0,8,2],[5,1,6,3],[6,0,7,2],[4,0,5,1],[4,2,5,3],[2,1,4,3],[-1,2,2,3],[0,1,2,2],[6,2,8,3],[5,0,6,1],[4,1,5,2]]),false).
:-assert_are_equal(isRectangleCover([[0,0,1,1],[1,0,2,1],[1,0,3,1],[3,0,4,1]]),false).
:-assert_are_equal(isRectangleCover([[1,2,4,4],[1,0,4,1],[0,2,1,3],[0,1,3,2],[3,1,4,2],[0,3,1,4],[0,0,1,1]]),true).

И это еще не конец, задача из раздела "хард", в 41 тесте предлагают список из 10000 прямоугольников, во всех последних пяти тестах получаю такие времена в секундах:

test 41:length=10000
goal->ok:212/sec
test 42:length=3982
goal->ok:21/sec
test 43:length=10222
goal->ok:146/sec
test 44:length=10779
goal->ok:41/sec
test 45:length=11000
goal->ok:199/sec

Привести входящие значения не могу, в редактор они не помещаются, прикреплю вот так тест 41 ^[3].

Формулировка 2

Предыдущий подход, использовать список для накопления фигур, оказывается сильно неэффективным, какое напрашивается изменение — вместо сложности n^2 сделать n*log(n). Для проверки пересечений списка прямоугольников можно использовать дерево.
Бинарное дерево для Пролога, это также структурированный терм, и как список он рекурсивно определен, дерево оно пустое или содержит значение и два поддерева.
Использую для этого трехместный функтор: t(LeftTree, RootValue, RightTree), а пустое дерево будет [].
Простое дерево из чисел, с упорядочением слева меньшие, а справа большие, можно выразить вот так:

add_to_tree(X,[],t([],X,[])).
add_to_tree(X,t(L,Root,R),t(L,Root,NewR)):- X<Root,!,add_to_tree(X,R,NewR).
add_to_tree(X,t(L,Root,R),t(NewL,Root,R)):- add_to_tree(X,L,NewL).

В классической книге И.Братко "Программирование на языке Пролог для искусственного интеллекта" приведено множество реализаций деревьев 2-3, сбалансированные АВЛ…
Вопрос упорядочения прямоугольников предлагаю решать так: если прямоугольник находиться правее другого, то они не пересекаются, а те что левее надо проверять на пересечение. А правее, это когда правый угол одного меньше левого угла второго:

righter([X1,_,_,_],[_,_,X2,_]):-X1>X2.

И задача накопления фигур в дерево, плюс проверка на пересечение может выглядеть вот так, когда новый прямоугольник правее находящегося в корне, тогда проверять надо справа иначе проверять пересечения слева:

treechk(X,[],t([],X,[])).
treechk([X1,Y1,X2,Y2],t(L,[X1,Y11,X2,Y22],R),t(L,[X1,Yr,X2,Yr2],R)):- (Y1=Y22;Y2=Y11),!,Yr is min(Y1,Y11),Yr2 is max(Y2,Y22). %union
treechk(X,t(L,Root,R),t(L,Root,NewR)):- righter(X,Root),!,treechk(X,R,NewR).
treechk(X,t(L,Root,R),t(NewL,Root,R)):- not(cross(X,Root)),treechk(X,L,NewL).

Тут же учтена еще одну хитрость особенность, если прямоугольники совпадают по ширине, и имеют общую грань, то их можно объединить в один и не добавлять в дерево, а просто изменить в одном узле размер прямоугольника. К этому подталкивает тест 41, там такого вида данные: [[0,-1,1,0],[0,0,1,1],[0,1,1,2],[0,2,1,3],[0,3,1,4],[0,4,1,5],[0,5,1,6],[0,6,1,7],[0,7,1,8],[0,8,1,9],[0,9,1,10],[0,10,1,11],[0,11,1,12],[0,12,1,13],[0,13,1,14],...,[0,9998,1,9999]].

Эти усовершенствования соединим с предыдущим решением, привожу полностью, с некоторыми улучшениями:

treechk(X,[],t([],X,[])).
treechk([X1,Y1,X2,Y2],t(L,[X1,Y11,X2,Y22],R),t(L,[X1,Yr,X2,Yr2],R)):- (Y1=Y22;Y2=Y11),!,Yr is min(Y1,Y11),Yr2 is max(Y2,Y22). %union
treechk(X,t(L,Root,R),t(L,Root,NewR)):- righter(X,Root),!,treechk(X,R,NewR).
treechk(X,t(L,Root,R),t(NewL,Root,R)):- not(cross(X,Root)),treechk(X,L,NewL).

righter([X1,_,_,_],[_,_,X2,_]):-X1>X2.

findsum([],Sres,Sres,LConerRes,LConerRes,RConerRes,RConerRes,_).
findsum([[Lx,Ly,Rx,Ry]|T],Scur,Sres,LConerCur,LConerRes,RConerCur,RConerRes,RectTree):-
 coner(Lx:Ly,LConerCur,=<,LConerCur2),
 coner(Rx:Ry,RConerCur,>=,RConerCur2),
 Scur2 is Scur+abs(Rx-Lx)*abs(Ry-Ly),
 treechk([Lx,Ly,Rx,Ry],RectTree,RectTree2),!,
 findsum(T,Scur2,Sres,LConerCur2,LConerRes,RConerCur2,RConerRes,RectTree2).

isRectangleCover(Rects):-
    [[Lx,Ly,Rx,Ry]|_]=Rects,
    findsum(Rects,0,S,Lx:Ly,LconerX:LconerY,Rx:Ry,RconerX:RconerY,[]),!,
    S=:= abs(RconerX-LconerX)*abs(RconerY-LconerY).

coner(X1:Y1,X2:Y2,Dir,X1:Y1):-apply(Dir,[X1,X2]),apply(Dir,[Y1,Y2]),!.
coner(_,XY,_,XY).

cross(X,X):-!.
cross(X,Y):-cross2(X,Y),!.
cross(X,Y):-cross2(Y,X).

cross2([X11,Y11,X12,Y12],[_,_,X22,Y22]):-X11<X22,X22=<X12, Y11<Y22,Y22=<Y12,!.  %right-top
cross2([X11,Y11,X12,Y12],[X21,_,_,Y22]):-X11=<X21,X21<X12, Y11<Y22,Y22=<Y12,!.  %left-top
cross2([X11,Y11,X12,Y12],[_,Y21,X22,_]):-X11<X22,X22=<X12, Y11=<Y21,Y21<Y12,!.  %right-bottom
cross2([X11,Y11,X12,Y12],[X21,Y21,_,_]):-X11=<X21,X21<X12, Y11=<Y21,Y21<Y12.    %left-bottom

Вот такое время выполнения "тяжелых" тестов:

goal-true->ok:0/sec
41:length=10000
goal-true->ok:0/sec
42:length=3982
goal-true->ok:0/sec
43:length=10222
goal-true->ok:2/sec
44:length=10779
goal-false->ok:1/sec
45:length=11000
goal-true->ok:1/sec

На этом совершенствования закончу, все тесты проходят верно, время удовлетворительное. Кто заинтересовался, предлагаю попробовать онлайн ^[4] или тут ^[5].

Итого

Статьи связанные с функциональным программированием, с постоянной частотой встречаются на портале. Я затрагиваю, еще один аспект декларативного подхода — логическое программирование. Можно представлять задачи с помощью логического описания, есть факты и правила, посылки и следствия, отношения и рекурсивные отношения. Описание задачи нужно превратить в набор отношений ее описывающих. Результат — это следствие разложения проблемы на более простые составляющие.
Программой на декларативном языке, можно пользоваться как набором высказываний, которые должны сконструировать результат, решение задачи в ее удачной формулировке. А оптимизация может состоять, например, в том, что "беглое" описание способа контроля пересечений прямоугольников, может потребовать уточнения, доступно сконструировать древовидную структуру, для более эффективных вычислений.
И… куда-то пропал Prolog из стилей исходного кода, еще полгода назад я им пользовался. Пришлось указывать "родственный" Erlang. А не похоже ли это на "популярность", в списке нет и Фортрана с Бейсиком, что это рейтинг языков?

Автор: go-prolog

Источник ^[6]