;
; benchmark.scm - Compare manual PMI vs matrix module approaches
;
; Tests:
; 1. Bootstrap time (load data + compute)
; 2. Association lookup time (single query)
; 3. Structure discovery time
; 4. Query response time (question answering)
; 5. Memory usage (atom counts)
;
; Usage: guile benchmark.scm
;
(use-modules (opencog))
(use-modules (ice-9 format))
(use-modules (ice-9 rdelim))
(use-modules (srfi srfi-1))
;; ═══════════════════════════════════════════════════════════════════
;; TIMING UTILITY
;; ═══════════════════════════════════════════════════════════════════
(define (time-it label thunk)
"Run thunk, return (elapsed-ms . result)"
(let* ((start (get-internal-real-time))
(result (thunk))
(end (get-internal-real-time))
(elapsed-ms (inexact->exact
(round (* 1000.0
(/ (- end start) internal-time-units-per-second))))))
(display (format #f " ~a: ~a ms\n" label elapsed-ms))
(cons elapsed-ms result)))
;; ═══════════════════════════════════════════════════════════════════
;; LOAD KNOWLEDGE (shared)
;; ═══════════════════════════════════════════════════════════════════
(define (load-knowledge-into filename process-fn)
(let ((port (open-input-file filename))
(count 0))
(let loop ((line (read-line port)))
(if (eof-object? line)
(begin (close-port port) count)
(begin
(let ((trimmed (string-trim-both line)))
(unless (or (string-null? trimmed)
(string-prefix? "#" trimmed))
(process-fn trimmed)
(set! count (+ count 1))))
(loop (read-line port)))))))
;; ═══════════════════════════════════════════════════════════════════
;; BENCHMARK: MANUAL APPROACH
;; ═══════════════════════════════════════════════════════════════════
(define (benchmark-manual)
(display "\n══════════════════════════════════════════════════════\n")
(display " BENCHMARK: Manual PMI (atomspace-learner.scm)\n")
(display "══════════════════════════════════════════════════════\n\n")
;; Fresh AtomSpace
(cog-atomspace-clear)
(primitive-load "atomspace-learner.scm")
(let ((results '()))
;; Test 1: Bootstrap time
(let ((r (time-it "Bootstrap (load data)"
(lambda ()
(load-knowledge-into "data/self-knowledge.txt" process-text-manual!)
(load-knowledge-into "data/anproto-knowledge.txt" process-text-manual!)))))
(set! results (cons (cons 'bootstrap (car r)) results)))
;; Test 2: Structure discovery
(let ((r (time-it "Structure discovery"
(lambda () (discover-all-structures!)))))
(set! results (cons (cons 'discover (car r)) results)))
;; Test 3: Association lookup (5 words, average)
(let ((r (time-it "Assoc lookup (5 words)"
(lambda ()
(for-each
(lambda (w) (get-associations w 10))
'("keypair" "anproto" "grep" "atomspace" "signature"))))))
(set! results (cons (cons 'assoc-5 (car r)) results)))
;; Test 4: Association lookup (single word)
(let ((r (time-it "Assoc lookup (1 word)"
(lambda () (get-associations "keypair" 10)))))
(set! results (cons (cons 'assoc-1 (car r)) results)))
;; Test 5: Question response
(let ((r (time-it "Question response"
(lambda () (respond "what is keypair")))))
(set! results (cons (cons 'response (car r)) results)))
;; Test 6: Learning priorities
(let ((r (time-it "Learning priorities"
(lambda () (get-learning-priorities)))))
(set! results (cons (cons 'priorities (car r)) results)))
;; Memory stats
(display (format #f "\n Memory:\n"))
(display (format #f " ConceptNodes: ~a\n" (length (cog-get-atoms 'ConceptNode #t))))
(display (format #f " EdgeLinks: ~a\n" (length (cog-get-atoms 'EdgeLink #t))))
(display (format #f " EvalLinks: ~a\n" (length (cog-get-atoms 'EvaluationLink #t))))
(display (format #f " Words: ~a\n" (length (get-all-words))))
(reverse results)))
;; ═══════════════════════════════════════════════════════════════════
;; BENCHMARK: MATRIX APPROACH
;; ═══════════════════════════════════════════════════════════════════
(define (benchmark-matrix)
(display "\n══════════════════════════════════════════════════════\n")
(display " BENCHMARK: Matrix MI (atomspace-matrix-learner.scm)\n")
(display "══════════════════════════════════════════════════════\n\n")
;; Fresh AtomSpace
(cog-atomspace-clear)
(primitive-load "atomspace-matrix-learner.scm")
(let ((results '()))
;; Test 1: Bootstrap time (includes batch MI)
(let ((r (time-it "Bootstrap (load data)"
(lambda ()
(load-knowledge-into "data/self-knowledge.txt" process-text-manual!)
(load-knowledge-into "data/anproto-knowledge.txt" process-text-manual!)))))
(set! results (cons (cons 'bootstrap (car r)) results)))
;; Test 2a: Batch MI computation
(let ((r (time-it "Batch MI computation"
(lambda () (recompute-mi!)))))
(set! results (cons (cons 'batch-mi (car r)) results)))
;; Test 2b: Structure discovery
(let ((r (time-it "Structure discovery"
(lambda () (discover-all-structures!)))))
(set! results (cons (cons 'discover (car r)) results)))
;; Test 3: Association lookup (5 words, average) - should be O(1) cached
(let ((r (time-it "Assoc lookup (5 words)"
(lambda ()
(for-each
(lambda (w) (get-associations w 10))
'("keypair" "anproto" "grep" "atomspace" "signature"))))))
(set! results (cons (cons 'assoc-5 (car r)) results)))
;; Test 4: Association lookup (single word) - O(1) cached
(let ((r (time-it "Assoc lookup (1 word)"
(lambda () (get-associations "keypair" 10)))))
(set! results (cons (cons 'assoc-1 (car r)) results)))
;; Test 5: Question response
(let ((r (time-it "Question response"
(lambda () (respond "what is keypair")))))
(set! results (cons (cons 'response (car r)) results)))
;; Test 6: Learning priorities
(let ((r (time-it "Learning priorities"
(lambda () (get-learning-priorities)))))
(set! results (cons (cons 'priorities (car r)) results)))
;; Memory stats
(display (format #f "\n Memory:\n"))
(display (format #f " ConceptNodes: ~a\n" (length (cog-get-atoms 'ConceptNode #t))))
(display (format #f " EdgeLinks: ~a\n" (length (cog-get-atoms 'EdgeLink #t))))
(display (format #f " EvalLinks: ~a\n" (length (cog-get-atoms 'EvaluationLink #t))))
(display (format #f " Words: ~a\n" (length (get-all-words))))
(reverse results)))
;; ═══════════════════════════════════════════════════════════════════
;; COMPARISON
;; ═══════════════════════════════════════════════════════════════════
(define (compare-results manual matrix)
(display "\n══════════════════════════════════════════════════════\n")
(display " COMPARISON: Manual vs Matrix\n")
(display "══════════════════════════════════════════════════════\n\n")
(display (format #f " ~30a ~10a ~10a ~10a\n"
"Test" "Manual" "Matrix" "Ratio"))
(display (format #f " ~30a ~10a ~10a ~10a\n"
"----" "------" "------" "-----"))
;; Find common tests
(for-each
(lambda (m-entry)
(let* ((test-name (car m-entry))
(m-time (cdr m-entry))
(x-entry (assoc test-name matrix)))
(when x-entry
(let* ((x-time (cdr x-entry))
(ratio (if (> x-time 0)
(/ (* 1.0 m-time) x-time)
99.9)))
(display (format #f " ~30a ~8a ms ~8a ms ~,1fx\n"
test-name m-time x-time ratio))))))
manual)
;; Show matrix-only tests
(for-each
(lambda (x-entry)
(unless (assoc (car x-entry) manual)
(display (format #f " ~30a ~10a ~8a ms\n"
(car x-entry) "n/a" (cdr x-entry)))))
matrix))
;; ═══════════════════════════════════════════════════════════════════
;; MAIN
;; ═══════════════════════════════════════════════════════════════════
(display "\n")
(display "════════════════════════════════════════════════════════════\n")
(display " AtomSpace Learner Benchmark\n")
(display " Manual PMI vs (opencog matrix) batch MI\n")
(display "════════════════════════════════════════════════════════════\n")
(let ((manual-results (benchmark-manual))
(matrix-results (benchmark-matrix)))
(compare-results manual-results matrix-results))
(display "\n════════════════════════════════════════════════════════════\n")
(display " END\n")
(display "════════════════════════════════════════════════════════════\n")