郭涛算法中inver-over算子快在哪里？

aimisiyou

遗传算法收敛性一般较慢，通过种群的多样性来寻求近似最优解，这就需要种群容量和遗传代数较大才能找到最好解，但运行效率就慢。文献上说郭涛算法采用inver-over算子收敛较快，不明其理？粗略理解为删除原路径上的一些边，生成新的边，不知快在哪里？

aimisiyou

(defun rnd ()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun rnd_n (n)
  (fix (* n (rnd)))
)
(defun pick (lst i j)
   (setq count (length lst) nc 0 picklst nil)
   (while (<= nc j)
       (if (<= i nc)
           (setq picklst (cons (nth nc lst) picklst))
       )
      (setq nc (+ nc 1))
   )   
   (reverse picklst)
)
;;;重新洗牌
(defun xipai (n)
  (setq i 1 j 0 klst nil)
  (while (<= i n)
      (setq klst (cons i klst))
      (setq i (+ 1 i))
   )
   (while (<= j 20)
         (setq i_pot (rnd_n n))
         (setq j_pot (rnd_n n))
         (setq nmin (min i_pot j_pot))
         (setq nmax (max i_pot j_pot))
         (setq klst (append (pick klst  (+ 1 nmax) (- n 1)) (pick klst (+ 1 nmin) nmax) (pick klst 0 nmin)))
         (setq j (+ j 1))
   )
   (mapcar '1- klst)
)
(defun fitfun (ptlst)
   (apply '+ (mapcar 'distance ptlst (append (cdr ptlst) (list (car ptlst)))))
)
;;;取点函数
(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) pts nil)
    (while (< i n)
        (setq pts (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) pts))
        (setq i (+ i 1))
    )
    (reverse pts)
)
(defun n-pt (nlst pts)
(mapcar '(lambda (x) (cdr (nth x pts))) nlst)
)
(setq pts (fp))
(setq poplst nil)
(repeat 100
  (setq plst (xipai (length pts)))
  (setq poplst (cons plst poplst))
)
(setq p_best  (cdr (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x pts)) y))
                                      poplst
                                                                          poplst
                                                          )  
                              '(lambda (e1 e2)  (< (car e1) (car e2)) )
                      )                          
                )
                        )
)

;;;变异算子
(defun change(en)
(setq n_length (length en))
(setq pc1 (rnd_n n_length))
(setq pc2 (rnd_n n_length))
(setq flag t)
(while flag
    (if (= pc1 pc2)
             (setq pc2 (rnd_n n_length))
             (progn
                    (setq i1 (vl-position pc1 en))
            (setq i2 (vl-position pc2 en))
                        (setq ent (append (pick en 0 (min i1 i2)) (reverse (pick en  (+ 1 (min i1 i2)) (max i1 i2) )) (pick en (+ 1 (max i1 i2)) (- n_length 1))) )
                        (setq flag nil)
                  )        
        )
  )
ent
)
;;;交叉算子
(defun cross(en1 en2)
(setq n_length (length en1))
(setq pc_st (rnd_n n_length))
(setq pc1 pc_st)
(setq flag t)
(while flag
    (setq pc2 (nth (rem (+ (vl-position pc1 en2) 1) n_length)  en2))
    (if  (= (cadr (member pc1 en1)) pc2)
               (progn
                      (setq flag nil)
               (setq ent en1)
                        )
                   (progn
                     (setq i1 (vl-position pc1 en1))
             (setq i2 (vl-position pc2 en1))
                         (setq ent (append (pick en1 0 (min i1 i2) ) (reverse (pick en1  (+ 1 (min i1 i2)) (max i1 i2))) (pick en1 (+ 1 (max i1 i2)) (- n_length 1))) )
                         (setq pc1 pc2)
                   )
          )
    )
ent
)

