#|------------------------------------------------------------------02/May/88-- Module - STRUCT.LSP Programmer: John Gennari/Patrick Young/Kevin Thompson This is a utility module used by "classit.lsp". Contains defstructs and copier functions. Make sure to change copy functions whenever adding/deleting fields. -----------------------------------------------------------------------JHG--|# (provide "struct") (require "globals") #|---------------------------------------------------------------------------- NODE is a node of the C-Tree which represents either an instance of whatever is being classified, or a generalization of what is being classified. It can either be an internal node or a leaf. The Common Lisp copier function is not used, since we will need the atts to be copied explicitly (the standard copy function will merely copy pointers, not produce new copies). In fact we will define two seperate copiers: copy-node which will make duplicates of the atts, but will merely return pointers to the children, extensive-copy-node which makes duplicates of both the atts and the children (but not the children's children). -----------------------------------------------------------------------------|# (defstruct (node (:copier nil) (:print-function (lambda (struct stream level) (node-printer struct stream level)))) (count 0 :type integer) ; number of instances associated with given node atts ; statstical info for each attribute (see below) attScores ; sum over atts and values of P(A=V / C) (COBWEB) ; or sum reciprocals of squareroot of atts variances children ; children nodes members ; members of the node ) (defun short-printer (struct stream level) (format stream "~vTNODE{members ~A " (min (* 3 level) 25) (node-members struct)) (mapc #'(lambda (child) (terpri stream) (short-printer child stream (1+ level))) (node-children struct)) (format stream "}")) (defun long-printer (struct stream level) (format stream "~vTNODE{members ~A Scores ~5,2F" (min (* 3 level) 25) (node-members struct) (node-attScores struct)) (mapc #'(lambda (att) (terpri stream) (if (eq (basic-att-key att) :numeric) (NumAtt-Printer att stream (1+ level)) (NomAtt-Printer att stream (1+ level)))) (node-atts struct)) (mapc #'(lambda (child) (terpri stream) (long-printer child stream (1+ level))) (node-children struct)) (format stream "}")) (defun node-printer (struct stream level) (short-printer struct stream level)) (defmacro setup-node-printer (arg) `(ecase ,arg (:long (defun node-printer (struct stream level) (long-printer struct stream level))) (:short (defun node-printer (struct stream level) (short-printer struct stream level))))) #|----------------------------------------------------------------04/May/88---- Function - COPY-NODE Used in place of the Common Lisp default copier, since we need explicit copies of the atts, not just copies of the pointers to the atts. Inputs -> a node Returns -> copy -------------------------------------------------------------------Pyoung---|# (defun copy-node (node &aux new-node) (if node (setq new-node (make-node :count (node-count node) :atts (mapcar #'copy-att (node-atts node)) :attScores (node-attScores node) :children (node-children node) :members (node-members node)) ) nil) ) #|----------------------------------------------------------------04/May/88---- Function - EXTENSIVE-COPY-NODE copies of the atts, not just copies of the pointers to the atts. Inputs -> a node Returns -> a copy -------------------------------------------------------------------Pyoung---|# (defun extensive-copy-node (node &aux new-node) (if node (setq new-node (make-node :count (node-count node) :atts (mapcar #'copy-att (node-atts node)) :attScores (node-attScores node) :children (mapcar #'copy-node (node-children node)) :members (node-members node)) ) nil) ) #|***************************************************************************** ATT is a storage structure for statistical information for a given attribute. It can vary depending on the type of attribute; e.g. whether it's nominal or numeric. *****************************************************************************|# (defstruct basic-att name ; name of attribute (acount 0 :type integer) ; number of instances with given attribute ; (= # of times att seen for missing attributes) key ; either :NOMINAL or :NUMERIC ) (defstruct (NumAtt (:copier nil) (:include basic-att (key :numeric)) (:print-function (lambda (struct stream level) (NumAtt-Printer struct stream level)))) (variance *ACUITY* :type float) ; variance (sum 0.0 :type float) ; sum of attribute value for all members of node (sum2 0.0 :type float) ; sum of squares ) (defstruct (NomAtt (:copier nil) (:include basic-att (key :nominal)) (:print-function (lambda (struct stream level) (NomAtt-Printer struct stream level)))) values ; list of (value . count) pairs ) (defun NumAtt-Printer (struct stream level) (format stream "~vTNumAtt{~10A acnt=~3D var=~8,1F sum=~8,1F }" (min (* 3 level) 25) (NumAtt-name struct) (NumAtt-acount struct) (NumAtt-variance struct) (NumAtt-sum struct))) (defun NomAtt-Printer (struct stream level) (format stream "~vTNomAtt{~10A acnt=~3D ~A}" (min (* 3 level) 25) (NomAtt-name struct) (NomAtt-acount struct) (NomAtt-values struct))) #|----------------------------------------------------------------10/May/88---- Function - COPY-NUMATT Inputs -> an attribute struct Returns -> a copy, including copying the values field -------------------------------------------------------------------KThompso--|# (defun copy-NumAtt (att) (if att (make-NumAtt :name (NumAtt-name att) :acount (NumAtt-acount att) :sum (NumAtt-sum att) :sum2 (NumAtt-sum2 att) :variance (NumAtt-variance att)) nil)) #|----------------------------------------------------------------10/May/88---- Function - COPY-NOMATT Inputs -> an attribute struct Returns -> a copy, including copying the values field -------------------------------------------------------------------KThompso--|# (defun copy-NomAtt (att) (if att (make-NomAtt :name (NomAtt-name att) :acount (NomAtt-acount att) :values (copy-tree (NomAtt-values att))) nil)) (defun copy-att (att) (ecase (basic-att-key att) (:nominal (copy-NomAtt att)) (:numeric (copy-NumAtt att)))) #|***************************************************************************** A F E W R A N D O M L O W - L E V E L M A C R O S *****************************************************************************|# (defmacro inverse (x) `(/ 1.0 ,x)) (defmacro square (x) `(* ,x ,x)) (defmacro putprop(place value fieldname) `(setf (get ,place ,fieldname) ,value)) (defmacro pr-out (control-string &rest args) `(format *OUTPUT-STREAM* ,control-string ,@args)) (defmacro given-name (obj) `(get ,obj 'given))