Hola trabajadores No llamaré su atención por mucho tiempo explicando el enfoque declarativo, trataré de proponer resolver otro problema usando el lenguaje de programación lógico, como una opción para una visión declarativa de la formulación de problemas y sus soluciones.

Tarea 391. Rectángulo perfecto

Dados N rectángulos alineados al eje donde N> 0, determine si todos juntos forman una cubierta exacta de una región rectangular.
Cada rectángulo se representa como un punto inferior izquierdo y un punto superior derecho. Por ejemplo, un cuadrado unitario se representa como [1,1,2,2]. (la coordenada del punto inferior izquierdo es (1, 1) y el punto superior derecho es (2, 2)).

Ejemplo 1: rectángulos = [
[1,1,3,3]
[3,1,4,2]
[3,2,4,4]
[1,3,2,4]
[2,3,3,4]]
Vuelve verdadero. Los 5 rectángulos juntos forman una cubierta exacta de una región rectangular.
...
Ejemplo 3: rectángulos =
[[1,1,3,3]
[3,1,4,2]
[1,3,2,4]
[3,2,4,4]]
Devuelve falso. Porque hay un espacio en el centro superior.

Pensando en la redacción, el segundo día pasa, ciertamente este no es un entrenamiento de una semana para encender lámparas antiguas , pero aún quiero presentar los resultados del trabajo en la tarea. Se necesitaron varios intentos para resolver todas las pruebas disponibles.

Los datos iniciales están representados por una lista, les recuerdo brevemente, la lista es [Head | Tail], donde Tail es una lista, también la lista está vacía [] .

Formulamos 1

Es necesario calcular el área total de todos los rectángulos, encontrar el tamaño máximo del rectángulo describiéndolos a todos y comparar estas dos sumas, si eso significa que todos los rectángulos cubren el área de manera uniforme. Al mismo tiempo, verifique que los rectángulos no se crucen, agregaremos cada nuevo rectángulo a la lista, por condición, no debe superponerse e intersecar a todos los anteriores.

Para hacer esto, uso la recursión de la cola (también conocida como recursión en el descenso), la forma más "imperativa" de representar un ciclo. En uno de estos "ciclos", inmediatamente encontramos la suma total de las áreas y los ángulos mínimos izquierdo y máximo derecho del rectángulo descriptivo, caminata, acumulando una lista general de figuras, verificando que no haya intersecciones.

Así:

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

En Prolog, las variables son desconocidas, no se pueden cambiar, están vacías o tienen un valor, esto requiere un par de variables, la inicial y la resultante, cuando lleguemos al final de la lista, el valor actual se convertirá en el resultado (la primera línea de la regla). A diferencia de los lenguajes imperativos, para apoyo Para comprender la línea del programa, debe imaginar la ruta completa que lo condujo a ella, y todas las variables pueden tener su propio "historial" de acumulación, allí mismo, cada línea del programa solo en el contexto de la regla actual, todo el estado que la afectó. hay reglas de entrada

Entonces

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

Aquí, para representar el ángulo, se utiliza un "término estructurado" de la forma X: Y, es una oportunidad para combinar varios valores en una estructura, por así decir una tupla, solo cualquier operación puede ser un functor. Y recortar "!" Le permite no especificar una condición en la segunda línea de la regla, esta es una forma de aumentar la eficiencia de los cálculos.

Y como resultó más tarde, lo más importante es verificar la no intersección de los rectángulos, que se acumulan en la 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 

La intersección de los rectángulos, estas son cuatro opciones para golpear la parte superior del primero dentro del otro.

Y la declaración 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). 

En la entrada, una lista de figuras, tomamos el primero para los valores iniciales de las esquinas izquierda y derecha, los rodeamos a todos, calculamos el área total y verificamos las sumas obtenidas. Observo que si hubo una intersección de los rectángulos, entonces la búsqueda de la cantidad "se niega", devuelve la "caída", esto significa que no hay nada para comparar las cantidades. Lo mismo sucede si no hay una sola figura en la lista de entrada, habrá una falla, no hay nada que verificar ...

A continuación, ejecuto esta implementación en pruebas existentes, y cito los primeros 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). 

Y este no es el final, la tarea de la sección "difícil", en 41 pruebas ofrecen una lista de 10,000 rectángulos, en las últimas cinco pruebas obtengo esos tiempos en 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 

No puedo traer los valores de entrada, no encajan en el editor, adjuntaré la prueba 41 de esta manera.

Redacción 2

El enfoque anterior, que usa la lista para acumular cifras, resulta ser muy ineficaz, cuyo cambio se sugiere a sí mismo: en lugar de la complejidad n ^ 2, haga n * log (n). Puede usar el árbol para verificar las intersecciones de la lista de rectángulos.

El árbol binario para Prolog también es un término estructurado, y como una lista se define recursivamente, el árbol está vacío o contiene un valor y dos subárboles .

Utilizo un triple functor para esto: t (LeftTree, RootValue, RightTree), y el árbol vacío será [].

Un árbol simple de números, con un orden a la izquierda es más pequeño y a la derecha es grande, puede expresarse así:

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

En el libro clásico de I. Bratko "Programación en Prolog para la Inteligencia Artificial", se dan muchas realizaciones de los árboles 2-3, balanceados por AVL ...

Propongo resolver el problema de ordenar rectángulos de la siguiente manera: si el rectángulo está a la derecha del otro, entonces no se cruzan, y los que están a la izquierda deben verificarse para la intersección. Y a la derecha, esto es cuando la esquina derecha de una es menor que la esquina izquierda de la segunda:

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

Y la tarea de acumular figuras en un árbol, además de verificar la intersección puede verse así, cuando un nuevo rectángulo está a la derecha de la raíz, entonces debe verificar a la derecha, de lo contrario, verifique las intersecciones a la izquierda:

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

Inmediatamente tomado en cuenta otro truco característica, si los rectángulos son del mismo ancho y tienen una cara común, entonces se pueden combinar en uno y no agregarse al árbol, sino simplemente cambiar el tamaño del rectángulo en un nodo. La prueba 41 está presionando para esto, allí los datos son: [[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 estas mejoras con la solución anterior, las doy por completo, con algunas mejoras:

 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 

Aquí está el tiempo de ejecución de las pruebas "pesadas":

 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 

Terminaré esta mejora, todas las pruebas pasan correctamente, el tiempo es satisfactorio. Quienes estén interesados, le sugiero que pruebe en línea o aquí .

Total

Los artículos relacionados con la programación funcional se encuentran en el portal con una frecuencia constante. Toco otro aspecto del enfoque declarativo: la programación lógica. Puede representar tareas utilizando una descripción lógica, hay hechos y reglas, premisas y consecuencias, relaciones y relaciones recursivas. La descripción de la tarea debe convertirse en un conjunto de relaciones que la describan. El resultado es una consecuencia de la descomposición del problema en componentes más simples.

Un programa en un lenguaje declarativo puede usarse como un conjunto de declaraciones que deberían construir un resultado, una solución a un problema en su formulación exitosa. Y la optimización puede consistir, por ejemplo, en que una descripción "superficial" del método para controlar las intersecciones de rectángulos puede requerir aclaración; es posible construir una estructura de árbol para cálculos más eficientes.

Y ... en algún lugar Prolog desapareció de los estilos del código fuente, hace medio año lo usé. Tuve que especificar una "hermana" Erlang. Pero no es esto como "popularidad", Fortran y BASIC no están en la lista, ¿cuál es la calificación de los idiomas?