Tema 5: Programación lógica de orden superior

• assert(+Term) inserta un hecho o una cláusula en la base de conocimientos. Term es insertado como última cláusula del predicado correspondiente.
• retract(+Term) elimina la primera cláusula de la base de conocimientos que unifica con Term.

• Ejemplos:

  ?- dynamic hace_frío/0.
  true.
  
  ?- hace_frío.
  false.
  
  ?- assert(hace_frío).
  true.
  
  ?- hace_frío.
  true.
  
  ?- retract(hace_frío).
  true.
  
  ?- hace_frío.
  false.
  

• listing(+Pred) lista las cláusulas en cuya cabeza aparece el predicado Pred. Por ejemplo,

  ?- assert((gana(X,Y) :- rápido(X), lento(Y))).
  true.
  
  ?- listing(gana).
  :- dynamic gana/2.
  
  gana(A, B) :-
      rápido(A),
      lento(B).
  
  true.
  
  ?- assert(rápido(juan)), assert(lento(jose)), assert(lento(luis)).
  true.
  
  ?- gana(X,Y).
  X = juan,
  Y = jose ;
  X = juan,
  Y = luis.
  
  ?- retract(lento(X)).
  X = jose ;
  X = luis.
  
  ?- gana(X,Y).
  false.
  

• asserta(+Term) equivale a assert/1, pero Term es insertado como primera cláusula del predicado correspondiente.
• assertz(+Term) equivale a assert/1.

• Ejemplos:

  ?- assert(p(a)), assertz(p(b)), asserta(p(c)).
  true.
  
  ?- p(X).
  X = c ;
  X = a ;
  X = b.
  
  ?- listing(p).
  :- dynamic p/1.
  
  p(c).
  p(a).
  p(b).
  
  true.
  

• retractall(+C) elimina de la base de conocimientos todas las cláusulas cuya cabeza unifica con C.
• abolish(+SimbPred/+Aridad) elimina de la base de conocimientos todas las cláusulas que en su cabeza aparece el símbolo de predicado SimbPred/Aridad.

• Ejemplos:

  ?- assert(p(a)), assert(p(b)).
  true.
  
  ?- retractall(p(_)).
  true.
  
  ?- p(a).
  false.
  
  ?- assert(p(a)), assert(p(b)).
  true.
  
  ?- abolish(p/1).
  true.
  
  ?- p(a).
  ERROR: Unknown procedure: p/1 (DWIM could not correct goal)
  

• crea_tabla añade los hechos producto(X,Y,Z) donde X e Y son números de 0 a 9 y Z es el producto de X e Y. Por ejemplo,

  ?- crea_tabla.
  Yes
  ?- listing(producto).
  producto(0,0,0).
  producto(0,1,0).
  ...
  producto(9,8,72).
  producto(9,9,81).
  Yes
  

  Su definición es (tabla_de_multiplicar.pl).

  crea_tabla :-
     L = [0,1,2,3,4,5,6,7,8,9],
     member(X,L),
     member(Y,L),
     Z is X*Y,
     assert(producto(X,Y,Z)),
     fail.
  crea_tabla.
  

• Consulta: Determinar las descomposiciones de 6 en producto de dos números.

  ?- producto(A,B,6).
  A = 1,
  B = 6 ;
  A = 2,
  B = 3 ;
  A = 3,
  B = 2 ;
  A = 6,
  B = 1.
  

• findall(T,O,L) se verifica si L es la lista de las instancias del término T que verifican el objetivo O. Por ejemplo,

  ?- assert(clase(a,voc)), assert(clase(b,con)),
     assert(clase(e,voc)), assert(clase(c,con)).
  true.
  
  ?- findall(X,clase(X,voc),L).
  L = [a, e].
  
  ?- findall(_X,clase(_X,_Clase),L).
  L = [a, b, e, c].
  
  ?- findall(X,clase(X,vocal),L).
  L = [].
  
  ?- findall(X,(member(X,[c,b,c]),member(X,[c,b,a])),L).
  L = [c, b, c].
  
  ?- findall(X,(member(X,[c,b,c]),member(X,[1,2,3])),L).
  L = [].
  

• setof(T,O,L) se verifica si L es la lista ordenada sin repeticiones de las instancias del término T que verifican el objetivo O. Por ejemplo,

  ?- setof(X,clase(X,Clase),L).
  Clase = con,
  L = [b, c] ;
  Clase = voc,
  L = [a, e].
  
  ?- setof(X,Y^clase(X,Y),L).
  L = [a, b, c, e].
  
  ?- setof(X,clase(X,vocal),L).
  false.
  
  ?- setof(X,(member(X,[c,b,c]),member(X,[c,b,a])),L).
  L = [b, c].
  
  ?- setof(X,(member(X,[c,b,c]),member(X,[1,2,3])),L).
  false.
  

• bagof(T,O,L) se verifica si L es el multiconjunto de las instancias del término T que verifican el objetivo O. Por ejemplo,

  ?- bagof(X,clase(X,Clase),L).
  Clase = con,
  L = [b, c] ;
  Clase = voc,
  L = [a, e].
  
  ?- bagof(X,Y^clase(X,Y),L).
  L = [a, b, e, c].
  
  ?- bagof(X,clase(X,vocal),L).
  false.
  
  ?- bagof(X,(member(X,[c,b,c]),member(X,[c,b,a])),L).
  L = [c, b, c].
  
  ?- bagof(X,(member(X,[c,b,c]),member(X,[1,2,3])),L).
  false.
  

