File Coverage

blib/lib/Algorithm/Knap01DP.pm

Criterion	Covered	Total	%
statement	126	126	100.0
branch	22	28	78.5
condition	6	16	37.5
subroutine	11	11	100.0
pod	0	6	0.0
total	165	187	88.2

package Algorithm::Knap01DP;
use 5.008004;
use strict;
use warnings;
use Carp;
use IO::File;

our $VERSION = '0.25';
# Still a very early "alpha" version

sub new {
    my $class = shift;
    my $self = {
        capacity    => 0,       # total capacity of this knapsack
        numobjects  => 0,       # number of objects
        weights     => [],      # weights to be packed into the knapsack
        profits     => [],      # profits to be packed into the knapsack
        tableval    => [],      # f[k][c] DP table of values
        tablesol    => [],      # x[k][c] DP table of sols
                                # (0 = out, 1 = in, 2 = in and out)
        solutions   => [],      # list of lists of object indexes
        filename    => "",      # name of the file the problem was read from
        @_,
    };

    croak "Profits and Weights don't have the same size"
           unless scalar(@{$self->{weights}}) == scalar(@{$self->{profits}});

    bless $self, $class;
}

sub Knap01DP {
  my $self = shift();
  my $M = $self->{capacity};
  my @w = @{$self->{weights}};
  my @p = @{$self->{profits}};

  croak "Weight list is empty" unless (@w > 0);

  my $N = @w;
  my (@f, @x);

  for my $c (0..$M) {
    if ($w[0] <= $c) {
      $f[0][$c] = $p[0];
      $x[0][$c] = 1;
    }
    else {
      $f[0][$c] = 0;
      $x[0][$c] = 0;
    }
  }

  for my $k (1..$N-1) {
    for my $c (0..$M) {
      my $n = $f[$k-1][$c];
      if ($c >= $w[$k]) {
        my $y = $f[$k-1][$c-$w[$k]]+$p[$k];
        if ($n < $y) {
          $f[$k][$c] = $y;
          $x[$k][$c] = 1;
        }
        elsif ($n > $y) {
          $f[$k][$c] = $n;
          $x[$k][$c] = 0;
        }
        else { # $n == $y
          $f[$k][$c] = $n;
          $x[$k][$c] = 2; # both ways
        }
      }
      else {
        $f[$k][$c] = $n;
        $x[$k][$c] = 0;
      }
    }
  }
  ($self->{tableval}, $self->{tablesol}) = (\@f, \@x);
}

sub solutions {
  my $self = shift();
  my $N = $self->{numobjects};
  my $M = $self->{capacity};
  my @w = @{$self->{weights}};
  my (@f, @x);

  $self->Knap01DP() if (!@{$self->{tableval}});
  @f = @{$self->{tableval}};
  @x = @{$self->{tablesol}};

  my ($k, $c, $s);

  my @sol = ({ sol=>[], cap=>$M });
  for($k = $N-1; $k >= 0; $k--) {
    my @temp = ();
    foreach $s (@sol) {
      $c = $s->{cap};
      if ($x[$k][$c] == 1) {
        unshift @{$s->{sol}}, $k;
        $s->{cap} -= $w[$k];
      }
      elsif ($x[$k][$c] == 2) {
        push @temp, {sol => [ @{$s->{sol}} ], cap =>$s->{cap}};
        unshift @{$s->{sol}}, $k;
        $s->{cap} -= $w[$k];
      }
    } # foreach $s
    push @sol, @temp if @temp;
  } # for
  $self->{solutions} = \@sol;
}

sub ReadKnap {
  my $class = shift;
  my $filename = shift;

  my $file = IO::File->new("< $filename");
  croak "Can't open $filename" unless defined($file);
  my (@w, @p);

  my $N = <$file>; chomp($N);
  my $M = <$file>; chomp($M);
  for (0..$N-1) {
    $w[$_] = <$file>;
    $p[$_] = <$file>;
  }
  chomp @w; chomp @p;
  return $class->new(
                 capacity => $M,
                 numobjects => $N,
                 weights =>\@w,
                 profits => \@p,
                 filename => $filename);
}

sub GenKnap {
  my $class = shift;
  my $N = (shift() || 17); # number of objects
  my $R = (shift() || $N); # range

  croak "Number of objects and Range must be positive integers"
     unless ($N > 0) and ($R > 0) and ($N == int($N)) and ($R == int($R));

  my ($x, $M, @w);
  @w = map { $x = 1 + int(rand($R)); $M += $x; $x } 1..$N;
  $M = int ($M / 2);
  return $class->new(
                 capacity => $M,
                 numobjects => $N,
                 weights =>\@w,
                 profits => \@w,
                 filename => 'RANDOM');
}

sub ShowResults {
  my $self = shift();
  my $width = (shift() || 8);
  my @sol = @{$self->{solutions}};
  my ($x, $i, $w);

  print "Problem: ";
  print "$self->{filename}\n" if defined($self->{filename});
  print "Number of Objects = $self->{numobjects} Capacity = $self->{capacity}\n";
  for (@sol) {
    my @s = @{$_->{sol}};

    $i = 1;
    $w = 0;
    for $x (@s) {
      print "$x ($self->{weights}[$x])\t";
      $w += $self->{weights}[$x];
      print "\n" if ($i % $width) == 0;
      $i++;
    }
    print "Used Capacity = $w\n";
  }
  print "Profit = $self->{tableval}[-1][-1]\n";
}

1;
__END__