% MDS 03/03/02
% Simple dialogue

% data structures
% context:
%
%  cx(Questions,
%     Proposals,
%     History,
%     KB)
%
% history:
%
%  last(utterance,
%       analysis,
%       prior context)

%%%%%%%%%%%%%%%%%%%%%
% COMMENT OUT FOR SWI

member(E, [E|_]).
member(E, [_|L]) :- member(E,L).

% SETUP

questions(cx(Q,_,_,_), Q).
proposals(cx(_,P,_,_), P).
history(cx(_,_,H,_), H).
shared(cx(_,_,_,K), K).

initial_context( cx([], [], [], KB) ) :-
	initial_kb( KB ).

talk :-
	initial_context(C),
	react(C).

hear(U) :-
	write( 'A: ' ),
	read( U ).

utter(U) :-
	write( 'B: ' ),
	write( U ),
	write( '.' ),
	nl.

% RATIONALITY - a perception, deliberation, action cycle.

react(C) :-
	shared(C, K),
	member(over, K),
	!.

react(C) :-
	print_status(C),
	hear(U),
	interpretations(U, C, C2L), 
	deliberate( U, C, C2L, G, CM ),
	force_to_debug(U, U2),
	act(G, CM, U2, C2),
	!,
	print_status(CM),
	utter(U2),
	react(C2).

% INTERPRETATION means finding the least cost
% matches against the context for the utterances
% you find.

interpretations( U, C, C2 ) :-
	findall(i(W,Cm), interpret(U, C, Cm, W), Ls),
	min(Ls, W),
	findall(Cm, member(i(W,Cm), Ls), C2).

interpret( U, C, C2, W ) :-
	possible_utterance(U, P, _A, C, C2, W),
	solve(P, C).

% DELIBERATION means incrementing the state of
% the conversation to respond to your obligations
% and goals as best you can.

deliberate( _, _, [CL], G, Cm ) :-
	!,
	update(CL, G, Cm).

deliberate( U, 
	    cx(Q, P, H, KB), 
	    [], 
	    [h(not_understood(U,H))], 
	    cx(Q, P, last(U, [], cx(Q, P, H, KB)), KB) ) :-
	!.

deliberate( _, _, Is, _, _) :-
	write('Incomplete definition:\n'),
	write('No way to deal with interpretations\n'),
	write(Is),
	write('.\n'),
	!,
	fail.
	
% ACTION means finding the least cost utterance
% that achieves your goals unambiguously.

act( G, C, U, C2 ) :-
	findall(i(W, (U, C2)), generate(G, C, U, C2, W), Ls),
	min(Ls, W),
	member(i(W, (U, C2)), Ls).

act( G, C, _, _ ) :-
	write('Warning: No way to achieve goal\n  '),
	print(G),
	write(' in context:\n'),
	print_error(C),
	!,
	fail.

generate( G, C, U, C2, W ) :-
	possible_utterance(U, P, A, C, C2, W),
	solve(G, C2),
	solve(P, C),
	call(A),
	interpretations(U, C, [C2]).

% COMPUTATIONAL RESOURCES
%
% SOLVE CONSTRAINTS ON THE CONTEXT

solve([], _).
solve([C | Cs], Cxt) :-
	match(C, Cxt),
	solve(Cs, Cxt).

match( q(C), Cxt ) :-
	questions(Cxt, Qs),
	member(C, Qs).
match( p(C), Cxt ) :-
	proposals(Cxt, Pls),
	member(Ps, Pls),
	member(C, Ps).
match( h(C), Cxt ) :-
	history(Cxt, last(_,HL,HC)),
	(member(C, HL) ;
	 match( h(C), HC)).
match( s(C), Cxt ) :-
	shared(Cxt, Ss),
	member(C, Ss).
match( x(C), _ ) :-
	call(C).

match( \+(P), Cxt) :-
	\+ match(P, Cxt).

% MIN

min([], 0).
min([ i(W,_) | R ], Z) :-
	min(W, R, Z).

min(W, [], W).
min(W, [i(W2,_)|R], Z) :-
	W > W2 ->
	min(W2, R, Z)
    ;   min(W, R, Z).

% DATA RESOURCES
%
% POSSIBLE UTTERANCES

possible_utterance([i,dont,understand],
	           [],
		   true,
		   cx(Q, P, last(U, I, cx(Q2, P2, H2, K2)), K),
		   cx(Q2, P2, last([i,dont,understand], 
		                   [not_understood(U, H2)],
				   cx(Q, P, last(U, I, cx(Q2, P2, H2, K2)), 
				      K)), 
 		      K2),
		   10).

