File Coverage

blib/lib/AI/CBR/Sim.pm
Criterion Covered Total %
statement 29 29 100.0
branch 17 18 94.4
condition 6 6 100.0
subroutine 7 7 100.0
pod 4 4 100.0
total 63 64 98.4


line stmt bran cond sub pod time code
1             package AI::CBR::Sim;
2              
3 5     5   119795 use warnings;
  5         14  
  5         150  
4 5     5   27 use strict;
  5         8  
  5         153  
5              
6 5     5   24 use Exporter;
  5         15  
  5         1983  
7             our @ISA = ('Exporter');
8             our @EXPORT_OK = qw(sim_dist sim_frac sim_eq sim_set);
9              
10              
11             =head1 NAME
12              
13             AI::CBR::Sim - collection of basic similarity functions
14              
15              
16             =head1 SYNOPSIS
17              
18             Import similarity functions for case construction.
19              
20             use AI::CBR::Sim qw(sim_dist sim_eq);
21              
22             ...
23             ...
24              
25              
26             =head1 EXPORT
27              
28             =over 4
29              
30             =item * sim_dist
31              
32             =item * sim_frac
33              
34             =item * sim_eq
35              
36             =item * sim_set
37              
38             =back
39              
40              
41             =head1 FUNCTIONS
42              
43             =head2 sim_dist
44              
45             Works for any numeric values.
46             Suitable when you are interested into the difference of values in a given range.
47             Returns the fraction of the difference of the values with respect to a given maximum range of interest.
48             The madatory third argument is this range.
49              
50             sim_dist(26, 22, 10); # returns 0.4
51             sim_dist(-2, 1, 100); # returns 0.03
52              
53             =cut
54              
55             sub sim_dist {
56 9     9 1 24 my ($a, $b, $range) = @_;
57 9 50       22 return 1 if $a == $b;
58 9         19 my $dist = abs($a - $b);
59 9 100       23 return 0 if $dist >= $range;
60 8         39 return 1 - $dist / $range;
61             }
62              
63              
64             =head2 sim_frac
65              
66             Works for non-negative numeric values.
67             Suitable when you are only interested into their relative difference with respect to 0.
68             Returns the fraction of the smaller argument with respect to the higher one.
69              
70             sim_frac(3, 2); # returns 0.67
71             sim_frac(40, 50); # returns 0.8
72              
73             =cut
74              
75             sub sim_frac {
76 10     10 1 15 my ($a, $b) = @_;
77 10 100       534 return 1 if $a == $b;
78 8 100       25 return 0 if $a * $b == 0;
79 6 100       37 return $a > $b ? $b / $a : $a / $b;
80             }
81              
82              
83             =head2 sim_eq
84              
85             Works for any textual value.
86             Suitable when you are interested only into equality/inequality.
87             Returns 1 in case of equality, 0 in case of inequality.
88             No third argument.
89              
90             sim_eq('foo', 'bar'); # returns 0
91             sim_eq('foo', 'foo'); # returns 1
92              
93             =cut
94              
95             sub sim_eq {
96 16 100   16 1 71 return $_[0] eq $_[1] ? 1 : 0;
97             }
98              
99              
100             =head2 sim_set
101              
102             Works for sets/lists of textual values.
103             Suitable when you are interested into overlap of the two sets.
104             Arguments are two array references with textual values.
105             Returns the number of elements in the intersection
106             divided by the number of elements in the union.
107             No third argument.
108              
109             sim_set([qw/a b c/], [qw/b c d/]); # returns 0.5
110             sim_set([qw/a b c/], [qw/c/]); # returns 0.33
111              
112             =cut
113              
114             sub sim_set {
115 13     13 1 26 my ($a, $b) = @_;
116 13 100 100     52 return 1 if int @$a == 0 && int @$b == 0;
117 12 100 100     68 return 0 unless int @$a && int @$b;
118 10         19 my %a = map { ($_ => 1) } @$a;
  23         68  
119 10         22 my $union = int keys %a;
120 10         24 my $intersection = 0;
121 23 100       56 map {
122 10         19 $a{$_} ? $intersection++ : $union++
123             } @$b;
124 10         107 return $intersection / $union;
125             }
126              
127              
128             =head1 SEE ALSO
129              
130             See L for an overview of the framework.
131              
132              
133             =head1 AUTHOR
134              
135             Darko Obradovic, C<< >>
136              
137             =head1 BUGS
138              
139             Please report any bugs or feature requests to C, or through
140             the web interface at L. I will be notified, and then you'll
141             automatically be notified of progress on your bug as I make changes.
142              
143              
144              
145              
146             =head1 SUPPORT
147              
148             You can find documentation for this module with the perldoc command.
149              
150             perldoc AI::CBR::Sim
151              
152              
153             You can also look for information at:
154              
155             =over 4
156              
157             =item * RT: CPAN's request tracker
158              
159             L
160              
161             =item * AnnoCPAN: Annotated CPAN documentation
162              
163             L
164              
165             =item * CPAN Ratings
166              
167             L
168              
169             =item * Search CPAN
170              
171             L
172              
173             =back
174              
175              
176             =head1 COPYRIGHT & LICENSE
177              
178             Copyright 2009 Darko Obradovic, all rights reserved.
179              
180             This program is free software; you can redistribute it and/or modify it
181             under the same terms as Perl itself.
182              
183              
184             =cut
185              
186             1; # End of AI::CBR::Sim