;
; layer3.scm - Cluster relation tracking
;
; Layer 3: Track how clusters combine in sentences.
; Count patterns like: ANIMAL + MOTION-VERB, ANIMAL + BODY-PART
;
(use-modules (opencog))
(use-modules (ice-9 format))
(use-modules (srfi srfi-1))
;; ═══════════════════════════════════════════════════════════════════
;; CONFIGURATION
;; ═══════════════════════════════════════════════════════════════════
(define *relation-min-count* 2)
;; ═══════════════════════════════════════════════════════════════════
;; RELATION COUNTING (using alist for simplicity)
;; ═══════════════════════════════════════════════════════════════════
(define *cluster-pairs* '()) ; ((("C0" . "C1") . count) ...)
(define *total-cluster-pairs* 0)
(define (count-cluster-pair c1 c2)
"Increment count for cluster pair"
(let* ((key (cons c1 c2))
(entry (assoc key *cluster-pairs*)))
(if entry
(set-cdr! entry (+ 1 (cdr entry)))
(set! *cluster-pairs* (cons (cons key 1) *cluster-pairs*)))
(set! *total-cluster-pairs* (+ 1 *total-cluster-pairs*))))
(define (get-cluster-pair-count c1 c2)
"Get count for cluster pair"
(let ((entry (assoc (cons c1 c2) *cluster-pairs*)))
(if entry (cdr entry) 0)))
;; ═══════════════════════════════════════════════════════════════════
;; PROCESSING
;; ═══════════════════════════════════════════════════════════════════
(define (layer3-process text)
"Process text: count cluster pair co-occurrences"
(let* ((words (tokenize text))
(clusters (filter identity (map layer2-get-cluster words))))
(when (>= (length clusters) 2)
(for-each
(lambda (i)
(when (< (+ i 1) (length clusters))
(let ((c1 (list-ref clusters i))
(c2 (list-ref clusters (+ i 1))))
(when (and c1 c2 (not (string=? c1 c2)))
(count-cluster-pair c1 c2)))))
(iota (- (length clusters) 1))))))
;; ═══════════════════════════════════════════════════════════════════
;; QUERIES
;; ═══════════════════════════════════════════════════════════════════
(define (layer3-relation-count)
"Count of unique cluster relations"
(length *cluster-pairs*))
(define (layer3-get-relations cluster-id)
"Get clusters that co-occur with given cluster"
(let ((relations '()))
(for-each
(lambda (entry)
(let ((key (car entry))
(count (cdr entry)))
(when (>= count *relation-min-count*)
(cond
((string=? (car key) cluster-id)
(set! relations (cons (cons (cdr key) count) relations)))
((string=? (cdr key) cluster-id)
(set! relations (cons (cons (car key) count) relations)))))))
*cluster-pairs*)
(sort relations (lambda (a b) (> (cdr a) (cdr b))))))
(define (show-relations cluster-id)
"Display relations for a cluster"
(let ((rels (layer3-get-relations cluster-id)))
(if (null? rels)
(format #f "No relations for ~a (need more data)" cluster-id)
(string-join
(cons (format #f "~a co-occurs with:" cluster-id)
(map (lambda (r)
(format #f " ~a (~a times)" (car r) (cdr r)))
(take rels (min 5 (length rels)))))
"\n"))))
(define (show-all-relations)
"Display all discovered relations"
(if (null? *cluster-pairs*)
"No relations discovered yet"
(let ((significant (filter (lambda (e) (>= (cdr e) *relation-min-count*))
*cluster-pairs*)))
(if (null? significant)
"No significant relations yet (need more data)"
(string-join
(cons "Cluster relations:"
(map (lambda (p)
(format #f " ~a->~a: ~a"
(caar p) (cdar p) (cdr p)))
(take (sort significant (lambda (a b) (> (cdr a) (cdr b))))
(min 10 (length significant)))))
"\n")))))
(define (layer3-predict-next cluster-id)
"Predict what cluster likely follows given cluster"
(let ((rels (layer3-get-relations cluster-id)))
(if (null? rels)
#f
(caar rels))))
(define (layer3-score-combination c1 c2)
"Score how likely cluster c1 combines with c2"
(let ((count (get-cluster-pair-count c1 c2)))
(if (= *total-cluster-pairs* 0)
0
(/ count *total-cluster-pairs*))))