Bacchus-Bosch - Part 2

game.lgt

:- object(game).
   
    :- info([
        version is 1.0,
        author is 'Victor Lagerkvist',
        date is 2011/03/09,
        comment is 'The core functionality of Bacchus-Bosch.']).

    :- public(init/0).

    init :-
         write('Welcome to Bacchus-Bosch!'), nl,
         current_input(S),
         repl(S, []).

    repl(S, History) :-
        write('> '),    
        nlp::parse_line(S, Atoms),
        write('The input is: '),
        meta::map([X] >> (write(X), write(' ')), Atoms), nl,
        nlp::tag_atoms(Atoms, AtomTags),
        write('The tagged input is: '),
        meta::map([X] >> (write(X), write(' ')), AtomTags), nl,
        (   eval(History, AtomTags) ->
            true
        ;   write('I''m sorry, Dave. I''m afraid I can''t do that'),
            nl
        ),
        repl(S, AtomTags).

    eval(History, AtomTags) :-
        nlp::resolve_pronouns(History, AtomTags, AtomTags1),
        eval_commands(AtomTags1).

    eval_commands(AtomTags) :-
        nlp::parse_atoms(AtomTags, _, Commands),
        write('The parsed commands are: '), nl,
        meta::map([X] >> (write(X), nl), Commands).

:- end_object.

game_logic.lgt

:- object(game_logic).

    :- info([
        version is 1.0,
        author is 'Victor Lagerkvist',
        date is 2011/03/09,
        comment is 'The vocabulary of Bacchus-Bosch.']).

    :- public(word/2).
    :- public(command/2).
    :- public(variants/2).

    word(entity, door).
    word(entity, key).
    word(entity, banana).

    word(direction, north). 
    word(direction, east).  
    word(direction, south). 
    word(direction, west).  

    word(preposition, above).
    word(preposition, across).
    word(preposition, against).
    word(preposition, along).
    word(preposition, around).
    word(preposition, at).
    word(preposition, before).
    word(preposition, behind).
    word(preposition, below).
    word(preposition, beneath).
    word(preposition, beside).
    word(preposition, besides).
    word(preposition, between).
    word(preposition, beyond).
    word(preposition, by).
    word(preposition, down).
    word(preposition, following).
    word(preposition, from).
    word(preposition, in).
    word(preposition, inside).
    word(preposition, near).
    word(preposition, of).
    word(preposition, off).
    word(preposition, on).
    word(preposition, onto).
    word(preposition, opposite).
    word(preposition, outside).
    word(preposition, over).
    word(preposition, past).
    word(preposition, through).
    word(preposition, to).
    word(preposition, toward).
    word(preposition, towards).
    word(preposition, under).
    word(preposition, underneath).
    word(preposition, up).
    word(preposition, upon).
    word(preposition, with).
    word(preposition, within).

    word(pronoun, anyone).
    word(pronoun, anything).
    word(pronoun, each).
    word(pronoun, either).   
    word(pronoun, everybody).
    word(pronoun, everyone).
    word(pronoun, everything).
    word(pronoun, he).
    word(pronoun, her).
    word(pronoun, herself).
    word(pronoun, him).
    word(pronoun, himself).
    word(pronoun, his).
    word(pronoun, 'I').
    word(pronoun, it).
    word(pronoun, its).
    word(pronoun, itself).
    word(pronoun, little).
    word(pronoun, me).
    word(pronoun, mine).
    word(pronoun, more).
    word(pronoun, most).
    word(pronoun, much).
    word(pronoun, myself).
    word(pronoun, neither).
    word(pronoun, nobody).
    word(pronoun, none).
    word(pronoun, one).
    word(pronoun, one).
    word(pronoun, another).
    word(pronoun, other).
    word(pronoun, she).
    word(pronoun, some).
    word(pronoun, somebody).
    word(pronoun, someone).
    word(pronoun, something).
    word(pronoun, that).
    word(pronoun, theirs).
    word(pronoun, them).
    word(pronoun, themselves).
    word(pronoun, these).
    word(pronoun, they).
    word(pronoun, this).
    word(pronoun, those).
    word(pronoun, us).
    word(pronoun, we).
    word(pronoun, what).
    word(pronoun, whatever).
    word(pronoun, which).
    word(pronoun, whichever).
    word(pronoun, who).
    word(pronoun, whoever).
    word(pronoun, whom).
    word(pronoun, whomever).
    word(pronoun, whose).
    word(pronoun, you).
    word(pronoun, yours).
    word(pronoun, yourself).
    word(pronoun, yourselves).

    word(verb, go).
    word(verb, run).
    word(verb, goto).
    word(verb, walk).
    word(verb, take).
    word(verb, open).
    word(verb, eat).
    word(verb, munch).
    word(verb, use).
    word(verb, look).
    word(verb, grab).
    word(verb, snap).
    word(verb, pick).

    word(article, a).
    word(article, an).
    word(article, the).

    word(conjunction, and).

    command(take, [entity]).
    command(look, [entity]).
    command(look, []).
    command(go, [direction]).
    command(go, [entity]).
    command(open, [entity, entity]).
    command(open, [entity]).
    command(eat, [entity]).

    variants(look ,[look, inspect]).
    variants(take, [take, grab, snap, pick]).
    variants(go, [go, goto, walk, run]).
    variants(eat, [eat, munch]).
    variants(open, [open]).

