%%%%%%%%%%%%%
%%% Model %%%
%%%%%%%%%%%%%

%% Facts %%

block(b1).
block(b2).
block(b3).
block(b4).
block(b5).
block(b6).
block(b7).
block(b8).

size(b1, large).
size(b2, large).
size(b3, large).
size(b4, large).
size(b5, small).
size(b6, small).
size(b7, small).
size(b8, small).

color(b1, yellow).
color(b2, red).
color(b3, blue).
color(b4, green).
color(b5, yellow).
color(b6, red).
color(b7, blue).
color(b8, green).

initial_state([on(b1, table), on(b2, table), on(b3, table), on(b4, table), on(b5, table),
    on(b6, table), on(b7, table), on(b8, table)]).

final_state([on(b1, table), on(b2, b3), on(b3, b1), on(b4, b5), on(b5, b6), on(b6, table), on(b7, b4), on(b8, b7)]).


%%%%%%%%%%%%%
%%% Rules %%%
%%%%%%%%%%%%%

clear(Block, State) :- \+ member(on(_, Block), State).
empty_hand(State) :- \+ member(hand(_), State).
holding(State, Block) :- member(hand(Block), State).
is_on(Block1, Block2, State) :- member(on(Block1, Block2), State).

validate(pickup, Block, State) :- clear(Block, State), empty_hand(State).
validate(pickup, Block1, Block2, State) :- clear(Block1, State), is_on(Block1, Block2, State),
    (empty_hand(State)).
validate(put, Block1, Block2, State) :- clear(Block1, State), clear(Block2, State),
    (empty_hand(State) ; holding(State, Block1)).
validate(put, Block, table) :- clear(Block, State),
    (empty_hand(State) ; holding(State, Block)).
validate(stack, Block1, Block2, State) :- clear(Block1, State), clear(Block2, State),
    (empty_hand(State) ; holding(State, Block1)).
validate(unstack, Block, State) :- clear(Block, State), empty_hand(State).
validate(unstack, Block1, Block2, State) :- clear(Block1, State), is_on(Block1, Block2, State),
    (empty_hand(State)).

perform(pickup, Block, State, NewState) :- replace(on(Block,_), hand(Block), State, NewState).
perform(put, Block1, Target, State, NewState) :- perform(pickup, Block1, State, State1),
    replace(hand(Block1), on(Block1, Target), State1, NewState).
perform(stack, Block1, Target, State, NewState) :- perform(pickup, Block1, State, State1),
    replace(hand(Block1), on(Block1, Target), State1, NewState).
perform(unstack, Block, State, NewState) :- replace(on(Block,_), hand(Block), State, NewState).

%%%%%%%%%%%
%%% NLP %%%
%%%%%%%%%%%

%% Parsing %%

sentence(s(VP)) --> verb_phrase(VP).
sentence(s(VP)) --> verb_phrase(VP), dot.
noun_phrase(np(Det, Noun)) --> det(Det), noun(Noun).
noun_phrase(np(Det, Adjp, Noun)) --> det(Det), adj_phrase(Adjp), noun(Noun).
verb_phrase(vp(Verb, NP)) --> verb(Verb), noun_phrase(NP).
verb_phrase(vp(Verb, NP, PP)) --> verb(Verb), noun_phrase(NP), prep_phrase(PP).
prep_phrase(pp(Prep, NP)) --> prep(Prep), noun_phrase(NP).
adj_phrase(adjp(Adj)) --> adj(Adj).
adj_phrase(adjp(Adj, Adjp)) --> adj(Adj), adj_phrase(Adjp).
verb(v(put)) --> [put].
verb(v(pickup)) --> [pickup].
verb(v(stack)) --> [stack].
verb(v(unstack)) --> [unstack].
det(d(the)) --> [the].
adj(a(large)) --> [large].
adj(a(small)) --> [small].
adj(a(green)) --> [green].
adj(a(red)) --> [red].
adj(a(yellow)) --> [yellow].
adj(a(blue)) --> [blue].
noun(n(block)) --> [block].
noun(n(table)) --> [table].
prep(p(on)) --> [on].
prep(p(from)) --> [from].
dot --> ['.'].

