math.extras: adding integer-sqrt.

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

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
+grouping kernel locals math math.bitwise math.combinatorics
-math.functions math.order math.primes math.primes.factors
+math.constants math.functions math.order math.primes
-math.ranges math.ranges.private math.statistics math.vectors
+math.primes.factors math.ranges math.ranges.private
-memoize parser random sequences sequences.extras
+math.statistics math.vectors memoize parser random sequences
-sequences.private sets sorting sorting.extras ;
+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 ;