initial import
This commit is contained in:
commit
efad832771
78
modules/aiml/AIML.pl
Executable file
78
modules/aiml/AIML.pl
Executable file
@ -0,0 +1,78 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use XML::Simple;
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
|
die("Usage: $0 aiml.xml\n") unless($ARGV[0]);
|
||||||
|
open(XML,"<$ARGV[0]") or die("open($ARGV[0]): $!\n");
|
||||||
|
my $aiml = '';
|
||||||
|
while(<XML>) {
|
||||||
|
$aiml .= $_;
|
||||||
|
}
|
||||||
|
close(XML);
|
||||||
|
|
||||||
|
my $parser = XML::Simple->new();
|
||||||
|
my $xml = $parser->XMLin($aiml);
|
||||||
|
|
||||||
|
print "xml: " . Dumper($xml) . "\n";
|
||||||
|
|
||||||
|
|
||||||
|
our $knowledge = {};
|
||||||
|
foreach my $c (@{$xml->{category}}) {
|
||||||
|
print "pattern: $c->{pattern}\n";
|
||||||
|
&addKnowledge($knowledge,$c->{pattern},$c->{template});
|
||||||
|
}
|
||||||
|
|
||||||
|
print "Knowledge: " . Dumper($knowledge) . "\n";
|
||||||
|
|
||||||
|
print "> ";
|
||||||
|
while(my $input = <STDIN>) {
|
||||||
|
chomp($input);
|
||||||
|
print &findAnswer($knowledge,$input) . "\n";
|
||||||
|
print "> ";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub findAnswer {
|
||||||
|
my ($struct,$input) = @_;
|
||||||
|
my ($key,$rest) = split(/\s+/,$input,2);
|
||||||
|
$key = '*' unless($struct->{uc($key)});
|
||||||
|
if($rest) {
|
||||||
|
if($struct->{uc($key)}) {
|
||||||
|
&findAnswer($struct->{uc($key)},$rest);
|
||||||
|
} elsif($struct->{template}) {
|
||||||
|
return(&parseAnswer($struct));
|
||||||
|
} elsif($struct->{'*'}) {
|
||||||
|
&findAnswer($struct->{'*'},$rest);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
return(&parseAnswer($struct->{uc($key)}));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub parseAnswer {
|
||||||
|
my ($struct) = @_;
|
||||||
|
if(ref($struct->{template}) eq '') {
|
||||||
|
return($struct->{template});
|
||||||
|
} elsif(ref($struct->{template}) eq 'HASH') {
|
||||||
|
if($struct->{template}->{random}) {
|
||||||
|
my @r = @{$struct->{template}->{random}->{li}};
|
||||||
|
srand($$^time^$struct);
|
||||||
|
return($r[rand(int($#r) + 1)]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return('I do not know what that means.');
|
||||||
|
}
|
||||||
|
|
||||||
|
sub addKnowledge {
|
||||||
|
my ($ref,$pattern,$template) = @_;
|
||||||
|
my ($key,$rest) = split(/\s+/,$pattern,2);
|
||||||
|
if($rest) {
|
||||||
|
&addKnowledge($ref->{uc($key)},$rest,$template);
|
||||||
|
} else {
|
||||||
|
$ref->{uc($key)}->{template} = $template;
|
||||||
|
}
|
||||||
|
return(1);
|
||||||
|
}
|
17
modules/aiml/knowledge/main.aiml
Normal file
17
modules/aiml/knowledge/main.aiml
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8" ?>
|
||||||
|
<aiml version="1.0">
|
||||||
|
<category>
|
||||||
|
<pattern>HELLO</pattern>
|
||||||
|
<template>Hi there!</template>
|
||||||
|
</category>
|
||||||
|
<category>
|
||||||
|
<pattern>*</pattern>
|
||||||
|
<template>
|
||||||
|
<random>
|
||||||
|
<li>What is your name?</li>
|
||||||
|
<li>What is your favorite movie?</li>
|
||||||
|
<li>Will you buy me a drink?</li>
|
||||||
|
</random>
|
||||||
|
</template>
|
||||||
|
</category>
|
||||||
|
</aiml>
|
20
modules/aiml/parser-design.txt
Normal file
20
modules/aiml/parser-design.txt
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
Design:
|
||||||
|
my @input = split(/ /,$ARGV[0]);
|
||||||
|
|
||||||
|
|
||||||
|
Expand Map:
|
||||||
|
{
|
||||||
|
don't => do not
|
||||||
|
}
|
||||||
|
...
|
||||||
|
|
||||||
|
Pattern Map
|
||||||
|
{
|
||||||
|
Do => You => -template => 'Yes I do',
|
||||||
|
Why => -that => { 'Do you' => 'Because I would like to know',
|
||||||
|
'Go to sleep' => 'You seem tired'
|
||||||
|
},
|
||||||
|
Hello => -template => ['How are you', 'What is your name', 'Where are you from?' ],
|
||||||
|
}
|
||||||
|
|
||||||
|
|
29
modules/aiml/tasks
Normal file
29
modules/aiml/tasks
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
/calendar
|
||||||
|
_ TODO _
|
||||||
|
_ APPOINTMENTS _
|
||||||
|
_ TASKS _
|
||||||
|
|
||||||
|
/status
|
||||||
|
BRIEF STATUS
|
||||||
|
STATUS OVERVIEW
|
||||||
|
FULL STATUS
|
||||||
|
CURRENT STATE
|
||||||
|
|
||||||
|
/music
|
||||||
|
PLAY
|
||||||
|
PAUSE
|
||||||
|
LOAD _
|
||||||
|
NEXT
|
||||||
|
BACK
|
||||||
|
|
||||||
|
/cooking
|
||||||
|
|
||||||
|
|
||||||
|
/medicine
|
||||||
|
|
||||||
|
/mail
|
||||||
|
|
||||||
|
/homeautomation
|
||||||
|
LIGHTS _ ON
|
||||||
|
LIGHTS _ OFF
|
||||||
|
|
20
modules/aiml/test.pl
Executable file
20
modules/aiml/test.pl
Executable file
@ -0,0 +1,20 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
|
my $ref = {
|
||||||
|
A => 1
|
||||||
|
};
|
||||||
|
|
||||||
|
print "pre: " . Dumper($ref) . "\n";
|
||||||
|
|
||||||
|
&add($ref,'B','2');
|
||||||
|
|
||||||
|
sub add {
|
||||||
|
my ($struct,$key,$value) = @_;
|
||||||
|
$struct->{$key} = $value;
|
||||||
|
}
|
||||||
|
|
||||||
|
print "post: " . Dumper($ref) . "\n";
|
Loading…
x
Reference in New Issue
Block a user