首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >Setf (?)导致树中的循环

Setf (?)导致树中的循环
EN

Stack Overflow用户
提问于 2012-12-11 01:26:54
回答 1查看 180关注 0票数 3

我正在用Common Lisp (CLISP)实现一个进化算法,我有一个问题。

我有一个像树一样的类:

代码语言:javascript
复制
(defclass node ()
  ((item :initarg :item :initform nil :accessor item)
   (children :initarg :children :initform nil :accessor children)
   (number-of-descendants :initarg :descs :initform nil :accessor descs)))

以及一些方法:

代码语言:javascript
复制
(defmethod copy-node ((n node))
  (make-instance
   'node
   :item (item n)
   :descs (descs n)
   :children (mapcar #'copy-node (children n))))

(defmethod get-subtree ((n node) nr)
 (gsth (children n) nr))
(defmethod (setf get-subtree) ((val node) (n node) nr)
  (setf (gsth (children n) nr) val))
(defmethod get-random-subtree ((n node))
  (gsth (children n) (random (descs n))))
(defmethod (setf get-random-subtree) ((val node) (n node))
  (setf (get-subtree n (random (descs n))) val))

(defun gsth (lst nr)    
  (let ((candidate (car lst)))
    (cond
      ((zerop nr) candidate)
      ((<= nr (descs candidate)) (gsth (children candidate) (1- nr)))
      (t (gsth (cdr lst) (- nr (descs candidate) 1))))))

(defun (setf gsth) (val lst nr)    
  (let ((candidate (car lst)))
    (cond
      ((zerop nr) (setf (car lst) val))
      ((<= nr (descs candidate))
       (setf (gsth (children candidate) (1- nr)) val))
      (t (setf (gsth (cdr lst) (- nr (descs candidate) 1)) val)))
    val))

我想要做的是从总体中交换两棵随机树的随机子树。但是当我这样做的时候:

代码语言:javascript
复制
(defun stdx (population)
  (let ((n (length population))
        (npop))
    (do ((done 0 (+ done 2)))
        ((>= done n) npop)
      (push (stdx2 (copy-node (random-el population))
                   (copy-node (random-el population)))
            npop))))

(defun stdx2 (father mother)
  ;; swap subtrees
  (rotatef (get-random-subtree father)
           (get-random-subtree mother))
  (check-for-cycles father)
  (check-for-cycles mother))

有时会检测到循环,这显然不应该发生。

检查周期是可以的,我也用(trace)检测到周期。我一直在更新子孙的数量。

我猜(setf get-subtree)出了什么问题。我是LISP的新手,而且我不太擅长setf扩展。请帮帮我。

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2012-12-11 02:11:44

想一想这将如何实现:

代码语言:javascript
复制
;; swap subtrees
(rotatef (get-random-subtree father)
         (get-random-subtree mother))

rotatef表单将被宏展成类似下面这样的内容:

代码语言:javascript
复制
(let ((a (get-subtree father (random (descs father))))
      (b (get-subtree mother (random (descs mother)))))
  (setf (get-subtree father (random (descs father))) b)
  (setf (get-subtree mother (random (descs mother))) a))

(您可以使用macroexpand来找出在您的情况下到底是什么扩展。)

换句话说,随机子树将被选择两次(一次是在读取时,一次是在更新时),这样,对子树的引用将被复制到另一棵树中的随机位置,而不是相互交换子树。

例如,在下图中,算法可能会选择要交换的蓝色和红色子树。但是当涉及到连接它们时,它将它们放在用点标记的点上。

图的下半部分显示了将子树附加到新点之后的结果数据结构:您可以看到已经创建了一个循环。

因此,您需要修改代码,以便只选择一次随机子树。可能是这样的:

代码语言:javascript
复制
(let ((a (random (descs father)))
      (b (random (descs mother))))
  (rotatef (get-subtree father a)
           (get-subtree mother b)))
票数 6
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/13805966

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档