;;
;; test-pmfg-simple.scm - Simple PMFG test with real MI data
;;
(use-modules (opencog) (opencog exec))
(use-modules (opencog sensory) (opencog opencl))
(use-modules (ice-9 format))
(use-modules (srfi srfi-1))
(display "\n═══════════════════════════════════════════════════════════════════\n")
(display "Simple PMFG Test with Real MI Data\n")
(display "═══════════════════════════════════════════════════════════════════\n\n")
;; ─────────────────────────────────────────────────────────────────────
;; Step 1: Get some edges with MI values
;; ─────────────────────────────────────────────────────────────────────
(define mi-key (Predicate "*-Mutual Info Key-*"))
(define (has-mi? atom) (cog-value atom mi-key))
;; Get edges with MI
(define edges-with-mi
(take (filter has-mi? (cog-get-atoms 'EdgeLink)) 200))
(format #t "Found ~a edges with MI~%~%" (length edges-with-mi))
;; Build word set and mapping
(define word-set (make-hash-table 500))
(define word-list '())
(for-each
(lambda (edge)
(let* ((lst (cog-outgoing-atom edge 1))
(w1 (cog-outgoing-atom lst 0))
(w2 (cog-outgoing-atom lst 1)))
(unless (hash-ref word-set w1)
(hash-set! word-set w1 (length word-list))
(set! word-list (append word-list (list w1))))
(unless (hash-ref word-set w2)
(hash-set! word-set w2 (length word-list))
(set! word-list (append word-list (list w2))))))
edges-with-mi)
(define vocab-size (length word-list))
(format #t "Vocabulary: ~a words~%" vocab-size)
;; Build MI matrix
(define mi-matrix (make-vector (* vocab-size vocab-size) 0.0))
(for-each
(lambda (edge)
(let* ((lst (cog-outgoing-atom edge 1))
(w1 (cog-outgoing-atom lst 0))
(w2 (cog-outgoing-atom lst 1))
(i1 (hash-ref word-set w1))
(i2 (hash-ref word-set w2))
(mi (cog-value-ref (cog-value edge mi-key) 1)))
(vector-set! mi-matrix (+ (* i1 vocab-size) i2) mi)
(vector-set! mi-matrix (+ (* i2 vocab-size) i1) mi)))
edges-with-mi)
(display "MI matrix built\n\n")
;; ─────────────────────────────────────────────────────────────────────
;; Step 2: Create a 5-word test sentence
;; ─────────────────────────────────────────────────────────────────────
(define test-indices '(0 1 2 3 4))
(display "Test sentence (first 5 words):\n")
(for-each
(lambda (i)
(format #t " [~a] ~a~%" i (cog-name (list-ref word-list i))))
test-indices)
;; Show MI values between these words
(display "\nMI values between test words:\n")
(do ((i 0 (+ i 1))) ((= i 5))
(do ((j (+ i 1) (+ j 1))) ((= j 5))
(let ((mi (vector-ref mi-matrix (+ (* i vocab-size) j))))
(when (> mi 0)
(format #t " [~a]-[~a] (~a -- ~a): ~,3f~%"
i j
(cog-name (list-ref word-list i))
(cog-name (list-ref word-list j))
mi)))))
;; ─────────────────────────────────────────────────────────────────────
;; Step 3: GPU PMFG - Use anchors for proper output handling
;; ─────────────────────────────────────────────────────────────────────
(display "\n--- GPU PMFG ---\n")
(define *kernel-path* "/storage/projects/code/hypercore-kb/opencog-kb/language-learning/mvp/pmfg-kernel.cl")
(define gpu-node (OpenclNode (string-append "opencl://:" *kernel-path*)))
;; Set up anchored values for output
(define anchor (Anchor "pmfg-test"))
;; Create OpenclFloatValues for outputs
(cog-set-value! anchor (Predicate "edges")
(OpenclFloatValue 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
(cog-set-value! anchor (Predicate "n-edges")
(OpenclFloatValue 0))
;; Define data sources
(define mi-src (apply Number (vector->list mi-matrix)))
(define words-src (Number 0 1 2 3 4))
(define nwords-src (Number 5))
(define vocab-src (Number vocab-size))
(define edges-loc (ValueOf anchor (Predicate "edges")))
(define nedges-loc (ValueOf anchor (Predicate "n-edges")))
;; Run kernel
(define start-time (get-internal-real-time))
(cog-execute!
(SetValue gpu-node (Predicate "*-write-*")
(Section (Item "pmfg_single")
(ConnectorSeq
mi-src
words-src
nwords-src
vocab-src
edges-loc
nedges-loc))))
(define gpu-raw (cog-execute! (ValueOf gpu-node (Predicate "*-read-*"))))
(define end-time (get-internal-real-time))
(define gpu-ms (inexact->exact (round (* 1000.0 (/ (- end-time start-time) internal-time-units-per-second)))))
(format #t "GPU time: ~a ms~%" gpu-ms)
;; Read back results
(define n-edges-result (cog-execute! nedges-loc))
(define edges-result (cog-execute! edges-loc))
(format #t "Number of edges: ~a~%" n-edges-result)
(format #t "Edge data: ~a~%~%" edges-result)
;; ─────────────────────────────────────────────────────────────────────
;; Step 4: CPU PMFG for comparison
;; ─────────────────────────────────────────────────────────────────────
(display "--- CPU PMFG ---\n")
(define (edges-cross? i j k l)
(let ((a (min i j)) (b (max i j))
(c (min k l)) (d (max k l)))
(or (and (< a c) (< c b) (< b d))
(and (< c a) (< a d) (< d b)))))
(define start-cpu (get-internal-real-time))
;; Get all pairs with MI
(define pairs '())
(do ((i 0 (+ i 1))) ((= i 5))
(do ((j (+ i 1) (+ j 1))) ((= j 5))
(let ((mi (vector-ref mi-matrix (+ (* i vocab-size) j))))
(set! pairs (cons (list mi i j) pairs)))))
;; Sort by MI descending
(set! pairs (sort pairs (lambda (a b) (> (car a) (car b)))))
;; Greedy PMFG
(define cpu-edges '())
(for-each
(lambda (p)
(when (< (length cpu-edges) 9) ; max 3*5-6 = 9
(let ((pos1 (cadr p)) (pos2 (caddr p)) (ok #t))
(for-each
(lambda (e)
(when (edges-cross? pos1 pos2 (car e) (cadr e))
(set! ok #f)))
cpu-edges)
(when ok
(set! cpu-edges (cons (list pos1 pos2) cpu-edges))))))
pairs)
(define end-cpu (get-internal-real-time))
(define cpu-ms (inexact->exact (round (* 1000.0 (/ (- end-cpu start-cpu) internal-time-units-per-second)))))
(format #t "CPU time: ~a ms~%" cpu-ms)
(format #t "CPU edges: ~a~%~%" (reverse cpu-edges))
;; ─────────────────────────────────────────────────────────────────────
;; Summary
;; ─────────────────────────────────────────────────────────────────────
(display "═══════════════════════════════════════════════════════════════════\n")
(display "SUMMARY\n")
(display "═══════════════════════════════════════════════════════════════════\n\n")
(format #t "GPU edges found: ~a~%" n-edges-result)
(format #t "CPU edges found: ~a~%" (length cpu-edges))
(display "\nEdge comparison:\n")
(display " CPU: ") (display (reverse cpu-edges)) (newline)
(display " GPU: ") (display edges-result) (newline)