line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package AI::ExpertSystem::Simple; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
983
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
4
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
440
|
use XML::Twig; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use AI::ExpertSystem::Simple::Rule; |
9
|
|
|
|
|
|
|
use AI::ExpertSystem::Simple::Knowledge; |
10
|
|
|
|
|
|
|
use AI::ExpertSystem::Simple::Goal; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '1.2'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub new { |
15
|
|
|
|
|
|
|
my ($class) = @_; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
die "Simple->new() takes no arguments" if scalar(@_) != 1; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $self = {}; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
$self->{_rules} = (); |
22
|
|
|
|
|
|
|
$self->{_knowledge} = (); |
23
|
|
|
|
|
|
|
$self->{_goal} = undef; |
24
|
|
|
|
|
|
|
$self->{_filename} = undef; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
$self->{_ask_about} = undef; |
27
|
|
|
|
|
|
|
$self->{_told_about} = undef; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
$self->{_log} = (); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
$self->{_number_of_rules} = 0; |
32
|
|
|
|
|
|
|
$self->{_number_of_attributes} = 0; |
33
|
|
|
|
|
|
|
$self->{_number_of_questions} = 0; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
return bless $self, $class; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub reset { |
39
|
|
|
|
|
|
|
my ($self) = @_; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
die "Simple->reset() takes no arguments" if scalar(@_) != 1; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
foreach my $name (keys %{$self->{_rules}}) { |
44
|
|
|
|
|
|
|
$self->{_rules}->{$name}->reset(); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
foreach my $name (keys %{$self->{_knowledge}}) { |
48
|
|
|
|
|
|
|
$self->{_knowledge}->{$name}->reset(); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
$self->{_ask_about} = undef; |
52
|
|
|
|
|
|
|
$self->{_told_about} = undef; |
53
|
|
|
|
|
|
|
$self->{_log} = (); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub load { |
57
|
|
|
|
|
|
|
my ($self, $filename) = @_; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
die "Simple->load() takes 1 argument" if scalar(@_) != 2; |
60
|
|
|
|
|
|
|
die "Simple->load() argument 1 (FILENAME) is undefined" if !defined($filename); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
if(-f $filename and -r $filename) { |
63
|
|
|
|
|
|
|
my $twig = XML::Twig->new( |
64
|
|
|
|
|
|
|
twig_handlers => { goal => sub { $self->_goal(@_) }, |
65
|
|
|
|
|
|
|
rule => sub { $self->_rule(@_) }, |
66
|
|
|
|
|
|
|
question => sub { $self->_question(@_) } } |
67
|
|
|
|
|
|
|
); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
$twig->safe_parsefile($filename); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
die "Simple->load() XML parse failed: $@" if $@; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
$self->{_filename} = $filename; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
$self->_add_to_log( "Read in $filename" ); |
76
|
|
|
|
|
|
|
$self->_add_to_log( "There are " . $self->{_number_of_rules} . " rules" ); |
77
|
|
|
|
|
|
|
$self->_add_to_log( "There are " . $self->{_number_of_attributes} . " attributes" ); |
78
|
|
|
|
|
|
|
$self->_add_to_log( "There are " . $self->{_number_of_questions} . " questions" ); |
79
|
|
|
|
|
|
|
$self->_add_to_log( "The goal attibutes is " . $self->{_goal}->name() ); |
80
|
|
|
|
|
|
|
return 1; |
81
|
|
|
|
|
|
|
} else { |
82
|
|
|
|
|
|
|
die "Simple->load() unable to use file"; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub _goal { |
87
|
|
|
|
|
|
|
my ($self, $t, $node) = @_; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
my $attribute = undef; |
90
|
|
|
|
|
|
|
my $text = undef; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
my $x = ($node->children('attribute'))[0]; |
93
|
|
|
|
|
|
|
$attribute = $x->text(); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$x = ($node->children('text'))[0]; |
96
|
|
|
|
|
|
|
$text = $x->text(); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
$self->{_goal} = AI::ExpertSystem::Simple::Goal->new($attribute, $text); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
eval { $t->purge(); } |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub _rule { |
104
|
|
|
|
|
|
|
my ($self, $t, $node) = @_; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
my $name = undef; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
my $x = ($node->children('name'))[0]; |
109
|
|
|
|
|
|
|
$name = $x->text(); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
if(!defined($self->{_rules}->{$name})) { |
112
|
|
|
|
|
|
|
$self->{_rules}->{$name} = AI::ExpertSystem::Simple::Rule->new($name); |
113
|
|
|
|
|
|
|
$self->{_number_of_rules}++; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
foreach $x ($node->get_xpath('//condition')) { |
117
|
|
|
|
|
|
|
my $attribute = undef; |
118
|
|
|
|
|
|
|
my $value = undef; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
my $y = ($x->children('attribute'))[0]; |
121
|
|
|
|
|
|
|
$attribute = $y->text(); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
$y = ($x->children('value'))[0]; |
124
|
|
|
|
|
|
|
$value = $y->text(); |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
$self->{_rules}->{$name}->add_condition($attribute, $value); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
if(!defined($self->{_knowledge}->{$attribute})) { |
129
|
|
|
|
|
|
|
$self->{_number_of_attributes}++; |
130
|
|
|
|
|
|
|
$self->{_knowledge}->{$attribute} = AI::ExpertSystem::Simple::Knowledge->new($attribute); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
foreach $x ($node->get_xpath('//action')) { |
135
|
|
|
|
|
|
|
my $attribute = undef; |
136
|
|
|
|
|
|
|
my $value = undef; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
my $y = ($x->children('attribute'))[0]; |
139
|
|
|
|
|
|
|
$attribute = $y->text(); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
$y = ($x->children('value'))[0]; |
142
|
|
|
|
|
|
|
$value = $y->text(); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
$self->{_rules}->{$name}->add_action($attribute, $value); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
if(!defined($self->{_knowledge}->{$attribute})) { |
147
|
|
|
|
|
|
|
$self->{_number_of_attributes}++; |
148
|
|
|
|
|
|
|
$self->{_knowledge}->{$attribute} = AI::ExpertSystem::Simple::Knowledge->new($attribute); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
eval { $t->purge(); } |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub _question { |
156
|
|
|
|
|
|
|
my ($self, $t, $node) = @_; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
my $attribute = undef; |
159
|
|
|
|
|
|
|
my $text = undef; |
160
|
|
|
|
|
|
|
my @responses = (); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
$self->{_number_of_questions}++; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
my $x = ($node->children('attribute'))[0]; |
165
|
|
|
|
|
|
|
$attribute = $x->text(); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
$x = ($node->children('text'))[0]; |
168
|
|
|
|
|
|
|
$text = $x->text(); |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
foreach $x ($node->children('response')) { |
171
|
|
|
|
|
|
|
push(@responses, $x->text()); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
if(!defined($self->{_knowledge}->{$attribute})) { |
175
|
|
|
|
|
|
|
$self->{_number_of_attributes}++; |
176
|
|
|
|
|
|
|
$self->{_knowledge}->{$attribute} = AI::ExpertSystem::Simple::Knowledge->new($attribute); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
$self->{_knowledge}->{$attribute}->set_question($text, @responses); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
eval { $t->purge(); } |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub process { |
184
|
|
|
|
|
|
|
my ($self) = @_; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
die "Simple->process() takes no arguments" if scalar(@_) != 1; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
my $n = $self->{_goal}->name(); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
if($self->{_knowledge}->{$n}->is_value_set()) { |
191
|
|
|
|
|
|
|
return 'finished'; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
if($self->{_ask_about}) { |
195
|
|
|
|
|
|
|
my %answers = (); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
$answers{$self->{_ask_about}}->{value} = $self->{_told_about}; |
198
|
|
|
|
|
|
|
$answers{$self->{_ask_about}}->{setter} = ''; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
$self->{_ask_about} = undef; |
201
|
|
|
|
|
|
|
$self->{_told_about} = undef; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
while(%answers) { |
204
|
|
|
|
|
|
|
my %old_answers = %answers; |
205
|
|
|
|
|
|
|
%answers = (); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
foreach my $answer (keys(%old_answers)) { |
208
|
|
|
|
|
|
|
my $n = $answer; |
209
|
|
|
|
|
|
|
my $v = $old_answers{$answer}->{value}; |
210
|
|
|
|
|
|
|
my $s = $old_answers{$answer}->{setter}; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
$self->_add_to_log( "Setting '$n' to '$v'" ); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
$self->{_knowledge}->{$n}->set_value($v,$s); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
foreach my $key (keys(%{$self->{_rules}})) { |
217
|
|
|
|
|
|
|
if($self->{_rules}->{$key}->state() eq 'active') { |
218
|
|
|
|
|
|
|
my $state = $self->{_rules}->{$key}->given($n, $v); |
219
|
|
|
|
|
|
|
if($state eq 'completed') { |
220
|
|
|
|
|
|
|
$self->_add_to_log( "Rule '$key' has completed" ); |
221
|
|
|
|
|
|
|
my %y = $self->{_rules}->{$key}->actions(); |
222
|
|
|
|
|
|
|
foreach my $k (keys(%y)) { |
223
|
|
|
|
|
|
|
$self->_add_to_log( "Rule '$key' is setting '$k' to '$y{$k}'" ); |
224
|
|
|
|
|
|
|
$answers{$k}->{value} = $y{$k}; |
225
|
|
|
|
|
|
|
$answers{$k}->{setter} = $key; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} elsif($state eq 'invalid') { |
228
|
|
|
|
|
|
|
$self->_add_to_log( "Rule '$key' is now inactive" ); |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
return 'continue'; |
236
|
|
|
|
|
|
|
} else { |
237
|
|
|
|
|
|
|
my %scoreboard = (); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
foreach my $rule (keys(%{$self->{_rules}})) { |
240
|
|
|
|
|
|
|
if($self->{_rules}->{$rule}->state() eq 'active') { |
241
|
|
|
|
|
|
|
my @listofquestions = $self->{_rules}->{$rule}->unresolved(); |
242
|
|
|
|
|
|
|
my $ok = 1; |
243
|
|
|
|
|
|
|
my @questionstoask = (); |
244
|
|
|
|
|
|
|
foreach my $name (@listofquestions) { |
245
|
|
|
|
|
|
|
if($self->{_knowledge}->{$name}->has_question()) { |
246
|
|
|
|
|
|
|
push(@questionstoask, $name); |
247
|
|
|
|
|
|
|
} else { |
248
|
|
|
|
|
|
|
$ok = 0; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
if($ok == 1) { |
253
|
|
|
|
|
|
|
foreach my $name (@questionstoask) { |
254
|
|
|
|
|
|
|
$scoreboard{$name}++; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
my $max_value = 0; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
foreach my $name (keys(%scoreboard)) { |
263
|
|
|
|
|
|
|
if($scoreboard{$name} > $max_value) { |
264
|
|
|
|
|
|
|
$max_value = $scoreboard{$name}; |
265
|
|
|
|
|
|
|
$self->{_ask_about} = $name; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
return $self->{_ask_about} ? 'question' : 'failed'; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub get_question { |
274
|
|
|
|
|
|
|
my ($self) = @_; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
die "Simple->get_question() takes no arguments" if scalar(@_) != 1; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
return $self->{_knowledge}->{$self->{_ask_about}}->get_question(); |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub answer { |
282
|
|
|
|
|
|
|
my ($self, $value) = @_; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
die "Simple->answer() takes 1 argument" if scalar(@_) != 2; |
285
|
|
|
|
|
|
|
die "Simple->answer() argument 1 (VALUE) is undefined" if ! defined($value); |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
$self->{_told_about} = $value; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
sub get_answer { |
291
|
|
|
|
|
|
|
my ($self) = @_; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
die "Simple->get_answer() takes no arguments" if scalar(@_) != 1; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
my $n = $self->{_goal}->name(); |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
return $self->{_goal}->answer($self->{_knowledge}->{$n}->get_value()); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
sub log { |
301
|
|
|
|
|
|
|
my ($self) = @_; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
die "Simple->log() takes no arguments" if scalar(@_) != 1; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
my @return = (); |
306
|
|
|
|
|
|
|
@return = @{$self->{_log}} if defined @{$self->{_log}}; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
$self->{_log} = (); |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
return @return; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub _add_to_log { |
314
|
|
|
|
|
|
|
my ($self, $message) = @_; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
push( @{$self->{_log}}, $message ); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub explain { |
320
|
|
|
|
|
|
|
my ($self) = @_; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
die "Simple->explain() takes no arguments" if scalar(@_) != 1; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
my $name = $self->{_goal}->name(); |
325
|
|
|
|
|
|
|
my $rule = $self->{_knowledge}->{$name}->get_setter(); |
326
|
|
|
|
|
|
|
my $value = $self->{_knowledge}->{$name}->get_value(); |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
my $x = "The goal '$name' was set to '$value' by " . ($rule ? "rule '$rule'" : 'asking a question' ); |
329
|
|
|
|
|
|
|
$self->_add_to_log( $x ); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
my @processed_rules; |
332
|
|
|
|
|
|
|
push( @processed_rules, $rule ) if $rule; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
$self->_explain_this( $rule, '', @processed_rules ); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub _explain_this { |
338
|
|
|
|
|
|
|
my ($self, $rule, $depth, @processed_rules) = @_; |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
$self->_add_to_log( "${depth}Explaining rule '$rule'" ); |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
my %dont_do_these = map{ $_ => 1 } @processed_rules; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
my @check_these_rules = (); |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
my %conditions = $self->{_rules}->{$rule}->conditions(); |
347
|
|
|
|
|
|
|
foreach my $name (sort keys %conditions) { |
348
|
|
|
|
|
|
|
my $value = $conditions{$name}; |
349
|
|
|
|
|
|
|
my $setter = $self->{_knowledge}->{$name}->get_setter(); |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
my $x = "$depth Condition '$name' was set to '$value' by " . ($setter ? "rule '$setter'" : 'asking a question' ); |
352
|
|
|
|
|
|
|
$self->_add_to_log( $x ); |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
if($setter) { |
355
|
|
|
|
|
|
|
unless($dont_do_these{$setter}) { |
356
|
|
|
|
|
|
|
$dont_do_these{$setter} = 1; |
357
|
|
|
|
|
|
|
push( @check_these_rules, $setter ); |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
my %actions = $self->{_rules}->{$rule}->actions(); |
363
|
|
|
|
|
|
|
foreach my $name (sort keys %actions) { |
364
|
|
|
|
|
|
|
my $value = $actions{$name}; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
my $x = "$depth Action set '$name' to '$value'"; |
367
|
|
|
|
|
|
|
$self->_add_to_log( $x ); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
@processed_rules = keys %dont_do_these; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
foreach my $x ( @check_these_rules ) { |
373
|
|
|
|
|
|
|
push( @processed_rules, $self->_explain_this( $x, "$depth ", keys %dont_do_these ) ); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
return @processed_rules; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
1; |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=head1 NAME |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
AI::ExpertSystem::Simple - A simple expert system shell |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=head1 VERSION |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
This document refers to verion 1.2 of AI::ExpertSystem::Simple, released June 10, 2003 |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=head1 SYNOPSIS |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
This class implements a simple expert system shell that reads the rules from an XML |
392
|
|
|
|
|
|
|
knowledge base and questions the user as it attempts to arrive at a conclusion. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=head1 DESCRIPTION |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head2 Overview |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
This class is where all the work is being done and the other three classes are only |
399
|
|
|
|
|
|
|
there for support. At present there is little you can do with it other than run it. Future |
400
|
|
|
|
|
|
|
version will make subclassing of this class feasable and features like logging will be introduced. |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
To see how to use this class there is a simple shell in the bin directory which allows you |
403
|
|
|
|
|
|
|
to consult the example knowledge bases and more extensive documemtation in the docs directory. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
There is a Ruby version that reads the same XML knowledge bases, if you are interested. |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=head2 Constructors and initialisation |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=over 4 |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
=item new( ) |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
The constructor takes no arguments and just initialises a few basic variables. |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=back |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=head2 Public methods |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=over 4 |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=item reset( ) |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
Resets the system back to its initial state so that a new consoltation can be run |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=item load( FILENAME ) |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
This method takes the FILENAME of an XML knowledgebase and attempts to parse it to set up the data structures |
428
|
|
|
|
|
|
|
required for a consoltation. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=item process( ) |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
Once the knowledgebase is loaded the consultation is run by repeatedly calling this method. |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
It returns four results: |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=over 4 |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=item "question" |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
The system has a question to ask of the user. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
The question and list of valid responses is available from the get_question( ) method and the users response should be returned via the answer( ) method. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Then simply call the process( ) method again. |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=item "continue" |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
The system has calculated some data but has nothing to ask the user but has still not finished. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
This response will be removed in future versions. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
Simply call the process( ) method again. |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=item "finished" |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
The consoltation has finished and the system has an answer for the user which is available from the answer( ) method. |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=item "failed" |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
The consoltation has finished and the system has failed to find an answer for the user. It happens. |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=back |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=item get_question( ) |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
If the process( ) method has returned "question" then this method will return the question to ask the user |
467
|
|
|
|
|
|
|
and a list of valid responses. |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=item answer( VALUE ) |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
The user has been presented with the question from the get_question( ) method along with a set of |
472
|
|
|
|
|
|
|
valid responses and the users selection is returned by this method. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=item get_answer( ) |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
If the process( ) method has returned "finished" then the answer to the users query will be |
477
|
|
|
|
|
|
|
returned by this method. |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=item log( ) |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
Returns a list of the actions undertaken so far and clears the log. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=item explain( ) |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
Explain how the given answer was arrived at. The explanation is added to the log. |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=back |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=head2 Private methods |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=over 4 |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=item _goal |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
A private method to get the goal data from the knowledgebase. |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
=item _rule |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
A private method to get the rule data from the knowledgebase. |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=item _question |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
A private method to get the question data from the knowledgebase. |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=item _add_to_log |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
A private method to add a message to the log. |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=item _explain_this |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
A private method to explain how a single attribute was set. |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=back |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=head1 ENVIRONMENT |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
None |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=over 4 |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=item Simple->new() takes no arguments |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
When the constructor is initialised it requires no arguments. This message is given if |
526
|
|
|
|
|
|
|
some arguments were supplied. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=item Simple->reset() takes no arguments |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
When the method is called it requires no arguments. This message is given if |
531
|
|
|
|
|
|
|
some arguments were supplied. |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
=item Simple->load() takes 1 argument |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
When the method is called it requires one argument. This message is given if more or |
536
|
|
|
|
|
|
|
less arguments were supplied. |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
=item Simple->load() argument 1 (FILENAME) is undefined |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
The corrct number of arguments were supplied with the method call, however the first |
541
|
|
|
|
|
|
|
argument, FILENAME, was undefined. |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=item Simple->load() XML parse failed |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
XML Twig encountered some errors when trying to parse the XML knowledgebase. |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
=item Simple->load() unable to use file |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
The file supplied to the load( ) method could not be used as it was either not a file |
550
|
|
|
|
|
|
|
or not readable. |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=item Simple->process() takes no arguments |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
When the method is called it requires no arguments. This message is given if |
555
|
|
|
|
|
|
|
some arguments were supplied. |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=item Simple->get_question() takes no arguments |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
When the method is called it requires no arguments. This message is given if |
560
|
|
|
|
|
|
|
some arguments were supplied. |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
=item Simple->answer() takes 1 argument |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
When the method is called it requires one argument. This message is given if more or |
565
|
|
|
|
|
|
|
less arguments were supplied. |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=item Simple->answer() argument 1 (VALUE) is undefined |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
The corrct number of arguments were supplied with the method call, however the first |
570
|
|
|
|
|
|
|
argument, VALUE, was undefined. |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=item Simple->get_answer() takes no arguments |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
When the method is called it requires no arguments. This message is given if |
575
|
|
|
|
|
|
|
some arguments were supplied. |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=item Simple->log() takes no arguments |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
When the method is called it requires no arguments. This message is given if |
580
|
|
|
|
|
|
|
some arguments were supplied. |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
=item Simple->explain() takes no arguments |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
When the method is called it requires no arguments. This message is given if |
585
|
|
|
|
|
|
|
some arguments were supplied. |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=back |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=head1 BUGS |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
None |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=head1 FILES |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
See the Simple.t file in the test directory and simpleshell in the bin directory. |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=head1 SEE ALSO |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
AI::ExpertSystem::Simple::Goal - A utility class |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
AI::ExpertSystem::Simple::Knowledge - A utility class |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
AI::ExpertSystem::Simple::Rule - A utility class |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
=head1 AUTHORS |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
Peter Hickman (peterhi@ntlworld.com) |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=head1 COPYRIGHT |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
Copyright (c) 2003, Peter Hickman. All rights reserved. |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
This module is free software. It may be used, redistributed and/or |
614
|
|
|
|
|
|
|
modified under the same terms as Perl itself. |