bless.* results from the CPAN

bless.*

Algorithm-CP-IZ

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	}
    }
    goto &$AUTOLOAD;
}

require XSLoader;
XSLoader::load('Algorithm::CP::IZ', $VERSION);

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

my $Instances = 0;

sub _report_error {
    my $msg = shift;
    croak __PACKAGE__ . ": ". $msg;
}

sub new {
    my $class = shift;

    if ($Instances > 0) {
	_report_error("another instance is working.");
    }

    Algorithm::CP::IZ::cs_init();
    $Instances++;

    bless {
	_vars => [],
	_cxt0 => [],
	_cxt => [],
	_const_vars => {},
	_backtracks => {},
	_ref_int_arrays => {},
	_ref_var_arrays => {},
    }, $class;
}

sub DESTROY {
    my $self = shift;
    my $vars = $self->{_vars};

    for my $v (@$vars) {
	# we must check existence of variable for global destruction.
	$v->_invalidate if (defined $v);
    }

    Algorithm::CP::IZ::cs_end();
    $Instances--;
}

sub save_context {
    my $self = shift;
    
    my $ret = Algorithm::CP::IZ::cs_saveContext();

    my $cxt = $self->{_cxt};
    push(@$cxt, []);

    $self->backtrack(undef, 0, sub { pop(@$cxt) });

    return $ret;
}

sub restore_context {
    my $self = shift;

    my $cxt = $self->{_cxt};
    if (@$cxt == 0) {
	_report_error("restore_context: bottom of context stack");
    }

    Algorithm::CP::IZ::cs_restoreContext();
}

sub restore_context_until {
    my $self = shift;
    my $label = shift;

    validate([$label], ["I"],
	     "Usage: restore_context_until(int_label)");

    my $cxt = $self->{_cxt};
    if (@$cxt == 0) {
	_report_error("restore_context_until: invalid label");
    }

    Algorithm::CP::IZ::cs_restoreContextUntil($label);

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

	unless ($ptr) {
	    my $param_str = join(", ", @$p1);
	    _report_error("cannot create variable from [$param_str]");
	}
    }
    else {
	my $min = $p1;
	my $max = shift;
	$name = shift;

	$ptr = $self->_create_int_from_min_max($min, $max);
	unless ($ptr) {
	    my $param_str = join(", ", $min, $max);
	    _report_error("cannot create variable from ($param_str)");
	}
    }

    my $ret = Algorithm::CP::IZ::Int->new($ptr);

    if (defined $name) {
	$ret->name($name);
    }

    $self->_register_variable($ret);

    return $ret;
}

sub _validate_search_params {
    my ($var_array, $params) = @_;
    return 1 unless (defined($params));
    return 0 unless (ref $params eq 'HASH');

    my %checker = (
	FindFreeVar => sub {
	    my $x = shift;
	    if (ref $x) {
		validate([$x], ["C"], "search: FindFreeVar must be a number or a coderef");
	    }
	    else {
		validate([$x], ["I"], "search: FindFreeVar must be a number or a coderef");
	    }
	},
	Criteria => sub {
	    my $x = shift;
	    validate([$x], ["C"], "search: Criteria must be a coderef");
	    return 1;
	},
	MaxFail => sub {
	    my $x = shift;
	    validate([$x], ["I"], "search: MaxFail must be an integer");
	},
	ValueSelectors => sub {
	    my $x = shift;
	    validate([$x], [
			 sub {
			     my $vs = shift;
			     return unless (ref $vs eq 'ARRAY'
					    && scalar @$vs == scalar @$var_array);
			     for my $obj (@$vs) {
				 return unless (blessed($obj)
						&& $obj->isa("Algorithm::CP::IZ::ValueSelector"));
			     }
			     1;
			 }], "search: ValueSelectos must be a arrayref of Algorithm::CP::IZ::ValueSelector instance for each variables");
	},
	MaxFailFunc => sub {
	    my $x = shift;
	    validate([$x], ["C"], "search: MaxFailFunc must be a coderef");
	},
	NoGoodSet => sub {
	    my $x = shift;
	    validate([$x], [
			 sub {
			     my $ngs = shift;
			     return blessed($ngs) && $ngs->isa("Algorithm::CP::IZ::NoGoodSet");
			 }], "search: NoGoodSet must be a instance of Algorithm::CP::IZ::NoGoodSet");
	},
	Notify => sub {
	    my $x = shift;
	    validate([$x], [
			 sub {
			     my $notify = shift;
			     return 1 if (ref $notify eq 'HASH');
			     return 1 if (blessed($notify));
			     return 0;
			 }], "search: Notify must be an hashref or object");
	},
    );

    my @keys = sort keys %$params;

    for my $k (@keys) {
	if (exists $checker{$k}) {
	    my $func = $checker{$k};
	    &$func($params->{$k});
	}
	else {
	    _report_error("search: Unknown Key $k in params");
	}
    }

    return 1;
}

