AI-CBR

 view release on metacpan or  search on metacpan

lib/AI/CBR/Case.pm  view on Meta::CPAN

=item * B<param>: the parameter for the similarity function, if required

=item * B<weight>: the weight of the attribute in the comparison of the case. If you do not give a weight value for an attribute, the package's C<$DEFAULT_WEIGHT> will be used, which is 1 by default.

=item * B<value>: the value of the attribute, if you want to specify the complete case immediately. You can also do this later.

=back

=cut

sub new {
	my ($class, %attributes) = @_;
	
	# set default weights if unspecified
	foreach (keys %attributes) {
		$attributes{$_}->{weight} = $DEFAULT_WEIGHT unless defined $attributes{$_}->{weight};
	}
	
	my $self = \%attributes;
	bless $self, $class;
	return $self;

lib/AI/CBR/Case.pm  view on Meta::CPAN

=head2 set_values

Pass a hash of attribute keys and values.
This will overwrite existing values, and can thus be used as a faster method
for generating new cases with the same specification.

=cut

sub set_values {
	my ($self, %values) = @_;
	foreach (keys %values) {
		$self->{$_}->{value} = $values{$_};
	}
}


=head1 SEE ALSO

See L<AI::CBR> for an overview of the framework.

lib/AI/CBR/Case/Compound.pm  view on Meta::CPAN

=head1 METHODS

=head2 new

Creates a new compound case specification.
Pass a list of hash references as argument.
Each hash reference is the same specification as passed to L<AI::CBR::Case>.

=cut

sub new {
	my ($class, @definitions) = @_;
	
	# set default weights if unspecified
	foreach my $attributes (@definitions) {
		foreach (keys %$attributes) {
			$attributes->{$_}->{weight} = $DEFAULT_WEIGHT unless defined $attributes->{$_}->{weight};
		}
	}
	
	my $self = \@definitions;

lib/AI/CBR/Case/Compound.pm  view on Meta::CPAN

=head2 set_values

Pass a flat hash of attribute keys and values.
This will overwrite existing values, and can thus be used as a faster method
for generating new cases with the same specification.
Notice that keys in the different specifications of the compound object may not have the same name!

=cut

sub set_values {
	my ($self, %values) = @_;
	foreach my $spec (@$self) {
		foreach (keys %$spec) {
			$spec->{$_}->{value} = $values{$_};
		}
	}
}


=head1 SEE ALSO

lib/AI/CBR/Retrieval.pm  view on Meta::CPAN

=head2 new

Creates a new object for retrieval.
Pass your case specification object as the first parameter.
Pass the reference of an array of hash references as the case-base.
The hashes should contain all attributes of the specification.
These will be called candidate cases internally.

=cut

sub new {
	my ($classname, $spec, $candidates) = @_;
	croak('new case without candidates') unless @$candidates;
	my $self = {
		candidates => $candidates,
		# we accept single specs as hash-ref or composed specs as array-ref
		# internally both will be handled as a composed array-ref
		queries    => ref $spec eq 'AI::CBR::Case' ? [$spec] : $spec,
	};
	bless $self, $classname;
	return $self;

lib/AI/CBR/Retrieval.pm  view on Meta::CPAN

=head2 compute_sims

If the case-specification is complete,
you may call this method to compute the similarities
of all candidate cases to this specification.
After this step, each candidate of the case-base will have an
additional attribute C<_sim> indicating the similarity.

=cut

sub compute_sims {
	my ($self) = @_;
	
	# pre-allocate variables used in loop
	my ($sum_sims, $sum_weights, $att_key, $att, $weight, $x, $y);
	
	my $num_queries = int @{$self->{queries}};
	foreach my $candidate (@{$self->{candidates}}) {
		$candidate->{_sim} = 1;
		foreach my $query (@{$self->{queries}}) {
			$sum_sims = 0;

lib/AI/CBR/Retrieval.pm  view on Meta::CPAN

Use one of these methods to get the similar cases you are interested into.

=head3 most_similar_candidate

Returns the most similar candidate.
No parameters.

=cut

sub most_similar_candidate {
	my ($self) = @_;
	return $self->{candidates}->[0];
}

=head3 n_most_similar_candidates

Returns the n most similar candidates.
n is the only parameter.

=cut

sub n_most_similar_candidates {
	my ($self, $n) = @_;
	my $last_index = min($n - 1, int @{$self->{candidates}});
	return map { $self->{candidates}->[$_] } (0 .. $last_index);
}

=head3 first_confirmed_candidate

Returns the first candidate that is confirmed by a later candidate.
Confirmation is based on an attribute value
whose key is passed as parameter.
In case there is no confirmed candidate at all,
simply returns the most similar one.

=cut

sub first_confirmed_candidate {
	my ($self, $key) = @_;
	my %candidate_with;
	my $value;
	foreach my $candidate (@{$self->{candidates}}) {
		$value = $candidate->{$key};
		if($candidate_with{$value}) {
			return $candidate_with{$value};
		} else {
			$candidate_with{$value} = $candidate;
		}
	}

	# no confirmed candidate found, fall back
	return $self->most_similar_candidate();
}


# internal method for n-th root
sub _nrt {
	return $_[1] ** (1 / $_[0]);
}


=head1 SEE ALSO

See L<AI::CBR> for an overview of the framework.


=head1 AUTHOR

lib/AI/CBR/Sim.pm  view on Meta::CPAN

Works for any numeric values.
Suitable when you are interested into the difference of values in a given range.
Returns the fraction of the difference of the values with respect to a given maximum range of interest.
The madatory third argument is this range.

	sim_dist(26, 22, 10); # returns 0.4
	sim_dist(-2, 1, 100); # returns 0.03

=cut

sub sim_dist {
	my ($a, $b, $range) = @_;
	return 1 if $a == $b;
	my $dist = abs($a - $b);
	return 0 if $dist >= $range;
	return 1 - $dist / $range;
}


=head2 sim_frac

Works for non-negative numeric values.
Suitable when you are only interested into their relative difference with respect to 0.
Returns the fraction of the smaller argument with respect to the higher one.

	sim_frac(3, 2); # returns 0.67
	sim_frac(40, 50); # returns 0.8

=cut

sub sim_frac {
	my ($a, $b) = @_;
	return 1 if $a == $b;
	return 0 if $a * $b == 0;
	return $a > $b ? $b / $a : $a / $b;
}


=head2 sim_eq

Works for any textual value.
Suitable when you are interested only into equality/inequality.
Returns 1 in case of equality, 0 in case of inequality.
No third argument.

	sim_eq('foo', 'bar'); # returns 0
	sim_eq('foo', 'foo'); # returns 1

=cut

sub sim_eq {
	return $_[0] eq $_[1] ? 1 : 0;
}


=head2 sim_set

Works for sets/lists of textual values.
Suitable when you are interested into overlap of the two sets.
Arguments are two array references with textual values.
Returns the number of elements in the intersection
divided by the number of elements in the union.
No third argument.

	sim_set([qw/a b c/], [qw/b c d/]); # returns 0.5
	sim_set([qw/a b c/], [qw/c/]); # returns 0.33

=cut

sub sim_set {
	my ($a, $b) = @_;
	return 1 if int @$a == 0 && int @$b == 0;
	return 0 unless int @$a && int @$b;
	my %a = map { ($_ => 1) } @$a;
	my $union = int keys %a;
	my $intersection = 0;
	map {
		$a{$_} ? $intersection++ : $union++
	} @$b;
	return $intersection / $union;

t/boilerplate.t  view on Meta::CPAN

#!perl -T

use strict;
use warnings;
use Test::More tests => 4;

sub not_in_file_ok {
    my ($filename, %regex) = @_;
    open( my $fh, '<', $filename )
        or die "couldn't open $filename for reading: $!";

    my %violated;

    while (my $line = <$fh>) {
        while (my ($desc, $regex) = each %regex) {
            if ($line =~ $regex) {
                push @{$violated{$desc}||=[]}, $.;

t/boilerplate.t  view on Meta::CPAN

    }

    if (%violated) {
        fail("$filename contains boilerplate text");
        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
    } else {
        pass("$filename contains no boilerplate text");
    }
}

sub module_boilerplate_ok {
    my ($module) = @_;
    not_in_file_ok($module =>
        'the great new $MODULENAME'   => qr/ - The great new /,
        'boilerplate description'     => qr/Quick summary of what the module/,
        'stub function definition'    => qr/function[12]/,
    );
}

TODO: {
  local $TODO = "Need to replace the boilerplate text";