;;
;; run-experiments.scm — Compartmentalization Experiment Runner
;;
;; Usage: Load into running CogServer (after bootstrap!):
;; (load "experiments/run-experiments.scm")
;;
;; Phase 1 — Feasibility:
;; (run-exp1) ;; Size vs performance
;; (run-exp2) ;; Domain-specific vs global MI
;; (run-exp3) ;; Statistics mergeability
;; (run-exp4) ;; Domain-specific clustering
;; (run-exp5) ;; Cross-domain structure (needs exp4 loaded first)
;;
;; Phase 2 — Proof-of-Concept:
;; (run-exp6) ;; Swap-globals compartment isolation
;; (run-exp7) ;; Multi-compartment merge quality
;; (run-exp8) ;; Freeze/thaw efficiency
;; (run-exp9) ;; Class alignment via connector-cosine (needs exp7 first)
;; (run-exp10) ;; Surprise-based attention allocation
;;
;; (experiment-report) ;; Summary of all results (Phase 1 + 2)
;; (run-all-experiments) ;; Run all 10 in sequence
;; (run-phase2-experiments) ;; Run only Phase 2 (exp6-10)
;;
;; Prerequisites:
;; - CogServer running with data loaded
;; - (bootstrap!) completed (populates *mi-cache*, *left-marginals*, etc.)
;;
;; Load all experiment scripts
(let ((exp-dir (string-append *mvp-dir* "/experiments/")))
(for-each
(lambda (file)
(format #t "Loading ~a...~%" file)
(load (string-append exp-dir file)))
(list "exp1-size-performance.scm"
"exp2-domain-mi.scm"
"exp3-merge-stats.scm"
"exp4-domain-clustering.scm"
"exp5-cross-domain.scm"
"exp6-swap-isolation.scm"
"exp7-merge-quality.scm"
"exp8-freeze-thaw.scm"
"exp9-class-alignment.scm"
"exp10-attention.scm")))
(define (experiment-report)
"Print summary report of all experiments that have been run."
(format #t "~%")
(format #t "╔══════════════════════════════════════════════════════════╗~%")
(format #t "║ COMPARTMENTALIZATION EXPERIMENT REPORT ║~%")
(format #t "╚══════════════════════════════════════════════════════════╝~%~%")
(format #t "┌──────────────────────────────────────────────────────────┐~%")
(format #t "│ PHASE 1: Feasibility (5 experiments) │~%")
(format #t "└──────────────────────────────────────────────────────────┘~%~%")
;; Exp 1
(format #t "┌─ Experiment 1: Size vs Performance ─────────────────────┐~%")
(if (null? *exp1-results*)
(format #t "│ NOT RUN — call (run-exp1) │~%")
(begin
(format #t "│ ~a data points collected ~%"
(length *exp1-results*))
(when (>= (length *exp1-results*) 2)
(let* ((first (car *exp1-results*))
(last (car (reverse *exp1-results*)))
(size-ratio (/ (list-ref last 0) (list-ref first 0) 1.0))
(iter-ratio (/ (list-ref last 1) (max (list-ref first 1) 0.001)))
(linearity (/ iter-ratio size-ratio)))
(format #t "│ Scale: ~ax size → ~,1fx iterate time (linearity: ~,2f)~%"
(inexact->exact (round size-ratio)) iter-ratio linearity)
(format #t "│ VERDICT: ~a~%"
(if (and (> linearity 0.5) (< linearity 2.0))
"CONFIRMED — linear scaling" "MIXED/REJECTED"))))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; Exp 2
(format #t "┌─ Experiment 2: Domain-Specific MI ──────────────────────┐~%")
(if (null? *exp2-results*)
(format #t "│ NOT RUN — call (run-exp2) │~%")
(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 (if (> total-compared 0) (* 100.0 (/ total-higher total-compared)) 0)))
(format #t "│ ~a books analyzed ~%"
(length *exp2-results*))
(format #t "│ ~,1f% of pairs have higher domain MI ~%" pct)
(format #t "│ VERDICT: ~a~%"
(if (> pct 40) "CONFIRMED — domain MI is distinct"
"MIXED/REJECTED — domain MI similar to global"))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; Exp 3
(format #t "┌─ Experiment 3: Statistics Mergeability ──────────────────┐~%")
(if (null? *exp3-results*)
(format #t "│ NOT RUN — call (run-exp3) │~%")
(let ((max-error (list-ref *exp3-results* 1))
(n-compared (list-ref *exp3-results* 0)))
(format #t "│ ~a pairs compared ~%"
n-compared)
(format #t "│ Max error: ~,8f ~%" max-error)
(format #t "│ VERDICT: ~a~%"
(if (< max-error 0.001) "CONFIRMED — stats are perfectly mergeable"
(if (< max-error 0.01) "CONFIRMED — tiny numerical noise"
"REJECTED — significant divergence")))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; Exp 4
(format #t "┌─ Experiment 4: Domain-Specific Clustering ──────────────┐~%")
(if (null? *exp4-results*)
(format #t "│ NOT RUN — call (run-exp4) │~%")
(let ((n-domain (list-ref *exp4-results* 1))
(avg-d (list-ref *exp4-results* 3))
(avg-g (list-ref *exp4-results* 4)))
(format #t "│ Domain classes: ~a, avg cosine: ~,3f ~%"
n-domain avg-d)
(format #t "│ Global avg cosine: ~,3f ~%" avg-g)
(format #t "│ VERDICT: ~a~%"
(if (> avg-d avg-g) "CONFIRMED — domain classes are tighter"
"MIXED/REJECTED — global classes comparable"))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; Exp 5
(format #t "┌─ Experiment 5: Cross-Domain Structure ──────────────────┐~%")
(if (null? *exp5-results*)
(format #t "│ NOT RUN — call (run-exp5) │~%")
(let ((shared (list-ref *exp5-results* 0))
(polysemy (list-ref *exp5-results* 1))
(shared-role (list-ref *exp5-results* 2)))
(format #t "│ Shared words: ~a ~%" shared)
(format #t "│ Polysemy candidates: ~a ~%" polysemy)
(format #t "│ Shared-role words: ~a ~%" shared-role)
(format #t "│ VERDICT: ~a~%"
(if (> polysemy 5) "CONFIRMED — cross-domain reveals polysemy"
"MIXED/REJECTED — words cluster identically"))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; ── Phase 2 ──
(format #t "┌──────────────────────────────────────────────────────────┐~%")
(format #t "│ PHASE 2: Proof-of-Concept (5 experiments) │~%")
(format #t "└──────────────────────────────────────────────────────────┘~%~%")
;; Exp 6
(format #t "┌─ Experiment 6: Swap-Globals Isolation ──────────────────┐~%")
(if (null? *exp6-results*)
(format #t "│ NOT RUN — call (run-exp6) │~%")
(let ((leaks (list-ref *exp6-results* 1))
(shared (list-ref *exp6-results* 2))
(restored (list-ref *exp6-results* 3)))
(format #t "│ Leaks: ~a, Shared vocabulary: ~a (expected) ~%" leaks shared)
(format #t "│ Globals restored: ~a ~%"
(if restored "YES" "NO"))
(format #t "│ VERDICT: ~a~%"
(if (list-ref *exp6-results* 4) "CONFIRMED — zero leaks, perfect isolation"
"REJECTED — isolation broken"))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; Exp 7
(format #t "┌─ Experiment 7: Merge Quality ───────────────────────────┐~%")
(if (null? *exp7-results*)
(format #t "│ NOT RUN — call (run-exp7) │~%")
(let ((merged-n (list-ref *exp7-results* 0))
(mono-n (list-ref *exp7-results* 1))
(cos-ratio (list-ref *exp7-results* 5)))
(format #t "│ Merged: ~a classes, Monolithic: ~a classes ~%" merged-n mono-n)
(format #t "│ Cosine quality ratio: ~,2f ~%" cos-ratio)
(format #t "│ VERDICT: ~a~%"
(if (list-ref *exp7-results* 7) "CONFIRMED — merged ≈ monolithic"
"REJECTED — merge degrades quality"))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; Exp 8
(format #t "┌─ Experiment 8: Freeze/Thaw Efficiency ──────────────────┐~%")
(if (null? *exp8-results*)
(format #t "│ NOT RUN — call (run-exp8) │~%")
(let ((thaw-frac (list-ref *exp8-results* 4))
(speedup (list-ref *exp8-results* 5)))
(format #t "│ Thaw time: ~,1f% of scratch ~%"
(* 100.0 thaw-frac))
(format #t "│ Speedup: ~,1fx ~%" speedup)
(format #t "│ VERDICT: ~a~%"
(if (list-ref *exp8-results* 12) "CONFIRMED — thaw < 50% scratch time"
"REJECTED — thaw not significantly faster"))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; Exp 9
(format #t "┌─ Experiment 9: Class Alignment (Connector-Cosine) ──────┐~%")
(if (null? *exp9-results*)
(format #t "│ NOT RUN — call (run-exp9) │~%")
(let ((alignments (list-ref *exp9-results* 0))
(polysemy (list-ref *exp9-results* 1)))
(format #t "│ Aligned class pairs: ~a ~%" alignments)
(format #t "│ Polysemy candidates: ~a ~%" polysemy)
(format #t "│ VERDICT: ~a~%"
(if (list-ref *exp9-results* 4) "CONFIRMED — alignment + polysemy found"
"REJECTED — insufficient cross-domain signal"))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; Exp 10
(format #t "┌─ Experiment 10: Attention Allocation ───────────────────┐~%")
(if (null? *exp10-results*)
(format #t "│ NOT RUN — call (run-exp10) │~%")
(let ((s-a (list-ref *exp10-results* 0))
(s-b (list-ref *exp10-results* 1))
(improvement (* 100.0 (list-ref *exp10-results* 4))))
(format #t "│ Round-robin surprise: ~,3f ~%" s-a)
(format #t "│ Surprise-weighted surprise: ~,3f ~%" s-b)
(format #t "│ Improvement: ~,1f% ~%" improvement)
(format #t "│ VERDICT: ~a~%"
(if (list-ref *exp10-results* 7) "CONFIRMED — surprise-weighted wins"
"REJECTED — round-robin equally effective"))))
(format #t "└─────────────────────────────────────────────────────────┘~%~%")
;; ── Decision Matrix ──
(format #t "┌─ DECISION MATRIX ──────────────────────────────────────┐~%")
(let ((e1-ok (and (not (null? *exp1-results*)) (>= (length *exp1-results*) 2)
(let* ((first (car *exp1-results*))
(last (car (reverse *exp1-results*)))
(r (/ (/ (list-ref last 1) (max (list-ref first 1) 0.001))
(/ (list-ref last 0) (list-ref first 0) 1.0))))
(and (> r 0.5) (< r 2.0)))))
(e2-ok (and (not (null? *exp2-results*))
(> (apply + (map (lambda (r) (list-ref r 3)) *exp2-results*))
(* 0.4 (apply + (map (lambda (r) (list-ref r 5)) *exp2-results*))))))
(e3-ok (and (not (null? *exp3-results*)) (< (list-ref *exp3-results* 1) 0.01)))
(e4-ok (and (not (null? *exp4-results*))
(> (list-ref *exp4-results* 3) (list-ref *exp4-results* 4))))
(e5-ok (and (not (null? *exp5-results*)) (> (list-ref *exp5-results* 1) 5)))
(e6-ok (and (not (null? *exp6-results*)) (list-ref *exp6-results* 4)))
(e7-ok (and (not (null? *exp7-results*)) (list-ref *exp7-results* 7)))
(e8-ok (and (not (null? *exp8-results*)) (list-ref *exp8-results* 12)))
(e9-ok (and (not (null? *exp9-results*)) (list-ref *exp9-results* 4)))
(e10-ok (and (not (null? *exp10-results*)) (list-ref *exp10-results* 7))))
(format #t "│ │~%")
(format #t "│ Phase 1 — Feasibility: │~%")
(format #t "│ Exp 1 (scaling): ~a~%"
(if (null? *exp1-results*) "NOT RUN" (if e1-ok "PASS ✓" "FAIL ✗")))
(format #t "│ Exp 2 (domain MI): ~a~%"
(if (null? *exp2-results*) "NOT RUN" (if e2-ok "PASS ✓" "FAIL ✗")))
(format #t "│ Exp 3 (merge): ~a~%"
(if (null? *exp3-results*) "NOT RUN" (if e3-ok "PASS ✓" "FAIL ✗")))
(format #t "│ Exp 4 (clustering): ~a~%"
(if (null? *exp4-results*) "NOT RUN" (if e4-ok "PASS ✓" "FAIL ✗")))
(format #t "│ Exp 5 (polysemy): ~a~%"
(if (null? *exp5-results*) "NOT RUN" (if e5-ok "PASS ✓" "FAIL ✗")))
(format #t "│ │~%")
(format #t "│ Phase 2 — Proof-of-Concept: │~%")
(format #t "│ Exp 6 (isolation): ~a~%"
(if (null? *exp6-results*) "NOT RUN" (if e6-ok "PASS ✓" "FAIL ✗")))
(format #t "│ Exp 7 (merge qual): ~a~%"
(if (null? *exp7-results*) "NOT RUN" (if e7-ok "PASS ✓" "FAIL ✗")))
(format #t "│ Exp 8 (freeze/thaw): ~a~%"
(if (null? *exp8-results*) "NOT RUN" (if e8-ok "PASS ✓" "FAIL ✗")))
(format #t "│ Exp 9 (alignment): ~a~%"
(if (null? *exp9-results*) "NOT RUN" (if e9-ok "PASS ✓" "FAIL ✗")))
(format #t "│ Exp 10 (attention): ~a~%"
(if (null? *exp10-results*) "NOT RUN" (if e10-ok "PASS ✓" "FAIL ✗")))
(let* ((all-results (list *exp1-results* *exp2-results* *exp3-results*
*exp4-results* *exp5-results* *exp6-results*
*exp7-results* *exp8-results* *exp9-results*
*exp10-results*))
(n-run (length (filter (lambda (r) (not (null? r))) all-results)))
(n-pass (length (filter identity
(list e1-ok e2-ok e3-ok e4-ok e5-ok
e6-ok e7-ok e8-ok e9-ok e10-ok)))))
(format #t "│ │~%")
(format #t "│ ~a/~a experiments run, ~a/~a passed ~%"
n-run 10 n-pass n-run)
(format #t "│ │~%")
(format #t "│ RECOMMENDATION: ~a~%"
(cond
;; Phase 2 all pass → full green light
((and e6-ok e7-ok e8-ok e9-ok e10-ok)
"ALL PHASE 2 PASSED → Proceed to compartment.scm")
;; Core passes (6+7) → architecture works
((and e6-ok e7-ok)
"Core architecture works → Proceed (coordination optional)")
;; Exp 6 fails → fundamental problem
((and (not (null? *exp6-results*)) (not e6-ok))
"BLOCKED: Swap isolation broken — need different architecture")
;; Exp 7 fails → merge degrades
((and (not (null? *exp7-results*)) (not e7-ok))
"CAUTION: Merge degrades quality — consider shared AtomSpace")
;; Not enough run
((< n-run 7)
"Run more experiments before deciding")
(else "MIXED results — implement compartments for proven benefits only")))))
(format #t "└─────────────────────────────────────────────────────────┘~%"))
(define (run-all-experiments)
"Run all 10 experiments in sequence."
(run-exp1)
(run-exp2)
(run-exp3)
(run-exp4)
(run-exp5)
(run-exp6)
(run-exp7)
(run-exp8)
(run-exp9)
(run-exp10)
(experiment-report))
(define (run-phase2-experiments)
"Run Phase 2 experiments (exp6-10) only."
(run-exp6)
(run-exp7)
(run-exp8)
(run-exp9)
(run-exp10)
(experiment-report))
;; Ready message
(format #t "~%═══ Compartmentalization Experiments Loaded ═══~%")
(format #t "~%Phase 1 — Feasibility:~%")
(format #t " (run-exp1) Size vs performance curve~%")
(format #t " (run-exp2) Domain-specific vs global MI~%")
(format #t " (run-exp3) Statistics mergeability proof~%")
(format #t " (run-exp4) Domain-specific clustering~%")
(format #t " (run-exp5) Cross-domain structure discovery~%")
(format #t "~%Phase 2 — Proof-of-Concept:~%")
(format #t " (run-exp6) Swap-globals compartment isolation~%")
(format #t " (run-exp7) Multi-compartment merge quality~%")
(format #t " (run-exp8) Freeze/thaw efficiency~%")
(format #t " (run-exp9) Class alignment via connector-cosine~%")
(format #t " (run-exp10) Surprise-based attention allocation~%")
(format #t "~%Control:~%")
(format #t " (run-all-experiments) Run all 10 in sequence~%")
(format #t " (run-phase2-experiments) Run only Phase 2 (exp6-10)~%")
(format #t " (experiment-report) Summary of all results~%")
(format #t "═════════════════════════════════════════════════~%~%")