%% Extracting Verbs and NPs %%

extract(s(vp(v(Verb), NounPhrase)), Verb, NounPhrase).
extract(s(vp(v(Verb), NounPhrase1, pp(_, NounPhrase2))), Verb, NounPhrase1, NounPhrase2).

%% Reference Resolution (Thanks for the video Dan) %%

%% 2-adjective
resolve_ref(NP, _, Block) :- NP = np(_, adjp(a(Size), adjp(a(Color))), n(block)),
    size(Block, Size), color(Block, Color).
resolve_ref(NP, _, Block) :- NP = np(_, adjp(a(Color), adjp(a(Size))), n(block)),
    size(Block, Size), color(Block, Color).


%% 1-adjective
resolve_ref(NP, State, Block) :- NP = np(_, adjp(a(Adjective)), n(block)),
    member(on(Block, _), State),
    (findall(Block, size(Block, Adjective), [Block]) ;
     findall(Block, color(Block, Adjective), [Block])).




/*
 * Suggestion from Dan
resolve_refs_size(NP, State, Block) :- NP = np(_, adjp(a(Adjective)), n(block)),
    member(on(Block,_),State),
    clear(Block,State),size(Block,Adjective).

resolve_refs_color(NP, State, Block) :- NP = np(_, adjp(a(Adjective)), n(block)),
    member(on(Block,_), State),
    clear(Block,State), color(Block, Adjective).

resolve_ref(NP, State, Block) :-
    findall(Block, resolve_refs_size(NP, State, Block), [Block]);
    findall(Block, resolve_refs_color(NP, State, Block), [Block]).
*/


%% 0-adjective
resolve_ref(NP, State, Block) :- NP = np(d(the), n(block)), member(hand(Block), State).
resolve_ref(NP, _, table) :- NP = np(d(the), n(table)).





%TASK 2

% These work the same way as the resolve_ref functions but we are only
% examining input with 1 noun phrase.
% You have to remove the clear from the 1-adjective resolve ref just in
% case you get a noun phrase that is ambiguous
resolve_np(NP, _, Block) :-
    NP = np(_, adjp(a(Size), adjp(a(Color))), n(block)),
    size(Block, Size),
    color(Block, Color).

resolve_np(NP, _, Block) :-
    NP = np(_, adjp(a(Color), adjp(a(Size))), n(block)),
    size(Block, Size),
    color(Block, Color).

resolve_np(NP, State, Block) :-
    NP = np(d(the), n(block)),
    member(hand(Block), State).

resolve_np(NP, _, table) :- NP = np(d(the), n(table)).


%% Natural Language Generation %%

nlg(Block) :- size(Block, S), color(Block, C), write("the "), write(S), write(" "),
    write(C), write(" block").
nlg(table) :- write("the table").
nlg(on(Block, Target)) :- nlg(Block), write(" is on "), nlg(Target), nl.
nlg(hand(Block)) :- nlg(Block), write(" is in the hand "), nl.

nlg([StateItem]) :- nlg(StateItem).
nlg([StateItem|Rest]) :- nlg(StateItem), nlg(Rest).

%%%%%%%%%%%%%%%%%
%%% Main Loop %%%
%%%%%%%%%%%%%%%%%

perform_act(Parse, State, NewState) :- extract(Parse, Verb, NP),
    resolve_np(NP, State, Block),
    validate(Verb, Block, State),
    perform(Verb, Block, State, NewState).



perform_act(Parse, State, NewState) :- extract(Parse, Verb, NP1, NP2),
    resolve_ref(NP1, State, Block1),
    resolve_ref(NP2, State, Block2),
    validate(Verb, Block1, Block2, State),
    (perform(Verb, Block1, State, NewState) ; perform(Verb, Block1, Block2, State, NewState)).



%TASK 1


% Check to see if the act can be performed, if not, return an error and
% start the loop over.
can_resolve(Parse, State) :-
    \+perform_act(Parse, State, _),
    write("There was a reference resolution error. You cannot perform this action."),
    nl, !, talktome(State).