• Nota: El código del programa que se desarrollará en esta sección se encuentra en conjuntos.pl.

• setof0(T,0,L) es como setof salvo en el caso en que ninguna instancia de T verifique O, en cuyo caso L es la lista vacía. Por ejemplo,

  ?- setof0(X, (member(X,[c,a,b]),member(X,[c,b,d])), L).
  L = [b, c].
  
  ?- setof0(X, (member(X,[c,a,b]),member(X,[e,f])), L).
  L = [].
  

  Su definición es

  setof0(X,O,L) :- setof(X,O,L), !.
  setof0(_,_,[]).
  

• intersección(S,T,U) se verifica si U es la intersección de S y T. Por ejemplo,

  ?- intersección([1,4,2],[2,3,4],U).
  U = [2,4].
  

  Su definición es

  intersección(S,T,U) :-
     setof0(X, (member(X,S), member(X,T)), U).
  

• unión(S,T,U) se verifica si U es la unión de S y T. Por ejemplo,

  ?- unión([1,2,4],[2,3,4],U).
  U = [1, 2, 3, 4].
  

  Su definición es

  unión(S,T,U) :-
     setof(X, (member(X,S); member(X,T)), U).
  

• diferencia(S,T,U) se verifica si U es la diferencia de los conjuntos de S y T. Por ejemplo,

  ?- diferencia([5,1,2],[2,3,4],U).
  U = [1, 5].
  

  Su definición es

  diferencia(S,T,U) :-
     setof0(X,(member(X,S),not(member(X,T))),U).
  

• subconjunto(-L1,+L2) se verifica si L1 es un subconjunto de L2. Por ejemplo,

  ?- subconjunto(L,[a,b]).
  L = [a, b] ;
  L = [a] ;
  L = [b] ;
  L = [].
  

  Su definición es

  subconjunto([],[]).
  subconjunto([X|L1],[X|L2]) :-
     subconjunto(L1,L2).
  subconjunto(L1,[_|L2]) :-
     subconjunto(L1,L2).
  

• subconjuntos(X,L) se verifica si L es el conjunto de las subconjuntos de X. Por ejemplo, Por ejemplo,

  ?- subconjuntos([a,b,c],L).
  L = [[], [a], [a, b], [a, b, c], [a, c], [b], [b, c], [c]].
  

  Su definición es

  subconjuntos(X,L) :-
     setof(Y,subconjunto(Y,X),L).
  

• ?T =.. ?L se verifica si L es una lista cuyo primer elemento es el functor del término T y los restantes elementos de L son los argumentos de T. Por ejemplo,

  ?- padre(juan,luis) =.. L.
  L = [padre, juan, luis].
  
  ?- T =.. [padre, juan, luis].
  T = padre(juan,luis).
  

• alarga(+F1,+N,-F2) se verifica si F1 y F2 son figuras geométricas del mismo tipo y el tamaño de la F1 es el de la F2 multiplicado por N, donde las figuras geométricas se representan como términos en los que el functor indica el tipo de figura y los argumentos su tamaño. Por ejemplo,

  ?- alarga(triángulo(3,4,5),2,F).
  F = triángulo(6, 8, 10).
  
  ?- alarga(cuadrado(3),2,F).
  F = cuadrado(6).
  

  Su definición (que está en alarga.pl) es

  alarga(Figura1,Factor,Figura2) :-
     Figura1 =.. [Tipo|Arg1],
     multiplica_lista(Arg1,Factor,Arg2),
     Figura2 =.. [Tipo|Arg2].
  
  multiplica_lista([],_,[]).
  multiplica_lista([X1|L1],F,[X2|L2]) :-
     X2 is X1*F,
     multiplica_lista(L1,F,L2).
  

• functor(T,F,A) se verifica si F es el functor del término T y A es su aridad.
• arg(N,T,A) se verifica si A es el argumento del término T que ocupa el lugar N.

• Ejemplo:

  ?- functor(g(b,c,d),F,A).
  F = g,
  A = 3.
  
  ?- functor(T,g,2).
  T = g(_8362, _8364).
  
  ?- arg(2,g(b,c,d),X).
  X = c.
  
  ?- functor(T,g,3), arg(1,T,b),arg(2,T,c).
  T = g(b, c, _1542).
  

• name(A,L) se verifica si L es la lista de códigos ASCII de los caracteres del átomo A. Por ejemplo,

  ?- name(bandera,L).
  L = [98, 97, 110, 100, 101, 114, 97].
  
  ?- name(A,[98, 97, 110, 100, 101, 114, 97]).
  A = bandera.
  

• concatena_átomos(A1,A2,A3) se verifica si A3 es la concatenación de los átomos A1 y A2. Por ejemplo,

  ?- concatena_átomos(pi,ojo,X).
  X = piojo
  

  Su definición (que está en concatena_atomos.pl) es

  concatena_átomos(A1,A2,A3) :-
     name(A1,L1),
     name(A2,L2),
     append(L1,L2,L3),
     name(A3,L3).
  

• apply(T,L) se verifica si es demostrable T después de aumentar el número de sus argumentos con los elementos de L; por ejemplo,

  ?- plus(2,3,X).
  X = 5.
  
  ?- apply(plus,[2,3,X]).
  X = 5.
  
  ?- apply(plus(2),[3,X]).
  X = 5.
  
  ?- apply(plus(2,3),[X]).
  X = 5.
  
  ?- apply(append([1,2]),[X,[1,2,3,4,5]]).
  X = [3, 4, 5].
  

