Гамильтонов цикл на Prolog, Гамильтонов цикл на Prolog Опции

[kosyak]

Доброго всем времени суток. Помогите разобраться с задачей: "определение цикла Гамильтона в заданном графе". Язык prolog. Какой может быть алгоритм, где можно об этом попонятней почитать? Может есть уже готовая))) На pascalе бы быстро все сделал, а вот с логическим программированием пока проблемы.

Заранее огромное спасибо.

[volvo]

Начать можно отсюда: http://isr.by.ru/prolog/ch9_5.htm

[kosyak]

Начать можно отсюда: http://isr.by.ru/prolog/ch9_5.htm

Спасибо, отличная ссылочка. Буду разбираться

[kosyak]

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

Вот я сделал как понял:

Код

domains
  V=integer
  VMas=V*
  R=R(V,V)
  RMas=R*
  Graf=Graf(VMas,RMas)

Правильно ли я понял?

Не получается определить следующий предикат:

Код

смеж( X, Y, граф( Верш, Реб) ) :-
                принадлежит( р( X, Y), Реб);
                принадлежит( р( Y, X), Реб).

Не знаю как разделить domain Graf на состовляющие : вершины и ребра...

Сообщение отредактировано: kosyak - 2.11.2008 13:39

[kosyak]

Вот описал часть программы:

Код

domains
  VMas=integer*
  R=Rebro(integer,integer)
  RMas=R*
predicates
  path(integer,integer,VMas,RMas,VMas)
  path1(integer,VMas,VMas,RMas,VMas)
  smezh(integer,integer,VMas,RMas)
  prinad(R,RMas)
clauses
  
  path(A,X,VM,RM,P):-
    path1(A,[Z],VM,RM,P).
    
  path1(A,[A|P1],_,_,[A|P1]).
    
  path1(A,[Y|P1],VM,RM,P):-
    smezh(X,Y,VM,RM),
    prinad(X,P1),
    path1(A,[X,Y|P1],VM,RM,P).
    
  smezh(X,Y,VM,RM):-
    prinad(Rebro(X,Y),RM);
    prinad(Rebro(Y,X),RM).
    
  prinad(X, [X|_]).
  prinad(X, [_|L]):-prinad(X,L).

Подчеркивает prinad(Rebro(X,Y),RM); пишет: "423 ',' or ')' expected"

[volvo]

Хм... Что ты тут натворил?

Смотри, что ты делаешь:
1) описываешь предикат prinad(R, RMas), то есть проверка на существование ребра в графе
2) и тут же:

Код

  path1(A,[Y|P1],VM,RM,P):-
    smezh(X,Y,VM,RM),
    prinad(X,P1),
    path1(A,[X,Y|P1],VM,RM,P).

- вызываешь его как prinad(integer, integer*) ? Нельзя... Сделай отдельно проверку существования вершины в списке...

В общем, вот это:

Код

domains
  VMas=integer*
  R=rebro(integer,integer)
  RMas=R*
predicates
  inlist(integer, VMas)
  path(integer,integer,VMas,RMas,VMas)
  path1(integer,VMas,VMas,RMas,VMas)
  smezh(integer,integer,VMas,RMas)
  prinad(R, RMas)
clauses

% проверка вхождения ребра в список ребер
prinad(X, [X|_]).
prinad(X, [_|L]):-prinad(X, L).

% проверка вхождения номера вершины (integer) в список целых
inlist(X, [X|_]).
inlist(X, [_|L]):-inlist(X, L).
  
  path(A,Z,VM,RM,P):-
    path1(A,[Z],VM,RM,P).
    
  path1(A,[A|P1],_,_,[A|P1]).
    
  path1(A,[Y|P1],VM,RM,P):-
    smezh(X,Y,VM,RM),
    inlist(X,P1),
    path1(A,[X,Y|P1],VM,RM,P).
    
  smezh(X,Y,VM,RM):-
    prinad(rebro(X,Y),RM);
    prinad(rebro(Y,X),RM).

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

[kosyak]

Спасибо большое... пойду дальше разбираться...

[kosyak]

