Japanese exam tool using WaKan dictionary format.

diff --git a/src/jaxam b/src/jaxam
new file mode 100755 (executable)
index 0000000..596a688
--- /dev/null
+++ b/src/jaxam
@@ -0,0 +1,216 @@
+#! /usr/bin/perl
+#
+# $Id$
+
+
+use strict;
+use warnings;
+require Term::ReadKey;
+require Tree::Binary::Search;
+use Getopt::Long;
+require Time::Piece::ISO;
+require POSIX;
+
+
+our $opt_debug=1;
+my $opt_dict=$ENV{"HOME"}."/priv/japan-lang/jfe_1-9.csv";
+my $opt_log=$opt_dict.".log";
+
+$Getopt::Long::ignorecase=0;
+$Getopt::Long::bundling=1;
+die if !GetOptions(
+               "d|debug+"=>\$opt_debug,
+               "c|dict=s"=>\$opt_dict,
+               "l|log=s" =>\$opt_log,
+               );
+
+my $T;
+
+sub schedule($)
+{
+       my($r)=@_;
+
+       my $sum=0;
+       for my $result (@{$r->{"result"}}) {
+               my $age=time()-$result->{"time"};
+               $age=0 if $age<0;
+               # $age:   0..  big importance
+               # $age: big..small importance
+               # $ok: 0..mistake
+               # $ok: 1..correct
+               # $sum:   big..far
+               # $sum: small..soon
+               # 1/log(2+$age): big..  big importance
+               # 1/log(2+$age):   0..small importance
+               $sum+=1/log(2+$age)*($result->{"ok"}?+1:-1);
+               }
+       my $arr=[];
+       if ($T->exists($sum)) {
+               $arr=$T->select($sum)->{"arr"};
+               $T->delete($sum);
+       }
+       splice @$arr,int(rand(@$arr+1)),0,$r;
+       $T->insert($sum=>{"key"=>$sum,"arr"=>$arr});
+       print STDERR "; schedule=$sum" if $opt_debug;
+}
+
+sub best()
+{
+       return if $T->isEmpty();
+       my $min=$T->min()->{"key"};
+       my $arr=$T->select($min)->{"arr"};
+       $T->delete($min);
+       my $r=shift @$arr;
+       $T->insert($min=>{"key"=>$min,"arr"=>$arr}) if @$arr;
+       print STDERR "min=$min\n" if $opt_debug;
+       return $r;
+}
+
+sub identify($)
+{
+       my($r)=@_;
+
+       return join " ",map(($r->{$_}||"-"),qw(
+                       written
+                       phonetic
+                       ));
+}
+
+sub result($$)
+{
+       my($r,$ok)=@_;
+
+       local *LOG_APPEND;
+       open LOG_APPEND,">>".$opt_log or die "append \"$opt_log\": $!";
+       print LOG_APPEND Time::Piece::ISO::localtime().POSIX::strftime("%z",localtime())." ok=$ok: ".identify($r)."\n";
+       close LOG_APPEND or die "close \"$opt_log\": $!";
+
+       push @{$r->{"result"}},{
+               "time"=>time(),
+               "ok"=>$ok,
+               };
+       schedule $r;
+}
+
+my @R;
+my %keyword;
+$T=Tree::Binary::Search->new();
+$T->useNumericComparison();
+local *DICT;
+open DICT,$opt_dict or die "open \"$opt_dict\": $!";
+while (<DICT>) {
+       chomp;
+       my $r;
+       my $rest;
+       (
+               $r->{"written"},
+               $r->{"phonetic"},
+               $r->{"meaning"},
+               $r->{"category"},
+               $r->{"learned"},
+               $rest,
+               )=split /\t/;
+       next if $r->{"written"} eq "";
+       die "Excessive argument: $rest" if defined $rest;
+       while ($r->{"meaning"}=~s/\s*<([-\w]+)>\s*//) {
+               my $keyword=$1;
+               $r->{"meaning_keyword"}{$keyword}=1;
+               $keyword{$keyword}=1;
+               }
+       $r->{"meaning"}!~/[<>]/ or warn "Meaning constains invalid characters: ".$r->{"meaning"};
+       push @R,$r;
+}
+close DICT or die "close \"$opt_dict\": $!";
+
+my %identify=map((identify($_)=>$_),@R);
+
+local *LOG_READ;
+if (!open LOG_READ,$opt_log) {
+       warn "open \"$opt_log\": $!";
+} else {
+       while (<LOG_READ>) {
+               chomp;
+               # 2002-04-25T21:17:52+0900 ok=1: identify($r)
+               my($year, $month, $day,   $hour,  $minute,$second,$zonepm,$zonehour,$zoneminute,$ok,$identify)=
+               /^(\d{4})-(\d{1,2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})([+-])(\d{2})(\d{2}) ok=(\d+): (.+)$/
+                               or do { warn "Unrecognized line: $_\n"; next; };
+               $year-=1900;
+               $month--;
+               my $localtime=POSIX::mktime($second,$minute,$hour,$day,$month,$year);
+               $localtime or do { warn "Unparsable time at line: $_\n"; next; };
+               my $gmtime=$localtime-($zonepm."1")*($zonehour*60+$zoneminute);
+               my $r=$identify{$identify}
+                               or do { warn "Word not found from line: $_\n"; next; };
+               push @{$r->{"result"}},{
+                       "time"=>$gmtime,
+                       "ok"=>$ok,
+                       };
+       }
+       close LOG_READ or die "close \"$opt_log\": $!";
+}
+
+for my $r (@R) {
+       local $opt_debug=0 if $opt_debug<2;
+       print STDERR $r->{"phonetic"}."\t".$r->{"meaning"} if $opt_debug;
+       schedule $r;
+       print STDERR "\n" if $opt_debug;
+}
+
+my %exam=(
+       "phonetic"=>"meaning",
+       "meaning"=>"phonetic",
+       );
+my @exam=keys(%exam);
+my $r_last;
+my $exam_from_last;
+for (;;) {
+       my $r=best();
+       # Do not change $exam_from if $r remained the same:
+       my $exam_from=$exam_from_last;
+       if (!$r_last || $r ne $r_last) {
+               $exam_from=$exam[int rand @exam];
+               }
+       my $exam_to  =$exam{$exam_from};
+       print $r->{$exam_from}.": ";
+       my $got=<STDIN>;
+       chomp $got;
+       my $want=$r->{$exam_to};
+       print "-------> $want\n";
+       (my $got_chk =lc $got )=~s/\s//g;
+       (my $want_chk=lc $want)=~s/\s//g;
+       $got_chk=~s/\bto\b//g;
+       $want_chk=~s/\bto\b//g;
+       $want_chk=~s/[(][^)]*[)]//g;
+       warn "Parenthesis ('(',')') not supported in the user input: $got\n" if $got=~/[()]/;
+       warn "Comma (',') not well supported in the user input: $got\n" if $got=~/,/;
+       my $ok;
+       $ok=1 if $got_chk eq $want_chk; # incl. commas
+       for (split /,/,$want_chk) {
+               $ok=1 if $got_chk eq $_;
+       }
+       if (!$ok) {
+               if ($exam_to eq "meaning" && $got=~/\S/ && $want=~/\Q$got\E/) {
+                       my $key;
+                       do {
+                               print STDERR "Is your answer correct? [y/n] ";
+                               sub restore
+                               {
+                                       Term::ReadKey::ReadMode(0);
+                               }
+                               local $SIG{"__DIE__"}=\&restore;
+                               Term::ReadKey::ReadMode(4);
+                               $key=Term::ReadKey::ReadKey(0);
+                               print STDERR "\n";      # no echo
+                               restore();
+                               $ok=1 if $key eq "y";
+                               $ok=0 if $key eq "n";
+                       } while (!defined $ok);
+               }
+       }
+       $ok||=0;
+       print STDERR "result: ".($ok ? "ok" : "WRONG");
+       result($r,$ok);
+       print "\n";
+       $r_last=$r;
+       $exam_from_last=$exam_from;
+}