;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Display Pivot Table as HTML ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define out-port (current-output-port))
(define (stream x)
  (display (if x x "&nbsp;") out-port))
(define (stream-table)
  (stream "<table cellspacing=\"0\" cellpadding=\"2\" class=\"report\" border=\"1\">\n"))
(define (stream-end-table)
  (stream "</table>\n"))
(define (stream-thead)
  (stream "<thead>\n"))
(define (stream-end-thead)
  (stream "</thead>\n"))
(define (stream-tbody)
  (stream "<tbody>\n"))
(define (stream-end-tbody)
  (stream "</tbody>\n"))
(define (stream-tr y)
  (stream
    (if (even? y)
      "<tr class=\"row_even\">\n"
      "<tr class=\"row_odd\">\n")))
(define (stream-end-tr)
  (stream "</tr>\n"))
(define (stream-th c)
  (stream "<th>")
  (stream c)
  (stream "</th>"))
(define (stream-th-row c s)
  (if s
    (begin
      (stream "<th rowspan=\"")
      (stream s)
      (stream "\">")
      (stream c)
      (stream "</th>"))))
(define (stream-th-col c s)
  (if s
    (begin
      (stream "<th colspan=\"")
      (stream s)
      (stream "\">")
      (stream c)
      (stream "</th>"))))
(define (stream-th-corner r c y row-headers)
  (cond
    ((and (zero? y) (> r 1) (positive? c))
     (stream "<th colspan=\"")
     (stream c)
     (stream "\" rowspan=\"")
     (stream (- r 1))
     (stream "\"></th>\n"))
    ((= y (- r 1))
     (for-each stream-th row-headers))))
(define (stream-td c)
  (stream "<td>")
  (stream c)
  (stream "</td>"))
(define (reset-span a sr i w)
  (if (< i w)
    (begin
      (vector-set! sr i (vector-ref a i))
      (vector-set! a i 0)
      (reset-span a sr (+ i 1) w))))
(define (set-span a c p sr i w)
  (if (< i w)
    (if (string=? (vector-ref c i)
                  (vector-ref p i))
      (set-span a c p sr (+ i 1) w)
      (reset-span a sr i w))))
(define (vector-incr a s e)
  (if (< s e)
    (begin
      (vector-set! a s (+ (vector-ref a s) 1))
      (vector-incr a (+ s 1) e))))
(define (vector-set-span p a h i sp w)
  (vector-incr a 0 w)
  (if (zero? i)
    (vector-set! sp 0 a)
    (let ((c (vector-ref h (- i 1)))
          (sr (make-vector w)))
      (set-span a c p sr 0 w)
      (vector-set! sp i sr)
      (vector-set-span c a h (- i 1) sp w))))
(define (make-span h w e)
  (let ((sp (make-vector e)))
    (if (positive? e)
      (vector-set-span
        (vector-ref h (- e 1))
        (make-vector w 0)
        h (- e 1) sp w))
    sp))
(define (stream-row-headers v sr s e)
  (if (< s e)
    (begin
      (stream-th-row
        (vector-ref v s)
        (vector-ref sr s))
      (stream-row-headers v sr (+ s 1) e))))
(define (stream-row v s e)
  (if (< s e)
    (begin
      (stream-td (vector-ref v s))
      (stream-row v (+ s 1) e))))
(define (pivot->stream-rows p sp y)
  (if (< y (height p))
    (begin
      (stream-tr y)
      (stream-row-headers
        (vector-ref (row-headers p) y)
        (vector-ref sp y)
        0 (row-heads-width p))
      (stream-row (vector-ref (cells p) y)
        0 (width p))
      (stream-end-tr)
      (pivot->stream-rows p sp (+ y 1)))))
(define (stream-col-headers v sp y s e)
  (if (< s e)
    (begin
      (stream-th-col
        (vector-ref (vector-ref v s) y)
        (vector-ref (vector-ref sp s) y))
      (stream-col-headers v sp y (+ s 1) e))))
(define (pivot->stream-col-headers p sp y row-headers)
  (if (< y (col-heads-height p))
    (begin
      (stream-tr y)
      (stream-th-corner
        (col-heads-height p)
        (row-heads-width p)
        y row-headers)
      (stream-col-headers
        (col-headers p) sp y 0 (width p))
      (stream-end-tr)
      (pivot->stream-col-headers p sp (+ y 1) row-headers))))
