An introduction to Artificial Intelligence. Finlay and Dix. 1st Edition.

blackboard.p

download

Header

%  =================================================================
%  ==                                                             ==
%  ==          An Introduction to ARTIFICIAL INTELLIGENCE         ==
%  ==                  Janet Finlay and Alan Dix                  ==
%  ==                       UCL Press, 1996                       ==
%  ==                                                             ==
%  =================================================================
%  ==                                                             ==
%  ==     chapter 10, pages 236-238:  blackboard architecture     ==
%  ==                                                             ==
%  ==          Prolog example, Alan Dix, September 1997           ==
%  ==                                                             ==
%  =================================================================

Code

%  Uses:
%      member/2, concat/3, count_members/3   -  from file 'list.p'
%      remove_list/3                              "    "      "
%      test_cond_list/3, set_cond_list/3     -  from file 'cond.p'
%  Please:
%      consult('../util/cond.p').
%      consult('../util/list.p').


%  the agents are declared using the predicate agent/1
%  each agent may be able to engage in sevral actions
%  each action is declared by the predicate action/6
%  the predicate is of the form:
%      action( Agent, Action, Read, Pre, Calc, Write)
%          Agent  -  the name of the agent
%          Action -  the name of the action
%          Read   -  list of values to read from the blackboard
%          Pre    -  goal to evaluated as preconditionfor action
%          Calc   -  goal to perform calculations for action (must succeed)
%          Write  -  list of values to write to blackboard
%
%  The blackboard is represented by a list of terms
%
%  The list Read consisits of positive terms, such as blocks(c,N), which
%  are matched against terms in on the blackboard and also negative
%  terms, such as 'not number(X,N)', which act as an extra precondition
%  only allowing the action to proceed if there is NO matching term
%  on the blacboard.
%
%  The list Write also may contain positive and negative terms.
%  In the case of Write a positive term means add this to the blackboard,
%  whilst a negative term means remove a matching term from the blacboard.
%
%  The special term 'done' when writen to the blackboard signals
%  to the interpreter that the required answer has been found.
%
%  The example below is taken from pages 237 and 238 and figure 10.1.
%  Note that an extra agent 'announcer' has been added to say when
%  the answer has been reached.
%
%  The agent/1 and action/6 predicates for the exmaple are declared
%  first followed by the predicates for the interpreter itself.
%  You could of course add different agents and try the interpreter
%  on them.  For example, try defining a subtracting agent.

agent(reader).
agent(pusher).
agent(swopper).
agent(announcer).

%  READER agent
%  this actualy works in two directions, turning numbers into blocks
%  and vice versa

action( reader, num_to_blocks,
            [ is(number(X,N)), not(blocks(X,B)) ],      %  read blackboard
            true,                                  %  pre-condition
            num_to_blocks(N,B),                    %  calculate
            [ is(blocks(X,B)) ] ).                     %  write blackboard
action( reader, blocks_to_num,
            [ us(blocks(X,B)), not(number(X,N)) ],      %  read blackboard
            true,                                  %  pre-condition
            blocks_to_num(B,N),                    %  calculate
            [ is(number(X,N)) ] ).                     %  write blackboard

num_to_blocks(0,[]).
num_to_blocks(N,[long|B]) :-
        N > 10, !,
        N1 is N-10,
        num_to_blocks(N1,B).
num_to_blocks(N,[short|B]) :-
        N > 0,
        N1 is N-1,
        num_to_blocks(N1,B).

blocks_to_num([],0).
blocks_to_num([short|B],N1) :-
        blocks_to_num(B,N),
        N1 is N+1.
blocks_to_num([long|B],N1) :-
        blocks_to_num(B,N),
        N1 is N+10.

%  READER pusher
%  this pushes 'a' and 'b' piles together into a pile 'c'

action( pusher, push,
            [ is(blocks(a,Ba)), is(blocks(b, Bb)), not(blocks(c,X)) ],
                                                     %  read blackboard
            true,                                    %  pre-condition
            concat(Ba,Bb,Bc),                        %  calculate
            [ is(blocks(c,Bc)) ] ).                      %  write blackboard

%  READER swopper
%  this looks for piles with 10 short (unit) blocks in them and turns
%  them into a single long (ten) block.

action( swopper, swop,
            [ is(blocks(X,B)) ],                         %  read blackboard
            need_swop(B),                            %  pre-condition
            do_swop(B,Bs),                           %  calculate
            [ not(blocks(X,B)), is(blocks(X,Bs)) ] ).     %  write blackboard

need_swop(B) :-
        count_members(short,B,N),
        N > 10.
do_swop(Bold,[10|Bnew]) :-
        remove_list( [ short,short,short,short,short,
                       short,short,short,short,short ], Bold, Bnew ).

%  READER announcer
%  this watches out until it sees the numeric answer for c on
%  the blackboard
%  when it sees it a message is written and the interpreter
%  is told to stop by writing 'done' on the blackboard

action( announcer, done,
            [ is(number(c,N)) ],                         %  read blackboard
            true,                                    %  pre-condition
            (write('the answer is '), write(N), nl), %  calculate
            [ is(done) ] ).                              %  write blackboard

%  INTERPRETER
%
%  The mulit-agent blackboard interpreter is comprised of
%  two predicates: run_blackboard/3 and do_one/4

%  The first of these:
%      run_blackboard(Binit,Trace,Bfinal)
%  takes Binit as the initial state of a blackboard and then
%  uses do_one/4 to repeatedly execute single agent actions until
%  either a succesful state is found (signaled by 'done' on the blackboard)
%  or no further action is possible.
%  The final state of the blackboard is returned in Bfinal.
%  The variable Trace contains a trace of the agents and actions
%  which have been executed and the blackboard state after each action.

run_blackboard(Binit,[],Binit) :-
        member(done,Binit), !,
        write('blackboard done.'), nl.
run_blackboard(Binit,[(Agent,Action,Bafter)|Trace],Bfinal) :-
        do_one(Agent,Action,Binit,Bafter), !,   %  enforce serial actions
        write(Agent), write(' doing '), write(Action), nl,
        run_blackboard(Bafter,Trace,Bfinal).
run_blackboard(Binit,[],Binit) :-
        write('blackboard failed!'), nl.        %  impassse

%  The second predicate:
%      do_one(Agent,Action,Bbefore,Bafter)
%  finds an agent and associated action which are enabled given the
%  state of the blackboard in Bbefore and then performs the action
%  of the agent giving the new blackboard state Bafter.
%  By enables, we mean that the read list of the action is available
%  and the precondition is satisfied by the values read.

do_one(Agent,Action,Bbefore,Bafter) :-
        agent(Agent),
        action(Agent,Action,Read,Pre,Calc,Write),
        test_cond_list(Read,Bbefore), Pre, !,
        Calc,
        set_cond_list(Write,Bbefore,Bafter).

Running this Code

%  RUNNING THIS CODE
%
%  To reproduce the example in figure 10.1 type:
%
%>     run_blackboard( [ number(a,13), number(b,8) ], Trace, Bfinal ).

Query

Response