Ejercicios de Prolog

Ejercicios.pl

/***********************************************
* Identificacion   : Ejercicios.pl
* Version          : 1.0
* Posgrado         : MCC UNAM
* Instalacion 	   : SWI-Prolog version 6.6.6 
* Fecha de Entrega : Diciembre 2014
***********************************************/

%EJERCICIO 1%
/* INCISO A. Predicados "x_pert_arb"
 * Objetivo: Verifica si un elemento pertenece
 * a un arbol.
 * Parametros
 	Elemento:Elemento a buscar,
 	Arbol: Estructura Arbol donde se va a buscar
*/
x_pert_arb(X,arbol(Izq,X,Der)):-!.
x_pert_arb(X,arbol(Izq,Y,Der)):-x_pert_arb(X,Izq).
x_pert_arb(X,arbol(Izq,Y,Der)):-x_pert_arb(X,Der).

/* INCISO B. Predicados "nods_arb"
 * Objetivo: Obtener el numero de nodos de un arbol
 * Parametros
 	  Arbol: Estructura Arbol que se va a procesar
 	  N: Resultado.
 */
nods_arb(nil,0).
nods_arb(arbol(nil,Raiz,nil),1):-!.
nods_arb(arbol(Izq,Raiz,Der),Tamanio):-
	nods_arb(Izq,TamanioIzq),
	nods_arb(Der,TamanioDer),
	Tamanio is TamanioIzq +TamanioDer + 1 .



%EJERCICIO 2%
/*
* Predicado: "problemaRecogedor"
* Objetivo: Imprime las posibles soluciones
 		   a el problema del recogedor.
* Parametros: 
			Recogedor: Representacion del recogedor 
			y la basura en forma de una matriz 
			(Lista de listas en prolog)
*/		   
problemaRecogedor([Head|Tail]):-
	nl,
	write('------ Problema Inicial --- '),nl,
	recorrerLista([Head|Tail]),
	buscarPosElem([Head|Tail],9,[X,Y]),
	nl,
	basuraAdentro([Head|Tail],0,[X,Y]),
	solucionValida([X,Y],SolucionParcial),
	procesarSoluciones(SolucionParcial,[X,Y],[],Solucion),
	write('------ Posibles Soluciones --- '),nl,
	recorrerSolucion(Solucion),!.

% Predicado auxiliar "indexOf" para obtener 
% la posicion de un
% elemento en una lista
indexOf([Element|_],Element,0):-!.
indexOf([_|Tail],Element,Index):-
	indexOf(Tail,Element,Index1),
	Index is Index1 + 1.

% Predicado auxiliar "buscarPorFila" 
% para buscar un elemento
% en una lista de listas
buscarPorFila([],Element,Fila,[0,0]).
buscarPorFila([Head|Tail],Element,Fila,[X,Y]):-
			    
			   (member(Element,Head)->
			   		indexOf(Head,Element,N1),
			   		Y is N1,
			   		X is Fila,
			   		!
			   	; 
			   	  Fila1 is Fila + 1,
			   	  buscarPorFila(Tail,Element,Fila1,[X,Y])
			   	).
% Predicado auxiliar "buscarPosElem" para buscar 
% la posicion X,Y de elemento en lista de listas
buscarPosElem([Head|Tail],Element,[X,Y]):-
			   buscarPorFila([Head|Tail],Element,0,[X1,Y1]),
			   X is X1,
			   Y is Y1.

% Predicado auxiliar "getElementByIndex". Obtiene un elemento por indice
getElementByIndex([Head|Tail],Index,Key,Result):-
					(Index==Key->
						%write(Head),
						Result is Head,
						!
					;
					Index1 is Index + 1,
					getElementByIndex(Tail,Index1,Key,Result)
					).

% Predicado auxliar "split".Divide una Lista en dos listas
% de acuerdo a un pivote
split(Lista, Pivote, Izq, Der) :- append(Izq, [Pivote|Der], Lista).


% Predicado auxliar "basuraAdentro".Verifica que la basura
% esta dentro del recogedor
basuraAdentro([Head|Tail],Indice,[X,Y]):-
				(Indice==X->
					getElementByIndex(Head,0,Y,Token),
					split(Head,Token,Izq,Der),
					member(1,Der),
					member(1,Izq),
					!
				;
				Indice1 is Indice + 1,
				basuraAdentro(Tail,Indice1,[X,Y])
				).

% Predicado auxiliar "recorreFila". Imprime una fila(Lista)
recorreFila([]):-nl.
recorreFila([Head|Tail]):-write(Head),write(' '),recorreFila(Tail).

% Predicado auxiliar "recorrerLista".Imprime una lista 
% de listas (Matriz)
recorrerLista([]).
recorrerLista([Head|Tail]):-recorreFila(Head),recorrerLista(Tail).