sub search {
    my $self = shift;
    my $var_array = shift;
    my $params = shift;

    validate([$var_array, $params], ["vA0", sub {_validate_search_params($var_array, @_)}],
	     "Usage: search([variables], {key=>value,...}");

    my $array = [map { $$_ } @$var_array];
    my $max_fail = -1;
    my $find_free_var_id = 0;
    my $find_free_var_func = sub { die "search: Internal error"; };
    my $criteria_func;
    my $value_selectors;
    my $max_fail_func;
    my $ngs;
    my $notify;
    
    if ($params->{FindFreeVar}) {
	my $ffv = $params->{FindFreeVar};

	if (ref $ffv) {
	    $find_free_var_id = -1;
	    $find_free_var_func = sub {
		return &$ffv($var_array);
	    };
	}
	else {
	    $find_free_var_id = int($ffv);
	}
    }

    if ($params->{Criteria}) {
	$criteria_func = $params->{Criteria};
    }

    if ($params->{MaxFail}) {
	$max_fail = int($params->{MaxFail});
    }

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

      return 1;
  }

EXTRA is a just a data passed to callbeck as parameter (it can be anything).

=item get_version

Returns version string like "3.5.0".
undef will be returned if getVersion() is not supported in iZ-C (old version).


=item get_value_selector(ID)

Get built-in value selector (instance of Algorithm::CP::IZ::ValueSelector) specifed by ID.
ID must be selected from following constants defined in package Algorithm::CP::IZ.

=over

=item CS_VALUE_SELECTOR_MIN_TO_MAX

=item CS_VALUE_SELECTOR_MAX_TO_MIN

=item CS_VALUE_SELECTOR_LOWER_AND_UPPER

=item CS_VALUE_SELECTOR_UPPER_AND_LOWER

=item CS_VALUE_SELECTOR_MEDIAN_AND_REST

=back

(These values are exported by Algorithm::CP::IZ and can be imported using tag 'value_selector')

Returned object will be used as a parameter ValueSelectors when calling "search" method.

  use Algorithm::CP::IZ qw(:value_selector);
  my $vs = $iz->get_value_selector(CS_VALUE_SELECTOR_MIN_TO_MAX);

  my $v1 = $iz->create_int(1, 9);
  my $v2 = $iz->create_int(1, 9);
  $iz->Add($v1, $v2)->Eq(12);
  my $rc = $iz->search([$v1, $v2], {
      ValueSelectors => [ $vs, $vs ],
  });


=item create_value_selector_simple(CLASS_NAME)

Create user defined value-seelctor defined by class named CLASS_NAME.
This class must have constructor named "new" and method namaed "next".

  use Algorithm::CP::IZ qw(:value_selector);
  
  package VSSample1;
  sub new {
    my $class = shift;
    my ($v, $index) = @_;

    my $self = {
      _pos => 0,
    };
    bless $self, $class;
  }

  sub next {
    my $self = shift;
    my ($v, $index) = @_;

    my $pos = $self->{_pos};
    my $domain = $v->domain;

    # return empty after enumerate all values
    return if ($pos >= @$domain);

    my @ret = (CS_VALUE_SELECTION_EQ, $domain->[$pos]);
    $self->{_pos} = ++$pos;

    # return pair of (CS_VALUE_SELECTION_*, value)
    return @ret;
  }

  my $v1 = $iz->create_int(1, 9);
  my $v2 = $iz->create_int(1, 9);
  $iz->Add($v1, $v2)->Eq(12);
  my $vs = $iz->create_value_selector_simple("VSSample1");
  my $rc = $iz->search([$v1, $v2], {
      ValueSelectors => [ $vs, $vs ],
  });

=item create_no_good_set(VARIABLES, PRE_FILTER, MAX_NO_GOOD, EXT)

Create an instance of Algorithm::CP::IZ::NoGoodSet. Returned object will be used as a
parameter NoGoodSet when calling "search" method.

=back


=head1 METHODS (Constraints)

=over 2

=item Add(VAR1, VAR2 [, VAR3....])

Create an instance of Algorithm::CP::IZ::Int constrainted to be:

  Created_instance  = VAR1 + VAR2 + ....

=item Mul(VAR1, VAR2 [, VAR3....])

Create an instance of Algorithm::CP::IZ::Int constrainted to be:

  Created_instance = VAR1 * VAR2 * ....

=item Sub(VAR1, VAR2)

Create an instance of Algorithm::CP::IZ::Int constrainted to be:

  Created_instance = VAR1 - VAR2

=item Div(VAR1, VAR2)

Create an instance of Algorithm::CP::IZ::Int constrainted to be:

( run in 2.861 seconds using v1.01-cache-2.11-cpan-5b529ec07f3 )