From 8d8e59c43eb433b08d3662379f8a1466e7884295 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 7 Nov 2019 21:32:07 -0800
Subject: [PATCH] math.extras: adding integer-sqrt.

---
 extra/math/extras/extras-tests.factor |  6 ++++++
 extra/math/extras/extras.factor       | 25 ++++++++++++++++++++-----
 2 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index 1d10a680d9..75caa52676 100644
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -151,3 +151,9 @@ tools.test ;
 { 1/5 } [ 3/5 1 kelly ] unit-test
 { 0 } [ 1/2 1 kelly ] unit-test
 { -1/5 } [ 2/5 1 kelly ] unit-test
+
+[ -1 integer-sqrt ] must-fail
+{ 0 } [ 0 integer-sqrt ] unit-test
+{ 3 } [ 12 integer-sqrt ] unit-test
+{ 4 } [ 16 integer-sqrt ] unit-test
+{ 44 } [ 2019 integer-sqrt ] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index 8136bdbd55..b38d98d0bf 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -3,11 +3,11 @@
 
 USING: accessors arrays assocs assocs.extras byte-arrays
 combinators combinators.short-circuit compression.zlib fry
-grouping kernel locals math math.combinatorics math.constants
-math.functions math.order math.primes math.primes.factors
-math.ranges math.ranges.private math.statistics math.vectors
-memoize parser random sequences sequences.extras
-sequences.private sets sorting sorting.extras ;
+grouping kernel locals math math.bitwise math.combinatorics
+math.constants math.functions math.order math.primes
+math.primes.factors math.ranges math.ranges.private
+math.statistics math.vectors memoize parser random sequences
+sequences.extras sequences.private sets sorting sorting.extras ;
 
 IN: math.extras
 
@@ -357,3 +357,18 @@ M: iota sum-cubes sum sq ;
 
 : kelly ( winning-probability odds -- fraction )
     [ 1 + * 1 - ] [ / ] bi ;
+
+:: integer-sqrt ( m -- n )
+    m [ 0 ] [
+        dup 0 < [ non-negative-integer-expected ] when
+        bit-length 1 - 2 /i :> c
+        1 :> a!
+        0 :> d!
+        c bit-length <iota> <reversed> [| s |
+            d :> e
+            c s neg shift d!
+            a d e - 1 - shift
+            m 2 c * e - d - 1 + neg shift a /i + a!
+        ] each
+        a a sq m > [ 1 - ] when
+    ] if-zero ;