• Definición de apply:

  n_apply(Término,Lista) :-
     Término =.. [Pred|Arg1],
     append(Arg1,Lista,Arg2),
     Átomo =.. [Pred|Arg2],
     Átomo.
  

• maplist(P,L1,L2) se verifica si se cumple el predicado P sobre los sucesivos pares de elementos de las listas L1 y L2; por ejemplo,

  ?- succ(2,X).
  X = 3.
  
  ?- succ(X,3).
  X = 2.
  
  ?- maplist(succ,[2,4],[3,5]).
  true.
  
  ?- maplist(succ,[0,4],[3,5]).
  false.
  
  ?- maplist(succ,[2,4],Y).
  Y = [3, 5].
  
  ?- maplist(succ,X,[3,5]).
  X = [2, 4].
  

• Definición de maplist:

  n_maplist(_,[],[]) :- !.
  n_maplist(R,[X1|L1],[X2|L2]) :-
     apply(R,[X1,X2]),
     n_maplist(R,L1,L2).
  

• T1 = T2 se verifica si T1 y T2 son unificables.
• T1 == T2 se verifica si T1 y T2 son idénticos.
• T1 \== T2~ se verifica si T1 y T2 no son idénticos.

• Ejemplos:

  ?- f(X) = f(Y).
  X = Y.
  
  ?- f(X) == f(Y).
  false.
  
  ?- f(X) == f(X).
  true.
  
  ?- f(X) \== f(X).
  false.
  

• cuenta(A,L,N) se verifica si N es el número de ocurrencias del átomo A en la lista L. Por ejemplo,

  ?- cuenta(a,[a,b,a,a],N).
  N = 3.
  
  ?- cuenta(a,[a,b,X,Y],N).
  N = 1.
  

  Su definición (que está en cuenta.pl) es:

  cuenta(_,[],0) :- !.
  cuenta(A,[B|L],N) :-
     A == B, !,
     cuenta(A,L,M),
     N is M+1.
  cuenta(A,[_B|L],N) :-
     % A \== _B,
     cuenta(A,L,N).
  

• T1 @< T2 se verifica si el término T1 es anterior que T2 en el orden de términos de Prolog.

  ?- ab @< ac.
  true.
  
  ?- 21 @< 123.
  true.
  
  ?- 12 @< a.
  true.
  
  ?- g @< f(b).
  true.
  
  ?- f(b) @< f(a,b).
  true.
  
  ?- [a,1] @< [a,3].
  true.
  

• sort(+L1,-L2) se verifica si L2 es la lista obtenida ordenando de manera creciente los distintos elementos de L1 y eliminando las repeticiones.

  ?- sort([c4,2,a5,2,c3,a5,2,a5],L).
  L = [2, a5, c3, c4].
  

Ejercicio 1. Definir la relación divisores(+N,-L) que se verifica si L es la lista de los divisores del número N. Por ejemplo,

?- divisores(24,L).
L = [1, 2, 3, 4, 6, 8, 12, 24].

Solución

divisores(N,L) :-
   findall(X,((between(1,N,X), N mod X =:= 0)),L).

Ejercicio 2. En los apartados de este ejercicio se darán distintas definiciones de la relación primo(+N) que se verifica si N es un número primo. Por ejemplo,

?- primo(7).
Yes
?- primo(9).
No

Ejercicio 2.1. Definir primo(X) que se verifica si el número de divisores de X es menor que 3 [Usar la definición anterior de ~divisores~].

Solución

primo(X) :-
   divisores(X,L),
   length(L,N),
   N < 3.

Ejercicio 2.2. Definir primo(X)4 que se verifica si no hay ningún número entre 2 y la raiz cuadrada de ~X que sea un divisor de X.

Solución

primo_2(X) :-
   Y is floor(sqrt(X)),
   not((between(2,Y,Z), X mod Z =:= 0)).

Ejercicio 2.3. Definir primo(X) que se verifica si no hay ningún número entre 2 y la raiz cuadrada de X que sea primo y divida a X.

Solución

primo_3(X) :-
   Y is floor(sqrt(X)),
   not((between(2,Y,Z), primo_3(Z), X mod Z =:= 0)).

La comparación de eficiencia es

?- time(primo(15485867)).
% 30,971,750 inferences, 2.074 CPU in 2.075 seconds (100% CPU, 14929796 Lips)
true.

?- time(primo_2(15485867)).
% 7,872 inferences, 0.003 CPU in 0.003 seconds (100% CPU, 2948049 Lips)
true.

?- time(primo_3(15485867)).
% 589,106 inferences, 0.085 CPU in 0.085 seconds (100% CPU, 6947773 Lips)
true.

Ejercicio 3.1. Se considera el siguiente polinomio p(X)=X^2-X+41. Definir la relación genera_primo(+X,+Y,-L) que se verifica si L es el conjunto de los pares (A,p(A)) tales A es un número del intervalo [X,Y] y p(A) es primo. Por ejemplo,

?- genera_primo(5,7,L).
L = [[5, 61], [6, 71], [7, 83]].

Solución

genera_primo(X,Y,L) :-
   findall([A,B],((between(X,Y,A), B is A^2-A+41, primo(B))),L).

