Translate this code into real Rebol?
[1/10] from: sunandadh:aol at: 23-Jan-2002 6:35
Here's a useful function (I think). It "pretty prints" numbers and currency
amounts. Examples of output:
>> pretty-print-number 123
== "123"
>> pretty-print-number 12345
== "12,345"
>> pretty-print-number $12345
== "£12,345.00"
>> pretty-print-number -12345
== "-12,345"
>> pretty-print-number/brackets -12345
== "(12,345)"
>> pretty-print-number/brackets -$12345
== "(£12,345.00)"
>> pretty-print-number/brackets -$12345.68
== "(£12,345.68)"
You can change the currency symbol, decimal and thousands separators, though
not easily (eg for India) the digit groupings.
It's typical of the sort of code I knock out in a hurry--in this case for the
prototype I mention in an earlier post. It works, but it could almost be
Basic. Is there a more Rebolish (Rebellious? Rebvolting?) way of doing this?
= = = = = = = = = = = = = = = = = rebol []
Pretty-print-number: func [in-amount [Money! Integer! Decimal!]
/Brackets
/local
work
out-string
thousands-sep
decimal-sep
currency-sign
][
thousands-sep: ","
decimal-sep: "."
currency-sign: "£"
work: parse/all to-string in-amount decimal-sep
out-string: copy ""
if (length? work) > 1 [
insert out-string join decimal-sep work/2]
while [(length? work/1) > 3] [
insert out-string copy skip work/1 ((length? work/1) - 3)
insert out-string thousands-sep
work/1: copy/part work/1 ((length? work/1) - 3)
]
insert out-string work/1
;; Fix the messes (like -,123 and $,123,456.78)
;; ============================================
replace out-string join "-" thousands-sep "-"
replace out-string "$," "$"
replace out-string "$" currency-sign
if all [negative? in-amount Brackets ][
replace out-string "-" ""
out-string: join "(" [out-string ")"]
]
return out-string
] ; func
= = = = = = = = = = = = = = = = Thanks,
Sunanda.
[2/10] from: joel:neely:fedex at: 23-Jan-2002 8:04
Hi, Sunanda,
I can't resist a good refactoring exercise... ;-)
[SunandaDH--aol--com] wrote:
> Here's a useful function (I think). It "pretty prints" numbers
> and currency amounts...
>
...
> It's typical of the sort of code I knock out in a hurry--in this
> case for the prototype I mention in an earlier post...
>
and quite nicely, IMHO!
> It works, but it could almost be Basic. Is there a more Rebolish
> (Rebellious? Rebvolting?) way of doing this?
>
I'm not sure how rebolting I am ;-) but here is a variation that
includes some alternatives you might consider. This one is also
deliberately very simple/explicit, in the interest of readability.
8<----------------------------------------------------------------
pp-number: func [
in-amount [Money! Integer! Decimal!]
/Brackets
/local work out-string thousands-sep decimal-sep currency-sign
][
thousands-sep: ","
decimal-sep: "."
currency-sign: "£"
work: parse/all to-string in-amount decimal-sep
out-string: work/1
if negative? in-amount [remove out-string] ;; remove "-"
if money? in-amount [remove out-string] ;; remove "$"
if 3 < length? out-string [
out-string: skip tail out-string -3 ;; to last 3 digits
while [1 < index? out-string] [ ;; insert as needed
insert out-string thousands-sep
out-string: skip out-string -3
]
]
if 1 < length? work [repend out-string [decimal-sep work/2]]
if money? in-amount [insert out-string currency-sign]
if negative? in-amount [
either Brackets [
out-string: join "(" [out-string ")"]
][
insert out-string "-"
]
]
out-string
]
8<----------------------------------------------------------------
A few comments about strategy:
* I tend to be reductionist in handling things like currency
symbols and negative signs; just eliminate them (remembering
that I did so!) and put them back after solving the simpler
remaining case. The same applied to the fractional part.
* Instead of after-the-fact correction of things like "-," and
"$," I try to keep from occurring at all.
* There are LOTS of variations on inserting thousands separators
in numeric strings. Some are probably more "rebollious" than
the one above, but I think it's fairly clear what it's doing
(and it does use a couple of REBOL-specific string tricks).
* I've gotten more in the habit of reserving RETURN for those
situations where I'm actually doing an "premature exit with
result" from a function. Since REBOL takes the last expression
evaluated in a function as the function's value, ending a
function with RETURN adds time, produces no benefit, and may
help newbie readers avoid learning that standard rule.
However, these are just my opinions, and YMMV.
Thanks for the interesting puzzle!
-jn-
--
; sub REBOL {}; sub head ($) {@_[0]}
REBOL []
# despam: func [e] [replace replace/all e ":" "." "#" "@"]
; sub despam {my ($e) = @_; $e =~ tr/:#/.@/; return "\n$e"}
print head reverse despam "moc:xedef#yleen:leoj" ;
[3/10] from: sunandadh:aol at: 23-Jan-2002 10:51
Hi Joel,
> I can't resist a good refactoring exercise... ;-)
<snip>
> Thanks for the interesting puzzle!
Thanks for the ideas. It is always good to see how other people would do
something. I find that very useful. It's a bit like having your pronunciation
corrected when learning another language.
Fess-up time. My original code had the inevitable bug, only--as
usual--noticed too late. If you change decimal-sep and thousands-sep, eg:
thousands-sep: "."
decimal-sep: ","
it goes wrong because it assumes Rebol is using the same decimal-sep
internally. Of course it isn't. I still need a literal "." for handling the
decimal while it's still a number.
Sunanda.
[4/10] from: g:santilli:tiscalinet:it at: 23-Jan-2002 22:32
Hello [SunandaDH--aol--com]!
On 23-Gen-02, you wrote:
S> works, but it could almost be Basic. Is there a more Rebolish
S> (Rebellious? Rebvolting?) way of doing this?
I don't know if this is more REBOLish, and it does not have all
the features of your version, but the output can be loaded by
REBOL and I've been using it for a lot of time.
>> form-decimal 123 none 2
== "123,00"
>> form-decimal 12345 none 2
== "12'345,00"
>> form-decimal 12345678 none 0
== "12'345'678"
>> form-decimal 123 10 2
== " 123,00"
>> form-decimal 123456 10 2
== "123'456,00"
right: func [str [string!] n [integer!]] [
head insert/part insert/dup make string! n #" " n - length? str tail str negate n
]
form-decimal: func [num [number!] len [integer! none!] cifre [integer!] /local str num-len]
[
; ***WARNING*** positive numbers only.
num: abs num
str: make string! len
either zero? num [
num-len: 1
if cifre > 0 [num-len: num-len + cifre + 1]
len: any [len num-len]
insert insert/dup str #" " subtract len num-len #"0"
if cifre > 0 [insert/dup insert tail str #"," #"0" cifre]
] [
if 14 < add cifre log-10 num [return either len [right form num len] [form num]]
num: form add multiply power 10 cifre to-decimal num 0,5
clear any [find num "." ""]
; for numbers < 1
insert/dup num #"0" 1 + cifre - length? num
cifre: skip tail num negate cifre
num-len: to-integer divide subtract index? cifre 2 3
num-len: add num-len length? num
if not tail? cifre [num-len: add num-len 1]
len: any [len num-len]
insert/part
insert/dup str #" " subtract len num-len
num
num: skip num add 1 (subtract index? cifre 2) // 3
while [(index? cifre) > (index? num)] [
insert/part insert tail str #"'" num num: skip num 3
]
if not tail? cifre [
insert insert tail str #"," cifre
]
]
str
]
Regards,
Gabriele.
--
Gabriele Santilli <[giesse--writeme--com]> - Amigan - REBOL programmer
Amiga Group Italia sez. L'Aquila -- http://www.amyresource.it/AGI/
[5/10] from: jeff:rebol at: 23-Jan-2002 17:00
Another entry for the number pretty printer:
pretty-number: func [
in-amt [money! integer! decimal!]
/local i-part f-part h-part out e neg get-high
thousands-sep decimal-sep currency p-amt zpad
][
decimal-sep: #. thousands-sep: #, currency: #£
set [i-part neg f-part get-high zpad] reduce [
abs to-integer any [
all [money? in-amt out: copy currency in-amt: in-amt/2]
all [out: copy currency: # in-amt]
]
pick ["-" ""] negative? in-amt
do pick [[join decimal-sep f-part] #]
found? f-part: find/reverse/tail tail form in-amt #.
func [x m /local p s][
reduce either x > p: 10 ** m [[s: to-integer x / p x - (s * p)]][[# x]]
]
func [e x][either e [x][skip tail append copy #000 x -3]]
]
for i 99 3 -3 [
set [h-part i-part] get-high i-part i
if any [not e: currency = out number? h-part][
repend out [zpad e h-part thousands-sep]
]
]
rejoin [neg out zpad e i-part f-part]
]
commentary: {
This has various REBOL idioms mixed in with my own.
The way I did the function is a common approach I find I do in
programming: breakdown, process, synthesize. In REBOL that
amounts to first setting various locals, then doing some
processing loop, ending with some kind of REDUCE or JOIN.
Another REBOL idiom used is to "piggy-back" work in certain
convenient places, for example, in the process of setting
'i-part I conditionally extract the number portion of in-amt
if it's a money! in turn making sure that my output string is
initialized with the currency or not depending on if money?.
Similarly, I "piggy-back" all the word setting together,
(except for the three user-vars which I left at the top).
I tried to avoid the RT favorite bug-bear, which is to turn
all problems into pure string processing. Working with the
item-in-question's natural datatype (number), with the notable
exception of handling the fractional part.
One of my idioms is I often (ab)use issue! datatype. That's
because no one seems to use it and I want to be original. (-:
To ensure we get a string result, I just make sure NEG is a
string.
Another handy REBOL idiom is to have a function which returns
a block. The block contains your "answer" as well as the next
increment. You can see this with
set [h-part i-part] get-high i-part i
'I-part gets moved along by each call to GET-HIGH. For
example, look at LOAD/next and DO/next.
Lets see.. I also removed the brackets refinement because I
felt it didn't go with the function, but should go somewhere
else.
Now, Joel may benchmark these functions and demonstrate that
my code is not the optimal solution. (-: This is likely
because of the inner functions among other things. Inner
functions are used when you want to share context, but in the
case above, I defined them inside the function because they go
with its "thinking". They'll likely be a performance hit,
though (among other things).
But efficiency wasn't a condition to play, so the optimization
can be left as an exercise for performance critical uses.
-jeff
}
[6/10] from: joel:neely:fedex at: 23-Jan-2002 20:52
Hi, Jeff,
Perhaps you can shed some light on a couple of questions...
Jeff Kreis wrote:
> Similarly, I "piggy-back" all the word setting together,
> (except for the three user-vars which I left at the top).
>
I did some test a while back that indicated that
set [word1 word2 word3 ... wordN] reduce [
expression1
expression2
expression3
...
expressionN
]
takes a surprising performance hit compared with
word1: expression1
word2: expression2
word3: expression3
...
wordN: expressionN
(example in footnote below). I'm very fond of the idea of
concurrent assignment
(or whatever other term one would
prefer) for a variety of reasons, but have a hard time with
the performance penalty.
Is it reasonable to believe that the majority of the extra
time required by the block SET is due to REDUCE -- specifically
the time required to allocate, and store values in, a new block?
Is there any hope of a "special form" or other means of
avoiding the cost penalty?
> Now, Joel may benchmark these functions and demonstrate that
> my code is not the optimal solution. (-:
>
Time isn't the only measure of optimality; readability also
counts for something! ;-)
> This is likely because of the inner functions among other
> things. Inner functions are used when you want to share
> context, but in the case above, I defined them inside the
> function because they go with its "thinking". They'll likely
> be a performance hit, though (among other things).
>
I'm also fond of using inner functions as a way to package
meaningful chunks of sub-computations without polluting the
enclosing namespace, but have pondered how to get those
benefits without the cost of (inner) function definition for
every (outer function) evaluation. One idea that I've played
with is employing USE to hide the helper(s), as in
fibonacci: use [fibohelp] [
fibohelp: func [n [integer!] /local a b] [
a: 0 b: 1
while [n > 0] [a: (b: b + a) - a n: n - 1]
a
]
func [n [integer!]] [
either all [negative? n even? n] [
- fibohelp abs n
][
fibohelp abs n
]
]
]
which allows the helper to be defined once for all, instead
of redefining it every time the parent is evaluated.
Of course, this has the drawback it doesn't allow the
(formerly inner) helper function access to the outer function's
namespace. This limitation can be fixed by placing the shared
words within the USE context, but then that has really nasty
consequences on recursion!
Any thoughts on how to get the benefits of inner functions
(nice "packaging" and communication of ideas, maximum locality,
minimizing global namespace impact, shared context) without
the overhead of redefinition on every use?
-jn-
8<------------------------------------------------------------
Footnote: The following functions demonstrate the extra
time required for block SET, and provide some evidence that
REDUCE is the culprit.
; set three words to trivial expressions via block SET
bset3: func [n [integer!] /local t0 w0 w1 w2] [
t0: now/time/precise
repeat i n [set [w0 w1 w2] reduce [i i i]]
now/time/precise - t0
]
; set three words to trivial expressions individually
iset3: func [n [integer!] /local t0 w0 w1 w2] [
t0: now/time/precise
repeat i n [w0: i w1: i w2: i]
now/time/precise - t0
]
; set one word to a block of trivial expressions
setb3: func [n [integer!] /local t0 w0] [
t0: now/time/precise
repeat i n [w0: reduce [i i i]]
now/time/precise - t0
]
; "chain" set three words to a trivial expression
cset3: func [n [integer!] /local t0 w0 w1 w2] [
t0: now/time/precise
repeat i n [w0: w1: w2: i]
now/time/precise - t0
]
>> print [cset3 1000000 iset3 1000000 setb3 1000000 bset3 1000000]
0:00:02.96 0:00:04.34 0:00:22.41 0:00:27.9
CSET3 provides a baseline for the overhead of the loop and the three
set-words. The additional time required by ISET3 is due to the two
additional evaluations of I. REDUCEing a block of three occurrences
of I takes about 5 times as much time as evaluating I three times.
Doing the block SET bumps the time up further (this increase alone
is more than the total time for the three set-word version).
--
; sub REBOL {}; sub head ($) {@_[0]}
REBOL []
# despam: func [e] [replace replace/all e ":" "." "#" "@"]
; sub despam {my ($e) = @_; $e =~ tr/:#/.@/; return "\n$e"}
print head reverse despam "moc:xedef#yleen:leoj" ;
[7/10] from: brett:codeconscious at: 24-Jan-2002 15:18
Hi Joel,
I know your message was directed to Jeff and I look forward to his answer.
> Any thoughts on how to get the benefits of inner functions
> (nice "packaging" and communication of ideas, maximum locality,
> minimizing global namespace impact, shared context) without
> the overhead of redefinition on every use?
I don't pretend to have a good answer, but thought I'd share
this; what about a defining a context (object!)?
make context [fibohelp: none] [
set 'fibonacci func [n [integer!] /test][
fibohelp: func [n [integer!] /local a b] [
a: 0 b: 1
while [n > 0] [a: (b: b + a) - a n: n - 1]
print ["by the way the value of test is:" mold test]
a
]
either all [negative? n even? n] [
- fibohelp abs n
] [
fibohelp abs n
]
]
]
The good thing is Fibohelp can utilise words from Fibonacci's namespace. The
bad thing is
if you wanted Fibonacci in an object of itself. The assumed thing is that
there is no redefinition
occurring every call.
Brett.
[8/10] from: joel::neely::fedex::com at: 23-Jan-2002 23:40
Hi, Brett,
Brett Handley wrote:
> make context [fibohelp: none] [
> set 'fibonacci func [n [integer!] /test][
<<quoted lines omitted: 14>>
> namespace... The assumed thing is that there is no redefinition
> occurring every call.
AFAICT that's a bad assumption, and the above is just a more
complicated way of saying
fibonacci: func [n [integer!] /local fibohelp] [
fibohelp: func [n [integer!] /local a b] [
a: 0 b: 1
while [n > 0] [a: (b: b + a) - a n: n - 1]
a
]
either all [negative? n even? n] [
- fibohelp abs n
][
fibohelp abs n
]
]
which actually *does* redefine FIBOHELP every time FIBONACCI is
invoked.
Both of the above versions run about four and a half times
slower than the version (posted earlier) created with USE.
(I removed the /TEST refinement and related PRINT before
running the timing tests so that I/O lag wouldn't affect
the results.)
-jn-
--
; sub REBOL {}; sub head ($) {@_[0]}
REBOL []
# despam: func [e] [replace replace/all e ":" "." "#" "@"]
; sub despam {my ($e) = @_; $e =~ tr/:#/.@/; return "\n$e"}
print head reverse despam "moc:xedef#yleen:leoj" ;
[9/10] from: rotenca:telvia:it at: 24-Jan-2002 17:07
> It's typical of the sort of code I knock out in a hurry--in this case for
the
> prototype I mention in an earlier post. It works, but it could almost be
> Basic. Is there a more Rebolish (Rebellious? Rebvolting?) way of doing this?
>
> rebol []
>
> Pretty-print-number: func [in-amount [Money! Integer! Decimal!]
This is my try (i do not if it is more ...anything, only sure that it uses
parse :-)
Note:
The var 'tho-any keeps the number of digits before the thousands separator.
Should not be difficult to change it to output a fixed number of decimal also
for integer! and decimal!.
REBOL []
context [
dec: #"." tho: #"," tho-any: 3 cur: #"£"
out: ""
emit: func[x][insert tail out x]
digit: make bitset! "0123456789"
y: ism: none
rule: [
[copy y some digit "." (emit y emit dec)
| (if is-m [emit "00" emit dec])]
copy y 1 tho-any digit (emit y)
any [copy y 1 tho-any digit (emit tho emit y)]
opt [#"$" (emit cur)]
opt [#"-" (emit #"-")]
]
do [
pretty-print-number: func [
x [Money! Integer! Decimal!]
/brackets
][
is-m: money? x
clear out
x: form x
reverse x
parse/all x rule
reverse out
print either all [brackets #"-" = first out][
join replace out "-" "(" ")"
][
out
]
]
]
]
---
Ciao
Romano
[10/10] from: jeff:rebol at: 24-Jan-2002 9:14
Howdy, Joel:
> I did some test a while back that indicated that
> set [word1 word2 word3 ... wordN] reduce [
<<quoted lines omitted: 4>>
> word2: expression2
> ... wordN: expressionN
. . .
> Is it reasonable to believe that the majority of the extra
> time required by the block SET is due to REDUCE --
> specifically the time required to allocate, and store
> values in, a new block?
Well, REDUCE will add some overhead because it adds another
thing to evaluate and, as you indicate, does create a
temporary block to return as a result, but there's some other
overhead as well. Consider what happens when REBOL encounters
the following:
A) SET [foo bar] [1 2]
B) foo: 1 bar: 2
First:
A) we see SET, we evaluate the word SET and determine it's a
NATIVE. We figure out how many args it takes, then collect the
arguments (evaluating those in the process) and then we call
the native.
B) we see FOO:, it's a set-word, to evaluate the set-word we
simply evaluate the next argument and we're done.
Back in case A) We see that it's a block of something to SET
so we're trucking down the block. We need to make sure that
each thing is a word before we try and set it. Bad things
happen when you try to set, for example, a number to some
value. This used to crash REBOL: set [1 2 3] [4 5 6] So this
additional but necessary error checking adds some overhead.
Again, in case B) after encountering BAR: we just evaluate the
next argument and we're done. We've only evaluated two
arguments in this case. The process of evaluating a SET-WORDS
sets it, so it will always be more efficient than using a
NATIVE, and the native has to worry about being passed bogus
stuff. The difference in speed is a matter of a difference in
the complexity of the expressions and a difference in the
amount of evaluation that occurs.
The question of efficiency and readability reminds me:
INSERT TAIL will always be quicker than APPEND, but most
people justifiably use APPEND.
I tend to use REBOL idioms to get me down the road. If and
when I ever determine that I need a speed up then I can go
back and optimize.
If I always picked my code based on efficiency I wouldn't use
mezzanines functions, just natives.
> Any thoughts on how to get the benefits of inner functions
> (nice "packaging" and communication of ideas, maximum
> locality, minimizing global namespace impact, shared
> context) without the overhead of redefinition on every use?
REBOL modules. (-;
Or contexts in the meantime.
-jeff
Notes
- Quoted lines have been omitted from some messages.
View the message alone to see the lines that have been omitted