toss-devel-svn Mailing List for Toss (Page 5)
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
toss-devel-svn — Toss development: svn commits
You can subscribe to this list here.
| 2010 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(25) |
Dec
(62) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2011 |
Jan
(26) |
Feb
(38) |
Mar
(67) |
Apr
(22) |
May
(41) |
Jun
(30) |
Jul
(24) |
Aug
(32) |
Sep
(29) |
Oct
(34) |
Nov
(18) |
Dec
(2) |
| 2012 |
Jan
(19) |
Feb
(25) |
Mar
(16) |
Apr
(2) |
May
(18) |
Jun
(21) |
Jul
(11) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <luk...@us...> - 2012-01-22 02:39:05
|
Revision: 1649
http://toss.svn.sourceforge.net/toss/?rev=1649&view=rev
Author: lukaszkaiser
Date: 2012-01-22 02:38:57 +0000 (Sun, 22 Jan 2012)
Log Message:
-----------
Videos for Breakthrough and Pawn-Whopping.
Modified Paths:
--------------
trunk/Toss/Learn/Makefile
trunk/Toss/Learn/examples/Breakthrough001_01.nwn
trunk/Toss/Learn/examples/Breakthrough001_01.wn0
trunk/Toss/Learn/examples/Breakthrough001_01.wn1
trunk/Toss/Learn/examples/Breakthrough001_02.nwn
trunk/Toss/Learn/examples/Breakthrough001_03.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_01.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn0
trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn1
trunk/Toss/Learn/examples/Pawn-Whopping001_01.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_02.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_03.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_03.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_04.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_04.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_05.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_06.wrg
trunk/Toss/Learn/reco.cpp
trunk/Toss/Learn/shapes.c
trunk/Toss/Learn/shapes.h
Added Paths:
-----------
trunk/Toss/Learn/videos/Breakthrough001_01.nwn.3gp
trunk/Toss/Learn/videos/Breakthrough001_01.wn0.3gp
trunk/Toss/Learn/videos/Breakthrough001_01.wn1.3gp
trunk/Toss/Learn/videos/Breakthrough001_02.nwn.3gp
trunk/Toss/Learn/videos/Breakthrough001_03.nwn.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_01.nwn.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_01.wn0.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_01.wn1.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_01.wrg.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_02.nwn.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_02.wrg.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_03.nwn.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_03.wrg.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_04.nwn.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_04.wrg.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_05.wrg.3gp
trunk/Toss/Learn/videos/Pawn-Whopping001_06.wrg.3gp
Removed Paths:
-------------
trunk/Toss/Learn/examples/Pawn-Whopping001_05.nwn
trunk/Toss/Learn/videos/Breakthrough001_01_nwn.3gp
trunk/Toss/Learn/videos/tic_tac_toe_0.3gp
Modified: trunk/Toss/Learn/Makefile
===================================================================
--- trunk/Toss/Learn/Makefile 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/Makefile 2012-01-22 02:38:57 UTC (rev 1649)
@@ -24,6 +24,11 @@
make -C .. Learn/LearnGameTest.native
time ../LearnGameTest.native -f $(basename $@) > $(basename $@).toss
+%.reco:
+ ./reco videos/$(basename $@).3gp W B > res.play.log
+ diff res.play.log examples/$(basename $@)
+ rm res.play.log
+
learntests:
make Tic-Tac-Toe001.learn
make Tic-Tac-Toe002.learn
@@ -32,7 +37,26 @@
make Connect4001.learn
#make Pawn-Whopping001.learn
+recotests: reco
+ make Breakthrough001_01.nwn.reco
+ make Breakthrough001_01.wn0.reco
+ make Breakthrough001_01.wn1.reco
+ make Breakthrough001_02.nwn.reco
+ make Breakthrough001_03.nwn.reco
+ make Pawn-Whopping001_01.nwn.reco
+ make Pawn-Whopping001_01.wn0.reco
+ make Pawn-Whopping001_01.wn1.reco
+ make Pawn-Whopping001_01.wrg.reco
+ make Pawn-Whopping001_02.nwn.reco
+ make Pawn-Whopping001_02.wrg.reco
+ make Pawn-Whopping001_03.nwn.reco
+ make Pawn-Whopping001_03.wrg.reco
+ make Pawn-Whopping001_04.nwn.reco
+ make Pawn-Whopping001_04.wrg.reco
+ make Pawn-Whopping001_05.wrg.reco
+ make Pawn-Whopping001_06.wrg.reco
+
.PHONY: clean
clean:
Modified: trunk/Toss/Learn/examples/Breakthrough001_01.nwn
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_01.nwn 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Breakthrough001_01.nwn 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
B B..B B..B B..B B..
@@ -219,7 +219,7 @@
... ... ... ...
B B.. B..B B..B B..
... ... ... ...
-B..B B..B ..B B..B
+B..B B..B ...B B..B
... ... ... ...
... ... ... ...
... ... ... ...
Modified: trunk/Toss/Learn/examples/Breakthrough001_01.wn0
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_01.wn0 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Breakthrough001_01.wn0 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
B B.. W.. B..B B..
@@ -15,4 +15,5 @@
... ... ... ...
W W..W ... W..W W..
... ... ... ...
-W..W ...W W..W W..W
+W.. W..W W..W W..W
+
Modified: trunk/Toss/Learn/examples/Breakthrough001_01.wn1
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_01.wn1 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Breakthrough001_01.wn1 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
B B..B B..B B..B B..
@@ -9,10 +9,11 @@
... ... ... ...
... ... ... ...
... ... ... ...
-W ... W..W ... ...
+W ...W W.. ... ...
... ... ... ...
W.. ... ... W..
... ... ... ...
... ... ... W..
... ... ... ...
... ... B.. ...W
+
Modified: trunk/Toss/Learn/examples/Breakthrough001_02.nwn
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_02.nwn 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Breakthrough001_02.nwn 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
B B.. ... B..B B..
@@ -15,4 +15,5 @@
... ... ... ...
W W..W ... W..W W..
... ... ... ...
-W..W ...W W..W W..W
+W.. W..W W..W W..W
+
Modified: trunk/Toss/Learn/examples/Breakthrough001_03.nwn
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_03.nwn 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Breakthrough001_03.nwn 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
B B..B B..B B..B B..
@@ -9,10 +9,11 @@
... ... ... ...
... ... ... ...
... ... ... ...
-W ... W..W ... ...
+W ...W W.. ... ...
... ... ... ...
W.. ... ... W..
... ... ... ...
... ... ... W..
... ... ... ...
... ... ... ...W
+
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_01.nwn
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_01.nwn 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_01.nwn 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn0
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn0 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn0 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... W.. ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn1
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn1 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn1 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
@@ -15,5 +15,5 @@
... ... ... ...
... ... ...W ...
... ... ... ...
-... ...B ... ...
+... B.. ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_01.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_01.wrg 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_01.wrg 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
@@ -17,6 +17,7 @@
... ... ... ...
... ... ... ...
+
... ... ... ...
... ... ... ...
... ... ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_02.nwn
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_02.nwn 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_02.nwn 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
@@ -17,6 +17,7 @@
... ... ... ...
... ... ... ...
+
... ... ... ...
... ... ... ...
... ... ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_03.nwn
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_03.nwn 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_03.nwn 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,9 +1,9 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
... ... ... ...
-B.. ... ... ...
+... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
@@ -13,7 +13,25 @@
... ... ... ...
... ... ... ...
... ... ... ...
- ... ... ...W ...
+ ... W.. ... ...
... ... ... ...
... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_03.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_03.wrg 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_03.wrg 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
@@ -17,6 +17,7 @@
... ... ... ...
... ... ... ...
+
... ... ... ...
... ... ... ...
... ... ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_04.nwn
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_04.nwn 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_04.nwn 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,9 +1,9 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
... ... ... ...
-... ... ... ...
+... ...B ... ...
... ... ... ...
... ... ... ...
... ... ... ...
@@ -13,24 +13,43 @@
... ... ... ...
... ... ... ...
... ... ... ...
- ... W.. ... ...
+ ... ... ... W..
... ... ... ...
... ... ... ...
+
... ... ... ...
... ... ... ...
... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
... ... ... ...
+... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
... ... ... ...
+... ... ... ...
+
+
... ... ... ...
- ... W.. ... ...
+ ... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_04.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_04.wrg 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_04.wrg 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
@@ -17,6 +17,7 @@
... ... ... ...
... ... ... ...
+
... ... ... ...
... ... ... ...
... ... ... ...
Deleted: trunk/Toss/Learn/examples/Pawn-Whopping001_05.nwn
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_05.nwn 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_05.nwn 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,53 +0,0 @@
-[ | B:1 {}; W:1 {} | ]
-
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ...B ... ...
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ... ... ...
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ... ... ...
- ... ... ... ...
- ... ... ... W..
-... ... ... ...
-... ... ... ...
-
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ...B ... ...
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ... ... ...
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ... ... ...W
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ... ... ...
-
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ... ... ...
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ...B ... ...
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ... ... ...W
- ... ... ... ...
- ... ... ... ...
-... ... ... ...
-... ... ... ...
-
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_05.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_05.wrg 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_05.wrg 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
@@ -17,6 +17,7 @@
... ... ... ...
... ... ... ...
+
... ... ... ...
... ... ... ...
... ... ... ...
@@ -28,7 +29,7 @@
... ... ... ...
... ... W.. ...
... ... ... ...
-... ... ... ..
+... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_06.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_06.wrg 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_06.wrg 2012-01-22 02:38:57 UTC (rev 1649)
@@ -1,4 +1,4 @@
-[ | B:1 {}; W:1 {} | ]
+[ | W:1 {}; B:1 {} | ]
... ... ... ...
... ... ... ...
@@ -17,6 +17,7 @@
... ... ... ...
... ... ... ...
+
... ... ... ...
... ... ... ...
... ... ... ...
Modified: trunk/Toss/Learn/reco.cpp
===================================================================
--- trunk/Toss/Learn/reco.cpp 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/reco.cpp 2012-01-22 02:38:57 UTC (rev 1649)
@@ -10,7 +10,9 @@
#define timeSTEP 15
+int debugLEVEL = 0;
+
void reset (char a[SIZEX][SIZEY]) {
for (int j = 0; j < SIZEY; j++) {
for (int i = 0; i < SIZEX; i++) {
@@ -60,11 +62,20 @@
char res[2000];
int rnbr = -2;
+ if (argc != 4) {
+ printf ("Usage: reco [filename] [letter for white] [letter for black]\n");
+ return (1);
+ }
+
+ // Print signature and set it in shapes module
+ printf ("[ | %c:1 {}; %c:1 {} | ]\n\n", argv[2][0], argv[3][0]);
+ setBlueChar (argv[2][0]);
+ setRedChar (argv[3][0]);
+
+ // Start recognition
cvNamedWindow ("Reco", CV_WINDOW_AUTOSIZE);
- CvCapture* capture = cvCreateFileCapture
- ("videos/chess1.3gp");
- // ("videos/tic_tac_toe_0.3gp");
- //cvCreateCameraCapture( 0 );
+ CvCapture* capture = cvCreateFileCapture (argv[1]);
+ // cvCreateCameraCapture( 0 );
IplImage *img, *col, *gray, *small;
int data_count = 0;
char data[SIZEX][SIZEY];
@@ -89,19 +100,18 @@
cvCvtColor (img, gray, CV_BGR2GRAY);
small = cvCreateImage (cvSize (SIZEX + 2*MARGINX, SIZEY + 2*MARGINY), 8, 1);
cvResize (gray, small, CV_INTER_LINEAR);
- cvCanny (small, small, 180, 200);
+ if ((time / timeSTEP) < 35) { // beginings are cleaner, compensate a bit
+ cvCanny (small, small, 195, 230);
+ } else {
+ cvCanny (small, small, 210, 230);
+ }
data_count = 0;
for (int i = 0; i < SIZEX; i++) {
for (int j = 0; j < SIZEY; j++) {
cur_data = (unsigned int)
small->imageData[(i+MARGINX) + small->widthStep * (j+MARGINY)];
- /* ok_around = i == 0 || j == 0 ? 1 :
- data[i][j] + data[i-1][j] + data[i+1][j] +
- data[i][j+1] + data[i-1][j-1] + data[i+1][j-1] +
- data[i][j-1] + data[i-1][j+1] + data[i+1][j+1];
- ok_around = ok_around == 0 ? 0 : 1; */
- data[i][j] = cur_data > 2 ? 1 : 0; //ok_around : 0;
+ data[i][j] = cur_data > 2 ? 1 : 0;
int r, g, b;
b = ((uchar*)(col->imageData + col->widthStep*(j+MARGINY)))[3*(i+MARGINX)];
g = ((uchar*)(col->imageData + col->widthStep*(j+MARGINY)))[3*(i+MARGINX)+1];
@@ -116,16 +126,13 @@
int i;
lines = cvHoughLines2( small, storage, CV_HOUGH_PROBABILISTIC,
1, CV_PI/180, 120, 50, 30 );
- //for( i = 0; i < lines->total; i++ ) {
- // CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i);
- // cvLine( small, line[0], line[1], CV_RGB(100,200,200), 3 );
- //}
+ if (debugLEVEL > 1) {
+ for( i = 0; i < lines->total; i++ ) {
+ CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i);
+ cvLine( small, line[0], line[1], CV_RGB(100,200,200), 3 );
+ }
+ }
- /* if (time % 5 == 0 && (data_count<500 || lines->total<5)) { //empty, reset
- reset (data);
- reset_color (color);
- time = 1;
- }*/
if (rnbr >= 0) {
shape p = (get_patterns())[rnbr];
for (int s = 0; s < p.size; s++) {
@@ -170,14 +177,15 @@
}
}
sprintf (fullsh_str + fullsh_str_pos, " END");
- printf ("step: %i\nlines: %i\ndata: %i\nreco:\n",
- time/timeSTEP, lines->total, data_count);
- if (time/timeSTEP > 1) { print_ppm (data, (char*) "log"); }
+ if (debugLEVEL > 1) {
+ printf ("step: %i\nlines: %i\ndata: %i\nreco:\n",
+ time/timeSTEP, lines->total, data_count);
+ }
+ if (time/timeSTEP>1 && debugLEVEL>1) { print_ppm (data, (char*) "log"); }
reset (data);
recognize_from_string (shape_str, fullsh_str, res,
&rnbr, time/timeSTEP-1, color);
reset_color (color);
- printf ("%i\n", rnbr);
for (int i = 0; i < 2000; i++) res[i] = 0;
for (int i = 0; i < SIZEX*SIZEY*24; i++) shape_str[i] = 0;
for (int i = 0; i < SIZEX*SIZEY*24; i++) fullsh_str[i] = 0;
@@ -188,6 +196,8 @@
}
cvReleaseCapture (&capture);
cvDestroyWindow ("Reco");
-
+
+ output_on_end ();
+ printf ("\n");
return (0);
}
Modified: trunk/Toss/Learn/shapes.c
===================================================================
--- trunk/Toss/Learn/shapes.c 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/shapes.c 2012-01-22 02:38:57 UTC (rev 1649)
@@ -11,6 +11,7 @@
#include "shapes.h"
+int shapesDebugLEVEL = 0;
static pthread_mutex_t shapes_stop_mutex;
static pthread_mutex_t shapes_working_mutex;
@@ -811,7 +812,7 @@
/* Keep old scale unchaged if within these bound, useful for video. */
int videoSTEP = 0;
point prev_dim = { 1., 1. };
-float prev_dim_change_bound = 1.5;
+float prev_dim_change_bound = 2;
/* Scale Margin since we do not detect outliers at present. */
float scale_margin = 0.88;
@@ -851,7 +852,7 @@
/* Keep old translation unchaged if within these bound, useful for video. */
point prev_move = { 0., 0. };
-float prev_move_change_bound = 25;
+float prev_move_change_bound = 50;
/* Find best fit (scale and translation) between shape and pattern. */
static interval best_fit (interval* shape, const int s_size, interval* pattern,
@@ -883,9 +884,13 @@
(prev_move.y - prev_move_change_bound < d_move.y)) {
d_move.x = prev_move.x;
d_move.y = prev_move.y;
- } else {
+ } else if (videoSTEP < 0) {
prev_move.x = d_move.x;
prev_move.y = d_move.y;
+ } else {
+ //printf ("\n\nmove change\n\n");
+ prev_move.x = (d_move.x + prev_move.x)/2;
+ prev_move.y = (d_move.y + prev_move.y)/2;
}
point d_scale = find_scale (pattern_mids.end, shape_mids.end);
@@ -1372,9 +1377,20 @@
#define gridSIZE 8
#define gridJUMP 1
#define gridMARGIN 0.5
+#define maxOUT 9
+
int gridSIZES[gridSIZE][gridSIZE];
interval * gridSHAPES[gridSIZE][gridSIZE];
+unsigned int gridCOLORS[gridSIZE][gridSIZE];
+char gridCHARS[gridSIZE][gridSIZE];
+char gridPrevCHARS[gridSIZE][gridSIZE];
+char gridSavedCHARS[gridSIZE][gridSIZE];
+int gridCharsREPEATED = 0;
+int prevOutlier = 0;
+int prevSaved = 0;
+int lastHandDetect = 0;
+
void print_grid (char* s, int n) {
int o;
o = sprintf (s, "SHAPES 1 PRECISION 0 RECO FACTOR 1.6 ");
@@ -1418,7 +1434,6 @@
}
} */
for (i = 0; i < size; i++) {
- //printf ("%f %f\n", shape[i].start.x, shape[i].start.y);
b += (int) (color[(int) shape[i].start.x][(int) shape[i].start.y] % 256);
g += (int) ((color[(int) shape[i].start.x][(int) shape[i].start.y] / 256) % 256);
r += (int) ((color[(int) shape[i].start.x][(int) shape[i].start.y] / (256*256)) % 256);
@@ -1431,8 +1446,64 @@
}
#define redblueDELTA 5
-#define minshapePTS 9
+#define minshapePTS 2
+#define minshapeHAND 3
+#define maxMoveCHANGE 2
+char blueChar = 'W';
+void setBlueChar (char c) { blueChar = c; }
+char redChar = 'B';
+void setRedChar (char c) { redChar = c; }
+
+/* The output character for a field with specified shape size and color. */
+static char describe_field (const int shape_size, const unsigned int col) {
+ if (shape_size > minshapePTS &&
+ (col % 256) > (col / (256*256)) + redblueDELTA) {
+ return (blueChar);
+ } else if (shape_size > minshapePTS) {
+ return (redChar);
+ } else {
+ return (' ');
+ }
+}
+
+int gridOutputCounter = 0;
+
+/* Print out grid. */
+static void output_grid (int sizes[gridSIZE][gridSIZE],
+ char chars[gridSIZE][gridSIZE]) {
+ int gi, gj;
+ gridOutputCounter++;
+ for (gj = 0; gj < gridSIZE; gj++) {
+ for (gi = 0; gi < gridSIZE; gi++) {
+ if (shapesDebugLEVEL > 1) {
+ if ((gi+gj) % 2 == 0) {
+ printf ("%.2i ", sizes[gi][gj]);
+ } else { printf ("%.2i.", sizes[gi][gj]); };
+ } else {
+ if ((gi+gj) % 2 == 0) {
+ printf (" ");
+ } else { printf ("..."); };
+ }
+ }
+ printf ("\n");
+ for (gi = 0; gi < gridSIZE; gi++) {
+ if ((gi+gj) % 2 == 0) {
+ printf ("%c ", chars[gi][gj]);
+ } else {
+ char c = chars[gi][gj] == ' ' ? '.' : chars[gi][gj];
+ printf ("%c..", c);
+ }
+ }
+ printf ("\n");
+ }
+}
+
+/* Outputs current grid if nothing was output before. */
+void output_on_end (void) {
+ if (gridOutputCounter == 0) { output_grid (gridSIZES, gridCHARS); };
+}
+
/* Run complete recognition from string, return result. */
void recognize_from_string (const char* shape_str, const char* full_str,
char* res_str, int* res_nbr, int step,
@@ -1443,19 +1514,25 @@
shape = sread_shape (shape_str, &shape_size, &offset);
videoSTEP = step;
- /* printf ("Read shape:\n");
- print_shape (shape, shape_size); */
+ if (shapesDebugLEVEL > 2) {
+ printf ("Read shape:\n");
+ print_shape (shape, shape_size);
+ }
int smaller_shape_size;
interval* smaller_shape;
smaller_shape = downsize_shape (shape, shape_size, &smaller_shape_size);
- /* printf ("Smaller shape:\n");
- print_shape (smaller_shape, smaller_shape_size); */
+ if (shapesDebugLEVEL > 2) {
+ printf ("Smaller shape:\n");
+ print_shape (smaller_shape, smaller_shape_size);
+ }
+ // Initial pattern will be a grid
char init_grid[20000];
print_grid (init_grid, gridSIZE);
+ // Match pattern and compute its mid-point
int res = 0;
init_patterns_from_string (init_grid);
res = match_pattern (smaller_shape, smaller_shape_size);
@@ -1467,44 +1544,110 @@
} else {
int o = sprintf (res_str, "1\n%s\n", patterns[res].name);
+ // Do grid shapes matching
if (step > 0) {
int full_size;
interval* full;
int full_offset = 0;
full = sread_shape (full_str, &full_size, &full_offset);
- //printf ("Full shape:\n");
- //print_shape (full, full_size);
+ if (shapesDebugLEVEL > 1) {
+ printf ("Full shape:\n");
+ print_shape (full, full_size);
+ }
- // put grid subshapes into grid;
- int gi, gj, cut_size;
+ // Put grid subshapes into grid;
+ int gi = 0, gj = 0, cut_size = 0, diffChars = 0, diffRedBlue = 0;
interval * cut;
for (gi = 0; gi < gridSIZE; gi++) {
for (gj = 0; gj < gridSIZE; gj++) {
cut = cut_res_grid (full, full_size, gi, gj, res_mid, &cut_size);
gridSIZES[gi][gj] = cut_size;
gridSHAPES[gi][gj] = cut;
+ gridCOLORS[gi][gj] = aggregate_color (cut, cut_size, color);
+ char desc = describe_field (cut_size, gridCOLORS[gi][gj]);
+ if (desc != gridCHARS[gi][gj]) {
+ diffChars++;
+ if (desc == redChar && gridCHARS[gi][gj] == ' ') { diffRedBlue++; };
+ if (desc == redChar && gridCHARS[gi][gj] == blueChar) {
+ diffRedBlue += 2;
+ };
+ if (desc == blueChar && gridCHARS[gi][gj] == ' ') { diffRedBlue--;};
+ if (desc == blueChar && gridCHARS[gi][gj] == blueChar) {
+ diffRedBlue -= 2;
+ };
+ };
+ gridPrevCHARS[gi][gj] = gridCHARS[gi][gj];
+ gridCHARS[gi][gj] = desc;
}
}
+ if (diffRedBlue > maxMoveCHANGE || diffRedBlue < -maxMoveCHANGE) {
+ diffChars++;
+ }
- cut_res_grid (full, full_size, gridSIZE, gridSIZE, res_mid, &cut_size);
- if (cut_size < 2) { printf ("hand\n"); } else {
- for (gj = 0; gj < gridSIZE; gj++) {
- for (gi = 0; gi < gridSIZE; gi++) {
- unsigned int col = aggregate_color (gridSHAPES[gi][gj],
- gridSIZES[gi][gj], color);
- //printf ("%.3i ", gridSIZES[gi][gj]);
- //printf ("%i ", gridSIZES[gi][gj] > 9 ? 1 : 0);
- if (gridSIZES[gi][gj] > minshapePTS &&
- (col % 256) > (col / (256*256)) + redblueDELTA) {
- printf ("b ");
- } else if (gridSIZES[gi][gj] > minshapePTS) {
- printf ("r ");
- } else { printf ("0 "); }
+ if (shapesDebugLEVEL > 2) {
+ printf ("TMPGRID diffChars %i\n", diffChars);
+ if (shapesDebugLEVEL > 2) { output_grid (gridSIZES, gridCHARS); };
+ }
+
+ // Did a structure repeat? If too much changed, it's an outlier -- reset.
+ if (diffChars == 0) { gridCharsREPEATED++; };
+ if (step > 1 && diffChars > maxMoveCHANGE) {
+ prevOutlier = 1;
+ for (gi = 0; gi < gridSIZE; gi++) {
+ for (gj = 0; gj < gridSIZE; gj++) {
+ gridCHARS[gi][gj] = gridPrevCHARS[gi][gj];
}
- printf ("\n");
}
+ } else {
+ if (gridCharsREPEATED == 0 && diffChars > 0) {
+ for (gi = 0; gi < gridSIZE; gi++) { // savei in case nothing repeats
+ for (gj = 0; gj < gridSIZE; gj++) {
+ gridSavedCHARS[gi][gj] = gridCHARS[gi][gj];
+ }
+ }
+ }
+ prevOutlier = 0;
+ prevSaved = 1;
}
+
+ // Detect right hand as a blank space in bottom right corner.
+ cut_res_grid (full, full_size, gridSIZE, gridSIZE, res_mid, &cut_size);
+ if (shapesDebugLEVEL > 0) { printf ("Hand cut size %i.\n", cut_size); }
+
+ if (cut_size < minshapeHAND && gridCharsREPEATED == 0 && prevSaved == 1) {
+ if (shapesDebugLEVEL > 1) {
+ printf ("Hand detected %i last %i.\n", cut_size, lastHandDetect);
+ }
+ if (lastHandDetect > 1 && lastHandDetect < maxOUT){
+ output_grid(gridSIZES, gridSavedCHARS);
+ if (shapesDebugLEVEL > 1) { printf ("lhd %i", lastHandDetect); };
+ printf ("\n\n");
+ };
+ prevOutlier = 0;
+ prevSaved = 0;
+ } else if (cut_size < minshapeHAND && gridCharsREPEATED > 0) {
+ // Hand detected, make just a new line.
+ if (shapesDebugLEVEL > 1) { printf ("Detected hand %i.\n", cut_size); }
+ if (gridCharsREPEATED > 0) { printf ("\n\n"); };
+ gridCharsREPEATED = 0;
+ prevOutlier = 0;
+ prevSaved = 0;
+ lastHandDetect = 0;
+ gridOutputCounter = 0;
+ } else if (cut_size < minshapeHAND) {
+ lastHandDetect = 0;
+ } else {
+ // Print out grid at the first repetition.
+ if (gridCharsREPEATED == 1) {
+ if (shapesDebugLEVEL > 1) { printf ("%i \n", diffChars); };
+ output_grid (gridSIZES, gridCHARS);
+ prevOutlier = 0;
+ prevSaved = 0;
+ gridCharsREPEATED++;
+ }
+ lastHandDetect++;
+ }
}
// Scale pattern and return it
Modified: trunk/Toss/Learn/shapes.h
===================================================================
--- trunk/Toss/Learn/shapes.h 2012-01-21 01:23:25 UTC (rev 1648)
+++ trunk/Toss/Learn/shapes.h 2012-01-22 02:38:57 UTC (rev 1649)
@@ -3,6 +3,8 @@
#define MARGINX 48
#define MARGINY 16
+void setBlueChar (char c);
+void setRedChar (char c);
typedef struct point_s {double x; double y;} point;
typedef struct interval_s {point start; point end;} interval;
@@ -21,6 +23,8 @@
shape* get_patterns (void);
+void output_on_end (void);
+
void recognize_from_string (const char* shape_str, const char* full_str,
char* res_str, int* res, int step,
unsigned int color[SIZEX][SIZEY]);
Copied: trunk/Toss/Learn/videos/Breakthrough001_01.nwn.3gp (from rev 1648, trunk/Toss/Learn/videos/Breakthrough001_01_nwn.3gp)
===================================================================
(Binary files differ)
Added: trunk/Toss/Learn/videos/Breakthrough001_01.wn0.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Breakthrough001_01.wn0.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Breakthrough001_01.wn1.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Breakthrough001_01.wn1.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Deleted: trunk/Toss/Learn/videos/Breakthrough001_01_nwn.3gp
===================================================================
(Binary files differ)
Added: trunk/Toss/Learn/videos/Breakthrough001_02.nwn.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Breakthrough001_02.nwn.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Breakthrough001_03.nwn.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Breakthrough001_03.nwn.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_01.nwn.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_01.nwn.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_01.wn0.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_01.wn0.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_01.wn1.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_01.wn1.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_01.wrg.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_01.wrg.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_02.nwn.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_02.nwn.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_02.wrg.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_02.wrg.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_03.nwn.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_03.nwn.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_03.wrg.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_03.wrg.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_04.nwn.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_04.nwn.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_04.wrg.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_04.wrg.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_05.wrg.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_05.wrg.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Toss/Learn/videos/Pawn-Whopping001_06.wrg.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Pawn-Whopping001_06.wrg.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Deleted: trunk/Toss/Learn/videos/tic_tac_toe_0.3gp
===================================================================
(Binary files differ)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-21 01:23:31
|
Revision: 1648
http://toss.svn.sourceforge.net/toss/?rev=1648&view=rev
Author: lukaszkaiser
Date: 2012-01-21 01:23:25 +0000 (Sat, 21 Jan 2012)
Log Message:
-----------
Work on visual recognition.
Modified Paths:
--------------
trunk/Toss/Learn/Makefile
trunk/Toss/Learn/reco.cpp
trunk/Toss/Learn/shapes.c
trunk/Toss/Learn/shapes.h
Added Paths:
-----------
trunk/Toss/Learn/videos/Breakthrough001_01_nwn.3gp
Modified: trunk/Toss/Learn/Makefile
===================================================================
--- trunk/Toss/Learn/Makefile 2012-01-20 02:32:20 UTC (rev 1647)
+++ trunk/Toss/Learn/Makefile 2012-01-21 01:23:25 UTC (rev 1648)
@@ -5,6 +5,7 @@
reco: reco.cpp shapes.o
g++ shapes.o reco.cpp -o reco `pkg-config opencv --cflags --libs`
+ rm -f shapes.o
%Test:
make -C .. Learn/$@Verbose
Modified: trunk/Toss/Learn/reco.cpp
===================================================================
--- trunk/Toss/Learn/reco.cpp 2012-01-20 02:32:20 UTC (rev 1647)
+++ trunk/Toss/Learn/reco.cpp 2012-01-21 01:23:25 UTC (rev 1648)
@@ -8,11 +8,9 @@
}
#include<cstdio>
-#define SIZEX 256 // 352 - MARGINX*2
-#define SIZEY 256 // 288 - MARGINY*2
-#define MARGINX 48
-#define MARGINY 16
+#define timeSTEP 15
+
void reset (char a[SIZEX][SIZEY]) {
for (int j = 0; j < SIZEY; j++) {
for (int i = 0; i < SIZEX; i++) {
@@ -21,6 +19,14 @@
}
}
+void reset_color (unsigned int a[SIZEX][SIZEY]) {
+ for (int j = 0; j < SIZEY; j++) {
+ for (int i = 0; i < SIZEX; i++) {
+ a[i][j] = 1;
+ }
+ }
+}
+
static int print_counter = 0;
void print_ppm (char pic[SIZEX][SIZEY], char * prefix) {
char fname[80];
@@ -56,14 +62,13 @@
cvNamedWindow ("Reco", CV_WINDOW_AUTOSIZE);
CvCapture* capture = cvCreateFileCapture
- //("videos/chess1.3gp");
- ("videos/tic_tac_toe_0.3gp");
+ ("videos/chess1.3gp");
+ // ("videos/tic_tac_toe_0.3gp");
//cvCreateCameraCapture( 0 );
- IplImage* img;
- IplImage* gray;
- IplImage* small;
+ IplImage *img, *col, *gray, *small;
int data_count = 0;
char data[SIZEX][SIZEY];
+ unsigned int color[SIZEX][SIZEY];
unsigned int cur_data = 0;
int time = 0;
int ok_around;
@@ -73,27 +78,35 @@
int fullsh_str_pos = 0;
reset (data);
+ reset_color (color);
while (true) {
img = cvQueryFrame (capture);
if (!img) break;
+ col = cvCreateImage (cvSize (SIZEX + 2*MARGINX, SIZEY + 2*MARGINY), 8, 3);
+ cvResize (img, col, CV_INTER_LINEAR);
gray = cvCreateImage (cvSize (img->width, img->height), 8, 1);
cvCvtColor (img, gray, CV_BGR2GRAY);
small = cvCreateImage (cvSize (SIZEX + 2*MARGINX, SIZEY + 2*MARGINY), 8, 1);
cvResize (gray, small, CV_INTER_LINEAR);
- cvCanny (small, small, 50, 100);
+ cvCanny (small, small, 180, 200);
data_count = 0;
for (int i = 0; i < SIZEX; i++) {
for (int j = 0; j < SIZEY; j++) {
cur_data = (unsigned int)
small->imageData[(i+MARGINX) + small->widthStep * (j+MARGINY)];
- ok_around = i == 0 || j == 0 ? 1 :
+ /* ok_around = i == 0 || j == 0 ? 1 :
data[i][j] + data[i-1][j] + data[i+1][j] +
data[i][j+1] + data[i-1][j-1] + data[i+1][j-1] +
data[i][j-1] + data[i-1][j+1] + data[i+1][j+1];
- ok_around = ok_around == 0 ? 0 : 1;
+ ok_around = ok_around == 0 ? 0 : 1; */
data[i][j] = cur_data > 2 ? 1 : 0; //ok_around : 0;
+ int r, g, b;
+ b = ((uchar*)(col->imageData + col->widthStep*(j+MARGINY)))[3*(i+MARGINX)];
+ g = ((uchar*)(col->imageData + col->widthStep*(j+MARGINY)))[3*(i+MARGINX)+1];
+ r = ((uchar*)(col->imageData + col->widthStep*(j+MARGINY)))[3*(i+MARGINX)+2];
+ color[i][j] = b + 256*g + 256*256*r;
if (data[i][j] == 1) data_count++;
}
}
@@ -102,16 +115,17 @@
CvSeq* lines = 0;
int i;
lines = cvHoughLines2( small, storage, CV_HOUGH_PROBABILISTIC,
- 1, CV_PI/180, 80, 50, 30 );
- for( i = 0; i < lines->total; i++ ) {
- CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i);
- cvLine( small, line[0], line[1], CV_RGB(100,200,200), 3 );
- }
+ 1, CV_PI/180, 120, 50, 30 );
+ //for( i = 0; i < lines->total; i++ ) {
+ // CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i);
+ // cvLine( small, line[0], line[1], CV_RGB(100,200,200), 3 );
+ //}
- if (time % 5 == 0 && (data_count<500 || lines->total<5)) { //empty, reset
+ /* if (time % 5 == 0 && (data_count<500 || lines->total<5)) { //empty, reset
reset (data);
+ reset_color (color);
time = 1;
- }
+ }*/
if (rnbr >= 0) {
shape p = (get_patterns())[rnbr];
for (int s = 0; s < p.size; s++) {
@@ -120,7 +134,7 @@
}
}
cvShowImage( "Reco", small );
- if (time % 70 == 0) { // wait < 4s for now
+ if (time % timeSTEP == 0) { // wait timeSTEP frames
int ok_lines = 0;
for( i = 0; i < lines->total; i++ ) {
CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i);
@@ -157,10 +171,12 @@
}
sprintf (fullsh_str + fullsh_str_pos, " END");
printf ("step: %i\nlines: %i\ndata: %i\nreco:\n",
- time/70, lines->total, data_count);
- if (time/70 > 1) { print_ppm (data, (char*) "log"); }
+ time/timeSTEP, lines->total, data_count);
+ if (time/timeSTEP > 1) { print_ppm (data, (char*) "log"); }
reset (data);
- recognize_from_string (shape_str, fullsh_str, res, &rnbr, time/70 - 1);
+ recognize_from_string (shape_str, fullsh_str, res,
+ &rnbr, time/timeSTEP-1, color);
+ reset_color (color);
printf ("%i\n", rnbr);
for (int i = 0; i < 2000; i++) res[i] = 0;
for (int i = 0; i < SIZEX*SIZEY*24; i++) shape_str[i] = 0;
Modified: trunk/Toss/Learn/shapes.c
===================================================================
--- trunk/Toss/Learn/shapes.c 2012-01-20 02:32:20 UTC (rev 1647)
+++ trunk/Toss/Learn/shapes.c 2012-01-21 01:23:25 UTC (rev 1648)
@@ -9,22 +9,9 @@
#include <math.h>
#include <pthread.h>
-typedef struct point_s {double x; double y;} point;
-typedef struct interval_s {point start; point end;} interval;
+#include "shapes.h"
-typedef struct shape_s {
- interval* shape;
- int size;
- char name[80];
- double max_dist;
- double correction;
- double scale_correction;
- double min_rotation;
- double max_rotation;
- double rotation_density;
-} shape;
-
static pthread_mutex_t shapes_stop_mutex;
static pthread_mutex_t shapes_working_mutex;
static pthread_mutex_t shapes_painting_mutex;
@@ -229,15 +216,19 @@
return (res);
}
+/* Move a point by a translation vector, given as a point. */
+static void move_point (const point t, point* p) {
+ p->x += t.x;
+ p->y += t.y;
+}
+
/* Move a shape by a translation vector, given as a point. */
static void move_shape (const point t, interval* s, const int size)
{
int i = 0;
for (i = 0; i < size; i++) {
- s[i].start.x += t.x;
- s[i].start.y += t.y;
- s[i].end.x += t.x;
- s[i].end.y += t.y;
+ move_point (t, &s[i].start);
+ move_point (t, &s[i].end);
}
}
@@ -288,16 +279,19 @@
return (res);
}
-/* Scale a shape by a scale vector, given as a point. */
-static void scale_shape_m (const point scale, interval* shape, const int size,
- const double mx, const double my)
-{
+/* Scale the point [p] by a [scale] vector around [mid], given as a points. */
+static void scale_point_m (const point scale, const point mid, point* p) {
+ p->x = ((p->x - mid.x) * scale.x) + mid.x;
+ p->y = ((p->y - mid.y) * scale.y) + mid.y;
+}
+
+/* Scale a shape by a [scale] vector around [mid], given as points. */
+static void scale_shape_m (const point scale, const point mid,
+ interval* shape, const int size) {
int i = 0;
for (i = 0; i < size; i++) {
- shape[i].start.x = ((shape[i].start.x - mx) * scale.x) + mx;
- shape[i].start.y = ((shape[i].start.y - my) * scale.y) + my;
- shape[i].end.x = ((shape[i].end.x - mx) * scale.x) + mx;
- shape[i].end.y = ((shape[i].end.y - my) * scale.y) + my;
+ scale_point_m (scale, mid, &shape[i].start);
+ scale_point_m (scale, mid, &shape[i].end);
}
}
@@ -305,7 +299,7 @@
static void scale_shape (const point scale, interval* shape, const int size)
{
interval mids = mid_dimen (shape, size);
- scale_shape_m (scale, shape, size, mids.start.x, mids.start.y);
+ scale_shape_m (scale, mids.start, shape, size);
}
/* Scale a shape and its points by a scale vector, given as a point. */
@@ -331,24 +325,22 @@
}
}
-/* Rotate point [p] by angle [a] (in radians) around point [x, y]. */
-static void rotate_point (point* p, double a, double tx, double ty)
-{
- double x = p->x - tx;
- double y = p->y - ty;
+/* Rotate point [p] by angle [a] (in radians) around [mid]. */
+static void rotate_point (const double a, const point mid, point* p) {
+ double x = p->x - mid.x;
+ double y = p->y - mid.y;
- p->x = (x * cos (a) - y * sin (a)) + tx;
- p->y = (x * sin (a) + y * cos (a)) + ty;
+ p->x = (x * cos (a) - y * sin (a)) + mid.x;
+ p->y = (x * sin (a) + y * cos (a)) + mid.y;
}
-/* Rotate a shape by an angle, in radians. */
-static void rotate_shape_m (const double angle, interval* shape, const int size,
- const double mx, const double my)
-{
+/* Rotate a shape by [angle], in radians, around [mid]. */
+static void rotate_shape_m (const double angle, const point mid,
+ interval* shape, const int size) {
int i = 0;
for (i = 0; i < size; i++) {
- rotate_point (&shape[i].start, angle, mx, my);
- rotate_point (&shape[i].end, angle, mx, my);
+ rotate_point (angle, mid, &shape[i].start);
+ rotate_point (angle, mid, &shape[i].end);
}
}
@@ -356,26 +348,25 @@
static void rotate_shape (const double angle, interval* shape, const int size)
{
interval mids = mid_dimen (shape, size);
- rotate_shape_m (angle, shape, size, mids.start.x, mids.start.y);
+ rotate_shape_m (angle, mids.start, shape, size);
}
/* Scale a shape and its points by a scale vector, given as a point. */
-static void rotate_shape_points (const double angle, interval* shape, const int size,
- point* points, const int points_size)
+static void rotate_shape_points (const double angle, interval* shape,
+ const int size, point* points,
+ const int points_size)
{
interval mids = mid_dimen (shape, size);
- double mx = mids.start.x;
- double my = mids.start.y;
int i = 0;
for (i = 0; i < size; i++) {
- rotate_point (&shape[i].start, angle, mx, my);
- rotate_point (&shape[i].end, angle, mx, my);
+ rotate_point (angle, mids.start, &shape[i].start);
+ rotate_point (angle, mids.start, &shape[i].end);
}
for (i = 0; i < points_size; i++) {
- rotate_point (&points[i], angle, mx, my);
+ rotate_point (angle, mids.start, &points[i]);
}
}
@@ -397,9 +388,21 @@
scale_shape_points (s, shape, size, points, points_size);
}
+/* Move and scale and rotate point [p] by a vector and an angle around [mid]. */
+static void move_scale_rotate_point_m (point* p, const point t, const point s,
+ const double angle, const point mid) {
+ point tmid;
+ tmid.x = mid.x + t.x;
+ tmid.y = mid.y + t.y;
+ move_point (t, p);
+ scale_point_m (s, tmid, p);
+ rotate_point (angle, tmid, p);
+}
+
/* Move and scale and rotate a shape by a vector and an angle. */
-static void move_scale_rotate_shape (const point t, const point s, const double angle,
- interval* shape, const int size)
+static void move_scale_rotate_shape (const point t, const point s,
+ const double angle,
+ interval* shape, const int size)
{
move_shape (t, shape, size);
scale_shape (s, shape, size);
@@ -805,6 +808,14 @@
}
+/* Keep old scale unchaged if within these bound, useful for video. */
+int videoSTEP = 0;
+point prev_dim = { 1., 1. };
+float prev_dim_change_bound = 1.5;
+
+/* Scale Margin since we do not detect outliers at present. */
+float scale_margin = 0.88;
+
/* Find scale factor given pattern and shape dimensions. */
static point find_scale (const point pattern_dim, const point shape_dim) {
point res;
@@ -821,9 +832,27 @@
res.x = shape_dim.x / pattern_dim.x;
res.y = shape_dim.y / pattern_dim.y;
}
- return (res);
+
+ res.x = scale_margin * res.x;
+ res.y = scale_margin * res.y;
+
+ if ((videoSTEP > 0) &&
+ (res.x < prev_dim_change_bound * prev_dim.x) &&
+ (prev_dim.x < prev_dim_change_bound * res.x) &&
+ (res.y < prev_dim_change_bound * prev_dim.y) &&
+ (prev_dim.y < prev_dim_change_bound * res.y)) {
+ return (prev_dim);
+ } else {
+ prev_dim.x = res.x;
+ prev_dim.y = res.y;
+ return (res);
+ }
}
+/* Keep old translation unchaged if within these bound, useful for video. */
+point prev_move = { 0., 0. };
+float prev_move_change_bound = 25;
+
/* Find best fit (scale and translation) between shape and pattern. */
static interval best_fit (interval* shape, const int s_size, interval* pattern,
const int p_size, const int no_iter, double* metric,
@@ -847,6 +876,18 @@
point d_move;
d_move.x = shape_mids.start.x - pattern_mids.start.x;
d_move.y = shape_mids.start.y - pattern_mids.start.y;
+ if ((videoSTEP > 0) &&
+ (d_move.x - prev_move_change_bound < prev_move.x) &&
+ (prev_move.x - prev_move_change_bound < d_move.x) &&
+ (d_move.y - prev_move_change_bound < prev_move.y) &&
+ (prev_move.y - prev_move_change_bound < d_move.y)) {
+ d_move.x = prev_move.x;
+ d_move.y = prev_move.y;
+ } else {
+ prev_move.x = d_move.x;
+ prev_move.y = d_move.y;
+ }
+
point d_scale = find_scale (pattern_mids.end, shape_mids.end);
double d_rot = 0;
@@ -933,6 +974,12 @@
static double get_res_rot () { return (res_rot); }
static double get_res_min () { return (res_min); }
+/* Move and scale and rotate point [p] by result vector around [mid]. */
+static void res_point (point* p, const point mid) {
+ move_scale_rotate_point_m (p, get_res_move (), get_res_scale (),
+ get_res_rot (), mid);
+}
+
/* How long to look for best fit. */
static int number_of_iterations = 4;
static int get_no_iterations () { return (number_of_iterations); }
@@ -1322,15 +1369,15 @@
return (new_shape);
}
-#define gridSIZE 3
+#define gridSIZE 8
#define gridJUMP 1
-#define gridMARGIN 0.3
+#define gridMARGIN 0.5
int gridSIZES[gridSIZE][gridSIZE];
interval * gridSHAPES[gridSIZE][gridSIZE];
void print_grid (char* s, int n) {
int o;
- o = sprintf (s, "SHAPES 1 PRECISION 4 RECO FACTOR 1.6 ");
+ o = sprintf (s, "SHAPES 1 PRECISION 0 RECO FACTOR 1.6 ");
o += sprintf (s+o, "SHAPE grid MAXDIST 900 CORRECTION 2 ");
o += sprintf (s+o, "SCALE DEVIATION 0 ROTATION MIN -1 MAX 1 DENSITY 0 ");
o += sprintf (s+o, "START %i ", 2*n+2);
@@ -1342,13 +1389,59 @@
sprintf (s+o, "END\n");
}
+/* Cut grid point shape scaling to result around mid. */
+static interval* cut_res_grid (const interval* shape, const int size, int gi,
+ int gj, const point res_mid, int* res_size) {
+ point bl, tr;
+ bl.x = gridJUMP * (2*gi - gridSIZE) + gridMARGIN;
+ bl.y = gridJUMP * (2*gj - gridSIZE) + gridMARGIN;
+ tr.x = gridJUMP * (2*gi + 2 - gridSIZE) - gridMARGIN;
+ tr.y = gridJUMP * (2*gj + 2 - gridSIZE) - gridMARGIN;
+ res_point (&bl, res_mid);
+ res_point (&tr, res_mid);
+ return (cut_shape (shape, size, bl, tr, res_size));
+}
+
+static unsigned int aggregate_color (const interval* shape, const int size,
+ unsigned int color[SIZEX][SIZEY]) {
+ interval cut_mid = mid_dimen (shape, size);
+ int i = 0, j = 0, r = 0, g = 0, b = 0, nbr = 0;
+ if (size == 0) { return (0); } /*
+ for (i = (int) (cut_mid.start.x - cut_mid.end.x);
+ i <= cut_mid.start.x + cut_mid.end.x; i++) {
+ for (j = (int) (cut_mid.start.y - cut_mid.end.y);
+ j <= cut_mid.start.y + cut_mid.end.y; j++) {
+ b += (int) (color[i][j] % 256);
+ g += (int) ((color[i][j] / 256) % 256);
+ r += (int) ((color[i][j] / (256*256)) % 256);
+ nbr++;
+ }
+ } */
+ for (i = 0; i < size; i++) {
+ //printf ("%f %f\n", shape[i].start.x, shape[i].start.y);
+ b += (int) (color[(int) shape[i].start.x][(int) shape[i].start.y] % 256);
+ g += (int) ((color[(int) shape[i].start.x][(int) shape[i].start.y] / 256) % 256);
+ r += (int) ((color[(int) shape[i].start.x][(int) shape[i].start.y] / (256*256)) % 256);
+ }
+ nbr = size;
+ r = (int) (r / nbr);
+ g = (int) (g / nbr);
+ b = (int) (b / nbr);
+ return (b + 256*g + 256*256*r);
+}
+
+#define redblueDELTA 5
+#define minshapePTS 9
+
/* Run complete recognition from string, return result. */
void recognize_from_string (const char* shape_str, const char* full_str,
- char* res_str, int* res_nbr, int step) {
+ char* res_str, int* res_nbr, int step,
+ unsigned int color[SIZEX][SIZEY]) {
int shape_size;
interval* shape;
int offset = 0;
shape = sread_shape (shape_str, &shape_size, &offset);
+ videoSTEP = step;
/* printf ("Read shape:\n");
print_shape (shape, shape_size); */
@@ -1367,6 +1460,7 @@
init_patterns_from_string (init_grid);
res = match_pattern (smaller_shape, smaller_shape_size);
*res_nbr = res;
+ point res_mid = mid_dimen (patterns[res].shape, patterns[res].size).start;
if (res < 0) {
sprintf (res_str, "0\n");
@@ -1381,47 +1475,36 @@
//printf ("Full shape:\n");
//print_shape (full, full_size);
-
- int smaller_full_size;
- interval* smaller_full;
- smaller_full = downsize_shape (full, full_size, &smaller_full_size);
-
- // Scale input back to recognized pattern coordinates.
- interval mids = mid_dimen (smaller_shape, smaller_shape_size);
- double mx = mids.start.x;
- double my = mids.start.y;
- rotate_shape_m (-1 * get_res_rot (), smaller_full, smaller_full_size,
- mx, my);
- point tmp;
- tmp.x = 1 / get_res_scale().x;
- tmp.y = 1 / get_res_scale().y;
- scale_shape_m (tmp, smaller_full, smaller_full_size, mx, my);
- tmp.x = -1 * get_res_move().x;
- tmp.y = -1 * get_res_move().y;
- move_shape (tmp, smaller_full, smaller_full_size);
-
- //printf ("Res shape:\n");
- //print_shape (smaller_full, smaller_full_size);
// put grid subshapes into grid;
- int gi;
- int gj;
+ int gi, gj, cut_size;
+ interval * cut;
for (gi = 0; gi < gridSIZE; gi++) {
for (gj = 0; gj < gridSIZE; gj++) {
- int cut_size;
- point bl, tr;
- bl.x = gridJUMP * (2*gi - gridSIZE) + gridMARGIN;
- bl.y = gridJUMP * (2*gj - gridSIZE) + gridMARGIN;
- tr.x = gridJUMP * (2*gi + 2 - gridSIZE) - gridMARGIN;
- tr.y = gridJUMP * (2*gj + 2 - gridSIZE) - gridMARGIN;
- interval * cut = cut_shape (smaller_full, smaller_full_size,
- bl, tr, &cut_size);
+ cut = cut_res_grid (full, full_size, gi, gj, res_mid, &cut_size);
gridSIZES[gi][gj] = cut_size;
- gridSHAPES[gi][gj] = cut;
- printf ("Grid at (%i, %i) shape size: %i\n", gi, gj, cut_size);
- //print_shape (cut, cut_size);
+ gridSHAPES[gi][gj] = cut;
}
}
+
+ cut_res_grid (full, full_size, gridSIZE, gridSIZE, res_mid, &cut_size);
+ if (cut_size < 2) { printf ("hand\n"); } else {
+ for (gj = 0; gj < gridSIZE; gj++) {
+ for (gi = 0; gi < gridSIZE; gi++) {
+ unsigned int col = aggregate_color (gridSHAPES[gi][gj],
+ gridSIZES[gi][gj], color);
+ //printf ("%.3i ", gridSIZES[gi][gj]);
+ //printf ("%i ", gridSIZES[gi][gj] > 9 ? 1 : 0);
+ if (gridSIZES[gi][gj] > minshapePTS &&
+ (col % 256) > (col / (256*256)) + redblueDELTA) {
+ printf ("b ");
+ } else if (gridSIZES[gi][gj] > minshapePTS) {
+ printf ("r ");
+ } else { printf ("0 "); }
+ }
+ printf ("\n");
+ }
+ }
}
// Scale pattern and return it
Modified: trunk/Toss/Learn/shapes.h
===================================================================
--- trunk/Toss/Learn/shapes.h 2012-01-20 02:32:20 UTC (rev 1647)
+++ trunk/Toss/Learn/shapes.h 2012-01-21 01:23:25 UTC (rev 1648)
@@ -1,3 +1,9 @@
+#define SIZEX 256 // 352 - MARGINX*2
+#define SIZEY 256 // 288 - MARGINY*2
+#define MARGINX 48
+#define MARGINY 16
+
+
typedef struct point_s {double x; double y;} point;
typedef struct interval_s {point start; point end;} interval;
@@ -16,4 +22,5 @@
shape* get_patterns (void);
void recognize_from_string (const char* shape_str, const char* full_str,
- char* res_str, int* res, int step);
+ char* res_str, int* res, int step,
+ unsigned int color[SIZEX][SIZEY]);
Added: trunk/Toss/Learn/videos/Breakthrough001_01_nwn.3gp
===================================================================
(Binary files differ)
Property changes on: trunk/Toss/Learn/videos/Breakthrough001_01_nwn.3gp
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-20 02:32:28
|
Revision: 1647
http://toss.svn.sourceforge.net/toss/?rev=1647&view=rev
Author: lukaszkaiser
Date: 2012-01-20 02:32:20 +0000 (Fri, 20 Jan 2012)
Log Message:
-----------
Learning Pawn-Whopping.
Modified Paths:
--------------
trunk/Toss/Formula/FormulaOpsTest.ml
trunk/Toss/Formula/FormulaParser.mly
trunk/Toss/Learn/Distinguish.ml
trunk/Toss/Learn/LearnGame.ml
trunk/Toss/Learn/LearnGameTest.ml
trunk/Toss/Learn/Makefile
trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg
Added Paths:
-----------
trunk/Toss/Learn/examples/Pawn-Whopping001_03.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_04.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_05.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_05.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_06.wrg
Modified: trunk/Toss/Formula/FormulaOpsTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaOpsTest.ml 2012-01-19 03:06:07 UTC (rev 1646)
+++ trunk/Toss/Formula/FormulaOpsTest.ml 2012-01-20 02:32:20 UTC (rev 1647)
@@ -32,6 +32,8 @@
nnf_eq "true" "true";
nnf_eq "(not false)" "true";
nnf_eq "not (P(x) and not Q(x))" "not P(x) or Q(x)";
+ nnf_eq "tc 1 x, y R(x, y)" "x = y or R(x, y)";
+ nnf_eq "tc !1 x, y R(x, y)" "R(x, y)";
nnf_eq "not ex x (not P(x) and Q(x))" "all x (P(x) or not Q(x))";
nnf_eq "not ex :x, :y (:x^2 + 3*:y + 2 < 0)"
"all :x, :y (not :x^2 + 3*:y + 2 < 0)";
Modified: trunk/Toss/Formula/FormulaParser.mly
===================================================================
--- trunk/Toss/Formula/FormulaParser.mly 2012-01-19 03:06:07 UTC (rev 1646)
+++ trunk/Toss/Formula/FormulaParser.mly 2012-01-20 02:32:20 UTC (rev 1647)
@@ -96,7 +96,7 @@
| TC ID COMMA ID formula_expr { FormulaSubst.make_lfp_tc $2 $4 $5 }
| TC IN_MOD ID COMMA ID formula_expr { FormulaSubst.make_mso_tc $3 $5 $6 }
| TC INT ID COMMA ID formula_expr { FormulaSubst.make_fo_tc_conj $2 $3 $5 $6 }
- | TC PLUS INT ID COMMA ID formula_expr
+ | TC NOT INT ID COMMA ID formula_expr
{ FormulaSubst.make_fo_tc_disj ~reflexive:false $3 $4 $6 $7 }
| LFP ID OPEN fo_var_list CLOSE EQ formula_expr
{ let vs = Array.of_list $4 in if Array.length vs <> 1 then
Modified: trunk/Toss/Learn/Distinguish.ml
===================================================================
--- trunk/Toss/Learn/Distinguish.ml 2012-01-19 03:06:07 UTC (rev 1646)
+++ trunk/Toss/Learn/Distinguish.ml 2012-01-20 02:32:20 UTC (rev 1647)
@@ -188,6 +188,7 @@
List.map Array.of_list (Aux.all_ntuples (Array.to_list tup) k) in
let ktups = List.rev_map k_subtuples (Aux.unique_sorted tups) in
let ktups = Aux.unique_sorted (List.concat ktups) in
+ if !debug_level>0 then print_endline "guarded_types:\t\t tuples generated";
let mem = Hashtbl.create 63 in
Aux.unique_sorted (List.rev_map
(guarded_type_memo existential struc mem qr) ktups)
@@ -211,6 +212,8 @@
let rec rept i l = if i < 1 then [] else l :: (rept (i-1) l) in
let atoms = Array.of_list (FormulaOps.atoms ~repetitions:repeat_vars
(Structure.rel_signature struc) (varnames 2)) in
+ if !debug_level > 0 then
+ Printf.printf "tc_atomic:\t\t %i atoms\n%!" (Array.length atoms);
let choices = List.rev_map Array.of_list
(if positive then Aux.product (rept (Array.length atoms) [0; 1]) else
Aux.product (rept (Array.length atoms) [0; 1; -1])) in
@@ -258,17 +261,27 @@
(* Helper function: remove atoms from a formula if [cond] is still satisfied.
Note that this is just a greedy heuristic, only And/Or and into Ex/All. *)
let rec greedy_remove ?(pos=false) cond phi =
- let rec greedy_remove_list constructor acc = function
+ if !debug_level > 1 then
+ Printf.printf "greedy_remove:\t\t %s\n%!" (Formula.str phi);
+ let rec greedy_remove_list minimize constructor acc = function
| [] -> acc
| x :: xs ->
let rest = acc @ xs in
- if cond (constructor rest) then greedy_remove_list constructor acc xs else
- let minx = greedy_remove (fun y -> cond (constructor (y :: rest))) x in
- greedy_remove_list constructor (minx::acc) xs in
+ if cond (constructor rest) then
+ greedy_remove_list minimize constructor acc xs
+ else if minimize then
+ let minx = greedy_remove (fun y-> cond (constructor (y :: rest))) x in
+ greedy_remove_list minimize constructor (minx::acc) xs
+ else greedy_remove_list minimize constructor (x::acc) xs in
+ let greedy_remove_lst cons lst =
+ let l = greedy_remove_list false cons [] lst in
+ if !debug_level > 1 then Printf.printf "greedy_remove_lst:\t min %i: %s\n%!"
+ (List.length l) (Formula.str (cons l));
+ greedy_remove_list true cons [] (List.rev l) in
match phi with
- | And fl -> And (greedy_remove_list (fun l -> And l) [] (List.rev fl))
+ | And fl -> And (greedy_remove_lst (fun l -> And l) (List.rev fl))
| Or fl -> if pos then Or fl else
- Or (greedy_remove_list (fun l -> Or l) [] (List.rev fl))
+ Or (greedy_remove_lst (fun l -> Or l) (List.rev fl))
| Not f -> if pos then Not f else
Not (greedy_remove (fun x -> cond (Not x)) f)
| Ex (vs, f) -> Ex (vs, greedy_remove (fun x -> cond (Ex (vs, x))) f)
@@ -291,9 +304,10 @@
| ExGuardedFO -> guarded_types ~existential:true struc ~qr ~k
| FO -> ntypes struc ~qr ~k
| ExFO -> ntypes ~existential:true struc ~qr ~k in
+ if !debug_level > 0 then print_endline "min_type_omitting:\t types generated";
let ok_types = List.filter (fun f -> not (List.mem f neg_types)) pos_types in
let ok_types = List.sort !compare_types ok_types in
- if ok_types = [] then None else Some (List.hd ok_types)
+ if ok_types = [] then None else Some (Formula.flatten_sort (List.hd ok_types))
(* Find a [logic]-formula with at most [qr] quantifiers and [k] variables
which holds on all [pos_strucs] and on no [neg_strucs]. *)
@@ -304,6 +318,7 @@
| FO -> ntypes s ~qr ~k
| ExFO -> ntypes ~existential:true s ~qr ~k in
let neg_tps = Aux.unique_sorted (Aux.concat_map types neg_strucs) in
+ if !debug_level > 0 then print_endline "distinguish_upto:\t neg types done";
let fails_on_negs f = not (List.exists (fun s-> check s [||] f) neg_strucs) in
let extend_by_pos acc struc =
if check struc [||] (Or acc) then acc else
@@ -313,6 +328,8 @@
let pos_formulas =
try List.fold_left extend_by_pos [] pos_strucs with Not_found -> [] in
let pos_formulas = Aux.unique_sorted ~cmp:!compare_types pos_formulas in
+ if !debug_level > 0 then Printf.printf
+ "distinguish_upto:\t pos_formulas %i\n%!" (List.length pos_formulas);
if pos_formulas = [] then None else
let succ_pos fl = List.for_all (fun s -> check s [||] (Or fl)) pos_strucs in
let is_ok f = fails_on_negs f && succ_pos [f] in
@@ -330,7 +347,8 @@
(String.concat "\n" (List.map Structure.str s2));
let rec diff qr k =
if qr > k then diff 0 (k+1) else (
- if !debug_level > 0 then Printf.printf "distinguish qr %i k %i\n%!" qr k;
+ if !debug_level > 0 then
+ Printf.printf "distinguish:\t\t qr %i k %i\n%!" qr k;
if qr = 0 then
match distinguish_upto ~logic:GuardedFO ~qr ~k s1 s2 with
| Some f -> f | None ->
@@ -340,9 +358,13 @@
else
match distinguish_upto ~logic:GuardedFO ~qr ~k s1 s2 with
| Some f ->
- (match distinguish_upto ~logic:ExGuardedFO ~qr ~k s1 s2 with
- | Some g-> if 2*(Formula.size f) < Formula.size g then f else g
- | None -> f)
+ if qr > 1 (* hurry up for large qr *) then f else (
+ if !debug_level > 0 then Printf.printf
+ "distinguish:\t\t guarded found: %s\n%!" (Formula.str f);
+ match distinguish_upto ~logic:ExGuardedFO ~qr ~k s1 s2 with
+ | Some g-> if 2*(Formula.size f) < Formula.size g then f else g
+ | None -> f
+ )
| None -> diff (qr+1) k
) in
let res = diff 0 1 in
Modified: trunk/Toss/Learn/LearnGame.ml
===================================================================
--- trunk/Toss/Learn/LearnGame.ml 2012-01-19 03:06:07 UTC (rev 1646)
+++ trunk/Toss/Learn/LearnGame.ml 2012-01-20 02:32:20 UTC (rev 1647)
@@ -20,7 +20,8 @@
(String.concat "\n" (List.map Structure.str winningStates)) ^ "\nNOT\n"^
(String.concat "\n" (List.map Structure.str notWinningStates)));
let res = Distinguish.distinguish winningStates notWinningStates in
- let print_tc (i,f) = Printf.sprintf "(tc+ %i x0 x1 (%s))" i (Formula.str f) in
+ let print_tc (i, f) =
+ Printf.sprintf "(tc !%i x0, x1 (%s))" i (Formula.str f) in
match !Distinguish.distinguish_result_tc with
| None | Some [(1, _)] -> Formula.str (FormulaOps.tnf_fv res)
| Some l -> if not nicetc then Formula.str (FormulaOps.tnf_fv res) else
@@ -81,7 +82,9 @@
let mright = List.filter (fun (l, r, x) -> movecmp x m = 0) moves in
let mark (l, r, _) =
let chg = Aux.unique_sorted (List.map fst (Structure.diff_elems l r)) in
- Structure.add_rels l "chg" (List.map (fun e -> [|e|]) chg) in
+ let mark_el (st, i) e =
+ (Structure.add_rel st ("ch" ^ string_of_int i) [|e|], i+1) in
+ fst (List.fold_left mark_el (l, 1) chg) in
let (good, bad) = (List.map mark mright, List.map mark mwrong) in
if !debug_level > 0 then (
List.iter Structure.print good;
@@ -91,10 +94,10 @@
let pre = Distinguish.distinguish good bad in
if !debug_level > 0 then print_endline (Formula.str pre);
let elems = Aux.range ~from:1 ((Structure.nbr_elems (fst m)) + 1) in
- let eqs = List.map (fun i -> "x = e" ^ (string_of_int i)) elems in
- let let_part = "let chg(x) = " ^ (String.concat " or " eqs) ^ " in " in
+ let let_part i = Printf.sprintf "let ch%i (x) = x = e%i in" i i in
+ let let_all = String.concat " " (List.map let_part elems) in
let phi = FormulaParser.parse_formula Lexer.lex
- (Lexing.from_string (let_part ^ (Formula.str pre))) in
+ (Lexing.from_string (let_all ^ " " ^ (Formula.str pre))) in
(m, FormulaOps.tnf_fv phi)
let learnFromParties ~win0 ~win1 ~notwon ~wrong =
@@ -105,7 +108,7 @@
let win1f = winFormula
(List.map (fun x -> List.hd (List.rev x)) win1)
(List.flatten ((List.map (fun x-> List.tl (List.rev x))
- win1) @ win0 @ notwon)) in
+ win1) @ win0 @ notwon)) in
let fullMoves0 = movesi 0 (win0 @ win1 @ notwon) in
let fullMoves1 = movesi 1 (win0 @ win1 @ notwon) in
@@ -123,7 +126,7 @@
let cmpll l1 l2 = (List.length l2) - (List.length l1) in
let longest = List.hd (List.sort cmpll (win0 @ win1 @ notwon)) in
- let mvlst pre post l = String.concat "; " (List.map (
+ let mvlst pre post l = String.concat "]; [" (List.map (
fun i -> pre ^ (string_of_int i) ^ post) (Aux.range (List.length l))) in
"PLAYERS 1, 2\n" ^
@@ -131,27 +134,26 @@
"REL Win2() = "^ win1f ^ "\n"^
(fst (List.fold_left
(fun (old, i) ((l, r), pre) ->
- (old ^ "\n" ^ "RULE Mv1-" ^ (string_of_int i) ^ ": \n" ^
+ (old ^ "\n" ^ "RULE Mv1r" ^ (string_of_int i) ^ ": \n" ^
(Structure.str l) ^ " -> " ^ (Structure.str r) ^ "\nemb " ^
(String.concat "," (List.map fst (Structure.rel_signature l))) ^
"\npre (" ^ (Formula.str pre) ^ ") and not Win2()"), i+1)
("", 0) moves0)) ^ "\n\n" ^
(fst (List.fold_left
(fun (old, i) ((l, r), pre) ->
- (old ^ "\n" ^ "RULE Mv2-" ^ (string_of_int i) ^ ": \n" ^
+ (old ^ "\n" ^ "RULE Mv2r" ^ (string_of_int i) ^ ": \n" ^
(Structure.str l) ^ " -> " ^ (Structure.str r) ^ "\nemb "^
(String.concat "," (List.map fst (Structure.rel_signature l))) ^
"\npre (" ^ (Formula.str pre) ^ ") and not Win1()"), i+1)
("",0) moves1)) ^ "\n\n" ^
"LOC 0 {
PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
- MOVES [" ^ (mvlst "Mv1-" " -> 1" moves0) ^ "]}
+ MOVES [" ^ (mvlst "Mv1r" " -> 1" moves0) ^ "]}
PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
}
LOC 1 {
PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
- MOVES [" ^ (mvlst "Mv2-" " -> 0" moves1) ^ "] }
+ MOVES [" ^ (mvlst "Mv2r" " -> 0" moves1) ^ "]}
}" ^ "\n" ^
"MODEL "^(Structure.str (List.hd longest))
-
Modified: trunk/Toss/Learn/LearnGameTest.ml
===================================================================
--- trunk/Toss/Learn/LearnGameTest.ml 2012-01-19 03:06:07 UTC (rev 1646)
+++ trunk/Toss/Learn/LearnGameTest.ml 2012-01-20 02:32:20 UTC (rev 1647)
@@ -6,7 +6,7 @@
let struc_of_string ?(diag=false) s =
if diag then
let s = "MODEL " ^ s ^ " with Da (x, y) = ex u (R(x, u) and C(u, y));" ^
- " Db (x, y) = ex u (R(x, u) and C(y, u))" in
+ " Db (x, y) = ex u (C(x, u) and R(y, u))" in
match ArenaParser.parse_game_defs Lexer.lex (Lexing.from_string s) with
| Arena.StateStruc struc -> struc
| _ -> failwith "LearnGameTest:struc_of_string: not a structure"
Modified: trunk/Toss/Learn/Makefile
===================================================================
--- trunk/Toss/Learn/Makefile 2012-01-19 03:06:07 UTC (rev 1646)
+++ trunk/Toss/Learn/Makefile 2012-01-20 02:32:20 UTC (rev 1647)
@@ -21,15 +21,15 @@
%.learn:
make -C .. Learn/LearnGameTest.native
- ../LearnGameTest.native -f $(basename $@)
+ time ../LearnGameTest.native -f $(basename $@) > $(basename $@).toss
learntests:
make Tic-Tac-Toe001.learn
make Tic-Tac-Toe002.learn
- #make Breakthrough001.learn
+ make Breakthrough001.learn
make Gomoku001.learn
make Connect4001.learn
- make Pawn-Whopping001.learn
+ #make Pawn-Whopping001.learn
.PHONY: clean
Modified: trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg 2012-01-19 03:06:07 UTC (rev 1646)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg 2012-01-20 02:32:20 UTC (rev 1647)
@@ -9,11 +9,11 @@
... ... ... ...
... ... ... ...
... ... ... ...
- ... ... ... ...
+ ... W.. ... ...
... ... ... ...
-... ...W ... ...
+... ... ... ...
... ... ... ...
- ... ... ... ...
+ ... W.. ... ...
... ... ... ...
... ... ... ...
@@ -22,15 +22,15 @@
... ... ... ...
... ... ... ...
... ... ... ...
- ... ... ... ...
+ ... W.. ... ...
... ... ... ...
-... ...W ... ...
+... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
... ... ... ...
- ... ... ... ...
+ ... W.. ... ...
... ... ... ...
... ... ... ...
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_03.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_03.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_03.wrg 2012-01-20 02:32:20 UTC (rev 1647)
@@ -0,0 +1,36 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... B.. ... ...
+... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_04.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_04.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_04.wrg 2012-01-20 02:32:20 UTC (rev 1647)
@@ -0,0 +1,36 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_05.nwn
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_05.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_05.nwn 2012-01-20 02:32:20 UTC (rev 1647)
@@ -0,0 +1,53 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... W..
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_05.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_05.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_05.wrg 2012-01-20 02:32:20 UTC (rev 1647)
@@ -0,0 +1,36 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... W.. ...
+... ... ... ...
+... ... ... ..
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_06.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_06.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_06.wrg 2012-01-20 02:32:20 UTC (rev 1647)
@@ -0,0 +1,36 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...B ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+...B ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...W
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-19 03:06:16
|
Revision: 1646
http://toss.svn.sourceforge.net/toss/?rev=1646&view=rev
Author: lukaszkaiser
Date: 2012-01-19 03:06:07 +0000 (Thu, 19 Jan 2012)
Log Message:
-----------
More game learning.
Modified Paths:
--------------
trunk/Toss/Formula/FormulaParser.mly
trunk/Toss/Learn/Distinguish.ml
trunk/Toss/Learn/Distinguish.mli
trunk/Toss/Learn/LearnGame.ml
trunk/Toss/Learn/LearnGame.mli
trunk/Toss/Learn/LearnGameTest.ml
trunk/Toss/Learn/Makefile
trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.nwn
Added Paths:
-----------
trunk/Toss/Learn/examples/Connect4001_01.nwn
trunk/Toss/Learn/examples/Connect4001_01.wn0
trunk/Toss/Learn/examples/Connect4001_01.wn1
trunk/Toss/Learn/examples/Connect4001_01.wrg
trunk/Toss/Learn/examples/Connect4001_02.nwn
trunk/Toss/Learn/examples/Connect4001_02.wn0
trunk/Toss/Learn/examples/Connect4001_02.wn1
trunk/Toss/Learn/examples/Connect4001_02.wrg
trunk/Toss/Learn/examples/Connect4001_03.nwn
trunk/Toss/Learn/examples/Connect4001_03.wn0
trunk/Toss/Learn/examples/Connect4001_03.wn1
trunk/Toss/Learn/examples/Connect4001_03.wrg
trunk/Toss/Learn/examples/Connect4001_04.nwn
trunk/Toss/Learn/examples/Connect4001_04.wn0
trunk/Toss/Learn/examples/Connect4001_04.wn1
trunk/Toss/Learn/examples/Connect4001_04.wrg
trunk/Toss/Learn/examples/Connect4001_05.nwn
trunk/Toss/Learn/examples/Connect4001_06.nwn
trunk/Toss/Learn/examples/Connect4001_07.nwn
trunk/Toss/Learn/examples/Connect4001_08.nwn
trunk/Toss/Learn/examples/Connect4001_09.nwn
trunk/Toss/Learn/examples/Connect4001_10.nwn
trunk/Toss/Learn/examples/Connect4001_11.nwn
trunk/Toss/Learn/examples/Connect4001_12.nwn
trunk/Toss/Learn/examples/Connect4001_13.nwn
trunk/Toss/Learn/examples/Gomoku001_01.nwn
trunk/Toss/Learn/examples/Gomoku001_01.wn0
trunk/Toss/Learn/examples/Gomoku001_01.wn1
trunk/Toss/Learn/examples/Gomoku001_02.nwn
trunk/Toss/Learn/examples/Gomoku001_02.wn0
trunk/Toss/Learn/examples/Gomoku001_02.wn1
trunk/Toss/Learn/examples/Gomoku001_03.nwn
trunk/Toss/Learn/examples/Gomoku001_03.wn0
trunk/Toss/Learn/examples/Gomoku001_03.wn1
trunk/Toss/Learn/examples/Gomoku001_04.nwn
trunk/Toss/Learn/examples/Gomoku001_04.wn0
trunk/Toss/Learn/examples/Gomoku001_04.wn1
trunk/Toss/Learn/examples/Gomoku001_05.nwn
trunk/Toss/Learn/examples/Gomoku001_06.nwn
trunk/Toss/Learn/examples/Gomoku001_07.nwn
trunk/Toss/Learn/examples/Gomoku001_08.nwn
trunk/Toss/Learn/examples/Gomoku001_09.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_01.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn0
trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn1
trunk/Toss/Learn/examples/Pawn-Whopping001_01.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_02.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_02.wrg
trunk/Toss/Learn/examples/Pawn-Whopping001_03.nwn
trunk/Toss/Learn/examples/Pawn-Whopping001_04.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_07.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_08.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_09.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_10.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_11.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_12.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_13.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_14.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_15.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_16.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_17.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe002_01.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe002_01.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe002_01.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe002_02.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe002_02.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe002_02.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe002_03.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe002_03.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe002_03.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe002_04.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe002_04.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe002_04.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe002_05.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe002_05.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe002_05.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe002_06.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe002_06.wn1
Removed Paths:
-------------
trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn1
Modified: trunk/Toss/Formula/FormulaParser.mly
===================================================================
--- trunk/Toss/Formula/FormulaParser.mly 2012-01-18 02:45:45 UTC (rev 1645)
+++ trunk/Toss/Formula/FormulaParser.mly 2012-01-19 03:06:07 UTC (rev 1646)
@@ -96,6 +96,8 @@
| TC ID COMMA ID formula_expr { FormulaSubst.make_lfp_tc $2 $4 $5 }
| TC IN_MOD ID COMMA ID formula_expr { FormulaSubst.make_mso_tc $3 $5 $6 }
| TC INT ID COMMA ID formula_expr { FormulaSubst.make_fo_tc_conj $2 $3 $5 $6 }
+ | TC PLUS INT ID COMMA ID formula_expr
+ { FormulaSubst.make_fo_tc_disj ~reflexive:false $3 $4 $6 $7 }
| LFP ID OPEN fo_var_list CLOSE EQ formula_expr
{ let vs = Array.of_list $4 in if Array.length vs <> 1 then
raise (Parsing_error "Monadic LFP with not one variable")
Modified: trunk/Toss/Learn/Distinguish.ml
===================================================================
--- trunk/Toss/Learn/Distinguish.ml 2012-01-18 02:45:45 UTC (rev 1645)
+++ trunk/Toss/Learn/Distinguish.ml 2012-01-19 03:06:07 UTC (rev 1646)
@@ -225,6 +225,9 @@
| Some n -> Some (n, f) in
Aux.map_some max_n_chosen choices
+(* Number of steps and base formulas if distinguish returns a TC. *)
+let distinguish_result_tc = ref None
+
(* Find a upto-[n]-step transitive closures of two-variable [?positive] atomic
formulas that hold on all [pos_strucs] and on no [neg_strucs]. *)
let tc_atomic_distinguish ?(positive=false) ?(repeat_vars=true) pos neg n =
@@ -238,9 +241,16 @@
let cmp (n1, f1) (n2, f2) =
if n1 <> n2 then n1-n2 else Formula.compare f1 f2 in
let (k, phi) = List.hd (List.sort cmp l) in
- tc k phi in
- try Some (Or (List.rev_map (fun s -> choose (tcs s)) pos)) with
- Not_found -> None
+ let phi = Formula.flatten_sort phi in
+ match !distinguish_result_tc with
+ | None -> distinguish_result_tc := Some [(k, phi)]; tc k phi
+ | Some l -> distinguish_result_tc := Some ((k, phi) :: l); tc k phi in
+ try distinguish_result_tc := None;
+ let res = Some (Or (List.rev_map (fun s -> choose (tcs s)) pos)) in
+ match !distinguish_result_tc with
+ | None -> res
+ | Some l -> distinguish_result_tc := Some (Aux.unique_sorted l); res
+ with Not_found -> distinguish_result_tc := None; None
(* - Distinguishing Structure Sets - *)
Modified: trunk/Toss/Learn/Distinguish.mli
===================================================================
--- trunk/Toss/Learn/Distinguish.mli 2012-01-18 02:45:45 UTC (rev 1645)
+++ trunk/Toss/Learn/Distinguish.mli 2012-01-19 03:06:07 UTC (rev 1646)
@@ -68,7 +68,10 @@
Structure.structure list -> Structure.structure list -> int ->
Formula.formula option
+(** Number of steps and base formula if distinguish returns a TC. *)
+val distinguish_result_tc : (int * Formula.formula) list option ref
+
(** {2 Distinguishing Structure Sets} *)
(** Order on types that we use to select the minimal ones. *)
Modified: trunk/Toss/Learn/LearnGame.ml
===================================================================
--- trunk/Toss/Learn/LearnGame.ml 2012-01-18 02:45:45 UTC (rev 1645)
+++ trunk/Toss/Learn/LearnGame.ml 2012-01-19 03:06:07 UTC (rev 1646)
@@ -13,30 +13,40 @@
evens ~acc:[1] k
-let winFormula winningStates notWinningStates =
+let winFormula ?(nicetc=true) winningStates notWinningStates =
if !debug_level > 0 then
print_endline (
"Searching WIN:\n" ^
(String.concat "\n" (List.map Structure.str winningStates)) ^ "\nNOT\n"^
(String.concat "\n" (List.map Structure.str notWinningStates)));
- FormulaOps.tnf_fv (Distinguish.distinguish winningStates notWinningStates)
+ let res = Distinguish.distinguish winningStates notWinningStates in
+ let print_tc (i,f) = Printf.sprintf "(tc+ %i x0 x1 (%s))" i (Formula.str f) in
+ match !Distinguish.distinguish_result_tc with
+ | None | Some [(1, _)] -> Formula.str (FormulaOps.tnf_fv res)
+ | Some l -> if not nicetc then Formula.str (FormulaOps.tnf_fv res) else
+ "ex x0, x1 (\n " ^ (String.concat " or\n " (List.map print_tc l)) ^ " )"
+
let cleanStructure struc =
let funs = ref [] in
let append_fun f _ = funs := f :: !funs in
Structure.StringMap.iter append_fun (Structure.functions struc);
- let struc = StructureParser.parse_structure Lexer.lex (Lexing.from_string (Structure.str struc)) in
- Structure.replace_names (List.fold_left
- (fun x y ->
- Structure.clear_fun x y)
- struc !funs) Structure.StringMap.empty
- Structure.IntMap.empty
+ let struc = StructureParser.parse_structure Lexer.lex
+ (Lexing.from_string (Structure.str struc)) in (* elems now from 1 *)
+ let nofun_struc =
+ List.fold_left (fun x y -> Structure.clear_fun x y) struc !funs in
+ let bind_name (sm, im) i =
+ (Structure.StringMap.add ("e" ^ (string_of_int i)) i sm,
+ Structure.IntMap.add i ("e" ^ (string_of_int i)) im) in
+ let bind_names l = List.fold_left bind_name
+ (Structure.StringMap.empty, Structure.IntMap.empty) l in
+ let (sm,im)= bind_names (Aux.range ~from:1 ((Structure.nbr_elems struc)+1)) in
+ Structure.replace_names nofun_struc sm im
let move struct1 struct2 =
- let changed = (Aux.unique_sorted
- ( List.map fst
- (Structure.diff_elems struct1 struct2 )) ) in
+ let changed =
+ Aux.unique_sorted (List.map fst (Structure.diff_elems struct1 struct2)) in
let strucBefore =
fst (Structure.del_elems struct1
(Aux.list_diff
@@ -47,27 +57,46 @@
(Aux.list_diff
(Aux.unique_sorted (Structure.elements struct2))
changed )) in
- ((cleanStructure strucBefore) , (cleanStructure strucAfter))
-
+ (struct1,struct2, ((cleanStructure strucBefore), (cleanStructure strucAfter)))
+
let movesi i partylist =
- Aux.unique_sorted
- ~cmp: (fun (s1,s2) (t1,t2) ->
- let c = ( Structure.compare s1 t1) in
- if c != 0 then c
- else (Structure.compare s2 t2))
- (List.fold_left
+ (List.fold_left
(fun acc party ->
List.append acc
(List.fold_left
- (fun prev i ->
- if (i < ((List.length party)-1)) then
- let m = move (List.nth party i) (List.nth party (i+1)) in
- (List.append prev [m])
- else
- (List.append prev []))
- [] (evens ~acc:[i] (List.length party)) ) )
- [] partylist)
+ (fun prev i ->
+ if (i < ((List.length party)-1)) then
+ (move (List.nth party i) (List.nth party (i+1))) :: prev
+ else prev) [] (evens ~acc:[i] (List.length party)))
+ ) [] partylist)
+
+let movecmp (s1,s2) (t1,t2) =
+ let c = (Structure.compare s1 t1) in
+ if c != 0 then c else (Structure.compare s2 t2)
+
+let add_precond moves wrong m =
+ let mwrong = List.filter (fun (l, r, x) -> movecmp x m = 0) wrong in
+ if mwrong = [] then (m, Formula.And []) else
+ let mright = List.filter (fun (l, r, x) -> movecmp x m = 0) moves in
+ let mark (l, r, _) =
+ let chg = Aux.unique_sorted (List.map fst (Structure.diff_elems l r)) in
+ Structure.add_rels l "chg" (List.map (fun e -> [|e|]) chg) in
+ let (good, bad) = (List.map mark mright, List.map mark mwrong) in
+ if !debug_level > 0 then (
+ List.iter Structure.print good;
+ List.iter Structure.print bad;
+ print_endline "";
+ );
+ let pre = Distinguish.distinguish good bad in
+ if !debug_level > 0 then print_endline (Formula.str pre);
+ let elems = Aux.range ~from:1 ((Structure.nbr_elems (fst m)) + 1) in
+ let eqs = List.map (fun i -> "x = e" ^ (string_of_int i)) elems in
+ let let_part = "let chg(x) = " ^ (String.concat " or " eqs) ^ " in " in
+ let phi = FormulaParser.parse_formula Lexer.lex
+ (Lexing.from_string (let_part ^ (Formula.str pre))) in
+ (m, FormulaOps.tnf_fv phi)
+
let learnFromParties ~win0 ~win1 ~notwon ~wrong =
let win0f = winFormula
(List.map (fun x -> List.hd (List.rev x)) win0)
@@ -76,40 +105,53 @@
let win1f = winFormula
(List.map (fun x -> List.hd (List.rev x)) win1)
(List.flatten ((List.map (fun x-> List.tl (List.rev x))
- win1) @ win0 @ notwon)) in
+ win1) @ win0 @ notwon)) in
- let moves0 = movesi 0 (win0 @ win1 @ notwon) in
- let moves1 = movesi 1 (win0 @ win1 @ notwon) in
+ let fullMoves0 = movesi 0 (win0 @ win1 @ notwon) in
+ let fullMoves1 = movesi 1 (win0 @ win1 @ notwon) in
+ let wrongPairs =
+ Aux.map_some (fun play -> if List.length play < 2 then None else
+ let r = List.rev play in Some (List.hd (List.tl r), List.hd r)) wrong in
+ let wrongMoves = List.map (fun (l, r) -> move l r) wrongPairs in
+
+ let moves0 = Aux.unique_sorted ~cmp:movecmp (List.map Aux.trd3 fullMoves0) in
+ let moves1 = Aux.unique_sorted ~cmp:movecmp (List.map Aux.trd3 fullMoves1) in
+
+ let moves0 = List.map (add_precond fullMoves0 wrongMoves) moves0 in
+ let moves1 = List.map (add_precond fullMoves1 wrongMoves) moves1 in
+
let cmpll l1 l2 = (List.length l2) - (List.length l1) in
let longest = List.hd (List.sort cmpll (win0 @ win1 @ notwon)) in
+ let mvlst pre post l = String.concat "; " (List.map (
+ fun i -> pre ^ (string_of_int i) ^ post) (Aux.range (List.length l))) in
"PLAYERS 1, 2\n" ^
- "REL Win1() = "^ (Formula.sprint win0f) ^"\n"^
- "REL Win2() = "^ (Formula.sprint win1f) ^"\n"^
+ "REL Win1() = "^ win0f ^ "\n"^
+ "REL Win2() = "^ win1f ^ "\n"^
(fst (List.fold_left
- (fun (old, i) x ->
+ (fun (old, i) ((l, r), pre) ->
(old ^ "\n" ^ "RULE Mv1-" ^ (string_of_int i) ^ ": \n" ^
- (Structure.str (fst x)) ^ " -> " ^ (Structure.str (snd x)) ^ "\nemb "^
- (String.concat "," (List.map fst (Structure.rel_signature (fst x)) ))^
- "\npre not Win2()"), i+1)
+ (Structure.str l) ^ " -> " ^ (Structure.str r) ^ "\nemb " ^
+ (String.concat "," (List.map fst (Structure.rel_signature l))) ^
+ "\npre (" ^ (Formula.str pre) ^ ") and not Win2()"), i+1)
("", 0) moves0)) ^ "\n\n" ^
(fst (List.fold_left
- (fun (old, i) x ->
+ (fun (old, i) ((l, r), pre) ->
(old ^ "\n" ^ "RULE Mv2-" ^ (string_of_int i) ^ ": \n" ^
- (Structure.str (fst x)) ^ " -> " ^ (Structure.str (snd x)) ^ "\nemb "^
- (String.concat "," (List.map fst (Structure.rel_signature (fst x)) ))^
- "\npre not Win1()"), i+1)
+ (Structure.str l) ^ " -> " ^ (Structure.str r) ^ "\nemb "^
+ (String.concat "," (List.map fst (Structure.rel_signature l))) ^
+ "\npre (" ^ (Formula.str pre) ^ ") and not Win1()"), i+1)
("",0) moves1)) ^ "\n\n" ^
"LOC 0 {
PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
- MOVES [Mv1 -> 1]}
+ MOVES [" ^ (mvlst "Mv1-" " -> 1" moves0) ^ "]}
PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
}
LOC 1 {
PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
- MOVES [Mv2 -> 0] }
-}" ^"\n" ^
- "MODEL "^(Structure.str (List.hd longest))
+ MOVES [" ^ (mvlst "Mv2-" " -> 0" moves1) ^ "] }
+}" ^ "\n" ^
+ "MODEL "^(Structure.str (List.hd longest))
Modified: trunk/Toss/Learn/LearnGame.mli
===================================================================
--- trunk/Toss/Learn/LearnGame.mli 2012-01-18 02:45:45 UTC (rev 1645)
+++ trunk/Toss/Learn/LearnGame.mli 2012-01-19 03:06:07 UTC (rev 1646)
@@ -1,7 +1,5 @@
(** Module for learning games from examples. *)
-val move: Structure.structure -> Structure.structure ->
- Structure.structure * Structure.structure
(** Learn a two-player win-lose-or-tie game given 4 sets of plays of another
game [source]: [wins0] which are now supposed to be won by Player 0,
Modified: trunk/Toss/Learn/LearnGameTest.ml
===================================================================
--- trunk/Toss/Learn/LearnGameTest.ml 2012-01-18 02:45:45 UTC (rev 1645)
+++ trunk/Toss/Learn/LearnGameTest.ml 2012-01-19 03:06:07 UTC (rev 1646)
@@ -50,25 +50,25 @@
REL Win2() = ex x1 (Q(x1) and ex x0 R(x0, x1))
RULE Mv1-0:
-[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P (1); Q:1 {}; R:2 {} | ]
+[e1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [e1 | P (e1); Q:1 {}; R:2 {} | ]
emb R,Q,P
-pre not Win2()
+pre (true) and not Win2()
RULE Mv2-0:
-[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P:1 {}; Q (1); R:2 {} | ]
+[e1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [e1 | P:1 {}; Q (e1); R:2 {} | ]
emb R,Q,P
-pre not Win1()
+pre (true) and not Win1()
LOC 0 {
PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
- MOVES [Mv1 -> 1]}
+ MOVES [Mv1-0 -> 1]}
PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
}
LOC 1 {
PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
- MOVES [Mv2 -> 0] }
+ MOVES [Mv2-0 -> 0] }
}
MODEL [ | P:1 {}; Q:1 {} | ] R R \"
@@ -87,8 +87,10 @@
match bound with None-> Str.split r s | Some b-> Str.bounded_split r s b in
let cl = String.index s '\n' in
let pref, st_s = String.sub s 0 cl, String.sub s cl ((String.length s)-cl) in
- let s = List.filter (fun s -> s <> "") (split_list "\n\n" st_s) in
- List.map (fun s -> struc_of_string ~diag:true (pref ^ " \n\"" ^ s ^"\n\"")) s
+ let strucstr s = pref ^ " \n\"" ^ s ^ "\n\"" in
+ let getstruc s = let st = strucstr s in try struc_of_string ~diag:true st
+ with e -> print_endline st; raise e in
+ List.map getstruc (List.filter (fun s -> s <> "") (split_list "\n\n" st_s))
let main () =
Aux.set_optimized_gc ();
@@ -108,8 +110,9 @@
let tfiles = List.map (fun fn -> !dir ^ "/" ^ fn)
(List.sort compare (List.filter is_test (AuxIO.list_dir !dir))) in
let is_group g fn = String.sub fn ((String.length fn) - 4) 4 = "." ^ g in
- let strucs_of_files fs =
- List.map (fun fn -> get_strucs (AuxIO.input_fname fn)) fs in
+ let get_struc fn = try get_strucs (AuxIO.input_fname fn) with
+ err -> print_endline ("Error in " ^ fn); raise err in
+ let strucs_of_files fs = List.map get_struc fs in
let (win0, win1, notwon, wrong) =
(strucs_of_files (List.filter (is_group "wn0") tfiles),
strucs_of_files (List.filter (is_group "wn1") tfiles),
Modified: trunk/Toss/Learn/Makefile
===================================================================
--- trunk/Toss/Learn/Makefile 2012-01-18 02:45:45 UTC (rev 1645)
+++ trunk/Toss/Learn/Makefile 2012-01-19 03:06:07 UTC (rev 1646)
@@ -25,7 +25,11 @@
learntests:
make Tic-Tac-Toe001.learn
- make Breakthrough001.learn
+ make Tic-Tac-Toe002.learn
+ #make Breakthrough001.learn
+ make Gomoku001.learn
+ make Connect4001.learn
+ make Pawn-Whopping001.learn
.PHONY: clean
Added: trunk/Toss/Learn/examples/Connect4001_01.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_01.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_01.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,43 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ...Q ... ...
+
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+...P ...Q ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_01.wn0
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_01.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_01.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ Q..Q Q..Q ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_01.wn1
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_01.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_01.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ P..P P..P ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_01.wrg
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_01.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_01.wrg 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,29 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_02.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_02.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_02.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ...Q Q..Q ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_02.wn0
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_02.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_02.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_02.wn1
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_02.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_02.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...P ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...P ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_02.wrg
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_02.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_02.wrg 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,29 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_03.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_03.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_03.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_03.wn0
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_03.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_03.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... Q.. ...
+ ... ... ...
+ ... Q.. ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ Q.. ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_03.wn1
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_03.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_03.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... P.. ...
+ ... ... ...
+ ... P.. ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ P.. ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_03.wrg
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_03.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_03.wrg 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,41 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P..Q ... ...
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P..Q ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_04.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_04.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_04.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... Q.. ...
+ ... ... ...
+ ... Q.. ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_04.wn0
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_04.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_04.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ... Q.. ...
+... ... ... ...
+... ... Q.. ...
+ ... ... ...
+ ... ... Q..
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_04.wn1
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_04.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_04.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ... P.. ...
+... ... ... ...
+... ... P.. ...
+ ... ... ...
+ ... ... P..
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_04.wrg
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_04.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_04.wrg 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,41 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. Q.. ...
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. Q.. ...
+
Added: trunk/Toss/Learn/examples/Connect4001_05.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_05.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_05.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ... Q.. ...
+... ... ... ...
+... ... Q.. ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_06.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_06.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_06.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ...P P..P ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_07.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_07.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_07.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ...P ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...P ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_08.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_08.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_08.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... P.. ...
+ ... ... ...
+ ... P.. ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_09.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_09.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_09.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,15 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ... P.. ...
+... ... ... ...
+... ... P.. ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_10.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_10.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_10.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,29 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_11.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_11.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_11.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,29 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_12.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_12.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_12.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,41 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P..Q ... ...
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ...P ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P..Q ... ...
+
Added: trunk/Toss/Learn/examples/Connect4001_13.nwn
===================================================================
--- trunk/Toss/Learn/examples/Connect4001_13.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Connect4001_13.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,41 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. ... ...
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. Q.. ...
+
+ ... ... ...
+ ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ...
+ ...P ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ...
+ ...Q ... ...
+... ... ... ...
+... P.. Q.. ...
+
Added: trunk/Toss/Learn/examples/Gomoku001_01.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_01.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_01.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,70 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...Q ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...Q ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...P ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...Q Q.. ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...P ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Gomoku001_01.wn0
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_01.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_01.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+...Q Q..Q Q..Q ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_01.wn1
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_01.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_01.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+...P P..P P..P ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_02.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_02.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_02.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... Q..Q Q..Q ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_02.wn0
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_02.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_02.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ ...Q ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ ...Q ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_02.wn1
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_02.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_02.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ ...P ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ ...P ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_03.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_03.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_03.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ...Q ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ ...Q ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_03.wn0
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_03.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_03.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... Q.. ...
+... ... ... ...
+... ... Q.. ...
+ ... ... ... ...
+ ... Q.. ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ Q.. ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_03.wn1
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_03.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_03.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... P.. ...
+... ... ... ...
+... ... P.. ...
+ ... ... ... ...
+ ... P.. ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ P.. ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_04.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_04.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_04.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... Q.. ...
+... ... ... ...
+... ... Q.. ...
+ ... ... ... ...
+ ... Q.. ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_04.wn0
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_04.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_04.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ Q.. ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ ... Q.. ... ...
+... ... ... ...
+... ... Q.. ...
+ ... ... ... ...
+ ... ... Q.. ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_04.wn1
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_04.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_04.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ P.. ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ ... P.. ... ...
+... ... ... ...
+... ... P.. ...
+ ... ... ... ...
+ ... ... P.. ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_05.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_05.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_05.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ Q.. ... ... ...
+... ... ... ...
+... Q.. ... ...
+ ... ... ... ...
+ ... Q.. ... ...
+... ... ... ...
+... ... Q.. ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_06.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_06.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_06.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... P..P P..P ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_07.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_07.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_07.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ...P ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ ...P ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_08.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_08.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_08.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... P.. ...
+... ... ... ...
+... ... P.. ...
+ ... ... ... ...
+ ... P.. ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Gomoku001_09.nwn
===================================================================
--- trunk/Toss/Learn/examples/Gomoku001_09.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Gomoku001_09.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,18 @@
+[ | P:1 {}; Q:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... P.. ... ...
+ ... ... ... ...
+ ... P.. ... ...
+... ... ... ...
+... ... P.. ...
+ ... ... ... ...
+ ... ... P.. ...
+... ... ... ...
+... ... ... ...
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_01.nwn
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_01.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_01.nwn 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,199 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B B..B B..B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W..W W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B B..B B..B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ...W W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ...B B..B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... B.. ... ...
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ...W W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ...B B..B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... W.. ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ...W W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ... B..B B..B
+ ... ... ... ...
+ ... B.. ... ...
+... ... ... ...
+... W.. ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ...W W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ... B..B B..B
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ...W W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ... ...B B..B
+ ... ... ... ...
+ ... B.. ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ...W W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ... ...B B..B
+ ... ... ... ...
+ ... B.. ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ...W ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ... W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ... ...B ...B
+ ... ... ... ...
+ ... B.. ...B ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ...W ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ... W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ... ...B ...B
+ ... ... ... ...
+ ... B.. ...B ...
+... ... ... ...
+... ... W.. ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ... W..W W..
+... ... ... ...
+... ... ... ...
+
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B..B ... ...B ...B
+ ... ... ... ...
+ ... ... ...B ...
+... ... ... ...
+... ... B.. ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ... W..W W..
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn0
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn0 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,19 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+B.. ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ...W ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn1
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_01.wn1 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,19 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+B.. ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ...W ...
+... ... ... ...
+... ...B ... ...
+
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_01.wrg
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_01.wrg (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-Whopping001_01.wrg 2012-01-19 03:06:07 UTC (rev 1646)
@@ -0,0 +1,36 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+... ... ... ...
+
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ...W ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+
Added: trunk/Toss/Learn/examples/Pawn-Whopping001_02.nwn
===================================================================
--- trunk/Toss/Learn/examples/Pawn-Whopping001_02.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Pawn-W...
[truncated message content] |
|
From: <luk...@us...> - 2012-01-18 02:45:54
|
Revision: 1645
http://toss.svn.sourceforge.net/toss/?rev=1645&view=rev
Author: lukaszkaiser
Date: 2012-01-18 02:45:45 +0000 (Wed, 18 Jan 2012)
Log Message:
-----------
Redoing learn tests, plays in separate files, removing Picture.
Modified Paths:
--------------
trunk/Toss/Formula/AuxIO.ml
trunk/Toss/Formula/AuxIO.mli
trunk/Toss/Learn/LearnGame.ml
trunk/Toss/Learn/LearnGame.mli
trunk/Toss/Learn/LearnGameTest.ml
trunk/Toss/Learn/Makefile
trunk/Toss/Server/Makefile
trunk/Toss/Server/ReqHandler.ml
trunk/Toss/Server/Tests.ml
trunk/Toss/WebClient/Main.js
Added Paths:
-----------
trunk/Toss/Learn/examples/
trunk/Toss/Learn/examples/Breakthrough001_01.nwn
trunk/Toss/Learn/examples/Breakthrough001_01.wn0
trunk/Toss/Learn/examples/Breakthrough001_01.wn1
trunk/Toss/Learn/examples/Breakthrough001_02.nwn
trunk/Toss/Learn/examples/Breakthrough001_03.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.nwn
trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn1
trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn0
trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn1
Removed Paths:
-------------
trunk/Toss/Server/Picture.ml
trunk/Toss/Server/Picture.mli
trunk/Toss/Server/PictureTest.ml
trunk/Toss/Server/def_pics/
Modified: trunk/Toss/Formula/AuxIO.ml
===================================================================
--- trunk/Toss/Formula/AuxIO.ml 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Formula/AuxIO.ml 2012-01-18 02:45:45 UTC (rev 1645)
@@ -27,6 +27,11 @@
with End_of_file -> ());
Buffer.contents buf
+let input_fname fn =
+ let f = open_in fn in
+ let res = input_file f in
+ close_in f; res
+
let list_dir dirname =
let files, dir_handle = (ref [], Unix.opendir dirname) in
let rec add () = files := (Unix.readdir dir_handle) :: !files; add () in
Modified: trunk/Toss/Formula/AuxIO.mli
===================================================================
--- trunk/Toss/Formula/AuxIO.mli 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Formula/AuxIO.mli 2012-01-18 02:45:45 UTC (rev 1645)
@@ -12,6 +12,9 @@
(** Input a file to a string. *)
val input_file : in_channel -> string
+(** Input a file with given filename to a string. *)
+val input_fname : string -> string
+
(** List the contents of a directory *)
val list_dir : string -> string list
Modified: trunk/Toss/Learn/LearnGame.ml
===================================================================
--- trunk/Toss/Learn/LearnGame.ml 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Learn/LearnGame.ml 2012-01-18 02:45:45 UTC (rev 1645)
@@ -68,51 +68,48 @@
[] (evens ~acc:[i] (List.length party)) ) )
[] partylist)
-let learnFromParties ~win0 ~win1 ~tie ~wrong =
+let learnFromParties ~win0 ~win1 ~notwon ~wrong =
let win0f = winFormula
(List.map (fun x -> List.hd (List.rev x)) win0)
(List.flatten ((List.map (fun x-> List.tl (List.rev x))
- win0) @ win1 @ tie)) in
+ win0) @ win1 @ notwon)) in
let win1f = winFormula
(List.map (fun x -> List.hd (List.rev x)) win1)
(List.flatten ((List.map (fun x-> List.tl (List.rev x))
- win1) @ win0 @ tie)) in
+ win1) @ win0 @ notwon)) in
- let moves0 = movesi 0 (win0 @ win1) in
- let moves1 = movesi 1 (win0 @ win1) in
+ let moves0 = movesi 0 (win0 @ win1 @ notwon) in
+ let moves1 = movesi 1 (win0 @ win1 @ notwon) in
- "PLAYERS 1, 2\n"^
+ let cmpll l1 l2 = (List.length l2) - (List.length l1) in
+ let longest = List.hd (List.sort cmpll (win0 @ win1 @ notwon)) in
+
+ "PLAYERS 1, 2\n" ^
"REL Win1() = "^ (Formula.sprint win0f) ^"\n"^
"REL Win2() = "^ (Formula.sprint win1f) ^"\n"^
- "RULE Mv1: " ^
- (List.fold_left
- (fun old x->
- old ^ "\n"^
- (Structure.str (fst x))^" -> "^(Structure.str
- (snd x)) ^
- "\nemb "^(String.concat "," (List.map fst (Structure.rel_signature
- (fst x)) )) ^ " " ^
- "pre not Win2()" )
- "" moves0) ^"\n"^
- "RULE Mv2: " ^
- (List.fold_left
- (fun old x->
- old^"\n"^
- (Structure.str (fst x))^" -> "^(Structure.str
- (snd x)) ^
- "\nemb "^(String.concat "," (List.map fst (Structure.rel_signature
- (fst x)) )) ^ " " ^
- "pre not Win1()" )
- "" moves1) ^"\n"^
+ (fst (List.fold_left
+ (fun (old, i) x ->
+ (old ^ "\n" ^ "RULE Mv1-" ^ (string_of_int i) ^ ": \n" ^
+ (Structure.str (fst x)) ^ " -> " ^ (Structure.str (snd x)) ^ "\nemb "^
+ (String.concat "," (List.map fst (Structure.rel_signature (fst x)) ))^
+ "\npre not Win2()"), i+1)
+ ("", 0) moves0)) ^ "\n\n" ^
+ (fst (List.fold_left
+ (fun (old, i) x ->
+ (old ^ "\n" ^ "RULE Mv2-" ^ (string_of_int i) ^ ": \n" ^
+ (Structure.str (fst x)) ^ " -> " ^ (Structure.str (snd x)) ^ "\nemb "^
+ (String.concat "," (List.map fst (Structure.rel_signature (fst x)) ))^
+ "\npre not Win1()"), i+1)
+ ("",0) moves1)) ^ "\n\n" ^
"LOC 0 {
PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
MOVES [Mv1 -> 1]}
PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
}
-LOC 1{
+LOC 1 {
PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
MOVES [Mv2 -> 0] }
}" ^"\n" ^
- "MODEL "^(Structure.str (List.hd (List.hd win0)))
+ "MODEL "^(Structure.str (List.hd longest))
Modified: trunk/Toss/Learn/LearnGame.mli
===================================================================
--- trunk/Toss/Learn/LearnGame.mli 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Learn/LearnGame.mli 2012-01-18 02:45:45 UTC (rev 1645)
@@ -11,7 +11,7 @@
val learnFromParties:
win0: Structure.structure list list ->
win1: Structure.structure list list ->
- tie: Structure.structure list list ->
+ notwon: Structure.structure list list ->
wrong: Structure.structure list list -> string
Modified: trunk/Toss/Learn/LearnGameTest.ml
===================================================================
--- trunk/Toss/Learn/LearnGameTest.ml 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Learn/LearnGameTest.ml 2012-01-18 02:45:45 UTC (rev 1645)
@@ -48,18 +48,24 @@
"PLAYERS 1, 2
REL Win1() = ex x0 (Q(x0) and ex x1 R(x0, x1))
REL Win2() = ex x1 (Q(x1) and ex x0 R(x0, x1))
-RULE Mv1:
+
+RULE Mv1-0:
[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P (1); Q:1 {}; R:2 {} | ]
-emb R,Q,P pre not Win2()
-RULE Mv2:
+emb R,Q,P
+pre not Win2()
+
+
+RULE Mv2-0:
[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P:1 {}; Q (1); R:2 {} | ]
-emb R,Q,P pre not Win1()
+emb R,Q,P
+pre not Win1()
+
LOC 0 {
PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
MOVES [Mv1 -> 1]}
PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
}
-LOC 1{
+LOC 1 {
PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
MOVES [Mv2 -> 0] }
@@ -70,331 +76,46 @@
\"" in
assert_equal ~printer:(fun x -> x) res_game
((LearnGame.learnFromParties ~win0:partylist0 ~win1:partylist1
- ~tie:[] ~wrong:[]));
+ ~notwon:[] ~wrong:[]));
);
]
-let bigtests = "LearnGame" >::: [
- "tic-tac-toe" >::
- (fun () ->
- Distinguish.set_debug_level 0; (* set to 1 to get some info printed out *)
- let partylist0 = [
- List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-P . .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q .
-. . .
-P . .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q .
-. . .
-P P .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q Q
-. . .
-P P .
-. . .
-. . .
-. . .
-\"";
- ]; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q P .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q P .
-. . .
-Q . .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q P .
-. . .
-Q P .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q P .
-. . .
-Q P .
-. . .
-Q . .
-. . .
-\"";]; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-Q Q Q
-\"";]; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. Q .
-. . .
-. Q .
-. . .
-. Q .
-\"";]; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . Q
-. . .
-. Q .
-. . .
-Q . .
-\"";]
-] in
- let partylist1 = [
- List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-P . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q .
-. . .
-. . .
-P . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q .
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q Q
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . P
-. . .
-. Q Q
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q P
-. . .
-. Q Q
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q P
-. . .
-. Q Q
-. . .
-. . .
-P P P
-\"";
- ]; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-P . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q .
-. . .
-. . .
-P . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q .
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q Q
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q Q
-. . .
-. . .
-P P P
-\"";
- ]
- ; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-P P P
-\"";]
- ; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. P .
-. . .
-. P .
-. . .
-. P .
-\"";]
- ; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . P
-. . .
-. P .
-. . .
-P . .
-\"";]
-] in
-let tie = [
- List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. P .
-. . .
-. Q .
-. . .
-. P .
-\"";]
- ; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . Q
-. . .
-. P .
-. . .
-P . .
-\"";]
- ; List.map (struc_of_string ~diag:true) [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . P
-. . .
-. P .
-. . .
-Q . .
-\"";]
-] in
-assert_equal ~printer:(fun x -> x) ""
- ((LearnGame.learnFromParties ~win0:partylist0 ~win1:partylist1
- ~tie ~wrong:[]));
- );
+let get_strucs s =
+ let split_list ?(bound=None) pat s =
+ let r = Str.regexp_string pat in
+ match bound with None-> Str.split r s | Some b-> Str.bounded_split r s b in
+ let cl = String.index s '\n' in
+ let pref, st_s = String.sub s 0 cl, String.sub s cl ((String.length s)-cl) in
+ let s = List.filter (fun s -> s <> "") (split_list "\n\n" st_s) in
+ List.map (fun s -> struc_of_string ~diag:true (pref ^ " \n\"" ^ s ^"\n\"")) s
-]
+let main () =
+ Aux.set_optimized_gc ();
+ let (testname, dir) = (ref "", ref "examples") in
+ let dbg_level i = (LearnGame.set_debug_level i) in
+ let opts = [
+ ("-v", Arg.Unit (fun () -> dbg_level 1), "be verbose");
+ ("-d", Arg.Int (fun i -> dbg_level i), "set debug level");
+ ("-f", Arg.String (fun s -> testname := s), "process files");
+ ("-dir", Arg.String (fun s -> dir := s), "set files directory");
+ ] in
+ Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
+ if !testname <> "" then (
+ let tnlen = String.length !testname in
+ let is_test fn =
+ String.length fn > tnlen && String.sub fn 0 tnlen = !testname in
+ let tfiles = List.map (fun fn -> !dir ^ "/" ^ fn)
+ (List.sort compare (List.filter is_test (AuxIO.list_dir !dir))) in
+ let is_group g fn = String.sub fn ((String.length fn) - 4) 4 = "." ^ g in
+ let strucs_of_files fs =
+ List.map (fun fn -> get_strucs (AuxIO.input_fname fn)) fs in
+ let (win0, win1, notwon, wrong) =
+ (strucs_of_files (List.filter (is_group "wn0") tfiles),
+ strucs_of_files (List.filter (is_group "wn1") tfiles),
+ strucs_of_files (List.filter (is_group "nwn") tfiles),
+ strucs_of_files (List.filter (is_group "wrg") tfiles)) in
+ print_endline (LearnGame.learnFromParties ~win0 ~win1 ~notwon ~wrong)
+ ) else ignore (OUnit.run_test_tt ~verbose:true tests)
+
+let _ = AuxIO.run_if_target "LearnGameTest" main
Modified: trunk/Toss/Learn/Makefile
===================================================================
--- trunk/Toss/Learn/Makefile 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Learn/Makefile 2012-01-18 02:45:45 UTC (rev 1645)
@@ -12,11 +12,22 @@
DistinguishTest:
LearnGameTest:
-
tests:
make -C .. LearnTestsVerbose
+LearnGameTest.native:
+ make -C .. Learn/LearnGameTest.native
+
+%.learn:
+ make -C .. Learn/LearnGameTest.native
+ ../LearnGameTest.native -f $(basename $@)
+
+learntests:
+ make Tic-Tac-Toe001.learn
+ make Breakthrough001.learn
+
+
.PHONY: clean
clean:
Added: trunk/Toss/Learn/examples/Breakthrough001_01.nwn
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_01.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Breakthrough001_01.nwn 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,235 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B B..B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W..W W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B B..B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... W.. ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B ...B B..B
+ ... ... ... ...
+ ... ...B ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... W.. ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B ...B B..B
+ ... ... ... ...
+ ... ...B ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B ...B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ...B ...
+ ... ... ... ...
+ ... W.. ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B ...B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... W..B ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B ...B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... W.. ...
+ ... ... ... ...
+ ... ...B ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B ...B B..B
+ ... ... ... ...
+ ... ...W ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ...B ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..B ...B B..B
+ ... ... ... ...
+ ... ...W ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... B.. ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..W ...B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... B.. ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..W ...B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W B.. W..W W..
+... ... ... ...
+W..W W..W W..W W..W
+
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+B..B B..W ...B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W ...W W..W W..W
+
+
+ ... ... ... ...
+B B.. B..B B..B B..
+... ... ... ...
+B..B B..B ..B B..B
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W W.. W..W W..
+... ... ... ...
+W..W ...W W..W W..W
+
Added: trunk/Toss/Learn/examples/Breakthrough001_01.wn0
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_01.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Breakthrough001_01.wn0 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,18 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+B B.. W.. B..B B..
+... ... ... ...
+B..B ... ... B..B
+ ... ... ... ...
+ ...B ... ... ...
+... ... ... ...
+... ... B..B ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ... W..W W..
+... ... ... ...
+W..W ...W W..W W..W
Added: trunk/Toss/Learn/examples/Breakthrough001_01.wn1
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_01.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Breakthrough001_01.wn1 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,18 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+... B..B ... ...
+ ... ... ... ...
+W ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W ... W..W ... ...
+... ... ... ...
+W.. ... ... W..
+ ... ... ... ...
+ ... ... ... W..
+... ... ... ...
+... ... B.. ...W
Added: trunk/Toss/Learn/examples/Breakthrough001_02.nwn
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_02.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Breakthrough001_02.nwn 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,18 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+B B.. ... B..B B..
+... ... ... ...
+B..B ... ... B..B
+ ... ... ... ...
+ ...B ... ... ...
+... ... ... ...
+... ... B..B ...
+ ... ... ... ...
+ ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W W..W ... W..W W..
+... ... ... ...
+W..W ...W W..W W..W
Added: trunk/Toss/Learn/examples/Breakthrough001_03.nwn
===================================================================
--- trunk/Toss/Learn/examples/Breakthrough001_03.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Breakthrough001_03.nwn 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,18 @@
+[ | B:1 {}; W:1 {} | ]
+
+ ... ... ... ...
+B B..B B..B B..B B..
+... ... ... ...
+... B..B ... ...
+ ... ... ... ...
+W ... ... ... ...
+... ... ... ...
+... ... ... ...
+ ... ... ... ...
+W ... W..W ... ...
+... ... ... ...
+W.. ... ... W..
+ ... ... ... ...
+ ... ... ... W..
+... ... ... ...
+... ... ... ...W
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.nwn
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.nwn 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+P P Q
+. . .
+Q Q P
+. . .
+P Q Q
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn0
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn0 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,45 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q . .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q . .
+. . .
+P . .
+. . .
+. . .
+. . .
+
+Q Q .
+. . .
+P . .
+. . .
+. . .
+. . .
+
+Q Q .
+. . .
+P P .
+. . .
+. . .
+. . .
+
+
+Q Q Q
+. . .
+P P .
+. . .
+. . .
+. . .
+
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn1
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_01.wn1 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,64 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q . .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q . .
+. . .
+. . .
+. . .
+. . .
+P . .
+
+Q . .
+. . .
+. Q .
+. . .
+. . .
+P . .
+
+Q . .
+. . .
+. Q .
+. . .
+. . .
+P P .
+
+Q . .
+. . .
+. Q Q
+. . .
+. . .
+P P .
+
+Q . P
+. . .
+. Q Q
+. . .
+. . .
+P P .
+
+Q Q P
+. . .
+. Q Q
+. . .
+. . .
+P P .
+
+Q Q P
+. . .
+. Q Q
+. . .
+. . .
+P P P
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.nwn
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.nwn 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+Q P P
+. . .
+P Q Q
+. . .
+Q Q P
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn0
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn0 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,43 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q . .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q P .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q P .
+. . .
+Q . .
+. . .
+. . .
+. . .
+
+Q P .
+. . .
+Q P .
+. . .
+. . .
+. . .
+
+Q P .
+. . .
+Q P .
+. . .
+Q . .
+. . .
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn1
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_02.wn1 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,50 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q . .
+. . .
+. . .
+. . .
+. . .
+. . .
+
+Q . .
+. . .
+. . .
+. . .
+. . .
+P . .
+
+Q . .
+. . .
+. Q .
+. . .
+. . .
+P . .
+
+Q . .
+. . .
+. Q .
+. . .
+. . .
+P P .
+
+Q . .
+. . .
+. Q Q
+. . .
+. . .
+P P .
+
+Q . .
+. . .
+. Q Q
+. . .
+. . .
+P P P
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.nwn
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.nwn 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . .
+. . .
+. P .
+. . .
+P . P
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn0
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn0 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . .
+. . .
+. . .
+. . .
+Q Q Q
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn1
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_03.wn1 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . .
+. . .
+. . .
+. . .
+P P P
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.nwn
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.nwn 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+P . P
+. . .
+. P .
+. . .
+. . .
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn0
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn0 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,9 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. Q .
+. . .
+. Q .
+. . .
+. Q .
+
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn1
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_04.wn1 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. P .
+. . .
+. P .
+. . .
+. P .
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.nwn
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.nwn (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.nwn 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . P
+. . .
+. P .
+. . .
+. P .
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn0
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn0 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . Q
+. . .
+. Q .
+. . .
+Q . .
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn1
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_05.wn1 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+. . P
+. . .
+. P .
+. . .
+P . .
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn0
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn0 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn0 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+Q . .
+. . .
+. Q .
+. . .
+. . Q
Added: trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn1
===================================================================
--- trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn1 (rev 0)
+++ trunk/Toss/Learn/examples/Tic-Tac-Toe001_06.wn1 2012-01-18 02:45:45 UTC (rev 1645)
@@ -0,0 +1,8 @@
+[ | P:1 {}; Q:1 {} | ]
+
+. . .
+P . .
+. . .
+. P .
+. . .
+. . P
Modified: trunk/Toss/Server/Makefile
===================================================================
--- trunk/Toss/Server/Makefile 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Server/Makefile 2012-01-18 02:45:45 UTC (rev 1645)
@@ -3,7 +3,6 @@
%Test:
make -C .. Server/$@Verbose
-PictureTest:
ReqHandlerTest:
LearnGameTest:
Deleted: trunk/Toss/Server/Picture.ml
===================================================================
--- trunk/Toss/Server/Picture.ml 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Server/Picture.ml 2012-01-18 02:45:45 UTC (rev 1645)
@@ -1,410 +0,0 @@
-(* Processing Pictures to create Structures *)
-
-let debug_level = ref 0
-let set_debug_level i = (debug_level := i;)
-
-
-(* --------- Basic Picture Functions --------- *)
-
-type picture = (int * int * int) array array
-
-(* Read a picture from a scanning buffer. *)
-let read_pic buf =
- let (width, height) = Scanf.bscanf buf "P3 %d %d 255" (fun x y -> (x, y)) in
- let pic = Array.make_matrix width height (0, 0, 0) in
- for j = 0 to height-1 do
- for i = 0 to width-1 do
- pic.(i).(j) <- Scanf.bscanf buf " %d %d %d" (fun x y z -> (x, y, z))
- done
- done;
- pic
-
-(* Print a matrix to the formatter [f], use [elem_f] for elements. *)
-let fprint_matrix f elem_f start mid m =
- let (width, height) = (Array.length m, Array.length (m.(0))) in
- Format.fprintf f "%s %d %d %s\n%!" start width height mid;
- for j = 0 to height-1 do
- for i = 0 to width-1 do
- Format.fprintf f "%a" elem_f m.(i).(j);
- done;
- Format.fprintf f "\n%!";
- done
-
-(* Print a picture in the simple PPM format to a formatter. *)
-let fprint_pic f pic =
- let pr fmt (a, b, c) = Format.fprintf fmt " %d %d %d\n" a b c in
- fprint_matrix f pr "P3" "255" pic
-
-(* Print a picture in the simple PPM format to standard output. *)
-let print_pic pic = fprint_pic Format.std_formatter pic
-
-
-(* Flip a picture. *)
-let flip pic =
- let (width, height) = (Array.length pic, Array.length (pic.(0))) in
- let flpic = Array.make_matrix height width (0, 0, 0) in
- for i = 0 to width-1 do
- for j = 0 to height-1 do
- flpic.(j).(i) <- pic.(i).(j)
- done
- done;
- flpic
-
-
-(* Cut a picture to the given rectangle. *)
-let cut (x1, y1) (x2, y2) pic =
- let (orig_w, orig_h) = (Array.length pic, Array.length (pic.(0))) in
- let x2 = if x2 <= 0 then orig_w + x2 - 1 else x2 in
- let y2 = if y2 <= 0 then orig_h + y2 - 1 else y2 in
- if x2 < x1+1 || y2 < y1+1 || orig_w<x2+1 || orig_h<y2+1 || x1<0 || y1<0 then
- failwith (Printf.sprintf "cut: wrong dimensions %i %i %i %i" x1 x2 y1 y2);
- let cutpic = Array.make_matrix (x2-x1+1) (y2-y1+1) (0, 0, 0) in
- for i = 0 to x2-x1 do
- for j = 0 to y2-y1 do
- cutpic.(i).(j) <- pic.(i+x1).(j+y1)
- done
- done;
- cutpic
-
-
-(* Apply the filter function [f] to each pixel in a picture. *)
-let apply_filter f pic =
- let (width, height) = (Array.length pic, Array.length (pic.(0))) in
- let fpic = Array.make_matrix width height (0, 0, 0) in
- for i = 0 to width-1 do
- for j = 0 to height-1 do
- fpic.(i).(j) <- f i j width height pic
- done
- done;
- fpic
-
-
-(* ------------ Change Detection ------------ *)
-
-let diff_filter maxdiff (distx, disty) x y w h pic =
- let res = ref false in
- for i = -distx to distx do
- for j = -disty to disty do
- if x+i >= 0 && x+i < w && y+j >= 0 && y+j < h then
- let (r1, g1, b1) = pic.(x).(y) in
- let (r2, g2, b2) = pic.(x+i).(y+j) in
- let (rd, gd, bd) = maxdiff in
- if rd >= abs (r1-r2) && gd >= abs (g1-g2) && bd >= abs (b1-b2) then
- res := false
- else res := true
- done
- done;
- if !res then (255, 255, 255) else (0, 0, 0)
-
-(* Calculate color difference, accept maxdiff differences up to dist. *)
-let diff ?(maxdiff=(1,1,1)) ?(dist=(1,1)) =
- apply_filter (diff_filter maxdiff dist)
-
-
-(* ------------ Simple Segmentation ------------ *)
-
-let all_in_color cl ((x1, y1), (x2, y2)) pic =
- let (w, h) = (Array.length pic, Array.length (pic.(0))) in
- if x2 < x1 || y2 < y1 || w < x2+1 || h < y2+1 || x1 < 0 || y1 < 0 then
- failwith (Printf.sprintf "all_in_color: wrong dim %i %i %i %i" x1 y1 x2 y2);
- let res = ref true in
- for i = x1 to x2 do
- for j = y1 to y2 do
- if pic.(i).(j) <> cl then res := false
- done
- done;
- !res
-
-let rec next_x cl i j w h pic =
- if pic.(i).(j) = cl then (i, j) else
- if i+1 < w then next_x cl (i+1) j w h pic else raise Not_found
-
-let rec next_y cl i j w h pic =
- if pic.(i).(j) = cl then (i, j) else
- if j+1 < h then next_y cl i (j+1) w h pic else raise Not_found
-
-let next_color cl i j w h pic =
- try
- let (i1, _) = next_x cl i j w h pic in
- if i1+1 < w && pic.(i1+1).(j) = cl then (i1, j) else raise Not_found
- with Not_found ->
- let (_, j1) = next_y cl 0 (j+1) w h pic in
- if j1+1 < h && pic.(i).(j1+1) = cl then (0, j1) else raise Not_found
-
-(* Make a row-first column-next black-white tour of a picture. *)
-let bw_tour pic =
- let (width, height) = (Array.length pic, Array.length (pic.(0))) in
- let (i, j, newi, newj) = (ref 0, ref 0, ref 0, ref 0) in
- let (rects, intv) = (ref [], ref []) in
- try
- while true do
- intv := [];
- while !j = !newj do
- let (ni, nj) = next_color (0, 0, 0) !i !j width height pic in
- newi := ni;
- let (nni, nnj) = next_color (255, 255, 255) ni nj width height pic in
- if nnj = !j then intv := (ni, nni-1) :: !intv;
- i := nni; j := !newj; newj := nnj;
- done;
- if !intv != [] then intv := (!newi, width-1) :: !intv;
- rects := (List.map (fun v-> v, (!j,!newj-1)) !intv) @ !rects;
- j := !newj; i := 0
- done;
- failwith "bw_tour: unreachable"
- with Not_found ->
- if !intv != [] then intv := (!newi, width-1) :: !intv;
- rects := (List.map (fun v-> v, (!j,height-1)) !intv) @ !rects;
- List.rev_map (fun ((a, b), (c, d)) -> (a, c), (b, d)) !rects
-
-let rect_dist ((x1, y1), (x2, y2)) ((a1, b1), (a2, b2)) pic =
- let (w, h, d) = (min (x2-x1) (a2-a1), min (y2-y1) (b2-b1), ref 0) in
- for i = 0 to w-1 do
- for j = 0 to h-1 do
- let (x, y, z), (a, b, c) = pic.(x1+i).(y1+j), pic.(a1+i).(b1+j) in
- d := !d + (abs (x-a)) + (abs (y-b)) + (abs (z-c))
- done
- done;
- (float !d) /. (float (w*h))
-
-let rect_dist_offset (x, y) ((x1, y1), (x2, y2)) ((a1, b1), (a2, b2)) pic =
- rect_dist ((x1+x, y1+y), (x2+x, y2+y)) ((a1+x, b1+y), (a2+x, b2+y)) pic
-
-(* Very basic picture segmentation, should work for grids. *)
-let segment offset threshold pic =
- let df = diff (cut (offset, offset) (-offset, -offset) pic) in
- let rects = bw_tour df in
- let assign_name (dict, i, bi) rect =
- let (a, b), (c, d) = rect in
- try
- let (r, n) =
- List.find (fun (r,_) ->
- rect_dist_offset (offset, offset) r rect pic < threshold) dict in
- if !debug_level > 0 then
- Printf.printf " (%i, %i) - (%i, %i) %s found \n%!" a b c d n;
- ((rect, n) :: dict, i, bi)
- with Not_found ->
- if all_in_color (0, 0, 0) rect df then (
- let n = Printf.sprintf "B%i" bi in
- if !debug_level > 0 then
- Printf.printf " (%i, %i) - (%i, %i) %s assigned \n%!" a b c d n;
- ((rect, n) :: dict, i, bi+1)
- ) else (
- let n = Printf.sprintf "P%i" i in
- if !debug_level > 0 then
- Printf.printf " (%i, %i) - (%i, %i) %s assigned \n%!" a b c d n;
- ((rect, n) :: dict, i+1, bi)
- ) in
- let (res, _, _) = List.fold_left assign_name ([], 1, 0) rects in
- List.rev res
-
-
-(* ------------- Structure from Segmented Data ------------ *)
-
-(* Create a structure from segmented data. *)
-let make_struc dict =
- let (prev_ys, prev_xs, maxdx, maxdy) =
- (ref (0, 0), ref (0, 0), ref 0, ref 0) in
- let add_el (struc, i, j) (((x1, y1), (x2, y2)), pred) =
- let (ni, nj) =
- if (y1, y2) = !prev_ys then (
- maxdx := max !maxdx (abs ((fst !prev_xs) - x1));
- prev_xs := (x1, x2);
- (i+1, j)
- ) else (
- maxdy := max !maxdy (abs ((fst !prev_ys) - y1));
- prev_xs := (x1, x2);
- prev_ys := (y1, y2);
- (1, j+1)
- ) in
- let name = try Structure.board_coords_name (ni, nj) with Not_found ->
- Printf.sprintf "e%i,%i" ni nj in
- let (s1, elem) = Structure.add_new_elem struc ~name () in
- let s2 = Structure.add_fun s1 "x" (elem, float (x1+x2) /. 2.) in
- let s3 = Structure.add_fun s2 "y" (elem, float (y1+y2) /. (2.)) in
- let s4 = Structure.add_fun s3 "x1" (elem, float x1) in
- let s5 = Structure.add_fun s4 "y1" (elem, float y1) in
- let s6 = Structure.add_fun s5 "x2" (elem, float x2) in
- let s7 = Structure.add_fun s6 "y2" (elem, float y2) in
- let s8 = Structure.add_fun s7 "vx" (elem, 0.) in
- let new_s = Structure.add_fun s8 "vy" (elem, 0.) in
- if pred = "B0" then (new_s, ni, nj) else
- (Structure.add_rel new_s pred [|elem|], ni, nj) in
- let (s, _, _) =
- List.fold_left add_el (Structure.empty_structure (), 1, 0) dict in
- (s, !maxdx, !maxdy)
-
-
-(* Minimal type of elements in a structure which is part-positive. *)
-let postp s rels els =
- let app_rel_phi (st, fos, vs, i) e =
- let r, v = "Elem" ^ (string_of_int i), Structure.elem_name st e in
- (Structure.add_rel st r [|e|],
- Formula.Rel (r, [|Formula.fo_var_of_string v|]) :: fos, v :: vs, i+1) in
- let (struc, els_phis, vars, _) = List.fold_left app_rel_phi (s,[],[],0) els in
- let neg_true = function Formula.Not _ -> Formula.And [] | x -> x in
- let pos phi =
- Formula.flatten (FormulaMap.map_to_literals neg_true (fun x->x) phi) in
- let pos_ok phi = let psi = pos phi in if psi = Formula.And [] then false else
- Solver.M.check struc (Formula.And (psi :: els_phis)) in
- let ts = List.map pos (FormulaOps.mintp pos_ok rels vars) in
- let tfvs = List.map (fun f-> (f,List.length (FormulaSubst.free_vars f))) ts in
- let maxfv = List.fold_left (fun m (_, x) -> max m x) 0 tfvs in
- List.map fst (List.filter (fun (f, x) -> x = maxfv) tfvs)
-
-let tp_rule drels (left, right, delems) =
- let not_drel (r,_) = not (List.mem r drels) in
- let crels = List.filter not_drel (Structure.rel_signature left) in
- if !debug_level > 0 then Printf.printf "CRels %i\n%!" (List.length crels);
- let tp = postp left crels delems in
- if !debug_level > -1 then
- Format.eprintf "@[%a@]@ \n%!" Formula.fprint (Formula.And tp);
- let cut s = List.fold_left Structure.del_elem s
- (List.filter (fun e -> not (List.mem e delems)) (Structure.elements s)) in
- (cut left, cut right, tp)
-
-let geom_rule drels (left, right, delems) =
- let get_dim s e = (Structure.fun_val s "x" e, Structure.fun_val s "y" e) in
- let rect s els =
- let upd_rect (x1, y1, x2, y2) e =
- let (x, y) = get_dim s e in (min x1 x, min y1 y, max x2 x, max y2 y) in
- let (x, y) = get_dim s (List.hd els) in
- List.fold_left upd_rect (x, y, x, y) (List.tl els) in
- let in_rect s (x1, y1, x2, y2) e =
- let (x, y) = get_dim s e in (x1 < x && x < x2 && y1 < y && y < y2) in
- let (x1, y1, x2, y2) = rect left delems in
- let r = (x1 -. 0.5, y1 -. 0.5, x2 +. 0.5, y2 +. 0.5) in
- let els = List.filter (in_rect left r) (Structure.elements left) in
- let new_els = List.filter (fun e -> not (List.mem e delems)) els in
- if !debug_level > 0 then
- Format.printf "%s\n%!" (String.concat ", " (List.map string_of_int els));
- let cut s = List.fold_left Structure.del_elem s
- (List.filter (fun e -> not (List.mem e els)) (Structure.elements s)) in
- let is_unary r = List.assoc r (Structure.rel_signature left) = 1 in
- let un_drels = Aux.unique_sorted (List.filter is_unary drels) in
- let delopt s r = Structure.del_rels s r (List.map (fun e -> [|e|]) new_els) in
- let delopts s = List.fold_left delopt s un_drels in
- (delopts (cut left), delopts (cut right), delems)
-
-let addopts drels (left, right, delems) =
- let is_unary r = List.assoc r (Structure.rel_signature left) = 1 in
- let un_drels = Aux.unique_sorted (List.filter is_unary drels) in
- let un_opt_drels = List.map (fun r -> "_opt_" ^ r) un_drels in
- let els = Structure.elements left in
- let new_els = List.filter (fun e -> not (List.mem e delems)) els in
- let addopt s r = Structure.add_rels s r (List.map (fun e -> [|e|]) new_els) in
- let addoptrels s = List.fold_left addopt s un_opt_drels in
- (addoptrels left, addoptrels right, [])
-
-let print_rule emb (name, (l, r, pre_l)) =
- let emb_s = String.concat ", " (Aux.unique_sorted emb) in
- let pre_s = Formula.sprint (Formula.And pre_l) in
- let sprints () s = Structure.sprint s in
- Format.sprintf "RULE %s:@ @[<2>%a@]@ ->@ @[<2>%a@]@ emb %s pre %s"
- name sprints l sprints r emb_s pre_s
-
-let formula_of_string s =
- FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
-
-let read_strucs rels offset threshold gname suffix =
- let get_struc fn =
- let pic = read_pic (Scanf.Scanning.from_file fn) in
- let (struc, dx, dy) = make_struc (segment offset threshold pic) in
- let formula_r = formula_of_string (Printf.sprintf (
- ":y(a) = :y(b) and :x(a) < :x(b) and :x(b) < :x(a) + %i.8") dx) in
- let formula_c = formula_of_string (Printf.sprintf (
- ":x(a) = :x(b) and :y(b) < :y(a) and :y(a) < :y(b) + %i.8") dy) in
- let row, col = ("R", ["a"; "b"], formula_r), ("C", ["a"; "b"], formula_c) in
- Arena.add_def_rels struc (row :: col :: rels) in
- let name i = Printf.sprintf "%s%s%02i.ppm" gname suffix i in
- let (strucs, i) = (ref [], ref 0) in
- while Sys.file_exists (name !i) do
- strucs := get_struc (name !i) :: !strucs; incr i;
- done;
- List.rev !strucs
-
-let make_cond drels (right, wrong, delem_rels) =
- let sg = Structure.rel_signature right in
- let is_unary r = List.assoc r sg = 1 in
- let name e = Structure.elem_name right e in
- let mk_atom e r = Formula.Rel (r, [|Formula.fo_var_of_string (name e)|]) in
- let preds (e, rels) =
- Formula.And (List.map (mk_atom e) (List.filter is_unary rels)) in
- let ex_var (e, _) = Formula.var_of_string (name e) in
- let ex_vars = List.map ex_var delem_rels in
- let basic = Formula.flatten (Formula.And (
- (List.fold_left (fun l x -> (preds x) :: l) [] delem_rels))) in
- if not (Solver.M.check wrong basic) then Formula.Ex (ex_vars, basic) else (
- let app_s s =
- let app_rel_phi (st, arels, fos, vs, i) (e, _) =
- let r, v = "Elem" ^ (string_of_int i), Structure.elem_name st e in
- (Structure.add_rel st r [|e|], (r, 1) :: arels,
- Formula.Rel (r, [|Formula.fo_var_of_string v|]) :: fos, v::vs, i+1) in
- List.fold_left app_rel_phi (s, [], [], [], 0) delem_rels in
- let (right_el, arels, afos, vars, _) = app_s right in
- let (wrong_el, _, _, _, _) = app_s wrong in
- let csg = List.filter (fun (r,_) -> not (List.mem r drels)) sg in
- let ok phi_in =
- let phi = Formula.And [phi_in; basic] in
- let psi = Formula.And (phi :: afos) in
- Solver.M.check right_el psi && not (Solver.M.check wrong_el phi) in
- let w = FormulaOps.mintp ok csg vars in
- let minimize phi =
- let atoms = FormulaMap.get_atoms phi in
- let subst_atom a b x = if x = a then b else x in
- let phi0 f a = FormulaMap.map_to_atoms (subst_atom a (Formula.Or[])) f in
- let phi1 f a = FormulaMap.map_to_atoms (subst_atom a (Formula.And[])) f in
- let mini f a =
- let (f0, f1) = (phi0 f a, phi1 f a) in
- Formula.flatten (if ok f0 then f0 else if ok f1 then f1 else f) in
- List.fold_left mini phi atoms in
- let mw = List.map minimize w in
- if !debug_level > -1 then
- Format.eprintf "@[%a@]@ \n%!" Formula.fprint (Formula.And (basic :: mw));
- if !debug_level > -1 then
- Format.eprintf "@[%a@]@ \n%!" Formula.fprint
- (Aux.unsome (Distinguish.distinguish_upto ~qr:1 ~k:2 [right] [wrong]));
- Formula.flatten (Formula.Ex (ex_vars, Formula.And (basic :: mw)))
- )
-
-(* Make a game from sequence of pictures. *)
-let make_game ?(rels=[]) ?(offset=2) ?(threshold=70.) ?(types=false) fname =
- let flen = String.length fname in
- let gname = if (flen > 6 && fname.[flen-4] = '.') then
- String.sub fname 0 (flen - 6) else fname in
- let seq = read_strucs rels offset threshold gname "" in
- let win1s = Array.of_list (read_strucs rels offset threshold gname "Win1") in
- let win2s = Array.of_list (read_strucs rels offset threshold gname "Win2") in
- if seq = [] then failwith "Empty picture sequence for game play.";
- if !debug_level > 0 then Printf.printf "Read %i move pics, %i+%i win.\n%!"
- (List.length seq) (Array.length win1s) (Array.length win2s);
- let diff_struc (s, drels, prev) cur =
- let dels, drels_l = List.split (Structure.diff_elems prev cur) in
- ((prev, cur, dels) :: s, (List.concat drels_l) @ drels, cur) in
- if !debug_level > 0 then Printf.printf "Diffstrucs computed.\n%!";
- let (s, dr,_) = List.fold_left diff_struc ([],[],List.hd seq) (List.tl seq) in
- let rules_geom = List.rev_map (geom_rule dr) s in
- let rules = if not types then List.map (addopts dr) rules_geom else
- List.map (tp_rule dr) rules_geom in
- let wi i =
- formula_of_string (if i mod 2 = 0 then "not Win2()" else "not Win1()") in
- let add_win i (l, r, pre) = (Printf.sprintf "Mv%i" i, (l, r, (wi i)::pre)) in
- let wrs = Array.mapi (fun i r -> add_win i r) (Array.of_list rules) in
- let emb = List.map fst (Structure.rel_signature (List.hd seq)) @ dr in
- let rs = String.concat "\n" (List.map (print_rule emb) (Array.to_list wrs)) in
- let allms = Array.to_list (Array.mapi (fun i _ -> i) (Array.of_list rules)) in
- let (mvi1, mvi2) = List.partition (fun i -> i mod 2 = 0) allms in
- let make_mv loc i = Printf.sprintf "[Mv%i -> %s]" i loc in
- let mvs1 = String.concat "; " (List.map (make_mv "1") mvi1) in
- let mvs2 = String.concat "; " (List.map (make_mv "0") mvi2) in
- let pay1 = "PAYOFF :(Win1()) - :(Win2())" in
- let pay2 = "PAYOFF :(Win2()) - :(Win1())" in
- let loc0 = Printf.sprintf "LOC 0 {\n PLAYER 1 { %s }\n PLAYER 2 { %s }\n}"
- (pay1 ^ "\n MOVES " ^ mvs1 ^ "\n") pay2 in
- let loc1 = Printf.sprintf "LOC 1 {\n PLAYER 1 { %s }\n PLAYER 2 { %s }\n}"
- pay1 (pay2 ^ "\n MOVES " ^ mvs2 ^ "\n") in
- let model_s = Structure.sprint (List.hd seq) in
- let dws a i = (a.(2*i+1), a.(2*i), Structure.diff_elems a.(2*i+1) a.(2*i)) in
- let (win1, win2) = (make_cond dr (dws win1s 0), make_cond dr (dws win2s 0)) in
- let beg = Printf.sprintf "PLAYERS 1, 2\nREL Win1() = %s\nREL Win2() = %s"
- (Formula.sprint win1) (Formula.sprint win2) in
- Printf.sprintf "%s\n%s\n%s\n%s\nMODEL\n%s\n" beg rs loc0 loc1 model_s
Deleted: trunk/Toss/Server/Picture.mli
===================================================================
--- trunk/Toss/Server/Picture.mli 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Server/Picture.mli 2012-01-18 02:45:45 UTC (rev 1645)
@@ -1,54 +0,0 @@
-(** Processing pictures to create structures *)
-
-(** {2 Debugging} *)
-
-val set_debug_level : int -> unit
-
-
-(** {2 Basic Picture Functions} *)
-
-type picture = (int * int * int) array array
-
-
-(** Read a picture from a scanning buffer. *)
-val read_pic : Scanf.Scanning.scanbuf -> picture
-
-(** Print a picture in the simple PPM format to a formatter. *)
-val fprint_pic : Format.formatter -> picture -> unit
-
-(** Print a picture in the simple PPM format to standard output. *)
-val print_pic : picture -> unit
-
-(** Flip a picture. *)
-val flip : picture -> picture
-
-(** Cut a picture to the given rectangle. *)
-val cut : int * int -> int * int -> picture -> picture
-
-(** Apply the filter function [f] to each pixel in a picture. *)
-val apply_filter : (int -> int -> int -> int -> picture -> int * int * int) ->
- picture -> picture
-
-
-(** {2 Change Detection} *)
-
-(** Calculate color difference, accept maxdiff differences up to dist. *)
-val diff : ?maxdiff: int * int * int -> ?dist: int * int -> picture -> picture
-
-
-(** {2 Simple Segmentation} *)
-
-(** Very basic picture segmentation, should work for grids. *)
-val segment : int -> float -> picture ->
- (((int * int) * (int * int)) * string) list
-
-
-(** {2 Structure from Segmented Data} *)
-
-(** Create a structure from segmented data. *)
-val make_struc : (((int * int) * (int * int)) * string) list ->
- Structure.structure * int * int
-
-(** Create a game from sequence of images. *)
-val make_game : ?rels : (string * string list * Formula.formula) list ->
- ?offset : int -> ?threshold : float -> ?types : bool -> string -> string
Deleted: trunk/Toss/Server/PictureTest.ml
===================================================================
--- trunk/Toss/Server/PictureTest.ml 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Server/PictureTest.ml 2012-01-18 02:45:45 UTC (rev 1645)
@@ -1,51 +0,0 @@
-open OUnit
-
-Picture.set_debug_level 0
-
-let tests = "Picture" >::: [
- "segmentation size for breakthrough" >::
- (fun () ->
- let fname = "./www/img/Breakthrough.ppm" in
- let pic = Picture.read_pic (Scanf.Scanning.from_file fname) in
- let seg = Picture.segment 2 70. pic in
- assert_equal ~printer:string_of_int 64 (List.length seg)
- );
-
- "breakthrough structure P1 size" >::
- (fun () ->
- let fname = "./www/img/Breakthrough.ppm" in
- let pic = Picture.read_pic (Scanf.Scanning.from_file fname) in
- let seg = Picture.segment 2 70. pic in
- let (struc, _, _) = Picture.make_struc seg in
- assert_equal ~printer:string_of_int 16 (Structure.rel_size struc "P1")
- );
-]
-
-
-let main () =
- Aux.set_optimized_gc ();
- let (file, game, use_types) = (ref "", ref "", ref false) in
- let dbg_level i = (Picture.set_debug_level i) in
- let opts = [
- ("-v", Arg.Unit (fun () -> dbg_level 1), "be verbose");
- ("-d", Arg.Int (fun i -> dbg_level i), "set debug level");
- ("-f", Arg.String (fun s -> file := s), "process file");
- ("-g", Arg.String (fun s -> game := s), "process files for a game");
- ("-tp", Arg.Unit (fun () -> use_types := true), "use formulas in rules");
- ] in
- Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
- if !file <> "" then (
- let pic = Picture.read_pic (Scanf.Scanning.from_file !file) in
- let (struc, dx, dy) = Picture.make_struc (Picture.segment 2 70. pic) in
- let formula_r = Printf.sprintf
- ":y(a) = :y(b) and :x(a) < :x(b) and :x(b) < :x(a) + %i.8" dx in
- let formula_c = Printf.sprintf
- ":x(a) = :x(b) and :y(b) < :y(a) and :y(a) < :y(b) + %i.8" dy in
- Printf.printf "MODEL \n %s \n with \n R(a, b) = %s;\n C(a, b) = %s\n\n%!"
- (Structure.sprint struc) formula_r formula_c;
- ) else if !game <> "" then (
- print_endline (Picture.make_game ~types:!use_types !game)
- ) else ignore (OUnit.run_test_tt ~verbose:true tests)
-
-
-let _ = AuxIO.run_if_target "PictureTest" main
Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Server/ReqHandler.ml 2012-01-18 02:45:45 UTC (rev 1645)
@@ -688,7 +688,7 @@
let plays_int = List.map (fun (a, b) -> (int_of_string a, b)) plays in
let (w0, other) = List.partition (fun (_, b) -> b = "0") plays_int in
let (w1, other) = List.partition (fun (_, b) -> b = "1") other in
- let (tie, other) = List.partition (fun (_, b) -> b = "2") other in
+ let (notwon, other) = List.partition (fun (_, b) -> b = "2") other in
let (wrong, _) = List.partition (fun (_, b) -> b = "3") other in
(* Get the play with given id from DB - as a sequence of structures. *)
let playFromDB pid =
@@ -702,24 +702,24 @@
game [source]: [wins0] which are now supposed to be won by Player 0,
[wins1] - now won by Player 1, [tie] - now a tie, and [wrong] which
are not correct plays of the newly constructed game. *)
- let learnFromDB source wins0 wins1 tie wrong =
+ let learnFromDB source wins0 wins1 nw wrong =
if !debug_level > 0 then (
let pl l = String.concat ", " (List.map string_of_int l) in
print_endline ("Learning from "^ source ^" w0: "^ (pl wins0) ^" w1: "^
- (pl wins1)^" tie: "^(pl tie) ^" wrong: "^ (pl wrong));
+ (pl wins1)^" notwon: "^(pl nw)^" wrong: "^(pl wrong));
);
- let (wins0, wins1, tie, wrong) =
+ let (wins0, wins1, notwon, wrong) =
(List.map playFromDB wins0, List.map playFromDB wins1,
- List.map playFromDB tie, List.map playFromDB wrong) in
+ List.map playFromDB nw, List.map playFromDB wrong) in
let struc_of_string s =
StructureParser.parse_structure Lexer.lex (Lexing.from_string s) in
LearnGame.learnFromParties
~win0:(List.map (List.map struc_of_string) wins0)
~win1:(List.map (List.map struc_of_string) wins1)
- ~tie:(List.map (List.map struc_of_string) tie)
+ ~notwon:(List.map (List.map struc_of_string) notwon)
~wrong:(List.map (List.map struc_of_string) wrong) in
learnFromDB game (List.map fst w0) (List.map fst w1)
- (List.map fst tie) (List.map fst wrong) in
+ (List.map fst notwon) (List.map fst wrong) in
let (tcmd, data) = split_two "#" msg in
let resp, new_cookies = match tcmd with
| "USERNAME" ->
Modified: trunk/Toss/Server/Tests.ml
===================================================================
--- trunk/Toss/Server/Tests.ml 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/Server/Tests.ml 2012-01-18 02:45:45 UTC (rev 1645)
@@ -42,11 +42,10 @@
let learn_tests = "Learn", [
"DistinguishTest", [DistinguishTest.tests; DistinguishTest.bigtests];
- "LearnGameTest", [LearnGameTest.tests; LearnGameTest.bigtests];
+ "LearnGameTest", [LearnGameTest.tests];
]
let server_tests = "Server", [
- "PictureTest", [PictureTest.tests];
"ReqHandlerTest", [ReqHandlerTest.tests];
]
Modified: trunk/Toss/WebClient/Main.js
===================================================================
--- trunk/Toss/WebClient/Main.js 2012-01-17 23:33:40 UTC (rev 1644)
+++ trunk/Toss/WebClient/Main.js 2012-01-18 02:45:45 UTC (rev 1645)
@@ -249,7 +249,7 @@
'<option class="play_select_opt" value="-1">skip</option>' +
'<option class="play_select_opt" value="0">wins0</option>' +
'<option class="play_select_opt" value="1">wins1</option>' +
- '<option class="play_select_opt" value="2">tie</option>' +
+ '<option class="play_select_opt" value="2">notwon</option>' +
'<option class="play_select_opt" value="3">wrong</option></select>';
} else {
li.innerHTML = bs;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-17 23:33:46
|
Revision: 1644
http://toss.svn.sourceforge.net/toss/?rev=1644&view=rev
Author: lukstafi
Date: 2012-01-17 23:33:40 +0000 (Tue, 17 Jan 2012)
Log Message:
-----------
Minor revert.
Modified Paths:
--------------
trunk/Toss/Solver/Solver.ml
Modified: trunk/Toss/Solver/Solver.ml
===================================================================
--- trunk/Toss/Solver/Solver.ml 2012-01-17 22:23:28 UTC (rev 1643)
+++ trunk/Toss/Solver/Solver.ml 2012-01-17 23:33:40 UTC (rev 1644)
@@ -265,14 +265,10 @@
| [] ->
let poly = poly_of assgn p in
if check then
- (IFDEF NOREALQE
- THEN failwith "Solver.ml: RealQuantElim is not enabled"
- ELSE
- ( if not (RealQuantElim.sat [(poly, sgn)]) then Empty else
- if RealQuantElim.sat [(poly, SignTable.neg_sign_op sgn)] then
- Real [[(poly, sgn)]]
- else Any)
- ENDIF)
+ if not (RealQuantElim.sat [(poly, sgn)]) then Empty else
+ if RealQuantElim.sat [(poly, SignTable.neg_sign_op sgn)] then
+ Real [[(poly, sgn)]]
+ else Any
else Real [[(poly, sgn)]]
| v :: vs ->
let append_elem_asg acc e =
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-17 22:23:35
|
Revision: 1643
http://toss.svn.sourceforge.net/toss/?rev=1643&view=rev
Author: lukstafi
Date: 2012-01-17 22:23:28 +0000 (Tue, 17 Jan 2012)
Log Message:
-----------
js_of_ocaml-friendly changes: pa_macro-based conditional compilation of RealQuantElim and Unix references.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/Formula/FormulaParser.mly
trunk/Toss/Formula/Lexer.mll
trunk/Toss/Formula/Tokens.mly
trunk/Toss/Makefile
trunk/Toss/Solver/Solver.ml
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2012-01-17 02:25:49 UTC (rev 1642)
+++ trunk/Toss/Formula/Aux.ml 2012-01-17 22:23:28 UTC (rev 1643)
@@ -1,7 +1,11 @@
(* Auxiliary functions that operate on standard library data
structures and standard library-like definitions. *)
-let gettimeofday () = Unix.gettimeofday (); (* 1. *)
+let gettimeofday () =
+ IFDEF NOUNIX
+ THEN 1.
+ ELSE Unix.gettimeofday ()
+ ENDIF
exception Timeout of string
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2012-01-17 02:25:49 UTC (rev 1642)
+++ trunk/Toss/Formula/Aux.mli 2012-01-17 22:23:28 UTC (rev 1643)
@@ -52,7 +52,7 @@
(** Random element of a list. *)
val random_elem : 'a list -> 'a
-(** Concatenate results of a function. *)
+(** Concatenate results of a function. Tail-recursive. *)
val concat_map : ('a -> 'b list) -> 'a list -> 'b list
(** Map a second list and prepend the result to the first list, by
Modified: trunk/Toss/Formula/FormulaParser.mly
===================================================================
--- trunk/Toss/Formula/FormulaParser.mly 2012-01-17 02:25:49 UTC (rev 1642)
+++ trunk/Toss/Formula/FormulaParser.mly 2012-01-17 22:23:28 UTC (rev 1643)
@@ -55,7 +55,7 @@
{ Formula.Sum ($3, $5, $7) }
| COLON OPEN formula_expr CLOSE { Char (Formula.flatten $3) }
| OPEN real_expr CLOSE { $2 }
- | COLON LET_CMD COLON v = ID EQ def = real_expr IN re = real_expr
+ | COLON LET_CMD COLON v = ID EQ def = real_expr IN_MOD re = real_expr
{ RLet (":" ^ v, def, re) }
real_ineq:
@@ -88,13 +88,13 @@
| MINUS ID OPEN fo_var_list CLOSE { Rel ("-"^$2, Array.of_list $4) }
| ID EQ ID { Eq (fo_var_of_s $1, fo_var_of_s $3) }
| ID NEQ ID { Not(Eq (fo_var_of_s $1,fo_var_of_s $3))}
- | ID IN ID { In (fo_var_of_s $1, mso_var_of_s $3) }
+ | ID IN_MOD ID { In (fo_var_of_s $1, mso_var_of_s $3) }
| real_ineq { let (p, s) = $1 in RealExpr (p, s) }
| NOT formula_expr { Not ($2) }
| EX var_list formula_expr { Ex ($2, $3) }
| ALL var_list formula_expr { All ($2, $3) }
| TC ID COMMA ID formula_expr { FormulaSubst.make_lfp_tc $2 $4 $5 }
- | TC IN ID COMMA ID formula_expr { FormulaSubst.make_mso_tc $3 $5 $6 }
+ | TC IN_MOD ID COMMA ID formula_expr { FormulaSubst.make_mso_tc $3 $5 $6 }
| TC INT ID COMMA ID formula_expr { FormulaSubst.make_fo_tc_conj $2 $3 $5 $6 }
| LFP ID OPEN fo_var_list CLOSE EQ formula_expr
{ let vs = Array.of_list $4 in if Array.length vs <> 1 then
@@ -120,7 +120,7 @@
{ Or [And [Not ($1); Not ($3)]; And [$1; $3]] }
| OPEN formula_expr CLOSE { $2 }
| LET_CMD rel = ID args = delimited (OPEN, separated_list (COMMA, ID), CLOSE)
- EQ body = formula_expr IN phi = formula_expr
+ EQ body = formula_expr IN_MOD phi = formula_expr
{ Let (rel, args, body, phi) } %prec LET_CMD
Modified: trunk/Toss/Formula/Lexer.mll
===================================================================
--- trunk/Toss/Formula/Lexer.mll 2012-01-17 02:25:49 UTC (rev 1642)
+++ trunk/Toss/Formula/Lexer.mll 2012-01-17 22:23:28 UTC (rev 1643)
@@ -1,9 +1,11 @@
{
+ let test = "test"
+
type token =
- | ID of (string)
- | INT of (int)
- | FLOAT of (float)
- | BOARD_STRING of (string)
+ | ID of string
+ | INT of int
+ | FLOAT of float
+ | BOARD_STRING of string
| APOSTROPHE
| COLON
| SEMICOLON
@@ -37,7 +39,7 @@
| CLOSESQ
| OPEN
| CLOSE
- | IN
+ | IN_MOD
| AND
| OR
| XOR
@@ -176,7 +178,7 @@
| '}' { CLOSECUR }
| '[' { OPENSQ }
| ']' { CLOSESQ }
- | "in" { IN }
+ | "in" { IN_MOD }
| "and" { AND }
| "or" { OR }
| "xor" { XOR }
Modified: trunk/Toss/Formula/Tokens.mly
===================================================================
--- trunk/Toss/Formula/Tokens.mly 2012-01-17 02:25:49 UTC (rev 1642)
+++ trunk/Toss/Formula/Tokens.mly 2012-01-17 22:23:28 UTC (rev 1643)
@@ -7,7 +7,7 @@
%token SUM PLUS MINUS TIMES DIV POW GR GREQ LT EQLT EQ LTGR NEQ
%token LARR LDARR RARR RDARR LRARR LRDARR INTERV
%token OPENCUR CLOSECUR OPENSQ CLOSESQ OPEN CLOSE
-%token IN AND OR XOR NOT EX ALL TC
+%token IN_MOD AND OR XOR NOT EX ALL TC
%token WITH EMB PRE INV POST UPDATE DYNAMICS TRUE FALSE ASSOC COND PAYOFF MOVES
%token MATCH ADD_CMD DEL_CMD GET_CMD SET_CMD LET_CMD EVAL_CMD
%token ELEM_MOD ELEMS_MOD REL_MOD RELS_MOD ALLOF_MOD SIG_MOD FUN_MOD DATA_MOD LOC_MOD TIMEOUT_MOD TIME_MOD PLAYER_MOD PLAYERS_MOD
@@ -26,7 +26,7 @@
%left OR
%left AND
%left COMMA
-%nonassoc EQ IN
+%nonassoc EQ IN_MOD
%left NOT EX ALL
%%
Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile 2012-01-17 02:25:49 UTC (rev 1642)
+++ trunk/Toss/Makefile 2012-01-17 22:23:28 UTC (rev 1643)
@@ -35,14 +35,16 @@
# -------- MAIN OCAMLBUILD PART --------
-OCB_LFLAG=-lflags -I,+oUnit,-I,+sqlite3,-I,+js_of_ocaml,-I,+site-lib/oUnit,-I,+site-lib/sqlite3
-OCB_CFLAG=-cflags -I,+oUnit,-I,+sqlite3,-I,+js_of_ocaml,-I,+site-lib/oUnit,-I,+site-lib/sqlite3,-g
+# TODO: Hard-coded path to js_of_ocaml.
+OCB_LFLAG=-lflags -I,/usr/local/lib/ocaml/3.12.0/js_of_ocaml,-I,+oUnit,-I,+sqlite3,-I,+js_of_ocaml,-I,+site-lib/oUnit,-I,+site-lib/sqlite3
+OCB_CFLAG=-cflags -I,/usr/local/lib/ocaml/3.12.0/js_of_ocaml,-I,+oUnit,-I,+sqlite3,-I,+js_of_ocaml,-I,+site-lib/oUnit,-I,+site-lib/sqlite3,-g
OCB_LIB=-libs str,nums,unix,oUnit,sqlite3
OCB_LIBJS=-libs str,js_of_ocaml
-OCB_PP=-pp "camlp4o ../caml_extensions/pa_let_try.cmo js_of_ocaml/pa_js.cmo"
+OCB_PP=-pp "camlp4o -I /usr/local/lib/ocaml/3.12.0 ../caml_extensions/pa_let_try.cmo pa_macro.cmo js_of_ocaml/pa_js.cmo"
+OCB_PPJS=-pp "camlp4o -I /usr/local/lib/ocaml/3.12.0 ../caml_extensions/pa_let_try.cmo pa_macro.cmo -DNOREALQE -DNOUNIX js_of_ocaml/pa_js.cmo"
OCAMLBUILD=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PP) \
$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
-OCAMLBUILDJS=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PP) \
+OCAMLBUILDJS=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PPJS) \
$(OCB_LIBJS) $(OCB_CFLAG) $(OCB_LFLAG)
OCAMLBUILDNOPP=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf \
$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
Modified: trunk/Toss/Solver/Solver.ml
===================================================================
--- trunk/Toss/Solver/Solver.ml 2012-01-17 02:25:49 UTC (rev 1642)
+++ trunk/Toss/Solver/Solver.ml 2012-01-17 22:23:28 UTC (rev 1643)
@@ -265,10 +265,14 @@
| [] ->
let poly = poly_of assgn p in
if check then
- if not (RealQuantElim.sat [(poly, sgn)]) then Empty else
- if RealQuantElim.sat [(poly, SignTable.neg_sign_op sgn)] then
- Real [[(poly, sgn)]]
- else Any
+ (IFDEF NOREALQE
+ THEN failwith "Solver.ml: RealQuantElim is not enabled"
+ ELSE
+ ( if not (RealQuantElim.sat [(poly, sgn)]) then Empty else
+ if RealQuantElim.sat [(poly, SignTable.neg_sign_op sgn)] then
+ Real [[(poly, sgn)]]
+ else Any)
+ ENDIF)
else Real [[(poly, sgn)]]
| v :: vs ->
let append_elem_asg acc e =
Modified: trunk/Toss/www/reference/reference.tex
===================================================================
--- trunk/Toss/www/reference/reference.tex 2012-01-17 02:25:49 UTC (rev 1642)
+++ trunk/Toss/www/reference/reference.tex 2012-01-17 22:23:28 UTC (rev 1643)
@@ -1226,7 +1226,10 @@
\[ \tp^{n-1,k}(\frakA,\ol{a}) \ \land\
\Land_{\sfx \in V} \Land_{g \in G_\sfx} \tau_{\sfx, g}. \]
+\section{Distinguishing Structures}
+
+
\section{Learning Games}
Let us start by showing how to learn two-player zero-sum games with payoffs only
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-17 02:25:57
|
Revision: 1642
http://toss.svn.sourceforge.net/toss/?rev=1642&view=rev
Author: lukaszkaiser
Date: 2012-01-17 02:25:49 +0000 (Tue, 17 Jan 2012)
Log Message:
-----------
Testing js_of_ocaml, some refactoring for that.
Modified Paths:
--------------
trunk/Toss/Arena/ArenaTest.ml
trunk/Toss/Arena/ContinuousRuleTest.ml
trunk/Toss/Arena/DiscreteRuleTest.ml
trunk/Toss/Arena/TermTest.ml
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/Formula/AuxTest.ml
trunk/Toss/Formula/BoolFormulaTest.ml
trunk/Toss/Formula/BoolFunctionTest.ml
trunk/Toss/Formula/FFTNFTest.ml
trunk/Toss/Formula/FormulaMapTest.ml
trunk/Toss/Formula/FormulaOpsTest.ml
trunk/Toss/Formula/FormulaSubstTest.ml
trunk/Toss/Formula/FormulaTest.ml
trunk/Toss/Formula/Sat/Sat.ml
trunk/Toss/Formula/Sat/SatTest.ml
trunk/Toss/GGP/GDLTest.ml
trunk/Toss/GGP/GameSimplTest.ml
trunk/Toss/GGP/TranslateFormulaTest.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/Makefile
trunk/Toss/Play/GameTree.ml
trunk/Toss/Play/GameTreeTest.ml
trunk/Toss/Play/HeuristicTest.ml
trunk/Toss/Play/MoveTest.ml
trunk/Toss/Play/PlayTest.ml
trunk/Toss/Server/DB.ml
trunk/Toss/Server/PictureTest.ml
trunk/Toss/Server/ReqHandler.ml
trunk/Toss/Server/ReqHandlerTest.ml
trunk/Toss/Server/Server.ml
trunk/Toss/Solver/AssignmentsTest.ml
trunk/Toss/Solver/ClassTest.ml
trunk/Toss/Solver/SolverTest.ml
trunk/Toss/Solver/StructureTest.ml
Added Paths:
-----------
trunk/Toss/Formula/AuxIO.ml
trunk/Toss/Formula/AuxIO.mli
trunk/Toss/js_of_ocaml_test.html
trunk/Toss/js_of_ocaml_test.ml
Modified: trunk/Toss/Arena/ArenaTest.ml
===================================================================
--- trunk/Toss/Arena/ArenaTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Arena/ArenaTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -116,7 +116,7 @@
(* skip_if true "Change to simpler and stable example."; *)
let fname = "./examples/rewriting_example.toss" in
let file = open_in fname in
- let contents = Aux.input_file file in
+ let contents = AuxIO.input_file file in
let s = "SET STATE #" ^ fname ^ "#" ^ contents in
let (gs,_) = Arena.handle_request Arena.empty_state (req_of_str s) in
let (_, msg) =
@@ -126,5 +126,4 @@
);
]
-let a =
- Aux.run_test_if_target "ArenaTest" tests
+let a = AuxIO.run_test_if_target "ArenaTest" tests
Modified: trunk/Toss/Arena/ContinuousRuleTest.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRuleTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Arena/ContinuousRuleTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -171,5 +171,4 @@
]
-let a =
- Aux.run_test_if_target "ContinuousRuleTest" tests
+let a = AuxIO.run_test_if_target "ContinuousRuleTest" tests
Modified: trunk/Toss/Arena/DiscreteRuleTest.ml
===================================================================
--- trunk/Toss/Arena/DiscreteRuleTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Arena/DiscreteRuleTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -801,8 +801,7 @@
]
-let a =
- Aux.run_test_if_target "DiscreteRuleTest" tests
+let a = AuxIO.run_test_if_target "DiscreteRuleTest" tests
let a () = DiscreteRule.debug_level := 7
Modified: trunk/Toss/Arena/TermTest.ml
===================================================================
--- trunk/Toss/Arena/TermTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Arena/TermTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -67,5 +67,4 @@
);
];;
-let a =
- Aux.run_test_if_target "TermTest" tests
+let a = AuxIO.run_test_if_target "TermTest" tests
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/Aux.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -1,6 +1,9 @@
(* Auxiliary functions that operate on standard library data
structures and standard library-like definitions. *)
+let gettimeofday () = Unix.gettimeofday (); (* 1. *)
+
+
exception Timeout of string
type ('a,'b) choice = Left of 'a | Right of 'b
@@ -50,6 +53,15 @@
(c = '0') || (c = '1') || (c = '2') || (c = '3') || (c = '4') ||
(c = '5') || (c = '6') || (c = '7') || (c = '8') || (c = '9')
+let is_space c =
+ c = '\n' || c = '\r' || c = ' ' || c = '\t'
+
+let strip_spaces s =
+ let (b, e) = (ref 0, ref ((String.length s) - 1)) in
+ while !b < !e && is_space (s.[!b]) do incr b done;
+ while !b <= !e && is_space (s.[!e]) do decr e done;
+ if !e < !b then "" else String.sub s !b (!e - !b + 1)
+
let fst3 (a,_,_) = a
let snd3 (_,a,_) = a
let trd3 (_,_,a) = a
@@ -259,10 +271,11 @@
) img) [[]] (List.rev dom)
-let product_size l =
- let size = List.fold_left (fun size subl ->
- Big_int.mult_int_big_int (List.length subl) size) Big_int.unit_big_int l in
- try Big_int.int_of_big_int size with _ -> max_int
+let product_size l =
+ let safe_mul size sublist =
+ let l = List.length sublist in
+ if l = 0 || max_int / l > size then l * size else max_int in
+ List.fold_left safe_mul 1 l
let product ?upto ?(timeout = fun () -> false) l =
let _ = match upto with None -> () | Some n ->
@@ -716,112 +729,9 @@
Format.fprintf f "%a%a" f_el hd pr_tail tl
-let run_if_target target_name f =
- let file_from_path p =
- String.sub p (String.rindex p '/'+1)
- (String.length p - String.rindex p '/' - 1) in
- let test_fname =
- let fname = file_from_path Sys.executable_name in
- String.length fname >= String.length target_name &&
- String.sub fname 0 (String.length target_name) = target_name in
- if test_fname then f ()
-
-let run_test_if_target target_name tests =
- let f () = ignore (OUnit.run_test_tt ~verbose:true tests) in
- (* So that the tests are not run twice while building TossTest. *)
- run_if_target target_name f
-
let set_optimized_gc () =
Gc.set { (Gc.get()) with
Gc.space_overhead = 300; (* 300% instead of 80% std *)
Gc.minor_heap_size = 160*1024; (* 4*std, opt ~= L2 cache/proc *)
Gc.major_heap_increment = 8*124*1024 (* 8*std ok *)
}
-
-let rec input_file file =
- let buf = Buffer.create 256 in
- (try
- while true do Buffer.add_channel buf file 1 done
- with End_of_file -> ());
- Buffer.contents buf
-
-let list_dir dirname =
- let files, dir_handle = (ref [], Unix.opendir dirname) in
- let rec add () = files := (Unix.readdir dir_handle) :: !files; add () in
- try add () with End_of_file -> Unix.closedir dir_handle; !files
-
-let is_space c =
- c = '\n' || c = '\r' || c = ' ' || c = '\t'
-
-let strip_spaces s =
- let (b, e) = (ref 0, ref ((String.length s) - 1)) in
- while !b < !e && is_space (s.[!b]) do incr b done;
- while !b <= !e && is_space (s.[!e]) do decr e done;
- if !e < !b then "" else String.sub s !b (!e - !b + 1)
-
-let rec input_http_message file =
- let buf = Buffer.create 256 in
- let get_pair s =
- let i, l = String.index s '=', String.length s in
- (String.sub s 0 i, String.sub s (i+1) (l-i-1)) in
- let rec get_cookies s =
- try
- let i, l = String.index s ';', String.length s in
- (get_pair (String.sub s 0 i)) :: get_cookies (String.sub s (i+1) (l-i-1))
- with Not_found -> [] in
- let line, head, cookies, msg_len = ref "HTTP", ref [], ref [], ref 0 in
- while !line <> "" do
- line := strip_spaces (input_line file);
- head := !line :: !head;
- let line_len = String.length !line in
- if line_len > 6 && String.lowercase (String.sub !line 0 6) = "cookie" then (
- let start = (String.index !line ' ') + 1 in
- let ck_str = String.sub !line start (line_len - start) in
- cookies := get_cookies (ck_str ^ ";") @ !cookies
- );
- if line_len > 16 &&
- String.lowercase (String.sub !line 0 15) = "content-length:" then (
- msg_len := int_of_string (String.sub !line 16 (line_len - 16));
- )
- done;
- Buffer.add_channel buf file !msg_len;
- (String.concat "\n" !head, Buffer.contents buf, !cookies)
-
-let input_if_http_message line in_ch =
- let ht1, ht2 = "GET /", "POST /" in
- let l1, l2, l = String.length ht1, String.length ht2, String.length line in
- if ((l > l1 && String.sub line 0 l1 = ht1) ||
- (l > l2 && String.sub line 0 l2 = ht2)) then
- Some (input_http_message in_ch)
- else None
-
-exception Host_not_found
-
-let get_inet_addr addr_s =
- try
- Unix.inet_addr_of_string addr_s
- with Failure _ ->
- try
- let addr_arr = (Unix.gethostbyname addr_s).Unix.h_addr_list in
- if Array.length addr_arr < 1 then raise Host_not_found else
- addr_arr.(0)
- with Not_found -> raise Host_not_found
-
-let toss_call (client_port, client_addr_s) f_in x =
- try
- let client_addr = get_inet_addr client_addr_s in
- let client_sock = Unix.ADDR_INET (client_addr, client_port) in
- let (cl_in_ch, cl_out_ch) = Unix.open_connection client_sock in
- output_string cl_out_ch "COMP\n";
- flush cl_out_ch;
- let f a = try `Res (f_in a) with exn -> `Exn exn in
- Marshal.to_channel cl_out_ch (f, x) [Marshal.Closures];
- flush cl_out_ch;
- (fun () ->
- let res = Marshal.from_channel cl_in_ch in
- Unix.shutdown_connection cl_in_ch;
- match res with `Res r -> r | `Exn e -> raise e)
- with Unix.Unix_error (e, f, s) ->
- Printf.printf "Toss call failed: %s; %s %s\n%!" (Unix.error_message e) f s;
- (fun () -> f_in x)
-
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/Aux.mli 2012-01-17 02:25:49 UTC (rev 1642)
@@ -1,6 +1,10 @@
(** Auxiliary functions that operate on standard library data
structures and standard library-like definitions. *)
+(** Replacement for Unix.gettimeofday. *)
+val gettimeofday: unit -> float
+
+
exception Timeout of string
type ('a, 'b) choice = Left of 'a | Right of 'b
@@ -349,37 +353,5 @@
?newline : int -> string -> (Format.formatter -> 'a -> unit) ->
Format.formatter -> 'a list -> unit
-(** Run a function if the executable name matches the given prefix. *)
-val run_if_target : string -> (unit -> unit) -> unit
-
-(** Run a test suite if the executable name matches the given prefix. *)
-val run_test_if_target : string -> OUnit.test -> unit
-
(** Set more agressive Gc values optimized for heavier computations. *)
val set_optimized_gc : unit -> unit
-
-(** Input a file to a string. *)
-val input_file : in_channel -> string
-
-(** List the contents of a directory *)
-val list_dir : string -> string list
-
-(** Extracting the [Content-length] field and input the content of
- an HTTP message. Return the pair: header first, content next. *)
-val input_http_message : in_channel -> string * string * (string * string) list
-
-(** Input HTTP message if [line] is a http header, ie. "GET /" or "POST /".*)
-val input_if_http_message : string -> in_channel ->
- (string * string * (string * string) list) option
-
-(** Exception used in connections when the host is not found. *)
-exception Host_not_found
-
-(** Determine the internet address or raise Host_not_found. *)
-val get_inet_addr : string -> Unix.inet_addr
-
-(** Call a Toss Server on [port, server] to compute [f] on [x]. BEWARE:
- (1) references are not sent, e.g. you must redo timeouts.
- (2) on single-threaded servers handling calls (older Toss versions),
- you have to collect the results, even on Exception in caller *)
-val toss_call : int * string -> ('a -> 'b) -> 'a -> (unit -> 'b)
Added: trunk/Toss/Formula/AuxIO.ml
===================================================================
--- trunk/Toss/Formula/AuxIO.ml (rev 0)
+++ trunk/Toss/Formula/AuxIO.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -0,0 +1,99 @@
+(* Auxiliary functions that operate on standard library data
+ structures and standard library-like definitions. *)
+open Aux
+
+
+let run_if_target target_name f =
+ let file_from_path p =
+ String.sub p (String.rindex p '/'+1)
+ (String.length p - String.rindex p '/' - 1) in
+ let test_fname =
+ let fname = file_from_path Sys.executable_name in
+ String.length fname >= String.length target_name &&
+ String.sub fname 0 (String.length target_name) = target_name in
+ if test_fname then f ()
+
+let run_test_if_target target_name tests =
+ let f () = ignore (OUnit.run_test_tt ~verbose:true tests) in
+ (* So that the tests are not run twice while building TossTest. *)
+ run_if_target target_name f
+
+
+
+let rec input_file file =
+ let buf = Buffer.create 256 in
+ (try
+ while true do Buffer.add_channel buf file 1 done
+ with End_of_file -> ());
+ Buffer.contents buf
+
+let list_dir dirname =
+ let files, dir_handle = (ref [], Unix.opendir dirname) in
+ let rec add () = files := (Unix.readdir dir_handle) :: !files; add () in
+ try add () with End_of_file -> Unix.closedir dir_handle; !files
+
+let rec input_http_message file =
+ let buf = Buffer.create 256 in
+ let get_pair s =
+ let i, l = String.index s '=', String.length s in
+ (String.sub s 0 i, String.sub s (i+1) (l-i-1)) in
+ let rec get_cookies s =
+ try
+ let i, l = String.index s ';', String.length s in
+ (get_pair (String.sub s 0 i)) :: get_cookies (String.sub s (i+1) (l-i-1))
+ with Not_found -> [] in
+ let line, head, cookies, msg_len = ref "HTTP", ref [], ref [], ref 0 in
+ while !line <> "" do
+ line := strip_spaces (input_line file);
+ head := !line :: !head;
+ let line_len = String.length !line in
+ if line_len > 6 && String.lowercase (String.sub !line 0 6) = "cookie" then (
+ let start = (String.index !line ' ') + 1 in
+ let ck_str = String.sub !line start (line_len - start) in
+ cookies := get_cookies (ck_str ^ ";") @ !cookies
+ );
+ if line_len > 16 &&
+ String.lowercase (String.sub !line 0 15) = "content-length:" then (
+ msg_len := int_of_string (String.sub !line 16 (line_len - 16));
+ )
+ done;
+ Buffer.add_channel buf file !msg_len;
+ (String.concat "\n" !head, Buffer.contents buf, !cookies)
+
+let input_if_http_message line in_ch =
+ let ht1, ht2 = "GET /", "POST /" in
+ let l1, l2, l = String.length ht1, String.length ht2, String.length line in
+ if ((l > l1 && String.sub line 0 l1 = ht1) ||
+ (l > l2 && String.sub line 0 l2 = ht2)) then
+ Some (input_http_message in_ch)
+ else None
+
+exception Host_not_found
+
+let get_inet_addr addr_s =
+ try
+ Unix.inet_addr_of_string addr_s
+ with Failure _ ->
+ try
+ let addr_arr = (Unix.gethostbyname addr_s).Unix.h_addr_list in
+ if Array.length addr_arr < 1 then raise Host_not_found else
+ addr_arr.(0)
+ with Not_found -> raise Host_not_found
+
+let toss_call (client_port, client_addr_s) f_in x =
+ try
+ let client_addr = get_inet_addr client_addr_s in
+ let client_sock = Unix.ADDR_INET (client_addr, client_port) in
+ let (cl_in_ch, cl_out_ch) = Unix.open_connection client_sock in
+ output_string cl_out_ch "COMP\n";
+ flush cl_out_ch;
+ let f a = try `Res (f_in a) with exn -> `Exn exn in
+ Marshal.to_channel cl_out_ch (f, x) [Marshal.Closures];
+ flush cl_out_ch;
+ (fun () ->
+ let res = Marshal.from_channel cl_in_ch in
+ Unix.shutdown_connection cl_in_ch;
+ match res with `Res r -> r | `Exn e -> raise e)
+ with Unix.Unix_error (e, f, s) ->
+ Printf.printf "Toss call failed: %s; %s %s\n%!" (Unix.error_message e) f s;
+ (fun () -> f_in x)
Added: trunk/Toss/Formula/AuxIO.mli
===================================================================
--- trunk/Toss/Formula/AuxIO.mli (rev 0)
+++ trunk/Toss/Formula/AuxIO.mli 2012-01-17 02:25:49 UTC (rev 1642)
@@ -0,0 +1,36 @@
+(** Auxiliary functions that operate on standard library data
+ structures and standard library-like definitions. *)
+
+
+(** Run a function if the executable name matches the given prefix. *)
+val run_if_target : string -> (unit -> unit) -> unit
+
+(** Run a test suite if the executable name matches the given prefix. *)
+val run_test_if_target : string -> OUnit.test -> unit
+
+
+(** Input a file to a string. *)
+val input_file : in_channel -> string
+
+(** List the contents of a directory *)
+val list_dir : string -> string list
+
+(** Extracting the [Content-length] field and input the content of
+ an HTTP message. Return the pair: header first, content next. *)
+val input_http_message : in_channel -> string * string * (string * string) list
+
+(** Input HTTP message if [line] is a http header, ie. "GET /" or "POST /".*)
+val input_if_http_message : string -> in_channel ->
+ (string * string * (string * string) list) option
+
+(** Exception used in connections when the host is not found. *)
+exception Host_not_found
+
+(** Determine the internet address or raise Host_not_found. *)
+val get_inet_addr : string -> Unix.inet_addr
+
+(** Call a Toss Server on [port, server] to compute [f] on [x]. BEWARE:
+ (1) references are not sent, e.g. you must redo timeouts.
+ (2) on single-threaded servers handling calls (older Toss versions),
+ you have to collect the results, even on Exception in caller *)
+val toss_call : int * string -> ('a -> 'b) -> 'a -> (unit -> 'b)
Modified: trunk/Toss/Formula/AuxTest.ml
===================================================================
--- trunk/Toss/Formula/AuxTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/AuxTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -483,5 +483,4 @@
]
-let a =
- Aux.run_test_if_target "AuxTest" tests
+let _ = AuxIO.run_test_if_target "AuxTest" tests
Modified: trunk/Toss/Formula/BoolFormulaTest.ml
===================================================================
--- trunk/Toss/Formula/BoolFormulaTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/BoolFormulaTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -410,9 +410,9 @@
);
]
-let exec () = Aux.run_test_if_target "BoolFormulaTest" tests
+let exec () = AuxIO.run_test_if_target "BoolFormulaTest" tests
-let execbig ()= Aux.run_test_if_target "BoolFormulaTest" bigtests
+let execbig ()= AuxIO.run_test_if_target "BoolFormulaTest" bigtests
let main () =
@@ -431,4 +431,4 @@
print_endline (BoolFormula.str (elim_quant qbf))
)
-let _ = Aux.run_if_target "BoolFormulaTest" main
+let _ = AuxIO.run_if_target "BoolFormulaTest" main
Modified: trunk/Toss/Formula/BoolFunctionTest.ml
===================================================================
--- trunk/Toss/Formula/BoolFunctionTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/BoolFunctionTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -127,7 +127,7 @@
Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
if !file = "" then ignore (OUnit.run_test_tt ~verbose:true tests) else
let f = open_in !file in
- let file_s = Aux.input_file f in
+ let file_s = AuxIO.input_file f in
close_in f;
let cleaned_s1 = Str.global_replace (Str.regexp "bool") "" file_s in
let cleaned_s2 = Str.global_replace (Str.regexp "^.*<.*$") "" cleaned_s1 in
@@ -157,4 +157,4 @@
)
-let _ = Aux.run_if_target "BoolFunctionTest" main
+let _ = AuxIO.run_if_target "BoolFunctionTest" main
Modified: trunk/Toss/Formula/FFTNFTest.ml
===================================================================
--- trunk/Toss/Formula/FFTNFTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FFTNFTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -346,8 +346,7 @@
]
-let a =
- Aux.run_test_if_target "FFTNFTest" tests
+let a = AuxIO.run_test_if_target "FFTNFTest" tests
let a () = FFTNF.debug_level := 7
Modified: trunk/Toss/Formula/FormulaMapTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaMapTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FormulaMapTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -42,4 +42,4 @@
);
]
-let exec = Aux.run_test_if_target "FormulaMapTest" tests
+let exec = AuxIO.run_test_if_target "FormulaMapTest" tests
Modified: trunk/Toss/Formula/FormulaOpsTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaOpsTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FormulaOpsTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -310,7 +310,7 @@
]
-let exec = Aux.run_test_if_target "FormulaOpsTest" tests
+let exec = AuxIO.run_test_if_target "FormulaOpsTest" tests
(* --------------------------- Reals separation test ----------------------- *)
Modified: trunk/Toss/Formula/FormulaSubstTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaSubstTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FormulaSubstTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -155,4 +155,4 @@
]
-let exec = Aux.run_test_if_target "FormulaSubstTest" tests
+let exec = AuxIO.run_test_if_target "FormulaSubstTest" tests
Modified: trunk/Toss/Formula/FormulaTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/FormulaTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -40,4 +40,4 @@
]
-let exec = Aux.run_test_if_target "FormulaTest" tests
+let exec = AuxIO.run_test_if_target "FormulaTest" tests
Modified: trunk/Toss/Formula/Sat/Sat.ml
===================================================================
--- trunk/Toss/Formula/Sat/Sat.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/Sat/Sat.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -6,12 +6,12 @@
let timeout = ref 0.
let minisat_timeout = ref 900.
let check_timeout msg =
- if !timeout > 0.5 && Unix.gettimeofday () > !timeout then
+ if !timeout > 0.5 && Aux.gettimeofday () > !timeout then
(timeout := 0.; raise (Aux.Timeout msg))
let set_timeout t =
minisat_timeout := 5. *. t; (* if MiniSat does it, it's important *)
- timeout := Unix.gettimeofday () +. t
+ timeout := Aux.gettimeofday () +. t
let clear_timeout () = (timeout := 0.; minisat_timeout := 900.)
Modified: trunk/Toss/Formula/Sat/SatTest.ml
===================================================================
--- trunk/Toss/Formula/Sat/SatTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Formula/Sat/SatTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -215,6 +215,6 @@
let exec = (
- Aux.run_test_if_target "SatTest" tests;
- Aux.run_test_if_target "SatTest" bigtests;
+ AuxIO.run_test_if_target "SatTest" tests;
+ AuxIO.run_test_if_target "SatTest" bigtests;
)
Modified: trunk/Toss/GGP/GDLTest.ml
===================================================================
--- trunk/Toss/GGP/GDLTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/GGP/GDLTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -511,4 +511,4 @@
(* failwith "tested"; *)
()
-let exec = Aux.run_test_if_target "GDLTest" tests
+let exec = AuxIO.run_test_if_target "GDLTest" tests
Modified: trunk/Toss/GGP/GameSimplTest.ml
===================================================================
--- trunk/Toss/GGP/GameSimplTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/GGP/GameSimplTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -14,8 +14,7 @@
]
-let a () =
- Aux.run_test_if_target "GameSimplTest" tests
+let a () = AuxIO.run_test_if_target "GameSimplTest" tests
let a () =
match test_filter
Modified: trunk/Toss/GGP/TranslateFormulaTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateFormulaTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/GGP/TranslateFormulaTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -108,4 +108,4 @@
let a () =
()
-let exec = Aux.run_test_if_target "TranslateFormulaTest" tests
+let exec = AuxIO.run_test_if_target "TranslateFormulaTest" tests
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -51,7 +51,7 @@
TranslateGame.translate_game ~playing_as:(Const player) game in
let goal_name = game_name^"-simpl.toss" in
(* let goal = state_of_file ("./GGP/tests/"^goal_name) in *)
- let goal_str = Aux.input_file (open_in ("./GGP/tests/"^goal_name)) in
+ let goal_str = AuxIO.input_file (open_in ("./GGP/tests/"^goal_name)) in
let resf = open_out ("./GGP/tests/"^game_name^"-temp.toss") in
let res_str = Arena.state_str (r_game, r_struc) in
output_string resf res_str;
@@ -151,7 +151,7 @@
TranslateGame.translate_game ~playing_as:(Const player) game in
let goal_name = game_name^"-simpl.toss" in
(* let goal = state_of_file ("./GGP/tests/"^goal_name) in *)
- let goal_str = Aux.input_file (open_in ("./GGP/tests/"^goal_name)) in
+ let goal_str = AuxIO.input_file (open_in ("./GGP/tests/"^goal_name)) in
let resf = open_out ("./GGP/tests/"^game_name^"-temp.toss") in
let res_str = Arena.state_str (r_game, r_struc) in
output_string resf res_str;
@@ -461,7 +461,7 @@
let translate_dir_tests dirname from_file timeout =
let is_gdl fn = (String.length fn > 4) &&
String.sub fn ((String.length fn) - 4) 4 = ".gdl" in
- let files = List.sort compare (List.filter is_gdl (Aux.list_dir dirname)) in
+ let files = List.sort compare (List.filter is_gdl (AuxIO.list_dir dirname)) in
let from_file =
try let r = String.rindex from_file '/' in
String.sub from_file (r+1) ((String.length from_file)-r-1)
@@ -484,7 +484,7 @@
("TranslateGame " ^ dirname) >::: (List.map mk_tst files)
let exec () =
- Aux.run_test_if_target "TranslateGameTest"
+ AuxIO.run_test_if_target "TranslateGameTest"
("TranslateGame" >::: [tests; bigtests])
@@ -503,8 +503,8 @@
if !file <> "" && !testdir = "" then
print_endline (snd (translate_file !file (Some !timeout)))
else if !testdir <> "" then
- Aux.run_test_if_target "TranslateGameTest"
+ AuxIO.run_test_if_target "TranslateGameTest"
(translate_dir_tests !testdir !file !timeout)
else exec ()
-let _ = Aux.run_if_target "TranslateGameTest" main
+let _ = AuxIO.run_if_target "TranslateGameTest" main
Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Makefile 2012-01-17 02:25:49 UTC (rev 1642)
@@ -3,6 +3,9 @@
TossServer: Server/Server.native
cp _build/Server/Server.native TossServer
+js_of_ocaml_test.js: js_of_ocaml_test.byte
+ js_of_ocaml js_of_ocaml_test.byte
+
RELEASE=0.6
Release: TossServer doc
rm -f *~ Formula/*~ Solver/*~ Arena/*~ Play/*~ GGP/*~ \
@@ -32,12 +35,15 @@
# -------- MAIN OCAMLBUILD PART --------
-OCB_LFLAG=-lflags -I,+oUnit,-I,+sqlite3,-I,+site-lib/oUnit,-I,+site-lib/sqlite3
-OCB_CFLAG=-cflags -I,+oUnit,-I,+sqlite3,-I,+site-lib/oUnit,-I,+site-lib/sqlite3,-g
+OCB_LFLAG=-lflags -I,+oUnit,-I,+sqlite3,-I,+js_of_ocaml,-I,+site-lib/oUnit,-I,+site-lib/sqlite3
+OCB_CFLAG=-cflags -I,+oUnit,-I,+sqlite3,-I,+js_of_ocaml,-I,+site-lib/oUnit,-I,+site-lib/sqlite3,-g
OCB_LIB=-libs str,nums,unix,oUnit,sqlite3
-OCB_PP=-pp "camlp4o ../caml_extensions/pa_let_try.cmo"
+OCB_LIBJS=-libs str,js_of_ocaml
+OCB_PP=-pp "camlp4o ../caml_extensions/pa_let_try.cmo js_of_ocaml/pa_js.cmo"
OCAMLBUILD=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PP) \
$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
+OCAMLBUILDJS=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PP) \
+ $(OCB_LIBJS) $(OCB_CFLAG) $(OCB_LFLAG)
OCAMLBUILDNOPP=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf \
$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
@@ -49,7 +55,7 @@
LearnINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena
GGPINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play
ServerINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP,Learn
-.INC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP,Server
+.INC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP,Learn,Server
%.native: %.ml caml_extensions/pa_let_try.cmo
$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
@@ -58,7 +64,7 @@
$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
%.byte: %.ml caml_extensions/pa_let_try.cmo
- $(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
+ $(OCAMLBUILDJS) -Is $($(subst /,INC,$(dir $@))) $@
%.d.byte: %.ml caml_extensions/pa_let_try.cmo
$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
Modified: trunk/Toss/Play/GameTree.ml
===================================================================
--- trunk/Toss/Play/GameTree.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/GameTree.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -13,7 +13,7 @@
let l = Array.length a in
if l = 0 then [||] else if l = 1 then [|f a.(0)|] else (
let (a1, a2) = (Array.sub a 0 (l/2+1), Array.sub a (l/2+1) (l-(l/2+1))) in
- let r1 = Aux.toss_call !parallel_toss (Array.map f) a1 in
+ let r1 = AuxIO.toss_call !parallel_toss (Array.map f) a1 in
(* If the server handling COMP is single-threaded, they must wait for it!
In such case replace the last line with the two lines below.
try let r2 = Array.map f a2 in Array.append (r1 ()) (r2) with exn ->
Modified: trunk/Toss/Play/GameTreeTest.ml
===================================================================
--- trunk/Toss/Play/GameTreeTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/GameTreeTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -72,4 +72,4 @@
]
-let exec = Aux.run_test_if_target "GameTreeTest" tests
+let exec = AuxIO.run_test_if_target "GameTreeTest" tests
Modified: trunk/Toss/Play/HeuristicTest.ml
===================================================================
--- trunk/Toss/Play/HeuristicTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/HeuristicTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -478,11 +478,9 @@
]
-let a =
- Aux.run_test_if_target "HeuristicTest" tests
+let a = AuxIO.run_test_if_target "HeuristicTest" tests
-let a =
- Aux.run_test_if_target "HeuristicTest" bigtests
+let a = AuxIO.run_test_if_target "HeuristicTest" bigtests
let a () =
DiscreteRule.debug_level := 4;
Modified: trunk/Toss/Play/MoveTest.ml
===================================================================
--- trunk/Toss/Play/MoveTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/MoveTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -14,8 +14,6 @@
assert_equal ~printer:(fun x -> x) (Move.move_str_short s mv)
"rule{x:1}"
);
-] ;;
+]
-let a =
- Aux.run_test_if_target "MoveTest" tests
-;;
+let a = AuxIO.run_test_if_target "MoveTest" tests
Modified: trunk/Toss/Play/PlayTest.ml
===================================================================
--- trunk/Toss/Play/PlayTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Play/PlayTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -718,6 +718,6 @@
(* ----------------- RUN THE TESTS ------------- *)
-let exec = Aux.run_test_if_target "PlayTest" tests
+let exec = AuxIO.run_test_if_target "PlayTest" tests
-let execbig = Aux.run_test_if_target "PlayTest" bigtests
+let execbig = AuxIO.run_test_if_target "PlayTest" bigtests
Modified: trunk/Toss/Server/DB.ml
===================================================================
--- trunk/Toss/Server/DB.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/DB.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -43,7 +43,7 @@
"('computer', 'Computer', 'tPlay', 'co...@tp...', 'xxx')");
let insert_game g =
let f = open_in (games_path ^ "/" ^ g ^ ".toss") in
- let toss = Aux.input_file f in
+ let toss = AuxIO.input_file f in
close_in f;
exec ("insert into games(game, toss) values ('" ^ g ^ "','" ^ toss ^ "')");
print_endline ("Added " ^ g) in
@@ -59,7 +59,7 @@
print_endline "Deleted old games";
let reload_game g =
let f = open_in (games_path ^ "/" ^ g ^ ".toss") in
- let toss = Aux.input_file f in
+ let toss = AuxIO.input_file f in
close_in f;
exec ("insert into games(game, toss) values ('" ^ g ^ "','" ^ toss ^ "')");
print_endline ("Reloading games: added " ^ g) in
Modified: trunk/Toss/Server/PictureTest.ml
===================================================================
--- trunk/Toss/Server/PictureTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/PictureTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -48,4 +48,4 @@
) else ignore (OUnit.run_test_tt ~verbose:true tests)
-let _ = Aux.run_if_target "PictureTest" main
+let _ = AuxIO.run_if_target "PictureTest" main
Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/ReqHandler.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -454,7 +454,7 @@
if !debug_level > 1 then Printf.printf "SERVING FILE: %s;\n%!" fname;
if Sys.file_exists fname && not (Sys.is_directory fname) then (
let f = open_in fname in
- let content = Aux.input_file f in
+ let content = AuxIO.input_file f in
close_in f;
let tp = match String.sub fname ((String.index fname '.') + 1) 2 with
| "ht" -> "text/html; charset=utf-8"
@@ -841,7 +841,7 @@
(* String.escaped *) line_in
else
(* String.escaped *) (String.sub line_in 0 (line_in_len-1)) in
- match Aux.input_if_http_message line_in in_ch with
+ match AuxIO.input_if_http_message line_in in_ch with
| Some (head, msg, cookies) ->
if !debug_level > 0 then Printf.printf "Rcvd: %s\n%!" msg;
let ck = List.map (fun (k, v) -> (strip_ws k, strip_ws v)) cookies in
Modified: trunk/Toss/Server/ReqHandlerTest.ml
===================================================================
--- trunk/Toss/Server/ReqHandlerTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/ReqHandlerTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -13,9 +13,9 @@
with End_of_file -> ());
close_in in_ch; close_out out_ch;
let result =
- Aux.input_file (open_in "./Server/ServerTest.temp") in
+ AuxIO.input_file (open_in "./Server/ServerTest.temp") in
let target =
- Aux.input_file (open_in "./Server/ServerTest.out") in
+ AuxIO.input_file (open_in "./Server/ServerTest.out") in
Sys.remove "./Server/ServerTest.temp";
assert_equal ~printer:(fun x->x)
(strip_spaces target) (strip_spaces result)
@@ -37,9 +37,9 @@
with End_of_file -> ());
close_in in_ch; close_out out_ch;
let result =
- Aux.input_file (open_in "./Server/ServerGDLTest.temp") in
+ AuxIO.input_file (open_in "./Server/ServerGDLTest.temp") in
let target =
- Aux.input_file (open_in "./Server/ServerGDLTest.out2") in
+ AuxIO.input_file (open_in "./Server/ServerGDLTest.out2") in
Sys.remove "./Server/ServerGDLTest.temp";
assert_equal ~printer:(fun x->x)
(strip_spaces target) (strip_spaces result);
@@ -49,8 +49,7 @@
]
-let a =
- Aux.run_test_if_target "ReqHandlerTest" tests
+let a = AuxIO.run_test_if_target "ReqHandlerTest" tests
let a () =
GDL.debug_level := 4
Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Server/Server.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -35,7 +35,7 @@
Unix.setsockopt_optint sock Unix.SO_LINGER (Some 2);
Unix.setsockopt_float sock Unix.SO_RCVTIMEO (120.);
Unix.setsockopt sock Unix.SO_REUSEADDR true;
- Unix.bind sock (Unix.ADDR_INET (Aux.get_inet_addr (addr_s), port));
+ Unix.bind sock (Unix.ADDR_INET (AuxIO.get_inet_addr (addr_s), port));
Unix.listen sock 9; (* maximally 9 pending requests *)
let continue = ref true in
while !continue do
@@ -243,7 +243,7 @@
);
try
start_server req_handle !port !server
- with Aux.Host_not_found ->
+ with AuxIO.Host_not_found ->
print_endline "The host you specified was not found."
)
Modified: trunk/Toss/Solver/AssignmentsTest.ml
===================================================================
--- trunk/Toss/Solver/AssignmentsTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Solver/AssignmentsTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -141,4 +141,4 @@
]
-let exec = Aux.run_test_if_target "AssignmentsTest" tests
+let exec = AuxIO.run_test_if_target "AssignmentsTest" tests
Modified: trunk/Toss/Solver/ClassTest.ml
===================================================================
--- trunk/Toss/Solver/ClassTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Solver/ClassTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -449,7 +449,7 @@
ignore (OUnit.run_test_tt ~verbose:true bigtests);
) else (
let f = open_in !file in
- let s = Aux.input_file f in
+ let s = AuxIO.input_file f in
close_in f;
let i = Str.search_forward (Str.regexp_string "|=") s 0 in
let cl_s = String.sub s 0 i in
@@ -464,4 +464,4 @@
)
-let _ = Aux.run_if_target "ClassTest" main
+let _ = AuxIO.run_if_target "ClassTest" main
Modified: trunk/Toss/Solver/SolverTest.ml
===================================================================
--- trunk/Toss/Solver/SolverTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Solver/SolverTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -405,6 +405,6 @@
]
-let exec = Aux.run_test_if_target "SolverTest" tests
+let exec = AuxIO.run_test_if_target "SolverTest" tests
-let execbig = Aux.run_test_if_target "SolverTest" bigtests
+let execbig = AuxIO.run_test_if_target "SolverTest" bigtests
Modified: trunk/Toss/Solver/StructureTest.ml
===================================================================
--- trunk/Toss/Solver/StructureTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
+++ trunk/Toss/Solver/StructureTest.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -426,5 +426,4 @@
]
-let a =
- Aux.run_test_if_target "StructureTest" tests
+let a = AuxIO.run_test_if_target "StructureTest" tests
Added: trunk/Toss/js_of_ocaml_test.html
===================================================================
--- trunk/Toss/js_of_ocaml_test.html (rev 0)
+++ trunk/Toss/js_of_ocaml_test.html 2012-01-17 02:25:49 UTC (rev 1642)
@@ -0,0 +1,13 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head>
+ <title>Test</title>
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+ <script type="text/javascript" src="js_of_ocaml_test.js"></script>
+ </head>
+ <body>
+ <p id="testp"></p>
+ </body>
+</html>
Added: trunk/Toss/js_of_ocaml_test.ml
===================================================================
--- trunk/Toss/js_of_ocaml_test.ml (rev 0)
+++ trunk/Toss/js_of_ocaml_test.ml 2012-01-17 02:25:49 UTC (rev 1642)
@@ -0,0 +1,17 @@
+let rec fib n = if n < 2 then 1 else fib (n-1) + fib (n-2)
+
+let formula_of_string s =
+ FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
+
+let nnf s = Formula.str (FormulaOps.nnf (formula_of_string s))
+
+let fibstr () = Js.string (nnf "not (P(x) and Q(x))")
+
+let onload _ =
+ let d = Dom_html.document in
+ let div = Js.Opt.get (d##getElementById (Js.string "testp"))
+ (fun () -> assert false) in
+ Dom.appendChild div (d##createTextNode (fibstr ()));
+ Js._false
+
+let _ = Dom_html.window##onload <- Dom_html.handler onload
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-17 00:38:24
|
Revision: 1641
http://toss.svn.sourceforge.net/toss/?rev=1641&view=rev
Author: lukaszkaiser
Date: 2012-01-17 00:38:17 +0000 (Tue, 17 Jan 2012)
Log Message:
-----------
Cleanups and improvements in Learn, adding tc-atoms distinguishing.
Modified Paths:
--------------
trunk/Toss/Formula/FormulaSubst.ml
trunk/Toss/Formula/FormulaSubst.mli
trunk/Toss/Learn/Distinguish.ml
trunk/Toss/Learn/Distinguish.mli
trunk/Toss/Learn/DistinguishTest.ml
trunk/Toss/Learn/LearnGame.ml
trunk/Toss/Learn/LearnGameTest.ml
trunk/Toss/Learn/Makefile
Modified: trunk/Toss/Formula/FormulaSubst.ml
===================================================================
--- trunk/Toss/Formula/FormulaSubst.ml 2012-01-16 14:23:37 UTC (rev 1640)
+++ trunk/Toss/Formula/FormulaSubst.ml 2012-01-17 00:38:17 UTC (rev 1641)
@@ -370,20 +370,22 @@
let inphi = And [In (xv, frX); All (([nxv; nyv] :> var list), impphi)] in
All ([(frX :> var)], Or [Not inphi; In (yv, frX)])
-(* First-order [k]-step refl. transitive closure of [phi] over [x] and [y]. *)
-let rec make_fo_tc_conj k x y phi =
+(* First-order [k]-step [?refl] transitive closure of [phi] over [x] and [y]. *)
+let rec make_fo_tc_conj ?(reflexive=true) k x y phi =
let (xv, yv) = (fo_var_of_string x, fo_var_of_string y) in
- if k = 0 then Eq (xv, yv) else if k = 1 then Or [Eq (xv, yv); phi] else
+ if k = 0 then Eq (xv, yv) else if k = 1 then
+ if reflexive then Or [Eq (xv, yv); phi] else phi
+ else
let (fv, k1, k2) = (free_vars phi, k / 2, k - (k / 2)) in
let (_, t) = subst_name_avoiding fv (var_of_string "t") in
- let (phi1, phi2) =
- (make_fo_tc_conj k1 x y phi, make_fo_tc_conj k2 x y phi) in
+ let (phi1, phi2) = (make_fo_tc_conj ~reflexive k1 x y phi,
+ make_fo_tc_conj ~reflexive k2 x y phi) in
let (phi1s, phi2s) =
(subst_vars [(y,t)] phi1, subst_vars [(x,t)] phi2) in
Ex ([var_of_string t], And [phi1s; phi2s])
(* First-order [k]-step refl. transitive closure of [phi], disjunctive form. *)
-let make_fo_tc_disj k x y phi =
+let make_fo_tc_disj ?(reflexive=true) k x y phi =
let (fv, xv, yv) = (free_vars phi, fo_var_of_string x, fo_var_of_string y) in
let (_, t) = subst_name_avoiding fv (var_of_string "t") in
let phi_t = subst_vars [(y,t)] phi in
@@ -392,4 +394,4 @@
let lst = k_step (i-1) in
let psi = subst_vars [(x,t)] (List.hd lst) in
Ex ([var_of_string t], And [phi_t; psi]) :: lst in
- Or (List.rev (k_step k))
+ if reflexive then Or (List.rev (k_step k)) else List.hd (k_step k)
Modified: trunk/Toss/Formula/FormulaSubst.mli
===================================================================
--- trunk/Toss/Formula/FormulaSubst.mli 2012-01-16 14:23:37 UTC (rev 1640)
+++ trunk/Toss/Formula/FormulaSubst.mli 2012-01-17 00:38:17 UTC (rev 1641)
@@ -65,8 +65,10 @@
val make_mso_tc : string -> string -> formula -> formula
(** First-order [k]-step refl. transitive closure of [phi] over [x] and [y]. *)
-val make_fo_tc_conj : int -> string -> string -> formula -> formula
-val make_fo_tc_disj : int -> string -> string -> formula -> formula
+val make_fo_tc_conj : ?reflexive: bool ->
+ int -> string -> string -> formula -> formula
+val make_fo_tc_disj : ?reflexive: bool ->
+ int -> string -> string -> formula -> formula
(** {2 Debugging} *)
Modified: trunk/Toss/Learn/Distinguish.ml
===================================================================
--- trunk/Toss/Learn/Distinguish.ml 2012-01-16 14:23:37 UTC (rev 1640)
+++ trunk/Toss/Learn/Distinguish.ml 2012-01-17 00:38:17 UTC (rev 1641)
@@ -3,7 +3,7 @@
let debug_level = ref 0
let set_debug_level i = (debug_level := i)
-type logic = FO | GuardedFO
+type logic = FO | ExFO | GuardedFO | ExGuardedFO
(* Helper functions to construct variables for indices. *)
@@ -22,6 +22,7 @@
Assignments.assignments_of_list elems vars [tuple] in
eval structure formula assignment <> AssignmentSet.Empty
+
(* - Atoms and FO Types - *)
(* The list of literals which hold for a tuple on a structure. *)
@@ -36,9 +37,9 @@
) (atoms @ (equalities (varnames k)))
-(* The [qr]-type in [length of tuple]-variables of [tuple] in [struc].
- In [mem] we memorize the results for [qr] and [tuple], but *not* [struc]. *)
-let rec ntype_memo struc mem qr tuple =
+(* The [?existential] [qr]-type in [length of tuple]-variables of [tuple] in
+ [struc]. We memorize [mem] results for [qr] and [tuple], *not* [struc]. *)
+let rec ntype_memo existential struc mem qr tuple =
try Hashtbl.find mem (qr, tuple) with Not_found ->
if qr = 0 then (
let res = Formula.flatten_sort (And (atoms struc tuple)) in
@@ -46,30 +47,34 @@
res
) else (
let prevtp i e =
- ntype_memo struc mem (qr-1) (Aux.array_replace tuple i e) in
+ ntype_memo existential struc mem (qr-1) (Aux.array_replace tuple i e) in
let elems = Structure.elements struc in
let conj_prev_ex i =
And (List.map (fun e -> Ex ([var i], prevtp i e)) elems) in
let all_prev_disj i =
All ([var i], Or (List.map (prevtp i) elems)) in
- let next_ntype i = And [conj_prev_ex i; all_prev_disj i] in
+ let next_ntype i =
+ if existential then conj_prev_ex i else
+ And [conj_prev_ex i; all_prev_disj i] in
let nexttp = And (List.map next_ntype (Aux.range (Array.length tuple))) in
let res = Formula.flatten_sort (
- And [ntype_memo struc mem (qr-1) tuple; nexttp]) in
+ And [ntype_memo existential struc mem (qr-1) tuple; nexttp]) in
Hashtbl.add mem (qr, tuple) res;
res
)
-(* The [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
-let ntype struc qr tuple = ntype_memo struc (Hashtbl.create 7) qr tuple
+(* The [?existential] [qr]-type in [length of tuple]-variables
+ of [tuple] in [struc]. *)
+let ntype ?(existential=false) struc qr tuple =
+ ntype_memo existential struc (Hashtbl.create 7) qr tuple
-(* All types of rank [qr] of all [k]-tuples in [struc]. *)
-let ntypes struc ~qr ~k =
+(* All [?existential] types of rank [qr] of all [k]-tuples in [struc]. *)
+let ntypes ?(existential=false) struc ~qr ~k =
let elems = Structure.elements struc in
let tups = List.map Array.of_list (Aux.all_ntuples elems k) in
let mem = Hashtbl.create 63 in
- Aux.unique_sorted (List.rev_map (ntype_memo struc mem qr) tups)
+ Aux.unique_sorted (List.rev_map (ntype_memo existential struc mem qr) tups)
(* - Guards and Guarded Types - *)
@@ -120,23 +125,24 @@
(Formula.str atom) ^ " >"
-(* Guarded [qr]-type in [length of tuple]-variables of [tuple] in [struc].
- In [mem] we memorize the results for [qr] and [tuple], but *not* [struc]. *)
-let rec guarded_type_memo struc mem qr tuple =
+(* Guarded [?existential] [qr]-type in [length of tuple]-variables of [tuple] in
+ [struc]. We memorize [mem] results for [qr] and [tuple], *not* [struc]. *)
+let rec guarded_type_memo existential struc mem qr tuple =
try Hashtbl.find mem (qr, tuple) with Not_found ->
if qr = 0 then (
let res = Formula.flatten_sort (And (atoms struc tuple)) in
Hashtbl.add mem (qr, tuple) res;
res
) else (
- let prevtp tup = guarded_type_memo struc mem (qr-1) tup in
+ let prevtp tup = guarded_type_memo existential struc mem (qr-1) tup in
let conj_prev_ex vars guard subst_tuples =
let subst_tuples = List.filter (fun tup -> tup <> tuple) subst_tuples in
And (List.map (fun tup -> Ex (vars, prevtp tup)) subst_tuples) in
let all_prev_disj vars guard subst_tuples =
All (vars, Or ((Not guard) :: (List.map prevtp subst_tuples))) in
let next_gtype vs (g, ts) =
- And [conj_prev_ex vs g ts; all_prev_disj vs g ts] in
+ if existential then conj_prev_ex vs g ts else
+ And [conj_prev_ex vs g ts; all_prev_disj vs g ts] in
let subst_tuples =
List.rev_map (fun (_,vs,t,_,_) -> (vs, t)) (guards struc tuple) in
let subst_tuples = Aux.unique_sorted (([], tuple) :: subst_tuples) in
@@ -161,18 +167,20 @@
let next_gtype_vs (vs, gtups) = And (List.map (next_gtype vs) gtups) in
let nextf = And (List.map next_gtype_vs tups_with_guards) in
let res = Formula.flatten_sort (
- And [guarded_type_memo struc mem (qr-1) tuple; nextf]) in
+ And [guarded_type_memo existential struc mem (qr-1) tuple; nextf]) in
Hashtbl.add mem (qr, tuple) res;
res
)
-(* Guarded [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
-let guarded_type struc qr tuple =
- guarded_type_memo struc (Hashtbl.create 7) qr tuple
+(* Guarded [?existential] [qr]-type in [length of tuple]-variables
+ of [tuple] in [struc]. *)
+let guarded_type ?(existential=false) struc qr tuple =
+ guarded_type_memo existential struc (Hashtbl.create 7) qr tuple
-(* All guarded types of rank [qr] of guarded [k]-tuples in [struc]. *)
-let guarded_types struc ~qr ~k =
+(* All guarded [?existential] types of rank [qr] of
+ guarded [k]-tuples in [struc]. *)
+let guarded_types ?(existential=false) struc ~qr ~k =
let tups = List.map (Structure.incident struc) (Structure.elements struc) in
let tups = List.concat (List.map snd (List.concat tups)) in
let tups = List.filter (fun tup -> Array.length tup >= k) tups in
@@ -181,13 +189,62 @@
let ktups = List.rev_map k_subtuples (Aux.unique_sorted tups) in
let ktups = Aux.unique_sorted (List.concat ktups) in
let mem = Hashtbl.create 63 in
- Aux.unique_sorted (List.rev_map (guarded_type_memo struc mem qr) ktups)
+ Aux.unique_sorted (List.rev_map
+ (guarded_type_memo existential struc mem qr) ktups)
+(* - Transitive Closure Formulas - *)
+(* Maximum n between [from] and [upto] such that n-step TC of phi holds. *)
+let tc_max struc phi ?(from=1) upto =
+ let from, upto = max from 1, max (max upto 1) from in
+ let tc n = FormulaSubst.make_fo_tc_disj ~reflexive:false n "x0" "x1" phi in
+ if not (check struc [||] (tc from)) then None else
+ let rec ok i =
+ if i > upto || not (check struc [||] (tc i)) then i-1 else ok (i+1) in
+ Some (ok (from+1))
+
+(* Pairs (n, phi) such that phi is a two-variable [?positive] atomic formula
+ and the n-step transitive closure of phi holds somewhere on [struc].
+ The n is between [?from] and [upto], at least 1, phi has 2 free variables. *)
+let tc_atomic ?(positive=false) ?(repeat_vars=true) struc ?(from=1) upto =
+ let rec rept i l = if i < 1 then [] else l :: (rept (i-1) l) in
+ let atoms = Array.of_list (FormulaOps.atoms ~repetitions:repeat_vars
+ (Structure.rel_signature struc) (varnames 2)) in
+ let choices = List.rev_map Array.of_list
+ (if positive then Aux.product (rept (Array.length atoms) [0; 1]) else
+ Aux.product (rept (Array.length atoms) [0; 1; -1])) in
+ let atom_chosen i = function
+ | c when c < 0 -> Not (atoms.(i))
+ | c when c = 0 -> And []
+ | c -> atoms.(i) in
+ let max_n_chosen l =
+ let f = Formula.flatten (And (Array.to_list (Array.mapi atom_chosen l))) in
+ if List.length (FormulaSubst.free_vars f) < 2 then None else
+ match tc_max struc f ~from upto with None -> None
+ | Some n -> Some (n, f) in
+ Aux.map_some max_n_chosen choices
+
+(* Find a upto-[n]-step transitive closures of two-variable [?positive] atomic
+ formulas that hold on all [pos_strucs] and on no [neg_strucs]. *)
+let tc_atomic_distinguish ?(positive=false) ?(repeat_vars=true) pos neg n =
+ if pos = [] then failwith "tc_atomic_distinguish: no pos" else
+ let tc n f= FormulaSubst.make_fo_tc_disj ~reflexive:false n "x0" "x1" f in
+ let is_ok (m, phi) negstruc = not (check negstruc [||] (tc m phi)) in
+ let ok_all (m, phi) = List.for_all (is_ok (m, phi)) neg in
+ let tcs s = List.filter ok_all (tc_atomic ~positive ~repeat_vars s n) in
+ let choose l =
+ if l = [] then raise Not_found else
+ let cmp (n1, f1) (n2, f2) =
+ if n1 <> n2 then n1-n2 else Formula.compare f1 f2 in
+ let (k, phi) = List.hd (List.sort cmp l) in
+ tc k phi in
+ try Some (Or (List.rev_map (fun s -> choose (tcs s)) pos)) with
+ Not_found -> None
+
+
(* - Distinguishing Structure Sets - *)
-
(* Helper function: remove atoms from a formula if [cond] is still satisfied.
Note that this is just a greedy heuristic, only And/Or and into Ex/All. *)
let rec greedy_remove ?(pos=false) cond phi =
@@ -218,20 +275,24 @@
(* Find the minimal [logic]-type of [struc] not included in [neg_types]
and with at most [qr] quantifiers and [k] variables. *)
-let min_type_omitting ?(logic = GuardedFO) ~qr ~k neg_types struc =
+let min_type_omitting ?(logic=ExGuardedFO) ~qr ~k neg_types struc =
let pos_types = match logic with
| GuardedFO -> guarded_types struc ~qr ~k
- | FO -> ntypes struc ~qr ~k in
+ | ExGuardedFO -> guarded_types ~existential:true struc ~qr ~k
+ | FO -> ntypes struc ~qr ~k
+ | ExFO -> ntypes ~existential:true struc ~qr ~k in
let ok_types = List.filter (fun f -> not (List.mem f neg_types)) pos_types in
let ok_types = List.sort !compare_types ok_types in
if ok_types = [] then None else Some (List.hd ok_types)
(* Find a [logic]-formula with at most [qr] quantifiers and [k] variables
which holds on all [pos_strucs] and on no [neg_strucs]. *)
-let distinguish_upto ?(logic = GuardedFO) ~qr ~k pos_strucs neg_strucs =
+let distinguish_upto ?(logic=ExGuardedFO) ~qr ~k pos_strucs neg_strucs =
let types s = match logic with
- | GuardedFO -> guarded_types s ~qr ~k
- | FO -> ntypes s ~qr ~k in
+ | GuardedFO -> guarded_types s ~qr ~k
+ | ExGuardedFO -> guarded_types ~existential:true s ~qr ~k
+ | FO -> ntypes s ~qr ~k
+ | ExFO -> ntypes ~existential:true s ~qr ~k in
let neg_tps = Aux.unique_sorted (Aux.concat_map types neg_strucs) in
let fails_on_negs f = not (List.exists (fun s-> check s [||] f) neg_strucs) in
let extend_by_pos acc struc =
@@ -250,20 +311,29 @@
Some (FormulaOps.rename_quant_avoiding fv minimized)
-(* Find a [logic]-formula holding on all [pos_strucs] and on no [neg_strucs].
+(* Find a formula holding on all [pos_strucs] and on no [neg_strucs].
Leaves free variables (existential) if [skip_outer_exists] is set. *)
-let distinguish ?(how=GuardedFO) ?(skip_outer_exists=false) strucs1 strucs2 =
+let distinguish ?(skip_outer_exists=false) s1 s2 =
if !debug_level > 0 then
Printf.printf "distinguishing:\n\n%s\n\n and\n\n %s\n%!"
- (String.concat "\n" (List.map Structure.str strucs1))
- (String.concat "\n" (List.map Structure.str strucs2));
+ (String.concat "\n" (List.map Structure.str s1))
+ (String.concat "\n" (List.map Structure.str s2));
let rec diff qr k =
if qr > k then diff 0 (k+1) else (
if !debug_level > 0 then Printf.printf "distinguish qr %i k %i\n%!" qr k;
- match distinguish_upto ~logic:how ~qr ~k strucs1 strucs2 with
- | Some f ->
- if skip_outer_exists then Some f else
- Some (Ex (FormulaSubst.free_vars f, f))
- | None -> diff (qr+1) k
+ if qr = 0 then
+ match distinguish_upto ~logic:GuardedFO ~qr ~k s1 s2 with
+ | Some f -> f | None ->
+ match tc_atomic_distinguish ~positive:true
+ ~repeat_vars:false s1 s2 (3*k) with
+ | Some f -> Formula.flatten_sort f | None -> diff (qr+1) k
+ else
+ match distinguish_upto ~logic:GuardedFO ~qr ~k s1 s2 with
+ | Some f ->
+ (match distinguish_upto ~logic:ExGuardedFO ~qr ~k s1 s2 with
+ | Some g-> if 2*(Formula.size f) < Formula.size g then f else g
+ | None -> f)
+ | None -> diff (qr+1) k
) in
- diff 0 1
+ let res = diff 0 1 in
+ if skip_outer_exists then res else Ex (FormulaSubst.free_vars res, res)
Modified: trunk/Toss/Learn/Distinguish.mli
===================================================================
--- trunk/Toss/Learn/Distinguish.mli 2012-01-16 14:23:37 UTC (rev 1640)
+++ trunk/Toss/Learn/Distinguish.mli 2012-01-17 00:38:17 UTC (rev 1641)
@@ -1,6 +1,6 @@
(** Distinguish sets of structures by formulas. *)
-type logic = FO | GuardedFO
+type logic = FO | ExFO | GuardedFO | ExGuardedFO
(** {2 Atoms and FO Types} *)
@@ -9,11 +9,14 @@
i.e. the atomic type of this tuple. *)
val atoms: Structure.structure -> int array -> Formula.formula list
-(** The [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
-val ntype: Structure.structure -> int -> int array -> Formula.formula
+(** The [?existential] [qr]-type in [length of tuple]-variables
+ of [tuple] in [struc]. *)
+val ntype: ?existential: bool ->
+ Structure.structure -> int -> int array -> Formula.formula
-(** All types of rank [qr] of all [k]-tuples in [struc]. *)
-val ntypes: Structure.structure -> qr: int -> k:int -> Formula.formula list
+(** All [?existential] types of rank [qr] of all [k]-tuples in [struc]. *)
+val ntypes: ?existential: bool ->
+ Structure.structure -> qr: int -> k:int -> Formula.formula list
(** {2 Guards and Guarded Types} *)
@@ -36,14 +39,36 @@
(int list * Formula.var list * int array * int array * Formula.formula) ->
string
-(** Guarded [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
-val guarded_type: Structure.structure -> int -> int array -> Formula.formula
+(** Guarded [?existential] [qr]-type in [length of tuple]-variables
+ of [tuple] in [struc]. *)
+val guarded_type: ?existential: bool ->
+ Structure.structure -> int -> int array -> Formula.formula
-(** All guarded types of rank [qr] of guarded [k]-tuples in [struc]. *)
-val guarded_types: Structure.structure -> qr: int -> k:int ->
- Formula.formula list
+(** All guarded [?existential] types of rank [qr] of
+ guarded [k]-tuples in [struc]. *)
+val guarded_types: ?existential: bool ->
+ Structure.structure -> qr: int -> k:int -> Formula.formula list
+(** {2 Transitive Closure Formulas} *)
+
+(** Maximum n between [from] and [upto] such that n-step TC of phi holds. **)
+val tc_max:
+ Structure.structure -> Formula.formula -> ?from: int -> int -> int option
+
+(** Pairs (n, phi) such that phi is a two-variable [?positive] atomic formula
+ and the n-step transitive closure of phi holds somewhere on [struc].
+ The n is between [?from] - [upto], at least 1, phi has 2 free variables. **)
+val tc_atomic: ?positive: bool -> ?repeat_vars: bool ->
+ Structure.structure -> ?from: int -> int -> (int * Formula.formula) list
+
+(** Find a upto-[n]-step transitive closures of two-variable [?positive] atomic
+ formulas that hold on all [pos_strucs] and on no [neg_strucs]. **)
+val tc_atomic_distinguish: ?positive: bool -> ?repeat_vars: bool ->
+ Structure.structure list -> Structure.structure list -> int ->
+ Formula.formula option
+
+
(** {2 Distinguishing Structure Sets} *)
(** Order on types that we use to select the minimal ones. *)
@@ -60,10 +85,10 @@
val distinguish_upto: ?logic: logic -> qr: int -> k: int ->
Structure.structure list -> Structure.structure list -> Formula.formula option
-(** Find a [logic]-formula holding on all [pos_strucs] and on no [neg_strucs].
+(** Find a formula holding on all [pos_strucs] and on no [neg_strucs].
Leaves free variables (existential) if [skip_outer_exists] is set. *)
-val distinguish: ?how: logic -> ?skip_outer_exists: bool ->
- Structure.structure list -> Structure.structure list -> Formula.formula option
+val distinguish: ?skip_outer_exists: bool ->
+ Structure.structure list -> Structure.structure list -> Formula.formula
(** {2 Debugging} *)
Modified: trunk/Toss/Learn/DistinguishTest.ml
===================================================================
--- trunk/Toss/Learn/DistinguishTest.ml 2012-01-16 14:23:37 UTC (rev 1640)
+++ trunk/Toss/Learn/DistinguishTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
@@ -208,6 +208,27 @@
(List.length (Distinguish.guarded_types struc ~qr:1 ~k:2));
);
+ "tc_atomic" >::
+ (fun () ->
+ let struc = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
+ formula_list_eq [ "R(x1, x0)"; "R(x0, x1)" ]
+ (List.rev_map snd (tc_atomic ~positive:true struc 1));
+ formula_list_eq [ "R(x1, x0)"; "R(x0, x1)" ]
+ (List.rev_map snd (tc_atomic ~positive:true struc 2));
+ formula_list_eq [ "R(x1, x0)"; "R(x0, x1)" ]
+ (List.rev_map snd (tc_atomic ~positive:true struc ~from:2 2));
+ formula_list_eq []
+ (List.rev_map snd (tc_atomic ~positive:true struc ~from:3 3));
+ );
+
+ "tc_atomic_distinguish" >::
+ (fun () ->
+ let s1 = (struc_of_string "[ | P { 1; 2; 3 }; R { (1,2); (2,3) } | ]") in
+ let s2 = (struc_of_string "[ | P { 1; 2 }; R { (1,2); (2,3) } | ]") in
+ formula_option_eq "ex t (P(t) and P(x1) and R(t, x1) and R(x0, t))"
+ (tc_atomic_distinguish ~positive:true [s1] [s2] 2);
+ );
+
"distinguish_upto" >::
(fun () ->
let struc1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
@@ -220,7 +241,7 @@
(Distinguish.distinguish_upto ~logic:FO ~qr:0 ~k:2 [struc1] [struc2]);
formula_option_eq "None" (* we use guarded types - so None here *)
(Distinguish.distinguish_upto ~qr:0 ~k:3 [struc1] [struc2]);
- formula_option_eq "R(x0, x1) and ex x2 R(x2, x0)"
+ formula_option_eq "R(x0, x1) and ex x2 R(x1, x2)"
(Distinguish.distinguish_upto ~qr:1 ~k:2 [struc1] [struc2]);
let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
@@ -233,13 +254,12 @@
(fun () ->
let struc1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
let struc2 = (struc_of_string "[ | R { (1, 2) } | ]") in
- formula_option_eq "ex x0, x1 (R(x0, x1) and ex x2 R(x2, x0))"
+ formula_eq "ex x0, x1, t (R(t, x1) and R(x0, t))"
(Distinguish.distinguish [struc1] [struc2]);
let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
let struc2 = (struc_of_string "[ | P:1 {}; R { (1) } | ]") in
- formula_option_eq "ex x0 P(x0)"
- (Distinguish.distinguish [struc1] [struc2]);
+ formula_eq "ex x0 P(x0)" (Distinguish.distinguish [struc1] [struc2]);
let struc1 = struc_of_string "[ | | ] \"
...
@@ -253,7 +273,7 @@
...
...
\"" in
- formula_option_eq "ex x0, x1 (P(x0) and C(x0, x1))"
+ formula_eq "ex x0, x1 (P(x0) and C(x0, x1))"
(Distinguish.distinguish [struc1] [struc2]);
);
]
@@ -292,8 +312,8 @@
P..
... ...
...P ...
-\"" in formula_option_eq
- "P(x0) and P(x1) and C(x0, x1) and ex x2 (P(x2) and C(x2, x0))"
+\"" in formula_eq
+ "ex t (P(t) and P(x0) and P(x1) and C(t, x1) and C(x0, t))"
(Distinguish.distinguish ~skip_outer_exists:true
[strucP] [strucN1; strucN2; strucN3]);
);
@@ -336,7 +356,7 @@
... ... ... ...
...W ... ... ...
\"" in (* Distinguish.set_debug_level 1; *)
- formula_option_eq "W(x1) and all x0 not C(x1, x0)"
+ formula_eq "W(x1) and all x0 not C(x1, x0)"
(Distinguish.distinguish ~skip_outer_exists:true [struc1] [struc2]);
);
]
Modified: trunk/Toss/Learn/LearnGame.ml
===================================================================
--- trunk/Toss/Learn/LearnGame.ml 2012-01-16 14:23:37 UTC (rev 1640)
+++ trunk/Toss/Learn/LearnGame.ml 2012-01-17 00:38:17 UTC (rev 1641)
@@ -19,8 +19,7 @@
"Searching WIN:\n" ^
(String.concat "\n" (List.map Structure.str winningStates)) ^ "\nNOT\n"^
(String.concat "\n" (List.map Structure.str notWinningStates)));
- FormulaOps.tnf_fv
- (Aux.unsome (Distinguish.distinguish winningStates notWinningStates))
+ FormulaOps.tnf_fv (Distinguish.distinguish winningStates notWinningStates)
let cleanStructure struc =
let funs = ref [] in
@@ -73,11 +72,11 @@
let win0f = winFormula
(List.map (fun x -> List.hd (List.rev x)) win0)
(List.flatten ((List.map (fun x-> List.tl (List.rev x))
- win0) @ win1)) in
+ win0) @ win1 @ tie)) in
let win1f = winFormula
(List.map (fun x -> List.hd (List.rev x)) win1)
(List.flatten ((List.map (fun x-> List.tl (List.rev x))
- win1) @ win0)) in
+ win1) @ win0 @ tie)) in
let moves0 = movesi 0 (win0 @ win1) in
let moves1 = movesi 1 (win0 @ win1) in
Modified: trunk/Toss/Learn/LearnGameTest.ml
===================================================================
--- trunk/Toss/Learn/LearnGameTest.ml 2012-01-16 14:23:37 UTC (rev 1640)
+++ trunk/Toss/Learn/LearnGameTest.ml 2012-01-17 00:38:17 UTC (rev 1641)
@@ -3,8 +3,15 @@
let formula_of_string s =
FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
-let struc_of_string s =
- StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
+let struc_of_string ?(diag=false) s =
+ if diag then
+ let s = "MODEL " ^ s ^ " with Da (x, y) = ex u (R(x, u) and C(u, y));" ^
+ " Db (x, y) = ex u (R(x, u) and C(y, u))" in
+ match ArenaParser.parse_game_defs Lexer.lex (Lexing.from_string s) with
+ | Arena.StateStruc struc -> struc
+ | _ -> failwith "LearnGameTest:struc_of_string: not a structure"
+ else
+ StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
let tests = "LearnGame" >::: [
"simple test game" >::
@@ -39,7 +46,7 @@
\"" ;]] in
let res_game =
"PLAYERS 1, 2
-REL Win1() = ex x1 (Q(x1) and ex x0 R(x1, x0))
+REL Win1() = ex x0 (Q(x0) and ex x1 R(x0, x1))
REL Win2() = ex x1 (Q(x1) and ex x0 R(x0, x1))
RULE Mv1:
[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P (1); Q:1 {}; R:2 {} | ]
@@ -73,7 +80,7 @@
(fun () ->
Distinguish.set_debug_level 0; (* set to 1 to get some info printed out *)
let partylist0 = [
- List.map struc_of_string [
+ List.map (struc_of_string ~diag:true) [
"[ | P:1 {}; Q:1 {} | ] \"
. . .
. . .
@@ -122,7 +129,7 @@
. . .
. . .
\"";
- ]; List.map struc_of_string [
+ ]; List.map (struc_of_string ~diag:true) [
"[ | P:1 {}; Q:1 {} | ] \"
. . .
. . .
@@ -170,17 +177,41 @@
. . .
Q . .
. . .
-\"";]
- ] in
-let partylist1 = [
- List.map struc_of_string [
+\"";]; List.map (struc_of_string ~diag:true) [
"[ | P:1 {}; Q:1 {} | ] \"
. . .
. . .
. . .
. . .
. . .
+Q Q Q
+\"";]; List.map (struc_of_string ~diag:true) [
+"[ | P:1 {}; Q:1 {} | ] \"
. . .
+. Q .
+. . .
+. Q .
+. . .
+. Q .
+\"";]; List.map (struc_of_string ~diag:true) [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . Q
+. . .
+. Q .
+. . .
+Q . .
+\"";]
+] in
+ let partylist1 = [
+ List.map (struc_of_string ~diag:true) [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
\"" ;
"[ | P:1 {}; Q:1 {} | ] \"
Q . .
@@ -246,7 +277,7 @@
. . .
P P P
\"";
- ]; List.map struc_of_string [
+ ]; List.map (struc_of_string ~diag:true) [
"[ | P:1 {}; Q:1 {} | ] \"
. . .
. . .
@@ -304,7 +335,7 @@
P P P
\"";
]
- ; List.map struc_of_string [
+ ; List.map (struc_of_string ~diag:true) [
"[ | P:1 {}; Q:1 {} | ] \"
. . .
. . .
@@ -313,7 +344,7 @@
. . .
P P P
\"";]
- ; List.map struc_of_string [
+ ; List.map (struc_of_string ~diag:true) [
"[ | P:1 {}; Q:1 {} | ] \"
. . .
. P .
@@ -322,7 +353,7 @@
. . .
. P .
\"";]
- ; List.map struc_of_string [
+ ; List.map (struc_of_string ~diag:true) [
"[ | P:1 {}; Q:1 {} | ] \"
. . .
. . P
@@ -331,10 +362,39 @@
. . .
P . .
\"";]
- ] in
+] in
+let tie = [
+ List.map (struc_of_string ~diag:true) [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. P .
+. . .
+. Q .
+. . .
+. P .
+\"";]
+ ; List.map (struc_of_string ~diag:true) [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . Q
+. . .
+. P .
+. . .
+P . .
+\"";]
+ ; List.map (struc_of_string ~diag:true) [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . P
+. . .
+. P .
+. . .
+Q . .
+\"";]
+] in
assert_equal ~printer:(fun x -> x) ""
((LearnGame.learnFromParties ~win0:partylist0 ~win1:partylist1
- ~tie:[] ~wrong:[]));
+ ~tie ~wrong:[]));
);
]
Modified: trunk/Toss/Learn/Makefile
===================================================================
--- trunk/Toss/Learn/Makefile 2012-01-16 14:23:37 UTC (rev 1640)
+++ trunk/Toss/Learn/Makefile 2012-01-17 00:38:17 UTC (rev 1641)
@@ -1,4 +1,4 @@
-all: reco
+all: tests reco
shapes.o: shapes.c shapes.h
gcc -c shapes.c
@@ -6,5 +6,18 @@
reco: reco.cpp shapes.o
g++ shapes.o reco.cpp -o reco `pkg-config opencv --cflags --libs`
+%Test:
+ make -C .. Learn/$@Verbose
+
+DistinguishTest:
+LearnGameTest:
+
+
+tests:
+ make -C .. LearnTestsVerbose
+
+
+.PHONY: clean
+
clean:
rm -rf reco log*.ppm *.o *~
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-16 14:23:49
|
Revision: 1640
http://toss.svn.sourceforge.net/toss/?rev=1640&view=rev
Author: lukaszkaiser
Date: 2012-01-16 14:23:37 +0000 (Mon, 16 Jan 2012)
Log Message:
-----------
Tidy up: moving learning things to Learn.
Modified Paths:
--------------
trunk/Toss/Makefile
trunk/Toss/Server/ReqHandler.ml
trunk/Toss/Server/Tests.ml
Added Paths:
-----------
trunk/Toss/Learn/Distinguish.ml
trunk/Toss/Learn/Distinguish.mli
trunk/Toss/Learn/DistinguishTest.ml
trunk/Toss/Learn/LearnGame.ml
trunk/Toss/Learn/LearnGame.mli
trunk/Toss/Learn/LearnGameTest.ml
Removed Paths:
-------------
trunk/Toss/Server/LearnGame.ml
trunk/Toss/Server/LearnGame.mli
trunk/Toss/Server/LearnGameTest.ml
trunk/Toss/Solver/Distinguish.ml
trunk/Toss/Solver/Distinguish.mli
trunk/Toss/Solver/DistinguishTest.ml
Copied: trunk/Toss/Learn/Distinguish.ml (from rev 1639, trunk/Toss/Solver/Distinguish.ml)
===================================================================
--- trunk/Toss/Learn/Distinguish.ml (rev 0)
+++ trunk/Toss/Learn/Distinguish.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -0,0 +1,269 @@
+open Formula
+
+let debug_level = ref 0
+let set_debug_level i = (debug_level := i)
+
+type logic = FO | GuardedFO
+
+
+(* Helper functions to construct variables for indices. *)
+let varname i = "x" ^ string_of_int i
+let varnames k = List.map varname (Aux.range k)
+let var i = var_of_string (varname i)
+let fo_var i = fo_var_of_string (varname i)
+
+(* Helper function: check if a formula holds for a tuple on a structure. *)
+let check structure tuple formula =
+ let eval structure phi assignment =
+ (Solver.M.evaluate_partial structure assignment phi) in
+ let elems = Assignments.set_to_set_list (Structure.elems structure) in
+ let vars =Array.map fo_var (Array.of_list (Aux.range (Array.length tuple))) in
+ let assignment = if tuple = [||] then AssignmentSet.Any else
+ Assignments.assignments_of_list elems vars [tuple] in
+ eval structure formula assignment <> AssignmentSet.Empty
+
+(* - Atoms and FO Types - *)
+
+(* The list of literals which hold for a tuple on a structure. *)
+let atoms struc tuple =
+ let k = Array.length tuple in
+ let rec equalities = function
+ | [] -> []
+ | v :: vs -> (List.map (fun x -> Eq (`FO v,`FO x)) vs) @ (equalities vs) in
+ let atoms = FormulaOps.atoms (Structure.rel_signature struc) (varnames k) in
+ List.map (
+ fun atom -> if check struc tuple atom then atom else (Not atom)
+ ) (atoms @ (equalities (varnames k)))
+
+
+(* The [qr]-type in [length of tuple]-variables of [tuple] in [struc].
+ In [mem] we memorize the results for [qr] and [tuple], but *not* [struc]. *)
+let rec ntype_memo struc mem qr tuple =
+ try Hashtbl.find mem (qr, tuple) with Not_found ->
+ if qr = 0 then (
+ let res = Formula.flatten_sort (And (atoms struc tuple)) in
+ Hashtbl.add mem (qr, tuple) res;
+ res
+ ) else (
+ let prevtp i e =
+ ntype_memo struc mem (qr-1) (Aux.array_replace tuple i e) in
+ let elems = Structure.elements struc in
+ let conj_prev_ex i =
+ And (List.map (fun e -> Ex ([var i], prevtp i e)) elems) in
+ let all_prev_disj i =
+ All ([var i], Or (List.map (prevtp i) elems)) in
+ let next_ntype i = And [conj_prev_ex i; all_prev_disj i] in
+ let nexttp = And (List.map next_ntype (Aux.range (Array.length tuple))) in
+ let res = Formula.flatten_sort (
+ And [ntype_memo struc mem (qr-1) tuple; nexttp]) in
+ Hashtbl.add mem (qr, tuple) res;
+ res
+ )
+
+(* The [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
+let ntype struc qr tuple = ntype_memo struc (Hashtbl.create 7) qr tuple
+
+
+(* All types of rank [qr] of all [k]-tuples in [struc]. *)
+let ntypes struc ~qr ~k =
+ let elems = Structure.elements struc in
+ let tups = List.map Array.of_list (Aux.all_ntuples elems k) in
+ let mem = Hashtbl.create 63 in
+ Aux.unique_sorted (List.rev_map (ntype_memo struc mem qr) tups)
+
+
+(* - Guards and Guarded Types - *)
+
+(* Generate all guarded substitutions of [tuple] with the guards.
+ A subst-tuple is a substitution of [tuple] if it has the same length.
+ A subst-tuple is a guarded substitution of [tuple] if a permuted
+ sub-tuple of subst-tuple containig at least one element of
+ the original [tuple] is in some relation R in the structure [struc].
+ The guard for subst-tuple is then the atomic formula R(x_i1, ..., x_iK)
+ such that a = (subst-tuple_i1, ..., subst-tuple_iK) and R(a) holds.
+ For every subst-tuple as above we return the quintuple:
+ <new elems in subst-tuple, their indices as vars, subst-tuple, a, guard>.
+ We do not generate subst-tuples with repeated new elements. *)
+let guards struc tuple =
+ let in_tuple e = Aux.array_mem e tuple in
+ let tuple = Array.to_list tuple in
+ let all_incident = List.concat (List.map (Structure.incident struc) tuple) in
+ let subst_tuples a = (* all subst-tuples for which [a] witnesses a guard *)
+ let new_in =
+ Aux.unique_sorted (Aux.array_find_all (fun x -> not (in_tuple x)) a) in
+ let subst_tups = Aux.product (
+ List.map (fun e->if List.mem e new_in then new_in else e::new_in) tuple)in
+ let is_complete subst =
+ List.for_all (fun e -> List.mem e subst) (Array.to_list a) in
+ let complete_new_once subst = is_complete subst && List.for_all (
+ fun n -> List.length (List.filter (fun x -> x = n) subst) = 1
+ ) new_in in
+ List.rev_map Array.of_list (List.filter complete_new_once subst_tups) in
+ let make_guard rel a stp =
+ let new_els = List.filter (fun x -> not (in_tuple x)) (Array.to_list stp) in
+ let sindex e = Aux.array_argfind (fun x -> x = e) stp in
+ let guard = Rel (rel, Array.map (fun e -> fo_var (sindex e)) a) in
+ let ret_els = Aux.unique_sorted new_els in
+ (ret_els, List.map (fun e -> var (sindex e)) ret_els, stp, a, guard) in
+ let make_guard rel a = List.rev_map (make_guard rel a) (subst_tuples a) in
+ let make_guard (rel, tps) = List.concat (List.rev_map (make_guard rel) tps) in
+ let guards = List.filter (fun (e,_,_,_,_) -> e <> [])
+ (List.concat (List.rev_map make_guard all_incident)) in
+ Aux.unique_sorted guards
+
+(* Print a guard tuple, as returned above, to string. *)
+let guard_tuple_str (new_elems, vars, tup, a, atom) =
+ "< " ^ (String.concat ", " (List.map string_of_int new_elems)) ^ " | " ^
+ (String.concat ", " (List.map var_str vars)) ^ " | " ^
+ (String.concat ", " (List.map string_of_int (Array.to_list tup))) ^ " | " ^
+ (String.concat ", " (List.map string_of_int (Array.to_list a))) ^ " | " ^
+ (Formula.str atom) ^ " >"
+
+
+(* Guarded [qr]-type in [length of tuple]-variables of [tuple] in [struc].
+ In [mem] we memorize the results for [qr] and [tuple], but *not* [struc]. *)
+let rec guarded_type_memo struc mem qr tuple =
+ try Hashtbl.find mem (qr, tuple) with Not_found ->
+ if qr = 0 then (
+ let res = Formula.flatten_sort (And (atoms struc tuple)) in
+ Hashtbl.add mem (qr, tuple) res;
+ res
+ ) else (
+ let prevtp tup = guarded_type_memo struc mem (qr-1) tup in
+ let conj_prev_ex vars guard subst_tuples =
+ let subst_tuples = List.filter (fun tup -> tup <> tuple) subst_tuples in
+ And (List.map (fun tup -> Ex (vars, prevtp tup)) subst_tuples) in
+ let all_prev_disj vars guard subst_tuples =
+ All (vars, Or ((Not guard) :: (List.map prevtp subst_tuples))) in
+ let next_gtype vs (g, ts) =
+ And [conj_prev_ex vs g ts; all_prev_disj vs g ts] in
+ let subst_tuples =
+ List.rev_map (fun (_,vs,t,_,_) -> (vs, t)) (guards struc tuple) in
+ let subst_tuples = Aux.unique_sorted (([], tuple) :: subst_tuples) in
+ let all_vars = varnames (Array.length tuple) in
+ let at_most_vs_tuples vs = List.concat (List.map (
+ fun vs -> Aux.assoc_all vs subst_tuples) (Aux.all_subsets vs)) in
+ let tuples_by_vs = List.map (fun vs -> (vs, at_most_vs_tuples vs))
+ (Aux.all_subsets (List.map var_of_string all_vars)) in
+ let all_guards =
+ FormulaOps.atoms (Structure.rel_signature struc) all_vars in
+ let guards_to_tups (vs, tuples) =
+ let has_vs a = List.for_all (fun v -> Aux.array_mem (to_fo v) a) vs in
+ let is_vs_guard a = has_vs a &&
+ Aux.array_existsi (fun _ v -> not (List.mem (v :> var) vs)) a in
+ let is_vs_guard = function Rel (_, a) -> is_vs_guard a | _ -> false in
+ let vs_guards = List.filter is_vs_guard all_guards in
+ let guarded_tups g = List.filter (fun tup-> check struc tup g) tuples in
+ (vs, List.map (fun g -> (g, guarded_tups g)) vs_guards) in
+ let tups_with_guards = List.map guards_to_tups tuples_by_vs in
+ let tups_with_guards =
+ List.filter (fun (vs,_) -> vs <> []) tups_with_guards in
+ let next_gtype_vs (vs, gtups) = And (List.map (next_gtype vs) gtups) in
+ let nextf = And (List.map next_gtype_vs tups_with_guards) in
+ let res = Formula.flatten_sort (
+ And [guarded_type_memo struc mem (qr-1) tuple; nextf]) in
+ Hashtbl.add mem (qr, tuple) res;
+ res
+ )
+
+(* Guarded [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
+let guarded_type struc qr tuple =
+ guarded_type_memo struc (Hashtbl.create 7) qr tuple
+
+
+(* All guarded types of rank [qr] of guarded [k]-tuples in [struc]. *)
+let guarded_types struc ~qr ~k =
+ let tups = List.map (Structure.incident struc) (Structure.elements struc) in
+ let tups = List.concat (List.map snd (List.concat tups)) in
+ let tups = List.filter (fun tup -> Array.length tup >= k) tups in
+ let k_subtuples tup =
+ List.map Array.of_list (Aux.all_ntuples (Array.to_list tup) k) in
+ let ktups = List.rev_map k_subtuples (Aux.unique_sorted tups) in
+ let ktups = Aux.unique_sorted (List.concat ktups) in
+ let mem = Hashtbl.create 63 in
+ Aux.unique_sorted (List.rev_map (guarded_type_memo struc mem qr) ktups)
+
+
+
+(* - Distinguishing Structure Sets - *)
+
+
+(* Helper function: remove atoms from a formula if [cond] is still satisfied.
+ Note that this is just a greedy heuristic, only And/Or and into Ex/All. *)
+let rec greedy_remove ?(pos=false) cond phi =
+ let rec greedy_remove_list constructor acc = function
+ | [] -> acc
+ | x :: xs ->
+ let rest = acc @ xs in
+ if cond (constructor rest) then greedy_remove_list constructor acc xs else
+ let minx = greedy_remove (fun y -> cond (constructor (y :: rest))) x in
+ greedy_remove_list constructor (minx::acc) xs in
+ match phi with
+ | And fl -> And (greedy_remove_list (fun l -> And l) [] (List.rev fl))
+ | Or fl -> if pos then Or fl else
+ Or (greedy_remove_list (fun l -> Or l) [] (List.rev fl))
+ | Not f -> if pos then Not f else
+ Not (greedy_remove (fun x -> cond (Not x)) f)
+ | Ex (vs, f) -> Ex (vs, greedy_remove (fun x -> cond (Ex (vs, x))) f)
+ | All (vs, f) -> All (vs, greedy_remove (fun x -> cond (All (vs, x))) f)
+ | phi -> phi
+
+(* Order on types that we use to select the minimal one. *)
+let compare_types tp1 tp2 =
+ let tp_lits = function And fl -> List.filter Formula.is_literal fl | _-> [] in
+ let c = Formula.compare (And (tp_lits tp1)) (And (tp_lits tp2)) in
+ if c <> 0 then c else Formula.compare tp1 tp2
+
+let compare_types = ref compare_types
+
+(* Find the minimal [logic]-type of [struc] not included in [neg_types]
+ and with at most [qr] quantifiers and [k] variables. *)
+let min_type_omitting ?(logic = GuardedFO) ~qr ~k neg_types struc =
+ let pos_types = match logic with
+ | GuardedFO -> guarded_types struc ~qr ~k
+ | FO -> ntypes struc ~qr ~k in
+ let ok_types = List.filter (fun f -> not (List.mem f neg_types)) pos_types in
+ let ok_types = List.sort !compare_types ok_types in
+ if ok_types = [] then None else Some (List.hd ok_types)
+
+(* Find a [logic]-formula with at most [qr] quantifiers and [k] variables
+ which holds on all [pos_strucs] and on no [neg_strucs]. *)
+let distinguish_upto ?(logic = GuardedFO) ~qr ~k pos_strucs neg_strucs =
+ let types s = match logic with
+ | GuardedFO -> guarded_types s ~qr ~k
+ | FO -> ntypes s ~qr ~k in
+ let neg_tps = Aux.unique_sorted (Aux.concat_map types neg_strucs) in
+ let fails_on_negs f = not (List.exists (fun s-> check s [||] f) neg_strucs) in
+ let extend_by_pos acc struc =
+ if check struc [||] (Or acc) then acc else
+ match min_type_omitting ~logic ~qr ~k neg_tps struc with
+ | None -> raise Not_found
+ | Some f -> (greedy_remove ~pos:true fails_on_negs f) :: acc in
+ let pos_formulas =
+ try List.fold_left extend_by_pos [] pos_strucs with Not_found -> [] in
+ let pos_formulas = Aux.unique_sorted ~cmp:!compare_types pos_formulas in
+ if pos_formulas = [] then None else
+ let succ_pos fl = List.for_all (fun s -> check s [||] (Or fl)) pos_strucs in
+ let is_ok f = fails_on_negs f && succ_pos [f] in
+ let minimized = greedy_remove is_ok (Or pos_formulas) in
+ let fv = FormulaSubst.free_vars minimized in
+ Some (FormulaOps.rename_quant_avoiding fv minimized)
+
+
+(* Find a [logic]-formula holding on all [pos_strucs] and on no [neg_strucs].
+ Leaves free variables (existential) if [skip_outer_exists] is set. *)
+let distinguish ?(how=GuardedFO) ?(skip_outer_exists=false) strucs1 strucs2 =
+ if !debug_level > 0 then
+ Printf.printf "distinguishing:\n\n%s\n\n and\n\n %s\n%!"
+ (String.concat "\n" (List.map Structure.str strucs1))
+ (String.concat "\n" (List.map Structure.str strucs2));
+ let rec diff qr k =
+ if qr > k then diff 0 (k+1) else (
+ if !debug_level > 0 then Printf.printf "distinguish qr %i k %i\n%!" qr k;
+ match distinguish_upto ~logic:how ~qr ~k strucs1 strucs2 with
+ | Some f ->
+ if skip_outer_exists then Some f else
+ Some (Ex (FormulaSubst.free_vars f, f))
+ | None -> diff (qr+1) k
+ ) in
+ diff 0 1
Copied: trunk/Toss/Learn/Distinguish.mli (from rev 1639, trunk/Toss/Solver/Distinguish.mli)
===================================================================
--- trunk/Toss/Learn/Distinguish.mli (rev 0)
+++ trunk/Toss/Learn/Distinguish.mli 2012-01-16 14:23:37 UTC (rev 1640)
@@ -0,0 +1,71 @@
+(** Distinguish sets of structures by formulas. *)
+
+type logic = FO | GuardedFO
+
+
+(** {2 Atoms and FO Types} *)
+
+(** The list of literals which hold for a tuple on a structure,
+ i.e. the atomic type of this tuple. *)
+val atoms: Structure.structure -> int array -> Formula.formula list
+
+(** The [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
+val ntype: Structure.structure -> int -> int array -> Formula.formula
+
+(** All types of rank [qr] of all [k]-tuples in [struc]. *)
+val ntypes: Structure.structure -> qr: int -> k:int -> Formula.formula list
+
+
+(** {2 Guards and Guarded Types} *)
+
+(** Generate all guarded substitutions of [tuple] with the guards.
+ A subst-tuple is a substitution of [tuple] if it has the same length.
+ A subst-tuple is a guarded substitution of [tuple] if a permuted
+ sub-tuple a of subst-tuple containig at least one element of
+ the original [tuple] is in some relation R in the structure [struc].
+ The guard for subst-tuple is then the atomic formula R(x_i1, ..., x_iK)
+ such that a = (subst-tuple_i1, ..., subst-tuple_iK) and R(a) holds.
+ For every subst-tuple as above we return the quintuple:
+ <new elems in subst-tuple, their indices as vars, subst-tuple, a, guard>.
+ We do not generate subst-tuples with repeated new elements. *)
+val guards: Structure.structure -> int array ->
+ (int list * Formula.var list * int array * int array * Formula.formula) list
+
+(** Print a guard tuple, as returned above, to string. *)
+val guard_tuple_str:
+ (int list * Formula.var list * int array * int array * Formula.formula) ->
+ string
+
+(** Guarded [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
+val guarded_type: Structure.structure -> int -> int array -> Formula.formula
+
+(** All guarded types of rank [qr] of guarded [k]-tuples in [struc]. *)
+val guarded_types: Structure.structure -> qr: int -> k:int ->
+ Formula.formula list
+
+
+(** {2 Distinguishing Structure Sets} *)
+
+(** Order on types that we use to select the minimal ones. *)
+val compare_types : (Formula.formula -> Formula.formula -> int) ref
+
+(** Find the minimal [logic]-type of [struc] not included in [neg_types]
+ and with at most [qr] quantifiers and [k] variables. *)
+val min_type_omitting: ?logic: logic -> qr: int -> k: int ->
+ Formula.formula list -> Structure.structure -> Formula.formula option
+
+(** Find a [logic]-formula with at most [qr] quantifiers and [k] variables
+ which holds on all [pos_strucs] and on no [neg_strucs].
+ Leaves free variables which are implicitly quantified existentially. *)
+val distinguish_upto: ?logic: logic -> qr: int -> k: int ->
+ Structure.structure list -> Structure.structure list -> Formula.formula option
+
+(** Find a [logic]-formula holding on all [pos_strucs] and on no [neg_strucs].
+ Leaves free variables (existential) if [skip_outer_exists] is set. *)
+val distinguish: ?how: logic -> ?skip_outer_exists: bool ->
+ Structure.structure list -> Structure.structure list -> Formula.formula option
+
+
+(** {2 Debugging} *)
+
+val set_debug_level: int -> unit
Copied: trunk/Toss/Learn/DistinguishTest.ml (from rev 1639, trunk/Toss/Solver/DistinguishTest.ml)
===================================================================
--- trunk/Toss/Learn/DistinguishTest.ml (rev 0)
+++ trunk/Toss/Learn/DistinguishTest.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -0,0 +1,342 @@
+open OUnit
+open Distinguish
+
+let formula_of_string s =
+ FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
+
+let struc_of_string s =
+ StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
+
+let formula_eq ?(flatten_sort=true) phi1 phi2 =
+ if flatten_sort then
+ assert_equal ~printer:(fun x -> Formula.sprint x)
+ (Formula.flatten_sort (formula_of_string phi1))
+ (Formula.flatten_sort phi2)
+ else
+ assert_equal ~printer:(fun x -> Formula.sprint x)
+ (formula_of_string phi1) phi2
+
+let guards_eq res guards =
+ let guards_str gl = String.concat "\n" (List.map guard_tuple_str gl) in
+ assert_equal ~printer:(fun s -> s) res (guards_str guards)
+
+let formula_list_eq ?(flatten_sort=true) l1 l2 =
+ if List.length l1 = List.length l2 then
+ List.iter2 (formula_eq ~flatten_sort) l1 l2
+ else
+ let lstr l = "Length " ^ (string_of_int (List.length l)) ^
+ " [ " ^ (String.concat " | " l) ^ " ]" in
+ assert_equal ~printer:lstr l1 (List.map Formula.str l2)
+
+let formula_option_eq ?(flatten_sort=true) fopt1 fopt2 =
+ let fopt_str = function None -> "None" | Some f -> Formula.str f in
+ if fopt1 = "None" then
+ assert_equal ~printer:fopt_str None fopt2
+ else match fopt2 with
+ | None -> assert_equal ~printer:(fun x -> x) fopt1 "None"
+ | Some f -> formula_eq ~flatten_sort fopt1 f
+
+
+
+let tests = "Distinguish" >::: [
+ "atoms" >::
+ (fun () ->
+ let struc = struc_of_string "[ | R { (1, 2); (2, 3) } | ]" in
+ formula_eq
+ ("(not R(x0, x0) and R(x0, x1) and not R(x1, x0) " ^
+ "and not R(x1, x1) and not x0=x1)")
+ (Formula.And (atoms struc [|2; 3|]));
+ );
+
+ "ntype" >::
+ ( fun () ->
+ let structure = (struc_of_string "[ | R { (1, 2) } | ]") in
+ formula_eq ("R(x0, x1) and not R(x0, x0) and not x0=x1 and " ^
+ "not R(x1, x0) and not R(x1, x1)")
+ (Distinguish.ntype structure 0 [|1; 2|]);
+ formula_eq ("(R(x0,x1) and not R(x0,x0) and x0!=x1 and not R(x1,x0) and "^
+ "not R(x1, x1) and ex x0 (R(x0, x1) and not R(x0, x0) " ^
+ "and not x0 = x1 and not R(x1, x0) and not R(x1, x1)) " ^
+ "and ex x0 (x0 = x1 and not R(x0, x0) and not R(x0, x1) " ^
+ "and not R(x1,x0) and not R(x1,x1)) and ex x1(R(x0,x1) " ^
+ "and not R(x0, x0) and not x0 = x1 and not R(x1, x0) " ^
+ "and not R(x1,x1)) and ex x1 (x0=x1 and not R(x0, x0) " ^
+ "and not R(x0, x1) and not R(x1, x0) and not R(x1, x1))" ^
+ " and all x0 ((R(x0,x1) and not R(x0,x0) and x0!=x1 and " ^
+ "not R(x1, x0) and not R(x1, x1)) or (x0 = x1 and " ^
+ "not R(x0, x0) and not R(x0, x1) and not R(x1, x0) and " ^
+ "not R(x1,x1))) and all x1 ((R(x0, x1) and not R(x0, x0)" ^
+ " and not x0 = x1 and not R(x1, x0) and not R(x1, x1)) " ^
+ "or (x0 = x1 and not R(x0, x0) and not R(x0, x1) " ^
+ "and not R(x1, x0) and not R(x1, x1))))")
+ (Distinguish.ntype structure 1 [|1;2|]);
+ );
+
+ "ntypes" >::
+ (fun () ->
+ let structure = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
+ formula_list_eq
+ [("R(x0, x1) and not R(x0, x0) and not x0 = x1 and " ^
+ "not R(x1, x0) and not R(x1, x1)");
+ ("R(x1, x0) and not R(x0, x0) and not R(x0, x1) and " ^
+ "not x0 = x1 and not R(x1, x1)");
+ ("x0 = x1 and not R(x0, x0) and not R(x0, x1) and " ^
+ "not R(x1, x0) and not R(x1, x1)");
+ ("not R(x0, x0) and not R(x0, x1) and not x0 = x1 and " ^
+ "not R(x1, x0) and not R(x1, x1)")]
+ (Distinguish.ntypes structure ~qr:0 ~k:2);
+ );
+
+ "guards" >::
+ (fun () ->
+ let struc = struc_of_string "[ | R { (1, 2); (2, 3) } | ]" in
+ guards_eq "< 3 | x0 | 3, 2 | 2, 3 | R(x1, x0) >" (guards struc [|1; 2|]);
+ guards_eq ("< 2 | x0 | 2, 1 | 1, 2 | R(x1, x0) >\n" ^
+ "< 2 | x1 | 1, 2 | 1, 2 | R(x0, x1) >")
+ (guards struc [|1; 1|]);
+ guards_eq ("< 1 | x0 | 1, 2 | 1, 2 | R(x0, x1) >\n" ^
+ "< 1 | x1 | 2, 1 | 1, 2 | R(x1, x0) >\n" ^
+ "< 3 | x0 | 3, 2 | 2, 3 | R(x1, x0) >\n" ^
+ "< 3 | x1 | 2, 3 | 2, 3 | R(x0, x1) >")
+ (guards struc [|2; 2|]);
+ guards_eq ("< 2 | x0 | 2, 3 | 2, 3 | R(x0, x1) >\n" ^
+ "< 2 | x1 | 1, 2 | 1, 2 | R(x0, x1) >")
+ (guards struc [|1; 3|]);
+ guards_eq ("< 2 | x0 | 2, 1 | 1, 2 | R(x1, x0) >\n" ^
+ "< 2 | x1 | 3, 2 | 2, 3 | R(x1, x0) >")
+ (guards struc [|3; 1|]);
+ guards_eq "" (guards struc [|1|]);
+ guards_eq "" (guards struc [|2|]);
+ guards_eq "" (guards struc [|3|]);
+ guards_eq "" (guards struc [|1; 2; 3|]);
+
+ let struc = struc_of_string "[ | R { (1, 2); (2, 4) } | ]" in
+ guards_eq ("< 4 | x0 | 4, 2, 3 | 2, 4 | R(x1, x0) >\n" ^
+ "< 4 | x2 | 1, 2, 4 | 2, 4 | R(x1, x2) >")
+ (guards struc [|1; 2; 3|]);
+
+ let struc = struc_of_string "[ | R { (1, 2, 2) } | ]" in
+ guards_eq ("< 2 | x0 | 2, 1 | 1, 2, 2 | R(x1, x0, x0) >\n" ^
+ "< 2 | x1 | 1, 2 | 1, 2, 2 | R(x0, x1, x1) >")
+ (guards struc [|1; 1|]);
+
+ let struc = struc_of_string "[ | R { (1, 2, 3) } | ]" in
+ guards_eq "" (guards struc [|1; 1|]);
+ guards_eq "" (guards struc [|1; 2; 3|]);
+ guards_eq ("< 3 | x0 | 3, 1, 2 | 1, 2, 3 | R(x1, x2, x0) >\n" ^
+ "< 3 | x1 | 1, 3, 2 | 1, 2, 3 | R(x0, x2, x1) >")
+ (guards struc [|1; 1; 2|]);
+ guards_eq ("< 2 | x0 | 2, 1, 3 | 1, 2, 3 | R(x1, x0, x2) >\n" ^
+ "< 2 | x1 | 1, 2, 3 | 1, 2, 3 | R(x0, x1, x2) >")
+ (guards struc [|1; 1; 3|]);
+ guards_eq ("< 1 | x0 | 1, 2, 3 | 1, 2, 3 | R(x0, x1, x2) >\n" ^
+ "< 1 | x2 | 3, 2, 1 | 1, 2, 3 | R(x2, x1, x0) >")
+ (guards struc [|3; 2; 3|]);
+ guards_eq ("< 1, 3 | x0, x1 | 1, 3, 2 | 1, 2, 3 | R(x0, x2, x1) >\n" ^
+ "< 1, 3 | x0, x2 | 1, 2, 3 | 1, 2, 3 | R(x0, x1, x2) >\n" ^
+ "< 1, 3 | x1, x0 | 3, 1, 2 | 1, 2, 3 | R(x1, x2, x0) >\n" ^
+ "< 1, 3 | x1, x2 | 2, 1, 3 | 1, 2, 3 | R(x1, x0, x2) >\n" ^
+ "< 1, 3 | x2, x0 | 3, 2, 1 | 1, 2, 3 | R(x2, x1, x0) >\n" ^
+ "< 1, 3 | x2, x1 | 2, 3, 1 | 1, 2, 3 | R(x2, x0, x1) >")
+ (guards struc [|2; 2; 2|]);
+
+ let struc = struc_of_string "[ | | ] \"
+ ... ...
+ ... P..
+ ...
+ P..
+ ... ...
+ ...P ...
+\"" in
+ guards_eq ("< 3 | x0 | 3, 2 | 2, 3 | R(x1, x0) >\n" ^
+ "< 4 | x1 | 1, 4 | 1, 4 | C(x0, x1) >\n" ^
+ "< 5 | x0 | 5, 2 | 2, 5 | C(x1, x0) >")
+ (guards struc [|1; 2|]);
+ );
+
+ "guarded_type" >::
+ (fun () ->
+ let struc = (struc_of_string "[ | R { (1, 2) } | ]") in
+ let lits = "R(x0,x1) and not R(x0,x0) and not x0=x1 and not R(x1,x0) " ^
+ "and not R(x1,x1)" in
+ formula_eq lits (guarded_type struc 0 [|1; 2|]);
+ formula_eq (lits ^ " and all x0 not R(x1, x0) and all x1 not R(x1, x0) " ^
+ "and all x0 (not R(x0, x1) or (not R(x0, x0) and " ^
+ "not x0 = x1 and not R(x1, x0) and not R(x1, x1))) and " ^
+ "all x1 (not R(x0, x1) or (not R(x0, x0) and not x0 = x1" ^
+ " and not R(x1, x0) and not R(x1, x1)))")
+ (guarded_type struc 1 [|1; 2|]);
+
+ let struc = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
+ formula_eq lits (guarded_type struc 0 [|1; 2|]);
+ formula_eq (lits ^ " and all x1 not R(x1, x0) and " ^
+ "ex x0 (R(x1, x0) and not R(x0, x0) and not R(x0, x1) and" ^
+ " not x0 = x1 and not R(x1, x1)) and " ^
+ "all x0 (not R(x0, x1) or (not R(x0, x0) and not x0 = x1" ^
+ " and not R(x1, x0) and not R(x1, x1))) and " ^
+ "all x0 (not R(x1, x0) or (not R(x0, x0) and not R(x0, x1)"^
+ " and not x0 = x1 and not R(x1, x1))) and " ^
+ "all x1 (not R(x0, x1) or (not R(x0, x0) and not x0 = x1" ^
+ " and not R(x1, x0) and not R(x1, x1)))")
+ (guarded_type struc 1 [|1; 2|]);
+ );
+
+ "guarded_types" >::
+ (fun () ->
+ let struc = (struc_of_string "[ | R { (1, 2) } | ]") in
+ formula_list_eq [
+ ("(R(x0, x1) and not R(x0, x0) and not x0 = x1 and " ^
+ " not R(x1, x0) and not R(x1, x1))");
+ ("(R(x1, x0) and not R(x0, x0) and not R(x0, x1) and " ^
+ " not x0 = x1 and not R(x1, x1))");
+ ("(x0 = x1 and not R(x0, x0) and not R(x0, x1) and " ^
+ " not R(x1, x0) and not R(x1, x1))") ]
+ (Distinguish.guarded_types struc ~qr:0 ~k:2);
+ assert_equal ~printer:string_of_int 4
+ (List.length (Distinguish.guarded_types struc ~qr:1 ~k:2));
+
+ let struc = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
+ formula_list_eq [
+ ("(R(x0, x1) and not R(x0, x0) and not x0 = x1 and " ^
+ " not R(x1, x0) and not R(x1, x1))");
+ ("(R(x1, x0) and not R(x0, x0) and not R(x0, x1) and " ^
+ " not x0 = x1 and not R(x1, x1))");
+ ("(x0 = x1 and not R(x0, x0) and not R(x0, x1) and " ^
+ " not R(x1, x0) and not R(x1, x1))") ]
+ (Distinguish.guarded_types struc ~qr:0 ~k:2);
+ assert_equal ~printer:string_of_int 7
+ (List.length (Distinguish.guarded_types struc ~qr:1 ~k:2));
+ );
+
+ "distinguish_upto" >::
+ (fun () ->
+ let struc1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
+ let struc2 = (struc_of_string "[ | R { (1, 2) } | ]") in
+ formula_option_eq "None"
+ (Distinguish.distinguish_upto ~qr:2 ~k:1 [struc1] [struc2]);
+ formula_option_eq "None" (* we use guarded types - so None here *)
+ (Distinguish.distinguish_upto ~qr:0 ~k:2 [struc1] [struc2]);
+ formula_option_eq "not R(x0, x1) and not x0 = x1 and not R(x1, x0)"
+ (Distinguish.distinguish_upto ~logic:FO ~qr:0 ~k:2 [struc1] [struc2]);
+ formula_option_eq "None" (* we use guarded types - so None here *)
+ (Distinguish.distinguish_upto ~qr:0 ~k:3 [struc1] [struc2]);
+ formula_option_eq "R(x0, x1) and ex x2 R(x2, x0)"
+ (Distinguish.distinguish_upto ~qr:1 ~k:2 [struc1] [struc2]);
+
+ let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
+ let struc2 = (struc_of_string "[ | P:1 {}; R { (1) } | ]") in
+ formula_option_eq "P(x0)"
+ (Distinguish.distinguish_upto ~qr:0 ~k:1 [struc1] [struc2]);
+ );
+
+ "distinguish" >::
+ (fun () ->
+ let struc1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
+ let struc2 = (struc_of_string "[ | R { (1, 2) } | ]") in
+ formula_option_eq "ex x0, x1 (R(x0, x1) and ex x2 R(x2, x0))"
+ (Distinguish.distinguish [struc1] [struc2]);
+
+ let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
+ let struc2 = (struc_of_string "[ | P:1 {}; R { (1) } | ]") in
+ formula_option_eq "ex x0 P(x0)"
+ (Distinguish.distinguish [struc1] [struc2]);
+
+ let struc1 = struc_of_string "[ | | ] \"
+ ...
+ ...
+ ...
+ P..
+\"" in
+ let struc2 = struc_of_string "[ | | ] \"
+ ...
+ P..
+ ...
+ ...
+\"" in
+ formula_option_eq "ex x0, x1 (P(x0) and C(x0, x1))"
+ (Distinguish.distinguish [struc1] [struc2]);
+ );
+]
+
+let bigtests = "DistinguishBig" >::: [
+ "semi-tic-tac-toe" >::
+ (fun () ->
+ let strucN1 = struc_of_string "[ | | ] \"
+ ... ...
+ ... P..
+ ...
+ P..
+ ... ...
+ ...P ...
+\"" in
+ let strucN2 = struc_of_string "[ | | ] \"
+ ... ...
+ ...P ...
+ ...
+ ...
+ ... ...
+ ...P ...
+\"" in
+ let strucN3 = struc_of_string "[ | | ] \"
+ ... ...
+ ...P ...
+ ...
+ P..
+ ... ...
+ ... ...
+\"" in
+ let strucP = struc_of_string "[ | | ] \"
+ ... ...
+ ...P ...
+ ...
+ P..
+ ... ...
+ ...P ...
+\"" in formula_option_eq
+ "P(x0) and P(x1) and C(x0, x1) and ex x2 (P(x2) and C(x2, x0))"
+ (Distinguish.distinguish ~skip_outer_exists:true
+ [strucP] [strucN1; strucN2; strucN3]);
+ );
+
+ "breakthrough" >::
+ (fun () ->
+ let struc1 = struc_of_string "[ | | ] \"
+ ... ... ... ...
+ ... W.. ...B ...
+ ... ... ... ...
+ ... ... ... B..
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... W..
+ ... ... ... ...
+ ...W ... ... ...
+\"" in
+ let struc2 = struc_of_string "[ | | ] \"
+ ... ... ... ...
+ ... ... ...B ...
+ ... ... ... ...
+ ... ...W ... B..
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... ...
+ ... ... ... W..
+ ... ... ... ...
+ ...W ... ... ...
+\"" in (* Distinguish.set_debug_level 1; *)
+ formula_option_eq "W(x1) and all x0 not C(x1, x0)"
+ (Distinguish.distinguish ~skip_outer_exists:true [struc1] [struc2]);
+ );
+]
Copied: trunk/Toss/Learn/LearnGame.ml (from rev 1639, trunk/Toss/Server/LearnGame.ml)
===================================================================
--- trunk/Toss/Learn/LearnGame.ml (rev 0)
+++ trunk/Toss/Learn/LearnGame.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -0,0 +1,119 @@
+(* Learning games from examples. *)
+
+let debug_level = ref 0
+let set_debug_level i = (debug_level := i)
+
+let rec evens ?(acc=[0]) k =
+ let last = (List.hd (List.rev acc)) in
+ if (List.hd (List.rev acc))> k then
+ (List.rev (List.tl ( List.rev acc)))
+ else
+ evens ~acc:(acc@[(last+2)]) k
+let odds k =
+ evens ~acc:[1] k
+
+
+let winFormula winningStates notWinningStates =
+ if !debug_level > 0 then
+ print_endline (
+ "Searching WIN:\n" ^
+ (String.concat "\n" (List.map Structure.str winningStates)) ^ "\nNOT\n"^
+ (String.concat "\n" (List.map Structure.str notWinningStates)));
+ FormulaOps.tnf_fv
+ (Aux.unsome (Distinguish.distinguish winningStates notWinningStates))
+
+let cleanStructure struc =
+ let funs = ref [] in
+ let append_fun f _ = funs := f :: !funs in
+ Structure.StringMap.iter append_fun (Structure.functions struc);
+ let struc = StructureParser.parse_structure Lexer.lex (Lexing.from_string (Structure.str struc)) in
+ Structure.replace_names (List.fold_left
+ (fun x y ->
+ Structure.clear_fun x y)
+ struc !funs) Structure.StringMap.empty
+ Structure.IntMap.empty
+
+
+let move struct1 struct2 =
+ let changed = (Aux.unique_sorted
+ ( List.map fst
+ (Structure.diff_elems struct1 struct2 )) ) in
+ let strucBefore =
+ fst (Structure.del_elems struct1
+ (Aux.list_diff
+ (Aux.unique_sorted (Structure.elements struct1))
+ changed )) in
+ let strucAfter =
+ fst (Structure.del_elems struct2
+ (Aux.list_diff
+ (Aux.unique_sorted (Structure.elements struct2))
+ changed )) in
+ ((cleanStructure strucBefore) , (cleanStructure strucAfter))
+
+let movesi i partylist =
+ Aux.unique_sorted
+ ~cmp: (fun (s1,s2) (t1,t2) ->
+ let c = ( Structure.compare s1 t1) in
+ if c != 0 then c
+ else (Structure.compare s2 t2))
+ (List.fold_left
+ (fun acc party ->
+ List.append acc
+ (List.fold_left
+ (fun prev i ->
+ if (i < ((List.length party)-1)) then
+ let m = move (List.nth party i) (List.nth party (i+1)) in
+ (List.append prev [m])
+ else
+ (List.append prev []))
+ [] (evens ~acc:[i] (List.length party)) ) )
+ [] partylist)
+
+let learnFromParties ~win0 ~win1 ~tie ~wrong =
+ let win0f = winFormula
+ (List.map (fun x -> List.hd (List.rev x)) win0)
+ (List.flatten ((List.map (fun x-> List.tl (List.rev x))
+ win0) @ win1)) in
+ let win1f = winFormula
+ (List.map (fun x -> List.hd (List.rev x)) win1)
+ (List.flatten ((List.map (fun x-> List.tl (List.rev x))
+ win1) @ win0)) in
+
+ let moves0 = movesi 0 (win0 @ win1) in
+ let moves1 = movesi 1 (win0 @ win1) in
+
+ "PLAYERS 1, 2\n"^
+ "REL Win1() = "^ (Formula.sprint win0f) ^"\n"^
+ "REL Win2() = "^ (Formula.sprint win1f) ^"\n"^
+ "RULE Mv1: " ^
+ (List.fold_left
+ (fun old x->
+ old ^ "\n"^
+ (Structure.str (fst x))^" -> "^(Structure.str
+ (snd x)) ^
+ "\nemb "^(String.concat "," (List.map fst (Structure.rel_signature
+ (fst x)) )) ^ " " ^
+ "pre not Win2()" )
+ "" moves0) ^"\n"^
+ "RULE Mv2: " ^
+ (List.fold_left
+ (fun old x->
+ old^"\n"^
+ (Structure.str (fst x))^" -> "^(Structure.str
+ (snd x)) ^
+ "\nemb "^(String.concat "," (List.map fst (Structure.rel_signature
+ (fst x)) )) ^ " " ^
+ "pre not Win1()" )
+ "" moves1) ^"\n"^
+ "LOC 0 {
+ PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
+ MOVES [Mv1 -> 1]}
+ PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
+}
+LOC 1{
+ PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
+ PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
+ MOVES [Mv2 -> 0] }
+}" ^"\n" ^
+ "MODEL "^(Structure.str (List.hd (List.hd win0)))
+
Copied: trunk/Toss/Learn/LearnGame.mli (from rev 1639, trunk/Toss/Server/LearnGame.mli)
===================================================================
--- trunk/Toss/Learn/LearnGame.mli (rev 0)
+++ trunk/Toss/Learn/LearnGame.mli 2012-01-16 14:23:37 UTC (rev 1640)
@@ -0,0 +1,21 @@
+(** Module for learning games from examples. *)
+
+val move: Structure.structure -> Structure.structure ->
+ Structure.structure * Structure.structure
+
+(** Learn a two-player win-lose-or-tie game given 4 sets of plays of another
+ game [source]: [wins0] which are now supposed to be won by Player 0,
+ [wins1] - now won by Player 1, [tie] - now a tie, and [wrong] which
+ are not correct plays of the newly constructed game. The plays are given
+ as lists of ids to be retrieved from DB, result is a toss game string. *)
+val learnFromParties:
+ win0: Structure.structure list list ->
+ win1: Structure.structure list list ->
+ tie: Structure.structure list list ->
+ wrong: Structure.structure list list -> string
+
+
+(** {2 Debugging} *)
+
+(* At higher debug levels we prints out diagnostic information. *)
+val set_debug_level: int -> unit
Copied: trunk/Toss/Learn/LearnGameTest.ml (from rev 1639, trunk/Toss/Server/LearnGameTest.ml)
===================================================================
--- trunk/Toss/Learn/LearnGameTest.ml (rev 0)
+++ trunk/Toss/Learn/LearnGameTest.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -0,0 +1,340 @@
+open OUnit
+
+let formula_of_string s =
+ FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
+
+let struc_of_string s =
+ StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
+
+let tests = "LearnGame" >::: [
+ "simple test game" >::
+ (fun () ->
+ let partylist0 = [
+ List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. .
+. .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+. .
+. P
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+. .
+Q P
+\"" ;]] in
+ let partylist1 = [
+ List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. .
+. .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+. .
+P .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+. .
+P Q
+\"" ;]] in
+ let res_game =
+"PLAYERS 1, 2
+REL Win1() = ex x1 (Q(x1) and ex x0 R(x1, x0))
+REL Win2() = ex x1 (Q(x1) and ex x0 R(x0, x1))
+RULE Mv1:
+[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P (1); Q:1 {}; R:2 {} | ]
+emb R,Q,P pre not Win2()
+RULE Mv2:
+[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P:1 {}; Q (1); R:2 {} | ]
+emb R,Q,P pre not Win1()
+LOC 0 {
+ PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
+ MOVES [Mv1 -> 1]}
+ PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
+}
+LOC 1{
+ PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
+ PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
+ MOVES [Mv2 -> 0] }
+}
+MODEL [ | P:1 {}; Q:1 {} | ] R R \"
+
+ . .
+\"" in
+ assert_equal ~printer:(fun x -> x) res_game
+ ((LearnGame.learnFromParties ~win0:partylist0 ~win1:partylist1
+ ~tie:[] ~wrong:[]));
+ );
+]
+
+
+let bigtests = "LearnGame" >::: [
+ "tic-tac-toe" >::
+ (fun () ->
+ Distinguish.set_debug_level 0; (* set to 1 to get some info printed out *)
+ let partylist0 = [
+ List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+P . .
+. . .
+. . .
+. . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q Q .
+. . .
+P . .
+. . .
+. . .
+. . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q Q .
+. . .
+P P .
+. . .
+. . .
+. . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q Q Q
+. . .
+P P .
+. . .
+. . .
+. . .
+\"";
+ ]; List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+Q P .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q P .
+. . .
+Q . .
+. . .
+. . .
+. . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q P .
+. . .
+Q P .
+. . .
+. . .
+. . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q P .
+. . .
+Q P .
+. . .
+Q . .
+. . .
+\"";]
+ ] in
+let partylist1 = [
+ List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. . .
+. . .
+. . .
+P . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. Q .
+. . .
+. . .
+P . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. Q .
+. . .
+. . .
+P P .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. Q Q
+. . .
+. . .
+P P .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . P
+. . .
+. Q Q
+. . .
+. . .
+P P .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q Q P
+. . .
+. Q Q
+. . .
+. . .
+P P .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q Q P
+. . .
+. Q Q
+. . .
+. . .
+P P P
+\"";
+ ]; List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. . .
+. . .
+. . .
+. . .
+\"" ;
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. . .
+. . .
+. . .
+P . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. Q .
+. . .
+. . .
+P . .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. Q .
+. . .
+. . .
+P P .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. Q Q
+. . .
+. . .
+P P .
+\"";
+"[ | P:1 {}; Q:1 {} | ] \"
+Q . .
+. . .
+. Q Q
+. . .
+. . .
+P P P
+\"";
+ ]
+ ; List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . .
+. . .
+. . .
+. . .
+P P P
+\"";]
+ ; List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. P .
+. . .
+. P .
+. . .
+. P .
+\"";]
+ ; List.map struc_of_string [
+"[ | P:1 {}; Q:1 {} | ] \"
+. . .
+. . P
+. . .
+. P .
+. . .
+P . .
+\"";]
+ ] in
+assert_equal ~printer:(fun x -> x) ""
+ ((LearnGame.learnFromParties ~win0:partylist0 ~win1:partylist1
+ ~tie:[] ~wrong:[]));
+ );
+
+]
Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile 2012-01-16 01:49:42 UTC (rev 1639)
+++ trunk/Toss/Makefile 2012-01-16 14:23:37 UTC (rev 1640)
@@ -46,8 +46,9 @@
SolverINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim
ArenaINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver
PlayINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena
+LearnINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena
GGPINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play
-ServerINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP
+ServerINC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP,Learn
.INC=Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver,Arena,Play,GGP,Server
%.native: %.ml caml_extensions/pa_let_try.cmo
@@ -125,6 +126,14 @@
OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
./TossServer -fulltest GGP -v
+# Learn tests
+LearnTests: TossServer
+ OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
+ ./TossServer -fulltest Learn
+LearnTestsVerbose: TossServer
+ OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
+ ./TossServer -fulltest Learn -v
+
# Server tests
ServerTests: TossServer
OCAMLRUNPARAM=b; export OCAMLRUNPARAM; \
@@ -153,4 +162,5 @@
clean:
ocamlbuild -clean
rm -f *.cmx *.cmi *.o *.cmo *.a *.cmxa *.cma *.annot *~ TossServer
+ rm -f Formula/*~ Solver/*~ Arena/*~ Learn/*~ Play/*~ GGP/*~ Server/*~
rm -f caml_extensions/*.cmo caml_extensions/*.cmi
Deleted: trunk/Toss/Server/LearnGame.ml
===================================================================
--- trunk/Toss/Server/LearnGame.ml 2012-01-16 01:49:42 UTC (rev 1639)
+++ trunk/Toss/Server/LearnGame.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -1,149 +0,0 @@
-(* Learning games from examples. *)
-
-let debug_level = ref 0
-let set_debug_level i = (debug_level := i)
-
-let struc_of_string s =
- StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
-
-
-
-let rec evens ?(acc=[0]) k =
- let last = (List.hd (List.rev acc)) in
- if (List.hd (List.rev acc))> k then
- (List.rev (List.tl ( List.rev acc)))
- else
- evens ~acc:(acc@[(last+2)]) k
-let odds k =
- evens ~acc:[1] k
-
-
-let winFormula winningStates notWinningStates =
- if !debug_level > 0 then
- print_endline (
- "Searching WIN:\n" ^
- (String.concat "\n" (List.map Structure.str winningStates)) ^ "\nNOT\n"^
- (String.concat "\n" (List.map Structure.str notWinningStates)));
- FormulaOps.tnf_fv
- (Aux.unsome (Distinguish.distinguish winningStates notWinningStates))
-
-let cleanStructure struc =
- let funs = ref [] in
- let append_fun f _ = funs := f :: !funs in
- Structure.StringMap.iter append_fun (Structure.functions struc);
- let struc = StructureParser.parse_structure Lexer.lex (Lexing.from_string (Structure.str struc)) in
- Structure.replace_names (List.fold_left
- (fun x y ->
- Structure.clear_fun x y)
- struc !funs) Structure.StringMap.empty
- Structure.IntMap.empty
-
-
-let move struct1 struct2 =
- let changed = (Aux.unique_sorted
- ( List.map fst
- (Structure.diff_elems struct1 struct2 )) ) in
- let strucBefore =
- fst (Structure.del_elems struct1
- (Aux.list_diff
- (Aux.unique_sorted (Structure.elements struct1))
- changed )) in
- let strucAfter =
- fst (Structure.del_elems struct2
- (Aux.list_diff
- (Aux.unique_sorted (Structure.elements struct2))
- changed )) in
- ((cleanStructure strucBefore) , (cleanStructure strucAfter))
-
-let movesi i partylist =
- Aux.unique_sorted
- ~cmp: (fun (s1,s2) (t1,t2) ->
- let c = ( Structure.compare s1 t1) in
- if c != 0 then c
- else (Structure.compare s2 t2))
- (List.fold_left
- (fun acc party ->
- List.append acc
- (List.fold_left
- (fun prev i ->
- if (i < ((List.length party)-1)) then
- let m = move (List.nth party i) (List.nth party (i+1)) in
- (List.append prev [m])
- else
- (List.append prev []))
- [] (evens ~acc:[i] (List.length party)) ) )
- [] partylist)
-
-let learnFromParties partylistWin0 partylistWin1 =
- let win0 = winFormula
- (List.map (fun x -> List.hd (List.rev x)) partylistWin0)
- (List.flatten ((List.map (fun x-> List.tl (List.rev x))
- partylistWin0)@partylistWin1)) in
- let win1 = winFormula
- (List.map (fun x -> List.hd (List.rev x)) partylistWin1)
- (List.flatten ((List.map (fun x-> List.tl (List.rev x))
- partylistWin1)@partylistWin0)) in
-
- let moves0 = movesi 0 (partylistWin0 @ partylistWin1) in
- let moves1 = movesi 1 (partylistWin0 @ partylistWin1) in
-
- "PLAYERS 1, 2\n"^
- "REL Win1() = "^ (Formula.sprint win0) ^"\n"^
- "REL Win2() = "^ (Formula.sprint win1) ^"\n"^
- "RULE Mv1: " ^
- (List.fold_left
- (fun old x->
- old^"\n"^
- (Structure.str (fst x))^" -> "^(Structure.str
- (snd x)) ^
- "\nemb "^(String.concat "," (List.map fst (Structure.rel_signature
- (fst x)) )) ^ " " ^
- "pre not Win2()" )
- "" moves0) ^"\n"^
- "RULE Mv2: " ^
- (List.fold_left
- (fun old x->
- old^"\n"^
- (Structure.str (fst x))^" -> "^(Structure.str
- (snd x)) ^
- "\nemb "^(String.concat "," (List.map fst (Structure.rel_signature
- (fst x)) )) ^ " " ^
- "pre not Win1()" )
- "" moves1) ^"\n"^
- "LOC 0 {
- PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
- MOVES [Mv1 -> 1]}
- PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
-}
-LOC 1{
- PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
- PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
- MOVES [Mv2 -> 0] }
-}" ^"\n" ^
- "MODEL "^(Structure.str (List.hd (List.hd partylistWin0)))
-
-
-(* Get the play with given id from DB - as a sequence of structures. *)
-let playFromDB pid =
- let dbtable select tbl = DB.get_table !DB.dbFILE ~select tbl in
- let res = dbtable ("playid=" ^ (string_of_int pid) ) "old_states" in
- let moveStrucs = List.map (fun x -> ((int_of_string x.(4)), x.(5))) res in
- let prevs = List.sort (fun (a, b) (c, d) -> a - c) moveStrucs in
- let cur = dbtable ("playid=" ^ (string_of_int pid)) "cur_states" in
- (List.map snd prevs) @ [(List.hd cur).(5)]
-
-(* Learn a two-player win-lose-or-tie game given 4 sets of plays of another
- game [source]: [wins0] which are now supposed to be won by Player 0,
- [wins1] - now won by Player 1, [tie] - now a tie, and [wrong] which
- are not correct plays of the newly constructed game. *)
-let learnFromDB ~source ~wins0 ~wins1 ~tie ~wrong =
- if !debug_level > 0 then (
- let pl l = String.concat ", " (List.map string_of_int l) in
- print_endline ("Learning from " ^ source ^ " w0: " ^ (pl wins0) ^ " w1: " ^
- (pl wins1) ^" tie: "^ (pl tie) ^" wrong: "^ (pl wrong));
- );
- let (wins0, wins1, tie, wrong) =
- (List.map playFromDB wins0, List.map playFromDB wins1,
- List.map playFromDB tie, List.map playFromDB wrong) in
- learnFromParties (List.map (List.map struc_of_string) wins0)
- (List.map (List.map struc_of_string) wins1)
Deleted: trunk/Toss/Server/LearnGame.mli
===================================================================
--- trunk/Toss/Server/LearnGame.mli 2012-01-16 01:49:42 UTC (rev 1639)
+++ trunk/Toss/Server/LearnGame.mli 2012-01-16 14:23:37 UTC (rev 1640)
@@ -1,25 +0,0 @@
-(** Module for learning games from examples. *)
-
-val move: Structure.structure -> Structure.structure ->
- Structure.structure * Structure.structure
-
-val learnFromParties:
- Structure.structure list list -> Structure.structure list list -> string
-
-
-(** Get the play with given id from DB - as a sequence of structure strings. *)
-val playFromDB: int -> string list
-
-(** Learn a two-player win-lose-or-tie game given 4 sets of plays of another
- game [source]: [wins0] which are now supposed to be won by Player 0,
- [wins1] - now won by Player 1, [tie] - now a tie, and [wrong] which
- are not correct plays of the newly constructed game. The plays are given
- as lists of ids to be retrieved from DB, result is a toss game string. *)
-val learnFromDB: source:string -> wins0: int list -> wins1: int list ->
- tie: int list -> wrong: int list -> string
-
-
-(** {2 Debugging} *)
-
-(* At higher debug levels we prints out diagnostic information. *)
-val set_debug_level: int -> unit
Deleted: trunk/Toss/Server/LearnGameTest.ml
===================================================================
--- trunk/Toss/Server/LearnGameTest.ml 2012-01-16 01:49:42 UTC (rev 1639)
+++ trunk/Toss/Server/LearnGameTest.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -1,338 +0,0 @@
-open OUnit
-
-let formula_of_string s =
- FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
-
-let struc_of_string s =
- StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
-
-let tests = "LearnGame" >::: [
- "simple test game" >::
- (fun () ->
- let partylist0 = [
- List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. .
-. .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-. .
-. P
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-. .
-Q P
-\"" ;]] in
- let partylist1 = [
- List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. .
-. .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-. .
-P .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-. .
-P Q
-\"" ;]] in
- let res_game =
-"PLAYERS 1, 2
-REL Win1() = ex x1 (Q(x1) and ex x0 R(x1, x0))
-REL Win2() = ex x1 (Q(x1) and ex x0 R(x0, x1))
-RULE Mv1:
-[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P (1); Q:1 {}; R:2 {} | ]
-emb R,Q,P pre not Win2()
-RULE Mv2:
-[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P:1 {}; Q (1); R:2 {} | ]
-emb R,Q,P pre not Win1()
-LOC 0 {
- PLAYER 1 { PAYOFF : (Win1()) - :(Win2())
- MOVES [Mv1 -> 1]}
- PLAYER 2 { PAYOFF : (Win2()) - :(Win1()) }
-}
-LOC 1{
- PLAYER 1 { PAYOFF :(Win1()) - :(Win2()) }
- PLAYER 2 { PAYOFF :(Win2()) - :(Win1())
- MOVES [Mv2 -> 0] }
-}
-MODEL [ | P:1 {}; Q:1 {} | ] R R \"
-
- . .
-\"" in
- assert_equal ~printer:(fun x -> x) res_game
- ((LearnGame.learnFromParties partylist0 partylist1 ));
- );
-]
-
-
-let bigtests = "LearnGame" >::: [
- "tic-tac-toe" >::
- (fun () ->
- Distinguish.set_debug_level 0; (* set to 1 to get some info printed out *)
- let partylist0 = [
- List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-P . .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q .
-. . .
-P . .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q .
-. . .
-P P .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q Q
-. . .
-P P .
-. . .
-. . .
-. . .
-\"";
- ]; List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q P .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q P .
-. . .
-Q . .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q P .
-. . .
-Q P .
-. . .
-. . .
-. . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q P .
-. . .
-Q P .
-. . .
-Q . .
-. . .
-\"";]
- ] in
-let partylist1 = [
- List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-P . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q .
-. . .
-. . .
-P . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q .
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q Q
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . P
-. . .
-. Q Q
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q P
-. . .
-. Q Q
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q Q P
-. . .
-. Q Q
-. . .
-. . .
-P P P
-\"";
- ]; List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-. . .
-\"" ;
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. . .
-. . .
-. . .
-P . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q .
-. . .
-. . .
-P . .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q .
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q Q
-. . .
-. . .
-P P .
-\"";
-"[ | P:1 {}; Q:1 {} | ] \"
-Q . .
-. . .
-. Q Q
-. . .
-. . .
-P P P
-\"";
- ]
- ; List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . .
-. . .
-. . .
-. . .
-P P P
-\"";]
- ; List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. P .
-. . .
-. P .
-. . .
-. P .
-\"";]
- ; List.map struc_of_string [
-"[ | P:1 {}; Q:1 {} | ] \"
-. . .
-. . P
-. . .
-. P .
-. . .
-P . .
-\"";]
- ] in
-assert_equal ~printer:(fun x -> x) ""
- ((LearnGame.learnFromParties partylist0 partylist1 ));
- );
-
-]
Modified: trunk/Toss/Server/ReqHandler.ml
===================================================================
--- trunk/Toss/Server/ReqHandler.ml 2012-01-16 01:49:42 UTC (rev 1639)
+++ trunk/Toss/Server/ReqHandler.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -690,9 +690,36 @@
let (w1, other) = List.partition (fun (_, b) -> b = "1") other in
let (tie, other) = List.partition (fun (_, b) -> b = "2") other in
let (wrong, _) = List.partition (fun (_, b) -> b = "3") other in
- LearnGame.learnFromDB ~source:game
- ~wins0:(List.map fst w0) ~wins1:(List.map fst w1)
- ~tie:(List.map fst tie) ~wrong:(List.map fst wrong) in
+ (* Get the play with given id from DB - as a sequence of structures. *)
+ let playFromDB pid =
+ let dbtable select tbl = DB.get_table !DB.dbFILE ~select tbl in
+ let res = dbtable ("playid=" ^ (string_of_int pid) ) "old_states" in
+ let moveStrucs = List.map (fun x -> ((int_of_string x.(4)), x.(5))) res in
+ let prevs = List.sort (fun (a, b) (c, d) -> a - c) moveStrucs in
+ let cur = dbtable ("playid=" ^ (string_of_int pid)) "cur_states" in
+ (List.map snd prevs) @ [(List.hd cur).(5)] in
+ (* Learn a two-player win-lose-or-tie game given 4 sets of plays of another
+ game [source]: [wins0] which are now supposed to be won by Player 0,
+ [wins1] - now won by Player 1, [tie] - now a tie, and [wrong] which
+ are not correct plays of the newly constructed game. *)
+ let learnFromDB source wins0 wins1 tie wrong =
+ if !debug_level > 0 then (
+ let pl l = String.concat ", " (List.map string_of_int l) in
+ print_endline ("Learning from "^ source ^" w0: "^ (pl wins0) ^" w1: "^
+ (pl wins1)^" tie: "^(pl tie) ^" wrong: "^ (pl wrong));
+ );
+ let (wins0, wins1, tie, wrong) =
+ (List.map playFromDB wins0, List.map playFromDB wins1,
+ List.map playFromDB tie, List.map playFromDB wrong) in
+ let struc_of_string s =
+ StructureParser.parse_structure Lexer.lex (Lexing.from_string s) in
+ LearnGame.learnFromParties
+ ~win0:(List.map (List.map struc_of_string) wins0)
+ ~win1:(List.map (List.map struc_of_string) wins1)
+ ~tie:(List.map (List.map struc_of_string) tie)
+ ~wrong:(List.map (List.map struc_of_string) wrong) in
+ learnFromDB game (List.map fst w0) (List.map fst w1)
+ (List.map fst tie) (List.map fst wrong) in
let (tcmd, data) = split_two "#" msg in
let resp, new_cookies = match tcmd with
| "USERNAME" ->
Modified: trunk/Toss/Server/Tests.ml
===================================================================
--- trunk/Toss/Server/Tests.ml 2012-01-16 01:49:42 UTC (rev 1639)
+++ trunk/Toss/Server/Tests.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -17,7 +17,6 @@
"AssignmentsTest", [AssignmentsTest.tests];
"SolverTest", [SolverTest.tests; SolverTest.bigtests];
"ClassTest", [ClassTest.tests; ClassTest.bigtests];
- "DistinguishTest", [DistinguishTest.tests; DistinguishTest.bigtests];
]
let arena_tests = "Arena", [
@@ -41,10 +40,14 @@
"TranslateFormulaTest", [TranslateFormulaTest.tests];
]
+let learn_tests = "Learn", [
+ "DistinguishTest", [DistinguishTest.tests; DistinguishTest.bigtests];
+ "LearnGameTest", [LearnGameTest.tests; LearnGameTest.bigtests];
+]
+
let server_tests = "Server", [
"PictureTest", [PictureTest.tests];
"ReqHandlerTest", [ReqHandlerTest.tests];
- "LearnGameTest", [LearnGameTest.tests; LearnGameTest.bigtests];
]
let tests_l = [
@@ -53,6 +56,7 @@
arena_tests;
play_tests;
ggp_tests;
+ learn_tests;
server_tests;
]
Deleted: trunk/Toss/Solver/Distinguish.ml
===================================================================
--- trunk/Toss/Solver/Distinguish.ml 2012-01-16 01:49:42 UTC (rev 1639)
+++ trunk/Toss/Solver/Distinguish.ml 2012-01-16 14:23:37 UTC (rev 1640)
@@ -1,269 +0,0 @@
-open Formula
-
-let debug_level = ref 0
-let set_debug_level i = (debug_level := i)
-
-type logic = FO | GuardedFO
-
-
-(* Helper functions to construct variables for indices. *)
-let varname i = "x" ^ string_of_int i
-let varnames k = List.map varname (Aux.range k)
-let var i = var_of_string (varname i)
-let fo_var i = fo_var_of_string (varname i)
-
-(* Helper function: check if a formula holds for a tuple on a structure. *)
-let check structure tuple formula =
- let eval structure phi assignment =
- (Solver.M.evaluate_partial structure assignment phi) in
- let elems = Assignments.set_to_set_list (Structure.elems structure) in
- let vars =Array.map fo_var (Array.of_list (Aux.range (Array.length tuple))) in
- let assignment = if tuple = [||] then AssignmentSet.Any else
- Assignments.assignments_of_list elems vars [tuple] in
- eval structure formula assignment <> AssignmentSet.Empty
-
-(* - Atoms and FO Types - *)
-
-(* The list of literals which hold for a tuple on a structure. *)
-let atoms struc tuple =
- let k = Array.length tuple in
- let rec equalities = function
- | [] -> []
- | v :: vs -> (List.map (fun x -> Eq (`FO v,`FO x)) vs) @ (equalities vs) in
- let atoms = FormulaOps.atoms (Structure.rel_signature struc) (varnames k) in
- List.map (
- fun atom -> if check struc tuple atom then atom else (Not atom)
- ) (ato...
[truncated message content] |
|
From: <luk...@us...> - 2012-01-16 01:49:48
|
Revision: 1639
http://toss.svn.sourceforge.net/toss/?rev=1639&view=rev
Author: lukaszkaiser
Date: 2012-01-16 01:49:42 +0000 (Mon, 16 Jan 2012)
Log Message:
-----------
Byte compilation corrections.
Modified Paths:
--------------
trunk/Toss/Makefile
Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile 2012-01-06 00:34:49 UTC (rev 1638)
+++ trunk/Toss/Makefile 2012-01-16 01:49:42 UTC (rev 1639)
@@ -33,14 +33,11 @@
# -------- MAIN OCAMLBUILD PART --------
OCB_LFLAG=-lflags -I,+oUnit,-I,+sqlite3,-I,+site-lib/oUnit,-I,+site-lib/sqlite3
-OCB_LFLAGBT=-lflags -I,+oUnit,-I,+sqlite3,-I,+site-lib/oUnit,-I,+site-lib/sqlite3
OCB_CFLAG=-cflags -I,+oUnit,-I,+sqlite3,-I,+site-lib/oUnit,-I,+site-lib/sqlite3,-g
OCB_LIB=-libs str,nums,unix,oUnit,sqlite3
OCB_PP=-pp "camlp4o ../caml_extensions/pa_let_try.cmo"
OCAMLBUILD=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf $(OCB_PP) \
$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
-OCAMLBUILDBT=ocamlbuild -log build.log -j 8 menhir ../menhir_conf $(OCB_PP) \
- $(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAGBT)
OCAMLBUILDNOPP=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf \
$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
@@ -59,8 +56,11 @@
%.p.native: %.ml caml_extensions/pa_let_try.cmo
$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
+%.byte: %.ml caml_extensions/pa_let_try.cmo
+ $(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
+
%.d.byte: %.ml caml_extensions/pa_let_try.cmo
- $(OCAMLBUILDBT) -Is $($(subst /,INC,$(dir $@))) $@
+ $(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
doc: caml_extensions/pa_let_try.cmo
$(OCAMLBUILDNOPP) -Is +oUnit,+sqlite3,$(.INC) Toss.docdir/index.html
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2012-01-06 00:34:55
|
Revision: 1638
http://toss.svn.sourceforge.net/toss/?rev=1638&view=rev
Author: lukaszkaiser
Date: 2012-01-06 00:34:49 +0000 (Fri, 06 Jan 2012)
Log Message:
-----------
Better resolution and parametrized grid detection.
Modified Paths:
--------------
trunk/Toss/Learn/reco.cpp
trunk/Toss/Learn/shapes.c
Modified: trunk/Toss/Learn/reco.cpp
===================================================================
--- trunk/Toss/Learn/reco.cpp 2011-12-28 22:45:36 UTC (rev 1637)
+++ trunk/Toss/Learn/reco.cpp 2012-01-06 00:34:49 UTC (rev 1638)
@@ -8,10 +8,10 @@
}
#include<cstdio>
-#define SIZEX 128 // 352/2 - MARGINX*2
-#define SIZEY 128 // 288/2 - MARGINY*2
-#define MARGINX 24
-#define MARGINY 8
+#define SIZEX 256 // 352 - MARGINX*2
+#define SIZEY 256 // 288 - MARGINY*2
+#define MARGINX 48
+#define MARGINY 16
void reset (char a[SIZEX][SIZEY]) {
for (int j = 0; j < SIZEY; j++) {
@@ -55,7 +55,9 @@
int rnbr = -2;
cvNamedWindow ("Reco", CV_WINDOW_AUTOSIZE);
- CvCapture* capture = cvCreateFileCapture ("videos/tic_tac_toe_0.3gp");
+ CvCapture* capture = cvCreateFileCapture
+ //("videos/chess1.3gp");
+ ("videos/tic_tac_toe_0.3gp");
//cvCreateCameraCapture( 0 );
IplImage* img;
IplImage* gray;
@@ -100,7 +102,7 @@
CvSeq* lines = 0;
int i;
lines = cvHoughLines2( small, storage, CV_HOUGH_PROBABILISTIC,
- 1, CV_PI/180, 40, 50, 30 );
+ 1, CV_PI/180, 80, 50, 30 );
for( i = 0; i < lines->total; i++ ) {
CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i);
cvLine( small, line[0], line[1], CV_RGB(100,200,200), 3 );
Modified: trunk/Toss/Learn/shapes.c
===================================================================
--- trunk/Toss/Learn/shapes.c 2011-12-28 22:45:36 UTC (rev 1637)
+++ trunk/Toss/Learn/shapes.c 2012-01-06 00:34:49 UTC (rev 1638)
@@ -1013,7 +1013,7 @@
patterns[i].name, &patterns[i].max_dist, &patterns[i].correction,
&patterns[i].scale_correction);
offset += move_by_space (9, str + offset);
- // printf ("Reading %s.\n", patterns[i].name);
+ //printf ("Reading %s.\n", patterns[i].name);
sscanf (str + offset, " ROTATION MIN %lf MAX %lf DENSITY %lf",
&patterns[i].min_rotation, &patterns[i].max_rotation,
&patterns[i].rotation_density);
@@ -1024,6 +1024,7 @@
if (patterns[i].correction < 0) patterns[i].correction = 0;
interval* shape = sread_shape (str, &shape_size, &offset);
+ //print_shape (shape, shape_size);
while (shape_size <= densing_size) {
interval* new_shape = dense_shape (shape, shape_size);
@@ -1327,6 +1328,19 @@
int gridSIZES[gridSIZE][gridSIZE];
interval * gridSHAPES[gridSIZE][gridSIZE];
+void print_grid (char* s, int n) {
+ int o;
+ o = sprintf (s, "SHAPES 1 PRECISION 4 RECO FACTOR 1.6 ");
+ o += sprintf (s+o, "SHAPE grid MAXDIST 900 CORRECTION 2 ");
+ o += sprintf (s+o, "SCALE DEVIATION 0 ROTATION MIN -1 MAX 1 DENSITY 0 ");
+ o += sprintf (s+o, "START %i ", 2*n+2);
+ int i = 0;
+ for (i = 0; i < n+1; i++) {
+ o += sprintf (s+o, "(%i, %i) -- (%i, %i) ", -n, n - 2*i, n, n - 2*i);
+ o += sprintf (s+o, "(%i, %i) -- (%i, %i) ", n - 2*i, -n, n - 2*i, n);
+ }
+ sprintf (s+o, "END\n");
+}
/* Run complete recognition from string, return result. */
void recognize_from_string (const char* shape_str, const char* full_str,
@@ -1346,8 +1360,11 @@
/* printf ("Smaller shape:\n");
print_shape (smaller_shape, smaller_shape_size); */
+ char init_grid[20000];
+ print_grid (init_grid, gridSIZE);
+
int res = 0;
- init_patterns_from_string (default_shape_patterns);
+ init_patterns_from_string (init_grid);
res = match_pattern (smaller_shape, smaller_shape_size);
*res_nbr = res;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-12-28 22:45:43
|
Revision: 1637
http://toss.svn.sourceforge.net/toss/?rev=1637&view=rev
Author: lukaszkaiser
Date: 2011-12-28 22:45:36 +0000 (Wed, 28 Dec 2011)
Log Message:
-----------
Using Hough lines for grid detection.
Modified Paths:
--------------
trunk/Toss/Learn/reco.cpp
trunk/Toss/Learn/shapes.c
trunk/Toss/Learn/shapes.h
Modified: trunk/Toss/Learn/reco.cpp
===================================================================
--- trunk/Toss/Learn/reco.cpp 2011-12-10 23:39:15 UTC (rev 1636)
+++ trunk/Toss/Learn/reco.cpp 2011-12-28 22:45:36 UTC (rev 1637)
@@ -8,9 +8,9 @@
}
#include<cstdio>
-#define SIZEX 146 //352 - MARGINX / 2
-#define SIZEY 130 //288 - MARGINY / 2
-#define MARGINX 22
+#define SIZEX 128 // 352/2 - MARGINX*2
+#define SIZEY 128 // 288/2 - MARGINY*2
+#define MARGINX 24
#define MARGINY 8
void reset (char a[SIZEX][SIZEY]) {
@@ -25,6 +25,7 @@
void print_ppm (char pic[SIZEX][SIZEY], char * prefix) {
char fname[80];
sprintf (fname, "%s%i.ppm", prefix, print_counter);
+ printf ("%s%i.ppm\n", prefix, print_counter);
print_counter++;
FILE * f = fopen (fname, "w");
fprintf (f, "P3\n%i %i\n255\n", SIZEX, SIZEY);
@@ -55,7 +56,7 @@
cvNamedWindow ("Reco", CV_WINDOW_AUTOSIZE);
CvCapture* capture = cvCreateFileCapture ("videos/tic_tac_toe_0.3gp");
- //cvCreateCameraCapture( 0 );
+ //cvCreateCameraCapture( 0 );
IplImage* img;
IplImage* gray;
IplImage* small;
@@ -66,6 +67,8 @@
int ok_around;
char shape_str[SIZEX*SIZEY*24] = "";
int shape_str_pos = 0;
+ char fullsh_str[SIZEX*SIZEY*24] = "";
+ int fullsh_str_pos = 0;
reset (data);
@@ -77,6 +80,7 @@
small = cvCreateImage (cvSize (SIZEX + 2*MARGINX, SIZEY + 2*MARGINY), 8, 1);
cvResize (gray, small, CV_INTER_LINEAR);
cvCanny (small, small, 50, 100);
+
data_count = 0;
for (int i = 0; i < SIZEX; i++) {
for (int j = 0; j < SIZEY; j++) {
@@ -87,11 +91,22 @@
data[i][j+1] + data[i-1][j-1] + data[i+1][j-1] +
data[i][j-1] + data[i-1][j+1] + data[i+1][j+1];
ok_around = ok_around == 0 ? 0 : 1;
- data[i][j] = cur_data > 2 ? ok_around : 0;
+ data[i][j] = cur_data > 2 ? 1 : 0; //ok_around : 0;
if (data[i][j] == 1) data_count++;
}
}
- if (time % 5 == 0 && data_count < 500) { // we see empty picture, reset
+
+ CvMemStorage* storage = cvCreateMemStorage(0);
+ CvSeq* lines = 0;
+ int i;
+ lines = cvHoughLines2( small, storage, CV_HOUGH_PROBABILISTIC,
+ 1, CV_PI/180, 40, 50, 30 );
+ for( i = 0; i < lines->total; i++ ) {
+ CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i);
+ cvLine( small, line[0], line[1], CV_RGB(100,200,200), 3 );
+ }
+
+ if (time % 5 == 0 && (data_count<500 || lines->total<5)) { //empty, reset
reset (data);
time = 1;
}
@@ -104,23 +119,50 @@
}
cvShowImage( "Reco", small );
if (time % 70 == 0) { // wait < 4s for now
- shape_str_pos = sprintf (shape_str, "START %i ", data_count);
+ int ok_lines = 0;
+ for( i = 0; i < lines->total; i++ ) {
+ CvPoint* line = (CvPoint*)cvGetSeqElem(lines,i);
+ if ((line[0].x >= MARGINX && line[0].x <= SIZEX+MARGINX &&
+ line[0].y >= MARGINY && line[0].y <= SIZEY+MARGINY) ||
+ (line[1].x >= MARGINX && line[1].x <= SIZEX+MARGINX &&
+ line[1].y >= MARGINY && line[1].y <= SIZEY+MARGINY)) {
+ ok_lines++;
+ }
+ }
+
+ shape_str_pos = sprintf (shape_str, "START %i ", ok_lines);
+ for( i = 0; i < lines->total; i++ ) {
+ CvPoint* line = (CvPoint*) cvGetSeqElem (lines, i);
+ if ((line[0].x >= MARGINX && line[0].x <= SIZEX+MARGINX &&
+ line[0].y >= MARGINY && line[0].y <= SIZEY+MARGINY) ||
+ (line[1].x >= MARGINX && line[1].x <= SIZEX+MARGINX &&
+ line[1].y >= MARGINY && line[1].y <= SIZEY+MARGINY)) {
+ shape_str_pos += sprintf (shape_str + shape_str_pos,
+ "(%i, %i) -- (%i, %i) ",
+ line[0].x - MARGINX, line[0].y - MARGINY,
+ line[1].x - MARGINX, line[1].y - MARGINY);
+ }
+ }
+
+ fullsh_str_pos = sprintf (fullsh_str, "START %i ", data_count);
for (int i = 0; i < SIZEX; i++) {
for (int j = 0; j < SIZEY; j++) {
if (data[i][j] == 1) {
- shape_str_pos += sprintf (shape_str + shape_str_pos,
- "(%i, %i) -- (%i, %i) ", i, j, i, j);
+ fullsh_str_pos += sprintf (fullsh_str + fullsh_str_pos,
+ "(%i, %i) -- (%i, %i) ", i, j, i, j);
}
}
}
- sprintf (shape_str + shape_str_pos, " END");
- printf ("step: %i\nsize: %i\nreco:\n", time/70, data_count);
- print_ppm (data, (char*) "log");
+ sprintf (fullsh_str + fullsh_str_pos, " END");
+ printf ("step: %i\nlines: %i\ndata: %i\nreco:\n",
+ time/70, lines->total, data_count);
+ if (time/70 > 1) { print_ppm (data, (char*) "log"); }
reset (data);
- recognize_from_string (shape_str, res, &rnbr, time/70 - 1);
+ recognize_from_string (shape_str, fullsh_str, res, &rnbr, time/70 - 1);
printf ("%i\n", rnbr);
for (int i = 0; i < 2000; i++) res[i] = 0;
for (int i = 0; i < SIZEX*SIZEY*24; i++) shape_str[i] = 0;
+ for (int i = 0; i < SIZEX*SIZEY*24; i++) fullsh_str[i] = 0;
}
time++;
char c = cvWaitKey (50);
Modified: trunk/Toss/Learn/shapes.c
===================================================================
--- trunk/Toss/Learn/shapes.c 2011-12-10 23:39:15 UTC (rev 1636)
+++ trunk/Toss/Learn/shapes.c 2011-12-28 22:45:36 UTC (rev 1637)
@@ -289,12 +289,9 @@
}
/* Scale a shape by a scale vector, given as a point. */
-static void scale_shape (const point scale, interval* shape, const int size)
+static void scale_shape_m (const point scale, interval* shape, const int size,
+ const double mx, const double my)
{
- interval mids = mid_dimen (shape, size);
- double mx = mids.start.x;
- double my = mids.start.y;
-
int i = 0;
for (i = 0; i < size; i++) {
shape[i].start.x = ((shape[i].start.x - mx) * scale.x) + mx;
@@ -304,9 +301,17 @@
}
}
+/* Scale a shape by a scale vector, given as a point. */
+static void scale_shape (const point scale, interval* shape, const int size)
+{
+ interval mids = mid_dimen (shape, size);
+ scale_shape_m (scale, shape, size, mids.start.x, mids.start.y);
+}
+
/* Scale a shape and its points by a scale vector, given as a point. */
-static void scale_shape_points (const point scale, interval* shape, const int size,
- point* points, const int points_size)
+static void scale_shape_points (const point scale, interval* shape,
+ const int size,
+ point* points, const int points_size)
{
interval mids = mid_dimen (shape, size);
double mx = mids.start.x;
@@ -337,12 +342,9 @@
}
/* Rotate a shape by an angle, in radians. */
-static void rotate_shape (const double angle, interval* shape, const int size)
+static void rotate_shape_m (const double angle, interval* shape, const int size,
+ const double mx, const double my)
{
- interval mids = mid_dimen (shape, size);
- double mx = mids.start.x;
- double my = mids.start.y;
-
int i = 0;
for (i = 0; i < size; i++) {
rotate_point (&shape[i].start, angle, mx, my);
@@ -350,6 +352,14 @@
}
}
+/* Rotate a shape by an angle, in radians. */
+static void rotate_shape (const double angle, interval* shape, const int size)
+{
+ interval mids = mid_dimen (shape, size);
+ rotate_shape_m (angle, shape, size, mids.start.x, mids.start.y);
+}
+
+
/* Scale a shape and its points by a scale vector, given as a point. */
static void rotate_shape_points (const double angle, interval* shape, const int size,
point* points, const int points_size)
@@ -1256,11 +1266,6 @@
/* Default patterns. */
-/* There are 35 shapes with letters, but we skip letters and use only 10. */
-/*(-3, -3) -- (-3, 3) \
-(-3, 3) -- (3, 3) \
-(3, 3) -- (3, -3) \
-(3, -3) -- (-3, -3) \ */
static const char* default_shape_patterns = "\
SHAPES 1 \
PRECISION 4 \
@@ -1279,471 +1284,6 @@
(-3, -1) -- (3, -1) \
(-3, 1) -- (3, 1) \
END \
- \
-SHAPE grid3mid MAXDIST 900 CORRECTION 1 \
-SCALE DEVIATION 0.2 \
-ROTATION MIN -10 MAX 10 DENSITY 0 \
-START 6 \
-(-1, -3) -- (-1, 3) \
-(1, -3) -- (1, 3) \
-(-3, -1) -- (3, -1) \
-(-3, 1) -- (3, 1) \
-(0.8, 0.8) -- (-0.8, -0.8) \
-(0.8, -0.8) -- (-0.8, 0.8) \
-END \
- \
-SHAPE arrow2 MAXDIST 9 CORRECTION 2.2 \
-SCALE DEVIATION 0 \
-ROTATION MIN -180 MAX 180 DENSITY 0 \
-START 7 \
-(0, -2) -- (0, -1) \
-(0, -1) -- (0, 0) \
-(0, 0) -- (0, 1) \
-(0, 1) -- (0, 2) \
-(0, 2) -- (-0.5, 1.5) \
-(-0.5, 1.5) -- (0, 2) \
-(0, 2) -- (0.5, 1.5) \
-END \
- \
- \
-SHAPE backarrow1 MAXDIST 9 CORRECTION 1.6 \
-SCALE DEVIATION 0 \
-ROTATION MIN -180 MAX 180 DENSITY 0 \
-START 18 \
-(0.75, 0.25) -- (1, 0) \
-(1, 0) -- (1.25, 0.25) \
-(1.25, 0.25) -- (1, 0) \
-(1.000000, 0.000000) -- (0.951057, 0.309017) \
-(0.951057, 0.309017) -- (0.809017, 0.587785) \
-(0.809017, 0.587785) -- (0.587785, 0.809017) \
-(0.587785, 0.809017) -- (0.309017, 0.951057) \
-(0.309017, 0.951057) -- (0.000000, 1.000000) \
-(0.000000, 1.000000) -- (-0.309017, 0.951057) \
-(-0.309017, 0.951057) -- (-0.587785, 0.809017) \
-(-0.587785, 0.809017) -- (-0.809017, 0.587785) \
-(-0.809017, 0.587785) -- (-0.951057, 0.309017) \
-(-0.951057, 0.309017) -- (-1.000000, 0.000000) \
-(-1.000000, 0.000000) -- (-0.951057, -0.309017) \
-(-0.951057, -0.309017) -- (-0.809017, -0.587785) \
-(-0.809017, -0.587785) -- (-0.587785, -0.809017) \
-(-0.587785, -0.809017) -- (-0.309017, -0.951057) \
-(-0.309017, -0.951057) -- (-0.000000, -1.000000) \
-END \
- \
- \
-SHAPE backarrow2 MAXDIST 9 CORRECTION 1.6 \
-SCALE DEVIATION 0 \
-ROTATION MIN -180 MAX 180 DENSITY 0 \
-START 18 \
-(1.000000, 0.000000) -- (0.951057, 0.309017) \
-(0.951057, 0.309017) -- (0.809017, 0.587785) \
-(0.809017, 0.587785) -- (0.587785, 0.809017) \
-(0.587785, 0.809017) -- (0.309017, 0.951057) \
-(0.309017, 0.951057) -- (0.000000, 1.000000) \
-(0.000000, 1.000000) -- (-0.309017, 0.951057) \
-(-0.309017, 0.951057) -- (-0.587785, 0.809017) \
-(-0.587785, 0.809017) -- (-0.809017, 0.587785) \
-(-0.809017, 0.587785) -- (-0.951057, 0.309017) \
-(-0.951057, 0.309017) -- (-1.000000, 0.000000) \
-(-1.000000, 0.000000) -- (-0.951057, -0.309017) \
-(-0.951057, -0.309017) -- (-0.809017, -0.587785) \
-(-0.809017, -0.587785) -- (-0.587785, -0.809017) \
-(-0.587785, -0.809017) -- (-0.309017, -0.951057) \
-(-0.309017, -0.951057) -- (-0.000000, -1.000000) \
-(0, -1) -- (-0.25, -0.75) \
-(-0.25, -0.75) -- (0, -1) \
-(0, -1) -- (-0.25, -1.25) \
-END \
- \
- \
-SHAPE bentarrow1 MAXDIST 9 CORRECTION 2 \
-SCALE DEVIATION 0 \
-ROTATION MIN -180 MAX 180 DENSITY 0 \
-START 11 \
-(0.751057, 0.309017) -- (0.951057, 0.309017) \
-(0.951057, 0.309017) -- (0.951057, 0.509017) \
-(0.951057, 0.509017) -- (0.951057, 0.309017) \
-(0.951057, 0.309017) -- (0.809017, 0.587785) \
-(0.809017, 0.587785) -- (0.587785, 0.809017) \
-(0.587785, 0.809017) -- (0.309017, 0.951057) \
-(0.309017, 0.951057) -- (0.000000, 1.000000) \
-(0.000000, 1.000000) -- (-0.309017, 0.951057) \
-(-0.309017, 0.951057) -- (-0.587785, 0.809017) \
-(-0.587785, 0.809017) -- (-0.809017, 0.587785) \
-(-0.809017, 0.587785) -- (-0.951057, 0.309017) \
-END \
- \
- \
-SHAPE bentarrow2 MAXDIST 9 CORRECTION 2 \
-SCALE DEVIATION 0 \
-ROTATION MIN -180 MAX 180 DENSITY 0 \
-START 11 \
-(0.951057, 0.309017) -- (0.809017, 0.587785) \
-(0.809017, 0.587785) -- (0.587785, 0.809017) \
-(0.587785, 0.809017) -- (0.309017, 0.951057) \
-(0.309017, 0.951057) -- (0.000000, 1.000000) \
-(0.000000, 1.000000) -- (-0.309017, 0.951057) \
-(-0.309017, 0.951057) -- (-0.587785, 0.809017) \
-(-0.587785, 0.809017) -- (-0.809017, 0.587785) \
-(-0.809017, 0.587785) -- (-0.951057, 0.309017) \
-(-0.951057, 0.309017) -- (-0.951057, 0.509017) \
-(-0.951057, 0.509017) -- (-0.951057, 0.309017) \
-(-0.951057, 0.309017) -- (-0.751057, 0.309017) \
-END \
- \
- \
-SHAPE triangle MAXDIST 8 CORRECTION 1.7 \
-SCALE DEVIATION 0.2 \
-ROTATION MIN -180 MAX 180 DENSITY 30 \
-START 6 \
-(0, 0) -- (1, 0) \
-(1, 0) -- (2, 0) \
-(2, 0) -- (1.5, 0.866025) \
-(1.5, 0.866025) -- (1, 1.732051) \
-(1, 1.732051) -- (0.5, 0.866025) \
-(0.5, 0.866025) -- (0, 0) \
-END \
- \
- \
-SHAPE rectangle MAXDIST 7 CORRECTION 0.8 \
-SCALE DEVIATION 0.35 \
-ROTATION MIN -45 MAX 45 DENSITY 45 \
-START 8 \
-(0, 0) -- (0, 1) \
-(0, 1) -- (0, 2) \
-(0, 2) -- (1, 2) \
-(1, 2) -- (2, 2) \
-(2, 2) -- (2, 1) \
-(2, 1) -- (2, 0) \
-(2, 0) -- (1, 0) \
-(1, 0) -- (0, 0) \
-END \
- \
-SHAPE circle MAXDIST 7 CORRECTION 0 \
-SCALE DEVIATION 0.35 \
-ROTATION MIN -45 MAX 45 DENSITY 90 \
-START 41 \
-(1.000000, 0.000000) -- (0.988280, 0.152649) \
-(0.988280, 0.152649) -- (0.953396, 0.301721) \
-(0.953396, 0.301721) -- (0.896166, 0.443720) \
-(0.896166, 0.443720) -- (0.817929, 0.575319) \
-(0.817929, 0.575319) -- (0.720522, 0.693433) \
-(0.720522, 0.693433) -- (0.606225, 0.795293) \
-(0.606225, 0.795293) -- (0.477720, 0.878512) \
-(0.477720, 0.878512) -- (0.338017, 0.941140) \
-(0.338017, 0.941140) -- (0.190391, 0.981708) \
-(0.190391, 0.981708) -- (0.038303, 0.999266) \
-(0.038303, 0.999266) -- (-0.114683, 0.993402) \
-(-0.114683, 0.993402) -- (-0.264982, 0.964253) \
-(-0.264982, 0.964253) -- (-0.409069, 0.912504) \
-(-0.409069, 0.912504) -- (-0.543568, 0.839365) \
-(-0.543568, 0.839365) -- (-0.665326, 0.746553) \
-(-0.665326, 0.746553) -- (-0.771489, 0.636242) \
-(-0.771489, 0.636242) -- (-0.859570, 0.511019) \
-(-0.859570, 0.511019) -- (-0.927502, 0.373817) \
-(-0.927502, 0.373817) -- (-0.973695, 0.227854) \
-(-0.973695, 0.227854) -- (-0.997066, 0.076549) \
-(-0.997066, 0.076549) -- (-0.997066, -0.076549) \
-(-0.997066, -0.076549) -- (-0.973695, -0.227854) \
-(-0.973695, -0.227854) -- (-0.927502, -0.373817) \
-(-0.927502, -0.373817) -- (-0.859570, -0.511019) \
-(-0.859570, -0.511019) -- (-0.771489, -0.636242) \
-(-0.771489, -0.636242) -- (-0.665326, -0.746553) \
-(-0.665326, -0.746553) -- (-0.543568, -0.839365) \
-(-0.543568, -0.839365) -- (-0.409069, -0.912504) \
-(-0.409069, -0.912504) -- (-0.264982, -0.964253) \
-(-0.264982, -0.964253) -- (-0.114683, -0.993402) \
-(-0.114683, -0.993402) -- (0.038303, -0.999266) \
-(0.038303, -0.999266) -- (0.190391, -0.981708) \
-(0.190391, -0.981708) -- (0.338017, -0.941140) \
-(0.338017, -0.941140) -- (0.477720, -0.878512) \
-(0.477720, -0.878512) -- (0.606225, -0.795293) \
-(0.606225, -0.795293) -- (0.720522, -0.693433) \
-(0.720522, -0.693433) -- (0.817929, -0.575319) \
-(0.817929, -0.575319) -- (0.896166, -0.443720) \
-(0.896166, -0.443720) -- (0.953396, -0.301721) \
-(0.953396, -0.301721) -- (0.988280, -0.152649) \
-(0.988280, -0.152649) -- (1.000000, -0.000000) \
-END \
- \
-SHAPE A MAXDIST 8 CORRECTION 2 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 4 \
-(0.5, 4) -- (0.2, 4) \
-(0.2, 4) -- (-1.5, 0) \
-(0.5, 4) -- (1.5, 0) \
-(-0.8, 2) -- (1.2, 2) \
-END \
- \
-SHAPE B MAXDIST 8 CORRECTION 3.6 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 11 \
-(0, 4) -- (0, 0) \
-(0, 0) -- (1.5, 0) \
-(1.5, 0) -- (2.2, 0.5) \
-(2.2, 0.5) -- (2.4, 1.1) \
-(2.4, 1.1) -- (2.2, 1.7) \
-(2.2, 1.7) -- (1.5, 2.2) \
-(1.5, 2.2) -- (1.2, 2.2) \
-(1.2, 2.2) -- (1.8, 3.1) \
-(1.8, 3.1) -- (1.2, 4) \
-(1.2, 4) -- (0, 4) \
-(0, 2.2) -- (1.2, 2.2) \
-END \
- \
-SHAPE C MAXDIST 8 CORRECTION 2.2 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 8 \
-(3, 0.8) -- (2, 0) \
-(2, 0) -- (1, 0) \
-(1, 0) -- (0, 1) \
-(0, 1) -- (0, 2) \
-(0, 2) -- (0, 3) \
-(0, 3) -- (1, 4) \
-(1, 4) -- (2, 4) \
-(2, 4) -- (2.5, 3.5) \
-END \
- \
-SHAPE D MAXDIST 8 CORRECTION 2.4 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 7 \
-(0, 4) -- (0, 2) \
-(0, 2) -- (0, 0) \
-(0, 0) -- (1, 0) \
-(1, 0) -- (2, 0.8) \
-(2, 0.8) -- (2, 2.8) \
-(2, 2.8) -- (1, 4) \
-(1, 4) -- (0, 4) \
-END \
- \
-SHAPE E MAXDIST 8 CORRECTION 2.6 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 5 \
-(0, 4) -- (0, 0) \
-(2, 0) -- (0, 0) \
-(0, 0) -- (0, 2) \
-(1.5, 2) -- (0, 2) \
-(0, 4) -- (2, 4) \
-END \
- \
-SHAPE F MAXDIST 8 CORRECTION 3.8 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 4 \
-(0, 0) -- (0, 4) \
-(0, 4) -- (2.5, 4) \
-(2.5, 4) -- (2.5, 3.8) \
-(0, 1.9) -- (1.8, 1.9) \
-END \
- \
-SHAPE G MAXDIST 8 CORRECTION 3.4 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 9 \
-(2, 4) -- (1, 4) \
-(1, 4) -- (0, 3) \
-(0, 3) -- (0, 2) \
-(0, 2) -- (0, 1) \
-(0, 1) -- (1, 0) \
-(1, 0) -- (2, 0) \
-(2, 0) -- (2.5, 2) \
-(2.5, 2) -- (1.5, 2) \
-(1.5, 2) -- (3.5, 2) \
-END \
- \
-SHAPE H MAXDIST 8 CORRECTION 2.4 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 4 \
-(0, 4) -- (0, 0) \
-(2.5, 4) -- (2.5, 0) \
-(0, 1.8) -- (1.5, 1.8) \
-(1.5, 1.8) -- (2.5, 2) \
-END \
- \
-SHAPE I MAXDIST 8 CORRECTION 3.2 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 3 \
-(-1, 0) -- (1, 0) \
-(0, 0) -- (0, 4) \
-(-1, 4) -- (1, 4) \
-END \
- \
-SHAPE J MAXDIST 8 CORRECTION 3.8 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 4 \
-(-2, 4) -- (0, 4) \
-(0, 4) -- (0, 1) \
-(0, 1) -- (-1, 0) \
-(-1, 0) -- (-2, 1) \
-END \
- \
-SHAPE K MAXDIST 8 CORRECTION 1.5 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 3 \
-(0, 4) -- (0, 0) \
-(0, 1) -- (3, 4) \
-(0.5, 1.5) -- (3, 0) \
-END \
- \
-SHAPE L MAXDIST 8 CORRECTION 2 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 2 \
-(0, 4) -- (0, 0) \
-(0, 0) -- (2, 0) \
-END \
- \
-SHAPE M MAXDIST 8 CORRECTION 2.5 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 6 \
-(0, 0) -- (0, 4) \
-(0, 4) -- (1.2, 2.2) \
-(1.2, 2.2) -- (1.5, 2) \
-(1.5, 2) -- (1.8, 2.2) \
-(1.8, 2.2) -- (3, 4) \
-(3, 4) -- (3, 0) \
-END \
- \
-SHAPE N MAXDIST 8 CORRECTION 2 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 4 \
-(0, 0) -- (0, 4) \
-(0, 4) -- (2, 0.5) \
-(2, 0.5) -- (2.5, 1) \
-(2.5, 1) -- (2.8, 4) \
-END \
- \
-SHAPE P MAXDIST 8 CORRECTION 1.5 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 6 \
-(0, 0) -- (0, 4) \
-(0, 4) -- (1, 4) \
-(1, 4) -- (2, 3.5) \
-(2, 3.5) -- (2, 2.5) \
-(2, 2.5) -- (1, 2) \
-(1, 2) -- (0, 2) \
-END \
- \
-SHAPE Q MAXDIST 8 CORRECTION 3.4 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 9 \
-(2, 0) -- (1, 0) \
-(1, 0) -- (0, 1) \
-(0, 1) -- (0, 3) \
-(0, 3) -- (1, 4) \
-(1, 4) -- (2, 4) \
-(2, 4) -- (3, 3) \
-(3, 3) -- (3, 1) \
-(3, 1) -- (2, 0) \
-(2, 1) -- (4, 0) \
-END \
- \
-SHAPE R MAXDIST 8 CORRECTION 2.2 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 7 \
-(0, 0) -- (0, 4) \
-(0, 4) -- (1, 4) \
-(1, 4) -- (2, 3.5) \
-(2, 3.5) -- (2, 2.5) \
-(2, 2.5) -- (1, 2) \
-(1, 2) -- (0, 2) \
-(0, 2) -- (2, 0) \
-END \
- \
-SHAPE S MAXDIST 8 CORRECTION 2.6 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 8 \
-(1.5, 3.5) -- (1, 4) \
-(1, 4) -- (0, 4) \
-(0, 4) -- (-1, 3) \
-(-1, 3) -- (0, 2) \
-(0, 2) -- (1, 1) \
-(1, 1) -- (0, 0) \
-(0, 0) -- (-1, 0) \
-(-1, 0) -- (-1.5, 0.5) \
-END \
- \
-SHAPE T MAXDIST 8 CORRECTION 5.8 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 4 \
-(1.4, 3.8) -- (1.4, 4) \
-(1.4, 4) -- (-1.4, 4) \
-(-1.4, 4) -- (-1.4, 3.8) \
-(0, 4) -- (0, 0) \
-END \
- \
-SHAPE U MAXDIST 8 CORRECTION 1.7 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 6 \
-(1, 4) -- (1, 1.5) \
-(1, 1.5) -- (1.4, 0) \
-(1, 1.5) -- (0, 0) \
-(0, 0) -- (-0.5, 0) \
-(-0.5, 0) -- (-1, 1) \
-(-1, 1) -- (-1, 4) \
-END \
- \
-SHAPE V MAXDIST 8 CORRECTION 1.6 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 2 \
-(1.5, 4.5) -- (0, 0) \
-(-1, 4) -- (0, 0) \
-END \
- \
-SHAPE W MAXDIST 8 CORRECTION 2 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 4 \
-(-1.5, 4) -- (-1, 0) \
-(-1, 0) -- (0, 2.5) \
-(0, 2.5) -- (1, 0) \
-(1, 0) -- (2, 4) \
-END \
- \
-SHAPE X MAXDIST 8 CORRECTION 2.8 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 4 \
-(-2, 4) -- (0, 0) \
-(0, 0) -- (2, 4) \
-(-2, -4) -- (0, 0) \
-(0, 0) -- (2, -4) \
-END \
- \
-SHAPE Y MAXDIST 8 CORRECTION 4.4 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 2 \
-(2, 4) -- (0, 0) \
-(-0.8, 4) -- (0.8, 1.6) \
-END \
- \
-SHAPE Z MAXDIST 8 CORRECTION 2.8 \
-SCALE DEVIATION 0.5 \
-ROTATION MIN -9 MAX 9 DENSITY 20 \
-START 3 \
-(0, 4) -- (3, 4) \
-(3, 4) -- (0, 0) \
-(0, 0) -- (3, 0) \
-END \
";
@@ -1783,15 +1323,14 @@
#define gridSIZE 3
#define gridJUMP 1
-#define gridMARGIN 0.28
+#define gridMARGIN 0.3
int gridSIZES[gridSIZE][gridSIZE];
interval * gridSHAPES[gridSIZE][gridSIZE];
/* Run complete recognition from string, return result. */
-void recognize_from_string (const char* shape_str, char* res_str, int* res_nbr,
- int step)
-{
+void recognize_from_string (const char* shape_str, const char* full_str,
+ char* res_str, int* res_nbr, int step) {
int shape_size;
interval* shape;
int offset = 0;
@@ -1818,15 +1357,34 @@
int o = sprintf (res_str, "1\n%s\n", patterns[res].name);
if (step > 0) {
+ int full_size;
+ interval* full;
+ int full_offset = 0;
+ full = sread_shape (full_str, &full_size, &full_offset);
+
+ //printf ("Full shape:\n");
+ //print_shape (full, full_size);
+
+ int smaller_full_size;
+ interval* smaller_full;
+ smaller_full = downsize_shape (full, full_size, &smaller_full_size);
+
// Scale input back to recognized pattern coordinates.
- rotate_shape (-1 * get_res_rot (), smaller_shape, smaller_shape_size);
+ interval mids = mid_dimen (smaller_shape, smaller_shape_size);
+ double mx = mids.start.x;
+ double my = mids.start.y;
+ rotate_shape_m (-1 * get_res_rot (), smaller_full, smaller_full_size,
+ mx, my);
point tmp;
tmp.x = 1 / get_res_scale().x;
tmp.y = 1 / get_res_scale().y;
- scale_shape (tmp, smaller_shape, smaller_shape_size);
+ scale_shape_m (tmp, smaller_full, smaller_full_size, mx, my);
tmp.x = -1 * get_res_move().x;
tmp.y = -1 * get_res_move().y;
- move_shape (tmp, smaller_shape, smaller_shape_size);
+ move_shape (tmp, smaller_full, smaller_full_size);
+
+ //printf ("Res shape:\n");
+ //print_shape (smaller_full, smaller_full_size);
// put grid subshapes into grid;
int gi;
@@ -1839,7 +1397,7 @@
bl.y = gridJUMP * (2*gj - gridSIZE) + gridMARGIN;
tr.x = gridJUMP * (2*gi + 2 - gridSIZE) - gridMARGIN;
tr.y = gridJUMP * (2*gj + 2 - gridSIZE) - gridMARGIN;
- interval * cut = cut_shape (smaller_shape, smaller_shape_size,
+ interval * cut = cut_shape (smaller_full, smaller_full_size,
bl, tr, &cut_size);
gridSIZES[gi][gj] = cut_size;
gridSHAPES[gi][gj] = cut;
Modified: trunk/Toss/Learn/shapes.h
===================================================================
--- trunk/Toss/Learn/shapes.h 2011-12-10 23:39:15 UTC (rev 1636)
+++ trunk/Toss/Learn/shapes.h 2011-12-28 22:45:36 UTC (rev 1637)
@@ -15,5 +15,5 @@
shape* get_patterns (void);
-void recognize_from_string (const char* shape_str, char* res_str, int* res,
- int step);
+void recognize_from_string (const char* shape_str, const char* full_str,
+ char* res_str, int* res, int step);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-12-10 23:39:23
|
Revision: 1636
http://toss.svn.sourceforge.net/toss/?rev=1636&view=rev
Author: lukaszkaiser
Date: 2011-12-10 23:39:15 +0000 (Sat, 10 Dec 2011)
Log Message:
-----------
New directory for game learning stuff (will move later), starting visual recognition for grid-games using OpenCV.
Added Paths:
-----------
trunk/Toss/Learn/
trunk/Toss/Learn/.cvsignore
trunk/Toss/Learn/Makefile
trunk/Toss/Learn/grid.pdf
trunk/Toss/Learn/reco.cpp
trunk/Toss/Learn/shapes.c
trunk/Toss/Learn/shapes.h
trunk/Toss/Learn/videos/
trunk/Toss/Learn/videos/tic_tac_toe_0.3gp
Property changes on: trunk/Toss/Learn
___________________________________________________________________
Added: svn:ignore
+ # We are still using .cvsignore files as we find them easier to manage
# than svn properties. Therefore if you change .cvsignore do the following.
# svn propset svn:ignore -F .cvsignore .
reco
*~
*.o
log*.ppm
Added: trunk/Toss/Learn/.cvsignore
===================================================================
--- trunk/Toss/Learn/.cvsignore (rev 0)
+++ trunk/Toss/Learn/.cvsignore 2011-12-10 23:39:15 UTC (rev 1636)
@@ -0,0 +1,8 @@
+# We are still using .cvsignore files as we find them easier to manage
+# than svn properties. Therefore if you change .cvsignore do the following.
+# svn propset svn:ignore -F .cvsignore .
+
+reco
+*~
+*.o
+log*.ppm
Added: trunk/Toss/Learn/Makefile
===================================================================
--- trunk/Toss/Learn/Makefile (rev 0)
+++ trunk/Toss/Learn/Makefile 2011-12-10 23:39:15 UTC (rev 1636)
@@ -0,0 +1,10 @@
+all: reco
+
+shapes.o: shapes.c shapes.h
+ gcc -c shapes.c
+
+reco: reco.cpp shapes.o
+ g++ shapes.o reco.cpp -o reco `pkg-config opencv --cflags --libs`
+
+clean:
+ rm -rf reco log*.ppm *.o *~
Property changes on: trunk/Toss/Learn/Makefile
___________________________________________________________________
Added: svn:executable
+ *
Added: trunk/Toss/Learn/grid.pdf
===================================================================
--- trunk/Toss/Learn/grid.pdf (rev 0)
+++ trunk/Toss/Learn/grid.pdf 2011-12-10 23:39:15 UTC (rev 1636)
@@ -0,0 +1,69 @@
+%PDF-1.4
+%\xD0\xD4\xC5\xD8
+1 0 obj
+<<>>
+endobj
+2 0 obj
+<<>>
+endobj
+3 0 obj
+<< /pgfprgb [/Pattern /DeviceRGB] >>
+endobj
+6 0 obj <<
+/Length 139
+/Filter /FlateDecode
+>>
+stream
+xڅ\x911\xC20 Ew\x9F\xE2_ \x96\x83S㜠3\xE2 ]Z$&\xAEOڡ\x90Ш\x8Bc\xFF\xFF\xBE\x9C(\x82 \x82\x91\xE4䌥
+"T\x8CU I2\xE7dx,\xF4B\xA1Fl( k\xF6o\xACr\xE2\xEC\xB1\xC0e
+\xF1*,.n\xF8i\x97\xCA\xF8v3\xE8T\x95 zƽ\xF6c\xCBj\x97u\xF5\x91\xFC\x978\xB4\xFC>7\x8F\xDB\xF5\xF6N\x9D@\x97\xBF\x81\x9E[m?\xE6\xF6\xD4U@
+endstream
+endobj
+5 0 obj <<
+/Type /Page
+/Contents 6 0 R
+/Resources 4 0 R
+/MediaBox [0 0 612 792]
+/Parent 7 0 R
+>> endobj
+4 0 obj <<
+ /ColorSpace 3 0 R /Pattern 2 0 R /ExtGState 1 0 R
+/ProcSet [ /PDF ]
+>> endobj
+7 0 obj <<
+/Type /Pages
+/Count 1
+/Kids [5 0 R]
+>> endobj
+8 0 obj <<
+/Type /Catalog
+/Pages 7 0 R
+>> endobj
+9 0 obj <<
+/Producer (pdfTeX-1.40.10)
+/Creator (TeX)
+/CreationDate (D:20111210202438+01'00')
+/ModDate (D:20111210202438+01'00')
+/Trapped /False
+/PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-1.40.10-2.2 (TeX Live 2009/Debian) kpathsea version 5.0.0)
+>> endobj
+xref
+0 10
+0000000000 65535 f
+0000000015 00000 n
+0000000035 00000 n
+0000000055 00000 n
+0000000430 00000 n
+0000000326 00000 n
+0000000108 00000 n
+0000000521 00000 n
+0000000578 00000 n
+0000000627 00000 n
+trailer
+<< /Size 10
+/Root 8 0 R
+/Info 9 0 R
+/ID [<6450C2B72902EC0DBB009F58BA2907F2> <6450C2B72902EC0DBB009F58BA2907F2>] >>
+startxref
+892
+%%EOF
Added: trunk/Toss/Learn/reco.cpp
===================================================================
--- trunk/Toss/Learn/reco.cpp (rev 0)
+++ trunk/Toss/Learn/reco.cpp 2011-12-10 23:39:15 UTC (rev 1636)
@@ -0,0 +1,133 @@
+#include <opencv/cv.h>
+#include <opencv/ml.h>
+#include <opencv/cxcore.h>
+#include <opencv/cxtypes.h>
+#include <opencv/highgui.h>
+extern "C" {
+ #include "shapes.h"
+}
+#include<cstdio>
+
+#define SIZEX 146 //352 - MARGINX / 2
+#define SIZEY 130 //288 - MARGINY / 2
+#define MARGINX 22
+#define MARGINY 8
+
+void reset (char a[SIZEX][SIZEY]) {
+ for (int j = 0; j < SIZEY; j++) {
+ for (int i = 0; i < SIZEX; i++) {
+ a[i][j] = 1;
+ }
+ }
+}
+
+static int print_counter = 0;
+void print_ppm (char pic[SIZEX][SIZEY], char * prefix) {
+ char fname[80];
+ sprintf (fname, "%s%i.ppm", prefix, print_counter);
+ print_counter++;
+ FILE * f = fopen (fname, "w");
+ fprintf (f, "P3\n%i %i\n255\n", SIZEX, SIZEY);
+ for (int j = 0; j < SIZEY; j++) {
+ for (int i = 0; i < SIZEX; i++) {
+ if (pic[i][j] > 0) {
+ fprintf (f, "0 0 0 ");
+ } else {
+ fprintf (f, "255 255 255 ");
+ }
+ }
+ fprintf (f, "\n");
+ }
+ fclose (f);
+}
+
+CvPoint from_point (point p) {
+ double x = p.x + MARGINX; //(p.x * SIZEX) / (SIZEX + 2*MARGINX) + MARGINX;
+ double y = p.y + MARGINY;
+ return (cvPoint ((int) x, (int) y));
+}
+
+
+int main(int argc, char* argv[])
+{
+ char res[2000];
+ int rnbr = -2;
+
+ cvNamedWindow ("Reco", CV_WINDOW_AUTOSIZE);
+ CvCapture* capture = cvCreateFileCapture ("videos/tic_tac_toe_0.3gp");
+ //cvCreateCameraCapture( 0 );
+ IplImage* img;
+ IplImage* gray;
+ IplImage* small;
+ int data_count = 0;
+ char data[SIZEX][SIZEY];
+ unsigned int cur_data = 0;
+ int time = 0;
+ int ok_around;
+ char shape_str[SIZEX*SIZEY*24] = "";
+ int shape_str_pos = 0;
+
+ reset (data);
+
+ while (true) {
+ img = cvQueryFrame (capture);
+ if (!img) break;
+ gray = cvCreateImage (cvSize (img->width, img->height), 8, 1);
+ cvCvtColor (img, gray, CV_BGR2GRAY);
+ small = cvCreateImage (cvSize (SIZEX + 2*MARGINX, SIZEY + 2*MARGINY), 8, 1);
+ cvResize (gray, small, CV_INTER_LINEAR);
+ cvCanny (small, small, 50, 100);
+ data_count = 0;
+ for (int i = 0; i < SIZEX; i++) {
+ for (int j = 0; j < SIZEY; j++) {
+ cur_data = (unsigned int)
+ small->imageData[(i+MARGINX) + small->widthStep * (j+MARGINY)];
+ ok_around = i == 0 || j == 0 ? 1 :
+ data[i][j] + data[i-1][j] + data[i+1][j] +
+ data[i][j+1] + data[i-1][j-1] + data[i+1][j-1] +
+ data[i][j-1] + data[i-1][j+1] + data[i+1][j+1];
+ ok_around = ok_around == 0 ? 0 : 1;
+ data[i][j] = cur_data > 2 ? ok_around : 0;
+ if (data[i][j] == 1) data_count++;
+ }
+ }
+ if (time % 5 == 0 && data_count < 500) { // we see empty picture, reset
+ reset (data);
+ time = 1;
+ }
+ if (rnbr >= 0) {
+ shape p = (get_patterns())[rnbr];
+ for (int s = 0; s < p.size; s++) {
+ cvLine (small, from_point (p.shape[s].start),
+ from_point (p.shape[s].end), CV_RGB (200, 100, 100), 3);
+ }
+ }
+ cvShowImage( "Reco", small );
+ if (time % 70 == 0) { // wait < 4s for now
+ shape_str_pos = sprintf (shape_str, "START %i ", data_count);
+ for (int i = 0; i < SIZEX; i++) {
+ for (int j = 0; j < SIZEY; j++) {
+ if (data[i][j] == 1) {
+ shape_str_pos += sprintf (shape_str + shape_str_pos,
+ "(%i, %i) -- (%i, %i) ", i, j, i, j);
+ }
+ }
+ }
+ sprintf (shape_str + shape_str_pos, " END");
+ printf ("step: %i\nsize: %i\nreco:\n", time/70, data_count);
+ print_ppm (data, (char*) "log");
+ reset (data);
+ recognize_from_string (shape_str, res, &rnbr, time/70 - 1);
+ printf ("%i\n", rnbr);
+ for (int i = 0; i < 2000; i++) res[i] = 0;
+ for (int i = 0; i < SIZEX*SIZEY*24; i++) shape_str[i] = 0;
+ }
+ time++;
+ char c = cvWaitKey (50);
+ if (c == 27) break;
+ }
+ cvReleaseCapture (&capture);
+ cvDestroyWindow ("Reco");
+
+ return (0);
+}
Added: trunk/Toss/Learn/shapes.c
===================================================================
--- trunk/Toss/Learn/shapes.c (rev 0)
+++ trunk/Toss/Learn/shapes.c 2011-12-10 23:39:15 UTC (rev 1636)
@@ -0,0 +1,1858 @@
+/* Implementation of Shape Matching.
+ This is derived from a Xournal patch by Lukasz Kaiser.
+ In the future, we could consider external libraries for Frechet distance:
+ e.g. http://www.cs.uu.nl/centers/give/multimedia/matching/shame.html */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <math.h>
+#include <pthread.h>
+
+typedef struct point_s {double x; double y;} point;
+typedef struct interval_s {point start; point end;} interval;
+
+typedef struct shape_s {
+ interval* shape;
+ int size;
+ char name[80];
+ double max_dist;
+ double correction;
+ double scale_correction;
+ double min_rotation;
+ double max_rotation;
+ double rotation_density;
+} shape;
+
+
+static pthread_mutex_t shapes_stop_mutex;
+static pthread_mutex_t shapes_working_mutex;
+static pthread_mutex_t shapes_painting_mutex;
+static int stop_signal;
+
+#define min(x, y) (y < x ? y : x)
+#define max(x, y) (y > x ? y : x)
+
+/* The metric parameter used by computing averages. */
+static double metric_k_1 = 1.4;
+static int get_metric_k_1 () { return (metric_k_1); }
+static void set_metric_k_1 (double k) { metric_k_1 = k; }
+static double metric_k_2 = 14;
+static int get_metric_k_2 () { return (metric_k_2); }
+static void set_metric_k_2 (double k) { metric_k_2 = k; }
+
+/* Compare two points (compatible for qsort). */
+static int point_cmp (const void * p1, const void * p2)
+{
+ double x1 = ((point*) p1)->x;
+ double y1 = ((point*) p1)->y;
+ double x2 = ((point*) p2)->x;
+ double y2 = ((point*) p2)->y;
+ if (x1 - x2 == 0) {
+ if (y1 - y2 > 0) {
+ return (1);
+ } else if (y1 - y2 < 0) {
+ return (-1);
+ } else {
+ return (0);
+ }
+ } else {
+ if (x1 - x2 > 0) {
+ return (1);
+ } else if (x1 - x2 < 0) {
+ return (-1);
+ } else {
+ return (0);
+ }
+ }
+}
+
+/* Distance from (x, y) to the interval (x1, y1) -- (x2, y2). */
+static double distance (const point p, const interval i)
+{
+ double x = p.x;
+ double y = p.y;
+ double x1 = i.start.x;
+ double y1 = i.start.y;
+ double x2 = i.end.x;
+ double y2 = i.end.y;
+
+ /* find (x3, y3) so that:
+ - (y3-y1)*(x2-x1) = (y2-y1)*(x3-x1) // (x3, y3) on the line 1-2
+ <=> y3*dx - y1*dx = x3*dy - x1*dy
+ <=> y3 = x3*(dy/dx) + y1 - x1(dy/dx)
+ <=> x3 = y3(dx/dy) + x1 - y1(dx/dy)
+ - (x1-x3, y1-y3)*(x-x3, y-y3) = 0 // ortogonal
+ <=> (x3-x1)*(x3-x) = (y3-y1)*(y-y3)
+ <=> (x2-x1)*(x3-x) = (y1-y2)*(y3-y)
+ <=> x3*dx - x*dx = y*dy - y3*dy
+ <=> x3*dx - x*dx = y*dy - (x3*dy*dy/dx) - y1*dy + x1*dy*dy/dx
+ <=> x3*(dx*dx + dy*dy) = y*dy*dx + x*dx*dx - y1*dy*dx + x1*dy*dy
+ <=> y3*dx*dx/dy + x1*dx - y1*dx*dx/dy - x*dx = y*dy - y3*dy
+ <=> y3*(dx*dx + dy*dy) = y*dy*dy + y1*dx*dx + dx*dy*(x-x1)
+ */
+ const double dx = x2 - x1;
+ const double dy = y2 - y1;
+ const double dsq = dx*dx + dy*dy;
+ if (dsq < 0.000000001) {
+ return (sqrt ((x1 - x) * (x1 - x) + (y1 - y) * (y1 - y)));
+ } else {
+ const double x3 = (dx*dy*(y - y1) + dx*dx*x + dy*dy*x1) / dsq;
+ const double y3 = (dx*dy*(x - x1) + dx*dx*y1 + dy*dy*y) / dsq;
+ /* Use (x3, y3) if it lies on (x1,y1)--(x2,y2):
+ - (min (x1, x2) <= x3 <= max (x1, x2))
+ - (min (y1, y2) <= y3 <= max (y1, y2)), else use one of the ends.
+ */
+ if ((min (x1, x2) <= x3) && (max (x1, x2) >= x3) &&
+ (min (y1, y2) <= y3) && (max (y1, y2) >= y3)) {
+ return (sqrt ((x3-x) * (x3-x) + (y3-y) * (y3-y)));
+ } else {
+ double d1 = sqrt ((x1-x) * (x1-x) + (y1-y) * (y1-y));
+ double d2 = sqrt ((x2-x) * (x2-x) + (y2-y) * (y2-y));
+ return (min (d1, d2));
+ }
+ }
+}
+
+/* min_(intervals) distance p-interval */
+static double point_distance (const point p, const interval* ivs, const int size)
+{
+ if (size == 0) return (0.0);
+ if (size == 1) return (distance (p, ivs[0]));
+ double x = p.x;
+ double y = p.y;
+
+ double current_min_pt_dist =
+ distance (p, ivs[(rand() % (size/2)) + (size/2)]);
+
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ double x1 = ivs[i].start.x;
+ double y1 = ivs[i].start.y;
+ double x2 = ivs[i].end.x;
+ double y2 = ivs[i].end.y;
+ if (!(((x1 + current_min_pt_dist < x) && (x2 + current_min_pt_dist < x)) ||
+ ((y1 + current_min_pt_dist < y) && (y2 + current_min_pt_dist < y)) ||
+ ((x1 - current_min_pt_dist > x) && (x2 - current_min_pt_dist > x)) ||
+ ((y1 - current_min_pt_dist > y) && (y2 - current_min_pt_dist > y)))) {
+ current_min_pt_dist = min (current_min_pt_dist, distance (p, ivs[i]));
+ }
+ }
+
+ return (current_min_pt_dist);
+}
+
+
+/* Calculate k-avg_(points) min_(interval) distance point-interval, where
+ k-avg is L_k metric average: k-root of sum of k-powers divided by size. */
+static double set_distance (const point* pts, const int sizep,
+ const interval* ivs, const int sizei)
+{
+ /* For efficiency we include k-avg computation directly here. */
+ int i = 0;
+ double sum1 = 0.0;
+ double sum2 = 0.0;
+ for (i = 0; i < sizep; i++) {
+ double dist = point_distance (pts[i], ivs, sizei);
+ sum1 += pow (dist, metric_k_1);
+ sum2 += pow (dist, metric_k_2);
+ }
+ sum1 /= sizep;
+ sum2 /= sizep;
+ sum1 = pow (sum1, 1/metric_k_1);
+ sum2 = pow (sum2, 1/metric_k_2);
+
+ return (sum1 + sum2);
+}
+
+/* Make a list of points in a shape, sort them and remove repetitions. */
+static point* shape_points (const interval* shape, const int size, int* res_size)
+{
+ point points[2*size];
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ points[2*i] = shape[i].start;
+ points[2*i+1] = shape[i].end;
+ }
+ qsort (points, 2*size, sizeof (points[0]), point_cmp);
+
+ *res_size = 0;
+ for (i = 0; i < 2*size-1; i++) {
+ if ((points[i].x != points[i+1].x) || (points[i].y != points[i+1].y)) {
+ (*res_size)++;
+ }
+ }
+ (*res_size)++;
+
+ point* new_points = calloc ((*res_size), sizeof (point));
+ int j = 0;
+ for (i = 0; i < 2*size-1; i++) {
+ if ((points[i].x != points[i+1].x) || (points[i].y != points[i+1].y)) {
+ new_points[j] = points[i];
+ j++;
+ }
+ }
+ new_points[j] = points[2*size-1];
+
+ return (new_points);
+}
+
+/* Calculate the distance between two shapes fast using point sets. */
+static double shape_distance_fast (const interval* s1, const int size1,
+ const point* p1, const int sizep1,
+ const interval* s2, const int size2,
+ const point* p2, const int sizep2)
+{
+ double d1 = set_distance (p1, sizep1, s2, size2);
+ double d2 = set_distance (p2, sizep2, s1, size1);
+
+ return (sqrt (d1*d1 + d2*d2));
+}
+
+/* Calculate the distance between two shapes. */
+static double shape_distance (const interval* s1, const int size1,
+ const interval* s2, const int size2)
+{
+
+ int points_size1 = 0;
+ point* points1 = shape_points (s1, size1, &points_size1);
+
+ int points_size2 = 0;
+ point* points2 = shape_points (s2, size2, &points_size2);
+
+ double res = shape_distance_fast (s1, size1, points1, points_size1,
+ s2, size2, points2, points_size2);
+
+ free (points1);
+ free (points2);
+
+ return (res);
+}
+
+/* Move a shape by a translation vector, given as a point. */
+static void move_shape (const point t, interval* s, const int size)
+{
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ s[i].start.x += t.x;
+ s[i].start.y += t.y;
+ s[i].end.x += t.x;
+ s[i].end.y += t.y;
+ }
+}
+
+/* Move a shape and its points by a translation vector, given as a point. */
+static void move_shape_points (const point t, interval* s, const int size,
+ point* points, const int points_size)
+{
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ s[i].start.x += t.x;
+ s[i].start.y += t.y;
+ s[i].end.x += t.x;
+ s[i].end.y += t.y;
+ }
+
+ for (i = 0; i < points_size; i++) {
+ points[i].x += t.x;
+ points[i].y += t.y;
+ }
+}
+
+/* Compute the middle (avg) of shape x and y, and the height and width. */
+static interval mid_dimen (const interval* s, const int size)
+{
+ interval res;
+ res.start.x = 0;
+ res.start.y = 0;
+ res.end.x = 0;
+ res.end.y = 0;
+ if (size == 0) return (res);
+
+ double minx = s[0].start.x;
+ double miny = s[0].start.y;
+ double maxx = s[0].start.x;
+ double maxy = s[0].start.y;
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ minx = min (minx, min (s[i].start.x, s[i].end.x));
+ miny = min (miny, min (s[i].start.y, s[i].end.y));
+ maxx = max (maxx, max (s[i].start.x, s[i].end.x));
+ maxy = max (maxy, max (s[i].start.y, s[i].end.y));
+ }
+
+ res.start.x = (minx + maxx) / 2;
+ res.start.y = (miny + maxy) / 2;
+ res.end.x = maxx - minx;
+ res.end.y = maxy - miny;
+ return (res);
+}
+
+/* Scale a shape by a scale vector, given as a point. */
+static void scale_shape (const point scale, interval* shape, const int size)
+{
+ interval mids = mid_dimen (shape, size);
+ double mx = mids.start.x;
+ double my = mids.start.y;
+
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ shape[i].start.x = ((shape[i].start.x - mx) * scale.x) + mx;
+ shape[i].start.y = ((shape[i].start.y - my) * scale.y) + my;
+ shape[i].end.x = ((shape[i].end.x - mx) * scale.x) + mx;
+ shape[i].end.y = ((shape[i].end.y - my) * scale.y) + my;
+ }
+}
+
+/* Scale a shape and its points by a scale vector, given as a point. */
+static void scale_shape_points (const point scale, interval* shape, const int size,
+ point* points, const int points_size)
+{
+ interval mids = mid_dimen (shape, size);
+ double mx = mids.start.x;
+ double my = mids.start.y;
+
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ shape[i].start.x = ((shape[i].start.x - mx) * scale.x) + mx;
+ shape[i].start.y = ((shape[i].start.y - my) * scale.y) + my;
+ shape[i].end.x = ((shape[i].end.x - mx) * scale.x) + mx;
+ shape[i].end.y = ((shape[i].end.y - my) * scale.y) + my;
+ }
+
+ for (i = 0; i < points_size; i++) {
+ points[i].x = ((points[i].x - mx) * scale.x) + mx;
+ points[i].y = ((points[i].y - my) * scale.y) + my;
+ }
+}
+
+/* Rotate point [p] by angle [a] (in radians) around point [x, y]. */
+static void rotate_point (point* p, double a, double tx, double ty)
+{
+ double x = p->x - tx;
+ double y = p->y - ty;
+
+ p->x = (x * cos (a) - y * sin (a)) + tx;
+ p->y = (x * sin (a) + y * cos (a)) + ty;
+}
+
+/* Rotate a shape by an angle, in radians. */
+static void rotate_shape (const double angle, interval* shape, const int size)
+{
+ interval mids = mid_dimen (shape, size);
+ double mx = mids.start.x;
+ double my = mids.start.y;
+
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ rotate_point (&shape[i].start, angle, mx, my);
+ rotate_point (&shape[i].end, angle, mx, my);
+ }
+}
+
+/* Scale a shape and its points by a scale vector, given as a point. */
+static void rotate_shape_points (const double angle, interval* shape, const int size,
+ point* points, const int points_size)
+{
+ interval mids = mid_dimen (shape, size);
+ double mx = mids.start.x;
+ double my = mids.start.y;
+
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ rotate_point (&shape[i].start, angle, mx, my);
+ rotate_point (&shape[i].end, angle, mx, my);
+ }
+
+ for (i = 0; i < points_size; i++) {
+ rotate_point (&points[i], angle, mx, my);
+ }
+}
+
+
+/* Move and scale a shape by a vector, given as an interval. */
+static void move_scale_shape (const point t, const point s,
+ interval* shape, const int size)
+{
+ move_shape (t, shape, size);
+ scale_shape (s, shape, size);
+}
+
+/* Move and scale a shape and its points by a vector, given as an interval. */
+static void move_scale_shape_points (const point t, const point s,
+ interval* shape, const int size,
+ point* points, const int points_size)
+{
+ move_shape_points (t, shape, size, points, points_size);
+ scale_shape_points (s, shape, size, points, points_size);
+}
+
+/* Move and scale and rotate a shape by a vector and an angle. */
+static void move_scale_rotate_shape (const point t, const point s, const double angle,
+ interval* shape, const int size)
+{
+ move_shape (t, shape, size);
+ scale_shape (s, shape, size);
+ rotate_shape (angle, shape, size);
+}
+
+/* Move and scale and rotate a shape and its points by a vector and an angle. */
+static void move_scale_rotate_shape_points (const point t, const point s,
+ const double angle,
+ interval* shape, const int size,
+ point* points, const int points_size)
+{
+ move_shape_points (t, shape, size, points, points_size);
+ scale_shape_points (s, shape, size, points, points_size);
+ rotate_shape_points (angle, shape, size, points, points_size);
+}
+
+
+/* Make shape denser to improve precision. */
+static interval* dense_shape (const interval* shape, const int size)
+{
+ interval* new_shape = calloc (2 * size, sizeof (interval));
+
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ double midx = (shape[i].start.x + shape[i].end.x) / 2;
+ double midy = (shape[i].start.y + shape[i].end.y) / 2;
+
+ new_shape[2*i].start.x = shape[i].start.x;
+ new_shape[2*i].start.y = shape[i].start.y;
+ new_shape[2*i].end.x = midx;
+ new_shape[2*i].end.y = midy;
+
+ new_shape[2*i+1].start.x = midx;
+ new_shape[2*i+1].start.y = midy;
+ new_shape[2*i+1].end.x = shape[i].end.x;
+ new_shape[2*i+1].end.y = shape[i].end.y;
+ }
+
+ return (new_shape);
+}
+
+
+/* Read shape from file. */
+static interval* fread_shape (FILE* file, int* size)
+{
+ fscanf (file, " START %i", size);
+
+ interval* shape = calloc (*size, sizeof (interval));
+ int i = 0;
+ for (i = 0; i < *size; i++) {
+ double x1, y1, x2, y2;
+ fscanf (file, " (%lf, %lf) -- (%lf, %lf)", &x1, &y1, &x2, &y2);
+ shape[i].start.x = x1;
+ shape[i].start.y = y1;
+ shape[i].end.x = x2;
+ shape[i].end.y = y2;
+ }
+ fscanf (file, " END");
+
+ return (shape);
+}
+
+/* Move a string [n] spaces forward. */
+static int move_by_space (const int n, const char* s)
+{
+ int i = 0;
+ int j = 0;
+ for (j = 0; j < n; j++) {
+ while (s[i] == ' ') i++;
+ while (s[i] != ' ') i++;
+ }
+ return (i);
+}
+
+/* Read shape from string. */
+static interval* sread_shape (const char* str, int* size, int* offset)
+{
+ sscanf (str + *offset, " START %i", size);
+ *offset += move_by_space (2, str + *offset);
+
+ interval* shape = calloc (*size, sizeof (interval));
+ int i = 0;
+ for (i = 0; i < *size; i++) {
+ double x1, y1, x2, y2;
+ sscanf (str + *offset, " (%lf, %lf) -- (%lf, %lf)", &x1, &y1, &x2, &y2);
+ *offset += move_by_space (5, str + *offset);
+ shape[i].start.x = x1;
+ shape[i].start.y = y1;
+ shape[i].end.x = x2;
+ shape[i].end.y = y2;
+ }
+ sscanf (str + *offset, " END");
+ *offset += move_by_space (1, str + *offset);
+
+ return (shape);
+}
+
+/* Print shape. */
+static void print_shape (const interval* shape, const int size)
+{
+ printf ("START %i\n", size);
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ printf ("(%lf, %lf) -- (%lf, %lf)\n", shape[i].start.x, shape[i].start.y,
+ shape[i].end.x, shape[i].end.y);
+ }
+ printf ("END\n");
+}
+
+static void sprint_shape (char* s, const interval* shape, const int size)
+{
+ int o;
+ o = sprintf (s, "START %i\n", size);
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ o += sprintf (s+o, "(%lf, %lf) -- (%lf, %lf)\n",
+ shape[i].start.x, shape[i].start.y,
+ shape[i].end.x, shape[i].end.y);
+ }
+ sprintf (s+o, "END\n");
+}
+
+
+/* Print points. */
+static void print_points (const point* points, const int size)
+{
+ printf ("START %i\n", size);
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ printf ("(%lf, %lf)\n", points[i].x, points[i].y);
+ }
+ printf ("END\n");
+}
+
+
+
+/* Structure to hold shape and pattern, parameters for minimization. */
+typedef struct shape_and_pattern_s {
+ interval* shape;
+ int shape_size;
+ point* shape_points;
+ int shape_points_size;
+ interval* pattern;
+ int pattern_size;
+ point* pattern_points;
+ int pattern_points_size;
+} shape_and_pattern;
+
+
+/* We compute a penalty for very disproportional scaling. */
+static double disproportional_scale_penalty (double x, double y)
+{
+ double max_penalty_factor = 8;
+ double max_prop_diff = 16;
+ double free_d = 1.5;
+
+ if ((x < 0.0001) && (y < 0.0001)) {
+ return (-1);
+ } else if (x < 0.0001) {
+ return (-1);
+ } else if (y < 0.0001) {
+ return (-1);
+ } else {
+ double prop_diff = max (0, min (max (x / y, y / x)-free_d, max_prop_diff));
+ return (1 + max_penalty_factor * (prop_diff / max_prop_diff));
+ }
+}
+
+/* Minimal and maximal allowed rotation for the current shape. */
+static double min_rotation = 0;
+static double max_rotation = 0;
+
+/* Compute the distance between moved, scaled, rotated pattern and shape. */
+static double move_scale_rotate_distance (const point t, const point s,
+ const double a, const shape_and_pattern* s_p)
+{
+ double scale_penalty = disproportional_scale_penalty (s.x, s.y);
+ if (scale_penalty < 0) { // Infinite penalty = forbidden scaling.
+ return (100 * 100 * 100);
+ }
+
+ if ((a < min_rotation) || (a > max_rotation)) { //Disallowed rotation.
+ return (100 * 100 * 100);
+ }
+
+ interval new_pattern[s_p->pattern_size];
+ point new_pattern_points[s_p->pattern_points_size];
+
+ int i;
+ for (i = 0; i < s_p->pattern_size; i++) {
+ new_pattern[i] = s_p->pattern[i];
+ }
+ for (i = 0; i < s_p->pattern_points_size; i++) {
+ new_pattern_points[i] = s_p->pattern_points[i];
+ }
+
+ move_scale_rotate_shape_points (t, s, a, new_pattern, s_p->pattern_size,
+ new_pattern_points, s_p->pattern_points_size);
+ double res =
+ shape_distance_fast (new_pattern, s_p->pattern_size,
+ new_pattern_points, s_p->pattern_points_size,
+ s_p->shape, s_p->shape_size,
+ s_p->shape_points, s_p->shape_points_size);
+
+
+ return (res * scale_penalty);
+}
+
+
+/* Places for results during iteration of minimizing functions. */
+static point current_best_move;
+static point current_best_scale;
+static double current_best_rot;
+/* Step values for minimization. */
+static point current_move_step;
+static point current_scale_step;
+static double current_rot_step;
+/* Current minimization value. */
+static double current_min_dist;
+
+static const double min_improvement_factor = 1.0000001;
+
+
+/* Try adjusting current_best_move by trying to move by the
+ current_move_step in both directions. Report if adjusted. */
+static int adjust_translation (const shape_and_pattern* s_p)
+{
+ int done_something = 0;
+ int best_x = 0;
+ int best_y = 0;
+ int i = 0;
+
+ double scale_penalty =
+ disproportional_scale_penalty (current_best_scale.x, current_best_scale.y);
+ if (scale_penalty < 0) {
+ return (0);
+ }
+
+ interval new_pattern[s_p->pattern_size];
+ point new_pattern_points[s_p->pattern_points_size];
+ for (i = 0; i < s_p->pattern_size; i++) {
+ new_pattern[i] = s_p->pattern[i];
+ }
+ for (i = 0; i < s_p->pattern_points_size; i++) {
+ new_pattern_points[i] = s_p->pattern_points[i];
+ }
+
+ point prev_move;
+ int prev_move_x = 0;
+ int prev_move_y = 0;
+ for (i = -3; i <= 3; i++) {
+ int j = 0;
+ for (j = -3; j <= 3; j++) {
+ point t = current_best_move;
+ t.x += current_move_step.x * (i - prev_move_x);
+ t.y += current_move_step.y * (j - prev_move_y);
+ double dist = current_min_dist;
+ if (((i != 0) || (j != 0)) && ((i == 0) || (j == 0))) {
+ move_shape_points (t, new_pattern, s_p->pattern_size,
+ new_pattern_points, s_p->pattern_points_size);
+ dist =
+ shape_distance_fast (new_pattern, s_p->pattern_size,
+ new_pattern_points, s_p->pattern_points_size,
+ s_p->shape, s_p->shape_size,
+ s_p->shape_points, s_p->shape_points_size);
+ dist *= scale_penalty;
+
+ prev_move_x = i;
+ prev_move_y = j;
+ }
+ if (dist * min_improvement_factor < current_min_dist) {
+ best_x = i;
+ best_y = j;
+ current_min_dist = dist;
+ done_something = 1;
+ }
+ }
+ }
+
+ if (done_something) {
+ current_best_move.x += current_move_step.x * best_x;
+ current_best_move.y += current_move_step.y * best_y;
+ return (1);
+ } else {
+ return (0);
+ }
+}
+
+/* Try adjusting current_best_scale by trying to move by the
+ current_scale_step in both directions. Report if adjusted. */
+static int adjust_scale (const shape_and_pattern* params)
+{
+ int done_something = 0;
+ int best_x = 0;
+ int best_y = 0;
+ int i = 0;
+ for (i = -1; i <= 1; i++) {
+ int j = 0;
+ for (j = -1; j <= 1; j++) {
+ point s = current_best_scale;
+ s.x += current_scale_step.x * i;
+ s.y += current_scale_step.y * j;
+ double dist = current_min_dist + 1;
+ if (((i != 0) || (j != 0)) && ((i == 0) || (j == 0))) {
+ dist = move_scale_rotate_distance (current_best_move, s,
+ current_best_rot, params);
+ }
+ if (dist * min_improvement_factor < current_min_dist) {
+ best_x = i;
+ best_y = j;
+ current_min_dist = dist;
+ done_something = 1;
+ }
+ }
+ }
+
+ if (done_something) {
+ current_best_scale.x += current_scale_step.x * best_x;
+ current_best_scale.y += current_scale_step.y * best_y;
+ return (1);
+ } else {
+ return (0);
+ }
+}
+
+/* Try adjusting current_best_rot by trying to move by the
+ current_rot_step, plus or minus. */
+static int adjust_rotation (const shape_and_pattern* params)
+{
+ double dist1 =
+ move_scale_rotate_distance (current_best_move, current_best_scale,
+ current_best_rot + current_rot_step, params);
+ double dist2 =
+ move_scale_rotate_distance (current_best_move, current_best_scale,
+ current_best_rot - current_rot_step, params);
+
+ if ((dist1 * min_improvement_factor < current_min_dist) && (dist1 < dist2)) {
+ current_min_dist = dist1;
+ current_best_rot += current_rot_step;
+ return (1);
+ }
+ if (dist2 * min_improvement_factor < current_min_dist) {
+ current_min_dist = dist2;
+ current_best_rot -= current_rot_step;
+ return (1);
+ }
+ return (0);
+}
+
+
+/* Makes one step correction of current move, step and rot vectors. */
+static void correct_move_scale_rot_step (const shape_and_pattern* params)
+{
+ int should_adjust = 1;
+ int adjusted = 0;
+
+ should_adjust = adjust_scale (params);
+ while (should_adjust > 0) should_adjust = adjust_scale (params);
+
+ should_adjust = adjust_translation (params);
+ while (should_adjust > 0) should_adjust = adjust_translation (params);
+
+ should_adjust = adjust_rotation (params);
+ while (should_adjust > 0) {
+ adjusted = 1;
+ should_adjust = adjust_rotation (params);
+ }
+
+ if (adjusted) {
+ if (adjust_scale (params) > 0) adjust_rotation (params);
+ }
+}
+
+/* Minimize distance between moved and scaled and rotated pattern and shape.
+ Starts with and changes the current_best_{move,scale,rot} variables. */
+static double find_minimal_dist_rot (const shape_and_pattern* params,
+ const int no_iter)
+{
+ current_min_dist =
+ move_scale_rotate_distance (current_best_move, current_best_scale,
+ current_best_rot, params);
+
+ int iters = 0;
+ while (iters < no_iter) {
+ int should_stop = 0;
+ pthread_mutex_lock (&shapes_stop_mutex);
+ should_stop = stop_signal;
+ pthread_mutex_unlock (&shapes_stop_mutex);
+
+ if (should_stop) { return (current_min_dist); }
+
+ correct_move_scale_rot_step (params);
+ current_move_step.x /= 4;
+ current_move_step.y /= 4;
+ current_scale_step.x /= 4;
+ current_scale_step.y /= 4;
+ current_rot_step /= 4;
+ iters++;
+ }
+
+ return (current_min_dist);
+}
+
+
+/* Find scale factor given pattern and shape dimensions. */
+static point find_scale (const point pattern_dim, const point shape_dim) {
+ point res;
+ if ((pattern_dim.x < 0.01) && (pattern_dim.y < 0.01)) {
+ res.x = 1;
+ res.y = 1;
+ } else if (pattern_dim.x < 0.01) {
+ res.x = shape_dim.y / pattern_dim.y;
+ res.y = shape_dim.y / pattern_dim.y;
+ } else if (pattern_dim.y < 0.01) {
+ res.x = shape_dim.x / pattern_dim.x;
+ res.y = shape_dim.x / pattern_dim.x;
+ } else {
+ res.x = shape_dim.x / pattern_dim.x;
+ res.y = shape_dim.y / pattern_dim.y;
+ }
+ return (res);
+}
+
+/* Find best fit (scale and translation) between shape and pattern. */
+static interval best_fit (interval* shape, const int s_size, interval* pattern,
+ const int p_size, const int no_iter, double* metric,
+ double* rotation)
+{
+ shape_and_pattern params;
+ int points_size = 0;
+ params.shape = shape;
+ params.shape_size = s_size;
+ params.shape_points = shape_points (shape, s_size, &points_size);
+ params.shape_points_size = points_size;
+
+ params.pattern = pattern;
+ params.pattern_size = p_size;
+ params.pattern_points = shape_points (pattern, p_size, &points_size);
+ params.pattern_points_size = points_size;
+
+ interval shape_mids = mid_dimen (shape, s_size);
+ interval pattern_mids = mid_dimen (pattern, p_size);
+
+ point d_move;
+ d_move.x = shape_mids.start.x - pattern_mids.start.x;
+ d_move.y = shape_mids.start.y - pattern_mids.start.y;
+ point d_scale = find_scale (pattern_mids.end, shape_mids.end);
+ double d_rot = 0;
+
+
+ // Determine initial best rotation.
+ if (max_rotation - min_rotation > M_PI / 8) {
+ int rotate_try_size =
+ ((int) 16 * ((max_rotation - min_rotation + 0.001) / (2 * M_PI)));
+ if (rotate_try_size == 0) rotate_try_size = 1;
+ interval check_pattern[p_size];
+ point tmp_scale;
+ double cur_best = 0;
+ double cur_dist = move_scale_rotate_distance (d_move, d_scale, 0, ¶ms);
+ double angle = 0;
+ for (angle = min_rotation; angle < max_rotation + 0.0001;
+ angle += (max_rotation - min_rotation) / rotate_try_size) {
+ int j = 0;
+ for (j = 0; j < p_size; j++) {
+ check_pattern[j] = pattern[j];
+ }
+ rotate_shape (angle, check_pattern, p_size);
+
+ interval check_mids = mid_dimen (check_pattern, p_size);
+ tmp_scale = find_scale (check_mids.end, shape_mids.end);
+
+ double dist =
+ move_scale_rotate_distance (d_move, tmp_scale, angle, ¶ms);
+ if (dist < cur_dist) {
+ cur_best = angle;
+ d_scale = tmp_scale;
+ cur_dist = dist;
+ }
+ }
+ d_rot = cur_best;
+ }
+
+ // Set start and step values.
+ current_best_move = d_move;
+ current_best_scale = d_scale;
+ current_best_rot = d_rot;
+ current_move_step.x = (d_move.x > 1 ? d_move.x / 8 : 0.1);
+ current_move_step.y = (d_move.y > 1 ? d_move.y / 8 : 0.1);
+ current_scale_step.x = (d_scale.x > 0.1 ? d_scale.x / 8 : 0.01);
+ current_scale_step.y = (d_scale.y > 0.1 ? d_scale.y / 8 : 0.01);
+ current_rot_step = M_PI / 16;
+
+ *metric = find_minimal_dist_rot (¶ms, no_iter);
+
+ double shape_density = s_size /
+ ((shape_mids.end.x + 0.001) * (shape_mids.end.y + 0.001));
+ *metric = (*metric) * sqrt (shape_density) * 6;
+
+ interval res;
+ res.start = current_best_move;
+ res.end = current_best_scale;
+ *rotation = current_best_rot;
+
+ free (params.shape_points);
+ free (params.pattern_points);
+
+ return (res);
+}
+
+
+/* Shape management and fitting. */
+
+/* Storing shape patterns here. */
+static shape* patterns;
+static int no_patts = 0;
+shape* get_patterns () { return (patterns); }
+static int no_patterns () { return (no_patts); }
+
+/* Global scaling factor for distance. */
+static double scale_factor = 1;
+static double get_scale_factor () { return (scale_factor); }
+static void set_scale_factor (double s) { scale_factor = s; }
+
+/* Results will be put here. */
+static interval res_vec;
+static double res_min;
+static double res_rot;
+static point get_res_move () { return (res_vec.start); }
+static point get_res_scale () { return (res_vec.end); }
+static double get_res_rot () { return (res_rot); }
+static double get_res_min () { return (res_min); }
+
+/* How long to look for best fit. */
+static int number_of_iterations = 4;
+static int get_no_iterations () { return (number_of_iterations); }
+static void set_no_iterations (int n) { number_of_iterations = n; }
+
+/* Below what size should we make patterns denser. */
+static const int densing_size = 12;
+
+/* Initialize shape patterns from file. */
+static void init_patterns_from_file (const char* fname)
+{
+ const char mode = 'r';
+ FILE* file = fopen (fname, &mode);
+
+ pthread_mutex_init (&shapes_stop_mutex, PTHREAD_MUTEX_TIMED_NP);
+ pthread_mutex_init (&shapes_working_mutex, PTHREAD_MUTEX_TIMED_NP);
+ pthread_mutex_init (&shapes_painting_mutex, PTHREAD_MUTEX_TIMED_NP);
+
+ fscanf (file, " SHAPES %i PRECISION %i RECO FACTOR %lf",
+ &no_patts, &number_of_iterations, &scale_factor);
+ patterns = calloc (no_patts, sizeof(shape));
+
+ int i = 0;
+ int j = 0;
+ for (i = 0; i < no_patts; i++) {
+ int shape_size = 0;
+ double max_dist = 0;
+
+ fscanf (file, " SHAPE %s MAXDIST %lf CORRECTION %lf SCALE DEVIATION %lf",
+ patterns[i].name, &patterns[i].max_dist, &patterns[i].correction,
+ &patterns[i].scale_correction);
+ // printf ("Reading %s.\n", patterns[i].name);
+ fscanf (file, " ROTATION MIN %lf MAX %lf DENSITY %lf",
+ &patterns[i].min_rotation, &patterns[i].max_rotation,
+ &patterns[i].rotation_density);
+ patterns[i].min_rotation = M_PI * patterns[i].min_rotation / 180;
+ patterns[i].max_rotation = M_PI * patterns[i].max_rotation / 180;
+ patterns[i].rotation_density = M_PI * patterns[i].rotation_density / 180;
+ if (patterns[i].correction < 0) patterns[i].correction = 0;
+
+ interval* shape = fread_shape (file, &shape_size);
+
+ while (shape_size <= densing_size) {
+ interval* new_shape = dense_shape (shape, shape_size);
+ free (shape);
+ shape = new_shape;
+ shape_size *= 2;
+ }
+
+ patterns[i].shape = shape;
+ patterns[i].size = shape_size;
+ }
+
+ fclose (file);
+}
+
+/* Initialize shape patterns from string. */
+static void init_patterns_from_string (const char* str)
+{
+ int offset = 0;
+
+ pthread_mutex_init (&shapes_stop_mutex, PTHREAD_MUTEX_TIMED_NP);
+ pthread_mutex_init (&shapes_working_mutex, PTHREAD_MUTEX_TIMED_NP);
+
+ sscanf (str + offset, " SHAPES %i PRECISION %i RECO FACTOR %lf",
+ &no_patts, &number_of_iterations, &scale_factor);
+ offset += move_by_space (7, str + offset);
+ patterns = calloc (no_patts, sizeof(shape));
+
+ int i = 0;
+ int j = 0;
+ for (i = 0; i < no_patts; i++) {
+ int shape_size = 0;
+ double max_dist = 0;
+
+ sscanf (str + offset,
+ " SHAPE %s MAXDIST %lf CORRECTION %lf SCALE DEVIATION %lf",
+ patterns[i].name, &patterns[i].max_dist, &patterns[i].correction,
+ &patterns[i].scale_correction);
+ offset += move_by_space (9, str + offset);
+ // printf ("Reading %s.\n", patterns[i].name);
+ sscanf (str + offset, " ROTATION MIN %lf MAX %lf DENSITY %lf",
+ &patterns[i].min_rotation, &patterns[i].max_rotation,
+ &patterns[i].rotation_density);
+ offset += move_by_space (7, str + offset);
+ patterns[i].min_rotation = M_PI * patterns[i].min_rotation / 180;
+ patterns[i].max_rotation = M_PI * patterns[i].max_rotation / 180;
+ patterns[i].rotation_density = M_PI * patterns[i].rotation_density / 180;
+ if (patterns[i].correction < 0) patterns[i].correction = 0;
+
+ interval* shape = sread_shape (str, &shape_size, &offset);
+
+ while (shape_size <= densing_size) {
+ interval* new_shape = dense_shape (shape, shape_size);
+ free (shape);
+ shape = new_shape;
+ shape_size *= 2;
+ }
+
+ patterns[i].shape = shape;
+ patterns[i].size = shape_size;
+ }
+}
+
+/* Free shape patterns storage. */
+static void free_patterns ()
+{
+ no_patts = 0;
+ free (patterns);
+}
+
+static double prev_scale = 1;
+
+/* Find best matching pattern for the given shape.
+ Return pattern number if there is one or -1 else.
+ The required translation and scale are put in res_vec. */
+static int match_pattern (interval* shape, const int size)
+{
+ double min = 0;
+ res_min = -2;
+ int res = -1;
+ int i = 0;
+
+ for (i = 0; i < no_patts; i++) {
+ int should_stop = 0;
+ pthread_mutex_lock (&shapes_stop_mutex);
+ should_stop = stop_signal;
+ pthread_mutex_unlock (&shapes_stop_mutex);
+
+ if (should_stop) { return (-1); }
+
+ min_rotation = patterns[i].min_rotation;
+ max_rotation = patterns[i].max_rotation;
+ double rot = 0;
+ interval fit = best_fit (shape, size, patterns[i].shape, patterns[i].size,
+ number_of_iterations, &min, &rot);
+ if (rot < 0) rot += 2 * M_PI;
+ if (min > 2*patterns[i].correction) min -= patterns[i].correction;
+ min /= scale_factor;
+ //printf ("Distance to pattern %s: %lf.\n", patterns[i].name, min);
+ if ((min <= patterns[i].max_dist) &&
+ ((min < res_min) || (res_min < -1))) {
+ res_min = min;
+ res_rot = rot;
+ res_vec = fit;
+ res = i;
+ }
+ }
+ // printf ("\n");
+
+ if (res > -1) {
+ // Scale correction.
+ if ((res_vec.end.x > 0.0001) && (res_vec.end.y > 0.0001)) {
+ double quot = res_vec.end.x / res_vec.end.y;
+ double scale_correction = patterns[res].scale_correction;
+ if ((1 - scale_correction < quot) && (quot < 1 + scale_correction)) {
+ double q_pre = 2 * prev_scale / (res_vec.end.x + res_vec.end.y);
+ if ((1 - scale_correction < q_pre) && (q_pre < 1 + scale_correction)) {
+ res_vec.end.x = prev_scale;
+ res_vec.end.y = prev_scale;
+ } else {
+ res_vec.end.x = (res_vec.end.x + res_vec.end.y) / 2;
+ res_vec.end.y = res_vec.end.x;
+ prev_scale = res_vec.end.x;
+ }
+ }
+ }
+
+ // Rotation correction.
+ double rot_density = patterns[res].rotation_density;
+ if (rot_density > 0) {
+ res_rot = rint (res_rot / rot_density) * rot_density;
+ }
+ }
+
+ return (res);
+}
+
+/* Determine if two intervals can be merged looking at the angle they form. */
+static double merge_possibility (interval i1, interval i2)
+{
+ if ((i1.end.x != i2.start.x) || (i1.end.y != i2.start.y)) {
+ return (4);
+ } else {
+ double angle1 = atan2 (i1.start.y - i1.end.y, i1.start.x - i1.end.x);
+ double angle2 = atan2 (i2.end.y - i1.end.y, i2.end.x - i1.end.x);
+ return (fabs (fabs (angle1 - angle2) - M_PI));
+ }
+}
+
+/* The angle in degrees from which on we decide to merge. */
+static const double merge_degrees = 3;
+
+/* Decrease the size of the shape when possible, one step. */
+static interval* downsize_shape_step (const interval* shape, const int size,
+ int* new_size)
+{
+ double merge_diff = (M_PI * merge_degrees) / 180;
+ interval new_shape[size];
+
+ int i = 0;
+ int j = 0;
+ for (i = 0; i < size-1; i++) {
+ if (merge_possibility (shape[i], shape[i+1]) < merge_diff) {
+ new_shape[j].start = shape[i].start;
+ new_shape[j].end = shape[i+1].end;
+ j++;
+ i++;
+ } else {
+ new_shape[j] = shape[i];
+ j++;
+ }
+ }
+ if (i < size) { new_shape[j] = shape[i]; j++; }
+ *new_size = j;
+
+ interval* res_shape = calloc (*new_size, sizeof (interval));
+ for (i = 0; i < *new_size; i++) {
+ res_shape[i] = new_shape[i];
+ }
+
+ return (res_shape);
+}
+
+/* Decrease the size of the shape when possible, one step. */
+static interval* downsize_shape (const interval* shape, const int size,
+ int* final_size)
+{
+ int prev_size = size;
+ int cur_size = 0;
+ interval* cur_shape = downsize_shape_step (shape, size, &cur_size);
+
+ while (cur_size != prev_size) {
+ int new_size = 0;
+ interval* new_shape = downsize_shape_step (cur_shape, cur_size, &new_size);
+ prev_size = cur_size;
+ free (cur_shape);
+ cur_shape = new_shape;
+ cur_size = new_size;
+ }
+
+ *final_size = cur_size;
+ return (cur_shape);
+}
+
+/* Find best matching pattern for the given line segments.
+ Return pattern number if there is one or -1 else.
+ Combine with the previous pattern if [next] is set.
+ The required translation, scale, rotation are put in res_{move,scale,rot}. */
+static interval* current_lin_shape = NULL;
+static int current_lin_shape_size = 0;
+static interval* get_recent_shape () { return (current_lin_shape); }
+static int get_recent_shape_size () { return (current_lin_shape_size); }
+
+static int match_pattern_line (const double* segments, const int size, const int next)
+{
+ interval* shape;
+ int start;
+
+ if ((current_lin_shape_size > 0) && (next)) {
+ shape = calloc (current_lin_shape_size + size-1, sizeof (interval));
+ start = current_lin_shape_size;
+ } else {
+ shape = calloc (size-1, sizeof (interval));
+ start = 0;
+ }
+
+
+ int i = 0;
+ for (i = 0; i < start; i++) {
+ shape[i] = current_lin_shape[i];
+ }
+ for (i = 0; i < size-1; i++) {
+ shape[i+start].start.x = segments[2*i];
+ shape[i+start].start.y = segments[2*i+1];
+ shape[i+start].end.x = segments[2*i+2];
+ shape[i+start].end.y = segments[2*i+3];
+ }
+
+ free (current_lin_shape);
+
+ current_lin_shape =
+ downsize_shape (shape, start+size-1, ¤t_lin_shape_size);
+
+ free (shape);
+
+ return (match_pattern (current_lin_shape, current_lin_shape_size));
+}
+
+static void stop_recognition_forced ()
+{
+ pthread_mutex_lock (&shapes_stop_mutex);
+ stop_signal = 1;
+ pthread_mutex_unlock (&shapes_stop_mutex);
+
+ pthread_mutex_lock (&shapes_working_mutex);
+ pthread_mutex_unlock (&shapes_working_mutex);
+}
+
+static void stop_recognition (int milisec)
+{
+ stop_recognition_forced ();
+ int failed_lock = pthread_mutex_trylock (&shapes_working_mutex);
+
+ int i = 0;
+ while ((failed_lock > 0) && (i < milisec)) {
+ usleep (10000);
+ i++;
+ failed_lock = pthread_mutex_trylock (&shapes_working_mutex);
+ }
+
+ if (failed_lock > 0) {
+ stop_recognition_forced ();
+ } else {
+ pthread_mutex_unlock (&shapes_working_mutex);
+ }
+}
+
+static void stop_recognition_now ()
+{
+ if (pthread_mutex_trylock (&shapes_working_mutex) == 0) {
+ pthread_mutex_unlock (&shapes_working_mutex);
+ } else {
+ stop_recognition_forced ();
+ }
+}
+
+int status_recognize = 0;
+void set_recognize (int onoff) { status_recognize = onoff; }
+int should_recognize () { return (status_recognize); }
+
+/* Default patterns. */
+
+/* There are 35 shapes with letters, but we skip letters and use only 10. */
+/*(-3, -3) -- (-3, 3) \
+(-3, 3) -- (3, 3) \
+(3, 3) -- (3, -3) \
+(3, -3) -- (-3, -3) \ */
+static const char* default_shape_patterns = "\
+SHAPES 1 \
+PRECISION 4 \
+RECO FACTOR 1.6 \
+ \
+SHAPE grid3 MAXDIST 900 CORRECTION 2 \
+SCALE DEVIATION 0 \
+ROTATION MIN -1 MAX 1 DENSITY 0 \
+START 8 \
+(-3, -3) -- (-3, 3) \
+(-3, 3) -- (3, 3) \
+(3, 3) -- (3, -3) \
+(3, -3) -- (-3, -3) \
+(-1, -3) -- (-1, 3) \
+(1, -3) -- (1, 3) \
+(-3, -1) -- (3, -1) \
+(-3, 1) -- (3, 1) \
+END \
+ \
+SHAPE grid3mid MAXDIST 900 CORRECTION 1 \
+SCALE DEVIATION 0.2 \
+ROTATION MIN -10 MAX 10 DENSITY 0 \
+START 6 \
+(-1, -3) -- (-1, 3) \
+(1, -3) -- (1, 3) \
+(-3, -1) -- (3, -1) \
+(-3, 1) -- (3, 1) \
+(0.8, 0.8) -- (-0.8, -0.8) \
+(0.8, -0.8) -- (-0.8, 0.8) \
+END \
+ \
+SHAPE arrow2 MAXDIST 9 CORRECTION 2.2 \
+SCALE DEVIATION 0 \
+ROTATION MIN -180 MAX 180 DENSITY 0 \
+START 7 \
+(0, -2) -- (0, -1) \
+(0, -1) -- (0, 0) \
+(0, 0) -- (0, 1) \
+(0, 1) -- (0, 2) \
+(0, 2) -- (-0.5, 1.5) \
+(-0.5, 1.5) -- (0, 2) \
+(0, 2) -- (0.5, 1.5) \
+END \
+ \
+ \
+SHAPE backarrow1 MAXDIST 9 CORRECTION 1.6 \
+SCALE DEVIATION 0 \
+ROTATION MIN -180 MAX 180 DENSITY 0 \
+START 18 \
+(0.75, 0.25) -- (1, 0) \
+(1, 0) -- (1.25, 0.25) \
+(1.25, 0.25) -- (1, 0) \
+(1.000000, 0.000000) -- (0.951057, 0.309017) \
+(0.951057, 0.309017) -- (0.809017, 0.587785) \
+(0.809017, 0.587785) -- (0.587785, 0.809017) \
+(0.587785, 0.809017) -- (0.309017, 0.951057) \
+(0.309017, 0.951057) -- (0.000000, 1.000000) \
+(0.000000, 1.000000) -- (-0.309017, 0.951057) \
+(-0.309017, 0.951057) -- (-0.587785, 0.809017) \
+(-0.587785, 0.809017) -- (-0.809017, 0.587785) \
+(-0.809017, 0.587785) -- (-0.951057, 0.309017) \
+(-0.951057, 0.309017) -- (-1.000000, 0.000000) \
+(-1.000000, 0.000000) -- (-0.951057, -0.309017) \
+(-0.951057, -0.309017) -- (-0.809017, -0.587785) \
+(-0.809017, -0.587785) -- (-0.587785, -0.809017) \
+(-0.587785, -0.809017) -- (-0.309017, -0.951057) \
+(-0.309017, -0.951057) -- (-0.000000, -1.000000) \
+END \
+ \
+ \
+SHAPE backarrow2 MAXDIST 9 CORRECTION 1.6 \
+SCALE DEVIATION 0 \
+ROTATION MIN -180 MAX 180 DENSITY 0 \
+START 18 \
+(1.000000, 0.000000) -- (0.951057, 0.309017) \
+(0.951057, 0.309017) -- (0.809017, 0.587785) \
+(0.809017, 0.587785) -- (0.587785, 0.809017) \
+(0.587785, 0.809017) -- (0.309017, 0.951057) \
+(0.309017, 0.951057) -- (0.000000, 1.000000) \
+(0.000000, 1.000000) -- (-0.309017, 0.951057) \
+(-0.309017, 0.951057) -- (-0.587785, 0.809017) \
+(-0.587785, 0.809017) -- (-0.809017, 0.587785) \
+(-0.809017, 0.587785) -- (-0.951057, 0.309017) \
+(-0.951057, 0.309017) -- (-1.000000, 0.000000) \
+(-1.000000, 0.000000) -- (-0.951057, -0.309017) \
+(-0.951057, -0.309017) -- (-0.809017, -0.587785) \
+(-0.809017, -0.587785) -- (-0.587785, -0.809017) \
+(-0.587785, -0.809017) -- (-0.309017, -0.951057) \
+(-0.309017, -0.951057) -- (-0.000000, -1.000000) \
+(0, -1) -- (-0.25, -0.75) \
+(-0.25, -0.75) -- (0, -1) \
+(0, -1) -- (-0.25, -1.25) \
+END \
+ \
+ \
+SHAPE bentarrow1 MAXDIST 9 CORRECTION 2 \
+SCALE DEVIATION 0 \
+ROTATION MIN -180 MAX 180 DENSITY 0 \
+START 11 \
+(0.751057, 0.309017) -- (0.951057, 0.309017) \
+(0.951057, 0.309017) -- (0.951057, 0.509017) \
+(0.951057, 0.509017) -- (0.951057, 0.309017) \
+(0.951057, 0.309017) -- (0.809017, 0.587785) \
+(0.809017, 0.587785) -- (0.587785, 0.809017) \
+(0.587785, 0.809017) -- (0.309017, 0.951057) \
+(0.309017, 0.951057) -- (0.000000, 1.000000) \
+(0.000000, 1.000000) -- (-0.309017, 0.951057) \
+(-0.309017, 0.951057) -- (-0.587785, 0.809017) \
+(-0.587785, 0.809017) -- (-0.809017, 0.587785) \
+(-0.809017, 0.587785) -- (-0.951057, 0.309017) \
+END \
+ \
+ \
+SHAPE bentarrow2 MAXDIST 9 CORRECTION 2 \
+SCALE DEVIATION 0 \
+ROTATION MIN -180 MAX 180 DENSITY 0 \
+START 11 \
+(0.951057, 0.309017) -- (0.809017, 0.587785) \
+(0.809017, 0.587785) -- (0.587785, 0.809017) \
+(0.587785, 0.809017) -- (0.309017, 0.951057) \
+(0.309017, 0.951057) -- (0.000000, 1.000000) \
+(0.000000, 1.000000) -- (-0.309017, 0.951057) \
+(-0.309017, 0.951057) -- (-0.587785, 0.809017) \
+(-0.587785, 0.809017) -- (-0.809017, 0.587785) \
+(-0.809017, 0.587785) -- (-0.951057, 0.309017) \
+(-0.951057, 0.309017) -- (-0.951057, 0.509017) \
+(-0.951057, 0.509017) -- (-0.951057, 0.309017) \
+(-0.951057, 0.309017) -- (-0.751057, 0.309017) \
+END \
+ \
+ \
+SHAPE triangle MAXDIST 8 CORRECTION 1.7 \
+SCALE DEVIATION 0.2 \
+ROTATION MIN -180 MAX 180 DENSITY 30 \
+START 6 \
+(0, 0) -- (1, 0) \
+(1, 0) -- (2, 0) \
+(2, 0) -- (1.5, 0.866025) \
+(1.5, 0.866025) -- (1, 1.732051) \
+(1, 1.732051) -- (0.5, 0.866025) \
+(0.5, 0.866025) -- (0, 0) \
+END \
+ \
+ \
+SHAPE rectangle MAXDIST 7 CORRECTION 0.8 \
+SCALE DEVIATION 0.35 \
+ROTATION MIN -45 MAX 45 DENSITY 45 \
+START 8 \
+(0, 0) -- (0, 1) \
+(0, 1) -- (0, 2) \
+(0, 2) -- (1, 2) \
+(1, 2) -- (2, 2) \
+(2, 2) -- (2, 1) \
+(2, 1) -- (2, 0) \
+(2, 0) -- (1, 0) \
+(1, 0) -- (0, 0) \
+END \
+ \
+SHAPE circle MAXDIST 7 CORRECTION 0 \
+SCALE DEVIATION 0.35 \
+ROTATION MIN -45 MAX 45 DENSITY 90 \
+START 41 \
+(1.000000, 0.000000) -- (0.988280, 0.152649) \
+(0.988280, 0.152649) -- (0.953396, 0.301721) \
+(0.953396, 0.301721) -- (0.896166, 0.443720) \
+(0.896166, 0.443720) -- (0.817929, 0.575319) \
+(0.817929, 0.575319) -- (0.720522, 0.693433) \
+(0.720522, 0.693433) -- (0.606225, 0.795293) \
+(0.606225, 0.795293) -- (0.477720, 0.878512) \
+(0.477720, 0.878512) -- (0.338017, 0.941140) \
+(0.338017, 0.941140) -- (0.190391, 0.981708) \
+(0.190391, 0.981708) -- (0.038303, 0.999266) \
+(0.038303, 0.999266) -- (-0.114683, 0.993402) \
+(-0.114683, 0.993402) -- (-0.264982, 0.964253) \
+(-0.264982, 0.964253) -- (-0.409069, 0.912504) \
+(-0.409069, 0.912504) -- (-0.543568, 0.839365) \
+(-0.543568, 0.839365) -- (-0.665326, 0.746553) \
+(-0.665326, 0.746553) -- (-0.771489, 0.636242) \
+(-0.771489, 0.636242) -- (-0.859570, 0.511019) \
+(-0.859570, 0.511019) -- (-0.927502, 0.373817) \
+(-0.927502, 0.373817) -- (-0.973695, 0.227854) \
+(-0.973695, 0.227854) -- (-0.997066, 0.076549) \
+(-0.997066, 0.076549) -- (-0.997066, -0.076549) \
+(-0.997066, -0.076549) -- (-0.973695, -0.227854) \
+(-0.973695, -0.227854) -- (-0.927502, -0.373817) \
+(-0.927502, -0.373817) -- (-0.859570, -0.511019) \
+(-0.859570, -0.511019) -- (-0.771489, -0.636242) \
+(-0.771489, -0.636242) -- (-0.665326, -0.746553) \
+(-0.665326, -0.746553) -- (-0.543568, -0.839365) \
+(-0.543568, -0.839365) -- (-0.409069, -0.912504) \
+(-0.409069, -0.912504) -- (-0.264982, -0.964253) \
+(-0.264982, -0.964253) -- (-0.114683, -0.993402) \
+(-0.114683, -0.993402) -- (0.038303, -0.999266) \
+(0.038303, -0.999266) -- (0.190391, -0.981708) \
+(0.190391, -0.981708) -- (0.338017, -0.941140) \
+(0.338017, -0.941140) -- (0.477720, -0.878512) \
+(0.477720, -0.878512) -- (0.606225, -0.795293) \
+(0.606225, -0.795293) -- (0.720522, -0.693433) \
+(0.720522, -0.693433) -- (0.817929, -0.575319) \
+(0.817929, -0.575319) -- (0.896166, -0.443720) \
+(0.896166, -0.443720) -- (0.953396, -0.301721) \
+(0.953396, -0.301721) -- (0.988280, -0.152649) \
+(0.988280, -0.152649) -- (1.000000, -0.000000) \
+END \
+ \
+SHAPE A MAXDIST 8 CORRECTION 2 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 4 \
+(0.5, 4) -- (0.2, 4) \
+(0.2, 4) -- (-1.5, 0) \
+(0.5, 4) -- (1.5, 0) \
+(-0.8, 2) -- (1.2, 2) \
+END \
+ \
+SHAPE B MAXDIST 8 CORRECTION 3.6 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 11 \
+(0, 4) -- (0, 0) \
+(0, 0) -- (1.5, 0) \
+(1.5, 0) -- (2.2, 0.5) \
+(2.2, 0.5) -- (2.4, 1.1) \
+(2.4, 1.1) -- (2.2, 1.7) \
+(2.2, 1.7) -- (1.5, 2.2) \
+(1.5, 2.2) -- (1.2, 2.2) \
+(1.2, 2.2) -- (1.8, 3.1) \
+(1.8, 3.1) -- (1.2, 4) \
+(1.2, 4) -- (0, 4) \
+(0, 2.2) -- (1.2, 2.2) \
+END \
+ \
+SHAPE C MAXDIST 8 CORRECTION 2.2 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 8 \
+(3, 0.8) -- (2, 0) \
+(2, 0) -- (1, 0) \
+(1, 0) -- (0, 1) \
+(0, 1) -- (0, 2) \
+(0, 2) -- (0, 3) \
+(0, 3) -- (1, 4) \
+(1, 4) -- (2, 4) \
+(2, 4) -- (2.5, 3.5) \
+END \
+ \
+SHAPE D MAXDIST 8 CORRECTION 2.4 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 7 \
+(0, 4) -- (0, 2) \
+(0, 2) -- (0, 0) \
+(0, 0) -- (1, 0) \
+(1, 0) -- (2, 0.8) \
+(2, 0.8) -- (2, 2.8) \
+(2, 2.8) -- (1, 4) \
+(1, 4) -- (0, 4) \
+END \
+ \
+SHAPE E MAXDIST 8 CORRECTION 2.6 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 5 \
+(0, 4) -- (0, 0) \
+(2, 0) -- (0, 0) \
+(0, 0) -- (0, 2) \
+(1.5, 2) -- (0, 2) \
+(0, 4) -- (2, 4) \
+END \
+ \
+SHAPE F MAXDIST 8 CORRECTION 3.8 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 4 \
+(0, 0) -- (0, 4) \
+(0, 4) -- (2.5, 4) \
+(2.5, 4) -- (2.5, 3.8) \
+(0, 1.9) -- (1.8, 1.9) \
+END \
+ \
+SHAPE G MAXDIST 8 CORRECTION 3.4 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 9 \
+(2, 4) -- (1, 4) \
+(1, 4) -- (0, 3) \
+(0, 3) -- (0, 2) \
+(0, 2) -- (0, 1) \
+(0, 1) -- (1, 0) \
+(1, 0) -- (2, 0) \
+(2, 0) -- (2.5, 2) \
+(2.5, 2) -- (1.5, 2) \
+(1.5, 2) -- (3.5, 2) \
+END \
+ \
+SHAPE H MAXDIST 8 CORRECTION 2.4 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 4 \
+(0, 4) -- (0, 0) \
+(2.5, 4) -- (2.5, 0) \
+(0, 1.8) -- (1.5, 1.8) \
+(1.5, 1.8) -- (2.5, 2) \
+END \
+ \
+SHAPE I MAXDIST 8 CORRECTION 3.2 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 3 \
+(-1, 0) -- (1, 0) \
+(0, 0) -- (0, 4) \
+(-1, 4) -- (1, 4) \
+END \
+ \
+SHAPE J MAXDIST 8 CORRECTION 3.8 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 4 \
+(-2, 4) -- (0, 4) \
+(0, 4) -- (0, 1) \
+(0, 1) -- (-1, 0) \
+(-1, 0) -- (-2, 1) \
+END \
+ \
+SHAPE K MAXDIST 8 CORRECTION 1.5 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 3 \
+(0, 4) -- (0, 0) \
+(0, 1) -- (3, 4) \
+(0.5, 1.5) -- (3, 0) \
+END \
+ \
+SHAPE L MAXDIST 8 CORRECTION 2 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 2 \
+(0, 4) -- (0, 0) \
+(0, 0) -- (2, 0) \
+END \
+ \
+SHAPE M MAXDIST 8 CORRECTION 2.5 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 6 \
+(0, 0) -- (0, 4) \
+(0, 4) -- (1.2, 2.2) \
+(1.2, 2.2) -- (1.5, 2) \
+(1.5, 2) -- (1.8, 2.2) \
+(1.8, 2.2) -- (3, 4) \
+(3, 4) -- (3, 0) \
+END \
+ \
+SHAPE N MAXDIST 8 CORRECTION 2 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 4 \
+(0, 0) -- (0, 4) \
+(0, 4) -- (2, 0.5) \
+(2, 0.5) -- (2.5, 1) \
+(2.5, 1) -- (2.8, 4) \
+END \
+ \
+SHAPE P MAXDIST 8 CORRECTION 1.5 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 6 \
+(0, 0) -- (0, 4) \
+(0, 4) -- (1, 4) \
+(1, 4) -- (2, 3.5) \
+(2, 3.5) -- (2, 2.5) \
+(2, 2.5) -- (1, 2) \
+(1, 2) -- (0, 2) \
+END \
+ \
+SHAPE Q MAXDIST 8 CORRECTION 3.4 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 9 \
+(2, 0) -- (1, 0) \
+(1, 0) -- (0, 1) \
+(0, 1) -- (0, 3) \
+(0, 3) -- (1, 4) \
+(1, 4) -- (2, 4) \
+(2, 4) -- (3, 3) \
+(3, 3) -- (3, 1) \
+(3, 1) -- (2, 0) \
+(2, 1) -- (4, 0) \
+END \
+ \
+SHAPE R MAXDIST 8 CORRECTION 2.2 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 7 \
+(0, 0) -- (0, 4) \
+(0, 4) -- (1, 4) \
+(1, 4) -- (2, 3.5) \
+(2, 3.5) -- (2, 2.5) \
+(2, 2.5) -- (1, 2) \
+(1, 2) -- (0, 2) \
+(0, 2) -- (2, 0) \
+END \
+ \
+SHAPE S MAXDIST 8 CORRECTION 2.6 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 8 \
+(1.5, 3.5) -- (1, 4) \
+(1, 4) -- (0, 4) \
+(0, 4) -- (-1, 3) \
+(-1, 3) -- (0, 2) \
+(0, 2) -- (1, 1) \
+(1, 1) -- (0, 0) \
+(0, 0) -- (-1, 0) \
+(-1, 0) -- (-1.5, 0.5) \
+END \
+ \
+SHAPE T MAXDIST 8 CORRECTION 5.8 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 4 \
+(1.4, 3.8) -- (1.4, 4) \
+(1.4, 4) -- (-1.4, 4) \
+(-1.4, 4) -- (-1.4, 3.8) \
+(0, 4) -- (0, 0) \
+END \
+ \
+SHAPE U MAXDIST 8 CORRECTION 1.7 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 6 \
+(1, 4) -- (1, 1.5) \
+(1, 1.5) -- (1.4, 0) \
+(1, 1.5) -- (0, 0) \
+(0, 0) -- (-0.5, 0) \
+(-0.5, 0) -- (-1, 1) \
+(-1, 1) -- (-1, 4) \
+END \
+ \
+SHAPE V MAXDIST 8 CORRECTION 1.6 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 2 \
+(1.5, 4.5) -- (0, 0) \
+(-1, 4) -- (0, 0) \
+END \
+ \
+SHAPE W MAXDIST 8 CORRECTION 2 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 4 \
+(-1.5, 4) -- (-1, 0) \
+(-1, 0) -- (0, 2.5) \
+(0, 2.5) -- (1, 0) \
+(1, 0) -- (2, 4) \
+END \
+ \
+SHAPE X MAXDIST 8 CORRECTION 2.8 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 4 \
+(-2, 4) -- (0, 0) \
+(0, 0) -- (2, 4) \
+(-2, -4) -- (0, 0) \
+(0, 0) -- (2, -4) \
+END \
+ \
+SHAPE Y MAXDIST 8 CORRECTION 4.4 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 2 \
+(2, 4) -- (0, 0) \
+(-0.8, 4) -- (0.8, 1.6) \
+END \
+ \
+SHAPE Z MAXDIST 8 CORRECTION 2.8 \
+SCALE DEVIATION 0.5 \
+ROTATION MIN -9 MAX 9 DENSITY 20 \
+START 3 \
+(0, 4) -- (3, 4) \
+(3, 4) -- (0, 0) \
+(0, 0) -- (3, 0) \
+END \
+";
+
+
+/* Cut shape to the given rectangle. */
+static interval* cut_shape (const interval* shape, const int size,
+ point bottom_left, point top_right, int* res_size)
+{
+ int new_size = 0;
+ int i = 0;
+ for (i = 0; i < size; i++) {
+ if (shape[i].start.x > bottom_left.x && shape[i].start.y > bottom_left.y &&
+ shape[i].start.x < top_right.x && shape[i].start.y < top_right.y &&
+ shape[i].end.x > bottom_left.x && shape[i].end.y > bottom_left.y &&
+ shape[i].end.x < top_right.x && shape[i].end.y < top_right.y) {
+ new_size++;
+ }
+ }
+
+ interval* new_shape = calloc (new_size, sizeof (interval));
+ int j = 0;
+ for (i = 0; i < size; i++) {
+ if (shape[i].start.x > bottom_left.x && shape[i].start.y > bottom_left.y &&
+ shape[i].start.x < top_right.x && shape[i].start.y < top_right.y &&
+ shape[i].end.x > bottom_left.x && shape[i].end.y > bottom_left.y &&
+ shape[i].end.x < top_right.x && shape[i].end.y < top_right.y) {
+ new_shape[j].start.x = shape[i].start.x;
+ new_shape[j].start.y = shape[i].start.y;
+ new_shape[j].end.x = shape[i].end.x;
+ new_shape[j].end.y = shape[i].end.y;
+ j++;
+ }
+ }
+
+ *res_size = new_size;
+ return (new_shape);
+}
+
+#define gridSIZE 3
+#define gridJUMP 1
+#define gridMARGIN 0.28
+int gridSIZES[gridSIZE][gridSIZE];
+interval * gridSHAPES[gridSIZE][gridSIZE];
+
+
+/* Run complete recognition from string, return resul...
[truncated message content] |
|
From: <luk...@us...> - 2011-11-17 23:56:48
|
Revision: 1635
http://toss.svn.sourceforge.net/toss/?rev=1635&view=rev
Author: lukaszkaiser
Date: 2011-11-17 23:56:41 +0000 (Thu, 17 Nov 2011)
Log Message:
-----------
Corrections in Distinguish, adding and cleaning up code documentation, removing old unused modules.
Modified Paths:
--------------
trunk/Toss/Arena/DiscreteRule.mli
trunk/Toss/Formula/FormulaMap.mli
trunk/Toss/Formula/FormulaSubst.mli
trunk/Toss/Formula/Sat/Sat.mli
trunk/Toss/GGP/GameSimpl.mli
trunk/Toss/GGP/TranslateFormula.mli
trunk/Toss/GGP/TranslateGame.mli
trunk/Toss/Server/DB.mli
trunk/Toss/Server/Picture.mli
trunk/Toss/Server/ReqHandler.mli
trunk/Toss/Solver/AssignmentSet.mli
trunk/Toss/Solver/Assignments.mli
trunk/Toss/Solver/Distinguish.ml
trunk/Toss/Solver/RealQuantElim/OrderedPoly.mli
trunk/Toss/Solver/RealQuantElim/OrderedPolySet.mli
trunk/Toss/Solver/RealQuantElim/Poly.mli
trunk/Toss/Solver/RealQuantElim/RealQuantElim.mli
trunk/Toss/Solver/RealQuantElim/SignTable.mli
trunk/Toss/Solver/Structure.mli
trunk/Toss/Toss.odocl
Removed Paths:
-------------
trunk/Toss/Formula/Sat/IntSet.ml
trunk/Toss/Formula/Sat/IntSet.mli
Modified: trunk/Toss/Arena/DiscreteRule.mli
===================================================================
--- trunk/Toss/Arena/DiscreteRule.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Arena/DiscreteRule.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,4 +1,4 @@
-(** {1 Discrete Structure Rewriting Rules and Rewriting.} *)
+(** Discrete structure rewriting rules construction and rewriting. *)
val debug_level : int ref
Modified: trunk/Toss/Formula/FormulaMap.mli
===================================================================
--- trunk/Toss/Formula/FormulaMap.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Formula/FormulaMap.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,3 +1,5 @@
+(** Maps, iterators and folds over formulas and real-valued expressions. *)
+
open Formula
(** {2 Basic maps - to literals and atoms.} *)
Modified: trunk/Toss/Formula/FormulaSubst.mli
===================================================================
--- trunk/Toss/Formula/FormulaSubst.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Formula/FormulaSubst.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,3 +1,5 @@
+(** Substitutions in formulas and real-valued expressions. *)
+
open Formula
(** {2 Basic Substitution Functions} *)
Deleted: trunk/Toss/Formula/Sat/IntSet.ml
===================================================================
--- trunk/Toss/Formula/Sat/IntSet.ml 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Formula/Sat/IntSet.ml 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,688 +0,0 @@
-(**************************************************************************)
-(* *)
-(* Copyright (C) Jean-Christophe Filliatre *)
-(* *)
-(* This software is free software; you can redistribute it and/or *)
-(* modify it under the terms of the GNU Library General Public *)
-(* License version 2.1, with the special exception on linking *)
-(* described in file LICENSE. *)
-(* *)
-(* This software is distributed in the hope that it will be useful, *)
-(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
-(* *)
-(**************************************************************************)
-
-(*i $Id: ptset.ml,v 1.17 2008-07-22 06:44:06 filliatr Exp $ i*)
-
-(*s Sets of integers implemented as Patricia trees, following Chris
- Okasaki and Andrew Gill's paper {\em Fast Mergeable Integer Maps}
- ({\tt\small http://www.cs.columbia.edu/\~{}cdo/papers.html\#ml98maps}).
- Patricia trees provide faster operations than standard library's
- module [Set], and especially very fast [union], [subset], [inter]
- and [diff] operations. *)
-
-(*s The idea behind Patricia trees is to build a {\em trie} on the
- binary digits of the elements, and to compact the representation
- by branching only one the relevant bits (i.e. the ones for which
- there is at least on element in each subtree). We implement here
- {\em little-endian} Patricia trees: bits are processed from
- least-significant to most-significant. The trie is implemented by
- the following type [t]. [Empty] stands for the empty trie, and
- [Leaf k] for the singleton [k]. (Note that [k] is the actual
- element.) [Branch (m,p,l,r)] represents a branching, where [p] is
- the prefix (from the root of the trie) and [m] is the branching
- bit (a power of 2). [l] and [r] contain the subsets for which the
- branching bit is respectively 0 and 1. Invariant: the trees [l]
- and [r] are not empty. *)
-
-(*i*)
-type elt = int
-(*i*)
-
-type t =
- | Empty
- | Leaf of int
- | Branch of int * int * t * t
-
-(*s Example: the representation of the set $\{1,4,5\}$ is
- $$\mathtt{Branch~(0,~1,~Leaf~4,~Branch~(1,~4,~Leaf~1,~Leaf~5))}$$
- The first branching bit is the bit 0 (and the corresponding prefix
- is [0b0], not of use here), with $\{4\}$ on the left and $\{1,5\}$ on the
- right. Then the right subtree branches on bit 2 (and so has a branching
- value of $2^2 = 4$), with prefix [0b01 = 1]. *)
-
-(*s Empty set and singletons. *)
-
-let empty = Empty
-
-let is_empty = function Empty -> true | _ -> false
-
-let singleton k = Leaf k
-
-let is_singleton = function Leaf _ -> true | _ -> false
-
-(*s Testing the occurrence of a value is similar to the search in a
- binary search tree, where the branching bit is used to select the
- appropriate subtree. *)
-
-let zero_bit k m = (k land m) == 0
-
-let rec mem k = function
- | Empty -> false
- | Leaf j -> k == j
- | Branch (_, m, l, r) -> mem k (if zero_bit k m then l else r)
-
-(*s The following operation [join] will be used in both insertion and
- union. Given two non-empty trees [t0] and [t1] with longest common
- prefixes [p0] and [p1] respectively, which are supposed to
- disagree, it creates the union of [t0] and [t1]. For this, it
- computes the first bit [m] where [p0] and [p1] disagree and create
- a branching node on that bit. Depending on the value of that bit
- in [p0], [t0] will be the left subtree and [t1] the right one, or
- the converse. Computing the first branching bit of [p0] and [p1]
- uses a nice property of twos-complement representation of integers. *)
-
-let lowest_bit x = x land (-x)
-
-let branching_bit p0 p1 = lowest_bit (p0 lxor p1)
-
-let mask p m = p land (m-1)
-
-let join (p0,t0,p1,t1) =
- let m = branching_bit p0 p1 in
- if zero_bit p0 m then
- Branch (mask p0 m, m, t0, t1)
- else
- Branch (mask p0 m, m, t1, t0)
-
-(*s Then the insertion of value [k] in set [t] is easily implemented
- using [join]. Insertion in a singleton is just the identity or a
- call to [join], depending on the value of [k]. When inserting in
- a branching tree, we first check if the value to insert [k]
- matches the prefix [p]: if not, [join] will take care of creating
- the above branching; if so, we just insert [k] in the appropriate
- subtree, depending of the branching bit. *)
-
-let match_prefix k p m = (mask k m) == p
-
-let add k t =
- let rec ins = function
- | Empty -> Leaf k
- | Leaf j as t ->
- if j == k then t else join (k, Leaf k, j, t)
- | Branch (p,m,t0,t1) as t ->
- if match_prefix k p m then
- if zero_bit k m then
- Branch (p, m, ins t0, t1)
- else
- Branch (p, m, t0, ins t1)
- else
- join (k, Leaf k, p, t)
- in
- ins t
-
-(*s The code to remove an element is basically similar to the code of
- insertion. But since we have to maintain the invariant that both
- subtrees of a [Branch] node are non-empty, we use here the
- ``smart constructor'' [branch] instead of [Branch]. *)
-
-let branch = function
- | (_,_,Empty,t) -> t
- | (_,_,t,Empty) -> t
- | (p,m,t0,t1) -> Branch (p,m,t0,t1)
-
-let remove k t =
- let rec rmv = function
- | Empty -> Empty
- | Leaf j as t -> if k == j then Empty else t
- | Branch (p,m,t0,t1) as t ->
- if match_prefix k p m then
- if zero_bit k m then
- branch (p, m, rmv t0, t1)
- else
- branch (p, m, t0, rmv t1)
- else
- t
- in
- rmv t
-
-(*s One nice property of Patricia trees is to support a fast union
- operation (and also fast subset, difference and intersection
- operations). When merging two branching trees we examine the
- following four cases: (1) the trees have exactly the same
- prefix; (2/3) one prefix contains the other one; and (4) the
- prefixes disagree. In cases (1), (2) and (3) the recursion is
- immediate; in case (4) the function [join] creates the appropriate
- branching. *)
-
-let rec merge = function
- | Empty, t -> t
- | t, Empty -> t
- | Leaf k, t -> add k t
- | t, Leaf k -> add k t
- | (Branch (p,m,s0,s1) as s), (Branch (q,n,t0,t1) as t) ->
- if m == n && match_prefix q p m then
- (* The trees have the same prefix. Merge the subtrees. *)
- Branch (p, m, merge (s0,t0), merge (s1,t1))
- else if m < n && match_prefix q p m then
- (* [q] contains [p]. Merge [t] with a subtree of [s]. *)
- if zero_bit q m then
- Branch (p, m, merge (s0,t), s1)
- else
- Branch (p, m, s0, merge (s1,t))
- else if m > n && match_prefix p q n then
- (* [p] contains [q]. Merge [s] with a subtree of [t]. *)
- if zero_bit p n then
- Branch (q, n, merge (s,t0), t1)
- else
- Branch (q, n, t0, merge (s,t1))
- else
- (* The prefixes disagree. *)
- join (p, s, q, t)
-
-let union s t = merge (s,t)
-
-(*s When checking if [s1] is a subset of [s2] only two of the above
- four cases are relevant: when the prefixes are the same and when the
- prefix of [s1] contains the one of [s2], and then the recursion is
- obvious. In the other two cases, the result is [false]. *)
-
-let rec subset s1 s2 = match (s1,s2) with
- | Empty, _ -> true
- | _, Empty -> false
- | Leaf k1, _ -> mem k1 s2
- | Branch _, Leaf _ -> false
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- subset l1 l2 && subset r1 r2
- else if m1 > m2 && match_prefix p1 p2 m2 then
- if zero_bit p1 m2 then
- subset l1 l2 && subset r1 l2
- else
- subset l1 r2 && subset r1 r2
- else
- false
-
-(*s To compute the intersection and the difference of two sets, we
- still examine the same four cases as in [merge]. The recursion is
- then obvious. *)
-
-let rec inter s1 s2 = match (s1,s2) with
- | Empty, _ -> Empty
- | _, Empty -> Empty
- | Leaf k1, _ -> if mem k1 s2 then s1 else Empty
- | _, Leaf k2 -> if mem k2 s1 then s2 else Empty
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- merge (inter l1 l2, inter r1 r2)
- else if m1 < m2 && match_prefix p2 p1 m1 then
- inter (if zero_bit p2 m1 then l1 else r1) s2
- else if m1 > m2 && match_prefix p1 p2 m2 then
- inter s1 (if zero_bit p1 m2 then l2 else r2)
- else
- Empty
-
-let rec diff s1 s2 = match (s1,s2) with
- | Empty, _ -> Empty
- | _, Empty -> s1
- | Leaf k1, _ -> if mem k1 s2 then Empty else s1
- | _, Leaf k2 -> remove k2 s1
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- merge (diff l1 l2, diff r1 r2)
- else if m1 < m2 && match_prefix p2 p1 m1 then
- if zero_bit p2 m1 then
- merge (diff l1 s2, r1)
- else
- merge (l1, diff r1 s2)
- else if m1 > m2 && match_prefix p1 p2 m2 then
- if zero_bit p1 m2 then diff s1 l2 else diff s1 r2
- else
- s1
-
-(*s All the following operations ([cardinal], [iter], [fold], [for_all],
- [exists], [filter], [partition], [choose], [elements]) are
- implemented as for any other kind of binary trees. *)
-
-let rec cardinal = function
- | Empty -> 0
- | Leaf _ -> 1
- | Branch (_,_,t0,t1) -> cardinal t0 + cardinal t1
-
-let rec iter f = function
- | Empty -> ()
- | Leaf k -> f k
- | Branch (_,_,t0,t1) -> iter f t0; iter f t1
-
-let rec fold f s accu = match s with
- | Empty -> accu
- | Leaf k -> f k accu
- | Branch (_,_,t0,t1) -> fold f t0 (fold f t1 accu)
-
-let rec for_all p = function
- | Empty -> true
- | Leaf k -> p k
- | Branch (_,_,t0,t1) -> for_all p t0 && for_all p t1
-
-let rec exists p = function
- | Empty -> false
- | Leaf k -> p k
- | Branch (_,_,t0,t1) -> exists p t0 || exists p t1
-
-let rec filter pr = function
- | Empty -> Empty
- | Leaf k as t -> if pr k then t else Empty
- | Branch (p,m,t0,t1) -> branch (p, m, filter pr t0, filter pr t1)
-
-let partition p s =
- let rec part (t,f as acc) = function
- | Empty -> acc
- | Leaf k -> if p k then (add k t, f) else (t, add k f)
- | Branch (_,_,t0,t1) -> part (part acc t0) t1
- in
- part (Empty, Empty) s
-
-let rec choose = function
- | Empty -> raise Not_found
- | Leaf k -> k
- | Branch (_, _,t0,_) -> choose t0 (* we know that [t0] is non-empty *)
-
-let elements s =
- let rec elements_aux acc = function
- | Empty -> acc
- | Leaf k -> k :: acc
- | Branch (_,_,l,r) -> elements_aux (elements_aux acc l) r
- in
- (* unfortunately there is no easy way to get the elements in ascending
- order with little-endian Patricia trees *)
- List.sort Pervasives.compare (elements_aux [] s)
-
-let split x s =
- let coll k (l, b, r) =
- if k < x then add k l, b, r
- else if k > x then l, b, add k r
- else l, true, r
- in
- fold coll s (Empty, false, Empty)
-
-(*s There is no way to give an efficient implementation of [min_elt]
- and [max_elt], as with binary search trees. The following
- implementation is a traversal of all elements, barely more
- efficient than [fold min t (choose t)] (resp. [fold max t (choose
- t)]). Note that we use the fact that there is no constructor
- [Empty] under [Branch] and therefore always a minimal
- (resp. maximal) element there. *)
-
-let rec min_elt = function
- | Empty -> raise Not_found
- | Leaf k -> k
- | Branch (_,_,s,t) -> min (min_elt s) (min_elt t)
-
-let rec max_elt = function
- | Empty -> raise Not_found
- | Leaf k -> k
- | Branch (_,_,s,t) -> max (max_elt s) (max_elt t)
-
-(*s Another nice property of Patricia trees is to be independent of the
- order of insertion. As a consequence, two Patricia trees have the
- same elements if and only if they are structurally equal. *)
-
-let equal = (=)
-
-let compare = compare
-
-(*i*)
-let make l = List.fold_right add l empty
-(*i*)
-
-(*s Additional functions w.r.t to [Set.S]. *)
-
-let rec intersect s1 s2 = match (s1,s2) with
- | Empty, _ -> false
- | _, Empty -> false
- | Leaf k1, _ -> mem k1 s2
- | _, Leaf k2 -> mem k2 s1
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- intersect l1 l2 || intersect r1 r2
- else if m1 < m2 && match_prefix p2 p1 m1 then
- intersect (if zero_bit p2 m1 then l1 else r1) s2
- else if m1 > m2 && match_prefix p1 p2 m2 then
- intersect s1 (if zero_bit p1 m2 then l2 else r2)
- else
- false
-
-
-(*s Big-endian Patricia trees *)
-
-module Big = struct
-
- type elt = int
-
- type t_ = t
- type t = t_
-
- let empty = Empty
-
- let is_empty = function Empty -> true | _ -> false
-
- let singleton k = Leaf k
-
- let zero_bit k m = (k land m) == 0
-
- let rec mem k = function
- | Empty -> false
- | Leaf j -> k == j
- | Branch (_, m, l, r) -> mem k (if zero_bit k m then l else r)
-
- let mask k m = (k lor (m-1)) land (lnot m)
-
- (* we first write a naive implementation of [highest_bit]
- only has to work for bytes *)
- let naive_highest_bit x =
- assert (x < 256);
- let rec loop i =
- if i = 0 then 1 else if x lsr i = 1 then 1 lsl i else loop (i-1)
- in
- loop 7
-
- (* then we build a table giving the highest bit for bytes *)
- let hbit = Array.init 256 naive_highest_bit
-
- (* to determine the highest bit of [x] we split it into bytes *)
- let highest_bit_32 x =
- let n = x lsr 24 in if n != 0 then hbit.(n) lsl 24
- else let n = x lsr 16 in if n != 0 then hbit.(n) lsl 16
- else let n = x lsr 8 in if n != 0 then hbit.(n) lsl 8
- else hbit.(x)
-
- let highest_bit_64 x =
- let n = x lsr 32 in if n != 0 then (highest_bit_32 n) lsl 32
- else highest_bit_32 x
-
- let highest_bit = match Sys.word_size with
- | 32 -> highest_bit_32
- | 64 -> highest_bit_64
- | _ -> assert false
-
- let branching_bit p0 p1 = highest_bit (p0 lxor p1)
-
- let join (p0,t0,p1,t1) =
- (*i let m = function Branch (_,m,_,_) -> m | _ -> 0 in i*)
- let m = branching_bit p0 p1 (*EXP (m t0) (m t1) *) in
- if zero_bit p0 m then
- Branch (mask p0 m, m, t0, t1)
- else
- Branch (mask p0 m, m, t1, t0)
-
- let match_prefix k p m = (mask k m) == p
-
- let add k t =
- let rec ins = function
- | Empty -> Leaf k
- | Leaf j as t ->
- if j == k then t else join (k, Leaf k, j, t)
- | Branch (p,m,t0,t1) as t ->
- if match_prefix k p m then
- if zero_bit k m then
- Branch (p, m, ins t0, t1)
- else
- Branch (p, m, t0, ins t1)
- else
- join (k, Leaf k, p, t)
- in
- ins t
-
- let remove k t =
- let rec rmv = function
- | Empty -> Empty
- | Leaf j as t -> if k == j then Empty else t
- | Branch (p,m,t0,t1) as t ->
- if match_prefix k p m then
- if zero_bit k m then
- branch (p, m, rmv t0, t1)
- else
- branch (p, m, t0, rmv t1)
- else
- t
- in
- rmv t
-
- let rec merge = function
- | Empty, t -> t
- | t, Empty -> t
- | Leaf k, t -> add k t
- | t, Leaf k -> add k t
- | (Branch (p,m,s0,s1) as s), (Branch (q,n,t0,t1) as t) ->
- if m == n && match_prefix q p m then
- (* The trees have the same prefix. Merge the subtrees. *)
- Branch (p, m, merge (s0,t0), merge (s1,t1))
- else if m > n && match_prefix q p m then
- (* [q] contains [p]. Merge [t] with a subtree of [s]. *)
- if zero_bit q m then
- Branch (p, m, merge (s0,t), s1)
- else
- Branch (p, m, s0, merge (s1,t))
- else if m < n && match_prefix p q n then
- (* [p] contains [q]. Merge [s] with a subtree of [t]. *)
- if zero_bit p n then
- Branch (q, n, merge (s,t0), t1)
- else
- Branch (q, n, t0, merge (s,t1))
- else
- (* The prefixes disagree. *)
- join (p, s, q, t)
-
- let union s t = merge (s,t)
-
- let rec subset s1 s2 = match (s1,s2) with
- | Empty, _ -> true
- | _, Empty -> false
- | Leaf k1, _ -> mem k1 s2
- | Branch _, Leaf _ -> false
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- subset l1 l2 && subset r1 r2
- else if m1 < m2 && match_prefix p1 p2 m2 then
- if zero_bit p1 m2 then
- subset l1 l2 && subset r1 l2
- else
- subset l1 r2 && subset r1 r2
- else
- false
-
- let rec inter s1 s2 = match (s1,s2) with
- | Empty, _ -> Empty
- | _, Empty -> Empty
- | Leaf k1, _ -> if mem k1 s2 then s1 else Empty
- | _, Leaf k2 -> if mem k2 s1 then s2 else Empty
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- merge (inter l1 l2, inter r1 r2)
- else if m1 > m2 && match_prefix p2 p1 m1 then
- inter (if zero_bit p2 m1 then l1 else r1) s2
- else if m1 < m2 && match_prefix p1 p2 m2 then
- inter s1 (if zero_bit p1 m2 then l2 else r2)
- else
- Empty
-
- let rec diff s1 s2 = match (s1,s2) with
- | Empty, _ -> Empty
- | _, Empty -> s1
- | Leaf k1, _ -> if mem k1 s2 then Empty else s1
- | _, Leaf k2 -> remove k2 s1
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- merge (diff l1 l2, diff r1 r2)
- else if m1 > m2 && match_prefix p2 p1 m1 then
- if zero_bit p2 m1 then
- merge (diff l1 s2, r1)
- else
- merge (l1, diff r1 s2)
- else if m1 < m2 && match_prefix p1 p2 m2 then
- if zero_bit p1 m2 then diff s1 l2 else diff s1 r2
- else
- s1
-
- (* same implementation as for little-endian Patricia trees *)
- let cardinal = cardinal
- let iter = iter
- let fold = fold
- let for_all = for_all
- let exists = exists
- let filter = filter
-
- let partition p s =
- let rec part (t,f as acc) = function
- | Empty -> acc
- | Leaf k -> if p k then (add k t, f) else (t, add k f)
- | Branch (_,_,t0,t1) -> part (part acc t0) t1
- in
- part (Empty, Empty) s
-
- let choose = choose
-
- let elements s =
- let rec elements_aux acc = function
- | Empty -> acc
- | Leaf k -> k :: acc
- | Branch (_,_,l,r) -> elements_aux (elements_aux acc r) l
- in
- (* we still have to sort because of possible negative elements *)
- List.sort Pervasives.compare (elements_aux [] s)
-
- let split x s =
- let coll k (l, b, r) =
- if k < x then add k l, b, r
- else if k > x then l, b, add k r
- else l, true, r
- in
- fold coll s (Empty, false, Empty)
-
- (* could be slightly improved (when we now that a branch contains only
- positive or only negative integers) *)
- let min_elt = min_elt
- let max_elt = max_elt
-
- let equal = (=)
-
- let compare = compare
-
- let make l = List.fold_right add l empty
-
- let rec intersect s1 s2 = match (s1,s2) with
- | Empty, _ -> false
- | _, Empty -> false
- | Leaf k1, _ -> mem k1 s2
- | _, Leaf k2 -> mem k2 s1
- | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) ->
- if m1 == m2 && p1 == p2 then
- intersect l1 l2 || intersect r1 r2
- else if m1 > m2 && match_prefix p2 p1 m1 then
- intersect (if zero_bit p2 m1 then l1 else r1) s2
- else if m1 < m2 && match_prefix p1 p2 m2 then
- intersect s1 (if zero_bit p1 m2 then l2 else r2)
- else
- false
-
-end
-
-(*s Big-endian Patricia trees with non-negative elements only *)
-
-module BigPos = struct
-
- include Big
-
- let singleton x = if x < 0 then invalid_arg "BigPos.singleton"; singleton x
-
- let add x s = if x < 0 then invalid_arg "BigPos.add"; add x s
-
- (* Patricia trees are now binary search trees! *)
-
- let rec mem k = function
- | Empty -> false
- | Leaf j -> k == j
- | Branch (p, _, l, r) -> if k <= p then mem k l else mem k r
-
- let rec min_elt = function
- | Empty -> raise Not_found
- | Leaf k -> k
- | Branch (_,_,s,_) -> min_elt s
-
- let rec max_elt = function
- | Empty -> raise Not_found
- | Leaf k -> k
- | Branch (_,_,_,t) -> max_elt t
-
- (* we do not have to sort anymore *)
- let elements s =
- let rec elements_aux acc = function
- | Empty -> acc
- | Leaf k -> k :: acc
- | Branch (_,_,l,r) -> elements_aux (elements_aux acc r) l
- in
- elements_aux [] s
-
-end
-
-(*s EXPERIMENT: Big-endian Patricia trees with swapped bit sign *)
-
-module Bigo = struct
-
- include Big
-
- (* swaps the sign bit *)
- let swap x = if x < 0 then x land max_int else x lor min_int
-
- let mem x s = mem (swap x) s
-
- let add x s = add (swap x) s
-
- let singleton x = singleton (swap x)
-
- let remove x s = remove (swap x) s
-
- let elements s = List.map swap (elements s)
-
- let choose s = swap (choose s)
-
- let iter f = iter (fun x -> f (swap x))
-
- let fold f = fold (fun x a -> f (swap x) a)
-
- let for_all f = for_all (fun x -> f (swap x))
-
- let exists f = exists (fun x -> f (swap x))
-
- let filter f = filter (fun x -> f (swap x))
-
- let partition f = partition (fun x -> f (swap x))
-
- let split x s = split (swap x) s
-
- let rec min_elt = function
- | Empty -> raise Not_found
- | Leaf k -> swap k
- | Branch (_,_,s,_) -> min_elt s
-
- let rec max_elt = function
- | Empty -> raise Not_found
- | Leaf k -> swap k
- | Branch (_,_,_,t) -> max_elt t
-
-end
-
-let test empty add mem =
- let seed = Random.int max_int in
- Random.init seed;
- let s =
- let rec loop s i =
- if i = 1000 then s else loop (add (Random.int max_int) s) (succ i)
- in
- loop empty 0
- in
- Random.init seed;
- for i = 0 to 999 do assert (mem (Random.int max_int) s) done
-
-
Deleted: trunk/Toss/Formula/Sat/IntSet.mli
===================================================================
--- trunk/Toss/Formula/Sat/IntSet.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Formula/Sat/IntSet.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,111 +0,0 @@
-(**************************************************************************)
-(* *)
-(* Copyright (C) Jean-Christophe Filliatre *)
-(* *)
-(* This software is free software; you can redistribute it and/or *)
-(* modify it under the terms of the GNU Library General Public *)
-(* License version 2.1, with the special exception on linking *)
-(* described in file LICENSE. *)
-(* *)
-(* This software is distributed in the hope that it will be useful, *)
-(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
-(* *)
-(**************************************************************************)
-
-(*i $Id: ptset.mli,v 1.10 2008-07-21 14:53:06 filliatr Exp $ i*)
-
-(*s Sets of integers implemented as Patricia trees. The following
- signature is exactly [Set.S with type elt = int], with the same
- specifications. This is a purely functional data-structure. The
- performances are similar to those of the standard library's module
- [Set]. The representation is unique and thus structural comparison
- can be performed on Patricia trees. *)
-
-type t
-
-type elt = int
-
-val empty : t
-
-val is_empty : t -> bool
-
-val mem : int -> t -> bool
-
-val add : int -> t -> t
-
-val singleton : int -> t
-
-val is_singleton : t -> bool
-
-val remove : int -> t -> t
-
-val union : t -> t -> t
-
-val subset : t -> t -> bool
-
-val inter : t -> t -> t
-
-val diff : t -> t -> t
-
-val equal : t -> t -> bool
-
-val compare : t -> t -> int
-
-val elements : t -> int list
-
-val choose : t -> int
-
-val cardinal : t -> int
-
-val iter : (int -> unit) -> t -> unit
-
-val fold : (int -> 'a -> 'a) -> t -> 'a -> 'a
-
-val for_all : (int -> bool) -> t -> bool
-
-val exists : (int -> bool) -> t -> bool
-
-val filter : (int -> bool) -> t -> t
-
-val partition : (int -> bool) -> t -> t * t
-
-val split : int -> t -> t * bool * t
-
-(*s Warning: [min_elt] and [max_elt] are linear w.r.t. the size of the
- set. In other words, [min_elt t] is barely more efficient than [fold
- min t (choose t)]. *)
-
-val min_elt : t -> int
-val max_elt : t -> int
-
-(*s Additional functions not appearing in the signature [Set.S] from ocaml
- standard library. *)
-
-(* [intersect u v] determines if sets [u] and [v] have a non-empty
- intersection. *)
-
-val intersect : t -> t -> bool
-
-
-(*s Big-endian Patricia trees *)
-
-module Big : sig
- include Set.S with type elt = int
- val intersect : t -> t -> bool
-end
-
-
-(*s Big-endian Patricia trees with non-negative elements. Changes:
- - [add] and [singleton] raise [Invalid_arg] if a negative element is given
- - [mem] is slightly faster (the Patricia tree is now a search tree)
- - [min_elt] and [max_elt] are now O(log(N))
- - [elements] returns a list with elements in ascending order
- *)
-
-module BigPos : sig
- include Set.S with type elt = int
- val intersect : t -> t -> bool
-end
-
-
Modified: trunk/Toss/Formula/Sat/Sat.mli
===================================================================
--- trunk/Toss/Formula/Sat/Sat.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Formula/Sat/Sat.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,46 +1,49 @@
-(* Basic interface to a sat solver and convertion between cnf and dnf formulas.
- Variables are given by positive integers and we use -n to denote 'not n'. *)
+(** Basic interface to a sat solver and convertion between cnf and dnf formulas.
+ Variables are given by positive integers and we use -n to denote 'not n'. *)
-(* ------- Main functions ------- *)
+(** {2 Main Functions} *)
(** Set timeout function for conversions. *)
val set_timeout : float -> unit
+
(** Clear timeout function. *)
val clear_timeout : unit -> unit
-
-(* Given a list of literals to set to true, simplify the given CNF formula. *)
+(** Given a list of literals to set to true, simplify the given CNF formula. *)
val simplify : int list -> int list list -> int list list
-(* Check satisfiability of a formula in CNF, return a satisfying assignment. *)
+(** Check satisfiability of a formula in CNF, return a satisfying assignment. *)
val sat : int list list -> int list option
+
+(** Check satisfiability of a formula in CNF, return just true or false. *)
val is_sat : int list list -> bool
-(* Convert a DNF formula to CNF (or equivalently, CNF to DNF). *)
exception OverBound
+
+(** Convert a DNF formula to CNF (or equivalently, CNF to DNF). *)
val convert : ?disc_vars: int list -> ?bound: int option -> int list list ->
int list list
-(* Convert a auxiliary CNF formula to "real" CNF (or, equivalently, to DNF). *)
+(** Convert a auxiliary CNF formula to "real" CNF (or, equivalently, to DNF). *)
val convert_aux_cnf : ?disc_vars: int list -> ?bound: int option ->
int -> int list list -> int list list
-(* ----- Printing helpers ------ *)
+(** {2 Printing} *)
-(* Return the given clause (disjunction of literals) as string. *)
+(** Return the given clause (disjunction of literals) as string. *)
val clause_str : int list -> string
-(* Return the given CNF formula as string. *)
+(** Return the given CNF formula as string. *)
val cnf_str : int list list -> string
-(* Return the given conjunction of literals as string. *)
+(** Return the given conjunction of literals as string. *)
val conjunct_str : int list -> string
-(* Return the given DNF formula as string. *)
+(** Return the given DNF formula as string. *)
val dnf_str : int list list -> string
-(* ------------------------- DEBUGGING ------------------------------------- *)
+(** {2 Debugging} *)
-(* Debugging information. At level 0 nothing is printed out. *)
+(** Debugging information. At level 0 nothing is printed out. *)
val set_debug_level : int -> unit
Modified: trunk/Toss/GGP/GameSimpl.mli
===================================================================
--- trunk/Toss/GGP/GameSimpl.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/GGP/GameSimpl.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,4 +1,4 @@
-(** {2 Simplification of Toss Games.}
+(** {2 Simplification of Toss games.}
Whole-game simplifications and helper functions that consider both
a structure and a formula.
Modified: trunk/Toss/GGP/TranslateFormula.mli
===================================================================
--- trunk/Toss/GGP/TranslateFormula.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/GGP/TranslateFormula.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,3 +1,5 @@
+(** Translating formulas from GDL to Toss. *)
+
val debug_level : int ref
(** Whether to add root predicates. Note that not adding root
Modified: trunk/Toss/GGP/TranslateGame.mli
===================================================================
--- trunk/Toss/GGP/TranslateGame.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/GGP/TranslateGame.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,3 +1,5 @@
+(** Translating games from GDL to Toss. *)
+
(** Local level of logging. *)
val debug_level : int ref
val generate_test_case : string option ref
Modified: trunk/Toss/Server/DB.mli
===================================================================
--- trunk/Toss/Server/DB.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Server/DB.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,3 +1,6 @@
+(** Interface to the Toss database through Sqlite. *)
+
+
exception DBError of string
val debug_level : int ref
Modified: trunk/Toss/Server/Picture.mli
===================================================================
--- trunk/Toss/Server/Picture.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Server/Picture.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,4 +1,4 @@
-(** Processing Pictures to create Structures *)
+(** Processing pictures to create structures *)
(** {2 Debugging} *)
Modified: trunk/Toss/Server/ReqHandler.mli
===================================================================
--- trunk/Toss/Server/ReqHandler.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Server/ReqHandler.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,4 +1,4 @@
-(** Main Request Handler for Toss. *)
+(** Main request handler for Toss. *)
(** {2 Debugging} *)
@@ -35,5 +35,5 @@
req_state * bool
-(* Client db game setting - public only for caching reasons. *)
+(** Client db game setting - public only for caching reasons. *)
val client_set_game : string -> unit
Modified: trunk/Toss/Solver/AssignmentSet.mli
===================================================================
--- trunk/Toss/Solver/AssignmentSet.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/AssignmentSet.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,5 +1,4 @@
-(** This module contains the main type for partial assignments of
- values to variables. *)
+(** Main type for partial assignments of elements to variables. *)
(** {2 Basic type definition.} *)
Modified: trunk/Toss/Solver/Assignments.mli
===================================================================
--- trunk/Toss/Solver/Assignments.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/Assignments.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,7 +1,4 @@
-(** This module contains functions for handling partial assignments of
- values to variables. The main type [assignmnent_set] represents
- a set of assignments of values to variables and the main functions
- are [join], [sum], [project] and [complement] with natural meanings. *)
+(** Handling partial assignments of elements to variables. *)
(** {2 Basic Type Definition} *)
Modified: trunk/Toss/Solver/Distinguish.ml
===================================================================
--- trunk/Toss/Solver/Distinguish.ml 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/Distinguish.ml 2011-11-17 23:56:41 UTC (rev 1635)
@@ -190,7 +190,7 @@
(* Helper function: remove atoms from a formula if [cond] is still satisfied.
Note that this is just a greedy heuristic, only And/Or and into Ex/All. *)
-let rec greedy_remove cond phi =
+let rec greedy_remove ?(pos=false) cond phi =
let rec greedy_remove_list constructor acc = function
| [] -> acc
| x :: xs ->
@@ -200,8 +200,10 @@
greedy_remove_list constructor (minx::acc) xs in
match phi with
| And fl -> And (greedy_remove_list (fun l -> And l) [] (List.rev fl))
- | Or fl -> Or (greedy_remove_list (fun l -> Or l) [] (List.rev fl))
- | Not f -> Not (greedy_remove (fun x -> cond (Not x)) f)
+ | Or fl -> if pos then Or fl else
+ Or (greedy_remove_list (fun l -> Or l) [] (List.rev fl))
+ | Not f -> if pos then Not f else
+ Not (greedy_remove (fun x -> cond (Not x)) f)
| Ex (vs, f) -> Ex (vs, greedy_remove (fun x -> cond (Ex (vs, x))) f)
| All (vs, f) -> All (vs, greedy_remove (fun x -> cond (All (vs, x))) f)
| phi -> phi
@@ -231,20 +233,21 @@
| GuardedFO -> guarded_types s ~qr ~k
| FO -> ntypes s ~qr ~k in
let neg_tps = Aux.unique_sorted (Aux.concat_map types neg_strucs) in
- let pos_tps = Aux.unique_sorted ~cmp:!compare_types (
- Aux.map_some (min_type_omitting ~logic ~qr ~k neg_tps) pos_strucs) in
- let fails_neg f = not (List.exists (fun s -> check s [||] f) neg_strucs) in
- let succ_pos fl = List.for_all (fun s -> check s [||] (Or fl)) pos_strucs in
- let rec find_type acc = function
- | [] -> []
- | x :: xs -> if succ_pos (x::acc) then x :: acc else
- find_type (x::acc) xs in
- let dtypes = find_type [] pos_tps in
- if dtypes = [] then None else
- let is_ok f = fails_neg f && succ_pos [f] in
- let mintp = greedy_remove is_ok (Or dtypes) in
- let fv = FormulaSubst.free_vars mintp in
- Some (FormulaOps.rename_quant_avoiding fv mintp)
+ let fails_on_negs f = not (List.exists (fun s-> check s [||] f) neg_strucs) in
+ let extend_by_pos acc struc =
+ if check struc [||] (Or acc) then acc else
+ match min_type_omitting ~logic ~qr ~k neg_tps struc with
+ | None -> raise Not_found
+ | Some f -> (greedy_remove ~pos:true fails_on_negs f) :: acc in
+ let pos_formulas =
+ try List.fold_left extend_by_pos [] pos_strucs with Not_found -> [] in
+ let pos_formulas = Aux.unique_sorted ~cmp:!compare_types pos_formulas in
+ if pos_formulas = [] then None else
+ let succ_pos fl = List.for_all (fun s -> check s [||] (Or fl)) pos_strucs in
+ let is_ok f = fails_on_negs f && succ_pos [f] in
+ let minimized = greedy_remove is_ok (Or pos_formulas) in
+ let fv = FormulaSubst.free_vars minimized in
+ Some (FormulaOps.rename_quant_avoiding fv minimized)
(* Find a [logic]-formula holding on all [pos_strucs] and on no [neg_strucs].
Modified: trunk/Toss/Solver/RealQuantElim/OrderedPoly.mli
===================================================================
--- trunk/Toss/Solver/RealQuantElim/OrderedPoly.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/RealQuantElim/OrderedPoly.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,31 +1,31 @@
-(* Polynomials with ordered variables, integer coefficients.*)
+(** Polynomials with ordered variables and integer coefficients.*)
-(* ----------------------- BASIC TYPE DEFINITIONS --------------------------- *)
+(** {2 Basic Type Definitions} *)
type polynomial = Const of Num.num | Poly of string * (polynomial * int) list
-type t = polynomial (* to be compatible with OrderedType signature *)
+type t = polynomial (** to be compatible with OrderedType signature *)
exception Unmatched_variables
-(* Constructur 'Const' but taking normal integers. *)
+(** Constructur 'Const' but taking normal integers. *)
val const : int -> polynomial
-(* ------------------------- PRINTING FUNCTION ------------------------------ *)
+(** {2 Printing} *)
val str : polynomial -> string
-(* ------------------------- EQUALITY AND COMPARISON ------------------------ *)
+(** {2 Equality and Comparison} *)
val is_zero : polynomial -> bool
val equal : polynomial -> polynomial -> bool
val compare : polynomial -> polynomial -> int
-(* ------------------------- BASIC HELPER FUNCTIONS ------------------------- *)
+(** {Basic Operations} *)
val var : polynomial -> string
val lower : polynomial -> polynomial
@@ -39,7 +39,7 @@
val constant_factors : polynomial -> polynomial -> (Num.num * Num.num) option
-(* -------------------------- ARITHMETIC FUNCTIONS -------------------------- *)
+(** {2 Arithmetic Functions} *)
val add : polynomial -> polynomial -> polynomial
val neg : polynomial -> polynomial
@@ -51,11 +51,11 @@
polynomial * polynomial
-(* -------------------------- DIFFERENTIATION ------------------------------- *)
+(** {2 Differentiation} *)
val diff : polynomial -> polynomial
-(* ------------------------- MODIFIED REMAINDER ----------------------------- *)
+(** {2 Modified remainder} *)
val modified_remainder : polynomial -> polynomial -> polynomial
Modified: trunk/Toss/Solver/RealQuantElim/OrderedPolySet.mli
===================================================================
--- trunk/Toss/Solver/RealQuantElim/OrderedPolySet.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/RealQuantElim/OrderedPolySet.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,11 +1,11 @@
-(* Represent set of ordered polynomials and operate on it. *)
+(** Represent set of ordered polynomials and operate on it. *)
module PSet : Set.S with type elt = OrderedPoly.polynomial
type pset = PSet.t
-(* ------------------------ BASIC SET OPERATIONS ---------------------------- *)
+(** {2 Basic Set Operations} *)
val empty : PSet.t
val add : OrderedPoly.polynomial -> PSet.t -> PSet.t
@@ -15,50 +15,50 @@
val elements : PSet.t -> OrderedPoly.polynomial list
-(* ------------------------ PRINTING FUNCTION ------------------------------- *)
+(** {2 Printing} *)
-(* Print the given set as string. *)
+(** Print the given set as string. *)
val str : PSet.t -> string
-(* ------------- MAPPING WITH DEGREE DETECTION AND BASIC MAPS --------------- *)
+(** {2 Mapping with degree detection and basic maps} *)
-(* Maps a function to all polynomials in the set. Returns non-empty
- resulting polynomials of degree 0 and greater separately. *)
+(** Maps a function to all polynomials in the set. Returns non-empty
+ resulting polynomials of degree 0 and greater separately. *)
val map : (OrderedPoly.polynomial -> OrderedPoly.polynomial) -> PSet.t ->
PSet.t * PSet.t
-(* Extract leading coefficients from all polynomials in the set. *)
+(** Extract leading coefficients from all polynomials in the set. *)
val leading_coeff : PSet.t -> PSet.t
-(* Omit leading coefficients from all polynomials in the given set.
- Return resulting polynomials of degree 0 and greater separately. *)
+(** Omit leading coefficients from all polynomials in the given set.
+ Return resulting polynomials of degree 0 and greater separately. *)
val omit_leading : PSet.t -> PSet.t * PSet.t
-(* Differentiate all polynomials in the given set.
- Return resulting polynomials of degree 0 and greater separately. *)
+(** Differentiate all polynomials in the given set.
+ Return resulting polynomials of degree 0 and greater separately. *)
val differentiate: PSet.t -> PSet.t * PSet.t
-(* Compute factors r such that for some p,q in [ps,qs] holds p = r*q. *)
+(** Compute factors r such that for some p,q in [ps,qs] holds p = r*q. *)
val div : PSet.t -> PSet.t -> PSet.t
-(* ------------ MODIFIED REMAINDER OF ALL PAIRS BETWEEN TWO SETS ------------ *)
+(** {2 Modified remainder of all pairs between two sets} *)
-(* Compute the modified remainder for all pairs of polynomials p from
- ps1 and q!=p from qs1 such that the degree of p >= degree of q.
- Return resulting polynomials of degree 0 and greater separately. *)
+(** Compute the modified remainder for all pairs of polynomials p from
+ ps1 and q!=p from qs1 such that the degree of p >= degree of q.
+ Return resulting polynomials of degree 0 and greater separately. *)
val modified_remainder : PSet.t * PSet.t -> PSet.t * PSet.t
-(* ---------------- CLOSURE UNDER 4 ABOVE OPERATIONS ------------------------ *)
+(** {2 Closure under the 4 operations above} *)
exception Closure_count_exceeded of int
-(* Closure of a set of polynomials [polys] under the operations:
- - extracting the leading coefficient (if deg > 0)
- - omitting the leading term (if deg > 0)
- - taking the derivative (if deg > 0)
- - taking the modified remainder MR(p, q) for deg p >= deg q.
- Return resulting polynomials of degree 0 and greater separately. *)
+(** Closure of a set of polynomials [polys] under the operations:
+ - extracting the leading coefficient (if deg > 0)
+ - omitting the leading term (if deg > 0)
+ - taking the derivative (if deg > 0)
+ - taking the modified remainder MR(p, q) for deg p >= deg q.
+ Return resulting polynomials of degree 0 and greater separately. *)
val closure : ?upto : int -> PSet.t -> PSet.t * PSet.t
Modified: trunk/Toss/Solver/RealQuantElim/Poly.mli
===================================================================
--- trunk/Toss/Solver/RealQuantElim/Poly.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/RealQuantElim/Poly.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,6 +1,6 @@
-(* Represent polynomials as written and convert to ordered form. *)
+(** Represent polynomials as written and convert to ordered form. *)
-(* ---------------------- BASIC TYPE DEFINITION ----------------------------- *)
+(** {2 Basic Type Definition} *)
type polynomial =
Var of string
@@ -9,22 +9,22 @@
| Plus of polynomial * polynomial
-(* ------------------------ PRINTING FUNCTION ------------------------------- *)
+(** {2 Printing} *)
-(* Print a polynomial as a string. *)
+(** Print a polynomial as a string. *)
val str : polynomial -> string
-(* ------------------ HELPER POWER FUNCTION USED IN PARSER ------------------ *)
+(** {Basic Functions used in Parser} *)
-(* Power function used in parser. *)
+(** Power function used in parser. *)
val pow : polynomial -> int -> polynomial
-(* Basic simplification, reduces constant polynomials to integers. *)
+(** Basic simplification, reduces constant polynomials to integers. *)
val simp_const : polynomial -> polynomial
-(* ----------------- CONVERTION TO UNORDERED POLYNOMIALS -------------------- *)
+(** {2 Convertion to Unordered Polynomials} *)
val make_unordered : OrderedPoly.polynomial -> polynomial
@@ -32,24 +32,24 @@
(polynomial * 'a) list
-(* ------------------ CONVERTION TO ORDERED POLYNOMIALS --------------------- *)
+(** {2 Convertion to Ordered Polynomials} *)
-(* List variables in the given polynomial. *)
+(** List variables in the given polynomial. *)
val vars : polynomial -> string list
-(* List variables in the given polynomial list. *)
+(** List variables in the given polynomial list. *)
val vars_list : polynomial list -> string list
-(* Make an ordered polynomial from [p] with [prio_list] order on variables, i.e.
- if x appears in [prio_list] before y then x < y. Strings not appearing
- in [prio_list] at all are considered smaller than any string that appears. *)
+(** Make an ordered polynomial from [p] with [prio_list] order on variables,i.e.
+ if x appears in [prio_list] before y then x < y. Strings not appearing
+ in [prio_list] at all are considered smaller than any string that appears.*)
val make_ordered : string list -> polynomial -> OrderedPoly.polynomial
-(* Make ordered polynomials from [ps] with [prio_list] order on variables. *)
+(** Make ordered polynomials from [ps] with [prio_list] order on variables. *)
val make_ordered_list : string list -> polynomial list ->
OrderedPoly.polynomial list
-(* Make ordered polynomials from first components of [ps], [prio_list] order. *)
+(** Make ordered polynomials from first components of [ps], [prio_list] order.*)
val make_ordered_pair_list : string list -> (polynomial * 'a) list ->
(OrderedPoly.polynomial * 'a) list
Modified: trunk/Toss/Solver/RealQuantElim/RealQuantElim.mli
===================================================================
--- trunk/Toss/Solver/RealQuantElim/RealQuantElim.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/RealQuantElim/RealQuantElim.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,4 +1,4 @@
-(* Simplify existentially quantified conjunction of polynomial inequalities. *)
+(** Simplify existentially quantified conjunction of polynomial inequalities. *)
open OrderedPolySet
Modified: trunk/Toss/Solver/RealQuantElim/SignTable.mli
===================================================================
--- trunk/Toss/Solver/RealQuantElim/SignTable.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/RealQuantElim/SignTable.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,42 +1,42 @@
-(* Handling Sign Tables for quantifier elimination. *)
+(** Handling sign tables for quantifier elimination. *)
open Formula
val poly_sign_op_cmp : OrderedPoly.polynomial * sign_op ->
OrderedPoly.polynomial * sign_op -> int
-(* Exception raised when contraditing ops are given to join_sign_ops. *)
+(** Exception raised when contraditing ops are given to join_sign_ops. *)
exception Contradicting_sign_ops
-(* Given two sign_ops [x] and [y] return a sign op for "x and y". *)
+(** Given two sign_ops [x] and [y] return a sign op for "x and y". *)
val join_sign_ops : sign_op -> sign_op -> sign_op
-(* Print a sign_op as string. *)
+(** Print a sign_op as string. *)
val sign_op_str : sign_op -> string
-(* Check if given float has sign as required by the sign_op. *)
+(** Check if given float has sign as required by the sign_op. *)
val check_sign : float -> sign_op -> bool
-(* Negate a sign_op. *)
+(** Negate a sign_op. *)
val neg_sign_op : sign_op -> sign_op
-(* Print a case, i.e. a list of polynomials and their signs, as string. *)
+(** Print a case, i.e. a list of polynomials and their signs, as string. *)
val int_case_str : (OrderedPoly.polynomial * int) list -> string
val case_str : (OrderedPoly.polynomial * sign_op) list -> string
-(* Estimate the (base-3) logarithm of the number of cases needed for [pset]. *)
+(** Estimate the (base-3) logarithm of the number of cases needed for [pset]. *)
val log_no_cases : ?upto: int -> (OrderedPoly.polynomial * sign_op) list -> int
-(* Build the array of polynomials and cases to check given set of polynomials.*)
+(** Build array of polynomials and cases to check given set of polynomials. *)
val build_cases : (OrderedPoly.polynomial * sign_op) list ->
(OrderedPoly.polynomial * int) list list * OrderedPoly.polynomial array
-(* Given cases and polynomial array as constructed by [build_cases] and
- requirement list for some polynomials, return all satisfying cases. *)
+(** Given cases and polynomial array as constructed by [build_cases] and
+ requirement list for some polynomials, return all satisfying cases. *)
val solve : (OrderedPoly.polynomial * int) list list *
OrderedPoly.polynomial array -> (OrderedPoly.polynomial * sign_op) list ->
(OrderedPoly.polynomial * sign_op) list list
-(* Debugging information. At level 0 nothing is printed out. *)
+(** Debugging information. At level 0 nothing is printed out. *)
val set_debug_level : int -> unit
Modified: trunk/Toss/Solver/Structure.mli
===================================================================
--- trunk/Toss/Solver/Structure.mli 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Solver/Structure.mli 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,4 +1,4 @@
-(** Representing Relational Structures with Real-Valued Functions *)
+(** Representing relational structures with real-valued functions. *)
(** {2 Modules used in structure representation.} *)
Modified: trunk/Toss/Toss.odocl
===================================================================
--- trunk/Toss/Toss.odocl 2011-11-17 17:12:44 UTC (rev 1634)
+++ trunk/Toss/Toss.odocl 2011-11-17 23:56:41 UTC (rev 1635)
@@ -1,5 +1,8 @@
Formula/Formula
Formula/FormulaParser
+Formula/FormulaMap
+Formula/FormulaSubst
+Formula/Sat/Sat
Formula/BoolFormula
Formula/BoolFunction
Formula/FFTNF
@@ -8,9 +11,16 @@
Solver/StructureParser
Solver/AssignmentSet
Solver/Assignments
+Solver/RealQuantElim/OrderedPoly
+Solver/RealQuantElim/OrderedPolySet
+Solver/RealQuantElim/Poly
+Solver/RealQuantElim/SignTable
+Solver/RealQuantElim/RealQuantElim
+Solver/RealQuantElim/RealQuantElimParser
Solver/Solver
Solver/Class
Solver/ClassParser
+Solver/Distinguish
Arena/Term
Arena/TermParser
Arena/DiscreteRule
@@ -25,5 +35,10 @@
Play/Play
GGP/GDL
GGP/GDLParser
+GGP/TranslateFormula
+GGP/TranslateGame
GGP/GameSimpl
Server/Picture
+Server/LearnGame
+Server/DB
+Server/ReqHandler
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-17 17:12:57
|
Revision: 1634
http://toss.svn.sourceforge.net/toss/?rev=1634&view=rev
Author: lukaszkaiser
Date: 2011-11-17 17:12:44 +0000 (Thu, 17 Nov 2011)
Log Message:
-----------
Cleanups and optimizations in Distinguish, also changing variable order returned by free_vars, adding comments and reference.
Modified Paths:
--------------
trunk/Toss/Formula/FFTNFTest.ml
trunk/Toss/Formula/FormulaSubst.ml
trunk/Toss/Formula/FormulaSubstTest.ml
trunk/Toss/Formula/Makefile
trunk/Toss/Play/HeuristicTest.ml
trunk/Toss/Server/LearnGame.ml
trunk/Toss/Server/LearnGameTest.ml
trunk/Toss/Server/Picture.ml
trunk/Toss/Solver/Distinguish.ml
trunk/Toss/Solver/Distinguish.mli
trunk/Toss/Solver/DistinguishTest.ml
trunk/Toss/www/reference/reference.tex
Modified: trunk/Toss/Formula/FFTNFTest.ml
===================================================================
--- trunk/Toss/Formula/FFTNFTest.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Formula/FFTNFTest.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -17,7 +17,7 @@
let winQxyz =
"ex x, y, z ((((Q(x) and Q(y)) and Q(z)) and ((((R(x, y) and R(y, z)) or (C(x, y) and C(y, z))) or ex u, v ((((R(x, v) and C(v, y)) and R(y, u)) and C(u, z)))) or ex u, v ((((R(x, v) and C(y, v)) and R(y, u)) and C(z, u))))))"
let winQzyx =
- "ex z, y, x (Q(x) and Q(y) and Q(z) and ((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (R(x, v) and C(v, y) and R(y, u) and C(u, z)) or ex u, v (R(x, v) and C(y, v) and R(y, u) and C(z, u))))"
+ "ex x, y, z (Q(x) and Q(y) and Q(z) and ((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (R(x, v) and C(v, y) and R(y, u) and C(u, z)) or ex u, v (R(x, v) and C(y, v) and R(y, u) and C(z, u))))"
let winPxyz =
"ex x, y, z ((((P(x) and P(y)) and P(z)) and ((((R(x, y) and R(y, z)) or (C(x, y) and C(y, z))) or ex u, v ((((R(x, v) and C(v, y)) and R(y, u)) and C(u, z)))) or ex u, v ((((R(x, v) and C(y, v)) and R(y, u)) and C(z, u))))))"
@@ -156,7 +156,7 @@
(formula_of_str winQzyx)));
assert_eq_str ~msg:"reversing ff_tnf"
- "ex z, y, x (Q(z) and Q(y) and Q(x) and ex u0 (ex v0 (R(x, v0) and C(v0, y)) and R(y, u0) and C(u0, z))) or ex z, y, x (Q(z) and Q(y) and Q(x) and ex u (ex v (R(x, v) and C(y, v)) and R(y, u) and C(z, u))) or ex z, y, x (Q(z) and Q(y) and Q(x) and R(x, y) and R(y, z)) or ex z, y, x (Q(z) and Q(y) and Q(x) and C(x, y) and C(y, z))"
+ "ex x, y, z (Q(z) and Q(y) and Q(x) and ex u0 (ex v0 (R(x, v0) and C(v0, y)) and R(y, u0) and C(u0, z))) or ex x, y, z (Q(z) and Q(y) and Q(x) and ex u (ex v (R(x, v) and C(y, v)) and R(y, u) and C(z, u))) or ex x, y, z (Q(z) and Q(y) and Q(x) and R(x, y) and R(y, z)) or ex x, y, z (Q(z) and Q(y) and Q(x) and C(x, y) and C(y, z))"
(Formula.str (
formula_of_guards (Aux.strings_of_list ["P"; "Q"])
Aux.Strings.empty
@@ -275,7 +275,7 @@
(* interpretation warning: in cases below, pulled-out "Q" in the
result represents "not Q" actually (a negative literal) *)
assert_eq_str ~msg:"#5"
- "ex z (Q(z) and ex y not R(x, y)) or ex z, x (P(x) and Q(z) and ex y C(y, z))"
+ "ex z (Q(z) and ex y not R(x, y)) or ex x, z (P(x) and Q(z) and ex y C(y, z))"
(Formula.str (
formula_of_guards (Aux.strings_of_list ["P"])
(Aux.strings_of_list ["Q"])
Modified: trunk/Toss/Formula/FormulaSubst.ml
===================================================================
--- trunk/Toss/Formula/FormulaSubst.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Formula/FormulaSubst.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -276,15 +276,6 @@
(* -------------------------- FREE VARIABLES -------------------------------- *)
-(* Helper function: remove duplicates from sorted list of variables. *)
-let rec remove_dup_vars acc = function
- [] -> acc
- | [v] -> v :: acc
- | v1 :: v2 :: vs ->
- match compare_vars v1 v2 with
- 0 -> remove_dup_vars acc (v2::vs)
- | _ -> remove_dup_vars (v1::acc) (v2::vs)
-
let rec all_vars_acc acc = function
| Eq (x, y) -> (x :> var) :: (y :> var) :: acc
| Rel (r, vs) -> List.rev_append ((Array.to_list vs) :> var list) acc
@@ -314,8 +305,7 @@
List.rev_append (List.rev_map var_str (all_vars_acc [] f)) (all_vars_real r)
| RLet (_, def, re) -> List.rev_append (all_vars_real def) (all_vars_real re)
-let all_vars phi =
- remove_dup_vars [] (List.sort compare_vars (all_vars_acc [] phi))
+let all_vars phi = Aux.unique_sorted ~cmp:compare_vars (all_vars_acc [] phi)
let rec free_vars_acc acc = function
| Eq (x, y) -> (x :> var) :: (y :> var) :: acc
@@ -350,8 +340,7 @@
List.filter (fun w -> not (List.mem w vs)) (free_vars_real r)
| RLet _ as r -> free_vars_real (expand_real_expr r)
-let free_vars phi =
- remove_dup_vars [] (List.sort compare_vars (free_vars_acc [] phi))
+let free_vars phi = Aux.unique_sorted ~cmp:compare_vars (free_vars_acc [] phi)
(* --------------------------- TRANSITIVE CLOSURE --------------------------- *)
Modified: trunk/Toss/Formula/FormulaSubstTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaSubstTest.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Formula/FormulaSubstTest.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -121,9 +121,9 @@
assert_equal ~printer:(fun x -> x)
vs (Formula.var_list_str (
FormulaSubst.free_vars (formula_of_string phi))) in
- fv_eq "not (P(x) and not Q(y))" "y, x";
+ fv_eq "not (P(x) and not Q(y))" "x, y";
fv_eq "Q(x) or (ex x P(x))" "x";
- fv_eq "P(x) or ex y (E(x, y) and y in T)" "x, T";
+ fv_eq "P(x) or ex y (E(x, y) and y in T)" "T, x";
fv_eq "lfp T(x) = (P(x) or ex y (E(x, y) and y in T))" "x";
);
Modified: trunk/Toss/Formula/Makefile
===================================================================
--- trunk/Toss/Formula/Makefile 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Formula/Makefile 2011-11-17 17:12:44 UTC (rev 1634)
@@ -5,6 +5,8 @@
AuxTest:
FormulaTest:
+FormulaMapTest:
+FormulaSubstTest:
BoolFormulaTest:
BoolFunctionTest:
FormulaOpsTest:
Modified: trunk/Toss/Play/HeuristicTest.ml
===================================================================
--- trunk/Toss/Play/HeuristicTest.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Play/HeuristicTest.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -275,14 +275,14 @@
"[a | P:1 {}; Q:1 {} | ] -> [ | P:1 {}; Q(a) | ] emb P, Q"] in
assert_eq_str
- "Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (P(x) or P(y) or P(z)) and (not Q(x) or P(x)) and (not Q(y) or P(y)) and (not Q(z) or P(z))) : (:(P(x)) + :(P(y)) + :(P(z))) * 0.33) - Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (Q(x) or Q(y) or Q(z)) and (not P(x) or Q(x)) and (not P(y) or Q(y)) and (not P(z) or Q(z))) : (:(Q(x)) + :(Q(y)) + :(Q(z))) * 0.33)"
+ "Sum (x, y, z | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (P(x) or P(y) or P(z)) and (not Q(x) or P(x)) and (not Q(y) or P(y)) and (not Q(z) or P(z))) : (:(P(x)) + :(P(y)) + :(P(z))) * 0.33) - Sum (x, y, z | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (Q(x) or Q(y) or Q(z)) and (not P(x) or Q(x)) and (not P(y) or Q(y)) and (not P(z) or Q(z))) : (:(Q(x)) + :(Q(y)) + :(Q(z))) * 0.33)"
(Formula.real_str
(Heuristic.map_constants (fun c->(floor (c*.100.))/.100.)
(default_heuristic 1. rules
(real_of_str (":("^winPxyz^") - :("^winQxyz^")")))));
assert_eq_str
- "Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (P(x) or P(y) or P(z)) and (not Q(x) or P(x)) and (not Q(y) or P(y)) and (not Q(z) or P(z))) : (:(P(x)) + :(P(y)) + :(P(z))) * (:(P(x)) + :(P(y)) + :(P(z))) * 0.11) - Sum (z, y, x | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (Q(x) or Q(y) or Q(z)) and (not P(x) or Q(x)) and (not P(y) or Q(y)) and (not P(z) or Q(z))) : (:(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(x)) + :(Q(y)) + :(Q(z))) * 0.11)"
+ "Sum (x, y, z | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (P(x) or P(y) or P(z)) and (not Q(x) or P(x)) and (not Q(y) or P(y)) and (not Q(z) or P(z))) : (:(P(x)) + :(P(y)) + :(P(z))) * (:(P(x)) + :(P(y)) + :(P(z))) * 0.11) - Sum (x, y, z | (((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u, v (C(z, u) and C(y, v) and R(y, u) and R(x, v)) or ex u, v (R(y, u) and R(x, v) and C(v, y) and C(u, z))) and (Q(x) or Q(y) or Q(z)) and (not P(x) or Q(x)) and (not P(y) or Q(y)) and (not P(z) or Q(z))) : (:(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(x)) + :(Q(y)) + :(Q(z))) * 0.11)"
(Formula.real_str
(Heuristic.map_constants (fun c->(floor (c*.100.))/.100.)
(default_heuristic 2. rules
@@ -298,14 +298,14 @@
"[a | P:1 {}; Q:1 {} | ] -> [ | P:1 {}; Q(a) | ] emb P, Q"] in
assert_eq_str
- "Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (P(z) or P(y) or P(x) or P(w) or P(v)) and (not Q(z) or P(z)) and (not Q(y) or P(y)) and (not Q(x) or P(x)) and (not Q(w) or P(w)) and (not Q(v) or P(v))) : (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * 0.04 ) - Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (Q(z) or Q(y) or Q(x) or Q(w) or Q(v)) and (not P(z) or Q(z)) and (not P(y) or Q(y)) and (not P(x) or Q(x)) and (not P(w) or Q(w)) and (not P(v) or Q(v))) : (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * 0.04 )"
+ "Sum (v, w, x, y, z | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (P(z) or P(y) or P(x) or P(w) or P(v)) and (not Q(z) or P(z)) and (not Q(y) or P(y)) and (not Q(x) or P(x)) and (not Q(w) or P(w)) and (not Q(v) or P(v))) : (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * 0.04 ) - Sum (v, w, x, y, z | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (Q(z) or Q(y) or Q(x) or Q(w) or Q(v)) and (not P(z) or Q(z)) and (not P(y) or Q(y)) and (not P(x) or Q(x)) and (not P(w) or Q(w)) and (not P(v) or Q(v))) : (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * 0.04 )"
(Formula.real_str
((* Heuristic.map_constants (fun c->(floor (c*.100.))/.100.) *)
(default_heuristic 2. rules
(real_of_str (":("^winPvwxyz^") - :("^winQvwxyz^")")))));
assert_eq_str
- "Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (P(z) or P(y) or P(x) or P(w) or P(v)) and (not Q(z) or P(z)) and (not Q(y) or P(y)) and (not Q(x) or P(x)) and (not Q(w) or P(w)) and (not Q(v) or P(v))) : (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * 0.008 ) - Sum (z, y, x, w, v | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (Q(z) or Q(y) or Q(x) or Q(w) or Q(v)) and (not P(z) or Q(z)) and (not P(y) or Q(y)) and (not P(x) or Q(x)) and (not P(w) or Q(w)) and (not P(v) or Q(v))) : (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * 0.008 )"
+ "Sum (v, w, x, y, z | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (P(z) or P(y) or P(x) or P(w) or P(v)) and (not Q(z) or P(z)) and (not Q(y) or P(y)) and (not Q(x) or P(x)) and (not Q(w) or P(w)) and (not Q(v) or P(v))) : (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * (:(P(v)) + :(P(w)) + :(P(x)) + :(P(y)) + :(P(z))) * 0.008 ) - Sum (v, w, x, y, z | (((R(v, w) and R(w, x) and R(x, y) and R(y, z)) or (C(v, w) and C(w, x) and C(x, y) and C(y, z)) or ex r, s, t, u (C(z, u) and R(y, u) and C(y, t) and R(x, t) and C(x, s) and R(w, s) and C(w, r) and R(v, r)) or ex r, s, t, u (R(y, u) and R(x, t) and R(w, s) and R(v, r) and C(u, z) and C(t, y) and C(s, x) and C(r, w))) and (Q(z) or Q(y) or Q(x) or Q(w) or Q(v)) and (not P(z) or Q(z)) and (not P(y) or Q(y)) and (not P(x) or Q(x)) and (not P(w) or Q(w)) and (not P(v) or Q(v))) : (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * (:(Q(v)) + :(Q(w)) + :(Q(x)) + :(Q(y)) + :(Q(z))) * 0.008 )"
(Formula.real_str
((* Heuristic.map_constants (fun c->(floor (c*.1000.))/.1000.) *)
(default_heuristic 3. rules
@@ -347,7 +347,7 @@
~advr:4.0 game in
assert_eq_str
- "100. * (Sum (cell_e_y8__BLANK_, cell_d_y8__BLANK_, cell_c1_y8__BLANK_, cell_b_y8__BLANK_, cell_a_y8__BLANK_ | ((cell_2x(cell_a_y8__BLANK_) or cell_2x(cell_b_y8__BLANK_) or cell_2x(cell_c1_y8__BLANK_) or cell_2x(cell_d_y8__BLANK_) or cell_2x(cell_e_y8__BLANK_)) and (cell_2b(cell_a_y8__BLANK_) or cell_2x(cell_a_y8__BLANK_)) and (cell_2b(cell_b_y8__BLANK_) or cell_2x(cell_b_y8__BLANK_)) and (cell_2b(cell_c1_y8__BLANK_) or cell_2x(cell_c1_y8__BLANK_)) and (cell_2b(cell_d_y8__BLANK_) or cell_2x(cell_d_y8__BLANK_)) and (cell_2b(cell_e_y8__BLANK_) or cell_2x(cell_e_y8__BLANK_)) and R2(cell_d_y8__BLANK_, cell_e_y8__BLANK_) and R2(cell_c1_y8__BLANK_, cell_d_y8__BLANK_) and R2(cell_b_y8__BLANK_, cell_c1_y8__BLANK_) and R2(cell_a_y8__BLANK_, cell_b_y8__BLANK_)) : (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * 0.0016 ) + Sum (cell_x18_y14__BLANK_, cell_x17_y15__BLANK_, cell_x16_y16__BLANK_, cell_x15_y17__BLANK_, cell_x14_y18__BLANK_ | ((cell_2x(cell_x14_y18__BLANK_) or cell_2x(cell_x15_y17__BLANK_) or cell_2x(cell_x16_y16__BLANK_) or cell_2x(cell_x17_y15__BLANK_) or cell_2x(cell_x18_y14__BLANK_)) and (cell_2b(cell_x14_y18__BLANK_) or cell_2x(cell_x14_y18__BLANK_)) and (cell_2b(cell_x15_y17__BLANK_) or cell_2x(cell_x15_y17__BLANK_)) and (cell_2b(cell_x16_y16__BLANK_) or cell_2x(cell_x16_y16__BLANK_)) and (cell_2b(cell_x17_y15__BLANK_) or cell_2x(cell_x17_y15__BLANK_)) and (cell_2b(cell_x18_y14__BLANK_) or cell_2x(cell_x18_y14__BLANK_)) and R1(cell_x17_y15__BLANK_, cell_x18_y14__BLANK_) and R1(cell_x16_y16__BLANK_, cell_x17_y15__BLANK_) and R1(cell_x15_y17__BLANK_, cell_x16_y16__BLANK_) and R1(cell_x14_y18__BLANK_, cell_x15_y17__BLANK_)) : (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * 0.0016 ) + Sum (cell_x9_y9__BLANK_, cell_x13_y13__BLANK_, cell_x12_y12__BLANK_, cell_x11_y11__BLANK_, cell_x10_y10__BLANK_ | ((cell_2x(cell_x10_y10__BLANK_) or cell_2x(cell_x11_y11__BLANK_) or cell_2x(cell_x12_y12__BLANK_) or cell_2x(cell_x13_y13__BLANK_) or cell_2x(cell_x9_y9__BLANK_)) and (cell_2b(cell_x10_y10__BLANK_) or cell_2x(cell_x10_y10__BLANK_)) and (cell_2b(cell_x11_y11__BLANK_) or cell_2x(cell_x11_y11__BLANK_)) and (cell_2b(cell_x12_y12__BLANK_) or cell_2x(cell_x12_y12__BLANK_)) and (cell_2b(cell_x13_y13__BLANK_) or cell_2x(cell_x13_y13__BLANK_)) and (cell_2b(cell_x9_y9__BLANK_) or cell_2x(cell_x9_y9__BLANK_)) and R0(cell_x9_y9__BLANK_, cell_x10_y10__BLANK_) and R0(cell_x12_y12__BLANK_, cell_x13_y13__BLANK_) and R0(cell_x11_y11__BLANK_, cell_x12_y12__BLANK_) and R0(cell_x10_y10__BLANK_, cell_x11_y11__BLANK_)) : (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * 0.0016 ) + Sum (cell_x8_e0__BLANK_, cell_x8_d0__BLANK_, cell_x8_c2__BLANK_, cell_x8_b0__BLANK_, cell_x8_a0__BLANK_ | ((cell_2x(cell_x8_a0__BLANK_) or cell_2x(cell_x8_b0__BLANK_) or cell_2x(cell_x8_c2__BLANK_) or cell_2x(cell_x8_d0__BLANK_) or cell_2x(cell_x8_e0__BLANK_)) and (cell_2b(cell_x8_a0__BLANK_) or cell_2x(cell_x8_a0__BLANK_)) and (cell_2b(cell_x8_b0__BLANK_) or cell_2x(cell_x8_b0__BLANK_)) and (cell_2b(cell_x8_c2__BLANK_) or cell_2x(cell_x8_c2__BLANK_)) and (cell_2b(cell_x8_d0__BLANK_) or cell_2x(cell_x8_d0__BLANK_)) and (cell_2b(cell_x8_e0__BLANK_) or cell_2x(cell_x8_e0__BLANK_)) and R(cell_x8_d0__BLANK_, cell_x8_e0__BLANK_) and R(cell_x8_c2__BLANK_, cell_x8_d0__BLANK_) and R(cell_x8_b0__BLANK_, cell_x8_c2__BLANK_) and R(cell_x8_a0__BLANK_, cell_x8_b0__BLANK_)) : (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * 0.0016 )) + 50. * Sum ( | false : 0. * 0. * 0. * 0. * inf)"
+ "100. * (Sum (cell_a_y8__BLANK_, cell_b_y8__BLANK_, cell_c1_y8__BLANK_, cell_d_y8__BLANK_, cell_e_y8__BLANK_ | ((cell_2x(cell_a_y8__BLANK_) or cell_2x(cell_b_y8__BLANK_) or cell_2x(cell_c1_y8__BLANK_) or cell_2x(cell_d_y8__BLANK_) or cell_2x(cell_e_y8__BLANK_)) and (cell_2b(cell_a_y8__BLANK_) or cell_2x(cell_a_y8__BLANK_)) and (cell_2b(cell_b_y8__BLANK_) or cell_2x(cell_b_y8__BLANK_)) and (cell_2b(cell_c1_y8__BLANK_) or cell_2x(cell_c1_y8__BLANK_)) and (cell_2b(cell_d_y8__BLANK_) or cell_2x(cell_d_y8__BLANK_)) and (cell_2b(cell_e_y8__BLANK_) or cell_2x(cell_e_y8__BLANK_)) and R2(cell_d_y8__BLANK_, cell_e_y8__BLANK_) and R2(cell_c1_y8__BLANK_, cell_d_y8__BLANK_) and R2(cell_b_y8__BLANK_, cell_c1_y8__BLANK_) and R2(cell_a_y8__BLANK_, cell_b_y8__BLANK_)) : (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * 0.0016 ) + Sum (cell_x14_y18__BLANK_, cell_x15_y17__BLANK_, cell_x16_y16__BLANK_, cell_x17_y15__BLANK_, cell_x18_y14__BLANK_ | ((cell_2x(cell_x14_y18__BLANK_) or cell_2x(cell_x15_y17__BLANK_) or cell_2x(cell_x16_y16__BLANK_) or cell_2x(cell_x17_y15__BLANK_) or cell_2x(cell_x18_y14__BLANK_)) and (cell_2b(cell_x14_y18__BLANK_) or cell_2x(cell_x14_y18__BLANK_)) and (cell_2b(cell_x15_y17__BLANK_) or cell_2x(cell_x15_y17__BLANK_)) and (cell_2b(cell_x16_y16__BLANK_) or cell_2x(cell_x16_y16__BLANK_)) and (cell_2b(cell_x17_y15__BLANK_) or cell_2x(cell_x17_y15__BLANK_)) and (cell_2b(cell_x18_y14__BLANK_) or cell_2x(cell_x18_y14__BLANK_)) and R1(cell_x17_y15__BLANK_, cell_x18_y14__BLANK_) and R1(cell_x16_y16__BLANK_, cell_x17_y15__BLANK_) and R1(cell_x15_y17__BLANK_, cell_x16_y16__BLANK_) and R1(cell_x14_y18__BLANK_, cell_x15_y17__BLANK_)) : (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * 0.0016 ) + Sum (cell_x10_y10__BLANK_, cell_x11_y11__BLANK_, cell_x12_y12__BLANK_, cell_x13_y13__BLANK_, cell_x9_y9__BLANK_ | ((cell_2x(cell_x10_y10__BLANK_) or cell_2x(cell_x11_y11__BLANK_) or cell_2x(cell_x12_y12__BLANK_) or cell_2x(cell_x13_y13__BLANK_) or cell_2x(cell_x9_y9__BLANK_)) and (cell_2b(cell_x10_y10__BLANK_) or cell_2x(cell_x10_y10__BLANK_)) and (cell_2b(cell_x11_y11__BLANK_) or cell_2x(cell_x11_y11__BLANK_)) and (cell_2b(cell_x12_y12__BLANK_) or cell_2x(cell_x12_y12__BLANK_)) and (cell_2b(cell_x13_y13__BLANK_) or cell_2x(cell_x13_y13__BLANK_)) and (cell_2b(cell_x9_y9__BLANK_) or cell_2x(cell_x9_y9__BLANK_)) and R0(cell_x9_y9__BLANK_, cell_x10_y10__BLANK_) and R0(cell_x12_y12__BLANK_, cell_x13_y13__BLANK_) and R0(cell_x11_y11__BLANK_, cell_x12_y12__BLANK_) and R0(cell_x10_y10__BLANK_, cell_x11_y11__BLANK_)) : (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * 0.0016 ) + Sum (cell_x8_a0__BLANK_, cell_x8_b0__BLANK_, cell_x8_c2__BLANK_, cell_x8_d0__BLANK_, cell_x8_e0__BLANK_ | ((cell_2x(cell_x8_a0__BLANK_) or cell_2x(cell_x8_b0__BLANK_) or cell_2x(cell_x8_c2__BLANK_) or cell_2x(cell_x8_d0__BLANK_) or cell_2x(cell_x8_e0__BLANK_)) and (cell_2b(cell_x8_a0__BLANK_) or cell_2x(cell_x8_a0__BLANK_)) and (cell_2b(cell_x8_b0__BLANK_) or cell_2x(cell_x8_b0__BLANK_)) and (cell_2b(cell_x8_c2__BLANK_) or cell_2x(cell_x8_c2__BLANK_)) and (cell_2b(cell_x8_d0__BLANK_) or cell_2x(cell_x8_d0__BLANK_)) and (cell_2b(cell_x8_e0__BLANK_) or cell_2x(cell_x8_e0__BLANK_)) and R(cell_x8_d0__BLANK_, cell_x8_e0__BLANK_) and R(cell_x8_c2__BLANK_, cell_x8_d0__BLANK_) and R(cell_x8_b0__BLANK_, cell_x8_c2__BLANK_) and R(cell_x8_a0__BLANK_, cell_x8_b0__BLANK_)) : (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * 0.0016 )) + 50. * Sum ( | false : 0. * 0. * 0. * 0. * inf)"
(Formula.real_str loc_heurs.(0).(0));
);
Modified: trunk/Toss/Server/LearnGame.ml
===================================================================
--- trunk/Toss/Server/LearnGame.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Server/LearnGame.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -19,7 +19,13 @@
let winFormula winningStates notWinningStates =
- Distinguish.distinguish winningStates notWinningStates
+ if !debug_level > 0 then
+ print_endline (
+ "Searching WIN:\n" ^
+ (String.concat "\n" (List.map Structure.str winningStates)) ^ "\nNOT\n"^
+ (String.concat "\n" (List.map Structure.str notWinningStates)));
+ FormulaOps.tnf_fv
+ (Aux.unsome (Distinguish.distinguish winningStates notWinningStates))
let cleanStructure struc =
let funs = ref [] in
Modified: trunk/Toss/Server/LearnGameTest.ml
===================================================================
--- trunk/Toss/Server/LearnGameTest.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Server/LearnGameTest.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -6,43 +6,6 @@
let struc_of_string s =
StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
-let formula_eq ?(flatten_sort=true) phi1 phi2 =
- if flatten_sort then
- assert_equal ~printer:(fun x -> Formula.sprint x)
- (Formula.flatten_sort (formula_of_string phi1))
- (Formula.flatten_sort phi2)
- else
- assert_equal ~printer:(fun x -> Formula.sprint x)
- (formula_of_string phi1) phi2
-
-let formula_list_eq ?(flatten_sort=true) l1 l2 =
- List.iter2 (formula_eq ~flatten_sort) l1 l2
-
-let formula_option_eq ?(flatten_sort=true) fopt1 fopt2 =
- let fopt_str = function None -> "None" | Some f -> Formula.str f in
- if fopt1 = "None" then
- assert_equal ~printer:fopt_str None fopt2
- else match fopt2 with
- | None -> assert_equal ~printer:(fun x -> x) fopt1 "None"
- | Some f -> formula_eq ~flatten_sort fopt1 f
-
-let hashtbl_eq struc list ht =
- let str_pair (tuple, phi) =
- (Structure.tuple_str struc tuple) ^ "->" ^ (Formula.str phi) in
- let str ps = String.concat "; " (List.map str_pair ps) in
- let hashtbl_to_list ht =
- let res = ref [] in
- Hashtbl.iter (fun k v -> res := (k, v) :: !res) ht; !res in
- let lst = List.map (fun (tp, fs) -> (tp, formula_of_string fs)) list in
- let simp l = List.sort Pervasives.compare
- (List.map (fun (t, f) -> (t, Formula.flatten f)) l) in
- assert_equal ~printer:str (simp lst) (simp (hashtbl_to_list ht))
-
-let array_list_str f a = "[| [" ^ (String.concat "]; [" (
- List.map (fun l -> String.concat ";" (List.map f l))
- (Array.to_list a))) ^ "] |]"
-
-
let tests = "LearnGame" >::: [
"simple test game" >::
(fun () ->
@@ -76,8 +39,8 @@
\"" ;]] in
let res_game =
"PLAYERS 1, 2
-REL Win1() = ex x0, x1 (Q(x1) and R(x1, x0))
-REL Win2() = ex x0, x1 (Q(x1) and R(x0, x1))
+REL Win1() = ex x1 (Q(x1) and ex x0 R(x1, x0))
+REL Win2() = ex x1 (Q(x1) and ex x0 R(x0, x1))
RULE Mv1:
[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P (1); Q:1 {}; R:2 {} | ]
emb R,Q,P pre not Win2()
Modified: trunk/Toss/Server/Picture.ml
===================================================================
--- trunk/Toss/Server/Picture.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Server/Picture.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -362,7 +362,7 @@
Format.eprintf "@[%a@]@ \n%!" Formula.fprint (Formula.And (basic :: mw));
if !debug_level > -1 then
Format.eprintf "@[%a@]@ \n%!" Formula.fprint
- (Aux.unsome (Distinguish.distinguish_by_type ~qr:1 ~k:2 [right] [wrong]));
+ (Aux.unsome (Distinguish.distinguish_upto ~qr:1 ~k:2 [right] [wrong]));
Formula.flatten (Formula.Ex (ex_vars, Formula.And (basic :: mw)))
)
Modified: trunk/Toss/Solver/Distinguish.ml
===================================================================
--- trunk/Toss/Solver/Distinguish.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Solver/Distinguish.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -3,10 +3,9 @@
let debug_level = ref 0
let set_debug_level i = (debug_level := i)
-type distinguish_method = Types | Guarded
+type logic = FO | GuardedFO
-
(* Helper functions to construct variables for indices. *)
let varname i = "x" ^ string_of_int i
let varnames k = List.map varname (Aux.range k)
@@ -76,8 +75,9 @@
(* - Guards and Guarded Types - *)
(* Generate all guarded substitutions of [tuple] with the guards.
+ A subst-tuple is a substitution of [tuple] if it has the same length.
A subst-tuple is a guarded substitution of [tuple] if a permuted
- sub-tuple a of subst-tuple containig at least one element of
+ sub-tuple of subst-tuple containig at least one element of
the original [tuple] is in some relation R in the structure [struc].
The guard for subst-tuple is then the atomic formula R(x_i1, ..., x_iK)
such that a = (subst-tuple_i1, ..., subst-tuple_iK) and R(a) holds.
@@ -206,39 +206,50 @@
| All (vs, f) -> All (vs, greedy_remove (fun x -> cond (All (vs, x))) f)
| phi -> phi
+(* Order on types that we use to select the minimal one. *)
+let compare_types tp1 tp2 =
+ let tp_lits = function And fl -> List.filter Formula.is_literal fl | _-> [] in
+ let c = Formula.compare (And (tp_lits tp1)) (And (tp_lits tp2)) in
+ if c <> 0 then c else Formula.compare tp1 tp2
-let distinguish_by_type ?(how=Guarded) ?(skip_outer_exists=false)
- ~qr ~k pos_struc neg_struc =
- let types s = match how with
- | Guarded -> guarded_types s ~qr ~k
- | Types -> ntypes s ~qr ~k in
- let (pos_tp, neg_tp) = (List.map types pos_struc, List.map types neg_struc) in
- let candidates = List.rev_append (List.concat pos_tp)
- (List.map (fun f -> Not f) (List.concat neg_tp)) in
- let fails_neg f = not (List.exists (fun s -> check s [||] f) neg_struc) in
- let fail_neg = List.filter fails_neg (Aux.unique_sorted candidates) in
- let fail_neg =
- List.rev_map (fun f -> Formula.flatten_sort (FormulaOps.nnf f)) fail_neg in
- let tp_lits = function And fl -> List.filter Formula.is_literal fl | _-> [] in
- let cmp_tp tp1 tp2 =
- let c = Formula.compare (And (tp_lits tp1)) (And (tp_lits tp2)) in
- if c <> 0 then c else Formula.compare tp1 tp2 in
- let fail_neg = Aux.unique_sorted ~cmp:cmp_tp fail_neg in
- let succ_pos fl = List.for_all (fun s -> check s [||] (Or fl)) pos_struc in
+let compare_types = ref compare_types
+
+(* Find the minimal [logic]-type of [struc] not included in [neg_types]
+ and with at most [qr] quantifiers and [k] variables. *)
+let min_type_omitting ?(logic = GuardedFO) ~qr ~k neg_types struc =
+ let pos_types = match logic with
+ | GuardedFO -> guarded_types struc ~qr ~k
+ | FO -> ntypes struc ~qr ~k in
+ let ok_types = List.filter (fun f -> not (List.mem f neg_types)) pos_types in
+ let ok_types = List.sort !compare_types ok_types in
+ if ok_types = [] then None else Some (List.hd ok_types)
+
+(* Find a [logic]-formula with at most [qr] quantifiers and [k] variables
+ which holds on all [pos_strucs] and on no [neg_strucs]. *)
+let distinguish_upto ?(logic = GuardedFO) ~qr ~k pos_strucs neg_strucs =
+ let types s = match logic with
+ | GuardedFO -> guarded_types s ~qr ~k
+ | FO -> ntypes s ~qr ~k in
+ let neg_tps = Aux.unique_sorted (Aux.concat_map types neg_strucs) in
+ let pos_tps = Aux.unique_sorted ~cmp:!compare_types (
+ Aux.map_some (min_type_omitting ~logic ~qr ~k neg_tps) pos_strucs) in
+ let fails_neg f = not (List.exists (fun s -> check s [||] f) neg_strucs) in
+ let succ_pos fl = List.for_all (fun s -> check s [||] (Or fl)) pos_strucs in
let rec find_type acc = function
| [] -> []
| x :: xs -> if succ_pos (x::acc) then x :: acc else
find_type (x::acc) xs in
- let dtypes = find_type [] fail_neg in
+ let dtypes = find_type [] pos_tps in
if dtypes = [] then None else
let is_ok f = fails_neg f && succ_pos [f] in
let mintp = greedy_remove is_ok (Or dtypes) in
let fv = FormulaSubst.free_vars mintp in
- let t = FormulaOps.rename_quant_avoiding fv mintp in
- if skip_outer_exists then Some t else
- Some (Ex (List.sort Formula.compare_vars fv, t))
+ Some (FormulaOps.rename_quant_avoiding fv mintp)
-let distinguish ?(how=Guarded) ?(skip_outer_exists=false) strucs1 strucs2 =
+
+(* Find a [logic]-formula holding on all [pos_strucs] and on no [neg_strucs].
+ Leaves free variables (existential) if [skip_outer_exists] is set. *)
+let distinguish ?(how=GuardedFO) ?(skip_outer_exists=false) strucs1 strucs2 =
if !debug_level > 0 then
Printf.printf "distinguishing:\n\n%s\n\n and\n\n %s\n%!"
(String.concat "\n" (List.map Structure.str strucs1))
@@ -246,8 +257,10 @@
let rec diff qr k =
if qr > k then diff 0 (k+1) else (
if !debug_level > 0 then Printf.printf "distinguish qr %i k %i\n%!" qr k;
- match distinguish_by_type ~how ~skip_outer_exists ~qr ~k strucs1 strucs2 with
- | Some f -> f
+ match distinguish_upto ~logic:how ~qr ~k strucs1 strucs2 with
+ | Some f ->
+ if skip_outer_exists then Some f else
+ Some (Ex (FormulaSubst.free_vars f, f))
| None -> diff (qr+1) k
) in
diff 0 1
Modified: trunk/Toss/Solver/Distinguish.mli
===================================================================
--- trunk/Toss/Solver/Distinguish.mli 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Solver/Distinguish.mli 2011-11-17 17:12:44 UTC (rev 1634)
@@ -1,6 +1,6 @@
(** Distinguish sets of structures by formulas. *)
-type distinguish_method = Types | Guarded
+type logic = FO | GuardedFO
(** {2 Atoms and FO Types} *)
@@ -19,6 +19,7 @@
(** {2 Guards and Guarded Types} *)
(** Generate all guarded substitutions of [tuple] with the guards.
+ A subst-tuple is a substitution of [tuple] if it has the same length.
A subst-tuple is a guarded substitution of [tuple] if a permuted
sub-tuple a of subst-tuple containig at least one element of
the original [tuple] is in some relation R in the structure [struc].
@@ -45,14 +46,26 @@
(** {2 Distinguishing Structure Sets} *)
-val distinguish_by_type: ?how: distinguish_method -> ?skip_outer_exists: bool ->
- qr: int -> k: int -> Structure.structure list -> Structure.structure list ->
- Formula.formula option
-
-val distinguish: ?how: distinguish_method -> ?skip_outer_exists: bool ->
- Structure.structure list -> Structure.structure list -> Formula.formula
+(** Order on types that we use to select the minimal ones. *)
+val compare_types : (Formula.formula -> Formula.formula -> int) ref
+(** Find the minimal [logic]-type of [struc] not included in [neg_types]
+ and with at most [qr] quantifiers and [k] variables. *)
+val min_type_omitting: ?logic: logic -> qr: int -> k: int ->
+ Formula.formula list -> Structure.structure -> Formula.formula option
+(** Find a [logic]-formula with at most [qr] quantifiers and [k] variables
+ which holds on all [pos_strucs] and on no [neg_strucs].
+ Leaves free variables which are implicitly quantified existentially. *)
+val distinguish_upto: ?logic: logic -> qr: int -> k: int ->
+ Structure.structure list -> Structure.structure list -> Formula.formula option
+
+(** Find a [logic]-formula holding on all [pos_strucs] and on no [neg_strucs].
+ Leaves free variables (existential) if [skip_outer_exists] is set. *)
+val distinguish: ?how: logic -> ?skip_outer_exists: bool ->
+ Structure.structure list -> Structure.structure list -> Formula.formula option
+
+
(** {2 Debugging} *)
val set_debug_level: int -> unit
Modified: trunk/Toss/Solver/DistinguishTest.ml
===================================================================
--- trunk/Toss/Solver/DistinguishTest.ml 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/Solver/DistinguishTest.ml 2011-11-17 17:12:44 UTC (rev 1634)
@@ -208,39 +208,38 @@
(List.length (Distinguish.guarded_types struc ~qr:1 ~k:2));
);
- "distinguish_by_type" >::
+ "distinguish_upto" >::
(fun () ->
let struc1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
let struc2 = (struc_of_string "[ | R { (1, 2) } | ]") in
formula_option_eq "None"
- (Distinguish.distinguish_by_type ~qr:2 ~k:1 [struc1] [struc2]);
+ (Distinguish.distinguish_upto ~qr:2 ~k:1 [struc1] [struc2]);
formula_option_eq "None" (* we use guarded types - so None here *)
- (Distinguish.distinguish_by_type ~qr:0 ~k:2 [struc1] [struc2]);
+ (Distinguish.distinguish_upto ~qr:0 ~k:2 [struc1] [struc2]);
formula_option_eq "not R(x0, x1) and not x0 = x1 and not R(x1, x0)"
- (Distinguish.distinguish_by_type ~how:Types ~skip_outer_exists:true
- ~qr:0 ~k:2 [struc1] [struc2]);
+ (Distinguish.distinguish_upto ~logic:FO ~qr:0 ~k:2 [struc1] [struc2]);
formula_option_eq "None" (* we use guarded types - so None here *)
- (Distinguish.distinguish_by_type ~qr:0 ~k:3 [struc1] [struc2]);
+ (Distinguish.distinguish_upto ~qr:0 ~k:3 [struc1] [struc2]);
formula_option_eq "R(x0, x1) and ex x2 R(x2, x0)"
- (Distinguish.distinguish_by_type ~skip_outer_exists:true ~qr:1 ~k:2
- [struc1] [struc2]);
+ (Distinguish.distinguish_upto ~qr:1 ~k:2 [struc1] [struc2]);
let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
let struc2 = (struc_of_string "[ | P:1 {}; R { (1) } | ]") in
- formula_option_eq "ex x0 P(x0)"
- (Distinguish.distinguish_by_type ~qr:0 ~k:1 [struc1] [struc2]);
+ formula_option_eq "P(x0)"
+ (Distinguish.distinguish_upto ~qr:0 ~k:1 [struc1] [struc2]);
);
"distinguish" >::
(fun () ->
let struc1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
let struc2 = (struc_of_string "[ | R { (1, 2) } | ]") in
- formula_eq "ex x0, x1 (R(x0, x1) and ex x2 R(x2, x0))"
+ formula_option_eq "ex x0, x1 (R(x0, x1) and ex x2 R(x2, x0))"
(Distinguish.distinguish [struc1] [struc2]);
let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
let struc2 = (struc_of_string "[ | P:1 {}; R { (1) } | ]") in
- formula_eq "ex x0 P(x0)" (Distinguish.distinguish [struc1] [struc2]);
+ formula_option_eq "ex x0 P(x0)"
+ (Distinguish.distinguish [struc1] [struc2]);
let struc1 = struc_of_string "[ | | ] \"
...
@@ -254,7 +253,7 @@
...
...
\"" in
- formula_eq "ex x0, x1 (P(x0) and C(x0, x1))"
+ formula_option_eq "ex x0, x1 (P(x0) and C(x0, x1))"
(Distinguish.distinguish [struc1] [struc2]);
);
]
@@ -293,7 +292,7 @@
P..
... ...
...P ...
-\"" in formula_eq
+\"" in formula_option_eq
"P(x0) and P(x1) and C(x0, x1) and ex x2 (P(x2) and C(x2, x0))"
(Distinguish.distinguish ~skip_outer_exists:true
[strucP] [strucN1; strucN2; strucN3]);
@@ -337,7 +336,7 @@
... ... ... ...
...W ... ... ...
\"" in (* Distinguish.set_debug_level 1; *)
- formula_eq "W(x1) and all x0 not C(x1, x0)"
+ formula_option_eq "W(x1) and all x0 not C(x1, x0)"
(Distinguish.distinguish ~skip_outer_exists:true [struc1] [struc2]);
);
]
Modified: trunk/Toss/www/reference/reference.tex
===================================================================
--- trunk/Toss/www/reference/reference.tex 2011-11-16 21:58:12 UTC (rev 1633)
+++ trunk/Toss/www/reference/reference.tex 2011-11-17 17:12:44 UTC (rev 1634)
@@ -1,4 +1,4 @@
-\documentclass{scrbook}
+\documentclass[oneside,fleqn]{scrbook}
% Font choice
\usepackage[sc]{mathpazo}
@@ -94,6 +94,7 @@
\newcommand{\TrST}{\ensuremath{\mathrm{TrST}}}
\newcommand{\lfp}{\mathrm{lfp}}
\newcommand{\gfp}{\mathrm{gfp}}
+\newcommand{\tp}{\mathrm{tp}}
% Theorem environments
\theoremstyle{plain}
@@ -1101,11 +1102,12 @@
\section{Solver Techniques}
-We used a SAT solver (MiniSAT) to operate on symbolic representations
-of MSO variables. We decided in favor of CNF representation instead of
-the more standard BDD approach as it seems to scale in a more consistent way.
+We use a SAT solver (from The Decision Procedure Toolkit, DPT) to operate on
+symbolic representations of MSO variables. We decided in favor of CNF
+representation instead of the more standard BDD approach as it seems to
+scale in a more consistent way.
-For handling real arithmetic, we implemented a quantifier elimination
+For handling real arithmetic, we implement a quantifier elimination
procedure based on Muchnik's proof. It is not as efficient as CAD
(cylindrical algebraic decomposition) but works very consistently
for many cases.
@@ -1113,7 +1115,156 @@
The main formula optimization is just performing the TNF, later we
only push predicates to the front.
+\chapter{Formula and Game Induction}
+In this chapter we present a method for constructing formulas that
+separate sets of structures from such sets given as input, and we
+describe how games can be learned from example plays using this method.
+
+\section{Fragments of First-Order Logic}
+
+The $k$-variable fragment of FO consists of all formulas which use only
+the variables $x_1, \ldots, x_{k-1}$, both as free ones and under quantifiers.
+
+The guarded fragment of FO is defined inductively by
+\[ \phi\ ::= \ R(\ol{x}) \ \mid \ x = x \ \mid \ \neg \phi \ \mid \
+ \phi \land \phi \ \mid \ \phi \lor \phi \ \mid \]
+\[ \phantom{\phi\ :==}\
+ \exists \ol{y} \big( R(\ol{x},\ol{y}) \land \phi(\ol{x},\ol{y}) \big)
+ \quad \mid \quad
+ \forall \ol{y} \big( \neg R(\ol{x},\ol{y}) \lor \phi(\ol{x},\ol{y})\big),\]
+where in the line above $\phi(\ol{x},\ol{y})$ means that all free variables
+of $\phi$ must be included in the set $\{\ol{x}\} \cup \{\ol{y}\}$.
+
+\begin{example}
+Formulas of modal logic translate to guarded first-order logic with two
+variables, so \eg a formula with one free variable $x$ expressing that
+``every $E$-sucessor of $x$ has an $R$-successor in which $P$ holds'' can be
+written in the guarded fragment with two variables as follows:
+\[ \exists y \big( E(x, y) \land \forall x (R(y, x) \to P(y)) \big). \]
+\end{example}
+
+
+\section{Types}
+
+Let $\calL$ be any set of formulas, \eg a fragment of first-order logic.
+The $\calL$-type of a tuple $\ol{a}$ in a structure $\frakA$ is the subset
+of $\calL$ of formulas with as many free variables as $|\ol{a}|$ which are
+satisified by $\ol{a}$ in $\frakA$, \ie
+\[ \calL-\mathrm{type}(\frakA, \ol{a}) =
+ \{ \phi(\ol{x}) \in \calL \mid |\ol{x}| = |\ol{a}| \text{ and }
+ \frakA \models \phi(\ol{a}) \}. \]
+
+The set described above is most often infinite even for trivial reasons, \eg
+it might contain formulas $P(x), P(x) \land P(x), P(x) \land P(x) \land P(x)$,
+and so on -- something which could be described just by $P(x)$. And since in
+many cases there exists one formula describing this set, we will often abuse
+the terminology and say that the $\calL$-type of $\ol{a}$ in $\frakA$ is one
+formula $\tau \in \calL$, denoted $\tau = \tp^\calL(\frakA, \ol{a})$, such that
+\[ \frakA \models \tau(\ol{a}) \text{ and for all } \phi \in
+ \calL-\mathrm{type}(\frakA, \ol{a}) \text{ holds }
+ \tau(\ol{x}) \Rightarrow \phi(\ol{x}). \]
+
+Note that, in principle, such a formula $\tau$ might not exist in $\calL$.
+But it does exist for fragments of FO with bounded quantifier rank,
+additionally bounded number of variables, and additionally guarded.
+The proof of existence is done by inductive construction, and the same
+constructions are also used in our algorithms to compute the types.
+
+\subsubsection{Type in FO with Bounded Rank and Variable Number}
+
+Let $n$ be the bound on the number of quantifiers and let us fix $\frakA$
+and $\ol{a}$ and assume that $|\ol{a}| = k$ is also the bound on the number
+of variables we are allowed to use. We denote the FO type with quantifier rank
+bounded by $n$ and variable number bounded by $k$ by $\tp^{n,k}(\frakA,\ol{a})$.
+
+For $n = 0$, the formula $\tp^{n,k}(\frakA,\ol{a})$ is simply a conjunction of
+all literals satisfied by $\ol{a}$ in $\frakA$, which we compute exhaustively.
+
+For $n > 0$, the formula $\tp^{n,k}(\frakA,\ol{a})$ is given by
+\[ \tp^{n-1,k}(\frakA,\ol{a}) \ \land\ \Land_{i < |\ol{a}|} \left(
+ \forall x_i \left( \Lor_{b \in \frakA}
+ \tp^{n-1,k}(\frakA,\ol{a}[a_i \ot b]) \right) \ \land \
+ \Land_{b \in \frakA} \exists x_i \left(
+ \tp^{n-1,k}(\frakA,\ol{a}[a_i \ot b]) \right) \right). \]
+We omit the proof of correctness for this formula.
+
+
+\subsubsection{Type in Guarded FO with Bounded Rank and Variable Number}
+
+Let $n$ be the bound on the number of quantifiers and let us fix $\frakA$
+and $\ol{a}$ and assume that $|\ol{a}| = k$ is also the bound on the number
+of variables we are allowed to use. We denote the guarded-FO type with
+quantifier rank bounded by $n$ and variable number bounded by $k$ by
+$\tp_g^{n,k}(\frakA,\ol{a})$.
+
+For $n = 0$, $\tp^{n,k}(\frakA,\ol{a})$ is again a conjunction of
+all literals satisfied by $\ol{a}$ in $\frakA$.
+
+For $n > 0$, we first need to consider all \emph{guarded substitutions} of
+the tuple $\ol{a}$. We say that $\ol{b}$ is a guarded substitution of $\ol{a}$
+in $\frakA$ if $|\ol{b}| = |\ol{a}|$, and there is a subset $\{b_1,\ldots,b_k\}$
+of $\ol{b}$ such that $(b_1, \ldots, b_k) \in R^\frakA$ for some $R$, at least
+one $b_i \in \ol{a}$, and on all positions $j < |b|$ either
+$b[j] = a[j]$ or $b[j] = b_i$ for some $i$.
+
+Let now $S$ be the set of all guarded substitutions of $\ol{a}$ and
+$V$ the set of all proper subsets of variables $x_0, \ldots, x_{|a|-1}$.
+For each non-empty set $\sfx \in V$ let $G_\sfx$ denote proper guards
+for $\sfx$, \ie formulas $R(\ol{x}, \ol{y})$ such that $\{\ol{x}\} = \sfx$
+and $\ol{y}$ is not empty. For each such $g \in G_\sfx$ let us denote by
+$S_g$ the subset of $S$ for which the guard $g$ holds, \ie
+$S_g = \{ \ol{b} \in S \mid \frakA \models g(\ol{b}) \}.$
+We will now construct the next type for $\sfx$ and $g \in G_\sfx$ as
+\[ \tau_{\sfx, g} =
+ \forall \sfx \left(g \to
+ \Lor_{\ol{b} \in S_g}\tp_g^{n-1,k}(\frakA,\ol{b}) \right) \ \land \
+ \Land_{\ol{b} \in S_g} \exists \sfx \left(
+ g \land \tp_g^{n-1,k}(\frakA,\ol{b}) \right). \]
+
+Finally, the guarded type $\tp_g^{n,k}(\frakA,\ol{a})$ is given by
+\[ \tp^{n-1,k}(\frakA,\ol{a}) \ \land\
+ \Land_{\sfx \in V} \Land_{g \in G_\sfx} \tau_{\sfx, g}. \]
+
+
+\section{Learning Games}
+
+Let us start by showing how to learn two-player zero-sum games with payoffs only
+$1$, $0$, and $-1$. First, we say that an abstract \emph{play} is a sequence
+\[ \frakA_0 \to_{p_0} \frakA_1 \to_{p_1} \dots \to_{p_{n-1}} \frakA_n, \]
+where each $\frakA_i$ is a structure (the state of the play) and each
+$p_i$ is the player who made that move, \ie $p_i \in \{0,1\}$.
+The input for learning a game as above consists of four sets of plays:
+\begin{enumerate}
+\item[$\Pi_1$] -- plays after which Player~$0$ gets payoff $1$,
+\item[$\Pi_0$] -- plays after which both players get payoff $0$,
+\item[$\Pi_{-1}$] -- plays after which Player~$0$ gets payoff $-1$,
+\item[$\Pi_W$] -- plays in which the last move is incorrect.
+\end{enumerate}
+
+To learn the game, we induce the winning conditions for both players and
+the termination condition, and the rules for moves of the players.
+
+\subsubsection{Termination Condition and Payoffs}
+
+To learn this, we apply the distinguish function described above $3$ times,
+to induce formulas for the last structures in $\Pi_1, \Pi_0$ and $\Pi_{-1}$.
+
+\subsubsection{Inducing Moves}
+
+First, we create for each of the two players two list of pairs
+$(\frakL, \frakR)$ -- one with all his correct moves in the sets $\Pi_*$ and
+the other with incorrect moves of this player, \ie the last ones from $\Pi_W$.
+We create the general move rules by taking the positive list and cutting
+each $(\frakL, \frakR)$ to only the elements that differ. If the list of
+wrong moves is empty, this is the end, we have the moves.
+
+If the list of wrong moves is not empty, we match each general move to
+the right and wrong move pairs in which it could have been applied,
+and use the function distinguish from above to learn a precondition or
+postcondition which will restrict the move only to the correct structures.
+
+
\chapter{GDL to Toss Translation}
\section{Game Description Language}
@@ -1167,28 +1318,20 @@
(init (cell c c b))
(init (control x))
(<= (next (control ?r)) (does ?r noop))
-(<= (next (cell ?x ?y ?r))
- (does ?r (mark ?x ?y)))
-(<= (next (cell ?x ?y ?c))
- (true (cell ?x ?y ?c))
- (does ?r (mark ?x1 ?y1))
+(<= (next (cell ?x ?y ?r)) (does ?r (mark ?x ?y)))
+(<= (next (cell ?x ?y ?c)) (true (cell ?x ?y ?c)) (does ?r (mark ?x1 ?y1))
(or (distinct ?x ?x1) (distinct ?y ?y1)))
-(<= (legal ?r (mark ?x ?y))
- (true (control ?r))
- (true (cell ?x ?y b)))
-(<= (legal ?r noop) (role ?r)
- (not (true (control ?r))))
+(<= (legal ?r (mark ?x ?y)) (true (control ?r)) (true (cell ?x ?y b)))
+(<= (legal ?r noop) (role ?r) (not (true (control ?r))))
(<= (goal ?r 100) (conn3 ?r))
-(<= (goal ?r 50) (role ?r)
- (not exists_line3))
+(<= (goal ?r 50) (role ?r) (not exists_line3))
(<= (goal x 0) (conn3 o))
(<= (goal o 0) (conn3 x))
(<= terminal exists_line3)
(<= terminal (not exists_blank))
(<= exists_blank (true (cell ?x ?y b)))
(<= exists_line3 (role ?r) (conn3 ?r))
-(<= (conn3 ?r) (or (col ?r) (row ?r)
- (diag1 ?r) (diag2 ?r)))
+(<= (conn3 ?r) (or (col ?r) (row ?r) (diag1 ?r) (diag2 ?r)))
(<= (row ?r)
(true (cell ?a ?y ?r)) (nextcol ?a ?b)
(true (cell ?b ?y ?r)) (nextcol ?b ?c)
@@ -2496,10 +2639,8 @@
-\chapter{Design}
+\chapter{Implementation}
-\section{Organization of Code}
-
Toss consists of the main \emph{TossServer} which is built from several
main modules explained in the sections below and corresponding to
directories in the code tree. The main modules contain OCaml modules
@@ -2512,7 +2653,7 @@
specification of available server requests and the response format.
-\section{Formula}
+\subsubsection{Formula}
This most basic directory implements formulas as described above and various
operations on formulas which are necessary for other modules. It also
@@ -2521,28 +2662,28 @@
simplification.
-\section{Solver}
+\subsubsection{Solver}
This directory contains the module which represents relational structures,
and the full Solver, including the elimination-based solver for the theory
of reals and the SAT-based solving algorithm for monadic second-order logic.
-\section{Arena}
+\subsubsection{Arena}
This directory contains modules which implement the game definition,
including discrete and continuous structure rewriting, game file parser
and client-server communication parser and request type.
-\section{Play}
+\subsubsection{Play}
This directory contains modules responsible for automatic play, including
the heuristic generation module, the abstract game tree module and its
instantiations to Maximax and UCT.
-\section{GGP}
+\subsubsection{GGP}
This directory contains the code which translates GDL files into Toss
format together with various needed simplifications. Multiple tests
@@ -2550,19 +2691,14 @@
of the Toss-GGP code.
-\section{Server}
+\subsubsection{Server}
In this directory we simply keep the implementation of TossServer
together with several high-level tests to check that it works ok.
-\section{Client}
+\subsubsection{WebClient}
-This stand-alone Toss client is written in python using the Qt4 library.
-
-
-\section{WebClient}
-
The browser-based client does not currently interface TossServer directly,
but uses a python request Handler.py as an intermediate step. This handler
also manages a database of users and games.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-16 21:58:18
|
Revision: 1633
http://toss.svn.sourceforge.net/toss/?rev=1633&view=rev
Author: lukaszkaiser
Date: 2011-11-16 21:58:12 +0000 (Wed, 16 Nov 2011)
Log Message:
-----------
Better ordering in distinguish_by_type, gives more readable formulas.
Modified Paths:
--------------
trunk/Toss/Formula/Formula.ml
trunk/Toss/Formula/Formula.mli
trunk/Toss/Formula/FormulaTest.ml
trunk/Toss/Server/Makefile
trunk/Toss/Solver/Distinguish.ml
trunk/Toss/Solver/DistinguishTest.ml
Modified: trunk/Toss/Formula/Formula.ml
===================================================================
--- trunk/Toss/Formula/Formula.ml 2011-11-14 15:49:50 UTC (rev 1632)
+++ trunk/Toss/Formula/Formula.ml 2011-11-16 21:58:12 UTC (rev 1633)
@@ -129,10 +129,14 @@
let is_atom = function
- | Rel _ | Eq _ | In _ | SO _ | RealExpr _ -> true
+ | Rel _ | Eq _ | In _ | SO _ -> true
| _ -> false
+let rec is_literal = function
+ | Not f -> is_literal f
+ | f -> is_atom f
+
(* Helper power function, used in parser. *)
let rec pow p n =
if n = 0 then Const 1. else if n = 1 then p else Times (p, pow p (n-1))
Modified: trunk/Toss/Formula/Formula.mli
===================================================================
--- trunk/Toss/Formula/Formula.mli 2011-11-14 15:49:50 UTC (rev 1632)
+++ trunk/Toss/Formula/Formula.mli 2011-11-16 21:58:12 UTC (rev 1633)
@@ -81,6 +81,7 @@
val compare : formula -> formula -> int
val is_atom : formula -> bool
+val is_literal : formula -> bool
(** Equation system: a left-hand-side [f,a] actually represents
[Fun (f, `FO a)] *)
Modified: trunk/Toss/Formula/FormulaTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaTest.ml 2011-11-14 15:49:50 UTC (rev 1632)
+++ trunk/Toss/Formula/FormulaTest.ml 2011-11-16 21:58:12 UTC (rev 1633)
@@ -14,6 +14,16 @@
(And [rel "P" 1; rel "Q" 1; rel "S" 1]);
);
+ "size, compare" >::
+ (fun () ->
+ assert_equal ~printer:(fun x -> string_of_int x) 5
+ (size (And [rel "P" 1; rel "Q" 1; Not (rel "R" 2)]));
+
+ assert_equal ~printer:(fun x -> string_of_int x) 1
+ (compare (And [rel "P" 1; Not (rel "Q" 1); Not (rel "R" 2)])
+ (And [rel "P" 1; rel "Q" 1; Not (rel "R" 2)]));
+ );
+
"syntax check" >::
(fun () ->
assert_equal ~printer:string_of_bool true
Modified: trunk/Toss/Server/Makefile
===================================================================
--- trunk/Toss/Server/Makefile 2011-11-14 15:49:50 UTC (rev 1632)
+++ trunk/Toss/Server/Makefile 2011-11-16 21:58:12 UTC (rev 1633)
@@ -5,6 +5,7 @@
PictureTest:
ReqHandlerTest:
+LearnGameTest:
tests:
make -C .. ServerTestsVerbose
Modified: trunk/Toss/Solver/Distinguish.ml
===================================================================
--- trunk/Toss/Solver/Distinguish.ml 2011-11-14 15:49:50 UTC (rev 1632)
+++ trunk/Toss/Solver/Distinguish.ml 2011-11-16 21:58:12 UTC (rev 1633)
@@ -37,24 +37,40 @@
) (atoms @ (equalities (varnames k)))
+(* The [qr]-type in [length of tuple]-variables of [tuple] in [struc].
+ In [mem] we memorize the results for [qr] and [tuple], but *not* [struc]. *)
+let rec ntype_memo struc mem qr tuple =
+ try Hashtbl.find mem (qr, tuple) with Not_found ->
+ if qr = 0 then (
+ let res = Formula.flatten_sort (And (atoms struc tuple)) in
+ Hashtbl.add mem (qr, tuple) res;
+ res
+ ) else (
+ let prevtp i e =
+ ntype_memo struc mem (qr-1) (Aux.array_replace tuple i e) in
+ let elems = Structure.elements struc in
+ let conj_prev_ex i =
+ And (List.map (fun e -> Ex ([var i], prevtp i e)) elems) in
+ let all_prev_disj i =
+ All ([var i], Or (List.map (prevtp i) elems)) in
+ let next_ntype i = And [conj_prev_ex i; all_prev_disj i] in
+ let nexttp = And (List.map next_ntype (Aux.range (Array.length tuple))) in
+ let res = Formula.flatten_sort (
+ And [ntype_memo struc mem (qr-1) tuple; nexttp]) in
+ Hashtbl.add mem (qr, tuple) res;
+ res
+ )
+
(* The [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
-let rec ntype struc qr tuple =
- if qr = 0 then Formula.flatten_sort (And (atoms struc tuple)) else
- let prevtp i e = ntype struc (qr-1) (Aux.array_replace tuple i e) in
- let elems = Structure.elements struc in
- let conj_prev_ex i =
- And (List.map (fun e -> Ex ([var i], prevtp i e)) elems) in
- let all_prev_disj i =
- All ([var i], Or (List.map (prevtp i) elems)) in
- let next_ntype i = And [conj_prev_ex i; all_prev_disj i] in
- let nexttp = And (List.map next_ntype (Aux.range (Array.length tuple))) in
- Formula.flatten_sort (And [ntype struc (qr-1) tuple; nexttp])
+let ntype struc qr tuple = ntype_memo struc (Hashtbl.create 7) qr tuple
+
(* All types of rank [qr] of all [k]-tuples in [struc]. *)
let ntypes struc ~qr ~k =
let elems = Structure.elements struc in
let tups = List.map Array.of_list (Aux.all_ntuples elems k) in
- Aux.unique_sorted (List.rev_map (ntype struc qr) tups)
+ let mem = Hashtbl.create 63 in
+ Aux.unique_sorted (List.rev_map (ntype_memo struc mem qr) tups)
(* - Guards and Guarded Types - *)
@@ -104,39 +120,57 @@
(Formula.str atom) ^ " >"
+(* Guarded [qr]-type in [length of tuple]-variables of [tuple] in [struc].
+ In [mem] we memorize the results for [qr] and [tuple], but *not* [struc]. *)
+let rec guarded_type_memo struc mem qr tuple =
+ try Hashtbl.find mem (qr, tuple) with Not_found ->
+ if qr = 0 then (
+ let res = Formula.flatten_sort (And (atoms struc tuple)) in
+ Hashtbl.add mem (qr, tuple) res;
+ res
+ ) else (
+ let prevtp tup = guarded_type_memo struc mem (qr-1) tup in
+ let conj_prev_ex vars guard subst_tuples =
+ let subst_tuples = List.filter (fun tup -> tup <> tuple) subst_tuples in
+ And (List.map (fun tup -> Ex (vars, prevtp tup)) subst_tuples) in
+ let all_prev_disj vars guard subst_tuples =
+ All (vars, Or ((Not guard) :: (List.map prevtp subst_tuples))) in
+ let next_gtype vs (g, ts) =
+ And [conj_prev_ex vs g ts; all_prev_disj vs g ts] in
+ let subst_tuples =
+ List.rev_map (fun (_,vs,t,_,_) -> (vs, t)) (guards struc tuple) in
+ let subst_tuples = Aux.unique_sorted (([], tuple) :: subst_tuples) in
+ let all_vars = varnames (Array.length tuple) in
+ let at_most_vs_tuples vs = List.concat (List.map (
+ fun vs -> Aux.assoc_all vs subst_tuples) (Aux.all_subsets vs)) in
+ let tuples_by_vs = List.map (fun vs -> (vs, at_most_vs_tuples vs))
+ (Aux.all_subsets (List.map var_of_string all_vars)) in
+ let all_guards =
+ FormulaOps.atoms (Structure.rel_signature struc) all_vars in
+ let guards_to_tups (vs, tuples) =
+ let has_vs a = List.for_all (fun v -> Aux.array_mem (to_fo v) a) vs in
+ let is_vs_guard a = has_vs a &&
+ Aux.array_existsi (fun _ v -> not (List.mem (v :> var) vs)) a in
+ let is_vs_guard = function Rel (_, a) -> is_vs_guard a | _ -> false in
+ let vs_guards = List.filter is_vs_guard all_guards in
+ let guarded_tups g = List.filter (fun tup-> check struc tup g) tuples in
+ (vs, List.map (fun g -> (g, guarded_tups g)) vs_guards) in
+ let tups_with_guards = List.map guards_to_tups tuples_by_vs in
+ let tups_with_guards =
+ List.filter (fun (vs,_) -> vs <> []) tups_with_guards in
+ let next_gtype_vs (vs, gtups) = And (List.map (next_gtype vs) gtups) in
+ let nextf = And (List.map next_gtype_vs tups_with_guards) in
+ let res = Formula.flatten_sort (
+ And [guarded_type_memo struc mem (qr-1) tuple; nextf]) in
+ Hashtbl.add mem (qr, tuple) res;
+ res
+ )
+
(* Guarded [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
-let rec guarded_type struc qr tuple =
- if qr = 0 then Formula.flatten_sort (And (atoms struc tuple)) else
- let prevtp tup = guarded_type struc (qr-1) tup in
- let conj_prev_ex vars guard subst_tuples =
- let subst_tuples = List.filter (fun tup -> tup <> tuple) subst_tuples in
- And (List.map (fun tup -> Ex (vars, prevtp tup)) subst_tuples) in
- let all_prev_disj vars guard subst_tuples =
- All (vars, Or ((Not guard) :: (List.map prevtp subst_tuples))) in
- let next_gtype vs (g, ts) =
- And [conj_prev_ex vs g ts; all_prev_disj vs g ts] in
- let subst_tuples = Aux.unique_sorted (([], tuple) ::
- List.rev_map (fun (_,vs,t,_,_) -> (vs, t)) (guards struc tuple)) in
- let all_vars = varnames (Array.length tuple) in
- let at_most_vs_tuples vs = List.concat (List.map (
- fun vs -> Aux.assoc_all vs subst_tuples) (Aux.all_subsets vs)) in
- let tuples_by_vs = List.map (fun vs -> (vs, at_most_vs_tuples vs))
- (Aux.all_subsets (List.map var_of_string all_vars)) in
- let all_guards= FormulaOps.atoms (Structure.rel_signature struc) all_vars in
- let guards_to_tups (vs, tuples) =
- let has_vs a = List.for_all (fun v -> Aux.array_mem (to_fo v) a) vs in
- let is_vs_guard a = has_vs a &&
- Aux.array_existsi (fun _ v -> not (List.mem (v :> var) vs)) a in
- let is_vs_guard = function Rel (_, a) -> is_vs_guard a | _ -> false in
- let vs_guards = List.filter is_vs_guard all_guards in
- let guarded_tups g = List.filter (fun tup -> check struc tup g) tuples in
- (vs, List.map (fun g -> (g, guarded_tups g)) vs_guards) in
- let tups_with_guards = List.map guards_to_tups tuples_by_vs in
- let tups_with_guards = List.filter (fun (vs,_)-> vs<>[]) tups_with_guards in
- let next_gtype_vs (vs, gtups) = And (List.map (next_gtype vs) gtups) in
- let nextf = And (List.map next_gtype_vs tups_with_guards) in
- Formula.flatten_sort (And [guarded_type struc (qr-1) tuple; nextf])
+let guarded_type struc qr tuple =
+ guarded_type_memo struc (Hashtbl.create 7) qr tuple
+
(* All guarded types of rank [qr] of guarded [k]-tuples in [struc]. *)
let guarded_types struc ~qr ~k =
let tups = List.map (Structure.incident struc) (Structure.elements struc) in
@@ -146,7 +180,8 @@
List.map Array.of_list (Aux.all_ntuples (Array.to_list tup) k) in
let ktups = List.rev_map k_subtuples (Aux.unique_sorted tups) in
let ktups = Aux.unique_sorted (List.concat ktups) in
- Aux.unique_sorted (List.rev_map (guarded_type struc qr) ktups)
+ let mem = Hashtbl.create 63 in
+ Aux.unique_sorted (List.rev_map (guarded_type_memo struc mem qr) ktups)
@@ -172,30 +207,29 @@
| phi -> phi
-let distinguish_by_type ?(how=Guarded) ?(skip_outer_exists=false) ~qr ~k
- sPos sNeg =
+let distinguish_by_type ?(how=Guarded) ?(skip_outer_exists=false)
+ ~qr ~k pos_struc neg_struc =
let types s = match how with
| Guarded -> guarded_types s ~qr ~k
| Types -> ntypes s ~qr ~k in
- let (tpPos, tpNeg) = (List.map types sPos, List.map types sNeg) in
- (*let all_diff vars = Aux.map_some (
- function [x; y] -> if x < y then Some (Not (Eq (x, y))) else None| _ -> None
- ) (Aux.all_ntuples (List.map to_fo vars) 2) in *)
- let fails_neg f = (* check whether f fails on all negative structs *)
- (* let f = And (f :: (all_diff (FormulaSubst.free_vars f))) in *)
- not (List.exists (fun s -> check s [||] f) sNeg) in
- let succ_pos fl = (* check whether disjunction of fl holds on all positives *)
- (* let f = And ((Or fl):: (all_diff (FormulaSubst.free_vars (Or fl)))) in *)
- List.for_all (fun s -> check s [||] (Or fl)) sPos in
- let candidates = List.rev_append (List.concat tpPos)
- (List.map (fun f -> Not f) (List.concat tpNeg)) in
+ let (pos_tp, neg_tp) = (List.map types pos_struc, List.map types neg_struc) in
+ let candidates = List.rev_append (List.concat pos_tp)
+ (List.map (fun f -> Not f) (List.concat neg_tp)) in
+ let fails_neg f = not (List.exists (fun s -> check s [||] f) neg_struc) in
let fail_neg = List.filter fails_neg (Aux.unique_sorted candidates) in
- let phis = List.sort Formula.compare (Aux.unique_sorted fail_neg) in
+ let fail_neg =
+ List.rev_map (fun f -> Formula.flatten_sort (FormulaOps.nnf f)) fail_neg in
+ let tp_lits = function And fl -> List.filter Formula.is_literal fl | _-> [] in
+ let cmp_tp tp1 tp2 =
+ let c = Formula.compare (And (tp_lits tp1)) (And (tp_lits tp2)) in
+ if c <> 0 then c else Formula.compare tp1 tp2 in
+ let fail_neg = Aux.unique_sorted ~cmp:cmp_tp fail_neg in
+ let succ_pos fl = List.for_all (fun s -> check s [||] (Or fl)) pos_struc in
let rec find_type acc = function
| [] -> []
| x :: xs -> if succ_pos (x::acc) then x :: acc else
find_type (x::acc) xs in
- let dtypes = find_type [] phis in
+ let dtypes = find_type [] fail_neg in
if dtypes = [] then None else
let is_ok f = fails_neg f && succ_pos [f] in
let mintp = greedy_remove is_ok (Or dtypes) in
Modified: trunk/Toss/Solver/DistinguishTest.ml
===================================================================
--- trunk/Toss/Solver/DistinguishTest.ml 2011-11-14 15:49:50 UTC (rev 1632)
+++ trunk/Toss/Solver/DistinguishTest.ml 2011-11-16 21:58:12 UTC (rev 1633)
@@ -293,13 +293,10 @@
P..
... ...
...P ...
-\"" in (*"P(x2) and ex x3 (P(x3) and C(x2,x3)) and ex x3 (P(x3) and C(x3,x2))"*)
- formula_eq
- ("C(x0, x1) and ex x2 (P(x2) and R(x2, x0)) and " ^
- "ex x2 (P(x2) and R(x2, x1)) and ex x2 (C(x1, x2) and not P(x2))")
- (Distinguish.distinguish ~skip_outer_exists:true
- [strucP] [strucN1; strucN2; strucN3]);
- assert true;
+\"" in formula_eq
+ "P(x0) and P(x1) and C(x0, x1) and ex x2 (P(x2) and C(x2, x0))"
+ (Distinguish.distinguish ~skip_outer_exists:true
+ [strucP] [strucN1; strucN2; strucN3]);
);
"breakthrough" >::
@@ -339,9 +336,8 @@
... ... ... W..
... ... ... ...
...W ... ... ...
-\"" in (* "W(x2) and all x3 not C(x2, x3)" *)
- (* Distinguish.set_debug_level 1; *)
- formula_eq "W(x0) and R(x0, x1) and all x2 not C(x1, x2)"
+\"" in (* Distinguish.set_debug_level 1; *)
+ formula_eq "W(x1) and all x0 not C(x1, x0)"
(Distinguish.distinguish ~skip_outer_exists:true [struc1] [struc2]);
);
]
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-14 15:49:57
|
Revision: 1632
http://toss.svn.sourceforge.net/toss/?rev=1632&view=rev
Author: lukaszkaiser
Date: 2011-11-14 15:49:50 +0000 (Mon, 14 Nov 2011)
Log Message:
-----------
Correcting a bug in simplify_re, connect4 plays from translation now.
Modified Paths:
--------------
trunk/Toss/Formula/FormulaOps.ml
trunk/Toss/Formula/FormulaOpsTest.ml
trunk/Toss/Formula/FormulaSubst.ml
trunk/Toss/Formula/FormulaSubst.mli
trunk/Toss/Play/HeuristicTest.ml
Modified: trunk/Toss/Formula/FormulaOps.ml
===================================================================
--- trunk/Toss/Formula/FormulaOps.ml 2011-11-13 22:58:16 UTC (rev 1631)
+++ trunk/Toss/Formula/FormulaOps.ml 2011-11-14 15:49:50 UTC (rev 1632)
@@ -278,6 +278,44 @@
(* Simplify. *)
(* ------------------------------------------------------------------------- *)
+let fp_var_subst s (v : [ mso_var | so_var ]) = to_mso_or_so (var_subst s v)
+
+(* Rename quantified variables avoiding the ones from [avs],
+ and the above-quantified ones. Does not go into real_expr. *)
+let rec rename_quant_avoiding avs = function
+ | Rel _ | Eq _ | In _ | SO _ | RealExpr _ as x -> x
+ | Not phi -> Not (rename_quant_avoiding avs phi)
+ | Or flist -> Or (List.map (rename_quant_avoiding avs) flist)
+ | And flist -> And (List.map (rename_quant_avoiding avs) flist)
+ | Ex (vs, phi) ->
+ let (avoidv, okv) = List.partition (fun v -> List.mem v avs) vs in
+ if avoidv = [] then Ex (vs, rename_quant_avoiding (avs @ vs) phi) else
+ let subst = List.map (subst_name_avoiding avs) avoidv in
+ let nvs = okv @ (List.map var_of_string (snd (List.split subst))) in
+ Ex (nvs, subst_vars subst (rename_quant_avoiding (avs @ nvs) phi))
+ | All (vs, phi) ->
+ let (avoidv, okv) = List.partition (fun v -> List.mem v avs) vs in
+ if avoidv = [] then All (vs, rename_quant_avoiding (avs @ vs) phi) else
+ let subst = List.map (subst_name_avoiding avs) avoidv in
+ let nvs = okv @ (List.map var_of_string (snd (List.split subst))) in
+ All (nvs, subst_vars subst (rename_quant_avoiding (avs @ nvs) phi))
+ | Lfp (v, vs, phi) ->
+ let vars = [(v :> var)] in
+ let (avoidv, okv) = List.partition (fun v -> List.mem v avs) vars in
+ if avoidv=[] then Lfp (v, vs, rename_quant_avoiding (avs @ vars) phi) else
+ let subst = List.map (subst_name_avoiding avs) avoidv in
+ let nv = fp_var_subst subst v in
+ Lfp (nv, vs, rename_quant_avoiding ((nv :> var) :: avs) phi)
+ | Gfp (v, vs, phi) ->
+ let vars = [(v :> var)] in
+ let (avoidv, okv) = List.partition (fun v -> List.mem v avs) vars in
+ if avoidv=[] then Gfp (v, vs, rename_quant_avoiding (avs @ vars) phi) else
+ let subst = List.map (subst_name_avoiding avs) avoidv in
+ let nv = fp_var_subst subst v in
+ Gfp (nv, vs, rename_quant_avoiding ((nv :> var) :: avs) phi)
+ | Let _ as phi -> rename_quant_avoiding avs (expand_formula phi)
+
+
let str_contains c s =
try let _ = String.index s c in true with Not_found -> false
@@ -408,23 +446,11 @@
and simplify_re ?(do_pnf=false) ?(do_formula=true) ?(ni=0) = function
| RVar _ | Const _ | Fun _ as atom -> atom
- | Char phi ->
- let name_i = ref ni in
- let namef () = incr name_i; string_of_int !name_i in
- let subst_l l = List.map (fun v -> (var_str v, "fo__cx_" ^ namef())) l in
- let get_fo sl = List.map (fun (_, v) -> var_of_string v) sl in
- let new_phi = match nnf phi with
- | Ex (x, f) when List.for_all is_fo x ->
- let sl = subst_l x in Ex (get_fo sl, subst_vars sl f)
- | All (x, f) when List.for_all is_fo x ->
- let sl = subst_l x in All (get_fo sl, subst_vars sl f)
- | psi ->
- (* {{{ log entry *)
- if !debug_level > 1 then (
- print_endline ("PSi: " ^ (Formula.str psi));
- );
- (* }}} *)
- psi in
+ | Char phi ->
+ let prefix = !FormulaSubst.subst_name_prefix in
+ FormulaSubst.subst_name_prefix := "fo_cx_";
+ let new_phi = rename_quant_avoiding (FormulaSubst.all_vars phi) phi in
+ FormulaSubst.subst_name_prefix := prefix;
if do_formula then
Char (simplify ~do_pnf ~do_re:true ~ni new_phi)
else Char new_phi
@@ -434,12 +460,14 @@
let subst_l = List.map (fun v -> (var_str v, "fo__sx_" ^ namef())) l in
let new_re = subst_vars_expr subst_l re in
let re_simp = simplify_re ~do_pnf ~do_formula ~ni:!name_i new_re in
- let new_phi = subst_vars subst_l phi in
+ let new_phi = flatten_sort (subst_vars subst_l phi) in
let phi_simp =
if do_formula then simplify ~do_pnf ~do_re:true ~ni:!name_i new_phi else
new_phi in
- Sum (List.map (fun (_, v) -> fo_var_of_string v) subst_l,
- phi_simp, re_simp)
+ if new_phi = Or [] then Const 0. else
+ if new_phi = And [] && l = [] then re_simp else
+ Sum (List.map (fun (_, v) -> fo_var_of_string v) subst_l,
+ phi_simp, re_simp)
| Plus _ | Times (Const _, _) | Times (_, Const _) as x ->
let rec get_linear = function
| Plus (p, q) -> List.rev_append (get_linear p) (get_linear q)
@@ -468,7 +496,9 @@
| Times (p, q) ->
let simp_p = simplify_re ~do_pnf ~do_formula ~ni p in
let simp_q = simplify_re ~do_pnf ~do_formula ~ni q in
- if simp_p = p && simp_q = q then Times (p, q) else
+ if size_real simp_p = size_real p && size_real simp_q = size_real q then
+ Times (p, q)
+ else
simplify_re ~do_pnf ~do_formula ~ni (Times (simp_p, simp_q))
| RLet _ as re -> simplify_re ~do_pnf ~do_formula ~ni (expand_real_expr re)
@@ -873,44 +903,6 @@
(* ------------ TNF with variable pushing --------- *)
-let fp_var_subst s (v : [ mso_var | so_var ]) = to_mso_or_so (var_subst s v)
-
-(* Rename quantified variables avoiding the ones from [avs],
- and the above-quantified ones. Does not go into real_expr. *)
-let rec rename_quant_avoiding avs = function
- | Rel _ | Eq _ | In _ | SO _ | RealExpr _ as x -> x
- | Not phi -> Not (rename_quant_avoiding avs phi)
- | Or flist -> Or (List.map (rename_quant_avoiding avs) flist)
- | And flist -> And (List.map (rename_quant_avoiding avs) flist)
- | Ex (vs, phi) ->
- let (avoidv, okv) = List.partition (fun v -> List.mem v avs) vs in
- if avoidv = [] then Ex (vs, rename_quant_avoiding (avs @ vs) phi) else
- let subst = List.map (subst_name_avoiding avs) avoidv in
- let nvs = okv @ (List.map var_of_string (snd (List.split subst))) in
- Ex (nvs, subst_vars subst (rename_quant_avoiding (avs @ nvs) phi))
- | All (vs, phi) ->
- let (avoidv, okv) = List.partition (fun v -> List.mem v avs) vs in
- if avoidv = [] then All (vs, rename_quant_avoiding (avs @ vs) phi) else
- let subst = List.map (subst_name_avoiding avs) avoidv in
- let nvs = okv @ (List.map var_of_string (snd (List.split subst))) in
- All (nvs, subst_vars subst (rename_quant_avoiding (avs @ nvs) phi))
- | Lfp (v, vs, phi) ->
- let vars = [(v :> var)] in
- let (avoidv, okv) = List.partition (fun v -> List.mem v avs) vars in
- if avoidv=[] then Lfp (v, vs, rename_quant_avoiding (avs @ vars) phi) else
- let subst = List.map (subst_name_avoiding avs) avoidv in
- let nv = fp_var_subst subst v in
- Lfp (nv, vs, rename_quant_avoiding ((nv :> var) :: avs) phi)
- | Gfp (v, vs, phi) ->
- let vars = [(v :> var)] in
- let (avoidv, okv) = List.partition (fun v -> List.mem v avs) vars in
- if avoidv=[] then Gfp (v, vs, rename_quant_avoiding (avs @ vars) phi) else
- let subst = List.map (subst_name_avoiding avs) avoidv in
- let nv = fp_var_subst subst v in
- Gfp (nv, vs, rename_quant_avoiding ((nv :> var) :: avs) phi)
- | Let _ as phi -> rename_quant_avoiding avs (expand_formula phi)
-
-
let rec has_mso = function
| In _ -> true
| Rel _ | Eq _ | RealExpr _ | SO _ -> false
Modified: trunk/Toss/Formula/FormulaOpsTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaOpsTest.ml 2011-11-13 22:58:16 UTC (rev 1631)
+++ trunk/Toss/Formula/FormulaOpsTest.ml 2011-11-14 15:49:50 UTC (rev 1632)
@@ -221,6 +221,7 @@
simp_eq ":(ex x R(x)) - :(ex x R(x))" "0";
simp_eq ":(ex x P(x)) - :(ex y P(y))" "0";
simp_eq "Sum (x | P(x) : :f(x)) - Sum (y | P(y) : :f(y))" "0";
+ simp_eq "Sum (x | false : :f(x))" "0";
simp_eq ("Sum (x | P(x) : Sum (y | Q(y) : :f(x)))" ^
"- Sum (y | P(y) : Sum (z | Q(z) : :f(y)))") "0";
);
Modified: trunk/Toss/Formula/FormulaSubst.ml
===================================================================
--- trunk/Toss/Formula/FormulaSubst.ml 2011-11-13 22:58:16 UTC (rev 1631)
+++ trunk/Toss/Formula/FormulaSubst.ml 2011-11-14 15:49:50 UTC (rev 1632)
@@ -17,6 +17,8 @@
let fo_var_subst subst (v : fo_var) = to_fo (var_subst subst v)
let fp_var_subst s (v : [ mso_var | so_var ]) = to_mso_or_so (var_subst s v)
+let subst_name_prefix = ref ""
+
(* Find a substitution for [v] which avoids [avs], string arguments *)
let subst_name_avoiding_str avs var_s =
(* Helper: strip digits from string end if it doesn't start with one.*)
@@ -26,7 +28,8 @@
if Aux.is_digit s.[len-1] then
strip_digits (String.sub s 0 (len-1))
else s in
- let v = strip_digits var_s in
+ let v = if !subst_name_prefix = "" then
+ strip_digits var_s else !subst_name_prefix in
let rec asubst i =
let vi = v ^ (string_of_int i) in
if not (List.mem vi avs) then (var_s, vi) else asubst (i+1) in
Modified: trunk/Toss/Formula/FormulaSubst.mli
===================================================================
--- trunk/Toss/Formula/FormulaSubst.mli 2011-11-13 22:58:16 UTC (rev 1631)
+++ trunk/Toss/Formula/FormulaSubst.mli 2011-11-14 15:49:50 UTC (rev 1632)
@@ -8,6 +8,9 @@
(** Find a substitution for [v] which avoids [avs], string arguments. *)
val subst_name_avoiding_str : string list -> string -> string * string
+(** Prefix for variable name replacements. Default (empty) = derived from var.*)
+val subst_name_prefix: string ref
+
(** Find a substitution for [v] which avoids [avs]. *)
val subst_name_avoiding : [< var] list -> [< var] -> string * string
Modified: trunk/Toss/Play/HeuristicTest.ml
===================================================================
--- trunk/Toss/Play/HeuristicTest.ml 2011-11-13 22:58:16 UTC (rev 1631)
+++ trunk/Toss/Play/HeuristicTest.ml 2011-11-14 15:49:50 UTC (rev 1632)
@@ -347,7 +347,7 @@
~advr:4.0 game in
assert_eq_str
-"100. * (Sum (cell_e_y8__BLANK_, cell_d_y8__BLANK_, cell_c1_y8__BLANK_, cell_b_y8__BLANK_, cell_a_y8__BLANK_ | ((cell_2x(cell_a_y8__BLANK_) or cell_2x(cell_b_y8__BLANK_) or cell_2x(cell_c1_y8__BLANK_) or cell_2x(cell_d_y8__BLANK_) or cell_2x(cell_e_y8__BLANK_)) and (cell_2b(cell_a_y8__BLANK_) or cell_2x(cell_a_y8__BLANK_)) and (cell_2b(cell_b_y8__BLANK_) or cell_2x(cell_b_y8__BLANK_)) and (cell_2b(cell_c1_y8__BLANK_) or cell_2x(cell_c1_y8__BLANK_)) and (cell_2b(cell_d_y8__BLANK_) or cell_2x(cell_d_y8__BLANK_)) and (cell_2b(cell_e_y8__BLANK_) or cell_2x(cell_e_y8__BLANK_)) and coordinate(cell_e_y8__BLANK_) and coordinate(cell_d_y8__BLANK_) and coordinate(cell_c1_y8__BLANK_) and coordinate(cell_b_y8__BLANK_) and coordinate(cell_a_y8__BLANK_) and R2(cell_d_y8__BLANK_, cell_e_y8__BLANK_) and R2(cell_c1_y8__BLANK_, cell_d_y8__BLANK_) and R2(cell_b_y8__BLANK_, cell_c1_y8__BLANK_) and R2(cell_a_y8__BLANK_, cell_b_y8__BLANK_)) : (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * 0.0016 ) + Sum (cell_x18_y14__BLANK_, cell_x17_y15__BLANK_, cell_x16_y16__BLANK_, cell_x15_y17__BLANK_, cell_x14_y18__BLANK_ | ((cell_2x(cell_x14_y18__BLANK_) or cell_2x(cell_x15_y17__BLANK_) or cell_2x(cell_x16_y16__BLANK_) or cell_2x(cell_x17_y15__BLANK_) or cell_2x(cell_x18_y14__BLANK_)) and (cell_2b(cell_x14_y18__BLANK_) or cell_2x(cell_x14_y18__BLANK_)) and (cell_2b(cell_x15_y17__BLANK_) or cell_2x(cell_x15_y17__BLANK_)) and (cell_2b(cell_x16_y16__BLANK_) or cell_2x(cell_x16_y16__BLANK_)) and (cell_2b(cell_x17_y15__BLANK_) or cell_2x(cell_x17_y15__BLANK_)) and (cell_2b(cell_x18_y14__BLANK_) or cell_2x(cell_x18_y14__BLANK_)) and coordinate(cell_x18_y14__BLANK_) and coordinate(cell_x17_y15__BLANK_) and coordinate(cell_x16_y16__BLANK_) and coordinate(cell_x15_y17__BLANK_) and coordinate(cell_x14_y18__BLANK_) and R1(cell_x17_y15__BLANK_, cell_x18_y14__BLANK_) and R1(cell_x16_y16__BLANK_, cell_x17_y15__BLANK_) and R1(cell_x15_y17__BLANK_, cell_x16_y16__BLANK_) and R1(cell_x14_y18__BLANK_, cell_x15_y17__BLANK_)) : (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * 0.0016 ) + Sum (cell_x9_y9__BLANK_, cell_x13_y13__BLANK_, cell_x12_y12__BLANK_, cell_x11_y11__BLANK_, cell_x10_y10__BLANK_ | ((cell_2x(cell_x10_y10__BLANK_) or cell_2x(cell_x11_y11__BLANK_) or cell_2x(cell_x12_y12__BLANK_) or cell_2x(cell_x13_y13__BLANK_) or cell_2x(cell_x9_y9__BLANK_)) and (cell_2b(cell_x10_y10__BLANK_) or cell_2x(cell_x10_y10__BLANK_)) and (cell_2b(cell_x11_y11__BLANK_) or cell_2x(cell_x11_y11__BLANK_)) and (cell_2b(cell_x12_y12__BLANK_) or cell_2x(cell_x12_y12__BLANK_)) and (cell_2b(cell_x13_y13__BLANK_) or cell_2x(cell_x13_y13__BLANK_)) and (cell_2b(cell_x9_y9__BLANK_) or cell_2x(cell_x9_y9__BLANK_)) and coordinate(cell_x9_y9__BLANK_) and coordinate(cell_x13_y13__BLANK_) and coordinate(cell_x12_y12__BLANK_) and coordinate(cell_x11_y11__BLANK_) and coordinate(cell_x10_y10__BLANK_) and R0(cell_x9_y9__BLANK_, cell_x10_y10__BLANK_) and R0(cell_x12_y12__BLANK_, cell_x13_y13__BLANK_) and R0(cell_x11_y11__BLANK_, cell_x12_y12__BLANK_) and R0(cell_x10_y10__BLANK_, cell_x11_y11__BLANK_)) : (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * 0.0016 ) + Sum (cell_x8_e0__BLANK_, cell_x8_d0__BLANK_, cell_x8_c2__BLANK_, cell_x8_b0__BLANK_, cell_x8_a0__BLANK_ | ((cell_2x(cell_x8_a0__BLANK_) or cell_2x(cell_x8_b0__BLANK_) or cell_2x(cell_x8_c2__BLANK_) or cell_2x(cell_x8_d0__BLANK_) or cell_2x(cell_x8_e0__BLANK_)) and (cell_2b(cell_x8_a0__BLANK_) or cell_2x(cell_x8_a0__BLANK_)) and (cell_2b(cell_x8_b0__BLANK_) or cell_2x(cell_x8_b0__BLANK_)) and (cell_2b(cell_x8_c2__BLANK_) or cell_2x(cell_x8_c2__BLANK_)) and (cell_2b(cell_x8_d0__BLANK_) or cell_2x(cell_x8_d0__BLANK_)) and (cell_2b(cell_x8_e0__BLANK_) or cell_2x(cell_x8_e0__BLANK_)) and coordinate(cell_x8_e0__BLANK_) and coordinate(cell_x8_d0__BLANK_) and coordinate(cell_x8_c2__BLANK_) and coordinate(cell_x8_b0__BLANK_) and coordinate(cell_x8_a0__BLANK_) and R(cell_x8_d0__BLANK_, cell_x8_e0__BLANK_) and R(cell_x8_c2__BLANK_, cell_x8_d0__BLANK_) and R(cell_x8_b0__BLANK_, cell_x8_c2__BLANK_) and R(cell_x8_a0__BLANK_, cell_x8_b0__BLANK_)) : (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * 0.0016 )) + 50. * Sum ( | false : 0. * 0. * 0. * 0. * inf)"
+ "100. * (Sum (cell_e_y8__BLANK_, cell_d_y8__BLANK_, cell_c1_y8__BLANK_, cell_b_y8__BLANK_, cell_a_y8__BLANK_ | ((cell_2x(cell_a_y8__BLANK_) or cell_2x(cell_b_y8__BLANK_) or cell_2x(cell_c1_y8__BLANK_) or cell_2x(cell_d_y8__BLANK_) or cell_2x(cell_e_y8__BLANK_)) and (cell_2b(cell_a_y8__BLANK_) or cell_2x(cell_a_y8__BLANK_)) and (cell_2b(cell_b_y8__BLANK_) or cell_2x(cell_b_y8__BLANK_)) and (cell_2b(cell_c1_y8__BLANK_) or cell_2x(cell_c1_y8__BLANK_)) and (cell_2b(cell_d_y8__BLANK_) or cell_2x(cell_d_y8__BLANK_)) and (cell_2b(cell_e_y8__BLANK_) or cell_2x(cell_e_y8__BLANK_)) and R2(cell_d_y8__BLANK_, cell_e_y8__BLANK_) and R2(cell_c1_y8__BLANK_, cell_d_y8__BLANK_) and R2(cell_b_y8__BLANK_, cell_c1_y8__BLANK_) and R2(cell_a_y8__BLANK_, cell_b_y8__BLANK_)) : (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * (:(cell_2x(cell_a_y8__BLANK_)) + :(cell_2x(cell_b_y8__BLANK_)) + :(cell_2x(cell_c1_y8__BLANK_)) + :(cell_2x(cell_d_y8__BLANK_)) + :(cell_2x(cell_e_y8__BLANK_))) * 0.0016 ) + Sum (cell_x18_y14__BLANK_, cell_x17_y15__BLANK_, cell_x16_y16__BLANK_, cell_x15_y17__BLANK_, cell_x14_y18__BLANK_ | ((cell_2x(cell_x14_y18__BLANK_) or cell_2x(cell_x15_y17__BLANK_) or cell_2x(cell_x16_y16__BLANK_) or cell_2x(cell_x17_y15__BLANK_) or cell_2x(cell_x18_y14__BLANK_)) and (cell_2b(cell_x14_y18__BLANK_) or cell_2x(cell_x14_y18__BLANK_)) and (cell_2b(cell_x15_y17__BLANK_) or cell_2x(cell_x15_y17__BLANK_)) and (cell_2b(cell_x16_y16__BLANK_) or cell_2x(cell_x16_y16__BLANK_)) and (cell_2b(cell_x17_y15__BLANK_) or cell_2x(cell_x17_y15__BLANK_)) and (cell_2b(cell_x18_y14__BLANK_) or cell_2x(cell_x18_y14__BLANK_)) and R1(cell_x17_y15__BLANK_, cell_x18_y14__BLANK_) and R1(cell_x16_y16__BLANK_, cell_x17_y15__BLANK_) and R1(cell_x15_y17__BLANK_, cell_x16_y16__BLANK_) and R1(cell_x14_y18__BLANK_, cell_x15_y17__BLANK_)) : (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * (:(cell_2x(cell_x14_y18__BLANK_)) + :(cell_2x(cell_x15_y17__BLANK_)) + :(cell_2x(cell_x16_y16__BLANK_)) + :(cell_2x(cell_x17_y15__BLANK_)) + :(cell_2x(cell_x18_y14__BLANK_))) * 0.0016 ) + Sum (cell_x9_y9__BLANK_, cell_x13_y13__BLANK_, cell_x12_y12__BLANK_, cell_x11_y11__BLANK_, cell_x10_y10__BLANK_ | ((cell_2x(cell_x10_y10__BLANK_) or cell_2x(cell_x11_y11__BLANK_) or cell_2x(cell_x12_y12__BLANK_) or cell_2x(cell_x13_y13__BLANK_) or cell_2x(cell_x9_y9__BLANK_)) and (cell_2b(cell_x10_y10__BLANK_) or cell_2x(cell_x10_y10__BLANK_)) and (cell_2b(cell_x11_y11__BLANK_) or cell_2x(cell_x11_y11__BLANK_)) and (cell_2b(cell_x12_y12__BLANK_) or cell_2x(cell_x12_y12__BLANK_)) and (cell_2b(cell_x13_y13__BLANK_) or cell_2x(cell_x13_y13__BLANK_)) and (cell_2b(cell_x9_y9__BLANK_) or cell_2x(cell_x9_y9__BLANK_)) and R0(cell_x9_y9__BLANK_, cell_x10_y10__BLANK_) and R0(cell_x12_y12__BLANK_, cell_x13_y13__BLANK_) and R0(cell_x11_y11__BLANK_, cell_x12_y12__BLANK_) and R0(cell_x10_y10__BLANK_, cell_x11_y11__BLANK_)) : (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * (:(cell_2x(cell_x10_y10__BLANK_)) + :(cell_2x(cell_x11_y11__BLANK_)) + :(cell_2x(cell_x12_y12__BLANK_)) + :(cell_2x(cell_x13_y13__BLANK_)) + :(cell_2x(cell_x9_y9__BLANK_))) * 0.0016 ) + Sum (cell_x8_e0__BLANK_, cell_x8_d0__BLANK_, cell_x8_c2__BLANK_, cell_x8_b0__BLANK_, cell_x8_a0__BLANK_ | ((cell_2x(cell_x8_a0__BLANK_) or cell_2x(cell_x8_b0__BLANK_) or cell_2x(cell_x8_c2__BLANK_) or cell_2x(cell_x8_d0__BLANK_) or cell_2x(cell_x8_e0__BLANK_)) and (cell_2b(cell_x8_a0__BLANK_) or cell_2x(cell_x8_a0__BLANK_)) and (cell_2b(cell_x8_b0__BLANK_) or cell_2x(cell_x8_b0__BLANK_)) and (cell_2b(cell_x8_c2__BLANK_) or cell_2x(cell_x8_c2__BLANK_)) and (cell_2b(cell_x8_d0__BLANK_) or cell_2x(cell_x8_d0__BLANK_)) and (cell_2b(cell_x8_e0__BLANK_) or cell_2x(cell_x8_e0__BLANK_)) and R(cell_x8_d0__BLANK_, cell_x8_e0__BLANK_) and R(cell_x8_c2__BLANK_, cell_x8_d0__BLANK_) and R(cell_x8_b0__BLANK_, cell_x8_c2__BLANK_) and R(cell_x8_a0__BLANK_, cell_x8_b0__BLANK_)) : (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * (:(cell_2x(cell_x8_a0__BLANK_)) + :(cell_2x(cell_x8_b0__BLANK_)) + :(cell_2x(cell_x8_c2__BLANK_)) + :(cell_2x(cell_x8_d0__BLANK_)) + :(cell_2x(cell_x8_e0__BLANK_))) * 0.0016 )) + 50. * Sum ( | false : 0. * 0. * 0. * 0. * inf)"
(Formula.real_str loc_heurs.(0).(0));
);
@@ -360,7 +360,7 @@
~advr:2.0 game in
assert_eq_str
- "100. * (0.99609375 + 1.9921875 * :( not ex cellholds_x28_y28__BLANK_ (cellholds_2black(cellholds_x28_y28__BLANK_) and index__cellholds_1(cellholds_x28_y28__BLANK_) and index__cellholds_1(cellholds_x28_y28__BLANK_)) ) + Sum (cellholds_x25_8__BLANK_ | (cellholds_2white(cellholds_x25_8__BLANK_) and index__cellholds_1(cellholds_x25_8__BLANK_)) : 0.0078125 + Sum (y | R(y, cellholds_x25_8__BLANK_) : 0.015625 + Sum (y0 | R(y0, y) : 0.03125 + Sum (y1 | R(y1, y0) : 0.0625 + Sum (y2 | R(y2, y1) : 0.125 + Sum (y3 | R(y3, y2) : 0.25 + Sum (y4 | R(y4, y3) : 0.5 + Sum (y5 | R(y5, y4) : 1.))) ) ) ) ) ))"
+ "100. * (0.99609375 + 1.9921875 * :( not ex cellholds_x28_y28__BLANK_ (cellholds_2black(cellholds_x28_y28__BLANK_) and index__cellholds_1(cellholds_x28_y28__BLANK_)) ) + Sum (cellholds_x25_8__BLANK_ | (cellholds_2white(cellholds_x25_8__BLANK_) and index__cellholds_1(cellholds_x25_8__BLANK_)) : 0.0078125 + Sum (y | R(y, cellholds_x25_8__BLANK_) : 0.015625 + Sum (y0 | R(y0, y) : 0.03125 + Sum (y1 | R(y1, y0) : 0.0625 + Sum (y2 | R(y2, y1) : 0.125 + Sum (y3 | R(y3, y2) : 0.25 + Sum (y4 | R(y4, y3) : 0.5 + Sum (y5 | R(y5, y4) : 1.))) ) ) ) ) ))"
(Formula.real_str loc_heurs.(0).(0));
);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-13 22:58:22
|
Revision: 1631
http://toss.svn.sourceforge.net/toss/?rev=1631&view=rev
Author: lukaszkaiser
Date: 2011-11-13 22:58:16 +0000 (Sun, 13 Nov 2011)
Log Message:
-----------
Final tiny GDL translation stack reliability fix.
Modified Paths:
--------------
trunk/Toss/GGP/GDL.ml
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-11-12 23:53:56 UTC (rev 1630)
+++ trunk/Toss/GGP/GDL.ml 2011-11-13 22:58:16 UTC (rev 1631)
@@ -987,9 +987,8 @@
check_timeout "GDL: expand_definitions: fix";
let brs = Aux.concat_map expand_br brs in
let new_n_brs = List.length brs in
- let brs = List.map snd brs in
- if new_n_brs > n_brs && i > 0 then fix new_n_brs brs (i-1)
- else brs in
+ let brs = List.rev (List.rev_map snd brs) in
+ if new_n_brs > n_brs && i > 0 then fix new_n_brs brs (i-1) else brs in
fix (List.length brs) brs 5
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-12 23:54:03
|
Revision: 1630
http://toss.svn.sourceforge.net/toss/?rev=1630&view=rev
Author: lukaszkaiser
Date: 2011-11-12 23:53:56 +0000 (Sat, 12 Nov 2011)
Log Message:
-----------
Make GDL translation more stable for longer runtimes, avoid Aux.product if too big.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/TranslateGameTest.ml
trunk/Toss/Solver/Solver.ml
Removed Paths:
-------------
trunk/Toss/GGP/examples/mastermind448.gdl
trunk/Toss/GGP/examples/uf20-01.cnf.SAT.gdl
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-11-11 22:57:56 UTC (rev 1629)
+++ trunk/Toss/Formula/Aux.ml 2011-11-12 23:53:56 UTC (rev 1630)
@@ -254,16 +254,24 @@
let rec power ?(timeout = fun () -> false) dom img =
List.fold_left (fun sbs v ->
- concat_map (fun e -> if timeout () then raise (Timeout "Aux.power") else
- List.rev (List.rev_map (fun sb -> (v,e)::sb) sbs)) img)
- [[]] (List.rev dom)
+ concat_map (fun e -> List.rev (List.rev_map (fun sb ->
+ if timeout () then raise (Timeout "Aux.power") else (v,e)::sb) sbs)
+ ) img) [[]] (List.rev dom)
-let product ?(timeout = fun () -> false) l =
+
+let product_size l =
+ let size = List.fold_left (fun size subl ->
+ Big_int.mult_int_big_int (List.length subl) size) Big_int.unit_big_int l in
+ try Big_int.int_of_big_int size with _ -> max_int
+
+let product ?upto ?(timeout = fun () -> false) l =
+ let _ = match upto with None -> () | Some n ->
+ let s = product_size l in if s > n then
+ raise (Timeout ("Aux.product: size would be >= "^ (string_of_int s))) in
List.fold_left (fun prod set ->
- concat_map (fun el -> if timeout () then raise (Timeout "Aux.product") else
- List.rev (List.rev_map (fun tup -> el::tup) prod)
- ) set)
- [[]] (List.rev l)
+ concat_map (fun el -> List.rev (List.rev_map (fun tup ->
+ if timeout () then raise (Timeout "Aux.product") else el::tup) prod)
+ ) set) [[]] (List.rev l)
let rec pairs l =
match l with
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-11-11 22:57:56 UTC (rev 1629)
+++ trunk/Toss/Formula/Aux.mli 2011-11-12 23:53:56 UTC (rev 1630)
@@ -159,12 +159,15 @@
val fold_left_try : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
(** [power dom img] generates all functions with domain [dom] and
- image [img], as graphs. *)
+ image [img], as graphs. Tail recursive. *)
val power : ?timeout:(unit -> bool) -> 'a list -> 'b list -> ('a * 'b) list list
-(** Cartesian product of lists. Not tail recursive. *)
-val product : ?timeout:(unit -> bool) -> 'a list list -> 'a list list
+(** Cartesian product of lists. Tail recursive. *)
+val product : ?upto:int -> ?timeout:(unit->bool) -> 'a list list -> 'a list list
+(** Size of the cartesian product of lists; max_int if the size is bigger. *)
+val product_size : 'a list list -> int
+
(** A list of all pairs of elements that preserve the order of
elements from the list. *)
val pairs : 'a list -> ('a * 'a) list
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-11-11 22:57:56 UTC (rev 1629)
+++ trunk/Toss/GGP/GDL.ml 2011-11-12 23:53:56 UTC (rev 1630)
@@ -969,20 +969,22 @@
else (
(* DNF of the negation of [def_brs] disjunction --
[Left]/[Right] switch meaning *)
- let dnf_of_neg = Aux.product ~timeout:!timeout def_brs in
- List.map (fun dnf_br ->
+ let dnf_of_neg = Aux.product ~upto:100100100 ~timeout:!timeout def_brs in
+ List.rev (List.rev_map (fun dnf_br ->
+ check_timeout ~print:false "GDL: expand_definitions: neg_atom: rmap";
let d_neg_body, d_body = Aux.partition_choice dnf_br in
sb, (head, d_body @ r_body, d_neg_body @ r_neg_body)
- ) dnf_of_neg )
+ ) dnf_of_neg) )
with Not_found ->
[sb, (head, r_body, (subst_rel sb atom)::r_neg_body)]) in
let expand_br (head, body, neg_body) =
let init = [[], (head, [], [])] in
- Aux.concat_foldr expand_neg_atom neg_body
- (Aux.concat_foldr expand_pos_atom body init) in
+ let with_pos_body = Aux.concat_foldr expand_pos_atom body init in
+ Aux.concat_foldr expand_neg_atom neg_body with_pos_body in
let rec fix n_brs brs i =
+ check_timeout "GDL: expand_definitions: fix";
let brs = Aux.concat_map expand_br brs in
let new_n_brs = List.length brs in
let brs = List.map snd brs in
@@ -1004,7 +1006,7 @@
let clauses = List.map (fun (_,body,neg_body) ->
List.map (fun a -> pos (atom_of_rel a)) body @
List.map (fun a -> neg (atom_of_rel a)) neg_body) clauses in
- let negated = Aux.product ~timeout:!timeout clauses in
+ let negated = Aux.product ~upto:100100100 ~timeout:!timeout clauses in
(* can raise [Not_found] in case of unsatisfiable "not distinct" *)
let nclause body =
let uniterms, lits =
Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml 2011-11-11 22:57:56 UTC (rev 1629)
+++ trunk/Toss/GGP/TranslateGameTest.ml 2011-11-12 23:53:56 UTC (rev 1630)
@@ -458,10 +458,16 @@
| Aux.Timeout msg -> (false, "Timeout: " ^ msg)
| e -> (false, "Failed: " ^ (Printexc.to_string e))
-let translate_dir_tests dirname timeout =
+let translate_dir_tests dirname from_file timeout =
let is_gdl fn = (String.length fn > 4) &&
String.sub fn ((String.length fn) - 4) 4 = ".gdl" in
let files = List.sort compare (List.filter is_gdl (Aux.list_dir dirname)) in
+ let from_file =
+ try let r = String.rindex from_file '/' in
+ String.sub from_file (r+1) ((String.length from_file)-r-1)
+ with Not_found -> from_file in
+ let files = if from_file = "" then files else
+ List.filter (fun f -> compare f from_file >= 0) files in
let mk_tst fname =
(fname ^ " (" ^ (string_of_int timeout) ^ "s)") >::
(fun () ->
@@ -470,6 +476,7 @@
(fun () -> Unix.gettimeofday() -. start > float (timeout));
let res, msg = translate_file (dirname ^ fname) None in
let t = Unix.gettimeofday() -. start in
+ Gc.compact ();
let final = if res then Printf.sprintf "Suceeded (%f sec.)\n%!" t else
Printf.sprintf "%s (%f sec)\n%!" msg t in
assert_bool final res
@@ -487,16 +494,17 @@
let opts = [
("-v", Arg.Unit (fun () -> set_debug_level 1), "be verbose");
("-d", Arg.Int (fun i -> set_debug_level i), "set debug level");
- ("-f", Arg.String (fun s -> file := s), "process file");
("-t", Arg.String (fun s -> testdir:= s), "run all tests from a directory");
+ ("-f", Arg.String (fun s -> file := s),
+ "process file if no -t; start directory tests from this file if -t given");
("-s", Arg.Int (fun i -> timeout := i), "set timeout for tests (seconds)");
] in
Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
- if !file <> "" then
+ if !file <> "" && !testdir = "" then
print_endline (snd (translate_file !file (Some !timeout)))
else if !testdir <> "" then
Aux.run_test_if_target "TranslateGameTest"
- (translate_dir_tests !testdir !timeout)
+ (translate_dir_tests !testdir !file !timeout)
else exec ()
let _ = Aux.run_if_target "TranslateGameTest" main
Deleted: trunk/Toss/GGP/examples/mastermind448.gdl
===================================================================
--- trunk/Toss/GGP/examples/mastermind448.gdl 2011-11-11 22:57:56 UTC (rev 1629)
+++ trunk/Toss/GGP/examples/mastermind448.gdl 2011-11-12 23:53:56 UTC (rev 1630)
@@ -1,227 +0,0 @@
-;; GDL-II
-;;;;;;;;;;;;;;;;;;;;;; Mastermind 4 4 8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(role random)
-(role player)
-
-(color red)
-(color blue)
-(color green)
-(color pink)
-
-(number 1)
-(number 2)
-(number 3)
-(number 4)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(init (guess 1))
-(init setup)
-(succ 2 1)
-(succ 3 2)
-(succ 4 3)
-(succ 5 4)
-(succ 6 5)
-(succ 7 6)
-(succ 8 7)
-(succ 9 8)
-(succ 10 9)
-(succ 11 10)
-(succ 12 11)
-(succ 13 12)
-
-(<= (next (guess ?g))
- (true (guess ?gp))
- (succ ?g ?gp)
-)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(<= (sees ?r (does ?r ?m))
- (does ?r ?m)
-)
-
-(<= (legal random (set ?n ?c))
- (true (guess ?n))
- (color ?c)
- (true setup)
- (not (true (set ?n ?c2)))
- (color ?c2)
-)
-
-(<= (next (set ?n ?c))
- (or
- (true (set ?n ?c))
- (does random (set ?n ?c))
- )
-)
-
-(<= (legal random noop)
- (not (true setup))
-)
-
-(<= (next setup)
- (or
- (true (guess 1))
- (true (guess 2))
- (true (guess 3))
- )
-)
-
-(<= (legal player noop)
- (true setup)
-)
-
-(<= (legal player (guessColors ?c1 ?c2 ?c3 ?c4))
- (not (true setup))
- (color ?c1)
- (color ?c2)
- (color ?c3)
- (color ?c4)
-)
-
-(<= (sees player (set 1 ?c1))
- (does player (guessColors ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?c1))
-)
-(<= (sees player (set 2 ?c2))
- (does player (guessColors ?c1 ?c2 ?c3 ?c4))
- (true (set 2 ?c2))
-)
-(<= (sees player (set 3 ?c3))
- (does player (guessColors ?c1 ?c2 ?c3 ?c4))
- (true (set 3 ?c3))
-)
-(<= (sees player (set 4 ?c4))
- (does player (guessColors ?c1 ?c2 ?c3 ?c4))
- (true (set 4 ?c4))
-)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(<= terminal
- (true (guess 13))
-)
-
-(<= (sees player won)
- (true won)
-)
-(<= (next won)
- (does player (guessColors ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?c1))
- (true (set 2 ?c2))
- (true (set 3 ?c3))
- (true (set 4 ?c4))
-)
-(<= (next (playerset ?c1 ?c2 ?c3 ?c4))
- (does player (guessColors ?c1 ?c2 ?c3 ?c4))
-)
-
-(<= terminal
- (true won)
-)
-
-(goal random 100)
-
-(<= (goal player 100)
- (true won)
-)
-
-(<= (same ?x ?x)
- (color ?x))
-
-(<= (goal player 75)
- (true (guess 13))
- (true (playerset ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?s1))
- (true (set 2 ?s2))
- (true (set 3 ?s3))
- (true (set 4 ?s4))
- (or
- (and (same ?c1 ?s1) (same ?c2 ?s2) (same ?c3 ?s3) (distinct ?c4 ?s4))
- (and (same ?c1 ?s1) (same ?c2 ?s2) (same ?c4 ?s4) (distinct ?c3 ?s3))
- (and (same ?c1 ?s1) (same ?c3 ?s3) (same ?c4 ?s4) (distinct ?c2 ?s2))
- (and (same ?c2 ?s2) (same ?c3 ?s3) (same ?c4 ?s4) (distinct ?c1 ?s1))
- )
-)
-
-(<= (goal player 50)
- (true (guess 13))
- (true (playerset ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?s1))
- (true (set 2 ?s2))
- (true (set 3 ?s3))
- (true (set 4 ?s4))
- (or
- (and (same ?c1 ?s1) (same ?c2 ?s2) (distinct ?c3 ?s3) (distinct ?c4 ?s4))
- (and (same ?c1 ?s1) (same ?c3 ?s3) (distinct ?c2 ?s2) (distinct ?c4 ?s4))
- (and (same ?c1 ?s1) (same ?c4 ?s4) (distinct ?c2 ?s2) (distinct ?c3 ?s3))
- (and (same ?c2 ?s2) (same ?c3 ?s3) (distinct ?c1 ?s1) (distinct ?c4 ?s4))
- (and (same ?c2 ?s2) (same ?c4 ?s4) (distinct ?c1 ?s1) (distinct ?c3 ?s3))
- (and (same ?c3 ?s3) (same ?c4 ?s4) (distinct ?c1 ?s1) (distinct ?c2 ?s2))
- )
-)
-
-(<= (goal player 25)
- (true (guess 13))
- (true (playerset ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?c1))
- (true (set 2 ?s2))
- (true (set 3 ?s3))
- (true (set 4 ?s4))
- (distinct ?c2 ?s2)
- (distinct ?c3 ?s3)
- (distinct ?c4 ?s4)
-)
-
-(<= (goal player 25)
- (true (guess 13))
- (true (playerset ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?s1))
- (true (set 2 ?c2))
- (true (set 3 ?s3))
- (true (set 4 ?s4))
- (distinct ?c1 ?s1)
- (distinct ?c3 ?s3)
- (distinct ?c4 ?s4)
-)
-
-(<= (goal player 25)
- (true (guess 13))
- (true (playerset ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?s1))
- (true (set 2 ?s2))
- (true (set 3 ?c3))
- (true (set 4 ?s4))
- (distinct ?c2 ?s2)
- (distinct ?c1 ?s1)
- (distinct ?c4 ?s4)
-)
-
-(<= (goal player 25)
- (true (guess 13))
- (true (playerset ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?s1))
- (true (set 2 ?s2))
- (true (set 3 ?s3))
- (true (set 4 ?c4))
- (distinct ?c2 ?s2)
- (distinct ?c3 ?s3)
- (distinct ?c1 ?s1)
-)
-
-(<= (goal player 0)
- (true (guess 13))
- (true (playerset ?c1 ?c2 ?c3 ?c4))
- (true (set 1 ?s1))
- (true (set 2 ?s2))
- (true (set 3 ?s3))
- (true (set 4 ?s4))
- (distinct ?c1 ?s1)
- (distinct ?c2 ?s2)
- (distinct ?c3 ?s3)
- (distinct ?c4 ?s4)
-)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Deleted: trunk/Toss/GGP/examples/uf20-01.cnf.SAT.gdl
===================================================================
--- trunk/Toss/GGP/examples/uf20-01.cnf.SAT.gdl 2011-11-11 22:57:56 UTC (rev 1629)
+++ trunk/Toss/GGP/examples/uf20-01.cnf.SAT.gdl 2011-11-12 23:53:56 UTC (rev 1630)
@@ -1,692 +0,0 @@
-(contains 1 4)
-(contains 1 (not 18))
-(contains 1 19)
-(contains 2 3)
-(contains 2 18)
-(contains 2 (not 5))
-(contains 3 (not 5))
-(contains 3 (not 8))
-(contains 3 (not 15))
-(contains 4 (not 20))
-(contains 4 7)
-(contains 4 (not 16))
-(contains 5 10)
-(contains 5 (not 13))
-(contains 5 (not 7))
-(contains 6 (not 12))
-(contains 6 (not 9))
-(contains 6 17)
-(contains 7 17)
-(contains 7 19)
-(contains 7 5)
-(contains 8 (not 16))
-(contains 8 9)
-(contains 8 15)
-(contains 9 11)
-(contains 9 (not 5))
-(contains 9 (not 14))
-(contains 10 18)
-(contains 10 (not 10))
-(contains 10 13)
-(contains 11 (not 3))
-(contains 11 11)
-(contains 11 12)
-(contains 12 (not 6))
-(contains 12 (not 17))
-(contains 12 (not 8))
-(contains 13 (not 18))
-(contains 13 14)
-(contains 13 1)
-(contains 14 (not 19))
-(contains 14 (not 15))
-(contains 14 10)
-(contains 15 12)
-(contains 15 18)
-(contains 15 (not 19))
-(contains 16 (not 8))
-(contains 16 4)
-(contains 16 7)
-(contains 17 (not 8))
-(contains 17 (not 9))
-(contains 17 4)
-(contains 18 7)
-(contains 18 17)
-(contains 18 (not 15))
-(contains 19 12)
-(contains 19 (not 7))
-(contains 19 (not 14))
-(contains 20 (not 10))
-(contains 20 (not 11))
-(contains 20 8)
-(contains 21 2)
-(contains 21 (not 15))
-(contains 21 (not 11))
-(contains 22 9)
-(contains 22 6)
-(contains 22 1)
-(contains 23 (not 11))
-(contains 23 20)
-(contains 23 (not 17))
-(contains 24 9)
-(contains 24 (not 15))
-(contains 24 13)
-(contains 25 12)
-(contains 25 (not 7))
-(contains 25 (not 17))
-(contains 26 (not 18))
-(contains 26 (not 2))
-(contains 26 20)
-(contains 27 20)
-(contains 27 12)
-(contains 27 4)
-(contains 28 19)
-(contains 28 11)
-(contains 28 14)
-(contains 29 (not 16))
-(contains 29 18)
-(contains 29 (not 4))
-(contains 30 (not 1))
-(contains 30 (not 17))
-(contains 30 (not 19))
-(contains 31 (not 13))
-(contains 31 15)
-(contains 31 10)
-(contains 32 (not 12))
-(contains 32 (not 14))
-(contains 32 (not 13))
-(contains 33 12)
-(contains 33 (not 14))
-(contains 33 (not 7))
-(contains 34 (not 7))
-(contains 34 16)
-(contains 34 10)
-(contains 35 6)
-(contains 35 10)
-(contains 35 7)
-(contains 36 20)
-(contains 36 14)
-(contains 36 (not 16))
-(contains 37 (not 19))
-(contains 37 17)
-(contains 37 11)
-(contains 38 (not 7))
-(contains 38 1)
-(contains 38 (not 20))
-(contains 39 (not 5))
-(contains 39 12)
-(contains 39 15)
-(contains 40 (not 4))
-(contains 40 (not 9))
-(contains 40 (not 13))
-(contains 41 12)
-(contains 41 (not 11))
-(contains 41 (not 7))
-(contains 42 (not 5))
-(contains 42 19)
-(contains 42 (not 8))
-(contains 43 1)
-(contains 43 16)
-(contains 43 17)
-(contains 44 20)
-(contains 44 (not 14))
-(contains 44 (not 15))
-(contains 45 13)
-(contains 45 (not 4))
-(contains 45 10)
-(contains 46 14)
-(contains 46 7)
-(contains 46 10)
-(contains 47 (not 5))
-(contains 47 9)
-(contains 47 20)
-(contains 48 10)
-(contains 48 1)
-(contains 48 (not 19))
-(contains 49 (not 16))
-(contains 49 (not 15))
-(contains 49 (not 1))
-(contains 50 16)
-(contains 50 3)
-(contains 50 (not 11))
-(contains 51 (not 15))
-(contains 51 (not 10))
-(contains 51 4)
-(contains 52 4)
-(contains 52 (not 15))
-(contains 52 (not 3))
-(contains 53 (not 10))
-(contains 53 (not 16))
-(contains 53 11)
-(contains 54 (not 8))
-(contains 54 12)
-(contains 54 (not 5))
-(contains 55 14)
-(contains 55 (not 6))
-(contains 55 12)
-(contains 56 1)
-(contains 56 6)
-(contains 56 11)
-(contains 57 (not 13))
-(contains 57 (not 5))
-(contains 57 (not 1))
-(contains 58 (not 7))
-(contains 58 (not 2))
-(contains 58 12)
-(contains 59 1)
-(contains 59 (not 20))
-(contains 59 19)
-(contains 60 (not 2))
-(contains 60 (not 13))
-(contains 60 (not 8))
-(contains 61 15)
-(contains 61 18)
-(contains 61 4)
-(contains 62 (not 11))
-(contains 62 14)
-(contains 62 9)
-(contains 63 (not 6))
-(contains 63 (not 15))
-(contains 63 (not 2))
-(contains 64 5)
-(contains 64 (not 12))
-(contains 64 (not 15))
-(contains 65 (not 6))
-(contains 65 17)
-(contains 65 5)
-(contains 66 (not 13))
-(contains 66 5)
-(contains 66 (not 19))
-(contains 67 20)
-(contains 67 (not 1))
-(contains 67 14)
-(contains 68 9)
-(contains 68 (not 17))
-(contains 68 15)
-(contains 69 (not 5))
-(contains 69 19)
-(contains 69 (not 18))
-(contains 70 (not 12))
-(contains 70 8)
-(contains 70 (not 10))
-(contains 71 (not 18))
-(contains 71 14)
-(contains 71 (not 4))
-(contains 72 15)
-(contains 72 (not 9))
-(contains 72 13)
-(contains 73 9)
-(contains 73 (not 5))
-(contains 73 (not 1))
-(contains 74 10)
-(contains 74 (not 19))
-(contains 74 (not 14))
-(contains 75 20)
-(contains 75 9)
-(contains 75 4)
-(contains 76 (not 9))
-(contains 76 (not 2))
-(contains 76 19)
-(contains 77 (not 5))
-(contains 77 13)
-(contains 77 (not 17))
-(contains 78 2)
-(contains 78 (not 10))
-(contains 78 (not 18))
-(contains 79 (not 18))
-(contains 79 3)
-(contains 79 11)
-(contains 80 7)
-(contains 80 (not 9))
-(contains 80 17)
-(contains 81 (not 15))
-(contains 81 (not 6))
-(contains 81 (not 3))
-(contains 82 (not 2))
-(contains 82 3)
-(contains 82 (not 13))
-(contains 83 12)
-(contains 83 3)
-(contains 83 (not 2))
-(contains 84 (not 2))
-(contains 84 (not 3))
-(contains 84 17)
-(contains 85 20)
-(contains 85 (not 15))
-(contains 85 (not 16))
-(contains 86 (not 5))
-(contains 86 (not 17))
-(contains 86 (not 19))
-(contains 87 (not 20))
-(contains 87 (not 18))
-(contains 87 11)
-(contains 88 (not 9))
-(contains 88 1)
-(contains 88 (not 5))
-(contains 89 (not 19))
-(contains 89 9)
-(contains 89 17)
-(contains 90 12)
-(contains 90 (not 2))
-(contains 90 17)
-(contains 91 4)
-(contains 91 (not 16))
-(contains 91 (not 5))
-(prop_var 1)
-(prop_var 2)
-(prop_var 3)
-(prop_var 4)
-(prop_var 5)
-(prop_var 6)
-(prop_var 7)
-(prop_var 8)
-(prop_var 9)
-(prop_var 10)
-(prop_var 11)
-(prop_var 12)
-(prop_var 13)
-(prop_var 14)
-(prop_var 15)
-(prop_var 16)
-(prop_var 17)
-(prop_var 18)
-(prop_var 19)
-(prop_var 20)
-(clause 1)
-(clause 2)
-(clause 3)
-(clause 4)
-(clause 5)
-(clause 6)
-(clause 7)
-(clause 8)
-(clause 9)
-(clause 10)
-(clause 11)
-(clause 12)
-(clause 13)
-(clause 14)
-(clause 15)
-(clause 16)
-(clause 17)
-(clause 18)
-(clause 19)
-(clause 20)
-(clause 21)
-(clause 22)
-(clause 23)
-(clause 24)
-(clause 25)
-(clause 26)
-(clause 27)
-(clause 28)
-(clause 29)
-(clause 30)
-(clause 31)
-(clause 32)
-(clause 33)
-(clause 34)
-(clause 35)
-(clause 36)
-(clause 37)
-(clause 38)
-(clause 39)
-(clause 40)
-(clause 41)
-(clause 42)
-(clause 43)
-(clause 44)
-(clause 45)
-(clause 46)
-(clause 47)
-(clause 48)
-(clause 49)
-(clause 50)
-(clause 51)
-(clause 52)
-(clause 53)
-(clause 54)
-(clause 55)
-(clause 56)
-(clause 57)
-(clause 58)
-(clause 59)
-(clause 60)
-(clause 61)
-(clause 62)
-(clause 63)
-(clause 64)
-(clause 65)
-(clause 66)
-(clause 67)
-(clause 68)
-(clause 69)
-(clause 70)
-(clause 71)
-(clause 72)
-(clause 73)
-(clause 74)
-(clause 75)
-(clause 76)
-(clause 77)
-(clause 78)
-(clause 79)
-(clause 80)
-(clause 81)
-(clause 82)
-(clause 83)
-(clause 84)
-(clause 85)
-(clause 86)
-(clause 87)
-(clause 88)
-(clause 89)
-(clause 90)
-(clause 91)
-(role exists)
-(truth_value t)
-(truth_value f)
-(init (control exists 1))
-(<= (legal ?v17219 (assign ?v17229 ?v17230)) (true (control ?v17219 ?v17229)) (role ?v17219) (prop_var ?v17229) (truth_value ?v17230))
-(<= (legal exists noop) (true (control forall ?v17265)) (prop_var ?v17265))
-(<= (legal forall noop) (true (control exists ?v17265)) (prop_var ?v17265))
-(<= (next (sat ?v17289)) (true (sat ?v17289)) (clause ?v17289))
-(<= (next (control exists 2)) (true (control exists 1)))
-(<= (next (control exists 3)) (true (control exists 2)))
-(<= (next (control exists 4)) (true (control exists 3)))
-(<= (next (control exists 5)) (true (control exists 4)))
-(<= (next (control exists 6)) (true (control exists 5)))
-(<= (next (control exists 7)) (true (control exists 6)))
-(<= (next (control exists 8)) (true (control exists 7)))
-(<= (next (control exists 9)) (true (control exists 8)))
-(<= (next (control exists 10)) (true (control exists 9)))
-(<= (next (control exists 11)) (true (control exists 10)))
-(<= (next (control exists 12)) (true (control exists 11)))
-(<= (next (control exists 13)) (true (control exists 12)))
-(<= (next (control exists 14)) (true (control exists 13)))
-(<= (next (control exists 15)) (true (control exists 14)))
-(<= (next (control exists 16)) (true (control exists 15)))
-(<= (next (control exists 17)) (true (control exists 16)))
-(<= (next (control exists 18)) (true (control exists 17)))
-(<= (next (control exists 19)) (true (control exists 18)))
-(<= (next (control exists 20)) (true (control exists 19)))
-(<= (next (control the end)) (true (control exists 20)))
-(<= (next (sat 1)) (does ?v18107 (assign 4 t)) (role ?v18107))
-(<= (next (sat 1)) (does ?v18128 (assign 18 f)) (role ?v18128))
-(<= (next (sat 1)) (does ?v18149 (assign 19 t)) (role ?v18149))
-(<= (next (sat 2)) (does ?v18172 (assign 3 t)) (role ?v18172))
-(<= (next (sat 2)) (does ?v18193 (assign 18 t)) (role ?v18193))
-(<= (next (sat 2)) (does ?v18214 (assign 5 f)) (role ?v18214))
-(<= (next (sat 3)) (does ?v18237 (assign 5 f)) (role ?v18237))
-(<= (next (sat 3)) (does ?v18258 (assign 8 f)) (role ?v18258))
-(<= (next (sat 3)) (does ?v18279 (assign 15 f)) (role ?v18279))
-(<= (next (sat 4)) (does ?v18302 (assign 20 f)) (role ?v18302))
-(<= (next (sat 4)) (does ?v18323 (assign 7 t)) (role ?v18323))
-(<= (next (sat 4)) (does ?v18344 (assign 16 f)) (role ?v18344))
-(<= (next (sat 5)) (does ?v18367 (assign 10 t)) (role ?v18367))
-(<= (next (sat 5)) (does ?v18388 (assign 13 f)) (role ?v18388))
-(<= (next (sat 5)) (does ?v18409 (assign 7 f)) (role ?v18409))
-(<= (next (sat 6)) (does ?v18432 (assign 12 f)) (role ?v18432))
-(<= (next (sat 6)) (does ?v18453 (assign 9 f)) (role ?v18453))
-(<= (next (sat 6)) (does ?v18474 (assign 17 t)) (role ?v18474))
-(<= (next (sat 7)) (does ?v18497 (assign 17 t)) (role ?v18497))
-(<= (next (sat 7)) (does ?v18518 (assign 19 t)) (role ?v18518))
-(<= (next (sat 7)) (does ?v18539 (assign 5 t)) (role ?v18539))
-(<= (next (sat 8)) (does ?v18562 (assign 16 f)) (role ?v18562))
-(<= (next (sat 8)) (does ?v18583 (assign 9 t)) (role ?v18583))
-(<= (next (sat 8)) (does ?v18604 (assign 15 t)) (role ?v18604))
-(<= (next (sat 9)) (does ?v18627 (assign 11 t)) (role ?v18627))
-(<= (next (sat 9)) (does ?v18648 (assign 5 f)) (role ?v18648))
-(<= (next (sat 9)) (does ?v18669 (assign 14 f)) (role ?v18669))
-(<= (next (sat 10)) (does ?v18692 (assign 18 t)) (role ?v18692))
-(<= (next (sat 10)) (does ?v18713 (assign 10 f)) (role ?v18713))
-(<= (next (sat 10)) (does ?v18734 (assign 13 t)) (role ?v18734))
-(<= (next (sat 11)) (does ?v18757 (assign 3 f)) (role ?v18757))
-(<= (next (sat 11)) (does ?v18778 (assign 11 t)) (role ?v18778))
-(<= (next (sat 11)) (does ?v18799 (assign 12 t)) (role ?v18799))
-(<= (next (sat 12)) (does ?v18822 (assign 6 f)) (role ?v18822))
-(<= (next (sat 12)) (does ?v18843 (assign 17 f)) (role ?v18843))
-(<= (next (sat 12)) (does ?v18864 (assign 8 f)) (role ?v18864))
-(<= (next (sat 13)) (does ?v18887 (assign 18 f)) (role ?v18887))
-(<= (next (sat 13)) (does ?v18908 (assign 14 t)) (role ?v18908))
-(<= (next (sat 13)) (does ?v18929 (assign 1 t)) (role ?v18929))
-(<= (next (sat 14)) (does ?v18952 (assign 19 f)) (role ?v18952))
-(<= (next (sat 14)) (does ?v18973 (assign 15 f)) (role ?v18973))
-(<= (next (sat 14)) (does ?v18994 (assign 10 t)) (role ?v18994))
-(<= (next (sat 15)) (does ?v19017 (assign 12 t)) (role ?v19017))
-(<= (next (sat 15)) (does ?v19038 (assign 18 t)) (role ?v19038))
-(<= (next (sat 15)) (does ?v19059 (assign 19 f)) (role ?v19059))
-(<= (next (sat 16)) (does ?v19082 (assign 8 f)) (role ?v19082))
-(<= (next (sat 16)) (does ?v19103 (assign 4 t)) (role ?v19103))
-(<= (next (sat 16)) (does ?v19124 (assign 7 t)) (role ?v19124))
-(<= (next (sat 17)) (does ?v19147 (assign 8 f)) (role ?v19147))
-(<= (next (sat 17)) (does ?v19168 (assign 9 f)) (role ?v19168))
-(<= (next (sat 17)) (does ?v19189 (assign 4 t)) (role ?v19189))
-(<= (next (sat 18)) (does ?v19212 (assign 7 t)) (role ?v19212))
-(<= (next (sat 18)) (does ?v19233 (assign 17 t)) (role ?v19233))
-(<= (next (sat 18)) (does ?v19254 (assign 15 f)) (role ?v19254))
-(<= (next (sat 19)) (does ?v19277 (assign 12 t)) (role ?v19277))
-(<= (next (sat 19)) (does ?v19298 (assign 7 f)) (role ?v19298))
-(<= (next (sat 19)) (does ?v19319 (assign 14 f)) (role ?v19319))
-(<= (next (sat 20)) (does ?v19342 (assign 10 f)) (role ?v19342))
-(<= (next (sat 20)) (does ?v19363 (assign 11 f)) (role ?v19363))
-(<= (next (sat 20)) (does ?v19384 (assign 8 t)) (role ?v19384))
-(<= (next (sat 21)) (does ?v19407 (assign 2 t)) (role ?v19407))
-(<= (next (sat 21)) (does ?v19428 (assign 15 f)) (role ?v19428))
-(<= (next (sat 21)) (does ?v19449 (assign 11 f)) (role ?v19449))
-(<= (next (sat 22)) (does ?v19472 (assign 9 t)) (role ?v19472))
-(<= (next (sat 22)) (does ?v19493 (assign 6 t)) (role ?v19493))
-(<= (next (sat 22)) (does ?v19514 (assign 1 t)) (role ?v19514))
-(<= (next (sat 23)) (does ?v19537 (assign 11 f)) (role ?v19537))
-(<= (next (sat 23)) (does ?v19558 (assign 20 t)) (role ?v19558))
-(<= (next (sat 23)) (does ?v19579 (assign 17 f)) (role ?v19579))
-(<= (next (sat 24)) (does ?v19602 (assign 9 t)) (role ?v19602))
-(<= (next (sat 24)) (does ?v19623 (assign 15 f)) (role ?v19623))
-(<= (next (sat 24)) (does ?v19644 (assign 13 t)) (role ?v19644))
-(<= (next (sat 25)) (does ?v19667 (assign 12 t)) (role ?v19667))
-(<= (next (sat 25)) (does ?v19688 (assign 7 f)) (role ?v19688))
-(<= (next (sat 25)) (does ?v19709 (assign 17 f)) (role ?v19709))
-(<= (next (sat 26)) (does ?v19732 (assign 18 f)) (role ?v19732))
-(<= (next (sat 26)) (does ?v19753 (assign 2 f)) (role ?v19753))
-(<= (next (sat 26)) (does ?v19774 (assign 20 t)) (role ?v19774))
-(<= (next (sat 27)) (does ?v19797 (assign 20 t)) (role ?v19797))
-(<= (next (sat 27)) (does ?v19818 (assign 12 t)) (role ?v19818))
-(<= (next (sat 27)) (does ?v19839 (assign 4 t)) (role ?v19839))
-(<= (next (sat 28)) (does ?v19862 (assign 19 t)) (role ?v19862))
-(<= (next (sat 28)) (does ?v19883 (assign 11 t)) (role ?v19883))
-(<= (next (sat 28)) (does ?v19904 (assign 14 t)) (role ?v19904))
-(<= (next (sat 29)) (does ?v19927 (assign 16 f)) (role ?v19927))
-(<= (next (sat 29)) (does ?v19948 (assign 18 t)) (role ?v19948))
-(<= (next (sat 29)) (does ?v19969 (assign 4 f)) (role ?v19969))
-(<= (next (sat 30)) (does ?v19992 (assign 1 f)) (role ?v19992))
-(<= (next (sat 30)) (does ?v20013 (assign 17 f)) (role ?v20013))
-(<= (next (sat 30)) (does ?v20034 (assign 19 f)) (role ?v20034))
-(<= (next (sat 31)) (does ?v20057 (assign 13 f)) (role ?v20057))
-(<= (next (sat 31)) (does ?v20078 (assign 15 t)) (role ?v20078))
-(<= (next (sat 31)) (does ?v20099 (assign 10 t)) (role ?v20099))
-(<= (next (sat 32)) (does ?v20122 (assign 12 f)) (role ?v20122))
-(<= (next (sat 32)) (does ?v20143 (assign 14 f)) (role ?v20143))
-(<= (next (sat 32)) (does ?v20164 (assign 13 f)) (role ?v20164))
-(<= (next (sat 33)) (does ?v20187 (assign 12 t)) (role ?v20187))
-(<= (next (sat 33)) (does ?v20208 (assign 14 f)) (role ?v20208))
-(<= (next (sat 33)) (does ?v20229 (assign 7 f)) (role ?v20229))
-(<= (next (sat 34)) (does ?v20252 (assign 7 f)) (role ?v20252))
-(<= (next (sat 34)) (does ?v20273 (assign 16 t)) (role ?v20273))
-(<= (next (sat 34)) (does ?v20294 (assign 10 t)) (role ?v20294))
-(<= (next (sat 35)) (does ?v20317 (assign 6 t)) (role ?v20317))
-(<= (next (sat 35)) (does ?v20338 (assign 10 t)) (role ?v20338))
-(<= (next (sat 35)) (does ?v20359 (assign 7 t)) (role ?v20359))
-(<= (next (sat 36)) (does ?v20382 (assign 20 t)) (role ?v20382))
-(<= (next (sat 36)) (does ?v20403 (assign 14 t)) (role ?v20403))
-(<= (next (sat 36)) (does ?v20424 (assign 16 f)) (role ?v20424))
-(<= (next (sat 37)) (does ?v20447 (assign 19 f)) (role ?v20447))
-(<= (next (sat 37)) (does ?v20468 (assign 17 t)) (role ?v20468))
-(<= (next (sat 37)) (does ?v20489 (assign 11 t)) (role ?v20489))
-(<= (next (sat 38)) (does ?v20512 (assign 7 f)) (role ?v20512))
-(<= (next (sat 38)) (does ?v20533 (assign 1 t)) (role ?v20533))
-(<= (next (sat 38)) (does ?v20554 (assign 20 f)) (role ?v20554))
-(<= (next (sat 39)) (does ?v20577 (assign 5 f)) (role ?v20577))
-(<= (next (sat 39)) (does ?v20598 (assign 12 t)) (role ?v20598))
-(<= (next (sat 39)) (does ?v20619 (assign 15 t)) (role ?v20619))
-(<= (next (sat 40)) (does ?v20642 (assign 4 f)) (role ?v20642))
-(<= (next (sat 40)) (does ?v20663 (assign 9 f)) (role ?v20663))
-(<= (next (sat 40)) (does ?v20684 (assign 13 f)) (role ?v20684))
-(<= (next (sat 41)) (does ?v20707 (assign 12 t)) (role ?v20707))
-(<= (next (sat 41)) (does ?v20728 (assign 11 f)) (role ?v20728))
-(<= (next (sat 41)) (does ?v20749 (assign 7 f)) (role ?v20749))
-(<= (next (sat 42)) (does ?v20772 (assign 5 f)) (role ?v20772))
-(<= (next (sat 42)) (does ?v20793 (assign 19 t)) (role ?v20793))
-(<= (next (sat 42)) (does ?v20814 (assign 8 f)) (role ?v20814))
-(<= (next (sat 43)) (does ?v20837 (assign 1 t)) (role ?v20837))
-(<= (next (sat 43)) (does ?v20858 (assign 16 t)) (role ?v20858))
-(<= (next (sat 43)) (does ?v20879 (assign 17 t)) (role ?v20879))
-(<= (next (sat 44)) (does ?v20902 (assign 20 t)) (role ?v20902))
-(<= (next (sat 44)) (does ?v20923 (assign 14 f)) (role ?v20923))
-(<= (next (sat 44)) (does ?v20944 (assign 15 f)) (role ?v20944))
-(<= (next (sat 45)) (does ?v20967 (assign 13 t)) (role ?v20967))
-(<= (next (sat 45)) (does ?v20988 (assign 4 f)) (role ?v20988))
-(<= (next (sat 45)) (does ?v21009 (assign 10 t)) (role ?v21009))
-(<= (next (sat 46)) (does ?v21032 (assign 14 t)) (role ?v21032))
-(<= (next (sat 46)) (does ?v21053 (assign 7 t)) (role ?v21053))
-(<= (next (sat 46)) (does ?v21074 (assign 10 t)) (role ?v21074))
-(<= (next (sat 47)) (does ?v21097 (assign 5 f)) (role ?v21097))
-(<= (next (sat 47)) (does ?v21118 (assign 9 t)) (role ?v21118))
-(<= (next (sat 47)) (does ?v21139 (assign 20 t)) (role ?v21139))
-(<= (next (sat 48)) (does ?v21162 (assign 10 t)) (role ?v21162))
-(<= (next (sat 48)) (does ?v21183 (assign 1 t)) (role ?v21183))
-(<= (next (sat 48)) (does ?v21204 (assign 19 f)) (role ?v21204))
-(<= (next (sat 49)) (does ?v21227 (assign 16 f)) (role ?v21227))
-(<= (next (sat 49)) (does ?v21248 (assign 15 f)) (role ?v21248))
-(<= (next (sat 49)) (does ?v21269 (assign 1 f)) (role ?v21269))
-(<= (next (sat 50)) (does ?v21292 (assign 16 t)) (role ?v21292))
-(<= (next (sat 50)) (does ?v21313 (assign 3 t)) (role ?v21313))
-(<= (next (sat 50)) (does ?v21334 (assign 11 f)) (role ?v21334))
-(<= (next (sat 51)) (does ?v21357 (assign 15 f)) (role ?v21357))
-(<= (next (sat 51)) (does ?v21378 (assign 10 f)) (role ?v21378))
-(<= (next (sat 51)) (does ?v21399 (assign 4 t)) (role ?v21399))
-(<= (next (sat 52)) (does ?v21422 (assign 4 t)) (role ?v21422))
-(<= (next (sat 52)) (does ?v21443 (assign 15 f)) (role ?v21443))
-(<= (next (sat 52)) (does ?v21464 (assign 3 f)) (role ?v21464))
-(<= (next (sat 53)) (does ?v21487 (assign 10 f)) (role ?v21487))
-(<= (next (sat 53)) (does ?v21508 (assign 16 f)) (role ?v21508))
-(<= (next (sat 53)) (does ?v21529 (assign 11 t)) (role ?v21529))
-(<= (next (sat 54)) (does ?v21552 (assign 8 f)) (role ?v21552))
-(<= (next (sat 54)) (does ?v21573 (assign 12 t)) (role ?v21573))
-(<= (next (sat 54)) (does ?v21594 (assign 5 f)) (role ?v21594))
-(<= (next (sat 55)) (does ?v21617 (assign 14 t)) (role ?v21617))
-(<= (next (sat 55)) (does ?v21638 (assign 6 f)) (role ?v21638))
-(<= (next (sat 55)) (does ?v21659 (assign 12 t)) (role ?v21659))
-(<= (next (sat 56)) (does ?v21682 (assign 1 t)) (role ?v21682))
-(<= (next (sat 56)) (does ?v21703 (assign 6 t)) (role ?v21703))
-(<= (next (sat 56)) (does ?v21724 (assign 11 t)) (role ?v21724))
-(<= (next (sat 57)) (does ?v21747 (assign 13 f)) (role ?v21747))
-(<= (next (sat 57)) (does ?v21768 (assign 5 f)) (role ?v21768))
-(<= (next (sat 57)) (does ?v21789 (assign 1 f)) (role ?v21789))
-(<= (next (sat 58)) (does ?v21812 (assign 7 f)) (role ?v21812))
-(<= (next (sat 58)) (does ?v21833 (assign 2 f)) (role ?v21833))
-(<= (next (sat 58)) (does ?v21854 (assign 12 t)) (role ?v21854))
-(<= (next (sat 59)) (does ?v21877 (assign 1 t)) (role ?v21877))
-(<= (next (sat 59)) (does ?v21898 (assign 20 f)) (role ?v21898))
-(<= (next (sat 59)) (does ?v21919 (assign 19 t)) (role ?v21919))
-(<= (next (sat 60)) (does ?v21942 (assign 2 f)) (role ?v21942))
-(<= (next (sat 60)) (does ?v21963 (assign 13 f)) (role ?v21963))
-(<= (next (sat 60)) (does ?v21984 (assign 8 f)) (role ?v21984))
-(<= (next (sat 61)) (does ?v22007 (assign 15 t)) (role ?v22007))
-(<= (next (sat 61)) (does ?v22028 (assign 18 t)) (role ?v22028))
-(<= (next (sat 61)) (does ?v22049 (assign 4 t)) (role ?v22049))
-(<= (next (sat 62)) (does ?v22072 (assign 11 f)) (role ?v22072))
-(<= (next (sat 62)) (does ?v22093 (assign 14 t)) (role ?v22093))
-(<= (next (sat 62)) (does ?v22114 (assign 9 t)) (role ?v22114))
-(<= (next (sat 63)) (does ?v22137 (assign 6 f)) (role ?v22137))
-(<= (next (sat 63)) (does ?v22158 (assign 15 f)) (role ?v22158))
-(<= (next (sat 63)) (does ?v22179 (assign 2 f)) (role ?v22179))
-(<= (next (sat 64)) (does ?v22202 (assign 5 t)) (role ?v22202))
-(<= (next (sat 64)) (does ?v22223 (assign 12 f)) (role ?v22223))
-(<= (next (sat 64)) (does ?v22244 (assign 15 f)) (role ?v22244))
-(<= (next (sat 65)) (does ?v22267 (assign 6 f)) (role ?v22267))
-(<= (next (sat 65)) (does ?v22288 (assign 17 t)) (role ?v22288))
-(<= (next (sat 65)) (does ?v22309 (assign 5 t)) (role ?v22309))
-(<= (next (sat 66)) (does ?v22332 (assign 13 f)) (role ?v22332))
-(<= (next (sat 66)) (does ?v22353 (assign 5 t)) (role ?v22353))
-(<= (next (sat 66)) (does ?v22374 (assign 19 f)) (role ?v22374))
-(<= (next (sat 67)) (does ?v22397 (assign 20 t)) (role ?v22397))
-(<= (next (sat 67)) (does ?v22418 (assign 1 f)) (role ?v22418))
-(<= (next (sat 67)) (does ?v22439 (assign 14 t)) (role ?v22439))
-(<= (next (sat 68)) (does ?v22462 (assign 9 t)) (role ?v22462))
-(<= (next (sat 68)) (does ?v22483 (assign 17 f)) (role ?v22483))
-(<= (next (sat 68)) (does ?v22504 (assign 15 t)) (role ?v22504))
-(<= (next (sat 69)) (does ?v22527 (assign 5 f)) (role ?v22527))
-(<= (next (sat 69)) (does ?v22548 (assign 19 t)) (role ?v22548))
-(<= (next (sat 69)) (does ?v22569 (assign 18 f)) (role ?v22569))
-(<= (next (sat 70)) (does ?v22592 (assign 12 f)) (role ?v22592))
-(<= (next (sat 70)) (does ?v22613 (assign 8 t)) (role ?v22613))
-(<= (next (sat 70)) (does ?v22634 (assign 10 f)) (role ?v22634))
-(<= (next (sat 71)) (does ?v22657 (assign 18 f)) (role ?v22657))
-(<= (next (sat 71)) (does ?v22678 (assign 14 t)) (role ?v22678))
-(<= (next (sat 71)) (does ?v22699 (assign 4 f)) (role ?v22699))
-(<= (next (sat 72)) (does ?v22722 (assign 15 t)) (role ?v22722))
-(<= (next (sat 72)) (does ?v22743 (assign 9 f)) (role ?v22743))
-(<= (next (sat 72)) (does ?v22764 (assign 13 t)) (role ?v22764))
-(<= (next (sat 73)) (does ?v22787 (assign 9 t)) (role ?v22787))
-(<= (next (sat 73)) (does ?v22808 (assign 5 f)) (role ?v22808))
-(<= (next (sat 73)) (does ?v22829 (assign 1 f)) (role ?v22829))
-(<= (next (sat 74)) (does ?v22852 (assign 10 t)) (role ?v22852))
-(<= (next (sat 74)) (does ?v22873 (assign 19 f)) (role ?v22873))
-(<= (next (sat 74)) (does ?v22894 (assign 14 f)) (role ?v22894))
-(<= (next (sat 75)) (does ?v22917 (assign 20 t)) (role ?v22917))
-(<= (next (sat 75)) (does ?v22938 (assign 9 t)) (role ?v22938))
-(<= (next (sat 75)) (does ?v22959 (assign 4 t)) (role ?v22959))
-(<= (next (sat 76)) (does ?v22982 (assign 9 f)) (role ?v22982))
-(<= (next (sat 76)) (does ?v23003 (assign 2 f)) (role ?v23003))
-(<= (next (sat 76)) (does ?v23024 (assign 19 t)) (role ?v23024))
-(<= (next (sat 77)) (does ?v23047 (assign 5 f)) (role ?v23047))
-(<= (next (sat 77)) (does ?v23068 (assign 13 t)) (role ?v23068))
-(<= (next (sat 77)) (does ?v23089 (assign 17 f)) (role ?v23089))
-(<= (next (sat 78)) (does ?v23112 (assign 2 t)) (role ?v23112))
-(<= (next (sat 78)) (does ?v23133 (assign 10 f)) (role ?v23133))
-(<= (next (sat 78)) (does ?v23154 (assign 18 f)) (role ?v23154))
-(<= (next (sat 79)) (does ?v23177 (assign 18 f)) (role ?v23177))
-(<= (next (sat 79)) (does ?v23198 (assign 3 t)) (role ?v23198))
-(<= (next (sat 79)) (does ?v23219 (assign 11 t)) (role ?v23219))
-(<= (next (sat 80)) (does ?v23242 (assign 7 t)) (role ?v23242))
-(<= (next (sat 80)) (does ?v23263 (assign 9 f)) (role ?v23263))
-(<= (next (sat 80)) (does ?v23284 (assign 17 t)) (role ?v23284))
-(<= (next (sat 81)) (does ?v23307 (assign 15 f)) (role ?v23307))
-(<= (next (sat 81)) (does ?v23328 (assign 6 f)) (role ?v23328))
-(<= (next (sat 81)) (does ?v23349 (assign 3 f)) (role ?v23349))
-(<= (next (sat 82)) (does ?v23372 (assign 2 f)) (role ?v23372))
-(<= (next (sat 82)) (does ?v23393 (assign 3 t)) (role ?v23393))
-(<= (next (sat 82)) (does ?v23414 (assign 13 f)) (role ?v23414))
-(<= (next (sat 83)) (does ?v23437 (assign 12 t)) (role ?v23437))
-(<= (next (sat 83)) (does ?v23458 (assign 3 t)) (role ?v23458))
-(<= (next (sat 83)) (does ?v23479 (assign 2 f)) (role ?v23479))
-(<= (next (sat 84)) (does ?v23502 (assign 2 f)) (role ?v23502))
-(<= (next (sat 84)) (does ?v23523 (assign 3 f)) (role ?v23523))
-(<= (next (sat 84)) (does ?v23544 (assign 17 t)) (role ?v23544))
-(<= (next (sat 85)) (does ?v23567 (assign 20 t)) (role ?v23567))
-(<= (next (sat 85)) (does ?v23588 (assign 15 f)) (role ?v23588))
-(<= (next (sat 85)) (does ?v23609 (assign 16 f)) (role ?v23609))
-(<= (next (sat 86)) (does ?v23632 (assign 5 f)) (role ?v23632))
-(<= (next (sat 86)) (does ?v23653 (assign 17 f)) (role ?v23653))
-(<= (next (sat 86)) (does ?v23674 (assign 19 f)) (role ?v23674))
-(<= (next (sat 87)) (does ?v23697 (assign 20 f)) (role ?v23697))
-(<= (next (sat 87)) (does ?v23718 (assign 18 f)) (role ?v23718))
-(<= (next (sat 87)) (does ?v23739 (assign 11 t)) (role ?v23739))
-(<= (next (sat 88)) (does ?v23762 (assign 9 f)) (role ?v23762))
-(<= (next (sat 88)) (does ?v23783 (assign 1 t)) (role ?v23783))
-(<= (next (sat 88)) (does ?v23804 (assign 5 f)) (role ?v23804))
-(<= (next (sat 89)) (does ?v23827 (assign 19 f)) (role ?v23827))
-(<= (next (sat 89)) (does ?v23848 (assign 9 t)) (role ?v23848))
-(<= (next (sat 89)) (does ?v23869 (assign 17 t)) (role ?v23869))
-(<= (next (sat 90)) (does ?v23892 (assign 12 t)) (role ?v23892))
-(<= (next (sat 90)) (does ?v23913 (assign 2 f)) (role ?v23913))
-(<= (next (sat 90)) (does ?v23934 (assign 17 t)) (role ?v23934))
-(<= (next (sat 91)) (does ?v23957 (assign 4 t)) (role ?v23957))
-(<= (next (sat 91)) (does ?v23978 (assign 16 f)) (role ?v23978))
-(<= (next (sat 91)) (does ?v23999 (assign 5 f)) (role ?v23999))
-(<= all_sat (true (sat 1)) (true (sat 2)) (true (sat 3)) (true (sat 4)) (true (sat 5)) (true (sat 6)) (true (sat 7)) (true (sat 8)) (true (sat 9)) (true (sat 10)) (true (sat 11)) (true (sat 12)) (true (sat 13)) (true (sat 14)) (true (sat 15)) (true (sat 16)) (true (sat 17)) (true (sat 18)) (true (sat 19)) (true (sat 20)) (true (sat 21)) (true (sat 22)) (true (sat 23)) (true (sat 24)) (true (sat 25)) (true (sat 26)) (true (sat 27)) (true (sat 28)) (true (sat 29)) (true (sat 30)) (true (sat 31)) (true (sat 32)) (true (sat 33)) (true (sat 34)) (true (sat 35)) (true (sat 36)) (true (sat 37)) (true (sat 38)) (true (sat 39)) (true (sat 40)) (true (sat 41)) (true (sat 42)) (true (sat 43)) (true (sat 44)) (true (sat 45)) (true (sat 46)) (true (sat 47)) (true (sat 48)) (true (sat 49)) (true (sat 50)) (true (sat 51)) (true (sat 52)) (true (sat 53)) (true (sat 54)) (true (sat 55)) (true (sat 56)) (true (sat 57)) (true (sat 58)) (true (sat 59)) (true (sat 60)) (true (sat 61)) (true (sat 62)) (true (sat 63)) (true (sat 64)) (true (sat 65)) (true (sat 66)) (true (sat 67)) (true (sat 68)) (true (sat 69)) (true (sat 70)) (true (sat 71)) (true (sat 72)) (true (sat 73)) (true (sat 74)) (true (sat 75)) (true (sat 76)) (true (sat 77)) (true (sat 78)) (true (sat 79)) (true (sat 80)) (true (sat 81)) (true (sat 82)) (true (sat 83)) (true (sat 84)) (true (sat 85)) (true (sat 86)) (true (sat 87)) (true (sat 88)) (true (sat 89)) (true (sat 90)) (true (sat 91)))
-(<= terminal all_sat)
-(<= terminal (true (control the end)))
-(<= (goal exists 100) all_sat)
-(<= (goal exists 0) (not all_sat))
-(<= (goal forall 100) (not all_sat))
-(<= (goal forall 0) all_sat)
\ No newline at end of file
Modified: trunk/Toss/Solver/Solver.ml
===================================================================
--- trunk/Toss/Solver/Solver.ml 2011-11-11 22:57:56 UTC (rev 1629)
+++ trunk/Toss/Solver/Solver.ml 2011-11-12 23:53:56 UTC (rev 1630)
@@ -516,16 +516,26 @@
module M = struct
let solver = new_solver ()
- let evaluate struc phi =
- evaluate solver ~formula:(register_formula_s struc solver phi) struc
- let evaluate_real = evaluate_real
- let evaluate_partial struc intpr phi =
+ let check_cache x = x
+ (*
+ print_endline (string_of_int (Hashtbl.length solver.reg_formulas));
+ print_endline (string_of_int (Hashtbl.length solver.formulas_eval));
+ print_endline (string_of_int (Hashtbl.length solver.formulas_check));
+ x
+ *)
+
+ let evaluate struc phi = check_cache (
+ evaluate solver ~formula:(register_formula_s struc solver phi) struc)
+ let evaluate_real rvar expr struc =
+ check_cache (evaluate_real rvar expr struc)
+ let evaluate_partial struc intpr phi = check_cache (
evaluate_partial_aset solver ~formula:(register_formula_s struc solver phi)
- struc intpr
+ struc intpr)
- let check struc phi =
- check solver ~formula:(register_formula_s struc solver phi) struc
- let get_real_val ?asg re struc = get_real_val_cache ?asg solver struc re
+ let check struc phi = check_cache (
+ check solver ~formula:(register_formula_s struc solver phi) struc)
+ let get_real_val ?asg re struc = check_cache (
+ check_cache (get_real_val_cache ?asg solver struc re))
let set_timeout t = timeout := t
let clear_timeout () = timeout := (fun () -> false);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-11 22:58:02
|
Revision: 1629
http://toss.svn.sourceforge.net/toss/?rev=1629&view=rev
Author: lukaszkaiser
Date: 2011-11-11 22:57:56 +0000 (Fri, 11 Nov 2011)
Log Message:
-----------
A few more small changes, all GDL translation tests go through.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/GGP/TranslateGame.ml
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-11-11 22:08:39 UTC (rev 1628)
+++ trunk/Toss/Formula/Aux.ml 2011-11-11 22:57:56 UTC (rev 1629)
@@ -254,7 +254,7 @@
let rec power ?(timeout = fun () -> false) dom img =
List.fold_left (fun sbs v ->
- concat_map (fun e -> if timeout () then raise (Timeout "Aux.product") else
+ concat_map (fun e -> if timeout () then raise (Timeout "Aux.power") else
List.rev (List.rev_map (fun sb -> (v,e)::sb) sbs)) img)
[[]] (List.rev dom)
@@ -275,9 +275,10 @@
if n <= 0 then accu
else fold_n f (f accu) (n-1)
-let all_ntuples elems arity =
+let all_ntuples ?(timeout = fun () -> false) elems arity =
fold_n (fun tups ->
- concat_map (fun e -> (List.map (fun tup -> e::tup) tups))
+ concat_map (fun e -> if timeout () then raise (Timeout "Aux.all_ntuples")
+ else List.rev (List.rev_map (fun tup -> e::tup) tups))
elems) [[]] arity
let rec remove_one e = function
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-11-11 22:08:39 UTC (rev 1628)
+++ trunk/Toss/Formula/Aux.mli 2011-11-11 22:57:56 UTC (rev 1629)
@@ -170,7 +170,7 @@
val pairs : 'a list -> ('a * 'a) list
(** An [n]th cartesian power of the list. Tail recursive. *)
-val all_ntuples : 'a list -> int -> 'a list list
+val all_ntuples : ?timeout:(unit -> bool) -> 'a list -> int -> 'a list list
(** All subsets of a given [set] of size up to [max_size]. *)
val all_subsets : ?max_size: int -> 'a list -> 'a list list
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-11-11 22:08:39 UTC (rev 1628)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-11-11 22:57:56 UTC (rev 1629)
@@ -1056,9 +1056,10 @@
match List.assoc rel argpaths with
| Aux.Left argpaths ->
let arity = List.assoc rel arities in
- let elem_tups = Aux.all_ntuples element_reps arity in
+ let elem_tups =
+ Aux.all_ntuples ~timeout:!timeout element_reps arity in
let path_tups =
- Aux.product (Array.to_list argpaths) in
+ Aux.product ~timeout:!timeout (Array.to_list argpaths) in
List.fold_left (fun struc ptup ->
Aux.fold_left_try (fun struc etup ->
let rname = rel_on_paths rel ptup in
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-11 22:08:45
|
Revision: 1628
http://toss.svn.sourceforge.net/toss/?rev=1628&view=rev
Author: lukaszkaiser
Date: 2011-11-11 22:08:39 +0000 (Fri, 11 Nov 2011)
Log Message:
-----------
More tail-recursiveness corrections for GDL translation, some added timeouts.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/TranslateGame.ml
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-11-11 00:56:17 UTC (rev 1627)
+++ trunk/Toss/Formula/Aux.ml 2011-11-11 22:08:39 UTC (rev 1628)
@@ -246,23 +246,24 @@
try f hd
with Not_found -> find_try f tl
-let rec fold_left_try f accu l =
- match l with
- [] -> accu
- | a::l ->
- try
- fold_left_try f (f accu a) l
- with Not_found -> fold_left_try f accu l
+let rec fold_left_try f accu = function
+ | [] -> accu
+ | a::l ->
+ let new_accu = try f accu a with Not_found -> accu in
+ fold_left_try f new_accu l
-let rec power dom img =
- List.fold_right (fun v sbs ->
- concat_map (fun e -> List.map (fun sb -> (v,e)::sb) sbs) img)
- dom [[]]
+let rec power ?(timeout = fun () -> false) dom img =
+ List.fold_left (fun sbs v ->
+ concat_map (fun e -> if timeout () then raise (Timeout "Aux.product") else
+ List.rev (List.rev_map (fun sb -> (v,e)::sb) sbs)) img)
+ [[]] (List.rev dom)
-let product l =
- List.fold_right (fun set prod ->
- concat_map (fun el -> List.map (fun tup -> el::tup) prod) set)
- l [[]]
+let product ?(timeout = fun () -> false) l =
+ List.fold_left (fun prod set ->
+ concat_map (fun el -> if timeout () then raise (Timeout "Aux.product") else
+ List.rev (List.rev_map (fun tup -> el::tup) prod)
+ ) set)
+ [[]] (List.rev l)
let rec pairs l =
match l with
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-11-11 00:56:17 UTC (rev 1627)
+++ trunk/Toss/Formula/Aux.mli 2011-11-11 22:08:39 UTC (rev 1628)
@@ -159,11 +159,11 @@
val fold_left_try : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
(** [power dom img] generates all functions with domain [dom] and
- image [img], as graphs. *)
-val power : 'a list -> 'b list -> ('a * 'b) list list
+ image [img], as graphs. *)
+val power : ?timeout:(unit -> bool) -> 'a list -> 'b list -> ('a * 'b) list list
(** Cartesian product of lists. Not tail recursive. *)
-val product : 'a list list -> 'a list list
+val product : ?timeout:(unit -> bool) -> 'a list list -> 'a list list
(** A list of all pairs of elements that preserve the order of
elements from the list. *)
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-11-11 00:56:17 UTC (rev 1627)
+++ trunk/Toss/GGP/GDL.ml 2011-11-11 22:08:39 UTC (rev 1628)
@@ -934,6 +934,7 @@
(Aux.Strings.elements br_vars) in
let sb = List.map (fun (v,t) -> v, Var t) sb in
List.map (subst_br sb) brs in
+
let expand_pos_atom (rel, args as atom)
(sb, (head, r_body, r_neg_body)) =
(let try def_brs = freshen_brs (List.assoc rel defs) in
@@ -946,9 +947,11 @@
) def_brs
with Not_found ->
[sb, (head, (subst_rel sb atom)::r_body, r_neg_body)]) in
+
let pack_lits body neg_body =
List.map (fun a->Aux.Left a) body @
List.map (fun a->Aux.Right a) neg_body in
+
let expand_neg_atom (rel, args as atom)
(sb, (head, r_body, r_neg_body)) =
(let try def_brs = freshen_brs (List.assoc rel defs) in
@@ -963,14 +966,14 @@
def_brs in
if def_brs = [] then
[sb, (head, r_body, r_neg_body)]
- else
+ else (
(* DNF of the negation of [def_brs] disjunction --
[Left]/[Right] switch meaning *)
- let dnf_of_neg = Aux.product def_brs in
+ let dnf_of_neg = Aux.product ~timeout:!timeout def_brs in
List.map (fun dnf_br ->
let d_neg_body, d_body = Aux.partition_choice dnf_br in
sb, (head, d_body @ r_body, d_neg_body @ r_neg_body)
- ) dnf_of_neg
+ ) dnf_of_neg )
with Not_found ->
[sb, (head, r_body, (subst_rel sb atom)::r_neg_body)]) in
@@ -978,6 +981,7 @@
let init = [[], (head, [], [])] in
Aux.concat_foldr expand_neg_atom neg_body
(Aux.concat_foldr expand_pos_atom body init) in
+
let rec fix n_brs brs i =
let brs = Aux.concat_map expand_br brs in
let new_n_brs = List.length brs in
@@ -1000,7 +1004,7 @@
let clauses = List.map (fun (_,body,neg_body) ->
List.map (fun a -> pos (atom_of_rel a)) body @
List.map (fun a -> neg (atom_of_rel a)) neg_body) clauses in
- let negated = Aux.product clauses in
+ let negated = Aux.product ~timeout:!timeout clauses in
(* can raise [Not_found] in case of unsatisfiable "not distinct" *)
let nclause body =
let uniterms, lits =
@@ -1602,7 +1606,7 @@
(player_vars_of (List.map rel_of_atom (atoms_of_clause clause))) in
if plvars = [] then [clause]
else
- let sbs = Aux.power plvars players in
+ let sbs = Aux.power ~timeout:!timeout plvars players in
List.map (fun sb -> subst_clause sb clause) sbs in
Aux.concat_map exp_clause clauses
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-11-11 00:56:17 UTC (rev 1627)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-11-11 22:08:39 UTC (rev 1628)
@@ -1179,7 +1179,7 @@
);
(* }}} *)
List.map (fun sb->subst_clause sb g_cl) v_sbs in
- Aux.concat_map expand goal_cls @ clauses
+ List.rev_append (List.rev (Aux.concat_map expand goal_cls)) clauses
let prepare_relations_and_structure
ground_state_terms f_paths c_paths element_reps root_reps
@@ -1816,26 +1816,27 @@
(String.concat " "(List.map literal_str goal));
);
(* }}} *)
- let res =
- run_prolog_check_goal static_goal program &&
- let goal = optimize_goal ~testground goal in
- (* {{{ log entry *)
+ let res_prolog = run_prolog_check_goal static_goal program in
+ let res = res_prolog &&
+ let goal = optimize_goal ~testground goal in
+ (* {{{ log entry *)
if !debug_level > 3 then (
Printf.printf
"goal=%s\n%!" (String.concat " "(List.map literal_str goal))
);
- (* }}} *)
- List.exists
+ (* }}} *)
+ List.exists
(fun state ->
- (* {{{ log entry *)
+ (* {{{ log entry *)
if !debug_level > 3 then Printf.printf ".%!";
- (* }}} *)
- run_prolog_check_goal goal
- (replace_rel_in_program "true" (state_cls state) program))
+ (* }}} *)
+ let repl_program =
+ replace_rel_in_program "true" (state_cls state) program in
+ run_prolog_check_goal goal repl_program)
playout_states in
- (* {{{ log entry *)
+ (* {{{ log entry *)
if !debug_level > 3 then Printf.printf " %B\n%!" res;
- (* }}} *)
+ (* }}} *)
res in
let unrequired_cls = Aux.map_some
(function
@@ -1909,9 +1910,10 @@
Array.iteri print_cl (Array.of_list unrequired_cls)
);
(* }}} *)
- let choices = Aux.power split_atoms [false; true] in
+ let choices = Aux.power ~timeout:!timeout split_atoms [false; true] in
let unrequired_cls = Array.of_list unrequired_cls in
let rule_case choice =
+ check_timeout ~print:false "rule_cases: internal rule_case: start";
let separation_cond =
List.map (fun (a,b) -> if b then Pos a else Neg a) choice in
let case =
@@ -1928,7 +1930,7 @@
) unrequired_cls in
let ids, cls = List.split (Array.to_list case) in
Aux.ints_of_list ids, separation_cond, cls in
- let cases = List.map rule_case choices in
+ let cases = List.rev (List.rev_map rule_case choices) in
let process_case (ids, separation_cond, case_cls) =
let case_cls = Aux.map_prepend case_cls
(fun (h,b) -> h, Legal_cl, b) required_cls in
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-11 00:56:24
|
Revision: 1627
http://toss.svn.sourceforge.net/toss/?rev=1627&view=rev
Author: lukaszkaiser
Date: 2011-11-11 00:56:17 +0000 (Fri, 11 Nov 2011)
Log Message:
-----------
Making Aux.unique_sorted tail-recursive, corrects segfault in GDL translation of satlike.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/GGP/GDL.ml
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-11-10 23:59:43 UTC (rev 1626)
+++ trunk/Toss/Formula/Aux.ml 2011-11-11 00:56:17 UTC (rev 1627)
@@ -340,13 +340,12 @@
| [] -> acc in
List.rev (aux (List.rev l2) l1)
-(* Not tail-recursive. *)
let unique_sorted ?(cmp = Pervasives.compare) l =
- let rec idemp = function
- | e1::(e2::_ as tl) when cmp e1 e2 = 0 -> idemp tl
- | e::tl -> e::idemp tl
- | [] -> [] in
- idemp (List.sort cmp l)
+ let rec idemp acc = function
+ | e1::(e2::_ as tl) when cmp e1 e2 = 0 -> idemp acc tl
+ | e::tl -> idemp (e::acc) tl
+ | [] -> acc in
+ idemp [] (List.sort (fun x y -> - (cmp x y)) l)
let all_subsets ?max_size set =
let size = match max_size with Some i -> i | None -> List.length set in
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-11-10 23:59:43 UTC (rev 1626)
+++ trunk/Toss/GGP/GDL.ml 2011-11-11 00:56:17 UTC (rev 1627)
@@ -637,15 +637,16 @@
(rel_atoms_str new_base3)
);
(* }}} *)
- let new_base = build_graph
- (new_base1 @ new_base2 @ new_base3)
- and new_irules = Aux.unique_sorted
- (new_irules1 @ new_irules2 @ new_irules3) in
+ let append_base = List.rev_append (List.rev new_base1)
+ (List.rev_append (List.rev new_base2) new_base3) in
+ let new_base = build_graph append_base
+ and all_new_irules =
+ List.rev_append (List.rev_append new_irules1 new_irules2) new_irules3 in
+ let new_irules = Aux.unique_sorted all_new_irules in
(* [new_base] is already disjoint from [base] *)
let new_irules = Aux.sorted_diff new_irules irules in
- if Aux.StrMap.is_empty new_base && new_irules = []
- then base
- else inst_stratum base irules new_base new_irules in
+ if Aux.StrMap.is_empty new_base && new_irules = [] then base else
+ inst_stratum base irules new_base new_irules in
let rec instantiate base = function
| [] -> base
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-10 23:59:50
|
Revision: 1626
http://toss.svn.sourceforge.net/toss/?rev=1626&view=rev
Author: lukaszkaiser
Date: 2011-11-10 23:59:43 +0000 (Thu, 10 Nov 2011)
Log Message:
-----------
Corrections to compile on older OCaml 3.11.
Modified Paths:
--------------
trunk/Toss/Arena/ContinuousRule.ml
trunk/Toss/GGP/TranslateGame.ml
trunk/Toss/Play/Heuristic.ml
trunk/Toss/Server/LearnGame.ml
Modified: trunk/Toss/Arena/ContinuousRule.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRule.ml 2011-11-10 01:26:59 UTC (rev 1625)
+++ trunk/Toss/Arena/ContinuousRule.ml 2011-11-10 23:59:43 UTC (rev 1626)
@@ -30,7 +30,8 @@
let inv = FormulaSubst.subst_rels defs inv in
let post = FormulaSubst.subst_rels defs post in
(*let obj = DiscreteRule.compile_rule signat defs discrete in*)
- { discrete; dynamics; update; inv; post; }
+ { discrete = discrete; dynamics = dynamics; update = update;
+ inv = inv; post = post; }
@@ -52,7 +53,7 @@
else
{ struc_r with DiscreteRule.rhs_struc = res_struc } in
let discrete = DiscreteRule.compile_rule signat defs struc_r in
- {r with discrete}
+ {r with discrete = discrete}
let lhs r =
match r.discrete.DiscreteRule.struc_rule with
Modified: trunk/Toss/GGP/TranslateGame.ml
===================================================================
--- trunk/Toss/GGP/TranslateGame.ml 2011-11-10 01:26:59 UTC (rev 1625)
+++ trunk/Toss/GGP/TranslateGame.ml 2011-11-10 23:59:43 UTC (rev 1626)
@@ -2604,12 +2604,12 @@
let del_tuples = Aux.collect del in
let discrete = {
DiscreteRule.struc_rule = None;
- lhs_vars;
- rhs_vars;
- add_tuples;
- del_tuples;
- match_formula = precond;
- rlmap = None
+ DiscreteRule.lhs_vars = lhs_vars;
+ DiscreteRule.rhs_vars = rhs_vars;
+ DiscreteRule.add_tuples = add_tuples;
+ DiscreteRule.del_tuples = del_tuples;
+ DiscreteRule.match_formula = precond;
+ DiscreteRule.rlmap = None
} in
let rule =
ContinuousRule.make_rule [] discrete [] updates () in
Modified: trunk/Toss/Play/Heuristic.ml
===================================================================
--- trunk/Toss/Play/Heuristic.ml 2011-11-10 01:26:59 UTC (rev 1625)
+++ trunk/Toss/Play/Heuristic.ml 2011-11-10 23:59:43 UTC (rev 1626)
@@ -1075,8 +1075,9 @@
let use_monotonic = ref true
-let default_heuristic_old ?struc ?advr
- ({Arena.rules; graph; starting_struc} as game) =
+let default_heuristic_old ?struc ?advr game =
+ let (rules, graph, starting_struc) =
+ (game.Arena.rules, game.Arena.graph, game.Arena.starting_struc) in
(* TODO: cache the default heuristic in game definition or state *)
let drules =
List.map (fun r -> (snd r).ContinuousRule.discrete) rules in
Modified: trunk/Toss/Server/LearnGame.ml
===================================================================
--- trunk/Toss/Server/LearnGame.ml 2011-11-10 01:26:59 UTC (rev 1625)
+++ trunk/Toss/Server/LearnGame.ml 2011-11-10 23:59:43 UTC (rev 1626)
@@ -22,12 +22,14 @@
Distinguish.distinguish winningStates notWinningStates
let cleanStructure struc =
- let funs = List.map fst (Structure.StringMap.bindings (Structure.functions struc)) in
+ let funs = ref [] in
+ let append_fun f _ = funs := f :: !funs in
+ Structure.StringMap.iter append_fun (Structure.functions struc);
let struc = StructureParser.parse_structure Lexer.lex (Lexing.from_string (Structure.str struc)) in
Structure.replace_names (List.fold_left
(fun x y ->
Structure.clear_fun x y)
- struc funs) Structure.StringMap.empty
+ struc !funs) Structure.StringMap.empty
Structure.IntMap.empty
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <luk...@us...> - 2011-11-10 01:27:07
|
Revision: 1625
http://toss.svn.sourceforge.net/toss/?rev=1625&view=rev
Author: lukaszkaiser
Date: 2011-11-10 01:26:59 +0000 (Thu, 10 Nov 2011)
Log Message:
-----------
Correcting and completing guarded types, merging WL with Distinguish and allowing to set method.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/Formula/Aux.mli
trunk/Toss/Server/LearnGame.ml
trunk/Toss/Server/LearnGameTest.ml
trunk/Toss/Server/Picture.ml
trunk/Toss/Server/Tests.ml
trunk/Toss/Solver/Distinguish.ml
trunk/Toss/Solver/Distinguish.mli
trunk/Toss/Solver/DistinguishTest.ml
Removed Paths:
-------------
trunk/Toss/Solver/WL.ml
trunk/Toss/Solver/WL.mli
trunk/Toss/Solver/WLTest.ml
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Formula/Aux.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -348,6 +348,10 @@
| [] -> [] in
idemp (List.sort cmp l)
+let all_subsets ?max_size set =
+ let size = match max_size with Some i -> i | None -> List.length set in
+ [] :: (unique_sorted (List.map unique_sorted (all_ntuples set size)))
+
let unique_append l1 l2 =
List.fold_left (fun l2 e ->
if List.mem e l2 then l2 else e::l2) l2 (List.rev l1)
Modified: trunk/Toss/Formula/Aux.mli
===================================================================
--- trunk/Toss/Formula/Aux.mli 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Formula/Aux.mli 2011-11-10 01:26:59 UTC (rev 1625)
@@ -172,6 +172,9 @@
(** An [n]th cartesian power of the list. Tail recursive. *)
val all_ntuples : 'a list -> int -> 'a list list
+(** All subsets of a given [set] of size up to [max_size]. *)
+val all_subsets : ?max_size: int -> 'a list -> 'a list list
+
(** Remove an occurrence of a value (uses structural equality). *)
val remove_one : 'a -> 'a list -> 'a list
Modified: trunk/Toss/Server/LearnGame.ml
===================================================================
--- trunk/Toss/Server/LearnGame.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Server/LearnGame.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -19,7 +19,7 @@
let winFormula winningStates notWinningStates =
- WL.distinguish winningStates notWinningStates
+ Distinguish.distinguish winningStates notWinningStates
let cleanStructure struc =
let funs = List.map fst (Structure.StringMap.bindings (Structure.functions struc)) in
Modified: trunk/Toss/Server/LearnGameTest.ml
===================================================================
--- trunk/Toss/Server/LearnGameTest.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Server/LearnGameTest.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -76,8 +76,8 @@
\"" ;]] in
let res_game =
"PLAYERS 1, 2
-REL Win1() = ex x1, x2 (Q(x2) and R(x2, x1))
-REL Win2() = ex x1, x2 (Q(x2) and R(x1, x2))
+REL Win1() = ex x0, x1 (Q(x1) and R(x1, x0))
+REL Win2() = ex x0, x1 (Q(x1) and R(x0, x1))
RULE Mv1:
[1 | P:1 {}; Q:1 {}; R:2 {} | ] -> [1 | P (1); Q:1 {}; R:2 {} | ]
emb R,Q,P pre not Win2()
@@ -107,7 +107,7 @@
let bigtests = "LearnGame" >::: [
"tic-tac-toe" >::
(fun () ->
- WL.set_debug_level 0; (* set to 1 to get some info printed out *)
+ Distinguish.set_debug_level 0; (* set to 1 to get some info printed out *)
let partylist0 = [
List.map struc_of_string [
"[ | P:1 {}; Q:1 {} | ] \"
Modified: trunk/Toss/Server/Picture.ml
===================================================================
--- trunk/Toss/Server/Picture.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Server/Picture.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -258,12 +258,6 @@
let tp = postp left crels delems in
if !debug_level > -1 then
Format.eprintf "@[%a@]@ \n%!" Formula.fprint (Formula.And tp);
- if !debug_level > -1 then (
- let nofluent_left = Structure.clear_rels left (fun r -> List.mem r drels) in
- let tbl = WL.all_ntypes_simplified nofluent_left 1 2 in
- Format.eprintf "@[%a@]@ \n%!" Formula.fprint
- (Hashtbl.find tbl (Array.of_list delems));
- );
let cut s = List.fold_left Structure.del_elem s
(List.filter (fun e -> not (List.mem e delems)) (Structure.elements s)) in
(cut left, cut right, tp)
@@ -368,7 +362,7 @@
Format.eprintf "@[%a@]@ \n%!" Formula.fprint (Formula.And (basic :: mw));
if !debug_level > -1 then
Format.eprintf "@[%a@]@ \n%!" Formula.fprint
- (Aux.unsome (WL.distinguish_by_type ~qr:1 ~k:2 [right] [wrong]));
+ (Aux.unsome (Distinguish.distinguish_by_type ~qr:1 ~k:2 [right] [wrong]));
Formula.flatten (Formula.Ex (ex_vars, Formula.And (basic :: mw)))
)
Modified: trunk/Toss/Server/Tests.ml
===================================================================
--- trunk/Toss/Server/Tests.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Server/Tests.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -17,7 +17,6 @@
"AssignmentsTest", [AssignmentsTest.tests];
"SolverTest", [SolverTest.tests; SolverTest.bigtests];
"ClassTest", [ClassTest.tests; ClassTest.bigtests];
- "WLTest", [WLTest.tests; WLTest.bigtests];
"DistinguishTest", [DistinguishTest.tests; DistinguishTest.bigtests];
]
Modified: trunk/Toss/Solver/Distinguish.ml
===================================================================
--- trunk/Toss/Solver/Distinguish.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Solver/Distinguish.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -3,6 +3,10 @@
let debug_level = ref 0
let set_debug_level i = (debug_level := i)
+type distinguish_method = Types | Guarded
+
+
+
(* Helper functions to construct variables for indices. *)
let varname i = "x" ^ string_of_int i
let varnames k = List.map varname (Aux.range k)
@@ -19,7 +23,7 @@
Assignments.assignments_of_list elems vars [tuple] in
eval structure formula assignment <> AssignmentSet.Empty
-(* - Atoms - *)
+(* - Atoms and FO Types - *)
(* The list of literals which hold for a tuple on a structure. *)
let atoms struc tuple =
@@ -33,7 +37,26 @@
) (atoms @ (equalities (varnames k)))
+(* The [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
+let rec ntype struc qr tuple =
+ if qr = 0 then Formula.flatten_sort (And (atoms struc tuple)) else
+ let prevtp i e = ntype struc (qr-1) (Aux.array_replace tuple i e) in
+ let elems = Structure.elements struc in
+ let conj_prev_ex i =
+ And (List.map (fun e -> Ex ([var i], prevtp i e)) elems) in
+ let all_prev_disj i =
+ All ([var i], Or (List.map (prevtp i) elems)) in
+ let next_ntype i = And [conj_prev_ex i; all_prev_disj i] in
+ let nexttp = And (List.map next_ntype (Aux.range (Array.length tuple))) in
+ Formula.flatten_sort (And [ntype struc (qr-1) tuple; nexttp])
+(* All types of rank [qr] of all [k]-tuples in [struc]. *)
+let ntypes struc ~qr ~k =
+ let elems = Structure.elements struc in
+ let tups = List.map Array.of_list (Aux.all_ntuples elems k) in
+ Aux.unique_sorted (List.rev_map (ntype struc qr) tups)
+
+
(* - Guards and Guarded Types - *)
(* Generate all guarded substitutions of [tuple] with the guards.
@@ -86,19 +109,32 @@
if qr = 0 then Formula.flatten_sort (And (atoms struc tuple)) else
let prevtp tup = guarded_type struc (qr-1) tup in
let conj_prev_ex vars guard subst_tuples =
+ let subst_tuples = List.filter (fun tup -> tup <> tuple) subst_tuples in
And (List.map (fun tup -> Ex (vars, prevtp tup)) subst_tuples) in
let all_prev_disj vars guard subst_tuples =
All (vars, Or ((Not guard) :: (List.map prevtp subst_tuples))) in
- let next_gtype ((vs, g), ts) =
+ let next_gtype vs (g, ts) =
And [conj_prev_ex vs g ts; all_prev_disj vs g ts] in
- let (guards, subst_tuples) = List.split (
- List.rev_map (fun (_, vs, t, _, f) -> (vs,f), t) (guards struc tuple)) in
- let (guards, subst_tuples) =
- (Aux.unique_sorted guards, Aux.unique_sorted subst_tuples) in
- let guarded_tups (_, f) =
- List.filter (fun tup -> check struc tup f) subst_tuples in
- let guards_with_tups = List.map (fun g -> (g, guarded_tups g)) guards in
- let nextf = And (List.map next_gtype guards_with_tups) in
+ let subst_tuples = Aux.unique_sorted (([], tuple) ::
+ List.rev_map (fun (_,vs,t,_,_) -> (vs, t)) (guards struc tuple)) in
+ let all_vars = varnames (Array.length tuple) in
+ let at_most_vs_tuples vs = List.concat (List.map (
+ fun vs -> Aux.assoc_all vs subst_tuples) (Aux.all_subsets vs)) in
+ let tuples_by_vs = List.map (fun vs -> (vs, at_most_vs_tuples vs))
+ (Aux.all_subsets (List.map var_of_string all_vars)) in
+ let all_guards= FormulaOps.atoms (Structure.rel_signature struc) all_vars in
+ let guards_to_tups (vs, tuples) =
+ let has_vs a = List.for_all (fun v -> Aux.array_mem (to_fo v) a) vs in
+ let is_vs_guard a = has_vs a &&
+ Aux.array_existsi (fun _ v -> not (List.mem (v :> var) vs)) a in
+ let is_vs_guard = function Rel (_, a) -> is_vs_guard a | _ -> false in
+ let vs_guards = List.filter is_vs_guard all_guards in
+ let guarded_tups g = List.filter (fun tup -> check struc tup g) tuples in
+ (vs, List.map (fun g -> (g, guarded_tups g)) vs_guards) in
+ let tups_with_guards = List.map guards_to_tups tuples_by_vs in
+ let tups_with_guards = List.filter (fun (vs,_)-> vs<>[]) tups_with_guards in
+ let next_gtype_vs (vs, gtups) = And (List.map (next_gtype vs) gtups) in
+ let nextf = And (List.map next_gtype_vs tups_with_guards) in
Formula.flatten_sort (And [guarded_type struc (qr-1) tuple; nextf])
(* All guarded types of rank [qr] of guarded [k]-tuples in [struc]. *)
@@ -136,8 +172,11 @@
| phi -> phi
-let distinguish_by_type ?(skip_outer_exists=false) ~qr ~k sPos sNeg=
- let types s = guarded_types s ~qr ~k in
+let distinguish_by_type ?(how=Guarded) ?(skip_outer_exists=false) ~qr ~k
+ sPos sNeg =
+ let types s = match how with
+ | Guarded -> guarded_types s ~qr ~k
+ | Types -> ntypes s ~qr ~k in
let (tpPos, tpNeg) = (List.map types sPos, List.map types sNeg) in
(*let all_diff vars = Aux.map_some (
function [x; y] -> if x < y then Some (Not (Eq (x, y))) else None| _ -> None
@@ -160,12 +199,12 @@
if dtypes = [] then None else
let is_ok f = fails_neg f && succ_pos [f] in
let mintp = greedy_remove is_ok (Or dtypes) in
- let fv = FormulaSubst.free_vars (Or dtypes) in
- let t= FormulaOps.rename_quant_avoiding fv mintp in
+ let fv = FormulaSubst.free_vars mintp in
+ let t = FormulaOps.rename_quant_avoiding fv mintp in
if skip_outer_exists then Some t else
Some (Ex (List.sort Formula.compare_vars fv, t))
-let distinguish ?(skip_outer_exists=false) strucs1 strucs2 =
+let distinguish ?(how=Guarded) ?(skip_outer_exists=false) strucs1 strucs2 =
if !debug_level > 0 then
Printf.printf "distinguishing:\n\n%s\n\n and\n\n %s\n%!"
(String.concat "\n" (List.map Structure.str strucs1))
@@ -173,7 +212,7 @@
let rec diff qr k =
if qr > k then diff 0 (k+1) else (
if !debug_level > 0 then Printf.printf "distinguish qr %i k %i\n%!" qr k;
- match distinguish_by_type ~skip_outer_exists ~qr ~k strucs1 strucs2 with
+ match distinguish_by_type ~how ~skip_outer_exists ~qr ~k strucs1 strucs2 with
| Some f -> f
| None -> diff (qr+1) k
) in
Modified: trunk/Toss/Solver/Distinguish.mli
===================================================================
--- trunk/Toss/Solver/Distinguish.mli 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Solver/Distinguish.mli 2011-11-10 01:26:59 UTC (rev 1625)
@@ -1,12 +1,21 @@
(** Distinguish sets of structures by formulas. *)
-(** {2 Atoms} *)
+type distinguish_method = Types | Guarded
+
+(** {2 Atoms and FO Types} *)
+
(** The list of literals which hold for a tuple on a structure,
i.e. the atomic type of this tuple. *)
val atoms: Structure.structure -> int array -> Formula.formula list
+(** The [qr]-type in [length of tuple]-variables of [tuple] in [struc]. *)
+val ntype: Structure.structure -> int -> int array -> Formula.formula
+(** All types of rank [qr] of all [k]-tuples in [struc]. *)
+val ntypes: Structure.structure -> qr: int -> k:int -> Formula.formula list
+
+
(** {2 Guards and Guarded Types} *)
(** Generate all guarded substitutions of [tuple] with the guards.
@@ -36,10 +45,11 @@
(** {2 Distinguishing Structure Sets} *)
-val distinguish_by_type: ?skip_outer_exists: bool -> qr: int -> k: int ->
- Structure.structure list -> Structure.structure list -> Formula.formula option
+val distinguish_by_type: ?how: distinguish_method -> ?skip_outer_exists: bool ->
+ qr: int -> k: int -> Structure.structure list -> Structure.structure list ->
+ Formula.formula option
-val distinguish: ?skip_outer_exists: bool ->
+val distinguish: ?how: distinguish_method -> ?skip_outer_exists: bool ->
Structure.structure list -> Structure.structure list -> Formula.formula
Modified: trunk/Toss/Solver/DistinguishTest.ml
===================================================================
--- trunk/Toss/Solver/DistinguishTest.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Solver/DistinguishTest.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -48,6 +48,45 @@
(Formula.And (atoms struc [|2; 3|]));
);
+ "ntype" >::
+ ( fun () ->
+ let structure = (struc_of_string "[ | R { (1, 2) } | ]") in
+ formula_eq ("R(x0, x1) and not R(x0, x0) and not x0=x1 and " ^
+ "not R(x1, x0) and not R(x1, x1)")
+ (Distinguish.ntype structure 0 [|1; 2|]);
+ formula_eq ("(R(x0,x1) and not R(x0,x0) and x0!=x1 and not R(x1,x0) and "^
+ "not R(x1, x1) and ex x0 (R(x0, x1) and not R(x0, x0) " ^
+ "and not x0 = x1 and not R(x1, x0) and not R(x1, x1)) " ^
+ "and ex x0 (x0 = x1 and not R(x0, x0) and not R(x0, x1) " ^
+ "and not R(x1,x0) and not R(x1,x1)) and ex x1(R(x0,x1) " ^
+ "and not R(x0, x0) and not x0 = x1 and not R(x1, x0) " ^
+ "and not R(x1,x1)) and ex x1 (x0=x1 and not R(x0, x0) " ^
+ "and not R(x0, x1) and not R(x1, x0) and not R(x1, x1))" ^
+ " and all x0 ((R(x0,x1) and not R(x0,x0) and x0!=x1 and " ^
+ "not R(x1, x0) and not R(x1, x1)) or (x0 = x1 and " ^
+ "not R(x0, x0) and not R(x0, x1) and not R(x1, x0) and " ^
+ "not R(x1,x1))) and all x1 ((R(x0, x1) and not R(x0, x0)" ^
+ " and not x0 = x1 and not R(x1, x0) and not R(x1, x1)) " ^
+ "or (x0 = x1 and not R(x0, x0) and not R(x0, x1) " ^
+ "and not R(x1, x0) and not R(x1, x1))))")
+ (Distinguish.ntype structure 1 [|1;2|]);
+ );
+
+ "ntypes" >::
+ (fun () ->
+ let structure = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
+ formula_list_eq
+ [("R(x0, x1) and not R(x0, x0) and not x0 = x1 and " ^
+ "not R(x1, x0) and not R(x1, x1)");
+ ("R(x1, x0) and not R(x0, x0) and not R(x0, x1) and " ^
+ "not x0 = x1 and not R(x1, x1)");
+ ("x0 = x1 and not R(x0, x0) and not R(x0, x1) and " ^
+ "not R(x1, x0) and not R(x1, x1)");
+ ("not R(x0, x0) and not R(x0, x1) and not x0 = x1 and " ^
+ "not R(x1, x0) and not R(x1, x1)")]
+ (Distinguish.ntypes structure ~qr:0 ~k:2);
+ );
+
"guards" >::
(fun () ->
let struc = struc_of_string "[ | R { (1, 2); (2, 3) } | ]" in
@@ -121,15 +160,24 @@
let lits = "R(x0,x1) and not R(x0,x0) and not x0=x1 and not R(x1,x0) " ^
"and not R(x1,x1)" in
formula_eq lits (guarded_type struc 0 [|1; 2|]);
- formula_eq lits (guarded_type struc 1 [|1; 2|]); (* no guards *)
- formula_eq lits (guarded_type struc 2 [|1; 2|]); (* no guards *)
+ formula_eq (lits ^ " and all x0 not R(x1, x0) and all x1 not R(x1, x0) " ^
+ "and all x0 (not R(x0, x1) or (not R(x0, x0) and " ^
+ "not x0 = x1 and not R(x1, x0) and not R(x1, x1))) and " ^
+ "all x1 (not R(x0, x1) or (not R(x0, x0) and not x0 = x1" ^
+ " and not R(x1, x0) and not R(x1, x1)))")
+ (guarded_type struc 1 [|1; 2|]);
let struc = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
formula_eq lits (guarded_type struc 0 [|1; 2|]);
- formula_eq (lits ^ " and ex x0 (R(x1, x0) and not R(x0, x0) and " ^
- "not R(x0, x1) and not x0 = x1 and not R(x1, x1)) and " ^
- "all x0 (not R(x1, x0) or (not R(x0, x0) and not R(x0,x1)" ^
- " and not x0 = x1 and not R(x1, x1)))")
+ formula_eq (lits ^ " and all x1 not R(x1, x0) and " ^
+ "ex x0 (R(x1, x0) and not R(x0, x0) and not R(x0, x1) and" ^
+ " not x0 = x1 and not R(x1, x1)) and " ^
+ "all x0 (not R(x0, x1) or (not R(x0, x0) and not x0 = x1" ^
+ " and not R(x1, x0) and not R(x1, x1))) and " ^
+ "all x0 (not R(x1, x0) or (not R(x0, x0) and not R(x0, x1)"^
+ " and not x0 = x1 and not R(x1, x1))) and " ^
+ "all x1 (not R(x0, x1) or (not R(x0, x0) and not x0 = x1" ^
+ " and not R(x1, x0) and not R(x1, x1)))")
(guarded_type struc 1 [|1; 2|]);
);
@@ -168,9 +216,12 @@
(Distinguish.distinguish_by_type ~qr:2 ~k:1 [struc1] [struc2]);
formula_option_eq "None" (* we use guarded types - so None here *)
(Distinguish.distinguish_by_type ~qr:0 ~k:2 [struc1] [struc2]);
+ formula_option_eq "not R(x0, x1) and not x0 = x1 and not R(x1, x0)"
+ (Distinguish.distinguish_by_type ~how:Types ~skip_outer_exists:true
+ ~qr:0 ~k:2 [struc1] [struc2]);
formula_option_eq "None" (* we use guarded types - so None here *)
(Distinguish.distinguish_by_type ~qr:0 ~k:3 [struc1] [struc2]);
- formula_option_eq "R(x0, x1) and ex x2 R(x1, x2)"
+ formula_option_eq "R(x0, x1) and ex x2 R(x2, x0)"
(Distinguish.distinguish_by_type ~skip_outer_exists:true ~qr:1 ~k:2
[struc1] [struc2]);
@@ -184,12 +235,27 @@
(fun () ->
let struc1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
let struc2 = (struc_of_string "[ | R { (1, 2) } | ]") in
- formula_eq "ex x0, x1 (R(x0, x1) and ex x2 R(x1, x2))"
+ formula_eq "ex x0, x1 (R(x0, x1) and ex x2 R(x2, x0))"
(Distinguish.distinguish [struc1] [struc2]);
let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
let struc2 = (struc_of_string "[ | P:1 {}; R { (1) } | ]") in
formula_eq "ex x0 P(x0)" (Distinguish.distinguish [struc1] [struc2]);
+
+ let struc1 = struc_of_string "[ | | ] \"
+ ...
+ ...
+ ...
+ P..
+\"" in
+ let struc2 = struc_of_string "[ | | ] \"
+ ...
+ P..
+ ...
+ ...
+\"" in
+ formula_eq "ex x0, x1 (P(x0) and C(x0, x1))"
+ (Distinguish.distinguish [struc1] [struc2]);
);
]
@@ -233,6 +299,7 @@
"ex x2 (P(x2) and R(x2, x1)) and ex x2 (C(x1, x2) and not P(x2))")
(Distinguish.distinguish ~skip_outer_exists:true
[strucP] [strucN1; strucN2; strucN3]);
+ assert true;
);
"breakthrough" >::
@@ -272,9 +339,9 @@
... ... ... W..
... ... ... ...
...W ... ... ...
-\"" in
- Distinguish.set_debug_level 1;
- formula_eq "W(x2) and all x3 not C(x2, x3)"
+\"" in (* "W(x2) and all x3 not C(x2, x3)" *)
+ (* Distinguish.set_debug_level 1; *)
+ formula_eq "W(x0) and R(x0, x1) and all x2 not C(x1, x2)"
(Distinguish.distinguish ~skip_outer_exists:true [struc1] [struc2]);
);
]
Deleted: trunk/Toss/Solver/WL.ml
===================================================================
--- trunk/Toss/Solver/WL.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Solver/WL.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -1,255 +0,0 @@
-open Formula
-
-let debug_level = ref 0
-let set_debug_level i = (debug_level := i)
-
-(* Given an array of lists, i.e. a.(i) is a list, find an array b of the same
- size of sub-lists (b.(i) subset a.(i)) such that if there was an element
- distinguishing a.(i) from a.(j) then one separates b.(i) from b.(j).
- This can be done in many ways (is it NP-complete to get the shortest b?),
- we remove the intersection and after this greedily unused elements if
- the option [greedy_cleanup] is set. *)
-let rec separate ?(cmp = Pervasives.compare) ?(greedy_cleanup = true) a =
- let nonempty_intersect l1 l2 =
- if l1 = [] then l2 else if l2 = [] then l1 else Aux.sorted_inter l1 l2 in
- let no_intersect arr =
- let sorted = Array.map Aux.unique_sorted arr in
- let inter = Array.fold_left nonempty_intersect sorted.(0) sorted in
- Array.map (fun x -> Aux.list_diff x inter) arr in
- let cleanup arr =
- let suffices orig l i = Aux.array_for_alli (
- fun j lst -> j = i || lst = orig ||
- List.exists (fun x -> not (List.mem x a.(j))) l) arr in
- let rec filter orig i acc rest =
- if rest = [] || suffices orig acc i then acc else
- filter orig i ((List.hd rest)::acc) (List.tl rest) in
- Array.mapi (fun i l -> filter l i [] (List.sort cmp l)) arr in
- let rec rec_cleanup arr =
- let new_arr = cleanup arr in
- if new_arr = arr then arr else rec_cleanup new_arr in
- if Array.length a = 0 then a else
- let b = no_intersect a in
- if greedy_cleanup then rec_cleanup b else b
-
-
-(* Call the separate function from above on an array of conjunctions. *)
-let separate_conjs greedy conjs =
- separate ~cmp:Formula.compare ~greedy_cleanup:greedy conjs
-
-
-(* Helper function: check if a formula holds for a tuple on a structure. *)
-let check structure tuple variables formula =
- let eval structure phi assignment =
- (Solver.M.evaluate_partial structure assignment phi) in
- let elems = Assignments.set_to_set_list (Structure.elems structure) in
- let assignment = if tuple = [||] then AssignmentSet.Any else
- Assignments.assignments_of_list elems
- (Array.map fo_var_of_string variables) [tuple] in
- eval structure formula assignment <> AssignmentSet.Empty
-
-(* The list of literals which hold for a tuple on a structure,
- i.e. the atomic type of this tuple. *)
-let atoms structure tuple variables_in =
- let variables = (Array.sub variables_in 0 (Array.length tuple)) in
- let rec inequalities vars = match vars with
- head::tail -> List.append (List.map (fun x -> Eq (`FO head,`FO x) ) tail)
- (inequalities tail)
- | _ -> [] in
- let listOfLiterals = FormulaOps.atoms (Structure.rel_signature structure)
- (Array.to_list variables) in
- List.map (fun literal ->
- if check structure tuple variables literal then literal else (Not literal)
- ) (List.append listOfLiterals (inequalities (Array.to_list variables)))
-
-let range k = Aux.range ~from:1 (k+1)
-
-(* The n-type from FO^k for the [tuple] in [structure]. *)
-let rec ntype structure tuple k_in n =
- let m = Array.length tuple in
- let k = max k_in m in
- let variables = (List.map (fun i -> "x"^string_of_int(i)) (range k)) in
- if n=0 then
- Formula.flatten_sort (And (atoms structure tuple (Array.of_list variables)))
- else
- let elements = Structure.elements structure in
- if m < k then (* tuple shorter than variables, append one *)
- let x_new = `FO ("x"^(string_of_int((Array.length tuple)+1))) in
- let conj_b_ex_xmplus1_typesN structure tuple k n =
- And ( List.map (fun x ->
- Ex ([x_new], ntype structure (Array.append tuple [|x|]) k n)
- ) elements) in
- let all_xmplus1_disj_b_typesN structure tuple k n =
- All ([x_new], (Or (List.map (fun x ->
- ntype structure (Array.append tuple [|x|]) k n) elements ) )) in
- Formula.flatten_sort (And [
- (ntype structure tuple k (n-1));
- (conj_b_ex_xmplus1_typesN structure tuple k (n-1));
- (all_xmplus1_disj_b_typesN structure tuple k (n-1))])
- else (* all variables already used, substitute *)
- let indices = range k in
- let substituted i e = (Aux.array_replace tuple (i-1) e) in
- let conj_b_ex_xi_typesN_replace_ai_by_b structure tuple k n i =
- And (List.map (fun x ->
- Ex ([`FO ("x"^(string_of_int i))],
- (ntype structure (substituted i x) k n))
- ) elements) in
- let all_xi_disj_b_typesN_replace_ai_by_b structure tuple k n i=
- All ([`FO ("x"^(string_of_int i))],
- ( Or (List.map (fun x ->
- (ntype structure (substituted i x) k n)) elements ))) in
- Formula.flatten_sort (And [
- (ntype structure tuple k (n-1));
- (And ( (List.map (fun i ->
- (And [(conj_b_ex_xi_typesN_replace_ai_by_b structure tuple k (n-1) i);
- (all_xi_disj_b_typesN_replace_ai_by_b structure tuple k (n-1) i)
- ])) indices )))])
-
-let rec all_ntypes_ktuples ?(acc_types=[]) ?(tuples=None) structure n k =
- let elements = Structure.elements structure in
- let tuples = match tuples with Some tp -> tp | None ->
- List.map Array.of_list (Aux.all_ntuples elements k) in
- match tuples with
- | head::tail ->
- let ntyp = (ntype structure head k n) in
- let vars = (List.map (fun i -> "x"^string_of_int i) (range k)) in
- let check tuple = check structure tuple (Array.of_list vars) ntyp in
- let filtered = List.filter (fun t -> not (check t)) tail in
- (all_ntypes_ktuples ~acc_types:(ntyp::acc_types)
- ~tuples:(Some filtered) structure n k)
- | _ -> acc_types
-
-
-(* --- WITH SIMPLIFICATION --- *)
-
-let atoms_simplified ?(min=true) structure tuples variables =
- let tlist = Array.map (fun tuple ->
- Aux.unique_sorted (atoms structure tuple variables)) tuples in
- let tlistF =
- if min then separate_conjs (Array.length tuples < 80) tlist else tlist in
- let tuplesTable = Hashtbl.create 7 in
- Array.iteri (fun i tuple->
- Hashtbl.add tuplesTable tuple (Formula.flatten_sort (And (tlistF.(i))))
- ) tuples;
- tuplesTable
-
-let nextTypes ?(min=true) structure tuples variables types =
- let conjuncts tuple =
- let indices = range (Array.length tuple) in
- let substituted i e = Aux.array_replace tuple (i-1) e in
- let sorted tp = Array.of_list (Aux.unique_sorted (Array.to_list tp)) in
- let all_diff i = Array.to_list (Aux.array_mapi_some (
- fun j v -> if j = i then None else
- Some (Not (Eq (fo_var_of_string variables.(i), fo_var_of_string variables.(j))))
- ) variables) in
- let all_eq i = List.map (function Not f-> f | _-> failwith "neq") (all_diff i) in
- let conj_b_ex_xi_typesN_replace_ai_by_b structure tuple i =
- Aux.unique_sorted (Aux.map_some (fun x ->
- let subst = substituted i x in
- if Array.length (sorted subst) < Array.length tuple then None else
- Some (Ex ([`FO ("x"^(string_of_int i))],
- And ( (Hashtbl.find types subst) :: (all_diff (i-1)))))
- ) (Structure.elements structure)) in
- let all_xi_disj_b_typesN_replace_ai_by_b structure tuple i=
- All ([`FO ("x"^(string_of_int i))],
- (Or ((all_eq (i-1)) @ Aux.unique_sorted (Aux.map_some (
- fun x ->
- let subst = substituted i x in
- if Array.length (sorted subst) < Array.length tuple then None
- else Some (Hashtbl.find types (substituted i x))
- ) (Structure.elements structure) )))) in
- ((Hashtbl.find types tuple)::
- (List.flatten (List.map (fun i ->
- (all_xi_disj_b_typesN_replace_ai_by_b structure tuple i)::
- (conj_b_ex_xi_typesN_replace_ai_by_b structure tuple i)
- ) indices ))) in
- let tlist = Array.map conjuncts tuples in
- let tlistF = if min then separate_conjs false tlist else tlist in
- let tuplesTable = Hashtbl.create 7 in
- Array.iteri (fun i tuple->
- Hashtbl.add tuplesTable tuple (Formula.flatten_sort (And (tlistF.(i))))
- ) tuples;
- tuplesTable
-
-let rec ntypesSimplified ?(min=true) ?cur_types tuples variables structure n k =
- let x, types = match cur_types with
- | Some (step, typs) -> (step, typs)
- | None -> (0, atoms_simplified ~min structure tuples variables) in
- if x >= n then types else
- ntypesSimplified
- ~cur_types:(x+1, nextTypes ~min structure tuples variables types)
- tuples variables structure n k
-
-let rec all_ntypes_simplified ?(min=true) structure n k =
- let rec no_rept l = List.length l = List.length (Aux.unique_sorted l) in
- let tuples =
- Array.of_list (List.map Array.of_list (List.filter no_rept (
- Aux.all_ntuples (Structure.elements structure) k))) in
- let variables =
- Array.map (fun i -> "x"^string_of_int(i)) (Array.of_list (range k)) in
- ntypesSimplified ~min tuples variables structure n k
-
-(* Helper function: remove atoms from a formula if [cond] is still satisfied.
- Note that this is just a greedy heuristic, only And/Or and into Ex/All. *)
-let rec greedy_remove cond phi =
- let rec greedy_remove_list constructor acc = function
- | [] -> acc
- | x :: xs ->
- let rest = acc @ xs in
- if cond (constructor rest) then greedy_remove_list constructor acc xs else
- let minx = greedy_remove (fun y -> cond (constructor (y :: rest))) x in
- greedy_remove_list constructor (minx::acc) xs in
- match phi with
- | And fl -> And (greedy_remove_list (fun l -> And l) [] (List.rev fl))
- | Or fl -> Or (greedy_remove_list (fun l -> Or l) [] (List.rev fl))
- | Not f -> Not (greedy_remove (fun x -> cond (Not x)) f)
- | Ex (vs, f) -> Ex (vs, greedy_remove (fun x -> cond (Ex (vs, x))) f)
- | All (vs, f) -> All (vs, greedy_remove (fun x -> cond (All (vs, x))) f)
- | phi -> phi
-
-
-let distinguish_by_type ?(min=true) ?(skip_outer_exists=false) ~qr ~k sPos sNeg=
- let listht table = Hashtbl.fold (fun x y z -> y :: z) table [] in
- let types s= Aux.unique_sorted (listht (all_ntypes_simplified ~min s qr k)) in
- let (tpPos, tpNeg) = (List.map types sPos, List.map types sNeg) in
- let all_diff vars = Aux.map_some (
- function [x; y] -> if x < y then Some (Not (Eq (x, y))) else None| _ -> None
- ) (Aux.all_ntuples (List.map to_fo vars) 2) in
- let fails_neg f = (* check whether f fails on all negative structs *)
- let f = And (f :: (all_diff (FormulaSubst.free_vars f))) in
- not (List.exists (fun s -> check s [||] [||] f) sNeg) in
- let succ_pos fl = (* check whether disjunction of fl holds on all positives *)
- let f = And ((Or fl) :: (all_diff (FormulaSubst.free_vars (Or fl)))) in
- List.for_all (fun s -> check s [||] [||] f) sPos in
- let candidates = List.rev_append (List.concat tpPos)
- (List.map (fun f -> Not f) (List.concat tpNeg)) in
- let fail_neg = List.filter fails_neg (Aux.unique_sorted candidates) in
- let phis = List.sort Formula.compare (Aux.unique_sorted fail_neg) in
- let rec find_type acc = function
- | [] -> []
- | x :: xs -> if succ_pos (x::acc) then x :: acc else
- find_type (x::acc) xs in
- let dtypes = find_type [] phis in
- if dtypes = [] then None else
- let is_ok f = fails_neg f && succ_pos [f] in
- let mintp = greedy_remove is_ok (Or dtypes) in
- let fv = FormulaSubst.free_vars (Or dtypes) in
- let t= FormulaOps.rename_quant_avoiding ((var_of_string "x0")::fv) mintp in
- if skip_outer_exists then Some t else
- Some (Ex (List.sort Formula.compare_vars fv, t))
-
-let distinguish ?(skip_outer_exists=false) strucs1 strucs2 =
- if !debug_level > 0 then
- Printf.printf "distinguishing:\n\n%s\n\n and\n\n %s\n%!"
- (String.concat "\n" (List.map Structure.str strucs1))
- (String.concat "\n" (List.map Structure.str strucs2));
- let rec diff qr k =
- if qr > k then diff 0 (k+1) else (
- if !debug_level > 0 then Printf.printf "distinguish qr %i k %i\n%!" qr k;
- match distinguish_by_type ~skip_outer_exists ~qr ~k strucs1 strucs2 with
- | Some f -> f
- | None -> match distinguish_by_type ~min:false ~skip_outer_exists
- ~qr ~k strucs1 strucs2 with
- | Some f -> f
- | None -> diff (qr+1) k
- ) in
- diff 0 1
Deleted: trunk/Toss/Solver/WL.mli
===================================================================
--- trunk/Toss/Solver/WL.mli 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Solver/WL.mli 2011-11-10 01:26:59 UTC (rev 1625)
@@ -1,43 +0,0 @@
-(** The WL algorithm and related tests. *)
-
-(** Given an array of lists, i.e. a.(i) is a list, find an array b of the same
- size of sub-lists (b.(i) subset a.(i)) such that if there was an element
- distinguishing a.(i) from a.(j) then one separates b.(i) from b.(j).
- This can be done in many ways (is it NP-complete to get the shortest b?),
- we remove the intersection and after this greedily unused elements if
- the option [greedy_cleanup] is set. *)
-val separate: ?cmp: ('a -> 'a -> int) -> ?greedy_cleanup: bool ->
- 'a list array -> 'a list array
-
-(** The list of literals which hold for a tuple on a structure,
- i.e. the atomic type of this tuple. *)
-val atoms: Structure.structure -> int array -> string array ->
- Formula.formula list
-
-(** The n-type from FO^k for the given int tuple in the structure. *)
-val ntype: Structure.structure -> int array -> int -> int -> Formula.formula
-
-(** All n-types from FO^k for the given structure, with accumulators. *)
-val all_ntypes_ktuples: ?acc_types: Formula.formula list ->
- ?tuples: int array list option ->
- Structure.structure -> int -> int -> Formula.formula list
-
-val atoms_simplified: ?min:bool -> Structure.structure -> int array array ->
- string array -> (int array,Formula.formula) Hashtbl.t
-
-val all_ntypes_simplified: ?min:bool -> Structure.structure -> int -> int ->
- (int array, Formula.formula) Hashtbl.t
-
-(** Distinguish two structures using n-types from FO^k, a bit minimized. *)
-val distinguish_by_type: ?min:bool -> ?skip_outer_exists: bool ->
- qr: int -> k: int ->
- Structure.structure list -> Structure.structure list -> Formula.formula option
-
-(** Distinguish two structures. *)
-val distinguish: ?skip_outer_exists: bool ->
- Structure.structure list -> Structure.structure list -> Formula.formula
-
-
-(** {2 Debugging} *)
-
-val set_debug_level: int -> unit
Deleted: trunk/Toss/Solver/WLTest.ml
===================================================================
--- trunk/Toss/Solver/WLTest.ml 2011-11-08 09:44:53 UTC (rev 1624)
+++ trunk/Toss/Solver/WLTest.ml 2011-11-10 01:26:59 UTC (rev 1625)
@@ -1,244 +0,0 @@
-open OUnit
-
-let formula_of_string s =
- FormulaParser.parse_formula Lexer.lex (Lexing.from_string s)
-
-let struc_of_string s =
- StructureParser.parse_structure Lexer.lex (Lexing.from_string s)
-
-let formula_eq ?(flatten_sort=true) phi1 phi2 =
- if flatten_sort then
- assert_equal ~printer:(fun x -> Formula.sprint x)
- (Formula.flatten_sort (formula_of_string phi1))
- (Formula.flatten_sort phi2)
- else
- assert_equal ~printer:(fun x -> Formula.sprint x)
- (formula_of_string phi1) phi2
-
-let formula_list_eq ?(flatten_sort=true) l1 l2 =
- List.iter2 (formula_eq ~flatten_sort) l1 l2
-
-let formula_option_eq ?(flatten_sort=true) fopt1 fopt2 =
- let fopt_str = function None -> "None" | Some f -> Formula.str f in
- if fopt1 = "None" then
- assert_equal ~printer:fopt_str None fopt2
- else match fopt2 with
- | None -> assert_equal ~printer:(fun x -> x) fopt1 "None"
- | Some f -> formula_eq ~flatten_sort fopt1 f
-
-let hashtbl_eq struc list ht =
- let str_pair (tuple, phi) =
- (Structure.tuple_str struc tuple) ^ "->" ^ (Formula.str phi) in
- let str ps = String.concat "; " (List.map str_pair ps) in
- let hashtbl_to_list ht =
- let res = ref [] in
- Hashtbl.iter (fun k v -> res := (k, v) :: !res) ht; !res in
- let lst = List.map (fun (tp, fs) -> (tp, formula_of_string fs)) list in
- let simp l = List.sort Pervasives.compare
- (List.map (fun (t, f) -> (t, Formula.flatten f)) l) in
- assert_equal ~printer:str (simp lst) (simp (hashtbl_to_list ht))
-
-let array_list_str f a = "[| [" ^ (String.concat "]; [" (
- List.map (fun l -> String.concat ";" (List.map f l))
- (Array.to_list a))) ^ "] |]"
-
-
-let tests = "WL" >::: [
- "separate" >::
- (fun () ->
- let str = array_list_str string_of_int in
- assert_equal ~printer:str [| [1]; [3] |]
- (WL.separate [| [1;2]; [2;3] |]);
- assert_equal ~printer:str [| [1]; [3] |]
- (WL.separate [| [1;2]; [2;3] |]);
- assert_equal ~printer:str [| [3;1]; [-3]; [-1] |]
- (WL.separate [| [1;2;3;4]; [1;2;-3;4]; [-1;2;3;4] |]);
- assert_equal ~printer:str [| [3;1]; [-3]; [-1] |]
- (WL.separate [|[1;2;3;4]; [1;2;-3;4]; [-1;2;3;4]|]);
- );
-
- "atoms" >::
- (fun () ->
- let variables = ["x1";"x2"] in
- let structure = struc_of_string "[ | R { (1, 2); (2, 3) } | ]" in
- formula_eq
- "(not R(x1, x1) and R(x1, x2) and not R(x2, x1) and not R(x2, x2) and not x1=x2)"
- (Formula.And (WL.atoms structure [|2; 3|] (Array.of_list variables)));
- );
-
- "ntype" >::
- ( fun () ->
- let structure = (struc_of_string "[ | R { (1, 2) } | ]") in
- formula_eq ("R(x1,x2) and not R(x1,x1) and not x1=x2 and not R(x2, x1)" ^
- " and not R(x2, x2)") (WL.ntype structure [|1;2|] 1 0);
- formula_eq
- "(R(x1, x2) and not R(x1, x1) and not x1 = x2 and not R(x2, x1) and not R(x2, x2) and
- ex x1 (R(x1, x2) and not R(x1, x1) and not x1 = x2 and not R(x2, x1) and not R(x2, x2)) and
- ex x1 (x1 = x2 and not R(x1, x1) and not R(x1, x2) and not R(x2, x1) and not R(x2, x2)) and
- ex x2 (R(x1, x2) and not R(x1, x1) and not x1 = x2 and not R(x2, x1) and not R(x2, x2)) and
- ex x2 (x1 = x2 and not R(x1, x1) and not R(x1, x2) and not R(x2, x1) and not R(x2, x2)) and
- all x1 ((R(x1, x2) and not R(x1, x1) and not x1 = x2 and not R(x2, x1) and not R(x2, x2)) or
- (x1 = x2 and not R(x1, x1) and not R(x1, x2) and not R(x2, x1) and not R(x2, x2))) and
- all x2 ((R(x1, x2) and not R(x1, x1) and not x1 = x2 and not R(x2, x1) and not R(x2, x2)) or
- (x1 = x2 and not R(x1, x1) and not R(x1, x2) and not R(x2, x1) and not R(x2, x2))))"
- (WL.ntype structure [|1;2|] 2 1);
-
- formula_eq
- "(R(x1, x2) and not R(x1, x1) and not x1 = x2 and not R(x2, x1) and not R(x2, x2) and
- ex x3 (R(x1, x2) and R(x1, x3) and x2 = x3 and not R(x1, x1) and not x1 = x2 and not x1 = x3 and not R(x2, x1) and not R(x2, x2) and not R(x2, x3) and not R(x3, x1) and not R(x3, x2) and not R(x3, x3)) and
- ex x3 (R(x1, x2) and x1 = x3 and R(x3, x2) and not R(x1, x1) and not x1 = x2 and not R(x1, x3) and not R(x2, x1) and not R(x2, x2) and not R(x2, x3) and not x2 = x3 and not R(x3, x1) and not R(x3, x3)) and
- all x3 ((R(x1, x2) and R(x1, x3) and x2 = x3 and not R(x1, x1) and not x1 = x2 and not x1 = x3 and not R(x2, x1) and not R(x2, x2) and not R(x2, x3) and not R(x3, x1) and not R(x3, x2) and not R(x3, x3)) or
- (R(x1, x2) and x1 = x3 and R(x3, x2) and not R(x1, x1) and not x1 = x2 and not R(x1, x3) and not R(x2, x1) and not R(x2, x2) and not R(x2, x3) and not x2 = x3 and not R(x3, x1) and not R(x3, x3))))"
- (WL.ntype structure [|1;2|] 3 1);
- );
-
- "all_ntypes" >::
- (fun () ->
- let structure = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
- formula_list_eq
- ["(R(x2, x1) and not R(x1, x1) and not R(x1, x2) and not x1 = x2 and not R(x2, x2))";
- "(not R(x1, x1) and not R(x1, x2) and not R(x2, x1) and not R(x2, x2) and not x1=x2)";
- "(not R(x1, x1) and R(x1, x2) and not R(x2,x1) and not R(x2,x2) and not x1=x2)";
- "(not R(x1,x1) and not R(x1,x2) and not R(x2,x1) and not R(x2,x2) and x1=x2)"]
- (WL.all_ntypes_ktuples structure 0 2);
- );
-
- "atoms_simplified" >::
- (fun () ->
- let structure = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
- hashtbl_eq structure
- [ ([|1;2|], "R(x1, x2)"); ([|3;3|], "x1 = x2") ]
- (WL.atoms_simplified structure [| [| 1;2 |]; [|3;3|] |] [|"x1";"x2"|]);
- );
-
- "all_ntypes_simplified" >::
- (fun () ->
- let structure = (struc_of_string "[ | R { (1, 2) } | ]") in
- hashtbl_eq structure
- [ ([|1;2|], "R(x1, x2)");
- ([|2;1|], "R(x2, x1)")]
- (WL.all_ntypes_simplified structure 0 2);
- let structure = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
- hashtbl_eq structure
- [ ([|1;2|], "R(x1, x2)");
- ([|2;1|], "R(x2, x1)");
- ([|1;3|], "not R(x1, x2) and not R(x2, x1)");
- ([|3;1|], "not R(x1, x2) and not R(x2, x1)");
- ([|2;3|], "R(x1, x2)");
- ([|3;2|], "R(x2, x1)")]
- (WL.all_ntypes_simplified structure 0 2);
- );
-
- "distinguish_by_type" >::
- (fun () ->
- let structure1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
- let structure2 = (struc_of_string "[ | R { (1, 2) } | ]") in
- formula_option_eq "None"
- (WL.distinguish_by_type ~qr:2 ~k:1 [structure1] [structure2]);
- formula_option_eq "ex x1, x2 (not R(x1, x2) and not R(x2, x1))"
- (WL.distinguish_by_type ~qr:0 ~k:2 [structure1] [structure2]);
- formula_option_eq "ex x1, x2, x3 (R(x1, x2) and R(x2, x3))"
- (WL.distinguish_by_type ~qr:0 ~k:3 [structure1] [structure2]);
- formula_option_eq "not R(x1, x2) and not R(x2, x1)"
- (WL.distinguish_by_type ~skip_outer_exists:true ~qr:1 ~k:2
- [structure1] [structure2]);
-
- let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
- let struc2 = (struc_of_string "[ | P:1 {}; R { (1) } | ]") in
- formula_option_eq "ex x1 P(x1)"
- (WL.distinguish_by_type ~min:false ~qr:0 ~k:1 [struc1] [struc2]);
- );
-
- "distinguish" >::
- (fun () ->
- let structure1 = (struc_of_string "[ | R { (1, 2); (2, 3) } | ]") in
- let structure2 = (struc_of_string "[ | R { (1, 2) } | ]") in
- formula_eq "ex x1, x2 (not R(x1, x2) and not R(x2, x1))"
- (WL.distinguish [structure1] [structure2]);
-
- let struc1 = (struc_of_string "[ | P { (1) }; R:1 {} | ]") in
- let struc2 = (struc_of_string "[ | P:1 {}; R { (1) } | ]") in
- formula_eq "ex x1 P(x1)" (WL.distinguish [struc1] [struc2]);
- );
-]
-
-let bigtests = "WLBig" >::: [
- "distinguish" >::
- (fun () ->
- let strucN1 = struc_of_string "[ | | ] \"
- ... ...
- ... P..
- ...
- P..
- ... ...
- ...P ...
-\"" in
- let strucN2 = struc_of_string "[ | | ] \"
- ... ...
- ...P ...
- ...
- ...
- ... ...
- ...P ...
-\"" in
- let strucN3 = struc_of_string "[ | | ] \"
- ... ...
- ...P ...
- ...
- P..
- ... ...
- ... ...
-\"" in
- let strucP = struc_of_string "[ | | ] \"
- ... ...
- ...P ...
- ...
- P..
- ... ...
- ...P ...
-\"" in
- formula_eq
- "P(x2) and ex x3 (P(x3) and C(x2, x3)) and ex x3 (P(x3) and C(x3, x2))"
- (WL.distinguish ~skip_outer_exists:true
- [strucP] [strucN1; strucN2; strucN3]);
-
- let struc1 = struc_of_string "[ | | ] \"
- ... ... ... ...
- ... W.. ...B ...
- ... ... ... ...
- ... ... ... B..
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... W..
- ... ... ... ...
- ...W ... ... ...
-\"" in
- let struc2 = struc_of_string "[ | | ] \"
- ... ... ... ...
- ... ... ...B ...
- ... ... ... ...
- ... ...W ... B..
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... ...
- ... ... ... W..
- ... ... ... ...
- ...W ... ... ...
-\"" in assert true;
- formula_eq "W(x2) and all x3 not C(x2, x3)"
- (WL.distinguish ~skip_outer_exists:true [struc1] [struc2]);
- );
-]
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