possible_utterance([ok],
	           [],
		   true,
		   cx([Q1|Q], [[P1]|P], H, KB),
		   cx(Q, P, 
		      last(ok, [ok:P1], cx([Q1|Q], [P1|P], H, KB)), 
		      [P1|KB]),
		   1) :-
	\+ \+ (Q1 = P1).

possible_utterance([],
	           [],
		   true,
		   C,
		   C,
		   0).

possible_utterance([goodbye],
	           [],
		   true,
		   cx([over], [[over]], H, KB),
		   cx([], [], last(goodbye, [], cx([over], [over], H, KB)), 
		      [over|KB]),
		   0).

possible_utterance([goodbye],
	           [],
		   true,
		   cx([], [], H, KB),
		   cx([over], [[over]], 
		      last(goodbye, [], cx([], [], H, KB)), 
		      KB),
		   2).

possible_utterance([lets,build,a,shelf],
	           [x(building(A,K)), x(kind(K,shelf))],
		   goal(A),
		   cx(Q,P,H,KB),
		   cx([goal(A)|Q],[[goal(A)] | P], 
		      last([lets,build,a,shelf],
		           [build:A, shelf:K], 
			   cx(Q,P,H,KB)),
		      KB),
		   3).

possible_utterance([what,should,we,do],
	           [s(goal(G))],
		   needinfo(method(G,_)),
		   cx(Q, P, H, KB),
		   cx([method(G,_) | Q], [[]|P], 
		      last([what,should,we,do],
		           [should:G],
			   cx(Q, P, H, KB)),
	              KB),
		   3).

possible_utterance([use,pine,boards],
	           [q(method(G,_)), 
		    x(using(A,K)), 
		    x(kind(K,boards)), 
		    \+ s(bad(method(G,A)))],
		   method(G,A),
		   cx(Q, [[]|P], H, KB),
		   cx(Q, [[method(G,A)]|P], 
		      last([use,pine,boards],
		           [use:A, boards:K],
			   cx(Q,[[]|P],H,KB)), 
		      KB),
		   3).

possible_utterance([use,plywood],
	           [q(method(G,_)), 
		    x(using(A,K)), 
		    x(kind(K,plywood)), 
		    \+ s(bad(method(G,A)))],
		   method(G,A),
		   cx(Q, [[]|P], H, KB),
		   cx(Q, [[method(G,A)]|P], 
		      last([use,plywood],
		           [use:A, plywood:K],
			   cx(Q,P,H,KB)), 
		      KB),
		   3).

possible_utterance([that,wont,work],
	           [],
		   bad(method(G,A)),
		   cx(Q, [[method(G,A)] | P], H, KB),
		   cx(Q, [[]|P], 
                      last([that,wont,work], [that:A],
		           cx(Q, [[method(G,A)] | P], H, KB)), 
		      [bad(method(G,A))|KB]),
		   3).

possible_utterance([you,can,say,L],
	           [],
		   findall(U, generate([], 
		                       cx(Q, P, H, KB),
				       U, _, _), L),
		   cx([whatnow(Hx,V) | Q], [[]|P], H, KB),
		   cx(Q, P, 
		      last([you,can,say,L], [],
		           cx([whatnow(Hx,V) | Q], [[]|P], H, KB)),
		      [whatnow(Hx,L) | KB]),
                   0).

possible_utterance([what,can,i,say],
	           [],
		   needinfo(whatnow(H,L)),
		   cx(Q, P, H, KB),
		   cx([whatnow(H,L) | Q], [[]|P], 
		      last([what,can,i,say], [], cx(Q,P,H,KB)), 
		      KB),
		   10).

% UPDATES

update( cx(Q,[[P]|Ps],H,K), 
	[s(P)],
	cx(Q,[[P]|Ps],H,K) ) :-
	\+ bad(P).

update( cx(Q,[[P]|Ps],H,K), 
	[s(bad(P))],
	cx(Q,[[P]|Ps],H,K) ) :-
	bad(P).

update( cx([Q|Qs], [[]|Ps], H, K),
	[p(P)],
	cx([Q|Qs], [[]|Ps], H, K) ) :-
	findall(P, P=Q, [P]).

update( cx([Q|Qs], [[]|Ps], H, K),
	[s(P)],
	cx([Q|Qs], [[]|Ps], H, K) ) :-
	findall(P, P=Q, [P]).

update( cx([], [], H, K),
	[p(goal(A))],
	cx([], [], H, K) ) :-
	goal(A),
	\+ member(goal(A),K).

update( cx([], [], H, K),
	[q(A)],
	cx([], [], H, K) ) :-
	needinfo(A),
	\+ member(A,K).

update( cx([], [], H, K),
	[],
	cx([], [], H, K) ).

