X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=composite.lisp;h=ddda98f6cd9aeda7179ed11c0e77e27794b4b74c;hb=d17db83f9f6dc74ea41cc960770dcbfafa3fef30;hp=07307139abf38e161f1bb06f51486086fabafd32;hpb=62174876033b75ec9583ad2137a014c78bd76d92;p=umlisp.git diff --git a/composite.lisp b/composite.lisp index 0730713..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.7 2002/10/16 16:09:55 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,62 +65,30 @@ ;;; 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")) - (:ref-fields (tui find-ucon-tui)) - (:fields (tui :string fmt-tui) (freq :fixnum) (sty :string)) + (:print-slots tui freq sty) (:documentation "Composite object of usty/freq")) -(defmethod tui ((s usty_freq)) - (tui (usty 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")) @@ -132,23 +100,14 @@ (sort usty_freqs #'> :key #'freq))) -(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) +(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")) -(defmethod sab ((s usrl_freq)) - (sab (usrl s))) - -(defmethod srl ((s usrl_freq)) - (srl (usrl s))) - - ;; Frequency finding functions (defun find-usrl_freq-all () @@ -168,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))) @@ -201,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)) @@ -216,9 +177,9 @@ (defun find-ucon2_freq-coc-tui-all (tui) (find-ucon2_freq-tui-all tui #'find-ucon2-coc-tui)) -#+cmu +#+(or cmu scl) (dolist (c '(ucon_freq ustr_freq usty_freq usrl_freq)) (let ((cl #+cmu (pcl:find-class c) - #+sbcl (sb-pcl:find-class c))) + #+scl (find-class c))) #+cmu (pcl:finalize-inheritance cl) - #+sbcl (sb-pcl:finalize-inheritance cl))) + #+scl (clos:finalize-inheritance cl)))