;
; run-phase2.scm -- MVP Phase 2: NPMI Computation + MST Parsing
;
; Computes NPMI on Phase 1 word-pair counts, then runs MST parsing
; to extract Sections (word + connector-sets).
;
; Usage:
; guile -s run-phase2.scm
;
; Prerequisites:
; - Phase 1 complete (data/pairs.rdb exists with 1.18M pairs)
; - Link Grammar installed with dict-pair support
;
; Architecture: CPU-first using Linas's existing code
;
(use-modules (ice-9 format))
(use-modules (ice-9 textual-ports))
(use-modules (ice-9 ftw))
(use-modules (srfi srfi-1))
(use-modules (opencog) (opencog exec) (opencog persist) (opencog persist-rocks))
(use-modules (opencog lg))
(use-modules (opencog matrix))
; ═══════════════════════════════════════════════════════════════════
; TYPE ALIASES: Map old NLP types to modern AnchorNode
;
; ParseNode and SentenceNode were part of the old opencog-nlp package
; (not installed). The learn module uses them ONLY as counter anchors -
; atoms to attach count Values to. The actual type doesn't matter.
;
; AnchorNode is the modern, semantically correct type for this purpose:
; - Designed for "anchoring" references to data
; - Already used by learn module for "data logger" (see agglo-goe.scm)
; - No C++ type registration needed - just Scheme aliases
;
; Reference: make-parse-pipe docs say "PARSE-CNT an Atom which is
; incremented for each parse" - ANY atom type works.
;
; CRITICAL: We inject into (opencog lg) because that's what pipe-count.scm
; imports. Injecting into guile-user doesn't work - Guile modules only see
; symbols from modules they explicitly import.
; ═══════════════════════════════════════════════════════════════════
(define (ParseNode name) (Anchor (string-append "parse:" name)))
(define (SentenceNode name) (Anchor (string-append "sentence:" name)))
;; Inject into (opencog lg) BEFORE loading (opencog learn)
;; pipe-count.scm does (use-modules (opencog lg)) so it will find these
(module-define! (resolve-module '(opencog lg)) 'ParseNode ParseNode)
(module-define! (resolve-module '(opencog lg)) 'SentenceNode SentenceNode)
;; Now load learn - pipe-count.scm will get ParseNode/SentenceNode from (opencog lg)
(use-modules (opencog learn))
; ═══════════════════════════════════════════════════════════════════
; CONFIGURATION
; ═══════════════════════════════════════════════════════════════════
(define *rocks-path* "rocks://data/pairs.rdb")
(define *corpus-dir* "corpus")
(define *log-file* "data/phase2.log")
; ═══════════════════════════════════════════════════════════════════
; JSON LOGGER (same format as Phase 1)
; ═══════════════════════════════════════════════════════════════════
(define *start-time* (car (gettimeofday)))
(define *log-port* #f)
(define (elapsed-seconds)
(- (car (gettimeofday)) *start-time*))
(define (log-json step . kvpairs)
"Log a JSON line with phase=2, step, elapsed_s, and optional key-value pairs."
(let* ((elapsed (elapsed-seconds))
(base (format #f "{\"phase\":2,\"step\":\"~a\",\"elapsed_s\":~a" step elapsed))
(extra (if (null? kvpairs) ""
(string-join
(map (lambda (kv)
(format #f ",\"~a\":~a" (car kv) (cdr kv)))
kvpairs)
"")))
(line (string-append base extra "}\n")))
(display line)
(when *log-port*
(display line *log-port*)
(force-output *log-port*))
(force-output)))
; ═══════════════════════════════════════════════════════════════════
; TEXT CORPUS READER (reused from Phase 1)
; ═══════════════════════════════════════════════════════════════════
(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 (read-corpus-text dir)
"Read all .txt files from DIR, return concatenated text as blocks."
(let* ((entries (scandir dir
(lambda (f) (string-suffix? ".txt" f))))
(blocks '()))
(for-each
(lambda (filename)
(let* ((path (string-append dir "/" filename))
(text (call-with-input-file path get-string-all))
(body (strip-gutenberg-header text)))
(format #t " ~a: ~a chars\n" filename (string-length body))
(set! blocks (cons body blocks))))
entries)
(reverse blocks)))
; ═══════════════════════════════════════════════════════════════════
; PHASE 2: MAIN PIPELINE
; ═══════════════════════════════════════════════════════════════════
(define (run-phase2)
(display "═══ MVP Phase 2: NPMI Computation + MST Parsing ═══\n\n")
;; Open log file
(set! *log-port* (open-output-file *log-file*))
;; ─────────────────────────────────────────────────────────────────
;; Step 1: Open database and create matrix API
;; ─────────────────────────────────────────────────────────────────
(display "Step 1: Opening database and setting up matrix API...\n")
(log-json "open_db")
(define rsn (RocksStorageNode *rocks-path*))
(cog-open rsn)
(display " Database opened.\n")
;; Create the pair matrix API (same structure as Phase 1)
;; make-any-link-api creates an API for:
;; EdgeLink (BondNode "ANY") (ListLink (WordNode w1) (WordNode w2))
(define ala (make-any-link-api))
(define aca (add-count-api ala))
(define asa (add-pair-stars aca))
(display " Matrix API created.\n")
(log-json "matrix_api_ready")
;; ─────────────────────────────────────────────────────────────────
;; Step 2: Load all pairs from RocksDB into RAM
;; ─────────────────────────────────────────────────────────────────
;; TIMING NOTE: get-all-elts, left-basis, and right-basis each call
;; get-all-pairs internally, which builds a Scheme list of ALL 1.18M
;; pairs. This is NOT cached, so each call takes ~14 minutes.
;;
;; We skip get-all-elts since we know the pair count from Phase 1.
;; left-basis and right-basis still each take ~14 min (unavoidable
;; without modifying the matrix API to cache get-all-pairs).
;; ─────────────────────────────────────────────────────────────────
(display "\nStep 2: Loading word pairs from database...\n")
(display " This takes ~30 min for 1M+ pairs (two passes to compute basis).\n")
(log-json "load_pairs_start")
;; fetch-pairs loads EdgeLink atoms with BondNode "ANY" into the AtomSpace
;; This is fast (~80 sec) - just RocksDB → AtomSpace transfer
(asa 'fetch-pairs)
;; Compute left and right basis (each iterates all pairs once)
;; These results are cached after first computation
(let ((num-left (length (asa 'left-basis)))
(num-right (length (asa 'right-basis))))
;; Pair count known from Phase 1: 1,184,936
;; Calling get-all-elts would add another 14 min for no benefit
(format #t " Loaded: ~a left-words, ~a right-words (pairs: 1.18M from Phase 1)\n"
num-left num-right)
(log-json "load_pairs_done"
(cons "left_words" num-left)
(cons "right_words" num-right)))
;; ─────────────────────────────────────────────────────────────────
;; Step 3: Compute MI/NPMI on all pairs
;; ─────────────────────────────────────────────────────────────────
(display "\nStep 3: Computing MI/NPMI on all pairs...\n")
(display " This is the main computation - may take 30-60 minutes.\n")
(log-json "compute_mi_start")
;; batch-all-pair-mi computes:
;; - N(x,*) and N(*,y) marginals
;; - N(*,*) total
;; - p(x,y), p(x,*), p(*,y) frequencies
;; - MI(x,y) = log2[p(x,y) / (p(x,*) * p(*,y))]
;; - NPMI normalization
;; All values are stored on the atoms and persisted to RocksDB
(batch-all-pair-mi asa)
(display "\n MI computation complete.\n")
(log-json "compute_mi_done")
;; Print matrix summary
(display "\n Matrix summary:\n")
(print-matrix-summary-report asa)
;; ─────────────────────────────────────────────────────────────────
;; Step 4: MST parsing to extract Sections
;; ─────────────────────────────────────────────────────────────────
(display "\nStep 4: MST parsing to extract Sections...\n")
(display " Re-parsing corpus with MI-weighted MST parser.\n")
(log-json "mst_parse_start")
;; Create the MST observer
;; This uses dict-pair which reads MI values from BondNode "ANY" edges
;; and creates MST/MPG parses, storing Sections (word + ConnectorSeq)
(define mst-observer (make-block-mpg-pipe-observer))
;; Read and parse corpus
(display " Loading corpus...\n")
(let ((text-blocks (read-corpus-text *corpus-dir*))
(block-count 0))
(format #t " Loaded ~a text blocks.\n" (length text-blocks))
(for-each
(lambda (text-block)
(set! block-count (+ block-count 1))
(when (zero? (modulo block-count 1))
(format #t " Processing block ~a/~a (~a chars)...\n"
block-count (length text-blocks) (string-length text-block)))
;; The observer applies sliding window and MST parsing
(mst-observer text-block))
text-blocks)
(format #t " Parsed ~a text blocks.\n" block-count)
(log-json "mst_parse_done" (cons "blocks" block-count)))
;; ─────────────────────────────────────────────────────────────────
;; Step 5: Compute Section marginals
;; ─────────────────────────────────────────────────────────────────
(display "\nStep 5: Computing Section marginals...\n")
(log-json "section_marginals_start")
;; Create Section (pseudo-cset) matrix API
;; Sections are: (Section (WordNode "word") (ConnectorSeq ...))
(define pca (make-pseudo-cset-api))
(define psa (add-pair-stars pca))
;; Load all Sections that were created by MST parsing
(psa 'fetch-pairs)
(let ((num-sections (length (psa 'get-all-elts)))
(num-words (length (psa 'left-basis)))
(num-csets (length (psa 'right-basis))))
(format #t " Sections: ~a, Words: ~a, ConnectorSeqs: ~a\n"
num-sections num-words num-csets)
(log-json "sections_loaded"
(cons "sections" num-sections)
(cons "words" num-words)
(cons "csets" num-csets))
;; Only compute marginals if we have sections
(when (> num-sections 0)
;; Compute transpose marginals (needed for Section MI later)
(let ((btr (batch-transpose psa)))
(btr 'mmt-marginals))
(display " Marginals computed.\n")
(log-json "marginals_done")))
;; ─────────────────────────────────────────────────────────────────
;; Step 6: Final save and summary
;; ─────────────────────────────────────────────────────────────────
(display "\nStep 6: Final save...\n")
(barrier rsn)
(let ((total-elapsed (elapsed-seconds)))
(format #t "\n═══ Phase 2 Complete ═══\n")
(format #t "Total time: ~,1f minutes (~a seconds)\n"
(/ total-elapsed 60.0) total-elapsed)
(log-json "complete" (cons "total_seconds" total-elapsed)))
;; Close resources
(cog-close rsn)
(close-output-port *log-port*)
(display "Done.\n"))
; ═══════════════════════════════════════════════════════════════════
; RUN
; ═══════════════════════════════════════════════════════════════════
(run-phase2)