six variants of classify in Typed Racket

classify-typed.rkt

#lang typed/racket

(define-type PreSorted1 (Pairof PreEntry [Listof PreEntry]))
(define-type PreSorted  [Listof PreEntry])
(define-type PreEntry   [List Symbol Number])

(define-type Classifier [Listof Entry])
(define-type Entry      [Pairof Symbol [Listof Number]])

(define-type Accu (mu T (U (Pairof Number T) (List Symbol))))

#; (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
 PreSorted1 Classifier PreEntry
 
 #; {PreSorted1 -> Classifier} #;String
 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 typed/rackunit)
  
  (: test-me {(PreSorted1 -> Classifier) String  -> Any})
  (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 "typed ISL-like solution with two calls to reverse")

(: classify-1 (PreSorted1 -> Classifier))
(define (classify-1 l0)
  (: classify/a (PreSorted Symbol Accu  -> 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 (cast (reverse accu) Entry))]
          [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
              (define sp (cast (reverse accu) Entry))
              (cons sp (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 "typed ISL+-like solution, use `foldr` with two calls to reverse")

(: classify-2 (PreSorted1 -> Classifier))
(define (classify-2 l0)

  (: classify-1-element ([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))]))

  (: add-to ([List Symbol Number] Classifier -> Classifier))
  (define (add-to key-value accum)
    (cons (list* (first key-value) (second key-value) (rest (first accum))) (rest accum)))

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

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

(require/typed SwDev/Lib/should-be-racket
               [all-but-last (-> PreSorted PreSorted)])

(: classify-3 (PreSorted1 -> Classifier))
(define (classify-3 l0)

  (: classify-1-element {[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 (list* (first key-value) (second 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 "typed Racket solution, using for/fold with three accumulators")

(: classify-4 (PreSorted1 -> Classifier))
(define (classify-4 l0)
  (define first-key (first (first l0)))

  (for/fold ([global : Classifier'()]          #; (reverse global) ; is the Classifier between l0 & l
             [local  : Accu [list first-key]]  #; (reverse local)  ; classifies 1 key, before l in l0
             [last-key : Symbol 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? current-key last-key)
        (values global              (cons current-val local)       current-key)
        (values (plus local global) (list current-val current-key) current-key))))

(: plus (Accu Classifier -> Classifier))
(define (plus l-accu g-accu)
  (cons (cast (reverse l-accu) Entry) g-accu))

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

(: classify-5 (PreSorted1 -> Classifier))
(define (classify-5 l0)
  (define heads (remove-duplicates (map (λ ({x : PreEntry}) (first x)) l0)))
  (define-type HT [Immutable-HashTable Symbol [Listof Number]])
  (define table0 : HT (make-immutable-hash (map (λ ({s : Symbol}) (list s)) heads)))
  (define table 
    (for/fold ([table : HT table0]) ([x : PreEntry l0])
      (hash-update table (first x) (λ ({v : [Listof Number]}) (cons (second x) v)))))
  (map (λ ({h : Symbol}) (cast (cons h (reverse (hash-ref table h))) Entry)) heads))

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

(: classify-6 (PreSorted1 -> Classifier))
(define (classify-6 l0)
  (define groups ((inst group-by [List Symbol Number] Symbol)  first l0))
  (for/list : Classifier ([g : PreSorted groups])
    (define key    (first (first g)))
    (define values (map (λ ({p : PreEntry}) (second p)) g))
    (cast (cons key values) Entry)))