six variants of classify in plain Racket

classify-plain.rkt

#lang racket

#; {type Classifier = [Listof [Cons Symbol [Listof Number]]]}

#; {[NEListof [List Symbol Number]] -> Classifier}
#; (classify l)
;; associate each symbol in `l` with all values in a single entry
;; ASSUME all key-value pairs with identical keys are in contiguous segments of `l`
;; REQUIRED prerserves the order in which the values show up in `l` from left to right

(provide
 classify-1 version-1
 classify-2 version-2
 classify-3 version-3
 classify-4 version-4
 classify-5 version-5
 classify-6 version-6)

(define example-1 (list '(a 1) '(a 2) '(b 1) '(b 2) '(b 3) '(b 4) '(c 1) '(c 2) '(c 3)))
(define result-1  '((a 1 2) (b 1 2 3 4) (c 1 2 3)))

;; ---------------------------------------------------------------------------------------------------
;; correctness testing

(module+ test
  (require rackunit)
  
  (define (test-me f msg)
    (check-equal? (f example-1) result-1 msg))

  (test-me classify-1 version-1)
  (test-me classify-2 version-2)
  (test-me classify-3 version-3)
  (test-me classify-4 version-4)
  (test-me classify-5 version-5)
  (test-me classify-6 version-6))

;; ---------------------------------------------------------------------------------------------------
(define version-1 "ISL-like solution with two calls to reverse")

(define (classify-1 l0)
  #; {[Listof [List Symbol Number]] Symbol [Listof [Snoc [Listof Number] Symbol]] -> Classifier}
  #; (reverse accu)
  ;; represents the key-value associations for `prev-key` found between the beginning of `l0` and `l`
  (define (classify/a l prev-key accu)
    (cond [(empty? l) (list (reverse accu))]
          [else
           (define curr-key (first (first l)))
           (define curr-value (second (first l)))
           (cond 
             [(eq? curr-key prev-key)
              (classify/a (rest l) prev-key (cons curr-value accu))]
             [else
              (cons (reverse accu) (classify/a (rest l) curr-key (list curr-value curr-key)))])]))
  (define first-key (first (first l0)))
  (classify/a l0 first-key (list first-key)))

;; ---------------------------------------------------------------------------------------------------
(define version-2 "ISL+-like solution, use `foldr` with two calls to reverse")

(define (classify-2 l0)

  #; {[List Symbol Number] Classifier -> Classifier}
  ;; ACCUMULATOR `accum` represents the Classifier from l0 to key-value
  ;; its _first_ element is the key that was seen in the preceding element of l (wrt to l0)
  (define (classify-1-element key-value accum)
    (cond
      ((empty? accum) (cons key-value '[]))
      [else
       (if (eq? (first key-value) (first (first accum)))
           (add-to key-value accum)
           (cons key-value accum))]))

  #; {[List Symbol Number] Classifier -> Classifier}
  (define (add-to key-value accum)
    (cons (append key-value (rest (first accum))) (rest accum)))

  (foldr classify-1-element '() l0))

;; ---------------------------------------------------------------------------------------------------
(define version-3 "ISL+-like solution, but avoids the repeated `(empty? accu)` test")

(require SwDev/Lib/should-be-racket)

(define (classify-3 l0)

  #; {[List Symbol Number] Classifier -> Classifier}
  ;; ACCUMULATOR `accum` represents the Classifier from l0 to key-value
  ;; its _first_ element is the key that was seen in the preceding element of l (wrt to l0)
  (define (classify-1-element key-value accum)
    (if (eq? (first key-value) (first (first accum)))
        (cons (append key-value (rest (first accum))) (rest accum))
        (cons key-value accum)))
  
  (foldr classify-1-element (list (last l0)) (all-but-last l0)))

;; ---------------------------------------------------------------------------------------------------
(define version-4 "Racket solution, using for/fold with three accumulators")

(define (classify-4 l0)
  (define first-key (first (first l0)))

  (for/fold ([global '()]               #; (reverse global) ; is the Classifier between l0 & l
             [local  [list first-key]]  #; (reverse local)  ; classifies 1 key, right before l in l0
             [last-key-seen first-key]  ;; the key preceeding `l` in `l0` 
             #:result #;"of this loop is:" (reverse (plus local global)))
            ([key-value-pair (in-list l0)])
    (define current-key (first key-value-pair))
    (define current-val (second key-value-pair))
    
    (if (eq? last-key-seen current-key)
        (values global              (cons current-val local)       current-key)
        (values (plus local global) (list current-val current-key) current-key))))

(define (plus l-accu g-accu)
  (cons (reverse l-accu) g-accu))

;; ---------------------------------------------------------------------------------------------------
(define version-5 "ASL-like solution, uses dictionaries, which we all know and love")

(define (classify-5 l0)
  (define heads (remove-duplicates (map first l0)))
  (define table 
    (for/fold ([table (make-immutable-hash (map list heads))]) ([x l0])
      (hash-update table (first x) (λ (v) (cons (second x) v)))))
  (map (λ (h) (cons h (reverse (hash-ref table h)))) heads))

;; ---------------------------------------------------------------------------------------------------
(define version-6 "Racket solution, using the `group-by` functiion")

(define (classify-6 l0)
  (for/list ([g (group-by first l0)]) 
    (define key    (first (first g)))  ;; groups are never empty & each element has at least a symbol
    (define values (map second g))
    (cons key values)))