VPF::гамильтонов цикл графе - Форум программистов

myrik1990

Дата 24.9.2009, 12:38 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 24.9.2009

Репутация: нет
Всего: нет

Есть граф, заданный матрицей смежности. надо найти все гамильтоновы циклы. Появилась проблема: алгоритм с бектрекингом лагает, потому как при возврате в точку входа в рекурсию, цикл LOOP (в функции gamilt) не выполняется дальше. Подскажите плз как это исправить.

Код


(defun iel(spis i)
   ((ZEROP i)(car spis))
   (iel (CDR spis)(- i 1))
   
)

(DEFUN CHANGE (lst nn val)
    ((ZEROP nn) (POP lst) (PUSH val lst))
    (CONS (CAR lst) (CHANGE (CDR lst) (- nn 1) val))
)


(defun matr(m i j)
  (SET 'q (IEL m i))
  (SET 'q (IEL q j))
  RETURN q
)


(defun changematr(m i j val)
 (SET 'q(IEL m i))
 (SET 'q (CHANGE q j val))
 (CHANGE m i q)
)


(defun printarr(arr nll)  
  ((ZEROP nll) (RETURN))
   (PRINT (car arr))
   (printarr (cdr arr) (- nll 1))
)



(defun gamilt(v)

(SET 'i 0) 
 (SET 'n1 (- n 1))
 (SET 'c (iel cycle n1))
((AND(EQL cnt n)(EQL (matr a c 0) 1))(PRINTARR cycle n)(RETURN))

(LOOP ((EQL i n )(RETURN))
   (PRINT i)
  ((AND(EQL 1 (matr a v i))(EQL 0 (iel used i))) 
 
    (SET 'used (CHANGE used i 1))
     (SET 'a (changematr a v i 0))
     (SET 'a (changematr a i v 0))       
     (SET 'cycle (change cycle cnt i))
     (SET 'cnt (ADD1 cnt))     
     (PUSH i stack)
     (gamilt i)
     (SET     'i (POP stack))
     
     
     (SET 'cnt (- cnt 1))
     (SET 'used (CHANGE used i  0))
     (SET 'a (changematr a v i 1))
     (SET 'a (changematr a i v 1))
        
   )
 (SET 'i (ADD1 i)) 
)
)


(SET 'stack NIL)
(SET 'n 6)
(SET 'a '((0 1 0 0 0 1)(1 0 0 0 1 1)(0 0 0 1 1 1)(0 0 1 0 1 0)(0 1 1 1 0 0)(1 1 1 0 0 0)))
(SET 'cycle '(0 0 0 0 0 0))
(SET 'used '(0 0 0 0 0 0))
(SET 'cnt 0)
(SET 'cycle (CHANGE cycle cnt 0))
(SET 'cnt (ADD1 cnt))
(SET 'used (CHANGE used 0 1))
(gamilt 0)

myrik1990

Дата 29.9.2009, 13:54 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 24.9.2009

Репутация: нет
Всего: нет

Переделал. Теперь работает.

Код


(defun iel(spis i)
   ((ZEROP i)(car spis))
   (iel (CDR spis)(- i 1))
   
)

(DEFUN CHANGE (lst nn val)
    ((ZEROP nn) (POP lst) (PUSH val lst))
    (CONS (CAR lst) (CHANGE (CDR lst) (- nn 1) val))
)


(defun matr(m i j)
  (SET 'q (IEL m i))
  (SET 'q (IEL q j))
  RETURN q
)


(defun changematr(m i j val)
 (SET 'q(IEL m i))
 (SET 'q (CHANGE q j val))
 (CHANGE m i q)
)






(defun gamilt(v p)
 
 (SET 'n1 (- n 1))
 (SET 'c (iel cycle n1))

 ((AND(EQL cnt n)(EQL (matr a c 0) 1))(PRINT cycle)(RETURN))

 ((EQL p n )(RETURN))
     
  ((AND(EQL 1 (matr a v p))(EQL 0 (iel used p))) 
 
    (SET 'used (CHANGE used p 1))
     (SET 'a (changematr a v p 0))
     (SET 'a (changematr a p v 0))       
     (SET 'cycle (change cycle cnt p))
     (SET 'cnt (ADD1 cnt))
     
     (gamilt p 0)
     
     (SET 'cnt (- cnt 1))
     (SET 'used (CHANGE used p 0))
     (SET 'a (changematr a v p 1))
     (SET 'a (changematr a p v 1))
     (gamilt v (+ p 1))    
   )
 
 (gamilt v (+ p 1))
)



(SET 'stack NIL)
(SET 'n 6)
(SET 'a '((0 1 0 0 0 1)
          (1 0 0 0 1 1)
          (0 0 0 1 1 1)
          (0 0 1 0 1 0)
          (0 1 1 1 0 0)
          (1 1 1 0 0 0)))
(SET 'cycle '(0 0 0 0 0 0))
(SET 'used '(0 0 0 0 0 0))
(SET 'cnt 0)
(SET 'cycle (CHANGE cycle cnt 0))
(SET 'cnt (ADD1 cnt))
(SET 'used (CHANGE used 0 1))
(gamilt 0 0)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| LISP \| Следующая тема »