annotate scripts/statistics/distributions/betainv.m @ 7795:df9519e9990c

Handle single precision eps values
author David Bateman <dbateman@free.fr>
date Mon, 12 May 2008 22:57:11 +0200
parents a1dbe9d80eee
children eb63fbe60fab
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
7017
a1dbe9d80eee [project @ 2007-10-12 21:27:11 by jwe]
jwe
parents: 7016
diff changeset
1 ## Copyright (C) 1995, 1996, 1997, 2005, 2006, 2007 Kurt Hornik
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
2 ##
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
3 ## This file is part of Octave.
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
4 ##
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
5 ## Octave is free software; you can redistribute it and/or modify it
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
6 ## under the terms of the GNU General Public License as published by
7016
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6046
diff changeset
7 ## the Free Software Foundation; either version 3 of the License, or (at
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6046
diff changeset
8 ## your option) any later version.
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
9 ##
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
10 ## Octave is distributed in the hope that it will be useful, but
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
11 ## WITHOUT ANY WARRANTY; without even the implied warranty of
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
12 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
13 ## General Public License for more details.
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
14 ##
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
15 ## You should have received a copy of the GNU General Public License
7016
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6046
diff changeset
16 ## along with Octave; see the file COPYING. If not, see
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6046
diff changeset
17 ## <http://www.gnu.org/licenses/>.
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
18
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
19 ## -*- texinfo -*-
5411
bee21f388110 [project @ 2005-07-13 17:53:44 by jwe]
jwe
parents: 5410
diff changeset
20 ## @deftypefn {Function File} {} betainv (@var{x}, @var{a}, @var{b})
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
21 ## For each component of @var{x}, compute the quantile (the inverse of
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
22 ## the CDF) at @var{x} of the Beta distribution with parameters @var{a}
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
23 ## and @var{b}.
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
24 ## @end deftypefn
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
25
5428
2a16423e4aa0 [project @ 2005-08-23 18:38:27 by jwe]
jwe
parents: 5411
diff changeset
26 ## Author: KH <Kurt.Hornik@wu-wien.ac.at>
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
27 ## Description: Quantile function of the Beta distribution
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
28
5411
bee21f388110 [project @ 2005-07-13 17:53:44 by jwe]
jwe
parents: 5410
diff changeset
29 function inv = betainv (x, a, b)
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
30
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
31 if (nargin != 3)
6046
34f96dd5441b [project @ 2006-10-10 16:10:25 by jwe]
jwe
parents: 5428
diff changeset
32 print_usage ();
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
33 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
34
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
35 if (!isscalar (a) || !isscalar(b))
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
36 [retval, x, a, b] = common_size (x, a, b);
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
37 if (retval > 0)
5411
bee21f388110 [project @ 2005-07-13 17:53:44 by jwe]
jwe
parents: 5410
diff changeset
38 error ("betainv: x, a and b must be of common size or scalars");
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
39 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
40 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
41
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
42 sz = size (x);
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
43 inv = zeros (sz);
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
44
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
45 k = find ((x < 0) | (x > 1) | !(a > 0) | !(b > 0) | isnan (x));
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
46 if (any (k))
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
47 inv (k) = NaN;
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
48 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
49
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
50 k = find ((x == 1) & (a > 0) & (b > 0));
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
51 if (any (k))
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
52 inv (k) = 1;
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
53 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
54
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
55 k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0));
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
56 if (any (k))
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
57 if (!isscalar(a) || !isscalar(b))
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
58 a = a (k);
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
59 b = b (k);
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
60 y = a ./ (a + b);
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
61 else
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
62 y = a / (a + b) * ones (size (k));
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
63 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
64 x = x (k);
7795
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
65
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
66 if (isa (y, "single"))
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
67 myeps = eps ("single");
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
68 else
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
69 myeps = eps;
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
70 endif
7795
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
71
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
72 l = find (y < myeps);
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
73 if (any (l))
7795
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
74 y(l) = sqrt (myeps) * ones (length (l), 1);
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
75 endif
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
76 l = find (y > 1 - myeps);
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
77 if (any (l))
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
78 y(l) = 1 - sqrt (myeps) * ones (length (l), 1);
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
79 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
80
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
81 y_old = y;
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
82 for i = 1 : 10000
5411
bee21f388110 [project @ 2005-07-13 17:53:44 by jwe]
jwe
parents: 5410
diff changeset
83 h = (betacdf (y_old, a, b) - x) ./ betapdf (y_old, a, b);
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
84 y_new = y_old - h;
7795
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
85 ind = find (y_new <= myeps);
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
86 if (any (ind))
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
87 y_new (ind) = y_old (ind) / 10;
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
88 endif
7795
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
89 ind = find (y_new >= 1 - myeps);
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
90 if (any (ind))
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
91 y_new (ind) = 1 - (1 - y_old (ind)) / 10;
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
92 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
93 h = y_old - y_new;
7795
df9519e9990c Handle single precision eps values
David Bateman <dbateman@free.fr>
parents: 7017
diff changeset
94 if (max (abs (h)) < sqrt (myeps))
5410
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
95 break;
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
96 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
97 y_old = y_new;
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
98 endfor
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
99
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
100 inv (k) = y_new;
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
101 endif
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
102
56e066f5efc1 [project @ 2005-07-13 17:43:35 by jwe]
jwe
parents:
diff changeset
103 endfunction