Ejercicio 3.2. Comprobar que p(A) es primo para A desde 1 hasta 40, pero no es primo para A=41.

Solución

?- genera_primo(1,40,_L), length(_L,40).
true.

?- genera_primo(41,41,L).
L = [].

Ejercicio 4.1. Definir la relación divisores_propios(+N,-L) que se verifique si L es la lista ordenada de los divisores propios del número N. Por ejemplo,

?- divisores_propios(42,L).
L = [1, 2, 3, 6, 7, 14, 21] 

Solución

divisores_propios(N,L) :-
   N1 is N -1,
   findall(X,(between(1,N1,X), 0 =:= N mod X),L).

Ejercicio 4.2. Se dice que dos números X e Y son amigos cuando X es igual a la suma de los divisores de Y (exceptuando al propio Y) y viceversa. Por ejemplo, 6 es amigo de sí mismo puesto que los divisores de 6 (exceptuando al 6) son 1, 2 y 3 y 6=1+2+3. Igualmente 28 es amigo de sí mismo, puesto que 28=1+2+4+7+14.

Definir la relación amigos(+A,+B,-L) que se verifica si L es la lista de las parejas de números amigos comprendidos entre A y B4, con ~A menor o igual que B. Por ejemplo,

?- amigos(1,2000,L).
L = [6-6, 28-28, 220-284, 496-496, 1184-1210].

Solución

amigos(A,B,L) :-
   findall(X-Y, ((between(A,B,X),
                  divisores_propios(X,Dx),
                  sumlist(Dx,Y),
                  between(X,B,Y),
                  divisores_propios(Y,Dy),
                  sumlist(Dy,X))),
           L).

Ejercicio 5. Definir la relación lista_a_conjunto(+L,-C) que se verifica si C es el conjunto de los elementos de la lista no vacía L. Por ejemplo,

?- lista_a_conjunto([b,c,d,a,c,f,a],C).
C = [a, b, c, d, f]

Solución

lista_a_conjunto(L,C) :-
   setof(X,member(X,L),C).

Ejercicio 6. Definir la relación para_todos(+P,+L) que se verifica si todos los elementos de la lista L cumplen la propiedad P. Por ejemplo,

?- para_todos(number,[1,2,3]).
true
?- para_todos(number,[1,2,3,a]).
false.

Solución

para_todos(_,[]).
para_todos(P,[X|L]) :-
   apply(P,[X]),
   para_todos(P,L).

Ejercicio 7. Definir la relación existe(+P,+L) que se verifica si existe algún elemento de la lista L que cumple la propiedad P. Por ejemplo,

?- existe(number,[a,b,c]).
false.
?- existe(number,[a,1,b,c]).
true.

Solución

existe(P,[X|_]) :-
   apply(P,[X]), !.
existe(P,[_|L]) :-
   existe(P,L).

Ejercicio 8. Definir la relación sublista(+P,+L1,?L2) que se verifica si L2 es la lista de los elementos de L1 que verifican la propiedad P. Por ejemplo,

?- sublista(number,[1,a,2,b,1],L).
L = [1, 2, 1]

Nota: La relación predefinida correspondiente a sublista es include.

1ª solución

sublista(_P,[],[]).
sublista(P,[X|L1],[X|L2]) :-
   Q =.. [P,X],
   Q,
   sublista(P,L1,L2).
sublista(P,[X|L1],L2) :-
   Q =.. [P,X],
   \+ Q,
   sublista(P,L1,L2).

2ª solución

sublista_2(_P,[],[]).
sublista_2(P,[X|L1],[X|L2]) :-
   Q =.. [P,X],
   Q, !,
   sublista_2(P,L1,L2).
sublista_2(P,[_X|L1],L2) :-
   % Q =.. [P,_X],
   % \+ Q,
   sublista_2(P,L1,L2).

3ª solución

sublista_3(P,L1,L2) :-
   findall(X,(member(X,L1),apply(P,[X])),L2).

4ª solución

sublista_4(_,[],[]).
sublista_4(P,[X|Xs],Ys) :-
   (   call(P, X)
   ->  Ys = [X | Zs]
   ;   Ys = Zs
   ),
   sublista_4(P, Xs, Zs).

Ejercicio 9. Definir la relación rotaciones(L1,L2) que se verifica si L2 es la lista cuyos elementos son las listas formadas por las sucesivas rotaciones de los elementos de la lista L1. Por ejemplo,

?- rotaciones([1,2,3,4],L).
L = [[1, 2, 3, 4], [2, 3, 4, 1], [3, 4, 1, 2], [4, 1, 2, 3]].
?- rotaciones([2,3,4,1],L).
L = [[2, 3, 4, 1], [3, 4, 1, 2], [4, 1, 2, 3], [1, 2, 3, 4]].

1ª solución

rotaciones(L1,L2) :-
   findall(L,es_rotacion(L1,L),L2).

es_rotacion(L1,L2)  :-
   append(L3,[X|L4],L1),
   append([X|L4],L3,L2).

2ª solución

rotaciones_2(L1,L2) :-
   findall(L,
           (append(L3,[X|L4],L1),append([X|L4],L3,L)),
           L2).

Ejercicio 10. Definir la relación capicúas(N,L) que se verifica si L es la listas de los números enteros positivos capicúa menores que N. Por ejemplo,

?- capicúas(100,L).
L = [1, 2, 3, 4, 5, 6, 7, 8, 9|...].

