(defvar *current-srl* nil)
(defun current-srl ()
*current-srl*)
-(defun current-srl! (srl)
+(defun set-current-srl (srl)
(setq *current-srl* srl))
(defmacro query-string (table fields srl where-name where-value
&key (lrl "KCUILRL") single distinct order like limit
filter)
(let* ((%%fields (format nil "SELECT ~A~{~:@(~A~)~^,~} FROM ~:@(~A~)"
- (if distinct "DISTINCT " "") fields table))
+ (if distinct "DISTINCT " "") (sqlname fields) table))
(%%order (if order (format nil " ORDER BY ~{~:@(~A~) ~(~A~)~^,~}"
order)
""))
(%%lrl (format nil " AND ~:@(~A~)<=" lrl))
(%%where (when where-name
- (format nil " WHERE ~:@(~A~)~A" where-name
+ (format nil " WHERE ~:@(~A~)~A" (sqlname where-name)
(if like " like " ""))))
(%filter (gensym "FILTER-"))
(%single (gensym "SINGLE-"))
(concatenate
'string
(format nil "SELECT ~A~{~:@(~A~)~^,~} FROM ~:@(~A~)"
- (if distinct "DISTINCT " "") fields table)
- (if where-name (format nil " WHERE ~:@(~A~)" where-name) "")
+ (if distinct "DISTINCT " "") (sqlname fields) table)
+ (if where-name (format nil " WHERE ~:@(~A~)" (sqlname where-name)) "")
(if where-name
(format nil
(typecase where-value
(number "='~D'")
(null " IS NULL")
(t
- (if like " LINK '%~A%""='~A'")))
+ (if like " LIKE '%~A%'" "='~A'")))
where-value)
"")
(if filter (concatenate 'string " AND " filter) nil)
:kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl
:ksuilrl ksuilrl)))
+(defun find-uconso-cuisui (cuisui &key sab (srl *current-srl*))
+ "Find uconso for a cuisui."
+ (collect-umlisp-query (mrconso (cui lat ts lui stt sui ispref aui saui scui sdui sab tty code str
+ srl suppress cvf kpfeng kcuisui kcuilui kcuilrl
+ kluilrl ksuilrl) srl kcuisui cuisui
+ :filter (if sab (concatenate 'string "SAB='" sab "'") nil))
+ (make-instance 'uconso :cui cui :lat lat :ts ts :lui lui :stt stt :sui sui :ispref ispref
+ :aui aui :saui saui :scui scui :sdui sdui :sab sab :tty tty :code code
+ :str str :srl srl :suppress suppress :cvf cvf :kpfeng kpfeng
+ :kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl
+ :ksuilrl ksuilrl)))
+
(defun find-uconso-code (code &key first sab (srl *current-srl*) (like nil))
"Return list of uconso objects that match code. Optional, filter for SAB. Optionally, use SQL's LIKE syntax"
(defun find-uconso-sui (sui &key sab (srl *current-srl*))
"Find uconso for a sui. If set SAB, the without-pfstr is on by default"
(ensure-sui-integer sui)
- (unless (and sui (stringp sab))
+;; (unless (and sui (stringp sab))
+ (unless sui
(return-from find-uconso-sui nil))
(collect-umlisp-query (mrconso (cui lat ts lui stt sui ispref aui saui scui sdui sab tty code str
(make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui)
:lrl (ensure-integer kcuilrl))))
-(defun find-ucon-cuisui (cui sui &key (srl *current-srl*))
+(defun find-ucon-cuisui (cuisui &key (srl *current-srl*))
+ "Find ucon for cui/sui"
+ (collect-umlisp-query (mrconso (cui kcuilrl) srl kcuisui cuisui)
+ (make-instance 'ucon :cui cui
+ :pfstr (find-pfstr-cui cui)
+ :lrl (ensure-integer kcuilrl))))
+
+(defun find-ucon-cui-sui (cui sui &key (srl *current-srl*))
"Find ucon for cui/sui"
(ensure-cui-integer cui)
(ensure-sui-integer sui)
(when (and cui sui)
- (collect-umlisp-query (mrconso (kcuilrl) srl kcuisui
- (make-cuisui cui sui))
- (make-instance 'ucon :cui cui
- :pfstr (find-pfstr-cui cui)
- :lrl (ensure-integer kcuilrl)))))
+ (find-ucon-cui-sui cui sui :srl srl)))
(defun find-ucon-str (str &key (srl *current-srl*))
"Find ucon that are exact match for str"
(defun find-udef-cui (cui &key (srl *current-srl*))
"Return a list of udefs for cui"
(ensure-cui-integer cui)
- (collect-umlisp-query (mrdef (sab def suppress) srl cui cui :lrl "KSRL")
+ (collect-umlisp-query (mrdef (sab def suppress) srl cui cui :lrl "KSRL"
+ :distinct t)
(make-instance 'udef :sab sab :def def :suppress suppress)))
(defun find-udoc-key (key)
(mapcar #'cui1 (find-urel-cui2 cui2 :srl srl)))
collect (find-ucon-cui cui :srl srl)))
-(defun find-ucoc-cui (cui &key (srl *current-srl*))
+#+mrcoc (defun find-ucoc-cui (cui &key (srl *current-srl*))
"Return a list of ucoc for cui"
(ensure-cui-integer cui)
(collect-umlisp-query (mrcoc (aui1 cui2 aui2 sab cot cof coa) srl cui1
:cot cot :cof (ensure-integer cof) :coa coa :sab sab
:pfstr2 (find-pfstr-cui cui2))))
-(defun find-ucoc-cui2 (cui2 &key (srl *current-srl*))
+#+mrcoc (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*))
"Return a list of ucoc for cui2"
(ensure-cui-integer cui2)
(collect-umlisp-query (mrcoc (cui1 aui1 aui2 sab cot cof coa) srl cui2
:sab sab :cot cot :cof (ensure-integer cof) :coa coa
:pfstr2 (find-pfstr-cui cui2))))
-(defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
+#+mrcoc (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
"List of ucon with co-occurance cui2"
(ensure-cui-integer cui2)
(mapcar
(ensure-cui-integer cui)
(ensure-lui-integer lui)
(collect-umlisp-query (mrconso (sui stt str suppress ksuilrl) srl kcuilui
- (make-cuilui cui lui) :lrl ksuilrl)
+ (make-cuilui cui lui) :lrl ksuilrl :distinct t)
(make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui
:cuisui (make-cuisui cui sui) :stt stt :str str :suppress suppress
:lrl (ensure-integer ksuilrl))))
-(defun find-ustr-cuisui (cui sui &key (srl *current-srl*))
+(defun find-ustr-cuisui (cuisui &key (srl *current-srl*))
"Return the single ustr for cuisui"
- (ensure-cui-integer cui)
- (ensure-sui-integer sui)
- (collect-umlisp-query (mrconso (lui stt str suppress ksuilrl) srl kcuisui
- (make-cuisui cui sui) :lrl lsuilrl :single t)
- (make-instance 'ustr :sui sui :cui cui :cuisui (make-cuisui cui sui)
+ (collect-umlisp-query (mrconso (cui lui sui stt str suppress ksuilrl) srl kcuisui
+ cuisui :lrl ksuilrl :single t)
+ (make-instance 'ustr :sui sui :cui cui :cuisui cuisui
:lui (ensure-integer lui) :stt stt :str str :suppress suppress
:lrl (ensure-integer ksuilrl))))
+(defun find-ustr-cui-sui (cui sui &key (srl *current-srl*))
+ "Return the single ustr for cuisui"
+ (ensure-cui-integer cui)
+ (ensure-sui-integer sui)
+ (find-ustr-cuisui (make-cuisui cui sui) :srl srl))
+
(defun find-ustr-sui (sui &key (srl *current-srl*))
"Return the list of ustr for sui"
(ensure-sui-integer sui)
(collect-umlisp-query (mrconso (cui lui stt str suppress ksuilrl) srl sui sui
- :lrl ksuilrl)
+ :lrl ksuilrl :distinct t)
(make-instance 'ustr :sui sui :cui cui :stt stt :str str
:cuisui (make-cuisui (ensure-integer cui) sui)
:suppress suppress
"Return the list of ustr for sab"
(collect-umlisp-query (mrconso (kcuisui) srl sab sab :lrl srl)
(let ((cuisui (ensure-integer kcuisui)))
- (apply #'find-ustr-cuisui
- (append
- (multiple-value-list (decompose-cuisui cuisui))
- (list :srl srl))))))
+ (find-ustr-cuisui cuisui :srl srl))))
(defun find-ustr-all (&key (srl *current-srl*))
"Return list of all ustr's"
(defun find-uso-cuisui (cui sui &key (srl *current-srl*))
(ensure-sui-integer sui)
(ensure-cui-integer cui)
- (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str)
+ (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str ts)
srl kcuisui (make-cuisui cui sui) :lrl srl)
(make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty
:cui cui :sui sui :saui saui :sdui sdui :scui scui
- :lat lat :str str)))
+ :lat lat :str str :ts ts)))
(defun find-uso-cui (cui &key (srl *current-srl*) (english-only nil) limit)
(ensure-cui-integer cui)
- (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str sui)
+ (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str sui ts)
srl cui cui :lrl srl :limit limit
:filter (when english-only "LAT='ENG'"))
(make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty
:cui cui :sui sui :saui saui :sdui sdui :scui scui
- :lat lat :str str)))
+ :lat lat :str str :ts ts)))
(defun find-uso-aui (aui &key (srl *current-srl*))
(ensure-sui-integer aui)
(collect-umlisp-query (mrconso (sab cui sui code srl tty saui sdui scui lat
- str) srl aui aui :lrl srl :single t)
+ str ts) srl aui aui :lrl srl :single t)
(make-instance 'uso :aui aui :cui cui :sab sab :code code :srl srl :tty tty
:sui sui :saui saui :sdui sdui :scui scui :lat lat
- :str str)))
+ :str str :ts ts)))
(defun find-uhier-cui (cui &key (srl *current-srl*))
(ensure-cui-integer cui)
:cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc
:curver curver :sabin sabin :ssn ssn :scit scit)))
-(defun find-usab-by-key (key-name key)
+(defun find-usab-by-key (key-name key &key current)
"Find usab for a key"
(collect-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver vstart
vend imeta rmeta slc scc srl tfr cfr cxty
ttyl atnl lat cenc curver sabin
ssn scit)
- nil key-name key :single t)
+ nil key-name key :single t
+ :filter (when current "RMETA=''"))
(make-instance 'usab :vcui (ensure-integer vcui)
:rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son
:sf sf :sver sver :vstart vstart :vend vend :imeta imeta
:curver curver :sabin sabin
:ssn ssn :scit scit)))
-(defun find-usab-rsab (rsab)
+(defun find-usab-rsab (rsab &key (current t))
"Find usab for rsab"
(find-usab-by-key 'rsab rsab))
-(defun find-usab-vsab (vsab)
+(defun find-usab-vsab (vsab &key (current t))
"Find usab for vsab"
(find-usab-by-key 'vsab vsab))
(setq uconsos (nconc uconsos (find-uconso-sui sui :sab sab))))
(remove-duplicates uconsos :key 'cui)))
(t
- (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t
- :lrl 'klrl :order '(cui asc))
- (find-uconso-cui cui :srl srl)))))
+ (collect-umlisp-query-eval ('mrxw_eng '(kcuisui) srl 'wd word :like like
+ :lrl 'klrl :order '(kcuisui asc))
+ (find-uconso-cuisui kcuisui :srl srl)))))
(defun find-ucon-word (word &key sab (srl *current-srl*) (like nil))
"Return list of ucon that match word in matching SAB. Optionally, use SQL's LIKE syntax"
"Return list of cui that match word, optionally use SQL's LIKE syntax"
(collect-umlisp-query-eval ('mrxnw_eng '(sui) srl 'nwd word :like like :distinct t
:lrl 'klrl :order '(cui asc))
- sui))
+ sui))
(defun find-ustr-word (word &key sab (srl *current-srl*) (like nil))
"Return list of ustr that match word in matching SAB. Optionally, use SQL's LIKE syntax"
""))
(if srl (format nil " AND KCUILRL <= ~D" srl) ""))))
(loop for tuple in (mutex-sql-query query)
- collect (destructuring-bind (sui cui lui str lrl stt suppress cuisui) tuple
- (make-instance 'ustr :sui sui :cui cui :lui lui :str str :lrl lrl
- :stt stt :suppress suppress :cuisui cuisui)))))
+ collect (destructuring-bind (sui cui lui str lrl stt suppress cuisui) tuple
+ (make-instance 'ustr :sui sui :cui cui :lui lui :str str :lrl lrl
+ :stt stt :suppress suppress :cuisui cuisui)))))
(t
- (collect-umlisp-query (mrxw_eng (cui sui) srl wd word :lrl klrl
+ (collect-umlisp-query (mrxw_eng (kcuisui) srl wd word :lrl klrl
:order (cui asc sui asc))
- (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))))
+ (find-ustr-cuisui kcuisui :srl srl)))))
(defun find-ustr-normalized-word (word &key (srl *current-srl*))
"Return list of ustrs that match word"
- (collect-umlisp-query (mrxnw_eng (cui sui) srl nwd word :lrl klrl
+ (collect-umlisp-query (mrxnw_eng (kcuisui) srl nwd word :lrl klrl
:order (cui asc sui asc))
- (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
+ (find-ustr-cuisui kcuisui :srl srl)))
(defun find-uterm-word (word &key (srl *current-srl*))
"Return list of uterms that match word"
(defun find-ustr-noneng-word (word &key (srl *current-srl*))
"Return list of ustrs that match non-english word"
- (collect-umlisp-query (mrxw_noneng (cui sui) srl wd word :lrl klrl
+ (collect-umlisp-query (mrxw_noneng (kcuisui) srl wd word :lrl klrl
:order (cui asc sui asc))
- (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
+ (find-ustr-cuisui kcuisui :srl srl)))
;; Special tables
only-exact-if-match limit &key extra-lookup-args)
(let ((uobjs '()))
(dolist (word (delimited-string-to-list str #\space))
- (setq uobjs (append uobjs (apply obj-lookup-fun word :srl srl extra-lookup-args))))
+ (setq uobjs (nconc uobjs
+ (kmrcl:flatten (apply obj-lookup-fun word :srl srl extra-lookup-args)))))
(let ((sorted
(funcall sort-fun str
(delete-duplicates uobjs :test #'= :key key))))
;;; **************************
-(defun make-ustats ()
- (with-sql-connection (conn)
- (ignore-errors (sql-execute "drop table USTATS" conn))
- (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn)
-
- (dotimes (srl 5)
- (insert-ustats-count conn "Concept Count" "MRCONSO" "distinct CUI" "KCUILRL" srl)
- (insert-ustats-count conn "Term Count" "MRCONSO" "distinct KCUILUI" "KCUILRL" srl)
- (insert-ustats-count conn "Distinct Term Count" "MRCONSO" "distinct LUI" "KLUILRL" srl)
- (insert-ustats-count conn "String Count" "MRCONSO" "*" "KSUILRL" srl)
- (insert-ustats-count conn "Distinct String Count" "MRCONSO" "distinct SUI" "KSUILRL" srl)
- (insert-ustats-count conn "Hierarchcy" "MRHIER" "*" "KSRL" srl)
- (insert-ustats-count conn "Mappings" "MRMAP" "*" "KSRL" srl)
- (insert-ustats-count conn "Simple Mappings" "MRSMAP" "*" "KSRL" srl)
- (insert-ustats-count conn "Co-occuring Concept Count" "MRCOC" "*" "KLRL" srl)
- (insert-ustats-count conn "Definition Count" "MRDEF" "*" "KSRL" srl)
- (insert-ustats-count conn "Rank Count" "MRRANK" "*" "KSRL" srl)
- (insert-ustats-count conn "Relationship Count" "MRREL" "*" "KSRL" srl)
- (insert-ustats-count conn "Semantic Type Count" "MRSTY" "*" "KLRL" srl)
- (insert-ustats-count conn "Simple Attribute Count" "MRSAT" "*" "KSRL" srl)
- (insert-ustats-count conn "Source Abbreviation Count" "MRSAB" "*" "SRL" srl)
- (insert-ustats-count conn "Word Index Count" "MRXW_ENG" "*" "KLRL" srl)
- (insert-ustats-count conn "Normalized Word Index Count" "MRXNW_ENG" "*" "KLRL" srl)
- (insert-ustats-count conn "Normalized String Index Count" "MRXNS_ENG" "*" "KLRL" srl))
- (sql-execute "create index USTATS_SRL on USTATS (SRL)" conn))
- (find-ustats-all))
-
-(defun insert-ustats-count (conn name table count-variable srl-control srl)
- (insert-ustats conn name (find-count-table conn table srl count-variable srl-control) srl))
-
(defun find-count-table (conn table srl count-variable srl-control)
+ (with-sql-connection (conn)
(cond
((stringp srl-control)
(ensure-integer
conn))))
(t
(error "Unknown srl-control")
- 0)))
+ 0))))
(defun insert-ustats (conn name count srl)
(sql-execute (format nil "insert into USTATS (name,count,srl) values ('~a',~d,~d)"
(collect-umlisp-query (ustats (name count) nil srl srl :order (name asc))
(make-instance 'ustats :name name :hits (ensure-integer count))))
+(defun find-urank-sab (sab &key (srl *current-srl*))
+ (collect-umlisp-query (mrrank (rank sab suppress tty) nil sab sab)
+ (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress)))
+
+(defun find-urank-all (&key (srl *current-srl*))
+ (if srl
+ (collect-umlisp-query (mrrank (rank sab suppress tty) nil ksrl srl)
+ (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress))
+ (collect-umlisp-query (mrrank (rank sab suppress tty ksrl) nil nil nil)
+ (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress))))
projects / umlisp.git / blobdiff