(macro timer
  (lambda (x)
    (let ((exp (cadr x)))
      `(let ((time0 (runtime)))
         ((lambda () ,exp))
         (/ (- (runtime) time0) 100)))))

(define (random-list n . p)
  (if (null? p)
      (let loop ((i 1) (tail '()))
        (if (> i n)
            tail
            (loop (1+ i) (cons (%random) tail))))
      (let loop ((i 1) (tail '()) (p (car p)))
        (if (> i n)
            tail
            (loop (1+ i) (cons (random p) tail) p)))))

(define (random-vector n . p)
  (if (null? p)
      (do ((v (make-vector n))
           (i 0 (+ i 1)))
          ((>= i n) v)
          (vector-set! v i (%random)))
      (do ((p (car p))
           (v (make-vector n))
           (i 0 (+ i 1)))
          ((>= i n) v)
          (vector-set! v i (random p)))))

(define (iota n)
  (let loop ((i (-1+ n)) (tail '()))
    (if (< i 0)
        tail
        (loop (- i 1) (cons i tail)))))

(define (reverse-iota n) (reverse! (iota n)))

(define (random-iota n . p)
  (set! p (if (null? p) n (car p)))
  (let loop ((i (-1+ n)) (tail '()))
    (if (< i 0)
        tail
        (loop (-1+ i) (cons (+ i (random p)) tail)))))

(define (list-copy x) (append x '()))

(define (make-time-sort copy-function)
  (lambda (sort)
    (gc t)
    (let ((x (copy-function *test-list*)))
      (timer (sort  x >)))))

(define time-sort (make-time-sort list-copy))

(define time-vsort (make-time-sort list->vector))

(define (make-comp-count copy-function)
  (lambda (sort)
    (letrec ((comp-count0 0)
             (comp-count1 0)
             (comp (lambda (x y)
                     (cond ((> 16000 comp-count0)
                            (set! comp-count0 (1+ comp-count0)))
                           (else
                             (set! comp-count1 (1+ comp-count1))
                             (set! comp-count0 1)))
                     (> x y))))
      (sort (copy-function *test-list*) comp)
      (+ comp-count0 (* comp-count1 16000)))))

(define comp-count (make-comp-count list-copy))

(define v-comp-count (make-comp-count list->vector))

(define (make-test x) (set! *test-list* x) *the-non-printing-object*)

(define *test-list* '())

(define (make-statistic function title-string)
  (lambda (sort length n)
    (do ((nl #\newline)
         (i 0 (1+ i))
         (l '()))
        ((>= i n)
         (for-each
           display
           (list
             "     " title-string nl
             "number of elements: " length nl
             "number of tests: " n nl
             "mean: " (mean l) nl
             "standard-deviation: "  (standard-deviation l) nl))
         *the-non-printing-object*)
        (make-test (random-list length))
        (set! l (cons (function sort) l)))))

(define statistic-comp-count
  (make-statistic comp-count "COUNTING COMPARISONS"))

(define statistic-v-comp-count
  (make-statistic v-comp-count "COUNTING COMPARISONS"))

(define statistic-time-sort
  (make-statistic time-sort "TIMING"))

(define statistic-time-vsort
  (make-statistic time-vsort "TIMING"))

(define (mean l)
  (let loop ((result 0) (n 0) (l l))
    (if (null? l)
        (/ result n)
        (loop (+ result (car l)) (1+ n) (cdr l)))))

(define (variance l)
  (let ((m (mean l)))
    (let loop ((result 0) (n -1) (l l))
      (if (null? l)
          (/ result n)
          (loop (+ result (let ((i (- (car l) m))) (* i i)))
                (1+ n)
                (cdr l))))))

(define (standard-deviation l) (sqrt (variance l)))

(define (average-deviation l)
  (let ((m (mean l)))
    (let loop ((result 0) (n 0) (l l))
      (if (null? l)
          (/ result n)
          (loop (+ result (abs (- (car l) m))) (1+ n) (cdr l))))))