[alexandria.git] updated branch master: 0e6be92 improved -- well, fixed -- SUBFACTORIAL

[Nikodemus Siivola]

The branch master has been updated:
       via  0e6be9262e000c8748942379d9c18778b393dd99 (commit)
      from  75f9136a7c62d2da139e2f45b9dad5b8aa021fa2 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 0e6be9262e000c8748942379d9c18778b393dd99
Author: Mason Smith <masonium at gmail.com>
Date:   Sun Oct 30 00:49:29 2011 +0300

    improved -- well, fixed -- SUBFACTORIAL
    
      Plus tests.

-----------------------------------------------------------------------

Summary of changes:
 numbers.lisp |   11 ++++++-----
 tests.lisp   |   25 +++++++++++++++++++++++++
 2 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/numbers.lisp b/numbers.lisp
index 0fa29a4..03430cc 100644
--- a/numbers.lisp
+++ b/numbers.lisp
@@ -227,11 +227,12 @@ greater then K."
 (defun subfactorial (n)
   "Subfactorial of the non-negative integer N."
   (check-type n (integer 0))
-  (case n
-    (0 1)
-    (1 0)
-    (otherwise
-     (floor (/ (+ 1 (factorial n)) (exp 1))))))
+  (if (zerop n)
+      1
+      (do ((x 1 (1+ x))
+           (a 0 (* x (+ a b)))
+           (b 1 a))
+          ((= n x) a))))
 
 (defun count-permutations (n &optional (k n))
   "Number of K element permutations for a sequence of N objects.
diff --git a/tests.lisp b/tests.lisp
index cb1978c..a4a8e55 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -991,6 +991,31 @@
       (list p xv))
   (2 #(10 2 10)))
 
+(deftest subfactorial.1
+    (mapcar #'subfactorial (iota 22))
+  (1
+   0
+   1
+   2
+   9
+   44
+   265
+   1854
+   14833
+   133496
+   1334961
+   14684570
+   176214841
+   2290792932
+   32071101049
+   481066515734
+   7697064251745
+   130850092279664
+   2355301661033953
+   44750731559645106
+   895014631192902121
+   18795307255050944540))
+
 ;;;; Arrays
 
 #+nil
-- 
Alexandria hooks/post-receive