You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
47 lines
1.4 KiB
47 lines
1.4 KiB
;;;; 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))
|
|
|