2011-04-22 136 views
1

给出一个列表,如何从Scheme的列表中删除非重复的元素?

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

我想删除所有非重复的元素,离开重复一个只有一个副本,即除去后,其结果将是

(a c e) 

我的算法是:

  • 遍历列表,比较当前元素和下一个元素。

    • 如果它们相等,则cons当前元素与下一个递归调用的列表。例如,

      (a a a b c) 
      

      移动由左到右,遇到aa

      (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))) 

回答

1

这里是我的解决方案:第一,抓住bagify(任何版本都可以)。然后:

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

remove是SRFI 1.如果您使用的球拍,运行(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)))))) 
+0

你可以给一个没有预定义库的解决方案吗?在尝试使用库函数之前,我试图先熟悉Scheme。谢谢。 – Chan 2011-04-22 02:24:45

+0

@Chan:我添加了'remove'的定义。我不能避免使用它,而不会使功能太糟糕,所以这是最好的。 – 2011-04-22 02:32:23

0

下面是仅使用标准库函数,只有尾调用的方式,但它执行线性搜索,查看是否有物品已经看到或放置在结果:

(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是一个“命名让”:一种方便的方式来粘贴帮助程序内没有很多句法混乱的程序。

如果你只想收缩连续复制到一个项目,只有当不连续出现两次,那么这里就是“记住”的项目的方式,他们两个单元前没有寻找它删除项目,和仅使用尾调用:

(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完成的额外cons'ing是一个问题,您可以进行非尾调用或将项目粘贴到列表的末尾,但这样做很难高效(但使用非标准库宏很容易)。