Как удалить неповторяющиеся элементы из списка в схеме?

Question

Учитывая список,

(define ll '(a a a b c c c d e e e e))

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

(a c e)

Мой алгоритм:

• Просматривать список, сравнивая текущий элемент со следующим.

  • Если они равны, то cons текущий элемент со списком следующего рекурсивного вызова.Например,

    (a a a b c)
    

    Переместить слева направо, встретить a и a.

    (cons a (remove-nondup (cddr lst)))
    

  • В противном случае пропустить текущий и следующий элемент.

    (remove-nondup (cddr lst))
    

Проблема, с которой я сталкиваюсь,

(define (remove-nondup lst)
  (if (>= (length lst) 2)
      (if (eq? (car lst) (cadr lst))
          (cons (car lst) (remove-nondup (cdr lst)))
          (remove-nondup (cddr lst)))
      lst))

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

Так что мое альтернативное текущее решение было,

(define (remove-dup lst)
  (if (>= (length lst) 2)
      (if (eq? (car lst) (cadr lst))
          (cons (car lst) (remove-dup (cddr lst)))
          (cons (car lst) (remove-dup (cdr lst))))
      lst))

(define (remove-nondup-helper lst)
  (if (>= (length lst) 2)
      (if (eq? (car lst) (cadr lst))
          (cons (car lst) (remove-nondup-helper (cdr lst)))
          (remove-nondup (cddr lst)))
      lst))

; call the helper function and remove-dup
(define (remove-nondup lst)
  (remove-dup (remove-nondup-helper lst)))

Answer 1

Вот мое решение: сначала возьмите bagify (подойдет любая версия). Тогда:

(define (remove-singletons lst)
  (define (singleton? ass)
    (< (cdr ass) 2))
  (map car (remove singleton? (bagify lst))))

remove от SRFI 1. Если вы используете Racket, сначала запустите (require srfi/1). Или используйте это простое определение:

(define remove #f)   ; Only needed in Racket's REPL
(define (remove pred lst)
  (cond ((null? lst) lst)
        ((pred (car lst)) (remove pred (cdr lst)))
        (else (cons (car lst) (remove pred (cdr lst))))))

Answer 2

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

(define remove-nondup
  (λ (ls)
    (reverse
      (let loop ([ls ls] [found '()] [acc '()])
        (cond
          [(null? ls)
            acc]
          [(memq (car ls) found)
            (loop (cdr ls)
                  found
                  (if (memq (car ls) acc)
                      acc
                      (cons (car ls) acc)))]
          [else
            (loop (cdr ls)
                  (cons (car ls) found)
                  acc)])))))

(remove-nondup '(a a a b c c c d e e e e)) =>
  (a c e)
(remove-nondup '(a a a b c c c d e e e e f a a f)) =>
  (a c e f)

loop - это «именованное let»: удобный способ вставить вспомогательную процедуру в процедуру без большого количества синтаксических помех.

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

(define remove-nonconsecdup
  (λ (ls)
    (reverse
      (letrec (
          [got1 (λ (ls prev acc)
                  (cond
                    [(null? ls)
                      acc]
                    [(eq? prev (car ls))
                      (got2 (cdr ls) (cons prev acc))]
                    [else
                      (got1 (cdr ls) (car ls) acc)]))]
          [got2 (λ (ls acc)
                  (cond
                    [(null? ls)
                      acc]
                    [(eq? (car acc) (car ls))
                      (got2 (cdr ls) acc)]
                    [else
                      (got1 (cdr ls) (car ls) acc)]))])
        (if (null? ls)
            '()
            (got1 (cdr ls) (car ls) '()))))))

(remove-nonconsecdup '(a a a b c c c d e e e e)) =>
  (a c e)
(remove-nonconsecdup '(a a a b c c c d e e e e f a a f)) =>
  (a c e a)

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