X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=composite.lisp;h=ddda98f6cd9aeda7179ed11c0e77e27794b4b74c;hb=d17db83f9f6dc74ea41cc960770dcbfafa3fef30;hp=f363287930adc7a6eab1fd22a0e9c5f010e4ba82;hpb=bfdd5c9d3d66970759fcdbee5a51da2ca93ddf06;p=umlisp.git diff --git a/composite.lisp b/composite.lisp index f363287..ddda98f 100644 --- a/composite.lisp +++ b/composite.lisp @@ -1,4 +1,4 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*- +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: composite.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $ +;;;; $Id: composite.lisp,v 1.11 2002/11/23 22:15:13 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -65,78 +65,61 @@ ;;; Composite Objects -(defclass ucon_freq (umlsclass) - ((ucon :type ucon :initarg :ucon :reader ucon) - (freq :type fixnum :initarg :freq :accessor freq)) - (:metaclass kmrcl:ml-class) - (:default-initargs :cui nil :pfstr nil :freq nil) +(defclass ucon_freq (ucon) + ((freq :type integer :initarg :freq :accessor freq :print-formatter ho:comma-integer)) + (:metaclass hyperobject-class) + (:default-initargs :freq 0) (:title "Concept and Count") - (:fields (cui :string fmt-cui) (freq :fixnum) (pfstr :cdata)) - (:ref-fields (cui find-ucon-cui)) + (:print-slots cui freq pfstr) (:documentation "Composite object of ucon/freq")) -(defun ucon_freq-cui (c) - (cui (ucon c))) - -(defun ucon_freq-pfstr (c) - (pfstr (ucon c))) - -(defclass ustr_freq (umlsclass) - ((ustr :type ustr :initarg :ustr :reader ustr) - (freq :type fixnum :initarg :freq :accessor freq)) - (:metaclass kmrcl:ml-class) - (:default-initargs :cui nil :pfstr nil :freq nil) +(defclass ustr_freq (ustr) + ((freq :type fixnum :initarg :freq :accessor freq :print-formatter ho:comma-integer)) + (:metaclass hyperobject-class) + (:default-initargs :freq 0) (:title "String and Count") - (:fields (sui :string fmt-sui) (freq :fixnum) (stt :string) (lrl :fixnum) (str :cdata)) - (:ref-fields (sui find-ustr-sui)) + (:print-slots sui freq stt lrl str) (:documentation "Composite object of ustr/freq")) -(defun ustr_freq-sui (s) - (sui (ustr s))) - -(defun ustr_freq-str (s) - (str (ustr s))) - -(defun ustr_freq-lrl (s) - (lrl (ustr s))) - -(defun ustr_freq-stt (s) - (stt (ustr s))) - -(defclass usty_freq (umlsclass) - ((usty :type usty :initarg :usty :reader usty) - (freq :type fixnum :initarg :freq :accessor freq)) - (:metaclass kmrcl:ml-class) - (:default-initargs :usty nil :freq nil) +(defclass usty_freq (usty) + ((freq :type fixnum :initarg :freq :accessor freq)) + (:metaclass hyperobject-class) + (:default-initargs :freq 0) (:title "Semantic Type and Count") - (:ref-fields (tui find-ucon-tui "subobjects=no")) - (:fields (tui :string fmt-tui) (freq :fixnum) (sty :string)) + (:print-slots tui freq sty) (:documentation "Composite object of usty/freq")) -(defun usty_freq-tui (s) - (tui (usty s))) - -(defun usty_freq-sty (s) - (sty (usty s))) - -(defclass usrl_freq (umlsclass) - ((usrl :type usrl :initarg :usrl :reader usrl) - (freq :type fixnum :initarg :freq :accessor freq)) - (:metaclass kmrcl:ml-class) - (:default-initargs :usrl nil :freq nil) +(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 (usrl) + ((freq :type fixnum :initarg :freq :accessor freq :print-formatter ho:comma-integer)) + (:metaclass hyperobject-class) + (:default-initargs :freq 0) (:title "Source and Count") - (:ref-fields (sab find-ustr-sab)) - (:fields (sab :string) (freq :commainteger) (srl :fixnum)) + (:print-slots sab freq srl) (:documentation "Composite object of usrl/freq")) -(defun usrl_freq-sab (s) - (sab (usrl s))) - -(defun usrl_freq-srl (s) - (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))) -;; Frequency finding functions (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 '())) @@ -144,7 +127,8 @@ (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)) + (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))) @@ -177,7 +161,8 @@ (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))))) + (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)) @@ -192,3 +177,9 @@ (defun find-ucon2_freq-coc-tui-all (tui) (find-ucon2_freq-tui-all tui #'find-ucon2-coc-tui)) +#+(or cmu 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)))