File Coverage

blib/lib/AI/Logic/AnswerSet.pm
Criterion Covered Total %
statement 15 249 6.0
branch 1 104 0.9
condition 0 6 0.0
subroutine 4 20 20.0
pod 15 15 100.0
total 35 394 8.8


line stmt bran cond sub pod time code
1             package AI::Logic::AnswerSet;
2              
3 1     1   23811 use 5.010001;
  1         4  
  1         37  
4 1     1   6 use strict;
  1         2  
  1         33  
5 1     1   5 use warnings;
  1         6  
  1         3209  
6              
7             require Exporter;
8              
9             our @ISA = qw(Exporter);
10              
11             our %EXPORT_TAGS = ( 'all' => [ qw(
12            
13             ) ] );
14              
15             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
16              
17             our @EXPORT = qw(
18            
19             );
20              
21             our $VERSION = '0.02';
22              
23             sub executeFromFileAndSave { #Executes DLV with a file as input and saves the output in another file
24              
25 0     0 1 0 open DLVW, ">>", "$_[1]";
26 0         0 print DLVW $_[2];
27 0         0 close DLVW;
28              
29 0 0       0 open(SAVESTDOUT, ">&STDOUT") or die "Can't save STDOUT: $!\n";
30 0 0       0 open(STDOUT, ">$_[0]") or die "Can't open STDOUT to $_[0]", "$!\n";
31              
32              
33 0         0 my @args = ("./dlv", "$_[1]");
34 0 0       0 system(@args) == 0
35             or die "system @args failed: $?";
36              
37 0         0 open(STDOUT,">&SAVESTDOUT"); #close file and restore STDOUT
38 0         0 close OUTPUT;
39              
40             }
41              
42             sub executeAndSave { #Executes DLV and saves the output of the program written by the user in a file
43              
44 0 0   0 1 0 open(SAVESTDOUT, ">&STDOUT") or die "Can't save STDOUT: $!\n";
45 0 0       0 open(STDOUT, ">$_[0]") or die "Can't open STDOUT to $_[0]", "$!\n";
46              
47 0         0 my @args = ("./dlv --");
48 0 0       0 system(@args) == 0 or die "system @args failed: $?";
49              
50 0         0 open(STDOUT,">&SAVESTDOUT"); #close file and restore STDOUT
51 0         0 close OUTPUT;
52              
53              
54             }
55              
56              
57             sub iterativeExec { # Executes an input program with several instances and stores them in a bidimensional array
58              
59 0     0 1 0 my @input = @_;
60              
61 0         0 my @returned_value;
62              
63 0 0       0 if(@input) {
64            
65 0         0 my $option = $input[$#input];
66              
67 0 0       0 if($option =~ /^-/) {
68 0         0 pop(@input);
69             }
70             else {
71 0         0 $option = "";
72             }
73              
74 0         0 my $dir = pop(@input);
75 0         0 my @files = qx(ls $dir);
76            
77 0         0 my $size = @files;
78              
79 0         0 for(my $i = 0; $i < $size; $i++) {
80              
81 0         0 my $elem = $files[$i];
82 0         0 chomp $elem;
83 0         0 my @args = ("./dlv", "@input", "$dir$elem", "$option");
84 0         0 my (@out) = `@args`;
85 0         0 push @{$returned_value[$i]}, @out;
  0         0  
86             }
87            
88             }
89              
90             else {
91 0         0 print "INPUT ERROR\n";
92             }
93              
94 0         0 return @returned_value;
95              
96             }
97              
98             sub singleExec { # Executes a single input program or opens the DLV terminal and stores it in an array
99              
100 0     0 1 0 my @input = @_;
101 0         0 my @returned_value;
102              
103 0 0       0 if(@input) {
104              
105              
106 0         0 my @args = ("./dlv", "@input");
107 0         0 (@returned_value) = `@args`;
108            
109             }
110              
111             else {
112 0         0 my $command = "./dlv --";
113 0         0 (@returned_value) = `$command`;
114             }
115              
116 0         0 return @returned_value;
117             }
118              
119             sub selectOutput { # Select one of the outputs returned by the iterative execution of more input programs
120              
121 0     0 1 0 my @stdoutput = @{$_[0]};
  0         0  
122 0         0 my $n = $_[1];
123              
124 0         0 return @{$stdoutput[$n]};
  0         0  
125            
126             }
127              
128             sub getFacts { # Return the facts of the input program
129              
130 0     0 1 0 my $input = shift;
131              
132 0         0 my @isAFile = stat($input);
133              
134 0         0 my @facts;
135              
136 0 0       0 if(@isAFile) {
137              
138 0         0 open INPUT, "<", "$input";
139 0         0 my @rows = ;
140 0         0 foreach my $row (@rows) {
141 0 0       0 if($row =~ /^(\w+)(\(((\w|\d|\.)+,?)*\))?\./) {
142 0         0 push @facts, $row;
143             }
144             }
145 0         0 close INPUT;
146              
147             }
148             else {
149 0         0 my @str = split /\. /,$input;
150 0         0 foreach my $elem (@str) {
151              
152 0 0       0 if($elem =~ /^(\w+)(\(((\w|\d|\.)+,?)*\))?\.?$/) {
153 0         0 push @facts, $elem;
154             }
155             }
156             }
157 0         0 return @facts;
158            
159             }
160              
161             sub addCode { #Adds code to input
162              
163 1     1 1 325 my $program = $_[0];
164 1         2 my $code = $_[1];
165 1         23 my @isAFile = stat($program);
166              
167 1 50       6 if(@isAFile) {
168 0         0 open PROGRAM, ">>", $program;
169 0         0 print PROGRAM "$code\n";
170 0         0 close PROGRAM;
171             }
172              
173             else {
174 1         2 $program = \($_[0]);
175 1         105 $$program = "$$program $code";
176             }
177            
178             }
179              
180             sub getASFromFile { #Gets the Answer Set from the file where the output was saved
181              
182 0 0   0 1   open RESULT, "<", "$_[0]" or die $!;
183 0           my @result = ;
184 0           my @arr;
185 0           foreach my $line (@result) {
186              
187 0 0         if($line =~ /\{\w*/) {
188 0           $line =~ s/(\{|\})//g;
189             #$line =~ s/\n//g; # delete \n from $line
190 0           my @tmp = split(', ', $line);
191 0           push @arr, @tmp;
192             }
193              
194             }
195              
196 0           close RESULT;
197 0           return @arr;
198             }
199              
200             sub getAS { #Returns the Answer Sets from the array where the output was saved
201              
202 0     0 1   my @result = @_;
203 0           my @arr;
204              
205 0           foreach my $line (@result) {
206              
207              
208 0 0         if($line =~ /\{\w*/) {
209 0           $line =~ s/(\{|\})//g;
210 0           $line =~ s/(Best model:)//g;
211 0           my @tmp = split(', ', $line);
212 0           push @arr, @tmp;
213             }
214              
215             }
216              
217 0           return @arr;
218             }
219              
220             sub statistics { # Return an array of hashes in which the statistics of every predicate of every answerSets are stored
221             # If a condition of comparison is specified(number of predicates) it returns the answer sets that satisfy
222             # that condition
223              
224 0     0 1   my @as = @{$_[0]};
  0            
225 0           my @pred = @{$_[1]};
  0            
226 0           my @num = @{$_[2]};
  0            
227 0           my @operators = @{$_[3]};
  0            
228              
229 0           my @sets;
230             my @ans;
231            
232 0           my $countAS = 0;
233 0           my @stat;
234              
235             my $countPred;
236              
237 0           foreach my $elem (@as) {
238              
239 0 0         if($elem =~ /(\w+).*\n/) {
    0          
240 0           push @{$sets[$countAS]}, $elem;
  0            
241 0 0         if(_existsPred($1,\@pred)) {
242 0           $stat[$countAS]{$1} += 1;
243 0           $countAS += 1;
244             }
245             }
246              
247             elsif($elem =~ /(\w+).*/) {
248 0           push @{$sets[$countAS]}, $elem;
  0            
249 0 0         if(_existsPred($1,\@pred)) {
250 0           $stat[$countAS]{$1} += 1;
251             }
252             }
253             }
254              
255 0           my $comparison = 0;
256 0 0 0       if(@num and @operators) {
    0 0        
257 0           $comparison = 1;
258             }
259             elsif(@num and !@operators) {
260 0           print "Error: comparison element missing";
261 0           return @ans;
262             }
263            
264            
265              
266 0 0         if($comparison) {
267 0           my $size = @pred;
268 0           my $statSize = @stat;
269              
270 0           for(my $j = 0; $j < $statSize; $j++) {
271 0           for(my $i = 0; $i < $size; $i++) {
272              
273 0           my $t = $stat[$j]{$pred[$i]};
274              
275 0 0         if(_evaluate($t,$num[$i],$operators[$i])) {
276 0           $countPred++;
277             }
278             else {
279 0           $countPred = 0;
280 0           break;
281             }
282             }
283              
284 0 0         if($countPred == $size) {
285 0           push @ans , $sets[$j];
286             }
287 0           $countPred = 0;
288             }
289 0           return @ans;
290              
291             }
292              
293 0           return @stat;
294             }
295              
296             sub _evaluate { #private use only
297              
298 0     0     my $value = shift;
299 0           my $num = shift;
300 0           my $operator = shift;
301              
302 0 0         if($operator eq "==") {
    0          
    0          
    0          
    0          
    0          
303 0 0         if($value == $num) {
304 0           return 1;
305             }
306 0           return 0;
307             }
308             elsif($operator eq "!=") {
309 0 0         if($value != $num) {
310 0           return 1;
311             }
312 0           return 0;
313             }
314             elsif($operator eq ">") {
315 0 0         if($value > $num) {
316 0           return 1;
317             }
318 0           return 0;
319             }
320             elsif($operator eq ">=") {
321 0 0         if($value >= $num) {
322 0           return 1;
323             }
324 0           return 0;
325             }
326             elsif($operator eq "<") {
327 0 0         if($value < $num) {
328 0           return 1;
329             }
330 0           return 0;
331             }
332             elsif($operator eq "<=") {
333 0 0         if($value <= $num) {
334 0           return 1;
335             }
336 0           return 0;
337             }
338 0           return 0;
339             }
340              
341             sub mapAS { #Mapping of the Answer Sets in an array of hashes
342              
343 0     0 1   my $countAS = 0;
344              
345 0           my @answerSets = @{$_[0]};
  0            
346              
347 0           my @second;
348 0 0         if($_[1]) {
349 0           @second = @{$_[1]};
  0            
350             }
351              
352 0           my @third;
353 0 0         if($_[2]) {
354 0           @third = @{$_[2]};
  0            
355             }
356              
357 0           my @selectedAS;
358            
359             my @predList;
360              
361 0           my @pred;
362              
363 0 0         if(@second) {
364 0 0         if($second[0] =~ /\d+/) {
365              
366 0           @selectedAS = @second;
367 0 0         if(@third) {
368 0           @predList = @third;
369             }
370              
371             }
372              
373             else {
374 0           @predList = @second;
375 0 0         if(@third) {
376 0           @selectedAS = @third;
377             }
378             }
379             }
380              
381              
382 0           foreach my $elem (@answerSets) {
383              
384              
385 0 0         if($elem =~ /(\w+).*\n/){
    0          
386 0 0         if(@predList) {
387 0 0         if(_existsPred($1,\@predList)) {
388 0           push @{$pred[$countAS]{$1}}, $elem;
  0            
389             }
390             }
391             else {
392 0           push @{$pred[$countAS]{$1}}, $elem;
  0            
393             }
394 0           $countAS = $countAS + 1;
395            
396             }
397              
398             elsif($elem =~ /(\w+).*/) {
399 0 0         if(@predList) {
400 0 0         if(_existsPred($1,\@predList)) {
401 0           push @{$pred[$countAS]{$1}}, $elem;
  0            
402             }
403             }
404             else {
405 0           push @{$pred[$countAS]{$1}}, $elem;
  0            
406             }
407             }
408            
409             }
410              
411 0 0         if(@selectedAS) {
412            
413 0           my $size = @selectedAS;
414              
415 0           my @selectedPred;
416              
417              
418 0           for(my $i = 0; $i < $size; $i++) {
419 0           my $as = $selectedAS[$i];
420 0           push @selectedPred, $pred[$as];
421             }
422              
423 0           return @selectedPred;
424             }
425 0           return @pred;
426              
427             }
428              
429             sub _existsPred { #Verifies the existence of a predicate (private use only)
430              
431 0     0     my $pred = $_[0];
432 0           my @predList = @{$_[1]};
  0            
433              
434 0           my $size = @predList;
435              
436 0           for(my $i = 0; $i < $size; $i++) {
437 0 0         if($pred eq $predList[$i]) {
438 0           return 1;
439             }
440             }
441 0           return 0;
442            
443             }
444              
445             sub getPred { #Returns the predicates from the array of hashes
446              
447 0     0 1   my @pr = @{$_[0]};
  0            
448 0           return @{$pr[$_[1]]{$_[2]}};
  0            
449             }
450              
451             sub getProjection { #Returns the values selected by the user
452              
453 0     0 1   my @pr = @{$_[0]};
  0            
454 0           my @projection;
455              
456 0           my @res = @{$pr[$_[1]]{$_[2]}};
  0            
457            
458 0           my $size = @res;
459 0           my $fieldsStr;
460              
461 0           for(my $i = 0; $i < $size; $i++) {
462 0           my $pred = @{$pr[$_[1]]{$_[2]}}[$i];
  0            
463 0 0         if($pred =~ /(\w+)\((.+)\)/) {
464 0           $fieldsStr = $2;
465             }
466 0           my @fields = split(',',$fieldsStr);
467 0           push @projection , $fields[$_[3]-1];
468            
469             }
470              
471 0           return @projection;
472             }
473              
474             sub createNewFile {
475              
476 0     0 1   my $file = $_[0];
477 0           my $code = $_[1];
478              
479 0           open FILE, ">", $file;
480 0           print FILE "$code\n";
481 0           close FILE;
482              
483             }
484              
485             sub addFacts {
486              
487 0     0 1   my $name = $_[0];
488 0           my @facts = @{$_[1]};
  0            
489 0           my $append = $_[2];
490 0           my $filename = $_[3];
491            
492 0           open FILE, $append, $filename;
493              
494 0           foreach my $f (@facts) {
495 0           print FILE "$name($f).\n";
496             }
497 0           close FILE;
498             }
499              
500              
501             1;
502             __END__