Hi eyepopslikeamosquito. Yes, I've been running tgol2.t found here and it's been running fine. I can comfirm that bit-manipulation is failing with the new tgot2.t. The initial test script did not test for negative $y. Thus, assumed that $y was always positive. The bit-manipulation code will no longer work.
Okay, will comment readers to your post and strike out the bit-manipulation sections. Thank you for posting Extra Test Program tgol.t.
Update: For closure, I tested mapping supporting negative $x and $y. Pack('i2') is faster unless running cperl.
use strict;
use warnings;
use Time::HiRes qw(time);
my ( $x , $y , $iters ) = ( -890394, 100, 5_000_000 );
my ( $xx, $yy, $n );
##
# sub _pack {
# my ( $x, $y ) = @_;
# return
# $x < 0 ? -( abs($x) << 16 | $y ) : $x << 16 | $y;
# }
#
# sub _unpack {
# my ( $n ) = @_;
# return $n < 0
# ? ( -( abs($n) >> 16 ), abs($n) & 0xFFFF )
# : ( $n >> 16 , $n & 0xFFFF );
# }
##
bench( "bitops ", sub {
# map two integers $x and $y into $n
# support negative $x only
for ( 1 .. $iters ) {
$n = $x < 0 ? -( abs($x) << 16 | $y ) : $x << 16 | $y;
( $xx, $yy ) = $n < 0
? ( -( abs($n) >> 16 ), abs($n) & 0xFFFF )
: ( $n >> 16 , $n & 0xFFFF );
}
});
##
# sub _pack {
# my ( $x, $y ) = @_;
# # bits 0,1 indicate neg flag for $x,$y respectively
# return
# ( abs($x) << 18 ) + ( $x < 0 ? 1 : 0 ) +
# ( abs($y) << 2 ) + ( $y < 0 ? 2 : 0 );
# }
#
# sub _unpack {
# my ( $n ) = @_;
# # bits 0,1 indicate neg flag for $x,$y respectively
# return (
# $n & 0x1 ? -($n >> 18 ) : $n >> 18,
# $n & 0x2 ? -($n >> 2 & 0xFFFF) : $n >> 2 & 0xFFFF
# );
# }
##
bench( "bitops neg ", sub {
# map two integers $x and $y into $n
# support negative $x and $y
for ( 1 .. $iters ) {
$n = ( abs($x) << 18 ) + ( $x < 0 ? 1 : 0 ) +
( abs($y) << 2 ) + ( $y < 0 ? 2 : 0 );
( $xx, $yy ) = (
$n & 0x1 ? -($n >> 18 ) : $n >> 18,
$n & 0x2 ? -($n >> 2 & 0xFFFF) : $n >> 2 & 0xFFFF
);
}
});
bench( "(un)pack ii", sub {
for ( 1 .. $iters ) {
$n = pack 'ii', $x, $y;
( $xx, $yy ) = unpack 'ii', $n;
}
});
bench( "(un)pack i2", sub {
for ( 1 .. $iters ) {
$n = pack 'i2', $x, $y;
( $xx, $yy ) = unpack 'i2', $n;
}
});
exit;
sub bench {
my ( $start, $desc, $fcn ) = ( scalar time, @_ );
$fcn->();
printf "duration $desc %0.03f\n", time - $start;
}
Regards, Mario
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.