(ensure-cui-integer cui)
(unless cui (return-from find-ucon-cui nil))
- (let ((tuple (car (mutex-sql-query "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND KPFENG=1 AND SRL<=~D"
- cui srl))))
+ (let ((tuple (car (mutex-sql-query
+ (format nil
+ "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND KPFENG=1~A"
+ cui (if srl (format nil " AND SRL<=~D" srl) ""))))))
(unless tuple
- (setq tuple (car (mutex-sql-query "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D AND SRL<=~D"
- cui srl))))
+ (setq tuple (car (mutex-sql-query
+ (format nil
+ "SELECT kcuilrl,str FROM MRCONSO WHERE CUI=~D"
+ cui (if srl (format nil " AND SRL<=~D" srl) nil))))))
(unless tuple
(return-from find-ucon-cui nil))
(make-instance 'ucon :cui cui :pfstr (second tuple)
(ensure-cui-integer cui)
(or
(caar (mutex-sql-query
- (format nil "SELECT str FROM MRCONSO WHERE CUI=~D AND KPFENG=1 AND SLR<=~D"
- cui srl)))
+ (format nil "SELECT DISTINCT str FROM MRCONSO WHERE CUI=~D AND KPFENG=1~A LIMIT 1"
+ cui (if srl (format nil " AND SRL<=~D" srl) ""))))
(caar (mutex-sql-query
- (format nil "SELECT str FROM MRCONSO WHERE CUI=~D AND SLR<=~D"
- cui srl)))))
+ (format nil "SELECT DISTINCT str FROM MRCONSO WHERE CUI=~D~A LIMIT 1"
+ cui (if srl (format nil " AND SRL<=~D" srl) ""))))))
(defun find-ucon-lui (lui &key (srl *current-srl*))
"Find list of ucon for lui"
:lrl (ensure-integer kcuilrl)))
(unless lui (return-from find-ucon-lui nil))
- (let ((tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D AND KPFENG=1 AND SRL<=~D"
- lui srl))))
+ (let ((tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D AND KPFENG=1~A ORDER BY kcuilrl ASC LIMIT 1"
+ lui (if srl (format nil " AND SRL<=~D" srl) "")))))
(unless tuple
- (setq tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D AND SRL<=~D"
- lui srl))))
+ (setq tuple (car (mutex-sql-query "SELECT cui,kcuilrl,str FROM MRCONSO WHERE LUI=~D~A ORDER BY kcuilrl ASC LIMIT 1"
+ lui (if srl (format nil " AND SRL<=~D" srl) "")))))
(unless tuple
(return-from find-ucon-lui nil))
(make-instance 'ucon :cui (first tuple) :pfstr (third tuple)
;;; Multiword lookup and score functions
(defun find-uobj-multiword (str obj-lookup-fun sort-fun key srl
- only-exact-if-match)
+ only-exact-if-match limit)
(let ((uobjs '()))
(dolist (word (delimited-string-to-list str #\space))
(setq uobjs (append uobjs (funcall obj-lookup-fun word :srl srl))))
(let ((sorted
(funcall sort-fun str
(delete-duplicates uobjs :test #'= :key key))))
- (if (and (plusp (length sorted))
- only-exact-if-match
- (multiword-match str (pfstr (first sorted))))
- (first sorted)
- sorted))))
+ (let ((len (length sorted)))
+ (cond
+ ((zerop len)
+ (return-from find-uobj-multiword nil))
+ ((and only-exact-if-match (multiword-match str (pfstr (first sorted))))
+ (first sorted))
+ (limit
+ (if (and (plusp limit) (> len limit))
+ (subseq sorted 0 limit)
+ limit))
+ (t
+ sorted))))))
(defun find-ucon-multiword (str &key (srl *current-srl*)
- (only-exact-if-match t))
+ (only-exact-if-match t)
+ limit)
(find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str
- #'cui srl only-exact-if-match))
+ #'cui srl only-exact-if-match limit))
(defun find-uterm-multiword (str &key (srl *current-srl*)
- (only-exact-if-match t))
+ (only-exact-if-match t)
+ limit)
(find-uobj-multiword str #'find-uterm-word #'sort-score-pfstr-str
- #'lui srl only-exact-if-match))
+ #'lui srl only-exact-if-match limit))
(defun find-ustr-multiword (str &key (srl *current-srl*)
- (only-exact-if-match t))
+ (only-exact-if-match t)
+ limit)
(find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str
- #'sui srl only-exact-if-match))
+ #'sui srl only-exact-if-match limit))
(defun sort-score-pfstr-str (str uobjs)
"Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"