;
; layer1.scm - Word pair counting and PMI
;
; Layer 1: Count word co-occurrences within sentences.
; Compute PMI (Pointwise Mutual Information) for associations.
;
; AtomSpace representation:
; (Edge (Concept "pair") (List (Concept "fish") (Concept "swim")))
; Count stored as value on the Edge.
;
(use-modules (opencog))
(use-modules (ice-9 format))
(use-modules (srfi srfi-1))
;; ═══════════════════════════════════════════════════════════════════
;; CONFIGURATION
;; ═══════════════════════════════════════════════════════════════════
(define *window-size* 5) ; Co-occurrence window
(define *min-word-length* 2) ; Skip very short words
;; ═══════════════════════════════════════════════════════════════════
;; COUNTERS
;; ═══════════════════════════════════════════════════════════════════
(define *total-words* 0)
(define *total-pairs* 0)
(define (layer1-reset)
(set! *total-words* 0)
(set! *total-pairs* 0))
(define (layer1-word-count)
(length (cog-get-atoms 'ConceptNode #t)))
(define (layer1-pair-count)
(length (cog-get-atoms 'EdgeLink #t)))
(define (layer1-total-observations)
*total-pairs*)
;; ═══════════════════════════════════════════════════════════════════
;; TOKENIZATION
;; ═══════════════════════════════════════════════════════════════════
(define (tokenize text)
"Split text into words, lowercase, filter short words"
(filter
(lambda (w) (> (string-length w) *min-word-length*))
(map string-downcase
(filter (lambda (s) (> (string-length s) 0))
(string-split
(string-filter char-alphabetic-or-space? text)
#\space)))))
(define (char-alphabetic-or-space? c)
(or (char-alphabetic? c) (char=? c #\space)))
;; ═══════════════════════════════════════════════════════════════════
;; ATOMSPACE STORAGE
;; ═══════════════════════════════════════════════════════════════════
(define (get-or-create-word word)
"Get or create word Concept, increment count"
(let ((wnode (cog-new-node 'ConceptNode (string-append "word:" word))))
;; Increment word count
(let ((current (cog-value wnode (Predicate "count"))))
(if current
(cog-set-value! wnode (Predicate "count")
(FloatValue (+ 1 (car (cog-value->list current)))))
(cog-set-value! wnode (Predicate "count")
(FloatValue 1))))
wnode))
(define (get-word-count wnode)
"Get count for a word node"
(let ((val (cog-value wnode (Predicate "count"))))
(if val (car (cog-value->list val)) 0)))
(define (get-or-create-pair word1 word2)
"Get or create word pair Edge, increment count"
(let* ((w1 (cog-new-node 'ConceptNode (string-append "word:" word1)))
(w2 (cog-new-node 'ConceptNode (string-append "word:" word2)))
(bond (cog-new-node 'ConceptNode "pair-bond"))
(pair (cog-new-link 'EdgeLink bond
(cog-new-link 'ListLink w1 w2))))
;; Increment pair count
(let ((current (cog-value pair (Predicate "count"))))
(if current
(cog-set-value! pair (Predicate "count")
(FloatValue (+ 1 (car (cog-value->list current)))))
(cog-set-value! pair (Predicate "count")
(FloatValue 1))))
pair))
(define (get-pair-count pair)
"Get count for a pair Edge"
(let ((val (cog-value pair (Predicate "count"))))
(if val (car (cog-value->list val)) 0)))
(define (find-pair word1 word2)
"Find existing pair, or #f"
(let* ((w1 (cog-node 'ConceptNode (string-append "word:" word1)))
(w2 (cog-node 'ConceptNode (string-append "word:" word2)))
(bond (cog-node 'ConceptNode "pair-bond")))
(if (and w1 w2 bond)
(let ((lst (cog-link 'ListLink w1 w2)))
(if lst
(cog-link 'EdgeLink bond lst)
#f))
#f)))
(define (find-word word)
"Find word node if exists"
(cog-node 'ConceptNode (string-append "word:" word)))
(define (get-all-word-nodes)
"Get all word ConceptNodes"
(filter
(lambda (node)
(string-prefix? "word:" (cog-name node)))
(cog-get-atoms 'ConceptNode #t)))
(define (get-all-words)
"Get all word names (strings)"
(map
(lambda (wnode)
(substring (cog-name wnode) 5)) ; Remove "word:" prefix
(get-all-word-nodes)))
(define (get-all-word-counts)
"Get alist of (word . count) for all words"
(map
(lambda (wnode)
(cons (substring (cog-name wnode) 5) ; Remove "word:" prefix
(get-word-count wnode)))
(get-all-word-nodes)))
(define (get-word-count-by-name word)
"Get count for a word by name string"
(let ((wnode (find-word word)))
(if wnode (get-word-count wnode) 0)))
;; ═══════════════════════════════════════════════════════════════════
;; COUNTING
;; ═══════════════════════════════════════════════════════════════════
(define (layer1-process text)
"Process text: count words and pairs"
(let ((words (tokenize text)))
;; Count individual words
(for-each
(lambda (w)
(get-or-create-word w)
(set! *total-words* (+ 1 *total-words*)))
words)
;; Count pairs within window
(for-each
(lambda (i)
(for-each
(lambda (j)
(when (< j (length words))
(get-or-create-pair (list-ref words i)
(list-ref words j))
(set! *total-pairs* (+ 1 *total-pairs*))))
(iota (min *window-size* (- (length words) i 1)) (+ i 1))))
(iota (max 0 (- (length words) 1))))))
(define (layer1-count-for-text text)
"Return number of pairs that would be/were counted"
(let* ((words (tokenize text))
(n (length words)))
(if (< n 2) 0
;; Pairs within window
(apply + (map (lambda (i)
(min (- n i 1) *window-size*))
(iota (- n 1)))))))
;; ═══════════════════════════════════════════════════════════════════
;; PMI COMPUTATION
;; ═══════════════════════════════════════════════════════════════════
(define (layer1-pmi word1 word2)
"Compute PMI between two words"
(let ((pair (find-pair word1 word2))
(w1 (find-word word1))
(w2 (find-word word2)))
(if (and pair w1 w2 (> *total-pairs* 0) (> *total-words* 0))
(let ((p-joint (/ (get-pair-count pair) *total-pairs*))
(p-w1 (/ (get-word-count w1) *total-words*))
(p-w2 (/ (get-word-count w2) *total-words*)))
(if (and (> p-joint 0) (> p-w1 0) (> p-w2 0))
(/ (log (/ p-joint (* p-w1 p-w2))) (log 2))
0))
0)))
(define (show-pmi word1 word2)
"Show PMI between two words"
(let ((pmi (layer1-pmi word1 word2)))
(format #f "PMI(~a, ~a) = ~,3f" word1 word2 pmi)))
;; ═══════════════════════════════════════════════════════════════════
;; ASSOCIATIONS
;; ═══════════════════════════════════════════════════════════════════
(define (get-all-words)
"Get all word strings from AtomSpace"
(let ((nodes (cog-get-atoms 'ConceptNode #t)))
(filter-map
(lambda (n)
(let ((name (cog-name n)))
(if (string-prefix? "word:" name)
(substring name 5)
#f)))
nodes)))
(define (layer1-associations word n)
"Get top N associations for a word by PMI"
(let ((wnode (find-word word)))
(if (not wnode)
'()
(let* ((all-words (get-all-words))
(other-words (filter (lambda (w) (not (string=? w word)))
all-words))
(scored (map (lambda (w)
(cons (layer1-pmi word w) w))
other-words))
(positive (filter (lambda (p) (> (car p) 0)) scored))
(sorted (sort positive (lambda (a b) (> (car a) (car b))))))
(take sorted (min n (length sorted)))))))
(define (show-associations word)
"Display top associations for a word"
(let ((assocs (layer1-associations word 10)))
(if (null? assocs)
(format #f "No associations found for '~a'" word)
(string-join
(cons (format #f "Top associations for '~a':" word)
(map (lambda (pair)
(format #f " ~,3f ~a" (car pair) (cdr pair)))
assocs))
"\n"))))