?- set_prolog_flag(answer_write_options, [quoted(true), portray(true), max_depth(100)]).
true.

?- capicúas(100,L).
L = [1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99].

Solución

capicúas(N,L) :-
   setof(X,(between(1,N,X),es_capicúa(X)),L).

es_capicúa(N) :-
   name(N,L),
   reverse(L,L).

Ejercicio 11. Definir la relación invierte_palabra(P1,P2) que se verifica si P2 es la palabra formada invirtiendo el orden de las letras de P1. Por ejemplo,

?- invierte_palabra(arroz,P).
P = zorra.

Solución

invierte_palabra(P1,P2) :-
    name(P1,L1),
    reverse(L1,L2),
    name(P2,L2).

Ejercicio 12. Definir la relación factorial_inverso(+X,-N) que se verifique si X es el factorial de N. Por ejemplo,

?- factorial_inverso(120,N).
N = 5 ;
false.
?- factorial_inverso(80,N).
false.

1ª solución

factorial_inverso_1(X,N) :-
   factorial_inverso_1_aux(X,1,N).

• factorial_inverso_1_aux(+X,+A,-N) se verifica si N es el menor número mayor o igual que A cuyo factorial es X.

  factorial_inverso_1_aux(X,A,A) :-
     factorial(A,X).
  factorial_inverso_1_aux(X,A,N) :-
     factorial(A,N1),
     N1 < X,
     A1 is A + 1,
     factorial_inverso_1_aux(X,A1,N).
  

• factorial(+N,-X) se verifica si X es el factorial de N.

  factorial(1,1).
  factorial(N,X) :-
     N > 1,
     N1 is N-1,
     factorial(N1,X1),
     X is X1 * N.
  

2ª solución (con memorización)

factorial_inverso_2(X,N) :-
   factorial_inverso_2_aux(X,1,N).

• factorial_inverso_2_aux(+X,+A,-N) se verifica si N es el menor número mayor o igual que A cuyo factorial (con memoria) es X.

  factorial_inverso_2_aux(X,A,A) :-
     factorial_con_memoria(A,X).
  factorial_inverso_2_aux(X,A,N) :-
     factorial_con_memoria(A,N1),
     N1 < X,
     C1 is A + 1,
     factorial_inverso_2_aux(X,C1,N).
  

• factorial_con_memoria(+N,-X) se verifica si X es el factorial de N. Además almacena en la base de datos internas los factoriales calculados.

  :- dynamic factorial_con_memoria/2.
  
  factorial_con_memoria(1,1).
  factorial_con_memoria(N,X) :-
     N > 1,
     N1 is N-1,
     factorial_con_memoria(N1,X1),
     X is X1 * N,
     asserta(factorial_con_memoria(N,X) :- !).
  

3ª solución (con dos acumuladores)

factorial_inverso_3(X,N) :-
   factorial_inverso_aux_3(X,1,1,N).

• factorial_inverso_aux_3(+X,+A,+F,-N) se verifica si X = A*(A+1)*...*N (de forma que si A = 1 entonces X = N!).

  factorial_inverso_aux_3(X,A,F,A) :-
     A*F =:= X.
  factorial_inverso_aux_3(X,A,F,N) :-
     F1 is A*F,
     F1 < X, !,
     A1 is A + 1,
     factorial_inverso_aux_3(X,A1,F1,N).
  

Comparación de eficiencia

La comparación es

?- factorial(2000,_X), time(factorial_inverso_1(_X,_N)).
% 11,997,999 inferences, 2.921 CPU in 2.925 seconds (100% CPU, 4106828 Lips)
true 
?- factorial(2000,_X), time(factorial_inverso_2(_X,_N)).
% 13,993 inferences, 0.004 CPU in 0.004 seconds (100% CPU, 3832958 Lips)
true 
?- factorial(2000,_X), time(factorial_inverso_3(_X,_N)).
% 7,997 inferences, 0.009 CPU in 0.009 seconds (100% CPU, 877368 Lips)
true 

?- factorial(4000,_X), time(factorial_inverso_2(_X,_N)).
% 35,993 inferences, 0.035 CPU in 0.035 seconds (100% CPU, 1035996 Lips)
true 
?- factorial(4000,_X), time(factorial_inverso_3(_X,_N)).
% 15,997 inferences, 0.022 CPU in 0.022 seconds (100% CPU, 716325 Lips)
true 

Ejercicio 13. Un árbol binario es vacío o consta de tres partes: la raíz (que debe de ser un número positivo), el subárbol izquierdo (que debe ser un árbol binario) y el subárbol derecho (que debe ser un árbol binario). Usaremos la siguiente representación

• nil representa el árbol vacío
• t(I,R,D) representa el árbol de la raíz R, subárbol izquierdo I y subárbol derecho D.

Por ejemplo, t(t(nil,2,nil),1,t(t(nil,4,nil),3,nil)) representa el árbol

   1                                   
 /   \                                 
2     3                                
     /                                 
    4                                  

Definir la relación generación(+N,+L1,-L2) que se verifique si L2 es la lista de nodos de la generación N de la lista de árboles L1. Por ejemplo,

?- generación(0,[t(t(nil,2,nil),3,nil),t(nil,4,t(nil,5,nil))],L).
L = [3, 4] 
?- generación(1,[t(t(nil,2,nil),3,nil),t(nil,4,t(nil,5,nil))],L).
L = [2, 5] 
?- generación(2,[t(t(nil,2,nil),3,nil),t(nil,4,t(nil,5,nil))],L).
L = [] 

