/*  SEARCH_BUG.PL  */


/*
This bug demonstrates depth- and breadth-first search. It needs to
be run in treeworld:
    eden( search_bug, treeworld ).

It is implemented using library(exec). When the brain starts, by
start_thinking being called, it calls the goal
    start_search( [ go(forward,[]) ], [] ).

start_search asks the use what kind of search, and then calls 'search'.
This is a predicate of two arguments. The first is a queue of points    
to be explored. The second is the current position. Points to be
explored are represented as
    go( <direction>, <position> )
where <direction> is one of forward, left, or right. <position>
represents a previous bug position, as the path taken from the root of
the tree in treeworld. Such paths are represented as a list of
<direction>s.

'search' first "forces evaluation" of the first point to be explored, by
making the bug walk to the node it indicates, from wherever it is now.
The bug has now ended up at an X, *, or +. If it's at the +, it eats it.
If at a * or X, it makes a list of the possible directions it can go in,
and adds these to the queue. (For a *, there are none). It then repeats,
and this continues until it eats the food, or the queue is empty. The
search_type assertion controls whether the bug engages in depth-first or
breadth-first search, by controlling how the queue is updated.


I derived this program by starting with a standard search algorithm. The
key idea was that points to be explored can be positions which the bug
may not yet have reached. If you represent them in the form
    "You have to go in <direction> from <here>
then you can insert an "evaluation-forcing" stage, as long as it happens
before the bug needs to find the point's descendants. The evaluation-
forcer corresponds to quite a lot of activity (see 'force' below), but
can be hived off from the search routine itself.
*/


:- library(exec).


start_thinking :-
    retractall( coroutine(_) ),
    goal_to_process( start_search([go(forward,[])],[]), Co ),
    assert( coroutine(Co) ).


think( Action ) :-
    coroutine( Co ),
    restart_process( Co, Action ).


bugdead( _, rerun ) :-
    start_thinking.


start_search( Q, Here ) :-
    /*  Ask user what kind of search to demonstrate: sets
        search_type assertion.
    */
    retractall( search_type(_) ),
    get_search_type,

    /*  Start the search proper.  */
    search( Q, Here ).  


search( [], _ ) :- !.

search( [ go(Dir,Parent) | RestQ ], Here ) :-

    /*  Force evaluation. Bug ends up at Here.  */
    force( [Dir|Parent], Here ),

    /*  Get possible directions from this new node.  */
    directions( [Dir|Parent], Dirs ),

    /*  Add these choices to the queue.  */
    (
        search_type(dfs)
    ->
        append( Dirs, RestQ, NewQ )
    ;
        search_type(bfs)
    ->
        append( RestQ, Dirs, NewQ )
    ;
        search_type( ST ),
        fault( 'search: illegal search type', [ST] )
    ),

    /*  And recurse.  */
    search( NewQ, [Dir|Parent] ).


/*  force( Next+, Here+ ):
        Make bug walk to Next from Here. In general, bug will have to
        find the common ancestor of the nodes represented by Here and
        Next; walk back to it from Here; and then walk forward to Next.
*/
force( Next, Here ) :-
    common_ancestor( Next, Here, AToNext, HereToA ),
    backtrack_along( HereToA ),
    forward_along( AToNext ).


/*  common_ancestor( Next+, Here+, AToNext-, HereToA- ):
        HereToA becomes the path from Here to the common ancestor
        of Next and Here; AToNext becomes the path from it to Next.
*/
common_ancestor( Next, Here, AToNext, HereToA ) :-
    reverse( Next, NextR ),
    reverse( Here, HereR ),
    common_ancestor_1( NextR, HereR, AToNext, HereToAR ),
    reverse( HereToAR, HereToA ).


/*  common_ancestor_1( L1+, L2+, T1_-, T2_- ):
        L1 and L2 are paths from the root of the tree to two nodes,
        represented as reversed lists of directions. Let A be the nodes'
        common ancestor. Then T1_ and T2_ are the (reversed) paths from
        A to each of the nodes. This just involves taking off the lists'
        common prefix.
*/
common_ancestor_1( [H|T1], [H|T2], T1_, T2_ ) :-
    !,
    common_ancestor_1( T1, T2, T1_, T2_ ).

common_ancestor_1( L1, L2, L1, L2 ).


/*  backtrack_along( Path ):
        Walk backwards along Path.
*/
backtrack_along( [] ) :- !.

backtrack_along( [Dir|P] ) :-
    go_back_to_X,
    ( Dir = left -> exec(right)
    ; Dir = right -> exec(left)
    ; Dir = forward -> true
    ; fault( 'backtrack_along: bad Dir', [ Dir, P ] )          
    ),
    backtrack_along( P ).


