Mercurial > hg > octave-lyh

changeset 4079:c0532bbaefd7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2002-09-30 19:08:09 by jwe]
author jwe
date Mon, 30 Sep 2002 19:08:09 +0000
parents bd51df637cb3
children 8683d23356cb
files libcruft/ChangeLog libcruft/slatec-fn/xdacosh.f libcruft/slatec-fn/xdasinh.f libcruft/slatec-fn/xdatanh.f libcruft/slatec-fn/xdbetai.f libcruft/slatec-fn/xderf.f libcruft/slatec-fn/xderfc.f libcruft/slatec-fn/xdgami.f libcruft/slatec-fn/xdgamit.f libcruft/slatec-fn/xdgamma.f libcruft/slatec-fn/xgmainc.f scripts/ChangeLog scripts/statistics/distributions/normal_cdf.m scripts/statistics/distributions/normal_inv.m scripts/statistics/distributions/normal_pdf.m
diffstat 15 files changed, 49 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/libcruft/ChangeLog
+++ b/libcruft/ChangeLog
@@ -1,3 +1,16 @@
+2002-09-30  Paul Kienzle <pkienzle@users.sf.net>
+
+	* slatec-fn/xdacosh.f: Mark external functions as external.
+	* slatec-fn/xdasinh.f: Ditto.
+	* slatec-fn/xdatanh.f: Ditto.
+	* slatec-fn/xdbetai.f: Ditto.
+	* slatec-fn/xderf.f: Ditto.
+	* slatec-fn/xderfc.f: Ditto.
+	* slatec-fn/xdgami.f: Ditto.
+	* slatec-fn/xdgamit.f: Ditto.
+	* slatec-fn/xdgamma.f: Ditto.
+	* slatec-fn/xgmainc.f: Ditto.
+
 2002-08-14  John W. Eaton  <jwe@bevo.che.wisc.edu>
 
 	* odessa/odessa.f (ODESSA): Use XERRWD instead of XERR.
--- a/libcruft/slatec-fn/xdacosh.f
+++ b/libcruft/slatec-fn/xdacosh.f
@@ -1,4 +1,5 @@
       subroutine xdacosh (x, result)
+      external dacosh
       double precision x, result, dacosh
       result = dacosh (x)
       return
--- a/libcruft/slatec-fn/xdasinh.f
+++ b/libcruft/slatec-fn/xdasinh.f
@@ -1,4 +1,5 @@
       subroutine xdasinh (x, result)
+      external dasinh
       double precision x, result, dasinh
       result = dasinh (x)
       return
--- a/libcruft/slatec-fn/xdatanh.f
+++ b/libcruft/slatec-fn/xdatanh.f
@@ -1,4 +1,5 @@
       subroutine xdatanh (x, result)
+      external datanh
       double precision x, result, datanh
       result = datanh (x)
       return
--- a/libcruft/slatec-fn/xdbetai.f
+++ b/libcruft/slatec-fn/xdbetai.f
@@ -1,4 +1,5 @@
       subroutine xdbetai (x, a, b, result)
+      external dbetai
       double precision x, a, b, result, dbetai
       result = dbetai (x, a, b)
       return
--- a/libcruft/slatec-fn/xderf.f
+++ b/libcruft/slatec-fn/xderf.f
@@ -1,4 +1,5 @@
       subroutine xderf (x, result)
+      external derf
       double precision x, result, derf
       result = derf (x)
       return
--- a/libcruft/slatec-fn/xderfc.f
+++ b/libcruft/slatec-fn/xderfc.f
@@ -1,4 +1,5 @@
       subroutine xderfc (x, result)
+      external derfc
       double precision x, result, derfc
       result = derfc (x)
       return
--- a/libcruft/slatec-fn/xdgami.f
+++ b/libcruft/slatec-fn/xdgami.f
@@ -1,4 +1,5 @@
       subroutine xdgami (a, x, result)
+      external dgami
       double precision a, x, result, dgami
       result = dgami (a, x)
       return
--- a/libcruft/slatec-fn/xdgamit.f
+++ b/libcruft/slatec-fn/xdgamit.f
@@ -1,4 +1,5 @@
       subroutine xdgamit (a, x, result)
+      external dgamit
       double precision a, x, result, dgamit
       result = dgamit (a, x)
       return
