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) ты (?* ?x))
     (сам ?x) (сам ты ?x) (а по ебалу?) (сейчас мы разберемся кто еще тут ?x) ,@*fuck-off*)
    (((?is ?x dirty-p))
     (сам ?x) (сам ты ?x) (а по ебалу?) (сейчас мы разберемся кто еще тут ?x))
    (((?* ?a) (?or хуита хуета хуйня лажа говно бред) (?* ?b))
     ("вам, сударь," не угодить) (и что?) (бывает) (мопед не мой) (сам получше придумывай) ,@*fuck-off*)
    (((?* ?a) (?or норм хорошо молодец ниплохо ниплоха ниеплоха) (?* ?b))
     (спасибо) (я старался) (как себе) ,@*fuck-off*)
    (((?or спасибо) (?* ?x))
     (всё для вас) (пожалуйста) (на здоровье) ,@*fuck-off*)
    (((?* ?x) (?or уровень) (?* ?y))
     (в жопу себе его засунь) (хуюровень) ,@*fuck-off*)
    (((?* ?a) (?is ?x ,(lambda (i) (and (symbolp i) (search "ХАХА" (symbol-name i))))) (?* ?b))
     (очень смешно) (клоунов тут нашел?) (посмейся мне еще) ,@*fuck-off*)
    (((?* ?a) (?or сиськи сисяндры титьки буфера boobs tits) (?is ?n numberp))
     (#'tumblr-random-photo ,*boobs-roll* ?n))
    (((?* ?a) (?or сиськи сисяндры титьки буфера boobs tits) (?* ?b))
     (#'tumblr-random-photo ,*boobs-roll*))
    (((?* ?a) (?or жопа жопы ягодицы зад зады ass asses) (?is ?n numberp))
     (#'tumblr-random-photo ,*ass-roll* ?n))
    (((?* ?a) (?or жопа жопы ягодицы зад зады ass asses) (?* ?b))
     (#'tumblr-random-photo ,*ass-roll*))
    (((?* ?a) (?or тёлка телка телку тёлку баба бабу сука суку сучка сучку babe bitch) (?* ?b))
     (#'tumblr-random-photo ,*ass-roll*) (#'tumblr-random-photo ,*boobs-roll*))
    (((?* 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 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 ((r (use-eliza-rules
            (read-from-string-no-punct input))))
    (cond
      ((null r) nil)
      ((and (consp (car r)) (eq 'function (caar r)))
       (apply (cadar r) (cdr r)))
      ((keywordp (car r)) r)
      (t (print-with-spaces (flatten r))))))