Term-Sample
view release on metacpan or search on metacpan
print "\n" if($newline);
return $sample;
}
sub print_data {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift; # || $_;
my %args = @_;
my $type = $args{type};
if(ref($sample) ne "ARRAY" && ($type eq "basic" || $type eq "avg" || $type eq "average")) {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
elsif(ref($sample) ne "HASH" && ($type eq "analysis" || $type eq "overview" || $type eq "details")) {
print "Error: Invalid analysis data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(ref($sample) eq "ARRAY") {
if(!$type || $type eq 'basic') {
for my $key (0..$#{$sample}) {
print "idx: $key ",(($key<10)?' ':' '),"[ key => $sample->[$key]->{key}, delay => $sample->[$key]->{delay}, inter => $sample->[$key]->{inter} ]\n";
}
}
elsif($type eq 'average' || $type eq 'avg') {
my $delay = 0;
print "\nKey Hold Times: \n";
for my $x (0..$#{$sample->{sorted_delay}}) {
print "\tKeys : $sample->{sorted_inter}->[$x]->{codes}->[0]->{char}, $sample->{sorted_inter}->[$x]->{codes}->[1]->{char}, $sample->{sorted_inter}->[$x]->{codes}->[2]->{char} \n";
print "\tCodes : $sample->{sorted_inter}->[$x]->{codes}->[0]->{key}, $sample->{sorted_inter}->[$x]->{codes}->[1]->{key}, $sample->{sorted_inter}->[$x]->{codes}->[2]->{key} \n";
print "\tSum Delay: $sample->{sorted_inter}->[$x]->{delay} Sum Inter: $sample->{sorted_inter}->[$x]->{inter}\n";
print "\n";
}
}
} else {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
}
sub to_string {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
if(ref($sample) ne "ARRAY") {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $str;
$str.=$sample->[$_]->{key} for (0..$#{$sample});
return $str;
}
sub diff {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample1 = shift;
my $sample2 = shift;
my %args = @_;
my $v = $args{verbose} || 0;
if(ref($sample1) ne "HASH" || ref($sample2) ne "HASH") {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}: Both arguments must be HASH refrences from analyze().\n";
return undef;
}
my $diff = 0;
my $count = 0;
my $sample;
if($v) {
print "\nAnalysis Diff\n";
print "\nTotal Key Presses : ",round(p($sample1->{size},$sample2->{size}),2),"%\n";
$out = [];
my $x = $#vectors+1;
for my $sample (@vectors) {
for my $key (0..$#{$sample}) {
$out->[$key]->{key} = $vectors[0]->[$key]->{key};
$out->[$key]->{delay} += ($sample->[$key]->{delay}/$x);
$out->[$key]->{inter} += ($sample->[$key]->{inter}/$x);
}
}
} else {
print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $out;
}
sub save {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
my $file = shift;
if(ref($sample) ne "ARRAY" && ref($sample) ne "HASH") {
print "Error: Invalid save data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
open(F, ">$file");
if(ref($sample) eq "HASH") {
print F "type=hash\n";
print F "size=$sample->{size}\n";
print F "avg_codes=$sample->{avg_codes}\n";
print F "avg_delay=$sample->{avg_delay}\n";
}
close(F);
return $sample;
}
sub load {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $file = shift;
if(!(-f $file)) {
print "Error: File $file doesn't exist at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
open(F, $file);
my @lines = <F>;
close(F);
my %db;
for my $line (@lines) {
chomp($line);
$sample->{sorted_inter}->[$x]->{inter}=$db{"sorted_inter:$x:inter"};
}
}
elsif($db{type} eq "array") {
$sample = [];
for my $key (0..$db{index_size}) {
($sample->[$key]->{key},$sample->[$key]->{delay},$sample->[$key]->{inter}) =
split /\:\:/, $db{"index$key"};
}
} else {
print "Error: Invalid file type in file $file at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $sample;
}
sub analyze {
my $self = shift if(substr($_[0],0,6) eq 'Term::');
my $sample = shift;
if(ref($sample) ne "ARRAY") {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $delay = 0;
my $inter = 0;
my $codes = 0;
my $size = $#{$sample};
for my $key (0..$size-1) {
$codes+=ascii($sample->[$key]->{key});
$delay+=$sample->[$key]->{delay};
bless $self, $type;
}
sub store {
my $self = shift;
my %args = @_;
my ($key,$sample);
while(($key,$sample) = each %args) {
if(ref($sample) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Invalid sample data type for key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(!exists $self->{samples}->{$key}) {
$self->{samples}->{$key} = $sample;
} else {
$self->{samples}->{$key} = $self->{term}->average($self->{samples}->{$key},$sample);
}
}
return $self;
}
sub remove {
my $self = shift;
my $key = shift;
if(!exists $self->{samples}->{$key} && !$self->{silent}) {
print "Error: Key `$key' does not exist in set at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
delete $self->{samples}->{$key};
return $self;
}
sub get {
my $self = shift;
my $key = shift;
if(!exists $self->{samples}->{$key} && !$self->{silent}) {
print "Error: Key `$key' does not exist in set at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $self->{samples}->{$key};
}
sub match {
my $self = shift;
my $match = shift;
my $term = $self->{term};
my $v = shift || 0;
if(ref($match) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $test = ($self->{type} eq 'sample')?$term->analyze($match):$match;
my @diffs = ();
my ($key,$sample);
while(($key,$sample) = each %{$self->{samples}}) {
if(ref($sample) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
print "Error: Corrupted sample data type for key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
my $analysis = ($self->{type} eq 'sample')?$term->analyze($sample):$sample;
my $i=++$#diffs;
$diffs[$i] = { diff => $term->diff($analysis, $test), key => $key };
print "match(): $diffs[$i]->{diff} => $diffs[$i]->{key} \n" if($v);
}
my $top = 0;
for(0..$#diffs) {
sub save {
my $self = shift;
my $file = shift;
open(F, ">$file");
my ($key,$sample);
while(($key,$sample) = each %{$self->{samples}}) {
print F "_____KEY_____=$key\n";
if(ref($sample) ne "ARRAY" && ref($sample) ne "HASH" && !$self->{silent}) {
print "Error: Corrupted data type key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
if(ref($sample) eq "HASH") {
print F "type=hash\n";
print F "size=$sample->{size}\n";
print F "avg_codes=$sample->{avg_codes}\n";
print F "avg_delay=$sample->{avg_delay}\n";
print F "avg_inter=$sample->{avg_inter}\n";
}
close(F);
return $self;
}
sub load {
my $self = shift;
my $file = shift;
if(!(-f $file) && !$self->{silent}) {
print "Error: File $file doesn't exist at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
return $self if(!(-f $file) && $self->{silent});
open(F, $file);
my @lines = <F>;
close(F);
my $data = {};
$self->{samples}->{$key}->{sorted_inter}->[$x]->{inter}=$db{"sorted_inter:$x:inter"};
}
}
elsif($db{type} eq "array") {
$self->{samples}->{$key} = [];
for my $x (0..$db{index_size}) {
($self->{samples}->{$key}->[$x]->{key},$self->{samples}->{$key}->[$x]->{delay},$self->{samples}->{$key}->[$x]->{inter}) =
split /\:\:/, $db{"index$x"};
}
} else {
print "Error: Invalid file type in file $file at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
return undef;
}
}
return $self;
}
1;
__END__
( run in 1.115 second using v1.01-cache-2.11-cpan-a3c8064c92c )