% Predicado auxiliar "recorrerSolucion".Recorre las posibles soluciones
recorrerSolucion([]).
recorrerSolucion([Head|Tail]):-
			nl,
			recorrerLista(Head),
			recorrerSolucion(Tail).

% Predicado auxiliar "reemplazar".Reemplaza un elemento dentro de una lista
reemplazar([_|T], 0, X, [X|T]).
reemplazar([H|T], I, X, [H|R]):- I > -1, NI is I-1, reemplazar(T, NI, X, R), !.
reemplazar(L, _, _, L).

% Predicado auxiliar "revertirLista".Invierte una lista
revertirLista([],Z,Z).
revertirLista([H|T],Z,Acc) :- revertirLista(T,Z,[H|Acc]).

% Predicado auxiliar "iniProcesaSolucion". Inicia el proceso de las posibles 
% soluciones.
iniProcesaSolucion(ListaInicial,Indice,[X,Y],Final):-
					procesaSolucion(ListaInicial,Indice,[X,Y],[],Final1),
					revertirLista(Final1,Final,[]).

% Predicando auxiliar "procesarSoluciones". Procesa todas las soluciones.
procesarSoluciones([],[X,Y],Acc,Acc).
procesarSoluciones([Head|Tail],[X,Y],Acc,Final):-
			iniProcesaSolucion(Head,0,[X,Y],Resultado),
			procesarSoluciones(Tail,[X,Y],[Resultado|Acc],Final).

% Predicado auxiliar "procesaSolucion". Procesa cada solucion de forma
% individual.
procesaSolucion([],Indice,[X,Y],Acc,Acc).
procesaSolucion([Head|Tail],Indice,[X,Y],Acc,Final):-
				(Indice==X->
					Indice1 is Indice + 1,
					reemplazar(Head,Y,9,Resultado),
					procesaSolucion(Tail,Indice1,[X,Y],[Resultado|Acc],Final)
				; 
				  Indice1 is Indice + 1,
				  procesaSolucion(Tail,Indice1,[X,Y],[Head|Acc],Final)
				 ).

% Predicado auxiliar "solucionValida". Determina la solucion valida.
solucionValida([X,Y],
	[[[0, 0, 1, 0, 0],[0, 0, 1, 0, 0],[0, 0, 1, 0, 0],[0, 1, 1, 1, 0],[0, 1, 0, 1, 0],[0, 1, 0, 1, 0],[0, 1, 0, 1, 0]]
	]):-Y==1;Y==3,X<3.

solucionValida([X,Y],
	[[[0, 1, 0, 1, 0],[0, 1, 0, 1, 0],[0, 1, 0, 1, 0],[0, 1, 1, 1, 0],[0, 0, 1, 0, 0],[0, 0, 1, 0, 0],[0, 0, 1, 0, 0]]
	]):-Y==1;Y==3,X>3.

solucionValida([X,Y],
	[[[1, 0, 1, 0, 0],[1, 0, 1, 0, 0],[1, 0, 1, 0, 0],[1, 1, 1, 0, 0],[0, 1, 0, 0, 0],[0, 1, 0, 0, 0],[0, 1, 0, 0, 0]],
	[[0, 0, 1, 0, 1],[0, 0, 1, 0, 1],[0, 0, 1, 0, 1],[0, 0, 1, 1, 1],[0, 0, 0, 1, 0],[0, 0, 0, 1, 0],[0, 0, 0, 1, 0]]
	]):-Y==2,X>3.

solucionValida([X,Y],
	[[[0, 1, 0, 0, 0],[0, 1, 0, 0, 0],[0, 1, 0, 0, 0],[1, 1, 1, 0, 0],[1, 0, 1, 0, 0],[1, 0, 1, 0, 0],[1, 0, 1, 0, 0]],
	[[0, 0, 0, 1, 0],[0, 0, 0, 1, 0],[0, 0, 0, 1, 0],[0, 0, 1, 1, 1],[0, 0, 1, 0, 1],[0, 0, 1, 0, 1],[0, 0, 1, 0, 1]]
	]):-Y==2,X<3.




%EJERCICIO 3%
/*
* Escribe el arbol de derivacion que realiza Prolog 
* para encontrar la solucion a la siguiente meta :
* cuenta( [ a, b, c, a, b ], M )
*/
% Cuenta( Xs, N ) : Cierto si N es el número de elementos distintos en 
% la lista Xs .
cuenta( Xs, N ) :- filtra( Xs, Ys ), long( Ys, 0, N ) .

% filtra( Xs, Ys ) : Elimina de la lista Xs los elementos repetidos, 
% obteniendo una nueva lista YS .
filtra( [ X | Xs ], [ X | Ys ] ) :- borra( X, [ X | Xs ], Zs ), filtra( Zs, Ys ) .
filtra( [], [] ) .

