From 905e26e9e065cdefb50b529b7f3de0b8259e3230 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 26 Sep 2012 15:25:45 -0700
Subject: [PATCH] math.extras: adding the Herfindahl measure.

---
 extra/math/extras/extras-tests.factor | 3 +++
 extra/math/extras/extras.factor       | 7 +++++++
 2 files changed, 10 insertions(+)

diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index d47a00dbab..d5232cb4de 100644
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -65,3 +65,6 @@ IN: math.extras.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
+
+{ 57/200 } [ { 80 60 10 20 30 } herfindahl ] unit-test
+{ 17/160 } [ { 80 60 10 20 30 } normalized-herfindahl ] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index 9ba914930f..79fc89d2cb 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -178,3 +178,10 @@ PRIVATE>
     ] [
         [ gini ] [ length [ ] [ 1 - ] bi / ] bi *
     ] if ;
+
+: herfindahl ( seq -- x )
+    dup sum sq '[ sq _ / ] map-sum ;
+
+: normalized-herfindahl ( seq -- x )
+    [ herfindahl ] [ length recip ] bi
+    [ - ] [ 1 swap - / ] bi ;