From 1cf27a2af9bc756d043f8acdeeccb881b0f7e772 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 25 Sep 2012 17:54:24 -0700
Subject: [PATCH] math.extras: Fix concentration-coefficient.

---
 extra/math/extras/extras-tests.factor | 5 +++++
 extra/math/extras/extras.factor       | 6 +++++-
 2 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index ae3a69beb2..d47a00dbab 100644
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -60,3 +60,8 @@ IN: math.extras.test
 { 0 } [ { 1 1 1 1 1 1 } gini ] unit-test
 { 0 } [ { 10 10 10 10 } gini ] unit-test
 { 0 } [ { } gini ] unit-test
+
+{ 0 } [ { 1 } concentration-coefficient ] unit-test
+{ 0 } [ { 1 1 1 1 1 1 } concentration-coefficient ] unit-test
+{ 0 } [ { 10 10 10 10 } concentration-coefficient ] unit-test
+{ 0 } [ { } concentration-coefficient ] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index 550484dd89..88dcf7086a 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -172,4 +172,8 @@ PRIVATE>
     dup length 1 <= [ drop 0 ] [ (gini) ] if ;
 
 : concentration-coefficient ( seq -- x )
-    [ gini ] [ length [ ] [ 1 - ] bi / ] bi * ;
+    dup gini [
+        drop 0
+    ] [
+        [ length [ ] [ 1 - ] bi / ] dip *
+    ] if-zero ;