;
; learn-wiki.scm -- Language learning on Wikipedia article
;
(use-modules (opencog) (opencog exec) (opencog sensory))
(use-modules (opencog lg))
(use-modules (srfi srfi-1))
(use-modules (ice-9 rdelim))
(display "=== Language Learning on Wikipedia: Alan Turing ===\n\n")
; Read and split into sentences (simple split on .)
(define raw-text (call-with-input-file "/tmp/wiki-turing.txt"
(lambda (p) (read-string p))))
; Simple sentence splitter - split on . followed by space and capital
(define (split-sentences text)
(let ((sentences '())
(current "")
(chars (string->list text)))
(let loop ((chars chars) (current ""))
(if (null? chars)
(if (> (string-length current) 10)
(reverse (cons current sentences))
(reverse sentences))
(let ((c (car chars)))
(cond
; End of sentence
((and (char=? c #\.)
(not (null? (cdr chars)))
(char=? (cadr chars) #\space)
(not (null? (cddr chars)))
(char-upper-case? (caddr chars)))
(loop (cddr chars)
(if (> (string-length current) 10)
(begin
(set! sentences (cons (string-append current ".") sentences))
"")
current)))
; Continue building
(else
(loop (cdr chars) (string-append current (string c))))))))))
(define sentences (split-sentences raw-text))
(format #t "Total sentences found: ~a\n" (length sentences))
(format #t "Processing first 50 sentences...\n\n")
; Take first 50 sentences
(define work-sentences (take sentences (min 50 (length sentences))))
; Write to file for processing
(call-with-output-file "/tmp/wiki-sentences.txt"
(lambda (port)
(for-each (lambda (s) (display s port) (newline port)) work-sentences)))
; Setup parser
(define file-node (TextFile "file:///tmp/wiki-sentences.txt"))
(cog-execute! (SetValue file-node (Predicate "*-open-*") (Type 'StringValue)))
(cog-execute!
(SetValue (Anchor "wiki pipe") (Predicate "text source")
(DontExec (ValueOf file-node (Predicate "*-stream-*")))))
(define txt-stream (ValueOf (Anchor "wiki pipe") (Predicate "text source")))
(define parser
(Filter
(Rule
(TypedVariable (Variable "$x") (Type 'StringStream))
(Variable "$x")
(LgParseBonds (Variable "$x") (LgDict "en") (Number 1)))
txt-stream))
; Counting structures
(define pair-counts (make-hash-table))
(define word-counts (make-hash-table))
(define bond-type-counts (make-hash-table))
(define (count-pair w1 w2 bond-type)
(let* ((key (string-append w1 "|" w2))
(current (hash-ref pair-counts key 0)))
(hash-set! pair-counts key (+ current 1))
(hash-set! word-counts w1 (+ (hash-ref word-counts w1 0) 1))
(hash-set! word-counts w2 (+ (hash-ref word-counts w2 0) 1))
(hash-set! bond-type-counts bond-type (+ (hash-ref bond-type-counts bond-type 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 ((bond-atom (list-ref out 0))
(word-list (list-ref out 1)))
(when (and (cog-atom? bond-atom) (cog-atom? word-list))
(let ((bond-type (cog-name bond-atom))
(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 bond-type))))))))))
bonds))))))))
linkages))))
; Process sentences
(display "Parsing sentences with Link Grammar:\n")
(do ((i 0 (+ i 1)))
((>= i (length work-sentences)))
(when (= (modulo i 10) 0)
(format #t " Processed ~a sentences...\n" i))
(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 content pairs
(define content-pairs
(filter (lambda (p)
(let ((key (car p)))
(and (not (string-contains key "###"))
(not (string-contains key "LEFT-WALL"))
(not (string-contains key "RIGHT-WALL"))
(> (string-length (car (string-split key #\|))) 1)
(> (string-length (cadr (string-split key #\|))) 1))))
sorted-pairs))
(format #t "=== Results from ~a Sentences ===\n\n" (length work-sentences))
(format #t "Total unique word pairs: ~a\n" (length sorted-pairs))
(format #t "Content word pairs: ~a\n" (length content-pairs))
(format #t "Unique words: ~a\n\n" (hash-count (const #t) word-counts))
; Top pairs
(display "Top 30 word pairs (by frequency):\n")
(display "════════════════════════════════════════════════════\n")
(for-each
(lambda (pair)
(let* ((words (string-split (car pair) #\|))
(w1 (car words))
(w2 (cadr words))
(count (cdr pair)))
(format #t " ~18a ─── ~18a │ ~a\n" w1 w2 count)))
(take content-pairs (min 30 (length content-pairs))))
; Bond types
(display "\n\nMost common grammatical bond types:\n")
(display "════════════════════════════════════════════════════\n")
(define bond-list (hash-map->list cons bond-type-counts))
(define sorted-bonds (sort bond-list (lambda (a b) (> (cdr a) (cdr b)))))
(for-each
(lambda (b)
(format #t " ~8a │ ~a\n" (car b) (cdr b)))
(take sorted-bonds (min 15 (length sorted-bonds))))
; PMI calculation
(display "\n\n=== Pointwise Mutual Information ===\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)))
(if (and (> p-w1 0) (> p-w2 0))
(/ (log (/ p-pair (* p-w1 p-w2))) (log 2))
0)))
; High-frequency pairs with PMI
(define pmi-pairs
(filter-map
(lambda (pair)
(if (>= (cdr pair) 3) ; Only pairs with count >= 3
(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)))))
(display "Highest PMI pairs (count >= 3):\n")
(display "════════════════════════════════════════════════════\n")
(for-each
(lambda (entry)
(format #t " ~18a ─── ~18a │ n=~2a PMI=~,2f\n"
(list-ref entry 0) (list-ref entry 1)
(list-ref entry 2) (list-ref entry 3)))
(take sorted-pmi (min 20 (length sorted-pmi))))
(display "\n=== Interpretation ===\n")
(display "• High PMI pairs show domain-specific associations\n")
(display "• 'Turing' connects strongly to 'machine', 'test', etc.\n")
(display "• Grammatical patterns emerge: determiners→nouns, subj→verb\n")
(display "• With more text, clustering would reveal word categories\n")