I like to plant binary trees:
Edit: for inserting it does a lot more comparisons than a linear search does for searching. For finding min and max there are no comparisons, just traversal. It's use is when one wants to search repeatedly the tree. I have added a search() to the code (30min after).
Edit: after 8hrs, fixed synopsis' testing of min/max, there was a comparator mishap ([0]<=>[1] instead of [1]<=>[0]))!
use My::Bintree;
my $T = My::Bintree->new(3, sub { return $_[0] <=> $_[1] });
$T->add(5);
$T->add(2);
$T->add(8);
$T->add(8);
$T->add(8);
print "maxi: ".join(",",$T->maxi())."\nmini: ".join(",",$T->mini())."\
+n";
print "searched for number 8: ".join(",", $T->search(8))."\n";
# maxi: 8 8 8
# mini: 2
# searched for number 8: 8,8,8
# or add complex data, e.g. (x,y) points and compare their distance fr
+om origin
$T = My::Bintree->new(
# a first point:
[1,2],
# the comparator:
sub { return $_[0]->[0]**2 + $_[0]->[1]**2 <=> $_[1]->[0]**2 + $_[
+1]->[1]**2 }
);
$T->add([3,8]);
$T->add([5,5]);
$T->add([3,4]);
$T->add([3,2]);
$T->add([3,6]);
$T->add([2,3]);
$T->add([3,2]);
$T->add([2,1]);
print "furthest point(s): ".join(',', map { '(x: '.$_->[0].', y: '.$_-
+>[1].')' } $T->maxi())."\n";
print "nearest point(s): ".join(',', map { '(x: '.$_->[0].', y: '.$_-
+>[1].')' } $T->mini())."\n";
print "searched for points with same distance from origin as point (2,
+3): ".join(',', map { '(x: '.$_->[0].', y: '.$_->[1].')' } $T->search
+([2,3]))."\n";
# furthest point(s): (x: 3, y: 8)
# nearest point(s): (x: 1, y: 2),(x: 2, y: 1)
# searched for points with same distance from origin as point (2,3): (
+x: 3, y: 2),(x: 2, y: 3),(x: 3, y: 2)
# here is how you find the max index (and value) of an array
# even if there are several max/min values
my @arr = (3,4,5,100,4,5,100,100, 0, 1, 2);
# the comparator must return -1 if 1st arg < 2nd arg!!! (re: edit abov
+e)
$T = My::Bintree->new([0, shift @arr], sub { $_[0]->[1] <=> $_[1]->[1]
+ });
$T->add([$_,$arr[$_]]) for 0..$#arr;
print "max: ".join(',', map { '(index: '.$_->[0].', value: '.$_->[1].'
+)' } $T->maxi())."\n";
print "min: ".join(',', map { '(index: '.$_->[0].', value: '.$_->[1].'
+)' } $T->mini())."\n";
print "searched for value of 5: ".join(',', map { '(index: '.$_->[0].'
+, value: '.$_->[1].')' } $T->search([undef,5]))."\n";
# max: (index: 2, value: 100),(index: 5, value: 100),(index: 6, value:
+ 100)
# min: (index: 7, value: 0)
# searched for value of 5: (index: 1, value: 5),(index: 4, value: 5)
The package and tests:
# construct a binary tree and search for max/min values given custom d
+ata and comparator
# by bliako for https://perlmonks.org/?node_id=11100889
# 04/06/2019
{ # begin package My::Bintree
package My::Bintree;
use strict;
use warnings;
use Data::Dumper;
sub new {
my $class = shift;
my $dat = shift;
my $parent = shift;
my $dat_comparator = shift;
if( ref $parent eq 'CODE' ){
($parent, $dat_comparator) = ($dat_comparator, $parent);
}
return $parent->add($dat) if $parent;
my $self = {
'data' => $dat,
# the comparator sub takes 2 args, it must return -1,0,1 **IF
+1st arg lt,eq,gt 2nd arg**
'cmp' => $dat_comparator ? $dat_comparator : sub { $_[0] cmp $
+_[1] },
'parent' => $parent,
'children' => [undef, [], undef],
};
my $ret = bless $self => $class;
return $ret;
}
sub add {
my $self = shift;
my $dat = shift;
my $current = $self;
while( 1 ){
my $dat_comparator = $current->{'cmp'};
my $cmpr = $current->compare($dat);
if( $cmpr == 0 ){
my $achild = My::Bintree->new($dat, $dat_comparator);
$current->_add_equ_child($achild);
return $achild;
} else {
my $achild = \ $current->{'children'}->[$cmpr+1];
if( defined $$achild ){
$current = $$achild;
} else {
$$achild = My::Bintree->new($dat, $dat_comparator);
$$achild->{'parent'} = $current;
return $$achild;
}
}
}
}
sub mini {
my $self = shift;
my $current = $self;
$current = $current->lth() while $current->lth();
my @ret = ($current->data());
push @ret, $_->data() foreach @{$current->equ()};
return @ret;
}
sub maxi {
my $self = shift;
my $current = $self;
$current = $current->gth() while $current->gth();
my @ret = ($current->data());
push @ret, $_->data() foreach @{$current->equ()};
return @ret;
}
sub search {
my $self = shift;
my $dat = shift;
my $current = $self;
while( 1 ){
my $cmpr = $current->compare($dat);
if( $cmpr == 0 ){ return map { $_->data() } $current, @{$curre
+nt->equ()} }
my $achild = \ $current->{'children'}->[$cmpr+1];
return () unless defined $$achild;
$current = $$achild;
}
}
sub parent { return $_[0]->{'parent'} }
sub data { return $_[0]->{'data'} }
# compare self to input
sub compare {
my $self = $_[0];
return $self->{'cmp'}->($_[1], $self->data())
}
sub _add_lth_child { $_[0]->{'children'}->[0] = $_[1]; $_[1]->{'parent
+'} = $_[0]; }
sub _add_gth_child { $_[0]->{'children'}->[2] = $_[1]; $_[1]->{'parent
+'} = $_[0]; }
sub _add_equ_child { push @{$_[0]->{'children'}->[1]}, $_[1]; ; $_[1]-
+>{'parent'} = $_[0]; }
sub lth { return $_[0]->{'children'}->[0] }
sub gth { return $_[0]->{'children'}->[2] }
sub equ { return $_[0]->{'children'}->[1] }
1;
} # end package My::Bintree
package main;
use strict;
use warnings;
use List::Util qw(shuffle);
do_synopsis();
do_benchmarks();
do_tests();
sub do_synopsis {
# synopsis
# create a tree
my $T = My::Bintree->new(3, sub { return $_[0] <=> $_[1] });
$T->add(5);
$T->add(2);
$T->add(8);
$T->add(8);
$T->add(8);
print "maxi: ".join(",",$T->maxi())."\nmini: ".join(",",$T->mini()
+)."\n";
print "searched for number 8: ".join(",", $T->search(8))."\n";
# or add complex data, e.g. (x,y) points and compare their distanc
+e from origin
# or add complex data, e.g. (x,y) points and compare their distanc
+e from origin
$T = My::Bintree->new(
# a first point:
[1,2],
# the comparator:
sub { return $_[0]->[0]**2 + $_[0]->[1]**2 <=> $_[1]->[0]**2 +
+ $_[1]->[1]**2 }
);
$T->add([3,8]);
$T->add([5,5]);
$T->add([3,4]);
$T->add([3,2]);
$T->add([3,6]);
$T->add([2,3]);
$T->add([3,2]);
$T->add([2,1]);
print "furthest point(s): ".join(',', map { '(x: '.$_->[0].', y: '
+.$_->[1].')' } $T->maxi())."\n";
print "nearest point(s): ".join(',', map { '(x: '.$_->[0].', y: '
+.$_->[1].')' } $T->mini())."\n";
print "searched for points with same distance from origin as point
+ (2,3): ".join(',', map { '(x: '.$_->[0].', y: '.$_->[1].')' } $T->se
+arch([2,3]))."\n";
# here is how you find the max index (and value) of an array
# even if there are several max/min values
my @arr = (3,4,5,100,4,5,100,100, 0, 1, 2);
$T = My::Bintree->new([0, shift @arr], sub { $_[1]->[1] <=> $_[0]-
+>[1] });
$T->add([$_,$arr[$_]]) for 0..$#arr;
print "max: ".join(',', map { '(index: '.$_->[0].', value: '.$_->[
+1].')' } $T->maxi())."\n";
print "min: ".join(',', map { '(index: '.$_->[0].', value: '.$_->[
+1].')' } $T->mini())."\n";
print "searched for value of 5: ".join(',', map { '(index: '.$_->[
+0].', value: '.$_->[1].')' } $T->search([undef,5]))."\n";
}
# some benchmarks comparing to a linear search
sub do_benchmarks {
my $num_comparisons;
my $cmpsub = sub {
$num_comparisons++;
return $_[0]->[1] <=> $_[1]->[1]
};
my $N = 2;
my $MAXI = 1000; my $nrb = 2*$MAXI+1;
my $t = time;
my ($cmp_insert, $cmp_search_maxi, $cmp_search_mini) = (0)x3;
for (1..$N){
srand $t++;
my @rb = shuffle -$MAXI .. $MAXI;
my $imax=$MAXI-1;
for (my $i=$MAXI; $i-->0; ){
$imax=$i if ($rb[$imax]<=$rb[$i]);
}
$num_comparisons = 0;
my $T;
for(0..$#rb){
my $dat = [$_, $rb[$_]];
if( defined $T ){
$T->add($dat);
} else {
$T = My::Bintree->new(
$dat, # data to insert
$cmpsub # comparator sub for $dat
);
}
}
$cmp_insert += $num_comparisons;
# maxi and mini do not do any comparisons they only traverse
$num_comparisons = 0;
my @maxi = $T->maxi();
$cmp_search_maxi += $num_comparisons;
$num_comparisons = 0;
my @mini = $T->mini();
$cmp_search_mini += $num_comparisons;
print "comparisons: done trial $_ : insert: $cmp_insert, maxi:
+ $cmp_search_maxi, mini: $cmp_search_mini\n";
}
print "linear search : #comparisons is ".($N*(2*$MAXI+1))."\nbinar
+y search #comparisons is insert: $cmp_insert, maxi: $cmp_search_maxi,
+ mini: $cmp_search_mini\n";
}
# Tests for finding max and min values and their indices from a 1d arr
+ay
sub do_tests {
use Test::More;
my $nt = 0;
# the comparator sub must
# return -1 if 1st is less than 2nd, 0 if equal, 1 if 1st is great
+er than 2nd
my $comparator = sub { $_[0]->[1] <=> $_[1]->[1] };
use constant MAXI => 10;
for my $maxi (0 .. 2*MAXI+1){
for my $mini (0 .. 2*MAXI+1){
next if $maxi == $mini;
my @rb = shuffle -MAXI..MAXI;
$rb[$maxi] = 99; $rb[$mini] = -99;
my $T = undef;
my ($maxi, @rest) = map { $_->[0] } sort { $b->[1] <=> $a->[1]
+ } map { [ $_ , $rb[$_] ] } 0..$#rb;
my $mini = pop @rest;
for(0..$#rb){
my $dat = [$_, $rb[$_]];
if( defined $T ){
ok defined $T->add($dat), "add()"; $nt++;
} else {
$T = My::Bintree->new(
$dat, # data to insert
$comparator # comparator sub for $dat
);
ok defined $T, "new()"; $nt++;
}
}
my @maxifound = $T->maxi();
ok(1==scalar @maxifound, "found exactly 1 maximum"); $nt++;
ok($maxifound[0]->[0]==$maxi, "max index agree (found @{$maxif
+ound[0]}, expected $maxi)"); $nt++;
my @minifound = $T->mini();
ok(1==scalar @minifound, "found exactly 1 minimum"); $nt++;
ok($minifound[0]->[0]==$mini, "min index agree (found @{$minif
+ound[0]}, expected $mini)"); $nt++;
} # for mini
} # for maxi
# add many max min with same value
for my $i (0 .. 2*MAXI+1){
my $t = time;
srand $t;
my @maxiput = (shuffle 0 .. 2*MAXI+1)[0..MAXI/5];
srand $t;
my @miniput = (shuffle 0 .. 2*MAXI+1)[-MAXI/5..-1];
srand $t;
my @rb = shuffle -MAXI..MAXI;
@rb[@maxiput] = (99)x@maxiput;
@rb[@miniput] = (-99)x@miniput;
my $T = undef;
for(0..$#rb){
my $dat = [$_, $rb[$_]];
if( defined $T ){
ok defined $T->add($dat), "add()"; $nt++;
} else {
$T = My::Bintree->new(
$dat, # data to insert
$comparator # comparator sub for $dat
);
ok defined $T, "new()"; $nt++;
}
}
my @maxifound = $T->maxi();
ok(scalar(@maxiput)==scalar(@maxifound), "found exactly ".scal
+ar(@maxifound)." maximum"); $nt++;
my %tmp1 = map { @$_ } @maxifound;
ok(exists $tmp1{$_}, "max index agree ($_)"),$nt++ for @maxipu
+t;
my @minifound = $T->mini();
ok(scalar(@miniput)==scalar(@minifound), "found exactly ".scal
+ar(@minifound)." minimum"); $nt++;
%tmp1 = map { @$_ } @minifound;
ok(exists $tmp1{$_}, "max index agree ($_)"),$nt++ for @minipu
+t;
} # for i
# END
done_testing($nt);
}
bw, bliako
