AI-CBR
view release on metacpan or search on metacpan
.cvsignore
Build.PL
Changes
lib/AI/CBR.pm
lib/AI/CBR/Case.pm
lib/AI/CBR/Case/Compound.pm
lib/AI/CBR/Retrieval.pm
lib/AI/CBR/Sim.pm
Makefile.PL
MANIFEST
META.yml
README
t/00-load.t
t/01-sim.t
t/02-case.t
t/03-retrieval.t
t/04-case-compound.t
t/boilerplate.t
t/pod-coverage.t
t/pod.t
build_requires:
Test::More: 0
provides:
AI::CBR:
file: lib/AI/CBR.pm
version: 0.02
AI::CBR::Case:
file: lib/AI/CBR/Case.pm
AI::CBR::Case::Compound:
file: lib/AI/CBR/Case/Compound.pm
AI::CBR::Retrieval:
file: lib/AI/CBR/Retrieval.pm
AI::CBR::Sim:
file: lib/AI/CBR/Sim.pm
generated_by: Module::Build version 0.2808
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2
lib/AI/CBR.pm view on Meta::CPAN
=cut
our $VERSION = '0.02';
=head1 SYNOPSIS
use AI::CBR::Sim qw(sim_eq ...);
use AI::CBR::Case;
use AI::CBR::Retrieval;
my $case = AI::CBR::Case->new(...);
my $r = AI::CBR::Retrieval->new($case, \@case_base);
...
=head1 DESCRIPTION
Framework for Case-Based Reasoning in Perl.
For an overview, please see my slides from YAPC::EU 2009.
In brief, you need to specifiy an L<AI::CBR::Case>
with the help of similarity functions from L<AI::CBR::Sim>.
Then you can find similar cases from a case-base
with L<AI::CBR::Retrieval>.
The technical documentation can be found in the
individual modules of this distribution.
=head1 SEE ALSO
=over 4
=item * L<AI::CBR::Sim>
=item * L<AI::CBR::Case>
=item * L<AI::CBR::Case::Compound>
=item * L<AI::CBR::Retrieval>
=back
=head1 AUTHOR
Darko Obradovic, C<< <dobradovic at gmx.de> >>
=head1 BUGS
lib/AI/CBR/Retrieval.pm view on Meta::CPAN
package AI::CBR::Retrieval;
use warnings;
use strict;
use List::Util qw(min);
=head1 NAME
AI::CBR::Retrieval - retrieve similar cases from a case-base
=head1 SYNOPSIS
Retrieve solutions for a case from a case-base
use AI::CBR::Retrieval;
my $r = AI::CBR::Retrieval->new($case, \@case_base);
$r->compute_sims();
my $solution = $r->most_similar_case();
...
=head1 METHODS
=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;
lib/AI/CBR/Retrieval.pm view on Meta::CPAN
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AI-CBR>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc AI::CBR::Retrieval
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=AI-CBR>
lib/AI/CBR/Retrieval.pm view on Meta::CPAN
=head1 COPYRIGHT & LICENSE
Copyright 2009 Darko Obradovic, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of AI::CBR::Retrieval
t/00-load.t view on Meta::CPAN
#!perl -T
use Test::More tests => 4;
BEGIN {
use_ok( 'AI::CBR::Sim' );
use_ok( 'AI::CBR::Case' );
use_ok( 'AI::CBR::Retrieval' );
use_ok( 'AI::CBR::Case::Compound' );
}
diag( "Testing AI::CBR::Case $AI::CBR::Case::VERSION, Perl $], $^X" );
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
is($case_base->[2]->{_sim}, (1/1+0+1+2*0/2)/5, 'sim 3 correct'); # 0.4
is($case_base->[3]->{_sim}, (5/6+1+1+2*1/1)/5, 'sim 4 correct'); # ~0.97
# check retrieval
is($retrieval->most_similar_candidate->{id}, 4, 'most similar candidate returned');
is($retrieval->n_most_similar_candidates(3), 3, 'n most similar candidates returned');
is($retrieval->first_confirmed_candidate('reason')->{id}, 2, 'first confirmed reason candidate returned');
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 },
},
# hotel object
t/04-case-compound.t view on Meta::CPAN
);
is(int @$case1, 2, '2 specs');
my @case_base = (
{id=>1, start=>'FRA', target=>'DBV', price=>200, stars=>5, rate=>160}, # ~0.35
{id=>2, start=>'FRA', target=>'LIS', price=>350, stars=>4, rate=>80}, # ~0.80
);
my $r = AI::CBR::Retrieval->new($case1, \@case_base);
$r->compute_sims();
is($r->{candidates}->[0]->{id}, 2, 'sim of id 2 is higher');
is($r->{candidates}->[1]->{id}, 1, 'sim of id 1 is lower');
is($case_base[0]->{_sim}, sqrt(0.5*0.25), 'sim of id 1 correct');
is($case_base[1]->{_sim}, sqrt((2.75/3)*(1.4/2)), 'sim of id 2 correct');
t/pod-coverage.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
if $@;
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
if $@;
all_pod_coverage_ok();
#!perl -T
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod
my $min_tp = 1.22;
eval "use Test::Pod $min_tp";
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
all_pod_files_ok();
( run in 2.791 seconds using v1.01-cache-2.11-cpan-acf6aa7dc9e )