Проверить является ли заданный граф блоком SWI prolog

@samuelquincy · Регистрация: 29.12.2013

Граф задается списком ребер, нужно проверить является ли заданный граф блоком на SWI prolog.

Блок - связный, непустой, не имеющий точек сочленения неориентированный граф.

Есть код разбиения графа на блоки на visual prolog:

Prolog

domains
дуга=д(integer,integer)
дуги=дуга*
циклы=дуги*
il=integer*
predicates
блоки(дуги,циклы,циклы)
nondeterm взять(дуги,дуга,дуги)
nondeterm простой_цикл(integer,integer,дуги,дуги,il,дуги)
объединение(циклы,дуги,дуги)
разность(дуги,дуги,дуги)
принадл(integer,il)
clauses
блоки(Граф,Блоки,Ответ):- 
    взять(Граф,д(X,Y),Граф1),
    findall(Цикл,простой_цикл(Y,X,Граф,[д(X,Y)],[Y],Цикл),Циклы),
    объединение(Циклы,[],Блок),
    разность(Граф1,Блок,Граф2),!,
    блоки(Граф2,[Блок|Блоки],Ответ).
блоки([],Блоки,Блоки).
 
взять([д(X,Y)|Граф],Ребро,Граф):- Ребро=д(X,Y);Ребро=д(Y,X).
взять([Дуга|Граф],Ребро,[Дуга|Граф1]):- взять(Граф,Ребро,Граф1).
 
простой_цикл(Y,X,Граф,Ребра,Вершины,Цикл):- Y<>X,
    взять(Граф,д(Y,Z),Граф1),not(принадл(Z,Вершины)),
    простой_цикл(Z,X,Граф1,[д(Y,Z)|Ребра],[Z|Вершины],Цикл).
простой_цикл(X,X,_,Цикл,_,Цикл).
 
объединение([[Д|Цикл]|Циклы],Ребра,Блок):- взять(Ребра,Д,_),!,
    объединение([Цикл|Циклы],Ребра,Блок).
объединение([[Д|Цикл]|Циклы],Ребра,Блок):- объединение([Цикл|Циклы],[Д|Ребра],Блок).
объединение([[]|Циклы],Ребра,Блок):- объединение(Циклы,Ребра,Блок).
объединение([],Блок,Блок).
 
разность([Д|Граф],Блок,Граф1):- взять(Блок,Д,Блок1),!,
  разность(Граф,Блок1,Граф1).
разность([Д|Граф],Блок,[Д|Граф1]):- разность(Граф,Блок,Граф1).
разность([],_,[]).
 
принадл(Вершина,[Вершина|_]):- !.
принадл(Вершина,[_|Вершины]):- принадл(Вершина,Вершины).
goal
блоки([д(1,2),д(2,3),д(3,4),д(4,5),д(5,6),д(2,5),д(6,1),д(5,7),д(5,8),д(7,8),д(2,9)],[],Блоки).

Просьба помочь, спасибо.

@Black Fregat · 20.12.2015, 13:05

Строки 1-14 убрать. В строке 25 заменить <> на \=
Строки 43-44 убрать, вместо этого строку 44 набирать в консоли SWI.
Или , как вариант, поменять слово goal на ?-

@samuelquincy · 20.12.2015, 14:41 **[ТС]**

после этого программа будет проверять является ли заданный граф блоком или просто будет разбивать граф на блоки?

@Black Fregat · 20.12.2015, 14:44

samuelquincy,

Сообщение от samuelquincy

просто будет разбивать граф на блоки

Добавлено через 1 минуту
А для проверки нужно смотреть длину полученного списка, для блока она будет 1

@samuelquincy · 20.12.2015, 18:52 **[ТС]**

Переписал на SWI, как мне проверить длину получаемого блока в коде а не в консоле?

код:

Prolog

blocks(GRAPH,BLOCKS,ANS):- 
    TAKE(GRAPH,D(X,Y),GRAPH1),
    findall(CYCLE,SIMPLE_CYCLE(Y,X,GRAPH,[D(X,Y)],[Y],CYCLE),CYCLES),
    COMBINE(CYCLES,[],BLOCK),
    DIFFERENCE(GRAPH1,BLOCK,GRAPH2),!,
    blocks(GRAPH2,[BLOCK|BLOCKS],ANS).
