hypercore-kb / opencog-kb / language-learning / chatbot / learner.scm

;
; learner.scm - Background learning daemon
;
; Processes queued messages in batches, runs clustering periodically.
; Designed to run continuously without blocking queries.
;

(use-modules (opencog))
(use-modules (ice-9 format))
(use-modules (srfi srfi-1))

;; Load dependencies
(primitive-load "layer1.scm")
(primitive-load "layer2.scm")
(primitive-load "layer3.scm")
(primitive-load "autodiscover.scm")
(primitive-load "persist.scm")
(primitive-load "queue.scm")

;; ═══════════════════════════════════════════════════════════════════
;; CONFIGURATION
;; ═══════════════════════════════════════════════════════════════════

(define *batch-size* 50)           ; Messages per batch
(define *batch-interval* 5)        ; Seconds between batch checks
(define *cluster-interval* 60)     ; Seconds between re-clustering
(define *save-interval* 300)       ; Seconds between saves (5 min)
(define *running* #t)

;; ═══════════════════════════════════════════════════════════════════
;; LEARNING OPERATIONS
;; ═══════════════════════════════════════════════════════════════════

(define (process-text text)
  "Process a single text through all layers"
  (layer1-process text)
  (layer2-process text)
  (layer3-process text)
  (autodiscover-process text))

(define (process-batch)
  "Process a batch of queued messages"
  (let ((messages (dequeue-batch *batch-size*)))
    (when (not (null? messages))
      (display (format #f "[learner] Processing ~a messages...~%" (length messages)))
      (for-each process-text messages)
      (display (format #f "[learner] Batch complete. Words: ~a, Pairs: ~a~%"
                       (layer1-word-count) (layer1-pair-count)))
      ;; Save after each batch so query can see updates
      (save-knowledge))
    (length messages)))

(define (run-clustering)
  "Run clustering algorithms"
  (display "[learner] Running clustering...~%")
  (layer2-recluster)
  (display (format #f "[learner] Clusters: ~a~%" (layer2-cluster-count)))

  ;; Also rebuild autodiscover layers
  (display "[learner] Rebuilding autodiscover levels...~%")
  (autodiscover-rebuild)
  (display (format #f "[learner] ~a~%" (show-autodiscover-stats))))

(define (save-state)
  "Save current knowledge to disk"
  (display "[learner] Saving knowledge...~%")
  (save-knowledge)
  (display "[learner] Save complete.~%"))

;; ═══════════════════════════════════════════════════════════════════
;; MAIN LOOP
;; ═══════════════════════════════════════════════════════════════════

(define (learner-loop)
  "Main learning loop"
  (let ((last-cluster-time (current-time))
        (last-save-time (current-time))
        (total-processed 0))

    (display "[learner] Starting learning daemon...~%")
    (display (format #f "[learner] Batch size: ~a, Batch interval: ~as~%"
                     *batch-size* *batch-interval*))
    (display (format #f "[learner] Cluster interval: ~as, Save interval: ~as~%"
                     *cluster-interval* *save-interval*))

    ;; Load existing knowledge
    (load-knowledge)
    (display (format #f "[learner] Loaded: ~a words, ~a pairs~%"
                     (layer1-word-count) (layer1-pair-count)))

    (while *running*
      ;; Process any pending messages
      (let ((processed (process-batch)))
        (set! total-processed (+ total-processed processed)))

      ;; Check if time for clustering
      (when (> (- (current-time) last-cluster-time) *cluster-interval*)
        (when (> (layer1-word-count) 10)  ; Only cluster if enough data
          (run-clustering))
        (set! last-cluster-time (current-time)))

      ;; Check if time for save
      (when (> (- (current-time) last-save-time) *save-interval*)
        (save-state)
        (set! last-save-time (current-time)))

      ;; Wait before next check
      (sleep *batch-interval*))

    ;; Final save on shutdown
    (display "[learner] Shutting down...~%")
    (save-state)
    (display (format #f "[learner] Total processed: ~a messages~%" total-processed))))

(define (stop-learner)
  "Signal learner to stop"
  (set! *running* #f))

;; ═══════════════════════════════════════════════════════════════════
;; ENTRY POINT
;; ═══════════════════════════════════════════════════════════════════

;; Run if executed directly
(when (and (defined? 'command-line)
           (> (length (command-line)) 1)
           (string=? (cadr (command-line)) "run"))
  (learner-loop))