;;
;; test-pmfg-real.scm - Test PMFG kernel with real MI data
;;
;; Uses actual MI values from the corpus to verify GPU PMFG parsing.
;;
(use-modules (opencog) (opencog exec))
(use-modules (opencog sensory) (opencog opencl))
(use-modules (ice-9 format))
(use-modules (srfi srfi-1))
;; Helper: time execution in milliseconds
(define (time-ms thunk)
(let* ((start (get-internal-real-time))
(result (thunk))
(end (get-internal-real-time)))
(values result (inexact->exact (round (* 1000.0 (/ (- end start) internal-time-units-per-second)))))))
(display "\n")
(display "═══════════════════════════════════════════════════════════════════\n")
(display "PMFG Kernel Test with Real MI Data\n")
(display "═══════════════════════════════════════════════════════════════════\n\n")
;; ─────────────────────────────────────────────────────────────────────
;; Step 1: Build word->index mapping for a small vocabulary
;; ─────────────────────────────────────────────────────────────────────
(display "Step 1: Building vocabulary index...\n")
;; Get some common words that have MI values
(define mi-key (Predicate "*-Mutual Info Key-*"))
(define (has-mi? atom) (cog-value atom mi-key))
;; Get first 500 edges with MI
(define edges-with-mi
(take (filter has-mi? (cog-get-atoms 'EdgeLink)) 500))
(format #t " Found ~a edges with MI values~%" (length edges-with-mi))
;; Extract unique words
(define (get-words edge)
(let ((lst (cog-outgoing-atom edge 1)))
(list (cog-outgoing-atom lst 0) (cog-outgoing-atom lst 1))))
(define all-words
(delete-duplicates
(apply append (map get-words edges-with-mi))))
(define vocab-size (length all-words))
(format #t " Vocabulary size: ~a words~%~%" vocab-size)
;; Create word->index mapping
(define word-to-idx (make-hash-table vocab-size))
(define idx-to-word (make-vector vocab-size))
(do ((i 0 (+ i 1))
(words all-words (cdr words)))
((null? words))
(hash-set! word-to-idx (car words) i)
(vector-set! idx-to-word i (car words)))
;; Show some words
(display " Sample words:\n")
(do ((i 0 (+ i 1))) ((= i (min 10 vocab-size)))
(format #t " [~a] ~a~%" i (cog-name (vector-ref idx-to-word i))))
;; ─────────────────────────────────────────────────────────────────────
;; Step 2: Build MI matrix for vocabulary
;; ─────────────────────────────────────────────────────────────────────
(display "\nStep 2: Building MI matrix...\n")
;; Initialize with zeros
(define mi-matrix (make-vector (* vocab-size vocab-size) 0.0))
;; Fill in MI values from edges
(define (fill-mi! edge)
(let* ((lst (cog-outgoing-atom edge 1))
(w1 (cog-outgoing-atom lst 0))
(w2 (cog-outgoing-atom lst 1))
(idx1 (hash-ref word-to-idx w1))
(idx2 (hash-ref word-to-idx w2))
(mi-val (cog-value edge mi-key)))
(when (and idx1 idx2 mi-val)
(let ((mi (cog-value-ref mi-val 1))) ; MI is second value
(vector-set! mi-matrix (+ (* idx1 vocab-size) idx2) mi)
(vector-set! mi-matrix (+ (* idx2 vocab-size) idx1) mi)))))
(for-each fill-mi! edges-with-mi)
(display " MI matrix filled\n")
;; Show some MI values
(display " Sample MI values:\n")
(do ((i 0 (+ i 1))) ((= i (min 5 (length edges-with-mi))))
(let* ((edge (list-ref edges-with-mi i))
(lst (cog-outgoing-atom edge 1))
(w1 (cog-name (cog-outgoing-atom lst 0)))
(w2 (cog-name (cog-outgoing-atom lst 1)))
(mi (cog-value-ref (cog-value edge mi-key) 1)))
(format #t " ~a -- ~a: MI = ~,4f~%" w1 w2 mi)))
;; ─────────────────────────────────────────────────────────────────────
;; Step 3: Create test sentence
;; ─────────────────────────────────────────────────────────────────────
(display "\nStep 3: Creating test sentence...\n")
;; Pick first 5 words that have high MI with each other
(define test-words (take (vector->list idx-to-word) (min 7 vocab-size)))
(define test-indices (map (lambda (w) (hash-ref word-to-idx w)) test-words))
(display " Test sentence: ")
(for-each (lambda (w) (format #t "~a " (cog-name w))) test-words)
(newline)
(format #t " Word indices: ~a~%~%" test-indices)
;; ─────────────────────────────────────────────────────────────────────
;; Step 4: GPU PMFG
;; ─────────────────────────────────────────────────────────────────────
(display "Step 4: Running GPU PMFG kernel...\n")
(define *kernel-path* "/storage/projects/code/hypercore-kb/opencog-kb/language-learning/mvp/pmfg-kernel.cl")
;; Open GPU
(define gpu-node (OpenclNode (string-append "opencl://:" *kernel-path*)))
(cog-execute! (SetValue gpu-node (Predicate "*-open-*") (Type 'FloatValue)))
;; Prepare data as Number atoms (will be converted to OpenclFloatValue)
(define mi-matrix-num (apply Number (vector->list mi-matrix)))
(define sentence-num (apply Number (map exact->inexact test-indices)))
(define n-words-num (Number (length test-words)))
(define vocab-size-num (Number vocab-size))
(define edges-out-num (Number 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
(define n-edges-num (Number 0))
;; Run PMFG kernel
(define gpu-result #f)
(call-with-values
(lambda ()
(time-ms (lambda ()
(cog-execute!
(SetValue gpu-node (Predicate "*-write-*")
(Section (Item "pmfg_single")
(ConnectorSeq
mi-matrix-num
sentence-num
n-words-num
vocab-size-num
edges-out-num
n-edges-num))))
(set! gpu-result (cog-execute! (ValueOf gpu-node (Predicate "*-read-*")))))))
(lambda (result ms)
(format #t " GPU PMFG execution time: ~a ms~%" ms)))
(format #t " GPU result: ~a~%~%" gpu-result)
;; ─────────────────────────────────────────────────────────────────────
;; Step 5: CPU PMFG for comparison
;; ─────────────────────────────────────────────────────────────────────
(display "Step 5: Running CPU PMFG for comparison...\n")
;; Simple CPU PMFG implementation
(define (edges-cross? i j k l)
;; Normalize
(when (> i j) (let ((t i)) (set! i j) (set! j t)))
(when (> k l) (let ((t k)) (set! k l) (set! l t)))
;; Check crossing
(or (and (< i k) (< k j) (< j l))
(and (< k i) (< i l) (< l j))))
(define (cpu-pmfg word-indices mi-matrix vocab-size)
(let* ((n (length word-indices))
(indices (list->vector word-indices))
;; Get all pairs with MI
(pairs '()))
;; Collect pairs
(do ((i 0 (+ i 1))) ((= i n))
(do ((j (+ i 1) (+ j 1))) ((= j n))
(let* ((w1 (vector-ref indices i))
(w2 (vector-ref indices j))
(mi (vector-ref mi-matrix (+ (* w1 vocab-size) w2))))
(set! pairs (cons (list mi i j) pairs)))))
;; Sort by MI descending
(set! pairs (sort pairs (lambda (a b) (> (car a) (car b)))))
;; Greedy selection
(let ((pmfg-edges '())
(max-edges (- (* 3 n) 6)))
(for-each
(lambda (pair)
(when (< (length pmfg-edges) max-edges)
(let ((pos1 (cadr pair))
(pos2 (caddr pair))
(crosses #f))
;; Check crossings
(for-each
(lambda (edge)
(when (edges-cross? pos1 pos2 (car edge) (cadr edge))
(set! crosses #t)))
pmfg-edges)
(unless crosses
(set! pmfg-edges (cons (list pos1 pos2) pmfg-edges))))))
pairs)
(reverse pmfg-edges))))
(define cpu-result #f)
(call-with-values
(lambda ()
(time-ms (lambda ()
(set! cpu-result (cpu-pmfg test-indices mi-matrix vocab-size)))))
(lambda (result ms)
(format #t " CPU PMFG execution time: ~a ms~%" ms)))
(format #t " CPU PMFG edges: ~a~%~%" cpu-result)
;; ─────────────────────────────────────────────────────────────────────
;; Summary
;; ─────────────────────────────────────────────────────────────────────
(display "═══════════════════════════════════════════════════════════════════\n")
(display "RESULTS\n")
(display "═══════════════════════════════════════════════════════════════════\n\n")
(display "Test sentence words:\n")
(do ((i 0 (+ i 1))) ((= i (length test-words)))
(format #t " [~a] ~a~%" i (cog-name (list-ref test-words i))))
(display "\nPMFG edges (word positions):\n")
(display " CPU: ") (display cpu-result) (newline)
(display " GPU: ") (display gpu-result) (newline)
(newline)