LIST以嵌套的cond返回

时间：2016-07-27 18:20:18

标签： lisp common-lisp

我不明白为什么我的程序表现得像。

(defvar A '((X Y Z) (J L O P) (G W U))

(defvar Z '(X W D U G))

(defvar STOP 'G)

(defun ADD_to_Z(A2)
  (prog()
    (cond
        ((equal (Member_Of_Z (list A2)) 0) )
        (t (setq Z (append Z (list A2))) )
    )
  )
)

(defun Member_of_Z(cdr_A1)

(prog(n temp)
   (setq n 0)
   (setq temp cdr_A1)
   repeat
   (cond
     ((null temp) (return n))
     ((null (member (car temp) Z) ) (setq n (+ n 1)) (setq temp (cdr temp)))
     (t (setq n (+ n 0)) (setq temp (cdr temp)))
   )
   (go repeat)
)
)



(defun TEST(A)

(prog(A1 A2)

      (cond
          ((null A ) (return 'Fail))
          (t (setq A1 (car A)) (setq A (cdr A)) (setq A2 (car A1)) 
             (cond 
              ((equal (Member_Of_Z (cdr A1)) 0) 
               (cond
                 ((equal A2 STOP) (return 'SUCCESS))
                 (t (ADD_to_Z A2) (setq A (cdr A)) (TEST A) )
               )
              )
              (t (TEST A)  )
             )
          )
      ) 

    )
    )

职能目标： - Member_of_Z将验证cdr A1的所有元素是否属于Z.如果属于，则返回0（否则返回其他数字）。 这是没有发生的事情当A等于((G W U))

时，假设返回SUCCESS
    当ADD_to_Z未返回0 时，
  • Member_Of_Z会将A2添加到Z.

问题：不仅A似乎永远不会被修改（在函数TEST结束时，A仍然等于defvar设置的原始值，即使我用(setq A (cdr A))修改它此外，SUCCESS永远不会被退回。

你能帮帮我吗？

1 个答案:

答案 0 :(得分：5)

步骤1：使用标准格式（修复第一个顶层形式）。

(defvar A '((X Y Z) (J L O P) (G W U)))

(defvar Z '(X W D U G))

(defvar STOP 'G)

(defun ADD_to_Z (A2)
  (prog ()
    (cond ((equal (Member_Of_Z (list A2)) 0))
          (t (setq Z (append Z (list A2)))))))

(defun Member_of_Z (cdr_A1)
  (prog (n temp)
    (setq n 0)
    (setq temp cdr_A1)
    repeat
    (cond ((null temp) (return n))
          ((null (member (car temp) Z) ) (setq n (+ n 1)) (setq temp (cdr temp)))
          (t (setq n (+ n 0)) (setq temp (cdr temp))))
    (go repeat)))

(defun TEST (A)
  (prog (A1 A2)
    (cond ((null A ) (return 'Fail))
          (t (setq A1 (car A))
             (setq A (cdr A))
             (setq A2 (car A1))
             (cond ((equal (Member_Of_Z (cdr A1)) 0)
                    (cond ((equal A2 STOP) (return 'SUCCESS))
                          (t (ADD_to_Z A2) (setq A (cdr A)) (TEST A) )))
                   (t (TEST A)))))))

第2步：使用标准命名。

(defvar *a* '((x y z) (j l o p) (g w u)))

(defvar *z* '(x w d u g))

(defvar *stop* 'g)

(defun add-to-z (a2)
  (prog ()
    (cond ((equal (member-of-z (list a2)) 0))
          (t (setq *z* (append *z* (list a2)))))))

(defun member-of-z (cdr-a1)
  (prog (n temp)
    (setq n 0)
    (setq temp cdr-a1)
    repeat
    (cond ((null temp) (return n))
          ((null (member (car temp) *z*)) (setq n (+ n 1)) (setq temp (cdr temp)))
          (t (setq n (+ n 0)) (setq temp (cdr temp))))
    (go repeat)))

(defun test (a)
  (prog (a1 a2)
    (cond ((null a) (return 'fail))
          (t (setq a1 (car a))
             (setq a (cdr a))
             (setq a2 (car a1))
             (cond ((equal (member-of-z (cdr a1)) 0)
                    (cond ((equal a2 *stop*) (return 'success))
                          (t (add-to-z a2) (setq a (cdr a)) (test a))))
                   (t (test a)))))))

第3步：摆脱PROG。

(defvar *a* '((x y z) (j l o p) (g w u)))

(defvar *z* '(x w d u g))

(defvar *stop* 'g)

(defun add-to-z (a2)
  (cond ((equal (member-of-z (list a2)) 0))
        (t (setq *z* (append *z* (list a2))))))

(defun member-of-z (cdr-a1)
  (let ((n 0)
        (temp cdr-a1))
    repeat
    (cond ((null temp) (return n))
          ((null (member (car temp) z)) (setq n (+ n 1)) (setq temp (cdr temp)))
          (t (setq n (+ n 0)) (setq temp (cdr temp))))
    (go repeat)))

(defun test (a)
  (cond ((null a) (return 'fail))
        (t (let ((a1 (car a))
                 (a (cdr a))
                 (a2 (car a1)))
             (cond ((equal (member-of-z (cdr a1)) 0)
                    (cond ((equal a2 *stop*) (return 'success))
                          (t (add-to-z a2) (setq a (cdr a)) (test a))))
                   (t (test a)))))))

步骤4：用结构化的环替换手卷循环。

(defvar *a* '((x y z) (j l o p) (g w u)))

(defvar *z* '(x w d u g))

(defvar *stop* 'g)

(defun add-to-z (a2)
  (cond ((equal (member-of-z (list a2)) 0))
        (t (setq *z* (append *z* (list a2))))))

(defun member-of-z (cdr-a1)
  (let ((n 0)
        (temp cdr-a1))
    (loop :for element :in temp
          :unless (member element *z*)
          :do (incf n))
    n))

(defun test (a)
  (cond ((null a) (return 'fail))
        (t (let ((a1 (car a))
                 (a (cdr a))
                 (a2 (car a1)))
             (cond ((equal (member-of-z (cdr a1)) 0)
                    (cond ((equal a2 *stop*) (return 'success))
                          (t (add-to-z a2) (setq a (cdr a)) (test a))))
                   (t (test a)))))))

步骤5：用IF替换双子句COND。当它们进入时减少RETURN表格 无论如何尾部位置（并且他们不会那样工作）。

(defvar *a* '((x y z) (j l o p) (g w u)))

(defvar *z* '(x w d u g))

(defvar *stop* 'g)

(defun add-to-z (a2)
  (if (equal (member-of-z (list a2)) 0)
      nil
      (setq *z* (append *z* (list a2)))))

(defun member-of-z (cdr-a1)
  (let ((n 0)
        (temp cdr-a1))
    (loop :for element :in temp
          :unless (member element *z*)
          :do (incf n))
    n))

(defun test (a)
  (if (null a)
      'fail
      (let ((a1 (car a))
            (a (cdr a))
            (a2 (car a1)))
        (if (equal (member-of-z (cdr a1)) 0)
            (if (equal a2 *stop*)
                'success
                (progn (add-to-z a2) (setq a (cdr a)) (test a)))
            (test a)))))

步骤6：用简单的计数功能替换循环。

(defvar *a* '((x y z) (j l o p) (g w u)))

(defvar *z* '(x w d u g))

(defvar *stop* 'g)

(defun add-to-z (a2)
  (if (equal (member-of-z (list a2)) 0)
      nil
      (setq *z* (append *z* (list a2)))))

(defun member-of-z (cdr-a1)
  (count-if-not (lambda (element)
                  (member element *z*))
                cdr-a1))

(defun test (a)
  (if (null a)
      'fail
      (let ((a1 (car a))
            (a (cdr a))
            (a2 (car a1)))
        (if (equal (member-of-z (cdr a1)) 0)
            (if (equal a2 *stop*)
                'success
                (progn
                  (add-to-z a2)
                  (setq a (cdr a))
                  (test a)))
            (test a)))))

此时，我仍然不知道你想要做什么。也许你想要 在*a*中找到完全包含在*z*中的列表：

(defun test (a)
  (find-if (lambda (list)
             (every (lambda (element)
                      (member element *z*))
                    list))
           a))
相关问题
最新问题