/*  go_back_to_X():
        Bug is standing on a line. Walk back to the previous X.
*/
go_back_to_X :-
    /*  Walk backwards along the line.  */
    see_line( 0, -1 ),
    !,
    exec( back ),
    go_back_to_X.

go_back_to_X :-
    see( 0, -1, 'X' ),
    !,
    /*  Step back onto the X.  */
    exec( back ).


/*  forward_along( Path+ ):                    
        Bug is standing on a X. If Path is non-empty, walk along
        it to the end. This leaves bug standing on an X, or in
        front of a *.
*/
forward_along( [] ) :- !.

forward_along( [Dir|Next] ) :-
    /*  is on a X  */
    ( Dir = forward -> exec(forward)
    ; Dir = left -> exec(left), exec(forward)
    ; Dir = right -> exec(right), exec(forward)
    ; fault( 'forward_along: bad direction', [ [Dir|Next] ] )
    ),

    /*  Bug is now standing on a - or |. Walk along the line to
        the thing at the end: either a *, X, or +.
    */
    walk_to_end( End ),
    forward_along( Next ).


/*  walk_to_end( End- ):
        Bug is standing on a - or |. Walk along it until it hits a
        X, * or +. If the latter, eat the food; if an X, stay standing
        on it; if a *, stay in front of it.
        The routine returns the object found, as either an X or a *. It
        will never return +, since eating the food kills the bug.
*/
walk_to_end( End ) :-
    see( 0, 1, Next ),
    walk_to_end( Next, End ).


/*  walk_to_end( ObjAhead+, End- ):
        Auxiliary for walk_to_end/1. ObjAhead is the object in                    
        the square in front of bug.
*/
walk_to_end( +, _ ) :-
    !,
    exec( forward ),
    exec( grab ),
    exec( use ).

walk_to_end( Obj, What ) :-
    ( Obj = '-' ; Obj = '|' ),
    !,
    exec( forward ),
    walk_to_end( What ).

walk_to_end( 'X', 'X' ) :-
    !,
    exec( forward ).
    /*  Am now on X  */

walk_to_end( *, * ) :-
    !.


/*  directions( P+, Dirs- ):
        Bug is standing on an X or in front of a *, and has to find out
        what directions it can go in. This routine returns them as a
        list. The elements of this list are in the order
            right, forward, left

        P is the path to here (representing ``here'').
*/
directions( P, Dirs ) :-
    ( see_line( -1, 0 ) -> D1 = [go(left,P)] ; D1 = [] ),
    ( see_line( 0, 1 )  -> D2 = [go(forward,P)|D1] ; D2 = D1 ),
    ( see_line( 1, 0 )  -> Dirs = [go(right,P)|D2] ; Dirs = D2 ).


/*  see( xB+, yB+, Obj- ):
        Return the object at (xB,yB) in the bug's field of vision,
        where xB and yB are bug-centered co-ordinates.
*/
see( XB, YB, Obj ) :-
    X is XB + 3,
    Y is YB + 2,
    retina( X, Y, Obj ).


/*  see_line( XB+, YB+ ):
        True if the object seen at (XB,YB) is a vertical or horizontal
        line.
*/
see_line( XB, YB) :-
    see( XB, YB, Obj ),
    ( Obj = '-' ; Obj = '|' ).


/*
Querying the user
-----------------
*/


/*  get_search_type:
        Ask the user for a type of search to do, and set search_type
        assertion.
*/
get_search_type :-
    bug_message write('Search type: D(epth-first)/B(readth-first)' ),

    (
        bug_using_ved
    ->
        prolog_eval( consword(tlc(apply(valof(rawcharin))),1), Key )
    ;
        prolog_eval( consword(tlc(apply(valof(charin))),1), Key )
    ),

    (
        Key = 'd'
    ->
        asserta(search_type(dfs))
    ;
        Key = 'b'
    ->
        asserta(search_type(bfs))
    ;
        get_search_type
    ).


/*
Utilities
---------
*/


/*  append( L1?, L2?, L? ):
        Append L1 to L2 giving L.
*/
append([], L, L).
append([H|R], S, [H|T]) :-
    append(R, S, T).


/*  reverse( L0+, L- ):
        Reverse L0 giving L.
*/
reverse( X, RX ) :-
    reverse( X, [], RX ).


reverse( [], R, R ) :- !.
reverse( [X|Y], Z, R ) :-
    reverse( Y, [X|Z], R ).


/*  fault( S+, C+ ):
        Report bug S with culprit-list C.          
*/
fault( S, C ) :-
    prolog_eval( 'FAULT'(S,quote(C)) ).
