pax_global_header00006660000000000000000000000064117271441510014515gustar00rootroot0000000000000052 comment=ed42d120aec4167b51d5b9c1a132732ac50c81d8 metatilities-base-20120909-git/000077500000000000000000000000001172714415100161535ustar00rootroot00000000000000metatilities-base-20120909-git/.boring000066400000000000000000000011621172714415100174340ustar00rootroot00000000000000# Boring file regexps: \.hi$ \.o$ \.o\.cmd$ # *.ko files aren't boring by default because they might # be Korean translations rather than kernel modules. # \.ko$ \.ko\.cmd$ \.mod\.c$ (^|/)\.tmp_versions($|/) (^|/)CVS($|/) (^|/)RCS($|/) ~$ #(^|/)\.[^/] (^|/)_darcs($|/) \.bak$ \.BAK$ \.orig$ (^|/)vssver\.scc$ \.swp$ (^|/)MT($|/) (^|/)\{arch\}($|/) (^|/).arch-ids($|/) (^|/), \.class$ \.prof$ (^|/)\.DS_Store$ (^|/)BitKeeper($|/) (^|/)ChangeSet($|/) (^|/)\.svn($|/) \.py[co]$ \# \.cvsignore$ (^|/)Thumbs\.db$ (^|/)autom4te\.cache($|/) (^|/)scratch($|/) (^|/)two words($|/) (^|/)test-results($|/) \.dribble \.drb (^|/)make($|/) metatilities-base-20120909-git/.gitignore000066400000000000000000000003031172714415100201370ustar00rootroot00000000000000# really this is private to my build process make/ common-lisp.net .vcs GNUmakefile init-lisp.lisp project-init.lisp log5.tar.gz website/output/ test-results/ lift-local.config *.dribble *.fasl metatilities-base-20120909-git/COPYING000066400000000000000000000021161172714415100172060ustar00rootroot00000000000000Copyright (c) 2008-2008 Gary Warren King (gwking@metabang.com) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. metatilities-base-20120909-git/dev/000077500000000000000000000000001172714415100167315ustar00rootroot00000000000000metatilities-base-20120909-git/dev/api.lisp000066400000000000000000000042161172714415100203760ustar00rootroot00000000000000(in-package #:metatilities) (defgeneric choose-directory-question* (interface &rest args) (:documentation "")) (defgeneric choose-file-question* (interface &rest args) (:documentation "")) (defgeneric choose-item-from-pup* (interface the-list &rest args &key &allow-other-keys) (:documentation "")) (defgeneric choose-item-question* (interface list &rest args &key title &allow-other-keys) (:documentation "")) (defgeneric choose-new-file-question* (interface &rest args) (:documentation "")) (defgeneric y-or-n-question* (interface message &rest args) (:documentation "Asks a yes or no question spiffily.")) (defgeneric gui-error* (interface condition &optional prefix standard-message) (:documentation "")) (defgeneric gui-warn* (interface string &rest args &key ok-text title size &allow-other-keys) (:documentation "")) ;;?? probably should hsave an interface argument (defgeneric report-condition (condition stream) ) (defgeneric help-spec (view) (:documentation "")) (defgeneric interface-beep* (interface &rest args) (:documentation "")) (defgeneric make-color** (interface red green blue) (:documentation "")) (defgeneric make-gray* (interface level) (:documentation "")) (defgeneric make-scaled-color* (interface red green blue scale) (:documentation "")) (defgeneric name (x) (:documentation "")) (defgeneric process-parameters* (interface &rest args) (:documentation "")) (defgeneric prompt-for* (interface type prompt &rest args &key &allow-other-keys) (:documentation "")) (defgeneric put-item-on-clipboard* (interface thing) (:documentation "")) (defgeneric select-instrument* (interface instrument &rest args) (:documentation "")) (defgeneric inspect-thing* (interface thing &rest args)) (defgeneric sound-note* (interface pitch velocity &rest args) (:documentation "")) (defgeneric stop-notes* (interface) (:documentation "")) (defgeneric make-progress-bar (interface min max title &key) ) (defgeneric progress-bar-value (interface bar) ) (defgeneric (setf progress-bar-value) (value interface bar) ) (defgeneric close-progress-bar (interface bar) ) (defgeneric make-ui-point* (interface x y)) metatilities-base-20120909-git/dev/copy-file.lisp000066400000000000000000000120351172714415100215120ustar00rootroot00000000000000(in-package #:metatilities) (eval-always (export '(source/target-file-error source-pathname target-pathname source/target-target-already-exists-error source/target-source-does-not-exist-error copy-file))) (define-condition source/target-file-error (file-error) ((pathname :reader source-pathname :initarg :source-pathname) (target-pathname :reader target-pathname :initarg :target-pathname :initform nil)) (:report (lambda (c s) (format s "Copy of ~S to ~S failed" (source-pathname c) (target-pathname c)))) (:documentation "General condition for file errors that have a source and target.")) (define-condition source/target-target-already-exists-error (source/target-file-error) () (:report (lambda (c s) (format s "File action failed because target ~S already exists" (target-pathname c)))) (:documentation "This error is signaled when the target pathname already exists.")) (define-condition source/target-source-does-not-exist-error (source/target-file-error) () (:report (lambda (c s) (format s "File action failed because source ~S does not exist" (source-pathname c)))) (:documentation "This error is signaled when the source file does not exist.")) (defun copy-file (from to &key (if-does-not-exist :error) (if-exists :error)) "Copies the file designated by the non-wild pathname designator FROM to the file designated by the non-wild pathname designator TO. The following keyword parameters are supported: * :if-exists this can be either :supersede or :error (the default). If it is :error then a source/target-target-already-exists-error will be signaled if the file designated by the TO pathname already exists. * :if-does-not-exist this can be either :ignore or :error (the default). If it is :error then a source/target-source-does-not-exist-error will be signaled if the FROM pathname designator does not exist. " (assert (member if-exists '(:error :supersede)) nil "The if-exists keyword parameter must be one of :error or :supersede. It is currently set to ~S" if-exists) (assert (member if-does-not-exist '(:error :ignore)) nil "The if-does-not-exist keyword parameter must be one of :error or :ignore. It is currently set to ~S" if-does-not-exist) (ensure-directories-exist to) (cond ((probe-file from) #+:allegro (excl.osi:copy-file from to :overwrite (if (eq if-exists :supersede) :ignore nil)) #-:allegro (let ((element-type #-:cormanlisp '(unsigned-byte 8) #+:cormanlisp 'unsigned-byte)) (with-open-file (in from :element-type element-type) (with-open-file (out to :element-type element-type :direction :output :if-exists if-exists) (unless out (error (make-condition 'source/target-target-already-exists :pathname from :target-pathname to))) (copy-stream in out)))) (values t)) (t ;; no source file! (ecase if-does-not-exist ((:error) (error 'source/target-source-does-not-exist-error :pathname from :target-pathname to)) ((:ignore) nil))))) (defun move-file (from to &rest args &key (if-does-not-exist :error) (if-exists :error)) (declare (dynamic-extent args) (ignore if-exists if-does-not-exist)) (when (apply #'copy-file from to args) (delete-file from))) ;;; borrowed from asdf-install -- how did this ever work ?! ;; for non-SBCL we just steal this from SB-EXECUTABLE #-(or :digitool) (defvar *stream-buffer-size* 8192) #-(or :digitool) (defun copy-stream (from to) "Copy into TO from FROM until end of the input stream, in blocks of *stream-buffer-size*. The streams should have the same element type." (unless (subtypep (stream-element-type to) (stream-element-type from)) (error "Incompatible streams ~A and ~A." from to)) (let ((buf (make-array *stream-buffer-size* :element-type (stream-element-type from)))) (loop (let ((pos #-(or :clisp :cmu) (read-sequence buf from) #+:clisp (ext:read-byte-sequence buf from :no-hang nil) #+:cmu (sys:read-n-bytes from buf 0 *stream-buffer-size* nil))) (when (zerop pos) (return)) (write-sequence buf to :end pos))))) #+:digitool (defun copy-stream (from to) "Perform copy and map EOL mode." (multiple-value-bind (reader reader-arg) (ccl::stream-reader from) (multiple-value-bind (writer writer-arg) (ccl::stream-writer to) (let ((datum nil)) (loop (unless (setf datum (funcall reader reader-arg)) (return)) (funcall writer writer-arg datum)))))) metatilities-base-20120909-git/dev/defclass-star.lisp000066400000000000000000000462371172714415100223710ustar00rootroot00000000000000(in-package #:metatilities) (defvar *automatic-slot-accessors?* nil) (defvar *automatic-slot-initargs?* nil) (defvar *clos-slot-options* '(:initform :initarg :reader :writer :accessor :documentation :type :allocation)) (defvar *prune-unknown-slot-options* nil) (defun parse-brief-slot (slot &optional (automatic-accessors? *automatic-slot-accessors?*) (automatic-initargs? *automatic-slot-initargs?*) name-prefix name-postfix (name-separator "-") (additional-options nil)) "Returns a verbose-style slot specification given a brief style, consisting of a single symbol, the name of the slot, or a list of the slot name, optional initform, optional symbol specifying whether there is an initarg, reader, or accessor, and optional documentation string. The specification of initarg, reader and accessor is done by the letters I, R and A, respectively; to specify none of those, give a symbol containing none of those letters, such as the symbol *. This function is used in the macro `defclass-brief,' but has been broken out as a function in its own right for those writing variants on the `defclass' macro. If a verbose-style slot specification is given, it is returned unchanged. If `automatic-accessors? is true, an accessor is defined, whether A is specified or not _unless_ R is specified. If `automatic-initargs? is true, an initarg is defined whether I is specified or not. If `name-prefix' or `name-postfix' is specified, the accessor name has that prepended or appended, with name-separator, and the slot name in the middle. All other CLOS slot options are processed normally." ;; check types (etypecase slot (symbol (setf slot (list slot))) (list nil)) (let* ((name (pop slot)) (new-slot (list name)) (done-initform? nil) (done-spec? nil) (done-documentation? nil) (reader-added? nil) (writer-added? nil) (accessor-added? nil) (initargs-added? nil) (all-allowed-options (if additional-options (append *clos-slot-options* additional-options) *clos-slot-options*))) (flet ((make-conc-name () (let (names) (when name-postfix (push name-postfix names) (push name-separator names)) (push name names) (when name-prefix (push name-separator names) (push name-prefix names)) (apply 'form-symbol names))) (add-option (option argument) (push option new-slot) (push argument new-slot)) ;; Remove duplicate options before returning the slot spec. (finish-new-slot (slot) ;; XXX This code is overly loopy and opaque ---L (destructuring-bind (slot-name &rest options) slot (let ((opts (make-hash-table))) (loop for (key val . d) = options then d while key doing (pushnew val (gethash key opts nil) :test #'equal)) (loop for key being each hash-key of opts using (hash-value vals) nconc (mapcan #'(lambda (x) (list key x)) vals) into spec finally (return (cons slot-name spec))))))) (setf accessor-added? (find :accessor slot) done-initform? (find :initform slot)) (do* ((items slot (rest items)) (item (first items) (first items)) (process-item? t t) (allowed-item? (member item all-allowed-options) (member item all-allowed-options))) ((null items) nil) (unless done-initform? (setf done-initform? t) (unless allowed-item? (setf process-item? nil) (unless (eq item :unbound) (push :initform new-slot) (push item new-slot)))) ;;?? maybe want (not (slot-reader-writer-initarg-accessor-spec-p ?!)) (when (and process-item? (not (keywordp item))) (unless (or done-spec? (not (symbolp item)) allowed-item?) (setf done-spec? t) (setf process-item? nil) ;; If you've got an A, who cares about R (when (find #\A (string item) :test #'char-equal) (setf accessor-added? t) (add-option :accessor (make-conc-name))) (when (and (not accessor-added?) (find #\R (string item) :test #'char-equal)) (setf reader-added? t) (add-option :reader (make-conc-name))) (when (and (not accessor-added?) (find #\W (string item) :test #'char-equal)) (setf writer-added? t) (add-option :writer (list 'setf (make-conc-name)))) (when (find #\I (string item) :test #'char-equal) (setf initargs-added? t) (add-option :initarg (intern (string name) (find-package :keyword)))))) (when process-item? (unless (or done-documentation? (not (stringp item))) (setf done-documentation? t process-item? nil) (push :documentation new-slot) (push item new-slot) )) (when process-item? (when (or (not *prune-unknown-slot-options*) allowed-item?) (push item new-slot) (pop items) ;(assert items) (push (first items) new-slot))) ;(spy new-slot) ) (when (and automatic-initargs? (not initargs-added?)) (add-option :initarg (intern (string name) (find-package :keyword)))) (when (and automatic-accessors? (and (not accessor-added?) (not reader-added?) (not writer-added?))) (add-option :accessor (make-conc-name))) ;; finish-new-slot cleans up duplicates (finish-new-slot (nreverse new-slot))))) (defmacro defclass-brief (name superclasses slots &rest class-options) "A macro with simpler syntax than `defclass' that allows some briefer ways of expressing things. The syntax is more like `defstruct.' A documentation string is optional. Each slot is expressed as either a bare symbol, or a list of the name of the slot, its initial value, a symbol with the letters I, R, A, standing for :initarg, :reader and :accessor, and a documentation string. The symbol, whose package is unimportant, determines the generation of reader, accessor and so forth; the names are the same as the slot name. All other CLOS options are processed normally. In addition, three new class options are defined. :AUTOMATIC-ACCESSORS means that an accessor is defined for every slot :AUTOMATIC-INITARGS means that an initarg is defined for every slot (:NAME-PREFIX ) (:NAME-POSTFIX ) prepends or appends `symbol' with `separator' to each slot accessor. The default symbol is the class name and the default separator is the hypen, in which case the wrapping parentheses are optional." (let ((docstring (if (stringp slots) (prog1 slots (setf slots (pop class-options))) nil))) (flet ((delete-option (name) ;; inefficient, but who cares, since it's at compile time and ;; `options' will be short. (let ((elt (or (find name class-options) (find name class-options :key #'(lambda (x) (and (consp x) (first x))))))) (setf class-options (delete elt class-options)) elt))) (let ((accessors? (or (delete-option :automatic-accessors) *automatic-slot-accessors?*)) (initargs? (or (delete-option :automatic-initargs) *automatic-slot-initargs?*)) (name-prefix (delete-option :name-prefix)) (name-postfix (delete-option :name-postfix)) name-separator) (macrolet ((process-name-pre/post-fix (name-pre/post-fix name-separator) `(when ,name-pre/post-fix (setf (values ,name-pre/post-fix ,name-separator) (cond ((cddr ,name-pre/post-fix) (values (cadr ,name-pre/post-fix) (caddr ,name-pre/post-fix))) ((cdr ,name-pre/post-fix) (values (cadr ,name-pre/post-fix) "-")) (t (values name "-")))) (setf ,name-pre/post-fix (string-upcase ,name-pre/post-fix))))) (process-name-pre/post-fix name-prefix name-separator) (process-name-pre/post-fix name-postfix name-separator)) `(progn (defclass ,name ,superclasses ,(mapcar #'(lambda (s) (parse-brief-slot s accessors? initargs? name-prefix name-postfix name-separator)) slots) ,@(when docstring `((:documentation ,docstring))) . ,class-options) #+No (defmethod reinitialize-instance :after ((object ,name) &key) ,@(loop for s in slots for parse = (parse-brief-slot s) when (find :initform parse) collect `(setf (slot-value object ',(first (ensure-list s))) ,(getf (rest parse) :initform)))) (values ',name)))))) (defparameter *defclass-copy-condition-function* #'warn) (defvar *defclass-generate-make-load-form* nil) (defclass-property defclass*-superclasses) (defun class-copyable-p (class-name) ;; (spy class-name) (or (eq class-name 'copyable-mixin) (some #'class-copyable-p (defclass*-superclasses class-name)))) (defmacro defclass* (name superclasses slots &rest class-options) "Like 'defclass-brief' but also provides the :MAKE-LOAD-FORM-P, :EXPORT-P, :EXPORT-SLOTS, :NO-COPY, :COPY-SLOTS and :COPY-SET-SLOTS options." (let* ((docstring (if (stringp slots) (prog1 slots (setf slots (pop class-options))) nil)) (slot-names (mapcar #'(lambda (s) (etypecase s (symbol s) (cons (first s)))) slots))) (flet ((delete-option (name &key error-if-atom (default-value nil)) ;; inefficient but who cares since it's at compile time and ;; `options' will be short. (let ((elt (or (find name class-options) (find name class-options :key #'(lambda (x) (and (consp x) (first x))))))) (setf class-options (delete elt class-options)) (cond ((null elt) (values nil nil)) ((consp elt) (values (rest elt) t)) (error-if-atom (error "~a option should be a list" name)) (t (values default-value t))))) (defclass*-problem (message &rest args) (funcall *defclass-copy-condition-function* (format nil "While defining class ~S,~%~A" name (apply #'format nil message args)))) (just-the-names (list) (mapcar (lambda (elt) (first (ensure-list elt))) list))) (let* ((copy-slots (delete-option :copy-slots :default-value slot-names)) (copy-set-slots (delete-option :copy-set-slots :default-value slot-names)) (copy-cond-slots (delete-option :copy-cond-slots :error-if-atom t :default-value slot-names)) (no-copy (delete-option :no-copy :error-if-atom t :default-value nil)) (export-p (delete-option :export-p :error-if-atom t)) (export-slots (delete-option :export-slots :default-value slot-names)) (make-load-form-p (delete-option :make-load-form-p :error-if-atom t #+NotYet :default-value #+NotYet *defclass-generate-make-load-form*)) (copyable? (some #'class-copyable-p superclasses))) (flet ((format-list (list &optional (end-with ".")) (apply #'format nil (concatenate 'string "~#[~;~A" end-with "~:;~@{~#[~;~]~A~^, ~}~]") list))) (let ((temp nil)) ;; make sure we can export things (setf temp (set-difference export-slots slot-names)) (when temp (defclass*-problem "slots ~A are exported but not defined." (format-list temp)) ;; don't allow it (setf export-slots (intersection export-slots slot-names))) ;;; make sure we can copy things ;; can't be :no-copy and specify copy options (when (and no-copy (or copy-slots copy-set-slots copy-cond-slots)) (defclass*-problem "cannot specify :no-copy copy options simultaneously.")) (when no-copy (setf copy-slots nil copy-set-slots nil copy-cond-slots nil)) ;; if we specify any copy options, then we must be copyable (when (and (or copy-slots copy-set-slots copy-cond-slots) (not copyable?)) ;;?? Gary King 2004-03-02: write copying code even if it is not ;; a copyable-mixin #+Ignore (setf copy-slots nil copy-set-slots nil copy-cond-slots nil) (defclass*-problem "slot copying are specified but ~A does not inherit from copyable-mixin" name)) (when copyable? ;; if we're copyable then all our superclasses should be too (unless (every #'class-copyable-p superclasses) (defclass*-problem "~A is copyable but some of its superclasses ~ (~A) are not." name (format-list (remove-if #'class-copyable-p superclasses) ""))) (let ((copy-slot-names (nconc (just-the-names copy-slots) (just-the-names copy-set-slots) (just-the-names copy-cond-slots)))) (when copy-slot-names ;; only slots of this class can be copied ;;?? should we allow superclasses too? (setf temp (set-difference copy-slot-names slot-names)) (when temp (defclass*-problem "slots ~A have copying options but they are not defined." (format-list temp))) ;; each slot must have only one kind of copy specified (setf temp (loop for elt in copy-slot-names when (> (count elt copy-slot-names) 1) collect elt)) (when temp (defclass*-problem "slots ~A specify multiple copying mechanisms" (format-list temp)))) ;; if we are copyable, we must specify options for all slots (setf temp (set-difference slot-names copy-slot-names)) (when temp (defclass*-problem "slots ~A do not specify a copying mechanism" (format-list temp))))))) `(eval-always ; why does this need to be eval-always? ---L ; b/c otherwise ACL complains about top-level exports (progn ,@(when export-p `((export ',name))) ,@(when export-slots `((export '(,@export-slots)))) (defclass-brief ,name ,superclasses ,slots ,@(when docstring `((:documentation ,docstring))) . ,class-options) ;;?? Gary King 2004-03-02: write copying code even if it is not ;; a copyable-mixin ,@(when (or copy-slots copy-set-slots) `((duplicator-methods (,name) ,slot-names (,@(when copy-slots `((duplicate-slots ,@copy-slots))) ,@(when copy-cond-slots (mapcar #'(lambda (pair) `(duplicate-cond-slots ,@pair)) copy-cond-slots)) ,@(when copy-set-slots (mapcar #'(lambda (pair) ;; Allows this syntax (:copy-set-slots a1 b2) (unless (consp pair) (setf pair (list pair pair))) `(duplicate-set ,@pair)) copy-set-slots)))))) (setf (defclass*-superclasses ',name) ',superclasses) ,@(when make-load-form-p `((make-load-form* ,name))) ',name)))))) (defparameter *defcondition-options* '(((:automatic-accessors :generate-accessors) t nil) ((:automatic-initargs :generate-initargs) t nil) ((:export-p :export?) t nil) ((:export-slots-p :export-slots?) t nil)) "Extra options to defcondition macro. Format is a list of sub-lists. Each sublist should be of length three and consists of a list of option synonyms, the default value for the option [currently ignored], and whether or not to signal an error if this option is used as an atom [currently ignored]") (defmacro defcondition (name supers slots &rest options) "Defcondition is a handy shortcut for defining Common Lisp conditions. It supports all of #[H][define-condition]'s options and more." (let ((elt nil) (extra-options nil)) (loop for (option-list default error-if-atom?) in *defcondition-options* do (progn default error-if-atom?) ;?? For now (setf elt nil) (when (some (lambda (name) (setf elt (find name options :key (lambda (x) (or (and (consp x) (first x)) x))))) option-list) (setf elt (first (ensure-list elt)) options (delete elt options :key (lambda (x) (or (and (consp x) (first x)) x)))) (pushnew (first option-list) extra-options))) (let ((slot-specs (mapcar (lambda (s) (parse-brief-slot s (member :automatic-accessors extra-options) (member :automatic-initargs extra-options) nil nil nil)) slots))) `(progn ,@(when (or (member :export-p extra-options) (member :export-slots-p extra-options)) `((eval-when (:compile-toplevel :load-toplevel :execute) ,@(when (member :export-p extra-options) `((export ',name))) ,@(when (member :export-slots-p extra-options) `((export ',(mapcar #'first slot-specs))))))) (define-condition ,name ,supers ,slot-specs ,@options))))) metatilities-base-20120909-git/dev/defcondition.lisp000066400000000000000000000067261172714415100223020ustar00rootroot00000000000000(in-package #:metatilities) #+(or) (defparameter *defcondition-options* '(((:automatic-accessors :generate-accessors) t nil) ((:automatic-initargs :generate-initargs) t nil) ((:export-p :export?) t nil) ((:export-slots-p :export-slots?) t nil)) "Extra options to defcondition macro. Format is a list of sub-lists. Each sublist should be of length three and consists of a list of option synonyms, the default value for the option [currently ignored], and whether or not to signal an error if this option is used as an atom [currently ignored]") ;;-- from moptilities (defgeneric get-class (thing &key error?) (:documentation "Returns the class of thing or nil if the class cannot be found. Thing can be a class, an object representing a class or a symbol naming a class. Get-class is like find-class only not as particular.") (:method ((thing symbol) &key error?) (find-class thing error?)) (:method ((thing standard-object) &key error?) (declare (ignore error?)) (class-of thing)) (:method ((thing t) &key error?) (declare (ignore error?)) (class-of thing)) (:method ((thing class) &key error?) (declare (ignore error?)) thing)) (defun finalize-class-if-necessary (thing) "Finalizes thing if necessary. Thing can be a class, object or symbol naming a class. Returns the class of thing." (let ((class (get-class thing))) (unless (mop:class-finalized-p class) (mop:finalize-inheritance class)) (values class))) (defun class-slot-names (thing) (let ((class (get-class thing))) (if class (mapcar 'mop:slot-definition-name (mop:class-slots (finalize-class-if-necessary class))) (progn (warn "class for ~a not found)" thing) nil)))) (defmacro defcondition* (name/options (&rest super-conditions) slot-names &optional format &rest args) ;; name/options can be a symbol or a list consisting of ;; (symbol &key exportp documentation) (bind:bind (((name &key documentation (exportp t)) (if (consp name/options) name/options (list name/options))) (all-slot-names (remove-duplicates (loop for super in super-conditions append (class-slot-names super))))) (flet ((massage-slot (slot-spec) (cond ((atom slot-spec) (push slot-spec all-slot-names) `(,slot-spec :initarg ,(intern (symbol-name slot-spec) :keyword))) (t (push (first slot-spec) all-slot-names) slot-spec)))) `(progn (eval-when (:compile-toplevel :load-toplevel :execute) ,@(when exportp `((export '(,name)))) (define-condition ,name ,super-conditions ,(mapcar #'massage-slot slot-names) ,@(when documentation `((:documentation ,documentation))) ,@(when ;; XXX ACL dependency -- this is used inside agraph. (and format #+allegro (setf format (excl::newlinify-format-string format))) `((:report (lambda (condition stream) (declare (ignorable condition)) (let ,(mapcar (lambda (name) `(,name (and (slot-boundp condition ',name) (slot-value condition ',name)))) all-slot-names) ,@(when all-slot-names `((declare (ignorable ,@all-slot-names)))) (format stream ,format ,@args)))))))))))) #+allegro (defmacro newlinify (format &environment e) (if (and (constantp format e) (stringp (sys:constant-value format e))) (excl::newlinify-format-string (sys:constant-value format e)) format)) metatilities-base-20120909-git/dev/generic-interface.lisp000066400000000000000000000263351172714415100232050ustar00rootroot00000000000000(in-package #:metatilities) ;;; System variables (declaim (special *development-mode* *use-native-debugger*)) (defvar *development-mode* t) (defvar *use-native-debugger* nil) ;;; progress bars (defvar *dummy-progress-variable*) (defvar *progress-bar-count* 0) (defmacro with-progress-bar ((min max &rest args &key (title "Progress") (verbose? t) (desired-interface nil interface-supplied?) (determinate-p t) &allow-other-keys) &body body) (remf args :title) (remf args :desired-interface) (remf args :verbose?) (with-variables (bar window interface) `(let ((,interface (if ,interface-supplied? ,desired-interface *default-interface*))) (if (and ,verbose? (is-interface-available-p ,interface)) (macrolet ((progress () ;; avoid compiler warnings `(progress-bar-value ,',interface ,',bar))) (multiple-value-bind (,window ,bar) (make-progress-bar ,interface ,min ,max ,title :determinate-p ,determinate-p ,@args) (declare (ignorable ,bar)) (unwind-protect (progn (incf *progress-bar-count*) (setf (progress-bar-value ,interface ,bar) ,min) ,@body) ;; cleanup (close-progress-bar ,interface ,window) (decf *progress-bar-count*)))) ;; just execute body (macrolet ((progress () '*dummy-progress-variable*)) (let ((*dummy-progress-variable* 0)) (progn ,@body))))))) (defmacro with-process-message ((&rest args &key (title "Please wait...") &allow-other-keys) &body body) (remf args :title) `(with-progress-bar (0 0 :title ,title :determinate-p nil ,@args) ,@body)) ;;; Error handling (defmacro handle-errors (standard-message &body body) `(catch 'recover (if *use-native-debugger* (progn . ,body) ;; Otherwise set up our nice error handlers... (handler-bind ((error #'(lambda (condition) (gui-error condition "ERROR: " ,standard-message) (throw 'recover NIL))) #+(or ccl mcl) (warning #'(lambda (condition) (gui-error condition "WARNING: ") (muffle-warning condition)))) ,@body)))) ;;; beeping (defmethod interface-beep* (interface &rest args) (declare (ignore interface args))) (defun interface-beep (&rest args) (apply #'interface-beep* *default-interface* args)) ;;; no interface interface implementations ;;; Progress bars (defmethod make-progress-bar (interface min max title &key &allow-other-keys) (declare (ignore interface min max title)) (values nil)) (defmethod progress-bar-value (interface bar) (declare (ignore interface bar)) (values 0)) (defmethod (setf progress-bar-value) (value interface bar) (declare (ignore interface bar)) (values value)) (defmethod close-progress-bar (interface bar) (declare (ignore interface bar)) (values)) #+Test (with-progress-bar (0 20) (loop repeat 20 do (incf (progress)) (sleep .1))) ;;; Errors and warnings #-(or digitool openmcl) (defmethod report-condition ((condition condition) stream) (write-string (cond ((typep condition 'error) "Error") ((typep condition 'warning) "Warning") (t "Unknown Condition")) stream) (print-object condition stream)) (defmethod gui-error* (interface condition &optional (prefix "") (standard-message nil)) (gui-warn* interface (if *development-mode* (with-output-to-string (stream) (let ((*print-array* nil) (*print-length* 10) (*print-level* 4)) (#+(or digitool openmcl) ccl::report-condition #-(or digitool openmcl) report-condition condition stream))) (format nil "~A~A" prefix (if standard-message standard-message condition))))) (defun gui-error (condition &optional (prefix "") (standard-message nil)) (gui-error* *default-interface* condition prefix standard-message)) (defmethod gui-warn* (interface string &rest args) (declare (ignore interface)) (apply #'warn string args)) (defun gui-warn (string &rest args) (apply #'gui-warn* *default-interface* string args)) ;;; Color (defmethod make-color** (interface red green blue) (declare (ignore interface red green blue)) (values 0)) (defun make-color* (red green blue) ;;; Make-color with sensible arguments "given red, green, and blue, returns an encoded rgb value" (make-color** (default-interface) red green blue)) (defmethod make-gray* (interface level) (make-color** interface level level level)) (defun make-gray (level) ;;; These use a 0-255 scale for component levels (make-gray* (default-interface) level)) (defmethod make-scaled-color* (interface red green blue scale) (make-color** interface (round (* red scale)) (round (* green scale)) (round (* blue scale)))) (defun make-scaled-color (red green blue scale) (make-scaled-color* (default-interface) red green blue scale)) ;;; y-or-n-dialog (defmethod y-or-n-question* (interface message &rest args) (declare (ignore interface args)) (y-or-n-p message)) (defun y-or-n-question (message &rest args) (apply #'y-or-n-question* *default-interface* message args)) ;;; choose-file-question (defmethod choose-file-question* (interface &rest args) (declare (ignore interface args)) (print "I would love to choose a file for you, but I'm not sure how?")) (defun choose-file-question (&rest args) (apply #'choose-file-question* *default-interface* args)) ;;; choose-new-file-question (defmethod choose-new-file-question* (interface &rest args) (declare (ignore interface args)) (print "I would love to choose a new file name for you, but I'm not sure how?")) (defun choose-new-file-question (&rest args) (apply #'choose-new-file-question* *default-interface* args)) ;;; choose-directory-question (defmethod choose-directory-question* (interface &rest args) (declare (ignore interface args)) (print "I would love to choose a directory name for you, but I'm not sure how?")) (defun choose-directory-question (&rest args) (apply #'choose-directory-question* *default-interface* args)) ;;; choose-item-question (defmethod choose-item-question* (interface list &rest args &key &allow-other-keys) (declare (ignore interface list args)) (print "I would love to choose an item for you, but I'm not sure how?")) (defun choose-item-question (list &rest args &key &allow-other-keys) (apply #'choose-item-question* *default-interface* list args)) ;;; choose-item-from-pup ;; defaults to choose-item-question: (defmethod choose-item-from-pup* (interface the-list &rest args &key &allow-other-keys) (apply #'choose-item-question* interface the-list args)) (defun choose-item-from-pup (the-list &rest args &key &allow-other-keys) "Present an interface to allow a choice from a list. Can throw :cancel." (apply #'choose-item-from-pup* *default-interface* the-list args)) (defun choose-item-from-pup-no-singletons (the-list-or-atom &rest args &key &allow-other-keys) "Like choose-item-from-pup, but just returns the datum if it is an atom or a singleton list." (cond ((atom the-list-or-atom) (values the-list-or-atom)) ((= (length the-list-or-atom) 1) (values (first the-list-or-atom))) (t (apply #'choose-item-from-pup the-list-or-atom args)))) ;;; make-ui-point (defmethod make-ui-point* (interface x y) (declare (ignore interface x y)) (values)) (defun make-ui-point (x y) (make-ui-point* *default-interface* x y)) ;;; process-parameters (defmethod process-parameters* (interface &rest args) (declare (ignore interface args)) (values)) (defun process-parameters (&rest args) (apply #'process-parameters* *default-interface* args) (values)) ;;; put-item-on-clipboard (defmethod put-item-on-clipboard* (interface thing) (declare (ignore interface thing)) (error "I don't know anything about clipboards.")) (defun put-item-on-clipboard (thing) (put-item-on-clipboard* *default-interface* thing) thing) ;;; inspect-thing (defmethod inspect-thing* (interface thing &rest args) (declare (ignore interface args)) (error "I don't know how toinspect ~S" thing)) (defun inspect-thing (thing &rest args) (apply #'inspect-thing* *default-interface* thing args) (values thing)) (defun inspect-things (&rest things) (let ((result nil)) (mapc (lambda (thing) (setf result (inspect-thing thing))) things) (values result))) (defmethod sound-note* (interface pitch velocity &rest args) (declare (ignore interface pitch velocity args)) (interface-beep)) (defun sound-note (pitch velocity &rest args) (apply #'sound-note* *default-interface* pitch velocity args)) (defmethod stop-notes* (interface) (declare (ignore interface)) (error "I don't know how to stop music.")) (defun stop-notes () (stop-notes* *default-interface*)) (defmethod select-instrument* (interface instrument &rest args) (declare (ignore interface instrument args)) (error "I don't know how to select instruments.")) (defun select-instrument (instrument &rest args) (apply #'select-instrument* *default-interface* instrument args)) ;;; query-user-for-string (defun query-user-for-string (prompt &rest args &key &allow-other-keys) (apply #'prompt-for 'string prompt args)) (defun query-user-for-integer (prompt &optional minimum maximum) (catch :cancel (loop do (let ((number (parse-integer (query-user-for-string prompt) :junk-allowed t))) (cond ((null number) ) ((and minimum (< number minimum)) ) ((and maximum (> number maximum)) ) (t (return-from query-user-for-integer number))))))) ;;; prompt-for (defmethod prompt-for* (interface type message &rest args) (declare (ignore interface message args)) (warn "I don't know how to prompt for ~A" type)) (defmethod prompt-for* (interface (type (eql 'string)) message &rest args) (declare (ignore interface)) (apply #'format *query-io* message args) (finish-output *query-io*) (read-line *query-io* nil :eof)) (defmethod prompt-for* (interface (type (eql 'fixnum)) message &rest args) (declare (ignore interface)) (apply #'query-user-for-integer message args)) (defun prompt-for (type message &rest args) (apply #'prompt-for* *default-interface* type message args)) ;;; *************************************************************************** ;;; * End of File * ;;; *************************************************************************** metatilities-base-20120909-git/dev/generic-lisp.lisp000066400000000000000000000040321172714415100222020ustar00rootroot00000000000000(in-package #:metatilities) ;;; Interface determination (defvar *default-interface* nil) (defun default-interface () "Return the current default interface (this is setfable)." *default-interface*) (defun (setf default-interface) (value) (setf *default-interface* value)) (defgeneric is-interface-available-p (interface-name) (:documentation "Returns true is interface-name is available.")) (defmethod is-interface-available-p ((interface (eql nil))) (values nil)) (defun is-default-interface-available-p () (is-interface-available-p *default-interface*)) ;;; quitting (defgeneric quit-lisp* (interface) (:documentation "Quits Lisp")) (defmethod quit-lisp* (interface) (declare (ignore interface)) (print "I would love to quit for you, but I'm not sure how?")) (defun quit-lisp () (quit-lisp* *default-interface*)) ;;; memory management stuff (defgeneric total-bytes-allocated* (interface) (:documentation "") (:method (interface) (declare (ignore interface)) (values nil))) (defun total-bytes-allocated () "Returns the total number of bytes that this Lisp session has allocated." (total-bytes-allocated* *default-interface*)) (defgeneric gc-time* (interface) (:documentation "") (:method (interface) (declare (ignore interface)) (values nil))) (defun gc-time () "Returns the total amount of time that this Lisp session has spent in garbage collection." (gc-time* *default-interface*)) (defgeneric collect-garbage* (interface) (:documentation "")) (defun collect-garbage () "Tell lisp that now is a good time to collect any accumulated garbage." (collect-garbage* *default-interface*)) ;;; other (defmacro make-load-form* (class-name) #+(or openmcl (not mcl) ansi-make-load-form) `(defmethod make-load-form ((self ,class-name) &optional environment) (declare (ignore environment)) (make-load-form-saving-slots self)) #+(and digitool (not ansi-make-load-form)) `(defmethod make-load-form ((self ,class-name)) (make-load-form-saving-slots self))) metatilities-base-20120909-git/dev/l0-arrays.lisp000066400000000000000000000017771172714415100214500ustar00rootroot00000000000000(in-package #:metatilities) (defun linearize-array (array) (make-array (array-total-size array) :displaced-to array :element-type (array-element-type array))) (defun copy-array (array) (let ((storage (copy-seq (linearize-array array)))) (make-array (array-dimensions array) :displaced-to storage))) (defun maparray (array fn) (loop for x across (linearize-array array) do (funcall fn x)) array) (defun maparray! (array fn) (let ((temp (linearize-array array))) (loop for i from 0 to (1- (array-total-size temp)) do (setf (aref temp i) (funcall fn (aref temp i)))) array)) (defun array-row (array row) "Returns the row'th row of array. Array is assumed to be two dimensional and row is assumed to be in range. The returned array shared structure with the array parameter." (make-array (array-dimension array 1) :displaced-to (linearize-array array) :displaced-index-offset (* row (array-dimension array 1))))metatilities-base-20120909-git/dev/l0-clos.lisp000066400000000000000000000050261172714415100210760ustar00rootroot00000000000000(in-package #:metatilities) (defun finalize-class-if-necessary (thing) "Finalizes thing if necessary. Thing can be a class, object or symbol naming a class. Returns the class of thing." (let ((class (get-class thing))) (unless (class-finalized-p class) (finalize-inheritance class)) (values class))) ;;-- originally from moptilities (defgeneric get-class (thing &key error?) (:documentation "Returns the class of thing or nil if the class cannot be found. Thing can be a class, an object representing a class or a symbol naming a class. Get-class is like find-class only not as particular.") (:method ((thing symbol) &key error?) (find-class thing error?)) (:method ((thing standard-object) &key error?) (declare (ignore error?)) (class-of thing)) (:method ((thing t) &key error?) (declare (ignore error?)) (class-of thing)) (:method ((thing class) &key error?) (declare (ignore error?)) thing)) ;;; samep and nearly samep (declaim (special *samep-tolerance*)) (defvar *samep-tolerance* (coerce 1e-5 'double-float) "Used by samep to determine how close things need to be to be 'the same'.") (declaim (special *samep-test*)) (defvar *samep-test* #'equal "Used by samep to determine if two things are 'the same'. Defaults to #'equal") (defgeneric samep (thing-1 thing-2) (:documentation "Compares two things and returns true if they are the same in the sense of being interchangable. Implementations use the special variable *samep-tolerance* to specify how close two things need to be in order to be 'the same'. See nearly-samep too.") (:method (thing-1 thing-2) (funcall *samep-test* thing-1 thing-2)) (:method ((thing-1 integer) (thing-2 integer)) ;; we specialize on integers so that they don't get compared ;; with nearly-equal-p (= thing-1 thing-2)) (:method ((thing-1 number) (thing-2 number)) (= thing-1 thing-2)) (:method ((thing-1 real) (thing-2 real)) (nearly-equal-p thing-1 thing-2 *samep-tolerance*)) (:method ((thing-1 string) (thing-2 string)) (string-equal thing-1 thing-2))) (defgeneric nearly-samep (thing-1 thing-2 tolerance) (:documentation "Compares two things and returns true if they are the same in the sense of being interchangable. Tolerance indicates how close things need to be in order to be 'the same'.") (:method (thing-1 thing-2 (tolerance number)) (let ((*samep-tolerance* tolerance)) (samep thing-1 thing-2)))) metatilities-base-20120909-git/dev/l0-files.lisp000066400000000000000000000211611172714415100212360ustar00rootroot00000000000000(in-package #:metatilities) (define-condition invalid-stream-specifier-error (error) ((stream-specifier :initarg :stream-specifier :reader stream-specifier) (stream-specifier-direction :initarg :stream-specifier-direction :reader stream-specifier-direction) (stream-specifier-args :initform nil :initarg :stream-specifier-args :reader stream-specifier-args)) (:report (lambda (condition stream) (format stream "~&Unable to make an ~a stream with specifier ~s~@[ and arguments ~{~s~^, ~}~]" (stream-specifier-direction condition) (stream-specifier condition) (stream-specifier-args condition))))) #+(or) (error 'invalid-stream-specifier-error :stream-specifier nil :stream-specifier-direction :input :stream-specifier-args '(foo bar)) (defun invalid-stream-specifier-error (specifier direction &optional args) (error 'invalid-stream-specifier-error :stream-specifier specifier :stream-specifier-direction direction :stream-specifier-args args)) (defun pathname-name+type (pathname) "Returns a new pathname consisting of only the name and type from a non-wild pathname." (make-pathname :name (pathname-name pathname) :type (pathname-type pathname))) (defun physical-pathname-directory-separator () "Returns a string representing the separator used to delimit directories in a physical pathname. For example, Digitool's MCL would return \":\" whereas OpenMCL would return \"/\"." (let* ((directory-1 "foo") (directory-2 "bar") (pn (namestring (translate-logical-pathname (make-pathname :host nil :directory `(:absolute ,directory-1 ,directory-2) :name nil :type nil)))) (foo-pos (search directory-1 pn :test #'char-equal)) (bar-pos (search directory-2 pn :test #'char-equal))) (subseq pn (+ foo-pos (length directory-1)) bar-pos))) (defun relative-pathname (relative-to pathname &key name type) (let ((directory (pathname-directory pathname))) (when (eq (car directory) :absolute) (setf (car directory) :relative)) (merge-pathnames (make-pathname :name (or name (pathname-name pathname)) :type (or type (pathname-type pathname)) :directory directory ) relative-to))) (defun directory-pathname-p (pathname) (and (member (pathname-name pathname) (list nil :unspecified)) (member (pathname-type pathname) (list nil :unspecified)))) (defun ensure-directory-pathname (pathname) (if (directory-pathname-p pathname) pathname (make-pathname :directory `(,@(pathname-directory pathname) ,(namestring (pathname-name+type pathname)))))) (defun pathname-samep (p1 p2) "Returns true if the logical translations of `p1` and `p2` have the same (`string=`) namestrings." (and p1 p2 (typep p1 '(or string pathname)) (typep p2 '(or string pathname)) (string= (namestring (translate-logical-pathname p1)) (namestring (translate-logical-pathname p2))))) (defgeneric make-stream-from-specifier (specifier direction &rest args) (:documentation "Create and return a stream from specifier, direction and any other argsuments")) (defgeneric close-stream-specifier (steam) (:documentation "Close a stream and handle other bookkeeping as appropriate.")) (defmethod make-stream-from-specifier ((stream-specifier stream) (direction symbol) &rest args) (declare (ignore args)) (values stream-specifier nil)) (defmethod make-stream-from-specifier ((stream-specifier (eql t)) (direction symbol) &rest args) (declare (ignore args)) (values *standard-output* nil)) (defmethod make-stream-from-specifier ((stream-specifier (eql nil)) (direction symbol) &rest args) (declare (ignore args)) (values (make-string-output-stream) t)) (defmethod make-stream-from-specifier ((stream-specifier (eql nil)) (direction (eql :input)) &rest args) (invalid-stream-specifier-error stream-specifier direction args)) (defmethod make-stream-from-specifier ((stream-specifier (eql t)) (direction (eql :input)) &rest args) (invalid-stream-specifier-error stream-specifier direction args)) (defmethod make-stream-from-specifier ((stream-specifier (eql :none)) (direction symbol) &rest args) (declare (ignore args)) (values nil nil)) (defmethod make-stream-from-specifier ((stream-specifier pathname) (direction symbol) &rest args) (values (apply #'open stream-specifier :direction direction args) t)) (defmethod make-stream-from-specifier ((stream-specifier string) (direction symbol) &rest args) (declare (ignore args)) (values (make-string-input-stream stream-specifier) nil)) (defmethod make-stream-from-specifier ((stream-specifier string) (direction (eql :output)) &rest args) (apply #'make-stream-from-specifier (pathname stream-specifier) direction args)) (defmethod close-stream-specifier (s) (close s) (values nil)) (defmethod close-stream-specifier ((s string-stream)) (prog1 (values (get-output-stream-string s)) (close s))) ;;;; (defun map-forms (input fn &key (ignore-read-errors-p t)) (with-input (stream input) (flet ((next () (if ignore-read-errors-p (ignore-errors (read stream nil :eof)) (read stream nil :eof)))) (loop for f = (next) then (next) until (eq f :eof) do (handler-case (funcall fn f) (reader-error (c) (print c))))))) (defun map-lines (input fn &key include-empty-lines-p filter) (with-input (s input) (loop for line = (read-line s nil :eof) until (eq line :eof) when (and (or include-empty-lines-p (some (complement #'whitespacep) line)) (or (not filter) (funcall filter line))) do (funcall fn line)))) (defun collect-forms (input &key filter transform) (let ((result nil)) (map-forms input (lambda (form) (when (or (not filter) (funcall filter form)) (push (if transform (funcall transform form) form) result)))) (nreverse result))) (defun collect-lines (input &rest args &key count-empty-lines-p filter transform) (declare (ignore count-empty-lines-p filter)) (unless transform (setf transform #'identity)) (remf args :transform) (let ((results nil)) (apply #'map-lines input (lambda (line) (push (funcall transform line) results)) args) (nreverse results))) ;;;; ;; find . -name "_darcs" -type d -maxdepth 2 -exec ... (defun map-matching-files (root expression fn &key max-depth) (let ((test (compile-expression expression))) (labels ((make-wild (path) (make-pathname :name :wild :type :wild :directory (if (directory-pathname-p path) `(,@(pathname-directory path)) `(,@(pathname-directory path) ,(namestring (pathname-name+type path)))) :defaults path)) (do-it (root depth) (when (and max-depth (>= depth max-depth)) (return-from do-it nil)) (dolist (match (directory (make-wild root))) (when (funcall test match) (funcall fn match)) (when (probe-file (ensure-directory-pathname match)) (do-it match (1+ depth)))))) (do-it root 0)))) (defun compile-expression (expression) (if (functionp expression) expression ;; not done (constantly t))) #+(or) (map-matching-files "~/darcs" (lambda (pathname) (and (probe-file (ensure-directory-pathname pathname)) (string= "_darcs" (namestring (pathname-name+type pathname))))) #'print :max-depth 2) #+(or) (map-matching-files "~/darcs" (lambda (pathname) (and (not (probe-file (ensure-directory-pathname pathname))) (string= "common-lisp.net" (namestring (pathname-name+type pathname))))) #'print :max-depth 2) (defun collect-matching-files (root expression &key max-depth) (let ((results nil)) (map-matching-files root expression (lambda (file) (push file results)) :max-depth max-depth) (nreverse results))) (defun file-newer-than-file-p (file1 file2) "Compares the write dates of `file1' and `file' and returns t if `file' is newer than `file2' or if it cannot be determined. `file1' is usually the source file and `file2' the object file." ;; File write dates default to 0 and 1 so that if they can't be ;; determined, the file is recompiled, just to be safe. (< (or (file-write-date file2) 0) (or (file-write-date file1) 1))) (defun pathname-without-name+type (pathname) "Chop off any name and type information from a pathname." (make-pathname :name nil :type nil :defaults pathname) #+(or) (make-pathname :name :unspecific :type :unspecific :defaults pathname)) metatilities-base-20120909-git/dev/l0-macros.lisp000066400000000000000000000227711172714415100214300ustar00rootroot00000000000000(in-package #:metatilities) (defmacro nyi (&rest args) "Signals an error saying that this function is not yet implemented. The args are ignored, but by supplying args from the calling function, you can get them ignored by the compiler." `(error "This function is not yet implemented for ~A ~A on ~A." (lisp-implementation-type) (lisp-implementation-version) (machine-type) . ,args)) (defmacro deprecated (&body body) "Wrap a function definition with `deprecated' to indicate that it should no longer be used. If the first element of body is a string, it will be used as additional documentation in the deprecation message. Foo example, \(deprecated \"Use bar instead.\" \(defun foo-1 \(x\) \(format t \"~%FOO: ~A\" x\)\)\) Will generate the message: ; warning FOO-1 has been deprecated. Use bar instead. at compile time whereever foo-1 is used." (let ((documentation nil) (name nil)) (when (stringp (first body)) (setf documentation (first body) body (rest body))) (setf name (cadar body)) `(progn (define-compiler-macro ,name (&whole form &rest args) (declare (ignore args)) (fresh-line *error-output*) (write-string ,(format nil "~%; warning ~a has been deprecated.~@[ ~A~]" name documentation) *error-output*) (terpri *error-output*) (values form)) ,@body))) (defmacro once-only (variable-list &body body) "Generate code that evaluates certain expressions only once. This is used in macros, for computing expansions. VARIABLE-LIST is a list of symbols, whose values are subexpressions to be substituted into a larger expression. BODY is what uses those symbols' values and constructs the larger expression. ONCE-ONLY modifies BODY so that it constructs a different expression, which when run will evaluate the subsexpressions only once, save the values in temporary variables, and use those from then on. Example: \(DEFMACRO DOUBLE (ARG) `(+ ,ARG ,ARG)) expands into code that computes ARG twice. \(DEFMACRO DOUBLE (ARG) (ONCE-ONLY (ARG) `(+ ,ARG ,ARG))) will not." (dolist (variable variable-list) (if (not (symbolp variable)) (error "~S is not a variable" variable))) (let ((bind-vars (gensym)) (bind-vals (gensym)) (tem (gensym))) `(let ((,bind-vars nil) (,bind-vals nil)) (let ((result ((lambda ,variable-list . ,body) . ,(loop for variable in variable-list collect `(if (let ((variable ,variable)) (loop (when (atom variable) (return t)) (when (or (eq (car variable) 'quote) (eq (car variable) 'function)) (return t)) (if (eq (car variable) 'the) (setf variable (cadr (cdr variable))) (return nil)))) ,variable (let ((,tem (gensym))) (push ,tem ,bind-vars) (push ,variable ,bind-vals) ,tem)))))) (if (null ,bind-vars) result `((lambda ,(nreverse ,bind-vars) ,result) . ,(nreverse ,bind-vals))))))) (defmacro with-variables (symbols &body body) "Using gensyms is necessary to prevent variables produced by macro expansions from interfering with user variables, and naming them mnemonically helps make macro expansions and compiled code easier to read, but it's a pain to create them properly. This macro creates them for you, which makes writing nice macros easier. For example, if you are writing a macro to iterate over an array, you used to have to write: (defmacro do-2d-array ((elt array) &body body) (let ((row (gensym \"ROW\")) (col (gensym \"COL\"))) `(dotimes (,row (array-dimension 0)) (dotimes (,col ,(array-dimension 1)) (let ((,elt (aref ,array ,row ,col))) . ,body))))) Now you can just write the following, which eliminates the need to laboriously create the mnemonic gensyms. (defmacro do-2d-array ((elt array) &body body) (with-variables (row col) `(dotimes (,row ,(array-dimension 0)) (dotimes (,col ,(array-dimension 1)) (let ((,elt (aref ,array ,row ,col))) . ,body)))) " `(let ,(mapcar #'(lambda (sym) `(,sym (newsym ,(symbol-name sym)))) symbols) . ,body)) ;; a simple shorthand (defmacro eval-always (&body body) "Expands into an eval-when with all the fixings. It's nothing but a shorthand." `(eval-when (:compile-toplevel :load-toplevel :execute) ,@body)) (defmacro defclass-property (property &optional (default nil default-supplied?)) "Create getter and setter methods for 'property' on symbol's property lists." (once-only (property) (let ((real-name (form-keyword property))) `(progn (defgeneric ,property (class-name) (:documentation ,(format nil "Returns the value of `~(~A~)` for class-name" property))) (defgeneric (setf ,property) (value symbol) (:documentation ,(format nil "Sets the value of `~(~A~)` for class-name" property))) (defmethod ,property ((class-name symbol)) (get class-name ,real-name ,@(when default-supplied? (list default)))) (defmethod (setf ,property) (value (class-name symbol)) (setf (get class-name ,real-name) value)))))) #+(or allegro clisp) ;; everyone else already defines this... (defmacro without-interrupts (&body forms) "Executes `forms' as a critical section; no other threads can get in." ;; Because this macro will appear in user code (eg, the priority queue ;; code), whether there is multi-threading or not, we have to expand to ;; something, so we expand to progn. The :eksl-generic-load-utils feature ;; is used as an otherwise case, since it will be defined as long as this ;; code is being loaded via our loading procedure. (or #+allegro `(excl:without-interrupts . ,forms) ;; just in case... ;; default `(progn . ,forms))) ;;; This is a more portable name, IMO. It can't hurt. (defmacro with-atomic-execution (&body forms) `(without-interrupts ,@forms)) (defmacro handler-bind* (binds &rest body) "Special handler-bind which allow two special control contructs inside of the condition handlers. resume will resume execution past the handler-bind*. retry will execute the code from body, i.e. so you usually fix the problem and then call retry." (let ((catch-tag (gensym))) `(catch ',catch-tag (flet ((:resume () (throw ',catch-tag 0)) (:retry () ,@body)) (handler-bind ,binds (:retry)))))) (defmacro with-gensyms (syms &body body) `(let ,(mapcar #'(lambda (s) `(,s (gensym))) syms) ,@body)) (defvar *file-if-exists* :supersede "Default behavior to use when opening files if they already exist.") (defvar *file-print-right-margin* nil "Default print right margin to use in with-new-file") (defmacro with-new-file ((stream pathname &rest args &key (reset-io t) (print-right-margin *file-print-right-margin*) &allow-other-keys) &body body) (remf args :reset-io) (remf args :print-right-margin) `(progn (ensure-directories-exist ,pathname) (with-open-file (,stream ,pathname :if-exists *file-if-exists* :if-does-not-exist :create :direction :output ,@args) (let ((*print-right-margin* (or ,print-right-margin *print-right-margin*))) ,@(if reset-io (with-gensyms (the-package) `((let ((,the-package *package*)) (with-standard-io-syntax (let ((*package* ,the-package)) ,@body))))) body))))) (defmacro with-stream-from-specifier ((stream stream-specifier direction &rest args) &body body) (with-gensyms (s close? output) `(let (,s (,close? t) ,output) (unwind-protect (setf ,output (prog1 (let (,stream) (setf (values ,s ,close?) (make-stream-from-specifier ,stream-specifier ,direction ,@args) ,stream ,s) ,@body))) (when (and ,close? ,s) (let ((it (close-stream-specifier ,s))) (when it (setf ,output it))))) ,output))) (defmacro with-input ((var source &rest args) &body body) "Create an input stream from source and bind it to var within the body of the with-input form. The stream will be closed if necessary on exit." `(with-stream-from-specifier (,var ,source :input ,@args) ,@body)) (defmacro with-output ((var destination &rest args) &body body) "Create an output stream from source and bind it to var within the body of the with-output form. The stream will be closed if necessary on exit." `(with-stream-from-specifier (,var ,destination :output ,@args) ,@body)) (defmacro muffle-redefinition-warnings (&body body) "Evaluate the body so that redefinition warnings will not be signaled. (suppored in Allegro, Clozure CL, CLisp, and Lispworks)" #+allegro `(excl:without-redefinition-warnings ,@body) #+(or ccl mcl) `(let ((ccl::*warn-if-redefine* nil) ;;?? FIXME not sure if this should be here or not... (ccl::*record-source-file* nil)) ,@body) #+clisp `(let ((custom:*suppress-check-redefinition* t)) ,@body) #+lispworks `(let ((lw:*handle-warn-on-redefinition* :quiet)) ,@body) #+sbcl ;; from http://www.sbcl.info/manual/Controlling-Verbosity.html `(locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note)) ,@body) #-(or allegro ccl clisp mcl) `(progn ,@body)) metatilities-base-20120909-git/dev/l0-strings.lisp000066400000000000000000000046171172714415100216340ustar00rootroot00000000000000(in-package #:metatilities) ;;; whitespace-p (defparameter +whitespace-characters+ (list #\Space #\Newline #\Tab #\Page #\Null #\Linefeed #\Return) "A list of characters that should be treated as whitespace. See, for example, [whitespacep][].") (defun whitespacep (char) "Returns true if `char` is an element of [+whitespace-characters+][] and nil otherwise." (not (null (find char +whitespace-characters+ :test #'char=)))) (defun string-starts-with (string prefix &key test) "Returns true if `string` starts with `prefix`. Use the keyword argument `test` (which defaults to `char=`) to check each character." (setf test (or (and test (ensure-function test)) #'char=)) (let ((mismatch (mismatch prefix string :test test))) (or (not mismatch) (= mismatch (length prefix))))) (defun string-ends-with (string suffix &key test) "Returns true if `string` starts with `prefix`. Use the keyword argument `test` (which defaults to `eql`) to check each character." (setf test (or (and test (ensure-function test)) #'char=)) (let ((mm 0)) (loop for end1 from (1- (length string)) downto 0 for end2 from (1- (length suffix)) downto 0 while (funcall test (aref string end1) (aref suffix end2)) do (incf mm)) (= mm (length suffix)))) (defun string-trim-if (predicate string &key (start 0) (end (length string))) (let ((end (1- end))) (loop for ch across string while (funcall predicate ch) do (incf start)) (when (< start end) (loop for ch = (aref string end) while (funcall predicate ch) do (decf end))) (subseq string start (1+ end)))) (defun strip-whitespace (string &key (start 0) (end (length string))) (string-trim-if #'whitespacep string :start start :end end)) #| OR (defun string-starts-with (string prefix &key ignore-case-p) (declare (type string string prefix)) (let ((prelen (length prefix))) (when (<= prelen (length string)) (if ignore-case-p (string-equal string prefix :end1 prelen) (string= string prefix :end1 prelen))))) ;; not cribbed from Wilbur --cas (defun string-ends-with (string suffix &key ignore-case-p) (declare (type string string suffix)) (let ((suflen (length suffix)) (strlen (length string))) (when (< suflen (length string)) (if ignore-case-p (string-equal string suffix :start1 (- strlen suflen)) (string= string suffix :start1 (- strlen suflen)))))) |# metatilities-base-20120909-git/dev/l0-time.lisp000066400000000000000000000207221172714415100210740ustar00rootroot00000000000000(in-package #:metatilities) (defconstant +minutes-per-hour+ 60 "The number of minutes in one hour.") (defconstant +seconds-per-minute+ 60 "The number of seconds in one minute.") (defconstant +usual-days-per-year+ 365 "The number of days in an ordinary year.") (defconstant +seconds-per-hour+ (* +seconds-per-minute+ +minutes-per-hour+) "The number of seconds in one hour.") (defconstant +hours-per-day+ 24 "The number of hours in one day.") (defconstant +seconds-per-day+ (* +hours-per-day+ +seconds-per-hour+) "The number of seconds in one day.") (defparameter +days-per-month+ '(31 28 31 30 31 30 31 31 30 31 30 31)) (eval-always (defmacro generate-time-part-function (part-name position) (let ((function-name (form-symbol (symbol-name 'time) "-" part-name))) `(eval-always (export ',function-name) (defun ,function-name (&optional (universal-time (get-universal-time)) (time-zone nil)) ,(format nil "Returns the ~(~A~) part of the given time." part-name) (nth-value ,position (apply #'decode-universal-time universal-time time-zone)))))) (generate-time-part-function second 0) (generate-time-part-function minute 1) (generate-time-part-function hour 2) (generate-time-part-function date 3) (generate-time-part-function month 4) (generate-time-part-function year 5) (generate-time-part-function day-of-week 6) (generate-time-part-function daylight-savings-time-p 7)) (defun days-in-month (month &optional leap-year?) "Returns the number of days in the specified month. The month should be between 1 and 12." (+ (nth (1- month) +days-per-month+) (if (and (= month 2) leap-year?) 1 0))) (defun leap-year-p (year) "Returns t if the specified year is a leap year. I.e. if the year is divisible by four but not by 100 or if it is divisible by 400." (or (and (= (mod year 4) 0) ; logand is faster but less perspicuous (not (= (mod year 100) 0))) (= (mod year 400) 0))) (defun day-of-year (date &optional time-zone) "Returns the day of the year [1 to 366] of the specified date [which must be \(CL\) universal time format.]" (let ((leap-year? (leap-year-p (time-year date time-zone)))) (+ (loop for month from 1 to (1- (time-month date time-zone)) sum (days-in-month month leap-year?)) (time-date date time-zone)))) (defun format-date (format date &optional stream (time-zone nil tz-supplied?)) "Formats universal dates using the same format specifiers as NSDateFormatter. The format is: %% - A '%' character %a - Abbreviated weekday name %A - Full weekday name %b - Abbreviated month name %B - Full month name %c - Shorthand for \"%X %x\", the locale format for date and time %d - Day of the month as a decimal number [01-31] %e - Same as %d but does not print the leading 0 for days 1 through 9 [unlike strftime[], does not print a leading space] %F - Milliseconds as a decimal number [000-999] %H - Hour based on a 24-hour clock as a decimal number [00-23] %I - Hour based on a 12-hour clock as a decimal number [01-12] %j - Day of the year as a decimal number [001-366] %m - Month as a decimal number [01-12] %M - Minute as a decimal number [00-59] %p - AM/PM designation for the locale %S - Second as a decimal number [00-59] %w - Weekday as a decimal number [0-6], where Sunday is 0 %x - Date using the date representation for the locale, including the time zone [produces different results from strftime[]] %X - Time using the time representation for the locale [produces different results from strftime[]] %y - Year without century [00-99] %Y - Year with century [such as 1990] %Z - Time zone name [such as Pacific Daylight Time; produces different results from strftime[]] %z - Time zone offset in hours and minutes from GMT [HHMM] None of %c, %F, %x, %X, %Z are implemented." (let ((format-length (length format))) (multiple-value-bind (sec min hr day mon yr dow dst tz) (if tz-supplied? (decode-universal-time date time-zone) (decode-universal-time date)) (declare (ignore dst)) (format stream "~{~A~}" (loop for index = 0 then (1+ index) while (< index format-length) collect (let ((char (aref format index))) (cond ((char= #\% char) (setf char (aref format (incf index))) (cond ;; %% - A '%' character ((char= char #\%) #\%) ;; %a - Abbreviated weekday name ((char= char #\a) (day->string dow :short)) ;; %A - Full weekday name ((char= char #\A) (day->string dow :long)) ;; %b - Abbreviated month name ((char= char #\b) (month->string mon :short)) ;; %B - Full month name ((char= char #\B) (month->string mon :long)) ;; %c - Shorthand for "%X, %x", the locale format for date and time ((char= char #\c) (nyi)) ;; %d - Day of the month as a decimal number [01-31] ((char= char #\d) (format nil "~2,'0D" day)) ;; %e - Same as %d but does not print the leading 0 for days 1 through 9 ;; Unlike strftime, does not print a leading space ((char= char #\e) (format nil "~D" day)) ;; %F - Milliseconds as a decimal number [000-999] ((char= char #\F) (nyi)) ;; %H - Hour based on a 24-hour clock as a decimal number [00-23] ((char= char #\H) (format nil "~2,'0D" hr)) ;; %I - Hour based on a 12-hour clock as a decimal number [01-12] ((char= char #\I) (format nil "~2,'0D" (1+ (mod (1- hr) 12)))) ;; %j - Day of the year as a decimal number [001-366] ((char= char #\j) (format nil "~3,'0D" (day-of-year date time-zone))) ;; %m - Month as a decimal number [01-12] ((char= char #\m) (format nil "~2,'0D" mon)) ;; %M - Minute as a decimal number [00-59] ((char= char #\M) (format nil "~2,'0D" min)) ;; %p - AM/PM designation for the locale ((char= char #\p) (format nil "~:[PM~;AM~]" (< hr 12))) ;; %S - Second as a decimal number [00-59] ((char= char #\S) (format nil "~2,'0D" sec)) ;; %w - Weekday as a decimal number [0-6], where Sunday is 0 ((char= char #\w) (format nil "~D" dow)) ;; %x - Date using the date representation for the locale, ;; including the time zone [produces different results from strftime] ((char= char #\x) (nyi)) ;; %X - Time using the time representation for the locale ;; [produces different results from strftime] ((char= char #\X) (nyi)) ;; %y - Year without century [00-99] ((char= char #\y) (let ((year-string (format nil "~,2A" yr))) (subseq year-string (- (length year-string) 2)))) ;; %Y - Year with century [such as 1990] ((char= char #\Y) (format nil "~D" yr)) ;; %Z - Time zone name (such as Pacific Daylight Time; ;; produces different results from strftime. ((char= char #\Z) (nyi)) ;; %z - Time zone offset in hours and minutes from GMT [HHMM] ((char= char #\z) (multiple-value-bind (tzint tzfrac) (truncate tz) (format nil "~:[+~;-~]~2,'0D~2,'0D" (> tzint 0) (abs tzint) (* (abs tzfrac) 60)))) (t (error "Ouch - unknown formatter '%~c" char)))) (t char)))))))) (defconstant +longer-format-index+ 0) (defconstant +shorter-format-index+ 1) (defparameter +month-output-list+ '(("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December") ("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) (defparameter +dow-output-list '(("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") ("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))) (defun day->string (day-of-the-week &optional (format :long)) "Returns the name of `day-of-the-week`. The parameter should be a number between 0 and 6 where 0 represents Sunday and 6 repressents Saturday. The optional format argument can be either :long or :short. In the latter case, the return string will be of length three; in the former it will be the complete name of the appropriate day." (check-type day-of-the-week (mod 7)) (check-type format (member :long :short)) (nth day-of-the-week (case format (:long (nth +longer-format-index+ +dow-output-list)) (:short (nth +shorter-format-index+ +dow-output-list))))) (defun month->string (month &optional (format :long)) "Returns the name \(in English\) of the month. Format can be :long or :short." (check-type month (integer 1 12)) (check-type format (member :long :short)) (nth (1- month) (case format (:long (nth +longer-format-index+ +month-output-list+)) (:short (nth +shorter-format-index+ +month-output-list+))))) metatilities-base-20120909-git/dev/l0-utils.lisp000066400000000000000000000232771172714415100213060ustar00rootroot00000000000000(in-package #:metatilities) #-(or openmcl digitool ccl) ; already has this (defun fixnump (arg) "Same as (typep arg 'fixnum). A lot of Explorer code was written using this, and it's easier to implement it than to change them all." (typep arg 'fixnum)) ;;; ;;; MACROS ;;; (eval-when (:compile-toplevel :load-toplevel :execute) ;;; NOTE: can't use WITH-UNIQUE-NAMES here ;;; XXX This is a lousy name. Don't export. (defmacro with-standard-printing (&body forms &aux (package (gensym "PACKAGE"))) "Similar to WITH-STANDARD-IO-SYNTAX, but doesn't change packages." `(let ((,package *package*)) (with-standard-io-syntax (let ((*package* ,package)) ,@forms)))) ) ; eval-always ;;; ;;; PREDICATES ;;; #-(or digitool openmcl ccl) (defun neq (left right) (not (eq left right))) #-(or digitool openmcl ccl) (declaim (inline neq)) #-(or digitool openmcl ccl) (define-compiler-macro neq (left right) `(not (eq ,left ,right))) ;;; ;;; FORMING SYMBOLS ;;; (eval-when (:compile-toplevel :load-toplevel :execute) (defun form-symbol-in-package (package &rest names) "Finds or interns a symbol in package whose name is formed by concatenating the pretty printed representation of the names together." (with-standard-printing (intern (format nil "~{~a~}" names) package))) (defun form-symbol (&rest names) "Finds or interns a symbol in the current package whose name is formed by concatenating the pretty printed representation of the names together." (with-standard-printing (apply #'form-symbol-in-package *package* names))) (defun form-keyword (&rest names) "Finds or interns a symbol in the keyword package whose name is formed by concatenating the pretty printed representation of the names together." (with-standard-printing (apply #'form-symbol-in-package (load-time-value (find-package :keyword)) names))) (defun form-uninterned-symbol (&rest names) "Creates and returns an uninterned symbol whose name is formed by concatenating the pretty printed representation of the names together." (with-standard-printing (make-symbol (format nil "~{~a~}" names)))) ) ; eval-always (defun current-load-file () "Returns (if possible) the value of the file currently being loaded or from which code is currently being evaluated." #+allegro excl:*source-pathname* #+digitool (if *load-pathname* *load-pathname* ;; This makes it work in a fred buffer... ccl:*loading-file-source-file*) #-(or lucid allegro Genera Explorer digitool) *load-pathname*) (defmacro with-unique-names ((&rest vars) &body body) "Binds the symbols in VARS to gensyms. cf with-gensyms." (assert (every #'symbolp vars) () "Can't rebind an expression.") `(let ,(mapcar #'(lambda (x) `(,x (gensym* ',x))) vars) ,@body)) (defun ensure-list (x) "If `x` is a list then ensure-list returns it. Otherwise, this returns a singleton list containing `x`." (if (listp x) x (list x))) (defun ensure-function (thing) (typecase thing (function thing) (symbol (symbol-function thing)))) ;;; newsym ;;; ;;; Sometimes it's nice to have your gensyms mean something when ;;; you're reading the macroexpansion of some form. The problem ;;; is that if you give a prefix to GENSYM it remains the prefix ;;; until you change it. (eval-when (:compile-toplevel :load-toplevel :execute) ;; the eval-when is because the newsym function is used in expanding ;; `with-variables' and other macros below. (defvar *newsym-counter* 0 "Counter used by NEWSYM for generating print names.") (defun newsym (&optional (prefix "X")) "Create a new uninterned symbol whose print name begins with `prefix', which may be a string or a symbol. This differs from `gensym' in that the prefix is not sticky." (unless (stringp prefix) (setf prefix (string prefix))) (make-symbol (format nil "~a~4,'0d" prefix (incf *newsym-counter*))))) (defun export-exported-symbols (from-package to-package) "Make the exported symbols in from-package be also exported from to-package." (use-package from-package to-package) (do-external-symbols (sym (find-package from-package)) (export sym to-package))) (defgeneric length-at-least-p (thing length) (:documentation "Returns true if thing has no fewer than length elements in it.")) (defmethod length-at-least-p ((thing sequence) length) (>= (length thing) length)) (defmethod length-at-least-p ((thing cons) length) (let ((temp thing)) (loop repeat (1- length) while temp do (setf temp (rest temp))) (not (null temp)))) (defgeneric length-at-most-p (thing length) (:documentation "Returns true if thing has no more than length elements in it.")) (defmethod length-at-most-p ((thing sequence) length) (<= (length thing) length)) (defmethod length-at-most-p ((thing cons) length) ;;?? cf. length-at-least-p, this seems similar (let ((temp thing)) (loop repeat length while temp do (setf temp (rest temp))) (null temp))) (declaim (inline length-1-list-p)) (defun length-1-list-p (x) "Is x a list of length 1? Note that this is better than the naive \(= \(length x\) 1\) because we don't need to traverse the entire list..." (and (consp x) (null (cdr x)))) (defun nearly-zero-p (x &optional (threshold 0.0001)) "Returns true if `x` is within threshold of 0d0." (declare (optimize (speed 3) (space 3) (debug 0) (safety 0)) (dynamic-extent x threshold)) ;; ABS conses (if (< 0.0 x) (> threshold x) (> x threshold))) #+Test (timeit (:report t) (loop repeat 100000 do (nearly-zero-p 10.1) (nearly-zero-p 0.00001) (nearly-zero-p -0.00001))) (defun nearly-equal-p (x y threshold) "Returns true if x and y are within threshold of each other." (declare (optimize (speed 3) (space 3) (debug 0) (safety 0)) (dynamic-extent x y threshold) (type double-float x y threshold)) (let ((temp 0.0d0)) (declare (type double-float temp) (dynamic-extent temp)) (cond ((> x y) (setf temp (the double-float (- x y))) (< temp threshold)) (t (setf temp (the double-float (- y x))) (< temp threshold))))) #+Test (timeit (:report t) (loop repeat 100000 do (nearly-equal-p 10.1 10.2 0.0001) (nearly-equal-p 10.2342345 10.234234 0.0001))) ;;; dotted-pair-p (defun dotted-pair-p (putative-pair) "Returns true if and only if `putative-pair` is a dotted-list. I.e., if `putative-pair` is a cons cell with a non-nil cdr." (and (consp putative-pair) (cdr putative-pair) (not (consp (cdr putative-pair))))) #+No ;;?? move to test suite (deftestsuite test-dotted-pair-p () () (:tests ((ensure (dotted-pair-p '(a . b)))) ((ensure (not (dotted-pair-p '(a b))))) ((ensure (not (dotted-pair-p :a)))) ((ensure (not (dotted-pair-p '(a b . c))))) ((ensure (not (dotted-pair-p nil)))))) (defun apply-if-exists (function package &rest args) "If the function `function` can be found in `package`, then apply it to `args`. Returns nil if `package` does not exist or if `function` does not name a function in `package`. Otherwise, returns whatever `function` returns." (call-if-exists 'apply function package args)) (defun funcall-if-exists (function package &rest args) "If the function `function` can be found in `package`, then funcall it on `args`. Returns nil if `package` does not exist or if `function` does not name a function in `package`. Otherwise, returns whatever `function` returns." (call-if-exists 'funcall function package args)) (defun call-if-exists (call-with function package args) "If the function `function` can be found in `package`, then call it with `args`. Returns nil if `package` does not exist or if `function` does not name a function in `package`. Otherwise, returns whatever `function` returns." (let ((package (find-package package))) (when package (let ((symbol (find-symbol (etypecase function (string function) (symbol (symbol-name function))) package))) (when (and symbol (fboundp symbol)) (if (eq call-with 'funcall) (apply #'funcall symbol args) (apply #'apply symbol args))))))) (defun iterate-over-indexes (symbol-counts fn &optional (direction :left)) "Apply fn to lists of indexes generated from symbol counts. The counting is done so that the first symbol varies most quickly unless the optional direction parameter is set to :right." (let* ((dimension (length symbol-counts)) (current-thing (make-list dimension :initial-element 0)) (index-start (ecase direction (:right (1- dimension)) (:left 0))) (increment (ecase direction (:right -1) (:left 1))) (index-test (ecase direction (:right (lambda (i) (>= i 0))) (:left (lambda (i) (< i dimension))))) (index index-start)) (loop for i from 0 to (1- (reduce #'* (remove-if (complement #'plusp) symbol-counts))) do (funcall fn current-thing) (loop while (and (funcall index-test index) (>= (incf (elt current-thing index)) (elt symbol-counts index))) do (setf (elt current-thing index) 0) (setf index (+ index increment)) finally (setf index index-start))))) #+Experimental (defun ioi (lists fn &optional (direction :left)) (iterate-over-indexes (mapcar #'length lists) (lambda (indexes) (funcall fn (mapcar #'elt lists indexes))) direction)) #+Example (ioi '((:a :b) (:g) (:d :e :f)) #'print :right) metatilities-base-20120909-git/dev/metatilities.system000066400000000000000000000064111172714415100226760ustar00rootroot00000000000000 ;;; -*- Mode: Lisp; package: CL-USER; Syntax: Common-lisp; Base: 10 -*- (in-package common-lisp-user) (glu-define-logical-pathname-translations (metatilities) (source) (mcl-utils ("utilities" "mcl")) (openmcl-utils ("utilities" "openmcl")) (allegro-utils ("allegro" "mcl")) (lispworks-utils ("utilities" "lispworks"))) ;;; --------------------------------------------------------------------------- (define-glu-system :metatilities-base ((("package" "l0-utils" "l0-macros" "l0-arrays" "l0-clos" "l0-files" "set-equal" "generic-lisp" "generic-interface")) (("defclass-star" "define-class" ))) :base-dir "metatilities:source;" :bin-identifiers (:platform :vendor) :initially-do (progn #+(and DIGITOOL ANSI-MAKE-LOAD-FORM) (require 'ansi-make-load-form) (pushnew :metatilities *features*)) :include-in-menu nil :depends-on (:moptilities)) ;;; --------------------------------------------------------------------------- (define-glu-system :metabang.generic-lisp ((("generic-lisp" ;"generic-interface-support" ))) :base-dir (or #+OpenMCL "metatilities:openmcl;" #+DIGITOOL "metatilities:mcl;" (warn "Generic Lisp not defined for platform")) :bin-identifiers (:platform :vendor) :include-in-menu nil) ;;; --------------------------------------------------------------------------- (define-glu-system :metabang.dynamic-classes ((("dynamic-class"))) :base-dir "metatilities:source;" :bin-identifiers (:platform :vendor) :include-in-menu nil :depends-on (:metatilities-base )) ;;; --------------------------------------------------------------------------- (define-glu-system :metatilities ((("anaphoric" "graham" "dates-and-times" "files" "macros" "locks" "notifications" "sequences" "spy" "strings" #+Ignore "threads" "sequences" "utilities" "tcp" "searching" "views-and-windows")) #+Digitool (("tcp-mcl") :base-dir "metatilities:mcl-utils;") #+Lispworks (("tcp-lispworks") :base-dir "metatilities:source;utilities;lispworks;") #+Allegro (("tcp-allegro") :base-dir "metatilities:source;utilities;allegro;") #+openmcl (("tcp-openmcl") :base-dir "metatilities:source;utilities;openmcl;") ;;; contrib #+Digitool ((;; "appearance-mcl" "windoid-key-events" ;; "scrolling-windows" ;; "qt-midi" ;; "progress-indicator" ;; "processes" ;; "image-window" ;; "Image-Dialog-Item" "eval-apple-script" ;; "appleevent-toolkit" ) :base-dir "metatilities:source;contrib;mcl;") (("notes.text") :associates? t) ) :base-dir "metatilities:source;utilities;" :bin-identifiers (:platform :vendor) :include-in-menu nil :depends-on (:metatilities-base :cl-containers metabang.bind :metabang.generic-lisp)) ;;; --------------------------------------------------------------------------- (define-glu-system :metatilities-development ((("profile") :base-dir "metatilities:source;contrib;mcl;")) :bin-identifiers (:platform :vendor) :include-in-menu nil :depends-on (:metatilities :phex :metabang.interface)) metatilities-base-20120909-git/dev/names.lisp000066400000000000000000000131341172714415100207270ustar00rootroot00000000000000--- not loaded --- ;;; numbered-instances-mixin ;;; ;;; a sort of light-weight named-object-mixin (defclass* numbered-instances-mixin (copyable-mixin) ((object-number :unbound i)) (:copy-set-slots (object-number (get-next-instance-number (class-name (class-of self))))) (:export-slots object-number)) (defmethod object-number ((object numbered-instances-mixin)) (set-object-number-if-necessary object)) (defun set-object-number-if-necessary (object) "Sets a numbered-instances-mixin's object number if it hasn't already been set. Returns the object number." (if (slot-boundp object 'object-number) (slot-value object 'object-number) (setf (slot-value object 'object-number) (get-next-instance-number object)))) (defmethod initialize-instance :after ((object numbered-instances-mixin) &key) (set-object-number-if-necessary object)) (defmethod update-instance-for-different-class :after ((previous numbered-instances-mixin) (target numbered-instances-mixin) &key) (setf (slot-value target 'object-number) (get-next-instance-number (class-name (class-of target))))) (defgeneric get-next-instance-number (thing) (:documentation "") (:method ((class-name symbol)) (prog1 (get class-name 'object-number 0) (setf (get class-name 'object-number) (1+ (get class-name 'object-number 0))))) (:method ((object standard-object)) (get-next-instance-number (class-name-of object)))) (defmethod print-object ((object numbered-instances-mixin) stream) (let ((number (object-number object))) (print-unreadable-object (object stream :type t :identity t) (format stream "~S" number)))) (defun reset-symbol-numbering () (loop for name in (mapcar #'class-name (subclasses* (find-class 'numbered-instances-mixin))) do (reset-symbol-numbering-for-class name))) (defun reset-symbol-numbering-for-class (class-name) (setf (get class-name 'object-number) 0)) (defun numbered-symbols-count () (loop for name in (mapcar #'class-name (subclasses* (find-class 'numbered-instances-mixin))) sum (get name 'object-number 0))) (defun remove-numbered-symbols (&key (verbose? t)) (let ((grand-total 0)) (loop for name in (sort (mapcar #'class-name (subclasses* (find-class 'numbered-instances-mixin))) #'string-lessp) do (let ((i 0) (total (get name 'object-number 0))) (loop while (< i total) do (unintern (find-symbol (format nil "~A-~D" name i))) (incf i)) (when (and (plusp i) verbose?) (format t "~&~40A: ~A" name i)) (incf grand-total total))) (format t "~&~&~40A: ~A" "Grand Total" grand-total)) (reset-symbol-numbering)) (defun remove-numbered-symbols* (&key (verbose? t) (gap-size 10)) (loop for name in (sort (mapcar #'class-name (subclasses* (find-class 'numbered-instances-mixin))) #'string-lessp) do ;; Extra is a bit of hack (let ((extra gap-size) (i 0)) (loop while (or (find-symbol (format nil "~A-~D" name i)) (plusp extra)) do (unless (unintern (find-symbol (format nil "~A-~D" name i))) (decf extra)) (incf i)) (when (and (plusp (- i (- gap-size extra))) verbose?) (format t "~&~40A: ~A" name (- i (- gap-size extra))))))) ;;; object-with-name ;;; ;;; An object-with-name has a name slot which gets filled in automatically ;;; unless a name is passed in as an initarg. (defclass* object-with-name (numbered-instances-mixin) ((name :type symbol ir)) (:documentation "Allows each instance to have an name. One is generated for it if not provided. The name is always a symbol.") :copy-slots) (defmethod print-object ((object object-with-name) stream) (let ((name (and (slot-boundp object 'name) (slot-value object 'name)))) (print-unreadable-object (object stream :type t :identity t) (format stream "~:[~;~s~]" name name)))) (defmethod make-name ((object object-with-name) &optional new-name) "Make a name for yourself if necessary. This version insures name is a symbol." (let ((class-name (class-name (class-of object)))) (macrolet ((form-name-symbol (&rest strings) `(form-symbol-in-package *package* ,@strings))) (cond ((not new-name) (form-name-symbol (string-upcase class-name) "-" (princ-to-string (object-number object)))) ((symbolp new-name) new-name) ((stringp new-name) (form-name-symbol new-name)) (t (form-name-symbol (princ-to-string new-name))))))) (defmethod initialize-instance :around ((object object-with-name) &rest initargs &key name) (if name (apply #'call-next-method object :name (name->symbol name) initargs) (apply #'call-next-method object :name (make-name object name) initargs))) (defmethod name->symbol ((name symbol)) name) (defmethod name->symbol ((name string)) (form-symbol name)) (defmethod update-instance-for-different-class :after ((previous object-with-name) (target object-with-name) &key) ;;?? changing class always gives a new name... (setf (slot-value target 'name) (make-name target nil))) (defmethod (setf name) (new-name (object object-with-name)) (setf (slot-value object 'name) (make-name object new-name)))metatilities-base-20120909-git/dev/notes.text000066400000000000000000000000411172714415100207620ustar00rootroot00000000000000Need touch-file for all platformsmetatilities-base-20120909-git/dev/package.lisp000066400000000000000000000112131172714415100212130ustar00rootroot00000000000000(in-package #:common-lisp-user) (defpackage #:metabang.utilities (:nicknames #:metatilities) (:use #:common-lisp) ;; just a little bit of mop (:import-from #+(or allegro abcl) #:mop #+clisp #:clos #+ecl #:clos #+lispworks #:clos #+(or mcl openmcl) #:ccl #+cmu #:clos-mop #+sbcl #:sb-mop #:class-direct-subclasses #:class-precedence-list #:class-finalized-p #:finalize-inheritance) (:export #:class-direct-subclasses #:class-precedence-list #:class-finalized-p #:finalize-inheritance) #+asdf (:import-from #:asdf #:load-op #:compile-op #:test-op #:operate #:oos) #+asdf (:export #:load-op #:compile-op #:test-op #:operate #:oos) #+(or openmcl digitool) ; ??? I think this is the right thing... (:shadow #:line #:copy-file #:lock-owner #:lock-name #:selected? #:whitespacep) #+(or openmcl digitool ccl) (:import-from #:ccl #:fixnump) (:intern #:depth) (:export #:copy-file) (:export #:neq) #-(or allegro clisp) (:import-from #+lispworks #:mp #+(or openmcl digitool) #:ccl #+cmu #:system #+sbcl #:sb-sys #:without-interrupts) ;; these are stand-ins for those that will come from cl-containers (:export #:element #:element-type #:filter #:parent #:tag #:size #:root #:next-element #:total-size #:argmax #:argmin #:best-item #:filter ) (:export #:apply-if-exists #:funcall-if-exists #:defclass-property #:deprecated #:once-only #:with-variables #:eval-always #:with-atomic-execution #:handler-bind* #:file-newer-than-file-p #:pathname-without-name+type #:with-stream-from-specifier #:relative-pathname #:directory-pathname-p #:ensure-directory-pathname #:with-input #:with-output #:map-lines #:map-forms #:collect-lines #:collect-forms #:map-matching-files #:collect-matching-files #:defclass-brief #:defclass* #:defcondition #:copy-array #:linearize-array #:maparray! #:maparray #:array-row #:without-interrupts #:linearize-array #:copy-array #:maparray #:fixnump #:set-equal #:constant-expression-p #:muffle-redefinition-warnings #:nyi #:deprecated #:with-unique-names #:defun* #:defmethod* #:*add-check-types* #:*optimizations-to-ignore* #:delegates-to #:funcall-if #:*file-if-exists* #:with-new-file #:with-gensyms #:invalid-stream-specifier-error #:pathname-samep #:physical-pathname-directory-separator #:map-lines #:day->string #:month->string #:+minutes-per-hour+ #:+seconds-per-hour+ #:+seconds-per-minute+ #:+usual-days-per-year+ #:+hours-per-day+ #:+seconds-per-day+ #:format-date #:days-in-month #:day-of-year #:leap-year-p #:dotted-pair-p #:iterate-over-indexes #:form-symbol-in-package #:form-symbol #:form-keyword #:form-uninterned-symbol #:current-load-file #:with-unique-names #:ensure-list #:newsym #:export-exported-symbols #:length-at-most-p #:length-at-least-p #:length-1-list-p #:nearly-zero-p #:nearly-equal-p #:samep #:nearly-samep #:*samep-test* #:set-equal #:is-interface-available-p #:is-default-interface-available-p #:default-interface #:quit-lisp #:quit-lisp* #:inspect-thing* #:inspect-thing #:inspect-things #:total-bytes-allocated* #:total-bytes-allocated #:gc-time #:collect-garbage* #:collect-garbage #:make-load-form* #:*development-mode* #:*use-native-debugger* #:with-progress-bar #:progress #:make-progress-bar #:progress-bar-value #:close-progress-bar #:with-process-message #:handle-errors #:gui-error #:gui-warn #:interface-beep #:sound-note #:stop-notes #:select-instrument #:make-color* #:make-scaled-color #:make-gray #:y-or-n-question #:choose-file-question #:choose-new-file-question #:choose-directory-question #:choose-item-question #:query-user-for-string #:query-user-for-integer #:choose-item-from-pup #:choose-item-from-pup-no-singletons #:make-ui-point* #:process-parameters #:put-item-on-clipboard #:inspect-things #:prompt-for #:parse-brief-slot #:class-copyable-p #:+whitespace-characters+ #:whitespacep #:string-starts-with #:string-ends-with #:string-trim-if #:strip-whitespace )) metatilities-base-20120909-git/dev/sbcl-warnings.text000066400000000000000000013434441172714415100224250ustar00rootroot00000000000000; loading system definition from /usr/local/lib/sbcl/systems/sb-bsd-sockets.asd ; into # ; registering # as SB-BSD-SOCKETS ; registering # as SB-BSD-SOCKETS-TESTS ; loading system definition from /usr/local/lib/sbcl/systems/sb-posix.asd into ; # ; registering # as SB-POSIX ; registering # as SB-POSIX-TESTS ; loading system definition from ; USER-HOME:DARCS;ASDF-SYSTEMS;CL-GRAPH.ASD.NEWEST into # ; registering # as CL-GRAPH ; loading system definition from ; USER-HOME:DARCS;ASDF-SYSTEMS;CL-MATHSTATS.ASD.NEWEST into ; # ; registering # as CL-MATHSTATS ; loading system definition from ; USER-HOME:DARCS;ASDF-SYSTEMS;CL-CONTAINERS.ASD.NEWEST into ; # ; loading system definition from ; USER-HOME:DARCS;ASDF-SYSTEMS;ASDF-SYSTEM-CONNECTIONS.ASD.NEWEST into ; # ; registering # as ; ASDF-SYSTEM-CONNECTIONS ; registering # as CL-CONTAINERS ; loading system definition from ; USER-HOME:DARCS;ASDF-SYSTEMS;METATILITIES-BASE.ASD.NEWEST into ; # ; registering # as METATILITIES-BASE ; loading system definition from ; USER-HOME:DARCS;ASDF-SYSTEMS;MOPTILITIES.ASD.NEWEST into # ; registering # as MOPTILITIES ; loading system definition from ; USER-HOME:DARCS;ASDF-SYSTEMS;METABANG-BIND.ASD.NEWEST into ; # ; registering # as METABANG-BIND ; registering # as ; BIND-AND-METATILITIES ; loading system definition from ; USER-HOME:DARCS;ASDF-SYSTEMS;METATILITIES.ASD.NEWEST into ; # ; registering # as ; METABANG-GENERIC-LISP ; in: LAMBDA NIL ; (ASDF::RESOLVE-SYMLINKS *LOAD-TRUENAME*) ; ==> ; *LOAD-TRUENAME* ; ; note: deleting unreachable code ; (OR (ASDF::PATHNAME-SANS-NAME+TYPE (ASDF::RESOLVE-SYMLINKS *LOAD-TRUENAME*)) ; *DEFAULT-PATHNAME-DEFAULTS*) ; --> LET IF OR ; ==> ; *DEFAULT-PATHNAME-DEFAULTS* ; ; note: deleting unreachable code ; ; compilation unit finished ; printed 2 notes ; registering # as METATILITIES ; (ASDF::RESOLVE-SYMLINKS *LOAD-TRUENAME*) ; ==> ; *LOAD-TRUENAME* ; ; note: deleting unreachable code ; (OR (ASDF::PATHNAME-SANS-NAME+TYPE (ASDF::RESOLVE-SYMLINKS *LOAD-TRUENAME*)) ; *DEFAULT-PATHNAME-DEFAULTS*) ; --> LET IF OR ; ==> ; *DEFAULT-PATHNAME-DEFAULTS* ; ; note: deleting unreachable code ; ; compilation unit finished ; printed 2 notes STYLE-WARNING: implicitly creating new generic function SUBCLASSP STYLE-WARNING: implicitly creating new generic function MOPU-METHOD-SPECIALIZERS STYLE-WARNING: implicitly creating new generic function MOPU-METHOD-QUALIFIERS STYLE-WARNING: implicitly creating new generic function MOPU-GENERIC-FUNCTION-METHODS STYLE-WARNING: implicitly creating new generic function MOPU-SPECIALIZER-DIRECT-GENERIC-FUNCTIONS STYLE-WARNING: implicitly creating new generic function MOPU-GENERIC-FUNCTION-NAME STYLE-WARNING: implicitly creating new generic function MOPU-EQL-SPECIALIZER-P STYLE-WARNING: implicitly creating new generic function RESET STYLE-WARNING: implicitly creating new generic function MACINTOSH-PATH->UNIX STYLE-WARNING: implicitly creating new generic function IS-INTERFACE-AVAILABLE-P STYLE-WARNING: implicitly creating new generic function QUIT-LISP* STYLE-WARNING: implicitly creating new generic function INTERFACE-BEEP* STYLE-WARNING: implicitly creating new generic function INTERFACE-BEEP STYLE-WARNING: redefining QUIT-LISP* in DEFGENERIC STYLE-WARNING: implicitly creating new generic function GUI-ERROR* STYLE-WARNING: implicitly creating new generic function GUI-WARN* STYLE-WARNING: implicitly creating new generic function MAKE-COLOR* STYLE-WARNING: implicitly creating new generic function MAKE-GRAY* STYLE-WARNING: implicitly creating new generic function MAKE-GRAY STYLE-WARNING: implicitly creating new generic function MAKE-SCALED-COLOR* STYLE-WARNING: implicitly creating new generic function MAKE-SCALED-COLOR STYLE-WARNING: implicitly creating new generic function CHOOSE-FILE-QUESTION* STYLE-WARNING: implicitly creating new generic function CHOOSE-NEW-FILE-QUESTION* STYLE-WARNING: implicitly creating new generic function CHOOSE-DIRECTORY-QUESTION* STYLE-WARNING: implicitly creating new generic function CHOOSE-ITEM-QUESTION* STYLE-WARNING: implicitly creating new generic function CHOOSE-ITEM-FROM-PUP* STYLE-WARNING: implicitly creating new generic function MAKE-UI-POINT* STYLE-WARNING: implicitly creating new generic function PROCESS-PARAMETERS* STYLE-WARNING: implicitly creating new generic function PROCESS-PARAMETERS STYLE-WARNING: implicitly creating new generic function PUT-ITEM-ON-CLIPBOARD* STYLE-WARNING: implicitly creating new generic function PUT-ITEM-ON-CLIPBOARD STYLE-WARNING: implicitly creating new generic function INSPECT-THING* STYLE-WARNING: implicitly creating new generic function INSPECT-THING STYLE-WARNING: implicitly creating new generic function SOUND-NOTE* STYLE-WARNING: implicitly creating new generic function SOUND-NOTE STYLE-WARNING: implicitly creating new generic function STOP-NOTES* STYLE-WARNING: implicitly creating new generic function SELECT-INSTRUMENT* STYLE-WARNING: implicitly creating new generic function SELECT-INSTRUMENT STYLE-WARNING: implicitly creating new generic function PROMPT-FOR* STYLE-WARNING: implicitly creating new generic function PROMPT-FOR STYLE-WARNING: implicitly creating new generic function SHELL-COMMAND* STYLE-WARNING: implicitly creating new generic function SHELL-COMMAND STYLE-WARNING: implicitly creating new generic function DEFCLASS*-SUPERCLASSES STYLE-WARNING: implicitly creating new generic function (SETF DEFCLASS*-SUPERCLASSES) ; compiling file "/Users/gwking/darcs/cl-containers/dev/package.lisp" (written 18 NOV 2005 08:16:42 AM): ; compiling (IN-PACKAGE COMMON-LISP-USER) ; compiling (DEFPACKAGE "METABANG.CL-CONTAINERS" ...) ; /Users/gwking/darcs/cl-containers/dev/package.fasl written ; compilation finished in 0:00:00 ; compiling file "/Users/gwking/darcs/cl-containers/dev/container-api.lisp" (written 21 OCT 2005 03:54:51 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFGENERIC SAMPLE-ELEMENTS ...) ; compiling (DEFGENERIC SAMPLE-KEY ...) ; compiling (DEFGENERIC SAMPLE-UNIQUE-ELEMENTS ...) ; compiling (DEFGENERIC SAMPLE-ELEMENT ...) ; compiling (DEFGENERIC SAMPLE-ITEM ...) ; compiling (DEFGENERIC BEST-ITEM ...) ; compiling (DEFGENERIC ARGMAX ...) ; compiling (DEFGENERIC ARGMIN ...) ; compiling (DEFGENERIC MAKE-NODE-FOR-CONTAINER ...) ; compiling (DEFGENERIC NODE-EMPTY-P ...) ; compiling (DEFGENERIC SIZE ...) ; compiling (DEFGENERIC EMPTY! ...) ; compiling (DEFGENERIC SOME-ITEM-P ...) ; compiling (DEFGENERIC EVERY-ITEM-P ...) ; compiling (DEFGENERIC MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFGENERIC NTH-ELEMENT ...) ; compiling (DEFGENERIC NTH-ITEM ...) ; compiling (DEFGENERIC TOTAL-SIZE ...) ; compiling (DEFGENERIC ITEM-AT ...) ; compiling (DEFGENERIC ITEM-AT! ...) ; compiling (DEFGENERIC FIND-ITEM ...) ; compiling (DEFGENERIC FIND-NODE ...) ; compiling (DEFGENERIC FIND-ELEMENT ...) ; compiling (DEFGENERIC SEARCH-FOR-ITEM ...) ; compiling (DEFGENERIC SEARCH-FOR-MATCH ...) ; compiling (DEFGENERIC ITERATE-NODES ...) ; compiling (DEFGENERIC PRINT-CONTAINER ...) ; compiling (DEFGENERIC COLLECT-NODES ...) ; compiling (DEFGENERIC COLLECT-ELEMENTS ...) ; compiling (DEFGENERIC COLLECT-KEY-VALUE ...) ; compiling (DEFGENERIC COLLECT-KEYS ...) ; compiling (DEFGENERIC ITERATE-KEY-VALUE ...) ; compiling (DEFGENERIC ITERATE-VALUE-KEY ...) ; compiling (DEFGENERIC FIRST-ITEM ...) ; compiling (DEFGENERIC LAST-ITEM ...) ; compiling (DEFGENERIC DELETE-FIRST ...) ; compiling (DEFGENERIC DELETE-LAST ...) ; compiling (DEFGENERIC INSERT-ITEM ...) ; compiling (DEFGENERIC APPEND-ITEM ...) ; compiling (DEFGENERIC INSERT-NEW-ITEM ...) ; compiling (DEFGENERIC APPEND-NEW-ITEM ...) ; compiling (DEFGENERIC INSERT-SEQUENCE ...) ; compiling (DEFGENERIC INSERT-LIST ...) ; compiling (DEFGENERIC DELETE-LIST ...) ; compiling (DEFGENERIC REVERSE-FIND ...) ; compiling (DEFGENERIC ENQUEUE ...) ; compiling (DEFGENERIC DEQUEUE ...) ; compiling (DEFGENERIC POP-ITEM ...) ; compiling (DEFGENERIC CHILDREN ...) ; compiling (DEFGENERIC ENSURE-SORTED ...) ; compiling (DEFGENERIC FORCE-SORT ...) ; compiling (DEFGENERIC REMOVE-ITEMS-IF ...) ; compiling (DEFGENERIC CONTAINER->ARRAY ...) ; compiling (DEFGENERIC ELEMENT-POSITION ...) ; compiling (DEFGENERIC DELETE-ITEM ...) ; compiling (DEFGENERIC DELETE-ITEM-IF ...) ; /Users/gwking/darcs/cl-containers/dev/container-api.fasl written ; compilation finished in 0:00:02 ; compiling file "/Users/gwking/darcs/cl-containers/dev/containers.lisp" (written 21 OCT 2005 03:54:51 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFPARAMETER +EMPTY-INITIAL-ELEMENT+ ...) ; compiling (DEFCLASS* ABSTRACT-CONTAINER ...) ; compiling (DEFCLASS* CONCRETE-CONTAINER ...) ; compiling (DEFCLASS* CONTAINER-NODE-MIXIN ...) ; compiling (DEFCLASS* LIST-CONTAINER ...) ; compiling (DEFCLASS* PARENT-NODE-MIXIN ...) ; compiling (DEFCLASS* TWO-CHILD-NODE ...) ; compiling (DEFCLASS* KEYED-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* TYPED-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* BOUNDED-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* INDEXED-CONTAINER-MIXIN ...) ; compiling (DEFMETHOD (SETF ITEM-AT) ...) ; compiling (DEFCLASS* INITIAL-ELEMENT-MIXIN ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFUN RETURN-EMPTY-INITIAL-ELEMENT ...) ; compiling (DEFMETHOD MAKE-INITIAL-ELEMENT ...) ; compiling (DEFCLASS* BASIC-INITIAL-CONTENTS-MIXIN ...) ; compiling (DEFCLASS* INITIAL-CONTENTS-MIXIN ...) ; compiling (DEFGENERIC INSERT-INITIAL-CONTENTS-P ...) ; compiling (DEFCLASS* INITIAL-CONTENTS-KEY-VALUE-MIXIN ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFCLASS* TEST-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* CONTAINER-USES-NODES-MIXIN ...) ; compiling (DEFCLASS* FINDABLE-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* SEARCHABLE-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* ITERATABLE-CONTAINER-MIXIN ...) ; compiling (DEFGENERIC ITERATABLE-P ...) ; compiling (DEFMETHOD ITERATE-CONTAINER ...) ; compiling (DEFMETHOD COLLECT-ITEMS ...) ; compiling (DEFCLASS* I-KNOW-MY-NODE-MIXIN ...) ; compiling (DEFMETHOD MAKE-NODE-FOR-CONTAINER ...) ; compiling (DEFCLASS* NON-ASSOCIATIVE-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* UNORDERED-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* ORDERED-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* SORTED-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* CLASSIFIED-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* USES-CONTENTS-MIXIN ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFCLASS* CONTENTS-AS-SEQUENCE-MIXIN ...) ; compiling (DEFCLASS* CONTENTS-AS-ARRAY-MIXIN ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD TOTAL-SIZE ...) ; compiling (DEFMETHOD INSERT-INITIAL-CONTENTS-P ...) ; compiling (DEFMETHOD MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFCLASS* CONTENTS-AS-LIST-MIXIN ...) ; compiling (DEFMETHOD MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFCLASS* CONTENTS-AS-HASHTABLE-MIXIN ...) ; compiling (DEFCLASS* STABLE-ASSOCIATIVE-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFCLASS* ASSOCIATIVE-ARRAY ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; /Users/gwking/darcs/cl-containers/dev/containers.fasl written ; compilation finished in 0:00:11 STYLE-WARNING: implicitly creating new generic function (SETF ITEM-AT) STYLE-WARNING: implicitly creating new generic function MAKE-INITIAL-ELEMENT STYLE-WARNING: implicitly creating new generic function ITERATE-CONTAINER STYLE-WARNING: implicitly creating new generic function COLLECT-ITEMS STYLE-WARNING: implicitly creating new generic function MAKE-NODE-FOR-CONTAINER STYLE-WARNING: implicitly creating new generic function COLLECT-ELEMENTS STYLE-WARNING: implicitly creating new generic function ITERATE-NODES STYLE-WARNING: implicitly creating new generic function SIZE STYLE-WARNING: implicitly creating new generic function TOTAL-SIZE STYLE-WARNING: implicitly creating new generic function MAKE-CONTAINER-FOR-CONTENTS ; compiling file "/Users/gwking/darcs/cl-containers/dev/basic-operations.lisp" (written 28 OCT 2005 12:18:11 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCONDITION CONTAINER-ERROR ...) ; compiling (DEFCONDITION INDEX-OUT-OF-RANGE-ERROR ...) ; compiling (DEFGENERIC MAKE-CONTAINER ...) ; compiling (DEFUN FIND-MATCHING-CONTAINER-CLASS ...) ; compiling (DEFGENERIC EMPTY-P ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD FIND-ELEMENT ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-ELEMENT ...) ; compiling (DEFMETHOD PRINT-CONTAINER ...) ; compiling (DEPRECATED "Use collect-elements instead." ...) ; compiling (DEFMETHOD NTH-ELEMENT ...) ; compiling (DEFMETHOD NTH-ELEMENT ...) ; compiling (DEFMETHOD COLLECT-NODES ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS ...) ; compiling (DEFUN COLLECTOR-INTERNAL ...) ; compiling (DEFMETHOD SEARCH-FOR-ITEM ...) ; compiling (DEFMETHOD SEARCH-FOR-ELEMENT ...) ; compiling (DEFMETHOD SEARCH-FOR-NODE ...) ; compiling (DEFUN %SEARCH-IN-CONTAINER ...) ; compiling (DEFMETHOD SEARCH-FOR-MATCH ...) ; compiling (DEFUN %SEARCH-FOR-MATCH ...) ; compiling (DEFMETHOD SEARCH-FOR-MATCHING-NODE ...) ; compiling (DEFMETHOD SEARCH-FOR-NODE ...) ; compiling (DEFMETHOD SEARCH-FOR-NODE ...) ; compiling (DEFMETHOD SEARCH-FOR-NODE* ...) ; compiling (DEFMETHOD SEARCH-FOR-NODE* ...) ; compiling (DEFMETHOD BEST-ITEM ...) ; compiling (DEFMETHOD BEST-ITEM ...) ; compiling (DEFMETHOD BEST-NODE ...) ; compiling (DEFMETHOD BEST-ELEMENT ...) ; compiling (DEFUN %BEST-HELPER ...) ; compiling (DEFMETHOD ARGMAX ...) ; file: /Users/gwking/darcs/cl-containers/dev/basic-operations.lisp ; in: DEFMETHOD ARGMAX (T T) ; (DEFMETHOD METABANG.UTILITIES:ARGMAX ; ((METABANG.CL-CONTAINERS::ITEMS T) FUNCTION &REST ; METABANG.CL-CONTAINERS::ARGS &KEY METABANG.CL-CONTAINERS::KEY ; METABANG.CL-CONTAINERS:FILTER) ; (DECLARE ; (IGNORE METABANG.CL-CONTAINERS::TEST ; METABANG.CL-CONTAINERS::KEY ; METABANG.CL-CONTAINERS:FILTER)) ; (APPLY #'METABANG.UTILITIES:BEST-ITEM ; METABANG.CL-CONTAINERS::ITEMS ; FUNCTION ; :TEST ; #'> ; METABANG.CL-CONTAINERS::ARGS)) ; --> PROGN SB-PCL::LOAD-DEFMETHOD SB-PCL::LOAD-DEFMETHOD LIST* ; --> SB-INT:NAMED-LAMBDA FUNCTION MACROLET ; --> SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS ; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-MACROS MACROLET ; --> SB-PCL::BIND-LEXICAL-METHOD-FUNCTIONS SB-PCL::CALL-NEXT-METHOD-BIND LET ; --> FLET SB-PCL::WITH-REBOUND-ORIGINAL-ARGS LET SB-PCL::BIND-ARGS ; ==> ; (LET* ((SB-PCL::.ARGS-TAIL. SB-PCL::.REST-ARG.) ; (METABANG.CL-CONTAINERS::ARGS SB-PCL::.ARGS-TAIL.) ; (METABANG.CL-CONTAINERS::KEY ; (CAR (SB-PCL::GET-KEY-ARG-TAIL :KEY SB-PCL::.ARGS-TAIL.))) ; (METABANG.CL-CONTAINERS:FILTER ; (CAR (SB-PCL::GET-KEY-ARG-TAIL :FILTER SB-PCL::.ARGS-TAIL.))) ; (SB-PCL::.DUMMY0.)) ; (DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.)) ; (DECLARE ; (IGNORE METABANG.CL-CONTAINERS:FILTER ; METABANG.CL-CONTAINERS::KEY ; METABANG.CL-CONTAINERS::TEST)) ; (BLOCK METABANG.UTILITIES:ARGMAX ; (APPLY #'METABANG.UTILITIES:BEST-ITEM ; METABANG.CL-CONTAINERS::ITEMS ; FUNCTION ; :TEST ; #'> ; METABANG.CL-CONTAINERS::ARGS))) ; ; caught STYLE-WARNING: ; declaring unknown variable TEST to be ignored ; compiling (DEFMETHOD ARGMIN ...) ; file: /Users/gwking/darcs/cl-containers/dev/basic-operations.lisp ; in: DEFMETHOD ARGMIN (T T) ; (DEFMETHOD METABANG.UTILITIES:ARGMIN ; ((METABANG.CL-CONTAINERS::ITEMS T) FUNCTION &REST ; METABANG.CL-CONTAINERS::ARGS &KEY METABANG.CL-CONTAINERS::KEY ; METABANG.CL-CONTAINERS:FILTER) ; (DECLARE ; (IGNORE METABANG.CL-CONTAINERS::TEST ; METABANG.CL-CONTAINERS::KEY ; METABANG.CL-CONTAINERS:FILTER)) ; (APPLY #'METABANG.UTILITIES:BEST-ITEM ; METABANG.CL-CONTAINERS::ITEMS ; FUNCTION ; :TEST ; #'< ; METABANG.CL-CONTAINERS::ARGS)) ; --> PROGN SB-PCL::LOAD-DEFMETHOD SB-PCL::LOAD-DEFMETHOD LIST* ; --> SB-INT:NAMED-LAMBDA FUNCTION MACROLET ; --> SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS ; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-MACROS MACROLET ; --> SB-PCL::BIND-LEXICAL-METHOD-FUNCTIONS SB-PCL::CALL-NEXT-METHOD-BIND LET ; --> FLET SB-PCL::WITH-REBOUND-ORIGINAL-ARGS LET SB-PCL::BIND-ARGS ; ==> ; (LET* ((SB-PCL::.ARGS-TAIL. SB-PCL::.REST-ARG.) ; (METABANG.CL-CONTAINERS::ARGS SB-PCL::.ARGS-TAIL.) ; (METABANG.CL-CONTAINERS::KEY ; (CAR (SB-PCL::GET-KEY-ARG-TAIL :KEY SB-PCL::.ARGS-TAIL.))) ; (METABANG.CL-CONTAINERS:FILTER ; (CAR (SB-PCL::GET-KEY-ARG-TAIL :FILTER SB-PCL::.ARGS-TAIL.))) ; (SB-PCL::.DUMMY0.)) ; (DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.)) ; (DECLARE ; (IGNORE METABANG.CL-CONTAINERS:FILTER ; METABANG.CL-CONTAINERS::KEY ; METABANG.CL-CONTAINERS::TEST)) ; (BLOCK METABANG.UTILITIES:ARGMIN ; (APPLY #'METABANG.UTILITIES:BEST-ITEM ; METABANG.CL-CONTAINERS::ITEMS ; FUNCTION ; :TEST ; #'< ; METABANG.CL-CONTAINERS::ARGS))) ; ; caught STYLE-WARNING: ; declaring unknown variable TEST to be ignored ; compiling (DEFMETHOD REDUCE-CONTAINER ...) ; compiling (DEFMETHOD REDUCE-ELEMENTS ...) ; compiling (DEFMETHOD REDUCE-NODES ...) ; compiling (DEFUN REDUCE-INTERNAL ...) ; compiling (DEFMETHOD DELETE-ITEM-IF ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFCLASS* KEY-VALUE-ITERATABLE-CONTAINER-MIXIN ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-LIST ...) ; compiling (DEFMETHOD INSERT-LIST ...) ; compiling (DEFMETHOD INSERT-SEQUENCE ...) ; compiling (DEFMETHOD INSERT-SEQUENCE ...) ; compiling (DEFMETHOD INSERT-SEQUENCE ...) ; compiling (DEFMETHOD INSERT-NEW-ITEM ...) ; compiling (DEFGENERIC SUCCESSOR ...) ; compiling (DEFGENERIC PREDECESSOR ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEPRECATED "Use collect-elements instead." ...) ; compiling (DEFMETHOD SORT-ELEMENTS ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD SEARCH-FOR-ITEM ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD SOME-ITEM-P ...) ; compiling (DEFMETHOD EVERY-ITEM-P ...) ; compiling (DEFMETHOD SOME-ELEMENT-P ...) ; compiling (DEFMETHOD EVERY-ELEMENT-P ...) ; compiling (DEFUN %EVERY-THING-P ...) ; compiling (DEFUN %SOME-THING-P ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD APPEND-ITEM ...) ; compiling (DEFMETHOD APPEND-NEW-ITEM ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD SEARCH-FOR-ITEM ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD SEARCH-FOR-ITEM ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD ITERATE-KEYS ...) ; compiling (DEFMETHOD COLLECT-KEY-VALUE ...) ; compiling (DEFUN %COLLECT-KEY-VALUE ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD REVERSE-FIND ...) ; compiling (DEFMETHOD FIND-VALUE ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFMETHOD ADD-DEFAULT-ITEM ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD ITERATE-KEYS ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS-STABLY ...) ; compiling (DEFMETHOD ITERATE-KEY-VALUE ...) ; compiling (DEFMETHOD COLLECT-KEYS ...) ; compiling (DEFMETHOD ITERATE-KEY-VALUE-STABLY ...) ; compiling (DEFMETHOD COLLECT-KEY-VALUE-STABLY ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS-STABLY ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFUN TUPLE-INDEX ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD CONTAINER-DIMENSION ...) ; compiling (DEFMETHOD DIMENSIONS ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFUN COLLECT-USING ...) ; compiling (DEFUN COUNT-USING ...) ; compiling (DEFMETHOD CONTAINER-DIFFERENCE ...) ; compiling (DEFUN ASSOCIATIVE-CONTAINER-P ...) ; compiling (DEFMETHOD ADD-INITIAL-CONTENTS ...) ; compiling (DEFMETHOD ADD-INITIAL-CONTENTS ...) ; compiling (DEFUN ADD-INITIAL-CONTENTS-INTERNAL ...) ; compiling (DEFMETHOD ADD-INITIAL-CONTENTS ...) ; compiling (DEFMETHOD ELEMENT-POSITION ...) ; compiling (DEFMETHOD ELEMENT-POSITION ...) ; compiling (DEFMETHOD SAMEP ...) ; compiling (DEFMETHOD SAMEP ...) ; compiling (DEFMETHOD SAMEP ...) ; compiling (DEFMETHOD SAMEP ...) ; /Users/gwking/darcs/cl-containers/dev/basic-operations.fasl written ; compilation finished in 0:18:24 WARNING: COMPILE-FILE warned while performing # on #. STYLE-WARNING: implicitly creating new generic function ITERATE-ELEMENTS STYLE-WARNING: implicitly creating new generic function FIND-ELEMENT STYLE-WARNING: implicitly creating new generic function DELETE-ITEM STYLE-WARNING: implicitly creating new generic function DELETE-ELEMENT STYLE-WARNING: implicitly creating new generic function PRINT-CONTAINER STYLE-WARNING: implicitly creating new generic function CONTAINER->LIST STYLE-WARNING: implicitly creating new generic function NTH-ELEMENT STYLE-WARNING: implicitly creating new generic function COLLECT-NODES STYLE-WARNING: implicitly creating new generic function SEARCH-FOR-ITEM STYLE-WARNING: implicitly creating new generic function SEARCH-FOR-ELEMENT STYLE-WARNING: implicitly creating new generic function SEARCH-FOR-NODE STYLE-WARNING: implicitly creating new generic function SEARCH-FOR-MATCH STYLE-WARNING: implicitly creating new generic function SEARCH-FOR-MATCHING-NODE STYLE-WARNING: implicitly creating new generic function SEARCH-FOR-NODE* STYLE-WARNING: implicitly creating new generic function BEST-ITEM STYLE-WARNING: implicitly creating new generic function BEST-NODE STYLE-WARNING: implicitly creating new generic function BEST-ELEMENT STYLE-WARNING: implicitly creating new generic function ARGMAX STYLE-WARNING: implicitly creating new generic function ARGMIN STYLE-WARNING: implicitly creating new generic function REDUCE-CONTAINER STYLE-WARNING: implicitly creating new generic function REDUCE-ELEMENTS STYLE-WARNING: implicitly creating new generic function REDUCE-NODES STYLE-WARNING: implicitly creating new generic function DELETE-ITEM-IF STYLE-WARNING: implicitly creating new generic function FIRST-ITEM STYLE-WARNING: implicitly creating new generic function DELETE-LIST STYLE-WARNING: implicitly creating new generic function INSERT-LIST STYLE-WARNING: implicitly creating new generic function INSERT-SEQUENCE STYLE-WARNING: implicitly creating new generic function INSERT-NEW-ITEM STYLE-WARNING: implicitly creating new generic function SORT-ELEMENTS STYLE-WARNING: implicitly creating new generic function EMPTY! STYLE-WARNING: implicitly creating new generic function FIND-ITEM STYLE-WARNING: implicitly creating new generic function SOME-ITEM-P STYLE-WARNING: implicitly creating new generic function EVERY-ITEM-P STYLE-WARNING: implicitly creating new generic function SOME-ELEMENT-P STYLE-WARNING: implicitly creating new generic function EVERY-ELEMENT-P STYLE-WARNING: implicitly creating new generic function INSERT-ITEM STYLE-WARNING: implicitly creating new generic function APPEND-ITEM STYLE-WARNING: implicitly creating new generic function APPEND-NEW-ITEM STYLE-WARNING: implicitly creating new generic function ITERATE-KEYS STYLE-WARNING: implicitly creating new generic function COLLECT-KEY-VALUE STYLE-WARNING: implicitly creating new generic function REVERSE-FIND STYLE-WARNING: implicitly creating new generic function FIND-VALUE STYLE-WARNING: implicitly creating new generic function ITEM-AT! STYLE-WARNING: implicitly creating new generic function ADD-DEFAULT-ITEM STYLE-WARNING: implicitly creating new generic function ITEM-AT STYLE-WARNING: implicitly creating new generic function ITERATE-ELEMENTS-STABLY STYLE-WARNING: implicitly creating new generic function ITERATE-KEY-VALUE STYLE-WARNING: implicitly creating new generic function COLLECT-KEYS STYLE-WARNING: implicitly creating new generic function ITERATE-KEY-VALUE-STABLY STYLE-WARNING: implicitly creating new generic function COLLECT-KEY-VALUE-STABLY STYLE-WARNING: implicitly creating new generic function COLLECT-ELEMENTS-STABLY STYLE-WARNING: implicitly creating new generic function CONTAINER-DIMENSION STYLE-WARNING: implicitly creating new generic function DIMENSIONS STYLE-WARNING: implicitly creating new generic function CONTAINER-DIFFERENCE STYLE-WARNING: implicitly creating new generic function ADD-INITIAL-CONTENTS STYLE-WARNING: implicitly creating new generic function ELEMENT-POSITION ; compiling file "/Users/gwking/darcs/cl-containers/dev/queues.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* ABSTRACT-QUEUE ...) ; compiling (DEFINE-CONDITION EKSL-QUEUE-EMPTY ...) ; compiling (DEFMETHOD ENQUEUE ...) ; compiling (DEFMETHOD DEQUEUE ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD DELETE-FIRST ...) ; compiling (DEFMETHOD ERROR-IF-QUEUE-EMPTY ...) ; compiling (DEFCLASS* PRIORITY-QUEUE-ON-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD DELETE-FIRST ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD FIND-NODE ...) ; compiling (DEFMETHOD FIND-ELEMENT ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-NODE ...) ; compiling (DEFMETHOD DELETE-ELEMENT ...) ; compiling (DEFMETHOD DELETE-ITEM-IF ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFCLASS* BASIC-QUEUE ...) ; compiling (DEFUN FRONT-OF-QUEUE ...) ; compiling (DEFUN FRONT-OF-QUEUE! ...) ; compiling (DEFSETF FRONT-OF-QUEUE ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN TAIL-OF-QUEUE ...) ; compiling (DEFUN TAIL-OF-QUEUE! ...) ; compiling (DEFSETF TAIL-OF-QUEUE ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD DELETE-FIRST ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; /Users/gwking/darcs/cl-containers/dev/queues.fasl written ; compilation finished in 0:00:25 ; compiling file "/Users/gwking/darcs/cl-containers/dev/stacks.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* ABSTRACT-STACK ...) ; compiling (DEFMETHOD (SETF FIRST-ITEM) ...) ; compiling (DEFMETHOD PUSH-ITEM ...) ; compiling (DEFCLASS* STACK-CONTAINER ...) ; compiling (DEFMETHOD MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD POP-ITEM ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD SEARCH-FOR-ITEM ...) ; /Users/gwking/darcs/cl-containers/dev/stacks.fasl written ; compilation finished in 0:00:04 ; compiling file "/Users/gwking/darcs/cl-containers/dev/trees.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* ABSTRACT-TREE-CONTAINER ...) ; compiling (DEFCLASS* ROOTED-TREE-CONTAINER ...) ; compiling (DEFCLASS* MANY-CHILD-NODE ...) ; compiling (DEFMETHOD ITERATE-CHILDREN ...) ; compiling (DEFMETHOD HAS-CHILDREN-P ...) ; compiling (DEFMETHOD FIND-CHILD-NODE ...) ; compiling (DEFCLASS* MANY-ORDERED-CHILD-NODE ...) ; compiling (DEFMETHOD CHILDREN ...) ; compiling (DEFCLASS* MANY-UNORDERED-CHILD-NODE ...) ; compiling (DEFCLASS* BINARY-SEARCH-TREE ...) ; compiling (DEFCLASS* BST-NODE ...) ; compiling (DEFMETHOD MAKE-NODE-FOR-CONTAINER ...) ; compiling (DEFMETHOD NODE-EMPTY-P ...) ; compiling (DEFMETHOD NODE-EMPTY-P ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD FIND-NODE ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD LAST-ITEM ...) ; compiling (DEFMETHOD LAST-ITEM ...) ; compiling (DEFMETHOD SUCCESSOR ...) ; compiling (DEFMETHOD PREDECESSOR ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD DELETE-NODE ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM-IF ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD INORDER-WALK ...) ; compiling (DEFMETHOD PREORDER-WALK ...) ; compiling (DEFMETHOD POSTORDER-WALK ...) ; compiling (DEFMETHOD INORDER-WALK-NODES ...) ; compiling (DEFMETHOD PREORDER-WALK-NODES ...) ; compiling (DEFMETHOD POSTORDER-WALK-NODES ...) ; compiling (DEFMETHOD WALK-TREE ...) ; compiling (DEFMETHOD WALK-TREE ...) ; compiling (DEFMETHOD WALK-TREE-NODES ...) ; compiling (DEFMETHOD WALK-TREE-NODES ...) ; compiling (DEFCONSTANT +RBT-COLOR-BLACK+ ...) ; compiling (DEFCONSTANT +RBT-COLOR-RED+ ...) ; compiling (DEFVAR *RBT-EMPTY-NODE* ...) ; compiling (DEFCLASS* RED-BLACK-TREE ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFCLASS* RED-BLACK-NODE ...) ; compiling (DEFMETHOD NODE-EMPTY-P ...) ; compiling (DEFMETHOD MAKE-NODE-FOR-CONTAINER ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (SETF *RBT-EMPTY-NODE* ...) ; compiling (DEFMETHOD ROTATE-LEFT ...) ; compiling (DEFMETHOD ROTATE-RIGHT ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD RB-DELETE-FIXUP ...) ; compiling (DEFMETHOD WALK-TREE-NODES ...) ; compiling (DEFMETHOD WALK-TREE ...) ; compiling (DEFMETHOD HEIGHT ...) ; compiling (DEFMETHOD HEIGHT ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD UPDATE-ELEMENT ...) ; compiling (DEFGENERIC BST-NODE-IS-LEFT-CHILD ...) ; compiling (DEFGENERIC BST-NODE-IS-RIGHT-CHILD ...) ; compiling (DEFGENERIC BST-NODE-SET-RIGHT-CHILD ...) ; compiling (DEFGENERIC BST-NODE-SET-LEFT-CHILD ...) ; compiling (DEFGENERIC BST-NODE-REPLACE-CHILD ...) ; compiling (DEFCLASS* SPLAY-TREE ...) ; compiling (DEFGENERIC SPLAY-TREE-ROTATE ...) ; compiling (DEFGENERIC SPLAY-TREE-SPLAY ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD UPDATE-ELEMENT ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFGENERIC RIGHT-MOST-CHILD ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM-AT ...) ; /Users/gwking/darcs/cl-containers/dev/trees.fasl written ; compilation finished in 0:00:22 ; compiling file "/Users/gwking/darcs/cl-containers/dev/lists.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFMETHOD INSERT-LIST ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD DELETE-FIRST ...) ; compiling (DEFMETHOD NTH-ELEMENT ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD PRINT-CONTAINER ...) ; compiling (DEFMETHOD LAST-ITEM ...) ; compiling (DEFCLASS* SORTED-LIST-CONTAINER ...) ; compiling (DEFMETHOD SET-DIRTY-FLAG ...) ; compiling (DEFMETHOD CLEAN-UP ...) ; compiling (DEFMETHOD INSERT-LIST ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD DELETE-FIRST ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD PRINT-CONTAINER ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS ...) ; compiling (DEFMETHOD ENSURE-SORTED ...) ; compiling (DEFMETHOD FORCE-SORT ...) ; compiling (DEFCLASS* DLIST-CONTAINER-NODE ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFCLASS* DLIST-CONTAINER ...) ; compiling (DEFMETHOD MAKE-NODE-FOR-CONTAINER ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD INSERT-ITEM-AFTER ...) ; compiling (DEFMETHOD INSERT-ITEM-AFTER ...) ; compiling (DEFMETHOD INSERT-ITEM-AFTER ...) ; compiling (DEFMETHOD INSERT-ITEM-AFTER ...) ; compiling (DEFMETHOD INSERT-ITEM-BEFORE ...) ; compiling (DEFMETHOD INSERT-ITEM-BEFORE ...) ; compiling (DEFMETHOD INSERT-ITEM-BEFORE ...) ; compiling (DEFMETHOD DELETE-ITEM-AFTER ...) ; compiling (DEFMETHOD DELETE-ITEM-BEFORE ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD REPLACE-ITEM ...) ; compiling (DEFMETHOD REPLACE-ITEM ...) ; compiling (DEFMETHOD SUCCESSOR ...) ; compiling (DEFMETHOD PREDECESSOR ...) ; compiling (DEFCLASS* SORTED-DLIST-CONTAINER ...) ; compiling (DEFMETHOD ITERATE-NODES-ABOUT-NODE ...) ; compiling (DEFMETHOD ITERATE-NODES-ABOUT-NODE ...) ; compiling (DEFMETHOD ITERATE-NODES-ABOUT-NODE ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD INSERT-ITEM-ORDERED-ABOUT-NODE ...) ; compiling (DEFMETHOD INSERT-ITEM-ORDERED-ABOUT-NODE ...) ; compiling (DEFMETHOD INSERT-ITEM-ORDERED-ABOUT-NODE ...) ; compiling (DEFMETHOD INSERT-ITEM-ORDERED ...) ; compiling (DEFMETHOD INSERT-ITEM-ORDERED ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD FORCE-SORT ...) ; compiling (DEFMETHOD ENSURE-SORTED ...) ; compiling (DEFMETHOD LEFT-NODE-FOR-ITEM ...) ; compiling (DEFMETHOD RIGHT-NODE-FOR-ITEM ...) ; compiling (DEFMETHOD LEFT-AND-RIGHT-NODES-FOR-ITEM ...) ; compiling (DEFMETHOD ITERATE-LEFT-NODES ...) ; compiling (DEFMETHOD ITERATE-LEFT-NODES ...) ; compiling (DEFMETHOD ITERATE-LEFT-NODES ...) ; compiling (DEFMETHOD ITERATE-RIGHT-NODES ...) ; compiling (DEFMETHOD ITERATE-RIGHT-NODES ...) ; compiling (DEFMETHOD ITERATE-RIGHT-NODES ...) ; compiling (DEFMETHOD ITERATE-LEFT ...) ; compiling (DEFMETHOD ITERATE-LEFT ...) ; compiling (DEFMETHOD ITERATE-LEFT ...) ; compiling (DEFMETHOD ITERATE-RIGHT ...) ; compiling (DEFMETHOD ITERATE-RIGHT ...) ; compiling (DEFMETHOD ITERATE-RIGHT ...) ; compiling (DEFMETHOD SORT-UPDATE-LEFT ...) ; compiling (DEFMETHOD SORT-UPDATE-RIGHT ...) ; compiling (DEFMETHOD UPDATE-ITEM ...) ; compiling (DEFMETHOD UPDATE-ITEM ...) ; compiling (DEFMETHOD UPDATE-ITEM ...) ; /Users/gwking/darcs/cl-containers/dev/lists.fasl written ; compilation finished in 0:00:27 ; compiling file "/Users/gwking/darcs/cl-containers/dev/bags-and-sets.lisp" (written 21 OCT 2005 03:54:51 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFCLASS* ABSTRACT-BAG/SET-CONTAINER ...) ; compiling (DEFMETHOD MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFCLASS* BAG-CONTAINER ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD SEARCH-FOR-ITEM ...) ; compiling (DEFMETHOD SEARCH-FOR-MATCH ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFCLASS* SET-CONTAINER ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFCLASS* BAG/SET-CONTAINER ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD SEARCH-FOR-ITEM ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD FIND-VALUE ...) ; compiling (DEFCLASS* KEYED-BAG/SET-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; /Users/gwking/darcs/cl-containers/dev/bags-and-sets.fasl written ; compilation finished in 0:00:08 ; compiling file "/Users/gwking/darcs/cl-containers/dev/ring-buffers.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* RING-BUFFER ...) ; compiling (DEFUN MAKE-RING-BUFFER ...) ; compiling (DEFMETHOD MAKE-CONTAINER ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFMETHOD INCREMENT-END ...) ; compiling (DEFMETHOD NEXT-ITEM ...) ; compiling (DEFMETHOD CURRENT-ITEM ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD DELETE-FIRST ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; /Users/gwking/darcs/cl-containers/dev/ring-buffers.fasl written ; compilation finished in 0:00:05 ; compiling file "/Users/gwking/darcs/cl-containers/dev/miscellaneous.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFUN MERGE-ELEMENTS ...) ; compiling (DEFUN MERGE-NODES ...) ; compiling (DEFUN %MERGE-HELPER ...) ; compiling (DEFUN ELEMENT-COUNTS ...) ; compiling (DEFUN NODE-COUNTS ...) ; compiling (DEFUN %CONTAINER-COUNTS ...) ; compiling (DEFUN MAP-WINDOW-OVER-ELEMENTS ...) ; compiling (DEFUN MAP-WINDOW-OVER-NODES ...) ; compiling (DEFUN COLLECT-WINDOW-OVER-ELEMENTS ...) ; compiling (DEFUN COLLECT-WINDOW-OVER-NODES ...) ; compiling (DEFUN MAP-WINDOW-OVER-ELEMENTS-HELPER ...) ; compiling (DEFUN MAP-PAIRS ...) ; compiling (DEFUN COLLECT-PAIRS ...) ; /Users/gwking/darcs/cl-containers/dev/miscellaneous.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/cl-containers/dev/associative.lisp" (written 21 OCT 2005 03:54:51 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* ASSOCIATIVE-CONTAINER-MIXIN ...) ; compiling (DEFMETHOD SOME-KEY-VALUE-P ...) ; compiling (DEFMETHOD EVERY-KEY-VALUE-P ...) ; compiling (DEFMETHOD SAMEP ...) ; compiling (DEFMETHOD COLLECT-KEYS ...) ; compiling (DEFMETHOD SEARCH-FOR-KEY ...) ; compiling (DEFMETHOD REMOVE-ITEMS-IF ...) ; compiling (DEFMETHOD REMOVE-ITEMS-IF ...) ; compiling (DEFMETHOD COUNT-ITEMS ...) ; compiling (DEFMETHOD COUNT-ELEMENTS ...) ; compiling (DEFMETHOD COUNT-ELEMENTS ...) ; compiling (DEFMETHOD COUNT-ELEMENTS-IF ...) ; compiling (DEFMETHOD COUNT-ELEMENTS-IF ...) ; compiling (DEFCLASS* ARRAY-CONTAINER-ABSTRACT ...) ; compiling (DEFCLASS* ARRAY-CONTAINER ...) ; compiling (DEFMETHOD PRINT-CONTAINER-SUMMARY ...) ; compiling (DEFUN MAKE-ARRAY-CONTAINER ...) ; compiling (DEFMETHOD MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFMETHOD MAKE-CONTAINER ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFMETHOD DIMENSIONS ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; file: /Users/gwking/darcs/cl-containers/dev/associative.lisp ; in: DEFMETHOD ITERATE-NODES (ARRAY-CONTAINER T) ; (DEFMETHOD METABANG.CL-CONTAINERS:ITERATE-NODES ; ((METABANG.CL-CONTAINERS::CONTAINER ; METABANG.CL-CONTAINERS:ARRAY-CONTAINER) ; METABANG.CL-CONTAINERS::FN) ; (WITH-SLOTS ; (METABANG.CL-CONTAINERS:CONTENTS METABANG.CL-CONTAINERS:CONTENTS) ; METABANG.CL-CONTAINERS::CONTAINER ; (DOTIMES ; (METABANG.CL-CONTAINERS::I ; (ARRAY-TOTAL-SIZE METABANG.CL-CONTAINERS:CONTENTS)) ; (FUNCALL METABANG.CL-CONTAINERS::FN ; (ROW-MAJOR-AREF METABANG.CL-CONTAINERS:CONTENTS ; METABANG.CL-CONTAINERS::I))))) ; --> PROGN SB-PCL::LOAD-DEFMETHOD SB-PCL::LOAD-DEFMETHOD LIST* ; --> SB-INT:NAMED-LAMBDA FUNCTION MACROLET ; --> SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS ; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-MACROS MACROLET ; --> SB-PCL::BIND-LEXICAL-METHOD-FUNCTIONS SB-PCL::CALL-NEXT-METHOD-BIND LET ; --> FLET SB-PCL::WITH-REBOUND-ORIGINAL-ARGS LET SB-PCL::BIND-ARGS LET* ; --> SB-PCL::PV-BINDING SB-PCL::PV-BINDING1 SB-PCL::PV-ENV LET LET BLOCK LET ; ==> ; (SYMBOL-MACROLET ((METABANG.CL-CONTAINERS:CONTENTS ; (SLOT-VALUE #:G698 'METABANG.CL-CONTAINERS:CONTENTS)) ; (METABANG.CL-CONTAINERS:CONTENTS ; (SLOT-VALUE #:G698 'METABANG.CL-CONTAINERS:CONTENTS))) ; (BLOCK NIL ; (LET ((METABANG.CL-CONTAINERS::I 0) (#:G702 #)) ; (DECLARE (TYPE UNSIGNED-BYTE METABANG.CL-CONTAINERS::I)) ; (TAGBODY ; (GO #:G704) ; #:G703 ; (TAGBODY #) ; (PSETQ METABANG.CL-CONTAINERS::I #) ; #:G704 ; (UNLESS # #) ; (RETURN-FROM NIL #))))) ; ; caught STYLE-WARNING: ; duplicate definitions in ((CONTENTS (SLOT-VALUE #:G698 'CONTENTS)) ; (CONTENTS (SLOT-VALUE #:G698 'CONTENTS))) ; compiling (DEFMETHOD NTH-ELEMENT ...) ; compiling (DEFCLASS* SPARSE-ARRAY-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFMETHOD TOTAL-SIZE ...) ; compiling (DEFUN SPARSE-ARRAY-ROW-MAJOR-INDEX ...) ; compiling (DEFUN SPARSE-ARRAY-VALUE-TO-INDEX ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFCLASS* SIMPLE-ASSOCIATIVE-CONTAINER ...) ; compiling (DEFMETHOD ITEM-AT-1 ...) ; compiling (DEFMETHOD ITEM-AT-1! ...) ; compiling (DEFMETHOD (SETF ITEM-AT-1) ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFMETHOD DELETE-ITEM-AT ...) ; compiling (DEFMETHOD ITERATE-KEY-VALUE ...) ; compiling (DEFCLASS* ASSOCIATIVE-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD DELETE-ITEM-AT ...) ; compiling (DEFMETHOD ITERATE-KEY-VALUE ...) ; compiling (DEFUN DESCEND-HT ...) ; compiling (DEFUN FIND-OR-CREATE-HT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFMETHOD PRINT-CONTAINER ...) ; compiling (DEFMETHOD PRINT-CONTAINER ...) ; compiling (DEFCLASS* BIASSOCIATIVE-CONTAINER-MIXIN ...) ; compiling (DEFCLASS* ALIST-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-CONTAINER ...) ; compiling (DEFMETHOD MAKE-CONTAINER-FOR-CONTENTS ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT-1 ...) ; compiling (DEFMETHOD ITEM-AT-1! ...) ; compiling (DEFUN MAYBE-SET-INITIAL-ELEMENT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; file: /Users/gwking/darcs/cl-containers/dev/associative.lisp ; in: DEFMETHOD ITEM-AT! (ALIST-CONTAINER T) ; (WITH-SLOTS (METABANG.CL-CONTAINERS:CONTENTS METABANG.CL-CONTAINERS:CONTENTS) ; METABANG.CL-CONTAINERS::CONTAINER ; (PUSH METABANG.CL-CONTAINERS::ITEM ; METABANG.CL-CONTAINERS:CONTENTS)) ; --> LET ; ==> ; (SYMBOL-MACROLET ((METABANG.CL-CONTAINERS:CONTENTS ; (SLOT-VALUE #:G1839 'METABANG.CL-CONTAINERS:CONTENTS)) ; (METABANG.CL-CONTAINERS:CONTENTS ; (SLOT-VALUE #:G1839 'METABANG.CL-CONTAINERS:CONTENTS))) ; (PUSH METABANG.CL-CONTAINERS::ITEM METABANG.CL-CONTAINERS:CONTENTS)) ; ; caught STYLE-WARNING: ; duplicate definitions in ((CONTENTS (SLOT-VALUE #:G1839 'CONTENTS)) ; (CONTENTS (SLOT-VALUE #:G1839 'CONTENTS))) ; compiling (DEFMETHOD DELETE-ITEM-AT ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD ITERATE-KEYS ...) ; compiling (DEFMETHOD REVERSE-FIND ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD ITERATE-KEY-VALUE ...) ; compiling (DEFMETHOD SORT-KEYS ...) ; compiling (DEFMETHOD SORT-ELEMENTS ...) ; compiling (DEFMETHOD SORT-CONTAINER ...) ; compiling (DEFCLASS* KEYED-ASSOCIATIVE-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFUN IDENTITY-2 ...) ; compiling (DEFMETHOD ITEM-KEY ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD DELETE-ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFGENERIC KEY-EXISTS-P ...) ; compiling (DEFMETHOD KEY-EXISTS-P ...) ; compiling (DEFMETHOD ITERATE-KEY-VALUE ...) ; /Users/gwking/darcs/cl-containers/dev/associative.fasl written ; compilation finished in 0:00:26 WARNING: COMPILE-FILE warned while performing # on #. STYLE-WARNING: implicitly creating new generic function SOME-KEY-VALUE-P STYLE-WARNING: implicitly creating new generic function EVERY-KEY-VALUE-P STYLE-WARNING: implicitly creating new generic function SEARCH-FOR-KEY STYLE-WARNING: implicitly creating new generic function REMOVE-ITEMS-IF STYLE-WARNING: implicitly creating new generic function COUNT-ITEMS STYLE-WARNING: implicitly creating new generic function COUNT-ELEMENTS STYLE-WARNING: implicitly creating new generic function COUNT-ELEMENTS-IF STYLE-WARNING: implicitly creating new generic function PRINT-CONTAINER-SUMMARY STYLE-WARNING: implicitly creating new generic function ITEM-AT-1 STYLE-WARNING: implicitly creating new generic function ITEM-AT-1! STYLE-WARNING: implicitly creating new generic function (SETF ITEM-AT-1) STYLE-WARNING: implicitly creating new generic function DELETE-ITEM-AT STYLE-WARNING: implicitly creating new generic function INITIALIZE-CONTAINER STYLE-WARNING: implicitly creating new generic function SORT-KEYS STYLE-WARNING: implicitly creating new generic function SORT-CONTAINER STYLE-WARNING: implicitly creating new generic function ITEM-KEY ; compiling file "/Users/gwking/darcs/cl-containers/dev/compatibility.lisp" (written 28 OCT 2005 12:17:49 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFMETHOD ITERATABLE-P ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS ...) ; file: /Users/gwking/darcs/cl-containers/dev/compatibility.lisp ; in: DEFMETHOD COLLECT-ELEMENTS (LIST) ; (IF METABANG.CL-CONTAINERS::TRANSFORM ; (FUNCALL METABANG.CL-CONTAINERS::TRANSFORM METABANG.CL-CONTAINERS::ITEM) ; METABANG.CL-CONTAINERS::ITEM) ; ==> ; METABANG.CL-CONTAINERS::ITEM ; ; note: deleting unreachable code ; compiling (DEFMETHOD ELEMENT-POSITION ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD LAST-ITEM ...) ; compiling (DEFMETHOD NTH-ELEMENT ...) ; compiling (DEFMETHOD SEARCH-FOR-MATCH ...) ; compiling (DEPRECATED "Use collect-elements instead." ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; compiling (DEFMETHOD SEARCH-FOR-ITEM ...) ; compiling (DEFMETHOD SEARCH-FOR-ELEMENT ...) ; compiling (DEFMETHOD REDUCE-ELEMENTS ...) ; compiling (DEFMETHOD SOME-ITEM-P ...) ; compiling (DEFMETHOD SOME-ELEMENT-P ...) ; compiling (DEFMETHOD EVERY-ITEM-P ...) ; compiling (DEFMETHOD EVERY-ELEMENT-P ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD ITERATABLE-P ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD LAST-ITEM ...) ; compiling (DEFMETHOD SEARCH-FOR-MATCH ...) ; compiling (DEPRECATED "Use collect-elements instead." ...) ; compiling (DEFMETHOD SOME-ITEM-P ...) ; compiling (DEFMETHOD SOME-ELEMENT-P ...) ; compiling (DEFMETHOD EVERY-ITEM-P ...) ; compiling (DEFMETHOD EVERY-ELEMENT-P ...) ; compiling (DEFMETHOD SORT-ELEMENTS ...) ; compiling (DEFMETHOD NTH-ELEMENT ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD ITERATABLE-P ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD LAST-ITEM ...) ; compiling (DEFMETHOD SEARCH-FOR-MATCH ...) ; compiling (DEFMETHOD SOME-ELEMENT-P ...) ; compiling (DEFMETHOD EVERY-ELEMENT-P ...) ; compiling (DEFMETHOD NTH-ELEMENT ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFMETHOD ITERATABLE-P ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS ...) ; compiling (DEFMETHOD COLLECT-KEYS ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFMETHOD ITEM-AT-1 ...) ; compiling (DEFMETHOD ITEM-AT-1! ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITERATE-KEY-VALUE ...) ; compiling (DEFMETHOD COLLECT-KEY-VALUE ...) ; /Users/gwking/darcs/cl-containers/dev/compatibility.fasl written ; compilation finished in 0:00:24 ; compiling file "/Users/gwking/darcs/cl-containers/dev/vectors.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* VECTOR-CONTAINER-MIXIN ...) ; compiling (DEFMETHOD ITEM-AT ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFMETHOD NTH-ELEMENT ...) ; compiling (DEFMETHOD FIRST-ITEM ...) ; compiling (DEFMETHOD LAST-ITEM ...) ; compiling (DEFCLASS* BASIC-VECTOR-CONTAINER ...) ; compiling (DEFCLASS* BOUNDED-VECTOR-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFCLASS* VECTOR-CONTAINER ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD INSERT-ITEM-AT ...) ; compiling (DEFMETHOD DELETE-ITEM-AT ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD DELETE-FIRST ...) ; compiling (DEFMETHOD DELETE-LAST ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFCLASS* FLEXIBLE-VECTOR-CONTAINER ...) ; compiling (DEFMETHOD ITEM-AT! ...) ; compiling (DEFUN RESIZE-VECTOR ...) ; compiling (DEFMETHOD SAMEP ...) ; /Users/gwking/darcs/cl-containers/dev/vectors.fasl written ; compilation finished in 0:00:07 ; compiling file "/Users/gwking/darcs/cl-containers/dev/quad-tree.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* QUAD-TREE ...) ; compiling (DEFCLASS* FOUR-CHILD-NODE ...) ; compiling (DEFCLASS* QUAD-TREE-NODE ...) ; compiling (DEFMETHOD MAKE-NODE-FOR-CONTAINER ...) ; compiling (DEFMETHOD NODE-EMPTY-P ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFGENERIC NOTIFY-ELEMENT-OF-CHILD-STATUS ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD EMPTY-P ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFMETHOD FIND-ITEM ...) ; /Users/gwking/darcs/cl-containers/dev/quad-tree.fasl written ; compilation finished in 0:00:05 ; compiling file "/Users/gwking/darcs/cl-containers/dev/heaps.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* HEAP-CONTAINER ...) ; compiling (DEFCLASS* HEAP-NODE ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFMETHOD L-CHILD ...) ; compiling (DEFMETHOD R-CHILD ...) ; compiling (DEFMETHOD HEAP-NODE-PARENT ...) ; compiling (DEFMETHOD L-CHILD-INDEX ...) ; compiling (DEFMETHOD R-CHILD-INDEX ...) ; compiling (DEFMETHOD NODE-PARENT-INDEX ...) ; compiling (DEFMETHOD EXCHANGE-HEAP-NODES ...) ; compiling (DEFMETHOD MAKE-NODE-FOR-CONTAINER ...) ; compiling (DEFMETHOD HEAPIFY ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD BIGGEST-ITEM ...) ; compiling (DEFMETHOD DELETE-BIGGEST-ITEM ...) ; compiling (DEFMETHOD DELETE-ITEM ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFCLASS* K-BEST-HEAP-CONTAINER ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; /Users/gwking/darcs/cl-containers/dev/heaps.fasl written ; compilation finished in 0:00:12 ; compiling file "/Users/gwking/darcs/cl-containers/dev/container-mixins.lisp" (written 30 OCT 2005 05:57:55 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFCLASS* FILTERED-CONTAINER-MIXIN ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD COLLECT-ELEMENTS ...) ; compiling (DEFMETHOD ITERATE-KEY-VALUE ...) ; /Users/gwking/darcs/cl-containers/dev/container-mixins.fasl written ; compilation finished in 0:00:02 ; compiling file "/Users/gwking/darcs/cl-containers/dev/union-find-container.lisp" (written 21 OCT 2005 03:54:52 PM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFCLASS* UNION-FIND-NODE ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFMETHOD MAKE-SET ...) ; compiling (DEFMETHOD GRAFT-NODES ...) ; compiling (DEFMETHOD FIND-SET ...) ; compiling (DEFMETHOD LINK-NODES ...) ; compiling (DEFCLASS* UNION-FIND-CONTAINER ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD REPRESENTATIVE ...) ; compiling (DEFMETHOD REPRESENTATIVE-NODE ...) ; /Users/gwking/darcs/cl-containers/dev/union-find-container.fasl written ; compilation finished in 0:00:04 ; compiling file "/Users/gwking/darcs/cl-containers/dev/package-container.lisp" (written 17 NOV 2005 08:07:29 AM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFCLASS* PACKAGE-CONTAINER ...) ; compiling (DEFMETHOD (SETF PACKAGES) ...) ; compiling (DEFMETHOD (SETF PACKAGES) ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFUN BOUND-SYMBOLS-IN-PACKAGE ...) ; /Users/gwking/darcs/cl-containers/dev/package-container.fasl written ; compilation finished in 0:00:03 ; compiling file "/Users/gwking/darcs/cl-containers/dev/containers-readtable.lisp" (written 17 NOV 2005 08:04:58 AM): ; compiling (IN-PACKAGE CONTAINERS) ; compiling (DEFVAR *CONTAINER-READTABLE* ...) ; compiling (DEFVAR *CONTAINER-PRINT-REPRESENTATION* ...) ; compiling (DEFVAR *CONTAINER-PRINT-LENGTH* ...) ; compiling (DEFVAR *CONTAINER-PRINT-ASSOCIATION-STRING* ...) ; compiling (DEFVAR *CONTAINER-PRINT-ASSOCIATION-SEPARATOR* ...) ; compiling (SET-MACRO-CHARACTER #\[ ...) ; compiling (SET-MACRO-CHARACTER #\] ...) ; compiling (DEFMETHOD PRINT-CONTAINER-SUMMARY ...) ; compiling (DEFMETHOD PRINT-CONTAINER-CONTENTS ...) ; compiling (DEFMETHOD PRINT-CONTAINER-CONTENTS ...) ; compiling (DEFMETHOD PRINT-CONTAINER-CONTENTS ...) ; compiling (DEFCLASS* CONTAINER-PRINTING-MIXIN ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; /Users/gwking/darcs/cl-containers/dev/containers-readtable.fasl written ; compilation finished in 0:00:03 STYLE-WARNING: redefining BEST-ITEM in DEFGENERIC STYLE-WARNING: redefining ARGMAX in DEFGENERIC STYLE-WARNING: redefining ARGMIN in DEFGENERIC STYLE-WARNING: redefining MAKE-NODE-FOR-CONTAINER in DEFGENERIC STYLE-WARNING: redefining SIZE in DEFGENERIC STYLE-WARNING: redefining EMPTY! in DEFGENERIC STYLE-WARNING: redefining SOME-ITEM-P in DEFGENERIC STYLE-WARNING: redefining EVERY-ITEM-P in DEFGENERIC STYLE-WARNING: redefining MAKE-CONTAINER-FOR-CONTENTS in DEFGENERIC STYLE-WARNING: redefining NTH-ELEMENT in DEFGENERIC STYLE-WARNING: redefining TOTAL-SIZE in DEFGENERIC STYLE-WARNING: redefining ITEM-AT in DEFGENERIC STYLE-WARNING: redefining ITEM-AT! in DEFGENERIC STYLE-WARNING: redefining FIND-ITEM in DEFGENERIC STYLE-WARNING: redefining FIND-ELEMENT in DEFGENERIC STYLE-WARNING: redefining SEARCH-FOR-ITEM in DEFGENERIC STYLE-WARNING: redefining SEARCH-FOR-MATCH in DEFGENERIC STYLE-WARNING: redefining ITERATE-NODES in DEFGENERIC STYLE-WARNING: redefining PRINT-CONTAINER in DEFGENERIC STYLE-WARNING: redefining COLLECT-NODES in DEFGENERIC STYLE-WARNING: redefining COLLECT-ELEMENTS in DEFGENERIC STYLE-WARNING: redefining COLLECT-KEY-VALUE in DEFGENERIC STYLE-WARNING: redefining COLLECT-KEYS in DEFGENERIC STYLE-WARNING: redefining ITERATE-KEY-VALUE in DEFGENERIC STYLE-WARNING: redefining FIRST-ITEM in DEFGENERIC STYLE-WARNING: redefining LAST-ITEM in DEFGENERIC STYLE-WARNING: redefining INSERT-ITEM in DEFGENERIC STYLE-WARNING: redefining APPEND-ITEM in DEFGENERIC STYLE-WARNING: redefining INSERT-NEW-ITEM in DEFGENERIC STYLE-WARNING: redefining APPEND-NEW-ITEM in DEFGENERIC STYLE-WARNING: redefining INSERT-SEQUENCE in DEFGENERIC STYLE-WARNING: redefining INSERT-LIST in DEFGENERIC STYLE-WARNING: redefining DELETE-LIST in DEFGENERIC STYLE-WARNING: redefining REVERSE-FIND in DEFGENERIC STYLE-WARNING: redefining REMOVE-ITEMS-IF in DEFGENERIC STYLE-WARNING: redefining ELEMENT-POSITION in DEFGENERIC STYLE-WARNING: redefining DELETE-ITEM in DEFGENERIC STYLE-WARNING: redefining DELETE-ITEM-IF in DEFGENERIC STYLE-WARNING: implicitly creating new generic function ERROR-IF-QUEUE-EMPTY STYLE-WARNING: implicitly creating new generic function DELETE-NODE STYLE-WARNING: implicitly creating new generic function PUSH-ITEM STYLE-WARNING: implicitly creating new generic function ITERATE-CHILDREN STYLE-WARNING: implicitly creating new generic function HAS-CHILDREN-P STYLE-WARNING: implicitly creating new generic function FIND-CHILD-NODE STYLE-WARNING: implicitly creating new generic function INORDER-WALK STYLE-WARNING: implicitly creating new generic function PREORDER-WALK STYLE-WARNING: implicitly creating new generic function POSTORDER-WALK STYLE-WARNING: implicitly creating new generic function INORDER-WALK-NODES STYLE-WARNING: implicitly creating new generic function PREORDER-WALK-NODES STYLE-WARNING: implicitly creating new generic function POSTORDER-WALK-NODES STYLE-WARNING: implicitly creating new generic function WALK-TREE STYLE-WARNING: implicitly creating new generic function WALK-TREE-NODES STYLE-WARNING: implicitly creating new generic function ROTATE-LEFT STYLE-WARNING: implicitly creating new generic function ROTATE-RIGHT STYLE-WARNING: implicitly creating new generic function RB-DELETE-FIXUP STYLE-WARNING: implicitly creating new generic function HEIGHT STYLE-WARNING: implicitly creating new generic function UPDATE-ELEMENT STYLE-WARNING: implicitly creating new generic function SET-DIRTY-FLAG STYLE-WARNING: implicitly creating new generic function CLEAN-UP STYLE-WARNING: implicitly creating new generic function INSERT-ITEM-AFTER STYLE-WARNING: implicitly creating new generic function INSERT-ITEM-BEFORE STYLE-WARNING: implicitly creating new generic function DELETE-ITEM-AFTER STYLE-WARNING: implicitly creating new generic function DELETE-ITEM-BEFORE STYLE-WARNING: implicitly creating new generic function REPLACE-ITEM STYLE-WARNING: implicitly creating new generic function ITERATE-NODES-ABOUT-NODE STYLE-WARNING: implicitly creating new generic function INSERT-ITEM-ORDERED-ABOUT-NODE STYLE-WARNING: implicitly creating new generic function INSERT-ITEM-ORDERED STYLE-WARNING: implicitly creating new generic function LEFT-NODE-FOR-ITEM STYLE-WARNING: implicitly creating new generic function RIGHT-NODE-FOR-ITEM STYLE-WARNING: implicitly creating new generic function LEFT-AND-RIGHT-NODES-FOR-ITEM STYLE-WARNING: implicitly creating new generic function ITERATE-LEFT-NODES STYLE-WARNING: implicitly creating new generic function ITERATE-RIGHT-NODES STYLE-WARNING: implicitly creating new generic function ITERATE-LEFT STYLE-WARNING: implicitly creating new generic function ITERATE-RIGHT STYLE-WARNING: implicitly creating new generic function SORT-UPDATE-LEFT STYLE-WARNING: implicitly creating new generic function SORT-UPDATE-RIGHT STYLE-WARNING: implicitly creating new generic function UPDATE-ITEM STYLE-WARNING: implicitly creating new generic function INCREMENT-END STYLE-WARNING: implicitly creating new generic function CURRENT-ITEM STYLE-WARNING: redefining NTH-ELEMENT (ARRAY NUMBER) in DEFMETHOD STYLE-WARNING: implicitly creating new generic function INSERT-ITEM-AT STYLE-WARNING: implicitly creating new generic function L-CHILD STYLE-WARNING: implicitly creating new generic function R-CHILD STYLE-WARNING: implicitly creating new generic function HEAP-NODE-PARENT STYLE-WARNING: implicitly creating new generic function L-CHILD-INDEX STYLE-WARNING: implicitly creating new generic function R-CHILD-INDEX STYLE-WARNING: implicitly creating new generic function NODE-PARENT-INDEX STYLE-WARNING: implicitly creating new generic function EXCHANGE-HEAP-NODES STYLE-WARNING: implicitly creating new generic function HEAPIFY STYLE-WARNING: implicitly creating new generic function BIGGEST-ITEM STYLE-WARNING: implicitly creating new generic function DELETE-BIGGEST-ITEM STYLE-WARNING: implicitly creating new generic function MAKE-SET STYLE-WARNING: implicitly creating new generic function GRAFT-NODES STYLE-WARNING: implicitly creating new generic function FIND-SET STYLE-WARNING: implicitly creating new generic function LINK-NODES STYLE-WARNING: implicitly creating new generic function REPRESENTATIVE STYLE-WARNING: implicitly creating new generic function REPRESENTATIVE-NODE STYLE-WARNING: implicitly creating new generic function (SETF PACKAGES) STYLE-WARNING: implicitly creating new generic function PRINT-CONTAINER-CONTENTS ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/package.lisp" (written 17 NOV 2005 12:09:42 PM): ; compiling (IN-PACKAGE COMMON-LISP-USER) ; compiling (DEFPACKAGE "CL-MATHSTATS" ...) ; /Users/gwking/darcs/cl-mathstats/dev/package.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/math-utilities.lisp" (written 21 OCT 2005 03:54:55 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (EXPORT (QUOTE #)) ; compiling (DECLAIM (INLINE ENSURE-FLOAT)) ; compiling (DEFUN ENSURE-FLOAT ...) ; compiling (DEFUN LINEAR-SCALE ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN TRUNCATE-TO-FACTOR ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN ROUND-TO-FACTOR ...) ; compiling (DEFCONSTANT FPI ...) ; compiling (DEFCONSTANT 2FPI ...) ; compiling (DEFCONSTANT +E+ ...) ; compiling (DEFUN DEGREES->RADIANS ...) ; compiling (DEFUN RADIANS->DEGREES ...) ; compiling (DEFUN ON-INTERVAL ...) ; compiling (DEFUN COMBINATION-COUNT ...) ; compiling (DEFUN PERMUTATION-COUNT ...) ; compiling (DECLAIM (INLINE SQUARE)) ; compiling (DEFUN SQUARE ...) ; compiling (DEFUN F-MEASURE ...) ; /Users/gwking/darcs/cl-mathstats/dev/math-utilities.fasl written ; compilation finished in 0:00:00 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/definitions.lisp" (written 21 OCT 2005 03:54:55 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFCONSTANT +0DEGREES+ ...) ; compiling (DEFCONSTANT +5DEGREES+ ...) ; compiling (DEFCONSTANT +10DEGREES+ ...) ; compiling (DEFCONSTANT +15DEGREES+ ...) ; compiling (DEFCONSTANT +30DEGREES+ ...) ; compiling (DEFCONSTANT +45DEGREES+ ...) ; compiling (DEFCONSTANT +60DEGREES+ ...) ; compiling (DEFCONSTANT +90DEGREES+ ...) ; compiling (DEFCONSTANT +120DEGREES+ ...) ; compiling (DEFCONSTANT +135DEGREES+ ...) ; compiling (DEFCONSTANT +150DEGREES+ ...) ; compiling (DEFCONSTANT +180DEGREES+ ...) ; compiling (DEFCONSTANT +210DEGREES+ ...) ; compiling (DEFCONSTANT +225DEGREES+ ...) ; compiling (DEFCONSTANT +240DEGREES+ ...) ; compiling (DEFCONSTANT +270DEGREES+ ...) ; compiling (DEFCONSTANT +300DEGREES+ ...) ; compiling (DEFCONSTANT +315DEGREES+ ...) ; compiling (DEFCONSTANT +330DEGREES+ ...) ; compiling (DEFCONSTANT +360DEGREES+ ...) ; /Users/gwking/darcs/cl-mathstats/dev/definitions.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/binary-math.lisp" (written 21 OCT 2005 03:54:55 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (EXPORT (QUOTE #)) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN TIMES2 ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN DIV2 ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN EXP2 ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN LOG2 ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN TRUNC2 ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN MOD2 ...) ; /Users/gwking/darcs/cl-mathstats/dev/binary-math.fasl written ; compilation finished in 0:00:00 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/matrices.lisp" (written 21 OCT 2005 03:54:55 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (DEFMACRO CHECK-TYPE-OF-ARG ...) ; compiling (DEFUN SCALAR-MATRIX-MULTIPLY ...) ; compiling (DEFUN 1-OR-2D-ARRAYP ...) ; compiling (DEFUN LIST-2D-ARRAY ...) ; compiling (DEFUN FILL-2D-ARRAY ...) ; compiling (DEFUN MULTIPLY-MATRICES ...) ; compiling (DEFUN INVERT-MATRIX ...) ; compiling (DEFUN MATRIX-NORM ...) ; compiling (DEFUN INVERT-MATRIX-ITERATE ...) ; compiling (DEFUN TRANSPOSE-MATRIX ...) ; compiling (DEFUN NORMALIZE-MATRIX ...) ; compiling (DEFUN SUM-OF-ARRAY-ELEMENTS ...) ; /Users/gwking/darcs/cl-mathstats/dev/matrices.fasl written ; compilation finished in 0:00:04 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/matrix-fns.lisp" (written 21 OCT 2005 03:54:55 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (DEFUN MATRIX-TRACE ...) ; compiling (DEFUN MATRIX-MULTIPLY ...) ; compiling (DEFUN MATRIX-TIMES-SCALAR! ...) ; compiling (DEFUN MATRIX-TIMES-SCALAR ...) ; compiling (DEFUN MATRIX-TIMES-MATRIX ...) ; compiling (DEFUN MATRIX-ADDITION ...) ; compiling (DEFUN MATRIX-PLUS-SCALAR ...) ; compiling (DEFUN MATRIX-PLUS-MATRIX ...) ; compiling (DEFUN REDUCE-MATRIX ...) ; /Users/gwking/darcs/cl-mathstats/dev/matrix-fns.fasl written ; compilation finished in 0:00:02 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/density-fns.lisp" (written 21 OCT 2005 03:54:55 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFPARAMETER *GAUSSIAN-CDF-SIGNALS-ZERO-STANDARD-DEVIATION-ERROR* ...) ; compiling (DEFCONSTANT +LOG-PI+ ...) ; compiling (DEFCONSTANT +SQRT-PI+ ...) ; compiling (DEFUN GAMMA-LN ...) ; file: /Users/gwking/darcs/cl-mathstats/dev/density-fns.lisp ; in: DEFUN GAMMA-LN ; (LOG (SIN (* PI CL-MATHSTATS::Z))) ; ; note: unable to ; optimize ; due to type uncertainty: ; The result is a (VALUES (OR (DOUBLE-FLOAT * 0.0d0) (COMPLEX DOUBLE-FLOAT)) ; &OPTIONAL), not a (VALUES FLOAT &REST T). ; (+ (CL-MATHSTATS::GAMMA-LN (+ 1.0d0 CL-MATHSTATS::Z)) ; (LOG (SIN (* PI CL-MATHSTATS::Z)))) ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a RATIONAL. ; The second argument is a (OR (DOUBLE-FLOAT * 0.0d0) ; (COMPLEX DOUBLE-FLOAT)), not a FLOAT. ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a SINGLE-FLOAT. ; The second argument is a (OR (DOUBLE-FLOAT * 0.0d0) ; (COMPLEX DOUBLE-FLOAT)), not a DOUBLE-FLOAT. ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT). ; The second argument is a (OR (DOUBLE-FLOAT * 0.0d0) ; (COMPLEX DOUBLE-FLOAT)), not a REAL. ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT). ; The second argument is a (OR (DOUBLE-FLOAT * 0.0d0) ; (COMPLEX DOUBLE-FLOAT)), not a (COMPLEX ; DOUBLE-FLOAT). ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT). ; The second argument is a (OR (DOUBLE-FLOAT * 0.0d0) ; (COMPLEX DOUBLE-FLOAT)), not a REAL. ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a REAL. ; The second argument is a (OR (DOUBLE-FLOAT * 0.0d0) ; (COMPLEX DOUBLE-FLOAT)), not a (COMPLEX ; DOUBLE-FLOAT). ; (- (+ (LOG CL-MATHSTATS::Z) CL-MATHSTATS::+LOG-PI+) ; (+ (CL-MATHSTATS::GAMMA-LN (+ 1.0d0 CL-MATHSTATS::Z)) ; (LOG (SIN (* PI CL-MATHSTATS::Z))))) ; ; note: unable to ; optimize ; due to type uncertainty: ; The second argument is a NUMBER, not a RATIONAL. ; ; note: unable to ; optimize ; due to type uncertainty: ; The second argument is a NUMBER, not a SINGLE-FLOAT. ; ; note: unable to ; optimize ; due to type uncertainty: ; The second argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT). ; ; note: unable to ; optimize ; due to type uncertainty: ; The second argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT). ; (LOG (* 2.50662827465d0 CL-MATHSTATS::SER)) ; ; note: unable to ; optimize ; due to type uncertainty: ; The result is a (VALUES (OR DOUBLE-FLOAT (COMPLEX DOUBLE-FLOAT)) ; &OPTIONAL), not a (VALUES FLOAT &REST T). ; (- (LOG (* 2.50662827465d0 CL-MATHSTATS::SER)) CL-MATHSTATS::TMP) ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a (OR DOUBLE-FLOAT ; (COMPLEX DOUBLE-FLOAT)), not a (COMPLEX ; DOUBLE-FLOAT). ; (+ (CL-MATHSTATS::GAMMA-LN (+ 1.0d0 CL-MATHSTATS::Z)) ; (LOG (SIN (* PI CL-MATHSTATS::Z)))) ; ; note: forced to do GENERIC-+ (cost 10) ; unable to do inline float arithmetic (cost 2) because: ; The first argument is a NUMBER, not a DOUBLE-FLOAT. ; The second argument is a (OR (DOUBLE-FLOAT * 0.0d0) ; (COMPLEX DOUBLE-FLOAT)), not a DOUBLE-FLOAT. ; The result is a (VALUES NUMBER ; &OPTIONAL), not a (VALUES DOUBLE-FLOAT &REST T). ; (- (+ (LOG CL-MATHSTATS::Z) CL-MATHSTATS::+LOG-PI+) ; (+ (CL-MATHSTATS::GAMMA-LN (+ 1.0d0 CL-MATHSTATS::Z)) ; (LOG (SIN (* PI CL-MATHSTATS::Z))))) ; ; note: forced to do GENERIC-- (cost 10) ; unable to do inline float arithmetic (cost 2) because: ; The second argument is a NUMBER, not a DOUBLE-FLOAT. ; The result is a (VALUES NUMBER ; &OPTIONAL), not a (VALUES DOUBLE-FLOAT &REST T). ; (- (LOG (* 2.50662827465d0 CL-MATHSTATS::SER)) CL-MATHSTATS::TMP) ; ; note: forced to do GENERIC-- (cost 10) ; unable to do inline float arithmetic (cost 2) because: ; The first argument is a (OR DOUBLE-FLOAT ; (COMPLEX DOUBLE-FLOAT)), not a DOUBLE-FLOAT. ; The result is a (VALUES (OR (COMPLEX DOUBLE-FLOAT) DOUBLE-FLOAT) ; &OPTIONAL), not a (VALUES DOUBLE-FLOAT &REST T). ; (LOG (* 2.50662827465d0 CL-MATHSTATS::SER)) ; ; note: doing float to pointer coercion (cost 13) ; (- (LOG (* 2.50662827465d0 CL-MATHSTATS::SER)) CL-MATHSTATS::TMP) ; ; note: doing float to pointer coercion (cost 13) from TMP, for: ; the second argument of GENERIC-- ; (CL-MATHSTATS::GAMMA-LN (+ 1.0d0 CL-MATHSTATS::Z)) ; ; note: doing float to pointer coercion (cost 13) to X ; (LOG (SIN (* PI CL-MATHSTATS::Z))) ; ; note: doing float to pointer coercion (cost 13) ; (- (+ (LOG CL-MATHSTATS::Z) CL-MATHSTATS::+LOG-PI+) ; (+ (CL-MATHSTATS::GAMMA-LN (+ 1.0d0 CL-MATHSTATS::Z)) ; (LOG (SIN (* PI CL-MATHSTATS::Z))))) ; ; note: doing float to pointer coercion (cost 13), for: ; the first argument of GENERIC-- ; compiling (DEFUN FACTORIAL-EXACT ...) ; compiling (DEFUN FACTORIAL ...) ; compiling (DEFUN FACTORIAL-LN ...) ; compiling (DEFUN BINOMIAL-COEFFICIENT ...) ; compiling (DEFUN BINOMIAL-COEFFICIENT-EXACT ...) ; compiling (DEFUN BINOMIAL-PROBABILITY ...) ; compiling (DEFUN BINOMIAL-PROBABILITY-EXACT ...) ; compiling (DEFUN BETA ...) ; compiling (DEFUN SAFE-EXP ...) ; compiling (DEFMACRO UNDERFLOW-GOES-TO-ZERO ...) ; compiling (DEFUN GAMMA-INCOMPLETE ...) ; compiling (DEFUN ERROR-FUNCTION ...) ; compiling (DEFUN GAUSSIAN-CDF ...) ; compiling (DEFUN ERROR-FUNCTION-COMPLEMENT ...) ; compiling (DEFUN ERROR-FUNCTION-COMPLEMENT-SHORT-1 ...) ; compiling (DEFUN ERROR-FUNCTION-COMPLEMENT-SHORT-2 ...) ; compiling (DEFUN GAUSSIAN-SIGNIFICANCE ...) ; compiling (DEFUN POISSON-CDF ...) ; compiling (DEFUN CHI-SQUARE-SIGNIFICANCE ...) ; compiling (DEFUN BETA-INCOMPLETE ...) ; compiling (DEFUN STUDENTS-T-SIGNIFICANCE ...) ; compiling (DEFUN F-SIGNIFICANCE ...) ; compiling (DEFUN BINOMIAL-CDF ...) ; compiling (DEFUN BINOMIAL-CDF-EXACT ...) ; /Users/gwking/darcs/cl-mathstats/dev/density-fns.fasl written ; compilation finished in 0:00:06 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/svd.lisp" (written 21 OCT 2005 03:54:56 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (DEFMACRO AREF1 ...) ; compiling (DEFMACRO AREF11 ...) ; compiling (DEFMACRO SIGN-DF ...) ; compiling (DEFUN PYTHAG-DF ...) ; compiling (DEFUN SVBKSB-DF ...) ; compiling (DEFUN SVDCMP-DF ...) ; compiling (DEFUN SVZERO-DF ...) ; compiling (DEFUN SVD-INVERSE-SLOW-DF ...) ; compiling (DEFUN SVD-INVERSE-FAST-DF ...) ; compiling (DEFMACRO SIGN-SF ...) ; compiling (DEFUN PYTHAG-SF ...) ; compiling (DEFUN SVBKSB-SF ...) ; compiling (DEFUN SVDCMP-SF ...) ; compiling (DEFUN SVZERO-SF ...) ; compiling (DEFUN SVD-INVERSE-SLOW-SF ...) ; compiling (DEFUN SVD-INVERSE-FAST-SF ...) ; compiling (DEFUN SINGULAR-VALUE-DECOMPOSITION ...) ; compiling (DEFUN SVD-ZERO ...) ; compiling (DEFUN SVD-BACK-SUBSTITUTE ...) ; compiling (DEFUN SVD-SOLVE-LINEAR-SYSTEM ...) ; compiling (DEFUN SVDVAR ...) ; compiling (DEFUN SVD-MATRIX-INVERSE ...) ; /Users/gwking/darcs/cl-mathstats/dev/svd.fasl written ; compilation finished in 0:00:15 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/parameters.lisp" (written 21 OCT 2005 03:54:55 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (DEFPARAMETER *GAUSSIAN-CDF-SIGNALS-ZERO-STANDARD-DEVIATION-ERROR* ...) ; /Users/gwking/darcs/cl-mathstats/dev/parameters.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/utilities.lisp" (written 21 OCT 2005 03:54:56 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFVAR *TEMPORARY-VECTOR* ...) ; compiling (DEFMACRO WITH-TEMP-VECTOR ...) ; compiling (DEFVAR *TEMPORARY-TABLE* ...) ; compiling (DEFMACRO WITH-TEMP-TABLE ...) ; compiling (DEFUN EXTRACT-UNIQUE-VALUES ...) ; /Users/gwking/darcs/cl-mathstats/dev/utilities.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/define-statistical-fun.lisp" (written 17 NOV 2005 01:48:14 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (DEFMACRO WITH-ROUTINE-ERROR-HANDLING ...) ; compiling (DEFMACRO DEFINE-STATISTIC ...) ; compiling (DEFUN REMOVE-&REST ...) ; compiling (DEFMETHOD MAKE-STATISTIC ...) ; compiling (DEFMETHOD CONVERT ...) ; compiling (DEFPARAMETER *CREATE-STATISTICAL-OBJECTS* ...) ; compiling (DEFCLASS DATA ...) ; compiling (DEFCLASS STATISTIC ...) ; compiling (DEFCLASS SIMPLE-STATISTIC ...) ; compiling (DEFCLASS COMPOSITE-STATISTIC ...) ; compiling (DEFMETHOD STATISTICP ...) ; compiling (DEFMETHOD STATISTICP ...) ; compiling (DEFMETHOD COMPOSITE-STATISTIC-P ...) ; compiling (DEFMETHOD COMPOSITE-STATISTIC-P ...) ; compiling (DEFMETHOD SIMPLE-STATISTIC-P ...) ; compiling (DEFMETHOD SIMPLE-STATISTIC-P ...) ; /Users/gwking/darcs/cl-mathstats/dev/define-statistical-fun.fasl written ; compilation finished in 0:00:06 STYLE-WARNING: implicitly creating new generic function MAKE-STATISTIC STYLE-WARNING: implicitly creating new generic function CONVERT STYLE-WARNING: implicitly creating new generic function STATISTICP STYLE-WARNING: implicitly creating new generic function COMPOSITE-STATISTIC-P STYLE-WARNING: implicitly creating new generic function SIMPLE-STATISTIC-P ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp" (written 11 NOV 2005 05:17:02 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFMETHOD CONVERT ...) ; compiling (DEFMETHOD CONVERT ...) ; compiling (DEFINE-STATISTIC DATA-LENGTH ...) ; compiling (DEFINE-STATISTIC MEAN ...) ; compiling (DEFUN SUM-OF-SQUARES ...) ; compiling (DEFINE-STATISTIC VARIANCE ...) ; compiling (DEFINE-STATISTIC STANDARD-DEVIATION ...) ; compiling (DEFINE-STATISTIC SKEWNESS ...) ; compiling (DEFINE-STATISTIC MINIMUM ...) ; compiling (DEFINE-STATISTIC MAXIMUM ...) ; compiling (DEFINE-STATISTIC RANGE ...) ; compiling (DEFINE-STATISTIC QUANTILE ...) ; compiling (DEFINE-STATISTIC MEDIAN ...) ; compiling (DEFINE-STATISTIC TRIMMED-MEAN ...) ; compiling (DEFMACRO START/END ...) ; compiling (DEFINE-STATISTIC MODE ...) ; compiling (DEFPARAMETER *CONTINUOUS-VARIABLE-UNIQUENESS-FACTOR* ...) ; compiling (DEFPARAMETER *CONTINOUS-DATA-WINDOW-DIVISOR* ...) ; compiling (DEFUN MODE-FOR-CONTINUOUS-DATA ...) ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN MODE-FOR-CONTINUOUS-DATA ; (DEFUN CL-MATHSTATS::MODE-FOR-CONTINUOUS-DATA ; (CL-MATHSTATS::DATA ; &REST CL-MATHSTATS::STANDARD-ARGS ; &KEY CL-MATHSTATS::START CL-MATHSTATS::END CL-MATHSTATS::KEY ; CL-MATHSTATS::WINDOW) ; "Returns the most frequent element of `data,' which should be a sequence. The ; algorithm involves sorting, and so the data must be numbers or the `key' ; function must produce numbers. Consider `sxhash' if no better function is ; available. Also returns the number of occurrences of the mode. If there is ; more than one mode, this returns the first mode, as determined by the sorting of ; the numbers. ; ; Keep in mind that if the data has multiple runs of like values that are bigger ; than the window size (currently defaults to 10% of the size of the data) this ; function will blindly pick the first one. If this is the case you probabaly ; should be calling `mode' instead of this function." ; (DECLARE ; (VALUES METABANG.UTILITIES:ELEMENT CL-MATHSTATS::NUMBER-OF-OCCURRENCES)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (WHEN (NOT (CL-MATHSTATS::DATA-CONTINUOUS-P CL-MATHSTATS::DATA)) ; (WARN 'CL-MATHSTATS::SEEMS-TO-BE-DISCRETE)) ; (LET* ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; :ALLOW-OTHER-KEYS ; T ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::START2 (OR CL-MATHSTATS::START 0)) ; (CL-MATHSTATS::END2 (OR CL-MATHSTATS::END #)) ; (CL-MATHSTATS::J (OR CL-MATHSTATS::WINDOW #))) ; (WHEN (ZEROP CL-MATHSTATS::N) (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF (NULL CL-MATHSTATS::KEY) ; (SORT CL-MATHSTATS::TEMP #'<) ; (SORT CL-MATHSTATS::TEMP ; #'< ; :KEY ; CL-MATHSTATS::KEY)) ; (MACROLET (#) ; (IF CL-MATHSTATS::KEY # #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION ; ==> ; (THE ; # ; (PROGN ; (BLOCK CL-MATHSTATS::MODE-FOR-CONTINUOUS-DATA ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (WHEN (NOT #) (WARN 'CL-MATHSTATS::SEEMS-TO-BE-DISCRETE)) ; (LET* (# # # #) ; (WHEN # #) ; (CL-MATHSTATS::WITH-TEMP-VECTOR # # # #))))) ; ; note: type assertion too complex to check: ; (VALUES &OPTIONAL ELEMENT NUMBER-OF-OCCURRENCES &REST T). ; compiling (DEFUN DATA-CONTINUOUS-P ...) ; compiling (DEFUN SMART-MODE ...) ; compiling (DEFINE-STATISTIC MULTIPLE-MODES ...) ; compiling (DEFINE-STATISTIC INTERQUARTILE-RANGE ...) ; compiling (DEFINE-STATISTIC TUKEY-SUMMARY ...) ; compiling (DEFINE-STATISTIC STATISTICAL-SUMMARY ...) ; compiling (DEFINE-STATISTIC SIGNIFICANCE ...) ; compiling (DEFINE-STATISTIC T-SIGNIFICANCE ...) ; compiling (DEFINE-STATISTIC T-TEST-ONE-SAMPLE ...) ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFINE-STATISTIC T-TEST-ONE-SAMPLE ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::T-TEST-ONE-SAMPLE ; (CL-MATHSTATS::T-SIGNIFICANCE) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Returns the t-statistic for the mean of the data, which should be a sequence ; of numbers. Let D be the sample mean. The null hypothesis is that D equals the ; `H0-mean.' The alternative hypothesis is specified by `tails': `:both' means D ; /= H0-mean, `:positive' means D > H0-mean, and `:negative' means D < H0-mean. ; ; The function also returns the significance, the standard error, and the degrees ; of freedom. Signals `zero-variance' if that condition occurs. Signals ; `insufficient-data' unless there are at least two elements in the sample." ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::SAMPLE-ERROR ; CL-MATHSTATS::DOF)) ; (LET ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET ((CL-MATHSTATS::D #) ; (CL-MATHSTATS::V #)) ; (WHEN (ZEROP CL-MATHSTATS::V) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # #) ; (VALUES CL-MATHSTATS::TT ; CL-MATHSTATS::SIG ; CL-MATHSTATS::SE ; #))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::T-TEST-ONE-SAMPLE-INTERNAL ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::SAMPLE-ERROR ; CL-MATHSTATS::DOF)) ; (BLOCK CL-MATHSTATS::T-TEST-ONE-SAMPLE-INTERNAL ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET (# #) ; (WHEN # #) ; (LET* # ; #))))) ; ; caught STYLE-WARNING: ; &OPTIONAL and &KEY found in the same lambda list: (DATA TAILS ; &OPTIONAL ; (H0-MEAN 0) ; &REST ; STANDARD-ARGS ; &KEY ; START ; END ; KEY) ; compiling (DEFINE-STATISTIC T-TEST ...) ; compiling (DEFINE-STATISTIC D-TEST ...) ; compiling (DEFINE-STATISTIC T-TEST-MATCHED ...) ; compiling (DEFINE-STATISTIC Z-TEST-ONE-SAMPLE ...) ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFINE-STATISTIC Z-TEST-ONE-SAMPLE ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::Z-TEST-ONE-SAMPLE ; (CL-MATHSTATS::SIGNIFICANCE) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; (CL-MATHSTATS::H0-STD-DEV ; 1) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY ; CL-MATHSTATS::TAILS) ; (VALUES CL-MATHSTATS::Z-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE)) ; (LET ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET ((CL-MATHSTATS::D #) ; (CL-MATHSTATS::V #)) ; (WHEN (ZEROP CL-MATHSTATS::V) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# CL-MATHSTATS::SIG) ; (VALUES CL-MATHSTATS::ZS ; CL-MATHSTATS::SIG))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::Z-TEST-ONE-SAMPLE-INTERNAL ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; (CL-MATHSTATS::H0-STD-DEV 1) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY ; CL-MATHSTATS::TAILS) ; (VALUES CL-MATHSTATS::Z-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE)) ; (BLOCK CL-MATHSTATS::Z-TEST-ONE-SAMPLE-INTERNAL ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET (# #) ; (WHEN # #) ; (LET* # ; #))))) ; ; caught STYLE-WARNING: ; &OPTIONAL and &KEY found in the same lambda list: (DATA TAILS ; &OPTIONAL ; (H0-MEAN 0) ; (H0-STD-DEV 1) ; &REST ; STANDARD-ARGS ; &KEY ; START ; END ; KEY) ; compiling (DEFUN INNER-PRODUCT ...) ; compiling (DEFINE-STATISTIC COVARIANCE ...) ; compiling (DEFINE-STATISTIC CONFIDENCE-INTERVAL ...) ; compiling (DEFINE-STATISTIC CONFIDENCE-INTERVAL-Z ...) ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFINE-STATISTIC CONFIDENCE-INTERVAL-Z ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::CONFIDENCE-INTERVAL-Z ; (CL-MATHSTATS::CONFIDENCE-INTERVAL) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::CONFIDENCE) ; "Suppose you have a sample of 50 numbers and you want to compute a 90 percent ; confidence interval on the population mean. This function is the one to use. ; Note that it makes the assumption that the sampling distribution is normal, so ; it's inappropriate for small sample sizes. Use confidence-interval-t instead. ; It returns three values: the mean and the lower and upper bound of the ; confidence interval. True, only two numbers are necessary, but the confidence ; intervals of other statistics may be asymmetrical and these values would be ; consistent with those confidence intervals. This function handles 90, 95 and 99 ; percent confidence intervals as special cases, so those will be quite fast. ; `Sample' should be a sequence of numbers. `Confidence' should be a number ; between 0 and 1, exclusive." ; (DECLARE ; (VALUES CL-MATHSTATS::MEAN ; CL-MATHSTATS::LOWER ; CL-MATHSTATS::UPPER)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE ; (REAL (0) (1))) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DATA) ; (SQRT ; (/ ; (CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::DATA) ; (LENGTH CL-MATHSTATS::DATA))) ; CL-MATHSTATS::CONFIDENCE)) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION ; ==> ; (THE ; # ; (PROGN ; (BLOCK CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE (REAL # #)) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DATA) ; (SQRT #) ; CL-MATHSTATS::CONFIDENCE)))) ; ; note: type assertion too complex to check: ; (VALUES &OPTIONAL MEAN LOWER UPPER &REST T). ; compiling (DEFUN CONFIDENCE-INTERVAL-Z-SUMMARIES ...) ; compiling (DEFINE-STATISTIC CONFIDENCE-INTERVAL-T ...) ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFINE-STATISTIC CONFIDENCE-INTERVAL-T ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::CONFIDENCE-INTERVAL-T ; (CL-MATHSTATS::CONFIDENCE-INTERVAL) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::CONFIDENCE) ; "Suppose you have a sample of 10 numbers and you want to compute a 90 percent ; confidence interval on the population mean. This function is the one to use. ; This function uses the t-distribution, and so it is appropriate for small sample ; sizes. It can also be used for large sample sizes, but the function ; `confidence-interval-z' may be computationally faster. It returns three values: ; the mean and the lower and upper bound of the confidence interval. True, only ; two numbers are necessary, but the confidence intervals of other statistics may ; be asymmetrical and these values would be consistent with those confidence ; intervals. `Sample' should be a sequence of numbers. `Confidence' should be a ; number between 0 and 1, exclusive." ; (DECLARE ; (VALUES CL-MATHSTATS::MEAN ; CL-MATHSTATS::LOWER ; CL-MATHSTATS::UPPER)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE ; (REAL (0) (1))) ; (LET* ((CL-MATHSTATS::N ; (LENGTH CL-MATHSTATS::DATA))) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-T-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DATA) ; (- CL-MATHSTATS::N 1) ; (SQRT (/ # CL-MATHSTATS::N)) ; CL-MATHSTATS::CONFIDENCE))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION ; ==> ; (THE ; # ; (PROGN ; (BLOCK CL-MATHSTATS::CONFIDENCE-INTERVAL-T-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE (REAL # #)) ; (LET* (#) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-T-SUMMARIES # ; # ; # ; CL-MATHSTATS::CONFIDENCE))))) ; ; note: type assertion too complex to check: ; (VALUES &OPTIONAL MEAN LOWER UPPER &REST T). ; compiling (DEFUN CONFIDENCE-INTERVAL-T-SUMMARIES ...) ; compiling (DEFINE-STATISTIC CONFIDENCE-INTERVAL-PROPORTION ...) ; compiling (DEFUN SCHEFFE-TESTS ...) ; compiling (DEFUN PRINT-SCHEFFE-TABLE ...) ; compiling (DEFMETHOD CROSS-PRODUCT ...) ; compiling (DEFUN R-SCORE ...) ; compiling (DEFUN DIFFERENCE-LIST ...) ; compiling (DEFUN SUM-LIST ...) ; compiling (DEFUN CHI-SQUARE-2X2-COUNTS ...) ; compiling (DEFUN CHI-SQUARE-2X2 ...) ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CHI-SQUARE-2X2 ; (DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Performs a chi-square test for independence of the two variables, `v1' and ; `v2.' These should be categorial variables with only two values; the function ; will construct a 2x2 contingency table by counting the number of occurrences of ; each combination of the variables. See the manual for more details." ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '(2 2) (ARRAY-DIMENSIONS CL-MATHSTATS::2X2-TABLE)) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET ((CL-MATHSTATS::A #) ; (CL-MATHSTATS::B #) ; (CL-MATHSTATS::C #) ; (CL-MATHSTATS::D #)) ; (MULTIPLE-VALUE-CALL #'VALUES ; (CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS CL-MATHSTATS::A ; CL-MATHSTATS::B ; CL-MATHSTATS::C ; CL-MATHSTATS::D) ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION ; ==> ; (THE ; # ; (PROGN ; (BLOCK CL-MATHSTATS::CHI-SQUARE-2X2 ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS # #) ; (LET # ; #))))) ; ; note: type assertion too complex to check: ; (VALUES &OPTIONAL ; CHI-SQUARE ; SIGNIFICANCE ; CONTINGENCY-TABLE ; V1-VALUES ; V2-VALUES ; &REST ; T). ; compiling (DEFUN CHI-SQUARE-RXC-COUNTS ...) ; compiling (DEFVAR *WAY-TOO-BIG-CONTINGENCY-TABLE-DIMENSION* ...) ; compiling (DEFUN MAKE-CONTINGENCY-TABLE ...) ; compiling (DEFUN CHI-SQUARE-RXC ...) ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CHI-SQUARE-RXC ; (DEFUN CL-MATHSTATS::CHI-SQUARE-RXC (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Performs a chi-square test for independence of the two variables, `v1' and ; `v2.' These should be categorial variables; the function will construct a ; contingency table by counting the number of occurrences of each combination of ; the variables. See the manual for more details." ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTIGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (CHECK-TYPE CL-MATHSTATS::V1 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::V2 SEQUENCE) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::TABLE CL-MATHSTATS::V1-VALUES CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (MULTIPLE-VALUE-CALL #'VALUES ; (CL-MATHSTATS::CHI-SQUARE-RXC-COUNTS CL-MATHSTATS::TABLE) ; (CL-MATHSTATS::G-TEST CL-MATHSTATS::TABLE NIL NIL) ; CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION ; ==> ; (THE ; # ; (PROGN ; (BLOCK CL-MATHSTATS::CHI-SQUARE-RXC ; (CHECK-TYPE CL-MATHSTATS::V1 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::V2 SEQUENCE) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::TABLE CL-MATHSTATS::V1-VALUES CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (MULTIPLE-VALUE-CALL #'VALUES ; # ; # ; CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))))) ; ; note: type assertion too complex to check: ; (VALUES &OPTIONAL ; CHI-SQUARE ; SIGNIFICANCE ; CONTIGENCY-TABLE ; V1-VALUES ; V2-VALUES ; &REST ; T). ; compiling (DEFUN G-TEST ...) ; compiling (DEFUN FIND-CRITICAL-VALUE ...) ; /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.fasl written ; compilation finished in 0:00:17 WARNING: COMPILE-FILE warned while performing # on #. ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/smoothing.lisp" (written 21 OCT 2005 03:54:56 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFUN SMOOTH-MEDIAN-2 ...) ; compiling (DEFUN SMOOTH-MEDIAN-3 ...) ; compiling (DEFUN SMOOTH-MEDIAN-4 ...) ; compiling (DEFUN SMOOTH-MEDIAN-5 ...) ; compiling (DEFUN SMOOTH-HANNING ...) ; compiling (DEFUN SMOOTH-4253H ...) ; compiling (DEFUN SMOOTH-MEAN-2 ...) ; compiling (DEFUN SMOOTH-MEAN-3 ...) ; compiling (DEFUN SMOOTH-MEAN-4 ...) ; compiling (DEFUN SMOOTH-MEAN-5 ...) ; /Users/gwking/darcs/cl-mathstats/dev/smoothing.fasl written ; compilation finished in 0:00:03 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp" (written 21 OCT 2005 03:54:55 PM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFINE-STATISTIC CORRELATION ...) ; compiling (DEFUN CORRELATION-FROM-SUMMARIES ...) ; compiling (DEFUN PARTIALS-FROM-PARENTS ...) ; compiling (DEFUN LAGGED-CORRELATION ...) ; compiling (DEFINE-STATISTIC CROSS-CORRELATION ...) ; compiling (DEFINE-STATISTIC AUTOCORRELATION ...) ; compiling (DEFUN LINEAR-REGRESSION-MINIMAL-SUMMARIES ...) ; compiling (DEFUN LINEAR-REGRESSION-MINIMAL ...) ; compiling (DEFUN LINEAR-REGRESSION-BRIEF-SUMMARIES ...) ; compiling (DEFUN LINEAR-REGRESSION-BRIEF ...) ; compiling (DEFUN LINEAR-REGRESSION-VERBOSE-SUMMARIES ...) ; compiling (DEFUN LINEAR-REGRESSION-VERBOSE ...) ; compiling (DEFUN MULTIPLE-LINEAR-REGRESSION-NORMAL ...) ; compiling (DEFUN MULTIPLE-LINEAR-REGRESSION-ARRAYS ...) ; compiling (DEFUN MULTIPLE-LINEAR-REGRESSION-MINIMAL ...) ; compiling (DEFUN MULTIPLE-LINEAR-REGRESSION-BRIEF ...) ; compiling (DEFUN MULTIPLE-LINEAR-REGRESSION-VERBOSE ...) ; compiling (DEFUN CORRELATION-MATRIX ...) ; /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.fasl written ; compilation finished in 0:00:06 ; compiling file "/Users/gwking/darcs/cl-mathstats/dev/anova.lisp" (written 17 NOV 2005 11:14:07 AM): ; compiling (IN-PACKAGE METABANG.MATH) ; compiling (DEFINE-STATISTIC ANOVA-ONE-WAY-VARIABLES ...) ; compiling (DEFUN ANOVA-ONE-WAY-GROUPS ...) ; compiling (DEFUN PRINT-ANOVA-TABLE ...) ; compiling (DEFUN ANOVA-TWO-WAY-GROUPS ...) ; compiling (DEFUN MAKE-3D-TABLE ...) ; compiling (DEFINE-STATISTIC ANOVA-TWO-WAY-VARIABLES-UNEQUAL-CELL-SIZES ...) ; compiling (DEFINE-STATISTIC ANOVA-TWO-WAY-VARIABLES ...) ; /Users/gwking/darcs/cl-mathstats/dev/anova.fasl written ; compilation finished in 0:00:03 ; compiling file "/Users/gwking/darcs/metabang.bind/dev/bind.lisp" (written 21 OCT 2005 03:54:53 PM): ; compiling (DEFPACKAGE "METABANG.BIND" ...) ; compiling (IN-PACKAGE METABANG.BIND) ; compiling (DEFPARAMETER *BIND-ALL-DECLARATIONS* ...) ; compiling (DEFPARAMETER *BIND-NON-VAR-DECLARATIONS* ...) ; compiling (DEFPARAMETER *BIND-SIMPLE-VAR-DECLARATIONS* ...) ; compiling (DEFMACRO BIND ...) ; compiling (DEFUN BIND-MACRO-HELPER ...) ; compiling (DEFUN BIND-FIX-NILS ...) ; compiling (DEFUN BIND-EXPAND-DECLARATIONS ...) ; compiling (DEFUN BIND-FILTER-DECLARATIONS ...) ; compiling (DEFMACRO FLUID-BIND ...) ; /Users/gwking/darcs/metabang.bind/dev/bind.fasl written ; compilation finished in 0:00:02 ; compiling file "/Users/gwking/darcs/metatilities/dev/sbcl/generic-lisp.lisp" (written 16 NOV 2005 08:56:10 PM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (SETF (DEFAULT-INTERFACE) ...) ; compiling (DEFMETHOD IS-INTERFACE-AVAILABLE-P ...) ; compiling (DEFMETHOD QUIT-LISP* ...) ; compiling (DEFMETHOD TOTAL-BYTES-ALLOCATED* ...) ; compiling (DEFMETHOD GC-TIME* ...) ; compiling (DEFMETHOD COLLECT-GARBAGE* ...) ; /Users/gwking/darcs/metatilities/dev/sbcl/generic-lisp.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/metatilities/dev/sbcl/generic-interface-support.lisp" (written 17 NOV 2005 10:51:36 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFMETHOD CHOOSE-FILE-QUESTION* ...) ; compiling (DEFMETHOD CHOOSE-NEW-FILE-QUESTION* ...) ; compiling (DEFMETHOD CHOOSE-DIRECTORY-QUESTION* ...) ; compiling (DEFMETHOD INSPECT-THING* ...) ; /Users/gwking/darcs/metatilities/dev/sbcl/generic-interface-support.fasl written ; compilation finished in 0:00:02 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/package-additional.lisp" (written 08 NOV 2005 09:18:43 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (USE-PACKAGE "METABANG.BIND" ...) ; compiling (SHADOWING-IMPORT (QUOTE #) ...) ; compiling (SHADOWING-IMPORT (QUOTE #) ...) ; compiling (EXPORT-EXPORTED-SYMBOLS "CONTAINERS" ...) ; compiling (MAKE-LOAD-FORM* METABANG.CL-CONTAINERS:ABSTRACT-CONTAINER) ; compiling (MAKE-LOAD-FORM* METABANG.CL-CONTAINERS::BST-NODE) ; compiling (MAKE-LOAD-FORM* METABANG.CL-CONTAINERS::QUAD-TREE-NODE) ; /Users/gwking/darcs/metatilities/dev/utilities/package-additional.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/anaphoric.lisp" (written 18 NOV 2005 08:10:31 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFMACRO AIF ...) ; compiling (DEFMACRO AWHEN ...) ; compiling (DEFMACRO AWHILE ...) ; compiling (DEFMACRO AAND ...) ; compiling (DEFMACRO ACOND ...) ; compiling (DEFMACRO ALAMBDA ...) ; compiling (DEFMACRO ABLOCK ...) ; compiling (DEFMACRO AIF2 ...) ; compiling (DEFMACRO AWHEN2 ...) ; compiling (DEFMACRO AWHILE2 ...) ; compiling (DEFMACRO ACOND2 ...) ; compiling (DEFMACRO APROG1 ...) ; compiling (DEFMACRO ATYPECASE ...) ; /Users/gwking/darcs/metatilities/dev/utilities/anaphoric.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/graham.lisp" (written 18 NOV 2005 08:08:14 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFUN MOST ...) ; compiling (DEFUN BEST ...) ; compiling (DEFUN MOSTN ...) ; compiling (DEFUN MAP0-N ...) ; compiling (DEFUN MAP1-N ...) ; compiling (DEFUN MAPA-B ...) ; compiling (DEFUN MAP-> ...) ; compiling (DEFUN MAPCARS ...) ; compiling (DEFUN FILTER-VALUES ...) ; compiling (DEFMACRO WITH-GENSYMS ...) ; compiling (DEFMACRO ALLF ...) ; compiling (DEFMACRO NILF ...) ; compiling (DEFMACRO TF ...) ; compiling (DEFMACRO TOGGLE! ...) ; compiling (DEFINE-MODIFY-MACRO TOGGLE-AUX ...) ; compiling (DEFINE-MODIFY-MACRO CONCF ...) ; compiling (DEFMACRO FN ...) ; compiling (DEFUN RBUILD ...) ; compiling (DEFUN BUILD-CALL ...) ; compiling (DEFUN BUILD-COMPOSE ...) ; compiling (DEFMACRO WITH-MATRIX ...) ; compiling (DEFMACRO WITH-ARRAY ...) ; compiling (DEFMACRO WITH-STRUCT ...) ; compiling (DEFUN MATCH ...) ; compiling (DEFUN VARSYM? ...) ; compiling (DEFUN BINDING ...) ; compiling (DEFMACRO IF-MATCH ...) ; compiling (DEFUN VARS-IN ...) ; /Users/gwking/darcs/metatilities/dev/utilities/graham.fasl written ; compilation finished in 0:00:03 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/dates-and-times.lisp" (written 18 NOV 2005 08:09:41 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFCONSTANT +MINUTES-PER-HOUR+ ...) ; compiling (DEFCONSTANT +SECONDS-PER-MINUTE+ ...) ; compiling (DEFCONSTANT +USUAL-DAYS-PER-YEAR+ ...) ; compiling (DEFCONSTANT +SECONDS-PER-HOUR+ ...) ; compiling (DEFPARAMETER +MONTH-LIST+ ...) ; compiling (DEFPARAMETER +DAY-LIST+ ...) ; compiling (DEFPARAMETER +FLUFF-LIST+ ...) ; compiling (DEFCONSTANT +LONGER-FORMAT-INDEX+ ...) ; compiling (DEFCONSTANT +SHORTER-FORMAT-INDEX+ ...) ; compiling (DEFPARAMETER +MONTH-OUTPUT-LIST+ ...) ; compiling (DEFPARAMETER +DOW-OUTPUT-LIST ...) ; compiling (DEFPARAMETER +DAYS-PER-MONTH+ ...) ; compiling (DEFUN DAY->STRING ...) ; compiling (DEFUN MONTH->STRING ...) ; compiling (DEFUN STRING->MONTH ...) ; compiling (DEFUN PRINT-DATE ...) ; compiling (DEFUN DATE-STRING ...) ; compiling (DEFUN DATE-STRING-BRIEF ...) ; compiling (DEFUN PRINT-TIME-WITH-NO-COLONS ...) ; compiling (DEFUN PRINT-TIME ...) ; compiling (DEFUN PRINT-UNIVERSAL-TIME-WITH-NO-COLONS ...) ; compiling (DEFUN PRINT-UNIVERSAL-TIME ...) ; compiling (DEFUN TIME-STRING ...) ; compiling (DEFUN TIME-STRING-WITH-NO-COLONS ...) ; compiling (DEFUN DATE-AND-TIME-STRING ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN NTH-OK-P ...) ; compiling (DEFUN MONTH-OK-P ...) ; compiling (DEFUN DAY-OK-P ...) ; compiling (DEFUN YEARP ...) ; compiling (DEFUN INDEX-OF ...) ; compiling (DEFUN TOKEN-TYPE ...) ; compiling (DEFUN READ-TIME ...) ; compiling (DEFUN READ-DATE ...) ; compiling (DEFMACRO HANDLE-TOKEN ...) ; compiling (DEFUN PARSE-DATE-AND-TIME-STRING ...) ; file: /Users/gwking/darcs/metatilities/dev/utilities/dates-and-times.lisp ; in: DEFUN PARSE-DATE-AND-TIME-STRING ; (ERROR "unsupported reader call") ; ==> ; "unsupported reader call" ; ; note: deleting unreachable code ; compiling (DEFUN PARSE-DATE-AND-TIME ...) ; compiling (DEFUN PRINT-BRIEF-UT ...) ; compiling (DEFUN PRINT-UT ...) ; compiling (DEFUN PRINT-TIME-INTERVAL ...) ; compiling (DEFUN PRINT-BRIEF-TIME-INTERVAL ...) ; compiling (DEFUN PARSE-NUMBER ...) ; compiling (DEFVAR TIME-INTERVAL-ARRAY ...) ; compiling (DEFVAR TIME-INTERVAL-UNIT-TYPES ...) ; compiling (DEFUN TIME-INTERVAL-TO-SECONDS ...) ; compiling (DEFUN PARSE-INTERVAL-OR-NEVER ...) ; compiling (DEFUN PARSE-TIME ...) ; file: /Users/gwking/darcs/metatilities/dev/utilities/dates-and-times.lisp ; in: DEFUN PARSE-TIME ; (+ METABANG.UTILITIES:IT 4) ; ; note: deleting unreachable code ; compiling (DEFUN INIT-TIME-INTERVAL-ARRAY ...) ; compiling (INIT-TIME-INTERVAL-ARRAY) ; compiling (DEFUN PRINT-UNIVERSAL-DATE-VERBOSE ...) ; compiling (DEFUN PRINT-DATE-VERBOSE ...) ; compiling (EVAL-ALWAYS (DEFMACRO GENERATE-TIME-PART-FUNCTION ...)) ; compiling (GENERATE-TIME-PART-FUNCTION SECOND ...) ; compiling (GENERATE-TIME-PART-FUNCTION MINUTE ...) ; compiling (GENERATE-TIME-PART-FUNCTION HOUR ...) ; compiling (GENERATE-TIME-PART-FUNCTION DATE ...) ; compiling (GENERATE-TIME-PART-FUNCTION MONTH ...) ; compiling (GENERATE-TIME-PART-FUNCTION YEAR ...) ; compiling (GENERATE-TIME-PART-FUNCTION DAY-OF-WEEK ...) ; compiling (GENERATE-TIME-PART-FUNCTION DAYLIGHT-SAVINGS-TIME-P ...) ; compiling (DEFUN FORMAT-DATE ...) ; compiling (DEFUN DAYS-IN-MONTH ...) ; compiling (DEFUN LEAP-YEAR-P ...) ; compiling (DEFUN DAY-OF-YEAR ...) ; /Users/gwking/darcs/metatilities/dev/utilities/dates-and-times.fasl written ; compilation finished in 0:00:07 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/files.lisp" (written 18 NOV 2005 08:08:56 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFUN NICELY-FORMAT-FILENAME ...) ; compiling (DEFCONSTANT +MAC-OS-FILENAME-LIMIT+ ...) ; compiling (DEFUN FILE-TO-LIST ...) ; compiling (DEFUN UNIQUE-FILE-NAME-FROM-DATE ...) ; compiling (DEFUN PRETTY-NAMESTRING-FROM-DATE ...) ; compiling (DEFUN EOS-NAMESTRING-FROM-DATE ...) ; compiling (DEFUN SHORT-EOS-NAMESTRING-FROM-DATE ...) ; compiling (DEFUN RENAME-FILE-IF-PRESENT ...) ; compiling (DEFMETHOD UNIQUIFY-FILE-NAME ...) ; compiling (DEFMETHOD UNIQUIFY-FILE-NAME ...) ; compiling (DEFUN GOOD-FILENAME-CHAR-P ...) ; compiling (DEFUN REMOVE-ILLEGAL-FILENAME-CHARACTERS ...) ; compiling (DEFMETHOD SHORTEN-FILENAME-FOR-OS ...) ; compiling (DEFMETHOD SHORTEN-FILENAME-FOR-OS ...) ; compiling (DEFUN MAXIMUM-FILENAME-LENGTH ...) ; compiling (DEFUN MAP-FILES ...) ; compiling (DEFMETHOD MAP-FORMS-IN-FILE ...) ; compiling (DEFMETHOD MAP-FORMS-IN-FILE ...) ; compiling (DEFMETHOD MAP-FORMS-IN-FILE ...) ; compiling (DEFMETHOD MAP-LINES-IN-FILE ...) ; compiling (DEFMETHOD MAP-LINES-IN-FILE ...) ; compiling (DEFMETHOD MAP-LINES-IN-FILE ...) ; compiling (DEFMACRO MAP-LINES ...) ; compiling (DEFUN FILE-NEWER-THAN-FILE-P ...) ; compiling (DEFUN ENSURE-WILD-FILE-SPEC ...) ; compiling (DEFUN REMOVE-DEAD-VERSIONS ...) ; compiling (DEFUN FILE-PACKAGE ...) ; compiling (DEFVAR *GLU-BLAST-PATHNAME-DEFAULTS* ...) ; compiling (DEFVAR *GLU-BLAST-DEFAULT-SELECTOR* ...) ; compiling (DEFUN GLU-BLAST ...) ; compiling (DEFUN PATHNAME-IS-OLD-CVS-JUNK-P ...) ; compiling (DEFUN COPY-FILE ...) ; file: /Users/gwking/darcs/metatilities/dev/utilities/files.lisp ; in: DEFUN COPY-FILE ; (LET ((METABANG.UTILITIES::DATA NIL) (METABANG.UTILITIES::EOF (GENSYM))) ; (LOOP METABANG.UTILITIES::WITH ; METABANG.UTILITIES::DATA ; METABANG.UTILITIES::WHILE ; (NOT (EQ (SETF METABANG.UTILITIES::DATA #) METABANG.UTILITIES::EOF)) ; DO ; (WRITE METABANG.UTILITIES::DATA :STREAM METABANG.UTILITIES::DST))) ; ; caught STYLE-WARNING: ; The variable DATA is defined but never used. ; /Users/gwking/darcs/metatilities/dev/utilities/files.fasl written ; compilation finished in 0:00:05 WARNING: COMPILE-FILE warned while performing # on #. ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/macros.lisp" (written 18 NOV 2005 08:07:01 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFMACRO NYI ...); ; caught STYLE-WARNING: ; NYI is being redefined as a macro when it was previously assumed to be a function. ; compiling (DEFMACRO MAKE-OBSOLETE ...) ; compiling (DEFMACRO NAMED-LAMBDA ...) ; compiling (DEFMACRO DELETEF ...) ; compiling (DEFMACRO REMOVEF ...) ; compiling (DEFMACRO DOPLIST ...) ; compiling (DEFMACRO ASSERT* ...) ; compiling (DEFINE-MODIFY-MACRO MAXF ...) ; compiling (DEFINE-MODIFY-MACRO MINF ...) ; compiling (DEFINE-MODIFY-MACRO MULTF ...) ; compiling (DEFMACRO SOME* ...) ; compiling (DEFMACRO HANDLER-CASE-IF ...) ; compiling (DEFUN GENSYM* ...) ; compiling (DEFMACRO REBINDING ...) ; compiling (DEFUN FUNCTION-EXPRESSION-P ...) ; compiling (DEFUN EXTRACT-HEAD-FORM ...) ; compiling (DEFMACRO |\\| ...) ; compiling (DEFUN MAKE-HCASE-TABLE ...) ; compiling (DEFMACRO HCASE ...) ; compiling (DEFMACRO ENSURE-TYPE ...) ; compiling (DEFMACRO WITH-SLOT-BINDINGS ...) ; compiling (DEFMACRO FUNCALL-IF ...) ; compiling (DEFVAR *FILE-IF-EXISTS* ...) ; compiling (DEFVAR *FILE-PRINT-RIGHT-MARGIN* ...) ; compiling (DEFMACRO WITH-NEW-FILE ...) ; /Users/gwking/darcs/metatilities/dev/utilities/macros.fasl written ; compilation finished in 0:00:04 WARNING: COMPILE-FILE warned while performing # on #. ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/locks.lisp" (written 21 OCT 2005 03:55:02 PM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFCLASS EKSL-LOCK ...) ; compiling (DEFMETHOD REALLOCATE-INSTANCE ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFVAR *LOCKBASE* ...) ; compiling (DEFVAR *ERROR-ON-REENTRANT-REQUEST* ...) ; compiling (DEFCONSTANT +WRITE-LOCK+ ...) ; compiling (DEFCONSTANT +READ-LOCK+ ...) ; compiling (DEFUN LOOK-LOCKS ...) ; compiling (DEFUN FIND-LOCK ...) ; compiling (DEFUN GRANT-LOCK ...) ; compiling (DEFUN SERVICE-PENDING-READS ...) ; compiling (DEFUN ENQUEUE-LOCK-REQUEST ...) ; compiling (DEFUN RELEASE-EKSL-LOCK ...) ; compiling (DEFUN REQUEST-EKSL-LOCK ...) ; compiling (DEFGENERIC DESTROY-LOCK ...) ; compiling (DEFUN SAFELY-DESTROY-LOCK ...) ; compiling (DEFUN FLUSH-LOCKS ...) ; compiling (DEFUN FLUSH-LOCKS-AND-TAKE-NAMES ...) ; compiling (DEFUN ACCESS-LOCK-P ...) ; compiling (DEFMACRO WITH-EKSL-LOCK ...) ; compiling (DEFMACRO WITH-READ-ACCESS ...) ; compiling (DEFMACRO WITH-WRITE-ACCESS ...) ; /Users/gwking/darcs/metatilities/dev/utilities/locks.fasl written ; compilation finished in 0:00:04 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/sequences.lisp" (written 18 NOV 2005 08:13:22 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFUN REDUCE-IF ...) ; compiling (DEFUN MINIMIZE ...) ; compiling (DEFUN MAPCAN1 ...) ; file: /Users/gwking/darcs/metatilities/dev/utilities/sequences.lisp ; in: DEFUN MAPCAN1 ; (FUNCALL METABANG.UTILITIES::FUN (CAR LIST)) ; --> SB-C::%FUNCALL THE ; ==> ; (SB-KERNEL:%COERCE-CALLABLE-TO-FUN FUNCTION) ; ; note: unable to ; optimize away possible call to FDEFINITION at runtime ; due to type uncertainty: ; The first argument is a (OR FUNCTION SYMBOL), not a FUNCTION. ; (FUNCALL METABANG.UTILITIES::FUN ELT) ; --> SB-C::%FUNCALL THE ; ==> ; (SB-KERNEL:%COERCE-CALLABLE-TO-FUN FUNCTION) ; ; note: unable to ; optimize away possible call to FDEFINITION at runtime ; due to type uncertainty: ; The first argument is a (OR FUNCTION SYMBOL), not a FUNCTION. ; compiling (DEFUN DOTTED-PAIR-P ...) ; compiling (DEFUN FLATTEN ...) ; compiling (DEFUN POWER-SET ...) ; compiling (DEFUN ALL-PAIRS ...) ; compiling (DEFUN MAP-COMBINATIONS ...) ; compiling (DEFUN COMBINATIONS ...) ; compiling (DEFUN PERMUTE ...) ; compiling (DEFUN REMOVE-MEMBERS ...) ; compiling (DEFUN TRANSPOSE ...) ; compiling (DEFUN TRANSPOSE2 ...) ; compiling (DEFUN LIST-CHOOSE-K ...) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFUN SAME-LENGTH-P ...) ; compiling (DEFUN LENGTH-EXACTLY-P ...) ; compiling (DEFUN PERCENT-OVERLAP ...) ; compiling (DEFUN ITERATE-OVER-INDEXES ...) ; /Users/gwking/darcs/metatilities/dev/utilities/sequences.fasl written ; compilation finished in 0:00:03 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/spy.lisp" (written 18 NOV 2005 08:04:43 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFPARAMETER *SPY-DEBUGGING* ...) ; compiling (DEFPARAMETER *SPY-OUTPUT* ...) ; compiling (DEFPARAMETER *SPY-NO-NEWLINE* ...) ; compiling (DEFPARAMETER *SPY-NO-EXPAND* ...) ; compiling (DEFUN SPY-PRIN1 ...) ; compiling (DEFUN SPY-PARSE-ARGLIST ...) ; compiling (DEFUN SPY-DO-FORM ...) ; compiling (DEFUN SPY-EXPAND-FORM ...) ; compiling (DEFMACRO SPY ...) ; compiling (DEFMACRO SPY* ...) ; compiling (DEFMACRO SPYX ...) ; /Users/gwking/darcs/metatilities/dev/utilities/spy.fasl written ; compilation finished in 0:00:00 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/strings.lisp" (written 18 NOV 2005 08:12:39 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFUN STRING-BEFORE ...) ; compiling (DEFUN STRING-AFTER ...) ; compiling (DEFUN STRING-STARTS-WITH ...) ; compiling (DEFUN STRING-ENDS-WITH ...) ; compiling (DEFUN SUBSTRING ...) ; file: /Users/gwking/darcs/metatilities/dev/utilities/strings.lisp ; in: DEFUN SUBSTRING ; (CHAR STRING METABANG.UTILITIES::R-INDEX) ; --> AREF LET* ; ==> ; (SB-KERNEL:HAIRY-DATA-VECTOR-REF ARRAY SB-INT:INDEX) ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a STRING, not a SIMPLE-STRING. ; ; note: unable to ; avoid runtime dispatch on array element type ; because: ; Upgraded element type of array is not known at compile time. ; (CHAR-DOWNCASE METABANG.UTILITIES::C) ; ; note: unable to ; open code ; due to type uncertainty: ; The first argument is a CHARACTER, not a BASE-CHAR. ; compiling (DEFUN (SETF SUBSTRING) ...) ; compiling (DEFUN STRING-CONTAINS-P ...) ; compiling (DEFUN COLLECT-TO-CHAR ...) ; file: /Users/gwking/darcs/metatilities/dev/utilities/strings.lisp ; in: DEFUN COLLECT-TO-CHAR ; (POSITION CHAR ; STRING ; :START ; METABANG.UTILITIES::START ; :END ; METABANG.UTILITIES::END ; :TEST ; #'CHAR=) ; --> NTH-VALUE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; ==> ; (SB-KERNEL:%FIND-POSITION SB-C::ITEM ; SEQUENCE ; SB-C::FROM-END ; SB-C::START ; SB-C::END ; (SB-KERNEL:EFFECTIVE-FIND-POSITION-KEY SB-C::KEY) ; (SB-KERNEL:EFFECTIVE-FIND-POSITION-TEST SB-C::TEST ; SB-C::TEST-NOT)) ; ; note: unable to ; expand inline ; because: ; upgraded array element type not known at compile time ; compiling (DEFUN COLLECT-TO-NOT ...) ; file: /Users/gwking/darcs/metatilities/dev/utilities/strings.lisp ; in: DEFUN COLLECT-TO-NOT ; (POSITION CHAR ; STRING ; :START ; METABANG.UTILITIES::START ; :END ; METABANG.UTILITIES::END ; :TEST-NOT ; #'CHAR=) ; --> NTH-VALUE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; ==> ; (SB-KERNEL:%FIND-POSITION SB-C::ITEM ; SEQUENCE ; SB-C::FROM-END ; SB-C::START ; SB-C::END ; (SB-KERNEL:EFFECTIVE-FIND-POSITION-KEY SB-C::KEY) ; (SB-KERNEL:EFFECTIVE-FIND-POSITION-TEST SB-C::TEST ; SB-C::TEST-NOT)) ; ; note: unable to ; expand inline ; because: ; upgraded array element type not known at compile time ; --> NTH-VALUE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> SB-KERNEL:%FIND-POSITION SB-KERNEL:EFFECTIVE-FIND-POSITION-TEST LET LET ; --> COND IF COND IF COND IF PROGN ; ==> ; (COMPLEMENT (SB-KERNEL:%COERCE-CALLABLE-TO-FUN #:ONCE-ONLY-404)) ; ; note: unable to open code because: The function doesn't have a fixed argument count. ; compiling (DEFUN STRING->SYMBOL ...) ; compiling (DEFUN SYMBOL->STRING ...) ; compiling (DEFUN TOKENIZE-STRING ...) ; compiling (DEFUN LIST->FORMATTED-STRING ...) ; /Users/gwking/darcs/metatilities/dev/utilities/strings.fasl written ; compilation finished in 0:00:02 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/utilities.lisp" (written 18 NOV 2005 08:02:55 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFUN MAPAPPEND ...); ; caught STYLE-WARNING: ; using deprecated EVAL-WHEN situation names LOAD ; compiling (SETF (FDEFINITION #) ...) ; compiling (DEFUN TREE-MAP ...) ; compiling (DEFUN TREE-FIND ...) ; compiling (DEFUN TREE-FIND-IF ...) ; compiling (DEFUN TREE-REMOVE-IF ...) ; compiling (DEFUN PARTITION ...) ; compiling (SETF (SYMBOL-FUNCTION #) ...) ; compiling (SETF (SYMBOL-FUNCTION #) ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN FIND-ALL ...) ; compiling (DEFUN NMERGE-LIST ...) ; compiling (DEFUN DELETE-IF! ...) ; compiling (DEFUN COMPACT-ARRAY ...) ; compiling (DEFUN CIRCULAR-LIST ...) ; compiling (DEFUN GENSYM0 ...) ; compiling (DEFUN GROUP ...) ; compiling (DEFUN MAKE-INITIALIZED-ARRAY ...) ; compiling (DEFUN FIXNUMP ...) ; compiling (DEFUN OBJECT->STRING ...) ; compiling (DEFUN FLOAT->INTEGER ...) ; compiling (DEFUN SORT-USING-LIST-ORDER ...) ; compiling (DEFUN UNUSED-VARIABLES ...) ; compiling (DEFUN LAMBDA-LIST->ARGS ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN CAR-SAFE ...) ; compiling (PROCLAIM (QUOTE #)) ; compiling (DEFUN CDR-SAFE ...) ; compiling (DEFCONSTANT +VERY-SMALL-NUMBER+ ...) ; compiling (DEFUN VERY-SMALL-NUMBER-P ...) ; file: /Users/gwking/darcs/metatilities/dev/utilities/utilities.lisp ; in: DEFUN VERY-SMALL-NUMBER-P ; (ABS NUMBER) ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT). ; The result is a (VALUES (REAL 0) ; &OPTIONAL), not a (VALUES DOUBLE-FLOAT &REST T). ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT). ; The result is a (VALUES (REAL 0) ; &OPTIONAL), not a (VALUES SINGLE-FLOAT &REST T). ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a NUMBER, not a RATIONAL. ; (< (ABS NUMBER) METABANG.UTILITIES:+VERY-SMALL-NUMBER+) ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a (OR (SINGLE-FLOAT 0.0) ; (DOUBLE-FLOAT 0.0d0) ; (RATIONAL 0)), not a DOUBLE-FLOAT. ; (ABS NUMBER) ; ; note: forced to do full call ; unable to do inline float arithmetic (cost 1) because: ; The first argument is a NUMBER, not a SINGLE-FLOAT. ; The result is a (VALUES (REAL 0) ; &OPTIONAL), not a (VALUES SINGLE-FLOAT &REST T). ; unable to do inline float arithmetic (cost 1) because: ; The first argument is a NUMBER, not a DOUBLE-FLOAT. ; The result is a (VALUES (REAL 0) ; &OPTIONAL), not a (VALUES DOUBLE-FLOAT &REST T). ; (< (ABS NUMBER) METABANG.UTILITIES:+VERY-SMALL-NUMBER+) ; ; note: forced to do GENERIC-< (cost 10) ; unable to do inline float comparison (cost 3) because: ; The first argument is a (OR (SINGLE-FLOAT 0.0) ; (DOUBLE-FLOAT 0.0d0) ; (RATIONAL 0)), not a SINGLE-FLOAT. ; compiling (DEFUN CONVERT-CLAUSES-INTO-LISTS ...) ; compiling (DEFUN CONVERT-CLAUSES-INTO-LISTS* ...) ; compiling (DEFUN CLEANUP-PARSED-PARAMETER ...) ; compiling (DEFUN FIRSTN ...) ; compiling (DEFUN CURRY ...) ; compiling (DEFINE-COMPILER-MACRO CURRY ...) ; compiling (DEFUN CURRY-AFTER ...) ; compiling (DEFUN COMPOSE ...) ; compiling (DEFUN CONJOIN ...) ; compiling (DEFINE-COMPILER-MACRO CONJOIN ...) ; compiling (DEFUN DISJOIN ...) ; compiling (DEFINE-COMPILER-MACRO DISJOIN ...) ; compiling (DEFUN ADD-CLASSES-IF-NECESSARY ...) ; compiling (DEFUN DIRECT-SUPERCLASSES-DEFCLASS* ...) ; compiling (DEFUN SUPERCLASSES-DEFCLASS* ...) ; compiling (DEFUN ADD-CLASS-IF-NECESSARY ...) ; compiling (DEFUN REMOVE-LEADING-QUOTE ...) ; compiling (DEFUN NTH-ELT-OF-CROSS-PRODUCT ...) ; compiling (DEFUN NTH-ELT-OF-CROSS-PRODUCT-AS-MULTIPLE-VALUES ...) ; compiling (DEFUN CONSTANT-EXPRESSION-P ...) ; compiling (DEFUN CONSTANT-FUNCTION-P ...) ; compiling (DEFUN MAKE-SORTER ...) ; compiling (DEFMETHOD COPY-TEMPLATE ...) ; compiling (DEFMETHOD MAKE-INSTANCE-FROM-OBJECT-INITARGS ...) ; compiling (DEFMACRO PUSH-END ...); ; caught STYLE-WARNING: ; PUSH-END is being redefined as a macro when it was previously assumed to be a function. ; /Users/gwking/darcs/metatilities/dev/utilities/utilities.fasl written ; compilation finished in 0:00:07 WARNING: COMPILE-FILE warned while performing # on #. ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/tcp.lisp" (written 21 OCT 2005 03:55:03 PM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFGENERIC OPEN-SOCKET-STREAM ...) ; compiling (DEFGENERIC CLOSE-SOCKET-STREAM ...) ; compiling (DEFMACRO WITH-OPEN-SOCKET ...) ; compiling (DEFGENERIC START-SERVER ...) ; /Users/gwking/darcs/metatilities/dev/utilities/tcp.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/searching.lisp" (written 18 NOV 2005 08:05:06 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFUN BINARY-SEARCH ...) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFUN TREE-SEARCH ...) ; compiling (DEFUN PREPEND ...) ; compiling (DEFUN DEPTH-FIRST-SEARCH ...) ; compiling (DEFUN BREADTH-FIRST-SEARCH ...) ; compiling (DEFUN MAKE-SORTER-FN ...) ; compiling (DEFUN BEST-FIRST-SEARCH ...) ; compiling (DEFUN BEAM-SEARCH ...) ; compiling (DEFUN ITER-WIDE-SEARCH ...) ; compiling (DEFUN GRAPH-SEARCH ...) ; compiling (DEFUN NEW-STATES ...) ; compiling (DEFVAR *A*-COUNT* ...) ; compiling (DEFVAR *A*-LIMIT* ...) ; compiling (DEFUN SEARCH-ALL ...) ; /Users/gwking/darcs/metatilities/dev/utilities/searching.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/metatilities/dev/utilities/views-and-windows.lisp" (written 18 NOV 2005 08:00:16 AM): ; compiling (IN-PACKAGE METATILITIES) ; compiling (DEFCLASS VIEW-REQUIRING-CLEANUP-MIXIN ...) ; compiling (DEFGENERIC CLEAN-UP-VIEW ...) ; compiling (DEFGENERIC UPDATE-DIALOG-UI ...) ; compiling (DEFCLASS* HELP-TEXT-MIXIN ...) ; compiling (DEFMETHOD HELP-SPEC ...) ; compiling (DEFCLASS* MARGINS-MIXIN ...) ; compiling (DEFMETHOD (SETF LEFT-MARGIN) ...) ; compiling (DEFMETHOD (SETF TOP-MARGIN) ...) ; compiling (DEFMETHOD (SETF RIGHT-MARGIN) ...) ; compiling (DEFMETHOD (SETF BOTTOM-MARGIN) ...) ; compiling (DEFMETHOD VIEW-X/VIEW-Y->X/Y ...) ; compiling (DEFMETHOD VIEW-SCALE ...) ; compiling (DEFGENERIC ADJUST-POINT-FOR-SCALING ...) ; compiling (DEFGENERIC VIEW-X/VIEW-Y->POINT ...) ; compiling (DEFGENERIC NOTE-VIEW-SETTINGS-CHANGED ...) ; compiling (DEFGENERIC REDRAW ...) ; compiling (DEFGENERIC DIALOG-ITEM-VALUE ...) ; compiling (DEFGENERIC (SETF DIALOG-ITEM-VALUE) ...) ; /Users/gwking/darcs/metatilities/dev/utilities/views-and-windows.fasl written ; compilation finished in 0:00:05 STYLE-WARNING: redefining TIME-SECOND in DEFUN STYLE-WARNING: redefining TIME-MINUTE in DEFUN STYLE-WARNING: redefining TIME-HOUR in DEFUN STYLE-WARNING: redefining TIME-DATE in DEFUN STYLE-WARNING: redefining TIME-MONTH in DEFUN STYLE-WARNING: redefining TIME-YEAR in DEFUN STYLE-WARNING: redefining TIME-DAY-OF-WEEK in DEFUN STYLE-WARNING: redefining TIME-DAYLIGHT-SAVINGS-TIME-P in DEFUN STYLE-WARNING: implicitly creating new generic function UNIQUIFY-FILE-NAME STYLE-WARNING: implicitly creating new generic function SHORTEN-FILENAME-FOR-OS STYLE-WARNING: implicitly creating new generic function MAP-FORMS-IN-FILE STYLE-WARNING: implicitly creating new generic function MAP-LINES-IN-FILE STYLE-WARNING: implicitly creating new generic function REALLOCATE-INSTANCE STYLE-WARNING: implicitly creating new generic function COPY-TEMPLATE STYLE-WARNING: implicitly creating new generic function MAKE-INSTANCE-FROM-OBJECT-INITARGS STYLE-WARNING: implicitly creating new generic function HELP-SPEC STYLE-WARNING: implicitly creating new generic function VIEW-X/VIEW-Y->X/Y STYLE-WARNING: implicitly creating new generic function VIEW-SCALE STYLE-WARNING: implicitly creating new generic function CROSS-PRODUCT ; compiling file "/Users/gwking/darcs/cl-graph/dev/package.lisp" (written 09 NOV 2005 05:27:46 PM): ; compiling (IN-PACKAGE COMMON-LISP-USER) ; compiling (DEFPACKAGE "CL-GRAPH" ...) ; /Users/gwking/darcs/cl-graph/dev/package.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/cl-graph/dev/macros.lisp" (written 21 OCT 2005 03:54:54 PM): ; compiling (IN-PACKAGE METABANG.GRAPH) ; compiling (DEFMACRO WITH-CHANGING-VERTEX ...) ; /Users/gwking/darcs/cl-graph/dev/macros.fasl written ; compilation finished in 0:00:00 ; compiling file "/Users/gwking/darcs/cl-graph/dev/graph.lisp" (written 21 OCT 2005 03:54:54 PM): ; compiling (IN-PACKAGE METABANG.GRAPH) ; compiling (DEFCONDITION GRAPH-ERROR ...) ; compiling (DEFCONDITION EDGE-ERROR ...) ; compiling (DEFCONDITION GRAPH-VERTEX-NOT-FOUND-ERROR ...) ; compiling (DEFCONDITION GRAPH-VERTEX-NOT-FOUND-IN-EDGE-ERROR ...) ; compiling (DEFCONDITION GRAPH-EDGE-NOT-FOUND-ERROR ...) ; compiling (DEFCLASS* BASIC-VERTEX ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFCLASS* BASIC-EDGE ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFCLASS* DIRECTED-EDGE-MIXIN ...) ; compiling (DEFCLASS* WEIGHTED-EDGE-MIXIN ...) ; compiling (DEFMETHOD WEIGHT ...) ; compiling (DEFCLASS* BASIC-GRAPH ...) ; compiling (DEFGENERIC MAKE-VERTEX-CONTAINER ...) ; compiling (DEFGENERIC MAKE-EDGE-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFMETHOD MAKE-VERTEX-FOR-GRAPH ...) ; compiling (DEFMETHOD MAKE-EDGE-FOR-GRAPH ...) ; compiling (DEFGENERIC MAKE-GRAPH ...) ; compiling (DEFMETHOD MAKE-GRAPH ...) ; compiling (DEFMETHOD MAKE-GRAPH ...) ; compiling (DEFGENERIC MAKE-EDGE-FOR-GRAPH ...) ; compiling (DEFGENERIC ADD-EDGE ...) ; compiling (DEFGENERIC ADD-EDGE-BETWEEN-VERTEXES ...) ; compiling (DEFGENERIC DELETE-EDGE ...) ; compiling (DEFGENERIC DELETE-EDGE-BETWEEN-VERTEXES ...) ; compiling (DEFGENERIC ADD-VERTEX ...) ; compiling (DEFGENERIC DELETE-VERTEX ...) ; compiling (DEFGENERIC FIND-VERTEX ...) ; compiling (DEFGENERIC SEARCH-FOR-VERTEX ...) ; compiling (DEFGENERIC FIND-EDGE ...) ; compiling (DEFGENERIC FIND-EDGE-BETWEEN-VERTEXES ...) ; compiling (DEFGENERIC SOURCE-VERTEX ...) ; compiling (DEFGENERIC TARGET-VERTEX ...) ; compiling (DEFGENERIC ITERATE-EDGES ...) ; compiling (DEFGENERIC ITERATE-SOURCE-EDGES ...) ; compiling (DEFGENERIC ITERATE-TARGET-EDGES ...) ; compiling (DEFGENERIC ITERATE-CHILDREN ...) ; compiling (DEFGENERIC HAS-CHILDREN-P ...) ; compiling (DEFGENERIC HAS-PARENT-P ...) ; compiling (DEFGENERIC ITERATE-PARENTS ...) ; compiling (DEFGENERIC ITERATE-NEIGHBORS ...) ; compiling (DEFGENERIC RENUMBER-VERTEXES ...) ; compiling (DEFGENERIC RENUMBER-EDGES ...) ; compiling (DEFGENERIC GENERATE-DIRECTED-FREE-TREE ...) ; compiling (DEFGENERIC IN-UNDIRECTED-CYCLE-P ...) ; compiling (DEFGENERIC UNDIRECTED-EDGE-P ...) ; compiling (DEFGENERIC DIRECTED-EDGE-P ...) ; compiling (DEFGENERIC TAGGED-EDGE-P ...) ; compiling (DEFGENERIC UNTAGGED-EDGE-P ...) ; compiling (DEFMETHOD UNDIRECTED-EDGE-P ...) ; compiling (DEFMETHOD DIRECTED-EDGE-P ...) ; compiling (DEFMETHOD TAGGED-EDGE-P ...) ; compiling (DEFMETHOD UNTAGGED-EDGE-P ...) ; compiling (DEFMETHOD TAG-ALL-EDGES ...) ; compiling (DEFMETHOD TAG-ALL-EDGES ...) ; compiling (DEFMETHOD UNTAG-ALL-EDGES ...) ; compiling (DEFMETHOD UNTAG-ALL-EDGES ...) ; compiling (DEFMETHOD UNTAG-EDGES ...) ; compiling (DEFMETHOD TAG-EDGES ...) ; compiling (DEFMETHOD (SETF ELEMENT) ...) ; compiling (DEFMETHOD ADD-VERTEX ...) ; compiling (DEFMETHOD REPLACE-VERTEX ...) ; compiling (DEFMETHOD ADD-EDGE-BETWEEN-VERTEXES ...) ; compiling (DEFMETHOD ADD-EDGE-BETWEEN-VERTEXES ...) ; compiling (DEFMETHOD ADD-EDGE-TO-VERTEX ...) ; compiling (DEFMETHOD FIND-EDGE-BETWEEN-VERTEXES ...) ; compiling (DEFMETHOD DELETE-EDGE-BETWEEN-VERTEXES ...) ; compiling (DEFMETHOD DELETE-EDGE ...) ; compiling (DEFMETHOD DELETE-VERTEX ...) ; compiling (DEFMETHOD DELETE-VERTEX ...) ; compiling (DEFMETHOD DELETE-VERTEX ...) ; compiling (DEFMETHOD INSERT-ITEM ...) ; compiling (DEFMETHOD SOURCE-EDGES ...) ; compiling (DEFMETHOD TARGET-EDGES ...) ; compiling (DEFMETHOD CHILD-VERTEXES ...) ; compiling (DEFMETHOD PARENT-VERTEXES ...) ; compiling (DEFMETHOD NEIGHBOR-VERTEXES ...) ; compiling (DEFUN ADJACENTP ...) ; compiling (DEFMETHOD NUMBER-OF-NEIGHBORS ...) ; compiling (DEFMETHOD IN-CYCLE-P ...) ; compiling (DEFMETHOD RENUMBER-VERTEXES ...) ; compiling (DEFMETHOD RENUMBER-EDGES ...) ; compiling (DEPRECATED (DEFMETHOD CONTAINER->LIST ...)) ; compiling (DEFMETHOD ADD-VERTEX ...) ; compiling (DEFMETHOD ADD-EDGE ...) ; compiling (DEFMETHOD FIND-VERTEX ...) ; compiling (DEFMETHOD FIND-VERTEX ...) ; compiling (DEFMETHOD SEARCH-FOR-VERTEX ...) ; compiling (DEFMETHOD SEARCH-FOR-VERTEX ...) ; compiling (DEFMETHOD SEARCH-FOR-VERTEX ...) ; compiling (DEFMETHOD ITERATE-ELEMENTS ...) ; compiling (DEFMETHOD ITERATE-NODES ...) ; compiling (DEFMETHOD ITERATE-VERTEXES ...) ; compiling (DEFMETHOD ITERATE-VERTEXES ...) ; compiling (DEFMETHOD SIZE ...) ; compiling (DEFMETHOD EDGES ...) ; compiling (DEFMETHOD EDGES ...) ; compiling (DEPRECATED "Use size instead" ...) ; compiling (DEFMETHOD VERTEXES ...) ; compiling (DEFMETHOD SOURCE-EDGE-COUNT ...) ; compiling (DEFMETHOD TARGET-EDGE-COUNT ...) ; compiling (DEFMETHOD GRAPH-ROOTS ...) ; compiling (DEFMETHOD ROOTP ...) ; compiling (DEFMETHOD FIND-VERTEX-IF ...) ; compiling (DEFMETHOD FIND-VERTEX-IF ...) ; compiling (DEFMETHOD FIND-EDGE-IF ...) ; compiling (DEFMETHOD FIND-EDGES-IF ...) ; compiling (DEFMETHOD FIND-VERTEXES-IF ...) ; compiling (DEFMETHOD EMPTY! ...) ; compiling (DEFUN NEIGHBORS-TO-CHILDREN ...) ; compiling (DEFMETHOD GENERATE-DIRECTED-FREE-TREE ...) ; compiling (DEFMETHOD FORCE-UNDIRECTED ...) ; compiling (DEFMETHOD TRAVERSE-ELEMENTS ...) ; compiling (DEFMETHOD TRAVERSE-ELEMENTS-HELPER ...) ; compiling (DEFMETHOD TRAVERSE-ELEMENTS-HELPER ...) ; compiling (DEFMETHOD IN-CYCLE-P ...) ; compiling (DEFMETHOD IN-UNDIRECTED-CYCLE-P ...) ; compiling (DEFMETHOD ANY-UNDIRECTED-CYCLE-P ...) ; compiling (DEFUN REMOVE-LIST ...) ; compiling (DEFUN GET-NODELIST-RELATIVES ...) ; compiling (DEFUN GET-TRANSITIVE-CLOSURE ...) ; compiling (DEFMETHOD COMPLETE-LINKS ...) ; compiling (DEFGENERIC MAKE-FILTERED-GRAPH ...) ; compiling (DEFMETHOD MAKE-FILTERED-GRAPH ...) ; compiling (DEFMETHOD SUBGRAPH-CONTAINING ...) ; compiling (DEFMETHOD EDGE-COUNT ...) ; compiling (DEFMETHOD EDGE-COUNT ...) ; compiling (DEFMETHOD TOPOLOGICAL-SORT ...) ; compiling (DEFMETHOD ASSIGN-LEVEL ...) ; compiling (DEFMETHOD ASSIGN-LEVEL ...) ; compiling (DEFMETHOD DEPTH ...) ; compiling (DEFUN MAP-PATHS ...) ; compiling (DEFUN MAP-SHORTEST-PATHS ...) ; compiling (DEFUN APPEND-UNIQUE ...) ; /Users/gwking/darcs/cl-graph/dev/graph.fasl written ; compilation finished in 0:00:37 ; compiling file "/Users/gwking/darcs/cl-graph/dev/graph-container.lisp" (written 21 OCT 2005 03:54:54 PM): ; compiling (IN-PACKAGE METABANG.GRAPH) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFCLASS* GRAPH-CONTAINER ...) ; compiling (DEFCLASS* GRAPH-CONTAINER-EDGE ...) ; compiling (DEFMETHOD PRINT-OBJECT ...) ; compiling (DEFCLASS* WEIGHTED-EDGE ...) ; compiling (DEFCLASS* GRAPH-CONTAINER-VERTEX ...) ; compiling (DEFMETHOD MAKE-VERTEX-EDGES-CONTAINER ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD MAKE-VERTEX-CONTAINER ...) ; compiling (DEFMETHOD MAKE-EDGE-CONTAINER ...) ; compiling (DEFCLASS* GRAPH-CONTAINER-DIRECTED-EDGE ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD SOURCE-VERTEX ...) ; compiling (DEFMETHOD TARGET-VERTEX ...) ; compiling (DEFMETHOD OTHER-VERTEX ...) ; compiling (DEFMETHOD OTHER-VERTEX ...) ; compiling (DEFMETHOD ADD-EDGE ...) ; compiling (DEFMETHOD ADD-EDGE-TO-VERTEX ...) ; compiling (DEFMETHOD MAKE-NODE-FOR-CONTAINER ...) ; compiling (DEFMETHOD FIND-EDGE-BETWEEN-VERTEXES ...) ; compiling (DEFMETHOD FIND-EDGE-BETWEEN-VERTEXES-IF ...) ; compiling (DEFMETHOD FIND-EDGE-BETWEEN-VERTEXES-IF ...) ; compiling (DEFMETHOD FIND-EDGE ...) ; compiling (DEFMETHOD DELETE-EDGE ...) ; compiling (DEFMETHOD ITERATE-EDGES ...) ; compiling (DEFMETHOD ITERATE-EDGES ...) ; compiling (DEFMETHOD ITERATE-SOURCE-EDGES ...) ; compiling (DEFMETHOD ITERATE-TARGET-EDGES ...) ; compiling (DEFMETHOD ITERATE-CHILDREN ...) ; compiling (DEFMETHOD ITERATE-PARENTS ...) ; compiling (DEFMETHOD ITERATE-NEIGHBORS ...) ; compiling (DEFMETHOD VERTEXES ...) ; compiling (DEFMETHOD HAS-CHILDREN-P ...) ; compiling (DEFMETHOD HAS-PARENT-P ...) ; compiling (DEFMETHOD VERTICES-SHARE-EDGE-P ...) ; /Users/gwking/darcs/cl-graph/dev/graph-container.fasl written ; compilation finished in 0:00:12 ; compiling file "/Users/gwking/darcs/cl-graph/dev/graph-matrix.lisp" (written 21 OCT 2005 03:54:54 PM): ; compiling (IN-PACKAGE METABANG.GRAPH) ; compiling (DEFCLASS* GRAPH-MATRIX ...) ; compiling (DEFMETHOD INITIALIZE-INSTANCE ...) ; compiling (DEFMETHOD MAKE-VERTEX-CONTAINER ...) ; compiling (DEFMETHOD MAKE-EDGE-CONTAINER ...) ; compiling (DEFCLASS* GRAPH-MATRIX-EDGE ...) ; compiling (DEFCLASS* GRAPH-MATRIX-VERTEX ...) ; /Users/gwking/darcs/cl-graph/dev/graph-matrix.fasl written ; compilation finished in 0:00:01 ; compiling file "/Users/gwking/darcs/cl-graph/dev/graph-metrics.lisp" (written 21 OCT 2005 03:54:54 PM): ; compiling (IN-PACKAGE METABANG.GRAPH) ; compiling (EXPORT (QUOTE #)) ; compiling (DEFUN VERTEX-DEGREE-COUNTS ...) ; compiling (DEFUN AVERAGE-VERTEX-DEGREE ...) ; compiling (DEFUN VERTEX-DEGREE ...) ; compiling (DEFUN %VERTEX-DEGREE ...) ; compiling (DEFUN VERTEX-DEGREE-SUMMARY ...) ; compiling (DEFUN AVERAGE-VERTEX-CLUSTERING-COEFFICIENT ...) ; compiling (DEFUN VERTEX-CLUSTERING-COEFFICIENT ...) ; compiling (DEFUN VERTEX-TRIANGLE-COUNT ...) ; compiling (DEFUN ROW-SUMS ...) ; compiling (DEFUN COLUMN-SUMS ...) ; compiling (DEFGENERIC ASSORTATIVITY-COEFFICIENT ...) ; compiling (DEFMETHOD ASSORTATIVITY-COEFFICIENT ...) ; compiling (DEFMETHOD GRAPH-EDGE-MIXTURE-MATRIX ...) ; compiling (DEFMETHOD GRAPH-MIXING-MATRIX ...) ; compiling (DEFMETHOD UNIQUE-ELEMENTS ...) ; compiling (DEFMETHOD UNIQUE-ELEMENTS ...) ; compiling (DEFMETHOD UNIQUE-NODES ...) ; compiling (DEFMETHOD UNIQUE-NODES ...) ; compiling (DEFUN %UNIQUE-ELEMENTS ...) ; /Users/gwking/darcs/cl-graph/dev/graph-metrics.fasl written ; compilation finished in 0:00:06 ; compiling file "/Users/gwking/darcs/cl-graph/dev/graph-algorithms.lisp" (written 21 OCT 2005 03:54:54 PM): ; compiling (IN-PACKAGE METABANG.GRAPH) ; compiling (DEFSTRUCT (VERTEX-DATUM # ...) ...) ; compiling (DEFMETHOD INITIALIZE-VERTEX-DATA ...) ; compiling (DEFMETHOD BREADTH-FIRST-VISITOR ...) ; compiling (DEFMETHOD BREADTH-FIRST-VISITOR ...) ; compiling (DEFMETHOD BREADTH-FIRST-SEARCH-GRAPH ...) ; compiling (DEFMETHOD BREADTH-FIRST-SEARCH-GRAPH ...) ; compiling (DEFMETHOD CONNECTED-COMPONENTS ...) ; compiling (DEFMETHOD FIND-CONNECTED-COMPONENTS ...) ; compiling (DEFMETHOD MST-FIND-SET ...) ; compiling (DEFMETHOD MST-MAKE-SET ...) ; compiling (DEFMETHOD MST-TREE-UNION ...) ; compiling (DEFMETHOD MST-LINK ...) ; compiling (DEFMETHOD ADD-EDGES-TO-GRAPH ...) ; compiling (DEFMETHOD MAKE-GRAPH-FROM-VERTEXES ...) ; compiling (DEFMETHOD EDGE-LESSP-BY-WEIGHT ...) ; compiling (DEFMETHOD MINIMUM-SPANNING-TREE ...) ; compiling (DEFMETHOD CONNECTED-GRAPH-P ...) ; compiling (DEFPARAMETER *DEPTH-FIRST-SEARCH-TIMER* ...) ; compiling (DEFMETHOD EDGE-LESSP-BY-DIRECTION ...) ; compiling (DEFMETHOD OUT-EDGE-FOR-VERTEX-P ...) ; compiling (DEFMETHOD DFS ...) ; compiling (DEFMETHOD DFS ...) ; compiling (DEFMETHOD DFS-VISIT ...) ; compiling (DEFMETHOD DFS-TREE-EDGE-P ...) ; compiling (DEFMETHOD DFS-BACK-EDGE-P ...) ; compiling (DEFMETHOD DFS-FORWARD-EDGE-P ...) ; compiling (DEFMETHOD DFS-CROSS-EDGE-P ...) ; compiling (DEFMETHOD DFS-EDGE-TYPE ...) ; compiling (DEFMETHOD MAP-OVER-ALL-COMBINATIONS-OF-K-VERTEXES ...) ; compiling (DEFMETHOD MAP-OVER-ALL-COMBINATIONS-OF-K-EDGES ...) ; compiling (DEFMETHOD MAP-OVER-ALL-COMBINATIONS-OF-K-EDGES ...) ; /Users/gwking/darcs/cl-graph/dev/graph-algorithms.fasl written ; compilation finished in 0:00:11 ; compiling file "/Users/gwking/darcs/cl-graph/dev/graphviz-support.lisp" (written 09 NOV 2005 04:12:56 PM): ; ; caught STYLE-WARNING: ; Character decoding error in a #|-comment at position 633 reading source file #, resyncing. ; ; caught STYLE-WARNING: ; Character decoding error in a #|-comment at position 635 reading source file #, resyncing. ; compiling (IN-PACKAGE METABANG.GRAPH) ; compiling (DEFMETHOD GRAPH->DOT ...) ; compiling (DEFMETHOD GRAPH->DOT ...) ; compiling (DEFMETHOD GRAPH->DOT ...) ; compiling (DEFMETHOD GRAPH->DOT ...) ; compiling (DEFMETHOD GRAPH->DOT ...) ; compiling (DEFMETHOD GRAPH->DOT-PROPERTIES ...) ; compiling (DEFMETHOD VERTEX->DOT ...) ; compiling (DEFMETHOD EDGE->DOT ...) ; /Users/gwking/darcs/cl-graph/dev/graphviz-support.fasl written ; compilation finished in 0:00:04 WARNING: COMPILE-FILE warned while performing # on #. STYLE-WARNING: redefining MAKE-LOAD-FORM (BASIC-VERTEX) in DEFMETHOD STYLE-WARNING: redefining MAKE-LOAD-FORM (BASIC-EDGE) in DEFMETHOD STYLE-WARNING: redefining MAKE-LOAD-FORM (BASIC-GRAPH) in DEFMETHOD STYLE-WARNING: implicitly creating new generic function MAKE-VERTEX-FOR-GRAPH STYLE-WARNING: implicitly creating new generic function MAKE-EDGE-FOR-GRAPH STYLE-WARNING: redefining MAKE-EDGE-FOR-GRAPH in DEFGENERIC STYLE-WARNING: redefining ITERATE-CHILDREN in DEFGENERIC STYLE-WARNING: implicitly creating new generic function TAG-ALL-EDGES STYLE-WARNING: implicitly creating new generic function UNTAG-ALL-EDGES STYLE-WARNING: implicitly creating new generic function UNTAG-EDGES STYLE-WARNING: implicitly creating new generic function TAG-EDGES STYLE-WARNING: implicitly creating new generic function REPLACE-VERTEX STYLE-WARNING: implicitly creating new generic function ADD-EDGE-TO-VERTEX STYLE-WARNING: implicitly creating new generic function SOURCE-EDGES STYLE-WARNING: implicitly creating new generic function TARGET-EDGES STYLE-WARNING: implicitly creating new generic function CHILD-VERTEXES STYLE-WARNING: implicitly creating new generic function PARENT-VERTEXES STYLE-WARNING: implicitly creating new generic function NEIGHBOR-VERTEXES STYLE-WARNING: implicitly creating new generic function NUMBER-OF-NEIGHBORS STYLE-WARNING: implicitly creating new generic function IN-CYCLE-P STYLE-WARNING: redefining SEARCH-FOR-VERTEX (BASIC-GRAPH T) in DEFMETHOD STYLE-WARNING: implicitly creating new generic function ITERATE-VERTEXES STYLE-WARNING: implicitly creating new generic function EDGES STYLE-WARNING: implicitly creating new generic function VERTEX-COUNT STYLE-WARNING: implicitly creating new generic function VERTEXES STYLE-WARNING: implicitly creating new generic function SOURCE-EDGE-COUNT STYLE-WARNING: implicitly creating new generic function TARGET-EDGE-COUNT STYLE-WARNING: implicitly creating new generic function GRAPH-ROOTS STYLE-WARNING: implicitly creating new generic function ROOTP STYLE-WARNING: implicitly creating new generic function FIND-VERTEX-IF STYLE-WARNING: implicitly creating new generic function FIND-EDGE-IF STYLE-WARNING: implicitly creating new generic function FIND-EDGES-IF STYLE-WARNING: implicitly creating new generic function FIND-VERTEXES-IF STYLE-WARNING: implicitly creating new generic function FORCE-UNDIRECTED STYLE-WARNING: implicitly creating new generic function TRAVERSE-ELEMENTS STYLE-WARNING: implicitly creating new generic function TRAVERSE-ELEMENTS-HELPER STYLE-WARNING: implicitly creating new generic function ANY-UNDIRECTED-CYCLE-P STYLE-WARNING: implicitly creating new generic function COMPLETE-LINKS STYLE-WARNING: implicitly creating new generic function SUBGRAPH-CONTAINING STYLE-WARNING: implicitly creating new generic function EDGE-COUNT STYLE-WARNING: implicitly creating new generic function TOPOLOGICAL-SORT STYLE-WARNING: implicitly creating new generic function ASSIGN-LEVEL STYLE-WARNING: implicitly creating new generic function DEPTH STYLE-WARNING: implicitly creating new generic function MAKE-VERTEX-EDGES-CONTAINER STYLE-WARNING: implicitly creating new generic function OTHER-VERTEX STYLE-WARNING: implicitly creating new generic function FIND-EDGE-BETWEEN-VERTEXES-IF STYLE-WARNING: implicitly creating new generic function VERTICES-SHARE-EDGE-P STYLE-WARNING: implicitly creating new generic function GRAPH-EDGE-MIXTURE-MATRIX STYLE-WARNING: implicitly creating new generic function GRAPH-MIXING-MATRIX STYLE-WARNING: implicitly creating new generic function UNIQUE-ELEMENTS STYLE-WARNING: implicitly creating new generic function UNIQUE-NODES STYLE-WARNING: implicitly creating new generic function INITIALIZE-VERTEX-DATA STYLE-WARNING: implicitly creating new generic function BREADTH-FIRST-VISITOR STYLE-WARNING: implicitly creating new generic function BREADTH-FIRST-SEARCH-GRAPH STYLE-WARNING: implicitly creating new generic function CONNECTED-COMPONENTS STYLE-WARNING: implicitly creating new generic function FIND-CONNECTED-COMPONENTS STYLE-WARNING: implicitly creating new generic function MST-FIND-SET STYLE-WARNING: implicitly creating new generic function MST-MAKE-SET STYLE-WARNING: implicitly creating new generic function MST-TREE-UNION STYLE-WARNING: implicitly creating new generic function MST-LINK STYLE-WARNING: implicitly creating new generic function ADD-EDGES-TO-GRAPH STYLE-WARNING: implicitly creating new generic function MAKE-GRAPH-FROM-VERTEXES STYLE-WARNING: implicitly creating new generic function EDGE-LESSP-BY-WEIGHT STYLE-WARNING: implicitly creating new generic function MINIMUM-SPANNING-TREE STYLE-WARNING: implicitly creating new generic function CONNECTED-GRAPH-P STYLE-WARNING: implicitly creating new generic function EDGE-LESSP-BY-DIRECTION STYLE-WARNING: implicitly creating new generic function OUT-EDGE-FOR-VERTEX-P STYLE-WARNING: implicitly creating new generic function DFS STYLE-WARNING: implicitly creating new generic function DFS-VISIT STYLE-WARNING: implicitly creating new generic function DFS-TREE-EDGE-P STYLE-WARNING: implicitly creating new generic function DFS-BACK-EDGE-P STYLE-WARNING: implicitly creating new generic function DFS-FORWARD-EDGE-P STYLE-WARNING: implicitly creating new generic function DFS-CROSS-EDGE-P STYLE-WARNING: implicitly creating new generic function DFS-EDGE-TYPE STYLE-WARNING: implicitly creating new generic function MAP-OVER-ALL-COMBINATIONS-OF-K-VERTEXES STYLE-WARNING: implicitly creating new generic function MAP-OVER-ALL-COMBINATIONS-OF-K-EDGES STYLE-WARNING: implicitly creating new generic function GRAPH->DOT STYLE-WARNING: implicitly creating new generic function GRAPH->DOT-PROPERTIES STYLE-WARNING: implicitly creating new generic function VERTEX->DOT STYLE-WARNING: implicitly creating new generic function EDGE->DOT ; file: /Users/gwking/darcs/metatilities/dev/utilities/locks.lisp ; in: DEFUN METABANG.UTILITIES::FIND-LOCK ; (METABANG.UTILITIES::ALLOCATE-EKSL-LOCK :NAME METABANG.UTILITIES::LOCK-NAME) ; ; caught STYLE-WARNING: ; undefined function: METABANG.UTILITIES::ALLOCATE-EKSL-LOCK ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:LINEAR-REGRESSION-VERBOSE-SUMMARIES ; (DEFUN CL-MATHSTATS::LINEAR-REGRESSION-VERBOSE-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X CL-MATHSTATS::Y CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 CL-MATHSTATS::XY) ; "Calculates almost every statistic of a linear regression: the slope and ; intercept of the line, the standard error on each, the correlation coefficient, ; the coefficient of determination, also known as r-square, and an ANOVA table as ; described in the manual. ; ; If you don't need all this information, consider using the ``-brief'' or ; ``-minimal'' functions, which do less computation. ; ; This function differs from `linear-regression-verbose' in that it takes summary ; variables: `x' and `y' are the sums of the independent variable and dependent ; variables, respectively; `x2' and `y2' are the sums of the squares of the ; independent variable and dependent variables, respectively; and `xy' is the sum ; of the products of the independent and dependent variables. ; ; You should first look at your data with a scatter plot to see if a linear model ; is plausible. See the manual for a fuller explanation of linear regression ; statistics." ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::CORRELATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::STD-ERR-INTERCEPT ; CL-MATHSTATS::ANOVA-TABLE)) ; (LET ((CL-MATHSTATS::NSSX (- # #)) ; (CL-MATHSTATS::NSSY (- # #)) ; (CL-MATHSTATS::NSSXY (- # #))) ; (WHEN (OR (ZEROP CL-MATHSTATS::NSSX) (ZEROP CL-MATHSTATS::NSSY)) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* ((CL-MATHSTATS::SLOPE #) ; (CL-MATHSTATS::INTERCEPT #) ; (CL-MATHSTATS::NSSR #) ; (CL-MATHSTATS::NSSE #) ; (CL-MATHSTATS::DETERMINATION #) ; (CL-MATHSTATS::CORRELATION #) ; (CL-MATHSTATS::DOF #) ; (CL-MATHSTATS::STD-ERR-SLOPE #) ; (CL-MATHSTATS::STD-ERR-INTERCEPT NIL) ; (CL-MATHSTATS::F #) ; (CL-MATHSTATS::P-VALUE #) ; (CL-MATHSTATS::SSR #) ; ...) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::CORRELATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::STD-ERR-INTERCEPT ; CL-MATHSTATS::ANOVA-TABLE)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G247 'CL-MATHSTATS::ANOVA-TABLE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::ANOVA-TABLE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G247 'CL-MATHSTATS::ANOVA-TABLE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::ANOVA-TABLE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::LINEAR-REGRESSION-VERBOSE-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X ; CL-MATHSTATS::Y ; CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 ; CL-MATHSTATS::XY) ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::CORRELATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::STD-ERR-INTERCEPT ; CL-MATHSTATS::ANOVA-TABLE)) ; (BLOCK ; CL-MATHSTATS::LINEAR-REGRESSION-VERBOSE-SUMMARIES ; (LET ((CL-MATHSTATS::NSSX #) ; (CL-MATHSTATS::NSSY #) ; (CL-MATHSTATS::NSSXY #)) ; (WHEN (OR # #) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # # # # # # # # # # # ...) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::CORRELATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::STD-ERR-INTERCEPT ; CL-MATHSTATS::ANOVA-TABLE))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::ANOVA-TABLE ; ; caught STYLE-WARNING: ; 1 more use of undefined type CL-MATHSTATS::ANOVA-TABLE ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G573 'CL-MATHSTATS::BETAS) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::BETAS ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G573 'CL-MATHSTATS::BETAS) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::BETAS ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::BETAS ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::BETAS ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::CHI-SQUARE-RXC-COUNTS ; (DEFUN CL-MATHSTATS::CHI-SQUARE-RXC-COUNTS (CL-MATHSTATS::CONTINGENCY-TABLE) ; "Calculates the chi-square statistic and corresponding p-value for the given ; contingency table. The result says whether the row factor is independent of the ; column factor. Does not apply Yate's correction." ; (DECLARE (VALUES CL-MATHSTATS::CHI-SQUARE CL-MATHSTATS::P-VALUE)) ; (CHECK-TYPE CL-MATHSTATS::CONTINGENCY-TABLE (ARRAY * 2)) ; (DESTRUCTURING-BIND ; (CL-MATHSTATS::ROWS CL-MATHSTATS::COLS) ; (ARRAY-DIMENSIONS CL-MATHSTATS::CONTINGENCY-TABLE) ; (MACROLET ((CL-MATHSTATS::ROW-SUM # ; `#) ; (CL-MATHSTATS::COL-SUM # ; `#)) ; (LET (# #) ; (DOTIMES # #) ; (VALUES CL-MATHSTATS::CHI-2 #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G2352 'CL-MATHSTATS::CHI-SQUARE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::CHI-SQUARE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CHI-SQUARE-RXC-COUNTS ; (CL-MATHSTATS::CONTINGENCY-TABLE) ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::P-VALUE)) ; (BLOCK CL-MATHSTATS::CHI-SQUARE-RXC-COUNTS ; (CHECK-TYPE CL-MATHSTATS::CONTINGENCY-TABLE ; (ARRAY * 2)) ; (DESTRUCTURING-BIND ; (CL-MATHSTATS::ROWS CL-MATHSTATS::COLS) ; (ARRAY-DIMENSIONS ; CL-MATHSTATS::CONTINGENCY-TABLE) ; (MACROLET (# #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::CHI-SQUARE ; in: DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 ; (DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Performs a chi-square test for independence of the two variables, `v1' and ; `v2.' These should be categorial variables with only two values; the function ; will construct a 2x2 contingency table by counting the number of occurrences of ; each combination of the variables. See the manual for more details." ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '(2 2) (ARRAY-DIMENSIONS CL-MATHSTATS::2X2-TABLE)) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET ((CL-MATHSTATS::A #) ; (CL-MATHSTATS::B #) ; (CL-MATHSTATS::C #) ; (CL-MATHSTATS::D #)) ; (MULTIPLE-VALUE-CALL #'VALUES ; (CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS CL-MATHSTATS::A ; CL-MATHSTATS::B ; CL-MATHSTATS::C ; CL-MATHSTATS::D) ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CHI-SQUARE-2X2 ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (BLOCK CL-MATHSTATS::CHI-SQUARE-2X2 ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '# #) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET (# # # #) ; (MULTIPLE-VALUE-CALL #'VALUES ; # ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::CHI-SQUARE ; ; caught STYLE-WARNING: ; 4 more uses of undefined type CL-MATHSTATS::CHI-SQUARE ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS ; (DEFUN CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS ; (CL-MATHSTATS::A CL-MATHSTATS::B CL-MATHSTATS::C CL-MATHSTATS::D ; &OPTIONAL (CL-MATHSTATS::YATES T)) ; "Runs a chi-square test for association on a simple 2 x 2 table. If `yates' ; is nil, the correction for continuity is not done; default is t. ; ; Returns the chi-square statistic and the significance of the value." ; (DECLARE (VALUES CL-MATHSTATS::CHI2 CL-MATHSTATS::P-VALUE)) ; (CHECK-TYPE CL-MATHSTATS::A INTEGER) ; (CHECK-TYPE CL-MATHSTATS::B INTEGER) ; (CHECK-TYPE CL-MATHSTATS::C INTEGER) ; (CHECK-TYPE CL-MATHSTATS::D INTEGER) ; (LET ((CL-MATHSTATS::N ; (+ CL-MATHSTATS::A CL-MATHSTATS::B CL-MATHSTATS::C CL-MATHSTATS::D)) ; (CL-MATHSTATS::DENOM (* # # # #)) ; (CL-MATHSTATS::NUMER (- # #))) ; (WHEN CL-MATHSTATS::YATES (SETF CL-MATHSTATS::NUMER (- # #))) ; (SETF CL-MATHSTATS::NUMER ; (* CL-MATHSTATS::N (CL-MATHSTATS:SQUARE CL-MATHSTATS::NUMER))) ; (LET* ((CL-MATHSTATS::CHI2 #) (CL-MATHSTATS::P-VALUE #)) ; (VALUES CL-MATHSTATS::CHI2 CL-MATHSTATS::P-VALUE)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G2279 'CL-MATHSTATS::CHI2) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::CHI2 ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G2279 'CL-MATHSTATS::CHI2) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::CHI2 ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS ; (CL-MATHSTATS::A CL-MATHSTATS::B ; CL-MATHSTATS::C ; CL-MATHSTATS::D ; &OPTIONAL ; (CL-MATHSTATS::YATES T)) ; (DECLARE ; (VALUES CL-MATHSTATS::CHI2 CL-MATHSTATS::P-VALUE)) ; (BLOCK CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS ; (CHECK-TYPE CL-MATHSTATS::A INTEGER) ; (CHECK-TYPE CL-MATHSTATS::B INTEGER) ; (CHECK-TYPE CL-MATHSTATS::C INTEGER) ; (CHECK-TYPE CL-MATHSTATS::D INTEGER) ; (LET ((CL-MATHSTATS::N #) ; (CL-MATHSTATS::DENOM #) ; (CL-MATHSTATS::NUMER #)) ; (WHEN CL-MATHSTATS::YATES ; (SETF CL-MATHSTATS::NUMER #)) ; (SETF CL-MATHSTATS::NUMER (* CL-MATHSTATS::N #)) ; (LET* (# #) ; (VALUES CL-MATHSTATS::CHI2 ; CL-MATHSTATS::P-VALUE))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::CHI2 ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::CHI2 ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G570 'CL-MATHSTATS::COEFFICIENTS) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::COEFFICIENTS ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G570 'CL-MATHSTATS::COEFFICIENTS) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::COEFFICIENTS ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::COEFFICIENTS ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::COEFFICIENTS ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G582 'CL-MATHSTATS::COMPATIBILITY-VALUE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::COMPATIBILITY-VALUE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G582 'CL-MATHSTATS::COMPATIBILITY-VALUE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::COMPATIBILITY-VALUE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::COMPATIBILITY-VALUE ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::COMPATIBILITY-VALUE ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::CHI-SQUARE-RXC ; (DEFUN CL-MATHSTATS::CHI-SQUARE-RXC (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Performs a chi-square test for independence of the two variables, `v1' and ; `v2.' These should be categorial variables; the function will construct a ; contingency table by counting the number of occurrences of each combination of ; the variables. See the manual for more details." ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTIGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (CHECK-TYPE CL-MATHSTATS::V1 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::V2 SEQUENCE) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::TABLE CL-MATHSTATS::V1-VALUES CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (MULTIPLE-VALUE-CALL #'VALUES ; (CL-MATHSTATS::CHI-SQUARE-RXC-COUNTS CL-MATHSTATS::TABLE) ; (CL-MATHSTATS::G-TEST CL-MATHSTATS::TABLE NIL NIL) ; CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CHI-SQUARE-RXC ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTIGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (BLOCK CL-MATHSTATS::CHI-SQUARE-RXC ; (CHECK-TYPE CL-MATHSTATS::V1 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::V2 SEQUENCE) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (MULTIPLE-VALUE-CALL #'VALUES ; (CL-MATHSTATS::CHI-SQUARE-RXC-COUNTS ; CL-MATHSTATS::TABLE) ; (CL-MATHSTATS::G-TEST CL-MATHSTATS::TABLE ; NIL ; NIL) ; CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::CONTIGENCY-TABLE ; in: DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 ; (DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Performs a chi-square test for independence of the two variables, `v1' and ; `v2.' These should be categorial variables with only two values; the function ; will construct a 2x2 contingency table by counting the number of occurrences of ; each combination of the variables. See the manual for more details." ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '(2 2) (ARRAY-DIMENSIONS CL-MATHSTATS::2X2-TABLE)) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET ((CL-MATHSTATS::A #) ; (CL-MATHSTATS::B #) ; (CL-MATHSTATS::C #) ; (CL-MATHSTATS::D #)) ; (MULTIPLE-VALUE-CALL #'VALUES ; (CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS CL-MATHSTATS::A ; CL-MATHSTATS::B ; CL-MATHSTATS::C ; CL-MATHSTATS::D) ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CHI-SQUARE-2X2 ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (BLOCK CL-MATHSTATS::CHI-SQUARE-2X2 ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '# #) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET (# # # #) ; (MULTIPLE-VALUE-CALL #'VALUES ; # ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::CONTINGENCY-TABLE ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:D-TEST ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::D-TEST ; (CL-MATHSTATS::SIGNIFICANCE) ; ((COUNT) (CL-MATHSTATS::TIMES)) ; (CL-MATHSTATS::STATISTIC CL-MATHSTATS::LEVEL ; COUNT ; CL-MATHSTATS::TIMES) ; ((CL-MATHSTATS::SAMPLE-1 'SEQUENCE) ; (CL-MATHSTATS::SAMPLE-2 'SEQUENCE)) ; (CL-MATHSTATS::SAMPLE-1 ; CL-MATHSTATS::SAMPLE-2 ; CL-MATHSTATS::TAILS ; &KEY ; (CL-MATHSTATS::TIMES 1000) ; (CL-MATHSTATS::H0MEAN 0)) ; "Two-sample test for difference in means. Competes with the unmatched, ; two-sample t-test. Each sample should be a sequence of numbers. We calculate ; the mean of `sample-1' minus the mean of `sample-2'; call that D. Under the null ; hypothesis, D is zero. There are three possible alternative hypotheses: D is ; positive, D is negative, and D is either, and they are selected by the `tails' ; parameter, which must be :positive, :negative, or :both, respectively. We count ; the number of chance occurrences of D in the desired rejection region, and ; return the estimated probability." ; (DECLARE ; (VALUES CL-MATHSTATS::D ; CL-MATHSTATS::SIGNIFICANCE ; COUNT)) ; (CHECK-TYPE CL-MATHSTATS::SAMPLE-1 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::SAMPLE-2 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::TAILS ; (MEMBER :BOTH ; :POSITIVE ; :NEGATIVE)) ; ...) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1614 'COUNT) ; ; caught STYLE-WARNING: ; undefined type: COUNT ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1614 'COUNT) ; ; caught STYLE-WARNING: ; undefined type: COUNT ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::D-TEST-INTERNAL ; (CL-MATHSTATS::SAMPLE-1 CL-MATHSTATS::SAMPLE-2 ; CL-MATHSTATS::TAILS ; &KEY ; (CL-MATHSTATS::TIMES 1000) ; (CL-MATHSTATS::H0MEAN 0)) ; (DECLARE ; (VALUES CL-MATHSTATS::D ; CL-MATHSTATS::SIGNIFICANCE ; COUNT)) ; (BLOCK CL-MATHSTATS::D-TEST-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::SAMPLE-1 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::SAMPLE-2 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::TAILS ; (MEMBER :BOTH :POSITIVE :NEGATIVE)) ; (LET ((CL-MATHSTATS::N1 #) (CL-MATHSTATS::N2 #)) ; (WHEN (OR # #) (ERROR 'CL-MATHSTATS::NO-DATA)) ; (WHEN (OR # #) ; (ERROR 'CL-MATHSTATS::INSUFFICIENT-DATA)) ; (LET* (# #) ; (IF # # #))))) ; ; caught STYLE-WARNING: ; undefined type: COUNT ; ; caught STYLE-WARNING: ; 1 more use of undefined type COUNT ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:D-TEST ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::D-TEST ; (CL-MATHSTATS::SIGNIFICANCE) ; ((COUNT) (CL-MATHSTATS::TIMES)) ; (CL-MATHSTATS::STATISTIC CL-MATHSTATS::LEVEL ; COUNT ; CL-MATHSTATS::TIMES) ; ((CL-MATHSTATS::SAMPLE-1 'SEQUENCE) ; (CL-MATHSTATS::SAMPLE-2 'SEQUENCE)) ; (CL-MATHSTATS::SAMPLE-1 ; CL-MATHSTATS::SAMPLE-2 ; CL-MATHSTATS::TAILS ; &KEY ; (CL-MATHSTATS::TIMES 1000) ; (CL-MATHSTATS::H0MEAN 0)) ; "Two-sample test for difference in means. Competes with the unmatched, ; two-sample t-test. Each sample should be a sequence of numbers. We calculate ; the mean of `sample-1' minus the mean of `sample-2'; call that D. Under the null ; hypothesis, D is zero. There are three possible alternative hypotheses: D is ; positive, D is negative, and D is either, and they are selected by the `tails' ; parameter, which must be :positive, :negative, or :both, respectively. We count ; the number of chance occurrences of D in the desired rejection region, and ; return the estimated probability." ; (DECLARE ; (VALUES CL-MATHSTATS::D ; CL-MATHSTATS::SIGNIFICANCE ; COUNT)) ; (CHECK-TYPE CL-MATHSTATS::SAMPLE-1 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::SAMPLE-2 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::TAILS ; (MEMBER :BOTH ; :POSITIVE ; :NEGATIVE)) ; ...) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1612 'CL-MATHSTATS::D) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::D ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1612 'CL-MATHSTATS::D) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::D ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::D-TEST-INTERNAL ; (CL-MATHSTATS::SAMPLE-1 CL-MATHSTATS::SAMPLE-2 ; CL-MATHSTATS::TAILS ; &KEY ; (CL-MATHSTATS::TIMES 1000) ; (CL-MATHSTATS::H0MEAN 0)) ; (DECLARE ; (VALUES CL-MATHSTATS::D ; CL-MATHSTATS::SIGNIFICANCE ; COUNT)) ; (BLOCK CL-MATHSTATS::D-TEST-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::SAMPLE-1 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::SAMPLE-2 SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::TAILS ; (MEMBER :BOTH :POSITIVE :NEGATIVE)) ; (LET ((CL-MATHSTATS::N1 #) (CL-MATHSTATS::N2 #)) ; (WHEN (OR # #) (ERROR 'CL-MATHSTATS::NO-DATA)) ; (WHEN (OR # #) ; (ERROR 'CL-MATHSTATS::INSUFFICIENT-DATA)) ; (LET* (# #) ; (IF # # #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::D ; ; caught STYLE-WARNING: ; 1 more use of undefined type CL-MATHSTATS::D ; file: /Users/gwking/darcs/metatilities/dev/utilities/locks.lisp ; in: DEFGENERIC METABANG.UTILITIES::DESTROY-LOCK ; (METABANG.UTILITIES:DEALLOCATE METABANG.UTILITIES::LOCK) ; ; caught STYLE-WARNING: ; undefined function: METABANG.UTILITIES:DEALLOCATE ; file: /Users/gwking/darcs/metatilities/dev/utilities/spy.lisp ; in: DEFUN METABANG.UTILITIES::SPY-PARSE-ARGLIST ; (METABANG.UTILITIES::DEBUGGING-P-FN DEBUG) ; ; caught STYLE-WARNING: ; undefined function: METABANG.UTILITIES::DEBUGGING-P-FN ; file: /Users/gwking/darcs/metatilities/dev/utilities/locks.lisp ; in: DEFUN METABANG.UTILITIES::FLUSH-LOCKS-AND-TAKE-NAMES ; (METABANG.UTILITIES:DESTROY-THREAD METABANG.UTILITIES::P) ; ; caught STYLE-WARNING: ; undefined function: METABANG.UTILITIES:DESTROY-THREAD ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:LINEAR-REGRESSION-BRIEF-SUMMARIES ; (DEFUN CL-MATHSTATS::LINEAR-REGRESSION-BRIEF-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X CL-MATHSTATS::Y CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 CL-MATHSTATS::XY) ; "Calculates the main statistics of a linear regression: the slope and ; intercept of the line, the coefficient of determination, also known as r-square, ; the standard error of the slope, and the p-value for the regression. This ; function differs from `linear-regression-brief' in that it takes summary ; variables: `x' and `y' are the sums of the independent variable and dependent ; variables, respectively; `x2' and `y2' are the sums of the squares of the ; independent variable and dependent variables, respectively; and `xy' is the sum ; of the products of the independent and dependent variables. ; ; You should first look at your data with a scatter plot to see if a linear model ; is plausible. See the manual for a fuller explanation of linear regression ; statistics." ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::P-VALUE)) ; (LET ((CL-MATHSTATS::NSSX (- # #)) ; (CL-MATHSTATS::NSSY (- # #)) ; (CL-MATHSTATS::NSSXY (- # #))) ; (WHEN (OR (ZEROP CL-MATHSTATS::NSSX) (ZEROP CL-MATHSTATS::NSSY)) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* ((CL-MATHSTATS::SLOPE #) ; (CL-MATHSTATS::INTERCEPT #) ; (CL-MATHSTATS::NSSR #) ; (CL-MATHSTATS::NSSE #) ; (CL-MATHSTATS::DETERMINATION #) ; (CL-MATHSTATS::DOF #) ; (CL-MATHSTATS::STD-ERR-SLOPE #) ; (CL-MATHSTATS::P-VALUE #)) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::P-VALUE)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G210 'CL-MATHSTATS::DETERMINATION) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::DETERMINATION ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G210 'CL-MATHSTATS::DETERMINATION) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::DETERMINATION ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::LINEAR-REGRESSION-BRIEF-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X ; CL-MATHSTATS::Y ; CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 ; CL-MATHSTATS::XY) ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::P-VALUE)) ; (BLOCK CL-MATHSTATS::LINEAR-REGRESSION-BRIEF-SUMMARIES ; (LET ((CL-MATHSTATS::NSSX #) ; (CL-MATHSTATS::NSSY #) ; (CL-MATHSTATS::NSSXY #)) ; (WHEN (OR # #) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # # # # # # #) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::P-VALUE))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::DETERMINATION ; ; caught STYLE-WARNING: ; 7 more uses of undefined type CL-MATHSTATS::DETERMINATION ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:T-TEST-ONE-SAMPLE ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::T-TEST-ONE-SAMPLE ; (CL-MATHSTATS::T-SIGNIFICANCE) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Returns the t-statistic for the mean of the data, which should be a sequence ; of numbers. Let D be the sample mean. The null hypothesis is that D equals the ; `H0-mean.' The alternative hypothesis is specified by `tails': `:both' means D ; /= H0-mean, `:positive' means D > H0-mean, and `:negative' means D < H0-mean. ; ; The function also returns the significance, the standard error, and the degrees ; of freedom. Signals `zero-variance' if that condition occurs. Signals ; `insufficient-data' unless there are at least two elements in the sample." ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::SAMPLE-ERROR ; CL-MATHSTATS::DOF)) ; (LET ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET ((CL-MATHSTATS::D #) ; (CL-MATHSTATS::V #)) ; (WHEN (ZEROP CL-MATHSTATS::V) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # #) ; (VALUES CL-MATHSTATS::TT ; CL-MATHSTATS::SIG ; CL-MATHSTATS::SE ; #))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1388 'CL-MATHSTATS::DOF) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::DOF ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1388 'CL-MATHSTATS::DOF) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::DOF ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::T-TEST-ONE-SAMPLE-INTERNAL ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::SAMPLE-ERROR ; CL-MATHSTATS::DOF)) ; (BLOCK CL-MATHSTATS::T-TEST-ONE-SAMPLE-INTERNAL ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET (# #) ; (WHEN # #) ; (LET* # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::DOF ; ; caught STYLE-WARNING: ; 12 more uses of undefined type CL-MATHSTATS::DOF ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:MODE ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::MODE ; NIL ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Returns the most frequent element of `data,' which should be a sequence. The ; algorithm involves sorting, and so the data must be numbers or the `key' ; function must produce numbers. Consider `sxhash' if no better function is ; available. Also returns the number of occurrences of the mode. If there is ; more than one mode, this returns the first mode, as determined by the sorting of ; the numbers." ; (DECLARE ; (VALUES METABANG.UTILITIES:ELEMENT ; CL-MATHSTATS::NUMBER-OF-OCCURRENCES)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (LET* ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::START2 ; (OR CL-MATHSTATS::START 0)) ; (CL-MATHSTATS::END2 ; (OR CL-MATHSTATS::END #))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR ; (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF (NULL CL-MATHSTATS::KEY) ; (SORT CL-MATHSTATS::TEMP #'<) ; (SORT CL-MATHSTATS::TEMP ; #'< ; :KEY ; CL-MATHSTATS::KEY)) ; (LET* (# # # # #) ; (IF # # #) ; (WHEN # #) ; (VALUES CL-MATHSTATS::BIGGEST-GROUP ; CL-MATHSTATS::BIGGEST-GROUP-SIZE))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G869 'METABANG.UTILITIES:ELEMENT) ; ; caught STYLE-WARNING: ; undefined type: METABANG.UTILITIES:ELEMENT ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G869 'METABANG.UTILITIES:ELEMENT) ; ; caught STYLE-WARNING: ; undefined type: METABANG.UTILITIES:ELEMENT ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MODE-INTERNAL ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (VALUES METABANG.UTILITIES:ELEMENT ; CL-MATHSTATS::NUMBER-OF-OCCURRENCES)) ; (BLOCK CL-MATHSTATS::MODE-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (LET* ((CL-MATHSTATS::N #) ; (CL-MATHSTATS::START2 #) ; (CL-MATHSTATS::END2 #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR ; (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF # # #) ; (LET* # ; # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: METABANG.UTILITIES:ELEMENT ; ; caught STYLE-WARNING: ; 1 more use of undefined type METABANG.UTILITIES:ELEMENT ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G575 'CL-MATHSTATS::F) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::F ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G575 'CL-MATHSTATS::F) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::F ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::F ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::F ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:TUKEY-SUMMARY ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::TUKEY-SUMMARY ; NIL ; ((CL-MATHSTATS::MINIMUM) ; (CL-MATHSTATS::FIRST-QUARTILE) ; (CL-MATHSTATS::MEDIAN) ; (CL-MATHSTATS::THIRD-QUARTILE) ; (CL-MATHSTATS::MAXIMUM)) ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Computes a Tukey five-number summary of the data. That is, it returns, in ; increasing order, the extremes and the quartiles: the minimum, the 1/4 quartile, ; the median, the 3/4 quartile, and the maximum." ; (DECLARE ; (VALUES CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::FIRST-QUARTILE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::THIRD-QUARTILE ; CL-MATHSTATS::MAXIMUM)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (LET* ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::START2 ; (OR CL-MATHSTATS::START 0)) ; (CL-MATHSTATS::END2 ; (OR CL-MATHSTATS::END #))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR ; (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF (NULL CL-MATHSTATS::KEY) ; (SORT CL-MATHSTATS::TEMP #'<) ; (SORT CL-MATHSTATS::TEMP ; #'< ; :KEY ; CL-MATHSTATS::KEY)) ; (FLET (#) ; (VALUES # # # # #))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1218 'CL-MATHSTATS::FIRST-QUARTILE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::FIRST-QUARTILE ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1218 'CL-MATHSTATS::FIRST-QUARTILE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::FIRST-QUARTILE ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::TUKEY-SUMMARY-INTERNAL ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (VALUES CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::FIRST-QUARTILE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::THIRD-QUARTILE ; CL-MATHSTATS::MAXIMUM)) ; (BLOCK CL-MATHSTATS::TUKEY-SUMMARY-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (LET* ((CL-MATHSTATS::N #) ; (CL-MATHSTATS::START2 #) ; (CL-MATHSTATS::END2 #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR ; (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF # # #) ; (FLET # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::FIRST-QUARTILE ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::FIRST-QUARTILE ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::G-TEST ; (FLET ((CL-MATHSTATS::DOIT ; (CL-MATHSTATS::CONTINGENCY-TABLE ; &OPTIONAL CL-MATHSTATS::EXPECTED-VALUE-MATRIX) ; (DECLARE ; (VALUES CL-MATHSTATS::G-SCORE ; CL-MATHSTATS::G-SIGNIFICANCE ; CL-MATHSTATS::DOF)) ; (DESTRUCTURING-BIND ; (CL-MATHSTATS::ROWS CL-MATHSTATS::COLUMNS) ; (ARRAY-DIMENSIONS CL-MATHSTATS::CONTINGENCY-TABLE) ; (LET # ; # ; # ; # ; #)))) ; (IF CL-MATHSTATS::ERROR-P ; (CL-MATHSTATS::DOIT CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::EXPECTED-VALUE-MATRIX) ; (CATCH 'CL-MATHSTATS::RECOVER ; (HANDLER-BIND (# #) ; (CL-MATHSTATS::DOIT CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::EXPECTED-VALUE-MATRIX))))) ; --> THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND IF NOT ; --> IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G2520 'CL-MATHSTATS::G-SCORE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::G-SCORE ; --> THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND IF NOT ; --> IF ; ==> ; (TYPEP #:G2520 'CL-MATHSTATS::G-SCORE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::G-SCORE ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::G-SCORE ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::G-SCORE ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::G-TEST ; (FLET ((CL-MATHSTATS::DOIT ; (CL-MATHSTATS::CONTINGENCY-TABLE ; &OPTIONAL CL-MATHSTATS::EXPECTED-VALUE-MATRIX) ; (DECLARE ; (VALUES CL-MATHSTATS::G-SCORE ; CL-MATHSTATS::G-SIGNIFICANCE ; CL-MATHSTATS::DOF)) ; (DESTRUCTURING-BIND ; (CL-MATHSTATS::ROWS CL-MATHSTATS::COLUMNS) ; (ARRAY-DIMENSIONS CL-MATHSTATS::CONTINGENCY-TABLE) ; (LET # ; # ; # ; # ; #)))) ; (IF CL-MATHSTATS::ERROR-P ; (CL-MATHSTATS::DOIT CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::EXPECTED-VALUE-MATRIX) ; (CATCH 'CL-MATHSTATS::RECOVER ; (HANDLER-BIND (# #) ; (CL-MATHSTATS::DOIT CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::EXPECTED-VALUE-MATRIX))))) ; --> THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND IF NOT ; --> IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G2521 'CL-MATHSTATS::G-SIGNIFICANCE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::G-SIGNIFICANCE ; --> THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND IF NOT ; --> IF ; ==> ; (TYPEP #:G2521 'CL-MATHSTATS::G-SIGNIFICANCE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::G-SIGNIFICANCE ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::G-SIGNIFICANCE ; ; caught STYLE-WARNING: ; 1 more use of undefined type CL-MATHSTATS::G-SIGNIFICANCE ; file: /Users/gwking/darcs/cl-graph/dev/graph.lisp ; in: ; DEFMETHOD CL-GRAPH:IN-CYCLE-P (CL-GRAPH:BASIC-GRAPH CL-GRAPH:BASIC-VERTEX) ; (CL-GRAPH::GRAPH-SEARCH (LIST CL-GRAPH::START-VERTEX) ; (LAMBDA (CL-GRAPH::V) ; (IF CL-GRAPH::FIRST-TIME? ; (METABANG.UTILITIES:NILF CL-GRAPH::FIRST-TIME?) ; (EQ ; (CL-GRAPH:FIND-VERTEX CL-GRAPH::GRAPH ; CL-GRAPH::V) ; CL-GRAPH::START-VERTEX))) ; (LAMBDA (CL-GRAPH::V) ; (CL-GRAPH:CHILD-VERTEXES CL-GRAPH::V)) ; #'APPEND ; :NEW-STATE-FN ; (LAMBDA ; (CL-GRAPH::STATES CL-GRAPH::SUCCESSORS ; CL-GRAPH::STATE= CL-GRAPH::OLD-STATES) ; (REMOVE-IF #'(LAMBDA (CL-GRAPH::STATE) (AND # #)) ; (FUNCALL CL-GRAPH::SUCCESSORS ; (FIRST CL-GRAPH::STATES))))) ; ; caught STYLE-WARNING: ; undefined function: CL-GRAPH::GRAPH-SEARCH ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:LINEAR-REGRESSION-MINIMAL-SUMMARIES ; (DEFUN CL-MATHSTATS::LINEAR-REGRESSION-MINIMAL-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X CL-MATHSTATS::Y CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 CL-MATHSTATS::XY) ; "Calculates the slope and intercept of the regression line. This function ; differs from `linear-regression-minimal' in that it takes summary statistics: ; `x' and `y' are the sums of the independent variable and dependent variables, ; respectively; `x2' and `y2' are the sums of the squares of the independent ; variable and dependent variables, respectively; and `xy' is the sum of the ; products of the independent and dependent variables. ; ; You should first look at your data with a scatter plot to see if a linear model ; is plausible. See the manual for a fuller explanation of linear regression ; statistics." ; (DECLARE (VALUES CL-MATHSTATS::SLOPE CL-MATHSTATS::INTERCEPT) ; (IGNORE CL-MATHSTATS::Y2)) ; (LET ((CL-MATHSTATS::NSSX (- # #)) (CL-MATHSTATS::NSSXY (- # #))) ; (WHEN (ZEROP CL-MATHSTATS::NSSX) (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* ((CL-MATHSTATS::SLOPE #) (CL-MATHSTATS::INTERCEPT #)) ; (VALUES CL-MATHSTATS::SLOPE CL-MATHSTATS::INTERCEPT)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G181 'CL-MATHSTATS::INTERCEPT) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::INTERCEPT ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G181 'CL-MATHSTATS::INTERCEPT) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::INTERCEPT ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::LINEAR-REGRESSION-MINIMAL-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X ; CL-MATHSTATS::Y ; CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 ; CL-MATHSTATS::XY) ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE CL-MATHSTATS::INTERCEPT) ; (IGNORE CL-MATHSTATS::Y2)) ; (BLOCK ; CL-MATHSTATS::LINEAR-REGRESSION-MINIMAL-SUMMARIES ; (LET ((CL-MATHSTATS::NSSX #) (CL-MATHSTATS::NSSXY #)) ; (WHEN (ZEROP CL-MATHSTATS::NSSX) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# #) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::INTERCEPT ; ; caught STYLE-WARNING: ; 16 more uses of undefined type CL-MATHSTATS::INTERCEPT ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:STATISTICAL-SUMMARY ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::STATISTICAL-SUMMARY ; (CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::MAXIMUM ; CL-MATHSTATS::RANGE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::MODE ; CL-MATHSTATS::MEAN ; CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::STANDARD-DEVIATION ; CL-MATHSTATS::INTERQUARTILE-RANGE ; CL-MATHSTATS::SKEWNESS) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Compute the length, minimum, maximum, range, median, mode, mean, variance, ; standard deviation, and interquartile-range of `sequence' from `start' to `end', ; accessed by `key'." ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END) ; (VALUES LENGTH ; CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::MAXIMUM ; CL-MATHSTATS::RANGE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::MODE ; CL-MATHSTATS::MEAN ; CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::STANDARD-DEVIATION ; CL-MATHSTATS::INTERQUARTILE-RANGE)) ; (LET* ((LENGTH ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::MINIMUM ; (APPLY #'CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::MAXIMUM ; (APPLY #'CL-MATHSTATS::MAXIMUM ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::RANGE (IF # # #)) ; (CL-MATHSTATS::MEDIAN ; (APPLY #'CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::MODE ; (APPLY #'CL-MATHSTATS::SMART-MODE ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::MEAN ; (APPLY #'CL-MATHSTATS::MEAN ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::VARIANCE ; (APPLY #'CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::SD ; (SQRT CL-MATHSTATS::VARIANCE)) ; (CL-MATHSTATS::IQR ; (APPLY ; #'CL-MATHSTATS::INTERQUARTILE-RANGE ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::SKEWNESS ; (APPLY #'CL-MATHSTATS::SKEWNESS ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS))) ; (VALUES LENGTH ; CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::MAXIMUM ; CL-MATHSTATS::RANGE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::MODE ; CL-MATHSTATS::MEAN ; CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::SD ; CL-MATHSTATS::IQR ; CL-MATHSTATS::SKEWNESS))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1285 'LENGTH) ; ; caught STYLE-WARNING: ; undefined type: LENGTH ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1285 'LENGTH) ; ; caught STYLE-WARNING: ; undefined type: LENGTH ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::STATISTICAL-SUMMARY-INTERNAL ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START CL-MATHSTATS::END) ; (VALUES LENGTH ; CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::MAXIMUM ; CL-MATHSTATS::RANGE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::MODE ; CL-MATHSTATS::MEAN ; CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::STANDARD-DEVIATION ; CL-MATHSTATS::INTERQUARTILE-RANGE)) ; (BLOCK CL-MATHSTATS::STATISTICAL-SUMMARY-INTERNAL ; (LET* ((LENGTH #) ; (CL-MATHSTATS::MINIMUM #) ; (CL-MATHSTATS::MAXIMUM #) ; (CL-MATHSTATS::RANGE #) ; (CL-MATHSTATS::MEDIAN #) ; (CL-MATHSTATS::MODE #) ; (CL-MATHSTATS::MEAN #) ; (CL-MATHSTATS::VARIANCE #) ; (CL-MATHSTATS::SD #) ; (CL-MATHSTATS::IQR #) ; (CL-MATHSTATS::SKEWNESS #)) ; (VALUES LENGTH ; CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::MAXIMUM ; CL-MATHSTATS::RANGE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::MODE ; CL-MATHSTATS::MEAN ; CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::SD ; CL-MATHSTATS::IQR ; CL-MATHSTATS::SKEWNESS)))) ; ; caught STYLE-WARNING: ; undefined type: LENGTH ; ; caught STYLE-WARNING: ; 1 more use of undefined type LENGTH ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS:CONFIDENCE-INTERVAL-T-SUMMARIES ; (DEFUN CL-MATHSTATS::CONFIDENCE-INTERVAL-T-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DOF CL-MATHSTATS::STANDARD-ERROR ; CL-MATHSTATS::CONFIDENCE) ; "This function is just like `confidence-interval-t,' except that instead of ; its arguments being the actual data, it takes the following summary statistics: ; `mean,' which is the estimator of some t-distributed parameter; `dof,' which is ; the number of degrees of freedom in estimating the mean; and the ; `standard-error' of the estimator. In general, `mean' is a point estimator of ; the mean of a t-distribution, which may be the slope parameter of a regression, ; the difference between two means, or other practical t-distributions. ; `Confidence' should be a number between 0 and 1, exclusive." ; (DECLARE ; (VALUES CL-MATHSTATS::MEAN CL-MATHSTATS::LOWER CL-MATHSTATS::UPPER)) ; (CHECK-TYPE CL-MATHSTATS::DOF (REAL 1 *)) ; (CHECK-TYPE CL-MATHSTATS::MEAN REAL) ; (CHECK-TYPE CL-MATHSTATS::STANDARD-ERROR REAL) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE (REAL (0) (1))) ; (LET* ((CL-MATHSTATS::T-X (CL-MATHSTATS::FIND-CRITICAL-VALUE #'# #)) ; (CL-MATHSTATS::W (* CL-MATHSTATS::STANDARD-ERROR CL-MATHSTATS::T-X)) ; (CL-MATHSTATS::UPPER (+ CL-MATHSTATS::MEAN CL-MATHSTATS::W)) ; (CL-MATHSTATS::LOWER (- CL-MATHSTATS::MEAN CL-MATHSTATS::W))) ; (VALUES CL-MATHSTATS::MEAN CL-MATHSTATS::LOWER CL-MATHSTATS::UPPER))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G2077 'CL-MATHSTATS::LOWER) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::LOWER ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G2077 'CL-MATHSTATS::LOWER) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::LOWER ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:CONFIDENCE-INTERVAL-Z ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::CONFIDENCE-INTERVAL-Z ; (CL-MATHSTATS::CONFIDENCE-INTERVAL) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::CONFIDENCE) ; "Suppose you have a sample of 50 numbers and you want to compute a 90 percent ; confidence interval on the population mean. This function is the one to use. ; Note that it makes the assumption that the sampling distribution is normal, so ; it's inappropriate for small sample sizes. Use confidence-interval-t instead. ; It returns three values: the mean and the lower and upper bound of the ; confidence interval. True, only two numbers are necessary, but the confidence ; intervals of other statistics may be asymmetrical and these values would be ; consistent with those confidence intervals. This function handles 90, 95 and 99 ; percent confidence intervals as special cases, so those will be quite fast. ; `Sample' should be a sequence of numbers. `Confidence' should be a number ; between 0 and 1, exclusive." ; (DECLARE ; (VALUES CL-MATHSTATS::MEAN ; CL-MATHSTATS::LOWER ; CL-MATHSTATS::UPPER)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE ; (REAL (0) (1))) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DATA) ; (SQRT ; (/ ; (CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::DATA) ; (LENGTH CL-MATHSTATS::DATA))) ; CL-MATHSTATS::CONFIDENCE)) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-INTERNAL ; (CL-MATHSTATS::DATA CL-MATHSTATS::CONFIDENCE) ; (DECLARE ; (VALUES CL-MATHSTATS::MEAN ; CL-MATHSTATS::LOWER ; CL-MATHSTATS::UPPER)) ; (BLOCK CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE (REAL (0) (1))) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DATA) ; (SQRT (/ # #)) ; CL-MATHSTATS::CONFIDENCE))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::LOWER ; ; caught STYLE-WARNING: ; 7 more uses of undefined type CL-MATHSTATS::LOWER ; file: /Users/gwking/darcs/cl-graph/dev/graph-algorithms.lisp ; in: DEFMETHOD CL-GRAPH:FIND-CONNECTED-COMPONENTS (CL-GRAPH:BASIC-GRAPH) ; (METABANG.CL-CONTAINERS:MAKE-ITERATOR ; (CL-GRAPH::CONNECTED-COMPONENTS CL-GRAPH::GRAPH) ; :UNIQUE ; T ; :TRANSFORM ; #'METABANG.UTILITIES:PARENT) ; ; caught STYLE-WARNING: ; undefined function: METABANG.CL-CONTAINERS:MAKE-ITERATOR ; file: /Users/gwking/darcs/metatilities/dev/utilities/macros.lisp ; in: DEFUN METABANG.UTILITIES::MAKE-HCASE-TABLE ; (METABANG.UTILITIES::MAPPEND ; (METABANG.UTILITIES:COMPOSE #'METABANG.UTILITIES:ENSURE-LIST #'CAR) ; METABANG.UTILITIES::CLAUSES) ; ; caught STYLE-WARNING: ; undefined function: METABANG.UTILITIES::MAPPEND ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G580 'CL-MATHSTATS::MSE-REG) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::MSE-REG ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G580 'CL-MATHSTATS::MSE-REG) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::MSE-REG ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::MSE-REG ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::MSE-REG ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G581 'CL-MATHSTATS::MSE-RES) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::MSE-RES ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G581 'CL-MATHSTATS::MSE-RES) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::MSE-RES ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::MSE-RES ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::MSE-RES ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:MODE ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::MODE ; NIL ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Returns the most frequent element of `data,' which should be a sequence. The ; algorithm involves sorting, and so the data must be numbers or the `key' ; function must produce numbers. Consider `sxhash' if no better function is ; available. Also returns the number of occurrences of the mode. If there is ; more than one mode, this returns the first mode, as determined by the sorting of ; the numbers." ; (DECLARE ; (VALUES METABANG.UTILITIES:ELEMENT ; CL-MATHSTATS::NUMBER-OF-OCCURRENCES)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (LET* ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::START2 ; (OR CL-MATHSTATS::START 0)) ; (CL-MATHSTATS::END2 ; (OR CL-MATHSTATS::END #))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR ; (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF (NULL CL-MATHSTATS::KEY) ; (SORT CL-MATHSTATS::TEMP #'<) ; (SORT CL-MATHSTATS::TEMP ; #'< ; :KEY ; CL-MATHSTATS::KEY)) ; (LET* (# # # # #) ; (IF # # #) ; (WHEN # #) ; (VALUES CL-MATHSTATS::BIGGEST-GROUP ; CL-MATHSTATS::BIGGEST-GROUP-SIZE))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G870 'CL-MATHSTATS::NUMBER-OF-OCCURRENCES) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::NUMBER-OF-OCCURRENCES ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G870 'CL-MATHSTATS::NUMBER-OF-OCCURRENCES) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::NUMBER-OF-OCCURRENCES ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MODE-INTERNAL ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (VALUES METABANG.UTILITIES:ELEMENT ; CL-MATHSTATS::NUMBER-OF-OCCURRENCES)) ; (BLOCK CL-MATHSTATS::MODE-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (LET* ((CL-MATHSTATS::N #) ; (CL-MATHSTATS::START2 #) ; (CL-MATHSTATS::END2 #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR ; (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF # # #) ; (LET* # ; # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::NUMBER-OF-OCCURRENCES ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::NUMBER-OF-OCCURRENCES ; file: /Users/gwking/darcs/metatilities/dev/utilities/dates-and-times.lisp ; in: DEFUN METABANG.UTILITIES:FORMAT-DATE ; (METABANG.UTILITIES:NYI) ; ; caught STYLE-WARNING: ; undefined function: METABANG.UTILITIES:NYI ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: ; CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:CONFIDENCE-INTERVAL-PROPORTION ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::CONFIDENCE-INTERVAL-PROPORTION ; (CL-MATHSTATS::CONFIDENCE-INTERVAL) ; NIL ; NIL ; NIL ; (CL-MATHSTATS::X CL-MATHSTATS::N ; CL-MATHSTATS::CONFIDENCE) ; "Suppose we have a sample of `n' things and `x' of them are ``successes.'' We ; can estimate the population proportion of successes as x/n; call it `p-hat.' ; This function computes the estimate and a confidence interval on it. This ; function is not appropriate for small samples with p-hat far from 1/2: `x' ; should be at least 5, and so should `n'-`x.' This function returns three values: ; p-hat, and the lower and upper bounds of the confidence interval. `Confidence' ; should be a number between 0 and 1, exclusive." ; (DECLARE ; (VALUES CL-MATHSTATS::P-HAT ; CL-MATHSTATS::LOWER ; CL-MATHSTATS::UPPER)) ; (LET ((CL-MATHSTATS::P-HAT ; (/ CL-MATHSTATS::X CL-MATHSTATS::N)) ; (CL-MATHSTATS::STANDARD-ERROR (SQRT #))) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-SUMMARIES ; CL-MATHSTATS::P-HAT ; CL-MATHSTATS::STANDARD-ERROR ; CL-MATHSTATS::CONFIDENCE))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G2091 'CL-MATHSTATS::P-HAT) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::P-HAT ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G2091 'CL-MATHSTATS::P-HAT) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::P-HAT ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CONFIDENCE-INTERVAL-PROPORTION-INTERNAL ; (CL-MATHSTATS::X CL-MATHSTATS::N ; CL-MATHSTATS::CONFIDENCE) ; (DECLARE ; (VALUES CL-MATHSTATS::P-HAT ; CL-MATHSTATS::LOWER ; CL-MATHSTATS::UPPER)) ; (BLOCK ; CL-MATHSTATS::CONFIDENCE-INTERVAL-PROPORTION-INTERNAL ; (LET ((CL-MATHSTATS::P-HAT #) ; (CL-MATHSTATS::STANDARD-ERROR #)) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-SUMMARIES ; CL-MATHSTATS::P-HAT ; CL-MATHSTATS::STANDARD-ERROR ; CL-MATHSTATS::CONFIDENCE)))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::P-HAT ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::P-HAT ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS ; (DEFUN CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS ; (CL-MATHSTATS::A CL-MATHSTATS::B CL-MATHSTATS::C CL-MATHSTATS::D ; &OPTIONAL (CL-MATHSTATS::YATES T)) ; "Runs a chi-square test for association on a simple 2 x 2 table. If `yates' ; is nil, the correction for continuity is not done; default is t. ; ; Returns the chi-square statistic and the significance of the value." ; (DECLARE (VALUES CL-MATHSTATS::CHI2 CL-MATHSTATS::P-VALUE)) ; (CHECK-TYPE CL-MATHSTATS::A INTEGER) ; (CHECK-TYPE CL-MATHSTATS::B INTEGER) ; (CHECK-TYPE CL-MATHSTATS::C INTEGER) ; (CHECK-TYPE CL-MATHSTATS::D INTEGER) ; (LET ((CL-MATHSTATS::N ; (+ CL-MATHSTATS::A CL-MATHSTATS::B CL-MATHSTATS::C CL-MATHSTATS::D)) ; (CL-MATHSTATS::DENOM (* # # # #)) ; (CL-MATHSTATS::NUMER (- # #))) ; (WHEN CL-MATHSTATS::YATES (SETF CL-MATHSTATS::NUMER (- # #))) ; (SETF CL-MATHSTATS::NUMER ; (* CL-MATHSTATS::N (CL-MATHSTATS:SQUARE CL-MATHSTATS::NUMER))) ; (LET* ((CL-MATHSTATS::CHI2 #) (CL-MATHSTATS::P-VALUE #)) ; (VALUES CL-MATHSTATS::CHI2 CL-MATHSTATS::P-VALUE)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G2280 'CL-MATHSTATS::P-VALUE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::P-VALUE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G2280 'CL-MATHSTATS::P-VALUE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::P-VALUE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS ; (CL-MATHSTATS::A CL-MATHSTATS::B ; CL-MATHSTATS::C ; CL-MATHSTATS::D ; &OPTIONAL ; (CL-MATHSTATS::YATES T)) ; (DECLARE ; (VALUES CL-MATHSTATS::CHI2 CL-MATHSTATS::P-VALUE)) ; (BLOCK CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS ; (CHECK-TYPE CL-MATHSTATS::A INTEGER) ; (CHECK-TYPE CL-MATHSTATS::B INTEGER) ; (CHECK-TYPE CL-MATHSTATS::C INTEGER) ; (CHECK-TYPE CL-MATHSTATS::D INTEGER) ; (LET ((CL-MATHSTATS::N #) ; (CL-MATHSTATS::DENOM #) ; (CL-MATHSTATS::NUMER #)) ; (WHEN CL-MATHSTATS::YATES ; (SETF CL-MATHSTATS::NUMER #)) ; (SETF CL-MATHSTATS::NUMER (* CL-MATHSTATS::N #)) ; (LET* (# #) ; (VALUES CL-MATHSTATS::CHI2 ; CL-MATHSTATS::P-VALUE))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::P-VALUE ; ; caught STYLE-WARNING: ; 9 more uses of undefined type CL-MATHSTATS::P-VALUE ; file: /Users/gwking/darcs/metatilities/dev/utilities/utilities.lisp ; in: DEFUN METABANG.UTILITIES:ADD-CLASS-IF-NECESSARY ; (METABANG.UTILITIES:PUSH-END METABANG.UTILITIES::SUPERCLASS-NAME ; METABANG.UTILITIES::CLASS-LIST) ; ; caught STYLE-WARNING: ; undefined function: METABANG.UTILITIES:PUSH-END ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G571 'CL-MATHSTATS::R-LIST) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::R-LIST ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G571 'CL-MATHSTATS::R-LIST) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::R-LIST ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::R-LIST ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::R-LIST ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G574 'CL-MATHSTATS::R-SQUARE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::R-SQUARE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G574 'CL-MATHSTATS::R-SQUARE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::R-SQUARE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::R-SQUARE ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::R-SQUARE ; file: /Users/gwking/darcs/cl-containers/dev/containers-readtable.lisp ; in: SET-MACRO-CHARACTER #\[ ; (METABANG.CL-CONTAINERS::READ-CONTAINER-ELEMENT STREAM #\]) ; ; caught STYLE-WARNING: ; undefined function: METABANG.CL-CONTAINERS::READ-CONTAINER-ELEMENT ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:T-TEST-ONE-SAMPLE ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::T-TEST-ONE-SAMPLE ; (CL-MATHSTATS::T-SIGNIFICANCE) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Returns the t-statistic for the mean of the data, which should be a sequence ; of numbers. Let D be the sample mean. The null hypothesis is that D equals the ; `H0-mean.' The alternative hypothesis is specified by `tails': `:both' means D ; /= H0-mean, `:positive' means D > H0-mean, and `:negative' means D < H0-mean. ; ; The function also returns the significance, the standard error, and the degrees ; of freedom. Signals `zero-variance' if that condition occurs. Signals ; `insufficient-data' unless there are at least two elements in the sample." ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::SAMPLE-ERROR ; CL-MATHSTATS::DOF)) ; (LET ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET ((CL-MATHSTATS::D #) ; (CL-MATHSTATS::V #)) ; (WHEN (ZEROP CL-MATHSTATS::V) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # #) ; (VALUES CL-MATHSTATS::TT ; CL-MATHSTATS::SIG ; CL-MATHSTATS::SE ; #))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1387 'CL-MATHSTATS::SAMPLE-ERROR) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SAMPLE-ERROR ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1387 'CL-MATHSTATS::SAMPLE-ERROR) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SAMPLE-ERROR ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::T-TEST-ONE-SAMPLE-INTERNAL ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::SAMPLE-ERROR ; CL-MATHSTATS::DOF)) ; (BLOCK CL-MATHSTATS::T-TEST-ONE-SAMPLE-INTERNAL ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET (# #) ; (WHEN # #) ; (LET* # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SAMPLE-ERROR ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::SAMPLE-ERROR ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:LINEAR-REGRESSION-MINIMAL-SUMMARIES ; (DEFUN CL-MATHSTATS::LINEAR-REGRESSION-MINIMAL-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X CL-MATHSTATS::Y CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 CL-MATHSTATS::XY) ; "Calculates the slope and intercept of the regression line. This function ; differs from `linear-regression-minimal' in that it takes summary statistics: ; `x' and `y' are the sums of the independent variable and dependent variables, ; respectively; `x2' and `y2' are the sums of the squares of the independent ; variable and dependent variables, respectively; and `xy' is the sum of the ; products of the independent and dependent variables. ; ; You should first look at your data with a scatter plot to see if a linear model ; is plausible. See the manual for a fuller explanation of linear regression ; statistics." ; (DECLARE (VALUES CL-MATHSTATS::SLOPE CL-MATHSTATS::INTERCEPT) ; (IGNORE CL-MATHSTATS::Y2)) ; (LET ((CL-MATHSTATS::NSSX (- # #)) (CL-MATHSTATS::NSSXY (- # #))) ; (WHEN (ZEROP CL-MATHSTATS::NSSX) (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* ((CL-MATHSTATS::SLOPE #) (CL-MATHSTATS::INTERCEPT #)) ; (VALUES CL-MATHSTATS::SLOPE CL-MATHSTATS::INTERCEPT)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G180 'CL-MATHSTATS::SLOPE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SLOPE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G180 'CL-MATHSTATS::SLOPE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SLOPE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::LINEAR-REGRESSION-MINIMAL-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X ; CL-MATHSTATS::Y ; CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 ; CL-MATHSTATS::XY) ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE CL-MATHSTATS::INTERCEPT) ; (IGNORE CL-MATHSTATS::Y2)) ; (BLOCK ; CL-MATHSTATS::LINEAR-REGRESSION-MINIMAL-SUMMARIES ; (LET ((CL-MATHSTATS::NSSX #) (CL-MATHSTATS::NSSXY #)) ; (WHEN (ZEROP CL-MATHSTATS::NSSX) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# #) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SLOPE ; ; caught STYLE-WARNING: ; 12 more uses of undefined type CL-MATHSTATS::SLOPE ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G577 'CL-MATHSTATS::SS-PERCENT-LIST) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-PERCENT-LIST ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G577 'CL-MATHSTATS::SS-PERCENT-LIST) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-PERCENT-LIST ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-PERCENT-LIST ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::SS-PERCENT-LIST ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G578 'CL-MATHSTATS::SS-REG) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-REG ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G578 'CL-MATHSTATS::SS-REG) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-REG ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-REG ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::SS-REG ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G576 'CL-MATHSTATS::SS-REG-LIST) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-REG-LIST ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G576 'CL-MATHSTATS::SS-REG-LIST) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-REG-LIST ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-REG-LIST ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::SS-REG-LIST ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G579 'CL-MATHSTATS::SS-RES) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-RES ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G579 'CL-MATHSTATS::SS-RES) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-RES ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::SS-RES ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::SS-RES ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:LINEAR-REGRESSION-VERBOSE-SUMMARIES ; (DEFUN CL-MATHSTATS::LINEAR-REGRESSION-VERBOSE-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X CL-MATHSTATS::Y CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 CL-MATHSTATS::XY) ; "Calculates almost every statistic of a linear regression: the slope and ; intercept of the line, the standard error on each, the correlation coefficient, ; the coefficient of determination, also known as r-square, and an ANOVA table as ; described in the manual. ; ; If you don't need all this information, consider using the ``-brief'' or ; ``-minimal'' functions, which do less computation. ; ; This function differs from `linear-regression-verbose' in that it takes summary ; variables: `x' and `y' are the sums of the independent variable and dependent ; variables, respectively; `x2' and `y2' are the sums of the squares of the ; independent variable and dependent variables, respectively; and `xy' is the sum ; of the products of the independent and dependent variables. ; ; You should first look at your data with a scatter plot to see if a linear model ; is plausible. See the manual for a fuller explanation of linear regression ; statistics." ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::CORRELATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::STD-ERR-INTERCEPT ; CL-MATHSTATS::ANOVA-TABLE)) ; (LET ((CL-MATHSTATS::NSSX (- # #)) ; (CL-MATHSTATS::NSSY (- # #)) ; (CL-MATHSTATS::NSSXY (- # #))) ; (WHEN (OR (ZEROP CL-MATHSTATS::NSSX) (ZEROP CL-MATHSTATS::NSSY)) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* ((CL-MATHSTATS::SLOPE #) ; (CL-MATHSTATS::INTERCEPT #) ; (CL-MATHSTATS::NSSR #) ; (CL-MATHSTATS::NSSE #) ; (CL-MATHSTATS::DETERMINATION #) ; (CL-MATHSTATS::CORRELATION #) ; (CL-MATHSTATS::DOF #) ; (CL-MATHSTATS::STD-ERR-SLOPE #) ; (CL-MATHSTATS::STD-ERR-INTERCEPT NIL) ; (CL-MATHSTATS::F #) ; (CL-MATHSTATS::P-VALUE #) ; (CL-MATHSTATS::SSR #) ; ...) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::CORRELATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::STD-ERR-INTERCEPT ; CL-MATHSTATS::ANOVA-TABLE)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G246 'CL-MATHSTATS::STD-ERR-INTERCEPT) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERR-INTERCEPT ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G246 'CL-MATHSTATS::STD-ERR-INTERCEPT) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERR-INTERCEPT ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::LINEAR-REGRESSION-VERBOSE-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X ; CL-MATHSTATS::Y ; CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 ; CL-MATHSTATS::XY) ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::CORRELATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::STD-ERR-INTERCEPT ; CL-MATHSTATS::ANOVA-TABLE)) ; (BLOCK ; CL-MATHSTATS::LINEAR-REGRESSION-VERBOSE-SUMMARIES ; (LET ((CL-MATHSTATS::NSSX #) ; (CL-MATHSTATS::NSSY #) ; (CL-MATHSTATS::NSSXY #)) ; (WHEN (OR # #) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # # # # # # # # # # # ...) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::CORRELATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::STD-ERR-INTERCEPT ; CL-MATHSTATS::ANOVA-TABLE))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERR-INTERCEPT ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::STD-ERR-INTERCEPT ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:LINEAR-REGRESSION-BRIEF-SUMMARIES ; (DEFUN CL-MATHSTATS::LINEAR-REGRESSION-BRIEF-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X CL-MATHSTATS::Y CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 CL-MATHSTATS::XY) ; "Calculates the main statistics of a linear regression: the slope and ; intercept of the line, the coefficient of determination, also known as r-square, ; the standard error of the slope, and the p-value for the regression. This ; function differs from `linear-regression-brief' in that it takes summary ; variables: `x' and `y' are the sums of the independent variable and dependent ; variables, respectively; `x2' and `y2' are the sums of the squares of the ; independent variable and dependent variables, respectively; and `xy' is the sum ; of the products of the independent and dependent variables. ; ; You should first look at your data with a scatter plot to see if a linear model ; is plausible. See the manual for a fuller explanation of linear regression ; statistics." ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::P-VALUE)) ; (LET ((CL-MATHSTATS::NSSX (- # #)) ; (CL-MATHSTATS::NSSY (- # #)) ; (CL-MATHSTATS::NSSXY (- # #))) ; (WHEN (OR (ZEROP CL-MATHSTATS::NSSX) (ZEROP CL-MATHSTATS::NSSY)) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* ((CL-MATHSTATS::SLOPE #) ; (CL-MATHSTATS::INTERCEPT #) ; (CL-MATHSTATS::NSSR #) ; (CL-MATHSTATS::NSSE #) ; (CL-MATHSTATS::DETERMINATION #) ; (CL-MATHSTATS::DOF #) ; (CL-MATHSTATS::STD-ERR-SLOPE #) ; (CL-MATHSTATS::P-VALUE #)) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::P-VALUE)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G211 'CL-MATHSTATS::STD-ERR-SLOPE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERR-SLOPE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G211 'CL-MATHSTATS::STD-ERR-SLOPE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERR-SLOPE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::LINEAR-REGRESSION-BRIEF-SUMMARIES ; (CL-MATHSTATS::N CL-MATHSTATS::X ; CL-MATHSTATS::Y ; CL-MATHSTATS::X2 ; CL-MATHSTATS::Y2 ; CL-MATHSTATS::XY) ; (DECLARE ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::P-VALUE)) ; (BLOCK CL-MATHSTATS::LINEAR-REGRESSION-BRIEF-SUMMARIES ; (LET ((CL-MATHSTATS::NSSX #) ; (CL-MATHSTATS::NSSY #) ; (CL-MATHSTATS::NSSXY #)) ; (WHEN (OR # #) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # # # # # # #) ; (VALUES CL-MATHSTATS::SLOPE ; CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::DETERMINATION ; CL-MATHSTATS::STD-ERR-SLOPE ; CL-MATHSTATS::P-VALUE))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERR-SLOPE ; ; caught STYLE-WARNING: ; 7 more uses of undefined type CL-MATHSTATS::STD-ERR-SLOPE ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:T-TEST ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::T-TEST ; (CL-MATHSTATS::T-SIGNIFICANCE) ; NIL ; NIL ; ((CL-MATHSTATS::SAMPLE-1 'SEQUENCE) ; (CL-MATHSTATS::SAMPLE-2 'SEQUENCE)) ; (CL-MATHSTATS::SAMPLE-1 ; CL-MATHSTATS::SAMPLE-2 ; &OPTIONAL ; (CL-MATHSTATS::TAILS :BOTH) ; (CL-MATHSTATS::H0MEAN 0)) ; "Returns the t-statistic for the difference in the means of two samples, which ; should each be a sequence of numbers. Let D=mean1-mean2. The null hypothesis ; is that D=0. The alternative hypothesis is specified by `tails': `:both' means ; D/=0, `:positive' means D>0, and `:negative' means D<0. Unless you're using ; :both tails, be careful what order the two samples are in: it matters! ; ; The function also returns the significance, the standard error, and the degrees ; of freedom. Signals `standard-error-is-zero' if that condition occurs. Signals ; `insufficient-data' unless there are at least two elements in each sample." ; (DECLARE ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::STD-ERROR ; CL-MATHSTATS::DOF)) ; (CHECK-TYPE CL-MATHSTATS::TAILS ; (MEMBER :BOTH ; :POSITIVE ; :NEGATIVE)) ; (LET ((CL-MATHSTATS::N1 ; (CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::SAMPLE-1)) ; (CL-MATHSTATS::N2 ; (CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::SAMPLE-2))) ; (WHEN ; (OR (ZEROP CL-MATHSTATS::N1) ; (ZEROP CL-MATHSTATS::N2)) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (WHEN ; (OR (< CL-MATHSTATS::N1 2) ; (< CL-MATHSTATS::N2 2)) ; (ERROR 'CL-MATHSTATS::INSUFFICIENT-DATA)) ; (LET* ((CL-MATHSTATS::MEAN1 #) ; (CL-MATHSTATS::MEAN2 #) ; (CL-MATHSTATS::SS1 #) ; (CL-MATHSTATS::SS2 #) ; (CL-MATHSTATS::DOF #) ; (CL-MATHSTATS::SP #)) ; (WHEN (ZEROP CL-MATHSTATS::SP) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # #) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::STD-ERROR ; CL-MATHSTATS::DOF))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1447 'CL-MATHSTATS::STD-ERROR) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERROR ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1447 'CL-MATHSTATS::STD-ERROR) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERROR ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::T-TEST-INTERNAL ; (CL-MATHSTATS::SAMPLE-1 CL-MATHSTATS::SAMPLE-2 ; &OPTIONAL ; (CL-MATHSTATS::TAILS :BOTH) ; (CL-MATHSTATS::H0MEAN 0)) ; (DECLARE ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::STD-ERROR ; CL-MATHSTATS::DOF)) ; (BLOCK CL-MATHSTATS::T-TEST-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::TAILS ; (MEMBER :BOTH :POSITIVE :NEGATIVE)) ; (LET ((CL-MATHSTATS::N1 #) (CL-MATHSTATS::N2 #)) ; (WHEN (OR # #) (ERROR 'CL-MATHSTATS::NO-DATA)) ; (WHEN (OR # #) ; (ERROR 'CL-MATHSTATS::INSUFFICIENT-DATA)) ; (LET* (# # # # # #) ; (WHEN # #) ; (LET* # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::STD-ERROR ; ; caught STYLE-WARNING: ; 5 more uses of undefined type CL-MATHSTATS::STD-ERROR ; file: /Users/gwking/darcs/cl-mathstats/dev/correlation-regression.lisp ; in: DEFUN CL-MATHSTATS:MULTIPLE-LINEAR-REGRESSION-NORMAL ; (DEFUN CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; "Performs linear regression of the dependent variable, `dv,' on multiple ; independent variables, `ivs.' Y on multiple X's, calculating the intercept and ; regression coefficient. Calculates the F statistic, intercept and the ; correlation coefficient for Y on X's." ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (LET* ((CL-MATHSTATS::NUM-X (LENGTH CL-MATHSTATS::IVS)) ; (CL-MATHSTATS::ROWS (+ 2 CL-MATHSTATS::NUM-X)) ; (CL-MATHSTATS::COLS (LENGTH CL-MATHSTATS::DV)) ; (CL-MATHSTATS::X-0 ; (MAKE-LIST CL-MATHSTATS::COLS :INITIAL-ELEMENT 1)) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::X) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* ((CL-MATHSTATS::Z-TRANS-MAT #) ; (CL-MATHSTATS::Z-MAT #) ; (CL-MATHSTATS::Z-TRANS-Z #) ; (CL-MATHSTATS::X-DIM #) ; (CL-MATHSTATS::X-TRANS-X #) ; (CL-MATHSTATS::X-TRANS-Y #) ; (CL-MATHSTATS::Y-TRANS-Y #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (DOTIMES (CL-MATHSTATS::I #) (DOTIMES # #)) ; (SETF (AREF CL-MATHSTATS::Y-TRANS-Y 0 0) ; (AREF CL-MATHSTATS::Z-TRANS-Z ; CL-MATHSTATS::X-DIM ; CL-MATHSTATS::X-DIM)) ; (LET (#) ; (UNLESS CL-MATHSTATS::INV-X-T-X #) ; (LET* # ; # ; # ; # ; #))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G572 'CL-MATHSTATS::T-BS) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::T-BS ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G572 'CL-MATHSTATS::T-BS) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::T-BS ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (CL-MATHSTATS::DV &REST CL-MATHSTATS::IVS) ; (DECLARE ; (VALUES CL-MATHSTATS::INTERCEPT ; CL-MATHSTATS::COEFFICIENTS ; CL-MATHSTATS::R-LIST ; CL-MATHSTATS::T-BS ; CL-MATHSTATS::BETAS ; CL-MATHSTATS::R-SQUARE ; CL-MATHSTATS::F ; CL-MATHSTATS::SS-REG-LIST ; CL-MATHSTATS::SS-PERCENT-LIST ; CL-MATHSTATS::SS-REG ; CL-MATHSTATS::SS-RES ; ...)) ; (BLOCK CL-MATHSTATS::MULTIPLE-LINEAR-REGRESSION-NORMAL ; (LET* ((CL-MATHSTATS::NUM-X #) ; (CL-MATHSTATS::ROWS #) ; (CL-MATHSTATS::COLS #) ; (CL-MATHSTATS::X-0 #) ; (CL-MATHSTATS::ITEM-LIST NIL)) ; (WHEN (MEMBER 'NIL CL-MATHSTATS::DV) ; (ERROR 'CL-MATHSTATS::MISSING-DATA)) ; (PUSH CL-MATHSTATS::X-0 CL-MATHSTATS::ITEM-LIST) ; (DOLIST (CL-MATHSTATS::X CL-MATHSTATS::IVS) ; (WHEN # #) ; (PUSH CL-MATHSTATS::X CL-MATHSTATS::ITEM-LIST)) ; (PUSH CL-MATHSTATS::DV CL-MATHSTATS::ITEM-LIST) ; (LET* (# # # # # # #) ; (DOTIMES # #) ; (DOTIMES # #) ; (SETF # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::T-BS ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::T-BS ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:T-TEST-ONE-SAMPLE ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::T-TEST-ONE-SAMPLE ; (CL-MATHSTATS::T-SIGNIFICANCE) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Returns the t-statistic for the mean of the data, which should be a sequence ; of numbers. Let D be the sample mean. The null hypothesis is that D equals the ; `H0-mean.' The alternative hypothesis is specified by `tails': `:both' means D ; /= H0-mean, `:positive' means D > H0-mean, and `:negative' means D < H0-mean. ; ; The function also returns the significance, the standard error, and the degrees ; of freedom. Signals `zero-variance' if that condition occurs. Signals ; `insufficient-data' unless there are at least two elements in the sample." ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::SAMPLE-ERROR ; CL-MATHSTATS::DOF)) ; (LET ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET ((CL-MATHSTATS::D #) ; (CL-MATHSTATS::V #)) ; (WHEN (ZEROP CL-MATHSTATS::V) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# # #) ; (VALUES CL-MATHSTATS::TT ; CL-MATHSTATS::SIG ; CL-MATHSTATS::SE ; #))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1385 'CL-MATHSTATS::T-STATISTIC) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::T-STATISTIC ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1385 'CL-MATHSTATS::T-STATISTIC) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::T-STATISTIC ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::T-TEST-ONE-SAMPLE-INTERNAL ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (VALUES CL-MATHSTATS::T-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::SAMPLE-ERROR ; CL-MATHSTATS::DOF)) ; (BLOCK CL-MATHSTATS::T-TEST-ONE-SAMPLE-INTERNAL ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET (# #) ; (WHEN # #) ; (LET* # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::T-STATISTIC ; ; caught STYLE-WARNING: ; 7 more uses of undefined type CL-MATHSTATS::T-STATISTIC ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (DEFUN CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Counts each unique combination of an element of `v1' and an element of `v2.' ; Returns a two-dimensional table of integers." ; (DECLARE ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (LET ((CL-MATHSTATS::N (LENGTH CL-MATHSTATS::V1))) ; (WHEN (/= CL-MATHSTATS::N (LENGTH CL-MATHSTATS::V2)) ; (ERROR 'CL-MATHSTATS::UNMATCHED-SEQUENCES)) ; (LET ((CL-MATHSTATS::V1-VALUES #) (CL-MATHSTATS::V2-VALUES #)) ; (WHEN (OR # #) ; (CERROR "Make it anyway" ; 'CL-MATHSTATS::ENORMOUS-CONTINGENCY-TABLE ; :SIZE-OF-TABLE ; #)) ; (LET (#) ; (MAP NIL #'# CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G2449 'CL-MATHSTATS::TABLE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::TABLE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G2449 'CL-MATHSTATS::TABLE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::TABLE ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (DECLARE ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (BLOCK CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (/= CL-MATHSTATS::N #) ; (ERROR 'CL-MATHSTATS::UNMATCHED-SEQUENCES)) ; (LET (# #) ; (WHEN # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::TABLE ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::TABLE ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:TUKEY-SUMMARY ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::TUKEY-SUMMARY ; NIL ; ((CL-MATHSTATS::MINIMUM) ; (CL-MATHSTATS::FIRST-QUARTILE) ; (CL-MATHSTATS::MEDIAN) ; (CL-MATHSTATS::THIRD-QUARTILE) ; (CL-MATHSTATS::MAXIMUM)) ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; "Computes a Tukey five-number summary of the data. That is, it returns, in ; increasing order, the extremes and the quartiles: the minimum, the 1/4 quartile, ; the median, the 3/4 quartile, and the maximum." ; (DECLARE ; (VALUES CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::FIRST-QUARTILE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::THIRD-QUARTILE ; CL-MATHSTATS::MAXIMUM)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (LET* ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS)) ; (CL-MATHSTATS::START2 ; (OR CL-MATHSTATS::START 0)) ; (CL-MATHSTATS::END2 ; (OR CL-MATHSTATS::END #))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR ; (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF (NULL CL-MATHSTATS::KEY) ; (SORT CL-MATHSTATS::TEMP #'<) ; (SORT CL-MATHSTATS::TEMP ; #'< ; :KEY ; CL-MATHSTATS::KEY)) ; (FLET (#) ; (VALUES # # # # #))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1220 'CL-MATHSTATS::THIRD-QUARTILE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::THIRD-QUARTILE ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1220 'CL-MATHSTATS::THIRD-QUARTILE) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::THIRD-QUARTILE ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::TUKEY-SUMMARY-INTERNAL ; (CL-MATHSTATS::DATA &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (VALUES CL-MATHSTATS::MINIMUM ; CL-MATHSTATS::FIRST-QUARTILE ; CL-MATHSTATS::MEDIAN ; CL-MATHSTATS::THIRD-QUARTILE ; CL-MATHSTATS::MAXIMUM)) ; (BLOCK CL-MATHSTATS::TUKEY-SUMMARY-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (LET* ((CL-MATHSTATS::N #) ; (CL-MATHSTATS::START2 #) ; (CL-MATHSTATS::END2 #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (CL-MATHSTATS::WITH-TEMP-VECTOR ; (CL-MATHSTATS::TEMP CL-MATHSTATS::N) ; (REPLACE CL-MATHSTATS::TEMP ; CL-MATHSTATS::DATA ; :END1 ; CL-MATHSTATS::N ; :START2 ; CL-MATHSTATS::START2 ; :END2 ; CL-MATHSTATS::END2) ; (IF # # #) ; (FLET # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::THIRD-QUARTILE ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::THIRD-QUARTILE ; file: /Users/gwking/darcs/metatilities/dev/utilities/locks.lisp ; in: DEFUN METABANG.UTILITIES::ENQUEUE-LOCK-REQUEST ; (METABANG.UTILITIES:THREAD-WAIT :WAITING ; (LAMBDA () ; (METABANG.UTILITIES::ACCESS-LOCK-P ; METABANG.UTILITIES::OWNER ; METABANG.UTILITIES::LOCK))) ; ; caught STYLE-WARNING: ; undefined function: METABANG.UTILITIES:THREAD-WAIT ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS:CONFIDENCE-INTERVAL-T-SUMMARIES ; (DEFUN CL-MATHSTATS::CONFIDENCE-INTERVAL-T-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DOF CL-MATHSTATS::STANDARD-ERROR ; CL-MATHSTATS::CONFIDENCE) ; "This function is just like `confidence-interval-t,' except that instead of ; its arguments being the actual data, it takes the following summary statistics: ; `mean,' which is the estimator of some t-distributed parameter; `dof,' which is ; the number of degrees of freedom in estimating the mean; and the ; `standard-error' of the estimator. In general, `mean' is a point estimator of ; the mean of a t-distribution, which may be the slope parameter of a regression, ; the difference between two means, or other practical t-distributions. ; `Confidence' should be a number between 0 and 1, exclusive." ; (DECLARE ; (VALUES CL-MATHSTATS::MEAN CL-MATHSTATS::LOWER CL-MATHSTATS::UPPER)) ; (CHECK-TYPE CL-MATHSTATS::DOF (REAL 1 *)) ; (CHECK-TYPE CL-MATHSTATS::MEAN REAL) ; (CHECK-TYPE CL-MATHSTATS::STANDARD-ERROR REAL) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE (REAL (0) (1))) ; (LET* ((CL-MATHSTATS::T-X (CL-MATHSTATS::FIND-CRITICAL-VALUE #'# #)) ; (CL-MATHSTATS::W (* CL-MATHSTATS::STANDARD-ERROR CL-MATHSTATS::T-X)) ; (CL-MATHSTATS::UPPER (+ CL-MATHSTATS::MEAN CL-MATHSTATS::W)) ; (CL-MATHSTATS::LOWER (- CL-MATHSTATS::MEAN CL-MATHSTATS::W))) ; (VALUES CL-MATHSTATS::MEAN CL-MATHSTATS::LOWER CL-MATHSTATS::UPPER))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G2078 'CL-MATHSTATS::UPPER) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::UPPER ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G2078 'CL-MATHSTATS::UPPER) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::UPPER ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:CONFIDENCE-INTERVAL-Z ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::CONFIDENCE-INTERVAL-Z ; (CL-MATHSTATS::CONFIDENCE-INTERVAL) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::CONFIDENCE) ; "Suppose you have a sample of 50 numbers and you want to compute a 90 percent ; confidence interval on the population mean. This function is the one to use. ; Note that it makes the assumption that the sampling distribution is normal, so ; it's inappropriate for small sample sizes. Use confidence-interval-t instead. ; It returns three values: the mean and the lower and upper bound of the ; confidence interval. True, only two numbers are necessary, but the confidence ; intervals of other statistics may be asymmetrical and these values would be ; consistent with those confidence intervals. This function handles 90, 95 and 99 ; percent confidence intervals as special cases, so those will be quite fast. ; `Sample' should be a sequence of numbers. `Confidence' should be a number ; between 0 and 1, exclusive." ; (DECLARE ; (VALUES CL-MATHSTATS::MEAN ; CL-MATHSTATS::LOWER ; CL-MATHSTATS::UPPER)) ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE ; (REAL (0) (1))) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DATA) ; (SQRT ; (/ ; (CL-MATHSTATS::VARIANCE ; CL-MATHSTATS::DATA) ; (LENGTH CL-MATHSTATS::DATA))) ; CL-MATHSTATS::CONFIDENCE)) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-INTERNAL ; (CL-MATHSTATS::DATA CL-MATHSTATS::CONFIDENCE) ; (DECLARE ; (VALUES CL-MATHSTATS::MEAN ; CL-MATHSTATS::LOWER ; CL-MATHSTATS::UPPER)) ; (BLOCK CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-INTERNAL ; (CHECK-TYPE CL-MATHSTATS::DATA SEQUENCE) ; (CHECK-TYPE CL-MATHSTATS::CONFIDENCE (REAL (0) (1))) ; (CL-MATHSTATS::CONFIDENCE-INTERVAL-Z-SUMMARIES ; (CL-MATHSTATS::MEAN CL-MATHSTATS::DATA) ; (SQRT (/ # #)) ; CL-MATHSTATS::CONFIDENCE))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::UPPER ; ; caught STYLE-WARNING: ; 7 more uses of undefined type CL-MATHSTATS::UPPER ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (DEFUN CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Counts each unique combination of an element of `v1' and an element of `v2.' ; Returns a two-dimensional table of integers." ; (DECLARE ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (LET ((CL-MATHSTATS::N (LENGTH CL-MATHSTATS::V1))) ; (WHEN (/= CL-MATHSTATS::N (LENGTH CL-MATHSTATS::V2)) ; (ERROR 'CL-MATHSTATS::UNMATCHED-SEQUENCES)) ; (LET ((CL-MATHSTATS::V1-VALUES #) (CL-MATHSTATS::V2-VALUES #)) ; (WHEN (OR # #) ; (CERROR "Make it anyway" ; 'CL-MATHSTATS::ENORMOUS-CONTINGENCY-TABLE ; :SIZE-OF-TABLE ; #)) ; (LET (#) ; (MAP NIL #'# CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G2450 'CL-MATHSTATS::V1-VALUES) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::V1-VALUES ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (DECLARE ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (BLOCK CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (/= CL-MATHSTATS::N #) ; (ERROR 'CL-MATHSTATS::UNMATCHED-SEQUENCES)) ; (LET (# #) ; (WHEN # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::V1-VALUES ; in: DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 ; (DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Performs a chi-square test for independence of the two variables, `v1' and ; `v2.' These should be categorial variables with only two values; the function ; will construct a 2x2 contingency table by counting the number of occurrences of ; each combination of the variables. See the manual for more details." ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '(2 2) (ARRAY-DIMENSIONS CL-MATHSTATS::2X2-TABLE)) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET ((CL-MATHSTATS::A #) ; (CL-MATHSTATS::B #) ; (CL-MATHSTATS::C #) ; (CL-MATHSTATS::D #)) ; (MULTIPLE-VALUE-CALL #'VALUES ; (CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS CL-MATHSTATS::A ; CL-MATHSTATS::B ; CL-MATHSTATS::C ; CL-MATHSTATS::D) ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CHI-SQUARE-2X2 ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (BLOCK CL-MATHSTATS::CHI-SQUARE-2X2 ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '# #) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET (# # # #) ; (MULTIPLE-VALUE-CALL #'VALUES ; # ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::V1-VALUES ; ; caught STYLE-WARNING: ; 4 more uses of undefined type CL-MATHSTATS::V1-VALUES ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: DEFUN CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (DEFUN CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Counts each unique combination of an element of `v1' and an element of `v2.' ; Returns a two-dimensional table of integers." ; (DECLARE ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (LET ((CL-MATHSTATS::N (LENGTH CL-MATHSTATS::V1))) ; (WHEN (/= CL-MATHSTATS::N (LENGTH CL-MATHSTATS::V2)) ; (ERROR 'CL-MATHSTATS::UNMATCHED-SEQUENCES)) ; (LET ((CL-MATHSTATS::V1-VALUES #) (CL-MATHSTATS::V2-VALUES #)) ; (WHEN (OR # #) ; (CERROR "Make it anyway" ; 'CL-MATHSTATS::ENORMOUS-CONTINGENCY-TABLE ; :SIZE-OF-TABLE ; #)) ; (LET (#) ; (MAP NIL #'# CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; --> FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL FUNCTION UNLESS COND ; --> IF NOT IF ; ==> ; (TYPEP #:G2451 'CL-MATHSTATS::V2-VALUES) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::V2-VALUES ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (DECLARE ; (VALUES CL-MATHSTATS::TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (BLOCK CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (/= CL-MATHSTATS::N #) ; (ERROR 'CL-MATHSTATS::UNMATCHED-SEQUENCES)) ; (LET (# #) ; (WHEN # #) ; (LET # ; # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::V2-VALUES ; in: DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 ; (DEFUN CL-MATHSTATS::CHI-SQUARE-2X2 (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; "Performs a chi-square test for independence of the two variables, `v1' and ; `v2.' These should be categorial variables with only two values; the function ; will construct a 2x2 contingency table by counting the number of occurrences of ; each combination of the variables. See the manual for more details." ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '(2 2) (ARRAY-DIMENSIONS CL-MATHSTATS::2X2-TABLE)) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET ((CL-MATHSTATS::A #) ; (CL-MATHSTATS::B #) ; (CL-MATHSTATS::C #) ; (CL-MATHSTATS::D #)) ; (MULTIPLE-VALUE-CALL #'VALUES ; (CL-MATHSTATS::CHI-SQUARE-2X2-COUNTS CL-MATHSTATS::A ; CL-MATHSTATS::B ; CL-MATHSTATS::C ; CL-MATHSTATS::D) ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)))) ; --> PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::CHI-SQUARE-2X2 ; (CL-MATHSTATS::V1 CL-MATHSTATS::V2) ; (DECLARE ; (VALUES CL-MATHSTATS::CHI-SQUARE ; CL-MATHSTATS::SIGNIFICANCE ; CL-MATHSTATS::CONTINGENCY-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES)) ; (BLOCK CL-MATHSTATS::CHI-SQUARE-2X2 ; (MULTIPLE-VALUE-BIND ; (CL-MATHSTATS::2X2-TABLE CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES) ; (CL-MATHSTATS::MAKE-CONTINGENCY-TABLE ; CL-MATHSTATS::V1 ; CL-MATHSTATS::V2) ; (UNLESS (EQUAL '# #) ; (ERROR 'CL-MATHSTATS::NOT-BINARY-VARIABLES)) ; (LET (# # # #) ; (MULTIPLE-VALUE-CALL #'VALUES ; # ; CL-MATHSTATS::2X2-TABLE ; CL-MATHSTATS::V1-VALUES ; CL-MATHSTATS::V2-VALUES))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::V2-VALUES ; ; caught STYLE-WARNING: ; 4 more uses of undefined type CL-MATHSTATS::V2-VALUES ; file: /Users/gwking/darcs/cl-mathstats/dev/basic-statistics.lisp ; in: CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS:Z-TEST-ONE-SAMPLE ; (CL-MATHSTATS::DEFINE-STATISTIC CL-MATHSTATS::Z-TEST-ONE-SAMPLE ; (CL-MATHSTATS::SIGNIFICANCE) ; NIL ; NIL ; ((CL-MATHSTATS::DATA 'SEQUENCE)) ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; (CL-MATHSTATS::H0-STD-DEV ; 1) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY ; CL-MATHSTATS::TAILS) ; (VALUES CL-MATHSTATS::Z-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE)) ; (LET ((CL-MATHSTATS::N ; (APPLY #'CL-MATHSTATS::DATA-LENGTH ; CL-MATHSTATS::DATA ; CL-MATHSTATS::STANDARD-ARGS))) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET ((CL-MATHSTATS::D #) ; (CL-MATHSTATS::V #)) ; (WHEN (ZEROP CL-MATHSTATS::V) ; (ERROR 'CL-MATHSTATS::ZERO-VARIANCE)) ; (LET* (# CL-MATHSTATS::SIG) ; (VALUES CL-MATHSTATS::ZS ; CL-MATHSTATS::SIG))))) ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF TYPEP ; ==> ; (SB-KERNEL:%TYPEP #:G1716 'CL-MATHSTATS::Z-STATISTIC) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::Z-STATISTIC ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA FUNCTION THE MULTIPLE-VALUE-BIND MULTIPLE-VALUE-CALL ; --> FUNCTION UNLESS COND IF NOT IF ; ==> ; (TYPEP #:G1716 'CL-MATHSTATS::Z-STATISTIC) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::Z-STATISTIC ; --> PROGN DEFUN PROGN EVAL-WHEN SB-IMPL::%DEFUN SB-IMPL::%DEFUN ; --> SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA CL-MATHSTATS::Z-TEST-ONE-SAMPLE-INTERNAL ; (CL-MATHSTATS::DATA CL-MATHSTATS::TAILS ; &OPTIONAL ; (CL-MATHSTATS::H0-MEAN 0) ; (CL-MATHSTATS::H0-STD-DEV 1) ; &REST ; CL-MATHSTATS::STANDARD-ARGS ; &KEY ; CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY) ; (DECLARE ; (IGNORE CL-MATHSTATS::START ; CL-MATHSTATS::END ; CL-MATHSTATS::KEY ; CL-MATHSTATS::TAILS) ; (VALUES CL-MATHSTATS::Z-STATISTIC ; CL-MATHSTATS::SIGNIFICANCE)) ; (BLOCK CL-MATHSTATS::Z-TEST-ONE-SAMPLE-INTERNAL ; (LET ((CL-MATHSTATS::N #)) ; (WHEN (ZEROP CL-MATHSTATS::N) ; (ERROR 'CL-MATHSTATS::NO-DATA)) ; (LET (# #) ; (WHEN # #) ; (LET* # ; #))))) ; ; caught STYLE-WARNING: ; undefined type: CL-MATHSTATS::Z-STATISTIC ; ; caught STYLE-WARNING: ; 2 more uses of undefined type CL-MATHSTATS::Z-STATISTIC ; ; caught STYLE-WARNING: ; These functions are undefined: ; METABANG.UTILITIES::ALLOCATE-EKSL-LOCK METABANG.UTILITIES:DEALLOCATE METABANG.UTILITIES::DEBUGGING-P-FN METABANG.UTILITIES:DESTROY-THREAD CL-GRAPH::GRAPH-SEARCH METABANG.CL-CONTAINERS:MAKE-ITERATOR METABANG.UTILITIES::MAPPEND METABANG.UTILITIES:NYI METABANG.UTILITIES:PUSH-END METABANG.CL-CONTAINERS::READ-CONTAINER-ELEMENT METABANG.UTILITIES:THREAD-WAIT ; ; caught STYLE-WARNING: ; These types are undefined: ; CL-MATHSTATS::ANOVA-TABLE CL-MATHSTATS::BETAS CL-MATHSTATS::CHI-SQUARE CL-MATHSTATS::CHI2 CL-MATHSTATS::COEFFICIENTS CL-MATHSTATS::COMPATIBILITY-VALUE CL-MATHSTATS::CONTIGENCY-TABLE CL-MATHSTATS::CONTINGENCY-TABLE COUNT CL-MATHSTATS::D CL-MATHSTATS::DETERMINATION CL-MATHSTATS::DOF METABANG.UTILITIES:ELEMENT CL-MATHSTATS::F CL-MATHSTATS::FIRST-QUARTILE CL-MATHSTATS::G-SCORE CL-MATHSTATS::G-SIGNIFICANCE CL-MATHSTATS::INTERCEPT LENGTH CL-MATHSTATS::LOWER CL-MATHSTATS::MSE-REG CL-MATHSTATS::MSE-RES CL-MATHSTATS::NUMBER-OF-OCCURRENCES CL-MATHSTATS::P-HAT CL-MATHSTATS::P-VALUE CL-MATHSTATS::R-LIST CL-MATHSTATS::R-SQUARE CL-MATHSTATS::SAMPLE-ERROR CL-MATHSTATS::SLOPE CL-MATHSTATS::SS-PERCENT-LIST CL-MATHSTATS::SS-REG CL-MATHSTATS::SS-REG-LIST CL-MATHSTATS::SS-RES CL-MATHSTATS::STD-ERR-INTERCEPT CL-MATHSTATS::STD-ERR-SLOPE CL-MATHSTATS::STD-ERROR CL-MATHSTATS::T-BS CL-MATHSTATS::T-STATISTIC CL-MATHSTATS::TABLE CL-MATHSTATS::THIRD-QUARTILE CL-MATHSTATS::UPPER CL-MATHSTATS::V1-VALUES CL-MATHSTATS::V2-VALUES CL-MATHSTATS::Z-STATISTIC ; ; compilation unit finished ; caught 195 STYLE-WARNING conditions ; printed 43 notes *metatilities-base-20120909-git/dev/set-equal.lisp000066400000000000000000000017641172714415100215320ustar00rootroot00000000000000(in-package #:metatilities) (defun set-equal (list1 list2 &rest args &key test key) "Returns t if list1 and list2 are equal (as sets). If list1 and list2 are not equal returns (as multiple values) nil and two lists. The first list contains the elements in list1 and not in list2 and the second list contains elements in list2 and not in list1." (declare (ignore test key)) (let ((in1-not2 (apply #'set-difference list1 list2 args)) (in2-not1 (apply #'set-difference list2 list1 args))) (if (apply #'union in1-not2 in2-not1 args) (values nil in1-not2 in2-not1) (values t nil nil)))) #+Alternate ;; some very quick testing doesn't show any real improvement ;; but needs more investigation --- should cons less at least (defun set-equal (list-1 list-2 &rest args) (and (every (lambda (elt-1) (apply #'member elt-1 list-2 args)) list-1) (every (lambda (elt-2) (apply #'member elt-2 list-1 args)) list-2))) metatilities-base-20120909-git/lift-standard.config000066400000000000000000000017041172714415100221000ustar00rootroot00000000000000;;; configuration for LIFT tests ;; settings (:if-dribble-exists :supersede) (:dribble "lift.dribble") (:print-length 10) (:print-level 5) (:print-test-case-names t) ;; suites to run (metatilities-base-test) ;; report properties (:report-property :title "Metatilities (Base) | Test results") (:report-property :relative-to metatilities-base-test) (:report-property :style-sheet "test-style.css") (:report-property :if-exists :supersede) (:report-property :format :html) (:report-property :full-pathname "test-results/test-report.html") (:report-property :unique-name t) (:build-report) (:report-property :unique-name t) (:report-property :format :describe) (:report-property :full-pathname "test-results/test-report.txt") (:build-report) (:report-property :format :save) (:report-property :full-pathname "test-results/test-report.sav") (:build-report) (:report-property :format :describe) (:report-property :full-pathname *standard-output*) (:build-report) metatilities-base-20120909-git/metatilities-base-test.asd000066400000000000000000000011021172714415100232200ustar00rootroot00000000000000#| Author: Gary King |# (defpackage #:metatilities-base-test-system (:use #:cl #:asdf)) (in-package #:metatilities-base-test-system) (defsystem metatilities-base-test :version "0.1" :author "Gary Warren King " :maintainer "Gary Warren King " :licence "MIT Style License" :components ((:module "unit-tests" :components ((:file "package") (:file "tests" :depends-on ("package")) (:file "test-parse-brief-class" :depends-on ("tests"))))) :depends-on (:lift :metatilities-base)) metatilities-base-20120909-git/metatilities-base.asd000066400000000000000000000032021172714415100222460ustar00rootroot00000000000000#| copyright See the file COPYING for details |# (defpackage #:metatilities-base-system (:use #:asdf #:common-lisp)) (in-package #:metatilities-base-system) (defsystem metatilities-base :author "Gary Warren King " :version "0.6.6" :maintainer "Gary Warren King " :licence "MIT Style license" :description "These are metabang.com's Common Lisp basic utilities." :long-description "These are metabang.com's Common Lisp basic utilities and what not." :components ((:module "setup" :pathname "dev/" :components ((:file "package"))) (:module "dev" :depends-on ("setup") :components ((:file "api") (:file "l0-utils" :depends-on ("api")) (:file "l0-strings" :depends-on ("api")) (:file "l0-macros" :depends-on ("api" "l0-utils")) (:file "l0-arrays" :depends-on ("api")) (:file "l0-clos" :depends-on ("api")) (:file "l0-files" :depends-on ("api" "l0-macros")) (:file "l0-time" :depends-on ("l0-macros")) (:file "set-equal" :depends-on ("api")) (:file "generic-lisp" :depends-on ("api")) (:file "generic-interface" :depends-on ("api" "generic-lisp" "l0-macros")) (:file "defclass-star" :depends-on ("api" "l0-macros")) (:file "copy-file") #+(or) (:file "define-class" :depends-on ("api" "defclass-star")))) ) :in-order-to ((test-op (load-op metatilities-base-test))) :perform (test-op :after (op c) (funcall (intern (symbol-name '#:run-tests) :lift) :config :generic))) (defmethod operation-done-p ((o test-op) (c (eql (find-system 'metatilities-base)))) (values nil)) metatilities-base-20120909-git/unit-tests/000077500000000000000000000000001172714415100202725ustar00rootroot00000000000000metatilities-base-20120909-git/unit-tests/package.lisp000066400000000000000000000001661172714415100225610ustar00rootroot00000000000000(in-package #:common-lisp-user) (defpackage #:metatilities-base-test (:use #:common-lisp #:lift #:metatilities)) metatilities-base-20120909-git/unit-tests/test-parse-brief-class.lisp000066400000000000000000000071031172714415100254430ustar00rootroot00000000000000(in-package #:metatilities-base-test) (defun slot-specs-same-p (spec-1 spec-2) (cond ((and (atom spec-1) (atom spec-2)) (eq spec-1 spec-2)) ((and (consp spec-1) (consp spec-2)) (and (slot-specs-same-p (first spec-1) (first spec-2)) (same-options-p (rest spec-1) (rest spec-2)) (same-options-p (rest spec-2) (rest spec-1)))))) (defun same-options-p (options-1 options-2) (loop for name in options-1 by #'cddr for value in (rest options-1) by #'cddr do ;; cons up something fresh to ensure that we don't get equality (unless (samep value (getf options-2 name (cons nil nil))) (return-from same-options-p nil))) (values t)) (deftestsuite test-parse-brief-slot (metatilities-base-test) () (:dynamic-variables (*automatic-slot-accessors?* nil) (*automatic-slot-initargs?* nil) (*prune-unknown-slot-options* nil) (*package* (find-package '#:metatilities-base-test))) (:equality-test #'slot-specs-same-p)) (addtest simple-1 (ensure-same (parse-brief-slot 'foo) '(foo))) (addtest simple-2 (ensure-same (parse-brief-slot '(foo)) '(foo))) (addtest initform-1 (ensure-same (parse-brief-slot '(foo t)) '(foo :initform t))) (addtest initform-initarg-1 (ensure-same (parse-brief-slot '(foo t i)) '(foo :initform t :initarg :foo))) (addtest initform-reader-1 (ensure-same (parse-brief-slot '(foo t r)) '(foo :reader foo :initform t))) (addtest initform-accessor-1 (ensure-same (parse-brief-slot '(foo t a)) '(foo :accessor foo :initform t))) (addtest initform-accessor-with-extra (ensure-same (parse-brief-slot '(foo t a :wow 2)) '(foo :accessor foo :initform t :wow 2))) (addtest unbound-with-extra (ensure-same (parse-brief-slot '(bar :unbound :component nil)) '(bar :component nil))) (addtest initform-accessor-documentation (ensure-same (parse-brief-slot '(foo t ia "test slot")) '(foo :accessor foo :initform t :initarg :foo :documentation "test slot"))) (addtest unbound-with-extra (ensure-same (parse-brief-slot '(bar :unbound :component nil)) '(bar :component nil))) #| (spy (parse-brief-slot '(foo t ia "test slot"))) (spy (parse-brief-slot '(foo t * "test slot"))) (spy (parse-brief-slot '(foo t "slot"))) (spy (parse-brief-slot '(bar :initform nil))) (spy (parse-brief-slot 'baz t t)) (spy (parse-brief-slot 'baz t t 'class)) (spy (parse-brief-slot '(baz nil) t t 'class)) (spy (parse-brief-slot '(baz nil) nil t 'class)) (spy (parse-brief-slot '(baz nil) t nil 'class)) (spy (parse-brief-slot '(baz nil) nil nil 'class)) (spy (parse-brief-slot '(baz nil "the baz slot") t t 'class)) (spy (parse-brief-slot '(baz nil a) nil nil 'class)) (spy (parse-brief-slot '(baz nil r) nil nil 'class)) (spy (parse-brief-slot '(baz nil r) nil nil 'class nil ".")) (spy (parse-brief-slot '(baz nil r) t t 'class nil ".")) (spy (parse-brief-slot '(foo 2 :type 'fixnum ia "the foo class" :initarg :what))) |# #+test (defclass-brief foo () "the Foo class" (a (b) (c 1) (d 2 i) (e 3 ia "The E slot"))) #+test (defclass-brief foo () "the Foo class" (a b) :automatic-accessors :automatic-initargs :name-prefix) #+test (defclass-brief foo () "the Foo class" ((a 1 r) (c 3 a)) :name-prefix) #+test (defclass-brief foo () "the Foo class" (a b) :automatic-accessors :name-prefix) #+test (defclass-brief foo () "the Foo class" (a b) :automatic-accessors :automatic-initargs (:name-prefix ugly)) metatilities-base-20120909-git/unit-tests/tests.lisp000066400000000000000000000001301172714415100223170ustar00rootroot00000000000000(in-package #:metatilities-base-test) (deftestsuite metatilities-base-test () ()) metatilities-base-20120909-git/website/000077500000000000000000000000001172714415100176155ustar00rootroot00000000000000metatilities-base-20120909-git/website/source/000077500000000000000000000000001172714415100211155ustar00rootroot00000000000000metatilities-base-20120909-git/website/source/index.md000066400000000000000000000033511172714415100225500ustar00rootroot00000000000000{include resources/header.md}
* [Mailing Lists][3] * [Getting it][4] {remark * [Documentation][5]} * [News][6] {remark * [Test results][tr]} * [Changelog][7] [3]: #mailing-lists [4]: #downloads [5]: documentation/ "documentation link" [6]: #news [7]: changelog.html [tr]: test-report.html
### What it is [Metatilities-base][] is the core of [Metatilities][]. It has the good stuff that sits at the foundation of the rest of the code that metabang.com writes. [Metatilities][] is [metabang.com][]'s big box of stuff that has accumulated over the years. It's full of things you're pretty sure you don't need but can't quite bear to part with. Putting metatilities-base into it's own project is a way of doing a bit of spring cleaning while there's still time (Summer is only three weeks away!) {anchor mailing-lists} ### Mailing Lists * [metatilities-base-devel][devel-list]: A list for announcements, questions, patches, bug reports, and so on; It's for everything. {anchor downloads} ### Where is it metabang.com is switching from [darcs][] to [git][] for source control; the current log5 repository is on [github][github-metatilities-base] and you can clone it using: git clone git://github.com/gwkkwg/metatilities-base You can use [ASDF-Install][asdf-install] or just download a [tarball][]. It's also on the [CLiki][log5-cliki]. You can follow development (such as it is :-)) on [unCLog][]. {anchor news} ### What is happening 2010-Dec-20 - moved to github. 2008-May-26 - Split metatilities-base out on its own even more officially. A good time was had by all.
{include resources/footer.md} metatilities-base-20120909-git/website/source/resources/000077500000000000000000000000001172714415100231275ustar00rootroot00000000000000metatilities-base-20120909-git/website/source/resources/footer.md000066400000000000000000000026651172714415100247600ustar00rootroot00000000000000 metatilities-base-20120909-git/website/source/resources/header.md000066400000000000000000000013771172714415100247110ustar00rootroot00000000000000{include shared-links.md} {set-property html yes} {set-property style-sheet "http://common-lisp.net/project/cl-containers/shared/style-200.css"} {set-property author "Gary Warren King"} {set-property title "metatilities-base | metabang.com"} [devel-list]: http://common-lisp.net/cgi-bin/mailman/listinfo/metatilities-base-devel [cliki-home]: http://www.cliki.net/metatilities-base [tarball]: http://common-lisp.net/project/metatilities-base/metatilities-base.tar.gz metatilities-base-20120909-git/website/source/resources/navigation.md000066400000000000000000000000351172714415100256060ustar00rootroot00000000000000 metatilities-base-20120909-git/website/website.tmproj000066400000000000000000000062731172714415100225240ustar00rootroot00000000000000 currentDocument source/index.md documents expanded name resources regexFolderFilter !.*/(\.[^/]*|CVS|_darcs|_MTN|\{arch\}|blib|.*~\.nib|.*\.(framework|app|pbproj|pbxproj|xcode(proj)?|bundle))$ sourceDirectory source/resources filename source/index.md lastUsed 2010-12-21T02:44:45Z selected filename ../../shared/shared-links.md lastUsed 2010-12-21T02:44:44Z fileHierarchyDrawerWidth 184 metaData ../../shared/shared-links.md caret column 0 line 0 firstVisibleColumn 0 firstVisibleLine 31 source/index.md caret column 0 line 72 firstVisibleColumn 0 firstVisibleLine 33 source/resources/footer.md caret column 27 line 9 firstVisibleColumn 0 firstVisibleLine 0 source/resources/header.md caret column 0 line 10 columnSelection firstVisibleColumn 0 firstVisibleLine 0 selectFrom column 0 line 7 selectTo column 0 line 10 source/resources/navigation.md caret column 0 line 1 firstVisibleColumn 0 firstVisibleLine 0 openDocuments source/index.md source/resources/header.md ../../shared/shared-links.md source/resources/footer.md source/resources/navigation.md showFileHierarchyDrawer windowFrame {{0, 15}, {688, 763}}