Solución

generación(0,L,G):-
   findall(R,member(t(_,R,_),L),G).
generación(N,L,G):-
   N > 0,
   elimina_raices(L,L1),
   N1 is N-1,
   generación(N1,L1,G).

• elimina_raices(+L1,-L2) se verifica si L2 es la lista de los árboles obtenidos de la lista de árboles L1 eliminando sus raices. Por ejemplo,

  ?- elimina_raices([t(t(nil,2,nil),3,nil),t(nil,4,t(nil,5,nil))],L).
  L = [t(nil, 2, nil), nil, nil, t(nil, 5, nil)] 
  

  Su definición es

  elimina_raices([],[]).
  elimina_raices([nil|L1],L2):-
     elimina_raices(L1,L2).
  elimina_raices([t(I,_,D)|L1],[I,D|L2]):-
     elimina_raices(L1,L2).
  

Ejercicio 14. Definir la relación únicos(+L1,-L2) que se verifique si L2 es la lista de los elementos que ocurren solamente una vez en la lista L1. Por ejemplo,

?- únicos([2,5,3,2],L).
L = [5, 3] 
?- únicos([2,5,5,2],L).
L = [] 

Solución

únicos(L1,L2) :-
   findall(X,es_único(X,L1),L2).

• es_único(?X,+L) se verifica si X es un elemento que ocurre solamente una vez en la lista L. Por ejemplo,

  ?- es_único(X,[2,5,3,2]).
  X = 5 ;
  X = 3 ;
  false.
  

  Su definición es

  es_único(X,L) :-
     select(X,L,R),
     not(memberchk(X,R)).
  

Ejercicio 15. Definir el predicado populares(L1,L2) que se verifique si L2 es la lista de los elementos de L1 que aparecen el mayor número de veces. Por ejemplo,

?- populares([rosa,juan,david,manu,rosa,nuria,david],L).
L = [david,rosa]

Solución

populares(L1,L2) :-
   setof(X,
         ((member(X,L1),
           cuenta(X,L1,N1),
           not((member(Y,L1),
                cuenta(Y,L1,N2),
                N1 < N2)))),
         L2).

• cuenta(+X,+L,-N) se verifica si N es el número de veces que aparece el elemento X en la lista L. Por ejemplo,

  ?- cuenta(d,[r,j,d,m,r,n,d],N).
  N = 2
  

  Su definición es

  cuenta(_,[],0).
  cuenta(A,[B|L],N) :-
     A == B, !,
     cuenta(A,L,M),
     N is M+1.
  cuenta(A,[_B|L],N) :-
     % A \== _B,
     cuenta(A,L,N).
  

Ejercicio 16.1. Consideremos la función siguiente definida sobre los números naturales: f(x) = 3x + 1, si x es impar; x / 2, si x es par

Definir la relación sucesión(+X,?L) que se verifique si L es la lista de los elementos X, f(X), f(f(X)), ..., f^n(X) tal que f^n(X) = 1. Por ejemplo,

?- sucesión(3,L).
L = [3, 10, 5, 16, 8, 4, 2, 1]

Se dice que L es la sucesión generada por X.

Solución

f(X,Y) :-
   X mod 2 =:= 0, !,
   Y is X/2.
f(X,Y) :-
   % X mod 2 =/= 0,
   Y is 3*X+1.

sucesión(1,[1]) :- !.
sucesión(X,[X|L]) :-
   % X =/= 1,
   f(X,Y),
   sucesión(Y,L).

Ejercicio 16.2. Definir la relación longitudes(+X,?L) que se verifique si L la lista de pares Y-N donde Y es un número de 1 a X y N es la longitud de sucesión generada por Y. Por ejemplo,

?- longitudes(5,L).
L = [1-1, 2-2, 3-8, 4-3, 5-6] 

1ª solución

longitudes(X,L) :-
   longitudes_aux(X,L1),
   reverse(L1,L).
longitudes_aux(1,[1-N]) :-
   !,
   sucesión(1,L),
   length(L,N).
longitudes_aux(X,[X-N|L]) :-
   % X > 1,
   sucesión(X,L1),
   length(L1,N),
   Y is X-1,
   longitudes_aux(Y,L).

2ª solución

longitudes_2(X,L) :-
   findall(Y-N,(between(1,X,Y),sucesión(Y,S),length(S,N)),L).

Ejercicio 16.3. Definir la relación longitud_máx(+X,?P) que se verifica si P es un par de la forma Y-N4 donde ~Y es un número entre 1 y X tal que la longitud de la sucesión generada por Y es la más larga de las sucesiones generadas por 1, 2, ..., X y N es la longitud de dicha sucesión. Por ejemplo,

?- longitud_máx(10,L).
L = 9-20

Solución

longitud_máx(X,Y-N) :-
   longitudes(X,L),
   member(Y-N,L),
   \+ (member(_Z-M,L), M > N).

Ejercicio 16.4. Definir menor_que_~genera_mayor(+N,-M)~ que se verifique si M es el menor número natural tal que la longitud de la sucesión generada por M es mayor que N. Por ejemplo,

?- menor_que_genera_mayor(100,N).
N = 27.

Solución

menor_que_genera_mayor(N,M) :-
   menor_que_genera_mayor_aux(N,1,M).
menor_que_genera_mayor_aux(N,M,M) :-
   sucesión(M,L),
   length(L,X),
   X > N, !.
