File Coverage

blib/lib/Math/Telephony/ErlangB.pm

Criterion	Covered	Total	%
statement	67	67	100.0
branch	28	28	100.0
condition	45	47	95.7
subroutine	16	16	100.0
pod	4	4	100.0
total	160	162	98.7

package Math::Telephony::ErlangB;

use version; our $VERSION = qv('1.0.2');

use warnings;
use strict;
use Carp;
use English qw( -no_match_vars );

use base 'Exporter';
our %EXPORT_TAGS =
  ('all' => [qw( blocking_probability gos servers traffic )]);
our @EXPORT_OK = (@{$EXPORT_TAGS{'all'}});
our @EXPORT    = qw();

# Module implementation here

# Workhorse functions, no check on input value is done!
sub _blocking_probability {
   my ($traffic, $servers) = @_;
   my $gos = 1;
   for my $m (1 .. $servers) {
      my $tmp = $gos * $traffic;
      $gos = $tmp / ($m + $tmp);
   }
   return $gos;
} ## end sub _blocking_probability

sub _generic_servers {
   my $cost = shift;

   # Exponential "backoff"
   my $servers = 1;
   $servers *= 2 while ($cost->($servers) > 0);
   return $servers if ($servers <= 2);

   # Binary search
   my ($minservers, $maxservers) = ($servers / 2, $servers);
   while ($maxservers - $minservers > 1) {
      $servers = int(($maxservers + $minservers) / 2);
      if ($cost->($servers) > 0) {
         $minservers = $servers;
      }
      else {
         $maxservers = $servers;
      }
   } ## end while ($maxservers - $minservers...
   return $maxservers;
} ## end sub _generic_servers

sub _generic_traffic {
   my ($cond, $prec, $hint) = @_;

   # Establish some upper limit
   my ($inftraffic, $suptraffic) = (0, $hint || 1);
   while ($cond->($suptraffic)) {
      $inftraffic = $suptraffic;
      $suptraffic *= 2;
   }

   # Binary search
   while (($suptraffic - $inftraffic) / $suptraffic > $prec) {
      my $traffic = ($suptraffic + $inftraffic) / 2;
      if ($cond->($traffic)) {
         $inftraffic = $traffic;
      }
      else {
         $suptraffic = $traffic;
      }
   } ## end while (($suptraffic - $inftraffic...
   return $inftraffic;
} ## end sub _generic_traffic

our $default_precision;

BEGIN {    # Ok, a little overkill to use a BEGIN block...
   $default_precision = 0.001;
}

sub blocking_probability {
   my ($traffic, $servers) = @_;

   return undef
     unless defined($traffic)
     && ($traffic >= 0)
     && defined($servers)
     && ($servers >= 0)
     && (int($servers) == $servers);
   return 0 unless $traffic > 0;
   return 1 unless $servers > 0;

   return _blocking_probability($traffic, $servers);
} ## end sub blocking_probability

sub gos { return blocking_probability(@_) }

sub servers {
   my ($traffic, $gos) = @_;

   return undef
     unless defined($traffic)
     && ($traffic >= 0)
     && defined($gos)
     && ($gos >= 0)
     && ($gos <= 1);
   return 0 unless ($traffic > 0 && $gos < 1);
   return undef unless ($gos > 0);

   return _generic_servers(
      sub { _blocking_probability($traffic, $_[0]) > $gos });
} ## end sub servers

sub traffic {
   my ($servers, $gos, $prec) = @_;

   return undef
     unless defined($servers)
     && ($servers >= 0)
     && (int($servers) == $servers)
     && defined($gos)
     && ($gos >= 0)
     && ($gos <= 1);
   return 0 unless ($servers > 0 && $gos > 0);
   return undef unless ($gos < 1);

   $prec = $default_precision unless defined $prec;
   return undef unless ($prec > 0);

   return _generic_traffic(
      sub { _blocking_probability($_[0], $servers) < $gos },
      $prec, $servers);
} ## end sub traffic

1;    # Magic true value required at end of module
__END__