Bonjour les travailleurs. Je ne retiendrai pas longtemps votre attention en expliquant l'approche déclarative, j'essaierai de proposer de résoudre un autre problème en utilisant le langage de programmation logique, comme option pour une vision déclarative de la formulation des problèmes et de leurs solutions.

Tâche 391. Rectangle parfait

Étant donné N rectangles alignés sur l'axe où N> 0, déterminez s'ils forment tous ensemble une couverture exacte d'une région rectangulaire.
Chaque rectangle est représenté comme un point inférieur gauche et un point supérieur droit. Par exemple, un carré unitaire est représenté par [1,1,2,2]. (la coordonnée du point inférieur gauche est (1, 1) et le point supérieur droit est (2, 2)).

Exemple 1: rectangles = [
[1,1,3,3],
[3,1,4,2],
[3,2,4,4],
[1,3,2,4],
[2,3,3,4]]
Retourne vrai. Les 5 rectangles forment ensemble une couverture exacte d'une région rectangulaire.
...
Exemple 3: rectangles =
[[1,1,3,3],
[3,1,4,2],
[1,3,2,4],
[3,2,4,4]]
Retour faux. Parce qu'il y a un écart au centre supérieur.

En pensant au libellé, le deuxième jour passe, ce n'est certainement pas une formation d'une semaine sur l'allumage des lampes vintage , mais je veux quand même présenter les résultats du travail sur la tâche. Il a fallu plusieurs tentatives pour résoudre tous les tests disponibles.

Les données initiales sont représentées par une liste, je vous rappelle brièvement, la liste est [Head | Tail], où Tail est une liste, également la liste est vide [] .

Nous formulons 1

Il est nécessaire de calculer l'aire totale de tous les rectangles, de trouver la taille maximale du rectangle les décrivant tous et de comparer ces deux sommes, si cela signifie que tous les rectangles couvrent uniformément l'aire. En même temps, vérifiez que les rectangles ne se coupent pas, nous ajouterons chaque nouveau rectangle à la liste, par condition, il ne doit pas se chevaucher et recouper tous les précédents.

Pour ce faire, j'utilise la récursivité de la queue (alias récursivité en descente), la manière la plus «impérative» de représenter un cycle. Dans un tel "cycle", nous trouvons immédiatement la somme totale des zones et les angles droit et gauche minimum du rectangle descriptif, parcourez, accumulez une liste générale de figures, vérifiez qu'il n'y a pas d'intersections.

Comme ça:

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]). 

Chez Prolog, les variables sont inconnues, elles ne peuvent pas être modifiées, elles sont vides ou ont une valeur, cela nécessite quelques variables, l'initiale et la résultante, lorsque nous arrivons à la fin de la liste, la valeur actuelle deviendra le résultat (la première ligne de la règle). Contrairement aux langues impératives, soutien Pour comprendre la ligne de programme, vous devez imaginer tout le chemin qui y a conduit, et toutes les variables peuvent avoir leur propre "historique" d'accumulation, là, chaque ligne du programme n'est que dans le contexte de la règle actuelle, tout l'état qui l'a affectée il y a règles d'entrée.

Donc:

 %   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). 

Ici, pour représenter l'angle, un «terme structuré» de la forme X: Y est utilisé, c'est l'occasion de combiner plusieurs valeurs en une structure, pour ainsi dire un tuple, seule n'importe quelle opération peut être un foncteur. Et l' écrêtage "!" Vous permet de ne pas spécifier de condition dans la deuxième ligne de la règle, c'est un moyen d'augmenter l'efficacité des calculs.

Et comme il s'est avéré, la chose la plus importante est de vérifier la non-intersection des rectangles, ils s'accumulent dans la liste:

 %    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 

L'intersection des rectangles, ce sont quatre options pour frapper le haut du premier à l'intérieur de l'autre.

Et la déclaration finale:

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

