;; test-gpu-scale.scm — Scale test: real Gutenberg corpus on GPU AtomSpace
;;
;; Tests the full pipeline at scale:
;; load corpus → count pairs → MI → sections → cosine → classes
;;
;; Run: guile -l test-gpu-scale.scm
(use-modules (ice-9 rdelim)
(ice-9 time)
(ice-9 format)
(srfi srfi-1))
(load "gpu-atomspace.scm")
;; ═══════════════════════════════════════════════════════════════════
;; CORPUS LOADING (same as corpus-learning.scm)
;; ═══════════════════════════════════════════════════════════════════
(define *mvp*
"/storage/projects/code/hypercore-kb/opencog-kb/language-learning/mvp")
(define (clean-sentence line)
(let* ((lower (string-downcase line))
(no-punct (string-map
(lambda (c)
(if (or (char-alphabetic? c) (char-whitespace? c))
c #\space))
lower))
(words (string-split no-punct #\space))
(non-empty (filter (lambda (w) (> (string-length w) 0)) words)))
(if (null? non-empty) #f (string-join non-empty " "))))
(define (load-corpus-file filename)
(let ((sentences '()) (in-content #f))
(catch #t
(lambda ()
(call-with-input-file filename
(lambda (port)
(let loop ()
(let ((line (read-line port)))
(unless (eof-object? line)
(when (string-contains line "*** START") (set! in-content #t))
(when (string-contains line "*** END") (set! in-content #f))
(when in-content
(let ((cleaned (clean-sentence line)))
(when (and cleaned (> (string-length cleaned) 10))
(set! sentences (cons cleaned sentences)))))
(loop)))))))
(lambda (key . args)
(format #t "Error: ~a ~a~%" key args)))
(reverse sentences)))
(define (load-all-corpus)
(let ((all '()))
(for-each
(lambda (file)
(format #t "Loading ~a..." file)
(let ((sents (load-corpus-file (string-append *mvp* "/corpus/" file))))
(format #t " ~a sentences~%" (length sents))
(set! all (append all sents))))
'("alice-in-wonderland.txt" "pride-and-prejudice.txt"
"sherlock-holmes.txt" "great-expectations.txt" "moby-dick.txt"))
;; Sort by length (curriculum learning)
(sort all (lambda (a b) (< (string-length a) (string-length b))))))
;; Simple MST: chain edges (position i → i+1)
(define (chain-edges words)
(let ((n (length words)))
(let loop ((i 0) (edges '()))
(if (>= i (- n 1))
(reverse edges)
(loop (+ i 1) (cons (cons i (+ i 1)) edges))))))
;; ═══════════════════════════════════════════════════════════════════
;; MAIN TEST
;; ═══════════════════════════════════════════════════════════════════
;; Force unbuffered output
(setvbuf (current-output-port) 'line)
(format #t "~%═══ GPU AtomSpace Scale Test ═══~%~%")
;; Load corpus
(define all-sentences (load-all-corpus))
(format #t "~%Total corpus: ~a sentences~%~%" (length all-sentences))
;; Init GPU
(gpu-init!)
(gpu-status)
;; Process in batches
(define batch-size 2000)
(define total-sents (length all-sentences))
(define max-sents (min total-sents 20000)) ;; cap at 20K for first test
(format #t "~%--- Processing ~a sentences in batches of ~a ---~%"
max-sents batch-size)
(let ((t-start (get-internal-real-time)))
(let loop ((offset 0))
(when (< offset max-sents)
(let* ((end (min (+ offset batch-size) max-sents))
(batch (take (drop all-sentences offset) (- end offset)))
(word-lists (map (lambda (s)
(filter (lambda (w) (> (string-length w) 0))
(string-split s #\space)))
batch))
(t0 (get-internal-real-time)))
;; Count pairs
(gpu-process-sentences! word-lists)
(let ((t1 (get-internal-real-time)))
(format #t " Batch ~a-~a: counted in ~,1fs"
offset end (/ (- t1 t0) 1e9)))
;; Extract sections with chain MST edges
(let ((edges (map chain-edges word-lists))
(t2 (get-internal-real-time)))
(gpu-extract-sections! word-lists edges)
(format #t ", sections in ~,1fs~%"
(/ (- (get-internal-real-time) t2) 1e9)))
(loop end))))
(let ((elapsed (/ (- (get-internal-real-time) t-start) 1e9)))
(format #t "~%Total counting + sections: ~,1fs (~,0f sents/s)~%"
elapsed (/ max-sents elapsed))))
(gpu-status)
;; Compute MI
(format #t "~%--- Computing MI ---~%")
(let ((t0 (get-internal-real-time)))
(gpu-compute-mi!)
(format #t "MI computed in ~,1fs~%" (/ (- (get-internal-real-time) t0) 1e9)))
;; Read top pairs
(format #t "~%--- Top 20 pairs by MI ---~%")
(let ((pairs (gpu-read-pairs #:max-pairs 200)))
(format #t "Read ~a pairs~%" (length pairs))
(let ((sorted (sort pairs (lambda (a b) (> (cadddr a) (cadddr b))))))
(for-each
(lambda (p)
(format #t " ~a - ~a count=~,0f MI=~,3f~%"
(car p) (cadr p) (caddr p) (cadddr p)))
(take sorted (min 20 (length sorted))))))
;; Cosine candidates
;; Filter out Roman numeral chapter numbers for readability
(define *roman-numerals*
'("i" "ii" "iii" "iv" "v" "vi" "vii" "viii" "ix" "x"
"xi" "xii" "xiii" "xiv" "xv" "xvi" "xvii" "xviii" "xix" "xx"
"xxi" "xxii" "xxiii" "xxiv" "xxv" "xxvi" "xxvii" "xxviii"
"xxix" "xxx" "xxxi" "xxxii" "xxxiii" "xxxiv" "xxxv" "xxxvi"
"xxxvii" "xxxviii" "xxxix" "xl" "xli" "xlii" "xliii" "xliv"
"xlv" "xlvi" "xlvii" "xlviii" "xlix" "l" "li" "lii" "liii"
"liv" "lv" "lvi" "lvii" "lviii" "lix"))
(define (roman? w) (member w *roman-numerals*))
(format #t "~%--- Computing cosine candidates ---~%")
(let ((t0 (get-internal-real-time)))
(let ((cands (gpu-cosine-candidates #:threshold 0.3 #:max-output 10000)))
(let ((elapsed (/ (- (get-internal-real-time) t0) 1e9)))
(format #t "Got ~a candidates in ~,2fs~%" (length cands) elapsed)
(when (> (length cands) 0)
(let ((interesting
(filter (lambda (c) (and (not (roman? (car c)))
(not (roman? (cadr c)))
(not (string=? (car c) ""))
(not (string=? (cadr c) ""))))
cands)))
(format #t "~%Top 40 cosine pairs (excluding Roman numerals):~%")
(for-each
(lambda (c)
(format #t " ~a - ~a cosine=~,3f~%"
(car c) (cadr c) (caddr c)))
(take interesting (min 40 (length interesting)))))))))
(format #t "~%═══ DONE ═══~%")
(gpu-shutdown!)