Сгладить список с помощью общего lisp

Question

Я читал книгу Пола Грэма "На Лиспе". В главе 4 "Функции утилит" он приводит примеры небольших функций, которые работают со списками, что будет полезно при написании более крупной программы.

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

Ниже моя попытка реализации flatten:

(defun flatten (lst)
  (labels ((rflatten (lst1 acc)
                     (dolist (el lst1)
                       (if (listp el)
                         (rflatten el acc)
                         (push el acc)))
                     acc))
    (reverse (rflatten lst nil))))

Но вышеупомянутая функция не выравнивает списки должным образом.

; returns (1) instead of (1 2)
(print (flatten '(1 (2))))
(1)

Вызов функции с (1 (2)) возвращается (1) вместо (1 2),

Я не могу найти, что не так с моей реализацией flatten. Это то, как я используюlabels? Или это то, как я использую dolist макрос? dolist макрос всегда возвращается nil, Но это не имеет значения, так как я использую аккумулятор acc хранить свернутый список.

Answer 1

push изменяет привязку символа в области видимости. Таким образом, рекурсия (rflatten el acc) имеет свой acc что является результатом, но вы ничего не делаете с возвращенным результатом, и это не меняет вызываемого acc,

Возможно (setf acc (rflatten el acc)) бы исправить это:

(defun flatten (lst)
  (labels ((rflatten (lst1 acc)
             (dolist (el lst1)
               (if (listp el)
                   (setf acc (rflatten el acc))
                   (push el acc)))
             acc))
    (reverse (rflatten lst nil))))

Answer 2

Вы на самом деле очень близко. Как упоминает Сильвестр, проблема в том, что (push el acc) изменяет только локальную привязку el (из которых есть новое для каждого вызова rflatten. Как упоминает Рейнер, это не совсем аккумулятор в традиционном смысле, поэтому я ' Я не собираюсь называть это acc, но результатом. Поскольку вы уже определяете локальную функцию, нет причин не определять результат в более широкой области:

(defun flatten (lst)
  (let ((result '()))
    (labels ((rflatten (lst1)
               (dolist (el lst1)
                 (if (listp el)
                   (rflatten el)
                   (push el result)))))
      (rflatten lst)
      (nreverse result))))

На самом деле, есть несколько способов это исправить. Первый - это вопрос стиля и вкуса, но я бы использовал переменную &aux для привязки результата, поэтому

(defun flatten (lst &aux (result '()))
  ...)

Следующим является то, что dolist может принимать третий аргумент - форму для оценки возвращаемого значения. Это часто используется в идиоме "push для создания списка, а затем в обратном порядке для возвращаемого значения", например,

(let ((result '()))
  (dolist (x list (nreverse result))
    ...
    (push ... result)))

Вы не хотите возвращаться после каждого Dolist, но вы все равно можете вернуть результат из Dolist, и, следовательно, из rflatten. Тогда вы можете просто вызвать nreverse с результатом rflatten:

(defun flatten (lst &aux (result '()))
  (labels ((rflatten (lst1)
             (dolist (el lst1 result)
               (if (listp el)
                 (rflatten el)
                 (push el result)))))
      (nreverse (rflatten lst))))

Answer 3

Нерекурсивный код, который строит результат conses, следующие комментарии и начиная с кода Sylwester:

(defun flatten (lst &optional back acc)
  (loop
     (cond 
        ((consp lst) (psetq lst (cdr lst)              ; parallel assignment
                           back (cons (car lst) back)))
        (back
                  (if (consp (car back))  
                    (psetq lst (cdar back)
                          back (cons (caar back) (cdr back)))
                    (psetq acc (if (car back) (cons (car back) acc) acc)
                          back (cdr back))))
        (t     
               (return acc)))))                        ; the result

Это не красиво, но, похоже, работает. Параллельное назначение PSETQ используется для имитации хвост-рекурсивного обновления фрейма вызова, не заботясь о точной последовательности.

Реализует тот же процесс, что и кодированный

(defun flatten2 (l z)
    (cond
        ((endp l) z)
        ((listp (car l)) (flatten2 (car l) (flatten2 (cdr l) z)))
        ((atom (car l)) (cons (car l) (flatten2 (cdr l) z)))))

(defun flatten (l)
   (flatten2 l nil))

с неявными операциями стека, объясненными как манипуляции со структурой списка среди переменных.

Answer 4

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

      (defun flatten (lst &aux (re '()))
  (cond
    ((null lst) '())
    ((listp (car lst))
     (append (flatten (car lst))
             (append (flatten (cdr lst))
                     re)))
    (t (cons (car lst)
             (append (flatten (cdr lst)) re)))))

И мы можем легко адаптировать его для управления глубиной выравнивания!

      (defun flatten* (lst depth &aux (re '()))
  (cond
    ((null lst) '())
    ((listp (car lst))
     (append (cond
               ((= 0 depth)             ; flatten none
                (list (car lst)))
               ((< 0 depth)             ; flatten down
                (flatten* (car lst) (- depth 1)))
               ((= -1 depth)            ; flatten all
                (flatten* (car lst) depth))
               ((< depth -1)            ; flatten up
                (list (flatten* (car lst) (+ depth 1)))))
             (append (flatten* (cdr lst) depth)
                     re)))
    (t (cons (car lst)
             (append (flatten* (cdr lst) depth) re)))))