classify.rkt

#lang racket

(define num-labels 20000)
(define max-values 1000)

(define (generate-list)
  (let loop ([ N num-labels ][ result '() ])
    (if (< N 1)
        result
        (loop (sub1 N) (generate-values (string->symbol (format "~a~a" "l" N)) result)))))

(define (generate-values label result)
  (let loop ([ N (add1 (random max-values)) ][ result result ])
    (if (< N 1)
        result
        (loop (sub1 N) (cons (list label N) result)))))
  
(define input (generate-list))

;; --------------------------------------------------------------------------------------------

(define (classify-1 input)
  (define (classify-one input current-label)
    (if (null? input)
        (values '() '())
        (match-let ([ (list label val) (car input) ])
          (if (eq? current-label label)
              (let-values ([ (result remaining) (classify-one (cdr input) current-label) ])
                (values (cons val result) remaining))
              (values '() input)))))
  
  (if (null? input)
      '()
      (let ([ label (caar input) ])
        (let-values ([ (one remaining) (classify-one input label) ])
          (cons (cons label one) (classify-1 remaining))))))

;; --------------------------------------------------------------------------------------------

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

;; --------------------------------------------------------------------------------------------

#;(time (begin
        (classify-1 input)
        (void)))

(time (begin
        (classify-4 input)
        (void)))