Wednesday, January 5, 2011

BFS in Prolog (AI)

I've mentioned elsewhere that I recently had to write a BFS in LISP.  Well, this is kinda a follow up to that.  Kinda.

I thought it made for a nice toy problem, and I wanted to learn some real Prolog, so I put the two together.  It worked, but it was a tad quirky, mostly in the way it stored the solution paths.

In an odd twist of fate, someone on Stack Overflow wanted to see an AI search like BFS implemented in Prolog.  I didn't want to post the solution to what originated as an assignment, so I changed the problem.  Like Knuth's conjecture, which is what the original solver solved, it has a given starting integer and a given goal integer.  However, the operations are simpler: increment, decrement, and multiply by +2 (no negative 2).  Additionally, I'm allowing for any starting integer, instead of positive four as in Knuth's conjecture.  The quirkiness is gone as well (which is why my bfs definition is slightly different from the original).

Without further ado, I post the code.  I'm sure that there are better ways to do certain things, especially if I had used some of SWI-Prolog's higher order predicates, but I think I learned more with the given definition.

% given a goal integer, it tries to determine the shortest
% series of actions needed to get to this integer given any other
% integer.  The actions allowed are increment, decrement, and
% multiply by two

% states are represented as two element lists
% the first is a number, and the second is a path

% gets the successors of the given state
% note that it must be redone via backtracking in order to
% get all of the successors
successors( [N,Path], [NewN, [Function|Path]] ) :-
        ( Function = increment, NewN is N + 1 ;
            Function = decrement, NewN is N - 1 ;
            Function = multiply, NewN is N * 2 ).

% gets all successors as a list
successors_list( State, Result ) :-
        findall( X, successors( State, X ), Result ).

% records results that have already been seen
:- dynamic seen/1.

% given a list of states, it will add each state to the table

% of states that have already been seen
add_to_seen( [] ).
add_to_seen( [[N|_]|Rest] ) :-
        assertz( seen( N ) ),
        add_to_seen( Rest ).

% removes all states that have already been seen
% returns a new list
remove_seen( [], [] ).
remove_seen( [[N|_]|Rest], Result ) :-
        seen( N ), !,
        remove_seen( Rest, Result ).
remove_seen( [State|Rest], [State|Result] ) :-
        !, remove_seen( Rest, Result ).

% performs a BFS, with the given goal and queue
bfs( Goal, [[Goal|[Path]]|_], FinalPath ) :-
        % note that operations are added from the front, and it's
        % more natural to read them left to right
        !, reverse( Path, FinalPath ).
bfs( Goal, [State|Rest], Result ) :-
        successors_list( State, Successors ),
        remove_seen( Successors, NewStates ),
        add_to_seen( NewStates ),
        append( Rest, NewStates, Queue ),
        bfs( Goal, Queue, Result ).

% runs the BFS for the given start integer and goal integer
% returns the path to reach the goal in "Path"
go( Start, Goal, Path ) :-
        retractall( seen( _ ) ),
        bfs( Goal, [[Start,[Start]]], Path ).

?- go( 4, 7, X ).
X = [4, multiply, decrement].

4 * 2 = 8; 8 - 1 = 7.  Cool.

No comments:

Post a Comment