A l'entrée, une liste de chiffres, on prend le premier pour les valeurs initiales des coins gauche et droit, on fait le tour de chacun d'eux, en calculant la surface totale, et on vérifie les sommes obtenues. Je note que s'il y avait une intersection des rectangles, alors la recherche du montant "refuse", renvoie la "chute", cela signifie qu'il n'y a rien pour comparer les montants. La même chose se produit s'il n'y a pas un seul chiffre dans la liste d'entrée, il y aura un échec, il n'y a rien à vérifier ...

Ensuite, je lance cette implémentation sur des tests existants, et je cite les 40 premiers:

 %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). 

Et ce n'est pas la fin, la tâche de la section «difficile», dans 41 tests, ils proposent une liste de 10 000 rectangles, dans les cinq derniers tests que j'obtiens en quelques secondes:

 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 

Je ne peux pas apporter les valeurs d'entrée, elles ne rentrent pas dans l'éditeur, je vais attacher le test 41 comme ça.

Libellé 2

L'approche précédente, en utilisant la liste pour accumuler des chiffres, s'avère très inefficace, ce que le changement suggère lui-même - au lieu de la complexité n ^ 2, faites n * log (n). Vous pouvez utiliser l'arborescence pour vérifier les intersections de la liste des rectangles.

L'arbre binaire pour Prolog est également un terme structuré, et en tant que liste, il est défini de manière récursive, l' arbre est vide ou contient une valeur et deux sous-arbres .

J'utilise un triple foncteur pour cela: t (LeftTree, RootValue, RightTree), et l'arborescence vide sera [].

Un simple arbre de nombres, avec un ordre à gauche est plus petit et à droite est grand, peut être exprimé comme ceci:

 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). 

Dans le livre classique de I. Bratko "Programmation en prologue pour l'intelligence artificielle", de nombreuses réalisations d'arbres 2-3, équilibrées par AVL, sont données ...

Je propose de résoudre le problème de la commande des rectangles comme suit: si le rectangle est à droite de l'autre, alors ils ne se coupent pas, et ceux qui sont à gauche doivent être vérifiés pour l'intersection. Et à droite, c'est lorsque le coin droit de l'un est inférieur au coin gauche du second:

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

Et la tâche d'accumuler des chiffres dans un arbre, ainsi que de vérifier l'intersection peut ressembler à ceci, lorsqu'un nouveau rectangle est à droite de la racine, alors vous devez vérifier à droite, sinon vérifiez les intersections à gauche:

 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). 

Immédiatement pris en compte un autre tromper Si les rectangles ont la même largeur et ont une face commune, ils peuvent être combinés en un seul et non ajoutés à l'arborescence, mais modifiez simplement la taille du rectangle dans un nœud. Le test 41 pousse pour cela, là ces données sont: [[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]].

Nous combinons ces améliorations avec la solution précédente, je les donne complètement, avec quelques améliorations:

 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 

Voici le temps d'exécution des tests "lourds":

 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 

Je vais terminer cette amélioration, tous les tests passent correctement, le temps est satisfaisant. Qui sont intéressés, je vous suggère d'essayer en ligne ou ici .

Total

Les articles liés à la programmation fonctionnelle se trouvent sur le portail avec une fréquence constante. J'aborde un autre aspect de l'approche déclarative - la programmation logique. Vous pouvez représenter des tâches à l'aide d'une description logique, il existe des faits et des règles, des prémisses et des conséquences, des relations et des relations récursives. La description de la tâche doit être transformée en un ensemble de relations la décrivant. Le résultat est une conséquence de la décomposition du problème en composants plus simples.

Un programme dans un langage déclaratif peut être utilisé comme un ensemble d'instructions qui devraient construire un résultat, une solution à un problème dans sa formulation réussie. Et l'optimisation peut consister, par exemple, en ce qu'une description "superficielle" de la méthode de contrôle des intersections de rectangles peut nécessiter des éclaircissements, il est possible de construire une arborescence pour des calculs plus efficaces.

Et ... quelque part Prolog a disparu des styles du code source, il y a six mois je l'ai utilisé. Je devais spécifier une "soeur" Erlang. Mais n'est-ce pas comme la «popularité», Fortran et BASIC ne sont pas sur la liste, quelle est la note des langues?