OverviewFilesCommitsIssuesDocsReleasesPeers

hypercore-kb / opencog-kb / language-learning / experiments / recursive-layer-discovery.scm

477 lines · scm ref:
;
; recursive-layer-discovery.scm
;
; Watch layers emerge from raw text through recursive counting.
; Each layer is discovered by counting patterns in the layer below.
;
; NOTE (2026-02-03): The numbered "layers" in this demo (0, 1, 1b,
; 2, 3, 4, 5) emerged from THIS specific corpus of 24 sentences.
; They are illustrative, not architectural. A different corpus might
; produce different dimensionality -- more dimensions, fewer, or
; orthogonal ones not shown here (temporal, causal, modal, etc.).
; The method itself doesn't prescribe a layer count; it says
; "recurse until the data stops producing new structure."
;
; See concepts/dimensions-of-structure.scm for 10+ orthogonal
; dimensions that the same counting method can discover.
;
; ZERO HARDCODING: Every value in this file -- cluster contents,
; cluster names, frame definitions, evidence scores -- is COMPUTED
; from the corpus. Nothing is assumed or hand-labeled.
;

(use-modules (srfi srfi-1))
(use-modules (srfi srfi-69))  ; hash tables
(use-modules (ice-9 format))

;; Load shared infrastructure
(load "../lib/counting.scm")

(display "═══════════════════════════════════════════════════════════════════\n")
(display "   RECURSIVE LAYER DISCOVERY FROM RAW TEXT                         \n")
(display "   (All values computed -- zero hardcoding)                        \n")
(display "═══════════════════════════════════════════════════════════════════\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; LAYER 0: RAW TEXT
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "LAYER 0: RAW TEXT (the only input)\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(define corpus '(
  ;; Financial contexts
  "the customer deposited money at the bank"
  "she withdrew cash from the bank"
  "the bank approved the loan"
  "he checked his account at the bank"
  "the teller counted the money"
  "the bank charges interest on loans"

  ;; Geographic contexts
  "the fisherman sat on the bank"
  "the river eroded the bank"
  "we walked along the bank"
  "the duck swam to the bank"
  "mud covered the bank"
  "trees grew on the bank"

  ;; Cooking contexts
  "the chef chopped the onion"
  "she stirred the soup"
  "he baked the bread"
  "the cook seasoned the meat"
  "they grilled the fish"
  "she boiled the water"

  ;; Movement contexts
  "the dog ran to the park"
  "she walked to the store"
  "he swam across the lake"
  "the bird flew to the tree"
  "they drove to the city"
  "the child ran home"
))

