;;
;; cogserver-init.scm -- CogServer with GPU MI + GPU PMFG
;;
;; Full GPU pipeline: text → pairs → GPU MI → GPU PMFG → Sections
;;
(use-modules (opencog) (opencog exec))
(use-modules (opencog persist) (opencog persist-rocks))
(use-modules (opencog lg))
(use-modules (opencog sensory) (opencog opencl))
(use-modules (srfi srfi-1))
(display "═══ CogServer Language Learning (GPU) ═══\n\n")
;; ═══════════════════════════════════════════════════════════════════
;; STATE
;; ═══════════════════════════════════════════════════════════════════
(define *rsn* #f)
(define *data-loaded* #f)
(define *mi-gpu-node* #f)
(define *pmfg-gpu-node* #f)
(define *gpu-ready* #f)
(define *mi-cache* (make-hash-table))
;; ═══════════════════════════════════════════════════════════════════
;; DATA LOADING
;; ═══════════════════════════════════════════════════════════════════
(define (load-phase1-data!)
"Load Phase 1 word pairs from RocksDB."
(if *data-loaded*
(display "Data already loaded.\n")
(let ((t0 (current-time)))
(display "Opening RocksDB...\n")
(set! *rsn* (RocksStorageNode "rocks://data/pairs.rdb"))
(cog-open *rsn*)
(display "Loading edges (this takes ~2 minutes)...\n")
(load-atoms-of-type 'Edge)
(let ((n-edges (length (cog-get-atoms 'Edge))))
(format #t "Loaded ~a edges in ~a seconds.\n" n-edges (- (current-time) t0)))
(set! *data-loaded* #t)
(display "Data loaded!\n\n"))))
;; ═══════════════════════════════════════════════════════════════════
;; GPU INITIALIZATION
;; ═══════════════════════════════════════════════════════════════════
(define (init-gpu!)
"Initialize both GPU kernels (MI + PMFG)."
(display "Initializing GPU kernels...\n")
(catch #t
(lambda ()
;; MI kernel
(set! *mi-gpu-node* (OpenclNode "opencl://:/tmp/mi-kernel.cl"))
(cog-execute! (SetValue *mi-gpu-node* (Predicate "*-open-*") (Type 'FloatValue)))
(display " MI kernel ready.\n")
;; PMFG kernel
(set! *pmfg-gpu-node* (OpenclNode "opencl://:/tmp/pmfg-kernel.cl"))
(cog-execute! (SetValue *pmfg-gpu-node* (Predicate "*-open-*") (Type 'FloatValue)))
(display " PMFG kernel ready.\n")
(set! *gpu-ready* #t)
(display "GPU initialized!\n\n"))
(lambda (key . args)
(format #t "GPU init failed: ~a ~a\n" key args)
(set! *gpu-ready* #f))))
;; ═══════════════════════════════════════════════════════════════════
;; GPU MI COMPUTATION
;; ═══════════════════════════════════════════════════════════════════
(define (gpu-compute-mi! counts left-margs right-margs total-n)
"Compute MI values on GPU for arrays of pairs.
Returns list of MI values.
counts: list of pair counts
left-margs: list of left marginals
right-margs: list of right marginals
total-n: total count (scalar)
"
(unless *gpu-ready* (error "GPU not initialized. Call (init-gpu!) first."))
(let* ((n-pairs (length counts))
;; Prepare input - replicate N for each pair (atomese-simd needs arrays)
(n-arr (make-list n-pairs (exact->inexact total-n))))
;; Set input buffers
(cog-set-value! (Anchor "mi") (Predicate "counts")
(apply FloatValue (map exact->inexact counts)))
(cog-set-value! (Anchor "mi") (Predicate "left")
(apply FloatValue (map exact->inexact left-margs)))
(cog-set-value! (Anchor "mi") (Predicate "right")
(apply FloatValue (map exact->inexact right-margs)))
(cog-set-value! (Anchor "mi") (Predicate "n")
(apply FloatValue n-arr))
;; Output buffer - use OpenclFloatValue!
(cog-set-value! (Anchor "mi") (Predicate "out")
(apply OpenclFloatValue (make-list n-pairs 0.0)))
;; Run kernel
(cog-execute!
(SetValue *mi-gpu-node* (Predicate "*-write-*")
(Section (Item "compute_mi")
(ConnectorSeq
(ValueOf (Anchor "mi") (Predicate "out"))
(ValueOf (Anchor "mi") (Predicate "counts"))
(ValueOf (Anchor "mi") (Predicate "left"))
(ValueOf (Anchor "mi") (Predicate "right"))
(ValueOf (Anchor "mi") (Predicate "n"))))))
;; Read result
(cog-execute! (ValueOf *mi-gpu-node* (Predicate "*-read-*")))
;; Return MI values
(cog-value->list
(cog-execute! (ValueOf (Anchor "mi") (Predicate "out"))))))
;; ═══════════════════════════════════════════════════════════════════
;; MI LOOKUP (from loaded data)
;; ═══════════════════════════════════════════════════════════════════
(define (get-mi w1 w2)
"Get MI for word pair from loaded data."
(or (hash-ref *mi-cache* (cons w1 w2))
(let ((edge (cog-link 'Edge (Bond "ANY") (List (Word w1) (Word w2)))))
(if edge
(let* ((v (cog-value edge (Predicate "*-Mutual Info Key-*")))
(mi (if v (cog-value-ref v 1) 0.0)))
(hash-set! *mi-cache* (cons w1 w2) mi)
(hash-set! *mi-cache* (cons w2 w1) mi)
mi)
0.0))))
;; ═══════════════════════════════════════════════════════════════════
;; GPU PMFG PARSING
;; ═══════════════════════════════════════════════════════════════════
(define (gpu-pmfg-parse words)
"Parse sentence with GPU PMFG using MI weights."
(unless *gpu-ready* (error "GPU not initialized. Call (init-gpu!) first."))
(let* ((n (length words))
(mi-list (make-list (* n n) 0.0)))
;; Build MI matrix
(do ((i 0 (+ i 1))) ((>= i n))
(do ((j 0 (+ j 1))) ((>= j n))
(list-set! mi-list (+ (* i n) j)
(get-mi (list-ref words i) (list-ref words j)))))
;; Setup GPU buffers
(cog-set-value! (Anchor "pmfg") (Predicate "mi") (apply FloatValue mi-list))
(cog-set-value! (Anchor "pmfg") (Predicate "words") (apply FloatValue (iota n)))
(cog-set-value! (Anchor "pmfg") (Predicate "nw") (FloatValue (exact->inexact n)))
(cog-set-value! (Anchor "pmfg") (Predicate "vs") (FloatValue (exact->inexact n)))
(cog-set-value! (Anchor "pmfg") (Predicate "edges")
(apply OpenclFloatValue (make-list (* 2 (* 3 n)) -1.0)))
(cog-set-value! (Anchor "pmfg") (Predicate "ne") (OpenclFloatValue -1.0))
;; Run kernel
(cog-execute!
(SetValue *pmfg-gpu-node* (Predicate "*-write-*")
(Section (Item "pmfg_single")
(ConnectorSeq
(ValueOf (Anchor "pmfg") (Predicate "mi"))
(ValueOf (Anchor "pmfg") (Predicate "words"))
(ValueOf (Anchor "pmfg") (Predicate "nw"))
(ValueOf (Anchor "pmfg") (Predicate "vs"))
(ValueOf (Anchor "pmfg") (Predicate "edges"))
(ValueOf (Anchor "pmfg") (Predicate "ne"))))))
(cog-execute! (ValueOf *pmfg-gpu-node* (Predicate "*-read-*")))
;; Extract results
(let* ((n-edges (inexact->exact (round (cog-value-ref
(cog-execute! (ValueOf (Anchor "pmfg") (Predicate "ne"))) 0))))
(edge-list (cog-value->list
(cog-execute! (ValueOf (Anchor "pmfg") (Predicate "edges"))))))
(let loop ((i 0) (edges '()))
(if (>= i n-edges) (reverse edges)
(let ((p1 (inexact->exact (round (list-ref edge-list (* i 2)))))
(p2 (inexact->exact (round (list-ref edge-list (+ (* i 2) 1))))))
(loop (+ i 1) (cons (list p1 p2
(get-mi (list-ref words p1)
(list-ref words p2)))
edges))))))))
;; ═══════════════════════════════════════════════════════════════════
;; CPU PMFG (fallback)
;; ═══════════════════════════════════════════════════════════════════
(define (edges-cross? i j k l)
(let ((i (min i j)) (j (max i j))
(k (min k l)) (l (max k l)))
(or (and (< i k) (< k j) (< j l))
(and (< k i) (< i l) (< l j)))))
(define (cpu-pmfg-parse words)
"CPU fallback for PMFG parsing."
(let* ((n (length words))
(word-vec (list->vector words)))
(if (< n 2) '()
(let* ((pairs
(let loop-i ((i 0) (pairs '()))
(if (>= i (- n 1)) pairs
(loop-i (+ i 1)
(let loop-j ((j (+ i 1)) (ps pairs))
(if (>= j n) ps
(loop-j (+ j 1)
(cons (list (get-mi (vector-ref word-vec i)
(vector-ref word-vec j))
i j)
ps))))))))
(sorted-pairs (sort pairs (lambda (a b) (> (car a) (car b))))))
(let loop ((remaining sorted-pairs) (edges '()))
(if (null? remaining) (reverse edges)
(let* ((pair (car remaining))
(mi (car pair)) (pos1 (cadr pair)) (pos2 (caddr pair))
(crosses? (any (lambda (e) (edges-cross? pos1 pos2 (car e) (cadr e))) edges)))
(loop (cdr remaining)
(if crosses? edges (cons (list pos1 pos2 mi) edges))))))))))
;; ═══════════════════════════════════════════════════════════════════
;; UNIFIED PARSE INTERFACE
;; ═══════════════════════════════════════════════════════════════════
(define (parse-sentence words)
"Parse sentence, using GPU if available, CPU otherwise."
(if *gpu-ready*
(gpu-pmfg-parse words)
(cpu-pmfg-parse words)))
(define (parse-and-show sentence-string)
"Parse a sentence and display results."
(let* ((words (string-split sentence-string #\space))
(t0 (get-internal-real-time))
(edges (parse-sentence words))
(elapsed-ms (/ (- (get-internal-real-time) t0) 1000.0)))
(format #t "\nSentence: ~a\n" words)
(format #t "Method: ~a\n" (if *gpu-ready* "GPU PMFG" "CPU PMFG"))
(format #t "PMFG edges (~a) in ~,2f ms:\n" (length edges) elapsed-ms)
(for-each
(lambda (e)
(format #t " ~a -- ~a (MI=~,2f)\n"
(list-ref words (car e))
(list-ref words (cadr e))
(caddr e)))
edges)
(format #t "Total MI: ~,2f\n" (apply + (map caddr edges)))
edges))
;; ═══════════════════════════════════════════════════════════════════
;; BATCH MI COMPUTATION (for new pairs)
;; ═══════════════════════════════════════════════════════════════════
(define (batch-compute-mi-gpu! pairs-data)
"Compute MI for batch of pairs on GPU.
pairs-data: list of (count left-marg right-marg) triples
Returns: list of MI values
"
(let* ((counts (map car pairs-data))
(lefts (map cadr pairs-data))
(rights (map caddr pairs-data))
;; Get total N from AtomSpace
(total-n (let ((edges (cog-get-atoms 'Edge)))
(apply + (map (lambda (e)
(let ((v (cog-value e (Predicate "*-TruthValueKey-*"))))
(if v (cog-value-ref v 2) 0)))
edges)))))
(gpu-compute-mi! counts lefts rights total-n)))
;; ═══════════════════════════════════════════════════════════════════
;; STATUS
;; ═══════════════════════════════════════════════════════════════════
(define (status)
"Show cogserver status."
(format #t "\n═══ CogServer Status ═══\n")
(format #t "Data loaded: ~a\n" *data-loaded*)
(when *data-loaded*
(format #t "Edges: ~a\n" (length (cog-get-atoms 'Edge))))
(format #t "GPU ready: ~a\n" *gpu-ready*)
(when *gpu-ready*
(format #t " MI kernel: ~a\n" (if *mi-gpu-node* "loaded" "none"))
(format #t " PMFG kernel: ~a\n" (if *pmfg-gpu-node* "loaded" "none")))
(format #t "MI cache: ~a entries\n" (hash-count (const #t) *mi-cache*))
(display "════════════════════════\n\n"))
;; ═══════════════════════════════════════════════════════════════════
;; QUICK TEST
;; ═══════════════════════════════════════════════════════════════════
(define (test-gpu-mi)
"Quick test of GPU MI computation."
(unless *gpu-ready* (init-gpu!))
(display "\nTesting GPU MI computation...\n")
;; Test data: count=10, left=100, right=50, N=10000
;; MI = log2(10) + log2(10000) - log2(100) - log2(50)
;; = 3.32 + 13.29 - 6.64 - 5.64 = 4.33
(let ((result (gpu-compute-mi! '(10 20 5) '(100 200 50) '(50 100 25) 10000)))
(format #t "Test pairs: [(10,100,50), (20,200,100), (5,50,25)] N=10000\n")
(format #t "GPU MI results: ~a\n" result)
(format #t "Expected ~4.3 for first pair\n\n")))
;; ═══════════════════════════════════════════════════════════════════
;; USAGE
;; ═══════════════════════════════════════════════════════════════════
(display "
Commands:
(load-phase1-data!) Load 1.24M pairs (~2 min)
(init-gpu!) Initialize GPU MI + PMFG
(status) Show status
(parse-and-show \"w1 w2 w3...\") Parse sentence (GPU/CPU auto)
(get-mi \"word1\" \"word2\") Get MI for pair
(test-gpu-mi) Test GPU MI computation
(gpu-compute-mi! counts lefts rights N) Batch GPU MI
(gpu-pmfg-parse '(\"w1\" ...)) GPU PMFG parse
(cpu-pmfg-parse '(\"w1\" ...)) CPU PMFG parse
")