OverviewFilesCommitsIssuesDocsReleasesPeers

hypercore-kb / opencog-kb / language-learning / mvp / test-pmfg-anchored.scm

121 lines · scm ref:
;;
;; test-pmfg-anchored.scm - Use anchored OpenclFloatValue for output
;;
;; The atomese-simd example shows using OpenclFloatValue anchored to atoms
;; for proper output handling.
;;

(use-modules (opencog) (opencog exec))
(use-modules (opencog sensory) (opencog opencl))
(use-modules (ice-9 format))

(display "\n=== PMFG with Anchored Output ===\n\n")

;; Build simple 5x5 MI matrix
;; Words: 0="the", 1="cat", 2="sat", 3="on", 4="mat"
;; Expected PMFG: [0-1]the-cat(5.0), [1-2]cat-sat(4.0), [2-3]sat-on(3.0), [3-4]on-mat(2.0)
(define mi-vals
  (list 0.0 5.0 1.0 0.5 0.1
        5.0 0.0 4.0 0.8 0.2
        1.0 4.0 0.0 3.0 0.3
        0.5 0.8 3.0 0.0 2.0
        0.1 0.2 0.3 2.0 0.0))

(display "MI matrix (5x5):\n")
(display "  the-cat=5, cat-sat=4, sat-on=3, on-mat=2, the-sat=1\n\n")

;; GPU setup
(define gpu (OpenclNode "opencl://:/storage/projects/code/hypercore-kb/opencog-kb/language-learning/mvp/pmfg-kernel.cl"))

;; Create anchored OpenclFloatValues for output
(define anchor (Anchor "pmfg-output"))

;; Initialize with zeros - OpenclFloatValue allows GPU to write back
(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))

(display "Running PMFG kernel...\n")

;; Run with ValueOf references for outputs
(cog-execute!
  (SetValue gpu (Predicate "*-write-*")
    (Section (Item "pmfg_single")
             (ConnectorSeq
               (apply Number mi-vals)
               (Number 0 1 2 3 4)
               (Number 5)
               (Number 5)
               (ValueOf anchor (Predicate "edges"))
               (ValueOf anchor (Predicate "n-edges"))))))

;; Read GPU result
(cog-execute! (ValueOf gpu (Predicate "*-read-*")))

;; Now read the anchored values - they should contain the computed output
(display "\nReading anchored output values:\n")

(define edges-out (cog-value anchor (Predicate "edges")))
(define nedges-out (cog-value anchor (Predicate "n-edges")))

(format #t "Edges type: ~a~%" (cog-type edges-out))
(format #t "N-edges type: ~a~%~%" (cog-type nedges-out))

;; Execute to get actual values
(define edges-exec (cog-execute! (ValueOf anchor (Predicate "edges"))))
(define nedges-exec (cog-execute! (ValueOf anchor (Predicate "n-edges"))))

(format #t "Edges (executed): ~a~%" edges-exec)
(format #t "N-edges (executed): ~a~%~%" nedges-exec)

;; Try to extract as list
(display "Attempting to extract edge values:\n")
(catch #t
  (lambda ()
    (let* ((n (cog-value-ref nedges-exec 0))
           (n-int (inexact->exact (round n))))
      (format #t "Number of edges: ~a~%" n-int)
      (display "Edge pairs:\n")
      (do ((i 0 (+ i 1))) ((= i n-int))
        (let ((p1 (cog-value-ref edges-exec (* i 2)))
              (p2 (cog-value-ref edges-exec (+ (* i 2) 1))))
          (format #t "  Edge ~a: [~a-~a]~%" i (inexact->exact (round p1)) (inexact->exact (round p2)))))))
  (lambda (key . args)
    (format #t "Error extracting: ~a ~a~%" key args)))

;; Also show CPU result for comparison
(display "\n=== CPU PMFG ===\n")

(define (crosses? a b c d)
  (let ((i (min a b)) (j (max a b))
        (k (min c d)) (l (max c d)))
    (or (and (< i k) (< k j) (< j l))
        (and (< k i) (< i l) (< l j)))))

;; Get pairs sorted by MI
(define pairs '())
(do ((i 0 (+ i 1))) ((= i 5))
  (do ((j (+ i 1) (+ j 1))) ((= j 5))
    (let ((mi (list-ref mi-vals (+ (* i 5) j))))
      (set! pairs (cons (list mi i j) pairs)))))
(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)
      (let ((pos1 (cadr p)) (pos2 (caddr p)) (ok #t))
        (for-each
          (lambda (e) (when (crosses? pos1 pos2 (car e) (cadr e)) (set! ok #f)))
          cpu-edges)
        (when ok (set! cpu-edges (cons (list pos1 pos2) cpu-edges))))))
  pairs)

(display "CPU PMFG edges:\n")
(for-each
  (lambda (e) (format #t "  [~a-~a]~%" (car e) (cadr e)))
  (reverse cpu-edges))
(format #t "Total: ~a edges~%" (length cpu-edges))