Olá trabalhadores. Não vou prender sua atenção por um longo tempo, explicando a abordagem declarativa, tentarei propor mais um problema usando a linguagem de programação lógica, como uma opção para uma análise declarativa da formulação de problemas e suas soluções.

Tarefa 391. Retângulo Perfeito

Dado N retângulos alinhados ao eixo onde N> 0, determine se todos juntos formam uma cobertura exata de uma região retangular.
Cada retângulo é representado como um ponto inferior esquerdo e um ponto superior direito. Por exemplo, um quadrado de unidade é representado como [1,1,2,2]. (a coordenada do ponto inferior esquerdo é (1, 1) e o ponto superior direito é (2, 2)).

Exemplo 1: retângulos = [
[1,1,3,3]
[3,1,4,2]
[3,2,4,4]
[1,3,2,4]
[2,3,3,4]]
Retorne verdadeiro. Todos os 5 retângulos juntos formam uma cobertura exata de uma região retangular.
...
Exemplo 3: retângulos =
[[1,1,3,3]
[3,1,4,2]
[1,3,2,4]
[3,2,4,4]]
Retorne falso. Porque existe uma lacuna no centro superior.

Pensando na redação, o segundo dia passa, esse certamente não é um treinamento de uma semana para acender lâmpadas vintage , mas ainda quero apresentar os resultados do trabalho na tarefa. Foram necessárias várias tentativas para resolver todos os testes disponíveis.

Os dados iniciais são apresentados por uma lista, lembro-lhe brevemente, a lista é [Head | Tail], onde Tail é uma lista, também a lista está vazia [] .

Nós formulamos 1

É necessário calcular a área total de todos os retângulos, encontrar o tamanho máximo do retângulo descrevendo todos eles e comparar essas duas somas, se isso significa que todos os retângulos cobrem a área de maneira uniforme. Ao mesmo tempo, verifique se os retângulos não se cruzam, vamos adicionar cada novo retângulo à lista, por condição, não deve se sobrepor e cruzar todos os anteriores.

Para fazer isso, eu uso a recursão da cauda (também conhecida como recursão na descida), a maneira mais "imperativa" de representar um ciclo. Em um desses "ciclos", encontramos imediatamente a soma total das áreas e os ângulos mínimos esquerdo e direito do retângulo descritivo, caminhada, acumulando uma lista geral de figuras, verificando se não há interseções.

Assim:

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

No Prolog, as variáveis ​​são desconhecidas, não podem ser alteradas, estão vazias ou têm um valor, isso requer algumas variáveis, a inicial e a resultante, quando chegarmos ao final da lista, o valor atual se tornará o resultado (a primeira linha da regra). Diferente das linguagens imperativas, por apoio Para entender a linha do programa, você precisa imaginar todo o caminho que levou a ela, e todas as variáveis ​​podem ter seu próprio "histórico" de acumulação, bem ali, cada linha do programa está apenas no contexto da regra atual, todo o estado que a afetou existe regras de entrada.

Então:

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

Aqui, para representar o ângulo, um "termo estruturado" da forma X: Y é usado, é uma oportunidade de combinar vários valores em uma estrutura, por assim dizer uma tupla, apenas qualquer operação pode ser um functor. E recorte "!" Permite que você não especifique uma condição na segunda linha da regra; é uma maneira de aumentar a eficiência dos cálculos.

E, como se viu, o mais importante é verificar a não interseção dos retângulos, que se acumulam na lista:

 %    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 

A interseção de retângulos, são quatro opções para atingir o topo do primeiro dentro do outro.

E a declaração final:

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

Na entrada, uma lista de figuras, pegamos o primeiro para os valores iniciais dos cantos esquerdo e direito, contornamos todos eles, calculamos a área total e verificamos as somas obtidas. Observo que, se houve uma interseção dos retângulos, a busca pelo valor "recusa" retorna a "queda", isso significa que não há nada para comparar os valores. O mesmo acontece se não houver uma única figura na lista de entrada, haverá uma falha, não há nada para verificar ...

Em seguida, eu executo essa implementação nos testes existentes e cito os primeiros 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). 

E este não é o fim, a tarefa da seção "difícil": em 41 testes, eles oferecem uma lista de 10.000 retângulos. Nos últimos cinco testes, recebo esse tempo em segundos:

 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 

Não consigo trazer os valores de entrada, eles não se encaixam no editor, anexarei o teste 41 assim.

Redação 2

A abordagem anterior, usando a lista para acumular números, acaba sendo muito ineficaz, cuja mudança sugere a si mesma - em vez da complexidade n ^ 2, faça n * log (n). Você pode usar a árvore para verificar as interseções da lista de retângulos.

A árvore binária do Prolog também é um termo estruturado e, como uma lista definida recursivamente, a árvore está vazia ou contém um valor e duas subárvores .

Eu uso um functor triplo para isso: t (LeftTree, RootValue, RightTree), e a árvore vazia será [].

Uma simples árvore de números, com ordenação à esquerda é menor e à direita é grande, pode ser expressa assim:

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

No livro clássico de I. Bratko "Programação em Prolog para Inteligência Artificial", muitas realizações de árvores 2-3, equilibradas por AVL, são dadas ...

Proponho resolver a questão de ordenar retângulos da seguinte forma: se o retângulo estiver à direita do outro, eles não se intersectam e os que estão à esquerda devem ser verificados quanto à interseção. E à direita, é quando o canto direito de um é menor que o canto esquerdo do segundo:

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

E a tarefa de acumular figuras em uma árvore, além de verificar se há interseção, pode parecer assim, quando um novo retângulo está à direita da raiz, é necessário verificar à direita, caso contrário, verifique as interseções à esquerda:

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

Considerado imediatamente outro truque recurso, se os retângulos tiverem a mesma largura e tiverem uma face comum, eles poderão ser combinados em um e não adicionados à árvore, mas simplesmente altere o tamanho do retângulo em um nó. O teste 41 está pressionando para isso, existem esses dados: [[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]].

Combinamos essas melhorias com a solução anterior, eu as dou completamente, com algumas melhorias:

 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 

Aqui está o tempo de execução dos testes "pesados":

 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 

Termino essa melhoria, todos os testes passam corretamente, o tempo é satisfatório. Quem estiver interessado, sugiro que tente online ou aqui .

Total

Os artigos relacionados à programação funcional são encontrados no portal com uma frequência constante. Eu toco em outro aspecto da abordagem declarativa - programação lógica. Você pode representar tarefas usando uma descrição lógica, existem fatos e regras, premissas e conseqüências, relacionamentos e relacionamentos recursivos. A descrição da tarefa deve ser transformada em um conjunto de relações que a descrevem. O resultado é uma conseqüência da decomposição do problema em componentes mais simples.

Um programa em uma linguagem declarativa pode ser usado como um conjunto de instruções que devem construir um resultado, uma solução para um problema em sua formulação bem-sucedida. E a otimização pode consistir, por exemplo, no fato de que uma descrição "superficial" do método para controlar interseções de retângulos pode exigir esclarecimentos; é possível construir uma estrutura em árvore para cálculos mais eficientes.

E ... em algum lugar, o Prolog desapareceu dos estilos do código-fonte, há meio ano eu o usei. Eu tive que especificar uma "irmã" Erlang. Mas isso não é como "popularidade", Fortran e BASIC não estão na lista, qual é a classificação dos idiomas?