;;
;; exp9d-class-centrality.scm — Class Centrality Difference
;;
;; Hypothesis: Words that are central in their class in one compartment
;; but peripheral in another are polysemous — they fit one grammatical
;; role well but are a poor fit in another context.
;;
;; Method: For each word, compute cosine to its class centroid in each
;; compartment. Large centrality difference = different grammatical role = polysemy.
;;
(define *exp9d-results* '())
(define (exp9d-class-centroid index members)
"Build centroid (average connector vector) for a class.
Returns hash: connector -> mean count."
(let ((centroid (make-hash-table))
(n-members 0))
(for-each
(lambda (word)
(let ((vec (hash-ref index word #f)))
(when vec
(set! n-members (+ n-members 1))
(hash-for-each
(lambda (conn cnt)
(hash-set! centroid conn (+ (hash-ref centroid conn 0) cnt)))
vec))))
members)
;; Average
(when (> n-members 0)
(hash-for-each
(lambda (conn total)
(hash-set! centroid conn (/ total n-members)))
centroid))
centroid))
(define (exp9d-cosine-to-centroid index word centroid)
"Cosine between a word's connector vector and a class centroid."
(let ((vec (hash-ref index word #f)))
(if (not vec) #f
(let ((dot 0.0) (norm-w-sq 0.0) (norm-c-sq 0.0))
(hash-for-each
(lambda (conn cw)
(set! norm-w-sq (+ norm-w-sq (* cw cw)))
(let ((cc (hash-ref centroid conn #f)))
(when cc (set! dot (+ dot (* cw cc))))))
vec)
(hash-for-each
(lambda (conn cc)
(set! norm-c-sq (+ norm-c-sq (* cc cc))))
centroid)
(let ((denom (* (sqrt norm-w-sq) (sqrt norm-c-sq))))
(if (< denom 1e-10) 0.0 (/ dot denom)))))))
(define (run-exp9d)
"Run Experiment 9d: Class Centrality Difference."
(format #t "~%══════════════════════════════════════════════════~%")
(format #t " EXPERIMENT 9d: Class Centrality Difference~%")
(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 class centroids per compartment
(format #t "~%Step 1: Building class centroids...~%")
(let* ((comp-centroids
(map (lambda (r)
(let* ((name (car r))
(classes (cadr r))
(index (list-ref (cdr r) 1))
(centroids (map (lambda (cls)
(exp9d-class-centroid index cls))
classes)))
(format #t " ~a: ~a class centroids built~%" name (length centroids))
(list name classes index centroids)))
comp-data)))
;; Step 2: Build word-to-class mapping per compartment
(format #t "~%Step 2: Building word→class mappings...~%")
(let* ((comp-w2c
(map (lambda (cp)
(let ((w2c (make-hash-table)))
(do ((i 0 (+ i 1))) ((>= i (length (list-ref cp 1))))
(for-each
(lambda (w) (hash-set! w2c w i))
(list-ref (list-ref cp 1) i)))
(cons (list-ref cp 0) w2c)))
comp-centroids))
(names (map car comp-centroids)))
;; Step 3: Find shared words in class systems
(format #t "~%Step 3: Finding words classified in 2+ compartments...~%")
(let ((word-class-info (make-hash-table)))
;; word -> list of (comp-idx class-idx)
(do ((i 0 (+ i 1))) ((>= i (length comp-w2c)))
(hash-for-each
(lambda (word ci)
(hash-set! word-class-info word
(cons (list i ci) (hash-ref word-class-info word '()))))
(cdr (list-ref comp-w2c i))))
(let ((shared-classified '()))
(hash-for-each
(lambda (word info)
(when (>= (length info) 2)
(set! shared-classified (cons (cons word info) shared-classified))))
word-class-info)
(format #t " Words classified in 2+ compartments: ~a~%~%"
(length shared-classified))
;; Step 4: Compute centrality difference
(format #t "Step 4: Computing centrality differences...~%")
(let ((polysemy-candidates '())
(stable-words '())
(all-scores '()))
(for-each
(lambda (entry)
(let* ((word (car entry))
(class-info (cdr entry))
;; Compute centrality in each compartment
(centralities
(filter-map
(lambda (info)
(let* ((ci (list-ref info 0)) ; compartment index
(cli (list-ref info 1)) ; class index
(cp (list-ref comp-centroids ci))
(index (list-ref cp 2))
(centroid (list-ref (list-ref cp 3) cli))
(cos (exp9d-cosine-to-centroid index word centroid)))
(if cos (list (list-ref names ci) cos cli) #f)))
class-info)))
(when (>= (length centralities) 2)
(let* ((cos-values (map cadr centralities))
(max-cent (apply max cos-values))
(min-cent (apply min cos-values))
(diff (- max-cent min-cent))
(mean-cent (/ (apply + cos-values) (length cos-values))))
(set! all-scores
(cons (list word diff mean-cent max-cent min-cent centralities)
all-scores))
(if (> diff 0.4)
(set! polysemy-candidates
(cons (list word diff mean-cent centralities)
polysemy-candidates))
(when (< diff 0.1)
(set! stable-words
(cons (list word diff mean-cent centralities)
stable-words))))))))
shared-classified)
;; Sort: polysemy by largest difference, stable by smallest
(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 " Classified words analyzed: ~a~%" (length all-scores))
(format #t " Polysemy candidates (centrality diff > 0.4): ~a~%"
(length polysemy-candidates))
(format #t " Stable words (centrality diff < 0.1): ~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))
(diff (list-ref p 1))
(centralities (list-ref p 3)))
(format #t "~% ~a (centrality-diff=~,3f):~%" word diff)
(for-each
(lambda (c)
(format #t " ~a: centrality=~,3f (class ~a)~%"
(list-ref c 0) (list-ref c 1) (list-ref c 2)))
centralities)))
(take polysemy-candidates (min 15 (length polysemy-candidates)))))
;; Stable words
(format #t "~%── Stable Words (consistent centrality) ──~%")
(for-each
(lambda (s)
(format #t " ~15a diff=~,3f mean=~,3f~%"
(list-ref s 0) (list-ref s 1) (list-ref s 2)))
(take stable-words (min 10 (length stable-words))))
;; Distribution
(format #t "~%── Centrality Diff 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)
"Centrality reveals 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 centrality (REJECTED)")))
(set! *exp9d-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/exp9d-results.txt")))
(call-with-output-file out-file
(lambda (port)
(format port "# Experiment 9d: Class Centrality Difference~%")
(format port "# Date: ~a~%" (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
(format port "#~%")
(format port "classified_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 (centrality diff > 0.4):~%")
(for-each
(lambda (p)
(format port "polysemy: ~a diff=~,3f mean=~,3f~%"
(list-ref p 0) (list-ref p 1) (list-ref p 2)))
polysemy-candidates)
(format port "#~%# Stable words (centrality diff < 0.1):~%")
(for-each
(lambda (s)
(format port "stable: ~a diff=~,3f~%"
(list-ref s 0) (list-ref s 1)))
stable-words)))
(format #t "~%Results written to ~a~%" out-file))))))))))