(setq p_chane 0.2  N_d 100 ii 0)
(while (< ii N_d)
   (setq  vlst nil)
   (foreach en poplst
      (progn
            (setq r_rnd (rnd) )
                    (if (< r_rnd p_chane)
                             (progn
                                      (setq ent (change en))
                                          (if (< (fitfun (n-pt ent pts)) (fitfun (n-pt en pts)))
                                                 (setq vlst (cons ent vlst))
                                         (setq vlst (cons en  vlst))
                                          )
                                  )
                             (progn
                                          (setq ent (cross en (nth (rnd_n (length poplst)) poplst)))
                                          (if (< (fitfun (n-pt ent pts)) (fitfun (n-pt en pts)))
                                                 (setq vlst (cons ent vlst))
                                         (setq vlst (cons en  vlst))
                                          )
                                  )
                        )
       )
   )
   (setq poplst vlst)
   (setq p_bestnew  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x pts)) y)) poplst poplst)  
                                             '(lambda (e1 e2)  (< (car e1) (car e2)) )
                                    )
                                )
                 )
  (if (< (car p_bestnew) (car p_best) )
        (setq  p_best p_bestnew)
       )
  (setq ii (+ 1 ii))
)
(apply 'command (cons "pline" (reverse (cons "c" (reverse (n-pt p_best pts))))))


效果不是很理想啊。感觉交叉算子产生的后代不一定就优于两个父体（哪怕两个父体的值都较优，后代的值可能很差，而且大部分情况是这样）。

aimisiyou

感觉文献上的思路可以借鉴学习，但里面描述的流程、书写伪代码的正确性还真的很待考虑，文献中都是直接给出程序运行结果图及不同算法对照，来凸显本算法的优越性，给人一种隔靴搔痒的感觉。

aimisiyou

;;;对于点数较多且点比较密集的情况，运行效果较差
(defun c:tt()
(defun rnd ()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun rnd_n (n)
  (fix (* n (rnd)))
)
(defun pick (lst i j)
   (setq count (length lst) nc 0 picklst nil)
   (while (<= nc j)
       (if (<= i nc)
           (setq picklst (cons (nth nc lst) picklst))
       )
      (setq nc (+ nc 1))
   )   
   (reverse picklst)
)
;;;重新洗牌
(defun xipai (n)
  (setq i 1 j 0 klst nil)
  (while (<= i n)
      (setq klst (cons i klst))
      (setq i (+ 1 i))
   )
   (while (<= j 20)
         (setq i_pot (rnd_n n))
         (setq j_pot (rnd_n n))
         (setq nmin (min i_pot j_pot))
         (setq nmax (max i_pot j_pot))
         (setq klst (append (pick klst  (+ 1 nmax) (- n 1)) (pick klst (+ 1 nmin) nmax) (pick klst 0 nmin)))
         (setq j (+ j 1))
   )
   (mapcar '1- klst)
)
(defun fitfun (ptlst)
  (apply '+ (mapcar 'distance ptlst (append (cdr ptlst) (list (car ptlst)))))
)
;;;取点函数
(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) pts nil)
    (while (< i n)
        (setq pts (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) pts))
        (setq i (+ i 1))
    )
    (reverse pts)
)
(setq pts (fp))
(setq poplst nil)
(repeat 50
  (setq plst (xipai (length pts)))
  (setq poplst (cons plst poplst))
)
(defun n-pt (nlst)
(mapcar '(lambda (x) (cdr (nth x pts))) nlst)
)
(setq p_best  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y))
                                      poplst
                                      poplst
                                                          )  
                              '(lambda (e1 e2)  (< (car e1) (car e2)) )
                      )                          
                )
)
(setq p_chane 0.02  N_d 50 ii 0)
(while (< ii N_d)
   (setq  vlst nil)
   (foreach en poplst
       (setq nt (length en))
       (setq pc1 (nth (rnd_n nt) en) flag t)
       (while flag
            (setq r_rnd (rnd) ens en)
            (if (< r_rnd p_chane)
                            (setq pc2 (nth (rnd_n (- nt 1)) (vl-remove pc1 ens)))
                (progn
                    (setq en_rnd (nth (rnd_n nt) poplst))
                                        (if (= pc1 (last en_rnd))
                                            (setq pc2 (car en_rnd))
                                            (setq pc2 (cadr (member pc1 en_rnd)) )
                                        )   
                                 )
                          )
                         (if (or (= pc2 (cadr (member pc1 ens))) (= pc1 (cadr (member pc2 ens))) )
                             (setq flag nil)
                 (progn
                    (if (member pc2 (member pc1 ens))
                        (setq ens (append (reverse (member pc1 (reverse ens))) (member pc2 (reverse (cdr (member pc1 ens)))) (cdr (member pc2 ens)) ))
                          (setq ens (append (reverse (member pc2 (reverse ens))) (member pc1 (reverse (cdr (member pc2 ens)))) (cdr (member pc1 ens)) ))
                     )
                     (setq pc1 pc2)
                                     (if (< (fitfun (n-pt ens)) (car p_best))
                                  (setq p_best (cons (fitfun (n-pt ens)) ens ))
                         )
                                 )
                         )
           )

        )
   (setq ii (+ 1 ii))
)
(apply 'command (cons "pline" (reverse (cons "c" (reverse (n-pt (cdr p_best)))))))
)

aimisiyou

