From 673d280fc5a02346b732a645a2846c3a1596ac1c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Sep 2011 21:37:39 -0500 Subject: [PATCH] Vocabulary to reduce numbers to more convenient representations --- extra/units/reduction/authors.txt | 1 + extra/units/reduction/reduction-tests.factor | 56 +++++++++++++++++++ extra/units/reduction/reduction.factor | 58 ++++++++++++++++++++ extra/units/reduction/summary.txt | 1 + 4 files changed, 116 insertions(+) create mode 100644 extra/units/reduction/authors.txt create mode 100644 extra/units/reduction/reduction-tests.factor create mode 100644 extra/units/reduction/reduction.factor create mode 100644 extra/units/reduction/summary.txt diff --git a/extra/units/reduction/authors.txt b/extra/units/reduction/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/units/reduction/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/units/reduction/reduction-tests.factor b/extra/units/reduction/reduction-tests.factor new file mode 100644 index 0000000000..001a9d658d --- /dev/null +++ b/extra/units/reduction/reduction-tests.factor @@ -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 diff --git a/extra/units/reduction/reduction.factor b/extra/units/reduction/reduction.factor new file mode 100644 index 0000000000..52279771f9 --- /dev/null +++ b/extra/units/reduction/reduction.factor @@ -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! ; diff --git a/extra/units/reduction/summary.txt b/extra/units/reduction/summary.txt new file mode 100644 index 0000000000..92de1896bb --- /dev/null +++ b/extra/units/reduction/summary.txt @@ -0,0 +1 @@ +Reduce units to most convenient format