Mercurial > hg > octave-lyh

annotate scripts/specfun/nchoosek.m @ 8404:868149aac690

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
nchoosek checks, warning, corner cases and tests
author Francesco Potortì <pot@gnu.org>
date Sat, 13 Dec 2008 20:08:30 +0100
parents 343f0fbca6eb
children bc982528de11
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) 2001, 2006, 2007 Rolf Fabian and Paul Kienzle
8391
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
2 ## Copyright (C) 2008 Jaroslav Hajek
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
3 ##
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
4 ## This file is part of Octave.
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
5 ##
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
6 ## Octave is free software; you can redistribute it and/or modify it
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
7 ## 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: 6754
diff changeset
8 ## the Free Software Foundation; either version 3 of the License, or (at
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6754
diff changeset
9 ## your option) any later version.
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
10 ##
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
11 ## Octave is distributed in the hope that it will be useful, but
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
12 ## WITHOUT ANY WARRANTY; without even the implied warranty of
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
13 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
14 ## General Public License for more details.
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
15 ##
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
16 ## 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: 6754
diff changeset
17 ## along with Octave; see the file COPYING. If not, see
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6754
diff changeset
18 ## <http://www.gnu.org/licenses/>.
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
19
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
20 ## -*- texinfo -*-
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
21 ## @deftypefn {Function File} {@var{c} =} nchoosek (@var{n}, @var{k})
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
22 ##
6575
9ef0450c873d [project @ 2007-04-25 14:07:20 by jwe]
jwe
parents: 6377
diff changeset
23 ## Compute the binomial coefficient or all combinations of @var{n}.
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
24 ## If @var{n} is a scalar then, calculate the binomial coefficient
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
25 ## of @var{n} and @var{k}, defined as
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
26 ##
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
27 ## @iftex
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
28 ## @tex
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
29 ## $$
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
30 ## {n \choose k} = {n (n-1) (n-2) \cdots (n-k+1) \over k!}
6754
451b346d8c2f [project @ 2007-06-25 17:31:46 by jwe]
jwe
parents: 6575
diff changeset
31 ## = {n! \over k! (n-k)!}
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
32 ## $$
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
33 ## @end tex
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
34 ## @end iftex
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
35 ## @ifinfo
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
36 ##
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
37 ## @example
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
38 ## @group
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
39 ## / \
6754
451b346d8c2f [project @ 2007-06-25 17:31:46 by jwe]
jwe
parents: 6575
diff changeset
40 ## | n | n (n-1) (n-2) ... (n-k+1) n!
451b346d8c2f [project @ 2007-06-25 17:31:46 by jwe]
jwe
parents: 6575
diff changeset
41 ## | | = ------------------------- = ---------
451b346d8c2f [project @ 2007-06-25 17:31:46 by jwe]
jwe
parents: 6575
diff changeset
42 ## | k | k! k! (n-k)!
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
43 ## \ /
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
44 ## @end group
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
45 ## @end example
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
46 ## @end ifinfo
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
47 ##
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
48 ## If @var{n} is a vector generate all combinations of the elements
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
49 ## of @var{n}, taken @var{k} at a time, one row per combination. The
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
50 ## resulting @var{c} has size @code{[nchoosek (length (@var{n}),
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
51 ## @var{k}), @var{k}]}.
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
52 ##
8404
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
53 ## @code{nchoosek} works only for nonnegative integer arguments; use
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
54 ## @code{bincoeff} for non-integer scalar arguments and for using vector
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
55 ## arguments to compute many coefficients at once.
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
56 ##
6316
a3a2580435c2 [project @ 2007-02-16 07:23:49 by jwe]
jwe
parents: 5827
diff changeset
57 ## @seealso{bincoeff}
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
58 ## @end deftypefn
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
59
6316
a3a2580435c2 [project @ 2007-02-16 07:23:49 by jwe]
jwe
parents: 5827
diff changeset
60 ## Author: Rolf Fabian <fabian@tu-cottbus.de>
a3a2580435c2 [project @ 2007-02-16 07:23:49 by jwe]
jwe
parents: 5827
diff changeset
61 ## Author: Paul Kienzle <pkienzle@users.sf.net>
8404
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
62 ## Author: Jaroslav Hajek
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
63
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
64 function A = nchoosek (v, k)
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
65
8404
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
66 if (nargin != 2
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
67 || !isnumeric(k) || !isnumeric(v)
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
68 || !isscalar(k) || (!isscalar(v) && !isvector(v)))
6316
a3a2580435c2 [project @ 2007-02-16 07:23:49 by jwe]
jwe
parents: 5827
diff changeset
69 print_usage ();
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
70 endif
8404
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
71 if ((isscalar(v) && v < k) || k < 0
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
72 || k != round(k) || any (v < 0 || v != round(v)))
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
73 error ("nchoosek: args are nonnegative integers with V not less than K");
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
74 endif
5827
1fe78adb91bc [project @ 2006-05-22 06:25:14 by jwe]
jwe
parents:
diff changeset
75
6318
bae85c1e0e2a [project @ 2007-02-16 08:15:25 by jwe]
jwe
parents: 6316
diff changeset
76 n = length (v);
bae85c1e0e2a [project @ 2007-02-16 08:15:25 by jwe]
jwe
parents: 6316
diff changeset
77
bae85c1e0e2a [project @ 2007-02-16 08:15:25 by jwe]
jwe
parents: 6316
diff changeset
78 if (n == 1)
8404
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
79 k = min (k, v-k); # improve precision at next step
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
80 A = round (prod ((v-k+1:v)./(1:k)));
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
81 if (A*2*k*eps >= 0.5)
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
82 warning ("nchoosek", "nchoosek: possible loss of precision");
8391
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
83 endif
8404
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
84 elseif (k == 0)
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
85 A = [];
6318
bae85c1e0e2a [project @ 2007-02-16 08:15:25 by jwe]
jwe
parents: 6316
diff changeset
86 elseif (k == 1)
bae85c1e0e2a [project @ 2007-02-16 08:15:25 by jwe]
jwe
parents: 6316
diff changeset
87 A = v(:);
8404
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
88 elseif (k == n)
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
89 A = v(:).';
8391
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
90 elseif (k > n)
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
91 A = zeros (0, k, class (v));
6318
bae85c1e0e2a [project @ 2007-02-16 08:15:25 by jwe]
jwe
parents: 6316
diff changeset
92 else
8391
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
93 p = cell (1, k);
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
94 # hack: do the op in the smallest integer class possible to avoid moving
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
95 # too much data.
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
96 if (n < intmax ("uint8"))
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
97 cl = "uint8";
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
98 elseif (n < intmax ("uint16"))
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
99 cl = "uint16";
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
100 elseif (n < intmax ("uint32"))
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
101 cl = "uint32";
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
102 else
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
103 # This would exhaust memory anyway.
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
104 cl = "double";
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
105 endif
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
106
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
107 # Use a generalized Pascal triangle. Traverse backwards to keep
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
108 # alphabetical order.
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
109 for i = 1:k
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
110 p{i} = zeros (0, i, cl);
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
111 endfor
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
112 s = ones (1, 1, cl);
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
113 p{1} = n*s;
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
114 for j = n-1:-1:1
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
115 for i = k:-1:2
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
116 q = p{i-1};
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
117 p{i} = [[repmat(s*j, rows (p{i-1}), 1), p{i-1}]; p{i}];
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
118 endfor
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
119 p{1} = [j;p{1}];
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
120 endfor
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
121 v = v(:);
343f0fbca6eb implement nchoosek without recursion
Jaroslav Hajek <highegg@gmail.com>
parents: 8361
diff changeset
122 A = v(p{k});
6318
bae85c1e0e2a [project @ 2007-02-16 08:15:25 by jwe]
jwe
parents: 6316
diff changeset
123 endif
8361
cf620941af1a Set max_recursion_depth and use a subfunction in nchoosek
Francesco Potortì <pot@gnu.org>
parents: 7017
diff changeset
124 endfunction
6318
bae85c1e0e2a [project @ 2007-02-16 08:15:25 by jwe]
jwe
parents: 6316
diff changeset
125
8404
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
126 %!warning (nchoosek(100,45));
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
127 %!error (nchoosek(100,45.5));
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
128 %!error (nchoosek(100,145));
868149aac690 nchoosek checks, warning, corner cases and tests
Francesco Potortì <pot@gnu.org>
parents: 8391
diff changeset
129 %!assert (nchoosek(80,10), bincoeff(80,10))
8361
cf620941af1a Set max_recursion_depth and use a subfunction in nchoosek
Francesco Potortì <pot@gnu.org>
parents: 7017
diff changeset
130 %!assert (nchoosek(1:5,3),[1:3;1,2,4;1,2,5;1,3,4;1,3,5;1,4,5;2:4;2,3,5;2,4,5;3:5])