diff --git a/basis/math/functions/integer-logs/integer-logs-docs.factor b/basis/math/functions/integer-logs/integer-logs-docs.factor new file mode 100644 index 0000000000..df98c997db --- /dev/null +++ b/basis/math/functions/integer-logs/integer-logs-docs.factor @@ -0,0 +1,36 @@ +! Copyright (C) 2017 Jon Harper. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel math quotations ; +IN: math.functions.integer-logs + +HELP: integer-log10 +{ $values + { "x" "a positive rational number" } + { "n" integer } +} +{ $description "Outputs the largest integer " { $snippet "n" } " such that " { $snippet "10^n" } " is less than or equal to " { $snippet "x" } "." } +{ $errors "Throws an error if " { $snippet "x" } " is zero or negative." } ; + +HELP: integer-log2 +{ $values + { "x" "a positive rational number" } + { "n" integer } +} +{ $description "Outputs the largest integer " { $snippet "n" } " such that " { $snippet "2^n" } " is less than or equal to " { $snippet "x" } "." } +{ $errors "Throws an error if " { $snippet "x" } " is zero or negative." } ; + +ARTICLE: "integer-logs" "Integer logarithms" +"The " { $vocab-link "math.functions.integer-logs" } " vocabulary provides exact integer logarithms for all rational numbers:" +{ $subsections integer-log2 integer-log10 } +{ $examples + { $example + "USING: prettyprint math.functions.integer-logs sequences ;" + "{" + " 5 99 100 101 100000000000000000000" + " 100+1/2 1/100" + "} [ integer-log10 ] map ." + "{ 0 1 2 2 20 2 -2 }" + } +} ; + +ABOUT: "integer-logs" diff --git a/basis/math/functions/integer-logs/integer-logs-tests.factor b/basis/math/functions/integer-logs/integer-logs-tests.factor new file mode 100644 index 0000000000..4abe9056f2 --- /dev/null +++ b/basis/math/functions/integer-logs/integer-logs-tests.factor @@ -0,0 +1,60 @@ +! Copyright (C) 2016 Jon Harper. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test math math.functions math.functions.integer-logs ; +IN: math.functions.integer-logs.tests + +[ -576460752303423489 integer-log10 ] [ log-expects-positive? ] must-fail-with +[ -123124 integer-log10 ] [ log-expects-positive? ] must-fail-with +[ -1/2 integer-log10 ] [ log-expects-positive? ] must-fail-with +[ 0 integer-log10 ] [ log-expects-positive? ] must-fail-with + +{ 0 } [ 1 integer-log10 ] unit-test +{ 0 } [ 5 integer-log10 ] unit-test +{ 0 } [ 9 integer-log10 ] unit-test +{ 1 } [ 10 integer-log10 ] unit-test +{ 1 } [ 99 integer-log10 ] unit-test +{ 2 } [ 100 integer-log10 ] unit-test +{ 2 } [ 101 integer-log10 ] unit-test +{ 2 } [ 101 integer-log10 ] unit-test +{ 8 } [ 134217726 integer-log10 ] unit-test +{ 8 } [ 134217727 integer-log10 ] unit-test +{ 8 } [ 134217728 integer-log10 ] unit-test +{ 8 } [ 134217729 integer-log10 ] unit-test +{ 8 } [ 999999999 integer-log10 ] unit-test +{ 9 } [ 1000000000 integer-log10 ] unit-test +{ 9 } [ 1000000001 integer-log10 ] unit-test +{ 17 } [ 576460752303423486 integer-log10 ] unit-test +{ 17 } [ 576460752303423487 integer-log10 ] unit-test +{ 17 } [ 576460752303423488 integer-log10 ] unit-test +{ 17 } [ 576460752303423489 integer-log10 ] unit-test +{ 17 } [ 999999999999999999 integer-log10 ] unit-test +{ 18 } [ 1000000000000000000 integer-log10 ] unit-test +{ 18 } [ 1000000000000000001 integer-log10 ] unit-test +{ 999 } [ 1000 10^ 1 - integer-log10 ] unit-test +{ 1000 } [ 1000 10^ integer-log10 ] unit-test +{ 1000 } [ 1000 10^ 1 + integer-log10 ] unit-test + +{ 0 } [ 9+1/2 integer-log10 ] unit-test +{ 1 } [ 10 integer-log10 ] unit-test +{ 1 } [ 10+1/2 integer-log10 ] unit-test +{ 999 } [ 1000 10^ 1/2 - integer-log10 ] unit-test +{ 1000 } [ 1000 10^ integer-log10 ] unit-test +{ 1000 } [ 1000 10^ 1/2 + integer-log10 ] unit-test +{ -1000 } [ 1000 10^ 1/2 - recip integer-log10 ] unit-test +{ -1000 } [ 1000 10^ recip integer-log10 ] unit-test +{ -1001 } [ 1000 10^ 1/2 + recip integer-log10 ] unit-test +{ -1 } [ 8/10 integer-log10 ] unit-test +{ -1 } [ 4/10 integer-log10 ] unit-test +{ -1 } [ 1/10 integer-log10 ] unit-test +{ -2 } [ 1/11 integer-log10 ] unit-test + +{ 99 } [ 100 2^ 1/2 - integer-log2 ] unit-test +{ 100 } [ 100 2^ integer-log2 ] unit-test +{ 100 } [ 100 2^ 1/2 + integer-log2 ] unit-test +{ -100 } [ 100 2^ 1/2 - recip integer-log2 ] unit-test +{ -100 } [ 100 2^ recip integer-log2 ] unit-test +{ -101 } [ 100 2^ 1/2 + recip integer-log2 ] unit-test +{ -1 } [ 8/10 integer-log2 ] unit-test +{ -2 } [ 4/10 integer-log2 ] unit-test +{ -3 } [ 2/10 integer-log2 ] unit-test +{ -4 } [ 1/10 integer-log2 ] unit-test diff --git a/basis/math/functions/integer-logs/integer-logs.factor b/basis/math/functions/integer-logs/integer-logs.factor new file mode 100644 index 0000000000..2d31459d35 --- /dev/null +++ b/basis/math/functions/integer-logs/integer-logs.factor @@ -0,0 +1,108 @@ +! Copyright (C) 2017 Jon Harper. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel kernel.private math math.functions +math.functions.private math.private sequences.private ; +IN: math.functions.integer-logs + +<PRIVATE + +GENERIC: (integer-log10) ( x -- n ) foldable + +! For 32 bits systems, we could reduce +! this to the first 27 elements.. +CONSTANT: log10-guesses { + 0 0 0 0 1 1 1 2 2 2 3 3 3 3 + 4 4 4 5 5 5 6 6 6 6 7 7 7 8 + 8 8 9 9 9 9 10 10 10 11 11 11 + 12 12 12 12 13 13 13 14 14 14 + 15 15 15 15 16 16 16 17 17 +} + +! This table will hold a few unused bignums on 32 bits systems... +! It could be reduced to the first 8 elements +! Note that even though the 64 bits most-positive-fixnum +! is hardcoded here this table also works (by chance) for 32bit systems. +! This is because there is only one power of 2 greater than the +! greatest power of 10 for 27 bit unsigned integers so we don't +! need to hardcode the 32 bits most-positive-fixnum. See the +! table below for powers of 2 and powers of 10 around the +! most-positive-fixnum. +! +! 67108864 2^26 | 72057594037927936 2^56 +! 99999999 10^8 | 99999999999999999 10^17 +! 134217727 2^27-1 | 144115188075855872 2^57 +! | 288230376151711744 2^58 +! | 576460752303423487 2^59-1 +CONSTANT: log10-thresholds { + 9 99 999 9999 99999 999999 + 9999999 99999999 999999999 + 9999999999 99999999999 + 999999999999 9999999999999 + 99999999999999 999999999999999 + 9999999999999999 99999999999999999 + 576460752303423487 +} + +: fixnum-integer-log10 ( n -- x ) + dup (log2) { array-capacity } declare + log10-guesses nth-unsafe { array-capacity } declare + dup log10-thresholds nth-unsafe { fixnum } declare + rot < [ 1 + ] when ; inline + +! bignum-integer-log10-find-down and bignum-integer-log10-find-up +! work with very bad guesses, but in practice they will never loop +! more than once. +: bignum-integer-log10-find-down ( guess 10^guess n -- log10 ) + [ 2dup > ] [ [ [ 1 - ] [ 10 / ] bi* ] dip ] do while 2drop ; + +: bignum-integer-log10-find-up ( guess 10^guess n -- log10 ) + [ 10 * ] dip + [ 2dup <= ] [ [ [ 1 + ] [ 10 * ] bi* ] dip ] while 2drop ; + +: bignum-integer-log10-guess ( n -- guess 10^guess ) + (log2) >integer log10-2 * >integer dup 10^ ; + +: bignum-integer-log10 ( n -- x ) + [ bignum-integer-log10-guess ] keep 2dup > + [ bignum-integer-log10-find-down ] + [ bignum-integer-log10-find-up ] if ; inline + +M: fixnum (integer-log10) fixnum-integer-log10 { fixnum } declare ; inline + +M: bignum (integer-log10) bignum-integer-log10 ; inline + +PRIVATE> + +ERROR: log-expects-positive x ; + +<PRIVATE + +GENERIC: (integer-log2) ( x -- n ) foldable + +M: integer (integer-log2) ( x -- n ) (log2) ; inline + +: ((ratio-integer-log)) ( ratio quot -- log ) + [ >integer ] dip call ; inline + +: (ratio-integer-log) ( ratio quot base -- log ) + pick 1 >= + [ drop ((ratio-integer-log)) ] [ + [ recip ] 2dip + [ drop ((ratio-integer-log)) ] [ nip pick ^ = ] 3bi + [ 1 + ] unless neg + ] if ; inline + +M: ratio (integer-log2) ( r -- n ) [ (integer-log2) ] 2 (ratio-integer-log) ; + +M: ratio (integer-log10) ( r -- n ) [ (integer-log10) ] 10 (ratio-integer-log) ; + +: (integer-log) ( x quot -- n ) + [ dup 0 > ] dip [ log-expects-positive ] if ; inline + +PRIVATE> + +: integer-log10 ( x -- n ) + [ (integer-log10) ] (integer-log) ; inline + +: integer-log2 ( x -- n ) + [ (integer-log2) ] (integer-log) ; inline