X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=composite.lisp;h=07307139abf38e161f1bb06f51486086fabafd32;hb=62174876033b75ec9583ad2137a014c78bd76d92;hp=d31c51321494f3cb4b9422e2085c3d1dfe660a80;hpb=cd8b476663925be5a1ebbeb569a056e2e5b93aba;p=umlisp.git diff --git a/composite.lisp b/composite.lisp index d31c513..0730713 100644 --- a/composite.lisp +++ b/composite.lisp @@ -1,15 +1,32 @@ -;;;; $Id: composite.lisp,v 1.1 2002/10/08 22:08:56 kevin Exp $ +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: composite.lisp +;;;; Purpose: Composite Classes for UMLisp +;;;; Programmer: Kevin M. Rosenberg +;;;; Date Started: Apr 2000 +;;;; +;;;; $Id: composite.lisp,v 1.7 2002/10/16 16:09:55 kevin Exp $ +;;;; +;;;; This file, part of UMLisp, is +;;;; Copyright (c) 2000-2002 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) +(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) ;;; Semantic type constants (defun find-tui-word (words) - (gu:aif (car (find-usty-word words)) - (tui gu::it) + (kmrcl:aif (car (find-usty-word words)) + (tui kmrcl::it) nil)) -(gu:memoize 'find-tui-word) +(kmrcl:memoize 'find-tui-word) (defun tui-disease-or-syndrome () (find-tui-word "disease or syndrome")) @@ -30,8 +47,8 @@ (remove-duplicates (filter #'(lambda (c) - (gu:aif (funcall cui2-func c) - (let ((ucon2 (find-ucon-cui gu::it))) + (kmrcl:aif (funcall cui2-func c) + (let ((ucon2 (find-ucon-cui kmrcl::it))) (when (ucon-is-tui? ucon2 tui) ucon2)) nil)) @@ -51,7 +68,7 @@ (defclass ucon_freq (umlsclass) ((ucon :type ucon :initarg :ucon :reader ucon) (freq :type fixnum :initarg :freq :accessor freq)) - (:metaclass ml-class) + (:metaclass kmrcl:ml-class) (:default-initargs :cui nil :pfstr nil :freq nil) (:title "Concept and Count") (:fields (cui :string fmt-cui) (freq :fixnum) (pfstr :cdata)) @@ -67,7 +84,7 @@ (defclass ustr_freq (umlsclass) ((ustr :type ustr :initarg :ustr :reader ustr) (freq :type fixnum :initarg :freq :accessor freq)) - (:metaclass ml-class) + (:metaclass kmrcl:ml-class) (:default-initargs :cui nil :pfstr nil :freq nil) (:title "String and Count") (:fields (sui :string fmt-sui) (freq :fixnum) (stt :string) (lrl :fixnum) (str :cdata)) @@ -89,43 +106,67 @@ (defclass usty_freq (umlsclass) ((usty :type usty :initarg :usty :reader usty) (freq :type fixnum :initarg :freq :accessor freq)) - (:metaclass ml-class) + (:metaclass kmrcl:ml-class) (:default-initargs :usty nil :freq nil) (:title "Semantic Type and Count") - (:ref-fields (tui find-ucon-tui "subobjects=no")) +;; (:ref-fields (tui find-ucon-tui "subobjects=no")) + (:ref-fields (tui find-ucon-tui)) (:fields (tui :string fmt-tui) (freq :fixnum) (sty :string)) (:documentation "Composite object of usty/freq")) -(defun usty_freq-tui (s) +(defmethod tui ((s usty_freq)) (tui (usty s))) - -(defun usty_freq-sty (s) + +(defmethod sty ((s usty_freq)) (sty (usty s))) + +(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)))))) + (push (make-instance 'usty_freq :usty (find-usty-tui tui) :freq freq) usty_freqs))) + (sort usty_freqs #'> :key #'freq))) + + (defclass usrl_freq (umlsclass) ((usrl :type usrl :initarg :usrl :reader usrl) (freq :type fixnum :initarg :freq :accessor freq)) - (:metaclass ml-class) + (:metaclass kmrcl:ml-class) (:default-initargs :usrl nil :freq nil) (:title "Source and Count") (:ref-fields (sab find-ustr-sab)) (:fields (sab :string) (freq :commainteger) (srl :fixnum)) (:documentation "Composite object of usrl/freq")) -(defun usrl_freq-sab (s) +(defmethod sab ((s usrl_freq)) (sab (usrl s))) -(defun usrl_freq-srl (s) +(defmethod srl ((s usrl_freq)) (srl (usrl s))) ;; 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 :usrl usrl :freq freq) freqs))) + (sort freqs #'> :key #'usrl_freq-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)) - (gu:aif (cui2 ucoc) - (let ((ucon2 (find-ucon-cui gu::it))) + (kmrcl:aif (cui2 ucoc) + (let ((ucon2 (find-ucon-cui kmrcl::it))) (when (ucon-is-tui? ucon2 tui) (push (make-instance 'ucon_freq :ucon ucon2 :freq (cof ucoc)) ucon_freqs))))) @@ -157,15 +198,15 @@ (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 - (gu:aif (aref ucon_freqs (cui ucon2)) - (setf (freq gu::it) (1+ (freq gu::it))) + (kmrcl:aif (aref ucon_freqs (cui ucon2)) + (setf (freq kmrcl::it) (1+ (freq kmrcl::it))) (setf (aref ucon_freqs (cui ucon2)) (make-instance 'ucon_freq :ucon ucon2 :freq 1))))) (let ((ucon_freq-list '())) (dotimes (i (find-cui-max)) (declare (fixnum i)) - (gu:awhen (aref ucon_freqs i) - (push gu::it ucon_freq-list))) + (kmrcl:awhen (aref ucon_freqs i) + (push kmrcl::it ucon_freq-list))) (sort ucon_freq-list #'> :key #'freq)))) (defun find-ucon2_freq-rel-tui-all (tui) @@ -175,3 +216,9 @@ (defun find-ucon2_freq-coc-tui-all (tui) (find-ucon2_freq-tui-all tui #'find-ucon2-coc-tui)) +#+cmu +(dolist (c '(ucon_freq ustr_freq usty_freq usrl_freq)) + (let ((cl #+cmu (pcl:find-class c) + #+sbcl (sb-pcl:find-class c))) + #+cmu (pcl:finalize-inheritance cl) + #+sbcl (sb-pcl:finalize-inheritance cl)))