<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">
%%%%%%%%%%%%%
%%% 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 %%%
%%%%%%%%%%%%%
%Added messages for possible errors
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, good) :- clear(Block, State), empty_hand(State).
validate(pickup, Block, State, error) :- \+ clear(Block, State),
	write("The block is currently under another block."), nl.
validate(pickup, Block, State, error) :- clear(Block, State),
	\+ empty_hand(State),
	write("Your hand is currently not empy."), nl.
	
validate(unstack, Block, State, good) :- clear(Block, State), empty_hand(State).
validate(unstack, Block, State, error) :-
	\+ clear(Block, State),
	write("The block is currently under another block."), nl.
validate(unstack, _, State, error) :-
	\+ empty_hand(State),
	write("your hand is currently not empty"), nl.
	
validate(put, Block, table, State, good) :- clear(Block, State), 
    (empty_hand(State) ; holding(State, Block)).
validate(put, Block, table, State, error) :- \+ clear(Block, State), 
    write("The block is currently under another block."), nl.

validate(pickup, Block1, Block2, State, good) :- Block1 \= Block2, clear(Block1, State), is_on(Block1, Block2, State),
    (empty_hand(State)).
validate(pickup, Block1, _, State, error) :-
	\+ clear(Block1, State),
	write("The block is currently under another block."), nl.
validate(pickup, Block1, Block2, State, error) :-
	\+ is_on(Block1, Block2, State),
	write("Those blocks are not on top of each other."), nl.
validate(pickup, _, _, State, error) :-
	\+ empty_hand(State),
	write("Your hand it currently not empty."), nl.
	
validate(put, Block1, Block2, State, good) :- Block1 \= Block2, clear(Block1, State), clear(Block2, State),
    (empty_hand(State) ; holding(State, Block1)).
validate(put, Block1, _, State, error) :-
	\+ clear(Block1, State),
    write("The block you're trying to pickup is currently under another block."), nl.
validate(put, _, Block2, State, error) :-
	\+ clear(Block2, State),
    write("The block you're trying to put onto is currently under another block."), nl.
validate(put, _, _, _, error) :-
	write("I couldn't put those blocks on each other"), nl.

validate(stack, Block1, Block2, State, good) :- Block1 \= Block2, clear(Block1, State), clear(Block2, State),
    (empty_hand(State) ; holding(State, Block1)).
validate(stack, Block1, _, State, error) :-
	\+ clear(Block1, State),
    write("The block you're trying to pickup is currently under another block."), nl.
validate(stack, _, Block2, State, error) :-
	\+ clear(Block2, State),
    write("The block you're trying to place onto is currently under another block."), nl.
validate(stack, _, _, _, error) :-
	write("I couldn't stack those blocks"), nl.

validate(unstack, Block1, Block2, State, good) :- Block1 \= Block2, clear(Block1, State), is_on(Block1, Block2, State),
    (empty_hand(State)).
validate(unstack, Block1, _, State, error) :- 
	\+ clear(Block1, State),
	write("The block is currently under another block.").
validate(unstack, Block1, Block2, State, error) :-
	\+ is_on(Block1, Block2, State),
	write("Those blocks are not on top of each other."), nl.
validate(unstack, _, _, State, error) :-
	\+ empty_hand(State),
	write("Your hand it currently not empty."), nl.	

%Don't allow for block to be spawned ambiguiously
validate(_, Block1, Block2, _, error) :-
	Block1 == Block2,
	write("The two blocks cannot be equal to each other"), nl.
    
	
perform(pickup, Block, State, NewState, good) :- replace(on(Block,_), hand(Block), State, NewState).
perform(unstack, Block, State, NewState, good) :- replace(on(Block,_), hand(Block), State, NewState).
perform(put, Block1, Target, State, NewState, good) :- perform(pickup, Block1, State, State1, good),
    replace(hand(Block1), on(Block1, Target), State1, NewState).
perform(stack, Block1, Target, State, NewState, good) :- perform(pickup, Block1, State, State1, good),
    replace(hand(Block1), on(Block1, Target), State1, NewState).
perform(_, _, _, _, _, error) :- write("I couldn't perform that action."), nl.

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

%% Parsing %%

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

%% Extracting Verbs and NPs %%

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

