AI-CBR
view release on metacpan or search on metacpan
lib/AI/CBR/Case.pm view on Meta::CPAN
AI::CBR::Case - case definition and representation
=head1 SYNOPSIS
Define and initialise a case.
In a productive system, you will want to encapsulate this.
use AI::CBR::Case;
use AI::CBR::Sim qw(sim_frac sim_eq sim_set);
# assume we are a doctor and see a patient
# shortcut one-time generated case
my $case = AI::CBR::Case->new(
age => { value => 30, sim => \&sim_frac },
gender => { value => 'male', sim => \&sim_eq },
job => { value => 'programmer', sim => \&sim_eq },
symptoms => { value => [qw(headache)], sim => \&sim_set },
);
# or case-specification with changing data
my $patient_case = AI::CBR::Case->new(
age => { sim => \&sim_frac },
gender => { sim => \&sim_eq },
job => { sim => \&sim_eq },
symptoms => { sim => \&sim_set },
);
foreach my $patient (@waiting_queue) {
$patient_case->set_values( %$patient ); # assume $patient is a hashref with the right attributes
...
}
...
=head1 METHODS
=head2 new
Creates a new case specification.
Pass a hash of hash references as argument.
lib/AI/CBR/Case.pm view on Meta::CPAN
=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;
}
=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
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;
bless $self, $class;
return $self;
}
=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/Sim.pm view on Meta::CPAN
package AI::CBR::Sim;
use warnings;
use strict;
use Exporter;
our @ISA = ('Exporter');
our @EXPORT_OK = qw(sim_dist sim_frac sim_eq sim_set);
=head1 NAME
AI::CBR::Sim - collection of basic similarity functions
=head1 SYNOPSIS
Import similarity functions for case construction.
lib/AI/CBR/Sim.pm view on Meta::CPAN
=head1 EXPORT
=over 4
=item * sim_dist
=item * sim_frac
=item * sim_eq
=item * sim_set
=back
=head1 FUNCTIONS
=head2 sim_dist
Works for any numeric values.
Suitable when you are interested into the difference of values in a given range.
lib/AI/CBR/Sim.pm view on Meta::CPAN
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;
#!perl -T
use Test::More tests => 22;
use AI::CBR::Sim qw(sim_dist sim_frac sim_eq sim_set);
# sim_dist
is(sim_dist(26,22,10), 0.6, 'sim_dist works');
is(sim_dist(-1,-0.9,0.5), 0.8, 'sim_dist works');
is(sim_dist(0,4,8), 0.5, 'sim_dist works');
# sim_frac
is(sim_frac(0,0), 1, 'sim_frac works');
is(sim_frac(0,2), 0, 'sim_frac works');
is(sim_frac(2,4), 0.5, 'sim_frac works');
is(sim_frac(16,4), 0.25, 'sim_frac works');
is(sim_frac(100,40), 0.4, 'sim_frac works');
# sim_eq
is(sim_eq('a','b'), 0, 'sim_eq works');
is(sim_eq('','b'), 0, 'sim_eq works');
is(sim_eq('a',''), 0, 'sim_eq works');
is(sim_eq('a','a'), 1, 'sim_eq works');
# sim_set
is(sim_set([], []), 1, 'sim_set works');
is(sim_set([qw(a b c)], []), 0, 'sim_set works');
is(sim_set([], [qw(d e f)]), 0, 'sim_set works');
is(sim_set([qw(a b)], [qw(c d)]), 0, 'sim_set works');
is(sim_set([qw(a b)], [qw(b c)]), 1/3, 'sim_set works');
is(sim_set([qw(a b c)], [qw(b c d)]), 0.5, 'sim_set works');
is(sim_set([qw(a b c d)], [qw(d e f g)]), 1/7, 'sim_set works');
is(sim_set([qw(a b c d)], [qw(a b c)]), 0.75, 'sim_set works');
is(sim_set([qw(a b c d)], [qw(a b c d)]), 1, 'sim_set works');
t/02-case.t view on Meta::CPAN
#!perl -T
use Test::More tests => 2;
use AI::CBR::Sim qw(sim_dist sim_frac sim_eq sim_set);
use AI::CBR::Case;
my $case1 = AI::CBR::Case->new(
age => { value => 30, sim => \&sim_amount },
gender => { value => 'male', sim => \&sim_eq },
job => { value => 'programmer', sim => \&sim_eq },
symptoms => { value => [qw(headache)], sim => \&sim_set, weight =>2 },
);
my $weights_at_1 = int grep { $case1->{$_}->{weight} == 1 } keys %$case1;
my $weights_at_2 = int grep { $case1->{$_}->{weight} == 2 } keys %$case1;
is($weights_at_1, 3, 'default weights set to 1');
is($weights_at_2, 1, 'symptom weight set to 2');
t/03-retrieval.t view on Meta::CPAN
#!perl -T
use Test::More tests => 7;
use AI::CBR::Sim qw(sim_frac sim_eq sim_set);
use AI::CBR::Case;
use AI::CBR::Retrieval;
my $case_base = [
{id=>1, age=>25, gender=>'male', job=>'manager', symptoms=>[qw(headache)], reason=>'stress' },
{id=>2, age=>40, gender=>'male', job=>'programmer', symptoms=>[qw(headache cough)], reason=>'flu' },
{id=>3, age=>30, gender=>'female', job=>'programmer', symptoms=>[qw(cough)], reason=>'flu' },
{id=>4, age=>25, gender=>'male', job=>'programmer', symptoms=>[qw(headache)], reason=>'alcohol'},
];
my $case1 = AI::CBR::Case->new(
age => { value => 30, sim => \&sim_frac },
gender => { value => 'male', sim => \&sim_eq },
job => { value => 'programmer', sim => \&sim_eq },
symptoms => { value => [qw(headache)], sim => \&sim_set, weight =>2 },
);
my $retrieval = AI::CBR::Retrieval->new($case1, $case_base);
$retrieval->compute_sims();
# check similarities
is($case_base->[0]->{_sim}, (5/6+1+0+2*1/1)/5, 'sim 1 correct'); # ~0.77
is($case_base->[1]->{_sim}, (3/4+1+1+2*1/2)/5, 'sim 2 correct'); # 0.75
t/04-case-compound.t view on Meta::CPAN
#!perl -T
use Test::More tests => 5;
use AI::CBR::Sim qw(sim_dist sim_frac sim_eq sim_set);
use AI::CBR::Case::Compound;
use AI::CBR::Retrieval;
my $case1 = AI::CBR::Case::Compound->new(
# flight object
{
start => { value => 'FRA', sim => \&sim_eq },
target => { value => 'LIS', sim => \&sim_eq },
price => { value => 300, sim => \&sim_dist, param => 200 },
( run in 0.783 second using v1.01-cache-2.11-cpan-49f99fa48dc )