Re: Another optimization question: bsearch()

Dnia piątek, 5 marca 2010 o 19:55:03 David Nicol napisał(a):
> On Wed, Mar 3, 2010 at 9:16 AM, karl williamson <[email protected]> 
wrote:
> > His point was that there's no gain in POSIX.pm having a bsearch, as
> > someone writing in Perl will just use a hash.  But then he started
> > thinking about it some more, and sent me privately a possible reason to
> > have a bsearch exposed to the Perl programmer, as in some cases it makes
> > more sense to keep things in an array instead of a hash.
> 
> an exposed POSIX::bsearch would use the same kind of comparator
> functions that C<sort> uses. The memory savings one could get from
> using a sorted array of object pointers instead of saving the
> temporary table from a Schwarzian transform would not be worth it in
> my (or Karl's) estimation.
> 
> On the other hand, you can get a range of consecutive elements with a
> bsearch, which you can't do with a hash table without a more complex
> data structure and advance indexing on partial keys.
> 
> So I've just published POSIX::bsearch to CPAN, which provides POSIX
> bsearch semantics (any matching element) in scalar context or extended
> semantics (the range of elements, and by the way, what index they
> started at and how many there were are available in documented package
> vars) in array context.
> 

Here is another implementation.  

It uses an array view, not necessarily a material array, so it is a little bit 
more flexible; OTOH, it does not return the full range as David's 
implementation does.  However, it should be noted that the steps to identify 
the full range from a single element are trivial enough to implement. 

I would publish my solution to CPAN but I do not know how to do it.  If you 
feel positive about this approach, feel free to do it yourself, or just let me 
know.

Cheers,
Chris

sub bsearch ($$) { 
my $comp = shift; my $val = shift; 
my @rg = $comp -> range; 
my $dir = $comp -> compare ($rg [0], $val); 
if ($dir) { if ($dir < 0) { return -01; } else { #?DIRDOWN N
while ($rg [01] > $rg [0]) #@CUT
{ 
my $ix = ($rg [0] + $rg [01]) >> 01; 
if ($dir = $comp -> compare ($ix, $val)) 
{ if ($dir < 0) { $rg [01] = $ix; } else { $rg [0] = $ix + 01; }} 
else { return 02 * $ix; }} #@CUT X
 return 2 * $rg [0] - 01; } #?DIRDOWN 
} else { return 0; }}

INVOCATION:
$res = bsearch $comp, $val

$comp is an object blessed to get range and to compare.  The callbacks have 
the following invocations:

@R = $comp -> range: 
returns an array R of 2 elements such that indices in [R[0]..R[1]) are valid 
arguments to compare, q.v.

$test = $comp -> compare ($ix, $val):
returns a result compatible with $val <=> $comp -> {data} [$ix]
(of course, the data table is imaginary).

$val

 RETURN VALUE:

if $res < 0 then range is empty or greater than $val.
if $res is even then $val == $comp -> {data} [$res >> 01].
If $res is odd then $val would between $comp -> {data} [$res >> 01] and the 
next element, if any.

TEST CASE:

my $comp = bless {}, 'I26';
# a virtual container where $comp -> {data} [$ix] == 2 * $ix
sub I26::range ($) { return 0, 020; }
sub I26::compare($$$) 
{ my ($obj, $ix, $test) = (shift, shift, shift); return $test <=> 2 * $ix; }

die "Failed" 
unless ((bsearch $comp, 010) == 010 and (bsearch $comp, 011) == 011); 

APPLICATION TO ORDINARY ARRAYS:

sub ArrayComp::range ($) { return 0, 0 + @{(shift) -> {D}}; }
sub ArrayComp::compare ($$$)
 { 
my ($data, $ix, $val) = ((shift) -> {D}, shift, shift); 
return $val <=> $data -> [$ix]; }
sub ArrayComp::new (\@) { return bless { D: shift }, 'ArrayComp'; }

LIMITATIONS:
If array indices are big enough to cause overflow when multiplied by 2, the 
behaviour is undefined.