;
; atomspace-learner.scm - Continuous learning with AtomSpace storage
;
; Pure PMI approach:
; 1. COUNT words and pairs → store in AtomSpace
; 2. Compute PMI from AtomSpace data
; 3. Discover structures from PMI → store as AtomSpace links
; 4. Query AtomSpace for responses
;
; AtomSpace representation:
; Units: (Concept "word:X") with count value
; Pairs: (Edge "pair" (List word1 word2)) with count value
; Structures: (Evaluation "contains" (List X Y)) - discovered from PMI
;
(use-modules (opencog))
(use-modules (ice-9 format))
(use-modules (ice-9 rdelim))
(use-modules (ice-9 popen))
(use-modules (srfi srfi-1))
;; ═══════════════════════════════════════════════════════════════════
;; CONFIGURATION
;; ═══════════════════════════════════════════════════════════════════
(define *window-size* 5)
(define *min-word-length* 2)
(define *total-observations* 0)
(define *manual-observations* 0) ;; Fed by human (bootstrap cost)
(define *auto-observations* 0) ;; Self-acquired via tools
;; Words that indicate structural relationships
(define *structure-predicates* '("contains" "has" "includes" "is" "are" "type" "kind"))
;; Words that indicate operational relationships
(define *action-predicates* '("create" "make" "build" "send" "sign" "verify" "use" "call" "search" "searches"))
;; Words that indicate tool input relationships
(define *input-predicates* '("takes" "needs" "requires" "accepts" "given"))
;; Words that indicate tool output relationships
(define *output-predicates* '("returns" "produces" "gives" "outputs"))
;; Words that indicate sequential relationships
(define *sequence-predicates* '("then" "first" "before" "after" "next"))
;; ═══════════════════════════════════════════════════════════════════
;; TOOL BINDINGS - The ONLY hardcoded bridge between concepts and reality
;; ═══════════════════════════════════════════════════════════════════
;; The program must LEARN about "grep" and "wirecore" through text.
;; These bindings just map the concept names to actual executables/paths.
;; Without these, the program knows "grep searches files" but can't run it.
(define *tool-bindings*
'(("grep" . tool-grep) ;; concept "grep" → function tool-grep
("wirecore" . "/storage/projects/code/hypercore-kb/hyper-fleeky/repos/wirecore")
("codebase" . "/storage/projects/code/hypercore-kb/hyper-fleeky/repos/wirecore")))
;; ═══════════════════════════════════════════════════════════════════
;; TOKENIZATION
;; ═══════════════════════════════════════════════════════════════════
(define *max-word-length* 20)
(define (hex-like? word)
"Is WORD likely a hex string? (only hex chars a-f plus 'x')"
(and (> (string-length word) 4)
(string-every (lambda (c) (member c '(#\a #\b #\c #\d #\e #\f #\x))) word)))
(define (split-camel-case text)
"Insert spaces before uppercase letters to split camelCase.
'createKeyPair' → 'create Key Pair'"
(let ((len (string-length text)))
(let loop ((i 0) (start 0) (out '()))
(cond
((>= i len)
(string-join (reverse (cons (substring text start i) out)) " "))
((and (> i start)
(char-upper-case? (string-ref text i))
(> i 0)
(char-lower-case? (string-ref text (- i 1))))
(loop i i (cons (substring text start i) out)))
(else
(loop (+ i 1) start out))))))
(define (tokenize text)
"Split text into words, lowercase, filter short/long/hex words.
Splits on code delimiters and camelCase boundaries."
(filter
(lambda (w) (and (> (string-length w) *min-word-length*)
(< (string-length w) *max-word-length*)
(not (hex-like? w))))
(map string-downcase
(filter (lambda (s) (> (string-length s) 0))
(string-split
(string-filter (lambda (c)
(or (char-alphabetic? c) (char=? c #\space)))
;; Split camelCase, then replace code delimiters with spaces
(split-camel-case
(string-map (lambda (c)
(if (member c '(#\. #\_ #\( #\) #\[ #\] #\{ #\}
#\; #\: #\, #\= #\+ #\- #\/ #\*
#\< #\> #\! #\| #\& #\@ #\# #\~
#\? #\% #\^ #\` #\' #\" #\\ #\tab
#\newline))
#\space
c))
text)))
#\space)))))
;; ═══════════════════════════════════════════════════════════════════
;; ATOMSPACE STORAGE - UNITS
;; ═══════════════════════════════════════════════════════════════════
(define (word-node word)
"Get or create a word concept node"
(cog-new-node 'ConceptNode (string-append "word:" word)))
(define (find-word-node word)
"Find word node if it exists"
(cog-node 'ConceptNode (string-append "word:" word)))
(define (observe-unit! word)
"Observe a word - increment its count in AtomSpace"
(let ((node (word-node word)))
(let ((current (cog-value node (Predicate "count"))))
(if current
(cog-set-value! node (Predicate "count")
(FloatValue (+ 1 (car (cog-value->list current)))))
(cog-set-value! node (Predicate "count")
(FloatValue 1))))
(set! *total-observations* (+ 1 *total-observations*))
node))
(define (get-unit-count word)
"Get count for a word"
(let ((node (find-word-node word)))
(if node
(let ((val (cog-value node (Predicate "count"))))
(if val (car (cog-value->list val)) 0))
0)))
(define (get-all-words)
"Get all word strings from AtomSpace"
(filter string?
(filter-map
(lambda (n)
(let ((name (cog-name n)))
(if (and (string? name)
(> (string-length name) 5)
(string-prefix? "word:" name))
(substring name 5)
#f)))
(cog-get-atoms 'ConceptNode #t))))
;; ═══════════════════════════════════════════════════════════════════
;; ATOMSPACE STORAGE - PAIRS
;; ═══════════════════════════════════════════════════════════════════
(define (pair-link word1 word2)
"Get or create a pair link (ordered alphabetically for consistency)"
(let* ((ordered (if (string<? word1 word2)
(list word1 word2)
(list word2 word1)))
(w1 (word-node (car ordered)))
(w2 (word-node (cadr ordered)))
(bond (cog-new-node 'ConceptNode "pair-bond"))
(pair (cog-new-link 'EdgeLink bond
(cog-new-link 'ListLink w1 w2))))
pair))
(define (find-pair-link word1 word2)
"Find pair link if it exists"
(let* ((ordered (if (string<? word1 word2)
(list word1 word2)
(list word2 word1)))
(w1 (find-word-node (car ordered)))
(w2 (find-word-node (cadr ordered)))
(bond (cog-node 'ConceptNode "pair-bond")))
(if (and w1 w2 bond)
(let ((lst (cog-link 'ListLink w1 w2)))
(if lst
(cog-link 'EdgeLink bond lst)
#f))
#f)))
(define (observe-pair! word1 word2)
"Observe a pair - increment its count in AtomSpace"
(let ((pair (pair-link word1 word2)))
(let ((current (cog-value pair (Predicate "count"))))
(if current
(cog-set-value! pair (Predicate "count")
(FloatValue (+ 1 (car (cog-value->list current)))))
(cog-set-value! pair (Predicate "count")
(FloatValue 1))))
pair))
(define (get-pair-count word1 word2)
"Get count for a pair"
(let ((pair (find-pair-link word1 word2)))
(if pair
(let ((val (cog-value pair (Predicate "count"))))
(if val (car (cog-value->list val)) 0))
0)))
;; ═══════════════════════════════════════════════════════════════════
;; PMI COMPUTATION
;; ═══════════════════════════════════════════════════════════════════
(define (compute-pmi word1 word2)
"Compute Pointwise Mutual Information between two words"
(let ((pair-count (get-pair-count word1 word2))
(count1 (get-unit-count word1))
(count2 (get-unit-count word2)))
(if (or (= pair-count 0) (= count1 0) (= count2 0) (= *total-observations* 0))
0
(let* ((p-pair (/ pair-count *total-observations*))
(p1 (/ count1 *total-observations*))
(p2 (/ count2 *total-observations*)))
(if (or (= p1 0) (= p2 0))
0
(/ (log (/ p-pair (* p1 p2))) (log 2)))))))
(define (get-co-occurring-words word)
"Get words that actually co-occur with WORD (have a pair in AtomSpace)"
(let ((word-node (find-word-node word)))
(if (not word-node)
'()
;; Find ListLinks containing this word node
(let ((lists (cog-incoming-by-type word-node 'ListLink)))
(filter-map
(lambda (lst)
(let ((edges (cog-incoming-by-type lst 'EdgeLink)))
(and (not (null? edges))
(let* ((args (cog-outgoing-set lst))
(other-node (if (equal? (car args) word-node)
(cadr args)
(car args)))
(name (cog-name other-node)))
(and (string? name)
(> (string-length name) 5)
(string-prefix? "word:" name)
(substring name 5))))))
lists)))))
(define (get-associations word n)
"Get top N associations for a word by PMI (optimized: only checks co-occurring words)"
(let* ((co-words (get-co-occurring-words word))
;; Remove duplicates and self
(others (delete-duplicates
(filter (lambda (x)
(and (string? x)
(not (string-null? x))
(not (equal? x word))))
co-words)))
(scored (map (lambda (other)
(cons (compute-pmi word other) other))
others))
(positive (filter (lambda (p)
(and (pair? p)
(number? (car p))
(string? (cdr p))
(> (car p) 0)))
scored))
(sorted (sort positive (lambda (a b) (> (car a) (car b))))))
(take sorted (min n (length sorted)))))
;; ═══════════════════════════════════════════════════════════════════
;; STRUCTURE DISCOVERY - Store discovered relations in AtomSpace
;; ═══════════════════════════════════════════════════════════════════
(define (store-structure! subject predicate object confidence)
"Store a discovered structure as an EvaluationLink"
(let* ((subj-node (word-node subject))
(pred-node (cog-new-node 'PredicateNode predicate))
(obj-node (word-node object))
(eval-link (cog-new-link 'EvaluationLink
pred-node
(cog-new-link 'ListLink subj-node obj-node))))
;; Store confidence as a value (not truth value)
(cog-set-value! eval-link (Predicate "confidence") (FloatValue confidence))
eval-link))
(define (discover-contains! word)
"Discover what WORD contains based on PMI with 'contains' and other words"
(let ((assocs (get-associations word 20)))
;; If word associates with 'contains', find what it might contain
(when (member "contains" (map cdr assocs))
(let ((contains-pmi (compute-pmi word "contains")))
(when (> contains-pmi 1.0)
;; For each association that's NOT a structure predicate,
;; check if it also associates with 'contains'
(for-each
(lambda (assoc)
(let ((other (cdr assoc))
(pmi (car assoc)))
(when (and (not (member other *structure-predicates*))
(> pmi 1.5)
(> (compute-pmi other "contains") 0))
;; Store: word contains other
(store-structure! word "contains" other pmi))))
assocs))))))
(define (discover-action! word)
"Discover what actions relate to WORD"
(let ((assocs (get-associations word 20)))
(for-each
(lambda (assoc)
(let ((other (cdr assoc))
(pmi (car assoc)))
(when (member other *action-predicates*)
;; Store: action relates to word
(store-structure! other "operates-on" word pmi))))
assocs)))
;; All predicate words combined (for filtering in discovery)
(define *all-predicate-words*
(append *structure-predicates* *action-predicates*
*input-predicates* *output-predicates* *sequence-predicates*))
(define (discover-tool-use! word)
"Discover input/output relationships for WORD from PMI.
If word co-occurs with a predicate (pair count > 0) and PMI > 1.0,
scans top-20 associations for inputs/outputs."
(let ((assocs (get-associations word 20)))
;; Input discovery
(for-each
(lambda (pred)
;; Fast check: does the word co-occur with this predicate at all?
(when (> (get-pair-count word pred) 0)
(let ((pred-pmi (compute-pmi word pred)))
(when (> pred-pmi 1.0)
(for-each
(lambda (assoc)
(let ((other (cdr assoc)) (mi (car assoc)))
(when (and (not (member other *all-predicate-words*))
(not (string=? other word))
(> mi 1.0)
(> (compute-pmi other pred) 0))
(store-structure! word "takes" other mi))))
assocs)))))
*input-predicates*)
;; Output discovery
(for-each
(lambda (pred)
(when (> (get-pair-count word pred) 0)
(let ((pred-pmi (compute-pmi word pred)))
(when (> pred-pmi 1.0)
(for-each
(lambda (assoc)
(let ((other (cdr assoc)) (mi (car assoc)))
(when (and (not (member other *all-predicate-words*))
(not (string=? other word))
(> mi 1.0)
(> (compute-pmi other pred) 0))
(store-structure! word "returns" other mi))))
assocs)))))
*output-predicates*)
;; Sequence discovery
(for-each
(lambda (pred)
(when (> (get-pair-count word pred) 0)
(let ((pred-pmi (compute-pmi word pred)))
(when (> pred-pmi 1.0)
(for-each
(lambda (assoc)
(let ((other (cdr assoc)) (mi (car assoc)))
(when (and (not (member other *all-predicate-words*))
(not (string=? other word))
(> mi 1.0)
(> (compute-pmi other pred) 0))
(store-structure! word "then" other mi))))
assocs)))))
*sequence-predicates*)))
(define (discover-all-structures!)
"Run structure discovery on all words"
(for-each
(lambda (word)
(discover-contains! word)
(discover-action! word)
(discover-tool-use! word))
(get-all-words)))
;; ═══════════════════════════════════════════════════════════════════
;; QUERY ATOMSPACE - For call/response
;; ═══════════════════════════════════════════════════════════════════
(define (query-contains word)
"Query what WORD contains (from discovered structures)"
(let ((subj-node (find-word-node word)))
(if subj-node
(let ((eval-links (cog-incoming-by-type subj-node 'ListLink)))
(filter-map
(lambda (lst)
(let ((evals (cog-incoming-by-type lst 'EvaluationLink)))
(and (not (null? evals))
(let* ((eval (car evals))
(pred (car (cog-outgoing-set eval))))
(and (equal? (cog-name pred) "contains")
(let ((args (cog-outgoing-set lst)))
(when (equal? (car args) subj-node)
(substring (cog-name (cadr args)) 5))))))))
eval-links))
'())))
(define (query-by-predicate word predicate-name)
"Query relationships for WORD with a given predicate.
Returns list of related words where WORD is the subject."
(let ((subj-node (find-word-node word)))
(if subj-node
(let ((eval-links (cog-incoming-by-type subj-node 'ListLink)))
(filter-map
(lambda (lst)
(let ((evals (cog-incoming-by-type lst 'EvaluationLink)))
(and (not (null? evals))
(let* ((eval (car evals))
(pred (car (cog-outgoing-set eval))))
(and (equal? (cog-name pred) predicate-name)
(let ((args (cog-outgoing-set lst)))
(when (equal? (car args) subj-node)
(substring (cog-name (cadr args)) 5))))))))
eval-links))
'())))
(define (query-takes word)
"Query what inputs WORD takes (from discovered tool-use structures)"
(query-by-predicate word "takes"))
(define (query-returns word)
"Query what WORD returns/produces"
(query-by-predicate word "returns"))
(define (query-then word)
"Query what follows WORD in a sequence"
(query-by-predicate word "then"))
(define (query-what-has word)
"Query what CONTAINS word"
(let ((obj-node (find-word-node word)))
(if obj-node
(let ((eval-links (cog-incoming-by-type obj-node 'ListLink)))
(filter-map
(lambda (lst)
(let ((evals (cog-incoming-by-type lst 'EvaluationLink)))
(and (not (null? evals))
(let* ((eval (car evals))
(pred (car (cog-outgoing-set eval))))
(and (equal? (cog-name pred) "contains")
(let ((args (cog-outgoing-set lst)))
(when (equal? (cadr args) obj-node)
(substring (cog-name (car args)) 5))))))))
eval-links))
'())))
;; ═══════════════════════════════════════════════════════════════════
;; RULE INFERENCE - Layer 8: Discover common-sense rules from structures
;; ═══════════════════════════════════════════════════════════════════
;; Rules are DISCOVERED from PMI structures, not hardcoded.
;; Five meta-patterns scan discovered structures and produce
;; ImplicationLinks following OpenCog conventions.
(define (get-all-structures-by-predicate pred-name)
"Get all EvaluationLinks for PRED-NAME.
Returns ((subject object confidence) ...) where subject/object are word strings."
(let ((pred-node (cog-node 'PredicateNode pred-name)))
(if (not pred-node)
'()
(let ((evals (cog-incoming-by-type pred-node 'EvaluationLink)))
(filter-map
(lambda (eval)
(let* ((outgoing (cog-outgoing-set eval))
(pred (car outgoing))
(lst (cadr outgoing))
(args (cog-outgoing-set lst))
(subj-name (cog-name (car args)))
(obj-name (cog-name (cadr args)))
(conf-val (cog-value eval (Predicate "confidence")))
(conf (if conf-val (car (cog-value->list conf-val)) 0)))
(and (string-prefix? "word:" subj-name)
(string-prefix? "word:" obj-name)
(equal? (cog-name pred) pred-name)
(list (substring subj-name 5)
(substring obj-name 5)
conf))))
evals)))))
(define (store-rule! antecedent-pred antecedent-subj antecedent-obj
consequent-pred consequent-subj consequent-obj
rule-type confidence)
"Store a discovered rule as an ImplicationLink.
Antecedent: the source EvaluationLink (e.g., takes(grep, pattern))
Consequent: the inferred EvaluationLink (e.g., precondition(grep, pattern))
Values: rule-type as StringValue, confidence as FloatValue"
(let* (;; Build or find the antecedent EvaluationLink
(ante-pred (cog-new-node 'PredicateNode antecedent-pred))
(ante-subj (word-node antecedent-subj))
(ante-obj (word-node antecedent-obj))
(ante-eval (cog-new-link 'EvaluationLink
ante-pred
(cog-new-link 'ListLink ante-subj ante-obj)))
;; Build the consequent EvaluationLink
(cons-pred (cog-new-node 'PredicateNode consequent-pred))
(cons-subj (word-node consequent-subj))
(cons-obj (word-node consequent-obj))
(cons-eval (cog-new-link 'EvaluationLink
cons-pred
(cog-new-link 'ListLink cons-subj cons-obj)))
;; Create the ImplicationLink
(impl (cog-new-link 'ImplicationLink ante-eval cons-eval)))
;; Store metadata
(cog-set-value! impl (Predicate "rule-type") (StringValue rule-type))
(cog-set-value! impl (Predicate "confidence") (FloatValue confidence))
;; Also store confidence on the consequent EvaluationLink
(cog-set-value! cons-eval (Predicate "confidence") (FloatValue confidence))
impl))
;; ── Rule Discovery Templates ──
;; A "tool-like" word is one that has BOTH "takes" and "returns" structures,
;; or is a known tool binding. This filters out noise from structure discovery
;; where ordinary words like "text", "something" get spurious takes/returns.
(define (tool-like-word? word)
"Is WORD plausibly a tool? Has both takes AND returns, or is a known binding.
Simple check that worked at 5/7 — the structures themselves are the filter."
(or (assoc word *tool-bindings*)
(and (not (null? (safe-string-list (query-takes word))))
(not (null? (safe-string-list (query-returns word)))))))
(define (discover-precondition-rules!)
"Scan 'takes' structures → store precondition rules.
Only for tool-like subjects (have both takes AND returns, or are known tools).
grep TAKES pattern ⟹ pattern IS-PRECONDITION-OF grep"
(let ((takes-structs (get-all-structures-by-predicate "takes"))
(count 0))
(for-each
(lambda (s)
(let ((tool (car s))
(input (cadr s))
(conf (caddr s)))
(when (tool-like-word? tool)
(store-rule! "takes" tool input
"is-precondition-of" input tool
"precondition" conf)
(set! count (+ count 1)))))
takes-structs)
count))
(define (discover-postcondition-rules!)
"Scan 'returns' structures → store postcondition rules.
Only for tool-like subjects.
grep RETURNS lines ⟹ lines IS-POSTCONDITION-OF grep"
(let ((returns-structs (get-all-structures-by-predicate "returns"))
(count 0))
(for-each
(lambda (s)
(let ((tool (car s))
(output (cadr s))
(conf (caddr s)))
(when (tool-like-word? tool)
(store-rule! "returns" tool output
"is-postcondition-of" output tool
"postcondition" conf)
(set! count (+ count 1)))))
returns-structs)
count))
(define (discover-chaining-rules!)
"Find pairs where tool-A returns X and tool-B takes Y and PMI(X,Y) > 1.0.
Only considers tool-like subjects on both sides.
grep RETURNS lines + process-text TAKES text + PMI(lines,text) > 1.0
⟹ grep CHAINS-TO process-text"
(let* ((returns-structs (get-all-structures-by-predicate "returns"))
(takes-structs (get-all-structures-by-predicate "takes"))
;; Pre-filter to tool-like words only
(tool-returns (filter (lambda (s) (tool-like-word? (car s))) returns-structs))
(tool-takes (filter (lambda (s) (tool-like-word? (car s))) takes-structs))
(count 0))
(for-each
(lambda (ret)
(let ((tool-a (car ret))
(output (cadr ret))
(ret-conf (caddr ret)))
(for-each
(lambda (tak)
(let ((tool-b (car tak))
(input (cadr tak))
(tak-conf (caddr tak)))
;; Don't chain a tool to itself
(when (not (string=? tool-a tool-b))
;; Check if output matches input directly or via PMI
(let ((pmi (if (string=? output input)
999.0 ;; Exact match
(compute-pmi output input))))
(when (> pmi 1.0)
(let ((conf (min ret-conf tak-conf)))
(store-rule! "returns" tool-a output
"chains-to" tool-a tool-b
"chaining" conf)
(set! count (+ count 1))))))))
tool-takes)))
tool-returns)
count))
(define (discover-slot-binding-rules!)
"For tool inputs with resolvable bindings.
Only for tool-like subjects.
grep TAKES directory + resolve-binding('directory') = wirecore
⟹ BIND directory=wirecore for grep"
(let ((takes-structs (get-all-structures-by-predicate "takes"))
(count 0))
(for-each
(lambda (s)
(let* ((tool (car s))
(input (cadr s))
(conf (caddr s))
(binding (resolve-binding input)))
(when (and binding (tool-like-word? tool))
(store-rule! "takes" tool input
"slot-binding" tool input
"slot-binding" conf)
(set! count (+ count 1)))))
takes-structs)
count))
(define (discover-applicability-rules!)
"For vague words PMI-reachable to a tool.
vagueness(keypair) > 0.01 + PMI-path(keypair → grep) within 2 hops
⟹ grep APPLICABLE-FOR keypair
Uses 2-hop limit to keep PMI walk fast."
(let ((all-words (get-all-words))
(tool-names (map car *tool-bindings*))
(count 0))
(for-each
(lambda (word)
(let ((vague (unit-vagueness word))
(freq (/ (get-unit-count word) (max 1 *total-observations*))))
;; Only consider genuinely vague domain-specific words
;; Skip predicates, tools, and high-frequency function words
(when (and (> vague 0.01)
(< freq 0.03)
(not (member word *all-predicate-words*))
(not (member word tool-names)))
;; Check if word is PMI-reachable to any tool (within 2 hops)
(for-each
(lambda (tool-name)
(let ((path (pmi-walk word tool-name 2)))
(when path
(store-rule! "vague" word (format #f "~,3f" vague)
"applicable-for" tool-name word
"applicability" vague)
(set! count (+ count 1)))))
tool-names))))
all-words)
count))
(define (discover-all-rules!)
"Master function: run all five rule discovery templates.
Returns total count of rules discovered."
(let ((pre (discover-precondition-rules!))
(post (discover-postcondition-rules!))
(chain (discover-chaining-rules!))
(slot (discover-slot-binding-rules!))
(app (discover-applicability-rules!)))
(let ((total (+ pre post chain slot app)))
(display (format #f "[rules] Discovered ~a rules: ~a precondition, ~a postcondition, ~a chaining, ~a slot-binding, ~a applicability\n"
total pre post chain slot app))
total)))
;; ── Rule Queries ──
(define (get-all-rules)
"Get all ImplicationLinks as structured data.
Returns ((rule-type antecedent-pred subj obj consequent-pred csubj cobj confidence) ...)"
(let ((impls (cog-get-atoms 'ImplicationLink #t)))
(filter-map
(lambda (impl)
(let* ((outgoing (cog-outgoing-set impl))
(ante (car outgoing))
(cons (cadr outgoing))
;; Antecedent parts
(ante-out (cog-outgoing-set ante))
(ante-pred-name (cog-name (car ante-out)))
(ante-list (cadr ante-out))
(ante-args (cog-outgoing-set ante-list))
(ante-subj (cog-name (car ante-args)))
(ante-obj (cog-name (cadr ante-args)))
;; Consequent parts
(cons-out (cog-outgoing-set cons))
(cons-pred-name (cog-name (car cons-out)))
(cons-list (cadr cons-out))
(cons-args (cog-outgoing-set cons-list))
(cons-subj (cog-name (car cons-args)))
(cons-obj (cog-name (cadr cons-args)))
;; Metadata
(rt-val (cog-value impl (Predicate "rule-type")))
(rule-type (if rt-val (car (cog-value->list rt-val)) "unknown"))
(conf-val (cog-value impl (Predicate "confidence")))
(conf (if conf-val (car (cog-value->list conf-val)) 0)))
;; Strip word: prefixes
(let ((strip (lambda (s) (if (string-prefix? "word:" s) (substring s 5) s))))
(list rule-type
ante-pred-name (strip ante-subj) (strip ante-obj)
cons-pred-name (strip cons-subj) (strip cons-obj)
conf))))
impls)))
(define (query-rules-by-type type-name)
"Filter rules by type string."
(filter (lambda (r) (string=? (car r) type-name))
(get-all-rules)))
(define (query-preconditions tool)
"What does TOOL need before it can run?"
(let ((rules (query-rules-by-type "precondition")))
(filter-map
(lambda (r)
;; consequent is: is-precondition-of INPUT TOOL
(and (string=? (list-ref r 6) tool)
(list-ref r 5)))
rules)))
(define (query-postconditions tool)
"What does TOOL produce?"
(let ((rules (query-rules-by-type "postcondition")))
(filter-map
(lambda (r)
;; consequent is: is-postcondition-of OUTPUT TOOL
(and (string=? (list-ref r 6) tool)
(list-ref r 5)))
rules)))
(define (query-chains-to tool)
"What can TOOL's output feed into?"
(let ((rules (query-rules-by-type "chaining")))
(filter-map
(lambda (r)
;; consequent is: chains-to TOOL-A TOOL-B
(and (string=? (list-ref r 5) tool)
(list-ref r 6)))
rules)))
(define (show-rules)
"Formatted display of all rules grouped by type."
(let* ((rules (get-all-rules))
(types '("precondition" "postcondition" "chaining" "slot-binding" "applicability"))
(total (length rules)))
(if (= total 0)
"No inference rules discovered yet. Run /infer first."
(string-join
(cons (format #f "Inference rules (~a total):" total)
(append-map
(lambda (type)
(let ((typed (filter (lambda (r) (string=? (car r) type)) rules)))
(if (null? typed)
'()
(cons (format #f "\n ~a (~a):"
(string-upcase type) (length typed))
(map (lambda (r)
(format #f " ~a(~a, ~a) => ~a(~a, ~a) [~,2f]"
(list-ref r 1) (list-ref r 2) (list-ref r 3)
(list-ref r 4) (list-ref r 5) (list-ref r 6)
(list-ref r 7)))
typed)))))
types))
"\n"))))
;; ── Rule Verification ──
(define (verify-precondition-rules)
"Every precondition rule's tool actually has the input in its 'takes' structures.
Returns (pass-count fail-count failures)."
(let ((rules (query-rules-by-type "precondition"))
(passes 0) (fails 0) (failures '()))
(for-each
(lambda (r)
(let* ((input (list-ref r 5)) ;; the precondition
(tool (list-ref r 6)) ;; the tool
(takes (safe-string-list (query-takes tool))))
(if (member input takes)
(set! passes (+ passes 1))
(begin
(set! fails (+ fails 1))
(set! failures (cons (format #f "precondition ~a of ~a: not in takes" input tool) failures))))))
rules)
(list passes fails failures)))
(define (verify-postcondition-rules)
"Every postcondition rule's tool actually has the output in its 'returns' structures."
(let ((rules (query-rules-by-type "postcondition"))
(passes 0) (fails 0) (failures '()))
(for-each
(lambda (r)
(let* ((output (list-ref r 5))
(tool (list-ref r 6))
(returns (safe-string-list (query-returns tool))))
(if (member output returns)
(set! passes (+ passes 1))
(begin
(set! fails (+ fails 1))
(set! failures (cons (format #f "postcondition ~a of ~a: not in returns" output tool) failures))))))
rules)
(list passes fails failures)))
(define (verify-chaining-rules)
"Every chaining rule has valid output/input PMI match."
(let ((rules (query-rules-by-type "chaining"))
(passes 0) (fails 0) (failures '()))
(for-each
(lambda (r)
(let* ((tool-a (list-ref r 5))
(tool-b (list-ref r 6))
(returns-a (safe-string-list (query-returns tool-a)))
(takes-b (safe-string-list (query-takes tool-b)))
;; Check if any output of A PMI-matches any input of B
(matched (any (lambda (out)
(any (lambda (inp)
(or (string=? out inp)
(> (compute-pmi out inp) 1.0)))
takes-b))
returns-a)))
(if matched
(set! passes (+ passes 1))
(begin
(set! fails (+ fails 1))
(set! failures (cons (format #f "chain ~a→~a: no output/input PMI match" tool-a tool-b) failures))))))
rules)
(list passes fails failures)))
(define (verify-all-rules)
"Run all verification checks. Returns (total-passes total-fails all-failures)."
(let* ((v-pre (verify-precondition-rules))
(v-post (verify-postcondition-rules))
(v-chain (verify-chaining-rules))
(passes (+ (car v-pre) (car v-post) (car v-chain)))
(fails (+ (cadr v-pre) (cadr v-post) (cadr v-chain)))
(failures (append (caddr v-pre) (caddr v-post) (caddr v-chain))))
(list passes fails failures)))
;; ── Convenience ──
(define (discover-all-knowledge!)
"Discover structures and rules in one call."
(discover-all-structures!)
(discover-all-rules!))
;; ═══════════════════════════════════════════════════════════════════
;; GROUNDING & VAGUENESS SCORES
;; ═══════════════════════════════════════════════════════════════════
(define (unit-vagueness word)
"How uncertain are we about this word?"
(let ((count (get-unit-count word))
(assocs (get-associations word 10)))
(let* ((assoc-count (length assocs))
(assoc-strength (if (null? assocs) 0 (apply + (map car assocs))))
(evidence (+ count assoc-count assoc-strength)))
(/ 1.0 (+ 1 evidence)))))
(define (grounding-score word)
"How grounded is this word? Based on PMI with action words."
(let ((assocs (get-associations word 20)))
(apply + (filter-map
(lambda (assoc)
(and (member (cdr assoc) *action-predicates*)
(car assoc)))
assocs))))
(define (structural-score word)
"How well do we understand the structure? PMI with structure words."
(let ((assocs (get-associations word 20)))
(apply + (filter-map
(lambda (assoc)
(and (member (cdr assoc) *structure-predicates*)
(car assoc)))
assocs))))
;; ═══════════════════════════════════════════════════════════════════
;; VAGUENESS-DRIVEN LEARNING
;; ═══════════════════════════════════════════════════════════════════
(define (get-most-vague n)
"Get the N most vague units - highest learning priority"
(let* ((all-words (get-all-words))
(scored (map (lambda (w)
(cons (unit-vagueness w) w))
all-words))
(sorted (sort scored (lambda (a b) (> (car a) (car b))))))
(take sorted (min n (length sorted)))))
(define (get-learning-priorities)
"Get units sorted by learning priority (vagueness)"
(let* ((all-words (get-all-words))
(scored (map (lambda (w)
(list w
(unit-vagueness w)
(grounding-score w)
(structural-score w)))
all-words))
;; Higher vagueness = higher priority
;; Lower grounding = higher priority
(prioritized (sort scored
(lambda (a b)
(let ((vague-a (cadr a))
(vague-b (cadr b))
(ground-a (caddr a))
(ground-b (caddr b)))
;; Primary: higher vagueness
;; Secondary: lower grounding (ungrounded concepts need work)
(or (> vague-a vague-b)
(and (= vague-a vague-b)
(< ground-a ground-b))))))))
prioritized))
(define (vagueness-question word)
"Generate a question to reduce vagueness about WORD"
(let ((g-score (grounding-score word))
(s-score (structural-score word)))
(cond
;; High vagueness, low structure - need to know what it IS
((< s-score 1.0)
(format #f "What is ~a? What does ~a contain?" word word))
;; High vagueness, low grounding - need to know how to USE it
((< g-score 1.0)
(format #f "How do you use ~a? How do you create ~a?" word word))
;; Both low - need everything
(else
(format #f "What is ~a and how is it used?" word)))))
(define (show-learning-priorities n)
"Show top N learning priorities"
(let ((priorities (get-learning-priorities)))
(string-join
(cons (format #f "Top ~a learning priorities (by vagueness):\n" (min n (length priorities)))
(map (lambda (p)
(format #f " ~a: vagueness=~,2f grounding=~,2f structure=~,2f\n → ~a"
(car p) (cadr p) (caddr p) (cadddr p)
(vagueness-question (car p))))
(take priorities (min n (length priorities)))))
"\n")))
;; ═══════════════════════════════════════════════════════════════════
;; PROCESSING - Feed text and learn
;; ═══════════════════════════════════════════════════════════════════
(define (process-text! text)
"Process text: observe units and pairs in AtomSpace"
(let ((words (tokenize text)))
;; Observe each word
(for-each observe-unit! words)
;; Observe pairs within window
(let loop ((i 0))
(when (< i (length words))
(let ((w1 (list-ref words i)))
(let inner ((j (+ i 1)))
(when (and (< j (length words))
(< (- j i) *window-size*))
(observe-pair! w1 (list-ref words j))
(inner (+ j 1)))))
(loop (+ i 1))))
(length words)))
;; ═══════════════════════════════════════════════════════════════════
;; CALL/RESPONSE - Generate responses from AtomSpace knowledge
;; ═══════════════════════════════════════════════════════════════════
(define (is-question? text)
"Detect if text is a question"
(let ((lower (string-downcase text)))
(or (string-suffix? "?" text)
(string-prefix? "what " lower)
(string-prefix? "how " lower)
(string-prefix? "who " lower))))
(define (extract-query-term text)
"Extract the term being asked about"
(let* ((clean (string-trim-right text (lambda (c) (char=? c #\?))))
(words (tokenize clean))
(stop-words '("what" "is" "are" "the" "how" "do" "you" "can" "does"))
(content-words (filter (lambda (w) (not (member w stop-words))) words)))
(if (null? content-words)
#f
(car (reverse content-words)))))
(define (safe-string-list lst)
"Filter list to only valid non-empty strings"
(filter (lambda (x)
(and (string? x)
(not (string-null? x))))
lst))
(define (generate-response query-term)
"Generate response from AtomSpace knowledge"
(let ((count (get-unit-count query-term)))
(if (= count 0)
(format #f "I don't know about '~a' yet." query-term)
(let* ((assocs (get-associations query-term 5))
(assoc-words (safe-string-list (map cdr assocs)))
(contains (query-contains query-term))
(contains-words (safe-string-list contains))
(takes (safe-string-list (query-takes query-term)))
(returns (safe-string-list (query-returns query-term)))
(g-score (grounding-score query-term))
(s-score (structural-score query-term))
;; Build response parts from all discovered structures
(parts '()))
;; Accumulate known structural facts
(when (not (null? contains-words))
(set! parts (cons (format #f "~a contains: ~a"
query-term (string-join contains-words ", "))
parts)))
(when (not (null? takes))
(set! parts (cons (format #f "~a takes: ~a"
query-term (string-join takes ", "))
parts)))
(when (not (null? returns))
(set! parts (cons (format #f "~a returns: ~a"
query-term (string-join returns ", "))
parts)))
(cond
;; If we have any structured knowledge
((not (null? parts))
(string-join (reverse parts) ". "))
;; If we have associations
((not (null? assoc-words))
(format #f "~a relates to: ~a"
query-term
(string-join assoc-words ", ")))
;; Just count
(else
(format #f "I've seen '~a' ~a times but don't know what it relates to."
query-term count)))))))
(define (respond text)
"Main entry point: respond to text or learn from it"
(if (is-question? text)
(let ((term (extract-query-term text)))
(if term
(generate-response term)
"I couldn't understand what you're asking about."))
(begin
(process-text! text)
(format #f "Learned from: ~a" text))))
;; ═══════════════════════════════════════════════════════════════════
;; TOOLS - Capabilities the program can invoke
;; ═══════════════════════════════════════════════════════════════════
(define (tool-grep pattern path)
"Search for PATTERN in files under PATH, return matching lines (max 10)"
(let* ((cmd (format #f "grep -r -i --include='*.js' --include='*.scm' '~a' ~a 2>/dev/null | head -10"
pattern path))
(port (open-input-pipe cmd))
(lines '()))
(let loop ((line (read-line port)))
(if (eof-object? line)
(begin (close-pipe port) (reverse lines))
(begin
(set! lines (cons line lines))
(loop (read-line port)))))))
(define (tool-read-file path n)
"Read first N lines from a file"
(if (file-exists? path)
(let ((port (open-input-file path))
(lines '()))
(let loop ((line (read-line port)) (count 0))
(if (or (eof-object? line) (>= count n))
(begin (close-port port) (reverse lines))
(begin
(set! lines (cons line lines))
(loop (read-line port) (+ count 1))))))
'()))
;; ═══════════════════════════════════════════════════════════════════
;; QUERY FORMULATION - Pure PMI self-directed search
;; ═══════════════════════════════════════════════════════════════════
;; NO hardcoded search strategies. The program walks its own PMI graph
;; to reason about WHAT tool to use, WHERE to search, and WHAT pattern.
;; The only hardcoded piece is *tool-bindings* (concept → executable).
(define (gap-type word)
"Classify the knowledge gap for WORD"
(let ((g (grounding-score word))
(s (structural-score word))
(v (unit-vagueness word)))
(cond
((and (< g 1.0) (< s 1.0)) 'unknown)
((and (> s 1.0) (< g 1.0)) 'ungrounded)
((and (> g 1.0) (< s 1.0)) 'unstructured)
(else 'grounded))))
(define (pmi-walk word target-concept max-hops)
"Walk the PMI graph from WORD toward TARGET-CONCEPT.
Returns the path if found within MAX-HOPS, or #f.
This is how the program reasons: 'verify' → 'anproto' → 'wirecore'"
(let walk ((current word) (hops 0) (visited '()))
(cond
((string=? current target-concept) (reverse (cons current visited)))
((>= hops max-hops) #f)
((member current visited) #f)
(else
(let* ((assocs (get-associations current 10))
(candidates (filter (lambda (a)
(and (string? (cdr a))
(not (member (cdr a) visited))
(not (member (cdr a) *structure-predicates*))))
assocs)))
;; Try each association in PMI order (highest first)
(let try ((remaining candidates))
(if (null? remaining)
#f
(or (walk (cdr (car remaining))
(+ hops 1)
(cons current visited))
(try (cdr remaining))))))))))
(define (resolve-binding concept)
"Look up the real-world binding for a concept name.
Returns the binding value or #f."
(let ((entry (assoc concept *tool-bindings*)))
(if entry (cdr entry) #f)))
(define (find-tool-for-action word)
"Use PMI to find what tool can help learn about WORD.
Walks associations looking for known tool concepts."
(let ((tool-names (map car *tool-bindings*)))
;; Check direct associations first
(let ((assocs (get-associations word 15)))
(let ((direct (filter (lambda (a) (member (cdr a) tool-names)) assocs)))
(if (not (null? direct))
(cdr (car direct)) ;; Return best direct tool match
;; Try PMI walk - can we reach a tool in 2-3 hops?
(let try ((tools tool-names))
(if (null? tools)
#f
(or (and (pmi-walk word (car tools) 3) (car tools))
(try (cdr tools))))))))))
(define (find-search-location word)
"Use PMI to find WHERE to search for WORD.
Walks associations looking for known location concepts (codebase, directory)."
(let ((location-hints '("wirecore" "codebase" "directory" "files")))
(let ((assocs (get-associations word 15)))
;; Direct association with a location?
(let ((direct (filter (lambda (a) (member (cdr a) location-hints)) assocs)))
(if (not (null? direct))
(cdr (car direct))
;; PMI walk to find location
(let try ((locs location-hints))
(if (null? locs)
#f
(or (and (pmi-walk word (car locs) 3) (car locs))
(try (cdr locs))))))))))
(define (predict-tool-inputs tool-name goal-word)
"Use PMI to fill the input slots of a tool.
For each input that TOOL takes, walk PMI from GOAL-WORD to find a value.
Returns alist of (slot . value) pairs."
(let ((inputs (safe-string-list (query-takes tool-name))))
(map (lambda (input-slot)
;; Try to resolve the input slot value:
;; 1. If slot matches a known binding, use that
;; 2. PMI walk from goal-word toward the slot concept
;; 3. Fallback: use the goal word itself
(let* ((binding (resolve-binding input-slot))
(pmi-path (and (not binding)
(pmi-walk goal-word input-slot 3)))
(value (cond
(binding binding)
(pmi-path (last pmi-path))
(else goal-word))))
(cons input-slot value)))
inputs)))
(define (reason-search-plan word)
"Use pure PMI reasoning to formulate a search plan for WORD.
Returns: ((tool . <name>) (location . <concept>) (patterns . (<list>)))
or #f if the program can't reason about how to search.
If the tool has discovered 'takes' structures, uses predict-tool-inputs
for slot filling. Otherwise falls back to PMI association scanning."
(let ((tool (find-tool-for-action word))
(location (find-search-location word)))
(if (and tool location)
;; Check if the tool has discovered input structures
(let ((tool-inputs (safe-string-list (query-takes tool))))
(if (not (null? tool-inputs))
;; Use structured prediction: fill discovered slots
(let* ((predicted (predict-tool-inputs tool word))
(patterns (cons word
(filter-map
(lambda (slot-val)
(let ((val (cdr slot-val)))
(and (string? val)
(not (string=? val word))
val)))
predicted))))
(list (cons 'tool tool)
(cons 'location location)
(cons 'patterns patterns)
(cons 'inputs predicted)
(cons 'reasoning
(format #f "~a → ~a(~a) [slots: ~a] → search ~a"
word tool location
(string-join
(map (lambda (p)
(format #f "~a=~a" (car p) (cdr p)))
predicted) ", ")
(string-join patterns ", ")))))
;; Fallback: original PMI association scanning
(let* ((assocs (get-associations word 5))
(context-words (filter (lambda (a)
(and (not (member (cdr a) *all-predicate-words*))
(> (car a) 0.5)))
assocs))
(patterns (cons word
(filter-map
(lambda (a)
(let ((other (cdr a)))
(and (not (string=? other word))
(not (member other '("grep" "search" "wirecore"
"codebase" "files" "directory"
"tool" "pattern")))
(string-append word ".*" other))))
context-words))))
(list (cons 'tool tool)
(cons 'location location)
(cons 'patterns patterns)
(cons 'reasoning
(format #f "~a → ~a(~a) → search ~a"
word
(or tool "?")
location
(string-join patterns ", ")))))))
;; Can't reason about search - report what's missing
(begin
(display (format #f "[reason] Cannot form search plan for '~a':\n" word))
(display (format #f "[reason] Tool found: ~a\n" (or tool "NO")))
(display (format #f "[reason] Location found: ~a\n" (or location "NO")))
(when (not tool)
(display "[reason] Missing: no PMI path to any tool concept\n"))
(when (not location)
(display "[reason] Missing: no PMI path to any location concept\n"))
#f))))
;; ═══════════════════════════════════════════════════════════════════
;; SELF-LEARNING LOOP - Vagueness drives knowledge acquisition
;; ═══════════════════════════════════════════════════════════════════
(define (process-text-auto! text)
"Process text from self-acquired source (tracks auto-observations)"
(let ((n (process-text! text)))
(set! *auto-observations* (+ *auto-observations* n))
n))
(define (process-text-manual! text)
"Process text from human-fed source (tracks manual observations)"
(let ((n (process-text! text)))
(set! *manual-observations* (+ *manual-observations* n))
n))
(define (learn-about! word)
"Attempt to learn about WORD using pure PMI reasoning.
The program reasons about WHAT tool to use and WHERE to search
by walking its own association graph. No hardcoded strategies."
(let ((before-vague (unit-vagueness word))
(before-ground (grounding-score word))
(before-struct (structural-score word))
(total-learned 0))
(display (format #f "\n[learn] Target: ~a (gap: ~a, vagueness: ~,3f)\n"
word (gap-type word) before-vague))
;; Step 1: Use PMI to reason about search plan
(let ((plan (reason-search-plan word)))
(if (not plan)
;; PMI couldn't form a plan - the program doesn't know enough yet
(display (format #f "[learn] BLOCKED: Cannot reason about how to search for '~a'.\n Need more bootstrap data about tools and locations.\n" word))
;; Step 2: Execute the PMI-reasoned plan
(let* ((tool-name (assoc-ref plan 'tool))
(location-concept (assoc-ref plan 'location))
(patterns (assoc-ref plan 'patterns))
(reasoning (assoc-ref plan 'reasoning))
;; Resolve concept names to real-world values
(location-path (resolve-binding location-concept)))
(display (format #f "[learn] PMI reasoning: ~a\n" reasoning))
(if (not location-path)
(display (format #f "[learn] BLOCKED: Know location concept '~a' but no binding to real path.\n" location-concept))
;; Execute search with each pattern
(for-each
(lambda (pattern)
(let ((results (tool-grep pattern location-path)))
(when (not (null? results))
(display (format #f "[learn] Found ~a results for '~a' in ~a\n"
(length results) pattern location-concept))
;; Process each result line as self-acquired text
(for-each
(lambda (line)
(let ((colon-pos (string-index line #\:)))
(when colon-pos
(let ((code (substring line (+ colon-pos 1))))
(process-text-auto! code)
(set! total-learned (+ total-learned 1))))))
results))))
patterns)))))
;; Re-discover structures (including tool-use)
(discover-contains! word)
(discover-action! word)
(discover-tool-use! word)
;; Report
(let ((after-vague (unit-vagueness word))
(after-ground (grounding-score word))
(after-struct (structural-score word)))
(display (format #f "[learn] Processed ~a lines (auto-acquired)\n" total-learned))
(display (format #f "[learn] Vagueness: ~,3f → ~,3f (~a)\n"
before-vague after-vague
(if (< after-vague before-vague) "REDUCED" "unchanged")))
(display (format #f "[learn] Grounding: ~,2f → ~,2f\n" before-ground after-ground))
(display (format #f "[learn] Structure: ~,2f → ~,2f\n" before-struct after-struct))
total-learned)))
(define (learnable-word? word)
"Can we potentially learn about WORD via PMI search?
True if the word has PMI paths to both a tool and a location."
(and (find-tool-for-action word)
(find-search-location word)))
(define (learning-loop! max-iterations target-vagueness)
"Run the vagueness-driven learning loop.
Targets are chosen by PMI - not hardcoded word lists.
A word is a target if: (1) it's vague, and (2) PMI can reason a search plan."
(display "\n══════════════════════════════════════\n")
(display " VAGUENESS-DRIVEN LEARNING LOOP\n")
(display (format #f " (pure PMI self-directed)\n"))
(display "══════════════════════════════════════\n\n")
(display (format #f "Bootstrap cost so far: ~a manual observations\n" *manual-observations*))
(display (format #f "Self-acquired so far: ~a auto observations\n\n" *auto-observations*))
(let loop ((iteration 1))
(when (<= iteration max-iterations)
(let* ((priorities (get-learning-priorities))
;; Filter to words we can actually reason about searching
;; Skip structure/action predicates and very short/common words
(skip-words (append *all-predicate-words*
'("grep" "search" "tool" "pattern" "files"
"directory" "codebase" "wirecore"
"the" "and" "for" "that" "this" "with")))
(relevant (filter (lambda (p)
(let ((w (car p)))
(and (not (member w skip-words))
(> (get-unit-count w) 0)
(learnable-word? w))))
priorities))
(target (if (null? relevant) #f (car relevant))))
(if (not target)
(begin
(display "[loop] No learnable targets found.\n")
(display "[loop] PMI cannot form search plans for remaining vague words.\n")
(display "[loop] More bootstrap data may be needed.\n"))
(let ((word (car target))
(vague (cadr target)))
(display (format #f "\n── Iteration ~a/~a ──\n" iteration max-iterations))
(if (<= vague target-vagueness)
(display (format #f "[loop] ~a vagueness ~,3f is below target ~,3f. Done.\n"
word vague target-vagueness))
(begin
(learn-about! word)
(loop (+ iteration 1)))))))))
(display "\n══════════════════════════════════════\n")
(display " LEARNING LOOP COMPLETE\n")
(display "══════════════════════════════════════\n")
;; Bootstrap cost report
(display (format #f "\nBootstrap cost: ~a manual observations\n" *manual-observations*))
(display (format #f "Self-acquired: ~a auto observations\n" *auto-observations*))
(display (format #f "Ratio: ~a\n"
(if (> *manual-observations* 0)
(format #f "1:~,1f (manual:auto)"
(/ (* 1.0 *auto-observations*) *manual-observations*))
"no manual data")))
;; Final grounding report - show ALL words that improved
(display "\nFinal grounding state (words with observations):\n")
(let* ((all (get-all-words))
(with-counts (filter (lambda (w)
(and (> (get-unit-count w) 1)
(not (member w *structure-predicates*))
(not (member w '("the" "and" "for" "that")))))
all))
(scored (map (lambda (w)
(list w (grounding-score w) (structural-score w)
(unit-vagueness w) (gap-type w)))
with-counts))
(sorted (sort scored (lambda (a b) (> (cadddr a) (cadddr b))))))
(for-each
(lambda (s)
(display (format #f " ~a: ground=~,2f struct=~,2f vague=~,3f [~a]\n"
(car s) (cadr s) (caddr s) (cadddr s)
(symbol->string (car (cddddr s))))))
(take sorted (min 20 (length sorted))))))
;; ═══════════════════════════════════════════════════════════════════
;; DISPLAY
;; ═══════════════════════════════════════════════════════════════════
(define (show-stats)
(format #f "Words: ~a\nObservations: ~a (manual: ~a, auto: ~a)\nPairs: ~a\nStructures: ~a"
(length (get-all-words))
*total-observations*
*manual-observations*
*auto-observations*
(length (cog-get-atoms 'EdgeLink #t))
(length (cog-get-atoms 'EvaluationLink #t))))
(define (show-unit word)
(let* ((count (get-unit-count word))
(vague (unit-vagueness word))
(g-score (grounding-score word))
(s-score (structural-score word))
(assocs (get-associations word 10))
(contains (safe-string-list (query-contains word)))
(takes (safe-string-list (query-takes word)))
(returns (safe-string-list (query-returns word)))
(sequences (safe-string-list (query-then word)))
(assoc-strs (safe-string-list
(map (lambda (a)
(if (and (pair? a) (number? (car a)) (string? (cdr a)))
(format #f "~a(~,1f)" (cdr a) (car a))
#f))
(take assocs (min 5 (length assocs)))))))
(string-join
(append
(list
(format #f "~a:" word)
(format #f " count: ~a" count)
(format #f " vagueness: ~,2f" vague)
(format #f " grounding: ~,2f" g-score)
(format #f " structure: ~,2f" s-score)
(format #f " associations: ~a"
(if (null? assoc-strs) "none" (string-join assoc-strs ", ")))
(format #f " contains: ~a"
(if (null? contains) "unknown" (string-join contains ", ")))
(format #f " takes: ~a"
(if (null? takes) "unknown" (string-join takes ", ")))
(format #f " returns: ~a"
(if (null? returns) "unknown" (string-join returns ", "))))
(if (null? sequences) '()
(list (format #f " then: ~a" (string-join sequences ", ")))))
"\n")))