Общие лисп-группы - PullRequest
       8

Общие лисп-группы

0 голосов
/ 16 октября 2018

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

(defun identity-groups (lst)
  (labels ((travel (tail group groups)
         (cond ((endp tail) (cons group groups))
           ((equal (car tail) (car (last group)))
            (travel (cdr tail) (cons (car tail) group) groups))
           (t (travel (cdr tail) (list (car tail)) (cons group groups))))))
    (reverse (travel (cdr lst) (list (car lst)) nil))))

(identity-groups '(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7))
;; => ((1) (3) (5) (4 4 4 4) (5) (1) (2 2 2) (1) (2) (3 3 3 3 3) (4) (5) (6) (7))

Ответы [ 3 ]

0 голосов
/ 16 октября 2018

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

Первым параметром анонимной функции сокращения является аккумулятор, здесь список групп.Второй параметр - это новое значение.

(reduce (lambda (groups value)
           (let ((most-recent-group (first groups)))
              (if (equal (first most-recent-group) value)
                  (list* (cons value most-recent-group) (rest groups))
                  (list* (list value) groups))))
        '(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7)
        :initial-value ())

Результат:

((7) (6) (5) (4) (3 3 3 3 3) (2) (1) (2 2 2) (1) (5) (4 4 4 4) (5) (3) (1))

Одна проблема в вашем коде - это вызов last для доступа к последней группе, что делаеткод пересекает списки снова и снова.Как правило, вам следует избегать обработки списков как массивов, но использовать их как стеки (только манипулировать верхним элементом).

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

0 голосов
/ 16 октября 2018

«Классическое» рекурсивное решение

(defun identity-groups (l &key (test #'eql))
  (labels ((group (l last-group acc)
              (cond ((null l) (cons last-group acc))
                    ((and last-group (funcall test (car l) (car last-group)))
                     (group (cdr l) (cons (car l) last-group) acc))
                    (t
                     (group (cdr l) (list (car l)) (cons last-group acc))))))
    (cdr (reverse (group l '() '())))))

Старая версия (требуется начальное значение, не равное первому элементу списка)

Таким образом, вышеприведенная версия избавилась от этого ключевого аргумента.

(defun identity-groups (l &key (test #'eql) (initial-value '(0))) 
  (labels ((group (l last-group acc)
              (cond ((null l) (cons last-group acc))
                    ((funcall test (car l) (car last-group))
                     (group (cdr l) (cons (car l) last-group) acc))
                    (t
                     (group (cdr l) (list (car l)) (cons last-group acc))))))
    (cdr (reverse (group l initial-value '())))))

Циклическая конструкция в императивном стиле

Попробовала для забавы также циклическую конструкцию с do.

(defun group-identicals (l &key (test #'eql))
  (let ((lx) (tmp) (res))                       ;; initiate variables
    (dolist (x l (reverse (cons tmp res)))      ;; var list return/result-value
      (cond ((or (null lx) (funcall test x lx)) ;; if first round or 
             (push x tmp)            ;; if last x (lx) equal to current `x`,
             (setf lx x))          ;; collect it in tmp and set lx to x
            (t (push tmp res)      ;; if x not equal to lastx, push tmp to result
               (setf tmp (list x)) ;; and begin new tmp list with x
               (setf lx x))))))    ;; and set last x value to current x
    (cdr (reverse (group l initial-value '()))))) 
    ;; cdr removes initial last-group value

;; test:
(group-identicals '(1 2 3 3 4 4 4 4 5 5 6 3 3 3 3))
;; ((1) (2) (3 3) (4 4 4 4) (5 5) (6) (3 3 3 3))
(group-identicals '("a" "b" "b" "c" "d" "d" "d" "e") :test #'string=)
;; (("a") ("b" "b") ("c") ("d" "d" "d") ("e"))
0 голосов
/ 16 октября 2018

выглядит довольно хорошо!

  • (equal (car tail) (car (last group))) кажется эквивалентным (equal (car tail) (car group))

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

  • Когда вы строите итоговый список groups самостоятельно, безопаснее и эффективнее использовать nreverse вместо reverse.

  • Нет конфликта имен при использовании list в качестве параметра вместо lst, поскольку переменные и функции живут в разных пространствах имен ("Lisp-2").

  • Считается хорошим стилем давать служебные функции, подобные этим &key test key аргументам, чтобы вызывающие абоненты могли выбирать, когда элементы списка считаются равными (см., Например, Общий параметр lisp: KEY use ), чтобы присоединиться к клубу.общих функций, таких как member, find и sort.

  • И строка документации!:)

Обновленная версия:

(defun identity-groups (list &key (test #'eql) (key #'identity))
  "Collect adjacent items in LIST that are the same. Returns a list of lists."
  (labels ((travel (tail group groups)
             (cond ((endp tail) (mapcar #'nreverse (cons group groups)))
                   ((funcall test
                             (funcall key (car tail))
                             (funcall key (car group)))
                    (travel (cdr tail) (cons (car tail) group) groups))
                   (t (travel (cdr tail) (list (car tail)) (cons group groups))))))
    (nreverse (travel (cdr list) (list (car list)) nil))))

Тесты:

(identity-groups '(1 2 2 2 3 3 3 4 3 2 2 1))
-> ((1) (2 2 2) (3 3 3) (4) (3) (2 2) (1))

;; Collect numbers in groups of even and odd:
(identity-groups '(1 3 4 6 8 9 11 13 14 15) :key #'oddp)
-> ((1 3) (4 6 8) (9 11 13) (14) (15))

;; Collect items that are EQ:
(identity-groups (list 1 1 2 2 (list "A") (list "A")) :test 'eq)
-> ((1 1) (2 2) (("A")) (("A")))
...