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

Задача 391. Perfect Rectangle

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.

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

Формулируем 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.

Формулировка 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

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

Итого

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

Автор: go-prolog

Источник