% transformacao de estados no mundo dos blocos

s(Stacks,[Stack1,[Top1|Stack2]|OtherStacks]) :-
    del([Top1|Stack1],Stacks,Stacks1),
    del(Stack2,Stacks1,OtherStacks).

del(X,[X|Y],Y).
del(X,[Y|L],[Y|L1]) :- del(X,L,L1).

% busca em profundidade com ciclos
% s definido no programa dependendo do problema

solve(Node,[Node]) :- goal(Node).
solve(Node,[Node|Sol]) :-
    s(Node,Next),
    solve(Next,Sol).

% busca em profundidade sem ciclos
% s definido no programa dependendo do problema

solve(Node,Solution) :- solve([],Node,Solution).

solve(Path,Node,[Node|Path]) :- goal(Node).
solve(Path,Node,Sol) :-
    s(Node,Next),
    not member(Next,Path),
    solve([Next|Path],Next,Sol).

% Busca em grafos (em profundidade, sem geracao de ciclos)
% grafo representado no programa

path(A,Z,P) :- path1(A,Z,[],P).

path1(Z,Z,L,[Z|L]).
path1(A,Z,L,P) :-
      (conectado(A,Y);    /* encontra caminho parcial */
       conectado(Y,A)),   /* de A para Y ou de Y para A */
      \+ member(Y,L),     /* verifica se ja passei por Y */
      path1(Y,Z,[Y|L],P). /* encontra caminho parcial de */
                          /* Y a Z */
% Busca em largura

solve(Start,Solution) :- bfs([[Start]],Solution).

bfs([[Node|Path]|_],[Node|Path]) :- goal(Node).
bfs([Path|Paths],Solution) :-
     extend(Path,NewPaths),
     conc(Paths,NewPaths,Paths1),
     bfs(Paths1,Solution).

extend([Node|Path],NewPaths) :-
     bagof([NewNode,Node|Path],
           (s(Node,NewNode), not member(NewNode,[Node|Path])),
           NewPaths),
     !.
extend(Path,[]).

% Busca limitada em profundidade
% ?- solve(<estado_inicial>,P,10).
% estado final codificado como goal/1.

solve(N,[N],_) :- goal(N).
solve(N,[N|Sol1],ProfMax) :-
    ProfMax > 0,
    s(N,N1),    
    NewMax is ProfMax - 1,
    solve(N1,Sol1,NewMax).

% Busca iterativa em profundidade
% ?- solve0(<estado_inicial>,P,0,10).
% estado final codificado como goal/1.

solve0(<estado_inicial>,P,LimiteInicial,LimiteMaximo) :-
    LimiteInicial < LimiteMaximo,
    solve(<estado_inicial>,P,LimiteInicial).
solve0(<estado_inicial>,P,LimiteInicial,LimiteMaximo) :-
    LimiteInicial < LimiteMaximo,
    Novo_LimiteInicial is LimiteInicial + 1,
    solve0(<estado_inicial>,P,Novo_LimiteInicial,LimiteMaximo).

solve(N,[N],_) :- goal(N).
solve(N,[N|Sol1],ProfMax) :-
    ProfMax > 0,
    s(N,N1),    
    NewMax is ProfMax - 1,
    solve(N1,Sol1,NewMax).

% IDA*
% ?- Bound = f(<estado_inicial>), solve0(<estado_inicial>,P,Bound).
% estado final codificado como goal/1.

solve0(<estado_inicial>,P,Bound) :-
    solve(<estado_inicial>,P,Bound).
solve0(<estado_inicial>,P,Bound) :-
    bound(NewBound),
    solve0(<estado_inicial>,P,NewBound).

solve(N,[N],_) :- goal(N).
solve(N,[N|Sol1],BoundN) :-
    s(N,N1),    
    f(N1,BoundN1), 
    (BoundN1 =< BoundN -> solve(N1,Sol1,Bound);
     bound(B) ->  (B > BoundN1 -> retract(bound(B)),
                                  assert(bound(BoundN1)), fail);
     assert(bound(BoundN1))
    ).

