add basis.math.functions.integer-logs: exact integer logarithms
Jon Harper
John Benediktsson
parent
34f36a529e
commit
bf852cea6a
|
|
@ -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"
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
Loading…
Reference in New Issue