% borra( X, Xs, Ys ) : Borra el elemento X de la lista Xs y obtiene una 
% nueva lista YS .
borra( X, [ X | Xs ], Zs ) :- borra( X, Xs, Zs ) .
borra( X, [ Y | Xs ], [ Y | Zs ] ) :- X \== Y, borra( X, Xs, Zs ) .  
borra( X, [], [] ) .

% long( Xs, I, M ) : Determina que M es la longitud de la lista Xs. 
% I es un acumulador que debe inicializarse con cero .
long( [ X | Xs ], I, M ) :- I1 is I + 1, long( Xs, I1, M ) .
long( [], M, M ).


%EJERCICIO 4%
/*
* Que cerillos deben de moverse en la siguiente figura, 
* que representa una casa, para que 
* la vista del triangulo sea ahora del lado derecho? 
*  Realiza un programa en Prolog que indique la solucion
*/
:-op(600,xfy,'-').

/*
* Predicado: "resolverCasa"
* Objetivo: Resuelve el problema de la orientacion
			de la casa
* Parametros: 
			ListaAristas: Representacion de la casa
					      en forma de vertices aristas
					      a-b.
			Zs: Representacion de la lista de la aristas
				de la casa solucion	 
*/	
resolverCasa(ListaAristas,Zs):-
	aristasDerecha(Derecha),
	aristasIzquierda(Izquierda),
    (validarAristas(ListaAristas,Derecha,[],Vs)-> 
    	write('Casa con orientacion a la Derecha'),nl,
    	compararAristas(ListaAristas,Izquierda,[],Rs),
    	compararAristas(Izquierda,ListaAristas,[],Ts),
    	write('Cambiar '),write(Rs),write(' por '),write(Ts),nl,
    	asignarRespuesta(ListaAristas,Izquierda,Zs)
    	;
    	validarAristas(ListaAristas,Izquierda,[],Vs)->
    	write('Casa con orientacion a la Izquierda'),nl,
    	compararAristas(ListaAristas,Derecha,[],Rs),
    	compararAristas(Derecha,ListaAristas,[],Ts),
    	write('Cambiar '),write(Rs),write(' por '),write(Ts),nl,
    	asignarRespuesta(ListaAristas,Derecha,Zs)

    	;
    	write('Configuracion no valida'),fail
    ).

%Predicado auxiliar "compararAristas" compara un conjunto de aristas
compararAristas([],Z,Zs,Zs).
compararAristas([Head|Tail],M,Acc,Zs):-
				  (
				  	aristaDiferente(M,Head,AristaValida)->
				  	compararAristas(Tail,M,[AristaValida|Acc],Zs)
				  ; 
				     aristaFaltante(Head,Zs) 
				  ).
%Predicado auxiliar "aristaFaltante". Verifica la aristas aristaFaltante
% de dos conjuntos de aristas.
aristaFaltante(X,X).
aristaDiferente([],X,Ys):-fail.			  
aristaDiferente([X|RV],X,X):-!.
aristaDiferente([Y-X|RV],X-Y,X-Y):-!.
aristaDiferente([W|RV],X,Ys):-aristaDiferente(RV,X,Ys).

% Predicado auxiliar "asignarRespuesta". Asigna la respuesta valida 
% a una variable 
asignarRespuesta(Respuesta,RespuestaValida,RespuestaValida).


%Predicado auxiliar "validarAristas". Compara y valida un conjunto de aristas
% con una solucion valida del problema.
validarAristas([],M,Acc,Acc):-
      length(Acc,N),
      N==11,
      !.
validarAristas([Head|Tail],M,Acc,Zs):-
				  recorrerAristas(M,Head,AristaValida),
				  %write(AristaValida),nl,
				  validarAristas(Tail,M,[AristaValida|Acc],Zs)
				  .
%Predicado auxiliar "recorrerAristas". Recorrer un conjunto de aristas.
recorrerAristas([]):-fail.
recorrerAristas([X|RV],X,X).
recorrerAristas([Y-X|RV],X-Y,X-Y).
recorrerAristas([W|RV],X,Ys):-recorrerAristas(RV,X,Ys).

%Predicado auxiliar "aristasDerecha". Define la solucion de aristas
%para una casa orientada a la derecha.
aristasDerecha([
	a-b,b-c,c-d,d-e,e-f,f-g,g-a,h-e,h-d,b-h,g-h
	]).


%Predicado auxiliar "aristasIzquierda". Define la solucion de aristas
%para una casa orientada a la Izquierda.
aristasIzquierda([
	a-b,b-c,c-d,d-e,e-f,f-g,g-a,h-f,h-d,b-h,g-h
	]).