;
; atomspace-matrix-daemon.scm - Background AtomSpace learning daemon (matrix version)
;
; Architecture:
; [Client] --socket--> [Daemon] ---> [AtomSpace + Matrix Module]
; |
; [Learning loop]
; (batch MI, O(1) lookups, MeetLink queries)
;
; Key difference from atomspace-daemon.scm:
; - Uses (opencog matrix) for batch MI computation
; - Queries are O(1) cached lookups (never block)
; - MI recomputed periodically after new data accumulates
;
(use-modules (opencog))
(use-modules (ice-9 format))
(use-modules (ice-9 rdelim))
(use-modules (ice-9 popen))
(use-modules (srfi srfi-1))
(primitive-load "atomspace-matrix-learner.scm")
;; ═══════════════════════════════════════════════════════════════════
;; CONFIGURATION
;; ═══════════════════════════════════════════════════════════════════
(define *socket-path* "/tmp/atomspace-matrix-learner.sock")
(define *pid-file* "/tmp/atomspace-matrix-learner.pid")
(define *log-file* "/tmp/atomspace-matrix-learner.log")
(define *learn-interval* 10) ;; Seconds between learning iterations
(define *mi-recompute-interval* 60) ;; Seconds between MI recomputations
(define *running* #t)
;; ═══════════════════════════════════════════════════════════════════
;; LAYER EMERGENCE DETECTION
;; ═══════════════════════════════════════════════════════════════════
(define *cached-layers* #f)
(define *layers-last-check* 0)
(define *layers-cache-ttl* 30)
(define (layer-status)
"Check which layers have emerged (cached for performance)"
(let ((now (current-time)))
(when (or (not *cached-layers*)
(> (- now *layers-last-check*) *layers-cache-ttl*))
(set! *cached-layers* (compute-layer-status))
(set! *layers-last-check* now))
*cached-layers*))
(define (compute-layer-status)
"Compute layer emergence - uses cached MI (cheap)"
(let* ((words (length (get-all-words)))
(pairs (length (*pair-stars* 'get-all-elts)))
(evals (length (cog-get-atoms 'EvaluationLink #t)))
(l1 (and (> words 0) (> pairs 0)))
(l2 (and l1
(> (get-unit-count "atomspace") 0)
(let ((a (get-associations "atomspace" 3)))
(and (not (null? a)) (> (car (car a)) 0.5)))))
(l3 (and l2 (> evals 0)))
(l4 (and l2 (> (get-unit-count "atomspace") 0)))
(l5 (and l4
(> (get-unit-count "grep") 0)
(> (get-unit-count "wirecore") 0)))
(l6 (and l5
(> (get-unit-count "keypair") 0)
(find-tool-for-action "keypair")
(find-search-location "keypair")))
(l7 (and l6 (> *auto-observations* 0))))
(list
(cons 1 l1) (cons 2 l2) (cons 3 l3) (cons 4 l4)
(cons 5 l5) (cons 6 l6) (cons 7 l7))))
(define (show-layers)
"Display layer emergence status"
(let ((layers (layer-status))
(names '("Counting" "Association" "Structure" "Response"
"Self-awareness" "Tool reasoning" "Autonomous action")))
(string-join
(cons "Layer emergence:"
(map (lambda (l name)
(format #f " ~a. ~a: ~a"
(car l) name
(if (cdr l) "EMERGED" "not yet")))
layers names))
"\n")))
;; ═══════════════════════════════════════════════════════════════════
;; ONE LEARNING STEP
;; ═══════════════════════════════════════════════════════════════════
(define *learning-iteration* 0)
(define (learning-step!)
"Run one step of the vagueness-driven learning loop.
Returns a status string."
(set! *learning-iteration* (+ *learning-iteration* 1))
(let* ((priorities (get-learning-priorities))
(skip-words (append *structure-predicates* *action-predicates*
'("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)
(format #f "[step ~a] No learnable targets. Need more bootstrap data."
*learning-iteration*)
(let ((word (car target))
(vague (cadr target)))
(display (format #f "[step ~a] Learning about '~a' (vagueness: ~,3f)\n"
*learning-iteration* word vague))
(let ((learned (learn-about! word)))
;; Recompute MI if we learned new data
(when (> learned 0)
(recompute-mi!))
(format #f "[step ~a] Learned ~a lines about '~a'"
*learning-iteration* learned word))))))
;; ═══════════════════════════════════════════════════════════════════
;; COMMAND PROCESSING
;; ═══════════════════════════════════════════════════════════════════
(define (process-command line)
"Process a command or query, return response string"
(cond
((string-prefix? "/quit" line)
'quit)
((string-prefix? "/stats" line)
(show-stats))
((string-prefix? "/layers" line)
(show-layers))
((string-prefix? "/recompute" line)
(set! *mi-stale* #t)
(recompute-mi!)
"MI recomputed for all pairs.")
((string-prefix? "/assoc " line)
(let* ((word (string-trim-both (substring line 7)))
(assocs (get-associations word 10)))
(if (null? assocs)
(format #f "No associations for '~a'" word)
(string-join
(cons (format #f "Associations for '~a':" word)
(map (lambda (p)
(format #f " ~a (MI: ~,2f)" (cdr p) (car p)))
assocs))
"\n"))))
((string-prefix? "/unit " line)
(let ((word (string-trim-both (substring line 6))))
(if (> (get-unit-count word) 0)
(show-unit word)
(format #f "Unknown word: '~a'" word))))
((string-prefix? "/reason " line)
(let* ((word (string-trim-both (substring line 8)))
(plan (reason-search-plan word)))
(if plan
(format #f "Search plan for '~a':\n ~a" word (assoc-ref plan 'reasoning))
(format #f "Cannot form search plan for '~a'" word))))
((string-prefix? "/learn " line)
(let* ((word (string-trim-both (substring line 7)))
(learned (learn-about! word)))
(when (> learned 0) (recompute-mi!))
(format #f "Learned ~a lines about '~a'" learned word)))
((string-prefix? "/step" line)
(learning-step!))
((string-prefix? "/bootstrap " line)
(let ((text (string-trim-both (substring line 11))))
(process-text-manual! text)
(set! *mi-stale* #t)
(format #f "Bootstrapped: ~a" text)))
((string-prefix? "/discover" line)
(discover-all-structures!)
(format #f "Structures discovered. EvaluationLinks: ~a"
(length (cog-get-atoms 'EvaluationLink #t))))
((string-prefix? "/priorities" line)
(show-learning-priorities 10))
((string-prefix? "/cost" line)
(format #f "Bootstrap cost: ~a manual observations\nSelf-acquired: ~a auto observations\nRatio: 1:~,1f"
*manual-observations* *auto-observations*
(if (> *manual-observations* 0)
(/ (* 1.0 *auto-observations*) *manual-observations*)
0)))
((string-prefix? "/help" line)
(string-join
'("Commands (matrix daemon):"
" /stats - Show word/pair/observation counts"
" /layers - Show which capability layers have emerged"
" /recompute - Force MI recomputation"
" /assoc <word> - Show MI associations for word"
" /unit <word> - Show full knowledge state for word"
" /reason <word> - Show MI-reasoned search plan for word"
" /learn <word> - Execute one search about word"
" /step - Run one learning iteration (most vague target)"
" /bootstrap <text> - Feed manual knowledge"
" /discover - Run structure discovery on all words"
" /priorities - Show learning priorities by vagueness"
" /cost - Show bootstrap cost vs self-acquired data"
" <question> - Ask a question (what is X, how do you Y)"
" <text> - Feed text for learning"
" /quit - Shut down")
"\n"))
((string-prefix? "/" line)
"Unknown command. Try /help")
;; Question detection - O(1) lookups!
((is-question? line)
(respond line))
;; Regular text - learn from it
(else
(process-text-manual! line)
(set! *mi-stale* #t)
(format #f "Learned from: ~a" line))))
;; ═══════════════════════════════════════════════════════════════════
;; BOOTSTRAP
;; ═══════════════════════════════════════════════════════════════════
(define (load-knowledge filename)
"Load and process a knowledge file (counts as manual bootstrap)"
(if (not (file-exists? filename))
(display (format #f "[boot] File not found: ~a\n" filename))
(begin
(display (format #f "[boot] Loading ~a...\n" filename))
(let ((port (open-input-file filename))
(count 0))
(let loop ((line (read-line port)))
(if (eof-object? line)
(begin (close-port port)
(display (format #f "[boot] Processed ~a lines\n" count)))
(begin
(let ((trimmed (string-trim-both line)))
(unless (or (string-null? trimmed)
(string-prefix? "#" trimmed))
(process-text-manual! trimmed)
(set! count (+ count 1))))
(loop (read-line port)))))))))
(define (bootstrap!)
"Load initial knowledge files, batch compute MI, discover structures"
(display "[boot] Bootstrapping (matrix version)...\n")
(load-knowledge "data/self-knowledge.txt")
(load-knowledge "data/anproto-knowledge.txt")
;; Batch MI computation - THE key difference
(display "[boot] Computing batch MI...\n")
(recompute-mi!)
(discover-all-structures!)
(display (format #f "[boot] Done. ~a\n" (show-stats)))
(display (format #f "[boot] ~a\n" (show-layers))))
;; ═══════════════════════════════════════════════════════════════════
;; SOCKET SERVER
;; ═══════════════════════════════════════════════════════════════════
(define (start-server)
"Start the daemon with socket server + learning loop"
(bootstrap!)
(when (file-exists? *socket-path*)
(delete-file *socket-path*))
(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
(bind sock AF_UNIX *socket-path*)
(listen sock 5)
(fcntl sock F_SETFL (logior (fcntl sock F_GETFL) O_NONBLOCK))
(display (format #f "
═══════════════════════════════════════════════════════════════════
AtomSpace Matrix Learning Daemon (batch MI, O(1) lookups)
Socket: ~a
~a
═══════════════════════════════════════════════════════════════════
Waiting for connections... (Ctrl+C to stop)
Query: echo '/stats' | socat - UNIX-CONNECT:~a
echo 'what is keypair' | socat - UNIX-CONNECT:~a
" *socket-path* (show-stats) *socket-path* *socket-path*))
(sigaction SIGINT
(lambda (sig)
(display "\n[daemon] Shutting down...\n")
(close sock)
(when (file-exists? *socket-path*)
(delete-file *socket-path*))
(when (file-exists? *pid-file*)
(delete-file *pid-file*))
(exit 0)))
;; Main loop
(let ((last-learn (current-time))
(last-mi-recompute (current-time)))
(let loop ()
(when *running*
(let ((client-info
(catch 'system-error
(lambda () (accept sock))
(lambda (key . args) #f))))
(if client-info
;; Handle client - queries use O(1) cached MI
(let ((client (car client-info)))
(handle-client client)
(close client))
;; No client - maybe learn or recompute MI
(begin
(let ((now (current-time)))
;; Periodic MI recomputation if data changed
(when (and *mi-stale*
(> (- now last-mi-recompute) *mi-recompute-interval*))
(display "[daemon] Recomputing MI (data changed)...\n")
(recompute-mi!)
(set! last-mi-recompute now))
;; Learning iteration
(when (> (- now last-learn) *learn-interval*)
(display (format #f "\n[daemon] Learning iteration ~a...\n"
(+ *learning-iteration* 1)))
(display (format #f "~a\n" (learning-step!)))
(set! last-learn now)))
(usleep 100000))))
(loop))))))
(define (handle-client client)
"Handle one client connection"
(let loop ()
(let ((line (read-line client)))
(cond
((eof-object? line) #f)
(else
(let ((trimmed (string-trim-both line)))
(unless (string-null? trimmed)
(display (format #f "[query] ~a\n" trimmed))
(let ((response (process-command trimmed)))
(if (eq? response 'quit)
(begin
(display "Shutting down.\n" client)
(set! *running* #f))
(begin
(display response client)
(newline client)
(loop)))))))))))
;; ═══════════════════════════════════════════════════════════════════
;; ENTRY POINT
;; ═══════════════════════════════════════════════════════════════════
(when (and (defined? 'command-line)
(> (length (command-line)) 0))
(let ((args (command-line)))
(cond
((and (> (length args) 1) (string=? (cadr args) "run"))
(start-server))
((and (> (length args) 1) (string=? (cadr args) "test"))
(bootstrap!)
(display "\n")
(display (show-layers))
(display "\n\n")
(display "Testing one learning step:\n")
(display (learning-step!))
(display "\n"))
(else
(display "Usage:\n guile atomspace-matrix-daemon.scm run - Start daemon\n guile atomspace-matrix-daemon.scm test - Quick test\n")))))