prolog 62

DOMAINS
    stringl=string*
    % в этой базе данных будут хранится факты а значении цвета вершины
DATABASE - vcolors
    % например, vcolor("A", "blue").
    vcolor(string,string).
PREDICATES
    % предикат берет список string и string и будет истинен, если в этом списке есть строка, напримеръ
    % contains(["AA", "asdas", "df"],"df")  -  истина
    contains(stringl,string).

    % предикат берет список вершин, и возвращает список их цветов (используя бд vcolors), тоже строки
    nondeterm vertsToCols(stringl,stringl).

    % предикат берет вершину в первый аргумент и во второй сует список цветов вершин, смежных с вершиной - первым аргументом
    nondeterm connects_cols(string,stringl).

    % просто предикат для вершин
    nondeterm vertex(string).
    % просто предикат для цветов
    nondeterm color(string).

    % предикат для задания ребер от одной вершины к другой (Внимание, ребра однонаправленные)
    nondeterm edge(string,string).

    % для упрощения будем рассметривать неориент графы, поэтому вместо edge будем использовать connected
    % connected(A, B) - истина, если А и В соединены ребром, неважжно A->B  или B->A
    nondeterm connected(string,string).
    % итоговый предикат, запускающий решение
    colorize.

    % предикат для проверки подбираемого решения, подробнее разберем ниже
    nondeterm check_solution(string,string,string,string,string,string,string,string).

    % предикат для красивого вывода просто
    nondeterm output.
CLAUSES
    % если то, что мы ищем (X) - голова списка, то это правда, что X содержится в списке
    contains([X|Xs],X):-!.
    % если же не голова, то возможно он где-то в хвосте - запускаем рекурсивно
    contains([X|Xs],Y):-
        contains(Xs,Y).

    % объявим возможные цвета
    color(blue).
    color(red).
    color(green).
    color(black).
    color(white).

    % вершины
    vertex(a).
    vertex(b).
    vertex(c).
    vertex(d).

    % ребра
    edge(a,b).
    edge(b,c).
    edge(b,d).
    edge(c,d).

    % две вершины x y соединены, если есть ребро y->x или x->y
    connected(X,Y):-edge(X,Y);edge(Y,X).

    % предикат для проверки решения
    % рассматриваем граф из 4 вершин
    % он принимает 8 аргументов, 4 вершины и 4 соответсвующих цвета вершин
    check_solution(A,ACol,B,BCol,C,CCol,D,DCol):-
        % с помощью connects_cols получаем цвета смежных вершин с каждой из четырех
        connects_cols(A,ANsCols),
        connects_cols(B,BNsCols),
        connects_cols(C,CNsCols),
        connects_cols(D,DNsCols),

        % затем указываем, что цвет каждой вершины не должен содержаться в цветах смежных с ней вершин
        % - это как бы раскраска графа
        not(contains(ANsCols,ACol)),
        not(contains(BNsCols,BCol)),
        not(contains(CNsCols,CCol)),
        not(contains(DNsCols,DCol))
        .

    % получаем цвета всех смежных с данной вершиной
    connects_cols(V,ConnCols):-
        % findall - это встроенный предикат, он позволяет получить список чего либо удовлетворяющего какому либо условию
        % найдем все смежные вершины с V:
        findall(X,connected(X,V),Cs), % в инете нашел пример и сделал по аналогии
        % все смежные вершины запишуться в переменную Cs, то есть список смежных вершин
        % затем преобразуем эти названия вершин в их цвета с помощью предиката vertsToCols
        % список соответсвующих цветов получаем в переменной ConnCols - втором аргументее vertsToCols в итоге получается, что второй
        % аргумент connects_cols - ConnCols равеен списку цветов смежныых с V вершин
        vertsToCols(Cs,ConnCols),!.

    % преобразуем список вершин в список их цветов
    vertsToCols([],[]).
    vertsToCols([V|VS],[C|CS]):-
        % отщепляем головы с обоих и должно быть, что соответсвующая голова V должна иметь цвет C,
        % задаем это условие с помощью выражения vcolor(V,C)
        vcolor(V,C),vertsToCols(VS,CS). % и рекурсивно вызываем от хвостов

    % итоговый
    colorize:-
        % для удобства запишем вершины в переменные (хотя на самом деле можно обойтись и без них)
        A=a,B=b,C=c,D=d,
        color(C1),color(C2),color(C3),color(C4), % тут и происходит перебор

        retractall(vcolor(_,_)), % очищаем БД, чтобы отсеять результат предыдущего перебора

        % assert присваивает/добавляет факт в бд - это встроенный предикат
        % пусть А имеет цвет С1 и тд
        assert(vcolor(A,C1)),assert(vcolor(B,C2)),assert(vcolor(C,C3)),assert(vcolor(D,C4)),

        % проверим решение с помощью вышеописанного предиката
        check_solution(A,C1,B,C2,C,C3,D,C4),

        % если проверка пройдена - выведем решение
        output,
        !.
    output:-
        % получим список всех цветов
        findall(V,vcolor(X,V),Cs),
        % получаем список всех вершин
        findall(X,vcolor(X,V),Vs),

        %пишем в консоль найденное решение
        write("Vertexes:\t\t"),write(Vs),nl,
        write("Colors:\t\t"),write(Cs),nl,nl.
GOAL
    colorize.