composite.lisp

   1 ;;;; $Id: composite.lisp,v 1.1 2002/10/08 22:08:56 kevin Exp $
   2
   3 (in-package :umlisp)
   4
   5
   6 ;;; Semantic type constants
   7
   8 (defun find-tui-word (words)
   9   (gu:aif (car (find-usty-word words))
  10        (tui gu::it)
  11        nil))
  12 (gu:memoize 'find-tui-word)
  13
  14 (defun tui-disease-or-syndrome ()
  15   (find-tui-word "disease or syndrome"))
  16 (defun tui-sign-or-symptom ()
  17   (find-tui-word "sign or symptom"))
  18 (defun tui-finding ()
  19   (find-tui-word "finding"))
  20
  21
  22 ;;;; Related concepts with specific tui lookup functions
  23
  24 (defun ucon-is-tui? (ucon tui)
  25   "Returns t if ucon has a semantic type of tui"
  26   (find tui (s#sty ucon) :key #'tui))
  27
  28 (defun find-ucon2-tui (ucon tui cui2-func related-con-func)
  29   "Returns a list of related ucons that have specific tui"
  30   (remove-duplicates
  31    (filter
  32     #'(lambda (c)
  33         (gu:aif (funcall cui2-func c)
  34              (let ((ucon2 (find-ucon-cui gu::it)))
  35                (when (ucon-is-tui? ucon2 tui)
  36                  ucon2))
  37              nil))
  38     (funcall related-con-func ucon))
  39    :key #'cui))
  40
  41 (defun find-ucon2-coc-tui (ucon tui)
  42   "Return list of ucon's that have co-occuring concepts of semantic type tui"
  43   (find-ucon2-tui ucon tui #'cui2 #'s#coc))
  44
  45 (defun find-ucon2-rel-tui (ucon tui)
  46   "Return list of ucon's that have related concepts to ucon and semantic type tui"
  47   (find-ucon2-tui ucon tui #'cui2 #'s#rel))
  48
  49 ;;; Composite Objects
  50
  51 (defclass ucon_freq (umlsclass)
  52   ((ucon :type ucon :initarg :ucon :reader ucon)
  53    (freq :type fixnum :initarg :freq :accessor freq))
  54   (:metaclass ml-class)
  55   (:default-initargs :cui nil :pfstr nil :freq nil)
  56   (:title "Concept and Count")
  57   (:fields (cui :string fmt-cui) (freq :fixnum) (pfstr :cdata))
  58   (:ref-fields (cui find-ucon-cui))
  59   (:documentation "Composite object of ucon/freq"))
  60
  61 (defun ucon_freq-cui (c)
  62   (cui (ucon c)))
  63
  64 (defun ucon_freq-pfstr (c)
  65   (pfstr (ucon c)))
  66
  67 (defclass ustr_freq (umlsclass)
  68   ((ustr :type ustr :initarg :ustr :reader ustr)
  69    (freq :type fixnum :initarg :freq :accessor freq))
  70   (:metaclass ml-class)
  71   (:default-initargs :cui nil :pfstr nil :freq nil)
  72   (:title "String and Count")
  73   (:fields (sui :string fmt-sui) (freq :fixnum) (stt :string) (lrl :fixnum) (str :cdata))
  74   (:ref-fields (sui find-ustr-sui))
  75   (:documentation "Composite object of ustr/freq"))
  76
  77 (defun ustr_freq-sui (s)
  78   (sui (ustr s)))
  79
  80 (defun ustr_freq-str (s)
  81   (str (ustr s)))
  82
  83 (defun ustr_freq-lrl (s)
  84   (lrl (ustr s)))
  85
  86 (defun ustr_freq-stt (s)
  87   (stt (ustr s)))
  88
  89 (defclass usty_freq (umlsclass)
  90   ((usty :type usty :initarg :usty :reader usty)
  91    (freq :type fixnum :initarg :freq :accessor freq))
  92   (:metaclass ml-class)
  93   (:default-initargs :usty nil :freq nil)
  94   (:title "Semantic Type and Count")
  95   (:ref-fields (tui find-ucon-tui "subobjects=no"))
  96   (:fields (tui :string fmt-tui) (freq :fixnum) (sty :string))
  97   (:documentation "Composite object of usty/freq"))
  98
  99 (defun usty_freq-tui (s)
 100   (tui (usty s)))
 101
 102 (defun usty_freq-sty (s)
 103   (sty (usty s)))
 104
 105 (defclass usrl_freq (umlsclass)
 106   ((usrl :type usrl :initarg :usrl :reader usrl)
 107    (freq :type fixnum :initarg :freq :accessor freq))
 108   (:metaclass ml-class)
 109   (:default-initargs :usrl nil :freq nil)
 110   (:title "Source and Count")
 111   (:ref-fields (sab find-ustr-sab))
 112   (:fields (sab :string) (freq :commainteger) (srl :fixnum))
 113   (:documentation "Composite object of usrl/freq"))
 114
 115 (defun usrl_freq-sab (s)
 116   (sab (usrl s)))
 117
 118 (defun usrl_freq-srl (s)
 119   (srl (usrl s)))
 120
 121
 122 ;; Frequency finding functions
 123 (defun find-ucon2_freq-coc-tui (ucon tui)
 124 "Return sorted list of tuples with ucon and freq that have co-occuring concepts of semantic type tui"
 125   (let ((ucon_freqs '()))
 126     (dolist (ucoc (s#coc ucon))
 127       (gu:aif (cui2 ucoc)
 128            (let ((ucon2 (find-ucon-cui gu::it)))
 129              (when (ucon-is-tui? ucon2 tui)
 130                (push (make-instance 'ucon_freq :ucon ucon2 :freq (cof ucoc))
 131                      ucon_freqs)))))
 132     (setq ucon_freqs (delete-duplicates ucon_freqs :key #'cui))
 133     (sort ucon_freqs #'> :key #'freq)))
 134
 135 (defun find-ucon2-str&sty (str sty lookup-func)
 136   "Call lookup-func for ucon and usty for given str and sty"
 137   (let ((ucon (car (find-ucon-str str)))
 138         (usty (car (find-usty-word sty))))
 139     (if (and ucon usty)
 140         (funcall lookup-func ucon (tui usty))
 141       nil)))
 142
 143 (defun find-ucon2-coc-str&sty (str sty)
 144   "Find all ucons that are a co-occuring concept for concept named str
 145    and that have semantic type of sty"
 146   (find-ucon2-str&sty str sty #'find-ucon2-coc-tui))
 147
 148 (defun find-ucon2-rel-str&sty (str sty)
 149   "Find all ucons that are a relationship to concept named str
 150    and that have semantic type of sty"
 151   (find-ucon2-str&sty str sty #'find-ucon2-rel-tui))
 152
 153 ;;; Most common relationships, co-occurances
 154
 155 (defun find-ucon2_freq-tui-all (tui ucon2-tui-func)
 156   "Return sorted list of all ucon2 that have a semantic type tui with ucon that is also has sty of tui"
 157   (let ((ucon_freqs (make-array (1+ (find-cui-max)) :initial-element nil)))
 158     (dolist (ucon (find-ucon-tui tui)) ;; for all disease-or-syn
 159       (dolist (ucon2 (funcall ucon2-tui-func ucon tui)) ;; for each related disease
 160         (gu:aif (aref ucon_freqs (cui ucon2))
 161              (setf (freq gu::it) (1+ (freq gu::it)))
 162              (setf (aref ucon_freqs (cui ucon2))
 163                (make-instance 'ucon_freq :ucon ucon2 :freq 1)))))
 164     (let ((ucon_freq-list '()))
 165       (dotimes (i (find-cui-max))
 166         (declare (fixnum i))
 167         (gu:awhen (aref ucon_freqs i)
 168              (push gu::it ucon_freq-list)))
 169       (sort ucon_freq-list #'> :key #'freq))))
 170
 171 (defun find-ucon2_freq-rel-tui-all (tui)
 172   "Sorted list of ucon_freq with semantic type tui that are rel's of ucons with semantic type tui"
 173   (find-ucon2_freq-tui-all tui #'find-ucon2-rel-tui))
 174
 175 (defun find-ucon2_freq-coc-tui-all (tui)
 176   (find-ucon2_freq-tui-all tui #'find-ucon2-coc-tui))
 177