|
|
@@ -98,6 +98,42 @@ is replaced with replacement."
|
|
|
(preprocess-input (subseq text (1+ first-space)))
|
|
|
(replace-all text *bot-name* "ты")))))
|
|
|
|
|
|
+(defun punctuation-p (char)
|
|
|
+ (find char ".,;:'!?#-()\\\""))
|
|
|
+
|
|
|
+(defun read-from-string-no-punct (input)
|
|
|
+ "Read from an input string, ignoring punctuation."
|
|
|
+ (let ((*package* (find-package 'chatikbot)))
|
|
|
+ (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 rules)
|
|
|
+ "Find some rule with which to transform the input."
|
|
|
+ (rule-based-translator input rules
|
|
|
+ :action #'(lambda (bindings responses)
|
|
|
+ (sublis (switch-viewpoint bindings)
|
|
|
+ (random-elt responses)))))
|
|
|
+
|
|
|
+(defun eliza (input rules)
|
|
|
+ (let ((r (use-eliza-rules
|
|
|
+ (read-from-string-no-punct input)
|
|
|
+ rules)))
|
|
|
+ (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))))))
|
|
|
+
|
|
|
(defun parse-cmd (text)
|
|
|
(let* ((args (split-sequence:split-sequence #\Space (subseq text 1) :remove-empty-subseqs t))
|
|
|
(cmd (subseq (car args) 0 (position #\@ (car args)))))
|
|
|
@@ -201,56 +237,6 @@ is replaced with replacement."
|
|
|
((< seconds (* 60 60 24 7 54)) (format nil "~A weeks" (round seconds (* 60 60 24 7))))
|
|
|
(:otherwise (format nil "~A years" (smart-f (/ seconds (* 60 60 24 365.25)) 1)))))
|
|
|
|
|
|
-(defun google-tts (text &key (lang "en"))
|
|
|
- (let ((path #P"google_tts.mp3"))
|
|
|
- (with-open-file (s path :direction :output
|
|
|
- :element-type '(unsigned-byte 8)
|
|
|
- :if-exists :supersede
|
|
|
- :if-does-not-exist :create)
|
|
|
- (write-sequence
|
|
|
- (drakma:http-request
|
|
|
- "http://translate.google.com/translate_tts"
|
|
|
- :parameters `(("ie" . "UTF-8")
|
|
|
- ("client" . "t")
|
|
|
- ("tl" . ,lang)
|
|
|
- ("q" . ,text))
|
|
|
- :user-agent "stagefright/1.2 (Linux;Android 5.0)"
|
|
|
- :additional-headers '((:referer . "http://translate.google.com/"))
|
|
|
- :external-format-out :utf-8
|
|
|
- :force-binary t)
|
|
|
- s)
|
|
|
- path)))
|
|
|
-
|
|
|
-(defun say-it (lang words)
|
|
|
- (cons :voice
|
|
|
- (google-tts (print-with-spaces words) :lang lang)))
|
|
|
-
|
|
|
-(defun yit-info ()
|
|
|
- (labels ((get-rows (url)
|
|
|
- (rest (get-by-tag (plump:get-element-by-id (xml-request url) "apartmentList") "tr")))
|
|
|
- (row-data (row)
|
|
|
- (mapcar (lambda (e) (string-trim '(#\Newline #\Space) (plump:text e)))
|
|
|
- (get-by-tag row "td")))
|
|
|
- (format-data (data)
|
|
|
- (format nil "~{~A~^ ~}" (mapcar (lambda (n) (nth n data)) '(1 2 3 4 7 6))))
|
|
|
- (get-intresting (rows)
|
|
|
- (loop for row in rows
|
|
|
- for data = (row-data row)
|
|
|
- for rooms = (parse-integer (nth 2 data))
|
|
|
- for area = (parse-float:parse-float (replace-all (nth 3 data) "," "."))
|
|
|
- when (= rooms 3)
|
|
|
- when (< 65 area 75)
|
|
|
- collect data))
|
|
|
- (format-apts (url)
|
|
|
- (let ((apts (get-intresting (get-rows url))))
|
|
|
- (format nil "~A~%~{~A~^~%~}~%~A/~A" url (mapcar #'format-data apts)
|
|
|
- (length (remove "забронировано" apts :test #'equal :key #'(lambda (r) (nth 7 r)) ))
|
|
|
- (length apts)))))
|
|
|
- (format nil "~{~A~^~%~%~}"
|
|
|
- (mapcar #'format-apts
|
|
|
- '("http://www.yitspb.ru/yit_spb/catalog/apartments/novoorlovskiy-korpus-1-1-1"
|
|
|
- "http://www.yitspb.ru/yit_spb/catalog/apartments/novoorlovskiy-korpus-1-1-2")))))
|
|
|
-
|
|
|
(defmacro def-message-handler (name (message) &body body)
|
|
|
`(progn
|
|
|
(defun ,name (,message)
|
