Helpers
~~~:s:shout (s-) '!_ s:prepend s:put nl 'Stack_:_ s:put dump-stack nl ;
{{
'Depth var
:message (-)
'abort_with__trail__invoked s:shout nl
'Do__reset__to_clear_stack. s:put nl ;
:put-name (a-) fetch d:lookup-xt
dup n:-zero? [ d:name s:put nl ] [ drop ] choose ;
---reveal---
:trail repeat pop put-name again ;
:abort (-?) depth !Depth message trail ;
:s:abort (s-) 's:abort_:_ s:prepend s:put nl abort ;
}}
{{
:f:dump-astack (-)_dump_alternative_stack
f:adepth [ [ f:pop ] times ] sip 'fa_ s:put [ f:dup f:put sp f:push ] times ;
:dump-stacks (-) dump-stack nl f:dump-stack nl f:dump-astack ;
---reveal---
:s (-)___Stack dump-stacks ;
}}
{{
:f:reset (-|float:?-) f:depth [ f:drop ] times ;
:f:areset (-|alt:?-) f:depth [ f:pop f:drop ] times ;
:reset.nf (?-|float:?-) reset f:reset f:areset ;
---reveal---
:r (?-)__Reset reset.nf ;
}}
~~~
Description
This implements a means of encoding floating point values
into signed integer cells. The technique is described in
the paper titled "Encoding floating point numbers to shorter
integers" by Kiyoshi Yoneda and Charles Childers.
This will extend the f: vocabulary and adds a new e: vocabulary.
Here e: stands for encoded.
Define some constants. The range is slightly reduced from
the standard integer range as the smallest value is used
for NaN.
~~~n:MAX n:dec 'e:MAX const
n:MAX n:dec n:negate 'e:MIN const
n:MIN 'e:NAN const
n:MAX 'e:INF const
n:MAX n:negate 'e:-INF const
~~~
~~~:e:n? (e-f) e:MIN n:inc e:MAX n:dec n:between? ;
:e:max? (e-f) e:MAX eq? ;
:e:min? (e-f) e:MIN eq? ;
:e:zero? (e-f) n:zero? ;
:e:nan? (e-f) e:NAN eq? ;
:e:inf? (e-f) e:INF eq? ;
:e:-inf? (e-f) e:-INF eq? ;
:e:clip (e-e) e:MIN e:MAX n:limit ;
~~~
Since 32-bit cell takes about 9 decimal digits, if you set
[ .1e5 ] f:E1 set-hook
you will have 4 decimal digits left for the integer part of the encoded number,
which corresponds to 8 decimal digits decoded.
Encode/decode words to secure dynamic range.
This portion is the essence of the method.
~~~:f:E1 (-|f:-n)_e-unit_in_float hook .1.e5 ; (decimal_digits_to_shift_left
:f:-shift (|f:n-n)_shift_left f:E1 f:* ;
:f:+shift (|f:n-n)_shift_right f:E1 f:/ ;
:f:signed-sqrt (|f:n-n) f:dup f:sign f:abs f:sqrt n:to-float f:* ;
:f:+encode (|f:n-n) f:signed-sqrt f:-shift ;
:f:-encode (|f:n-n) f:dup f:sign f:+shift f:dup f:* n:to-float f:* ;
:f:signed-square (|f:n-n) f:dup f:sign f:dup f:* n:to-float f:* ;
~~~
Deal with special cases.
~~~:f:to-e (-e|f:n-)
f:dup f:nan? [ f:drop drop e:NAN ] if;
f:dup f:inf? [ f:drop drop e:INF ] if;
f:dup f:-inf? [ f:drop drop e:-INF ] if;
f:+encode f:round f:to-number e:clip (e
e:MIN [ f:drop ] case
e:MAX [ f:drop ] case ;
:e:to-f (e-|f:-n)
e:NAN [ drop f:NAN ] case
e:INF [ drop f:INF ] case
e:-INF [ drop f:-INF ] case
n:to-float f:-encode ;
~~~
```r .-1234.56789 f:to-e s e:to-f s
```
~~~:f:store (a-|f:n-) [ f:to-e ] dip store ;
:f:fetch (a-|f:-n) fetch e:to-f ;
~~~
~~~:f:dump-stack f:depth dup [ f:push ] times [ f:pop f:dup f:put sp ] times ;
~~~
~~~:e:put (e-)
e:MAX [ 'e:MAX s:put ] case
e:MIN [ 'e:MIN s:put ] case
#0 [ 'e:0 s:put ] case
e:NAN [ 'e:NAN s:put ] case
e:INF [ 'e:INF s:put ] case
e:-INF [ 'e:-INF s:put ] case
e:to-f f:put ;
~~~
```r .-1234.56789 f:to-e e:put
```
Here are words to encode floating point numbers into two cells.
Words defined up to this point store
floating point numbers, which are often 64-bit or 2-cell numbers,
into signed integers, which are always 32-bit or 1-cell numbers.
The encoding causes loss in both precision and dynamic range.
Words defined below encode floating point numbers into
two integers occupying two 32-bit cells.
Two different ways are implemented:
• w1 uses fixed point encoding.
Splits a floating point number into the integer and the fraction
parts to store them in two cells.
This is faster with a narrower dynamic range.
• w2 uses sqrt-encoding described in doc/SqrtEncoding.pdf .
This is slower with a relatively wider dynamic range,
but likely not as wide as the original floating point.
Since Retro's cells are 32-bit, it is more convenient to handle
floating point numbers encoded into single cells than into pairs
of cells. For instance, consider using the a: words for vectors.
Hence in many cases the words found by doing
'e: d:words-with
are suitable.
However, sometimes a higher precision is desired at a higher cost.
These are the same as f:+encode and f:-encode except that they come
without f:-shift and f:+shift .
~~~:f:+encode.w2 (|f:n-n) f:dup f:sign f:abs f:sqrt n:to-float f:* ;
:f:-encode.w2 (|f:n-n) f:dup f:sign f:dup f:* n:to-float f:* ;
~~~
```r .-12345.6789 f:+encode.w2 s f:-encode.w2 s
```
Split encoded floating point numbers into the integer and the fraction parts.
The sign goes to the integer part.
The fractional part is that of the absolute value.
~~~{{
:f:+shift9 .1.e-9 f:* ;
:f:-shift9 .1.e9 f:* ;
---reveal---
:f:+split (-|f:n-fi)_absFrac.-shift9_signedInt
f:dup f:sign (s|f:_n
f:abs f:dup f:floor f:swap f:over (s|f:_abs.int_abs_abs.int
f:- f:-shift9 (s|f:_abs.int_abs.frac.-shift9
f:swap n:to-float f:* (_|f:_abs.frac.-shift9_signedInt
;
:f:-split (-|f:fi-n)
f:dup f:sign f:abs (s|f:_abs.frac.-shift9_abs.int
f:swap f:+shift9 f:+ n:to-float f:* (_|f:_n
;
}}
~~~
```r .-123456789.0987654321 f:+split s f:-split s
```
From float to double cells w2 .
And its inverse.
~~~:f:to-w1 (-fi|f:n-)_frac_sInt f:+split f:to-number f:to-number swap ;
:w1:to-f (fi-|f:-n) swap n:to-float n:to-float f:-split ;
:f:to-w2 (-fi|f:n-)_frac_sInt f:+encode.w2 f:to-w1 ;
:w2:to-f (fi-|f:-n) w1:to-f f:-encode.w2 ;
~~~
```r .-123456789.0987654321 f:to-w2 s w2:to-f s
```
f:var1 and f:var2 take initial values.
~~~{{
:f:SATURATE1 (|f:-n) n:MAX n:to-float ;
:f:overflow-check1 (|f:n-n)
f:dup f:abs f:SATURATE1 f:gt?
[ f:put nl 'f:var1_overflow s:abort ] if ;
---reveal---
:f:var1 (s-|f:n-) f:overflow-check1 f:to-w1 rot d:create , , ;
:f:@1 (a-|f:-n) fetch-next [ fetch ] dip w1:to-f ;
:f:!1 (a-|f:n-) f:overflow-check1 f:to-w1 rot store-next store ;
}}
~~~
```r
.-123456789.0987654321 'FVar1 f:var1
&FVar1 f:@1 s
r
.-98765.4321 &FVar1 f:!1
&FVar1 f:@1 s
```
.-9876543210.123456789 &FVar1 f:@1 (Thistestshouldabort
.1.e20 &FVar1 f:!1 (Thistestshouldabort
~~~{{
:f:SATURATE2 (|f:-n) n:MAX n:to-float f:dup f:* ;
:f:overflow-check2 (|f:n-n)
f:dup f:abs f:SATURATE2 f:gt?
[ f:put nl 'f:var2_overflow s:abort ] if ;
---reveal---
:f:var2 (s-|f:n-) f:overflow-check2 f:to-w2 rot d:create , , ;
:f:@2 (a-|f:-n) fetch-next [ fetch ] dip w2:to-f ;
:f:!2 (a-|f:n-) f:overflow-check2 f:to-w2 rot store-next store ;
}}
~~~
```r
.-123456789.0987654321 'FVar2 f:var2
&FVar2 f:@2 s
r
.-9876543210.123456789 &FVar2 f:!2
&FVar2 f:@2 s
```
.1.e20 &FVar2 f:!2 (Thistestshouldabort