1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: composite.lisp
;;;; Purpose: Composite Classes for UMLisp
;;;; Author: Kevin M. Rosenberg
;;;; Created: Apr 2000
;;;;
;;;; $Id$
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2006 by Kevin M. Rosenberg, M.D.
;;;;
;;;; UMLisp users are granted the rights to distribute and use this software
;;;; as governed by the terms of the GNU General Public License.
;;;; *************************************************************************
(in-package #:umlisp)
;;; Semantic type constants
(defun find-tui-word (words)
(aif (car (find-usty-word words))
(tui it)
nil))
(memoize 'find-tui-word)
(defun tui-disease-or-syndrome ()
(find-tui-word "disease or syndrome"))
(defun tui-sign-or-symptom ()
(find-tui-word "sign or symptom"))
(defun tui-finding ()
(find-tui-word "finding"))
;;;; Related concepts with specific tui lookup functions
(defun ucon-is-tui? (ucon tui)
"Returns t if ucon has a semantic type of tui"
(find tui (s#sty ucon) :key #'tui))
(defun find-ucon2-tui (ucon tui cui2-func related-con-func)
"Returns a list of related ucons that have specific tui"
(remove-duplicates
(filter
#'(lambda (c)
(aif (funcall cui2-func c)
(let ((ucon2 (find-ucon-cui it)))
(when (ucon-is-tui? ucon2 tui)
ucon2)) nil))
(funcall related-con-func ucon))
:key #'cui))
(defun find-ucon2-coc-tui (ucon tui)
"Return list of ucon's that have co-occuring concepts of semantic type tui"
(find-ucon2-tui ucon tui #'cui2 #'s#coc))
(defun find-ucon2-rel-tui (ucon tui)
"Return list of ucon's that have related concepts to ucon and semantic type tui"
(find-ucon2-tui ucon tui #'cui2 #'s#rel))
;;; Composite Objects
(defclass freq (hyperobject)
((freq :value-type integer :initarg :freq :accessor freq
:print-formatter fmt-comma-integer))
(:metaclass hyperobject-class)
(:default-initargs :freq 0)
(:user-name "Frequency class" "Frequency classes")
(:default-print-slots freq)
(:description "Base class containing frequency slot, used for multi-inherited objects"))
(defclass ucon_freq (ucon freq)
()
(:metaclass hyperobject-class)
(:user-name "Concept and Count" "Concepts and Counts")
(:default-print-slots cui freq pfstr)
(:description "Composite object of ucon/freq"))
(defclass ustr_freq (ustr freq)
()
(:metaclass hyperobject-class)
(:user-name "String and Count" "Strings and Counts")
(:default-print-slots sui freq stt lrl str)
(:description "Composite object of ustr/freq"))
(defclass usty_freq (usty freq)
()
(:metaclass hyperobject-class)
(:user-name "Semantic Type and Count" "Semantic Types and Counts")
(:default-print-slots tui freq sty)
(:description "Composite object of usty/freq"))
(defun find-usty_freq-all ()
(let ((usty_freqs '()))
(dolist (tuple (mutex-sql-query "select distinct TUI from MRSTY"))
(let* ((tui (car tuple))
(freq (ensure-integer
(caar (mutex-sql-query
(format nil "select count(*) from MRSTY where TUI=~a" tui)))))
(usty (find-usty-tui tui)))
(push (make-instance 'usty_freq :sty (sty usty)
:tui (tui usty) :freq freq) usty_freqs)))
(sort usty_freqs #'> :key #'freq)))
(defclass usrl_freq (usrl freq)
()
(:metaclass hyperobject-class)
(:user-name "Source and Count" "Sources and Counts")
(:default-print-slots sab freq srl)
(:description "Composite object of usrl/freq"))
;; Frequency finding functions
(defun find-usrl_freq-all ()
(let ((freqs '()))
(dolist (usrl (find-usrl-all))
(let ((freq (ensure-integer
(caar (mutex-sql-query
(format nil "select count(*) from MRSO where SAB='~a'"
(sab usrl)))))))
(push (make-instance 'usrl_freq :sab (sab usrl) :srl (srl usrl)
:freq freq)
freqs)))
(sort freqs #'> :key #'freq)))
(defun find-ucon2_freq-coc-tui (ucon tui)
"Return sorted list of tuples with ucon and freq that have co-occuring concepts of semantic type tui"
(let ((ucon_freqs '()))
(dolist (ucoc (s#coc ucon))
(aif (cui2 ucoc)
(let ((ucon2 (find-ucon-cui it)))
(when (ucon-is-tui? ucon2 tui)
(push (make-instance 'ucon_freq :cui (cui ucon2) :lrl (lrl ucon2)
:pfstr (pfstr ucon2) :freq (cof ucoc))
ucon_freqs)))))
(setq ucon_freqs (delete-duplicates ucon_freqs :key #'cui))
(sort ucon_freqs #'> :key #'freq)))
(defun find-ucon2-str&sty (str sty lookup-func)
"Call lookup-func for ucon and usty for given str and sty"
(let ((ucon (car (find-ucon-str str)))
(usty (car (find-usty-word sty))))
(if (and ucon usty)
(funcall lookup-func ucon (tui usty))
nil)))
(defun find-ucon2-coc-str&sty (str sty)
"Find all ucons that are a co-occuring concept for concept named str
and that have semantic type of sty"
(find-ucon2-str&sty str sty #'find-ucon2-coc-tui))
(defun find-ucon2-rel-str&sty (str sty)
"Find all ucons that are a relationship to concept named str
and that have semantic type of sty"
(find-ucon2-str&sty str sty #'find-ucon2-rel-tui))
;;; Most common relationships, co-occurances
(defun find-ucon2_freq-tui-all (tui ucon2-tui-func)
"Return sorted list of all ucon2 that have a semantic type tui with ucon that is also has sty of tui"
(let ((ucon_freqs (make-array (1+ (find-cui-max)) :initial-element nil)))
(dolist (ucon (find-ucon-tui tui)) ;; for all disease-or-syn
(dolist (ucon2 (funcall ucon2-tui-func ucon tui)) ;; for each related disease
(aif (aref ucon_freqs (cui ucon2))
(setf (freq it) (1+ (freq it)))
(setf (aref ucon_freqs (cui ucon2))
(make-instance 'ucon_freq :cui (cui ucon2) :lrl (lrl ucon2)
:pfstr (pfstr ucon2) :freq 1)))))
(let ((ucon_freq-list '()))
(dotimes (i (find-cui-max))
(declare (fixnum i))
(awhen (aref ucon_freqs i)
(push it ucon_freq-list)))
(sort ucon_freq-list #'> :key #'freq))))
(defun find-ucon2_freq-rel-tui-all (tui)
"Sorted list of ucon_freq with semantic type tui that are rel's of ucons with semantic type tui"
(find-ucon2_freq-tui-all tui #'find-ucon2-rel-tui))
(defun find-ucon2_freq-coc-tui-all (tui)
(find-ucon2_freq-tui-all tui #'find-ucon2-coc-tui))
#+(or scl)
(dolist (c '(ucon_freq ustr_freq usty_freq usrl_freq))
(let ((cl #+cmu (pcl:find-class c)
#+scl (find-class c)))
#+cmu (pcl:finalize-inheritance cl)
#+scl (clos:finalize-inheritance cl)))
|
