Moc*_*uck 6 lisp list common-lisp
我想只反转连续序列,而不是原始列表中的所有元素.
Ex:
(reverseC '( 1 2 ( 4 5 ) 5 ) ) => ( 2 1 ( 5 4 ) 5 )
(reverseC '(1 4 2 (3 4) 9 6 (7 8)))) => (2 4 1 (4 3) 6 9 (8 7))
我正在考虑将它分成两个函数:一个用于反转一个简单列表(1 2 3) - >(3 2 1)和一个函数(main)来确定连续序列,从中列出一个列表,应用反向该列表和重制整个反转列表.
(defun reverse-list ( lista )
(if (eql lista () )
()
(append (reverse-list (cdr lista )) (list ( car lista)))
)
)
这是相反的功能,但我不知道如何做另一个.我是Lisp的新手,我来自Prolog所以这是一个非常大的风景变化.欢迎任何想法.
(defun reverse-more (L)
(if (eql L nil)
nil
(let ( el (car L)) (aux (cdr L)))
(if (eql (listp el) nil)
...No idea on the rest of the code ...
已经有了一个公认的答案,但这似乎是一个有趣的挑战.我试图稍微抽象一些细节,并生成一个map-contig函数,它调用输入列表的每个连续子列表的函数,并通过传入的谓词确定什么是连续列表.
(defun map-contig (function predicate list)
"Returns a new list obtained by calling FUNCTION on each sublist of
LIST consisting of monotonically non-decreasing elements, as determined
by PREDICATE. FUNCTION should return a list."
;; Initialize an empty RESULT, loop until LIST is empty (we'll be
;; popping elements off of it), and finally return the reversed RESULT
;; (since we'll build it in reverse order).
(do ((result '())) ((endp list) (nreverse result))
(if (listp (first list))
;; If the first element is a list, then call MAP-CONTIG on it
;; and push the result into RESULTS.
(push (map-contig function predicate (pop list)) result)
;; Otherwise, build up sublist (in reverse order) of contiguous
;; elements. The sublist is finished when either: (i) LIST is
;; empty; (ii) another list is encountered; or (iii) the next
;; element in LIST is non-contiguous. Once the sublist is
;; complete, reverse it (since it's in reverse order), call
;; FUNCTION on it, and add the resulting elements, in reverse
;; order, to RESULTS.
(do ((sub (list (pop list)) (list* (pop list) sub)))
((or (endp list)
(listp (first list))
(not (funcall predicate (first sub) (first list))))
(setf result (nreconc (funcall function (nreverse sub)) result)))))))
这是你原来的例子:
(map-contig 'reverse '< '(1 2 (4 5) 5))
;=> (2 1 (5 4) 5)
值得注意的是,这将检测单个子列表中的不连续性.例如,如果我们只想要连续的整数序列(例如,每个连续的差异为1),我们可以使用特殊谓词来做到这一点:
(map-contig 'reverse (lambda (x y) (eql y (1+ x))) '(1 2 3 5 6 8 9 10))
;=> (3 2 1 6 5 10 9 8)
如果您只想在子列表出现时中断,则可以使用始终返回true的谓词:
(map-contig 'reverse (constantly t) '(1 2 5 (4 5) 6 8 9 10))
;=> (5 2 1 (5 4) 10 9 8 6)
这是另一个例子,其中"连续"意味着"具有相同的符号",而不是反转连续的序列,我们对它们进行排序:
;; Contiguous elements are those with the same sign (-1, 0, 1),
;; and the function to apply is SORT (with predicate <).
(map-contig (lambda (l) (sort l '<))
(lambda (x y)
(eql (signum x)
(signum y)))
'(-1 -4 -2 5 7 2 (-6 7) -2 -5))
;=> (-4 -2 -1 2 5 7 (-6 7) -5 -2)
(defun reverse-contig (list)
(labels ((reverse-until (list accumulator)
"Returns a list of two elements. The first element is the reversed
portion of the first section of the list. The second element is the
tail of the list after the initial portion of the list. For example:
(reverse-until '(1 2 3 (4 5) 6 7 8))
;=> ((3 2 1) ((4 5) 6 7 8))"
(if (or (endp list) (listp (first list)))
(list accumulator list)
(reverse-until (rest list) (list* (first list) accumulator)))))
(cond
;; If LIST is empty, return the empty list.
((endp list) '())
;; If the first element of LIST is a list, then REVERSE-CONTIG it,
;; REVERSE-CONTIG the rest of LIST, and put them back together.
((listp (first list))
(list* (reverse-contig (first list))
(reverse-contig (rest list))))
;; Otherwise, call REVERSE-UNTIL on LIST to get the reversed
;; initial portion and the tail after it. Combine the initial
;; portion with the REVERSE-CONTIG of the tail.
(t (let* ((parts (reverse-until list '()))
(head (first parts))
(tail (second parts)))
(nconc head (reverse-contig tail)))))))
(reverse-contig '(1 2 3 (4 5) 6 7 8))
;=> (3 2 1 (5 4) 8 7 6)
(reverse-contig '(1 3 (4) 6 7 nil 8 9))
;=> (3 1 (4) 7 6 nil 9 8)
关于这个只有两个注释.首先,list*非常像cons,因为(list*'a'(bcd))返回(abcd). list**虽然可以采用更多的参数(例如,**(list*'a'b'(cde))返回(abcde)),并且在我看来,它产生了列表的意图(而不是任意的细胞)有点清楚.第二,另一个答案解释了使用destructuring-bind ; 如果这种方法可能会稍微缩短一点
(let* ((parts (reverse-until list '()))
(head (first parts))
(tail (second parts)))
被替换为
(destructuring-bind (head tail) (reverse-until list '())
您可以使用单个递归函数一次性执行所有操作，并发出通常的警告，即您应该更喜欢循环构造而不是递归方法（见下文）：
(defun reverse-consecutive (list &optional acc)
(etypecase list
;; BASE CASE
;; return accumulated list
(null acc)
;; GENERAL CASE
(cons (destructuring-bind (head . tail) list
(typecase head
(list
;; HEAD is a list:
;;
;; - stop accumulating values
;; - reverse HEAD recursively (LH)
;; - reverse TAIL recursively (LT)
;;
;; Result is `(,@ACC ,LH ,@LT)
;;
(nconc acc
(list (reverse-consecutive head))
(reverse-consecutive tail)))
;; HEAD is not a list
;;
;; - recurse for the result on TAIL with HEAD
;; in front of ACC
;;
(t (reverse-consecutive tail (cons head acc))))))))
(reverse-consecutive '(1 2 (3 4) 5 6 (7 8)))
=> (2 1 (4 3) 6 5 (8 7))
(mapcar #'reverse-consecutive
'((1 3 (8 3) 2 )
(1 4 2 (3 4) 9 6 (7 8))
(1 2 (4 5) 5)))
=> ((3 1 (3 8) 2)
(2 4 1 (4 3) 6 9 (8 7))
(2 1 (5 4) 5))
@Melye77 该destructuring-bind表达式与 Prolog 中的功能相同 [Head|Tail] = List。我本来可以写这个
(let ((head (first list))
(tail (rest list)))
...)
同样，只要有可能，我更喜欢使用(e)typecase通用cond表达式，因为我认为它更精确。
我本来可以写：
(if acc
(if (listp (first list))
(nconc ...)
(reverse-consecutive ...))
acc)
...但我认为不太清楚，对初学者来说并不是一件好事。相反，我认为即使（尤其是）对于初学者来说，介绍全部可用的结构也是有用的。例如，实际上不建议过度使用递归函数：有大量现有的序列迭代构造不依赖于尾部调用优化的可用性（不保证实现，尽管通常可以通过适当的声明来实现） 。
这是使用标准reverse和nreverse函数的迭代版本。与上述方法相反，内部列表只是简单地反转（仅在第一深度级别检测到连续块）：
(defun reverse-consecutive (list)
(let (stack result)
(dolist (e list (nreverse result))
(typecase e
(list
(dolist (s stack)
(push s result))
(push (reverse e) result)
(setf stack nil))
(t (push e stack))))))