% N-queens assumindo tabuleiro inicializado com N rainhas (generate-and-test)
nqueens(N,S) :- 
   makelist(L,N),
   permutation(L,S),
   safe(S).

makelist([],0).
makelist([N|L],N) :-
   N1 is N - 1,
   makelist(L,N1).

safe([]).
safe([Queen|Others]) :-
  noattack(Queen,Others),
  safe(Others).

noattack(Queen,Others) :-
  noattack1(Queen,Others,1).

noattack1(_X,[],_).
noattack1(X,[Y|Ys],N) :-
  X \= Y + N, X \= Y - N,
  N1 is N + 1,
  noattack1(X,Ys,N1).

% N-queens assumindo tabuleiro vazio (constrain-and-generate)
nqueens(N,S) :- 
   makelist(L,N), % definido acima
   queens([],L,N,S).

queens(Placed,_L,N,Placed) :- 
   length(Placed,N1), N1 = N, !.
queens(Placed,L,N,S) :-
   member(X,L),
   \+ member(X,Placed),
   noattack(X,Placed), % definido acima
   queens([X|Placed],L,N,S).

% DCG: gramatica simples

sentence --> noun_phrase, verb_phrase.

noun_phrase --> determiner, noun.
noun_phrase --> proper_noun.

verb_phrase --> trans_verb, noun_phrase.
verb_phrase --> intrans_verb.

determiner --> [every].
determiner --> [a].

trans_verb --> [likes].
trans_verb --> [loves].

noun --> [man].
noun --> [woman].

intrans_verb --> [run].

% DCG: geracao de arvore sintatica

sentence(sentence(NP,VP)) --> 
        noun_phrase(NP),
	verb_phrase(VP).
        
noun_phrase(np(D,N,C)) -->
        determiner(D),
	noun(N),
	rel_clause(C).

noun_phrase(np(PN)) --> proper_noun(PN).

verb_phrase(vp(TV,NP) --> 
        trans_verb(TV),
	noun_phrase(NP).
verb_phrase(vp(IT)) -->
        intrans_verb(IT).

rel_clause(rc(that,VP)) -->
        [that],
	verb_phrase(VP),
rel_clause(rc([])) --> [].

determiner(det(every)) --> [every].
determiner(det(a)) --> [a].

noun(noun(man)) --> [man].
noun(noun(woman)) --> [woman].

proper_noun(pn(john)) --> [john].

trans_verb(tv(loves)) --> [loves].
intrans_verb(it(lives)) --> [lives].


% DCG: transformacao de sentencas em logica
% ?- sentence([every,man,loves,a,woman],X).
% X = all(X, (man(X) -> exists(Y,(woman(Y) & loves(X,Y)))))

:- op(500,xfy,&).
:- op(500,xfy,'->').

sentence(P) --> 
        noun_phrase(X,P1,P),
	verb_phrase(X,P1).

noun_phrase(X,P1,P) -->
        determiner(X,P2,P1,P),
	noun(X,P3),
	rel_clause(X,P3,P2).

noun_phrase(X,P,P) --> proper_noun(X).

verb_phrase(X,P) --> 
        trans_verb(X,Y,P1),
	noun_phrase(Y,P1,P).
verb_phrase(X,P) -->
        intrans_verb(X,P).

rel_clause(X,P1,(P1&P2)) -->
        [that],
	verb_phrase(X,P2),
rel_clause(_,P,P) --> [].

determiner(X,P1,P2,all(X,(P1->P2))) --> [every].
determiner(X,P1,P2,exists(X,(P1&P2))) --> [a].

noun(X,man(X)) --> [man].
noun(X,woman(X)) --> [woman].

proper_noun(john) --> [john].

trans_verb(X,Y,loves(X,Y)) --> [loves].
intrans_verb(X,lives(X)) --> [lives].