And here comes my next accomplishment, again an “empty” chatbot that you may educate yourself.
The commented version is only a little bit different from the ready-to-paste one as it does not make use of a “dummy” variable d for “return”-ing out of loops, whereas the uncommented variant does.
Again, this has been done on an Adafruit Metro M4 Grand Central, with the modifier:
#elif defined(ADAFRUIT_GRAND_CENTRAL_M4)
#define WORKSPACESIZE 29820-SDSIZE /* Cells (8*bytes) /
#define DATAFLASHSIZE 8192000 / 8 MBytes /
#define SYMBOLTABLESIZE 8192 / Bytes */
uint8_t _end;
; KNOWLEDGE ORIENTED VIRTUAL AGENT CONSTRUCTING INTERACTION KEYS
; by Nino Ivanov, September 2019
; governed by Gnu Affero GPL v.3.0
; https://www.gnu.org/licenses/agpl-3.0.en.html
; This AI continues symbolic chains based on n-grams of length
; *seclen*. Essentially, if it sees A B C D E F, it guesses the
; next topic will be G. Then, the n-gram becomes B C D E F G, and
; it continues with H, and so on, until it reaches some *terminator*.
; It is what I call an "n-gram creeper" type system.
; It is also "topic oriented", looking at rare words and favouring
; encountering them again. This variant also "updates" the topics,
; i.e. it lets them "creep", too.
; Its knowledge is non-hierarchical - essentially, one long string
; of words (symbols) experienced during interaction.
; generate symbols
(defun pgs (n sym lis)
(loop
(cond ((zerop n) (return lis)))
(push sym lis)
(decf n)))
(defun gs (n sym) (pgs n sym '()))
(defvar *seclen* 6) ; 10
(defvar *range* 20)
(defvar *terminator* 'TRM)
(defvar *allowterm* '())
(defvar *knowlen* 1000)
(defvar *knowledge* (gs *knowlen* '()))
(defvar *lastknowlen* 30)
(defvar *lastknowledge* (gs *lastknowlen* '()))
(defvar *in* '())
(defvar *out* '())
(defvar *maxtopics* 4) ; 6
(defvar *topics* '())
(defvar *growth* 1.05) ; traditionally 1.05
; remove nil ... or term
(defun proto-rnl (lis tmp)
(loop
(cond ((null lis) (return (reverse tmp)))
((or (null (car lis)) (eq *terminator* (car lis))) (pop lis))
(t (push (pop lis) tmp)))))
(defun rnl (lis) (proto-rnl lis '()))
; no repetitions
(defun nrp (lis)
(cond ((null lis) '())
((null (cdr lis)) lis)
((eq (car lis) (cadr lis)) (nrp (cdr lis)))
(t (cons (car lis) (nrp (cdr lis))))))
; an equal-operator that matches lists - nice to have
(defun ek (a b)
(cond ((eq a b) t)
((and (listp a) (listp b))
(cond ((or (null a) (null b)) '())
; that was because the above eq would have caught
; a mutual nil
((not (ek (car a) (car b))) '()) ; deep recursion
(t (ek (cdr a) (cdr b)))))
(t '())))
; (ek '((A B) (C D E)) '((A B) (C D E))) --> T
; nthcdr
(defun ncr (n lis)
(loop
(cond ((null lis) (return '()))
((zerop n) (return lis)))
(pop lis)
(decf n)))
(defun proto-tkf (n lis res)
(loop
(cond ((or (zerop n) (null lis)) (return res)))
(setq res (append res (list (car lis))))
(pop lis)
(decf n)))
; take first n elements
(defun tkf (n lis) (proto-tkf n lis '()))
; take last n elements
(defun tkl (n lis)
(loop
(cond ((null (ncr n lis)) (return lis)))
(pop lis)))
(defun pbl (lis res)
(loop
(cond ((null (cdr lis)) (return res)))
(setq res (append res (list (car lis))))
(pop lis)))
; butlast
(defun b-l (lis) (pbl lis '()))
; delete all instances
(defun dai (el lis)
(cond ((null lis) '())
((eq (car lis) el) (dai el (cdr lis)))
(t (cons (car lis) (dai el (cdr lis))))))
; make unique, front-heavy
(defun muq (lis)
(cond ((null lis) '())
(t (cons (car lis) (muq (dai (car lis) (cdr lis)))))))
; (muq '(A B C A D B F C R B)) --> (A B C D F R)
; define topics - total between 0 and *maxtopics*
(defun ptx (lis kno)
(cond ((null (ncr *maxtopics* lis)) lis) ; list reduced to topics
((null kno) (tkf *maxtopics* lis)) ; can't reduce: take most recent
((member (car kno) lis) ; i.e. assume it is usual blabla and eliminate
(ptx (dai (car kno) lis) (cdr kno)))
(t (ptx lis (cdr kno)))))
(defun tpx (lis kno) (ptx (muq lis) kno))
; (tpx '(A B F L X C A B C D Y Y A C)
; '(F G R A L T D M G X R N M G B A Y C M))
; -->
; (B X C D Y)
; proto-compare-section (see function below)
(defun pcs (s1 s2 fct)
(cond ((or (null s1) (null s2)) 0)
((and (eq (car s1) (car s2))
(not (null (car s1))) ; not matching for similarity null or
(not (eq *terminator* (car s1)))) ; terminator
(+ fct (pcs (cdr s1) (cdr s2) (* *growth* fct))))
(t (pcs (cdr s1) (cdr s2) (* *growth* fct)))))
; compare-section - the "tricks" below allow "variation"
; of the segment match, so (A B C X) and (X A B C) are
; not judged as "totally different" - increasing its "power of analogy"
; or "power of hypothesis"
(defun cs (s1 s2)
(let ((p (pcs s1 s2 1.0))
(q (pcs (cdr s1) (b-l s2) 1.0))
(r (pcs (b-l s1) (cdr s2) 1.0))
(s (pcs (cddr s1) (b-l (b-l s2)) 1.0))
(u (pcs (b-l (b-l s1)) (cddr s2) 1.0)))
(+ (* p p p p) (* q q) (* r r) s u)))
; (cs '(A A A A A A A A A A) '(A A A A A A A A A A A))
; --> 64908.46
; (defun cs (s1 s2) (pcs s1 s2 1.0)) ; the most simple alternative
; last topics matching
(defun ltm (tpc lst)
(cond ((null tpc) 1) ; in case you want to multiply
((member (car tpc) lst) (+ 1 (ltm (cdr tpc) lst)))
(t (ltm (cdr tpc) lst))))
; (ltm '(A B C D) '(R T S A L G C F B P)) --> 4, i.e. 1 + A B C
; section and topic evaluation
(defun ste (v1 v2) (+ v1 (* v2 v2))) ; this is REALLY arbitrary:
; i.e. "What is the weight of a matching section to matching the topic?"
; I COULD CONSIDER LETTING THE TOPIC "CREEP" HERE TOGETHER WITH THE ANSWER:
(defun seek-best-continuation (sec kno val cnd prv lst tpc)
(loop
(cond ((null (ncr *seclen* kno)) (return cnd))
(t (let ((new (ste (cs (tkf *seclen* kno) sec)
(ltm tpc lst)))
(nc (car (ncr *seclen* kno))))
(cond ((and (> new val)
; (cond ((null *allowterm*) t) ; *terminator*
; ; CANNOT be the FIRST thing said
; ((and (not (null *allowterm*))
; (not (eq nc *terminator*))) t)
; (t '()))
; this requirement forces PRECISE tracing:
(eq (car (ncr (- *seclen* 1) kno))
(car (reverse sec)))
; comment out if you wish FREE tracing.
(not (eq prv nc))) ; this avoids repetitions
; if you WANT a repetition, X X, then "SAY" that as X1
; X2 upon input
(progn (setq val new) (setq prv cnd) (setq cnd nc)))))))
(pop lst)
(setq lst (append lst (list (pop kno))))))
; proto-creep-continuations, i.e. plan composition
(defun proto-creep-continuations (sec kno con rng sbc)
(loop
(cond ((zerop rng) (progn (setq *allowterm* '()) ; disallow
; terminator as beginning of next plan
(return (append con (list *terminator*))))))
; ... meaning the plan cannot get longer
(setq sbc (seek-best-continuation
sec kno -1 '() '() (gs *lastknowlen* '()) *topics*))
(cond ((or (null sbc) (eq *terminator* sbc))
; nil means it has no idea what to say
(progn (setq *allowterm* '())
(return (append con (list *terminator*))))))
; optional step: creeping the topics with the plan
(setq *topics*
(tpx (rnl (tkl *lastknowlen*
(append *lastknowledge* con)))
*knowledge*))
(pop sec)
(setq sec (append sec (list sbc)))
(setq con (append con (list sbc)))
(decf rng)))
(defun creep-continuations (sec kno)
(let ((cn (seek-best-continuation
sec kno -1 '() '() (gs *lastknowlen* '()) *topics*)))
(progn (setq *allowterm* t) ; now, after the FIRST continuation,
; it MAY terminate
(proto-creep-continuations
(append (cdr sec) (list cn))
kno
(list cn)
(- *range* 1)
()))))
; (creep-continuations '(A X B C E D F G R M)
; '(P O A W C Y A B C D E F G H I J K L S X Y) )
; -->
; (J K L S X Y Y Y E F G H I J K L S X Y Y TRM)
;
; setup instincts
; this is to "mirror" the system's replies better to the user
(defun word-instinct (word)
(cond ((eq word 'I) 'YOU)
((eq word 'ME) 'YOU)
((eq word 'YOU) 'ME)
((eq word 'AM) 'ARE)
((eq word 'ARE) 'AM-ARE)
((eq word 'MINE) 'YOURS)
((eq word 'YOURS) 'MINE)
((eq word 'MY) 'YOUR)
((eq word 'YOUR) 'MY)
((eq word 'MYSELF) 'YOURSELF)
((eq word 'YOURSELF) 'MYSELF)
((eq word 'WAS) 'WAS-WERE)
(t word)))
(defun proto-apply-instincts (sentence checked-sentence)
(cond ((null sentence)
(reverse checked-sentence))
(t
(proto-apply-instincts
(cdr sentence)
(cons (word-instinct (car sentence)) checked-sentence)))))
(defun apply-instincts (sentence)
(proto-apply-instincts sentence '()))
; sample call: (apply-instincts '(I WAS HERE TODAY))
; --> (YOU WAS-WERE HERE TODAY)
; line print - 12 symbols per line
(defun lpr (lis)
(loop
(cond ((null lis) (return '())))
(princ (tkf 12 lis)) (terpri)
(setq lis (ncr 12 lis))))
; repl
(defun run ()
(loop (progn
(princ '-READ---)
(setq *in* (append (read) (list *terminator*)))
(cond ((null (cdr *in*)) (return '())))
; (terpri)
(setq *lastknowledge*
(tkl *lastknowlen* (append *lastknowledge* *in*)))
(setq *topics* (tpx (rnl *lastknowledge*) *knowledge*)) ; ... or here
(setq *out* (creep-continuations (tkl *seclen* *lastknowledge*)
*knowledge*))
(cond ((and (null (cddr *out*)) (null (car *out*))) (setq *out* '()))
(t (setq *out* (append (rnl *out*)
(list *terminator*) ; possibly comment out
'()))))
(setq *knowledge*
(append (ncr (length (append *in* *out*))
*knowledge*)
*in* *out*))
(lpr (rnl (cons 'REPLY-- (apply-instincts *out*)))))))
; PREVIOUSLY, INTERACTION LOOKED SOMEWHAT LIKE THIS:
; * (run)
; (now what happens if I switch back to a best first strategy how will you
; then answer)
; (VERY FUNNY)
; (I hope you do like it)
; (I ALWAYS WAS)
; (you always were a strange piece of metal)
; (I THINK SO INDEED NO MORE HELLO)
; (you were and are a super weird machine)
; (YOU I AM WHAT THE FUCK WERE YOU TELL ME AGAIN I)
; (AM TELLING YOU AGAIN AND AGAIN HOW WEIRD)
; (I think you may have become a genuine topic sequencer)
; (YOU I AM TELLING YOU AGAIN AND AGAIN HOW WEIRD)
; (weird is what you say now)
; (VERY FUNNY)
; (why so)
; (WEIRD IS WHAT YOU SAY NOW)
; (you repeat me or you are cynical i cannot quite tell)
; (WHY)
; (your way of answering me is very strange and very unique)
; (I HOPE YOU DO LIKE IT)
; (oh I perfectly do my dear machine)
; (I ALWAYS WAS)
; (you always were what my dear)
; (OH I ALWAYS WAS)
; (oh please)
; (OH I LOVE YOU COME JOIN THE JOY RIDE HERE I AM)
; (BUT YOU CANNOT MERELY SAY THAT IT IS)
; (OK I think I love this result)
; (HELLO YOU COME JOIN THE JOY RIDE HERE I AM WHAT MACHINE)
; (WHAT WILL YOU TELL ME STOP THAT I)
; (I think I might keep you and see how you turn out further)
; (VERY WELL)