From a4c0ae98c53c491060a5dd77bc4961c579481a08 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 1 Apr 2015 21:34:54 -0700
Subject: [PATCH] math.extras: adding the Kelly criterion.

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

diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index 3f56fe2c2e..6fc69a25f2 100644
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -157,3 +157,7 @@ IN: math.extras.test
 } [
     30 [1,b] [ mobius ] map
 ] unit-test
+
+{ 0.2 } [ 0.6 1 kelly ] unit-test
+{ 0.0 } [ 0.5 1 kelly ] unit-test
+{ -0.2 } [ 0.4 1 kelly ] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index 90d8d4f19f..1072b9801b 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -322,3 +322,6 @@ M: iota-tuple sum-cubes sum sq ;
         dup [ 1 > ] any?
         [ drop 0 ] [ length even? 1 -1 ? ] if
     ] if-empty ;
+
+: kelly ( winning-probability odds -- fraction )
+    [ 1 + * 1 - ] [ / ] bi ;