chatikbot/eliza.lisp

(in-package #:chatikbot)

(defparameter *fuck-off*
  '((отъебись) (мне похуй) (ебаный ты нахуй!))
  "Fuck-off responses")

(defun goto-p (input) (member input '(иди пошел вали)))
(defun prep-p (i) (member i '(в на)))
(defun dirty-p (i) (member i '(лох хуй мудак ебалай)))

(defparameter *eliza-rules*
  `(
    (((?is ?g goto-p) (?is ?prep prep-p) (?* ?х))
     (а самому не пойти ?prep ?х ?) (мамку свою посылай ?prep ?х) (покомандуй тут еще) ,@*fuck-off*)
    (((?is ?g goto-p) (?* ?x))
     (сам иди ?x) (покомандуй тут еще) ,@*fuck-off*)
    (((?* ?a) (?or норм хорошо молодец) (?* ?b))
     (спасибо) (я старался) (как себе) ,@*fuck-off*)
    (((?or спасибо) (?* ?x))
     (всё для вас) (пожалуйста) (на здоровье) ,@*fuck-off*)
    (((?* ?x) (?or уровень) (?* ?y))
     (в жопу себе его засунь) (хуюровень) ,@*fuck-off*)
    (((?* ?a) (?is ?x ,(lambda (i) (search "ХАХА" (symbol-name i)))) (?* ?b))
     (очень смешно) (клоунов тут нашел?) (посмейся мне еще) ,@*fuck-off*)
    (((?* ?a) (?or ты бот) (?* ?x))
     (сам ?x) (сам ты ?x) (а по ебалу?) (сейчас мы разберемся кто еще тут ?x) ,@*fuck-off*)
    (((?* x))
     (:text . "И чё?")
     (:text . "Сам-то понял?")
     (:text . "Ну хуй знает")
     (:text . "Бля...")
     (:text . "В душе не ебу")
     (:text . "Мне похуй")
     (:text . "Eбаный ты нахуй")
     (:text . "Отъебись")
     (:sticker . "BQADAgADFAADOoERAAGoLKS_Vgs6GgI") ;; ЭЭ епта Чо
     (:sticker . "BQADAgADGQADOoERAAFDXJisD4fClgI") ;; Ну чё ты несёшь
     (:sticker . "BQADAgADFwADOoERAAHCw-fBiFjACgI") ;; А у меня собака, я не могу
     (:sticker . "BQADAgADEgADOoERAAFtU3uF9HvtQgI") ;; Бухнём?
     (:sticker . "BQADBAADQAEAAnscSQABqWydSKTnASoC"))))


(defun punctuation-p (char)
  (find char ".,;:'!?#-()\\\""))

(defun read-from-string-no-punct (input)
  "Read from an input string, ignoring punctuation."
  (read-from-string
   (concatenate 'string
                "("
                (substitute-if #\space #'punctuation-p input)
                ")")))

(defun print-with-spaces (list)
  (format nil "~@(~{~a~^ ~}~)" list))

(defun mappend (fn &rest lists)
  "Apply fn to each element of lists and append the results."
  (apply #'append (apply #'mapcar fn lists)))

(defun random-elt (choices)
  "Choose an element from a list at random."
  (elt choices (random (length choices))))

(defun flatten (the-list)
  "Append together elements (or lists) in the list."
  (mappend #'(lambda (x) (if (listp x) (flatten x) (list x))) the-list))

(defun switch-viewpoint (words)
  "Change I to you and vice versa, and so on."
  (sublis '((I . you) (you . I) (me . you) (am . are)
            (я ты) (ты я) (меня тебя) (тебя меня))
          words))

(defun use-eliza-rules (input)
  "Find some rule with which to transform the input."
  (rule-based-translator input *eliza-rules*
                         :action #'(lambda (bindings responses)
                                     (sublis (switch-viewpoint bindings)
                                             (random-elt responses)))))

(defun eliza (input)
  (let ((response (use-eliza-rules
                   (read-from-string-no-punct input))))
    (when response
      (if (keywordp (first response))
          response
          (print-with-spaces (flatten response))))))