sub gf2 {
my ($spectrum, $subsp) = @_;
my %unique;
@unique{@spectrum} = ();
my @uspectrum = sort {$a <=> $b} keys %unique;
return gf1(\@uspectrum, $subsp);
}
sub gf1 {
my ($spectrum, $subsp) = @_;
my $sum = 0;
for my $value (@$subsp) {
my $mid = int (@$spectrum / 2);
my $span = int (@$spectrum / 2);
while (int $span) {
if ($value < $spectrum->[$mid]) {
$mid -= int (($span /= 2) + 0.5);
} elsif ($value > $spectrum->[$mid]) {
$mid += int (0.5 + ($span /= 2));
} else {
last;
}
}
my $delta;
my $left = $mid ? abs ($value - $spectrum->[$mid - 1]) : 1e6;
my $right = $mid < $#$spectrum ? abs ($value - $spectrum->[$mid + 1]) : 1e6;
my $cent = abs ($value - $spectrum->[$mid]);
$sum += (sort {$a <=> $b} ($left, $right, $cent))[0];
}
my $result = 1000;
$result = @$subsp / $sum if $sum != 0;
return $result;
}
####
gf1 result: 2.11267605633804
gf2 result: 2.11267605633804
op result: 2.11267605633804
Rate op gf2 gf1
op 7.57/s -- -100% -100%
gf2 7732/s 102012% -- -10%
gf1 8582/s 113238% 11% --
####
use warnings;
use strict;
use Benchmark qw(cmpthese);
my @spectrum = qw/174.0 102.99 71.62 70.53 82.49 69.05 18.94 102.99 71.62 70.53 82.49 69.05 18.94 102.99 71.62 70.53 82.49 69.05 18.94 102.99 71.62 70.53 82.49 69.05 18.94/;
my @subsp = qw(102.0 18.94 71.61 82.0 173.0 68.7);
my %unique;
@unique{@spectrum} = ();
my @uspectrum = sort {$a <=> $b} keys %unique;
print "gf1 result: ", gf1(\@uspectrum, \@subsp), "\n";
print "gf2 result: ", gf2(\@spectrum, \@subsp), "\n";
print "op result: ", op(\@subsp, \@spectrum, 3), "\n\n";
cmpthese (-5,
{
gf1 => sub {gf1(\@uspectrum, \@subsp)},
gf2 => sub {gf1(\@spectrum, \@subsp)},
op => sub {op(\@subsp, \@spectrum, 3)},
}
);
sub gf2 {
my ($spectrum, $subsp) = @_;
my %unique;
@unique{@spectrum} = ();
my @uspectrum = sort {$a <=> $b} keys %unique;
return gf1(\@uspectrum, $subsp);
}
sub gf1 {
my ($spectrum, $subsp) = @_;
my $sum = 0;
for my $value (@$subsp) {
my $mid = int (@$spectrum / 2);
my $span = int (@$spectrum / 2);
while (int $span) {
if ($value < $spectrum->[$mid]) {
$mid -= int (($span /= 2) + 0.5);
} elsif ($value > $spectrum->[$mid]) {
$mid += int (0.5 + ($span /= 2));
} else {
last;
}
}
my $delta;
my $left = $mid ? abs ($value - $spectrum->[$mid - 1]) : 1e6;
my $right = $mid < $#$spectrum ? abs ($value - $spectrum->[$mid + 1]) : 1e6;
my $cent = abs ($value - $spectrum->[$mid]);
$sum += (sort {$a <=> $b} ($left, $right, $cent))[0];
}
my $result = 1000;
$result = @$subsp / $sum if $sum != 0;
return $result;
}
sub op {
my ($request, $spectrum, $limit) = @_[0..3];
my @spectrum = @$spectrum;
my @request = sort {$a <=> $b} @$request;
return 0, [] unless @request;
return 0, [] if @spectrum < @request;
my %good;
foreach my $signal (@request) {
my @good;
return 0 unless (@good = grep { abs($_-$signal) <= $limit } @spectrum);
%good = (%good, map { ($_ => 1) } @good);
}
@spectrum = sort {$a <=> $b} grep { $good{$_} } @spectrum;
my $alpha;
my $best_subsp;
my $alphabeta;
$alphabeta = sub {
my ($beta, $spectrum, $subsp, $found) = @_;
unless (@$subsp) {
$alpha = $beta;
$best_subsp = $found;
return;
}
my $compared = $subsp->[0];
foreach my $sign_id (0..$#{$spectrum}) {
my $diff = abs($spectrum->[$sign_id] - $compared);
next if $diff > $limit;
next if defined($alpha) && ($diff + $beta) >= $alpha;
$alphabeta->($diff + $beta,
[@{$spectrum}[0..$sign_id-1, $sign_id+1..$#{$spectrum}]],
[@{$subsp}[1..$#{$subsp}]],
[@$found, $spectrum->[$sign_id]],
);
}
return;
};
$alphabeta->(0, \@spectrum, \@request, []);
return 0 unless defined $alpha;
return $alpha ? @request/$alpha : 1000;
}