;;;效果还不错
(defun rnd ()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun rnd_n (n)
  (fix (* n (rnd)))
)
(defun pick (lst i j)
   (setq count (length lst) nc 0 picklst nil)
   (while (<= nc j)
       (if (<= i nc)
           (setq picklst (cons (nth nc lst) picklst))
       )
      (setq nc (+ nc 1))
   )   
   (reverse picklst)
)
;;;重新洗牌
(defun xipai (n)
  (setq i 1 j 0 klst nil)
  (while (<= i n)
      (setq klst (cons i klst))
      (setq i (+ 1 i))
   )
   (while (<= j 20)
         (setq i_pot (rnd_n n))
         (setq j_pot (rnd_n n))
         (setq nmin (min i_pot j_pot))
         (setq nmax (max i_pot j_pot))
         (setq klst (append (pick klst  (+ 1 nmax) (- n 1)) (pick klst (+ 1 nmin) nmax) (pick klst 0 nmin)))
         (setq j (+ j 1))
   )
   (mapcar '1- klst)
)
(defun fitfun (ptlst)
  (apply '+ (mapcar 'distance ptlst (append (cdr ptlst) (list (car ptlst)))))
)
;;;取点函数
(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) pts nil)
    (while (< i n)
        (setq pts (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) pts))
        (setq i (+ i 1))
    )
    (reverse pts)
)
(setq pts (fp))
(setq poplst nil)
(repeat 100
  (setq plst (xipai (length pts)))
  (setq poplst (cons plst poplst))
)
(defun n-pt (nlst)
(mapcar '(lambda (x) (cdr (nth x pts))) nlst)
)
(setq p_best  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y))
                                      poplst
                                      poplst
                                                          )  
                              '(lambda (e1 e2)  (< (car e1) (car e2)) )
                      )                          
                )
)
(setq p_chane 0.02  N_d 300 ii 0)
(while (< ii N_d)
   (setq vlst nil)
   (foreach en poplst
       (setq nt (length en))
       (setq  ens en pc1 (nth (rnd_n nt) ens) flag t clst (list pc1))
       (while flag
            (setq r_rnd (rnd))
            (if (< r_rnd p_chane)
                            (setq pc2 (nth (rnd_n (- nt 1)) (vl-remove pc1 ens)))
                (progn
                    (setq en_rnd (nth (rnd_n nt) poplst))
                                        (if (= pc1 (last en_rnd))
                                            (setq pc2 (car en_rnd))
                                            (setq pc2 (cadr (member pc1 en_rnd)) )
                                        )   
                                 )
                          )
                         (if (or (= pc2 (cadr (member pc1 ens))) (= pc1 (cadr (member pc2 ens))) )
                             (setq flag nil)
                 (progn
                    (if (member pc2 (member pc1 ens))
                        (setq ens (append (reverse (member pc1 (reverse ens))) (member pc2 (reverse (cdr (member pc1 ens)))) (cdr (member pc2 ens)) ))
                          (setq ens (append (reverse (member pc2 (reverse ens))) (member pc1 (reverse (cdr (member pc2 ens)))) (cdr (member pc1 ens)) ))
                     )
                     (setq pc1 pc2)
                                         (setq clst (cons pc1 clst))
                                         (if (= (length clst) (- nt 1))
                                             (setq flag nil)
                                          )
                                 )
                         )
           )
      (if (< (fitfun (n-pt ens)) (fitfun (n-pt en)))
                  (setq vlst (cons ens vlst))
              (setq vlst (cons en  vlst))
           )
        )
   (setq ii (+ 1 ii))
   (setq poplst vlst)
   (setq p_bestnew  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y)) poplst poplst)  
                                             '(lambda (e1 e2)  (< (car e1) (car e2)) )
                                    )
                                )
                 )
  (if (< (car p_bestnew) (car p_best) )
      (setq  p_best p_bestnew)
   )
)
(apply 'command (cons "pline" (reverse (cons "c" (reverse (n-pt (cdr p_best)))))))

aimisiyou

(defun rnd ()

  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun rnd_n (n)
  (fix (* n (rnd)))
)
(defun pick (lst i j)
   (setq count (length lst) nc 0 picklst nil)
   (while (<= nc j)
       (if (<= i nc)
           (setq picklst (cons (nth nc lst) picklst))
       )
      (setq nc (+ nc 1))
   )   
   (reverse picklst)
)
(defun fitfun (ptlst)
  (apply '+ (mapcar 'distance ptlst (append (cdr ptlst) (list (car ptlst)))))
)
(defun nerfun (pts ner_k)
  (mapcar '(lambda (x) (cons (car x)
                             (pick
                                                             (mapcar 'car (vl-sort (mapcar '(lambda (y) (list (car y) (distance (cdr x) (cdr y))))
                                                                                    (vl-remove x pts)) '(lambda (ea eb) (< (cadr ea) (cadr eb)))))
                                    0
                                                                        ner_k
                                                         )   
                      )
                   )
                 pts
  )
)