Вот написал полную программу.... но не работает (((

Код

domains
  VMas=integer*
  R=rebro(integer,integer)
  RMas=R*
predicates
  inlist(integer, VMas)
  path(integer,integer,VMas,RMas,VMas)
  path1(integer,VMas,VMas,RMas,VMas)
  smezh(integer,integer,VMas,RMas)
  prinad(R, RMas)
  gamilton(VMas,RMas,VMas)
  vseversh(VMas,VMas,RMas)
clauses

  gamilton(VM, RM, P):-
    path(_,_,VM,RM,P),
    vseversh(P,VM,RM).
    
  vseversh(P,VM,RM):-
   not(inlist(B,VM)),
   not(inlist(B,P)).

  path(A,Z,VM,RM,P):-
    path1(A,[Z],VM,RM,P).
        
  path1(A,[A|P1],_,_,[A|P1]).
    
  path1(A,[Y|P1],VM,RM,P):-
    smezh(X,Y,VM,RM),
    inlist(X,P1),
    path1(A,[X,Y|P1],VM,RM,P).
    

  smezh(X,Y,VM,RM):-
    prinad(rebro(X,Y),RM);
    prinad(rebro(Y,X),RM).
    
  prinad(X, [X|_]).
  prinad(X, [_|L]):-prinad(X, L).
  
  inlist(X, [X|_]).
  inlist(X, [_|L]):-inlist(X, L).
  
/* goal*/
/* gamilton([1,2,3,4],[rebro(1,2),rebro(2,4),rebro(2,3),rebro(3,4)],X)*/
/*    path(1,3,[1,2,3,4],[rebro(1,2),rebro(2,4),rebro(2,3),rebro(3,1)],X)*/

Она даже путь не может посчитать... никак не могу найти ошибку

[kosyak]

Все, вроде сделал:

Код

domains
  top=symbol
  Vlist=top*
  rebro=rebro(top,top)
  Rlist=rebro*
  gr=graf(Vlist,Rlist)
predicates
  path(top,top,Vlist,Vlist,gr)
  memberV(top,Vlist)
  memberR(rebro,Rlist)
  gamil(gr,Vlist)
  allV(top,Vlist)
  
clauses
  gamil(G,P):-
    G=graf(Vlist,Rlist),
    P=[A|V],
    path(A,B,[A],V,G),
    memberR(rebro(B,A),Rlist),
    allV(X,V).

  path(A,B,V,[B|V],graf(Vlist,Rlist)):-
    memberR(rebro(A,B),Rlist),
    not(memberV(B,V)).
  path(A,B,V,V2,graf(Vlist,Rlist)):-
    memberR(rebro(A,N),Rlist),
    not(memberV(N,V)),
    V1=[N|V],
    path(N,B,V1,V2,graf(Vlist,Rlist)).

  allV(X,L):-
    memberV(X,L).

  memberV(A, [A|_]).
  memberV(A, [_|L]):-memberV(A,L).
  
  memberR(A, [A|_]).
  memberR(A, [_|L]):-memberR(A,L).

только вот почему он выводить несколько раз одно и тоже решение?? непонятно

[volvo]

непонятно

Вот именно... Тебе выводит несколько раз одно и то же, мне не выводит ни одного... Какую цель ставишь?

Код

goal
  gamil(graf([a, b, c, d, e],
       [rebro(a,b), rebro(b, c), rebro(a,d), rebro(d,c), rebro(d,e), rebro(c,e)]), X), write(X).

молчит, как партизан, хотя должен был бы выводить ["a", "b", "d", "c", "e"].

[kosyak]

Так он правильно выводит... нет никакого цикла... я просто сделал для ориентированного графа. надо rebro(1,2) и rebro(2,1) - не одно и тоже.

Вот исправленная программа, вроде все работает, как мне кажется(тоже с ориентированными):

Код

domains
  top=symbol
  Vlist=top*
  rebro=rebro(top,top)
  Rlist=rebro*
  gr=graf(Vlist,Rlist)
predicates
    /*put' ot odnoy vershini do drugoy*/
  path(top,top,Vlist,Vlist,gr)
    /*prinadlezhit li vershina spisku vershin*/
  memberV(top,Vlist)
    /*prinadlezhit li rebro spisku reber*/
  memberR(rebro,Rlist)
    /*gamiltonov cikl*/
  gamil(gr,Vlist)
    /*vse li vershini proydeni*/
  allV(Vlist,Vlist)
  
clauses
  gamil(G,P):-
    G=graf(Vlist,Rlist),
    P=[A|V],
    path(A,B,[A],V,G),
    memberR(rebro(B,A),Rlist),
    allV(Vlist,V).    

  path(A,B,V,[B|V],graf(Vlist,Rlist)):-
    memberR(rebro(A,B),Rlist),
    not(memberV(B,V)).
  path(A,B,V,V2,graf(Vlist,Rlist)):-
    memberR(rebro(A,N),Rlist),
    not(memberV(N,V)),
    V1=[N|V],
    path(N,B,V1,V2,graf(Vlist,Rlist)).

  allV([],L).
  allV([X|T],L):-
    memberV(X,L),
    allV(T,L).

  memberV(A, [A|_]).
  memberV(A, [_|L]):-memberV(A,L).
  
  memberR(A, [A|_]).
  memberR(A, [_|L]):-memberR(A,L).

[-Алексей-]

Так он правильно выводит... нет никакого цикла... я просто сделал для ориентированного графа. надо rebro(1,2) и rebro(2,1) - не одно и тоже.

Вот исправленная программа, вроде все работает, как мне кажется(тоже с ориентированными):

Код

domains
  top=symbol
  Vlist=top*
  rebro=rebro(top,top)
  Rlist=rebro*
  gr=graf(Vlist,Rlist)
predicates
    /*put' ot odnoy vershini do drugoy*/
  path(top,top,Vlist,Vlist,gr)
    /*prinadlezhit li vershina spisku vershin*/
  memberV(top,Vlist)
    /*prinadlezhit li rebro spisku reber*/
  memberR(rebro,Rlist)
    /*gamiltonov cikl*/
  gamil(gr,Vlist)
    /*vse li vershini proydeni*/
  allV(Vlist,Vlist)
  
clauses
  gamil(G,P):-
    G=graf(Vlist,Rlist),
    P=[A|V],
    path(A,B,[A],V,G),
    memberR(rebro(B,A),Rlist),
    allV(Vlist,V).    

  path(A,B,V,[B|V],graf(Vlist,Rlist)):-
    memberR(rebro(A,B),Rlist),
    not(memberV(B,V)).
  path(A,B,V,V2,graf(Vlist,Rlist)):-
    memberR(rebro(A,N),Rlist),
    not(memberV(N,V)),
    V1=[N|V],
    path(N,B,V1,V2,graf(Vlist,Rlist)).

  allV([],L).
  allV([X|T],L):-
    memberV(X,L),
    allV(T,L).

  memberV(A, [A|_]).
  memberV(A, [_|L]):-memberV(A,L).
  
  memberR(A, [A|_]).
  memberR(A, [_|L]):-memberR(A,L).

а никак нельзя код под SWI посмотреть? оч нужно