(display "  Input: 24 sentences\n\n")
(for-each (lambda (s) (format #t "    ~a\n" s)) (take corpus 6))
(display "    ...\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; LAYER 1: WORD CO-OCCURRENCE COUNTS
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "LAYER 1: Count word co-occurrences (within sentences)\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  Operation: For each sentence, count which words appear together\n")
(display "  Result: Co-occurrence matrix\n\n")

;; COMPUTE co-occurrence counts from corpus
(define counts (count-cooccurrences corpus 2))
(define word-counts (car counts))
(define cooccur (cdr counts))

(display "  Sample co-occurrence counts:\n\n")
(format #t "    bank + money:    ~a\n"
  (hash-table-ref/default cooccur (pair-key "bank" "money") 0))
(format #t "    bank + river:    ~a\n"
  (hash-table-ref/default cooccur (pair-key "bank" "river") 0))
(format #t "    bank + deposited: ~a\n"
  (hash-table-ref/default cooccur (pair-key "bank" "deposited") 0))
(format #t "    bank + eroded:   ~a\n"
  (hash-table-ref/default cooccur (pair-key "bank" "eroded") 0))
(format #t "    chef + chopped:  ~a\n"
  (hash-table-ref/default cooccur (pair-key "chef" "chopped") 0))
(format #t "    ran + park:      ~a\n"
  (hash-table-ref/default cooccur (pair-key "ran" "park") 0))
(newline)

;; ═══════════════════════════════════════════════════════════════════
;; LAYER 1b: PMI FROM CO-OCCURRENCE
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "LAYER 1b: Compute PMI from counts\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  Operation: PMI(w1,w2) = log2(P(w1,w2) / (P(w1) * P(w2)))\n")
(display "  Result: Association strengths (which words 'go together')\n\n")

(display "  PMI values (high = strong association):\n\n")
(format #t "    PMI(bank, money):     ~,2f\n"
  (compute-pmi word-counts cooccur "bank" "money"))
(format #t "    PMI(bank, deposited): ~,2f\n"
  (compute-pmi word-counts cooccur "bank" "deposited"))
(format #t "    PMI(bank, river):     ~,2f\n"
  (compute-pmi word-counts cooccur "bank" "river"))
(format #t "    PMI(bank, eroded):    ~,2f\n"
  (compute-pmi word-counts cooccur "bank" "eroded"))
(format #t "    PMI(chef, chopped):   ~,2f\n"
  (compute-pmi word-counts cooccur "chef" "chopped"))
(format #t "    PMI(dog, ran):        ~,2f\n"
  (compute-pmi word-counts cooccur "dog" "ran"))
(newline)

(display "  Observation: 'bank' has HIGH PMI with both financial AND geographic words\n")
(display "  -> This signals AMBIGUITY (multiple senses)\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; LAYER 2: WORD CLUSTERS (categories) -- COMPUTED
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "LAYER 2: Cluster words by PMI similarity (COMPUTED)\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  Operation: Words with similar PMI profiles -> same cluster\n")
(display "  Result: Emergent categories (no labels provided!)\n\n")

;; ACTUALLY RUN clustering on the corpus
(define discovered-clusters
  (cluster-by-pmi-similarity word-counts cooccur 0.15))

;; Filter to clusters with >1 member
(define multi-word-clusters
  (filter (lambda (c) (> (length c) 1)) discovered-clusters))

(display "  Discovered clusters (by PMI similarity):\n\n")
(for-each
  (lambda (cluster)
    (format #t "    {~a}\n"
            (string-join (take cluster (min 8 (length cluster))) ", "))
    (when (> (length cluster) 8)
      (format #t "     ... (~a total)\n" (length cluster))))
  multi-word-clusters)
(newline)

(display "  Note: These clusters EMERGE from statistics.\n")
(display "  We didn't tell the system about any topics.\n")
(display "  The system discovered words that behave similarly.\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; LAYER 2b: NAMING CLUSTERS BY MEDOID (algorithmic, not human)
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "LAYER 2b: Name clusters by MEDOID (no human labels)\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  The medoid is the member with highest average PMI to all others.\n")
(display "  It serves as the cluster's ALGORITHMIC name.\n\n")

;; COMPUTE medoid names for all clusters
(define named-clusters
  (name-clusters-by-medoid multi-word-clusters word-counts cooccur))

(for-each
  (lambda (nc)
    (let ((medoid (car nc))
          (members (cdr nc)))
      (format #t "    [~a]-cluster: ~a\n"
              medoid
              (string-join (take members (min 6 (length members))) ", "))
      (when (> (length members) 6)
        (display "              ...\n"))))
  named-clusters)
(newline)

(display "  Cluster names come from COMPUTATION, not human judgment.\n")
(display "  The system doesn't know 'financial' or 'cooking'.\n")
(display "  It knows '[money]-cluster' and '[chef]-cluster' (or whatever\n")
(display "  the medoid turns out to be).\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; LAYER 3: CLUSTER CO-OCCURRENCE (Frames) -- COMPUTED
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "LAYER 3: Count which CLUSTERS co-occur in sentences (COMPUTED)\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  Operation: For each sentence, find which clusters its words belong to.\n")
(display "  Count which clusters appear together.\n")
(display "  Result: FRAMES (patterns of clusters that appear together)\n\n")

;; Build word -> cluster-medoid lookup
(define word-to-cluster (make-hash-table string=?))
(for-each
  (lambda (nc)
    (let ((medoid (car nc)))
      (for-each
        (lambda (member)
          (hash-table-set! word-to-cluster member medoid))
        (cdr nc))))
  named-clusters)

;; For each sentence, find which cluster medoids appear
(define (sentence-clusters sent)
  (let* ((words (tokenize-content sent))
         (cluster-ids (filter-map
                        (lambda (w) (hash-table-ref/default word-to-cluster w #f))
                        words)))
    (delete-duplicates cluster-ids string=?)))

;; Count cluster co-occurrences across sentences
(define cluster-cooccur (make-hash-table string=?))
(define cluster-freq (make-hash-table string=?))

(for-each
  (lambda (sent)
    (let ((cl-ids (sentence-clusters sent)))
      ;; Count individual cluster frequencies
      (for-each
        (lambda (c)
          (hash-table-set! cluster-freq c
            (+ 1 (hash-table-ref/default cluster-freq c 0))))
        cl-ids)
      ;; Count cluster co-occurrences
      (for-each
        (lambda (c1)
          (for-each
            (lambda (c2)
              (when (not (string=? c1 c2))
                (let ((key (pair-key c1 c2)))
                  (hash-table-set! cluster-cooccur key
                    (+ 1 (hash-table-ref/default cluster-cooccur key 0))))))
            cl-ids))
        cl-ids)))
  corpus)

(display "  Example sentences with cluster labels:\n\n")
(for-each
  (lambda (sent)
    (let ((cl-ids (sentence-clusters sent)))
      (format #t "    '~a'\n" sent)
      (format #t "    -> clusters: ~a\n\n"
              (string-join cl-ids ", "))))
  (take corpus 6))

(display "  Cluster co-occurrence counts:\n\n")
(hash-table-walk cluster-cooccur
  (lambda (key count)
    (when (> count 1)
      (format #t "    ~a : ~a times\n" key count))))
(newline)

(display "  Sentences with the same cluster pattern form FRAMES.\n")
(display "  Frames are clusters-of-clusters, discovered by the same method.\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; LAYER 4: FRAME SEQUENCES (Scripts)
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "LAYER 4: Count which FRAMES follow which (in document order)\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  Operation: Look at consecutive sentences, count frame transitions\n")
(display "  Result: SCRIPTS (typical frame sequences)\n\n")

;; Count transitions between consecutive sentences' dominant clusters
(define frame-transitions (make-hash-table string=?))

(let loop ((sents corpus))
  (when (>= (length sents) 2)
    (let* ((cl1 (sentence-clusters (car sents)))
           (cl2 (sentence-clusters (cadr sents))))
      (for-each
        (lambda (c1)
          (for-each
            (lambda (c2)
              (let ((key (string-append c1 "->" c2)))
                (hash-table-set! frame-transitions key
                  (+ 1 (hash-table-ref/default frame-transitions key 0)))))
            cl2))
        cl1))
    (loop (cdr sents))))

(display "  Frame transitions (consecutive sentences):\n\n")
(let ((transitions (hash-table->alist frame-transitions)))
  (for-each
    (lambda (t)
      (when (> (cdr t) 0)
        (format #t "    ~a : ~a\n" (car t) (cdr t))))
    (sort transitions (lambda (a b) (> (cdr a) (cdr b))))))
(newline)

(display "  Repeated transitions reveal SCRIPTS: typical frame sequences.\n")
(display "  Same counting method, applied one level higher.\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; LAYER 5: USING LAYERS FOR DISAMBIGUATION
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "LAYER 5: Use all layers for disambiguation (COMPUTED)\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(define test-sentence "the fisherman walked to the bank")

(format #t "  New sentence: '~a'\n\n" test-sentence)

;; Layer 1 evidence: PMI between context words and 'bank'
(display "  Layer 1 evidence (PMI with 'bank'):\n")
(let* ((context-words (filter (lambda (w) (not (string=? w "bank")))
                              (tokenize-content test-sentence))))
  (for-each
    (lambda (w)
      (let ((pmi (compute-pmi word-counts cooccur w "bank")))
        (when (> pmi -999.0)
          (format #t "    PMI(~a, bank) = ~,2f\n" w pmi))))
    context-words))
(newline)

;; Layer 2 evidence: which clusters do context words belong to?
(display "  Layer 2 evidence (cluster membership of context words):\n")
(let* ((context-words (filter (lambda (w) (not (string=? w "bank")))
                              (tokenize-content test-sentence))))
  (for-each
    (lambda (w)
      (let ((cluster (hash-table-ref/default word-to-cluster w #f)))
        (when cluster
          (format #t "    '~a' -> [~a]-cluster\n" w cluster))))
    context-words))
(newline)

;; Layer 3 evidence: which frame (cluster combination) does this match?
(display "  Layer 3 evidence (frame matching via cluster evidence):\n")
(let ((evidence (compute-frame-evidence test-sentence named-clusters
                                         word-counts cooccur)))
  (display-evidence evidence)
  (newline)

  ;; Compute vagueness
  (let ((vagueness (compute-vagueness evidence)))
    (format #t "  Vagueness: ~,3f\n\n" vagueness)

    (display "  RESOLUTION:\n\n")
    (if (null? evidence)
        (display "  No evidence found -- cannot disambiguate\n")
        (let ((best (car evidence)))
          (format #t "  Best cluster: [~a]-cluster with evidence ~,2f\n"
                  (car best) (cdr best))
          (format #t "  Interpretation: 'bank' in this context aligns with [~a]\n"
                  (car best))
          (if (< vagueness 0.2)
              (display "  Confidence: HIGH (low vagueness, convergent proof)\n")
              (if (< vagueness 0.5)
                  (display "  Confidence: MODERATE (some uncertainty)\n")
                  (display "  Confidence: LOW (high vagueness, need more context)\n")))))))

(newline)

;; ═══════════════════════════════════════════════════════════════════
;; THE RECURSIVE PATTERN
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "THE RECURSIVE PATTERN: Same Operation At Each Level\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  ┌────────────┬─────────────────────┬──────────────────────────┐\n")
(display "  │ Layer      │ Input               │ Output                   │\n")
(display "  ├────────────┼─────────────────────┼──────────────────────────┤\n")
(display "  │ 0 -> 1     │ Words               │ Word co-occurrences      │\n")
(display "  │ 1 -> 2     │ Co-occurrences      │ Word clusters            │\n")
(display "  │ 2 -> 3     │ Cluster patterns    │ Frames                   │\n")
(display "  │ 3 -> 4     │ Frame sequences     │ Scripts                  │\n")
(display "  │ 4 -> 5     │ Script patterns     │ Genres/situations        │\n")
(display "  │ 5 -> 6     │ Genre patterns      │ Cultural schemas         │\n")
(display "  │ ...        │ ...                 │ ...                      │\n")
(display "  └────────────┴─────────────────────┴──────────────────────────┘\n\n")

(display "  At EVERY level, the operation is:\n\n")
(display "    1. COUNT: How often do elements co-occur?\n")
(display "    2. STATISTICS: Compute association strength (PMI)\n")
(display "    3. CLUSTER: Group elements with similar profiles\n")
(display "    4. NAME: Medoid of each cluster = its algorithmic name\n")
(display "    5. USE: Named clusters become input to next level\n\n")

(display "  The system builds its own hierarchy by applying\n")
(display "  THE SAME OPERATION recursively to its own outputs.\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; WHAT THE SYSTEM DISCOVERED
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "WHAT THE SYSTEM DISCOVERED (without being told)\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  From 24 raw sentences, the system discovered:\n\n")

(display "  1. WORD ASSOCIATIONS (Layer 1)\n")
(display "     Which words co-occur -- computed PMI values\n\n")

(display "  2. WORD CATEGORIES (Layer 2)\n")
(display "     Clusters of words that share PMI profiles\n")
(display "     Named by their medoid (most central member)\n\n")

(display "  3. SEMANTIC FRAMES (Layer 3)\n")
(display "     Which clusters appear together in sentences\n\n")

(display "  4. AMBIGUITY\n")
(display "     'bank' gets evidence from MULTIPLE clusters\n")
(display "     Detected because context words pull in different directions\n\n")

(display "  5. DISAMBIGUATION\n")
(display "     Context word PMIs + cluster membership resolve ambiguity\n")
(display "     No labels needed -- cluster medoids serve as sense IDs\n\n")

(display "  ALL of this emerged from counting patterns in patterns.\n")
(display "  No semantic labels were provided.\n")
(display "  No grammar rules were given.\n")
(display "  Just: COUNT -> CLUSTER -> NAME BY MEDOID -> REPEAT.\n\n")

;; ═══════════════════════════════════════════════════════════════════
;; SUMMARY
;; ═══════════════════════════════════════════════════════════════════

(display "═══════════════════════════════════════════════════════════════════\n")
(display "SUMMARY: Recursive Layer Discovery\n")
(display "─────────────────────────────────────────────────────────────────\n\n")

(display "  ┌─────────────────────────────────────────────────────────────┐\n")
(display "  │                                                             │\n")
(display "  │  Raw text                                                   │\n")
(display "  │      | count co-occurrences                                │\n")
(display "  │  Word associations (PMI) -- COMPUTED                       │\n")
(display "  │      | cluster by similarity                               │\n")
(display "  │  Word categories -- COMPUTED, named by medoid              │\n")
(display "  │      | count category co-occurrences                       │\n")
(display "  │  Semantic frames -- COMPUTED                               │\n")
(display "  │      | count frame sequences                               │\n")
(display "  │  Scripts -- COMPUTED                                       │\n")
(display "  │      | ...                                                 │\n")
(display "  │  Higher structures                                          │\n")
(display "  │                                                             │\n")
(display "  │  Each layer provides evidence for disambiguation.          │\n")
(display "  │  Multiple layers agreeing = convergent proof = low vagueness│\n")
(display "  │                                                             │\n")
(display "  │  ZERO hardcoded values. Every number is from computation.  │\n")
(display "  │                                                             │\n")
(display "  └─────────────────────────────────────────────────────────────┘\n\n")