Common LISP: создай свой собственный профсоюз

Question

Я пытаюсь заставить свой собственный профсоюз функционировать и понимаю, насколько сильно мне не нравится LISP. Цель состоит в том, чтобы дать функции два списка, и она вернет теорию множеств c объединение двух. Моя попытка решения стала более сложной с тем же результатом: NIL. Я не могу поменять это с того, чтобы быть результатом, независимо от того, что я делаю.

Я думал о создании отдельного списка в моей функции «removeDuplicates» ниже, но потом подумал, как мне вернуть это с помощью рекурсии. Я думаю, что происходит, моя функция «removeDuplicates» в конечном итоге возвращает пустой список (как и предполагалось), но затем пустой список возвращается на каждом уровне стека, когда рекурсия разворачивается (начинает возвращать значения вверх по стеку), но я могу ошибаться. У меня всегда были проблемы с пониманием рекурсии в деталях. Код ниже.

(defun rember (A LAT)
  (cond
   ((null LAT) ())
   ((EQ (car LAT) A) (cdr LAT))
   (T (cons (car LAT)(rember A (cdr LAT))))
   )
  )

(defun my_member (A LAT)
  (cond
   ((null LAT) nil)
   ((EQ (car LAT) A) T)
   (T (my_member A (cdr LAT)))
   )
  )

