Eliza in Erlang

Contents hide

Introduction

This is Chapter 5 of the book PAIP. It implemented an early-day algorithm to dialog with a machine. It had the appearance of AI, but actually it was just another interpreter: programmer designs some rules at first, and then eval the user’s input. The main topic is pattern-match programming.

Pattern-match is really my favorite language feature. Erlang and many functional programming languages (Oz, ML, …) support it quite well. C language offers switch statement which can only match constant expression in each clause. Different languages may have different scopes for pattern variables.

Implementation in Erlang

The code is https://github.com/kainwen/paip/tree/master/eliza. It consists of 3 modules:

pm2.erl: implement pattern-match algorithm for simple variable and segment variable
bindings.erl: implement the bindings data structure to store pattern-match result
eliza.erl: the eliza program which dialog with you

There are some issues with this implementation but the core idea is gotten:

Erlang does not treat lower case the same for upper case atoms
Erlang’s cons can only return a list

The full code (with demo run at the end):

-type varname() :: atom().
-type simple_var() :: {var, varname()}.
-type segment_var() :: {segvar, varname()}.
-type var() :: simple_var()
	     | segment_var().
-type ground_pattern() :: atom()
			| simple_var() 
			| segment_var().
-type pattern() :: [ground_pattern()].

-type key() :: varname().
-type val() :: [atom()].
-type bindings() :: [{key(), val()}].

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

-module(pm2).

-export([parse/1, pattern_match/2, sublis/2]).

-include("pm2_type.hrl").

-include_lib("eunit/include/eunit.hrl").

-spec pattern_match(pattern(), [atom()]) -> {boolean(), bindings()}.
pattern_match(Pattern, Input) ->
    pattern_match(Pattern, Input, bindings:empty()).

-spec pattern_match(pattern(), [atom()], bindings()) -> {boolean(), bindings()}.
pattern_match([], [], B) -> {true, B};
pattern_match([], _, _B) -> {false, []};
pattern_match([Var={var, _}|Pt], Input, B) ->
    handle_simple_var(Var, Pt, Input, B);
pattern_match([Segvar={segvar, _}|Pt], Input, B) ->
    handle_segment_var(Segvar, Pt, Input, B);
pattern_match(_, [], _B) -> {false, []};
pattern_match([P|Ps], [I|Is], B) when is_atom(P), is_atom(I) ->
    case P =:= I of
	true ->
	    pattern_match(Ps, Is, B);
	false ->
	    {false, []}
    end.

-spec handle_simple_var(simple_var(), pattern(), [atom()], bindings()) -> {boolean(), bindings()}.
handle_simple_var(_Var, _Pt, [], _B) -> {false, []}; %% Var at least represent one atom
handle_simple_var(Var, Pt, [I|Is], B) ->
    case bindings:lookup(B, var_name(Var)) of
	not_found ->
	    NB = bindings:extend(B, var_name(Var), [I]),
	    pattern_match(Pt, Is, NB);
	{ok, I} ->
    	    pattern_match(Pt, Is, B);
	_ ->
	    {false, []}
    end.

-spec handle_segment_var(segment_var(), pattern(), [atom()], bindings()) -> {boolean(), bindings()}.
handle_segment_var(Segvar, Pt, Input, B) ->
    case bindings:lookup(B, var_name(Segvar)) of
	not_found ->
	    case Pt of
		[] ->
		    {true, bindings:extend(B, var_name(Segvar), Input)};
		[P|Ps] when is_atom(P) ->
		    handle_segment_var(Segvar, P, Ps, Input, B, 0);
		_ ->
		    {false, []}
	    end;
	{ok, Is} ->
	    case lists:prefix(Is, Input) of
		true ->
		    RemInput = lists:nthtail(length(Is), Input),
		    pattern_match(Pt, RemInput, B);
		false ->
		    {false, []}
	    end
    end.

-spec handle_segment_var(segment_var(), atom(), pattern(), [atom()], bindings(), integer()) -> {boolean(), bindings()}.
handle_segment_var(_Segvar, _P, _Pt, Input, _B, StartPos) when StartPos >= length(Input) ->
    {false, []};
