Раскраска неориентированного плоского графа в Прологе
У меня есть программа для раскраски графиков в 3 цвета, соседние узлы должны иметь разные цвета.
Моя проблема заключается в том, что он работает только для ориентированного графа, когда я использую неориентированный граф, он перестает работать при переполнении стека. Я знаю, что есть некоторые ошибки, не могли бы вы помочь мне заставить это работать для неориентированного графа?
Существует также проблема с этим findall/3 в конце. Мне нужно изменить его, чтобы найти все узлы, а не только узлы с edge(V,_) но я не знаю точно, как это сделать. Я новичок, и мне нужно, чтобы решение было простым. Благодарю.
edge(1,2).
edge(2,3).
edge(2,4).
edge(3,4).
%for making the non-oriented graph I tried to use nonedge(X, Y) :- edge(X, Y).
% nonedge(X, Y) :- edge(Y, X).
color(blue).
color(red).
color(green).
coloring([V-C]) :-
color(C),
\+ edge(V,_).
coloring([V-C,V1-C1|Coloring]) :-
color(C),
edge(V, V1),
V \== V1,
coloring([V1-C1|Coloring]),
C1 \== C.
colors(X) :-
coloring(X),
findall(V, edge(V,_), List),
length(List, Len),
length(X, Len).
2 ответа
Код также не работает с циклами. Он только проверяет, если предыдущий не совпадает. Но в вашем примере 2 -> 3 -> 4 -> 2 -> .. никогда не закончится.
Также, если ваш график отключен, он никогда не вернет весь график.
По обеим причинам я бы предложил совершенно другой подход: сначала найдите все уникальные вершины. Затем назначьте им цвет и проверьте, не конфликтуют ли ранее установленные цвета с установленными цветами.
colors(Colored) :-
findall(U,edge(U,_),Vertices),
list_to_set(Vertices, UniqueVertices), %% find all unique vertices
coloring(UniqueVertices,[], Colored). %% color them
Предикат окраски будет выглядеть так:
coloring([],Acc,Acc). %% base case for empty list
coloring([H|T],Acc,AccRes) :-
color(C), %% pick a valid color
not((edge(H, V), member(V-C,Acc))), %% No linked vertex should have the same color
coloring(T,[H-C|Acc],AccRes). %% Color the rest of the vertices
Этот код использует аккумулятор, который содержит ранее установленные комбинации вершин и цветов.
В этом ответе мы представляем данные графа не так, как описано в OP, а скорее как список пар Id-Neibs с Neibs будучи списком соседнего узла Id "S.
: - use_module ( библиотека (агрегат)).: - use_module ( библиотека (списки)).: - use_module ( библиотека (clpfd)). is_graph (G): - ( земля (G) -> длина (G, _), maplist (пара_ключей, G, узлы), no_duplicates (узлы), список карт (is_graph_aux_outer (G), G); throw (ошибка ( instantation_error, _))). ключ_пары (K-_, K). no_duplicates (Ls): - (земля (Ls) -> Same_length (Ls, Xs), сортировать (Ls, Xs); бросить (ошибка (instantiation_error, _))). is_graph_aux_outer (G, E-Xs): - no_duplicates (XS), список карт (is_graph_aux_inner (G, E), Xs). is_graph_aux_inner (G, E, X): - член (X-Ys, G), член (E, Ys).
Некоторые примеры запросов с использованием is_graph/1- запустить с SICStus Prolog 4.3.2:
|? - is_graph ([1- [2], 2- [1,3,4], 3- [2,4], 4- [2,3], 4 - []]). % мусора в конце нет |? - is_graph ([1- [2], 2- [1,3,4], 3- [2,4], 4- [ 2,2, 3]]). % перебор нет |?- is_graph([1-[2],2-[3,4],3-[2,4],4-[2,3]]). % неполный нет |?- is_graph([1-[2],2-[3,4],3-[4]]). % неполный нет |?- is_graph([1-[2],2-[1,3,4],3-[2,4],4-[2,3]]). % ОК! да
Некоторый вспомогательный код для создания полных графиков:
полный_граф (N, G): - findall (X, (X в 1..N, индомен (X)), T0), список карт (complete_graph_aux (T0), T0, G). complete_graph_aux (T0, X, XT):- выберите (X, T0, T).
Пример использования complete_graph/2:
|? - N в 3..5, индомен (N), полный_граф (N,G0), is_graph(G0). N = 3, G0 = [1-[2,3],2-[1,3],3-[1,2]]?; N = 4, G0 = [1-[2,3,4],2-[1,3,4],3-[1,2,4],4-[1,2,3]]?; N = 5, G0 = [1-[2,3,4,5],2-[1,3,4,5],3-[1,2,4,5],4-[1,2,3,5],5-[1,2,3,4]]?; нет
Достаточно подготовки... Давайте возьмем наши кисти и накрасим эти графики - шаг за шагом!
G0≅[ID_X-[Neib1_of_X,Neib2_of_X,...], Node_Y-[Neighbor1_of_Y,...]G≅[t(ID_X,Color_X,[Neib1_of_X,Neib2_of_X,...]), ...]Zs≅[Color_X,...]Dss≅[[Color_X+Color_of_Neib1_of_X,Color_X+Color_of_Neib2_of_X, ...],...]Ds≅[Color_X+Color_of_Neib1_of_X, Color_X+Color_of_Neib2_of_X, ...]Все неравенства в
Dsисполняются. Мы используем clpfd здесь, но мы могли бы также использовать clpb.
graph_coloring (G0, Zs): - (is_graph (G0)% (1) -> maplist (node_augmented_color, G0, G, Zs),% (2) (3) добавить "цветной"
maplist(agraph_coloring_outer(G), G, Dss), % (4) получить неравенства добавить (Dss, Ds), % (5)
maplist(forcece_dif_clpfd, Ds) % (6); throw(error(domain_error(graph,G0),_))).
node_augmented_color(ID-Neibs, т (ID, цвет,Neibs), цвет). agraph_coloring_outer (G, t (_, Color_v,Neibs_v), Difs):- список карт (agraph_coloring_inner(G,Color_v), Neibs_v, Difs).
agraph_coloring_inner(G, Color_x, Id_y, Color_x+Color_y):- член (t(Id_y,Color_y,_), G).
empce_dif_clpfd (X + Y): - X # \ = Y. Пример запроса:
|? - N в 1..10, индомен (N), complete_graph (N, _G0), call_time ( агрегат (count, Zs^(graph_coloring(_G0,Zs), домен (Zs,1,N), маркировка ([], Zs)), N_sols), T_ms). N = 1, N_sols = 1, T_ms = 0?; N = 2, N_sols = 2, T_ms = 0?; N = 3, N_sols = 6, T_ms = 0?; N = 4, N_sols = 24, T_ms = 0?; N = 5, N_sols = 120, T_ms = 0?; N = 6, N_sols = 720, T_ms = 0?; N = 7, N_sols = 5040, T_ms = 20?; N = 8, N_sols = 40320, T_ms = 80?; N = 9, N_sols = 362880, T_ms = 660?; N = 10, N_sols = 3628800, T_ms = 6650?; нет
Давайте вернемся к графику, который мы представили в начале ответа!
| ?- graph_coloring([1-[2],2-[1,3,4],3-[2,4],4-[2,3]], Zs),
domain(Zs, 1, 3),
labeling([], Zs).
Zs = [1,2,1,3] ? ;
Zs = [1,2,3,1] ? ;
Zs = [1,3,1,2] ? ;
Zs = [1,3,2,1] ? ;
Zs = [2,1,2,3] ? ;
Zs = [2,1,3,2] ? ;
Zs = [2,3,1,2] ? ;
Zs = [2,3,2,1] ? ;
Zs = [3,1,2,3] ? ;
Zs = [3,1,3,2] ? ;
Zs = [3,2,1,3] ? ;
Zs = [3,2,3,1] ? ;
no