;;
;; exp2-domain-mi.scm — Domain-Specific vs Global MI
;;
;; Hypothesis: MI computed from a single book gives higher signal
;; for domain-relevant pairs than global MI.
;;
;; Method: For each book, collect pairs seen in that book,
;; compute domain-local MI, compare to global MI.
;;
(define *exp2-results* '())
(define (exp2-process-book-sentences book-idx sentences)
"Process sentences for one book: count pairs, compute marginals.
Returns (pair-counts left-marginals right-marginals total-N)
where pair-counts is hash (w1.w2) -> count."
(let ((pair-counts (make-hash-table))
(left-marg (make-hash-table))
(right-marg (make-hash-table))
(total-n 0)
(window 6))
(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 (exp2-compute-mi pair-counts left-marg right-marg total-n)
"Compute MI for all pairs in pair-counts. 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 (exp2-top-n-pairs mi-hash n)
"Get top N pairs by MI from hash. Returns list of (w1 w2 mi)."
(let ((pairs '()))
(hash-for-each
(lambda (key mi)
(set! pairs (cons (list (car key) (cdr key) mi) pairs)))
mi-hash)
(let ((sorted (sort pairs (lambda (a b) (> (list-ref a 2) (list-ref b 2))))))
(take sorted (min n (length sorted))))))
(define (exp2-compare-domain-global domain-mi global-mi-hash)
"Compare domain MI to global MI for the same pairs.
Returns (n-higher n-lower n-total mean-domain mean-global ratio-list)."
(let ((n-higher 0) (n-lower 0) (n-total 0)
(sum-domain 0.0) (sum-global 0.0)
(ratios '()))
(hash-for-each
(lambda (key domain-val)
(let ((global-val (hash-ref global-mi-hash key #f)))
(when global-val
(set! n-total (+ n-total 1))
(set! sum-domain (+ sum-domain domain-val))
(set! sum-global (+ sum-global global-val))
(if (> domain-val global-val)
(set! n-higher (+ n-higher 1))
(set! n-lower (+ n-lower 1)))
(when (> (abs global-val) 0.001)
(set! ratios (cons (/ domain-val global-val) ratios))))))
domain-mi)
(list n-higher n-lower n-total
(if (> n-total 0) (/ sum-domain n-total) 0.0)
(if (> n-total 0) (/ sum-global n-total) 0.0)
ratios)))
(define (run-exp2)
"Run Experiment 2: Domain-Specific vs Global MI."
(format #t "~%══════════════════════════════════════════════════~%")
(format #t " EXPERIMENT 2: Domain-Specific vs Global MI~%")
(format #t "══════════════════════════════════════════════════~%~%")
;; Load corpus if needed
(cl-load-all-corpus!)
;; Build a global MI lookup from *mi-cache* (only w1<w2 direction)
(let ((global-mi (make-hash-table))
(global-count 0))
(hash-for-each
(lambda (key mi)
(when (and (pair? key) (string<? (car key) (cdr key)))
(hash-set! global-mi key mi)
(set! global-count (+ global-count 1))))
*mi-cache*)
(format #t "Global MI: ~a unique pairs~%~%" global-count)
(set! *exp2-results* '())
;; Process each book
(do ((book-idx 0 (+ book-idx 1))) ((>= book-idx 5))
(let* ((book-name (vector-ref *cl-book-names* book-idx))
(book-sentences (filter (lambda (e) (= (car e) book-idx))
*cl-all-sentences*))
(n-sentences (length book-sentences)))
(format #t "── Book ~a: ~a (~a sentences) ──~%" book-idx book-name n-sentences)
(when (> n-sentences 0)
;; Compute domain-local statistics
(let* ((stats (exp2-process-book-sentences book-idx book-sentences))
(pair-counts (list-ref stats 0))
(left-marg (list-ref stats 1))
(right-marg (list-ref stats 2))
(total-n (list-ref stats 3))
(n-pairs (hash-count (const #t) pair-counts)))
(format #t " Pairs: ~a, N: ~a~%" n-pairs total-n)
;; Compute domain MI
(let ((domain-mi (exp2-compute-mi pair-counts left-marg right-marg total-n)))
(format #t " Domain MI computed for ~a pairs~%" (hash-count (const #t) domain-mi))
;; Get domain top-20
(let ((domain-top (exp2-top-n-pairs domain-mi 20)))
(format #t "~% Domain Top-20 MI pairs:~%")
(for-each
(lambda (p)
(let* ((w1 (list-ref p 0))
(w2 (list-ref p 1))
(d-mi (list-ref p 2))
(g-mi (hash-ref global-mi (cons w1 w2) 0.0)))
(format #t " ~15a ~15a domain=~,3f global=~,3f ~a~%"
w1 w2 d-mi g-mi
(if (> d-mi g-mi) "HIGHER" "lower"))))
domain-top))
;; Get global top-20 (only pairs that appear in this book)
(let* ((global-in-book (make-hash-table)))
(hash-for-each
(lambda (key _)
(let ((g (hash-ref global-mi key #f)))
(when g (hash-set! global-in-book key g))))
domain-mi)
(let ((global-top (exp2-top-n-pairs global-in-book 20)))
(format #t "~% Global Top-20 (book pairs only):~%")
(for-each
(lambda (p)
(let* ((w1 (list-ref p 0))
(w2 (list-ref p 1))
(g-mi (list-ref p 2))
(d-mi (hash-ref domain-mi (cons w1 w2) 0.0)))
(format #t " ~15a ~15a global=~,3f domain=~,3f~%"
w1 w2 g-mi d-mi)))
global-top)))
;; Compare domain vs global
(let* ((comparison (exp2-compare-domain-global domain-mi global-mi))
(n-higher (list-ref comparison 0))
(n-lower (list-ref comparison 1))
(n-total (list-ref comparison 2))
(mean-domain (list-ref comparison 3))
(mean-global (list-ref comparison 4))
(overlap-top
;; How many of domain top-20 also appear in global top-20?
(let* ((domain-top-keys (map (lambda (p) (cons (car p) (cadr p)))
(exp2-top-n-pairs domain-mi 20)))
(global-in-book (make-hash-table)))
(hash-for-each
(lambda (key _)
(let ((g (hash-ref global-mi key #f)))
(when g (hash-set! global-in-book key g))))
domain-mi)
(let ((global-top-keys (map (lambda (p) (cons (car p) (cadr p)))
(exp2-top-n-pairs global-in-book 20))))
(length (filter (lambda (k) (member k global-top-keys)) domain-top-keys))))))
(format #t "~% Comparison (~a pairs in both):~%" n-total)
(format #t " Higher in domain: ~a (~,1f%)~%"
n-higher (if (> n-total 0) (* 100.0 (/ n-higher n-total)) 0))
(format #t " Higher in global: ~a (~,1f%)~%"
n-lower (if (> n-total 0) (* 100.0 (/ n-lower n-total)) 0))
(format #t " Mean domain MI: ~,3f~%" mean-domain)
(format #t " Mean global MI: ~,3f~%" mean-global)
(format #t " Top-20 overlap: ~a/20~%" overlap-top)
(format #t "~%")
;; Record result
(set! *exp2-results*
(cons (list book-name n-sentences n-pairs
n-higher n-lower n-total
mean-domain mean-global overlap-top)
*exp2-results*))))))))
;; Summary
(set! *exp2-results* (reverse *exp2-results*))
(format #t "~%── SUMMARY ──~%")
(format #t "~15a ~8a ~8a ~8a ~8a ~10a ~10a ~7a~%"
"Book" "Sents" "Pairs" "Higher" "Lower" "D-MI" "G-MI" "Top20")
(format #t "──────────────────────────────────────────────────────────────────~%")
(for-each
(lambda (r)
(format #t "~15a ~8a ~8a ~8a ~8a ~10,3f ~10,3f ~7a~%"
(list-ref r 0) (list-ref r 1) (list-ref r 2)
(list-ref r 3) (list-ref r 4)
(list-ref r 6) (list-ref r 7) (list-ref r 8)))
*exp2-results*)
;; Verdict
(let* ((total-higher (apply + (map (lambda (r) (list-ref r 3)) *exp2-results*)))
(total-compared (apply + (map (lambda (r) (list-ref r 5)) *exp2-results*)))
(pct-higher (if (> total-compared 0) (* 100.0 (/ total-higher total-compared)) 0))
(avg-overlap (if (null? *exp2-results*) 0
(/ (apply + (map (lambda (r) (list-ref r 8)) *exp2-results*))
(length *exp2-results*) 1.0))))
(format #t "~%Overall: ~,1f% of comparable pairs have higher domain MI~%" pct-higher)
(format #t "Average top-20 overlap: ~,1f/20~%" avg-overlap)
(format #t "~%VERDICT: Domain MI is ~a~%"
(if (and (> pct-higher 40) (< avg-overlap 15))
"DISTINCT from global (hypothesis CONFIRMED)"
(if (> avg-overlap 15)
"SIMILAR to global (mostly same rankings)"
"MIXED (some domains distinct, some similar)"))))
;; Write results
(let ((out-file (string-append *mvp-dir* "/experiments/results/exp2-results.txt")))
(call-with-output-file out-file
(lambda (port)
(format port "# Experiment 2: Domain-Specific vs Global MI~%")
(format port "# Date: ~a~%" (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
(format port "#~%")
(format port "# book sentences pairs n_higher n_lower n_compared mean_domain mean_global overlap~%")
(for-each
(lambda (r)
(format port "~a ~a ~a ~a ~a ~a ~,4f ~,4f ~a~%"
(list-ref r 0) (list-ref r 1) (list-ref r 2)
(list-ref r 3) (list-ref r 4) (list-ref r 5)
(list-ref r 6) (list-ref r 7) (list-ref r 8)))
*exp2-results*)))
(format #t "Results written to ~a~%" out-file))))