(defun removeDuplicates (L)
  (cond
   ((null L) '())
   ((my_member (car L) (cdr L)) (rember (car L) L) (removeDuplicates (cdr L)))
   (T (removeDuplicates (cdr L)))
   )
  )

(defun my_union (A B)
  (setq together(append A B))
  (removeDuplicates together)
  )

Я знаю, что большинство людей не являются поклонниками этого формата кода LISP, но я предпочитаю его. Это позволяет мне увидеть, как скобки выстраиваются в линию лучше, чем если бы вы просто сложили все закрывающие скобки в конце функций и блоков условий.

Если я, например, запускаю (my_union '(a b) '(b c)), результатом будет NIL.

Answer 1

Когда вы вызываете removeDuplicates рекурсивно в последнем условии, вы не объединяете результат с car списка, поэтому вы отбрасываете этот элемент.

Вы также не используя результат rember.

(defun removeDuplicates (L)
  (cond
   ((null L) '())
   ((my_member (car L) (cdr L)) 
    (cons (car L) 
          (removeDuplicates 
           (rember (car L) (cdr L)) 
           ))
    )
   (T (cons (car L) (removeDuplicates (cdr L))))
   )
  )

Answer 2

Вот remove-dupes, который удаляет дубликаты из списка за O (n) раз, используя таблицу ha sh. Он поддерживает пользовательскую функцию равенства (которая должна быть eq, eql, equal или `equalp) и пользовательскую тестовую функцию, чтобы любой аспект элемента можно было рассматривать как ключ.

(defun remove-dupes (list &key (test #'eql) (key #'identity))
  (let ((hash (make-hash-table :test test)))
    (loop for item in list
          for item-key = (funcall key item)
          for seen = (gethash item-key hash)
          unless seen collect item and
                      do (setf (gethash item-key hash) t))))

Например, предположим, что у нас есть список c ((a . 1) (a . 2) (b . 3) (c . 4) (b . 4)). Мы хотели бы удалить дубликаты с помощью car:

[1]> (remove-dupes '((a . 1) (a . 2) (b . 3) (c . 4) (b . 4)) :key #'car)
((A . 1) (B . 3) (C . 4))

Сообщаются только самые левые записи A, B и C; дубликаты подавляются. Теперь давайте сделаем это с помощью cdr:

[2]> (remove-dupes '((a . 1) (a . 2) (b . 3) (c . 4) (b . 4)) :key #'cdr)
((A . 1) (A . 2) (B . 3) (C . 4))

(b . 4) был отбракован из-за дублированного значения 4.

Но зачем все это делать, когда Common Lisp предоставляет функция remove-duplicates (не говоря уже о union).

remove-duplicates является более общей, чем у меня здесь: она обрабатывает последовательности, а не только списки, поэтому она работает на векторах и строках. У него больше ключевых параметров.

Answer 3

Один из способов проверить ваш код Common Lisp - попросить вашего переводчика TRACE функции:

(trace removeDuplicates my_member rember)

Чтобы избежать слишком большого количества трассировок, используйте небольшие примеры.

Сначала попробуем с пустым списком; это пример из REPL («read eval print l oop»), протестированного с SBCL, в то время как в пакете «SO» (StackOverflow); трассировка напечатана с небольшим отступом, пронумерована в соответствии с глубиной рекурсии. Здесь вызов не является рекурсивным и сразу завершается:

SO> (removeduplicates nil)
  0: (SO::REMOVEDUPLICATES NIL)
  0: REMOVEDUPLICATES returned NIL
NIL

Это работает, давайте попробуем пример с одноэлементным списком, в котором явно нет дубликатов:

SO> (removeduplicates '(1))
  0: (SO::REMOVEDUPLICATES (1))
    1: (SO::MY_MEMBER 1 NIL)
    1: MY_MEMBER returned NIL
    1: (SO::REMOVEDUPLICATES NIL)
    1: REMOVEDUPLICATES returned NIL
  0: REMOVEDUPLICATES returned NIL
NIL

removeDuplicate вызывает my_member, что правильно возвращает nil, за которым следует рекурсивный вызов removeDuplicates с nil, который правильно возвращает nil. Однако есть проблема, потому что тогда внешний вызов тоже возвращает nil, что неверно .

Глядя на трассу, мы должны оглянуться на код, чтобы найти место где вызывается my_member, за которым следует рекурсивный вызов removeDuplicates. Существует только одно место, где my_member называется, в качестве теста для второго предложения в cond; Поскольку для этого теста результат равен nil, пробуется следующее предложение, в этом случае значение по умолчанию:

(cond
   ...
   ;; this is the call to my_member (= nil)
   ((my_member (car L) (cdr L)) ...)

   ;; this is the recursive call
   (t (removeDuplicates (cdr L))))

Значение cond - это значение, данное последним (removeDuplicates (cdr L)) , который просто не сохраняет существующие элементы перед L. Если бы вы изменяли последовательность, вы могли бы просто выделить подпоследовательность и проигнорировать предыдущие элементы: в этом случае вызывающая сторона все равно будет содержать ссылку на исходную последовательность, что приведет к удалению ее элемента из-за побочного эффекта ваших функций. Но здесь вы придерживаетесь строго неизменного подхода, и вам необходимо восстановить список в качестве возвращаемого значения.

Другими словами, removeDuplicates выражается как: return a новый список, который содержит те же элементы, что и исходный список, но без дубликатов .

Поэтому необходимо добавить (car L) перед (removeDuplicates (cdr L)).

(defun removeDuplicates (L)
  (cond
    ((null L) '())
    ((my_member (car L) (cdr L)) (rember (car L) L) (removeDuplicates (cdr L)))
    (T (cons (car L)
             (removeDuplicates (rest L))))))

Давайте test:

SO> (removeduplicates '())
  0: (SO::REMOVEDUPLICATES NIL)
  0: REMOVEDUPLICATES returned NIL
NIL
SO> (removeduplicates '(1))
  0: (SO::REMOVEDUPLICATES (1))
    1: (SO::MY_MEMBER 1 NIL)
    1: MY_MEMBER returned NIL
    1: (SO::REMOVEDUPLICATES NIL)
    1: REMOVEDUPLICATES returned NIL
  0: REMOVEDUPLICATES returned (1)
(1)

Вы можете проверить с более длинным списком (без дубликатов), результат верный, но трасса длиннее.

Теперь давайте добавим дубликаты:

SO> (removeduplicates '(1 2 2 1))
  0: (SO::REMOVEDUPLICATES (1 2 2 1))
    1: (SO::MY_MEMBER 1 (2 2 1))
      2: (SO::MY_MEMBER 1 (2 1))
        3: (SO::MY_MEMBER 1 (1))
        3: MY_MEMBER returned T
      2: MY_MEMBER returned T
    1: MY_MEMBER returned T
    1: (SO::REMBER 1 (1 2 2 1))
    1: REMBER returned (2 2 1)
    1: (SO::REMOVEDUPLICATES (2 2 1))
      2: (SO::MY_MEMBER 2 (2 1))
      2: MY_MEMBER returned T
      2: (SO::REMBER 2 (2 2 1))
      2: REMBER returned (2 1)
      2: (SO::REMOVEDUPLICATES (2 1))
        3: (SO::MY_MEMBER 2 (1))
          4: (SO::MY_MEMBER 2 NIL)
          4: MY_MEMBER returned NIL
        3: MY_MEMBER returned NIL
        3: (SO::REMOVEDUPLICATES (1))
          4: (SO::MY_MEMBER 1 NIL)
          4: MY_MEMBER returned NIL
          4: (SO::REMOVEDUPLICATES NIL)
          4: REMOVEDUPLICATES returned NIL
        3: REMOVEDUPLICATES returned (1)
      2: REMOVEDUPLICATES returned (2 1)
    1: REMOVEDUPLICATES returned (2 1)
  0: REMOVEDUPLICATES returned (2 1)
(2 1)

Результат правильный (порядок значения не имеет).

Пока наши тесты хороши.

Возможно, вы не определили другую проблему в этой функции, а именно, что все звонки на rember бесполезны, и, честно говоря, это не всегда легко обнаружить с помощью трассировки. Но, глядя на код, должно быть ясно, что если вы пишете код с небольшими побочными эффектами, следующий пункт бесполезно вызывает (rember ...):

((my_member (car L) (cdr L)) (rember (car L) L) (removeDuplicates (cdr L)))

Предложение cond имеет синтаксис (TEST . BODY), где BODY - это последовательность выражений, которая оценивается как PROGN: значение PROGN - это значение его последнего предложения, все промежуточные предложения используются только для их побочных эффектов. Например:

(progn
  (print "I am here")
  (* 10 3))

Здесь выше, вызов PRINT возвращает значение, но оно отбрасывается: значение включающего PROGN равно 30.

В вашем коде rember не имеет побочных эффектов, и его возвращаемое значение отбрасывается. Просто удалите его:

(defun removeDuplicates (L)
  (cond
    ((null L) '())
    ((my_member (car L) (cdr L)) 
     (removeDuplicates (cdr L)))
    (T (cons (first L)
             (removeDuplicates (rest L))))))

Я бы написал такой же код, как лично:

(defun remove-duplicate-elements (list)
  (when list
    (let ((head (first list))
          (tail (remove-duplicate-elements (rest list))))
      (if (member head tail) tail (cons head tail)))))

Answer 4

Вот простая, очевидная, объединяющая функция:

(defun union/tfb (&rest lists)
  ;; compute the union of any number of lists, implicitly using EQL
  (labels ((union/spread (l1 ls)
             ;; UNION/SPREAD just exists to avoid the impedance
             ;; mismatch in argument convention
             (if (null ls)
                 l1
               (let ((result l1))
                 (destructuring-bind (l2 . more) ls
                   (dolist (e l2 (union/spread result more))
                     (pushnew e result)))))))
    (union/spread (first lists) (rest lists))))

Я думаю, что это достаточно естественный CL, хотя, конечно, весь смысл использования такого языка, как CL, состоит в том, чтобы избежать бесконечного повторного изобретения колеса, подобного этому.

Так что правила игры, возможно, гласят, что вы не можете использовать PUSHNEW: ну, вы можете легко заменить его условным условием MEMBER:

(defun union/tfb (&rest lists)
  ;; compute the union of any number of lists, implicitly using EQL
  (labels ((union/spread (l1 ls)
             ;; UNION/SPREAD just exists to avoid the impedance
             ;; mismatch in argument convention
             (if (null ls)
                 l1
               (let ((result l1))
                 (destructuring-bind (l2 . more) ls
                   (dolist (e l2 (union/spread result more))
                     ;; Really use PUSHNEW for this
                     (unless (member e result)
                       (setf result (cons e result)))))))))
    (union/spread (first lists) (rest lists))))

И, возможно, вам также не разрешено использовать MEMBER: вы можете легко написать предикат, который будет делать то, что вам нужно:

(defun union/tfb (&rest lists)
  ;; compute the union of any number of lists, implicitly using EQL
  (labels ((union/spread (l1 ls)
             ;; UNION/SPREAD just exists to avoid the impedance
             ;; mismatch in argument convention
             (if (null ls)
                 l1
               (let ((result l1))
                 (destructuring-bind (l2 . more) ls
                   (dolist (e l2 (union/spread result more))
                     ;; Really use MEMBER for this, and in fact
                     ;; PUSHNEW
                     (unless (found-in-p e result)
                       (setf result (cons e result))))))))
           (found-in-p (e list)
             ;; is e found in LIST? This exists only because we're not
             ;; meant to use MEMBER
             (cond ((null list) nil)
                   ((eql e (first list)) t)
                   (t (found-in-p e (rest list))))))
    (union/spread (first lists) (rest lists))))

Если вы хотите, чтобы результатом был набор с уникальными элементами, даже если Во-первых, вы не можете сделать это тривиально (обратите внимание, что CL UNION не обещает этого, и вы можете получить тот же результат с более ранней версией UNION/TFB от (union/tfb '() ...)):

(defun union/tfb (&rest lists)
  ;; compute the union of any number of lists, implicitly using EQL
  (labels ((union/spread (l1 ls)
             ;; UNION/SPREAD just exists to avoid the impedance
             ;; mismatch in argument convention
             (if (null ls)
                 l1
               (let ((result l1))
                 (destructuring-bind (l2 . more) ls
                   (dolist (e l2 (union/spread result more))
                     ;; Really use MEMBER for this, and in fact
                     ;; PUSHNEW
                     (unless (found-in-p e result)
                       (setf result (cons e result))))))))
           (found-in-p (e list)
             ;; is e found in LIST? This exists only because we're not
             ;; meant to use MEMBER
             (cond ((null list) nil)
                   ((eql e (first list)) t)
                   (t (found-in-p e (rest list))))))
    (union/spread '() lists)))

Наконец, если правила запрещают вам использовать итеративные конструкции и присваивания, вы можете сделать это тоже:

(defun union/tfb (&rest lists)
  ;; compute the union of any number of lists, implicitly using EQL
  (labels ((union/spread (l1 ls)
             ;; UNION/SPREAD just exists to avoid the impedance
             ;; mismatch in argument convention
             (if (null ls)
                 l1
               (union/loop l1 (first ls) (rest ls))))
           (union/loop (result l more)
             ;; UNION/LOOP is just an iteration
             (if (null l)
                 (union/spread result more)
               (destructuring-bind (e . remainder) l
                 (union/loop (if (found-in-p e result)
                                 result
                               (cons e result))
                             remainder more))))
           (found-in-p (e list)
             ;; is e found in LIST? This exists only because we're not
             ;; meant to use MEMBER
             (cond ((null list) nil)
                   ((eql e (first list)) t)
                   (t (found-in-p e (rest list))))))
    (union/spread '() lists)))

Конечный результат всех этих изменений, возможно, очень чистый, но не естественный CL в все: что-то вроде этого может быть более естественным в Схеме (хотя и не заменяющим MEMBER доморощенным предикатом, подобным этому).