;;
;; exp3-merge-stats.scm — Statistics Mergeability
;;
;; Hypothesis: MI computed from merged sufficient statistics equals
;; MI computed from pooled data (up to float precision).
;;
;; Method: Split data into 5 book-compartments, compute MI per compartment,
;; merge stats, recompute MI, compare to global MI.
;;
(define *exp3-results* '())
(define (exp3-process-book book-idx sentences window)
"Process one book's sentences into pair counts + marginals.
Returns (pair-counts left-marg right-marg total-n)."
(let ((pair-counts (make-hash-table))
(left-marg (make-hash-table))
(right-marg (make-hash-table))
(total-n 0))
(for-each
(lambda (entry)
(let* ((sentence (cdr entry))
(words (filter (lambda (w) (> (string-length w) 0))
(string-split sentence #\space)))
(n (length words)))
(do ((i 0 (+ i 1))) ((>= i n))
(do ((j (+ i 1) (+ j 1))) ((or (>= j n) (> (- j i) window)))
(let* ((w1 (list-ref words i))
(w2 (list-ref words j))
(key (cons w1 w2)))
(hash-set! pair-counts key
(+ (hash-ref pair-counts key 0) 1))
(hash-set! left-marg w1
(+ (hash-ref left-marg w1 0) 1))
(hash-set! right-marg w2
(+ (hash-ref right-marg w2 0) 1))
(set! total-n (+ total-n 1)))))))
sentences)
(list pair-counts left-marg right-marg total-n)))
(define (exp3-merge-stats stats-list)
"Merge sufficient statistics from multiple compartments.
Each element is (pair-counts left-marg right-marg total-n).
Returns merged (pair-counts left-marg right-marg total-n)."
(let ((merged-pairs (make-hash-table))
(merged-left (make-hash-table))
(merged-right (make-hash-table))
(merged-n 0))
(for-each
(lambda (stats)
(let ((pairs (list-ref stats 0))
(left (list-ref stats 1))
(right (list-ref stats 2))
(n (list-ref stats 3)))
;; Merge pair counts
(hash-for-each
(lambda (key count)
(hash-set! merged-pairs key
(+ (hash-ref merged-pairs key 0) count)))
pairs)
;; Merge left marginals
(hash-for-each
(lambda (word count)
(hash-set! merged-left word
(+ (hash-ref merged-left word 0) count)))
left)
;; Merge right marginals
(hash-for-each
(lambda (word count)
(hash-set! merged-right word
(+ (hash-ref merged-right word 0) count)))
right)
;; Sum total N
(set! merged-n (+ merged-n n))))
stats-list)
(list merged-pairs merged-left merged-right merged-n)))
(define (exp3-compute-mi-from-stats pair-counts left-marg right-marg total-n)
"Compute MI for all pairs from sufficient statistics.
Returns hash (w1.w2) -> MI."
(let ((mi-hash (make-hash-table))
(n (exact->inexact total-n)))
(when (> n 0)
(hash-for-each
(lambda (key count)
(let* ((w1 (car key))
(w2 (cdr key))
(left-m (hash-ref left-marg w1 1))
(right-m (hash-ref right-marg w2 1)))
(when (and (> count 0) (> left-m 0) (> right-m 0))
(let* ((p-pair (/ count n))
(p-left (/ left-m n))
(p-right (/ right-m n))
(mi (/ (log (/ p-pair (* p-left p-right))) (log 2))))
(hash-set! mi-hash key mi)))))
pair-counts))
mi-hash))
(define (run-exp3)
"Run Experiment 3: Statistics Mergeability."
(format #t "~%══════════════════════════════════════════════════~%")
(format #t " EXPERIMENT 3: Statistics Mergeability~%")
(format #t "══════════════════════════════════════════════════~%~%")
;; Load corpus
(cl-load-all-corpus!)
(let ((window 6)
(t0 (get-internal-real-time)))
;; Step 1: Process each book into compartment stats
(format #t "Step 1: Computing per-book statistics...~%")
(let ((book-stats
(map (lambda (book-idx)
(let* ((book-sentences (filter (lambda (e) (= (car e) book-idx))
*cl-all-sentences*))
(stats (exp3-process-book book-idx book-sentences window)))
(format #t " Book ~a (~a): ~a pairs, N=~a~%"
book-idx (vector-ref *cl-book-names* book-idx)
(hash-count (const #t) (list-ref stats 0))
(list-ref stats 3))
stats))
(iota 5))))
;; Step 2: Merge all stats
(format #t "~%Step 2: Merging statistics...~%")
(let* ((t-merge (get-internal-real-time))
(merged (exp3-merge-stats book-stats))
(merge-time-ms (/ (- (get-internal-real-time) t-merge) 1000000.0))
(merged-pairs (list-ref merged 0))
(merged-left (list-ref merged 1))
(merged-right (list-ref merged 2))
(merged-n (list-ref merged 3)))
(format #t " Merged: ~a pairs, N=~a in ~,2f ms~%"
(hash-count (const #t) merged-pairs) merged-n merge-time-ms)
;; Step 3: Compute MI from merged stats
(format #t "~%Step 3: Computing MI from merged stats...~%")
(let* ((t-mi (get-internal-real-time))
(merged-mi (exp3-compute-mi-from-stats merged-pairs merged-left
merged-right merged-n))
(mi-time-ms (/ (- (get-internal-real-time) t-mi) 1000000.0)))
(format #t " MI computed for ~a pairs in ~,2f ms~%"
(hash-count (const #t) merged-mi) mi-time-ms)
;; Step 4: Also compute MI from pooled data (all sentences at once)
(format #t "~%Step 4: Computing MI from pooled data (single pass)...~%")
(let* ((t-pool (get-internal-real-time))
(pooled (exp3-process-book -1 *cl-all-sentences* window))
(pooled-mi (exp3-compute-mi-from-stats
(list-ref pooled 0) (list-ref pooled 1)
(list-ref pooled 2) (list-ref pooled 3)))
(pool-time-ms (/ (- (get-internal-real-time) t-pool) 1000000.0)))
(format #t " Pooled: ~a pairs, N=~a in ~,2f ms~%"
(hash-count (const #t) (list-ref pooled 0))
(list-ref pooled 3) pool-time-ms)
;; Step 5: Compare merged vs pooled MI
(format #t "~%Step 5: Comparing merged vs pooled MI...~%")
(let ((max-error 0.0)
(sum-error 0.0)
(n-compared 0)
(errors-above-001 0)
(errors-above-01 0))
(hash-for-each
(lambda (key merged-val)
(let ((pooled-val (hash-ref pooled-mi key #f)))
(when pooled-val
(let ((err (abs (- merged-val pooled-val))))
(set! n-compared (+ n-compared 1))
(set! sum-error (+ sum-error err))
(when (> err max-error) (set! max-error err))
(when (> err 0.001) (set! errors-above-001 (+ errors-above-001 1)))
(when (> err 0.01) (set! errors-above-01 (+ errors-above-01 1)))))))
merged-mi)
(let ((mean-error (if (> n-compared 0) (/ sum-error n-compared) 0.0))
(total-time-ms (/ (- (get-internal-real-time) t0) 1000000.0)))
(format #t "~%── RESULTS ──~%")
(format #t " Pairs compared: ~a~%" n-compared)
(format #t " Max |MI_merged - MI_pooled|: ~,8f~%" max-error)
(format #t " Mean error: ~,8f~%" mean-error)
(format #t " Errors > 0.001: ~a~%" errors-above-001)
(format #t " Errors > 0.01: ~a~%" errors-above-01)
(format #t " Merge time: ~,2f ms~%" merge-time-ms)
(format #t " Total time: ~,2f ms~%~%" total-time-ms)
(format #t "VERDICT: ~a~%"
(cond
((< max-error 0.001) "PERFECT MATCH — merged stats produce identical MI (CONFIRMED)")
((< max-error 0.01) "VERY CLOSE — tiny numerical differences (CONFIRMED)")
((< max-error 0.1) "CLOSE — small differences, likely due to counting method (MIXED)")
(else "SIGNIFICANT DIVERGENCE — stats are NOT simply additive (REJECTED)")))
;; Also compare merged vs global (*mi-cache*) to check our recomputation
(format #t "~%── Sanity check: Merged vs *mi-cache* (CogServer) ──~%")
(let ((gc-max-error 0.0) (gc-n 0) (gc-sum 0.0))
(hash-for-each
(lambda (key merged-val)
(let* ((w1 (car key)) (w2 (cdr key))
(global-val (hash-ref *mi-cache* key #f)))
(when global-val
(let ((err (abs (- merged-val global-val))))
(set! gc-n (+ gc-n 1))
(set! gc-sum (+ gc-sum err))
(when (> err gc-max-error) (set! gc-max-error err))))))
merged-mi)
(format #t " Pairs in both: ~a~%" gc-n)
(format #t " Max error vs *mi-cache*: ~,4f~%" gc-max-error)
(format #t " Mean error vs *mi-cache*: ~,4f~%"
(if (> gc-n 0) (/ gc-sum gc-n) 0.0))
(format #t " (Note: *mi-cache* may differ due to warm-start filtering)~%"))
;; Store results
(set! *exp3-results*
(list n-compared max-error mean-error errors-above-001
errors-above-01 merge-time-ms total-time-ms))
;; Write results
(let ((out-file (string-append *mvp-dir* "/experiments/results/exp3-results.txt")))
(call-with-output-file out-file
(lambda (port)
(format port "# Experiment 3: Statistics Mergeability~%")
(format port "# Date: ~a~%" (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
(format port "#~%")
(format port "pairs_compared: ~a~%" n-compared)
(format port "max_error: ~,10f~%" max-error)
(format port "mean_error: ~,10f~%" mean-error)
(format port "errors_above_0.001: ~a~%" errors-above-001)
(format port "errors_above_0.01: ~a~%" errors-above-01)
(format port "merge_time_ms: ~,2f~%" merge-time-ms)
(format port "total_time_ms: ~,2f~%" total-time-ms)
(format port "verdict: ~a~%"
(if (< max-error 0.001) "CONFIRMED" "MIXED_OR_REJECTED"))))
(format #t "~%Results written to ~a~%" out-file))))))))))