File Coverage

blib/lib/AI/CBR/Case.pm
Criterion Covered Total %
statement 12 15 80.0
branch 2 2 100.0
condition n/a
subroutine 3 4 75.0
pod 2 2 100.0
total 19 23 82.6


line stmt bran cond sub pod time code
1             package AI::CBR::Case;
2              
3 3     3   6771 use warnings;
  3         6  
  3         96  
4 3     3   17 use strict;
  3         6  
  3         996  
5              
6             our $DEFAULT_WEIGHT = 1;
7              
8              
9             =head1 NAME
10              
11             AI::CBR::Case - case definition and representation
12              
13              
14             =head1 SYNOPSIS
15              
16             Define and initialise a case.
17             In a productive system, you will want to encapsulate this.
18              
19             use AI::CBR::Case;
20             use AI::CBR::Sim qw(sim_frac sim_eq sim_set);
21              
22             # assume we are a doctor and see a patient
23             # shortcut one-time generated case
24             my $case = AI::CBR::Case->new(
25             age => { value => 30, sim => \&sim_frac },
26             gender => { value => 'male', sim => \&sim_eq },
27             job => { value => 'programmer', sim => \&sim_eq },
28             symptoms => { value => [qw(headache)], sim => \&sim_set },
29             );
30            
31             # or case-specification with changing data
32             my $patient_case = AI::CBR::Case->new(
33             age => { sim => \&sim_frac },
34             gender => { sim => \&sim_eq },
35             job => { sim => \&sim_eq },
36             symptoms => { sim => \&sim_set },
37             );
38            
39             foreach my $patient (@waiting_queue) {
40             $patient_case->set_values( %$patient ); # assume $patient is a hashref with the right attributes
41             ...
42             }
43             ...
44              
45             =head1 METHODS
46              
47             =head2 new
48              
49             Creates a new case specification.
50             Pass a hash of hash references as argument.
51             The hash keys identify the attributes of the case,
52             the hash reference specifies this attribute,
53             with the following values:
54              
55             =over 4
56              
57             =item * B: a reference to the similarity function to use for this attribute
58              
59             =item * B: the parameter for the similarity function, if required
60              
61             =item * B: 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.
62              
63             =item * B: the value of the attribute, if you want to specify the complete case immediately. You can also do this later.
64              
65             =back
66              
67             =cut
68              
69             sub new {
70 2     2 1 86 my ($class, %attributes) = @_;
71            
72             # set default weights if unspecified
73 2         9 foreach (keys %attributes) {
74 8 100       66 $attributes{$_}->{weight} = $DEFAULT_WEIGHT unless defined $attributes{$_}->{weight};
75             }
76            
77 2         6 my $self = \%attributes;
78 2         6 bless $self, $class;
79 2         8 return $self;
80             }
81              
82              
83             =head2 set_values
84              
85             Pass a hash of attribute keys and values.
86             This will overwrite existing values, and can thus be used as a faster method
87             for generating new cases with the same specification.
88              
89             =cut
90              
91             sub set_values {
92 0     0 1   my ($self, %values) = @_;
93 0           foreach (keys %values) {
94 0           $self->{$_}->{value} = $values{$_};
95             }
96             }
97              
98              
99             =head1 SEE ALSO
100              
101             See L for an overview of the framework.
102              
103              
104             =head1 AUTHOR
105              
106             Darko Obradovic, C<< >>
107              
108             =head1 BUGS
109              
110             Please report any bugs or feature requests to C, or through
111             the web interface at L. I will be notified, and then you'll
112             automatically be notified of progress on your bug as I make changes.
113              
114              
115              
116              
117             =head1 SUPPORT
118              
119             You can find documentation for this module with the perldoc command.
120              
121             perldoc AI::CBR::Case
122              
123              
124             You can also look for information at:
125              
126             =over 4
127              
128             =item * RT: CPAN's request tracker
129              
130             L
131              
132             =item * AnnoCPAN: Annotated CPAN documentation
133              
134             L
135              
136             =item * CPAN Ratings
137              
138             L
139              
140             =item * Search CPAN
141              
142             L
143              
144             =back
145              
146              
147             =head1 COPYRIGHT & LICENSE
148              
149             Copyright 2009 Darko Obradovic, all rights reserved.
150              
151             This program is free software; you can redistribute it and/or modify it
152             under the same terms as Perl itself.
153              
154              
155             =cut
156              
157             1; # End of AI::CBR::Case