%% Reference Resolution %%
%Added error messages for possible errors

%% 2-adjective
resolve_ref(NP, _, Block, good) :- NP = np(_, adjp(a(Size), adjp(a(Color))), n(block)), 
    size(Block, Size), color(Block, Color).
resolve_ref(NP, _, Block, good) :- NP = np(_, adjp(a(Color), adjp(a(Size))), n(block)), 
    size(Block, Size), color(Block, Color).
    
	
%% 1-adjective
%Added functions to find if the two requested blocks are stacked
resolve_ref(NP2, State, Block, good, Block1) :-
	NP2 = np(_, adjp(a(Adjective)), n(block)), 
    member(on(Block1, Block), State),
    (findall(Block, size(Block, Adjective), [Block]) ; 
     findall(Block, color(Block, Adjective), [Block])),
    clear(Block1, State).
resolve_ref(NP2, State, Block, error, Block1) :-
	NP2 = np(_, adjp(a(Adjective)), n(block)), 
    member(on(Block1, Block), State),
    (findall(Block, size(Block, Adjective), [Block]) ; 
     findall(Block, color(Block, Adjective), [Block])),
    \+ clear(Block1, State),
	write("The block is currently under another block."), nl.
resolve_ref(_, _, _, error, _) :-
	write("Those two blocks are not on top of each other."), nl.
	
resolve_ref(NP, State, Block, good) :- NP = np(_, adjp(a(Adjective)), n(block)), 
    member(on(Block, _), State),
    (findall(Block, size(Block, Adjective), [Block]) ; 
     findall(Block, color(Block, Adjective), [Block])),
    clear(Block, State).
	
resolve_ref(NP, State, Block, error) :- NP = np(_, adjp(a(_)), n(block)), 
    \+ member(on(Block, _), State),
	write("Somehow, all the blocks have dissapeared or cannot be refenced."), nl,
	write("So sorry about that..."), nl.
	
resolve_ref(NP, State, Block, error) :- NP = np(_, adjp(a(Adjective)), n(block)), 
    member(on(Block, _), State),
    (findall(Block, size(Block, Adjective), [Block]) ; 
     findall(Block, color(Block, Adjective), [Block])),
    \+ clear(Block, State),
	write("The block is currently under another block."), nl.

resolve_ref(NP, State, Block, error) :- NP = np(_, adjp(a(Adjective)), n(block)), 
    member(on(Block, _), State),
    (findall(Block, size(Block, Adjective), [Block]) ; 
     findall(Block, color(Block, Adjective), [Block])),
    \+ clear(Block, State),
	write("The block is currently under another block."), nl.


%% 0-adjective  
resolve_ref(NP, State, Block, good) :- NP = np(d(the), n(block)), member(hand(Block), State).
resolve_ref(NP, State, Block, error) :- NP = np(d(the), n(block)),
	\+ member(hand(Block), State),
	write("There is no block in your hand."), nl.

resolve_ref(NP, _, table, good) :- 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 %%%
%%%%%%%%%%%%%%%%%

%Added error returns for all possibilities
%Added new perform_act to check if two blocks are stacked
perform_act(Parse, _, _, exit) :- extract(Parse, Verb),
	Verb == exit.
perform_act(Parse, State, NewState, good) :- extract(Parse, Verb, NP), 
    resolve_ref(NP, State, Block, good), 
    validate(Verb, Block, State, good), 
    perform(Verb, Block, State, NewState, good).
perform_act(Parse, State, NewState, good) :- extract(Parse, Verb, NP1, NP2), 
    resolve_ref(NP1, State, Block1, good), 
    resolve_ref(NP2, State, Block2, good), 
    validate(Verb, Block1, Block2, State, good), 
    (perform(Verb, Block1, State, NewState, good) ; perform(Verb, Block1, Block2, State, NewState, good)).
perform_act(Parse, State, NewState, good) :- extract(Parse, Verb, NP1, NP2), 
    resolve_ref(NP1, State, Block1, good), 
    resolve_ref(NP2, State, Block2, good, Block1), 
    validate(Verb, Block1, Block2, State, good), 
    (perform(Verb, Block1, State, NewState, good) ; perform(Verb, Block1, Block2, State, NewState, good)).

perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP),
	resolve_ref(NP, State, _, error),
	NewState = State.
perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP),
	resolve_ref(NP, State, _, good),
	validate(_, _, State, error), 
	NewState = State.
perform_act(Parse, State, NewState, good) :- extract(Parse, Verb, NP), 
    resolve_ref(NP, State, Block, good), 
    validate(Verb, Block, State, good), 
    perform(Verb, Block, State, NewState, error),
	NewState = State.
	
perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP1, _),
	resolve_ref(NP1, State, _, error),
	NewState = State.
perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP1, NP2),
	resolve_ref(NP1, State, _, good),
	resolve_ref(NP2, State, _, error),
	NewState = State.
perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP1, NP2),
	resolve_ref(NP1, State, _, good),
	resolve_ref(NP2, State, _, good),
	validate(_, _, _, State, error), 
	NewState = State.
perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP1, NP2),
	resolve_ref(NP1, State, _, good),
	resolve_ref(NP2, State, _, good),
	validate(Verb, Block1, Block2, State, good),
	(perform(Verb, Block1, State, NewState, error) ; perform(Verb, Block1, Block2, State, NewState, error)),	
	NewState = State.

perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP1, _),
	resolve_ref(NP1, State, _, error),
	NewState = State.
perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP1, NP2),
	resolve_ref(NP1, State, _, good),
	resolve_ref(NP2, State, _, error, _),
	NewState = State.
perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP1, NP2),
	resolve_ref(NP1, State, _, good),
	resolve_ref(NP2, State, _, good, _),
	validate(_, _, _, State, error), 
	NewState = State.
perform_act(Parse, State, NewState, error) :- extract(Parse, _, NP1, NP2),
	resolve_ref(NP1, State, _, good),
	resolve_ref(NP2, State, _, good, _),
	validate(Verb, Block1, Block2, State, good),
	(perform(Verb, Block1, State, NewState, error) ; perform(Verb, Block1, Block2, State, NewState, error)),	
	NewState = State.
	
	
display_state(good, State) :-
	write("Currently..."), nl,
	nlg(State).
	
display_state(error, _).

	
action(Input, State) :-
	sentence(Parse, Input, []),
	perform_act(Parse, State, _, exit),
	write("Exiting talktome..."), nl.

action(Input, State) :-
	sentence(Parse, Input, []),
	perform_act(Parse, State, NewState, Status),
	display_state(Status, NewState),
	talktome(NewState).

action(Input, State) :-
	\+ sentence(_, Input, []),
	NewState = State,
	write("I couldn't understand that. Are you using proper words?"), nl,
	talktome(NewState).
	
action(Input, State) :-
	sentence(Parse, Input, []),
	\+ perform_act(Parse, State, _, _),
	NewState = State,
	write("That action could not be performed."), nl,
	talktome(NewState).
	

process_input(State) :- read_word_list(Input), 
    action(Input, State).
	
process_input(State) :- write("I'm not sure how to do that."), nl, talktome(State).

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

%% Simple, horribly inefficient, brute-force plan
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].
	
%Simple function to put a list in reverse order
reverse_list(Xs, Ys) :-
	reverse(Xs, [], Ys, Ys).	
reverse([], Ys, Ys, []).
reverse([X|Xs], Rs, Ys, [_|Bound]):-
	reverse(Xs, [X|Rs], Ys, Bound).


%%Level Plan.
%Running level_plan(X). will return X as the list of steps required to reach
%the given final state.
%This heuristic determines the "levels" that each block is on, and uses this information
%to stack the blocks one level at a time from top to bottom. I chose this heuristic because
%the most natural way to visualize blocks is as one block on top of another, creating
%different levels of stacked blocks. To reach the final state, execute_plan uses 
%the list of the levels to work its way up the tower stacking blocks.

%work_level: Takes the plan separated into levels from bottom to top, and works
%to provide a list of stacking steps to reach the final state.
work_level([Head|Tail], InitialState, FinalState, Steps, FinalSteps):-
	Tail \= [],
	member(on(Head, Block), FinalState),
	perform(stack, Head, Block, InitialState, NewState, good),
	NewSteps = [stack(Head, Block)|Steps],
	work_level(Tail, NewState, FinalState, NewSteps, FinalSteps).	
