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