X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=composite.lisp;h=49f6e2e06f551ed28ba9b99f06c82147b9148175;hb=cdaa9cb65482eaca5a8eafbbe7b3bec9fb157512;hp=5bc641800983b158c94b28f68072ec1d76c0d90e;hpb=3c2c3b6de4cf8855bd833c1d08510d016c3c3d96;p=umlisp.git diff --git a/composite.lisp b/composite.lisp index 5bc6418..49f6e2e 100644 --- a/composite.lisp +++ b/composite.lisp @@ -2,29 +2,27 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: composite.lisp -;;;; Purpose: Composite Classes for UMLisp -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 +;;;; Name: composite.lisp +;;;; Purpose: Composite Classes for UMLisp +;;;; Author: Kevin M. Rosenberg +;;;; Created: Apr 2000 ;;;; -;;;; $Id: composite.lisp,v 1.13 2002/11/24 05:24:26 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. +;;;; 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) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) - +(in-package #:umlisp) ;;; Semantic type constants (defun find-tui-word (words) (aif (car (find-usty-word words)) - (tui :it) + (tui it) nil)) (memoize 'find-tui-word) @@ -48,10 +46,9 @@ (filter #'(lambda (c) (aif (funcall cui2-func c) - (let ((ucon2 (find-ucon-cui :it))) + (let ((ucon2 (find-ucon-cui it))) (when (ucon-is-tui? ucon2 tui) - ucon2)) - nil)) + ucon2)) nil)) (funcall related-con-func ucon)) :key #'cui)) @@ -66,33 +63,34 @@ ;;; Composite Objects (defclass freq (hyperobject) - ((freq :type integer :initarg :freq :accessor freq :print-formatter fmt-comma-integer)) + ((freq :value-type integer :initarg :freq :accessor freq + :print-formatter fmt-comma-integer)) (:metaclass hyperobject-class) (:default-initargs :freq 0) - (:title "Frequency class") - (:print-slots freq) - (:documentation "Base class containing frequency slot, used for multi-inherited objects")) + (: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) - (:title "Concept and Count") - (:print-slots cui freq pfstr) - (:documentation "Composite object of ucon/freq")) + (: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) - (:title "String and Count") - (:print-slots sui freq stt lrl str) - (:documentation "Composite object of ustr/freq")) + (: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) - ((freq :type fixnum :initarg :freq :accessor freq)) + () (:metaclass hyperobject-class) - (:title "Semantic Type and Count") - (:print-slots tui freq sty) - (:documentation "Composite object of usty/freq")) + (: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 '())) @@ -100,17 +98,19 @@ (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))) + (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) - (:title "Source and Count") - (:print-slots sab freq srl) - (:documentation "Composite object of usrl/freq")) + (:user-name "Source and Count" "Sources and Counts") + (:default-print-slots sab freq srl) + (:description "Composite object of usrl/freq")) ;; Frequency finding functions @@ -121,15 +121,17 @@ (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))) + (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))) + (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)) @@ -163,7 +165,7 @@ (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 (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))))) @@ -171,7 +173,7 @@ (dotimes (i (find-cui-max)) (declare (fixnum i)) (awhen (aref ucon_freqs i) - (push :it ucon_freq-list))) + (push it ucon_freq-list))) (sort ucon_freq-list #'> :key #'freq)))) (defun find-ucon2_freq-rel-tui-all (tui) @@ -181,7 +183,7 @@ (defun find-ucon2_freq-coc-tui-all (tui) (find-ucon2_freq-tui-all tui #'find-ucon2-coc-tui)) -#+(or cmu scl) +#+(or scl) (dolist (c '(ucon_freq ustr_freq usty_freq usrl_freq)) (let ((cl #+cmu (pcl:find-class c) #+scl (find-class c)))