(defun lj (num_numlst pts)
  (setq n (length pts) xh (rnd_n n) xhlst nil)
  (while (< (length xhlst) n)
         (setq xhlst (cons xh xhlst))
                 (if (setq sxlst (cdr (assoc xh num_numlst)))
                     (progn
                            (setq xh (nth (rnd_n (length sxlst)) sxlst))
                        (setq num_numlst (vl-remove nil (mapcar '(lambda (x) (if (= (car x) (car xhlst))nil x))  num_numlst)))
                                (setq num_numlst (mapcar '(lambda (x) (cons (car x)(vl-remove (car xhlst) (cdr x)))) num_numlst))
                          )
                          (progn
                         (setq num_numlst (mapcar '(lambda (x) (vl-remove xh x)) (vl-remove (assoc (car xhlst) num_numlst) num_numlst)))
                             (setq pmlst (vl-remove nil (mapcar '(lambda (x) (if (member xh x) x nil)) num_numlst)))
                                 (if pmlst
                                     (progn
                                        (setq xh (car (nth (rnd_n (length pmlst)) pmlst)))
                        (setq num_numlst (mapcar '(lambda (x) (cons (car x)(vl-remove xh (cdr x)))) (vl-remove (assoc xh num_numlst) num_numlst)))
                                          )
                                          (progn
                                              (setq sxnlst (mapcar 'car num_numlst))
                                                  (setq xh (car (car (vl-sort (mapcar '(lambda (x) (list x (distance (cdr (assoc xh pts)) (cdr (assoc x pts))))) sxnlst) '(lambda (ea eb) (< (cadr ea) (cadr eb)))))))
                                          )
                                  )                          
                          )
                        )
        )
        xhlst
)
;;;取点函数
(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) pts nil)
    (while (< i n)
        (setq pts (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) pts))
        (setq i (+ i 1))
    )
    (reverse pts)
)
(setq pts (fp) num_numlst (nerfun pts 5))
(setq poplst nil )
(repeat 100
  (setq plst (lj num_numlst pts))
  (setq poplst (cons plst poplst))
)
(defun n-pt (nlst)
  (mapcar '(lambda (x) (cdr (nth x pts))) nlst)
)
(setq p_best  (car (vl-sort (mapcar '(lambda (x) (cons (fitfun (n-pt x)) x))
                                      poplst
                                                          )  
                              '(lambda (e1 e2)  (< (car e1) (car e2)) )
                      )                          
                )
)
(setq p_chane 0.01  N_d 1000 ii 0)
(while (< ii N_d)
   (setq vlst nil)
   (foreach en poplst
       (setq nt (length en))
       (setq ens en flag t)
       (if (< (rnd) 0.5)
           (setq en_rnd (cdr p_best) pc1 (nth (rnd_n nt) en_rnd) clst (list pc1))
               (setq en_rnd (nth (rnd_n 100) poplst) pc1 (nth (rnd_n nt) en_rnd) clst (list pc1))
                )
       (while flag
            (setq r_rnd (rnd))
            (if (< r_rnd p_chane)
                (setq pc2 (nth (rnd_n (- nt 1)) (vl-remove pc1 en_rnd)))
                (progn
                                        (if (= pc1 (last en_rnd))
                                            (setq pc2 (car en_rnd))
                                            (setq pc2 (cadr (member pc1 en_rnd)))
                                        )   
                                 )
                          )
                         (if (or (= pc2 (cadr (member pc1 ens))) (= pc1 (cadr (member pc2 ens))) )
                             (setq flag nil)
                 (progn
                    (if (member pc2 (member pc1 ens))
                        (setq ens (append (reverse (member pc1 (reverse ens))) (member pc2 (reverse (cdr (member pc1 ens)))) (cdr (member pc2 ens)) ))
                          (setq ens (append (reverse (member pc2 (reverse ens))) (member pc1 (reverse (cdr (member pc2 ens)))) (cdr (member pc1 ens)) ))
                     )
                     (setq pc1 pc2)
                                         (setq clst (cons pc1 clst))
                                         (if (= (length clst) (- nt 1))
                                             (setq flag nil)
                                          )
                                 )
                         )
           )
      (if (< (fitfun (n-pt ens)) (fitfun (n-pt en)))
                  (setq vlst (cons ens vlst))
              (setq vlst (cons en  vlst))
           )
        )
   (setq ii (+ 1 ii))
   (setq poplst vlst)
   (setq p_bestnew  (car (vl-sort (mapcar '(lambda (x) (cons (fitfun (n-pt x)) x)) poplst)  
                                             '(lambda (e1 e2)  (< (car e1) (car e2)) )
                                    )
                                )
                 )
  (if (< (car p_bestnew) (car p_best))
      (setq  p_best p_bestnew)
   )
)
(apply 'command (cons "pline" (reverse (cons "c" (reverse (n-pt (cdr p_best)))))))