handle_segment_var(Segvar, P, Pt, Input, B, StartPos) ->
    case split_list(Input, P, StartPos) of
	not_found ->
	    {false, []};	     
	{Pos, {H, T}} ->
	    case pattern_match(Pt, T, B) of
		{false, []} ->
		    handle_segment_var(Segvar, P, Pt, Input, B, Pos);
		{true, NB} ->
		    case bindings:lookup(NB, var_name(Segvar)) of
			not_found ->
			    NNB = bindings:extend(NB, var_name(Segvar), H),
			    {true, NNB};
			{ok, H} ->
			    {true, NB};
			_ ->
			    handle_segment_var(Segvar, P, Pt, Input, B, Pos)
		    end
	    end
    end.

%% List index is 1-based.
%% split_list find the A in As with index > Pos
-type split_result() :: not_found
		      | {integer(), {[atom()], [atom()]}}.
-spec split_list([atom()], atom(), integer()) -> split_result().
split_list(As, _A, Pos) when Pos >= length(As) -> not_found;
split_list(As, A, Pos) ->
    {_H, T} = lists:split(Pos, As),
    R = lists:dropwhile(fun (E) -> E =/= A end, T),
    case R of
	[] ->
	    not_found;
	[A|R1] ->
	    HeadLen = length(As) - 1 - length(R1),
	    {HeadLen+1, {lists:sublist(As, HeadLen), R1}}
    end.

-spec parse(string()) -> pattern().
parse(S) ->
    Ss = string:split(S, " ", all),
    [parse_ground_pattern(Str)
     || Str <- Ss].

-spec parse_ground_pattern(string()) -> ground_pattern().
parse_ground_pattern(S) ->
    case string:prefix(S, "?*") of
	nomatch ->
	    case string:prefix(S, "?") of
		nomatch ->
		    list_to_atom(S);
		X ->
		    {var, list_to_atom(X)}
	    end;
	Y ->
	    {segvar, list_to_atom(Y)}
    end.

-spec sublis(pattern(), bindings()) -> [atom()].
sublis(Pt, B) ->
    lists:flatmap(fun (P) ->
			  case is_atom(P) of
			      true ->
				  [P];
			      false ->
				  case bindings:lookup(B, var_name(P)) of
				      not_found ->
					  erlang:error({variable_not_found, P});
				      {ok, Val} ->
					  Val
				  end
			  end
		  end,
		  Pt).

-spec var_name(var()) -> varname().
var_name(Var) ->
    element(2, Var).