:- end_object.

loader.lgt

:- initialization((
   logtalk_load(library(metapredicates_loader)),
   logtalk_load(library(types_loader)),
   logtalk_load(game_logic),
   logtalk_load(nlp),
   logtalk_load(game),
   game::init)).

nlp.lgt

:- object(nlp).
   
    :- info([
        version is 1.0,
        author is 'Victor Lagerkvist',
        date is 2011/02/28,
        comment is 'The natural language processing primitives of Bacchus-Bosch.']).

    :- public(parse_line/2).
    :- mode(parse_line(+stream, -atoms), zero_or_more).
    :- info(parse_line/2, [
        comment is 'Reads a single line from the stream and tokenizes the characters into atoms. tokenize_input would probably be a better name!',
        argnames is ['Stream', 'Atoms']]).

    :- public(tag_atoms/2).
    :- mode(tag_atoms(+list, -list), one_or_more).
    :- info(tag_atoms/2, [
        comment is 'True if AtomTags is a list of pairs of the form Atom-Tag, where Tag is the tag corresponding to Atom.',
        argnames is ['Atoms', 'TaggedAtoms']]).

    :- public(parse_atoms/3).
    :- mode(parse_atoms(+list, -list, -command), zero_or_more).
    :- info(parse_atoms/3, [
        comment is 'True if CommandArgs is the command with arguments from AtomTags. The remainding chunk is stored in Remainder..',
        argnames is ['AtomTags', 'Remainder', 'CommandArgs']]).

    :- public(resolve_pronouns/3).
    :- mode(resolve_pronouns(+list, +list, -list), one_or_more).
    :- info(resolve_pronouns/3, [
        comment is 'True if ResolvedAtoms is the list obtained from TaggedAtoms by resolving pronouns with respect to 1.) the atoms that occur to the left of the pronoun and 2.) the atoms in History.',
        argnames is ['History', 'TaggedAtoms', 'ResolvedAtoms']]).


    resolve_pronouns(History, Xs, Ys) :-
        list::reverse(History, ReversedHistory),                      
        resolve_pronouns(ReversedHistory, Xs, [], Ys).

    resolve_pronouns(_, [], _, []).
    resolve_pronouns(History, [A-T|Xs], Pre, [Y|Ys]) :-
        (   T = pronoun ->                                     
            (   resolve_pronoun(A, Pre, Y)
            ;   resolve_pronoun(A, History, Y)
            ),
            resolve_pronouns(History, Xs, Pre, Ys)
        ;   Y = A-T,
            resolve_pronouns(History, Xs, [Y|Pre], Ys)
        ).

    %% NAME:
    %%  resolve_pronoun(Pronoun, AtomTags, X)
    %% DESCRIPTION:
    %% True if X is an entity corresponding to the pronoun resolved
    %% with the help of AtomTags. It is the caller's responsibility to
    %% make sure that AtomTags is in the correct (possibly reversed)
    %% order.
    resolve_pronoun(it, Xs, X) :-
        X = _-entity,               
        list::member(X, Xs).

    %% NAME:
    %%  parse_atoms(+AtomTags, -Remainder, -Commands)
    %% DESCRIPTION:
    %% True if Commands is a list of commands parsed from from the atoms and their
    %% tags in AtomTags. 
    parse_atoms(ATs, Remainder, Commands) :-
        sentence_chunk(ATs, Remainder, Commands).            

    %% NAME:
    %%  sentence_chunk(+AtomTags, -Remainder, -Commands)
    %% DESCRIPTION:
    %% True if Commands is a list of commands parsed from from the atoms and their
    %% tags in AtomTags. The remainder, i.e. the chunk after the
    %% sentence, is stored in Remainder (most likely just the empty list).
    sentence_chunk(ATs, Remainder, [C-Args|Cs]) :-
        command_chunk(ATs, ATs1, C),
        argument_chunk(ATs1, C, ATs2, Args),
        (   conjunction_chunk(ATs2, Remainder0, _) ->
            sentence_chunk(Remainder0, Remainder, Cs)
        ;   Cs = []
        ).

    conjunction_chunk([Conj-conjunction|ATs], ATs, Conj-conjunction).

    %% NAME:
    %%  command_chunk(+AtomTags, -Remainder, -Command)
    %% DESCRIPTION:
    %% True if Command is the command parsed from the atoms and their
    %% tags in AtomTags. The remainder, i.e. the chunk after the
    %% command, is stored in Remainder.
    command_chunk(ATs, ATs1, C) :-
        %% First find a verb, i.e. a potential command.
        list::append(_, [C0-verb|ATs1], ATs),
        %% Then check whether or not the verb is a variant of a known
        %% command.
        game_logic::variants(C, Cs),
        list::member(C0, Cs).

    %% NAME:
    %%  argument_chunk(+AtomTags, +Command, -Remainder, -Args)
    %% DESCRIPTION:
    %% True if Args are the arguments corresponding to the arity of
    %% Command with respect to the atoms and their tags in
    %% AtomTags. The remainder, i.e. the chunk after the last
    %% argument, is stored in Remainder.
    argument_chunk(ATs, C, ATs1, Args) :-
        game_logic::command(C, Tags),
        matches(ATs, Tags, ATs1, Args).

    %% NAME:
    %%  matches(+AtomTags, +Tags, -Remainder, -Args).
    %% DESCRIPTION:
    %%  True if the list of atoms and their corresponding tags matches
    %%  Tags, i.e. there exists a sequence of atoms, not necessarily
    %%  in a a direct linear sequence, such that their tags can be
    %%  mapped to the tags in Tags.
    matches(ATs, [], ATs, []).  
    matches(ATs, [T|Ts], Remainder, [A|As]) :-
        list::append(_, [A-T|ATs1], ATs),
        matches(ATs1, Ts, Remainder, As).

    tag_atoms(As, Ts) :-
        tag_atoms(As, [], Ts).        

    tag_atoms([], _, []).
    tag_atoms([A|As], Pre, [A-T|Ts]) :-
        tag(Pre, A, T),
        tag_atoms(As, [A-T|Pre],Ts).
    tag_atoms([A|As], Pre, [A-unknown|Ts]) :-
        %We don't use a cut since we want the ability to try several
        %different tags if necessary.
        \+ tag(Pre, A, _),
        tag_atoms(As, [A-unknown|Pre], Ts).     

    %% NAME:
    %%  tag(+Preceding, -Word, -Tag).
    %% DESCRIPTION:
    %%  True if Tag is the tag corresponding to Word. Preceding is used
    %%  whenever a rule needs to look at the history in order to tag the
    %%  word.
    tag([_-article|_], _, entity).
    tag(_, A, T) :-
        game_logic::word(T, A).

    parse_line(S, As) :-
        read_line(S, Cs),
        phrase(chars_to_list(As), Cs).

    read_line(S, Chars) :-
        get_char(S, C),
        read_line(C, S, Chars).

    read_line('\n', _, []) :- !.
    read_line(C, S, [C|Chars]) :- read_line(S, Chars).

    chars_to_list([A|As]) -->
        chars_to_atom(A),
        whitespace,
        chars_to_list(As).
    chars_to_list([A]) -->
        chars_to_atom(A),
        opt_whitespace.

    blank --> [' '].

    opt_whitespace --> [].
    opt_whitespace --> whitespace.

    whitespace --> blank, whitespace.   
    whitespace --> blank.

    chars_to_atom(A) -->
        chars(Cs),
        {atom_chars(A, Cs)}.

    chars([C|Cs]) -->
        char(C),
        chars(Cs).      
    chars([C]) --> char(C).

    %This might be a bit too permissive, but who cares! 
    char(C) --> [C], {C \= ' ', C \= '\n'}. 

:- end_object.