Основы программирования на языке Visual Prolog

Графы

Разбить на страницы
Показывать лекцию целиком

В настоящей главе изучаются основные методы поиска путей на графах — поиск в глубину и поиск в ширину. Рассматривается отношение достижимости на графе. Разбираются некоторые способы поиска кратчайших путей. Генерируется случайный лабиринт, визуализируется проход по нему.

Для представления графа в языке Пролог обычно используются факты. Например, пусть в отдельных фактах хранятся вершины и ребра графа:

node("a").
node("b").
node("c").

arc(1, "a", "b").   % номер ребра, его начало и конец
arc(2, "b", "c").

Тогда предикат, возвращающий элементы матрицы инцидентности, можно определить следующим образом:

incidenceMatrix(Node, Edge, Elem):-
    node(Node), 
    arc(Edge, Node1, Node2),
    getElem(Node, Node1, Node2, Elem).

getElem(Node, Node, _, 1):- !.
getElem(Node, _, Node, -1):- !. % 1 для неориент. графа
getElem(_, _, _, 0).

?- incidenceMatrix(Node, Edge, Elem).

В качестве основного примера в данной главе используется система дорог, которая связывает некоторые города. Эту систему можно изобразить в виде нагруженного графа, вершины которого соответствуют городам, а ребра — соединяющим им дорогам (рис. 8.1).

(рис 8.1) Граф системы дорог

Граф представляется в виде множества ребер, для хранения которых используются факты:

clauses
arc("Москва", "Нижний Новгород", 400).
arc("Нижний Новгород", "Пермь",  950).
arc("Екатеринбург", "Пермь",  350).
arc("Екатеринбург", "Новосибирск",  1550).
arc("Нижний Новгород", "Екатеринбург", 1300).
arc("Москва", "Самара", 1050).
arc("Самара", "Екатеринбург", 950).
arc("Самара", "Новосибирск", 2300).
arc("Санкт-Петербург", "Петрозаводск", 450).
arc("Санкт-Петербург", "Псков", 300).

В директории Exe проекта следует создать текстовый файл graph.txt и поместить в него данные факты.

8.1. Поиск в глубину

Поиск в глубину является естественным для языка Пролог, он используется машиной вывода Пролога для вычисления целей. Поэтому поиск в глубину путей на графах реализуется в языке Пролог наиболее просто.

Поясним идею поиска в глубину на следующем примере. Рассмотрим граф, изображенный на рис. 8.2 (a).

(рис 8.2) (a) Связный граф; (b) обход графа в глубину

Пусть ребра графа хранятся в следующем порядке: $$(a, b), (f, g), (c, d), (d, e), (b, c), (d, f), (a, f), (g, a), (c, g), (g, d)$$. Совершим обход графа из вершины $$a$$. Будем двигаться вперед по ребрам и помечать пройденные вершины до тех пор, пока будут встречаться непомеченные вершины. Когда это станет невозможным, вернемся в последнюю пройденную вершину $$\nu$$, для которой существует непомеченная смежная с ней вершина. Далее обход будет совершаться из вершины $$\nu$$. Обход продолжается до тех пор, пока остаются непомеченные вершины. Схематично обход графа можно представить следующим образом (рис. 8.2 (b)):

(рис 8.3) Схематичное изображение обхода графа

В следующих двух программах для нахождения путей используется поиск в глубину. В первой программе используется функциональный стиль, а во второй предикатный. Во второй программе вместе с поиском подсчитывается длина пути. Отношение edge является симметричным замыканием отношения arc. Для хранения пройденного пути используется список. В процессе вычислений вершины записываются в список, как в стек, поэтому к найденному пути применяется операция обращения списка.

class facts - graph
    arc: (string Город1, string Город2, unsigned Расстояние).

class predicates
    depthFirst: (string, string) -> string* nondeterm.
    path: (string, string, string*) -> string* nondeterm.
    edge: (string, string, unsigned) nondeterm (i,o,o).
clauses
    edge(X, Y, Dist):-
        arc(X, Y, Dist);
        arc(Y, X, Dist).

    depthFirst(Start, Goal) = list::reverse(path(Start, Goal, [Start])).

    path(Goal, Goal, Path) = Path:- !.
    path(V, Goal, CurrPath) = path(NextV, Goal, [NextV | CurrPath]):-
        edge(V, NextV, _),
        not(list::isMember(NextV, CurrPath)).

    run():-
        file::consult("graph.txt", graph),
        VertexList = depthFirst("Москва", "Новосибирск"),
            write(string::concatWithDelimiter(VertexList, " -> ")), nl,
        fail;
        _ = readLine().

Предикат concatWithDelimiter соединяет список строк в одну строку, вставляя между ними заданный разделитель.

Для текущей вершины можно не использовать отдельный аргумент (см. выше определение предиката path/3):

    depthFirst(Start, Goal) = list::reverse(path([Start], Goal)).

    path([Goal | Path], Goal) = [Goal | Path].
    path([V | Path], Goal) = path([NextV, V | Path], Goal):-
        edge(V, NextV, _),
        not(NextV in Path).

Упражнение 1. Найдите все пути из Москвы в Новосибирск, проходящие через ПермьПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

class facts - graph
    arc: (string, string, unsigned).

class predicates
    depthFirst: (string, string, string* [out], unsigned [out]) 
        nondeterm.
    path: (string, string, string*, string* [out], unsigned, 
        unsigned [out]) nondeterm.
    edge: (string, string, unsigned) nondeterm (i,o,o).
