;
; learn-bigger.scm -- Language learning with more text
;
(use-modules (opencog) (opencog exec) (opencog sensory))
(use-modules (opencog lg))
(use-modules (srfi srfi-1))
(display "=== Language Learning - Larger Corpus ===\n\n")
; More sample text
(define sample-text "
The cat sat on the mat.
The dog ran in the park.
A cat chased the dog.
The mat was on the floor.
A dog sat on the mat.
The bird flew over the tree.
A fish swam in the pond.
The cat saw the bird.
The dog chased the cat.
A bird sat on the tree.
The fish hid under the rock.
The cat ran from the dog.
A dog saw the fish.
The bird flew to the nest.
The cat slept on the mat.
The dog barked at the cat.
A fish jumped out of water.
The tree stood in the park.
The bird sang in the tree.
A cat climbed up the tree.
")
(call-with-output-file "/tmp/bigger-text.txt"
(lambda (port) (display sample-text port)))
(display "Corpus: 20 sentences about cats, dogs, birds, fish...\n\n")
; Setup
(define file-node (TextFile "file:///tmp/bigger-text.txt"))
(cog-execute! (SetValue file-node (Predicate "*-open-*") (Type 'StringValue)))
(cog-execute!
(SetValue (Anchor "learn pipe") (Predicate "text source")
(DontExec (ValueOf file-node (Predicate "*-stream-*")))))
(define txt-stream (ValueOf (Anchor "learn pipe") (Predicate "text source")))
(define parser
(Filter
(Rule
(TypedVariable (Variable "$x") (Type 'StringStream))
(Variable "$x")
(LgParseBonds (Variable "$x") (LgDict "en") (Number 1)))
txt-stream))
; Count pairs
(define pair-counts (make-hash-table))
(define word-counts (make-hash-table))
(define (count-pair w1 w2)
(let* ((key (string-append w1 "|" w2))
(current (hash-ref pair-counts key 0)))
(hash-set! pair-counts key (+ current 1))
; Also count individual words
(hash-set! word-counts w1 (+ (hash-ref word-counts w1 0) 1))
(hash-set! word-counts w2 (+ (hash-ref word-counts w2 0) 1))))
(define (extract-pairs result)
(when (and result (not (null? result)))
(let ((linkages (cog-value->list result)))
(for-each
(lambda (linkage)
(when (and linkage (not (null? linkage)))
(let ((parts (cog-value->list linkage)))
(when (>= (length parts) 2)
(let ((bonds-val (list-ref parts 1)))
(when bonds-val
(let ((bonds (cog-value->list bonds-val)))
(for-each
(lambda (bond)
(when (cog-atom? bond)
(let ((out (cog-outgoing-set bond)))
(when (>= (length out) 2)
(let ((word-list (list-ref out 1)))
(when (cog-atom? word-list)
(let ((words (cog-outgoing-set word-list)))
(when (= (length words) 2)
(let ((w1 (cog-name (car words)))
(w2 (cog-name (cadr words))))
(count-pair w1 w2))))))))))
bonds))))))))
linkages))))
(display "Parsing 20 sentences...\n")
(do ((i 0 (+ i 1)))
((>= i 20))
(let ((result (cog-execute! parser)))
(extract-pairs result)))
(display "Done!\n\n")
; Results
(define pair-list (hash-map->list cons pair-counts))
(define sorted-pairs
(sort pair-list (lambda (a b) (> (cdr a) (cdr b)))))
; Filter out wall markers
(define content-pairs
(filter (lambda (p)
(let ((key (car p)))
(and (not (string-contains key "###"))
(not (string-contains key ".")))))
sorted-pairs))
(format #t "=== Results ===\n\n")
(format #t "Total unique pairs: ~a\n" (length sorted-pairs))
(format #t "Content pairs (no punctuation): ~a\n\n" (length content-pairs))
(display "Top 25 content word pairs:\n")
(display "─────────────────────────────────────────\n")
(for-each
(lambda (pair)
(let* ((words (string-split (car pair) #\|))
(w1 (car words))
(w2 (cadr words))
(count (cdr pair)))
(format #t " ~12a ── ~12a │ ~a\n" w1 w2 count)))
(take content-pairs (min 25 (length content-pairs))))
; Compute simple MI for top pairs
(display "\n=== Mutual Information (simplified) ===\n\n")
(define total-pairs (apply + (map cdr pair-list)))
(define total-words (apply + (hash-map->list (lambda (k v) v) word-counts)))
(define (compute-pmi w1 w2 pair-count)
(let* ((w1-count (hash-ref word-counts w1 1))
(w2-count (hash-ref word-counts w2 1))
(p-pair (/ pair-count total-pairs))
(p-w1 (/ w1-count total-words))
(p-w2 (/ w2-count total-words))
(pmi (/ (log (/ p-pair (* p-w1 p-w2))) (log 2))))
pmi))
(display "Word pairs with highest PMI (strongest associations):\n")
(display "─────────────────────────────────────────────────────\n")
; Compute PMI for content pairs with count > 1
(define pmi-pairs
(filter-map
(lambda (pair)
(if (> (cdr pair) 1)
(let* ((words (string-split (car pair) #\|))
(w1 (car words))
(w2 (cadr words))
(pmi (compute-pmi w1 w2 (cdr pair))))
(list w1 w2 (cdr pair) pmi))
#f))
content-pairs))
(define sorted-pmi
(sort pmi-pairs (lambda (a b) (> (list-ref a 3) (list-ref b 3)))))
(for-each
(lambda (entry)
(format #t " ~12a ── ~12a │ count=~a PMI=~,2f\n"
(list-ref entry 0) (list-ref entry 1)
(list-ref entry 2) (list-ref entry 3)))
(take sorted-pmi (min 15 (length sorted-pmi))))
(display "\n=== What We Learned ===\n")
(display "• 'the' strongly connects to nouns (cat, dog, bird, tree, mat)\n")
(display "• Verbs connect to their subjects (cat-sat, dog-ran, bird-flew)\n")
(display "• Prepositions form patterns (on-the, in-the, to-the)\n")
(display "• High PMI = statistically significant word associations\n")
(display "\nThis is how Linas' system discovers grammar from raw text!\n")