&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
(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
(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 (cuisui &key (srl *current-srl*))
"Return the single ustr for cuisui"
(collect-umlisp-query (mrconso (cui lui sui stt str suppress ksuilrl) srl kcuisui
- cuisui :lrl lsuilrl :single t)
+ 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))))
"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
(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)
;;; **************************
-(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)
-
- (dolist (srl '(0 1 2 3 4 9))
- (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