;
; daemon.scm - Background learning daemon
;
; Runs continuously, accepts input via Unix socket.
; Idles when no input (zero CPU). Batches expensive operations.
;
; Architecture:
; [Client] --socket--> [Daemon] ---> [AtomSpace]
; |
; [Batch jobs]
; (PMI, clustering, save)
;
(add-to-load-path (dirname (current-filename)))
(use-modules (opencog))
(use-modules (opencog exec))
(use-modules (ice-9 format))
(use-modules (ice-9 rdelim))
(use-modules (srfi srfi-1))
;; Load layers
(load "layer1.scm")
(load "layer2.scm")
(load "layer3.scm")
(load "vagueness.scm")
(load "persist.scm")
(load "autodiscover.scm")
;; ═══════════════════════════════════════════════════════════════════
;; CONFIGURATION
;; ═══════════════════════════════════════════════════════════════════
(define *socket-path* "/tmp/atomspace-chatbot.sock")
(define *batch-interval* 60) ; Seconds between batch jobs
(define *max-words* 10000) ; Prune if exceeded
(define *min-count-to-keep* 2) ; Prune words seen less than this
;; ═══════════════════════════════════════════════════════════════════
;; RESOURCE MANAGEMENT
;; ═══════════════════════════════════════════════════════════════════
(define *inputs-since-batch* 0)
(define *last-batch-time* (current-time))
(define (maybe-run-batch)
"Run batch operations if enough time/inputs have passed"
(let ((now (current-time)))
(when (or (> *inputs-since-batch* 100)
(> (- now *last-batch-time*) *batch-interval*))
(run-batch-jobs)
(set! *inputs-since-batch* 0)
(set! *last-batch-time* now))))
(define (run-batch-jobs)
"Expensive operations run periodically, not on every input"
(display "[batch] Running batch jobs...\n")
;; Prune low-frequency items if too many words
(when (> (layer1-word-count) *max-words*)
(prune-low-frequency))
;; Auto-save
(maybe-auto-save)
(display "[batch] Done.\n"))
(define (prune-low-frequency)
"Remove words/pairs seen less than threshold"
(display "[prune] Pruning low-frequency items...\n")
(let ((pruned 0))
(for-each
(lambda (node)
(let ((name (cog-name node)))
(when (string-prefix? "word:" name)
(let ((count (get-word-count node)))
(when (< count *min-count-to-keep*)
(cog-delete-recursive! node)
(set! pruned (+ 1 pruned)))))))
(cog-get-atoms 'ConceptNode #t))
(display (format #f "[prune] Removed ~a low-frequency items\n" pruned))))
;; ═══════════════════════════════════════════════════════════════════
;; COMMAND PROCESSING
;; ═══════════════════════════════════════════════════════════════════
(define (process-command line)
"Process a line of input, return response string"
(cond
((string-prefix? "/quit" line)
(save-knowledge)
'quit)
((string-prefix? "/stats" line)
(format #f "words:~a pairs:~a clusters:~a relations:~a vagueness:~,2f"
(layer1-word-count)
(layer1-pair-count)
(layer2-cluster-count)
(layer3-relation-count)
(overall-vagueness)))
((string-prefix? "/assoc " line)
(let ((word (string-trim-both (substring line 7))))
(let ((assocs (layer1-associations word 5)))
(if (null? assocs)
(format #f "no associations for '~a'" word)
(string-join
(map (lambda (p) (format #f "~a:~,2f" (cdr p) (car p)))
assocs)
" ")))))
((string-prefix? "/pmi " line)
(let* ((parts (string-split (string-trim-both (substring line 5)) #\space))
(w1 (car parts))
(w2 (if (> (length parts) 1) (cadr parts) "")))
(if (string=? w2 "")
"usage: /pmi word1 word2"
(format #f "~,3f" (layer1-pmi w1 w2)))))
((string-prefix? "/cluster " line)
(let ((word (string-trim-both (substring line 9))))
(show-cluster word)))
((string-prefix? "/clusters" line)
(show-clusters))
((string-prefix? "/recluster" line)
(layer2-recluster)
(format #f "created ~a clusters" (layer2-cluster-count)))
((string-prefix? "/relations " line)
(let ((cluster (string-trim-both (substring line 11))))
(show-relations cluster)))
((string-prefix? "/relations" line)
(show-all-relations))
((string-prefix? "/vagueness " line)
(let ((word (string-trim-both (substring line 11))))
(show-word-vagueness word)))
((string-prefix? "/vagueness" line)
(show-overall-vagueness))
((string-prefix? "/gaps" line)
(show-knowledge-gaps))
((string-prefix? "/strengths" line)
(show-knowledge-strengths))
((string-prefix? "/suggest" line)
(suggest-learning-targets))
((string-prefix? "/analyze " line)
(let ((text (string-trim-both (substring line 9))))
(analyze-sentence text)))
;; Auto-discovery commands
((string-prefix? "/auto-rebuild" line)
(autodiscover-rebuild))
((string-prefix? "/auto-stats" line)
(show-autodiscover-stats))
((string-prefix? "/auto-level " line)
(let ((n (string->number (string-trim-both (substring line 12)))))
(if n (show-level n) "usage: /auto-level <number>")))
((string-prefix? "/save" line)
(save-knowledge)
"saved")
((string-prefix? "/help" line)
"commands: /stats /assoc /pmi /cluster /clusters /recluster /relations /vagueness /gaps /suggest /auto-rebuild /auto-stats /auto-level /save /quit")
((string-prefix? "/" line)
"unknown command (try /help)")
(else
;; Learn from input - both approaches
(layer1-process line)
(layer2-process line)
(layer3-process line)
(autodiscover-process line) ; Self-discovering approach
(set! *inputs-since-batch* (+ 1 *inputs-since-batch*))
(maybe-run-batch)
(format #f "learned ~a pairs" (layer1-count-for-text line)))))
;; ═══════════════════════════════════════════════════════════════════
;; SOCKET SERVER
;; ═══════════════════════════════════════════════════════════════════
(define (start-server)
"Start Unix socket server"
;; Load saved knowledge
(load-knowledge)
;; Remove old socket if exists
(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)
(display (format #f "
═══════════════════════════════════════════════════════════════════
AtomSpace Learning Daemon (Layer 1 + 2)
Socket: ~a
Words: ~a | Pairs: ~a | Clusters: ~a
═══════════════════════════════════════════════════════════════════
Waiting for connections... (Ctrl+C to stop)
" *socket-path* (layer1-word-count) (layer1-pair-count) (layer2-cluster-count)))
;; Handle Ctrl+C gracefully
(sigaction SIGINT
(lambda (sig)
(display "\n[daemon] Shutting down, saving...\n")
(save-knowledge)
(close sock)
(delete-file *socket-path*)
(exit 0)))
(let loop ()
(let* ((client-info (accept sock))
(client (car client-info)))
(handle-client client)
(close client)
(loop)))))
(define (handle-client client)
"Handle one client connection"
(let loop ()
(let ((line (read-line client)))
(cond
((eof-object? line)
#f) ; Client disconnected
(else
(let ((response (process-command (string-trim-both line))))
(if (eq? response 'quit)
(begin
(display "quit\n" client)
#f)
(begin
(display response client)
(newline client)
(loop)))))))))
;; ═══════════════════════════════════════════════════════════════════
;; ENTRY POINT
;; ═══════════════════════════════════════════════════════════════════
(define (main args)
(start-server))
;; Run if executed directly
(main (command-line))