From ed078524c02ebe899a709d3d7e0ea5c50c9d2167 Mon Sep 17 00:00:00 2001
From: Petr Baudis <pasky@ucw.cz>
Date: Thu, 23 Feb 2012 16:55:05 +0100
Subject: [PATCH] tools/pattern_getdrops.pl: Tool for learning patterns for
 unexpected moves

---
 HACKING                   | 10 ++++++++++
 tools/pattern_getdrops.pl | 40 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 50 insertions(+)
 create mode 100755 tools/pattern_getdrops.pl

diff --git a/HACKING b/HACKING
index 809e64c..1cfa226 100644
--- a/HACKING
+++ b/HACKING
@@ -221,6 +221,16 @@ matcher easy:
   pattern_bayes_gen (perhaps remove the counts >= 2 test) and then merge
   the generated tables.
 
+* tools/pattern_getdrops.pl: Processes game logs to determine moves that
+  lead to large drop in Pachi's evaluation and extracts patterns that
+  represent these moves. This might allow Pachi to "learn from its past
+  mistakes" and recognize these moves in the future. A full pipeline
+  for this might be:
+
+	cat kgsGtp.log | tools/kgslog2gtp.pl |
+		tools/pattern_getdrops.pl | tools/pattern_bayes_gen.sh - |
+		tools/pattern_bayes_merge.sh patterns.prob - >patterns.prob2
+
 
 Plugin API
 ==========
diff --git a/tools/pattern_getdrops.pl b/tools/pattern_getdrops.pl
new file mode 100755
index 0000000..99bff56
--- /dev/null
+++ b/tools/pattern_getdrops.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -n
+#
+# pattern_getdrops - Find significant value drops in kgslog GTP stream
+# and convert them to lead-in game records for pattern learning
+#
+# Run as pipeline:
+# 	tools/kgslog2gtp.pl | tools/pattern_getdrops.pl | tools/pattern_bayes_gen.sh -
+
+BEGIN {
+	use vars qw(@game $lastval $valthres $valfrac);
+	$valthres = 0.8;
+	$valfrac = 0.95;
+}
+
+chomp;
+@_ = split(/\s+/);
+
+if ($_[0] eq 'pachi-mygame') {
+	@game = @_[1..4];
+	print STDERR "*** new game [@game]\n";
+	$lastval = 0;
+	@commands = ();
+
+} elsif ($_[0] eq 'pachi-mymove') {
+	if ($lastval > 0 and $lastval < $valthres and $_[2] / $lastval < $valfrac) {
+		print STDERR "large value drop $lastval -> $_[2] [@game :: @_]\n";
+		print "$_\n" for @commands;
+		print "play $game[0] $_[1] 1\n";
+	}
+	$lastval = $_[2];
+	my $cmd = "play $game[0] $_[1] 0 $_[2]";
+	push @commands, $cmd;
+
+} elsif ($_[0] eq 'play') {
+	push @_, 0;
+	push @commands, "@_";
+
+} else {
+	push @commands, "@_";
+}
-- 
2.11.4.GIT