从列表中删除重复项并将其组合在Lisp中

时间:2013-05-15 20:06:15

标签: list lisp

我有以下类型的列表

(("abc" "12" "45")
 ("abc" "34" "56")
 ("cdb" "56" "78")
 ("deg" "90" "67")
 ("deg" "45" "34"))

并且所需的输出是

(("abc" "12" "45" "34" "56")
 ("cdb" "56" "78")
 ("deg" "90" "67" "45 "34)).

Lisp中相同的方法是什么?

6 个答案:

答案 0 :(得分:3)

在Common Lisp中,一种可能性是这样的:

(defun merge-lists (lists)
  (let ((rv (make-hash-table :test #'equal)))
         (mapcar (lambda (list)
           (mapcar (lambda (x) (push x (gethash (car list) rv nil))) (cdr list)))
                   lists)
    (loop for key being the hash-keys of rv
          collect (cons key (reverse (gethash key rv))))))

答案 1 :(得分:1)

这个帖子已经有很多很棒的答案了。但既然没有人 已经提到了Common Lisp集合操作,我以为我会用我的 自己的。

假设你的数据真的像这样:

'((("abc") ("12" "45"))
  (("abc") ("34" "56"))
  (("cdb") ("56" "78"))
  (("deg") ("90" "67"))
  (("deg") ("45" "34")))

,即。密钥表与一系列值配对。而你想要的是合并给定键的值,而不仅仅是 追加它们,然后Common Lisp有一个直接的系列 这样做的操作。只需使用assocunion即可。注意,union的工作原理如下:

(setf record1 '("abc" "12" "34" "56"))
(setf record2 ' ("abc" "56" "45" "43"))
(union (cdr record1) (cdr record2) :test #'string=)

=> ("34" "12" "56" "45" "43")

assoc允许您从列表列表构建键值表。您可以添加几个访问函数来抽象出底层表示,如下所示:

(defun get-record (table key)
  (assoc key table :test #'string=))

(defun merge-records (record1 record2)
  (if (not record1) 
      record2
          (cons (car record1) 
        (union (cdr record1) (cdr record2) :test #'string=))))

(defun insert-record (table record)
  (cons (merge-records record (get-record table (car record))) table))

所以,使用你的测试数据:

(setf raw-data '(("abc" "12" "45")
    ("abc" "34" "56")
    ("abc" "45" "43")  ;; Note, duplicate value 45 to illustrate usage of union.
    ("cdb" "56" "78")
    ("deg" "90" "67")
    ("deg" "45" "34")))

将数据加载到表中:

(setf data-table (reduce  #'insert-record raw-data :initial-value '()))

打印表格:

(mapcar (lambda (key) (get-record data-table key)) '("abc" "cdb" "deg"))

==> (("abc" "12" "34" "56" "45" "43") ("cdb" "78" "56") ("deg" "34" "45" "67" "90"))

当然,对于插入或查找值,alists效率不高。但它们使用起来非常方便,因此典型的工作流程是使用alist解决方案开发您的解决方案,通过访问功能抽象实际实现,然后,一旦您明确了解问题并确定实施,选择一种更有效的数据结构 - 当然,如果它会对现实世界的表现产生影响。

答案 2 :(得分:0)

在Racket中,这是Scheme的一种方言,反过来又是Lisp的一种方言,你可以通过使用哈希表来跟踪具有相同第一个元素的列表之间的重复元素来解决这个问题,使用第一个元素element作为键,通过折叠操作累积结果,最后映射键上的键/值对及其列表值。方法如下:

(define input
  '(("abc" "12" "45") ("abc" "34" "56") ("cdb" "56" "78")
    ("deg" "90" "67") ("deg" "45" "34")))

(hash-map
 (foldl (lambda (e h)
          (hash-update h (car e)
                       (lambda (p) (append (cdr e) p))
                       (const '())))
        (make-immutable-hash)
        input)
 cons)

结果如预期的那样,虽然合并列表中的元素以不同的顺序出现(但这不应该是一个问题,如果需要,排序它们是微不足道的):

'(("deg" "45" "34" "90" "67") ("abc" "34" "56" "12" "45") ("cdb" "56" "78"))

答案 3 :(得分:0)

在Common Lisp中,使用排序和尾递归的强力解决方案可以是:

(defun combine-duplicates (list)
  (labels ((rec (tail marker accum result)
             (cond ((not tail)
                    (append result (list accum)))
                   ((equal marker (caar tail))
                    (rec (cdr tail)  marker (append accum (cdar tail)) result))
                   (t
                    (rec (cdr tail) (caar tail) (car tail) (append result (list accum)))))))
    (if (not list) nil
        (let ((sorted-list (sort list #'string-lessp :key #'car)))
          (rec (cdr sorted-list) (caar sorted-list) (car sorted-list) nil)))))

答案 4 :(得分:0)

由于问题,如上所述,输入已经按第一个元素排序,这是一个利用这个事实的解决方案。它只对输入列表进行一次传递,以相反的顺序构建结果列表,并返回(nreverse d)结果。

(defparameter *input* 
  '(("abc" "12" "45")
    ("abc" "34" "56")
    ("cdb" "56" "78")
    ("deg" "90" "67")
    ("deg" "45" "34")))

(defparameter *desired-output* 
  '(("abc" "12" "45" "34" "56")
    ("cdb" "56" "78")
    ("deg" "90" "67" "45" "34")))

(defun merge-duplicates (input) 
  ;; Start with the result being empty, and continue until there are
  ;; no more sublists in the input to process.  Since the result is
  ;; built up in reverse order, it is NREVERSEd for return.
  (do ((result '()))
      ((endp input) (nreverse result))
    ;; Each element from the input can be popped off, and should have
    ;; the form (key . elements).  
    (destructuring-bind (key &rest elements) (pop input)
      ;; The result list (except in the first iteration) has the form
      ;; ((key-x . elements-x) ...), so we check whether key is equal
      ;; to key-x.
      (if (equal key (first (first result)))
          ;; If it is, then replace elements-x with (append
          ;; elements-x elements).  (This keeps the merged lists in
          ;; order.  This is a bit wasteful; we could record all
          ;; these elements during traversal and only concatenate
          ;; once at the end, but it would complicate the return form
          ;; a bit.
          (setf (rest (first result))
                (append (rest (first result)) elements))
          ;; Otherwise, they're different, and we can just push (key
          ;; . elements) into the result list, since it marks the
          ;; beginning of a new sublist.  Since we destructively
          ;; update the tails, we do not want to put the cons from
          ;; the input into results, so we make a copy using (list*
          ;; key elements) (which is EQUAL to the thing we popped
          ;; from input.
          (push (list* key elements)
                result)))))

这是一个实际操作的示例,以及一个确保它返回正确结果的测试:

CL-USER> (problem *input*)
(("abc" "12" "45" "34" "56") ("cdb" "56" "78") ("deg" "90" "67" "45" "34"))

CL-USER> (equal (problem *input*) *desired-output*)
T

如果输入的格式为((nil ...) ...),则会失败,因为result最初为nil(first (first result))将返回nil,因此{{1} }将是真的,(equal key (first (first result)))会尝试访问非(setf (rest (rest ...)) ...)能力的地方。在创建合并尾部时也有点浪费,但从未指定这些元素的顺序应该是什么,所以这至少会尝试将它们保持在相同的顺序。

答案 5 :(得分:0)

常见Lisp,但既不是最快也不是最短。您可以忽略copy-list并修改原始文件,但随后可以在给定共享结构的情况下生成循环列表。 TEST关键字具有规范的默认值。

(defun fixup-alist (old &key (test #'eql))
  "Combine OLD alist's duplicate keys."
  (let ((new (mapcar #'list
                     (delete-duplicates (mapcar #'car old)
                                        :test test))))
    (dolist (entry old new)
      (nconc (assoc (car entry) new
                    :test test)
             (copy-list (cdr entry))))))
FIXUP-ALIST
CL-USER> (fixup-alist x)
(("abc" "12" "45") ("abc" "34" "56") ("cdb" "56" "78") ("deg" "90" "67") ("deg" "45" "34"))
CL-USER> (fixup-alist x :test #'string=)
(("abc" "12" "45" "34" "56") ("cdb" "56" "78") ("deg" "90" "67" "45" "34"))