;
; run-phase1.scm -- MVP Phase 1: Foundation
;
; Streams Gutenberg text, counts word pairs within a sliding window,
; stores counts in AtomSpace backed by RocksDB, logs stats per block.
;
; Usage:
; guile -s run-phase1.scm
;
; The data directory holds the RocksDB store. Delete data/pairs.rdb
; to start fresh.
;
(use-modules (ice-9 textual-ports))
(use-modules (ice-9 regex))
(use-modules (ice-9 format))
(use-modules (ice-9 rdelim))
(use-modules (ice-9 threads))
(use-modules (ice-9 ftw))
(use-modules (srfi srfi-1))
(use-modules (opencog) (opencog exec) (opencog persist) (opencog persist-rocks))
(use-modules (opencog lg)) ; exports Word, Edge, Bond atom types
; ═══════════════════════════════════════════════════════════════════
; CONFIGURATION
; ═══════════════════════════════════════════════════════════════════
(define *corpus-dir* "corpus")
(define *rocks-path* "rocks://data/pairs.rdb")
(define *window-size* 6) ; sliding window for pair counting
(define *block-size* 1000) ; sentences per block
(define *min-word-length* 1) ; minimum word length to count
; ═══════════════════════════════════════════════════════════════════
; ATOMSPACE + ROCKSDB SETUP
; ═══════════════════════════════════════════════════════════════════
(define rsn (RocksStorageNode *rocks-path*))
(cog-open rsn)
(display "AtomSpace + RocksDB: open\n")
; Key for storing counts (same as Linas's convention)
(define *count-key* (Predicate "*-TruthValueKey-*"))
; Thread-safe count increment (simplified from Linas's common.scm)
(define *count-mutex* (make-mutex))
(define (count-inc! atom cnt)
"Increment the count on ATOM by CNT, persist to RocksDB."
(if (not (cog-value atom *count-key*))
(begin
(lock-mutex *count-mutex*)
(if (not (cog-value atom *count-key*))
(fetch-atom atom))
(cog-inc-value! atom *count-key* cnt 2)
(unlock-mutex *count-mutex*)
)
(cog-inc-value! atom *count-key* cnt 2))
(store-atom atom))
(define (get-count atom)
"Get the count stored on ATOM, or 0 if none."
(let ((tv (cog-value atom *count-key*)))
(if tv (cog-value-ref tv 2) 0)))
; ═══════════════════════════════════════════════════════════════════
; TEXT STREAMER
; ═══════════════════════════════════════════════════════════════════
(define (strip-gutenberg-header text)
"Remove Project Gutenberg header/footer boilerplate."
(let* ((start-marker "*** START OF THE PROJECT GUTENBERG EBOOK")
(end-marker "*** END OF THE PROJECT GUTENBERG EBOOK")
(start-pos (string-contains text start-marker))
(end-pos (string-contains text end-marker)))
(if start-pos
(let ((after-header (substring text
(+ start-pos (string-length start-marker)))))
(let ((newline-pos (string-index after-header #\newline)))
(if newline-pos
(let ((body (substring after-header (+ newline-pos 1))))
(if end-pos
(let ((adjusted-end (- end-pos start-pos
(string-length start-marker) newline-pos 1)))
(if (> adjusted-end 0)
(substring body 0 (min adjusted-end (string-length body)))
body))
body))
after-header)))
text)))
(define (text->sentences text)
"Split text into sentences on period, question mark, exclamation.
Simple heuristic: split on [.?!] followed by whitespace or end."
(let* ((cleaned (string-map
(lambda (c) (if (char=? c #\newline) #\space c))
text))
;; Split on sentence-ending punctuation followed by space
(parts (string-split cleaned #\.)))
(filter
(lambda (s) (> (string-length (string-trim-both s)) 3))
(map string-trim-both parts))))
(define (tokenize sentence)
"Split sentence into lowercase words, keeping only alphabetic chars."
(filter
(lambda (w) (>= (string-length w) *min-word-length*))
(map (lambda (w)
(string-downcase
(string-filter char-alphabetic? w)))
(string-split sentence #\space))))
(define (read-corpus-files dir)
"Read all .txt files from DIR, return list of sentences."
(let* ((entries (scandir dir
(lambda (f) (string-suffix? ".txt" f))))
(all-sentences '()))
(for-each
(lambda (filename)
(let* ((path (string-append dir "/" filename))
(text (call-with-input-file path get-string-all))
(body (strip-gutenberg-header text))
(sents (text->sentences body)))
(format #t " ~a: ~a sentences\n" filename (length sents))
(set! all-sentences (append all-sentences sents))))
entries)
all-sentences))
; ═══════════════════════════════════════════════════════════════════
; PAIR COUNTER (sliding window)
; ═══════════════════════════════════════════════════════════════════
(define *total-words* 0)
(define *total-pairs* 0)
(define *total-sentences* 0)
(define (count-pairs-in-sentence sentence)
"Count word pairs within sliding window. Store as Edge atoms."
(let ((words (tokenize sentence)))
(set! *total-words* (+ *total-words* (length words)))
(set! *total-sentences* (+ *total-sentences* 1))
;; Count each word occurrence
(for-each
(lambda (w)
(count-inc! (Word w) 1))
words)
;; Count pairs within window
(let ((n (length words)))
(do ((i 0 (+ i 1)))
((>= i n))
(do ((j (+ i 1) (+ j 1)))
((or (>= j n) (> (- j i) *window-size*)))
(let* ((w1 (list-ref words i))
(w2 (list-ref words j))
(pair (Edge (Bond "ANY")
(List (Word w1) (Word w2)))))
(count-inc! pair 1)
(set! *total-pairs* (+ *total-pairs* 1))))))))
; ═══════════════════════════════════════════════════════════════════
; JSON LOGGER
; ═══════════════════════════════════════════════════════════════════
(define *block-number* 0)
(define *start-time* (car (gettimeofday)))
(define (log-block-stats! block-start-words block-start-pairs)
"Output one JSON line of stats for the current block."
(let* ((elapsed (- (car (gettimeofday)) *start-time*))
(block-words (- *total-words* block-start-words))
(block-pairs (- *total-pairs* block-start-pairs))
(vocab-size (length (cog-get-atoms 'Word)))
(sps (if (> elapsed 0)
(/ *total-sentences* elapsed)
0)))
(format #t "{\"block\":~a,\"words\":~a,\"vocab\":~a,\"pairs\":~a,\"sentences\":~a,\"block_words\":~a,\"block_pairs\":~a,\"elapsed_s\":~a,\"sent_per_s\":~,1f}\n"
*block-number*
*total-words*
vocab-size
*total-pairs*
*total-sentences*
block-words
block-pairs
elapsed
sps)
(force-output)))
; ═══════════════════════════════════════════════════════════════════
; MAIN LOOP
; ═══════════════════════════════════════════════════════════════════
(define (run-phase1)
(display "═══ MVP Phase 1: Foundation ═══\n")
(format #t "Window size: ~a, Block size: ~a sentences\n"
*window-size* *block-size*)
(display "\nLoading corpus...\n")
(let ((sentences (read-corpus-files *corpus-dir*)))
(format #t "\nTotal sentences: ~a\n" (length sentences))
(display "\nProcessing...\n")
;; Process in blocks
(let loop ((remaining sentences))
(if (null? remaining)
(begin
(display "\n═══ Corpus complete ═══\n")
(format #t "Total: ~a words, ~a pairs, ~a vocab\n"
*total-words* *total-pairs*
(length (cog-get-atoms 'Word))))
(let* ((block (take remaining (min *block-size* (length remaining))))
(rest (drop remaining (min *block-size* (length remaining))))
(pre-words *total-words*)
(pre-pairs *total-pairs*))
;; Process each sentence in the block
(for-each count-pairs-in-sentence block)
;; Log stats
(set! *block-number* (+ *block-number* 1))
(log-block-stats! pre-words pre-pairs)
;; Persist periodically (every 5 blocks)
(when (zero? (modulo *block-number* 5))
(barrier rsn))
(loop rest)))))
;; Final save
(barrier rsn)
(display "\nSaving to RocksDB...\n")
(cog-close rsn)
(display "Done.\n"))
(run-phase1)