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

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

Author24 — интернет-сервис помощи студентам

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

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

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

Prolog
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
%+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)]).

Новые блоги и статьи Все статьи Все блоги /
Что нового в C# 14 UnmanagedCoder 10.03.2025 Предстоящая версия C# 14 обещает принести изменения, которые сделают разработку еще более приятной и эффективной. Что стоит отметить, так это влияние сообщества разработчиков на формирование новых. . .	Формулы поворота Igor3D 10.03.2025 Добрый день Тема Эти формулы приводятся во множестве тьюториалов, часто под видом "матрица вращения на плоскости". x' = x * cos(a) - y * sin(a) y' = y * cos(a) + x * sin(a) Как бы Вы их. . .	Что нового в .NET 10 UnmanagedCoder 10.03.2025 . NET 10 выходит как релиз с длительной поддержкой (LTS), включающей три года обновлений. В этом обновлении Microsoft сфокусировались на нескольких направлениях: производительность, оптимизация. . .	Отложенное высвобождение, RCU и Hazard Pointer в C++26 NullReferenced 09.03.2025 Многопоточное программирование стало важной частью современной разработки. Когда несколько потоков одновременно работают с общими данными, возникает целый ряд проблем, связанных с синхронизацией и. . .	Неблокирующийся стек на C++26 NullReferenced 09.03.2025 Традиционные способы синхронизации в многопоточном программировании — мьютексы, семафоры, условные переменные — часто превращаются в узкое место в плане производительности. При этом неблокирующиеся. . .
Обработка строк в C++26: Новые возможности string и string_view NullReferenced 09.03.2025 Новый стандарт C++26 предлагает много улучшений для работы с привычными string и относительно новыми string_view. string_view - это невладеющая ссылка на последовательность символов, появившаяся в. . .	Мой первый аддон для Blender 3D, с помощью нейронки (не зная даже азов пайтона, но это не значит что так и с остальным). Hrethgir 09.03.2025 Потратил весь день. Пол-дня мне хватило, чтобы понять что с версией с 14B мне не одолеть написание функционального кода, на языке с которым я вообще никак не знаком - пайтон. Версия 22B от другого. . .	Einstein@Home сегодня исполняется двадцать лет! Programma_Boinc 09.03.2025 Einstein@Home сегодня исполняется двадцать лет! Отправлено 19 февраля 2025 года в 17:20:21 UTC Я хочу поздравить всех наших волонтеров, разработчиков и ученых из Einstein@Home. Мы официально. . .	Заполнители и расширенный набор символов в C++26 NullReferenced 09.03.2025 C++26 представляет два важных обновления: заполнители и расширенный набор символов. Заполнители (placeholders) решают давнюю проблему лаконичности кода в шаблонных выражениях и лямбда-функциях. Они. . .	Контракты в C++26 NullReferenced 09.03.2025 Контракты – это механизм, позволяющий указывать предусловия, постусловия и инварианты для функций в коде. Эта функциональность должна была стать частью C++20, но была исключена на встрече комитета. . .

@Black Fregat Фрилансер 3709 / 2081 / 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 Фрилансер 3709 / 2081 / 567 Регистрация: 31.05.2009 Сообщений: 6,683
	20.12.2015, 14:44	4
	samuelquincy, Сообщение от samuelquincy просто будет разбивать граф на блоки Добавлено через 1 минуту А для проверки нужно смотреть длину полученного списка, для блока она будет 1 1

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