%If the task can be done do the task and return the new state
%then continue the loop
can_resolve(Parse, State) :-
    perform_act(Parse, State, NewState),
    write("Currently..."), nl,
    nlg(NewState),
    !, talktome(NewState).

%if the word isn't in the grammar then the sentence can't be 'true'
%so return a parsing error
can_be_parsed(State, Input) :-
    \+sentence(_, Input, []),
    write("There was a parsing error, one of the 'words' provided is not in the grammar of this model."),
    nl, !, talktome(State).

% if the sentence contains words we know, let's check that we can
% actually do the action.
can_be_parsed(State, Input) :-
    sentence(Parse, Input, []),
    can_resolve(Parse, State).

% Because we split up the process into multiple rules, we can shorten
% the process input function.
process_input(State) :-
    read_word_list(Input),
    can_be_parsed(State, Input).


talktome :- initial_state(State), write("Currently..."), nl, nlg(State), talktome(State).
talktome(State) :- write("What would you like to do next?"), nl, process_input(State).

%%%%%%%%%%%%%%%%
%%% Planning %%%
%%%%%%%%%%%%%%%%

%TASK 3

% This heuristic works bottom up as Dan recommended. Essentially we have
% a recursive function that examines each stack one at a time trying to
% build up to the End State by stacking the blocks that need to be on
% top of the current block if we can do so. When a stack is finished
% being examined it checks if the End State has been reached, if not it
% moves onto the next stack. This will continue until the End State is
% reached.


% If this is true we are done :)))
plan(CurrentState, CurrentState, _, []).

% This is a recursive function that uses helper functions to find the
% correct path
plan(CurrentState, EndState, CurrentBlock, Moves) :-
    check(CurrentState, EndState, CurrentBlock, StackBlock, NextCurrentBlock),
    clear(NextCurrentBlock, CurrentState),
    validate(stack, StackBlock, NextCurrentBlock, CurrentState),
    perform(stack, StackBlock, NextCurrentBlock, CurrentState, NextState), !,
    plan(NextState, EndState, StackBlock, NextMove),
    Moves = [putOn(StackBlock,NextCurrentBlock)|NextMove].


% We need to make sure that there is no block on the current block or
% when the block we are looking at is at the top of a stack
check(CurrentState, EndState, CurrentBlock, StackBlock, NextCurrentBlock) :-
    \+is_on(_, CurrentBlock, EndState),
    is_on(StackBlock, NextCurrentBlock, EndState),
    \+member(on(StackBlock, NextCurrentBlock), CurrentState),
    member(on(NextCurrentBlock, table), EndState).

% This checks if there is a block on top of the current block
check(_, EndState, CurrentBlock, StackBlock, CurrentBlock) :- is_on(StackBlock, CurrentBlock, EndState).

% rule used to find the top block of a stack
get_top_block(EndState, CurrentBlock) :- block(CurrentBlock), \+is_on(_, CurrentBlock, EndState).

% convenience rule.
solve(Moves) :- initial_state(CurrentState), final_state(EndState), get_top_block(EndState, CurrentBlock), plan(CurrentState, EndState, CurrentBlock, Moves).


plan(CurrentState, CurrentState, []).
plan(CurrentState, GoalState, Steps) :- block(Block1), block(Block2), Block1 \= Block2,
    validate(stack, Block1, Block2, CurrentState),
    perform(stack, Block1, Block2, CurrentState, NextState),
    plan(NextState, GoalState, Steps1), Steps = [putOn(Block1,Block2)|Steps1].

% Utilities

replace(_, _, [], []).
replace(O, R, [O|T], [R|T2]) :- replace(O, R, T, T2).
replace(O, R, [H|T], [H|T2]) :- dif(H,O), replace(O, R, T, T2).

find_in(Pattern, [H|_], Result) :- Pattern = H, Result = H.
find_in(Pattern, [_|R], Result) :- find_in(Pattern, R, Result).
find_in(_, [], _) :- fail.

%if the word provided is exit we can abort the execution.
read_word_list(Ws) :-
    read_line_to_codes(user_input, Cs),
    atom_codes(A, Cs),
    (A =@= exit -> abort; tokenize_atom(A, Ws)).





