Удаление всех повторяющихся элементов из последовательности - PullRequest
Новая
       38

Удаление всех повторяющихся элементов из последовательности

3 голосов
/ 10 июня 2019

Функция последовательности Common Lisp remove-duplicates оставляет один элемент каждой кратности.Цель следующей аналогичной функции remove-equals - удалить все кратности.

Однако я хочу использовать встроенную функцию remove-if (не итерацию) и хешТабличные возможности SBCL для: test функции, чтобы сохранить сложность времени в O (n).Непосредственная проблема заключается в том, что тест на равенство SBCL должен быть глобальным, но этот тест также должен зависеть от аргумента key для remove-equals.Может ли оно быть написано для удовлетворения обоих требований? 

(defun remove-equals (sequence &key (test #'eql) (start 0) end (key #'identity))
  "Removes all repetitive sequence elements based on equality test."
  #.(defun equality-test (x y)
      (funcall test (funcall key x) (funcall key y)))
  #.(sb-ext:define-hash-table-test equality-test sxhash)
  (let ((ht (make-hash-table :test #'equality-test)))
    (iterate (for elt in-sequence (subseq sequence start end))
             (incf (gethash (funcall key elt) ht 0)))
    (remove-if (lambda (elt)
                 (/= 1 (gethash elt ht)))
               sequence :start start :end end :key key)))

Ответы [ 3 ]

6 голосов
/ 10 июня 2019

Третий аргумент define-hash-table-test связывает тест с хэш-функцией.Использование sxhash отменяет цель, поскольку оно должно быть адаптировано к функции test.(equal x y) подразумевает (= (sxhash x) (sxhash)).Таким образом, второй параметр должен быть функцией test-hash такой, что (funcall test x y) подразумевает (= (test-hash x) (test-hash y)).Это невозможно сделать, просто имея тестовую функцию.Возможно, было бы лучше просто обойти все это, документировав, что ему нужна поддержка хэширования: 

(defun remove-duplicated (sequence &key (test #'eql) (start 0) end (key #'identity))
  "Removes all repetitive sequence elements based on equality test.
   equalily tests other than eq, eql, equal and equalp requires you
   add it to be allowed in a hash table eg. sb-ext:define-hash-table-test in SBCL"

  (let ((ht (make-hash-table :test test)))
    (iterate (for elt in-sequence (subseq sequence start end))
             (incf (gethash (funcall key elt) ht 0)))
    (remove-if (lambda (elt)
                 (/= 1 (gethash elt ht)))
               sequence :start start :end end :key key)))

Теперь, если пользователь хочет получить пользовательский тест, он должен сам выполнить его: 

(defun car-equals (a b)
  (equal (car a) (car b)))

(defun car-equals-hash (p)
  (sxhash (car p)))

(sb-ext:define-hash-table-test car-equals car-equals-hash)

(car-equals '(1 2 3 4) '(1 3 5 7)) ; ==> t
(defparameter *ht* (make-hash-table :test 'car-equals))
(setf (gethash '(1 2 3 4) *ht*) 'found)
(gethash '(1 3 5 7) *ht*) ; ==> found

(remove-duplicated '((5 0 1 2) (5 1 2 3) (5 1 3 2) (5 2 3 4)) 
                   :test #'car-equals 
                   :key #'cdr) 
; ==> ((5 0 1 2) (5 2 3 4))
5 голосов
/ 10 июня 2019

Что-то вроде этого с вычисленными функциями времени чтения не будет делать то, что вы думаете.Упрощено из вашего кода: 

(defun foo (a b test)
  #.(defun equality-test (x y)
      (funcall test x y))
  (funcall #'equality-test a b))

Нет способа, которым это может работать.

Причина 1 : время чтения созданная функция не имеет доступа к лексическим переменным из окружающего кода (здесь нет способа ссылаться на test, поскольку среда с функцией foo не существует во время чтения)

The test переменная внутри equality-test не относится к лексической переменной.Не определено / не объявлено.

Причина 2 : DEFUN оценивается как символ

Код выглядит следующим образом после чтения и оценки кода времени чтения: 

(defun foo (a b test)
   equality-test
   (funcall #'equality-test a b))

Ну, equality-test - это несвязанная переменная.Что является ошибкой во время выполнения.

Причина 3 : функция equality-test может не существовать

Если мы скомпилируем код с помощью файлового компилятора, функция equality-test создается во время компиляции во время чтения формы, но не будет частью скомпилированного кода.

2 голосов
/ 10 июня 2019

Отказ от ответственности: я считаю, что ответ @ Sylwester яснее и чище - просто лучше (без макроса).

Однако это только гипотетически (но не очень хорошая практика): 

(ql:quickload :iterate)    ;; you forgot these - but they are necessary
(use-package :iterate)     ;; for your code to run - at least my definition
(ql:quickload :alexandria) ;; of 'minimal working example' is to include imports.

(defmacro remove-equals (sequence &key (test #'eql) (start 0) end (key #'identity))
  "Remove all repetitive sequence alements based on equality test."
  (alexandria:once-only (sequence test start end key) ; as hygyenic macro
    `(progn
       (defun equality-test (x y)
          (funcall ,test (funcall ,key x) (funcall ,key y)))
       (sb-ext:define-hash-table-test equality-test sxhash)
       (let ((ht (make-hash-table :test #'equality-test)))
          (iterate (for elt in-sequence (subseq ,sequence ,start ,end))
                   (incf (gethash (funcall ,key elt) ht 0)))
          (remove-if (lambda (elt)
                       (/= 1 (gethash (funcall ,key elt) ht)))
                     ,sequence :start ,start :end ,end :key ,key)))))

(remove-equals '(1 2 3 1 4 5 3) :test #'= :end 6)
;; WARNING: redefining COMMON-LISP-USER::EQUALITY-TEST in DEFUN
;; 
;; (2 3 4 5 3)

(describe 'equality-test) ;; shows new definition
;; COMMON-LISP-USER::EQUALITY-TEST
;;   [symbol]
;; 
;; EQUALITY-TEST names a compiled function:
;;   Lambda-list: (X Y)
;;   Derived type: (FUNCTION (T T) (VALUES BOOLEAN &OPTIONAL))
;;   Source form:
;;     (SB-INT:NAMED-LAMBDA EQUALITY-TEST
;;         (X Y)
;;       (BLOCK EQUALITY-TEST
;;         (FUNCALL #'= (FUNCALL #1=#<FUNCTION IDENTITY> X)
;;                  (FUNCALL #1# Y))))

Предупреждение всегда будет появляться - и если вы используете более одной хеш-таблицы, это определенно будет мешать и вызывать ошибки. Поэтому я не рекомендую это!

...