(define (make-col-span p)
  (make-span
    (col-headers p)
    (col-heads-height p)
    (width p)))
(define (make-row-span p)
  (make-span
    (row-headers p)
    (row-heads-width p)
    (height p)))
(define (pivot->stream p row-headers)
  (stream-table)
  (stream-thead)
  (pivot->stream-col-headers p
    (make-col-span p)
    0 row-headers)
  (stream-end-thead)
  (stream-tbody)
  (pivot->stream-rows p
    (make-row-span p)
    0)
  (stream-end-tbody)
  (stream-end-table)
  #t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Display Pivot Table as CSV ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define out-port (current-output-port))
(define (stream-csv x)
  (if x (write x out-port)))
(define (stream-csv-end-tr)
  (newline out-port))
(define (stream-csv-th c)
  (stream-csv c)
  (write-char #\, out-port))
(define (stream-csv-th-row c s)
  (stream-csv c)
  (write-char #\, out-port))
(define (stream-csv-th-col c s)
  (stream-csv c)
  (write-char #\, out-port))
(define (stream-csv-th-corner r c y row-headers)
  (cond
    ((= y (- r 1))
     (for-each stream-csv-th row-headers))
    (else (display (make-string c #\,) out-port))))
(define (stream-csv-td c)
  (stream-csv c)
  (write-char #\, out-port))
(define (reset-span a sr i w)
  (if (< i w)
    (begin
      (vector-set! sr i (vector-ref a i))
      (vector-set! a i 0)
      (reset-span a sr (+ i 1) w))))
(define (set-span a c p sr i w)
  (if (< i w)
    (if (string=? (vector-ref c i)
                  (vector-ref p i))
      (set-span a c p sr (+ i 1) w)
      (reset-span a sr i w))))
(define (vector-incr a s e)
  (if (< s e)
    (begin
      (vector-set! a s (+ (vector-ref a s) 1))
      (vector-incr a (+ s 1) e))))
(define (vector-set-span p a h i sp w)
  (vector-incr a 0 w)
  (if (zero? i)
    (vector-set! sp 0 a)
    (let ((c (vector-ref h (- i 1)))
          (sr (make-vector w)))
      (set-span a c p sr 0 w)
      (vector-set! sp i sr)
      (vector-set-span c a h (- i 1) sp w))))
(define (make-span h w e)
  (let ((sp (make-vector e)))
    (if (positive? e)
      (vector-set-span
        (vector-ref h (- e 1))
        (make-vector w 0)
        h (- e 1) sp w))
    sp))
(define (stream-csv-row-headers v sr s e)
  (if (< s e)
    (begin
      (stream-csv-th-row
        (vector-ref v s)
        (vector-ref sr s))
      (stream-csv-row-headers v sr (+ s 1) e))))
(define (stream-csv-row v s e)
  (if (< s e)
    (begin
      (stream-csv-td (vector-ref v s))
      (stream-csv-row v (+ s 1) e))
    (stream-csv-end-tr)))
(define (pivot->stream-csv-rows p sp y)
  (if (< y (height p))
    (begin
      (stream-csv-row-headers
        (vector-ref (row-headers p) y)
        (vector-ref sp y)
        0 (row-heads-width p))
      (stream-csv-row (vector-ref (cells p) y)
        0 (width p))
      (pivot->stream-csv-rows p sp (+ y 1)))))
(define (stream-csv-col-headers v sp y s e)
  (if (< s e)
    (begin
      (stream-csv-th-col
        (vector-ref (vector-ref v s) y)
        (vector-ref (vector-ref sp s) y))
      (stream-csv-col-headers v sp y (+ s 1) e))
    (stream-csv-end-tr)))
(define (pivot->stream-csv-col-headers p sp y row-headers)
  (if (< y (col-heads-height p))
    (begin
      (stream-csv-th-corner
        (col-heads-height p)
        (row-heads-width p)
        y row-headers)
      (stream-csv-col-headers
        (col-headers p) sp y 0 (width p))
      (pivot->stream-csv-col-headers p sp (+ y 1) row-headers))))
(define (pivot->stream-csv p row-headers)
  (pivot->stream-csv-col-headers p
    (make-col-span p)
    0 row-headers)
  (pivot->stream-csv-rows p
    (make-row-span p)
    0)
  #t)
