;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create Pivot Table ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (row-heads-width p) (vector-ref p 0))
(define (col-heads-height p) (vector-ref p 1))
(define (height p) (vector-ref p 2))
(define (set-height! p h) (vector-set! p 2 h))
(define (row-headers p) (vector-ref p 3))
(define (set-row-headers! p r) (vector-set! p 3 r))
(define (width p) (vector-ref p 4))
(define (set-width! p w) (vector-set! p 4 w))
(define (col-headers p) (vector-ref p 5))
(define (set-col-headers! p c) (vector-set! p 5 c))
(define (cells p) (vector-ref p 6))
(define (set-cells! p c) (vector-set! p 6 c))
(define (set-empty-rows! c s e w)
  (if (< s e)
    (begin
      (vector-set! c s (make-vector w))
      (set-empty-rows! c (+ s 1) e w))))
(define (make-pivot r c w h)
  (letrec ((cells (make-vector h)))
    (set-empty-rows! cells 0 h w)
    (vector r c 0 (make-vector h) 0
                  (make-vector w) cells)))
(define (vector-copy! sv dv a z o)
  (if (>= z a)
    (begin
      (vector-set! dv (+ z o) (vector-ref sv z))
      (vector-copy! sv dv a (- z 1) o))))
(define (vector-compare a b s e bs)
  (if (= s e)
    0
    (let ((sa (vector-ref a s))
          (sb (vector-ref b bs)))
      (cond
        ((string<? sa sb) -1)
        ((string>? sa sb) 1)
        (else (vector-compare a b (+ s 1)
                              e (+ bs 1)))))))
(define (vector-insert! v s k h)
  (if (= h (vector-length v))
    (let ((nv (make-vector (+ (* h 2) 1))))
      (vector-copy! v nv s (- h 1) 1)
      (vector-copy! v nv 0 (- s 1) 0)
      (vector-set! nv s k)
      nv)
    (begin
      (vector-copy! v v s (- h 1) 1)
      (vector-set! v s k)
      v)))
(define (vector-search v s e k ks ke)
  (if (>= s e)
    (cons #f s)
    (let ((m (quotient (+ e s) 2)))
      (case (vector-compare k (vector-ref v m)
                            ks ke 0)
        ((-1) (vector-search v s m k ks ke))
        ((1) (vector-search v (+ m 1) e k ks ke))
        (else (cons #t m))))))
(define found car)
(define search-index cdr)
(define (measure-replace o n) n)
(define (measure-sum o n) (if o (+ o n) n))
(define measure measure-sum)
(define (pivot-set-cell! p y x k)
  (let ((r (vector-ref (cells p) y)))
    (vector-set! r x (measure (vector-ref r x) k))))
(define (pivot-insert-row! p y)
  (let ((h (height p)))
    (set-cells! p
      (vector-insert! (cells p) y
        (make-vector (width p))
        h))
    (set-height! p (+ h 1))))
(define (pivot-insert-col! p x)
  (let ((c (cells p))
        (w (width p)))
    (letrec
      ((e (height p))
       (insert
         (lambda (s)
           (if (< s e)
             (begin
               (vector-set! c s
                 (vector-insert! (vector-ref c s)
                   x #f w))
               (insert (+ s 1)))))))
      (insert 0)
      (set-width! p (+ w 1)))))
(define (pivot-new-row! p y v)
  (let* ((rw (row-heads-width p))
         (nr (make-vector rw)))
    (vector-copy! v nr 0 (- rw 1) 0)
    (set-row-headers! p
      (vector-insert! (row-headers p) y nr
                      (height p))))
  (pivot-insert-row! p y))
(define (pivot-new-col! p x v)
  (let ((rw (row-heads-width p))
        (ch (col-heads-height p)))
    (let ((nc (make-vector ch)))
      (vector-copy! v nc rw (- (+ rw ch) 1) (- rw))
      (set-col-headers! p
        (vector-insert! (col-headers p) x nc
                        (width p)))))
  (pivot-insert-col! p x))
(define (pivot-insert! p v data)
  (let* ((rw (row-heads-width p))
         (d (+ rw (col-heads-height p)))
         (rs (vector-search (row-headers p)
               0 (height p) v 0 rw))
         (cs (vector-search (col-headers p)
               0 (width p) v rw d))
         (x (search-index cs))
         (y (search-index rs)))
    (if (not (found rs))
      (pivot-new-row! p y v))
    (if (not (found cs))
      (pivot-new-col! p x v))
    (pivot-set-cell! p y x data))) 
(define (pivot-get-cell p v)
  (let* ((rw (row-heads-width p))
         (d (+ rw (col-heads-height p)))
         (rs (vector-search (row-headers p)
               0 (height p) v 0 rw))
         (cs (vector-search (col-headers p)
               0 (width p) v rw d)))
    (if (and (found rs) (found cs))
      (vector-ref
        (vector-ref (cells p) (search-index rs))
        (search-index cs)))))
(define (pivot-for-each-row thunk p)
  (let ((h (height p))
        (rows (row-headers p))
        (c (cells p)))
    (letrec
      ((pivot-for-each-row-range
         (lambda (s)
           (if (< s h)
             (begin
               (thunk (vector-ref rows s) (vector-ref c s))
               (pivot-for-each-row-range (+ s 1)))))))
      (pivot-for-each-row-range 0))))
