PasteRack.org
Paste # 95866
2019-08-18 12:18:14

Fork as a new paste.

Paste viewed 666 times.


Embed:

Uniq

  1. #lang racket/base
  2. (provide uniq)
  3.  
  4. ;;;
  5. ;;; Uniq
  6. ;;;
  7.  
  8. ; The function uniq takes a list as input and returns a new list:
  9. ; adjacent elements are compared and omits any repeated elements.
  10. ; In other words, uniq works like the Unix utility uniq, but on list.
  11.  
  12. ; The keywords #:count, #:repeats-only? and #:uniques-only? can
  13. ; be used to change the default behaviour.
  14.  
  15. ; If #:count is present the output list will contain elements
  16. ; of the form (list x frequency-of-x).
  17.  
  18. ; If #:repeats-only? is present, only the repeated elements will
  19. ; be in the output.
  20.  
  21. ; If #:uniques-only? is present, any repeated elements will be left out.
  22.  
  23. ; > (define xs '(a a a b b c d d b b b))
  24.  
  25. ; > (uniq xs)
  26. ; '(a b c d b)
  27.  
  28. ; > (uniq xs #:repeats-only? #t)
  29. ; '(a b d b)
  30.  
  31. ; > (uniq xs #:uniques-only? #t)
  32. ; '(c)
  33.  
  34. ; > (uniq xs #:count #t)
  35. ; ((a 3) (b 2) (c 1) (d 2) (b 3))
  36.  
  37. ; > (uniq xs #:count #t #:repeats-only? #t)
  38. ; '((a 3) (b 2) (d 2) (b 3))
  39.  
  40. ; > (uniq xs #:count #t #:uniques-only? #t)
  41. ; '((c 1))
  42.  
  43.  
  44. (require racket/list)
  45.  
  46. (define (uniq xs
  47.               #:key            [=?   equal?]
  48.               #:count          [count?   #f]
  49.               #:repeats-only?  [repeats? #f]  ; only inlude repeats in output
  50.               #:uniques-only?  [unique?  #f]) ; no repeats in output
  51.   (define msg "#:repeats-only? and #:unique-only? are mutually exclusive")
  52.   (cond
  53.     [(and repeats? unique?) (error 'unique msg)]
  54.     [(and repeats? count?)  (uniq/count/repeats    xs =?)]
  55.     [(and unique?  count?)  (uniq/count/uniques    xs =?)]
  56.     [count?                 (uniq/count            xs =?)]
  57.     [repeats?               (uniq/no-count/repeats xs =?)]
  58.     [unique?                (uniq/no-count/uniques xs =?)]
  59.     [else                   (uniq/no-count         xs =?)]))
  60.  
  61.  
  62. (define (uniq/no-count xs =?)
  63.   ; filter out repeated elements
  64.   (cond
  65.     [(null? xs)        '()]
  66.     [(null? (rest xs)) xs]
  67.     [else
  68.      (let loop ([x  (first xs)]
  69.                 [xs (rest xs)])
  70.        (cond
  71.          [(null? xs)        (list x)]
  72.          [(=? x (first xs)) (loop x (rest xs))]
  73.          [else              (cons x (loop (first xs) (rest xs)))]))]))
  74.  
  75. (define (uniq/no-count/repeats xs =?)
  76.   ; filter out repeated elements,
  77.   ; only output repeated elements
  78.   (cond
  79.     [(null? xs)        '()]
  80.     [(null? (rest xs)) '()]
  81.     [else
  82.      (let loop ([x         (first xs)]
  83.                 [xs        (rest xs)]
  84.                 [repeated? #f])
  85.        (cond
  86.          [(null? xs)        (if repeated? (list x) '())]
  87.          [(=? x (first xs)) (loop x (rest xs) #t)]
  88.          [else              (if repeated?
  89.                                 (cons x (loop (first xs) (rest xs) #f))
  90.                                 (loop (first xs) (rest xs) #f))]))]))
  91.  
  92. (define (uniq/no-count/uniques xs =?)
  93.   ; filter out repeated elements,
  94.   ; only output unique elements
  95.   (cond
  96.     [(null? xs)        '()]
  97.     [(null? (rest xs)) xs]
  98.     [else
  99.      (let loop ([x         (first xs)]
  100.                 [xs        (rest xs)]
  101.                 [unique?   #t])
  102.        (cond
  103.          [(null? xs)        (if unique? (list x) '())]
  104.          [(=? x (first xs)) (loop x (rest xs) #f)]
  105.          [else              (if unique?
  106.                                 (cons x (loop (first xs) (rest xs) #t))
  107.                                 (loop (first xs) (rest xs) #t))]))]))
  108.  
  109. (define (uniq/count xs =?)
  110.   ; filter out repeated elements
  111.   (cond
  112.     [(null? xs)        '()]
  113.     [(null? (rest xs)) (list (list (first xs) 1))]
  114.     [else
  115.      (let loop ([x  (first xs)]
  116.                 [xs (rest xs)]
  117.                 [n  1])
  118.        (cond
  119.          [(null? xs)        (list (list x n))]
  120.          [(=? x (first xs)) (loop x (rest xs) (+ n 1))]
  121.          [else              (cons (list x n)
  122.                                   (loop (first xs) (rest xs) 1))]))]))
  123.  
  124. (define (uniq/count/repeats xs =?)
  125.   ; filter out repeated elements,
  126.   ; only outputs repeated elements
  127.   (cond
  128.     [(null? xs)        '()]
  129.     [(null? (rest xs)) '()]
  130.     [else
  131.      (let loop ([x  (first xs)]
  132.                 [xs (rest xs)]
  133.                 [n  1])
  134.        (cond
  135.          [(null? xs)        (if (= n 1) '() (list (list x n)))]
  136.          [(=? x (first xs)) (loop x (rest xs) (+ n 1))]
  137.          [else              (if (= n 1)
  138.                                 (loop (first xs) (rest xs) 1)
  139.                                 (cons (list x n)
  140.                                       (loop (first xs) (rest xs) 1)))]))]))
  141.  
  142. (define (uniq/count/uniques xs =?)
  143.   ; filter out repeated elements,
  144.   ; only outputs unique elements
  145.   (map (λ (x) (list x 1))
  146.        (uniq/no-count/uniques xs =?)))
  147.  
  148. (let ()
  149.   (define xs '(1 1 1 2 2 2 3 2 2 55))
  150.   "xs"
  151.   xs
  152.   "uniq"
  153.   (uniq xs)
  154.   "uniq, repeats only"
  155.   (uniq xs #:repeats-only? #t)
  156.   "uniq, uniques only"
  157.   (uniq xs #:uniques-only? #t)
  158.  
  159.   "uniq with counts"
  160.   (uniq xs #:count #t)
  161.   "uniq with counts, repeats only"
  162.   (uniq xs #:count #t #:repeats-only? #t)
  163.   "uniq with counts , uniquess only"
  164.   (uniq xs #:count #t #:uniques-only? #t))

=>