X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=2831defc003504ff2c1f488793d013a80d612535;hb=9b9c48233072a8f64c9677d9b92b5eb956f4079d;hp=2c8c93eb760cda10257ac11e68dac2788ca6af77;hpb=5a49f7c38351f819fe9b59f565f6e241aa2ffe0d;p=umlisp.git

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 2c8c93e..2831def 100644
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -189,11 +189,15 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (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)
@@ -211,11 +215,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   (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"
@@ -226,11 +230,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 		   :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)
@@ -720,33 +724,43 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 ;;; 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"