%% UnitTest
pm2_test() ->
    %% > (pat-match '((?* ?x) a b (?* ?x)) '(1 2 a b a b 1 2 a b))
    %% ((?X 1 2 A B))
    Pt1 = parse("?*x a b ?*x"),
    In1 = parse("1 2 a b a b 1 2 a b"),
    {true,[{x,['1','2',a,b]}]} = pattern_match(Pt1, In1),
    %% > (pat-match '((?* ?p) need (?* ?x))
    %%    '(Mr Hulot and I need a vacation))
    %% ((?P MR HULOT AND I) (?X A VACATION))
    %% > (pat-match '((?* ?x) is a (?* ?y)) '(what he is is a fool))
    %% ((?X WHAT HE IS) (?Y FOOL))
    Pt2 = parse("?*p need ?*x"),
    In2 = parse("Mr Hulot and I need a vacation"),
    {true,[{p, ['Mr','Hulot','and','I']},
	   {x, [a,vacation]}]} = pattern_match(Pt2, In2),
    Pt3 = parse("?*x is a ?*y"),
    In3 = parse("what he is is a fool"),
    {true,[{x, [what,he,is]},{y, [fool]}]} = pattern_match(Pt3,
									   In3),
    %% ?*x should match empty.
    Pt4 = parse("?*x I want to ?*y"),
    In4 = parse("I want to have a vocation"),
    {true,[{x,[]},{y,[have,a,vocation]}]} = pattern_match(Pt4, In4),
    {true, B} = pattern_match(Pt4, In4),
    ['I',want,to,have,a,vocation] = sublis(Pt4, B).

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

-module(bindings).

-export([empty/0, lookup/2, extend/3]).

-include("pm2_type.hrl").

-spec empty() -> bindings().
empty() -> [].

-type lookup_result() :: not_found
		       | {ok, val()}.
-spec lookup(bindings(), key()) -> lookup_result().
lookup(B, Key) ->    
    case lists:keysearch(Key, 1, B) of
	false ->
	    not_found;
	{value, {Key, Val}} ->
	    {ok, Val}
    end.

-spec extend(bindings(), key(), val()) -> bindings().
extend(B, K, V) -> [{K, V}|B].

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-module(eliza).

-export([eliza/0, eliza/1]).

-include("pm2_type.hrl").

-record(rule, {pattern::pattern(),
	       response::[pattern()]}).
-type rule() :: #rule{}.

eliza() ->
    Rules = eliza_rule(),
    eliza(Rules).

eliza(Rules) ->
    Input = pm2:parse(string:trim(io:get_line('>: '), both)),
    Output = random_pick_response(Rules, Input),
    io:format("~s~n", [(string:join([atom_to_list(T) || T <- Output], " "))]),
    eliza(Rules).

-spec eliza_rule() -> [rule()].
eliza_rule() ->
    [
     make_rule(pm2:parse("?*x hello ?*y"),
	       [pm2:parse("How do you do. Please state your problem.")]),
     make_rule(pm2:parse("?*x I want ?*y"),
	       [pm2:parse("What would it mean if you got ?y"),
		pm2:parse("Why do you want ?y"),
		pm2:parse("Suppose you got ?y soon")]),
     make_rule(pm2:parse("?*x if ?*y"),
	       [pm2:parse("Do you really think its likely that ?y"),
		pm2:parse("Do you wish that ?y"),
		pm2:parse("What do you think about ?y"),
		pm2:parse("Really-- if ?y")]),
     make_rule(pm2:parse("?*x no ?*y"),
	       [pm2:parse("Why not"),
		pm2:parse("You are being a bit negative"),
		pm2:parse("Are you saying \"NO\" just to be negative")]),
     make_rule(pm2:parse("?*x I was ?*y"),
	       [pm2:parse("Were you really"),
		pm2:parse("Perhaps I already knew you were ?y"),
		pm2:parse("Why do you tell me you were ?y now")]),
     make_rule(pm2:parse("?*x I feel ?*y"),
	       [pm2:parse("Do you often feel ?y")]),
     make_rule(pm2:parse("?*x I felt ?*y"),
	       [pm2:parse("What other feelings do you have?")])
    ].

-spec make_rule(pattern(), [pattern()]) -> rule().
make_rule(Pt, Res) ->
    #rule{pattern=Pt, response=Res}.

-spec switch_viewpoint([atom()]) -> [atom()].
switch_viewpoint(Words) ->
    [replace_word(Word)
     || Word <- Words
    ].

-spec replace_word(atom()) -> atom().
replace_word(Word) ->
    % ((I . you) (you . I) (me . you) (am . are))
    L = [
	 {'I', 'you'},
	 {'you', 'I'},
	 {'me', 'you'},
	 {'am', 'are'}
	],
    case lists:keysearch(Word, 1, L) of
	false ->
	    Word;
	{value, {Word, Rep}} ->
	    Rep
    end.

-spec random_ele([A]) -> A.
random_ele(Res) when length(Res) > 0 ->
    lists:nth(rand:uniform(length(Res)), Res).

-spec random_pick_response([rule()], [atom()]) -> [atom()].
random_pick_response(Rule, Input) ->
    Rs = get_all_response(Rule, Input),
    {Res, B} = random_ele(Rs),
    R = random_ele(Res),
    pm2:sublis(switch_viewpoint(R), B).

-spec get_all_response([rule()], [atom()]) -> [{[pattern()], bindings()}].
get_all_response([], _Input) -> [];
get_all_response([#rule{pattern=Pt, response=Res}|Rules], Input) -> 
    case pm2:pattern_match(Pt, Input) of
	{true, B} ->
	    [{Res, B}|get_all_response(Rules, Input)];
	{false, []} ->
	    get_all_response(Rules, Input)
    end.

%% Demo run
%% >: hello there
%% hello there
%% How do I do. Please state your problem.
%% >: I want to test this program
%% I want to test this program
%% Suppose I got to test this program soon
%% >: I could see if it works
%% I could see if it works
%% Really-- if it works
%% >: no not really
%% no not really
%% Why not
%% >: forget it-- I was wondering how general the program is
%% forget it-- I was wondering how general the program is
%% Were I really
%% >: I felt like it
%% I felt like it
%% What other feelings do I have?
%% >: I feel this is enough
%% I feel this is enough
%% Do I often feel this is enough
%% >:

Thoughts on Computing

英雄无岁，江湖无辈

Introduction

Implementation in Erlang

Leave a ReplyCancel reply