1/*  File:    canny/a.pl
    2    Author:  Roy Ratcliffe
    3    Created: Jun  7 2021
    4    Purpose: A* Search
    5
    6Copyright (c) 2021, Roy Ratcliffe, Northumberland, United Kingdom
    7
    8Permission is hereby granted, free of charge,  to any person obtaining a
    9copy  of  this  software  and    associated   documentation  files  (the
   10"Software"), to deal in  the   Software  without  restriction, including
   11without limitation the rights to  use,   copy,  modify,  merge, publish,
   12distribute, sublicense, and/or sell  copies  of   the  Software,  and to
   13permit persons to whom the Software is   furnished  to do so, subject to
   14the following conditions:
   15
   16    The above copyright notice and this permission notice shall be
   17    included in all copies or substantial portions of the Software.
   18
   19THE SOFTWARE IS PROVIDED "AS IS", WITHOUT  WARRANTY OF ANY KIND, EXPRESS
   20OR  IMPLIED,  INCLUDING  BUT  NOT   LIMITED    TO   THE   WARRANTIES  OF
   21MERCHANTABILITY, FITNESS FOR A PARTICULAR   PURPOSE AND NONINFRINGEMENT.
   22IN NO EVENT SHALL THE AUTHORS  OR   COPYRIGHT  HOLDERS BE LIABLE FOR ANY
   23CLAIM, DAMAGES OR OTHER LIABILITY,  WHETHER   IN  AN ACTION OF CONTRACT,
   24TORT OR OTHERWISE, ARISING FROM,  OUT  OF   OR  IN  CONNECTION  WITH THE
   25SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
   26
   27*/
   28
   29:- module(canny_a,
   30          [ a_star/3                    % +Heuristics0,-Heuristics,+Options
   31          ]).   32:- predicate_options(a_star/3, 3,
   33                     [ initially(any),
   34                       finally(any),
   35                       reverse(boolean)
   36                     ]).   37:- autoload(library(option), [option/3, option/2]).   38:- autoload(library(lists), [reverse/2]).   39:- use_module(library(chr/a_star)).   40
   41:- public final/1, expand/3.
 a_star(+Heuristics0, -Heuristics, +Options) is det
Offers a static non-Constraint Handling Rules interface to a_star/4. Performs a simplified A* search using CHR where the input is a list of all the possible arcs along with their cost. Each element in Heuristics0 is a h/3 term specifying source of the heuristic arc, the arc's destination node and the cost of traversing in-between. Nodes specify distinct but arbitrary terms. Only terms initial and final have semantic significance. You can override these using Options for initially and finally. For Options see below.

Simplifies the CHR implementation by accepting h/3 terms as a list rather than using predicates to expand nodes. We match heuristic terms using member/2 from the list of heuristics. This interface does not replace a_star/4 since having a pre-loaded list of heuristics is not always possible or feasible, for example when the number of arcs is very large such as when traversing a grid of arcs.

Here is a simple example.

?- a_star([h(a, b, 1)], A, [initially(a), finally(b)]).
A = [h(a, b, 1)].

Options include:

See also
- https://rosettacode.org/wiki/A*_search_algorithm
   78a_star(Heuristics0, Heuristics, Options) :-
   79    option(initially(Initially), Options, initial),
   80    option(finally(Finally), Options, final),
   81    a_star(a(Initially, Finally, Heuristics0, []),
   82           Final^(canny_a:final(Final)),
   83           Node^Expand^Cost^(canny_a:expand(Node, Expand, Cost)),
   84           a(_, _, _, Heuristics_)),
   85    (   option(reverse(true), Options)
   86    ->  Heuristics_ = Heuristics
   87    ;   reverse(Heuristics_, Heuristics)
   88    ).
   89
   90final(a(Final, Final, _, _)).
   91
   92expand(a(A, Final, Heuristics0, Heuristics),
   93       a(B, Final, Heuristics0, [h(A, B, Cost)|Heuristics]),
   94       Cost) :-
   95    member(h(A, B, Cost), Heuristics0),
   96    A \== B