|
|
|
;;;; lift-search.lisp
|
|
|
|
|
|
|
|
(in-package #:cl-bible.lift-search)
|
|
|
|
|
|
|
|
(defun frequent-words ()
|
|
|
|
(str:words "der die das dir mir wir ihr sie sein mein dein euer unser dem den in zu und"))
|
|
|
|
|
|
|
|
(defparameter *punctuation*
|
|
|
|
'(#\; #\: #\' #\" #\. #\, #\« #\» #\( #\) #\[ #\] #\{ #\} #\! #\? #\-))
|
|
|
|
|
|
|
|
(defun normalize-string (str)
|
|
|
|
(map 'string (lambda (char)
|
|
|
|
(if (member char *punctuation*)
|
|
|
|
#\space
|
|
|
|
char))
|
|
|
|
str))
|
|
|
|
|
|
|
|
(defun compose (f1 f2)
|
|
|
|
(lambda (&rest args)
|
|
|
|
(funcall f1 (apply f2 args))))
|
|
|
|
|
|
|
|
(defun lift-search (search-result)
|
|
|
|
(comb (diff-verses (mapcar (compose #'normalize-string #'v:get-text)
|
|
|
|
search-result))
|
|
|
|
(length search-result)))
|
|
|
|
|
|
|
|
(defun count-words (words)
|
|
|
|
(let (result)
|
|
|
|
(mapc (lambda (word)
|
|
|
|
(if (assoc word result :test #'string=)
|
|
|
|
(incf (cdr (assoc word result :test #'string=)))
|
|
|
|
(setf result (acons word 1 result))))
|
|
|
|
words)
|
|
|
|
(sort result (lambda (x y)
|
|
|
|
(> (cdr x) (cdr y))))))
|
|
|
|
|
|
|
|
(defun diff-verses (verses)
|
|
|
|
(count-words (remove-if (lambda (word)
|
|
|
|
(member word
|
|
|
|
(frequent-words)
|
|
|
|
:test #'string=))
|
|
|
|
(mapcan #'str:words verses))))
|
|
|
|
|
|
|
|
(defun comb (freqs length)
|
|
|
|
(remove-if (lambda (word)
|
|
|
|
(< (cdr word) (* 0.25 length)))
|
|
|
|
freqs))
|