;;
;; exp9c-mi-neighborhood.scm — MI Neighborhood Divergence
;;
;; Hypothesis: Words with different MI neighborhoods across compartments
;; are being used in different contexts = polysemy.
;;
;; Method: For each word in multiple compartments, build its MI neighborhood
;; vector (top partners weighted by MI). Compute cosine between these vectors
;; across compartments. Low cosine = different usage patterns = polysemy.
;;
(define *exp9c-results* '())
(define (exp9c-build-mi-neighborhoods comp-data)
"Build MI neighborhood index per compartment.
Single pass over *mi-cache* for efficiency (~2.1M entries).
Returns list of (name . hash-table) where hash maps word -> (hash: partner -> MI)."
(let* ((indices (map (lambda (r) (list-ref (cdr r) 1)) comp-data))
(names (map car comp-data))
(n-comps (length comp-data))
;; Pre-allocate neighborhood tables per compartment
(hood-tables (map (lambda (_) (make-hash-table)) comp-data)))
;; Single pass over *mi-cache*
(hash-for-each
(lambda (pair mi)
(when (pair? pair)
(let ((w1 (car pair))
(w2 (cdr pair)))
;; For each compartment, check if both words are in its index
(do ((i 0 (+ i 1))) ((>= i n-comps))
(let ((index (list-ref indices i))
(hoods (list-ref hood-tables i)))
(when (and (hash-ref index w1 #f) (hash-ref index w2 #f))
;; Add w2 to w1's MI neighborhood
(let ((w1-vec (hash-ref hoods w1 #f)))
(unless w1-vec
(set! w1-vec (make-hash-table))
(hash-set! hoods w1 w1-vec))
(hash-set! w1-vec w2 mi))
;; Add w1 to w2's MI neighborhood
(let ((w2-vec (hash-ref hoods w2 #f)))
(unless w2-vec
(set! w2-vec (make-hash-table))
(hash-set! hoods w2 w2-vec))
(hash-set! w2-vec w1 mi))))))))
*mi-cache*)
;; Return as (name . hood-table) pairs
(map cons names hood-tables)))
(define (exp9c-mi-cosine vec-a vec-b)
"Cosine between two MI neighborhood vectors."
(let ((dot 0.0) (norm-a-sq 0.0) (norm-b-sq 0.0))
(hash-for-each
(lambda (partner mi-a)
(set! norm-a-sq (+ norm-a-sq (* mi-a mi-a)))
(let ((mi-b (hash-ref vec-b partner #f)))
(when mi-b (set! dot (+ dot (* mi-a mi-b))))))
vec-a)
(hash-for-each
(lambda (partner mi-b)
(set! norm-b-sq (+ norm-b-sq (* mi-b mi-b))))
vec-b)
(let ((denom (* (sqrt norm-a-sq) (sqrt norm-b-sq))))
(if (< denom 1e-10) 0.0 (/ dot denom)))))
(define (exp9c-top-partners mi-vec n)
"Get top-N partners from MI neighborhood vector as readable string."
(let ((pairs '()))
(hash-for-each (lambda (p m) (set! pairs (cons (cons p m) pairs))) mi-vec)
(let ((sorted (sort pairs (lambda (a b) (> (cdr a) (cdr b))))))
(string-join
(map (lambda (p) (format #f "~a(~,1f)" (car p) (cdr p)))
(take sorted (min n (length sorted))))
" "))))
(define (run-exp9c)
"Run Experiment 9c: MI Neighborhood Divergence."
(format #t "~%══════════════════════════════════════════════════~%")
(format #t " EXPERIMENT 9c: MI Neighborhood Divergence~%")
(format #t "══════════════════════════════════════════════════~%~%")
(when (null? *exp7-compartments*)
(format #t "Exp7 data not cached — running exp7 first...~%~%")
(run-exp7))
(let* ((comp-data *exp7-compartments*)
(t0 (get-internal-real-time)))
(format #t "Using ~a compartments from exp7~%" (length comp-data))
;; Step 1: Build MI neighborhoods
(format #t "~%Step 1: Building MI neighborhoods per compartment...~%")
(let* ((mi-hoods (exp9c-build-mi-neighborhoods comp-data))
(names (map car mi-hoods))
(hoods (map cdr mi-hoods)))
(for-each
(lambda (name hood)
(format #t " ~a: ~a words with MI neighborhoods~%"
name (hash-count (const #t) hood)))
names hoods)
;; Step 2: Find shared words
(format #t "~%Step 2: Finding shared words...~%")
(let ((word-presence (make-hash-table)))
(do ((i 0 (+ i 1))) ((>= i (length hoods)))
(hash-for-each
(lambda (word _)
(hash-set! word-presence word
(cons i (hash-ref word-presence word '()))))
(list-ref hoods i)))
(let ((shared-words '()))
(hash-for-each
(lambda (word comps)
(when (>= (length comps) 2)
(set! shared-words (cons (cons word comps) shared-words))))
word-presence)
(format #t " Words in 2+ compartments: ~a~%~%" (length shared-words))
;; Step 3: Compute MI neighborhood cosine
(format #t "Step 3: Computing MI neighborhood cosine...~%")
(let ((polysemy-candidates '())
(stable-words '())
(all-scores '()))
(for-each
(lambda (entry)
(let* ((word (car entry))
(comp-ids (cdr entry))
(pair-cosines '()))
(let outer ((rest comp-ids))
(when (>= (length rest) 2)
(let inner ((others (cdr rest)))
(when (not (null? others))
(let* ((ci-a (car rest))
(ci-b (car others))
(vec-a (hash-ref (list-ref hoods ci-a) word #f))
(vec-b (hash-ref (list-ref hoods ci-b) word #f)))
(when (and vec-a vec-b)
(let ((cos (exp9c-mi-cosine vec-a vec-b)))
(set! pair-cosines
(cons (list (list-ref names ci-a)
(list-ref names ci-b) cos)
pair-cosines)))))
(inner (cdr others))))
(outer (cdr rest))))
(unless (null? pair-cosines)
(let ((min-cos (apply min (map caddr pair-cosines)))
(mean-cos (/ (apply + (map caddr pair-cosines))
(length pair-cosines))))
(set! all-scores
(cons (list word min-cos mean-cos pair-cosines) all-scores))
(if (< min-cos 0.3)
(set! polysemy-candidates
(cons (list word min-cos mean-cos pair-cosines)
polysemy-candidates))
(when (> min-cos 0.7)
(set! stable-words
(cons (list word min-cos mean-cos pair-cosines)
stable-words))))))))
shared-words)
;; Sort
(set! polysemy-candidates
(sort polysemy-candidates (lambda (a b) (< (cadr a) (cadr b)))))
(set! stable-words
(sort stable-words (lambda (a b) (> (cadr a) (cadr b)))))
(set! all-scores
(sort all-scores (lambda (a b) (< (cadr a) (cadr b)))))
;; Report
(format #t "~%── RESULTS ──~%")
(format #t " Shared words analyzed: ~a~%" (length all-scores))
(format #t " Polysemy candidates (min cosine < 0.3): ~a~%"
(length polysemy-candidates))
(format #t " Stable words (min cosine > 0.7): ~a~%"
(length stable-words))
;; Show candidates
(format #t "~%── Polysemy Candidates ──~%")
(if (null? polysemy-candidates)
(format #t " (none found)~%")
(for-each
(lambda (p)
(let ((word (list-ref p 0))
(min-cos (list-ref p 1)))
(format #t "~% ~a (min-cosine=~,3f):~%" word min-cos)
(for-each
(lambda (pc)
(format #t " ~a vs ~a: cosine=~,3f~%"
(list-ref pc 0) (list-ref pc 1) (list-ref pc 2)))
(list-ref p 3))
;; Show top MI partners per compartment
(for-each
(lambda (ci)
(let ((vec (hash-ref (list-ref hoods ci) word #f)))
(when vec
(format #t " ~a MI neighbors: ~a~%"
(list-ref names ci)
(exp9c-top-partners vec 5)))))
(let ((seen (make-hash-table))
(ids '()))
(for-each
(lambda (pc)
(let ((ci-a (let find ((i 0))
(if (string=? (list-ref names i) (list-ref pc 0)) i
(find (+ i 1)))))
(ci-b (let find ((i 0))
(if (string=? (list-ref names i) (list-ref pc 1)) i
(find (+ i 1))))))
(unless (hash-ref seen ci-a #f)
(hash-set! seen ci-a #t)
(set! ids (cons ci-a ids)))
(unless (hash-ref seen ci-b #f)
(hash-set! seen ci-b #t)
(set! ids (cons ci-b ids)))))
(list-ref p 3))
(reverse ids)))))
(take polysemy-candidates (min 15 (length polysemy-candidates)))))
;; Stable words
(format #t "~%── Stable Words ──~%")
(for-each
(lambda (s)
(format #t " ~15a min-cosine=~,3f~%" (list-ref s 0) (list-ref s 1)))
(take stable-words (min 10 (length stable-words))))
;; Distribution
(format #t "~%── Cosine Distribution ──~%")
(let ((bins (make-vector 10 0)))
(for-each
(lambda (s)
(let ((bin (min 9 (inexact->exact (floor (* (cadr s) 10))))))
(vector-set! bins bin (+ (vector-ref bins bin) 1))))
all-scores)
(do ((i 0 (+ i 1))) ((>= i 10))
(format #t " ~,1f-~,1f: ~a ~a~%"
(* i 0.1) (* (+ i 1) 0.1)
(vector-ref bins i)
(make-string (min 50 (vector-ref bins i)) #\#))))
(let* ((elapsed-ms (/ (- (get-internal-real-time) t0) 1000000.0))
(passed (>= (length polysemy-candidates) 3)))
(format #t "~% Total time: ~,1f ms~%" elapsed-ms)
(format #t "~%VERDICT: ~a~%"
(cond
((>= (length polysemy-candidates) 6)
"MI neighborhoods reveal rich polysemy (CONFIRMED)")
((>= (length polysemy-candidates) 3)
"Polysemy detected, moderate signal (CONFIRMED)")
((> (length polysemy-candidates) 0)
"Some polysemy found but below threshold (PARTIALLY CONFIRMED)")
(else
"No polysemy detected via MI neighborhoods (REJECTED)")))
(set! *exp9c-results*
(list (length all-scores) (length polysemy-candidates)
(length stable-words)
polysemy-candidates stable-words passed))
(let ((out-file (string-append *mvp-dir* "/experiments/results/exp9c-results.txt")))
(call-with-output-file out-file
(lambda (port)
(format port "# Experiment 9c: MI Neighborhood Divergence~%")
(format port "# Date: ~a~%" (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
(format port "#~%")
(format port "shared_words: ~a~%" (length all-scores))
(format port "polysemy_candidates: ~a~%" (length polysemy-candidates))
(format port "stable_words: ~a~%" (length stable-words))
(format port "time_ms: ~,2f~%" elapsed-ms)
(format port "verdict: ~a~%" (if passed "CONFIRMED" "REJECTED"))
(format port "#~%# Polysemy candidates (min cosine < 0.3):~%")
(for-each
(lambda (p)
(format port "polysemy: ~a min_cos=~,3f mean_cos=~,3f~%"
(list-ref p 0) (list-ref p 1) (list-ref p 2)))
polysemy-candidates)
(format port "#~%# Stable words (min cosine > 0.7):~%")
(for-each
(lambda (s)
(format port "stable: ~a min_cos=~,3f~%"
(list-ref s 0) (list-ref s 1)))
stable-words)))
(format #t "~%Results written to ~a~%" out-file)))))))))