blocks([],BLOCKS,BLOCKS).
 
TAKE([D(X,Y)|GRAPH],EDGE,GRAPH):- EDGE=D(X,Y);EDGE=D(Y,X).
TAKE([ARC|GRAPH],EDGE,[ARC|GRAPH1]):- TAKE(GRAPH,EDGE,GRAPH1).
 
SIMPLE_CYCLE(Y,X,GRAPH,EDGES,TOPS,CYCLE):- Y\=X,
    TAKE(GRAPH,D(Y,Z),GRAPH1),not(MEMBER(Z,TOPS)),
    SIMPLE_CYCLE(Z,X,GRAPH1,[D(Y,Z)|EDGES],[Z|TOPS],CYCLE).
SIMPLE_CYCLE(X,X,_,CYCLE,_,CYCLE).
 
COMBINE([[D|CYCLE]|CYCLES],EDGES,BLOCK):- TAKE(EDGES,D,_),!,
    COMBINE([CYCLE|CYCLES],EDGES,BLOCK).
COMBINE([[D|CYCLE]|CYCLES],EDGES,BLOCK):- COMBINE([CYCLE|CYCLES],[D|EDGES],BLOCK).
COMBINE([[]|CYCLES],EDGES,BLOCK):- COMBINE(CYCLES,EDGES,BLOCK).
COMBINE([],BLOCK,BLOCK).
 
DIFFERENCE([D|GRAPH],BLOCK,GRAPH1):- TAKE(BLOCK,D,BLOCK1),!,
  DIFFERENCE(GRAPH,BLOCK1,GRAPH1).
DIFFERENCE([D|GRAPH],BLOCK,[D|GRAPH1]):- DIFFERENCE(GRAPH,BLOCK,GRAPH1).
DIFFERENCE([],_,[]).
 
MEMBER(TOP,[TOP|_]):- !.
MEMBER(TOP,[_|TOPS]):- MEMBER(TOP,TOPS).

@Black Fregat · 20.12.2015, 19:03

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

@samuelquincy · 21.12.2015, 01:01 **[ТС]**

исправил) вопрос тот же, как мне проверить длину получаемого блока в коде а не в консоле?

Prolog

blocks(Graph,Blocks,Ans):- 
    take(Graph,D(X,Y),Graph1),
    findall(Cycle,simple_cycle(Y,X,Graph,[D(X,Y)],[Y],Cycle),Cycles),
    combine(Cycles,[],Block),
    difference(Graph1,Block,Graph2),!,
    blocks(Graph2,[Block|Blocks],Ans).
blocks([],Blocks,Blocks).
 
take([D(X,Y)|Graph],Edge,Graph):- edge=D(X,Y);edge=d(Y,X).
take([Arc|Graph],Edge,[Arc|Graph1]):- take(Graph,Edge,Graph1).
 
simple_cycle(Y,X,Graph,Edges,Tops,Cycle):- Y\=X,
    take(Graph,D(Y,Z),Graph1),not(member(Z,Tops)),
    simple_cycle(Z,X,Graph1,[D(Y,Z)|Edges],[Z|Tops],Cycle).
simple_cycle(X,X,_,Cycle,_,Cycle).
 
combine([[D|Cycle]|Cycles],Edges,Block):- take(Edges,D,_),!,
    combine([Cycle|Cycles],Edges,Block).
combine([[D|Cycle]|Cycles],Edges,Block):- combine([Cycle|Cycles],[D|Edges],Block).
combine([[]|Cycles],Edges,Block):- combine(Cycles,Edges,Block).
combine([],Block,Block).
 
difference([D|Graph],Block,Graph1):- take(Block,D,Block1),!,
  difference(Graph,Block1,Graph1).
difference([D|Graph],Block,[D|Graph1]):- difference(Graph,Block,Graph1).
difference([],_,[]).
 
member(Top,[Top|_]):- !.
member(Top,[_|Tops]):- member(Top,Tops).

Добавлено через 1 час 31 минуту
help

Добавлено через 3 часа 6 минут
help please

@Black Fregat · 21.12.2015, 02:15

Например, напишите дополнительный предикат:

Prolog

1
2
3

checkBlock(Graph) :-
    blocks(Graph, [], Blocks),
    length(Blocks, 1).

