steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Vocabulary to reduce numbers to more convenient representations

db4
Doug Coleman 2011-09-16 21:37:39 -05:00
parent 5cf0652db4
commit 673d280fc5
4 changed files with 116 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/units/reduction/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

56
extra/units/reduction/reduction-tests.factor Normal file
View File

@ -0,0 +1,56 @@
! Copyright (C) 2011 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators fry kernel locals math math.functions
math.order math.parser sequences tools.test ;
IN: units.reduction
[ "0Bi" ] [ 0 n>storage ] unit-test
[ "0B" ] [ 0 n>Storage ] unit-test
[ "0Bi" ] [ -0 n>storage ] unit-test
[ "0B" ] [ -0 n>Storage ] unit-test
[ "1000Bi" ] [ 1,000 n>storage ] unit-test
[ "1K" ] [ 1,000 n>Storage ] unit-test
[ "976Ki" ] [ 1,000,000 n>storage ] unit-test
[ "1Mi" ] [ 2,000,000 n>storage ] unit-test
[ "190Mi" ] [ 200,000,000 n>storage ] unit-test
[ "1M" ] [ 1,000,000 n>Storage ] unit-test
[ "953Mi" ] [ 1,000,000,000 n>storage ] unit-test
[ "1G" ] [ 1,000,000,000 n>Storage ] unit-test
[ "931Gi" ] [ 1,000,000,000,000 n>storage ] unit-test
[ "1T" ] [ 1,000,000,000,000 n>Storage ] unit-test
[ "909Ti" ] [ 1,000,000,000,000,000 n>storage ] unit-test
[ "1P" ] [ 1,000,000,000,000,000 n>Storage ] unit-test
[ "888Pi" ] [ 1,000,000,000,000,000,000 n>storage ] unit-test
[ "1E" ] [ 1,000,000,000,000,000,000 n>Storage ] unit-test
[ "-1E" ] [ -1,000,000,000,000,000,000 n>Storage ] unit-test
: test-n>storage ( string -- string ) n>storage storage>n n>storage ;
: test-n>Storage ( string -- string ) n>Storage storage>n n>Storage ;
[ "0Bi" ] [ 0 test-n>storage ] unit-test
[ "0B" ] [ 0 test-n>Storage ] unit-test
[ "0Bi" ] [ -0 test-n>storage ] unit-test
[ "0B" ] [ -0 test-n>Storage ] unit-test
[ "1000Bi" ] [ 1,000 test-n>storage ] unit-test
[ "1K" ] [ 1,000 test-n>Storage ] unit-test
[ "976Ki" ] [ 1,000,000 test-n>storage ] unit-test
[ "1Mi" ] [ 2,000,000 test-n>storage ] unit-test
[ "190Mi" ] [ 200,000,000 test-n>storage ] unit-test
[ "1M" ] [ 1,000,000 test-n>Storage ] unit-test
[ "953Mi" ] [ 1,000,000,000 test-n>storage ] unit-test
[ "1G" ] [ 1,000,000,000 test-n>Storage ] unit-test
[ "931Gi" ] [ 1,000,000,000,000 test-n>storage ] unit-test
[ "1T" ] [ 1,000,000,000,000 test-n>Storage ] unit-test
[ "909Ti" ] [ 1,000,000,000,000,000 test-n>storage ] unit-test
[ "1P" ] [ 1,000,000,000,000,000 test-n>Storage ] unit-test
[ "888Pi" ] [ 1,000,000,000,000,000,000 test-n>storage ] unit-test
[ "1E" ] [ 1,000,000,000,000,000,000 test-n>Storage ] unit-test
[ "-1E" ] [ -1,000,000,000,000,000,000 test-n>Storage ] unit-test
[ "abc" storage>n ] [ bad-storage-string? ] must-fail-with
[ "-abc" storage>n ] [ bad-storage-string? ] must-fail-with
[ "10" storage>n ] [ bad-storage-string? ] must-fail-with
[ "10b" storage>n ] [ bad-storage-string? ] must-fail-with
[ "10Mib" storage>n ] [ bad-storage-string? ] must-fail-with
[ "asdfBi" storage>n ] [ bad-storage-string? ] must-fail-with
[ "asdfB" storage>n ] [ bad-storage-string? ] must-fail-with

58
extra/units/reduction/reduction.factor Normal file
View File

@ -0,0 +1,58 @@
! Copyright (C) 2011 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs combinators continuations fry kernel lexer locals
math math.functions math.order math.parser sequences splitting ;
IN: units.reduction
CONSTANT: storage-suffixes { "B" "K" "M" "G" "T" "P" "E" "Z" "Y" }
CONSTANT: unit-suffix-hash H{
{ CHAR: B 0 } { CHAR: K 1 } { CHAR: M 2 } { CHAR: G 3 }
{ CHAR: T 4 } { CHAR: P 5 } { CHAR: E 6 } { CHAR: Z 7 }
{ CHAR: Y 8 }
}
: threshhold ( n multiplier base -- x )
[ * ] dip swap ^ ; inline
:: find-unit-suffix ( suffixes n multiplier base -- i/f )
suffixes length
[ [ n ] dip multiplier base threshhold < ] find-integer
suffixes length or 1 - 0 max ;
:: reduce-magnitude ( n multiplier base suffixes -- string )
n 0 < [
n neg multiplier base suffixes reduce-magnitude
"-" prepend
] [
suffixes n multiplier base find-unit-suffix :> i
n multiplier i * base swap ^
/i number>string i suffixes nth append
] if ;
: n>storage ( n -- string )
10 2 storage-suffixes reduce-magnitude "i" append ;
: n>Storage ( n -- string )
3 10 storage-suffixes reduce-magnitude ;
ERROR: bad-storage-string string reason ;
:: (storage>n) ( string multiplier base -- n )
string last unit-suffix-hash ?at [
:> unit
string but-last string>number
[ "not a number" throw ] unless*
multiplier unit * base swap ^ *
] [
"unrecognized unit" throw
] if ;
: storage>n ( string -- n )
[ "i" ?tail [ 10 2 (storage>n) ] [ 3 10 (storage>n) ] if ]
[ \ bad-storage-string boa rethrow ] recover ;
: n>money ( n -- string )
3 10 { "" "K" "M" "B" "T" } reduce-magnitude ;
SYNTAX: STORAGE: scan storage>n suffix! ;

1
extra/units/reduction/summary.txt Normal file
View File

@ -0,0 +1 @@
Reduce units to most convenient format