menor_que_genera_mayor_aux(N,X,M) :-
   Y is X+1,
   menor_que_genera_mayor_aux(N,Y,M).

Ejercicio 17.1. Definir la relación suma_divisores_propios(+N,-S) que se verifique si S es la suma de los divisores propios del número N. Por ejemplo,

?- suma_divisores_propios(42,S).o
S = 54.
?- suma_divisores_propios(1,S).
S = 0. 

Solución

suma_divisores_propios(N,S) :-
   divisores_propios(N,L),
   sum_list(L,S).

Ejercicio 17.2. Clasificamos los números naturales en tres tipos:

• N es de tipo a si N es mayor que la suma de sus divisores propios
• N es de tipo b si N es igual que la suma de sus divisores propios
• N es de tipo c si N es menor que la suma de sus divisores propios

Definir la relación tipo(+N,-T) que se verifique si T es el tipo del número N. Por ejemplo,

?- tipo(10,T).
T = a 
?- tipo(28,T).
T = b 
?- tipo(12,T).
T = c 

1ª solución

tipo(N,T) :-
   suma_divisores_propios(N,S),
   tipo_aux(N,S,T).

tipo_aux(N,S,a) :- N > S, !. 
tipo_aux(N,N,b) :- !.
tipo_aux(_N,_S,c). % :- _N < _S.

2ª solución

tipo_2(N,T) :-
   suma_divisores_propios(N,S),
   ( N > S   -> T = a ;
     N =:= S -> T = b ;
     true    -> T = c).

Ejercicio 17.3. Definir la relación clasifica(+N,-L) que se verifique si L es la lista de tipos de los números comprendidos entre 1 y N. Por ejemplo,

?- clasifica(20,L).
L = [a, a, a, a, a, b, a, a, a, a, a, c, a, a, a, a, a, c, a, c] 

1ª solución

clasifica(N,L) :-
   findall(T,(between(1,N,X),tipo(X,T)),L).

2ª solución

clasifica_2(N,L) :-
   numlist(1,N,L1),
   maplist(tipo,L1,L).

Ejercicio 17.4. Definir la relación promedio(+N,-A,-B,-C) que se verifique si A, B y C son las cantidades de números naturales menores o iguales que N de tipo a, b y c, respectivamente. Por ejemplo,

?- promedio(20,A,B,C).
A = 16,
B = 1,
C = 3.

Solución

promedio(N,A,B,C) :-
   clasifica(N,L),
   promedio_aux(L,A,B,C).

promedio_aux([],0,0,0).
promedio_aux([a|L],A1,B,C) :-
   promedio_aux(L,A,B,C),
   A1 is A+1.
promedio_aux([b|L],A,B1,C) :-
   promedio_aux(L,A,B,C),
   B1 is B+1.
promedio_aux([c|L],A,B,C1) :-
   promedio_aux(L,A,B,C),
   C1 is C+1.

Ejercicio 17.5. Definir la relación menor(+N,-X) que se verifique si X es el menor número tal que la cantidad de números naturales menores o iguales que X de tipo a es N. Por ejemplo,

?- menor(20,X).
X = 25.

Solución

menor(N,X) :-
   menor_aux(N,N,X).

menor_aux(N,M,M) :-
   promedio(M,N,_,_), !.
menor_aux(N,M,X) :-
   M1 is M+1,
   menor_aux(N,M1,X).

Ejercicio 18. Definir la relación operación_listas(+O,+L1,+L2,-L3) que se verifique si L3 es la lista obtenida aplicando la operación binaria O a los elementos de L1 y L2 que ocupan la misma posición (Se supone que L1 y L2 tienen la misma longitud). Por ejemplo,

?- operación_lista(+,[1,2,3],[4,5,6],L).
L = [5, 7, 9] 
?- operación_lista(*,[1,2,3],[4,5,6],L).
L = [4, 10, 18] 

Solución

operación_lista(_,[],[],[]).
operación_lista(O,[X1|L1],[X2|L2],[X3|L3]) :-
   E =.. [O,X1,X2],
   X3 is E,
   operación_lista(O,L1,L2,L3).

Ejercicio 19. Definir la relación elimina_vocales(+P1,-P2) que se verifique si P2 es la palabra que se obtiene al eliminar todas las vocales de la palabra P1. Por ejemplo,

?- elimina_vocales(sevillano,P).
P = svlln 

1ª solución

elimina_vocales(P1,P2) :-
   name(P1,L1),
   códigos_vocales(L),
   findall(N,(member(N,L1),not(member(N,L))),L2),
   name(P2,L2).

• códigos_vocales(?L) se verifica si L es la lista de los códigos ASCII de las vocales.

  códigos_vocales(L) :-
     name(aeiouAEIOU,L).
  

2ª solución

elimina_vocales_2(P1,P2) :-
   name(P1,L1),
   exclude(es_código_vocal,L1,L2),
   name(P2,L2).

• es_código_vocal(X) se verifica si X es el códigos ASCII de una vocal.

  es_código_vocal(X) :-
     códigos_vocales(L),
     memberchk(X,L).
  

Ejercicio 20.1. Definir la relación longitud(+P,-N) que se verifique si N es la longitud de la palabra P. Por ejemplo,

?- longitud(ana,N).
N = 3.

Solución

longitud(P,N) :-
   name(P,L),
   length(L,N).

