partition-by.scm

(use-modules (srfi srfi-1))

(define* (partition-by f l #:optional (p eqv?))
  (if (null? l)
      '()
      (let A ((L '()) (M (list (car l))) (R (cdr l)) (f1 (f (car l))))
        (if (null? R)
            (reverse (cons (reverse M) L))
            (let* ((R1 (car R)) (f2 (f R1)) (R2 (cdr R)))
              (if (p f1 f2)
                  (A L (cons R1 M) R2 f2)
                  (A (cons (reverse M) L) (list R1) R2 f2)))))))

(define* (partition-by2 f l #:optional (p eqv?))
  (if (null? l)
      '()
      (reverse
       (map reverse
            (fold (lambda (a b)
                    (let ((f1 (f a)) (f2 (f (caar b))))
                      (if (p f1 f2)
                          (cons (cons a (car b))
                                (cdr b))
                          (cons (list a) b))))
                  (list (list (car l)))
                  (cdr l))))))

(define (remove-nth l n)
  (append (take l n) (drop l (1+ n))))

(define (shuffle l)
  (let A ((r '()) (l2 l) (n (length l)))
    (if (null? l2)
        (reverse r)
        (let ((R (random n)))
          (A (cons (list-ref l2 R) r)
             (remove-nth l2 R)
             (1- n))))))

(define (random-run-length-list n u)
  (let A ((r '()) (n2 n))
    (if (zero? n2)
        (apply append (shuffle r))
        (let* ((R1 (if (> n2 u) (1+ (random u)) n2))
               (R2 (random n)))
          (A (cons (make-list R1 R2) r)
             (- n2 R1))))))

(set! *random-state* (random-state-from-platform))

(do ((i 1 (1+ i)))
    ((> i 100))
  (partition-by2
   identity
   (random-run-length-list 10000 10)))