From 4d5998c3f90b58f7db7b0c7881e890f91b76555c Mon Sep 17 00:00:00 2001 From: AJ Rossini Date: Fri, 9 Feb 2007 21:59:30 +0100 Subject: [PATCH] more object system refactoring --- compound.lsp | 22 ++++++- lispstat.asd | 23 ++++--- lsbasics.lsp | 3 - lsfloat.lsp | 20 ++++-- lsmath.lsp | 202 +++++++++++++++++++++++++-------------------------------- lspackages.lsp | 79 +++++++--------------- 6 files changed, 158 insertions(+), 191 deletions(-) diff --git a/compound.lsp b/compound.lsp index fc393e5..3c84ad1 100644 --- a/compound.lsp +++ b/compound.lsp @@ -1,3 +1,8 @@ +;;; -*- mode: lisp -*- +;;; Copyright (c) 2005--2007, by A.J. Rossini +;;; See COPYRIGHT file for any additional restrictions (BSD license). +;;; Since 1991, ANSI was finally finished. Edited for ANSI Common Lisp. + ;;;; compound -- Compound data and element-wise mapping functions ;;;; ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for @@ -8,10 +13,21 @@ ;;;; Package Setup ;;;; -(in-package #:lisp-stat-basics) +(defpackage :lisp-stat-compound-data + (:use :common-lisp + :lisp-stat-object-system) + (:shadowing-import-from :lisp-stat-object-system + slot-value + call-next-method + call-method)) + +(in-package :lisp-stat-compound-data) + + +; (in-package #:lisp-stat-basics) -(export '(compound-data-p map-elements compound-data-seq - compound-data-length element-seq compound-data-proto)) +; (export '(compound-data-p map-elements compound-data-seq +; compound-data-length element-seq compound-data-proto)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; diff --git a/lispstat.asd b/lispstat.asd index 878cb41..d4b7704 100644 --- a/lispstat.asd +++ b/lispstat.asd @@ -47,18 +47,23 @@ Last touched 1991, then in 2005--2007." :components ((:static-file "version" :pathname #p"version.lisp-expr") (:lispstat-lsp-source-file "lsobjects") (:lispstat-lsp-source-file "fastmap") - (:lispstat-lsp-source-file "lspackages" - :depends-on ("fastmap" - "lsobjects")) ;; ls-basisc (:lispstat-lsp-source-file "compound" :depends-on ("lsobjects" "fastmap")) (:lispstat-lsp-source-file "lsmacros" :depends-on ("compound")) + + (:lispstat-lsp-source-file "lsfloat") +;; :depends-on ("lsbasics")) ;; in lisp-stat-basics + (:lispstat-lsp-source-file "lsmath" + :depends-on ("lsbasics" + "lsmacros" + "lsfloat")) (:lispstat-lsp-source-file "lsbasics" :depends-on ("lsobjects" - "lsmacros")) + "lsmacros" + "lsfloat")) (:lispstat-lsp-source-file "dists" :depends-on ("lsbasics")) (:lispstat-lsp-source-file "ladata" @@ -67,10 +72,12 @@ Last touched 1991, then in 2005--2007." :depends-on ("ladata")) ;; in lisp-stat-basics (:lispstat-lsp-source-file "matrices" :depends-on ("lsbasics")) - (:lispstat-lsp-source-file "lsfloat" - :depends-on ("lsbasics")) ;; in lisp-stat-basics - (:lispstat-lsp-source-file "lsmath" - :depends-on ("lsbasics")) + + (:lispstat-lsp-source-file "lspackages" + :depends-on ("fastmap" + "lsobjects" + "lsmath" + "lsfloat")) ;; Applications (:lispstat-lsp-source-file "regression" diff --git a/lsbasics.lsp b/lsbasics.lsp index 2d4977d..578f026 100644 --- a/lsbasics.lsp +++ b/lsbasics.lsp @@ -40,9 +40,6 @@ spline kernel-dens kernel-smooth ;; lispstat-macros make-rv-function make-rv-function-1 - ;; lispstat-float - #:*stat-float-typing* #:*stat-cfloat-typing* #:*stat-float-template* - #:machine-epsilon ;; dists log-gamma uniform-rand normal-cdf normal-quant normal-dens normal-rand bivnorm-cdf cauchy-cdf cauchy-quant cauchy-dens diff --git a/lsfloat.lsp b/lsfloat.lsp index 15c7dc8..a3c7932 100644 --- a/lsfloat.lsp +++ b/lsfloat.lsp @@ -38,17 +38,23 @@ ;;;; defined. ;;;; -;;;; -;;;; Package Setup -;;;; +;;; Package Setup + (defpackage :lisp-stat-float - (:use :common-lisp)) + (:use :common-lisp) + (:export +stat-float-typing+ +stat-cfloat-typing+ +stat-float-template+ + machine-epsilon -(in-package #:lisp-stat-float) + make-base-trans-fun-2 make-base-trans-fun + + BASE-LOG BASE-EXP BASE-EXPT BASE-SQRT BASE-SIN BASE-COS + BASE-TAN BASE-ASIN BASE-ACOS BASE-ATAN BASE-SINH + BASE-COSH BASE-TANH BASE-ASINH BASE-ACOSH BASE-ATANH + BASE-ABS BASE-PHASE BASE-FFLOOR BASE-FCEILING BASE-FTRUNCATE + BASE-FROUND BASE-SIGNUM BASE-CIS)) -;;(export '(+stat-float-typing+ +stat-cfloat-typing+ +stat-float-template+ -;; machine-epsilon)) +(in-package #:lisp-stat-float) ;; This should technically be conditionalized to the Lisp ;; implementation, i.e. diff --git a/lsmath.lsp b/lsmath.lsp index 2bc5ae3..f9c095f 100644 --- a/lsmath.lsp +++ b/lsmath.lsp @@ -8,62 +8,38 @@ ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for ;;;; unrestricted use. -;;;; -;;;; Package Setup -;;;; - - +;;; Package Setup ;; in another world... -;; (defpackage :lispstat-math -;; (:use #:common-lisp #:lispstat-objectsystem) -;; (:import-from #:lispstat-basics make-rv-function make-rv-function-1) -;; (:shadow expt + - * / ** mod rem abs 1+ 1- log exp sqrt sin cos tan -;; asin acos atan sinh cosh tanh asinh acosh atanh float random -;; truncate floor ceiling round minusp zerop plusp evenp oddp -;; < <= = /= >= > complex conjugate realpart imagpart phase -;; min max logand logior logxor lognot ffloor fceiling -;; ftruncate fround signum cis) -;; (:export ^ ** expt + - * / mod rem pmin pmax abs 1+ 1- log exp sqrt sin cos -;; tan asin acos atan sinh cosh tanh asinh acosh atanh float random -;; truncate floor ceiling round minusp zerop plusp evenp oddp < <= = -;; /= >= > complex conjugate realpart imagpart phase min max -;; logand logior logxor lognot ffloor fceiling ftruncate fround -;; signum cis) -;; (:documentation "Vectorization of numerical functions")) -;; (in-package :lispstat-math) - - -(in-package #:lisp-stat) - -(shadowing-import (package-shadowing-symbols 'lisp-stat-object-system)) -(shadowing-import (package-shadowing-symbols 'lisp-stat-basics)) -(use-package 'lisp-stat-object-system) -(use-package 'lisp-stat-basics) - -;;; -;;; Shadow the symbols in the lisp package that will be redefined -;;; - -(shadow '(expt + - * / ** mod rem abs 1+ 1- log exp sqrt sin cos tan - asin acos atan sinh cosh tanh asinh acosh atanh float random - truncate floor ceiling round minusp zerop plusp evenp oddp - < <= = /= >= > complex conjugate realpart imagpart phase - min max logand logior logxor lognot ffloor fceiling - ftruncate fround signum cis)) - -(export '(^ ** expt + - * / mod rem pmin pmax abs 1+ 1- log exp sqrt sin cos - tan asin acos atan sinh cosh tanh asinh acosh atanh float random - truncate floor ceiling round minusp zerop plusp evenp oddp < <= = - /= >= > complex conjugate realpart imagpart phase min max - logand logior logxor lognot ffloor fceiling ftruncate fround - signum cis)) - -;;;; -;;;; Import some symbols -;;;; - -(import '(ls-basics::make-rv-function ls-basics::make-rv-function-1)) +(defpackage :lisp-stat-math + (:use :common-lisp + :lisp-stat-object-system + :lisp-stat-macros + :lisp-stat-float) + ;; Shadow the symbols in the lisp package that will be redefined + (:shadow expt + - * / ** mod rem abs 1+ 1- log exp sqrt sin cos tan + asin acos atan sinh cosh tanh asinh acosh atanh float random + truncate floor ceiling round minusp zerop plusp evenp oddp + < <= = /= >= > complex conjugate realpart imagpart phase + min max logand logior logxor lognot ffloor fceiling + ftruncate fround signum cis) + (:export ^ ** expt + - * / mod rem pmin pmax abs 1+ 1- log exp sqrt sin cos + tan asin acos atan sinh cosh tanh asinh acosh atanh float random + truncate floor ceiling round minusp zerop plusp evenp oddp < <= = + /= >= > complex conjugate realpart imagpart phase min max + logand logior logxor lognot ffloor fceiling ftruncate fround + signum cis) + (:documentation "Vectorization of numerical functions")) + +(in-package :lisp-stat-math) + +;; (in-package #:lisp-stat) +;; (shadowing-import (package-shadowing-symbols 'lisp-stat-object-system)) +;; (shadowing-import (package-shadowing-symbols 'lisp-stat-basics)) +;; (use-package 'lisp-stat-object-system) +;; (use-package 'lisp-stat-basics) + +;;; Import some symbols #+(and kcl fast-c-code internal-c-math) (progn @@ -83,23 +59,23 @@ ls-basics::rv-realpart ls-basics::rv-imagpart ls-basics::rv-conjugate))) -(import '(ls-basics::base-expt ls-basics::base-log ls-basics::base-exp - ls-basics::base-sqrt ls-basics::base-sin ls-basics::base-cos - ls-basics::base-tan ls-basics::base-asin ls-basics::base-acos - ls-basics::base-atan ls-basics::base-sinh ls-basics::base-cosh - ls-basics::base-tanh ls-basics::base-asinh ls-basics::base-acosh - ls-basics::base-atanh ls-basics::base-float ls-basics::base-abs - ls-basics::base-phase ls-basics::base-ffloor - ls-basics::base-fceiling ls-basics::base-ftruncate - ls-basics::base-fround ls-basics::base-signum - ls-basics::base-cis)) +;; found in lisp-stat-float +;; (import '(ls-basics::base-expt ls-basics::base-log ls-basics::base-exp +;; ls-basics::base-sqrt ls-basics::base-sin ls-basics::base-cos +;; ls-basics::base-tan ls-basics::base-asin ls-basics::base-acos +;; ls-basics::base-atan ls-basics::base-sinh ls-basics::base-cosh +;; ls-basics::base-tanh ls-basics::base-asinh ls-basics::base-acosh +;; ls-basics::base-atanh ls-basics::base-float ls-basics::base-abs +;; ls-basics::base-phase ls-basics::base-ffloor +;; ls-basics::base-fceiling ls-basics::base-ftruncate +;; ls-basics::base-fround ls-basics::base-signum +;; ls-basics::base-cis)) + -;;;; -;;;; Patch up some type definitions -;;;; +;;; Patch up some type definitions -(deftype float () 'lisp:float) -(deftype complex () 'lisp:complex) +(deftype float () 'common-lisp:float) +(deftype complex () 'common-lisp:complex) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -111,17 +87,17 @@ (make-rv-function ** base-expt x y) (make-rv-function expt base-expt x y) -(make-rv-function + lisp:+) -(make-rv-function-1 - lisp:-) -(make-rv-function * lisp:*) -(make-rv-function-1 / lisp:/) -(make-rv-function mod lisp:mod x y) -(make-rv-function rem lisp:rem x y) -(make-rv-function-1 pmin lisp:min) -(make-rv-function-1 pmax lisp:max) +(make-rv-function + common-lisp:+) +(make-rv-function-1 - common-lisp:-) +(make-rv-function * common-lisp:*) +(make-rv-function-1 / common-lisp:/) +(make-rv-function mod common-lisp:mod x y) +(make-rv-function rem common-lisp:rem x y) +(make-rv-function-1 pmin common-lisp:min) +(make-rv-function-1 pmax common-lisp:max) (make-rv-function abs base-abs x) -(make-rv-function 1+ lisp:1+ x) -(make-rv-function 1- lisp:1- x) +(make-rv-function 1+ common-lisp:1+ x) +(make-rv-function 1- common-lisp:1- x) (make-rv-function-1 log base-log) (make-rv-function exp base-exp x) @@ -141,30 +117,30 @@ (make-rv-function atanh base-atanh x) (make-rv-function-1 float base-float) -(make-rv-function-1 random lisp:random) - -(make-rv-function-1 floor lisp:floor) -(make-rv-function-1 ceiling lisp:ceiling) -(make-rv-function-1 truncate lisp:truncate) -(make-rv-function-1 round lisp:round) - -(make-rv-function zerop lisp:zerop x) -(make-rv-function plusp lisp:plusp x) -(make-rv-function minusp lisp:minusp x) -(make-rv-function oddp lisp:oddp x) -(make-rv-function evenp lisp:evenp x) - -(make-rv-function-1 < lisp:<) -(make-rv-function-1 <= lisp:<=) -(make-rv-function-1 = lisp:=) -(make-rv-function-1 /= lisp:/=) -(make-rv-function-1 >= lisp:>=) -(make-rv-function-1 > lisp:>) - -(make-rv-function-1 complex lisp:complex) -(make-rv-function realpart lisp:realpart x) -(make-rv-function imagpart lisp:imagpart x) -(make-rv-function conjugate lisp:conjugate x) +(make-rv-function-1 random common-lisp:random) + +(make-rv-function-1 floor common-lisp:floor) +(make-rv-function-1 ceiling common-lisp:ceiling) +(make-rv-function-1 truncate common-lisp:truncate) +(make-rv-function-1 round common-lisp:round) + +(make-rv-function zerop common-lisp:zerop x) +(make-rv-function plusp common-lisp:plusp x) +(make-rv-function minusp common-lisp:minusp x) +(make-rv-function oddp common-lisp:oddp x) +(make-rv-function evenp common-lisp:evenp x) + +(make-rv-function-1 < common-lisp:<) +(make-rv-function-1 <= common-lisp:<=) +(make-rv-function-1 = common-lisp:=) +(make-rv-function-1 /= common-lisp:/=) +(make-rv-function-1 >= common-lisp:>=) +(make-rv-function-1 > common-lisp:>) + +(make-rv-function-1 complex common-lisp:complex) +(make-rv-function realpart common-lisp:realpart x) +(make-rv-function imagpart common-lisp:imagpart x) +(make-rv-function conjugate common-lisp:conjugate x) (make-rv-function phase base-phase x) (defun min-1 (x) @@ -176,18 +152,18 @@ (if (consp seq) (dolist (x (rest seq) result) (let ((r (if (numberp x) x (min-1 x)))) - (if (lisp:< r result) (setf result r)))) + (if (common-lisp:< r result) (setf result r)))) (let ((n (length seq))) (declare (fixnum n)) (dotimes (i n result) (declare (fixnum i)) (let* ((x (aref seq i)) (r (if (numberp x) x (min-1 x)))) - (if (lisp:< r result) (setf result r))))))))) + (if (common-lisp:< r result) (setf result r))))))))) (defun min (x &optional (y nil has-y) &rest args) (if (and (null args) (numberp x) (numberp y)) - (lisp:min x y) + (common-lisp:min x y) (if has-y (min-1 (cons x (cons y args))) (min-1 x)))) (defun max-1 (x) @@ -199,24 +175,24 @@ (if (consp seq) (dolist (x (rest seq) result) (let ((r (if (numberp x) x (max-1 x)))) - (if (lisp:> r result) (setf result r)))) + (if (common-lisp:> r result) (setf result r)))) (let ((n (length seq))) (declare (fixnum n)) (dotimes (i n result) (declare (fixnum i)) (let* ((x (aref seq i)) (r (if (numberp x) x (max-1 x)))) - (if (lisp:> r result) (setf result r))))))))) + (if (common-lisp:> r result) (setf result r))))))))) (defun max (x &optional (y nil has-y) &rest args) (if (and (null args) (numberp x) (numberp y)) - (lisp:max x y) + (common-lisp:max x y) (if has-y (max-1 (cons x (cons y args))) (max-1 x)))) -(make-rv-function logand lisp:logand) -(make-rv-function logior lisp:logior) -(make-rv-function logxor lisp:logxor) -(make-rv-function lognot lisp:lognot x) +(make-rv-function logand common-lisp:logand) +(make-rv-function logior common-lisp:logior) +(make-rv-function logxor common-lisp:logxor) +(make-rv-function lognot common-lisp:lognot x) (make-rv-function-1 ffloor base-ffloor) (make-rv-function-1 fceiling base-fceiling) diff --git a/lspackages.lsp b/lspackages.lsp index 1c6ac28..29864b6 100644 --- a/lspackages.lsp +++ b/lspackages.lsp @@ -23,66 +23,32 @@ (:nicknames :ls :stats) (:use ;; :common-lisp ;; :lisp-stat-object-system + :lisp-stat-float + :lisp-stat-math :lisp-stat-basics) (:shadowing-import-from :lisp-stat-object-system slot-value call-next-method) - ;; (shadowing-import (package-shadowing-symbols 'lisp-stat-object-system)) - ;; (shadowing-import (package-shadowing-symbols 'lisp-stat-basics)) +;; ;; statistics.lsp - (:import-from :ls-basics +;; |base-lowess| - ;; lsmath.lsp - ;; install-rv-function - - rv-expt rv-+ rv-- - rv-* rv-/ rv-mod - rv-rem rv-pmin rv-pmax - rv-1+ rv-1- rv-exp - rv-log rv-sqrt rv-sin - rv-cos rv-tan rv-atan - rv-float rv-random rv-floor - rv-ceiling rv-truncate rv-round - rv-zerop rv-plusp rv-minusp - rv-oddp rv-evenp rv-< - rv-<= rv-= rv-/= - rv->= rv-> rv-complex - rv-realpart rv-imagpart - rv-conjugate - - base-expt base-log base-exp - base-sqrt base-sin base-cos - base-tan base-asin base-acos - base-atan base-sinh base-cosh - base-tanh base-asinh base-acosh - base-atanh base-float base-abs - base-phase base-ffloor - base-fceiling base-ftruncate - base-fround base-signum - base-cis - - make-rv-function make-rv-function-1 - - ;; statistics.lsp - - |base-lowess| +;; ;; maximize.lsp +;; new-minfo-internals minfo-maximize - ;; maximize.lsp - new-minfo-internals minfo-maximize - - ) +;; ) - (:shadow +;; (:shadow - ;; lsmath.lsp +;; ;; lsmath.lsp - expt + - * / ** mod rem abs 1+ 1- log exp sqrt sin cos tan - asin acos atan sinh cosh tanh asinh acosh atanh float random - truncate floor ceiling round minusp zerop plusp evenp oddp - < <= = /= >= > complex conjugate realpart imagpart phase - min max logand logior logxor lognot ffloor fceiling - ftruncate fround signum cis +;; expt + - * / ** mod rem abs 1+ 1- log exp sqrt sin cos tan +;; asin acos atan sinh cosh tanh asinh acosh atanh float random +;; truncate floor ceiling round minusp zerop plusp evenp oddp +;; < <= = /= >= > complex conjugate realpart imagpart phase +;; min max logand logior logxor lognot ffloor fceiling +;; ftruncate fround signum cis - ) +;; ) (:export @@ -119,13 +85,12 @@ )) -;;(in-package :lisp-stat) +;;; Lisp-stat-user package + +(defpackage :lisp-stat-user + (:use :common-lisp + :lisp-stat)) -;;;; -;;;; lstoplevel.lsp -;;;; +(in-package :lisp-stat-user) -#+:kcl -(import '(si::*quit-tag* si::*eof* si::*lisp-initialized* - si::reset-stack-limits si::break-current)) -- 2.11.4.GIT