clauses
    edge(X, Y, Dist):-
        arc(X, Y, Dist);
        arc(Y, X, Dist).

    depthFirst(Start, Goal, list::reverse(Path), Dist):-
        path(Start, Goal, [Start], Path, 0, Dist).

    path(Goal, Goal, Path, Path, Dist, Dist):- !.
    path(V, Goal, CurrPath, Path, CurrDist, Dist):-
        edge(V, NextV, D),
        not(NextV in CurrPath),
        path(NextV, Goal, [NextV | CurrPath], Path, CurrDist + D, Dist).

    run():-
        file::consult("graph.txt", graph),
        depthFirst("Москва", "Новосибирск", Path, D),
            write(string::concatWithDelimiter(Path, " -> "), " : ", D), nl,
        fail;
        _ = readLine().

Упражнение 2.

  • Найдите все пути, не превосходящие заданной длины.
  • Найдите все пути от одного пункта до другого, которые содержат не более заданного числа пересадок.
  • 8.2. Отношение достижимости на графе

    Отношению достижимости на графе принадлежат пары вершин, для которых существует соединяющий их путь. Это отношение является рефлексивно-транзитивным замыканием отношения edge. Отношение достижимости на графе является отношением эквивалентности, поэтому все вершины распадаются на классы связанных между собой вершин. В следующей программе находятся вершины, достижимые из заданной вершины, а также классы достижимых друг из друга вершин.

    Факт-переменная conn в программе используется, во-первых, для предотвращения зацикливания и, во-вторых, для того чтобы достижимые вершины возвращались по одному разу, без повторов.

    open core, console, list
    
    class facts - graph
        arc: (string, string, unsigned).
    
    class facts
        conn : string* := [].
    
    class predicates
        connected: (string) -> string multi.
        connected1: (string) -> string multi.
        edge: (string, string, unsigned) nondeterm (i,o,o).
        components: () -> string**.
        components: (string*) -> string**.
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        connected(X) = connected1(X):-
            conn := [X].
    
        connected1(X) = X.
        connected1(X) = connected1(Y):-
            edge(X, Y, _),
            not(isMember(Y, conn)),
            conn := [Y | conn].
    
        components() = components(VList):-
            VList = removeDuplicates([V || arc(V, _, _); arc(_, V, _)]).
    
        components([V | L]) = [Cmp | components(difference(L, Cmp))]:-
            Cmp = [Vertex || Vertex = connected(V)].
        components([]) = [].
    
        run():-
            file::consult("graph.txt", graph),
            write(connected("Самара")), nl,
            fail;
            write("\nВершины компонент связности:\n"),
            forAll(components(), {(L):- write(L), nl}),
            _ = readLine().
    

    Предикат removeDuplicates удаляет из списка дубликаты элементов.

    Упражнение 3. Найдите вершины, не достижимые из заданной вершины.

    8.3. Поиск кратчайших путей

    Рассмотрим методы поиска кратчайших путей на графе.

    В приведенной ниже программе для поиска кратчайших путей используется самый простой декларативный метод, в котором реализуется определение: путь — кратчайший, если не существует путей короче негоПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

    class facts - graph
        arc: (string, string, unsigned).
    
    class predicates
        shortestPath: (string, string, string* [out], unsigned [out])
            nondeterm.
        path: (string, string, string*, string* [out], unsigned, 
            unsigned [out]) nondeterm.
        shorter: (string, string, unsigned) determ.
        edge: (string, string [out], unsigned [out]) nondeterm.
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        shortestPath(Start, Goal, list::reverse(Path), Dist):-
            path(Start, Goal, [Start], Path, 0, Dist),
            not(shorter(Start, Goal, Dist)).
    
        shorter(Start, Goal, Dist):-
            path(Start, Goal, [Start], _, 0, Dist1),
            Dist1 < Dist,
            !.
    
        path(Goal, Goal, Path, Path, Dist, Dist):- !.
        path(V, Goal, CurrPath, Path, CurrDist, Dist):-
            edge(V, NextV, D),
            not(NextV in CurrPath),
            path(NextV, Goal, [NextV | CurrPath], Path, CurrDist + D, Dist).
    
        run():-
            file::consult("graph.txt", graph),
            shortestPath("Москва", "Новосибирск", Path, D),
                write(string::concatWithDelimiter(Path, " -> "), " : ", D), nl,
            fail;
            _ = readLine().
    

    Упражнение 4. Найдите кратчайшие пути из Москвы до Новосибирска, не проходящие через Пермь.

    8.4. Эвристический поиск

    Декларативный метод, который используется в программе из листинга 8.4, прост, но не эффективен. Пути между заданными парами вершин, которые используются для проверки, кратчайший ли путь найден, могут вычисляться несколько раз. В следующей программе для поиска кратчайших путей применяется более эффективный алгоритм. Кратчайшие из уже найденных путей запоминаются в базе данных. Кроме этого, используется эвристика. Если длина текущего пути уже превышает длину кратчайшего из найденных путей, то текущий путь далее не продлевается, сразу выполняется откат для поиска другого вариантаПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

    class facts - graph
        arc: (string, string, unsigned).
    
    class facts
        minpath: (string*).
        mindist : unsigned := 2^30.
    
    class predicates
        shortestPath: (string, string, string* [out], unsigned [out])
            nondeterm.
        path: (string, string, string*, string* [out], unsigned, 
            unsigned [out]) nondeterm.
        setPath: (string*, unsigned).
        edge: (string, string, unsigned) nondeterm (i,o,o).
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        shortestPath(Start, Goal, list::reverse(Path), mindist):-
            path(Start, Goal, [Start], Path, 0, Dist),
                setPath(Path, Dist),
            fail;
            minPath(Path).
    
        setPath(Path, Dist):-
            Dist > mindist, !;
            if Dist < mindist then
                retractAll(minpath(_)),
                mindist := Dist
            end if,
            assert(minpath(Path)).
    
        path(Goal, Goal, Path, Path, Dist, Dist):- !.
        path(V, Goal, CurrPath, Path, CurrDist, Dist):-
            edge(V, NextV, D),
            CurrDist + D <= mindist,
            not(NextV in CurrPath),
            path(NextV, Goal, [NextV | CurrPath], Path, CurrDist + D, Dist).
    
        run():-
            file::consult("graph.txt", graph),
            shortestPath("Москва", "Новосибирск", Path, D),
                write(string::concatWithDelimiter(Path, " -> "), " : ", D), nl,
            fail;
            _ = readLine().
    

    8.5. Поиск в ширину

    Рассмотрим поиск в ширину. В его реализации все пройденные пути собираются в список. Голова этого списка становится текущим путем. В начале поиска этот путь содержит только начальную вершину, а список пройденных путей состоит только из текущего пути. Находятся продолжения текущего пути. Список этих продолжений присоединяется к хвосту списка пройденных путей (если его поставить в начало списка пройденных путей, то получится другая реализация поиска в глубину). В результате получается новый список пройденных путей. Поиск заканчивается, когда голова текущего пути совпадет с конечной вершиной.

    При поиске в ширину первым всегда продлевается путь, содержащий наименьшее количество ребер.

    Вернемся к графу, изображенному на рис. 8.2 (a). На рис. 8.4 показан результат обхода графа в ширину из вершины $$a$$.

    (рис 8.4) Обход графа в ширину

    Построение путей из вершины a, в соответствии с описанным выше алгоритмом поиска в ширину, выполняется следующим образом (см. рис. 8.4):

    $$a \to \begin{array}{l} a,b \\ a,g \\ a,f \end{array} \to \begin{array}{l} a,g \\ a,f \\ a,b,c \end{array} \to \begin{array}{l} a,f \\ a,b,c \\ a,g,d \end{array} \to \begin{array}{l} a,b,c \\ a,g,d \\ a,f \end{array} \to \begin{array}{l} a,g,d \\ a,f \\ a,b,c \end{array} \to \begin{array}{l} a,f \\ a,b,c \\ a,g,d,e \end{array} $$

    В программе, приведенной ниже, поиск в ширину используется для нахождения путей между заданными вершинами. Как и ранее, пути записываются в список, как в стек, поэтому в конце выполняется операция обращения найденного путиПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

    class facts - graph
        arc: (string, string, unsigned).
    
    class predicates
        breadthFirst: (string, string) -> string* nondeterm.
        path: (string**, string) -> string* nondeterm.
        edge: (string, string, unsigned) nondeterm (i,o,o).
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        breadthFirst(Start, Goal) = list::reverse(Path):-
            Path = path([[Start]], Goal).
    
        path([[Goal | Path] | _], Goal) = [Goal | Path]:- !.
        path([[V | Path] | PathList], Goal) = path(NextPathList, Goal):-
            NewPaths = [[NextV, V | Path] ||
                                edge(V, NextV, _), not(NextV in Path)],
            NextPathList = list::append(PathList, NewPaths).
    
        run():-
            file::consult("graph.txt", graph),
            Path = breadthFirst("Москва", "Новосибирск"),
                write(string::concatWithDelimiter(Path, " -> ")), nl,
            fail;
            _ = readLine().
    

    Если в список помещать пройденные пути вместе с их весом и первым в продлевать путь наименьшего веса, то в результате получится реализация алгоритма "первый лучший". В следующей программе для поиска кратчайшего пути применяется алгоритм "первый лучший". Для хранения пути и его веса используется терм tuple(Path, Dist), из таких термов состоит список, который строит предикатПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные. bestFirst.

        open core, console, list
    
    class facts - graph
        arc: (string, string, unsigned).
    
    class predicates
        bestFirst: (string, string) -> tuple{string*, unsigned} nondeterm.
        path: (tuple{string*, unsigned}*, string) ->
            tuple{string*, unsigned} nondeterm.
        edge: (string, string, unsigned) nondeterm (i,o,o).
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        bestFirst(Start, Goal) = tuple(reverse(Path), Dist):-
            tuple(Path, Dist) = path([tuple([Start], 0)], Goal).
    
        path([tuple([Goal | Path], Dist) | _], Goal) =
            tuple([Goal | Path], Dist):- !.
        path([tuple([V | Path], Dist) | PathList], Goal) =
                path(NextPathList, Goal):-
            NewPaths = [tuple([NextV, V | Path], Dist + D) ||
                               edge(V, NextV, D), not(NextV in Path)],
            NextPathList = sortBy(
                {(tuple(_, D1), tuple(_, D2)) = compare(D1, D2)},
                append(NewPaths, PathList)).
    
        run():-
            file::consult("graph.txt", graph),
            tuple(Path, D) = path("Москва", "Новосибирск"),
                write(string::concatWithDelimiter(Path, " -> "), " : ", D), nl,
            fail;
            _ = readLine().
    

    8.6. Лабиринт

    В настоящем параграфе строится лабиринт. Стенки лабиринта генерируются случайным образом. В качестве места для размещения лабиринта используется клеточное поле размером $$23 \times 38$$ (23 ряда и 38 столбцов). Размер поля подобран так, чтобы его было удобно отображать в окне консоли (рис. 8.5). Программа ищет путь из левого верхнего угла поля в правый нижний угол. Крайние столбцы слева и справа, а также самый нижний ряд поля всегда свободны, так что по этим клеткам можно перемещаться. Этим с избытком обеспечивается существование пути из начальной клетки в конечную. Для всех остальных клеток при генерации лабиринта шанс стать "стенкой", т. е. клеткой, по которой перемещаться нельзя, равен одному из трех.

    (рис 8.5) Лабиринт, сгенерированный случайным образом, и проход по нему

    Для поиска пути выхода из лабиринта используется "жадный" алгоритм. Первым продлевается путь, последняя вершина которого находится ближе всего к конечной клетке относительно обычного расстояния, без учета стенок. Для ускорения поиска используется следующее ограничение: пути не продлеваются в клетки, из которых уже строились продолжения путей. В результате путь находится быстро, но, в общем случае, этот путь не является кратчайшим.

    Для клеток, по которым можно перемещаться, используется серый цвет, клетки стенок лабиринта желтого цвета. Путь прокрашивается синим цветом. Перед выводом каждой клетки пути делается небольшая паузаПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

        open core, console, console_native, list, math, programControl
    
    domains
        state = empty; wall; pathcell.
        square = sq(unsigned16, unsigned16).
    
    class facts
        m : unsigned16 := 23.
        n : unsigned16 := getConsoleWidth() div 2 - 2.
    
    class facts
        cell: (unsigned16, unsigned16, state).
    
    class predicates
        create: ().
        print: ().
        f: (unsigned) -> state.
        attr: (state) -> unsigned16.
        printCell: (square, state).
    clauses
        create():-      % генерация лабиринта
            I = std::fromTo(0, m - 1), J = std::fromTo(0, n - 1),
                X = if (J = 0; J = n - 1; I = m - 1), ! then 1 
                    else random(3) end if,
                assert(cell(I, J, f(X))),
            fail;
            succeed().
    
        f(0) = wall:- !.
        f(_) = empty.
    
        attr(wall) = bit::bitLeft(14, 4):- !.
        attr(empty) = bit::bitLeft(7, 4):- !.
        attr(_) = bit::bitLeft(9, 4).
    
        print():-      % печать лабиринта
            cell(I, J, State),
                printCell(sq(I, J), State),
            fail;
            succeed().
    
        printCell(sq(I, J), State):-
            setTextAttribute(attr(State)),
            setLocation(coord(2 * J + 2, I + 1)),
            write("  ").      % два пробельных символа
    
    class predicates
        search: (square, square) -> square*.
        path: (square**, square*, square) -> square* determ.
        next: (square) -> square nondeterm.
        isEmpty: (square) determ.
        d: (square*, square) -> real.
    clauses
        search(Start, Goal) = reverse(Path):-
            Path = path([[Start]], [], Goal),
            !.
        search(Start, _) = [Start].
    
        path([[Goal | Path] | _], _, Goal) = [Goal | Path]:- !.
        path([[Cell | Path] | PathList], CList, Goal) = 
                path(NewPathList, [Cell | CList], Goal):-
            NextPaths = [[NextCell, Cell | Path] || NextCell = next(Cell),
                                isEmpty(NextCell), not(NextCell in CList)],
            if NextPaths <> [] then
                NextPathList = append(NextPaths, PathList),
                BestPath = minimumBy(
                    {(P1, P2) = compare(d(P1, Goal), d(P2, Goal))},
                    NextPathList),
                NewPathList = [BestPath | remove(NextPathList, BestPath)]
            else
                NewPathList = PathList
            end if.
        
        next(sq(I, J)) = sq(I, J + 1):- J < n - 1.
        next(sq(I, J)) = sq(I + 1, J):- I < m - 1.
        next(sq(I, J)) = sq(I - 1, J):- I > 0.
        next(sq(I, J)) = sq(I, J - 1):- J > 0.
    
        isEmpty(sq(I, J)):-
            cell(I, J, empty),
            !.
    
        d([sq(I1, J1) | _], sq(I2, J2)) = abs(I2 - I1)^2 + abs(J2 - J1)^2:-
            !.
        d(_, _) = 0.
    
        run():-
            setConsoleTitle("Лабиринт"),
            create(),
            print(),
            Path = search(sq(0, 0), sq(m - 1, n - 1)),
            forAll(Path, {(Cell):- printCell(Cell, pathcell), sleep(50)}),
            _ = readLine().
    

    Предикат getConsoleWidth возвращает ширину окна консоли. Предикат abs находит абсолютную величину числа.

    Вместо обычного расстояния можно использовать манхэттенское расстояние. Для этого нужно определить предикат d/2 следующим образом:

    d([sq(I1, J1) | _], sq(I2, J2)) = abs(I2 - I1) + abs(J2 - J1):- !.
        d(_, _) = 0.
    

    Упражнения

  • Найдите пути, проходящие только через разрешенное множество вершин.
  • Найдите пути между заданными вершинами, не проходящие через запрещенное множество вершин.
  • Найдите пути между заданными вершинами, состоящие из заданного количества ребер.
  • Реализуйте алгоритм поиска путей в ширину для графа, представленного в программе в виде фактов, каждый из которых хранит вершину и список пар, содержащих смежную вершину и вес ребра, который их соединяет.
  • Найдите эйлеров цикл в графе.
  • Используйте эвристический поиск в глубину для решения задачи о коммивояжере — для поиска гамильтоновых циклов в графе минимального суммарного веса.
  • Определите предикат, который возвращает элементы матрицы смежности графа.
  • Сгенерируйте полный граф с заданным количеством вершин и случайными весами ребер.
  • Используйте алгоритм "первый лучший" для поиска кратчайшего по стоимости пути между фигурами, стоящими на клетчатом поле, клетки которого имеют разный вес (от 1 до 4). Вес клеток генерируется случайным образом. Как поле, так и пути должны отображаться в окне консоли.
  • Страницы:

    В настоящей главе изучаются основные методы поиска путей на графах — поиск в глубину и поиск в ширину. Рассматривается отношение достижимости на графе. Разбираются некоторые способы поиска кратчайших путей. Генерируется случайный лабиринт, визуализируется проход по нему.

    Для представления графа в языке Пролог обычно используются факты. Например, пусть в отдельных фактах хранятся вершины и ребра графа:

    node("a").
    node("b").
    node("c").
    
    arc(1, "a", "b").   % номер ребра, его начало и конец
    arc(2, "b", "c").
    

    Тогда предикат, возвращающий элементы матрицы инцидентности, можно определить следующим образом:

    incidenceMatrix(Node, Edge, Elem):-
        node(Node), 
        arc(Edge, Node1, Node2),
        getElem(Node, Node1, Node2, Elem).
    
    getElem(Node, Node, _, 1):- !.
    getElem(Node, _, Node, -1):- !. % 1 для неориент. графа
    getElem(_, _, _, 0).
    
    ?- incidenceMatrix(Node, Edge, Elem).
    

    В качестве основного примера в данной главе используется система дорог, которая связывает некоторые города. Эту систему можно изобразить в виде нагруженного графа, вершины которого соответствуют городам, а ребра — соединяющим им дорогам (рис. 8.1).

    (рис 8.1) Граф системы дорог

    Граф представляется в виде множества ребер, для хранения которых используются факты:

    clauses
    arc("Москва", "Нижний Новгород", 400).
    arc("Нижний Новгород", "Пермь",  950).
    arc("Екатеринбург", "Пермь",  350).
    arc("Екатеринбург", "Новосибирск",  1550).
    arc("Нижний Новгород", "Екатеринбург", 1300).
    arc("Москва", "Самара", 1050).
    arc("Самара", "Екатеринбург", 950).
    arc("Самара", "Новосибирск", 2300).
    arc("Санкт-Петербург", "Петрозаводск", 450).
    arc("Санкт-Петербург", "Псков", 300).
    

    В директории Exe проекта следует создать текстовый файл graph.txt и поместить в него данные факты.

    8.1. Поиск в глубину

    Поиск в глубину является естественным для языка Пролог, он используется машиной вывода Пролога для вычисления целей. Поэтому поиск в глубину путей на графах реализуется в языке Пролог наиболее просто.

    Поясним идею поиска в глубину на следующем примере. Рассмотрим граф, изображенный на рис. 8.2 (a).

    (рис 8.2) (a) Связный граф; (b) обход графа в глубину

    Пусть ребра графа хранятся в следующем порядке: $$(a, b), (f, g), (c, d), (d, e), (b, c), (d, f), (a, f), (g, a), (c, g), (g, d)$$. Совершим обход графа из вершины $$a$$. Будем двигаться вперед по ребрам и помечать пройденные вершины до тех пор, пока будут встречаться непомеченные вершины. Когда это станет невозможным, вернемся в последнюю пройденную вершину $$\nu$$, для которой существует непомеченная смежная с ней вершина. Далее обход будет совершаться из вершины $$\nu$$. Обход продолжается до тех пор, пока остаются непомеченные вершины. Схематично обход графа можно представить следующим образом (рис. 8.2 (b)):

    (рис 8.3) Схематичное изображение обхода графа

    В следующих двух программах для нахождения путей используется поиск в глубину. В первой программе используется функциональный стиль, а во второй предикатный. Во второй программе вместе с поиском подсчитывается длина пути. Отношение edge является симметричным замыканием отношения arc. Для хранения пройденного пути используется список. В процессе вычислений вершины записываются в список, как в стек, поэтому к найденному пути применяется операция обращения списка.

    class facts - graph
        arc: (string Город1, string Город2, unsigned Расстояние).
    
    class predicates
        depthFirst: (string, string) -> string* nondeterm.
        path: (string, string, string*) -> string* nondeterm.
        edge: (string, string, unsigned) nondeterm (i,o,o).
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        depthFirst(Start, Goal) = list::reverse(path(Start, Goal, [Start])).
    
        path(Goal, Goal, Path) = Path:- !.
        path(V, Goal, CurrPath) = path(NextV, Goal, [NextV | CurrPath]):-
            edge(V, NextV, _),
            not(list::isMember(NextV, CurrPath)).
    
        run():-
            file::consult("graph.txt", graph),
            VertexList = depthFirst("Москва", "Новосибирск"),
                write(string::concatWithDelimiter(VertexList, " -> ")), nl,
            fail;
            _ = readLine().
    

    Предикат concatWithDelimiter соединяет список строк в одну строку, вставляя между ними заданный разделитель.

    Для текущей вершины можно не использовать отдельный аргумент (см. выше определение предиката path/3):

        depthFirst(Start, Goal) = list::reverse(path([Start], Goal)).
    
        path([Goal | Path], Goal) = [Goal | Path].
        path([V | Path], Goal) = path([NextV, V | Path], Goal):-
            edge(V, NextV, _),
            not(NextV in Path).
    

    Упражнение 1. Найдите все пути из Москвы в Новосибирск, проходящие через ПермьПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

    class facts - graph
        arc: (string, string, unsigned).
    
    class predicates
        depthFirst: (string, string, string* [out], unsigned [out]) 
            nondeterm.
        path: (string, string, string*, string* [out], unsigned, 
            unsigned [out]) nondeterm.
        edge: (string, string, unsigned) nondeterm (i,o,o).
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        depthFirst(Start, Goal, list::reverse(Path), Dist):-
            path(Start, Goal, [Start], Path, 0, Dist).
    
        path(Goal, Goal, Path, Path, Dist, Dist):- !.
        path(V, Goal, CurrPath, Path, CurrDist, Dist):-
            edge(V, NextV, D),
            not(NextV in CurrPath),
            path(NextV, Goal, [NextV | CurrPath], Path, CurrDist + D, Dist).
    
        run():-
            file::consult("graph.txt", graph),
            depthFirst("Москва", "Новосибирск", Path, D),
                write(string::concatWithDelimiter(Path, " -> "), " : ", D), nl,
            fail;
            _ = readLine().
    

    Упражнение 2.

  • Найдите все пути, не превосходящие заданной длины.
  • Найдите все пути от одного пункта до другого, которые содержат не более заданного числа пересадок.
  • 8.2. Отношение достижимости на графе

    Отношению достижимости на графе принадлежат пары вершин, для которых существует соединяющий их путь. Это отношение является рефлексивно-транзитивным замыканием отношения edge. Отношение достижимости на графе является отношением эквивалентности, поэтому все вершины распадаются на классы связанных между собой вершин. В следующей программе находятся вершины, достижимые из заданной вершины, а также классы достижимых друг из друга вершин.

    Факт-переменная conn в программе используется, во-первых, для предотвращения зацикливания и, во-вторых, для того чтобы достижимые вершины возвращались по одному разу, без повторов.

    open core, console, list
    
    class facts - graph
        arc: (string, string, unsigned).
    
    class facts
        conn : string* := [].
    
    class predicates
        connected: (string) -> string multi.
        connected1: (string) -> string multi.
        edge: (string, string, unsigned) nondeterm (i,o,o).
        components: () -> string**.
        components: (string*) -> string**.
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        connected(X) = connected1(X):-
            conn := [X].
    
        connected1(X) = X.
        connected1(X) = connected1(Y):-
            edge(X, Y, _),
            not(isMember(Y, conn)),
            conn := [Y | conn].
    
        components() = components(VList):-
            VList = removeDuplicates([V || arc(V, _, _); arc(_, V, _)]).
    
        components([V | L]) = [Cmp | components(difference(L, Cmp))]:-
            Cmp = [Vertex || Vertex = connected(V)].
        components([]) = [].
    
        run():-
            file::consult("graph.txt", graph),
            write(connected("Самара")), nl,
            fail;
            write("\nВершины компонент связности:\n"),
            forAll(components(), {(L):- write(L), nl}),
            _ = readLine().
    

    Предикат removeDuplicates удаляет из списка дубликаты элементов.

    Упражнение 3. Найдите вершины, не достижимые из заданной вершины.

    8.3. Поиск кратчайших путей

    Рассмотрим методы поиска кратчайших путей на графе.

    В приведенной ниже программе для поиска кратчайших путей используется самый простой декларативный метод, в котором реализуется определение: путь — кратчайший, если не существует путей короче негоПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

    class facts - graph
        arc: (string, string, unsigned).
    
    class predicates
        shortestPath: (string, string, string* [out], unsigned [out])
            nondeterm.
        path: (string, string, string*, string* [out], unsigned, 
            unsigned [out]) nondeterm.
        shorter: (string, string, unsigned) determ.
        edge: (string, string [out], unsigned [out]) nondeterm.
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        shortestPath(Start, Goal, list::reverse(Path), Dist):-
            path(Start, Goal, [Start], Path, 0, Dist),
            not(shorter(Start, Goal, Dist)).
    
        shorter(Start, Goal, Dist):-
            path(Start, Goal, [Start], _, 0, Dist1),
            Dist1 < Dist,
            !.
    
        path(Goal, Goal, Path, Path, Dist, Dist):- !.
        path(V, Goal, CurrPath, Path, CurrDist, Dist):-
            edge(V, NextV, D),
            not(NextV in CurrPath),
            path(NextV, Goal, [NextV | CurrPath], Path, CurrDist + D, Dist).
    
        run():-
            file::consult("graph.txt", graph),
            shortestPath("Москва", "Новосибирск", Path, D),
                write(string::concatWithDelimiter(Path, " -> "), " : ", D), nl,
            fail;
            _ = readLine().
    

    Упражнение 4. Найдите кратчайшие пути из Москвы до Новосибирска, не проходящие через Пермь.

    8.4. Эвристический поиск

    Декларативный метод, который используется в программе из листинга 8.4, прост, но не эффективен. Пути между заданными парами вершин, которые используются для проверки, кратчайший ли путь найден, могут вычисляться несколько раз. В следующей программе для поиска кратчайших путей применяется более эффективный алгоритм. Кратчайшие из уже найденных путей запоминаются в базе данных. Кроме этого, используется эвристика. Если длина текущего пути уже превышает длину кратчайшего из найденных путей, то текущий путь далее не продлевается, сразу выполняется откат для поиска другого вариантаПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

    class facts - graph
        arc: (string, string, unsigned).
    
    class facts
        minpath: (string*).
        mindist : unsigned := 2^30.
    
    class predicates
        shortestPath: (string, string, string* [out], unsigned [out])
            nondeterm.
        path: (string, string, string*, string* [out], unsigned, 
            unsigned [out]) nondeterm.
        setPath: (string*, unsigned).
        edge: (string, string, unsigned) nondeterm (i,o,o).
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        shortestPath(Start, Goal, list::reverse(Path), mindist):-
            path(Start, Goal, [Start], Path, 0, Dist),
                setPath(Path, Dist),
            fail;
            minPath(Path).
    
        setPath(Path, Dist):-
            Dist > mindist, !;
            if Dist < mindist then
                retractAll(minpath(_)),
                mindist := Dist
            end if,
            assert(minpath(Path)).
    
        path(Goal, Goal, Path, Path, Dist, Dist):- !.
        path(V, Goal, CurrPath, Path, CurrDist, Dist):-
            edge(V, NextV, D),
            CurrDist + D <= mindist,
            not(NextV in CurrPath),
            path(NextV, Goal, [NextV | CurrPath], Path, CurrDist + D, Dist).
    
        run():-
            file::consult("graph.txt", graph),
            shortestPath("Москва", "Новосибирск", Path, D),
                write(string::concatWithDelimiter(Path, " -> "), " : ", D), nl,
            fail;
            _ = readLine().
    

    8.5. Поиск в ширину

    Рассмотрим поиск в ширину. В его реализации все пройденные пути собираются в список. Голова этого списка становится текущим путем. В начале поиска этот путь содержит только начальную вершину, а список пройденных путей состоит только из текущего пути. Находятся продолжения текущего пути. Список этих продолжений присоединяется к хвосту списка пройденных путей (если его поставить в начало списка пройденных путей, то получится другая реализация поиска в глубину). В результате получается новый список пройденных путей. Поиск заканчивается, когда голова текущего пути совпадет с конечной вершиной.

    При поиске в ширину первым всегда продлевается путь, содержащий наименьшее количество ребер.

    Вернемся к графу, изображенному на рис. 8.2 (a). На рис. 8.4 показан результат обхода графа в ширину из вершины $$a$$.

    (рис 8.4) Обход графа в ширину

    Построение путей из вершины a, в соответствии с описанным выше алгоритмом поиска в ширину, выполняется следующим образом (см. рис. 8.4):

    $$a \to \begin{array}{l} a,b \\ a,g \\ a,f \end{array} \to \begin{array}{l} a,g \\ a,f \\ a,b,c \end{array} \to \begin{array}{l} a,f \\ a,b,c \\ a,g,d \end{array} \to \begin{array}{l} a,b,c \\ a,g,d \\ a,f \end{array} \to \begin{array}{l} a,g,d \\ a,f \\ a,b,c \end{array} \to \begin{array}{l} a,f \\ a,b,c \\ a,g,d,e \end{array} $$

    В программе, приведенной ниже, поиск в ширину используется для нахождения путей между заданными вершинами. Как и ранее, пути записываются в список, как в стек, поэтому в конце выполняется операция обращения найденного путиПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

    class facts - graph
        arc: (string, string, unsigned).
    
    class predicates
        breadthFirst: (string, string) -> string* nondeterm.
        path: (string**, string) -> string* nondeterm.
        edge: (string, string, unsigned) nondeterm (i,o,o).
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        breadthFirst(Start, Goal) = list::reverse(Path):-
            Path = path([[Start]], Goal).
    
        path([[Goal | Path] | _], Goal) = [Goal | Path]:- !.
        path([[V | Path] | PathList], Goal) = path(NextPathList, Goal):-
            NewPaths = [[NextV, V | Path] ||
                                edge(V, NextV, _), not(NextV in Path)],
            NextPathList = list::append(PathList, NewPaths).
    
        run():-
            file::consult("graph.txt", graph),
            Path = breadthFirst("Москва", "Новосибирск"),
                write(string::concatWithDelimiter(Path, " -> ")), nl,
            fail;
            _ = readLine().
    

    Если в список помещать пройденные пути вместе с их весом и первым в продлевать путь наименьшего веса, то в результате получится реализация алгоритма "первый лучший". В следующей программе для поиска кратчайшего пути применяется алгоритм "первый лучший". Для хранения пути и его веса используется терм tuple(Path, Dist), из таких термов состоит список, который строит предикатПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные. bestFirst.

        open core, console, list
    
    class facts - graph
        arc: (string, string, unsigned).
    
    class predicates
        bestFirst: (string, string) -> tuple{string*, unsigned} nondeterm.
        path: (tuple{string*, unsigned}*, string) ->
            tuple{string*, unsigned} nondeterm.
        edge: (string, string, unsigned) nondeterm (i,o,o).
    clauses
        edge(X, Y, Dist):-
            arc(X, Y, Dist);
            arc(Y, X, Dist).
    
        bestFirst(Start, Goal) = tuple(reverse(Path), Dist):-
            tuple(Path, Dist) = path([tuple([Start], 0)], Goal).
    
        path([tuple([Goal | Path], Dist) | _], Goal) =
            tuple([Goal | Path], Dist):- !.
        path([tuple([V | Path], Dist) | PathList], Goal) =
                path(NextPathList, Goal):-
            NewPaths = [tuple([NextV, V | Path], Dist + D) ||
                               edge(V, NextV, D), not(NextV in Path)],
            NextPathList = sortBy(
                {(tuple(_, D1), tuple(_, D2)) = compare(D1, D2)},
                append(NewPaths, PathList)).
    
        run():-
            file::consult("graph.txt", graph),
            tuple(Path, D) = path("Москва", "Новосибирск"),
                write(string::concatWithDelimiter(Path, " -> "), " : ", D), nl,
            fail;
            _ = readLine().
    

    8.6. Лабиринт

    В настоящем параграфе строится лабиринт. Стенки лабиринта генерируются случайным образом. В качестве места для размещения лабиринта используется клеточное поле размером $$23 \times 38$$ (23 ряда и 38 столбцов). Размер поля подобран так, чтобы его было удобно отображать в окне консоли (рис. 8.5). Программа ищет путь из левого верхнего угла поля в правый нижний угол. Крайние столбцы слева и справа, а также самый нижний ряд поля всегда свободны, так что по этим клеткам можно перемещаться. Этим с избытком обеспечивается существование пути из начальной клетки в конечную. Для всех остальных клеток при генерации лабиринта шанс стать "стенкой", т. е. клеткой, по которой перемещаться нельзя, равен одному из трех.

    (рис 8.5) Лабиринт, сгенерированный случайным образом, и проход по нему

    Для поиска пути выхода из лабиринта используется "жадный" алгоритм. Первым продлевается путь, последняя вершина которого находится ближе всего к конечной клетке относительно обычного расстояния, без учета стенок. Для ускорения поиска используется следующее ограничение: пути не продлеваются в клетки, из которых уже строились продолжения путей. В результате путь находится быстро, но, в общем случае, этот путь не является кратчайшим.

    Для клеток, по которым можно перемещаться, используется серый цвет, клетки стенок лабиринта желтого цвета. Путь прокрашивается синим цветом. Перед выводом каждой клетки пути делается небольшая паузаПример приведен для версии 7.5. В версии 7.4 вместо выражения not(A in B) должно быть not(list::isMember(A, B)). Вместо A и B в листингах стоят разные переменные..

        open core, console, console_native, list, math, programControl
    
    domains
        state = empty; wall; pathcell.
        square = sq(unsigned16, unsigned16).
    
    class facts
        m : unsigned16 := 23.
        n : unsigned16 := getConsoleWidth() div 2 - 2.
    
    class facts
        cell: (unsigned16, unsigned16, state).
    
    class predicates
        create: ().
        print: ().
        f: (unsigned) -> state.
        attr: (state) -> unsigned16.
        printCell: (square, state).
    clauses
        create():-      % генерация лабиринта
            I = std::fromTo(0, m - 1), J = std::fromTo(0, n - 1),
                X = if (J = 0; J = n - 1; I = m - 1), ! then 1 
                    else random(3) end if,
                assert(cell(I, J, f(X))),
            fail;
            succeed().
    
        f(0) = wall:- !.
        f(_) = empty.
    
        attr(wall) = bit::bitLeft(14, 4):- !.
        attr(empty) = bit::bitLeft(7, 4):- !.
        attr(_) = bit::bitLeft(9, 4).
    
        print():-      % печать лабиринта
            cell(I, J, State),
                printCell(sq(I, J), State),
            fail;
            succeed().
    
        printCell(sq(I, J), State):-
            setTextAttribute(attr(State)),
            setLocation(coord(2 * J + 2, I + 1)),
            write("  ").      % два пробельных символа
    
    class predicates
        search: (square, square) -> square*.
        path: (square**, square*, square) -> square* determ.
        next: (square) -> square nondeterm.
        isEmpty: (square) determ.
        d: (square*, square) -> real.
    clauses
        search(Start, Goal) = reverse(Path):-
            Path = path([[Start]], [], Goal),
            !.
        search(Start, _) = [Start].
    
        path([[Goal | Path] | _], _, Goal) = [Goal | Path]:- !.
        path([[Cell | Path] | PathList], CList, Goal) = 
                path(NewPathList, [Cell | CList], Goal):-
            NextPaths = [[NextCell, Cell | Path] || NextCell = next(Cell),
                                isEmpty(NextCell), not(NextCell in CList)],
            if NextPaths <> [] then
                NextPathList = append(NextPaths, PathList),
                BestPath = minimumBy(
                    {(P1, P2) = compare(d(P1, Goal), d(P2, Goal))},
                    NextPathList),
                NewPathList = [BestPath | remove(NextPathList, BestPath)]
            else
                NewPathList = PathList
            end if.
        
        next(sq(I, J)) = sq(I, J + 1):- J < n - 1.
        next(sq(I, J)) = sq(I + 1, J):- I < m - 1.
        next(sq(I, J)) = sq(I - 1, J):- I > 0.
        next(sq(I, J)) = sq(I, J - 1):- J > 0.
    
        isEmpty(sq(I, J)):-
            cell(I, J, empty),
            !.
    
        d([sq(I1, J1) | _], sq(I2, J2)) = abs(I2 - I1)^2 + abs(J2 - J1)^2:-
            !.
        d(_, _) = 0.
    
        run():-
            setConsoleTitle("Лабиринт"),
            create(),
            print(),
            Path = search(sq(0, 0), sq(m - 1, n - 1)),
            forAll(Path, {(Cell):- printCell(Cell, pathcell), sleep(50)}),
            _ = readLine().
    

    Предикат getConsoleWidth возвращает ширину окна консоли. Предикат abs находит абсолютную величину числа.

    Вместо обычного расстояния можно использовать манхэттенское расстояние. Для этого нужно определить предикат d/2 следующим образом:

    d([sq(I1, J1) | _], sq(I2, J2)) = abs(I2 - I1) + abs(J2 - J1):- !.
        d(_, _) = 0.
    

    Упражнения

  • Найдите пути, проходящие только через разрешенное множество вершин.
  • Найдите пути между заданными вершинами, не проходящие через запрещенное множество вершин.
  • Найдите пути между заданными вершинами, состоящие из заданного количества ребер.
  • Реализуйте алгоритм поиска путей в ширину для графа, представленного в программе в виде фактов, каждый из которых хранит вершину и список пар, содержащих смежную вершину и вес ребра, который их соединяет.
  • Найдите эйлеров цикл в графе.
  • Используйте эвристический поиск в глубину для решения задачи о коммивояжере — для поиска гамильтоновых циклов в графе минимального суммарного веса.
  • Определите предикат, который возвращает элементы матрицы смежности графа.
  • Сгенерируйте полный граф с заданным количеством вершин и случайными весами ребер.
  • Используйте алгоритм "первый лучший" для поиска кратчайшего по стоимости пути между фигурами, стоящими на клетчатом поле, клетки которого имеют разный вес (от 1 до 4). Вес клеток генерируется случайным образом. Как поле, так и пути должны отображаться в окне консоли.
  • Вернуться к учебному плану