Skip to content

Commit

Permalink
Bugfix encoding very small double precision floating point numbers
Browse files Browse the repository at this point in the history
  • Loading branch information
@MARTIMM
MARTIMM committed Apr 20, 2015
1 parent 0a0b554 commit 7afad41
Show file tree
Hide file tree
Showing 9 changed files with 296 additions and 157 deletions.
2 changes: 1 addition & 1 deletion .gitignore
View file
Expand Up @@ -2,4 +2,4 @@
*.pdf
*/*.pdf
*.html

double*
2 changes: 1 addition & 1 deletion META.info
View file
Expand Up @@ -11,5 +11,5 @@
"BSON::Javascript": "lib/BSON/Javascript.pm"
},
"source-url": "git://github.com/MARTIMM/BSON.git",
"version": "0.9.2"
"version": "0.9.3"
}
1 change: 1 addition & 0 deletions README.md
View file
Expand Up @@ -104,6 +104,7 @@ See [semantic versioning](http://semver.org/). Please note point 4. on
that page: *Major version zero (0.y.z) is for initial development. Anything may
change at any time. The public API should not be considered stable*.

* 0.9.3 Bugfix encoding very small double precision floating point numbers.
* 0.9.2 Upgraded Rakudo * ===> Bugfix in BSON
* 0.9.1 Testing with decode/encode classes and roles
* 0.9.0
Expand Down
96 changes: 69 additions & 27 deletions benchmarks/double.pl6
View file
Expand Up @@ -12,40 +12,82 @@ use BSON::Double;
my $bench = Bench.new;
my $bson = BSON.new;

my BSON::Double $bd .= new( :key_name('var1'), :key_data(Num.new(0.3)));
my $v-lt1 = Num.new(1/3);
my $v-gt1 = Num.new(12.3/2.456);
my $v-inf = Inf;
my $v-mnf = -Inf;
my $v-nul = Num.new(0.0);

my Buf $b = Buf.new(0x55, 0x55, 0x55, 0x55, 0x55, 0x55, 0xD5, 0x3F);
my BSON::Double $bd-lt1 .= new( :key_name('var-lt1'), :key_data($v-lt1));
my BSON::Double $bd-gt1 .= new( :key_name('var-gt1'), :key_data($v-gt1));
my BSON::Double $bd-inf .= new( :key_name('var-inf'), :key_data($v-inf));
my BSON::Double $bd-mnf .= new( :key_name('var-mnf'), :key_data($v-mnf));
my BSON::Double $bd-nul .= new( :key_name('var-nul'), :key_data($v-nul));

#my $bmr = $bench.cmpthese( 1000,
$bench.cmpthese( 1000,
{ decode1 => sub { return $bson._dec_double($b.list); },
encode1 => sub { return $bson._enc_double(Num.new(0.3)); },
decode2 => sub { return $bd.decode($b.list);},
encode2 => sub { return $bd.encode;}
my Buf $b-lt1 = Buf.new(0x55, 0x55, 0x55, 0x55, 0x55, 0x55, 0xD5, 0x3F);
my Buf $b-gt1 = Buf.new(0x7A, 0xDA, 0x1E, 0xB9, 0x56, 0x08, 0x14, 0x40);
my Buf $b-inf = Buf.new(0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xF0, 0x7F);
my Buf $b-mnf = Buf.new(0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xF0, 0xFF);
my Buf $b-nul = Buf.new(0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00);

#$bench.timethese( 1000,
# { obj-e-nul => sub { return $bd-nul.encode; },
# }
#);

#exit(0);

$bench.timethese( 1000,
{ bson-d-lt1 => sub { return $bson._dec_double($b-lt1.list); },
bson-d-gt1 => sub { return $bson._dec_double($b-gt1.list); },
bson-d-inf => sub { return $bson._dec_double($b-inf.list); },
bson-d-mnf => sub { return $bson._dec_double($b-mnf.list); },
bson-d-nul => sub { return $bson._dec_double($b-nul.list); },

bson-e-lt1 => sub { return $bson._enc_double($v-lt1); },
bson-e-gt1 => sub { return $bson._enc_double($v-gt1); },
bson-e-inf => sub { return $bson._enc_double($v-inf); },
bson-e-inf => sub { return $bson._enc_double($v-mnf); },
bson-e-nul => sub { return $bson._enc_double($v-nul); },

obj-d-lt1 => sub { return $bd-lt1.decode($b-lt1.list); },
obj-d-gt1 => sub { return $bd-gt1.decode($b-gt1.list); },
obj-d-inf => sub { return $bd-inf.decode($b-inf.list); },
obj-d-mnf => sub { return $bd-mnf.decode($b-mnf.list); },
obj-d-nul => sub { return $bd-nul.decode($b-nul.list); },

obj-e-lt1 => sub { return $bd-lt1.encode; },
obj-e-gt1 => sub { return $bd-gt1.encode; },
obj-e-inf => sub { return $bd-inf.encode; },
obj-e-mnf => sub { return $bd-mnf.encode; },
obj-e-nul => sub { return $bd-nul.encode; },
}
);

#say $bmr;
#say "\n", $bmr.^methods;
#say "\n", $bmr.^attributes;

#`{{
--------------------------------------------------------------------------------
2015 04 16 BSON:ver<0.9.2>
Timing 1000 iterations of decode1, decode2, encode1, encode2...
decode1: 0.0735 wallclock secs @ 13608.0697/s (n=1000)
decode2: 0.0817 wallclock secs @ 12236.3940/s (n=1000)
encode1: 4.0758 wallclock secs @ 245.3521/s (n=1000)
encode2: 4.1264 wallclock secs @ 242.3398/s (n=1000)
O---------O---------O---------O---------O---------O---------O
| | Rate | decode1 | decode2 | encode1 | encode2 |
O=========O=========O=========O=========O=========O=========O
| decode1 | 13608/s | -- | 11% | 5446% | 5515% |
| decode2 | 12236/s | -10% | -- | 4887% | 4949% |
| encode1 | 245/s | -98% | -98% | -- | 1% |
| encode2 | 242/s | -98% | -98% | -1% | -- |
-------------------------------------------------------------
2015 04 17 BSON:ver<0.9.2>
Timing 1000 iterations of decode1a, decode1b, decode2a, decode2b, encode1a, encode1b, encode2a, encode2b...
bson-d-gt1: 0.0870 wallclock secs @ 11494.8112/s (n=1000)
bson-d-inf: 0.5648 wallclock secs @ 1770.3843/s (n=1000)
bson-d-lt1: 0.0662 wallclock secs @ 15113.5623/s (n=1000)
bson-d-mnf: 0.5625 wallclock secs @ 1777.6998/s (n=1000)
bson-d-nul: 0.5583 wallclock secs @ 1791.1902/s (n=1000)
bson-e-gt1: 3.1676 wallclock secs @ 315.6995/s (n=1000)
bson-e-inf: 0.0865 wallclock secs @ 11565.0024/s (n=1000)
bson-e-lt1: 3.1786 wallclock secs @ 314.6054/s (n=1000)
bson-e-nul: 0.0426 wallclock secs @ 23475.5695/s (n=1000)
obj-d-gt1: 0.0835 wallclock secs @ 11976.8050/s (n=1000)
obj-d-inf: 0.5779 wallclock secs @ 1730.3083/s (n=1000)
obj-d-lt1: 0.0803 wallclock secs @ 12449.8632/s (n=1000)
obj-d-mnf: 0.5922 wallclock secs @ 1688.7545/s (n=1000)
obj-d-nul: 0.5753 wallclock secs @ 1738.2804/s (n=1000)
obj-e-gt1: 3.4131 wallclock secs @ 292.9893/s (n=1000)
obj-e-inf: 0.0933 wallclock secs @ 10715.8199/s (n=1000)
obj-e-lt1: 4.2394 wallclock secs @ 235.8813/s (n=1000)
obj-e-mnf: 0.0883 wallclock secs @ 11327.6430/s (n=1000)
obj-e-nul: 0.0411 wallclock secs @ 24337.3836/s (n=1000)
--------------------------------------------------------------------------------
}}

197 changes: 128 additions & 69 deletions lib/BSON.pm
View file
Expand Up @@ -32,7 +32,7 @@ class X::BSON::ImProperUse is Exception {
}
}

class BSON:ver<0.9.2> {
class BSON:ver<0.9.3> {

#-----------------------------------------------------------------------------
# Test elements see http://bsonspec.org/spec.html
Expand Down Expand Up @@ -624,96 +624,155 @@ class BSON:ver<0.9.2> {
# 8 bytes double (64-bit floating point number)
method _enc_double ( Num $r is copy ) {

my Buf $a;
my Buf $a;
my Num $r2;

# Test special cases
#
# 0x 0000 0000 0000 0000 = 0
# 0x 8000 0000 0000 0000 = -0 Not recognizable
# 0x 7ff0 0000 0000 0000 = Inf
# 0x fff0 0000 0000 0000 = -Inf
#
if $r == Num.new(0) {
$a = Buf.new(0 xx 8);
# Test special cases
#
# 0x 0000 0000 0000 0000 = 0
# 0x 8000 0000 0000 0000 = -0 Not recognizable
# 0x 7ff0 0000 0000 0000 = Inf
# 0x fff0 0000 0000 0000 = -Inf
#
given $r {
when 0.0 {
$a = Buf.new(0 xx 8);
}

elsif $r == Num.new(-Inf) {
$a = Buf.new( 0 xx 6, 0xF0, 0xFF);
when -Inf {
$a = Buf.new( 0 xx 6, 0xF0, 0xFF);
}

elsif $r == Num.new(Inf) {
$a = Buf.new( 0 xx 6, 0xF0, 0x7F);
when Inf {
$a = Buf.new( 0 xx 6, 0xF0, 0x7F);
}

else
{
my Int $sign = $r.sign == -1 ?? -1 !! 1;
$r *= $sign;
default {
my Int $sign = $r.sign == -1 ?? -1 !! 1;
$r *= $sign;

# Get proper precision from base(2) by first shifting 52 places which
# is the number of precision bits. Adjust the exponent bias for this.
# Get proper precision from base(2). Adjust the exponent bias for
# this.
#
my Int $exp-shift = 0;
my Int $exponent = 1023;
my Str $bit-string = $r.base(2);
#say "bs 1: $exp-shift, $exponent, bs: $bit-string, ", $bit-string.chars;
$bit-string ~= '.' unless $bit-string ~~ m/\./;

# Smaller than one
#
if $bit-string ~~ m/^0\./ {

# Normalize, Check if a '1' is found. Possible situation is
# a series of zeros because r.base(2) won't give that much
# information.
#
my Int $exp-shift = 0;
my Int $exponent = 1023;
my Str $bit-string = $r.base(2);
$bit-string ~= '.' unless $bit-string ~~ m/\./;

# Smaller than zero
my $first-one;
while !($first-one = $bit-string.index('1')) {
$exponent -= 52;
# $exp-shift += 52;
$r *= 2 ** 52;
$bit-string = $r.base(2);
}

#say "bs 2: $exp-shift. $exponent, $first-one, bs: $bit-string";
$first-one--;
$exponent -= $first-one;

# $exp-shift += $first-one;
$r *= 2 ** $first-one; # 1.***
$r2 = $r * 2 ** 52; # Get max precision
$bit-string = $r2.base(2); # Get bits
#say "bs 3a: $exp-shift. $exponent, $first-one, bs: $bit-string";
$bit-string ~~ s/\.//; # Remove dot
$bit-string ~~ s/^1//; # Remove first 1
#say "bs 3b: $exp-shift. $exponent, $first-one, bs: $bit-string";

if 0 {
# Multiply to get more bits in precision. Shift it 26 bits or the
# length returned by $r.base(2) when smaller than 1.
#
if $bit-string ~~ m/^0\./ {

# Normalize
#
my $first-one = $bit-string.index('1');
$exponent -= $first-one - 1;

# Multiply to get more bits in precision
#
while $bit-string ~~ m/^0\./ { # Starts with 0.
$exp-shift += 52; # modify precision
$r *= 2 ** $exp-shift; # modify number
$bit-string = $r.base(2) # Get bit string again
}
while $bit-string ~~ m/^0\./ { # Starts with 0.
$exp-shift += 52; # modify precision
$r *= 2 ** $exp-shift; # modify number
$bit-string = $r.base(2); # Get bit string again
if !?$first-one {
$exponent -= 52;
$first-one = $bit-string.index('1');
$exponent -= $first-one - 1 if ?$first-one;
}
}
#say "bs 4: $exp-shift. $exponent, Final bs: $bit-string";
}
}

# Bigger than zero
# Bigger than one
#
else {
# Normalize
#
else {
# Normalize
#
my Int $dot-loc = $bit-string.index('.');
$exponent += $dot-loc - 1;

# If dot is in the string, not at the end, the precision might
# be not sufficient. Enlarge one time more
#
my Int $str-len = $bit-string.chars;
if $dot-loc < $str-len - 1 {
$r *= 2 ** 52;
$bit-string = $r.base(2)
}
my Int $dot-loc = $bit-string.index('.');
$exponent += ($dot-loc - 1);
#say "bs 5: $dot-loc, $exponent, $bit-string";

# If dot is in the string, not at the end, the precision might
# be not sufficient. Enlarge one time more
#
my Int $str-len = $bit-string.chars;
if $dot-loc < $str-len - 1 or $str-len < 52 {
# $r *= 2 ** 52;
# $bit-string = $r.base(2);
$r2 = $r * 2 ** 52; # Get max precision
$bit-string = $r2.base(2); # Get bits
}
$bit-string ~~ s/\.//; # Remove dot
$bit-string ~~ s/^1//; # Remove first 1
}

$bit-string ~~ s/<[0.]>*$//; # Remove trailing zeros
$bit-string ~~ s/\.//; # Remove the dot
my @bits = $bit-string.split(''); # Create array of '1' and '0'
@bits.shift; # Remove the first 1.
# Remove the dot. Exponent is calculated and the dot is not needed
# anymore. From this string only 52 bits precision are needed after
# the first one is removed. This will always be a one and therefore
# not needed to store it.
#
# $bit-string ~~ s/^1\.//; # Remove first 1 and dot if any
# my @bits = $bit-string.split(''); # Create array of '1' and '0'
# @bits.shift; # Remove the first 1.

my Int $i = $sign == -1 ?? 0x8000_0000_0000_0000 !! 0;
$i = $i +| ($exponent +< 52);
my Int $bit-pattern = 1 +< 51;
do for @bits -> $bit {
$i = $i +| $bit-pattern if $bit eq '1';
# Prepare the number. First set the sign bit.
#
my Int $i = $sign == -1 ?? 0x8000_0000_0000_0000 !! 0;

$bit-pattern = $bit-pattern +> 1;
# Now fit the exponent on its place
#
$i +|= $exponent +< 52;

last unless $bit-pattern;
}
# And the precision
#
#say "bs 6: {$bit-string.substr( 0, 52)}";
$i +|= :2($bit-string.substr( 0, 52));

if 0 {
my @bits;
my Int $bit-pattern = 1 +< 51;
do for @bits -> $bit {
$i +|= $bit-pattern if ?$bit;

# Shift the one to the right until it disappears after which
# the loop will stop
#
$bit-pattern +>= 1;
last unless ?$bit-pattern;
}
}
#say "I2: {$i.fmt('%016x')}";

$a = self._enc_int64($i);
$a = self._enc_int64($i);
}
}

return $a;
return $a;
}

# We have to do some simulation using the information on
Expand Down

0 comments on commit 7afad41

Please sign in to comment.