;;
;; exp6-swap-isolation.scm — Swap-Globals Compartment Isolation
;;
;; Hypothesis: Multiple compartments can run independently by swapping
;; global hash tables, producing isolated results that don't interfere.
;;
;; Method: Create 3 compartments, swap globals for each, process book
;; sentences, verify no cross-contamination.
;;
(define *exp6-results* '())
;; ─────────────────────────────────────────────────────────────────────
;; MINI-COMPARTMENT RECORD
;; Shared data structure for all Phase 2 experiments.
;; ─────────────────────────────────────────────────────────────────────
(define (make-mini-compartment id name sentences)
"Create a compartment as a simple alist — no CogServer atoms needed."
(list
(cons 'id id)
(cons 'name name)
(cons 'sentences sentences)
(cons 'pair-counts (make-hash-table))
(cons 'left-marg (make-hash-table))
(cons 'right-marg (make-hash-table))
(cons 'total-n 0)
(cons 'mi-cache (make-hash-table))
(cons 'sections (make-hash-table))
(cons 'section-counts (make-hash-table))
(cons 'connector-index (make-hash-table))
(cons 'word-classes (make-hash-table))
(cons 'word-to-class (make-hash-table))
(cons 'level-state 'learning)
(cons 'sentences-processed 0)
(cons 'mean-surprise 10.0)
(cons 'top-pair-score 1.0)
(cons 'entropy-history '())
(cons 'merge-rounds-zero 0)))
(define (comp-ref comp key)
"Get value from compartment alist."
(let ((pair (assq key comp)))
(if pair (cdr pair)
(error (format #f "comp-ref: unknown key ~a" key)))))
(define (comp-set! comp key value)
"Set value in compartment alist (mutates the pair in place)."
(let ((pair (assq key comp)))
(if pair (set-cdr! pair value)
(error (format #f "comp-set!: unknown key ~a" key)))))
;; ─────────────────────────────────────────────────────────────────────
;; GLOBAL STATE SNAPSHOT / SWAP
;; ─────────────────────────────────────────────────────────────────────
(define (snapshot-globals)
"Capture current global state. Returns an alist."
(list
(cons 'mi-cache *mi-cache*)
(cons 'left-marg *left-marginals*)
(cons 'right-marg *right-marginals*)
(cons 'total-n *total-pair-count*)
(cons 'word-classes *word-classes*)
(cons 'word-to-class *word-to-class*)))
(define (restore-globals! snapshot)
"Restore globals from a snapshot."
(set! *mi-cache* (assoc-ref snapshot 'mi-cache))
(set! *left-marginals* (assoc-ref snapshot 'left-marg))
(set! *right-marginals* (assoc-ref snapshot 'right-marg))
(set! *total-pair-count* (assoc-ref snapshot 'total-n))
(set! *word-classes* (assoc-ref snapshot 'word-classes))
(set! *word-to-class* (assoc-ref snapshot 'word-to-class)))
(define (swap-in-compartment! comp)
"Install compartment's hash tables as the active globals."
(set! *mi-cache* (comp-ref comp 'mi-cache))
(set! *left-marginals* (comp-ref comp 'left-marg))
(set! *right-marginals* (comp-ref comp 'right-marg))
(set! *total-pair-count* (comp-ref comp 'total-n)))
(define (swap-out-compartment! comp)
"Save current globals back into the compartment record."
(comp-set! comp 'mi-cache *mi-cache*)
(comp-set! comp 'left-marg *left-marginals*)
(comp-set! comp 'right-marg *right-marginals*)
(comp-set! comp 'total-n *total-pair-count*))
;; ─────────────────────────────────────────────────────────────────────
;; HASH TABLE UTILITIES
;; ─────────────────────────────────────────────────────────────────────
(define (hash-copy ht)
"Create a shallow copy of a hash table."
(let ((new (make-hash-table)))
(hash-for-each (lambda (k v) (hash-set! new k v)) ht)
new))
(define (hash-equal? ht1 ht2)
"Check if two hash tables have identical contents."
(and (= (hash-count (const #t) ht1) (hash-count (const #t) ht2))
(let ((all-match #t))
(hash-for-each
(lambda (k v)
(let ((v2 (hash-ref ht2 k 'MISSING)))
(unless (equal? v v2) (set! all-match #f))))
ht1)
all-match)))
(define (hash-keys-as-words ht)
"Extract unique words from a pair-count hash (keys are (w1 . w2))."
(let ((words (make-hash-table)))
(hash-for-each
(lambda (key _)
(hash-set! words (car key) #t)
(hash-set! words (cdr key) #t))
ht)
(let ((wl '()))
(hash-for-each (lambda (w _) (set! wl (cons w wl))) words)
wl)))
;; ─────────────────────────────────────────────────────────────────────
;; EXPERIMENT RUNNER
;; ─────────────────────────────────────────────────────────────────────
(define (run-exp6)
"Run Experiment 6: Swap-Globals Compartment Isolation."
(format #t "~%══════════════════════════════════════════════════~%")
(format #t " EXPERIMENT 6: Swap-Globals Compartment Isolation~%")
(format #t "══════════════════════════════════════════════════~%~%")
;; Load corpus
(cl-load-all-corpus!)
;; Step 1: Save original globals
(format #t "Step 1: Saving original global state...~%")
(let* ((original-mi (hash-copy *mi-cache*))
(original-left (hash-copy *left-marginals*))
(original-right (hash-copy *right-marginals*))
(original-n *total-pair-count*)
(original-snapshot
(list (cons 'mi-cache original-mi)
(cons 'left-marg original-left)
(cons 'right-marg original-right)
(cons 'total-n original-n)
(cons 'word-classes (hash-copy *word-classes*))
(cons 'word-to-class (hash-copy *word-to-class*))))
(orig-mi-count (hash-count (const #t) original-mi))
(orig-left-count (hash-count (const #t) original-left)))
(format #t " Original: ~a MI pairs, ~a left-marginals, N=~a~%"
orig-mi-count orig-left-count original-n)
;; Step 2: Create 3 compartments with different books
(format #t "~%Step 2: Creating 3 compartments...~%")
(let* ((n-sentences 500)
(window 6)
;; Use alice (0), pride (1), sherlock (2)
(book-indices (list 0 1 2))
(compartments
(map (lambda (book-idx)
(let* ((bname (vector-ref *cl-book-names* book-idx))
(book-sents (filter (lambda (e) (= (car e) book-idx))
*cl-all-sentences*))
(sample (take book-sents (min n-sentences (length book-sents)))))
(format #t " Compartment ~a (~a): ~a sentences~%"
book-idx bname (length sample))
(make-mini-compartment book-idx bname sample)))
book-indices)))
;; Step 3: Process each compartment by swapping globals
(format #t "~%Step 3: Processing compartments with swap-globals...~%")
(for-each
(lambda (comp)
(let ((id (comp-ref comp 'id))
(name (comp-ref comp 'name))
(sents (comp-ref comp 'sentences)))
;; Swap in compartment's empty tables
(swap-in-compartment! comp)
;; Process using exp3's pair counting
(let ((stats (exp3-process-book id sents window)))
;; Save pair-counts for isolation checking
(comp-set! comp 'pair-counts (list-ref stats 0))
;; Install stats into globals
(set! *mi-cache*
(exp3-compute-mi-from-stats
(list-ref stats 0) (list-ref stats 1)
(list-ref stats 2) (list-ref stats 3)))
(set! *left-marginals* (list-ref stats 1))
(set! *right-marginals* (list-ref stats 2))
(set! *total-pair-count* (list-ref stats 3)))
;; Swap out — save globals back into compartment
(swap-out-compartment! comp)
(format #t " Compartment ~a (~a): ~a MI pairs, N=~a~%"
id name
(hash-count (const #t) (comp-ref comp 'mi-cache))
(comp-ref comp 'total-n))))
compartments)
;; Step 4: Verify isolation — no cross-contamination
(format #t "~%Step 4: Verifying isolation...~%")
(let ((leaks 0)
(checks 0))
;; For each compartment, check that its MI pairs only contain
;; words from its own book
(for-each
(lambda (comp)
(let* ((id (comp-ref comp 'id))
(name (comp-ref comp 'name))
(mi (comp-ref comp 'mi-cache))
(own-words (hash-keys-as-words (comp-ref comp 'pair-counts)))
(own-word-set (make-hash-table))
(comp-leaks 0))
(for-each (lambda (w) (hash-set! own-word-set w #t)) own-words)
;; Check each MI pair
(hash-for-each
(lambda (key _)
(set! checks (+ checks 1))
(unless (and (hash-ref own-word-set (car key) #f)
(hash-ref own-word-set (cdr key) #f))
(set! leaks (+ leaks 1))
(set! comp-leaks (+ comp-leaks 1))))
mi)
(format #t " Compartment ~a (~a): ~a pairs checked, ~a leaks~%"
id name (hash-count (const #t) mi) comp-leaks)))
compartments)
;; Cross-compartment check: shared pairs should have INDEPENDENT MI values
;; (Common words like "the", "of" naturally appear in multiple books,
;; so shared pairs are expected. The test is that MI values differ,
;; proving independent computation rather than state leakage.)
(format #t "~%Step 5: Cross-compartment independence check...~%")
(let ((shared-pairs 0)
(mi-identical 0)
(mi-different 0))
(let outer ((rest compartments))
(when (not (null? rest))
(let ((comp-a (car rest)))
(let inner ((others (cdr rest)))
(when (not (null? others))
(let* ((comp-b (car others))
(mi-a (comp-ref comp-a 'mi-cache))
(mi-b (comp-ref comp-b 'mi-cache))
(shared 0)
(identical 0)
(different 0))
(hash-for-each
(lambda (key val-a)
(let ((val-b (hash-ref mi-b key #f)))
(when val-b
(set! shared (+ shared 1))
(set! shared-pairs (+ shared-pairs 1))
;; MI values should differ (independent data = different stats)
(if (< (abs (- val-a val-b)) 0.001)
(begin (set! identical (+ identical 1))
(set! mi-identical (+ mi-identical 1)))
(begin (set! different (+ different 1))
(set! mi-different (+ mi-different 1)))))))
mi-a)
(format #t " ~a vs ~a: ~a shared pairs (~a different MI, ~a identical)~%"
(comp-ref comp-a 'name) (comp-ref comp-b 'name)
shared different identical))
(inner (cdr others)))))
(outer (cdr rest))))
;; Step 6: Restore original globals and verify
(format #t " Total shared: ~a (expected for common words)~%" shared-pairs)
(format #t " MI different: ~a, MI identical: ~a~%" mi-different mi-identical)
(format #t "~%Step 6: Restoring original globals...~%")
(restore-globals! original-snapshot)
(let* ((restored-mi-ok (hash-equal? *mi-cache* original-mi))
(restored-left-ok (hash-equal? *left-marginals* original-left))
(restored-right-ok (hash-equal? *right-marginals* original-right))
(restored-n-ok (= *total-pair-count* original-n))
(all-restored (and restored-mi-ok restored-left-ok
restored-right-ok restored-n-ok)))
(format #t " MI cache restored: ~a (~a entries)~%"
(if restored-mi-ok "YES" "NO")
(hash-count (const #t) *mi-cache*))
(format #t " Left marginals restored: ~a~%"
(if restored-left-ok "YES" "NO"))
(format #t " Right marginals restored: ~a~%"
(if restored-right-ok "YES" "NO"))
(format #t " Total N restored: ~a (was ~a, now ~a)~%"
(if restored-n-ok "YES" "NO") original-n *total-pair-count*)
;; Results
(format #t "~%── RESULTS ──~%")
(format #t " Pairs checked: ~a~%" checks)
(format #t " Leaks (words from wrong book): ~a~%" leaks)
(format #t " Shared vocabulary pairs: ~a (expected)~%" shared-pairs)
(format #t " MI independently computed: ~a different, ~a identical~%"
mi-different mi-identical)
(format #t " Globals restored: ~a~%" (if all-restored "PERFECT" "FAILED"))
;; Pass criteria: zero word leaks + globals restored
;; (Shared pairs from common vocabulary are expected and fine)
(let ((passed (and (= leaks 0) all-restored)))
(format #t "~%VERDICT: ~a~%"
(if passed
"Zero leaks, globals restored, compartments independent (CONFIRMED)"
"ISOLATION FAILURE — swap-globals approach is broken (REJECTED)"))
;; Store results
(set! *exp6-results*
(list checks leaks shared-pairs all-restored passed))
;; Write results
(let ((out-file (string-append *mvp-dir* "/experiments/results/exp6-results.txt")))
(call-with-output-file out-file
(lambda (port)
(format port "# Experiment 6: Swap-Globals Compartment Isolation~%")
(format port "# Date: ~a~%" (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
(format port "#~%")
(format port "sentences_per_compartment: ~a~%" n-sentences)
(format port "compartments: ~a~%" (length compartments))
(format port "pairs_checked: ~a~%" checks)
(format port "leaks: ~a~%" leaks)
(format port "shared_vocabulary_pairs: ~a~%" shared-pairs)
(format port "mi_different: ~a~%" mi-different)
(format port "mi_identical: ~a~%" mi-identical)
(format port "globals_restored: ~a~%" (if all-restored "yes" "no"))
(format port "verdict: ~a~%" (if passed "CONFIRMED" "REJECTED"))
(format port "#~%# Per-compartment stats:~%")
(for-each
(lambda (comp)
(format port "comp_~a: ~a pairs, N=~a~%"
(comp-ref comp 'name)
(hash-count (const #t) (comp-ref comp 'mi-cache))
(comp-ref comp 'total-n)))
compartments)))
(format #t "~%Results written to ~a~%" out-file)))))))))