work_level([Head|Tail], InitialState, FinalState, Steps, FinalSteps):-
	member(on(Head, Block), FinalState),
	perform(stack, Head, Block, InitialState, NewState, good),
	FinalSteps = [stack(Head, Block)|Steps].	
work_level([[Head|MidTail]|Tail], InitialState, FinalState, Steps, FinalSteps):-
	member(on(Head, Block), FinalState),
	perform(stack, Head, Block, InitialState, NewState, good),
	NewSteps = [stack(Head, Block)|Steps],
	work_level([MidTail|Tail], NewState, FinalState, NewSteps, FinalSteps).

execute_plan(start, [Head|Tail], InitialState, FinalState, Steps):-
	work_level(Tail, InitialState, FinalState, [], Steps).

%level_plan: Runs through the final state and creates a list of the blocks separated
%into individual levels ordered from top to bottom. The list is reversed by reverse 
%to make it more easily read by execute_plan.
level_plan(Display):-
	initial_state(InitialState),
	final_state(FinalState),
	level_plan(start, InitialState, FinalState, Levels, FinalLevel),
	reverse(FinalLevel, Plan),
	execute_plan(start, Plan, InitialState, FinalState, Steps),
	reverse(Steps, Display).	
level_plan(start, InitialState, FinalState, Levels, FinalLevel):-
	findall(Block, member(on(Block, table), FinalState), Level),
	Levels = [Level],
	level_plan(InitialState, FinalState, Levels, Level, FinalLevel).
level_plan(InitialState, FinalState, Levels, [Previous], FinalLevel):-
	clear(Previous, FinalState),
	FinalLevel = Levels.	
level_plan(InitialState, FinalState, Levels, [Previous|Next], FinalLevel):-
	clear(Previous, FinalState),
	level_plan(InitialState, FinalState, Levels, Next, FinalLevel).	
level_plan(InitialState, FinalState, Levels, [Previous|Next], FinalLevel):-
	clear(Previous, FinalState),
	level_plan(InitialState, FinalState, Levels, [Next], FinalLevel).	
level_plan(InitialState, FinalState, Levels, [Previous|Next], FinalLevel):-
	member(on(Block, Previous), FinalState),
	NewCurrent = [Block],
	level_plan(InitialState, FinalState, Levels, Next, NewCurrent, FinalLevel).	
level_plan(InitialState, FinalState, Levels, [Previous|Next], FinalLevel):-
	member(on(Block, Previous), FinalState),
	NewCurrent = [Block],
	level_plan(InitialState, FinalState, Levels, [Next], NewCurrent, FinalLevel).
level_plan(InitialState, FinalState, Levels, [Previous|Next], [Current], FinalLevel):-
	member(on(Block, Previous), FinalState),
	NewCurrent = [Block|Current],
	level_plan(InitialState, FinalState, Levels, Next, NewCurrent, FinalLevel).	
level_plan(InitialState, FinalState, Levels, [Previous|Next], [Current], FinalLevel):-
	member(on(Block, Previous), FinalState),
	NewCurrent = [Block|Current],
	Next = [],
	NewLevels = [NewCurrent|Levels],
	level_plan(InitialState, FinalState, NewLevels, NewCurrent, FinalLevel).	
level_plan(InitialState, FinalState, Levels, [Previous|Next], [Current], FinalLevel):-
	Previous = Next,
	member(on(Block, Previous), FinalState),
	NewCurrent = [Block|Current],
	NewLevels = [NewCurrent|Levels],
	level_plan(InitialState, FinalState, NewLevels, NewCurrent, FinalLevel).	
level_plan(InitialState, FinalState, Levels, [Previous|Next], [Current], FinalLevel):-
	clear(Previous, FinalState),
	level_plan(InitialState, FinalState, Levels, [Next], [Current], FinalLevel).	
level_plan(InitialState, FinalState, Levels, [], [Current], FinalLevel):-
	NewLevels = [Current|Levels],
	level_plan(InitialState, FinalState, NewLevels, [Current], FinalLevel).

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

read_word_list(Ws) :-
    read_line_to_codes(user_input, Cs),
    atom_codes(A, Cs),
    tokenize_atom(A, Ws).</pre></body></html>