view release on metacpan or  search on metacpan

lib/Algorithm/CP/IZ.pm  view on Meta::CPAN

package Algorithm::CP::IZ;

use 5.010000; # need Newx in XS
use strict;
use warnings;

use Carp;
use Scalar::Util qw(weaken blessed looks_like_number);

require Exporter;
use AutoLoader;

use Algorithm::CP::IZ::Int;
use Algorithm::CP::IZ::RefVarArray;
use Algorithm::CP::IZ::RefIntArray;
use Algorithm::CP::IZ::ParamValidator qw(validate);
use Algorithm::CP::IZ::ValueSelector;
use Algorithm::CP::IZ::CriteriaValueSelector;
use Algorithm::CP::IZ::NoGoodSet;
use Algorithm::CP::IZ::SearchNotify;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Algorithm::CP::IZ ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'value_selector' => [ qw(
    CS_VALUE_SELECTOR_MIN_TO_MAX
    CS_VALUE_SELECTOR_MAX_TO_MIN
    CS_VALUE_SELECTOR_LOWER_AND_UPPER
    CS_VALUE_SELECTOR_UPPER_AND_LOWER
    CS_VALUE_SELECTOR_MEDIAN_AND_REST
    CS_VALUE_SELECTION_EQ
    CS_VALUE_SELECTION_NEQ
    CS_VALUE_SELECTION_LE
    CS_VALUE_SELECTION_LT
    CS_VALUE_SELECTION_GE
    CS_VALUE_SELECTION_GT
) ]);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'value_selector'} } );

our $VERSION = '0.07';

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.

    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&Algorithm::CP::IZ::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
	no strict 'refs';
	# Fixed between 5.005_53 and 5.005_61
#XXX	if ($] >= 5.00561) {
#XXX	    *$AUTOLOAD = sub () { $val };
#XXX	}
#XXX	else {
	    *$AUTOLOAD = sub { $val };
#XXX	}
    }

lib/Algorithm/CP/IZ.pm  view on Meta::CPAN

sub Cumulative {
    my $self = shift;
    my ($starts, $durations, $resources, $limit) = @_;

    validate([$starts, $durations, $resources, $limit, 1],
	     ["vA0", "vA0", "vA0", "V", sub {
		 @$starts == @$durations && @$durations == @$resources
	      }],
	     "Usage: Cumulative([starts], [durations], [resources], limit)");

    @$starts = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$starts;
    @$durations = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$durations;
    @$resources = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$resources;
    $limit = ref $limit ? $limit : $self->_const_var(int($limit));

    my $pstarts = $self->_create_registered_var_array($starts);
    my $pdurs = $self->_create_registered_var_array($durations);
    my $pres = $self->_create_registered_var_array($resources);

    my $ret = Algorithm::CP::IZ::cs_Cumulative($$pstarts, $$pdurs, $$pres,
					       scalar(@$starts), $$limit);
    return $ret;
}

sub Disjunctive {
    my $self = shift;
    my ($starts, $durations) = @_;

    validate([$starts, $durations, 1],
	     ["vA0", "vA0",  sub {
		 @$starts == @$durations
	      }],
	     "Usage: Disjunctive([starts], [durations])");

    @$starts = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$starts;
    @$durations = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$durations;

    my $pstarts = $self->_create_registered_var_array($starts);
    my $pdurs = $self->_create_registered_var_array($durations);

    my $ret = Algorithm::CP::IZ::cs_Disjunctive($$pstarts, $$pdurs,
						scalar(@$starts));
    return $ret;
}

sub Regular {
    my $self = shift;
    my ($x, $d, $q0, $F) = @_;
    
    validate([scalar(@_), $x,
	      $d,
	      $q0, $F
	     ],
	     [sub { shift == 4 }, "vA0",
	      sub {
		  # array of array of integer
		  return 0 unless (ref $d eq "ARRAY");
		  for my $row (@$d) {
		      return 0 unless (ref $row eq "ARRAY");
		      for my $i (@$row) {
			  return 0 unless (looks_like_number($i));
		      }
		  }
		  return 1;
	      },
	      "I","iA0"
	     ],
	     "Usage: Regular([vars], [table(QxS)], q0, [F])");

    # $q0 must be in valid states
    return unless (0 <= $q0 && $q0 < scalar(@$d));

    # need acceptable states
    return unless (grep { 0 <= $_ && $_ < scalar(@$d) } @$F);

    my @xv = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$x;

    my $px = $self->_create_registered_var_array(\@xv);
    my $pfarray = $self->_create_registered_int_array($F);

    # get S for Regular (input alphabet size)
    # Q is size saclar(@$d)
    my $max_s = 0;
    for my $row (@$d) {
	my $s = scalar(@$row);
	$max_s = $s if ($max_s < $s)
    }

    # no acceptable alphabet
    if ($max_s == 0) {
	# accept empty set only
	return scalar(@$x) == 0;
    }

    # create d as 1d array
    my @darray = (-1) x (scalar(@$d) * $max_s);
    for (my $qi = 0; $qi < scalar(@$d); $qi++) {
	my $row = $d->[$qi];
	my $idx0 = $max_s * $qi;
	my $idx1 = $idx0 + scalar(@$row)-1;
	@darray[$idx0..$idx1] = @$row;
    }
    
    my $pdarray = $self->_create_registered_int_array(\@darray);
    
    my $ret = Algorithm::CP::IZ::cs_Regular($$px, scalar(@$x), $$pdarray,
					    scalar(@$d), $max_s, $q0,
					    $$pfarray, scalar(@$F));
    return $ret;
}

#
# Create Reif* Methods
#
{
    my @names = qw(Eq Neq Lt Le Gt Ge);
    
    for my $n (@names) {
	my $meth_name = "Reif$n";
	my $ucn = uc $n;