--- a/libcruft/slatec-fn/xdgamma.f
+++ b/libcruft/slatec-fn/xdgamma.f
@@ -1,4 +1,5 @@
       subroutine xdgamma (x, result)
+      external dgamma
       double precision x, result, dgamma
       result = dgamma (x)
       return
--- a/libcruft/slatec-fn/xgmainc.f
+++ b/libcruft/slatec-fn/xgmainc.f
@@ -6,9 +6,13 @@
 
       double precision a, x, result
       intrinsic exp, log, sqrt, sign, aint
+      external dgami, dlngam, d9lgit, d9lgic, d9gmit
+
+C     external dgamr
+C     DOUBLE PRECISION DGAMR
 
       DOUBLE PRECISION AEPS, AINTA, ALGAP1, ALNEPS, ALNG, ALX,
-     $     BOT, H, SGA, SGNGAM, SQEPS, T, D1MACH, DGAMR, D9GMIT,
+     $     BOT, H, SGA, SGNGAM, SQEPS, T, D1MACH, D9GMIT,
      $     D9LGIC, D9LGIT, DLNGAM, DGAMI 
 
       LOGICAL FIRST
--- a/scripts/ChangeLog
+++ b/scripts/ChangeLog
@@ -1,3 +1,9 @@
+2002-09-27  Paul Kienzle <pkienzle@users.sf.net>
+
+	* statistics/distributions/normal_cdf.m: Handle variance == 0.
+	* statistics/distributions/normal_pdf.m: Likewise.
+	* statistics/distributions/normal_inv.m: Likewise.
+
 2002-09-27  Paul Kienzle <pkienzle@users.sf.net>
 
 	* specfun/erfinv.m: Return NaN for NaN inputs.
--- a/scripts/statistics/distributions/normal_cdf.m
+++ b/scripts/statistics/distributions/normal_cdf.m
@@ -57,11 +57,13 @@
     cdf(k) = NaN * ones (1, length (k));
   endif
 
-  k = find (!isinf (m) & !isnan (m) & (v > 0) & (v < Inf));
+  k = find (!isinf (m) & !isnan (m) & (v >= 0) & (v < Inf));
   if (any (k))
     cdf(k) = stdnormal_cdf ((x(k) - m(k)) ./ sqrt (v(k)));
   endif
 
+  cdf((v == 0) & (x == m)) = 0.5;
+
   cdf = reshape (cdf, r, c);
 
 endfunction
--- a/scripts/statistics/distributions/normal_inv.m
+++ b/scripts/statistics/distributions/normal_inv.m
@@ -52,7 +52,7 @@
   v = reshape (v, 1, s);
   inv = zeros (1, s);
 
-  k = find (isinf (m) | isnan (m) | !(v >= 0) | !(v < Inf));
+  k = find (isinf (m) | isnan (m) | !(v > 0) | !(v < Inf));
   if (any (k))
     inv(k) = NaN * ones (1, length (k));
   endif
@@ -62,6 +62,14 @@
     inv(k) = m(k) + sqrt (v(k)) .* stdnormal_inv (x(k));
   endif
 
+  k = find ((v == 0) & (x > 0) & (x < 1));
+  if (any (k))
+    inv(k) = m(k);
+  endif
+
+  inv((v == 0) & (x == 0)) = -Inf;
+  inv((v == 0) & (x == 1)) = Inf;
+
   inv = reshape (inv, r, c);
 
 endfunction
--- a/scripts/statistics/distributions/normal_pdf.m
+++ b/scripts/statistics/distributions/normal_pdf.m
@@ -57,11 +57,14 @@
     pdf(k) = NaN * ones (1, length (k));
   endif
 
-  k = find (!isinf (m) & !isnan (m) & (v > 0) & (v < Inf));
+  k = find (!isinf (m) & !isnan (m) & (v >= 0) & (v < Inf));
   if (any (k))
     pdf(k) = stdnormal_pdf ((x(k) - m(k)) ./ sqrt (v(k))) ./ sqrt (v(k));
   endif
 
+  pdf((v == 0) & (x == m)) = Inf;
+  pdf((v == 0) & ((x < m) | (x > m))) = 0;
+
   pdf = reshape (pdf, r, c);
 
 endfunction