tea*_*sus 3 lisp tree common-lisp setf
我在Common Lisp(CLISP)中实现了一个进化算法,我遇到了一个问题.
我有一个树状的课:
(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)))
Run Code Online (Sandbox Code Playgroud)
还有一些方法:
(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))
Run Code Online (Sandbox Code Playgroud)
我要做的是从群体中交换两个随机树的两个随机子树.但是,当我做这样的事情时:
(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))
Run Code Online (Sandbox Code Playgroud)
有时检测到一个循环,显然不应该发生.
检查循环是否正常,我也检测到循环(跟踪).我一直在更新后代数.
我想(setf get-subtree)有问题.我是LISP的新手,我对setf扩展不太满意.请帮我.
想想如何实现这个:
;; swap subtrees
(rotatef (get-random-subtree father)
(get-random-subtree mother))
Run Code Online (Sandbox Code Playgroud)
该rotatef表格将按照以下方式进行宏观扩展:
(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))
Run Code Online (Sandbox Code Playgroud)
(您可以使用macroexpand以确切了解您的扩展情况.)
换句话说,随机子树将被选择两次(一次在读取时和一次在更新时),因此不是相互交换子树,而是将子树的引用复制到另一棵树中的随机位置.
例如,在下图中,算法可能会选择要交换的蓝色和红色子树.但是当它附加它们时,它会将它们放在标有点的点上.

图的下半部分显示了将子树附加到新点之后的结果数据结构:您可以看到已创建一个循环.
因此,您需要修改代码,以便您只需选择一次随机子树.也许是这样的事情:
(let ((a (random (descs father)))
(b (random (descs mother))))
(rotatef (get-subtree father a)
(get-subtree mother b)))
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
176 次 |
| 最近记录: |