Добавлено через 8 минут
Послушайте, Вы вообще свой исправленный код запускали? Там полно ошибок..
И это при том, что исходный русский текст спокойно запускается после 4 исправлений, о которых я писал..

Добавлено через 34 минуты

Не по теме:

А перевести вершину графа как Top - это вообще песня :)

@samuelquincy · 27.12.2015, 17:05 **[ТС]**

Все исправил, вроде работает, просьба проверить на правильность.

Prolog

%+d(X,Y),+List,-Ans
blocks(Graph,Blocks,Ans):-
    take(Graph,d(X,Y),Graph1),
    findall(Cycle,simple_cycle(Y,X,Graph,[d(X,Y)],[Y],Cycle),Cycles),
    combine(Cycles,[],Block),
    difference(Graph1,Block,Graph2),!,
    blocks(Graph2,[Block|Blocks],Ans).
blocks([],Blocks,Blocks).
 
%+Graph(d(X,Y),...)
checkBlock(Graph) :-
blocks(Graph, [], Blocks),
length(Blocks, 1).
 
%+Graph, +Edge, -Graph
take([d(X,Y)|Graph],Edge,Graph):- Edge=d(X,Y);Edge=d(Y,X).
take([Arc|Graph],Edge,[Arc|Graph1]):- take(Graph,Edge,Graph1).
 
simple_cycle(Y,X,Graph,Edges,Tops,Cycle):- Y\=X,
    take(Graph,d(Y,Z),Graph1),not(member(Z,Tops)),
    simple_cycle(Z,X,Graph1,[d(Y,Z)|Edges],[Z|Tops],Cycle).
simple_cycle(X,X,_,Cycle,_,Cycle).
 
%+cycles, +Edges, -Block
combine([[D|Cycle]|Cycles],Edges,Block):- take(Edges,D,_),!,
    combine([Cycle|Cycles],Edges,Block).
combine([[D|Cycle]|Cycles],Edges,Block):- combine([Cycle|Cycles],[D|Edges],Block).
combine([[]|Cycles],Edges,Block):- combine(Cycles,Edges,Block).
combine([],Block,Block).
 
difference([D|Graph],Block,Graph1):- take(Block,D,Block1),!,
  difference(Graph,Block1,Graph1).
difference([D|Graph],Block,[D|Graph1]):- difference(Graph,Block,Graph1).
difference([],_,[]).
 
member(Top,[Top|_]):- !.
member(Top,[_|Tops]):- member(Top,Tops).

Запрос:

Prolog

1 2	blocks([d(1,2),d(2,3),d(3,4),d(4,5),d(5,6),d(2,5),d(6,1),d(5,7),d(5,8),d(7,8),d(2,9)],[],Blocks). checkBlock([d(1,2),d(2,3),d(3,4),d(4,5),d(5,6),d(2,5),d(6,1),d(5,7),d(5,8),d(7,8),d(2,8)]).

@Black Fregat Фрилансер 3703 / 2075 / 567 Регистрация: 31.05.2009 Сообщений: 6,683
	20.12.2015, 13:05	2
	Строки 1-14 убрать. В строке 25 заменить <> на \= Строки 43-44 убрать, вместо этого строку 44 набирать в консоли SWI. Или , как вариант, поменять слово goal на ?- 0

@samuelquincy 0 / 0 / 0 Регистрация: 29.12.2013 Сообщений: 43
	20.12.2015, 14:41 [ТС]	3
	после этого программа будет проверять является ли заданный граф блоком или просто будет разбивать граф на блоки? 0

@Black Fregat Фрилансер 3703 / 2075 / 567 Регистрация: 31.05.2009 Сообщений: 6,683
	20.12.2015, 14:44	4
	samuelquincy, Сообщение от samuelquincy просто будет разбивать граф на блоки Добавлено через 1 минуту А для проверки нужно смотреть длину полученного списка, для блока она будет 1 1

@Black Fregat Фрилансер 3703 / 2075 / 567 Регистрация: 31.05.2009 Сообщений: 6,683
	20.12.2015, 19:03	6
	Этот код работать не будет, во всяком случае, на SWI Пролог требует названия предикатов начинать с маленькой буквы. При этом он прекрасно понимает русские буквы в названиях предикатов.. 1

Опции темы