Ejercicio 20.2. Definir la relación palabra_maximal(+L,-P) que se verifique si P es una palabra maximal (es decir, de máxima longitud) de la lista de palabras L. Por ejemplo,

?- palabra_maximal([eva,y,ana,se,van],P).
P = eva ;
P = ana ;
P = van.

Solución

palabra_maximal(L,P) :-
   select(P,L,R),
   longitud(P,N),
   not((member(P1,R), longitud(P1,N1), N < N1)).

Ejercicio 20.3. Definir la relación palabras_maximales(+L1,-L2) que se verifique si L2 es la lista de las palabras maximales de la lista de palabras L1. Por ejemplo,

?- palabras_maximales([eva,y,ana,se,van],L).
L = [eva, ana, van].

Solución

palabras_maximales(L1,L2) :-
   findall(P,palabra_maximal(L1,P),L2).

Ejercicio 21. La clausura transitiva de una relación binaria R es la menor relación transitiva que contiene a R; por ejemplo, la clausura transitiva de {(a,b),(b,c)} es {(a,b),(b,c),(a,c)}.

Definir la relación clausura_transitiva(R,X,Y) que se verifique si (X,Y) está en la clausura transitiva de la relación R. Por ejemplo, suponiendo que se han definido las relaciones p y q por

p(a,b).
p(b,c).
q(c,b).
q(b,a).

se tiene

?- clausura_transitiva(p,X,Y).
X = a,
Y = b ;
X = b,
Y = c ;
X = a,
Y = c ;
false.

?- clausura_transitiva(q,X,Y).
X = c,
Y = b ;
X = b,
Y = a ;
X = c,
Y = a ;
false.

Solución

clausura_transitiva(R,X,Y) :-
   apply(R,[X,Y]).
clausura_transitiva(R,X,Y) :-
   apply(R,[X,Z]),
   clausura_transitiva(R,Z,Y).

Ejercicio 22. Definir la relación traducción(+L1,-L2) que se verifique si L2 es la lista de palabras correspondientes a los dígitos de la lista L1. Por ejemplo,

?- traducción([1,3],L).
L = [uno,tres].

1ª solución

traducción_1([],[]).
traducción_1([D|L1],[N|L2]) :-
   nombre(D,N),
   traducción_1(L1,L2).

• nombre(D,N) se verifica si N es el nombre del dígito D.

  nombre(0,cero).
  nombre(1,uno).
  nombre(2,dos).
  nombre(3,tres).
  nombre(4,cuatro).
  nombre(5,cinco).
  nombre(6,seis).
  nombre(7,siete).
  nombre(8,ocho).
  nombre(9,nueve).
  

2ª solución

traducción_2(L1,L2) :-
   findall(N,(member(D,L1),nombre(D,N)),L2).

3ª solución

traducción_3(L1,L2) :-
   maplist(nombre,L1,L2).

Ejercicio 23. Definir la relación transforma(+L1,-L2) que se verifique si L2 es la lista obtenida sumándole a cada elemento numérico de L1 su posición en la lista. Por ejemplo,

?- transforma([1,1,1,a,b,c,1,1,1],L).
L = [2,3,4,a,b,c,8,9,10].

?- transforma([1,2,a,5,2,b,3,1],L).
L = [2,4,a,9,7,b,10,9].

1ª solución

transforma(L1,L2) :-
   transforma_aux(L1,1,L2).

• transforma_aux(+L1,+N,-L2) se verifica si L2 es la lista obtenida añadiéndole a cada elemento numérico de L1 la suma de N y su posición en la lista.

  transforma_aux([],_,[]).
  transforma_aux([X|L1],N,[Y|L2]) :-
     number(X), !,
     Y is X+N,
     N1 is N+1,
     transforma_aux(L1,N1,L2).
  transforma_aux([X|L1],N,[X|L2]) :-
     % not(number(X)),
     N1 is N+1,
     transforma_aux(L1,N1,L2).
  

2ª solución

transforma_2(L1,L2) :-
   lista_de_posiciones(L1,L),
   maplist(suma,L1,L,L2).

• lista_de_posiciones(+L1,-L2) se verifica si L2 es la lista de posiciones correspondiente a la lista L1. Por ejemplo,

  ?- lista_de_posiciones([1,1,1,a,b,c,1,1,1],L).
  L = [1, 2, 3, 4, 5, 6, 7, 8, 9] 
  

  Su definición es

  lista_de_posiciones(L1,L2) :-
     length(L1,N),
     numlist(1,N,L2).
  

• suma(+X,+Y,-Z) se verifica si Z es la suma de X y el número Y, cuando X es un número y es igual a X, en caso contrario. Por ejemplo,

  ?- suma(3,2,Z).
  Z = 5 
  ?- suma(b,2,Z).
  Z = b 
  

  Su definición es

  suma(X,Y,Z) :-
     number(X), !,
     Z is X+Y.
  suma(X,_,X).
  

Ejercicio 24. Definir la relación aplana(+L1,?L2) que se verifique si L2 es la lista obtenida reemplazando, recursivamente, cada lista de L1 por sus elementos. Por ejemplo,

?- aplana([a,[b,[c]],[[d],e]],L).
L = [a, b, c, d, e] 

Solución

aplana(X,[X]) :-
   \+ is_list(X).
aplana([],[]).
aplana([X|L1],L2) :-
   aplana(X,L3),
   aplana(L1,L4),
   append(L3,L4,L2).