我有以下类型的列表
(("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 中相同的正确方法是什么?
在 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))))))
在这个线程上已经有很多很好的答案了。但是由于没有人提到 Common Lisp 集合操作,我想我会用我自己的方法加入。
假设您的数据确实如下所示:
'((("abc") ("12" "45"))
(("abc") ("34" "56"))
(("cdb") ("56" "78"))
(("deg") ("90" "67"))
(("deg") ("45" "34")))
,即与一系列值配对的键表。你想要的是合并给定键的值,而不仅仅是附加它们,那么 Common Lisp 有一系列直接的操作来做到这一点。只需使用assoc
和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"))
当然,对于我们的插入或查找值,alist 的效率都不是很高。但是它们使用起来超级方便,因此典型的工作流程是使用 alist 解决方案开发您的解决方案,通过访问函数抽象实际实现,然后,一旦您明确了对问题的理解并确定了您的实现,选择一个更有效的数据结构——当然,如果它会对实际性能产生影响的话。
如上所述,由于问题的输入已经按第一个元素排序,因此这里有一个利用这一事实的解决方案。它只遍历输入列表一次,以相反的顺序构建结果列表,并返回 ( 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
,所以(equal key (first (first result)))
将是真的,并且(setf (rest (rest ...)) ...)
将尝试访问一个不可访问的setf
地方。创建合并的尾部也有点浪费,但从未指定这些元素的顺序应该是什么,所以这至少试图让它们保持相同的顺序。
在 Racket 中,这是 Scheme 的一种方言,而后者又是 Lisp 的一种方言,您可以通过使用哈希表来跟踪具有相同第一个元素的列表之间的重复元素,使用第一个元素作为键来解决这个问题,通过折叠操作累积结果,最后映射键/值对,将键与它们的列表值结合起来。就是这样:
(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"))
在 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)))))
再次是 Common 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"))