;;
;; exp9-class-alignment.scm — Cross-Compartment Class Alignment via Connector-Cosine
;;
;; Hypothesis: Classes discovered independently in different compartments
;; can be aligned using connector-cosine similarity on their merged
;; connector profiles, revealing both shared structure and polysemy.
;;
;; Method: Build class connector profiles from exp7 compartments,
;; compute class-to-class connector-cosine across compartments.
;; Replaces exp5's Jaccard with the correct metric.
;;
(define *exp9-results* '())
;; ─────────────────────────────────────────────────────────────────────
;; CLASS CONNECTOR PROFILES
;; ─────────────────────────────────────────────────────────────────────
(define (exp9-build-class-profile index class)
"Build a class connector profile by merging connector vectors of all members.
Returns hash: connector -> summed count."
(let ((profile (make-hash-table)))
(for-each
(lambda (word)
(let ((vec (hash-ref index word #f)))
(when vec
(hash-for-each
(lambda (conn cnt)
(hash-set! profile conn (+ (hash-ref profile conn 0) cnt)))
vec))))
class)
profile))
(define (exp9-profile-cosine profile-a profile-b)
"Compute cosine similarity between two class connector profiles."
(let ((dot 0.0) (norm-a-sq 0.0) (norm-b-sq 0.0))
(hash-for-each
(lambda (conn ca)
(set! norm-a-sq (+ norm-a-sq (* ca ca)))
(let ((cb (hash-ref profile-b conn #f)))
(when cb (set! dot (+ dot (* ca cb))))))
profile-a)
(hash-for-each
(lambda (conn cb)
(set! norm-b-sq (+ norm-b-sq (* cb cb))))
profile-b)
(let ((denom (* (sqrt norm-a-sq) (sqrt norm-b-sq))))
(if (< denom 1e-10) 0.0 (/ dot denom)))))
;; ─────────────────────────────────────────────────────────────────────
;; EXPERIMENT RUNNER
;; ─────────────────────────────────────────────────────────────────────
(define (run-exp9)
"Run Experiment 9: Cross-Compartment Class Alignment via Connector-Cosine."
(format #t "~%══════════════════════════════════════════════════~%")
(format #t " EXPERIMENT 9: Class Alignment via Connector-Cosine~%")
(format #t "══════════════════════════════════════════════════~%~%")
;; Check if exp7 data is available
(when (null? *exp7-compartments*)
(format #t "Exp7 data not cached — running exp7 first...~%~%")
(run-exp7))
(let* ((comp-data *exp7-compartments*)
(n-comps (length comp-data))
(t0 (get-internal-real-time)))
(format #t "Using ~a compartments from exp7:~%" n-comps)
(for-each
(lambda (r)
(format #t " ~a: ~a classes~%" (car r) (length (cadr r))))
comp-data)
;; Step 1: Build class connector profiles for each compartment
(format #t "~%Step 1: Building class connector profiles...~%")
(let* ((comp-profiles
(map (lambda (r)
(let* ((name (car r))
(classes (cadr r))
(index (list-ref (cdr r) 1))
(profiles (map (lambda (cls)
(exp9-build-class-profile index cls))
classes)))
(format #t " ~a: ~a class profiles built~%" name (length profiles))
(list name classes index profiles)))
comp-data)))
;; Step 2: Compute cross-compartment class-to-class cosine
(format #t "~%Step 2: Cross-compartment class alignment...~%")
(let ((alignments '())
(polysemy-candidates '()))
;; Compare all pairs of compartments
(let outer ((rest comp-profiles))
(when (>= (length rest) 2)
(let* ((comp-a (car rest))
(name-a (list-ref comp-a 0))
(classes-a (list-ref comp-a 1))
(profiles-a (list-ref comp-a 3)))
(let inner ((others (cdr rest)))
(when (not (null? others))
(let* ((comp-b (car others))
(name-b (list-ref comp-b 0))
(classes-b (list-ref comp-b 1))
(profiles-b (list-ref comp-b 3)))
(format #t "~% ── ~a vs ~a ──~%" name-a name-b)
;; Class-to-class cosine matrix
(do ((i 0 (+ i 1))) ((>= i (length profiles-a)))
(do ((j 0 (+ j 1))) ((>= j (length profiles-b)))
(let ((cos (exp9-profile-cosine
(list-ref profiles-a i)
(list-ref profiles-b j))))
(when (> cos 0.3)
(set! alignments
(cons (list name-a i name-b j cos
(list-ref classes-a i)
(list-ref classes-b j))
alignments))
(format #t " Class ~a:~a ↔ ~a:~a cosine=~,3f~%"
name-a i name-b j cos)
(format #t " ~a: ~a~%" name-a
(string-join (list-ref classes-a i) ", "))
(format #t " ~a: ~a~%" name-b
(string-join (list-ref classes-b j) ", "))))))
;; Print full alignment matrix
(format #t "~% Alignment matrix (~a classes × ~a classes):~%"
(length classes-a) (length classes-b))
(format #t " ~8a" "")
(do ((j 0 (+ j 1))) ((>= j (length profiles-b)))
(format #t " ~6a" (format #f "~a:~a" name-b j)))
(format #t "~%")
(do ((i 0 (+ i 1))) ((>= i (length profiles-a)))
(format #t " ~8a" (format #f "~a:~a" name-a i))
(do ((j 0 (+ j 1))) ((>= j (length profiles-b)))
(format #t " ~6,3f"
(exp9-profile-cosine
(list-ref profiles-a i)
(list-ref profiles-b j))))
(format #t "~%")))
(inner (cdr others)))))
(outer (cdr rest))))
;; Step 3: Polysemy detection
(format #t "~%Step 3: Polysemy detection...~%")
;; Word W in class C_A (comp A) and class C_B (comp B),
;; where C_A and C_B have cosine < 0.1 = polysemy candidate
(let outer2 ((rest comp-profiles))
(when (>= (length rest) 2)
(let* ((comp-a (car rest))
(name-a (list-ref comp-a 0))
(classes-a (list-ref comp-a 1))
(profiles-a (list-ref comp-a 3)))
(let inner2 ((others (cdr rest)))
(when (not (null? others))
(let* ((comp-b (car others))
(name-b (list-ref comp-b 0))
(classes-b (list-ref comp-b 1))
(profiles-b (list-ref comp-b 3)))
;; Find words in both compartments' class systems
(let ((w2c-a (make-hash-table))
(w2c-b (make-hash-table)))
(do ((i 0 (+ i 1))) ((>= i (length classes-a)))
(for-each (lambda (w) (hash-set! w2c-a w i))
(list-ref classes-a i)))
(do ((j 0 (+ j 1))) ((>= j (length classes-b)))
(for-each (lambda (w) (hash-set! w2c-b w j))
(list-ref classes-b j)))
;; Find shared words
(hash-for-each
(lambda (word ci-a)
(let ((ci-b (hash-ref w2c-b word #f)))
(when ci-b
(let ((class-cos (exp9-profile-cosine
(list-ref profiles-a ci-a)
(list-ref profiles-b ci-b))))
(when (< class-cos 0.1)
(set! polysemy-candidates
(cons (list word name-a ci-a name-b ci-b class-cos)
polysemy-candidates)))))))
w2c-a)))
(inner2 (cdr others)))))
(outer2 (cdr rest))))
;; Sort polysemy candidates by lowest cosine
(set! polysemy-candidates
(sort polysemy-candidates (lambda (a b) (< (list-ref a 5) (list-ref b 5)))))
;; Report
(format #t "~%── RESULTS ──~%")
(format #t " Aligned class pairs (cosine > 0.3): ~a~%" (length alignments))
(format #t " Polysemy candidates (cosine < 0.1): ~a~%~%" (length polysemy-candidates))
(when (not (null? polysemy-candidates))
(format #t " Top polysemy candidates:~%")
(for-each
(lambda (p)
(format #t " ~15a ~a:class~a ↔ ~a:class~a (class-cosine=~,3f)~%"
(list-ref p 0) (list-ref p 1) (list-ref p 2)
(list-ref p 3) (list-ref p 4) (list-ref p 5)))
(take polysemy-candidates (min 20 (length polysemy-candidates)))))
;; Compare to exp5
(format #t "~% Comparison to Exp5 (Jaccard):~%")
(format #t " Exp5 polysemy candidates: ~a~%"
(if (null? *exp5-results*) "NOT RUN"
(number->string (list-ref *exp5-results* 1))))
(format #t " Exp9 polysemy candidates: ~a~%" (length polysemy-candidates))
(format #t " Exp9 aligned pairs: ~a~%" (length alignments))
(let* ((elapsed-ms (/ (- (get-internal-real-time) t0) 1000000.0))
(exp5-polysemy (if (null? *exp5-results*) 6 (list-ref *exp5-results* 1)))
(passed (and (>= (length alignments) 3)
(>= (length polysemy-candidates) exp5-polysemy))))
(format #t "~% Total time: ~,1f ms~%" elapsed-ms)
(format #t "~%VERDICT: ~a~%"
(cond
((and (>= (length alignments) 3)
(>= (length polysemy-candidates) exp5-polysemy))
"Connector-cosine finds aligned classes AND polysemy (CONFIRMED)")
((>= (length alignments) 3)
"Aligned classes found but fewer polysemy candidates (PARTIALLY CONFIRMED)")
((>= (length polysemy-candidates) exp5-polysemy)
"Polysemy found but few aligned classes (PARTIALLY CONFIRMED)")
(else
"Insufficient cross-domain signal (REJECTED)")))
;; Store results
(set! *exp9-results*
(list (length alignments) (length polysemy-candidates)
alignments polysemy-candidates passed))
;; Write results
(let ((out-file (string-append *mvp-dir* "/experiments/results/exp9-results.txt")))
(call-with-output-file out-file
(lambda (port)
(format port "# Experiment 9: Cross-Compartment Class Alignment~%")
(format port "# Date: ~a~%" (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
(format port "#~%")
(format port "aligned_pairs: ~a~%" (length alignments))
(format port "polysemy_candidates: ~a~%" (length polysemy-candidates))
(format port "exp5_polysemy: ~a~%" exp5-polysemy)
(format port "time_ms: ~,2f~%" elapsed-ms)
(format port "verdict: ~a~%" (if passed "CONFIRMED" "REJECTED"))
(format port "#~%# Aligned class pairs (cosine > 0.3):~%")
(for-each
(lambda (a)
(format port "alignment: ~a:~a ↔ ~a:~a cosine=~,3f~%"
(list-ref a 0) (list-ref a 1)
(list-ref a 2) (list-ref a 3)
(list-ref a 4)))
alignments)
(format port "#~%# Polysemy candidates (class cosine < 0.1):~%")
(for-each
(lambda (p)
(format port "polysemy: ~a ~a:~a ↔ ~a:~a cosine=~,3f~%"
(list-ref p 0) (list-ref p 1) (list-ref p 2)
(list-ref p 3) (list-ref p 4) (list-ref p 5)))
polysemy-candidates)))
(format #t "~%Results written to ~a~%" out-file)))))))