update( C, _, _ ) :-
	write('Error: no rule to update context\n'),
	print_error(C),
	!,
	fail.
	
% INITIAL KNOWLEDGE BASE

initial_kb([]).

% STATIC UNCONTROVERSIAL SHARED BACKGROUND

building(building_shelf_action, shelf_kind).
using(building_shelf_with_pine_action, pine_board_kind).
using(building_shelf_with_plywood_action, plywood_kind).

kind(shelf_kind, shelf).
kind(pine_board_kind, boards).
kind(plywood_kind, plywood).

method(building_shelf_action, building_shelf_with_pine_action).
method(building_shelf_action, building_shelf_with_plywood_action).

% SHUT UP ERROR MESSAGES.

:- dynamic(goal/1).
:- dynamic(needinfo/1).
:- dynamic(bad/1).

goal(building_shelf_action).
needinfo(method(building_shelf_action,_)).
bad(method(building_shelf_action,building_shelf_with_plywood_action)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% DEBUGGABILITY

:- dynamic(state_info/1).
:- dynamic(error_info/1).
:- dynamic(debug_response/2).

error_info(last).
error_info(questions).
error_info(kb).

state(Q) :-
	member(Q, [last,questions,history,kb]),
	!,
	assert(state_info(Q)).
state(_) :-
	write('No such options: choose from\n'),
	write([last,questions,history,kb]).
nostate(Q) :-
	member(Q, [last,questions,history,kb]),
	!,
	retractall(state_info(Q)).
nostate(_) :-
	write('No such options: choose from\n'),
	write([last,questions,history,kb]).

error(Q) :-
	member(Q, [last,questions,history,kb]),
	!,
	assert(error_info(Q)).
error(_) :-
	write('No such options: choose from\n'),
	write([last,questions,history,kb]).
noerror(Q) :-
	member(Q, [last,questions,history,kb]),
	!,
	retractall(error_info(Q)).
noerror(_) :-
	write('No such options: choose from\n'),
	write([last,questions,history,kb]).

print_question_status([], []) :-
    !,
    write('no (other) questions being considered.\n').
print_question_status([Q|Qs], [[]|Ps]) :-
    !,
    write('need to answer question '),
    print(Q),
    write('? ...then\n'),
    print_question_status(Qs, Ps).
print_question_status([Q|Qs], [[P]|Ps]) :-
    !,
    write('considering '),
    print(P),
    write('\n   as resolution of '),
    print(Q),
    write('? ...then\n'),
    print_question_status(Qs, Ps).
print_question_status([Q|Qs], [P|Ps]) :-
	write('Data structure error: bad proposal '),
	print(P),
	write(' for question '),
	print(Q),
	write('. then\n'),
	print_question_status(Qs, Ps).
print_question_status(Q, []) :-
	write('Data structure error: extra questions '),
	print(Q),
	write('.\n').
print_question_status([], P) :-
	write('Data structure error: extra proposals '),
	print(P),
	write('.\n').

print_history(last(U, R, cx(_, _, H2, _))) :-
	!,
	print_history(H2),
	print(U),
	write(' understood as '),
	print(R),
	write('.\n').
print_history([]) :-
	!.
print_history(H) :-
	write('Data structure error: history '),
	print(H),
	write('\nshould have format last(U, R, Context).\n').

print_top_history(last(U, R, _)) :-
	!,
	write('Just understood utterance '),
	print(U),
	write('\n   with reference '),
	print(R),
	write('.\n').
print_top_history([]) :-
	!.
print_top_history(D) :-
	write('Data structure error: history '),
	print(D),
	write('\nshould take the form last(U, R, C)\n').

print_kb([]).
print_kb([H|R]) :-
	print(H),
	write('.\n'),
	print_kb(R).

print_status(cx(Q, P, H, KB)) :-
    (state_info(last) ->
	print_top_history(H)
    ;   true),
    (state_info(questions) ->
	print_question_status(Q, P)
    ;   true),
    (state_info(history) ->
	write('Discourse history:\n'),
	print_history(H)
    ;   true),
    (state_info(kb) ->
	write('Knowledge base:\n'),
	print_kb(KB)
    ;   true).

print_error(cx(Q, P, H, KB)) :-
    (error_info(last) ->
	print_top_history(H)
    ;   true),
    (error_info(questions) ->
	print_question_status(Q, P)
    ;   true),
    (error_info(history) ->
	write('Discourse history:\n'),
	print_history(H)
    ;   true),
    (error_info(kb) ->
	write('Knowledge base:\n'),
	print_kb(KB)
    ;   true).

force_to_debug(U, U2) :-
	debug_response(U, U2),
	!.
force_to_debug(_, _).