toss-devel-svn Mailing List for Toss (Page 21)
Status: Beta
Brought to you by:
lukaszkaiser
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...> - 2010-12-12 20:24:30
|
Revision: 1248 http://toss.svn.sourceforge.net/toss/?rev=1248&view=rev Author: lukaszkaiser Date: 2010-12-12 20:24:21 +0000 (Sun, 12 Dec 2010) Log Message: ----------- Storing games and play states in db instead of files. Modified Paths: -------------- trunk/Toss/WebClient/.cvsignore trunk/Toss/WebClient/README trunk/Toss/WebClient/TossConnect.js trunk/Toss/WebClient/TossHandler.py trunk/Toss/WebClient/TossMain.js trunk/Toss/WebClient/Wrapper.py trunk/Toss/WebClient/make_db.py trunk/Toss/WebClient/register.html Added Paths: ----------- trunk/Toss/WebClient/change_colours.sh Removed Paths: ------------- trunk/Toss/WebClient/colors.html Property Changed: ---------------- trunk/Toss/WebClient/ Property changes on: trunk/Toss/WebClient ___________________________________________________________________ Modified: 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 . plays games TossServer tossdb.sqlite *.ttf *.eot *.svg *.woff *~ + # 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 . TossServer tossdb.sqlite *.ttf *.eot *.svg *.woff *~ Modified: trunk/Toss/WebClient/.cvsignore =================================================================== --- trunk/Toss/WebClient/.cvsignore 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/.cvsignore 2010-12-12 20:24:21 UTC (rev 1248) @@ -2,8 +2,6 @@ # than svn properties. Therefore if you change .cvsignore do the following. # svn propset svn:ignore -F .cvsignore . -plays -games TossServer tossdb.sqlite *.ttf Modified: trunk/Toss/WebClient/README =================================================================== --- trunk/Toss/WebClient/README 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/README 2010-12-12 20:24:21 UTC (rev 1248) @@ -1,7 +1,7 @@ This is an experimental new Toss Client, which runs in a browser. Connection with Server goes through a python wrapper and it uses sqlite, so do: - sudo apt-get install libapache2-mod-python sqite python-pysqlite2 + sudo apt-get install libapache2-mod-python sqlite3 python-pysqlite2 to run the wrapper. Make sure apache works (you may need to edit the file /etc/apache2/apache2.conf and set ServerRoot to e.g. /var/www/) and then in the file /etc/apache2/sites-enabled/[your-site] add e.g. @@ -14,25 +14,17 @@ The main handler script is called TossHander.py (server side) and corresponding JavaScript functions are in Toss*.js. To start client open index.html, but first make sure that WebClient is linked in /var/www (ln -s should suffice). +Then run "./make_db" from WebClient and make sure TossHandler top is ok. +Also copy Server from main Toss dir as TossServer to the WebClient directory. -You must create "plays/" and "games/" directories and make "plays/" writeable. -In "games/" you should place the games toss files, you can link examples -symbolically. Moreover, copy Server as TossServer to the WebClient directory. -You also need a database, run "python make_db.py" to create an empty one. -To generate thumbnails we use rsvg-convert. Install it on ubuntu with -"sudo apt-get install librsvg2-bin". To flip images and make them better we use -imagemagick, you should also install it. You need both on the server as well. - TODO: + - bug with play numbering with different players (or just hide numbers?) - change wording from play to game - - adjust colors, e.g. more whitish with yellow board? - enable google (or other) analytics - - facebook message to friend on play start - refresh (async?) plays in which the other player moves - move interface: first click all, second click toggle, if one - confirm msg - after the above: remove left-of-board div, confirm in the middle - after the above: show game result in the middle / instead of move - option to give up game and offer a draw - sort plays by who's turn it is - - bug with play numbering with different players (or just hide numbers?) Modified: trunk/Toss/WebClient/TossConnect.js =================================================================== --- trunk/Toss/WebClient/TossConnect.js 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/TossConnect.js 2010-12-12 20:24:21 UTC (rev 1248) @@ -1,9 +1,5 @@ // JavaScript Toss Module -- Connect (basic Toss Server connection routines) -var GAMES_DIR = "/var/www/WebClient/games/"; -var PLAYS_DIR = "/var/www/WebClient/plays/"; -var MAIN_DIR = "/var/www/WebClient/"; - var UNAME = ""; var MODEL_MAXX = 0.0; @@ -99,6 +95,7 @@ for (j = str.length - 1; j > -1; j--) { if (str.charAt(j) != c1 && str.charAt(j) != c2) break; } + if (i > j) { return ("") }; return (str.substring(i, j+1)); } @@ -188,9 +185,9 @@ } // Open [file_name] on Toss Server running on port [port] and get dimenstions. -function toss_open (file_name) { +function toss_open_game (game_name) { open_toss_server (); - srv (TOSS_PORT, 'c.open("' + file_name + '")'); + srv (TOSS_PORT, 'open_game(c, "' + game_name + '")'); var dim_msg = srv (TOSS_PORT, "c.model.get_dim()"); var dim = strip('(', ')', dim_msg).split(','); MODEL_MAXX = parseFloat(strip(' ', ' ', dim[0])); @@ -201,7 +198,21 @@ MODEL_HEIGHT = Math.max (SVG_HEIGHT / 100, (MODEL_MAXY - MODEL_MINY)); } +// Open [file_name] on Toss Server running on port [port] and get dimenstions. +function toss_open_db (file_name_params) { + open_toss_server (); + srv (TOSS_PORT, 'open_db(c, ' + file_name_params + ')'); + var dim_msg = srv (TOSS_PORT, "c.model.get_dim()"); + var dim = strip('(', ')', dim_msg).split(','); + MODEL_MAXX = parseFloat(strip(' ', ' ', dim[0])); + MODEL_MINX = parseFloat(strip(' ', ' ', dim[1])); + MODEL_MAXY = parseFloat(strip(' ', ' ', dim[2])); + MODEL_MINY = parseFloat(strip(' ', ' ', dim[3])); + MODEL_WIDTH = Math.max (SVG_WIDTH / 100, (MODEL_MAXX - MODEL_MINX)); + MODEL_HEIGHT = Math.max (SVG_HEIGHT / 100, (MODEL_MAXY - MODEL_MINY)); +} + // ---- Two functions below are very basic and thus in this file. --- // Create basic svg box. Modified: trunk/Toss/WebClient/TossHandler.py =================================================================== --- trunk/Toss/WebClient/TossHandler.py 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/TossHandler.py 2010-12-12 20:24:21 UTC (rev 1248) @@ -16,6 +16,12 @@ file.write (str) file.close() +def get_all_from_db (tbl, select_s): + res = [] + for r in db.execute("select * from " + tbl + " where " + select_s): + res.append(r) + return (res) + def is_toss_server (host, port): """Simple server check - tries to get time from Toss server.""" try: @@ -45,63 +51,55 @@ subprocess.call(["cp", f1, f2]) def list_plays (game, player_id): - lsp = "ls /var/www/plays/" + str(game) + "*_" + str(player_id) + "_*.toss" - ls = subprocess.Popen([lsp], shell=True, stdout=subprocess.PIPE).communicate()[0] - return (ls) + or_s = "(player1='" + player_id + "' or player2='" + player_id + "')" + plays = get_all_from_db ("cur_states", "game='" + game + "' and " + or_s) + def play_name (p): + (g, p1, p2, pid, move, toss, svg) = p + return ("/plays/" + str(g) + "_" + str(p1) + "_" + str(p2) + "_" + + str(pid) + "_" + str(move)) + return (str([play_name (p) for p in plays])) -def write_svg (fname, svg_str): - svgfile = open (fname + ".svg", 'w') - svgfile.write ('<?xml-stylesheet href="TossStyle.css" type="text/css"?>\n') - svgfile.write (svg_str) - svgfile.close() - subprocess.call(["rsvg-convert", fname + ".svg", "-h", "20", "-w", "20", "-o", fname + ".png"]) - #subprocess.call(["convert", "-flip", fname + ".png", fname + ".png"]) +def db_cur_insert (game, p1, p2, pid, move, toss, svg_str): + db.execute ("insert into cur_states(game, player1, player2, playid, move, toss, svg) values (?, ?, ?, ?, ?, ?, ?)", (game, p1, p2, pid, move, toss, svg_str)) + db.commit () -def new_play (orig_f, fname, svg_str): - cp (orig_f, fname + ".toss") - write_svg (fname, svg_str) - return ("ok"); +def db_old_insert (game, p1, p2, pid, move, toss, svg_str): + db.execute ("insert into old_states(game, player1, player2, playid, move, toss, svg) values (?, ?, ?, ?, ?, ?, ?)", (game, p1, p2, pid, move, toss, svg_str)) + db.commit () -def move_play (client, old_fn, new_fn, svg_s): - state = client.get_state () - file = open (new_fn + ".toss", 'w') - file.write (state) - file.close () - subprocess.call(["mv", old_fn + ".toss", old_fn + ".tossm"]) - write_svg (new_fn, svg_s) - return ("OK") +def new_play (game, p1, p2, pid, move, svg_str): + res = get_all_from_db ("games", "game='" + game + "'") + (_, toss) = res[0] + db_cur_insert (game, p1, p2, pid, move, toss, svg_str) + return ("ok") -def change_colors (a, b, c, d): - file = open ("/var/www/plays/change.sh", 'w') - file.write ('#!/bin/bash' + "\n") - file.write ('export VERYLIGHT="' + a + '";' + "\n") - file.write ('export LIGHT="' + b + '";' + "\n") - file.write ('export DARK="' + c + '";' + "\n") - file.write ('export VERYDARK="' + d + '";' + "\n") - file.write (''' - sed "s/b5bf8f/NLGHT/g" /var/www/TossStyle.css | - sed "s/ffe4aa/VRYLGHT/g" | - sed "s/400827/NDRK/g" | - sed "s/260314/VRYDRK/g" | - sed "s/VRYLGHT/$VERYLIGHT/g" | - sed "s/NLGHT/$LIGHT/g" | - sed "s/NDRK/$DARK/g" | - sed "s/VRYDRK/$VERYDARK/g" > /var/www/plays/TossAltStyle.css'''); - file.close () - x = subprocess.call(["chmod a+x /var/www/plays/change.sh"], shell=True) - if x == 0: - cg = subprocess.call(["/var/www/plays/change.sh"], shell=True) - if cg == 0: return("Changed") - return ("Some error encountered, please try again in a few seconds.") +def game_select_s (g, p1, p2, pid, m): + return("game='" + g + "' and player1='" + p1 + "' and player2='" + p2 + + "' and playid=" + pid + " and move=" + m) -def get_from_db (uid, tbl): - res = [] - for r in db.execute("select * from passwd where id='" + uid + "'"): - res.append(r) - return (res) +def open_db (client, game, p1, p2, pid, move): + select_s = game_select_s (game, p1, p2, pid, move) + res = get_all_from_db ("cur_states", select_s) + (_, _, _, _, _, toss, _) = res[0] + client.open_from_str (toss) -def passwd_from_db (uid): - res = get_from_db (uid, "passwd") +def open_game (client, game): + res = get_all_from_db ("games", "game='" + game + "'") + (_, toss) = res[0] + client.open_from_str (toss) + +def move_play (client, g, p1, p2, pid, m, svg_s): + new_toss = client.get_state () + select_s = game_select_s (g, p1, p2, pid, m) + old_res = get_all_from_db ("cur_states", select_s) + (_, _, _, _, _, old_toss, old_svg) = old_res[0] + db.execute ("delete from cur_states where " + select_s) + db_old_insert (g, p1, p2, pid, m, old_toss, old_svg) + db_cur_insert (g, p1, p2, pid, int(m) + 1, new_toss, svg_s) + return ("OK") + +def passwd_from_db (uid): + res = get_all_from_db ("passwd", "id='" + uid + "'") if len(res) > 1: raise Exception ("db", "multiple passwords for " + uid) if len(res) == 0: return (None) (uid, passwd) = res[0] @@ -141,10 +139,6 @@ msg = req.read () #tmp_log(msg) if msg.find('#') == -1: - if msg.find('COL') > -1: - res = eval (msg.replace('COL', 'change_colors')) - req.write(str(res)) - return apache.OK port = open_toss_server (free_toss_port ()) req.write(str(port)) return apache.OK Modified: trunk/Toss/WebClient/TossMain.js =================================================================== --- trunk/Toss/WebClient/TossMain.js 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/TossMain.js 2010-12-12 20:24:21 UTC (rev 1248) @@ -116,6 +116,11 @@ PLAYS[i][1] + "_" + PLAYS[i][2] + "_" + PLAYS[i][3]) } +function play_file_cmd (i) { + return ("'" + GAME_NAME + "', '" + PLAYS[i][0] + "', '" + + PLAYS[i][1] + "', '" + PLAYS[i][2] + "', '" + PLAYS[i][3] + "'") +} + function new_play_item (i) { var li = document.createElement('li'); li.setAttribute ("class", "plays-list-elem"); @@ -141,8 +146,7 @@ while (plist.childNodes.length > 0) { plist.removeChild(plist.firstChild); } var d = game.length + 2; for (var i = 0; i < PLAYS.length; i++) { - var p = PLAYS[i].substring(PLAYS[i].lastIndexOf('/') + d, - PLAYS[i].length - 5); + var p = PLAYS[i].substring(PLAYS[i].lastIndexOf('/') + d); PLAYS[i] = convert_python_list ('_', p); if (PLAYS[i][2] > MAX_PLAY_NO) { MAX_PLAY_NO = PLAYS[i][2]; } plist.appendChild(new_play_item (i)); @@ -176,7 +180,7 @@ create_svg_box ("19em", "19em", 40, 40, "board"); } document.getElementById("opening").style.display = "block"; - toss_open (GAMES_DIR + game + ".toss"); + toss_open_game (game); document.getElementById("opening").style.display = "none"; list_plays (game); document.getElementById("game-disp").style.display = "block"; @@ -190,7 +194,7 @@ VIEW_MIRROR = (PLAYS[CUR_PLAY_I][0] == UNAME) ? 0 : 1; document.getElementById("cur-player").innerHTML = PLAYS[CUR_PLAY_I][PLAYS[CUR_PLAY_I][3] % 2]; - toss_open (MAIN_DIR + play + ".toss"); + toss_open_db (play_file_cmd(pi)); full_redraw (); } @@ -212,11 +216,9 @@ PLAYS[CUR_PLAY_I][(m + 1) % 2]; document.getElementById('cur-move').innerHTML = "none"; full_redraw (); - var fn_old = MAIN_DIR + play_file_name (CUR_PLAY_I); + var fn = play_file_cmd (CUR_PLAY_I); PLAYS[CUR_PLAY_I][3] = parseInt(PLAYS[CUR_PLAY_I][3]) + 1; - var fn_new = MAIN_DIR + play_file_name (CUR_PLAY_I); - srv (TOSS_PORT, "move_play(c, '" + fn_old + "', '" + fn_new + "', " + - svg_string () + ")"); + srv (TOSS_PORT, "move_play(c, " + fn + ", " + svg_string () + ")"); var old_li = document.getElementById ("plays-list-elem-" + CUR_PLAY_I); var li = new_play_item (CUR_PLAY_I); old_li.parentNode.replaceChild (li, old_li); @@ -331,12 +333,11 @@ document.getElementById("plays").style.left = "30em"; var p = [UNAME, opp_uid, MAX_PLAY_NO, 0]; PLAYS.push(p); - toss_open (GAMES_DIR + GAME_NAME + ".toss"); + toss_open_game (GAME_NAME); document.getElementById("game-desc").style.display = "none"; full_redraw (); - var fn = MAIN_DIR + play_file_name (CUR_PLAY_I); - srv (TOSS_PORT, "new_play('" + GAMES_DIR + GAME_NAME + ".toss', '" + - fn + "', " + svg_string () + ")"); + var fn = play_file_cmd (CUR_PLAY_I); + srv (TOSS_PORT, "new_play(" + fn + ", " + svg_string () + ")"); li = new_play_item (CUR_PLAY_I); document.getElementById("plays-list").appendChild(li); } Modified: trunk/Toss/WebClient/Wrapper.py =================================================================== --- trunk/Toss/WebClient/Wrapper.py 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/Wrapper.py 2010-12-12 20:24:21 UTC (rev 1248) @@ -424,6 +424,10 @@ params[ps[0]] = float(ps[1]) return ((msg[0], emb, params, int(msg[3]))) + def open_from_str (self, s): + state_str = ("#db#") + "$".join (s.split ("\n")) + self.set_state (state_str) + def open (self, file_name_s): file_name = str(file_name_s) if file_name == '': return Added: trunk/Toss/WebClient/change_colours.sh =================================================================== --- trunk/Toss/WebClient/change_colours.sh (rev 0) +++ trunk/Toss/WebClient/change_colours.sh 2010-12-12 20:24:21 UTC (rev 1248) @@ -0,0 +1,14 @@ +#!/bin/bash +export VERYLIGHT="f0f0f0"; +export LIGHT="b9bdbc"; +export DARK="3c3b37"; +export VERYDARK="000000"; + + sed "s/b5bf8f/NLGHT/g" TossStyle.css | + sed "s/ffe4aa/VRYLGHT/g" | + sed "s/400827/NDRK/g" | + sed "s/260314/VRYDRK/g" | + sed "s/VRYLGHT/$VERYLIGHT/g" | + sed "s/NLGHT/$LIGHT/g" | + sed "s/NDRK/$DARK/g" | + sed "s/VRYDRK/$VERYDARK/g" > TossAltStyle.css Property changes on: trunk/Toss/WebClient/change_colours.sh ___________________________________________________________________ Added: svn:executable + * Deleted: trunk/Toss/WebClient/colors.html =================================================================== --- trunk/Toss/WebClient/colors.html 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/colors.html 2010-12-12 20:24:21 UTC (rev 1248) @@ -1,75 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> -<html xmlns="http://www.w3.org/1999/xhtml" xmlns:svg="http://www.w3.org/2000/svg" xml:lang="en" lang="en"> -<head> - <meta http-equiv="Content-Type" content="text/xhtml+xml; charset=UTF-8" /> - <title>tPlay</title> - <meta http-equiv="X-UA-Compatible" content="chrome=1"> - <link rel="icon" type="image/vnd.microsoft.icon" href="/favicon.ico" /> - <link rel="stylesheet" type="text/css" href="http://fonts.googleapis.com/css?family=OFL+Sorts+Mill+Goudy+TT"/> - <link rel="stylesheet" type="text/css" href="TossStyle.css" media="screen" title="Default"/> - <link rel="alternate stylesheet" type="text/css" href="plays/TossAltStyle.css" media="screen" title="Alternate"/> - <script type="text/javascript" src="Hyphenator.js"> </script> - <script type="text/javascript"> - Hyphenator.config({minwordlength : 4}); - Hyphenator.run(); - - // Send [msg] to server and return response text. - function sync_server_msg (msg) { - var xml_request = new XMLHttpRequest (); - xml_request.open ('POST', 'TossHandler.py', false); - xml_request.setRequestHeader ('Content-Type', - 'application/x-www-form-urlencoded; charset=UTF-8'); - xml_request.send (msg); - return (xml_request.responseText); - } - - function change_color (a, b, c, d) { - alert (sync_server_msg ("COL('"+a+"', '"+b+"', '"+c+"', '"+d+"')")); - } - </script> -</head> - -<body> -<div id="top"> - <div id="logo"><a href="http://www.tplay.org">tPlay</a></div> - <div id="topbar"></div> -</div> - -<div id="main"> - -<div id="welcome" class="hyphenate"> -<p id="welcome-top">Change colors on <span class="logo-in">tPlay</span></p> -<p class="short"> -Insert four colors in the boxes below (in hex notation, as the example given) -and press the <b>Change</b> button to change the colors of the alternate -CSS style file for tPlay. Then, open tPlay again (remember to reload) and -in the <b>View</b> menu of your browser go to <b>Page Style</b> and -click on <b>Alternate</b> to see your changes. You may also do this -directly on this page to get the first impression.</p> - -<p class="short">Your colors will <b>not</b> be saved forever, -only for a short period of time. If you like them, then email -them to lukaszkaiser at gmail dot com.</p> - -<ul> -<li>Very Light # - <input id="vlt" name="vlt" value="eceab0"; type="text" style="margin-left: 0.4em" size="24"/> -</li> -<li>Light Color # <input id="lt" name="lt" value="61b594" type="text" size="24"/></li> -<li>Dark Color # <input id="dk" name="dk" value="bf4c18" type="text" size="24"/></li> -<li>Very Dark # - <input id="vdk" name="vdk" value="597533" type="text" style="margin-left: 0.4em" size="24"/> -</li> -</ul> - -<p><button onclick="change_color( - document.getElementById('vlt').value, - document.getElementById('lt').value, - document.getElementById('dk').value, - document.getElementById('vdk').value)">Change</button> -</p> - -</div> - -</body> -</html> Modified: trunk/Toss/WebClient/make_db.py =================================================================== --- trunk/Toss/WebClient/make_db.py 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/make_db.py 2010-12-12 20:24:21 UTC (rev 1248) @@ -1,11 +1,31 @@ #!/usr/bin/python +import os from pysqlite2 import dbapi2 as sqlite3 print "Creating empty Toss DB" conn = sqlite3.connect("tossdb.sqlite") conn.execute("create table passwd(id string primary key, passwd string)") +conn.execute("create table cur_states(game string, player1 string, player2 string, playid int, move int, toss string, svg string)") +conn.execute("create table old_states(game string, player1 string, player2 string, playid int, move int, toss string, svg string)") +conn.execute("create table games(game string primary key, toss string)") conn.commit () +def add_game (g): + f = open("../examples/" + g + ".toss") + toss = f.read() + f.close() + conn.execute ("insert into games(game, toss) values (?, ?)", (g, toss)) + +games = ["Breakthrough", "Chess", "Entanglement", "Gomoku", "Tic-Tac-Toe"] + +for g in games: + print ("Added " + g) + add_game (g) + +conn.commit () + +os.chmod ("tossdb.sqlite", 0777) + print "Created tossdb.sqlite" Modified: trunk/Toss/WebClient/register.html =================================================================== --- trunk/Toss/WebClient/register.html 2010-12-12 00:01:54 UTC (rev 1247) +++ trunk/Toss/WebClient/register.html 2010-12-12 20:24:21 UTC (rev 1248) @@ -18,7 +18,7 @@ <script> function sync_server_msg (msg) { var xml_request = new XMLHttpRequest (); - xml_request.open ('POST', 'PyHandler.py', false); + xml_request.open ('POST', 'TossHandler.py', false); xml_request.setRequestHeader ('Content-Type', 'application/x-www-form-urlencoded; charset=UTF-8'); xml_request.send (msg); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-12 00:02:00
|
Revision: 1247 http://toss.svn.sourceforge.net/toss/?rev=1247&view=rev Author: lukaszkaiser Date: 2010-12-12 00:01:54 +0000 (Sun, 12 Dec 2010) Log Message: ----------- Correct release script. Modified Paths: -------------- trunk/Toss/Makefile Modified: trunk/Toss/Makefile =================================================================== --- trunk/Toss/Makefile 2010-12-12 00:01:22 UTC (rev 1246) +++ trunk/Toss/Makefile 2010-12-12 00:01:54 UTC (rev 1247) @@ -6,17 +6,19 @@ Server: Play/Server.native cp _build/Play/Server.native Server -Release: - make -C . clean - make -C . Client - make -C . Server - make -C . doc - mkdir ../toss_0.5 - cp -r * ../toss_0.5 - find ../toss_0.5 -name '.svn' -exec rm -rf {} \; - rm -rf ../toss_0.5/_build ../toss_0.5/gmon.out - zip -r toss_0.5.zip ../toss_0.5 - rm -rf ../toss_0.5 +RELEASE=0.5 +Release: Client Server doc + rm -f *~ Formula/*~ Solver/*~ Arena/*~ Play/*~ Client/*~ www/*~ + make -C www + mkdir ../toss_$(RELEASE) + cp -r * ../toss_$(RELEASE) + mv ../toss_$(RELEASE) . + - find toss_$(RELEASE) -name '.svn' -exec rm -rf {} \; + rm -rf toss_$(RELEASE)/Toss.docdir + mv toss_$(RELEASE)/_build/Toss.docdir toss_$(RELEASE)/doc + rm -rf toss_$(RELEASE)/_build toss_$(RELEASE)/gmon.out + zip -r toss_$(RELEASE).zip toss_$(RELEASE) + rm -rf toss_$(RELEASE) # ------ NON OCAMLBUILD DEPENDENCIES -------- This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-12 00:01:29
|
Revision: 1246 http://toss.svn.sourceforge.net/toss/?rev=1246&view=rev Author: lukaszkaiser Date: 2010-12-12 00:01:22 +0000 (Sun, 12 Dec 2010) Log Message: ----------- Make WebClient run on local user db (start). Modified Paths: -------------- trunk/Toss/WebClient/.cvsignore trunk/Toss/WebClient/README trunk/Toss/WebClient/TossConnect.js trunk/Toss/WebClient/TossHandler.py trunk/Toss/WebClient/TossMain.js trunk/Toss/WebClient/TossStyle.css trunk/Toss/WebClient/colors.html trunk/Toss/WebClient/index.html Added Paths: ----------- trunk/Toss/WebClient/crypto-sha256.js trunk/Toss/WebClient/make_db.py trunk/Toss/WebClient/register.html Removed Paths: ------------- trunk/Toss/WebClient/TossAltStyle.css Property Changed: ---------------- trunk/Toss/WebClient/ Property changes on: trunk/Toss/WebClient ___________________________________________________________________ Modified: 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 . *.ttf *.eot *.svg *.woff *~ + # 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 . plays games TossServer tossdb.sqlite *.ttf *.eot *.svg *.woff *~ Modified: trunk/Toss/WebClient/.cvsignore =================================================================== --- trunk/Toss/WebClient/.cvsignore 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/.cvsignore 2010-12-12 00:01:22 UTC (rev 1246) @@ -2,6 +2,10 @@ # than svn properties. Therefore if you change .cvsignore do the following. # svn propset svn:ignore -F .cvsignore . +plays +games +TossServer +tossdb.sqlite *.ttf *.eot *.svg Modified: trunk/Toss/WebClient/README =================================================================== --- trunk/Toss/WebClient/README 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/README 2010-12-12 00:01:22 UTC (rev 1246) @@ -1,28 +1,26 @@ -This is an experimental new Toss Client, which is supposed to run in browsers. +This is an experimental new Toss Client, which runs in a browser. -Connection with Toss Server goes through a python wrapper, thus you need to - sudo apt-get install libapache2-mod-python -to run the wrapper, and in /etc/apache2/sites-enabled/[your-site] add e.g. - <Directory /var/www/TossClient> +Connection with Server goes through a python wrapper and it uses sqlite, so do: + sudo apt-get install libapache2-mod-python sqite python-pysqlite2 +to run the wrapper. Make sure apache works (you may need to edit the file +/etc/apache2/apache2.conf and set ServerRoot to e.g. /var/www/) and then +in the file /etc/apache2/sites-enabled/[your-site] add e.g. + <Directory /var/www/WebClient> AddHandler mod_python .py PythonHandler TossHandler # During development you might turn debugging on PythonDebug On </Directory> The main handler script is called TossHander.py (server side) and corresponding -JavaScript functions are in Toss*.js. To start client open index.html. +JavaScript functions are in Toss*.js. To start client open index.html, but +first make sure that WebClient is linked in /var/www (ln -s should suffice). -In the html root directory, or wherever you want to place this web client, you -must create "plays/" and "games/" directories and make "plays/" writeable. -In "games/" you should place the games toss files and the TossServer binary. +You must create "plays/" and "games/" directories and make "plays/" writeable. +In "games/" you should place the games toss files, you can link examples +symbolically. Moreover, copy Server as TossServer to the WebClient directory. +You also need a database, run "python make_db.py" to create an empty one. -To display text nicely hyphenated, we use a JavaScript Hyphenation program, -Hyphenator (http://code.google.com/p/hyphenator/). It is licenced under GPL3 -and you should download it separately and place "Hyphenator.js" and "patterns/" -in the same directory where you have Toss*.js files (and "plays/" directory). -You should also download and unzip font files listed in fontsstyle.css. - -To generate thumbnails we also use rsvg-convert. Install it on ubuntu with +To generate thumbnails we use rsvg-convert. Install it on ubuntu with "sudo apt-get install librsvg2-bin". To flip images and make them better we use imagemagick, you should also install it. You need both on the server as well. Deleted: trunk/Toss/WebClient/TossAltStyle.css =================================================================== --- trunk/Toss/WebClient/TossAltStyle.css 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/TossAltStyle.css 2010-12-12 00:01:22 UTC (rev 1246) @@ -1,392 +0,0 @@ -/* General */ - -html { - height: 100%; - width: 100%; -} - -body { - background-color: #eceab0; - font-family: Verdana, sans; - height: 100%; -} - -#logo { - font-size: 2em; - float: left; - font-family: 'OFL Sorts Mill Goudy TT', arial, serif; - width: 4.5em; - padding-left: 0.25em; -} - -#logo a, #logo a:link, #logo a:active, #logo a:visited { - color: #61b594; - background-color: transparent; - text-decoration: none; -} - -#logo a:hover { - color: #eceab0; -} - -.logo-in { - /*font-family: 'OFL Sorts Mill Goudy TT', arial, serif; - font-size: 1.2em;*/ -} - -#top { - font-weight: bold; - position: absolute; - top: 0px; - left: 0px; - width: 100%; - height: 2.5em; - color: #61b594; - background-color: #bf4c18; - border-color: #597533; - border-style: solid; - border-width: 0px 0px 5px 0px; -} - -#topbar { - margin-left: 9.5em; - padding-left: 1em; - padding-right: 1em; - padding-top: 0.7em; -} - -#fbpicture { - position: absolute; - top: 0px; - right: 0px; - margin-right: 0.5em; - height: 2.5em; -} - -#fbpic { - height: 2.5em; -} - -#fblogin { - float: right; - margin-right: 0em; -} - -#bottom { - position: relative; - bottom: 0px; - left: -0.5em; - width: 100%; - padding-right: 1em; - height: 1.3em; - text-align: right; - color: #61b594; - background-color: #bf4c18; - border-color: #597533; - border-style: solid; - border-width: 5px 0px 0px 0px; -} - -#sidebar { - float: left; - width: 8.2em; - color: #61b594; - background-color: #bf4c18; - margin-top: 1em; - margin-left: 0em; - padding-left: 0.1em; - border: 1px solid #597533; - -moz-border-radius: 8px; - -webkit-border-radius: 8px; -} - -#menu-top-par { - margin-top: 0.5em; - margin-bottom: 0em; -} - -#menu-list { - list-style: none; - padding: 0em; - margin: 0.25em; - margin-bottom: 0.5em; -} - -#sidebar button { - text-align: left; - border: none; - font-weight: bold; - text-decoration: none; - color: #61b594; - background-color: #bf4c18; - width: 100%; -} - -#sidebar a { - font-weight: bold; - text-decoration: none; - color: #61b594; - width: 100%; -} - -#sidebar a:hover { - color: #eceab0; -} - -#sidebar .game-highlighted { - color: #eceab0; -} - - -/* Content */ - -#main { - margin-top: 2.5em; - color: #597533; - background-color: #61b594; - margin-left: 9em; - margin-right: 1em; - padding: 1em; - min-height: 100%; - padding-bottom: 2em; - border: 1px solid #597533; - border-bottom: 0px; -} - -#main a, #main a:link, #main a:active, #main a:visited { - color: #597533; - text-decoration: underline; -} - -#main a:hover { - color: #bf4c18; - text-decoration: none; -} - - -#opponents { - display: none; - position: absolute; - left: 19em; - top: 3.5em; - min-width: 20em; - color: #61b594; - background-color: #bf4c18; - font-weight: bold; - padding: 1em; - border: 1px solid #597533; - z-index: 10; -} - -#opponents a, #opponents a:link, #opponents a:active, #opponents a:visited { - color: #61b594; - text-decoration: none; - font-weight: bold; -} - -#opponents a:hover { - color: #eceab0; -} - -#opponents-list { - list-style: square; - margin-top: 0.5em; -} - -.opponents-list-elem { - /* margin-left: -1em; */ -} - -#opponents-next { - position: absolute; - right: 1em; - bottom: 0.25em; -} - -#opponents-prev { - position: absolute; - left: 1em; - bottom: 0.25em; - display: none; -} - -#welcome { - text-align: justify; - margin-top: 1em; -} - -#welcome-top { - font-size: 1.2em; - font-weight: bold; - padding-left: 1.25em; -} - -.short { - max-width: 40em; -} - -#features-list { - list-style: square; -} - -#game-title { - font-size: 1.2em; - font-weight: bold; - margin-top: 1em; - margin-bottom: 2em; -} - -#game-disp { - position: relative; - display: none; -} - -#game-desc { - text-align: justify; - display: none; - width: 29em; - height: 19em; - margin-right: 1em; - padding-right: 1em; - border-right: 1px solid #597533; -} - -#board-disp { - position: relative; - display: none; -} - -#board { - position: absolute; - left: 9em; - padding-right: 1em; - top: 0px; - width: 20em; - height: 19em; - border-right: 1px solid #597533; -} - -#working { - position: absolute; - left: 4.5em; - top: 7em; - width: 10em; - text-align: center; - font-weight: bold; - color: #61b594; - background-color: #bf4c18; - display: none; - padding: 1em; -} - -#move { - position: absolute; - left: 0px; - top: 0px; -} - -#play-no-div { - padding-bottom: 0.5em; - padding-left: 1em; -} - -#cur-move, #cur-player { - padding-left: 1em; - margin-top: 0.5em; - margin-bottom: 0.5em; -} - -#mk-move { - padding-left: 0em; -} - -#plays { - position: absolute; - left: 30em; - top: 0px; - padding-left: 1em; -} - -#plays-list { - list-style: none; - margin-top: 0.25em; -} - -.plays-list-elem { - margin-left: -1.5em; -} - -.plays-list-elem a { - margin-right: 0.5em; -} - -.plays-list-elem .thumb { - position: relative; - top: 5px; - left: 0px; - border: 1px solid #597533; -} - - - -/* SVG styling */ -.board-outline { - fill: #eceab0; - stroke: #597533; - stroke-width: 10px; -} - -.model-elem { - fill: #eceab0; - stroke: #597533; - stroke-width: 3px; -} - -.model-elem-highlight { - fill: #61b594; - stroke: #bf4c18; - stroke-width: 3px; -} - -.model-pred-P { - fill: #bf4c18; - stroke: #597533; - stroke-width: 5px; -} - -.model-pred-Q { - fill: #eceab0; - stroke: #597533; - stroke-width: 5px; -} - -.model-pred-C { - fill: #61b594; - stroke: #597533; - stroke-width: 3px; -} - -.model-pred-R { - fill: #bf4c18; - stroke: #597533; - stroke-width: 3px; - z-index: 7; -} - -.model-pred-W { - fill: #61b594; - stroke: #597533; - stroke-width: 3px; -} - -.model-pred-B { - fill: #bf4c18; - stroke: #597533; - stroke-width: 3px; -} - -.model-edge-E { - fill: #597533; - stroke: #597533; - stroke-width: 3px; -} Modified: trunk/Toss/WebClient/TossConnect.js =================================================================== --- trunk/Toss/WebClient/TossConnect.js 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/TossConnect.js 2010-12-12 00:01:22 UTC (rev 1246) @@ -1,11 +1,10 @@ // JavaScript Toss Module -- Connect (basic Toss Server connection routines) -var GAMES_DIR = "/var/www/games/"; -var PLAYS_DIR = "/var/www/plays/"; -var MAIN_DIR = "/var/www"; +var GAMES_DIR = "/var/www/WebClient/games/"; +var PLAYS_DIR = "/var/www/WebClient/plays/"; +var MAIN_DIR = "/var/www/WebClient/"; -var UID = 0; -var UNAME = "Guest"; +var UNAME = ""; var MODEL_MAXX = 0.0; var MODEL_MINX = 0.0; @@ -50,9 +49,41 @@ xml_request.setRequestHeader ('Content-Type', 'application/x-www-form-urlencoded; charset=UTF-8'); xml_request.send (msg); - return (xml_request.responseText); + resp = xml_request.responseText; + if (resp.indexOf ("MOD_PYTHON ERROR") > -1) { + alert (resp.substring(resp.indexOf("Traceback"))); + return (""); + } + return (resp) } +// Simple encryption +function crypt (s) { + var c = Crypto.SHA256(s, true); + var d = c.replace("#", "$"); + return (d.replace(" ", "$")); +} + +// Login +function login () { + un = document.getElementById('username').value; + pwd = document.getElementById('password').value; + resp = sync_server_msg ("LOGIN#" + un + " " + crypt(pwd)); + if (resp == "OK") { + UNAME = un; + document.getElementById("topuser").innerHTML = "Welcome " + un; + document.getElementById("loginform").style.display = "none"; + } else { + alert (resp) + } +} + +// Logout +function logout () { + document.getElementById("loginform").style.display = "inline"; + document.getElementById("topuser").innerHTML = ""; +} + // Send [msg] to server attaching prefix '[port]#' and return response text. function srv (port, msg) { return (sync_server_msg (port.toString() + '#' + msg)); Modified: trunk/Toss/WebClient/TossHandler.py =================================================================== --- trunk/Toss/WebClient/TossHandler.py 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/TossHandler.py 2010-12-12 00:01:22 UTC (rev 1246) @@ -3,7 +3,14 @@ import time from Wrapper import * from mod_python import apache, Cookie +from pysqlite2 import dbapi2 as sqlite3 +DB_FILE = "/var/www/WebClient/tossdb.sqlite" + +TUID = "toss_id_05174_" + +db = None + def tmp_log (str): file = open ("/tmp/th.log", 'w') file.write (str) @@ -28,7 +35,7 @@ if not (is_toss_server ("localhost", 8110 + i)): return (8110 + i) def open_toss_server (port): - args = ["/var/www/games/TossServer", + args = ["/var/www/WebClient/TossServer", "-s", "localhost", "-t", "600", "-p", str(port)] server_proc = subprocess.Popen(args) time.sleep (0.1) @@ -87,8 +94,50 @@ if cg == 0: return("Changed") return ("Some error encountered, please try again in a few seconds.") +def get_from_db (uid, tbl): + res = [] + for r in db.execute("select * from passwd where id='" + uid + "'"): + res.append(r) + return (res) + +def passwd_from_db (uid): + res = get_from_db (uid, "passwd") + if len(res) > 1: raise Exception ("db", "multiple passwords for " + uid) + if len(res) == 0: return (None) + (uid, passwd) = res[0] + return (str(passwd)) + +def confirm_username (req): + cookies = Cookie.get_cookies(req) + if not (cookies.has_key(TUID + 'username')): return "" + if not (cookies.has_key(TUID + 'passphrase')): return "" + uid = cookies[TUID + 'username'].value + pwd1 = cookies[TUID + 'passphrase'].value + pwd2 = passwd_from_db (uid) + if (pwd1 != pwd2): return "" + return (uid) + +def login_user (req, uid, pwd): + db_pwd = passwd_from_db (uid) + if not db_pwd: return ("no such user registered") + if (pwd != db_pwd): return ("wrong password") + cookie1 = Cookie.Cookie(TUID + 'username', uid) + cookie2 = Cookie.Cookie(TUID + 'passphrase', pwd) + Cookie.add_cookie(req, cookie1) + Cookie.add_cookie(req, cookie2) + return ("OK") + +def register_user (uid, pwd): + if passwd_from_db (uid): return (False) + db.execute ("insert into passwd(id, passwd) values (?, ?)", (uid, pwd)) + db.commit () + return (True) + def handler(req): + global db req.content_type = "text/plain" + db = sqlite3.connect(DB_FILE) + usr = confirm_username (req) msg = req.read () #tmp_log(msg) if msg.find('#') == -1: @@ -99,8 +148,31 @@ port = open_toss_server (free_toss_port ()) req.write(str(port)) return apache.OK - port, sep, fun = msg.partition('#') - c = SystemClient ("localhost", int(port)) - res = eval (fun) + cmd, sep, data = msg.partition('#') + if cmd == "USERNAME": + req.write(usr) + return apache.OK + if cmd == "REGISTER": + uname, sep, pwd = data.partition(' ') + if register_user (uname, pwd): + req.write("Registration successful for " + uname) + return apache.OK + req.write("Registration failed, username " + uname + " already in use.") + return apache.OK + if cmd == "LOGIN": + uname, sep, pwd = data.partition(' ') + res = login_user (req, uname, pwd) + if res == "OK": + req.write("OK") + return apache.OK + req.write("Login failed for " + uname + ": " + res) + return apache.OK + if cmd == "LOGOUT": + cookie = Cookie.Cookie(TUID + 'passphrase', "") + Cookie.add_cookie(req, cookie) + req.write ("user logged out: " + usr + ".") + return apache.OK + c = SystemClient ("localhost", int(cmd)) + res = eval (data) req.write(str(res)) return apache.OK Modified: trunk/Toss/WebClient/TossMain.js =================================================================== --- trunk/Toss/WebClient/TossMain.js 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/TossMain.js 2010-12-12 00:01:22 UTC (rev 1246) @@ -8,9 +8,6 @@ var CUR_PLAY_I = -1; var MAX_PLAY_NO = 0; -var UNIQUEID = 0; -var ID_TO_USER_MAP = {} -var ID_TO_USER_FNAME_MAP = {} var FRIENDS = [] var MAX_OPNT_LEN = 20; @@ -114,30 +111,6 @@ } } -function fbname (uid) { - if (ID_TO_USER_MAP[uid]) { return (ID_TO_USER_MAP[uid]); } - UNIQUEID += 1; - var n = "fbname" + UNIQUEID; - var res = '<span id="' + n + '"></span>'; - FB.api('/' + uid, function(response) { - ID_TO_USER_MAP[uid] = response.name; - document.getElementById(n).innerHTML = response.name; - }); - return (res); -} - -function fbfirstname (uid) { - if (ID_TO_USER_FNAME_MAP[uid]) { return (ID_TO_USER_FNAME_MAP[uid]); } - UNIQUEID += 1; - var n = "fbfirstname" + UNIQUEID; - var res = '<span id="' + n + '"></span>'; - FB.api('/' + uid, function(response) { - ID_TO_USER_FNAME_MAP[uid] = response.first_name; - document.getElementById(n).innerHTML = response.first_name; - }); - return (res); -} - function play_file_name (i) { return ("/plays/" + GAME_NAME + "_" + PLAYS[i][0] + "_" + PLAYS[i][1] + "_" + PLAYS[i][2] + "_" + PLAYS[i][3]) @@ -149,8 +122,8 @@ li.setAttribute ("id", "plays-list-elem-" + i); var fn = play_file_name (i); var p = PLAYS[i][2]; - li.innerHTML = "" + PLAYS[i][2] + ': ' + fbname(PLAYS[i][0]) + " vs " + - fbname(PLAYS[i][1]) + " " + //" move " + PLAYS[i][3] + " "+ + li.innerHTML = "" + PLAYS[i][2] + ': ' + PLAYS[i][0] + " vs " + + PLAYS[i][1] + " " + //" move " + PLAYS[i][3] + " "+ '<a title="Open" href="#" onclick="'+ "play_click('"+ fn + "', " + p + ", " + i + ')"><img title="Open" height="20" width="20" class="thumb"'+ ' src="' + fn + '.png" alt="Play '+ PLAYS[i][2] + '"/></a>'; @@ -162,7 +135,7 @@ function list_plays (game) { MAX_PLAY_NO = 0; - var lst = srv (TOSS_PORT, "list_plays ('" + game + "', " + UID + ")"); + var lst = srv (TOSS_PORT, "list_plays ('" + game + "', '" + UNAME + "')"); PLAYS = convert_python_list ('\n', strip ('\n', ' ', lst)); var plist = document.getElementById("plays-list"); while (plist.childNodes.length > 0) { plist.removeChild(plist.firstChild); } @@ -214,9 +187,9 @@ document.getElementById("board-disp").style.display = "block"; document.getElementById("play-number").innerHTML = "" + play_id; CUR_PLAY_I = pi; - VIEW_MIRROR = (PLAYS[CUR_PLAY_I][0] == UID) ? 0 : 1; + VIEW_MIRROR = (PLAYS[CUR_PLAY_I][0] == UNAME) ? 0 : 1; document.getElementById("cur-player").innerHTML = - fbfirstname (PLAYS[CUR_PLAY_I][PLAYS[CUR_PLAY_I][3] % 2]); + PLAYS[CUR_PLAY_I][PLAYS[CUR_PLAY_I][3] % 2]; toss_open (MAIN_DIR + play + ".toss"); full_redraw (); } @@ -226,7 +199,7 @@ function make_move () { if (CUR_MOVE == "") return; var m = PLAYS[CUR_PLAY_I][3] % 2; - if (PLAYS[CUR_PLAY_I][m] != UID) { + if (PLAYS[CUR_PLAY_I][m] != UNAME) { alert ("It is your Opponent's turn"); return; } @@ -236,7 +209,7 @@ CUR_ELEMS = []; ELEM_COUNTERS = {}; document.getElementById("cur-player").innerHTML = - fbfirstname (PLAYS[CUR_PLAY_I][(m + 1) % 2]); + PLAYS[CUR_PLAY_I][(m + 1) % 2]; document.getElementById('cur-move').innerHTML = "none"; full_redraw (); var fn_old = MAIN_DIR + play_file_name (CUR_PLAY_I); @@ -264,7 +237,7 @@ function opponent_item (data, index) { var li = document.createElement('li'); li.setAttribute ("class", "opponents-list-elem"); - li.setAttribute ("id", "opponent-" + UNIQUEID + "-" + index); + li.setAttribute ("id", "opponent-" + data.id + "-" + index); li.innerHTML = '<a href="#" onclick="new_play_do(' + data.id + ')">' + data.name + '</a>'; return (li); @@ -286,7 +259,7 @@ } var zeroli = document.createElement('li'); zeroli.setAttribute ("class", "opponents-list-elem"); - zeroli.setAttribute ("id", "opponent-" + UNIQUEID + "-0"); + zeroli.setAttribute ("id", "opponent-" + "-0"); zeroli.innerHTML = '<a href="#" onclick="new_play_do(-1)">Play against Yourself</a>'; o.appendChild (zeroli); for (var i = 0; i < FRIENDS.length; i++) { @@ -298,27 +271,18 @@ } function new_play () { - if (UID == 0) { alert ("Please log in to create plays"); return; } - UNIQUEID += 1; - if (FRIENDS.length == 0) { - FB.api('/me/friends', function(response) { - FRIENDS = response.data.sort (data_cmp); - store_friend_names (); - make_opnt_list (); - }); - } else { - make_opnt_list (); - } + if (UNAME == "") { alert ("Please log in to create plays"); return; } + make_opnt_list (); } function opponents_next () { for (var i = CUR_OPNT_START; i < CUR_OPNT_START + MAX_OPNT_LEN; i++) { - document.getElementById("opponent-" + UNIQUEID + "-" + i).style.display = "none"; + document.getElementById("opponent-" + "-" + i).style.display = "none"; } CUR_OPNT_START += MAX_OPNT_LEN; for (var i = CUR_OPNT_START; i < CUR_OPNT_START + MAX_OPNT_LEN; i++) { if (i < FULL_OPNT_LEN) { - document.getElementById("opponent-" + UNIQUEID + "-" + i).style.display = "list-item"; + document.getElementById("opponent-" + "-" + i).style.display = "list-item"; } } document.getElementById("opponents-prev").style.display = "block" @@ -330,12 +294,12 @@ function opponents_prev () { for (var i = CUR_OPNT_START; i < CUR_OPNT_START + MAX_OPNT_LEN; i++) { if (i < FULL_OPNT_LEN) { - document.getElementById("opponent-" + UNIQUEID + "-" + i).style.display = "none"; + document.getElementById("opponent-" + "-" + i).style.display = "none"; } } CUR_OPNT_START -= MAX_OPNT_LEN; for (var i = CUR_OPNT_START; i < CUR_OPNT_START + MAX_OPNT_LEN; i++) { - document.getElementById("opponent-" + UNIQUEID + "-" + i).style.display = "list-item"; + document.getElementById("opponent-" + "-" + i).style.display = "list-item"; } document.getElementById("opponents-next").style.display = "block" if (CUR_OPNT_START == 0) { @@ -354,18 +318,18 @@ document.getElementById("opponents").style.display = "none"; var olist = document.getElementById("opponents-list"); while (olist.childNodes.length > 0) { olist.removeChild(olist.firstChild); } - if (opp_uid == -1) { opp_uid = UID; } - if (opp_uid == 0 || UID == 0) { return; } + if (opp_uid == -1) { opp_uid = UNAME; } + if (opp_uid == 0 || UNAME == "") { return; } document.getElementById("plays-txt").style.display = "block"; document.getElementById("plays-list").style.display = "block"; MAX_PLAY_NO = parseInt(MAX_PLAY_NO) + 1; document.getElementById("play-number").innerHTML = "" + MAX_PLAY_NO; CUR_PLAY_I = PLAYS.length; VIEW_MIRROR = 0; - document.getElementById("cur-player").innerHTML = fbfirstname (UID); + document.getElementById("cur-player").innerHTML = UNAME; document.getElementById("board-disp").style.display = "block"; document.getElementById("plays").style.left = "30em"; - var p = [UID, opp_uid, MAX_PLAY_NO, 0]; + var p = [UNAME, opp_uid, MAX_PLAY_NO, 0]; PLAYS.push(p); toss_open (GAMES_DIR + GAME_NAME + ".toss"); document.getElementById("game-desc").style.display = "none"; @@ -377,33 +341,15 @@ document.getElementById("plays-list").appendChild(li); } -function TossFBInit (response) { - if (response.session) { - FB.api('/me', function(response) { - document.getElementById("fblogin").style.display = "none"; - document.getElementById("fbpicture").style.display = "block"; - UID = response.id; - UNAME = response.name; - var pic = "http://graph.facebook.com/" + response.id + "/picture"; - document.getElementById("fbuser").innerHTML = " " + response.name; - document.getElementById("fbpicture").innerHTML = - '<img alt="Facebook Picture" id="fbpic" src="' + pic + '"/>'; - ID_TO_USER_MAP[UID] = UNAME; - ID_TO_USER_FNAME_MAP[UID] = response.first_name; - }); - FB.api('/me/friends', function(response) { - FRIENDS = response.data.sort (data_cmp); - store_friend_names (); - }); - } else { - document.getElementById("fblogin").style.display = "inline"; - document.getElementById("fbpicture").style.display = "none"; - document.getElementById("fbuser").innerHTML = "Guest"; - } +function startup () { + if (navigator.userAgent.indexOf('MSIE') !=-1) { + document.getElementById("nosvg").style.display = "block"; + } else { + var un = srv("USERNAME", "user"); + if (un != "") { + UNAME = un + document.getElementById("topuser").innerHTML = "Welcome " + un; + document.getElementById("loginform").style.display = "none"; + } + } } - -function svgMessage () { - if (navigator.userAgent.indexOf('MSIE') !=-1) { - document.getElementById("nosvg").style.display = "block"; - } -} Modified: trunk/Toss/WebClient/TossStyle.css =================================================================== --- trunk/Toss/WebClient/TossStyle.css 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/TossStyle.css 2010-12-12 00:01:22 UTC (rev 1246) @@ -7,14 +7,14 @@ body { background-color: #b5bf8f; - font-family: 'TeXGyreHerosRegular', Verdana, sans; + font-family: Verdana, 'TeXGyreHerosRegular', sans; height: 100%; } #logo { font-size: 2em; float: left; - font-family: 'OFLSortsMillGoudyRegular', arial, serif; + font-family: arial, 'OFLSortsMillGoudyRegular', serif; width: 4.5em; padding-left: 0.25em; } @@ -55,19 +55,7 @@ padding-top: 0.7em; } -#fbpicture { - position: absolute; - top: 0px; - right: 0px; - margin-right: 0.5em; - height: 2.5em; -} - -#fbpic { - height: 2.5em; -} - -#fblogin { +#topright { float: right; margin-right: 0em; } Modified: trunk/Toss/WebClient/colors.html =================================================================== --- trunk/Toss/WebClient/colors.html 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/colors.html 2010-12-12 00:01:22 UTC (rev 1246) @@ -1,5 +1,5 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> -<html xmlns="http://www.w3.org/1999/xhtml" xmlns:svg="http://www.w3.org/2000/svg" xmlns:fb="http://www.facebook.com/2008/fbml" xml:lang="en" lang="en"> +<html xmlns="http://www.w3.org/1999/xhtml" xmlns:svg="http://www.w3.org/2000/svg" xml:lang="en" lang="en"> <head> <meta http-equiv="Content-Type" content="text/xhtml+xml; charset=UTF-8" /> <title>tPlay</title> Added: trunk/Toss/WebClient/crypto-sha256.js =================================================================== --- trunk/Toss/WebClient/crypto-sha256.js (rev 0) +++ trunk/Toss/WebClient/crypto-sha256.js 2010-12-12 00:01:22 UTC (rev 1246) @@ -0,0 +1,7 @@ +/* + * Crypto-JS v2.0.0 + * http://code.google.com/p/crypto-js/ + * Copyright (c) 2009, Jeff Mott. All rights reserved. + * http://code.google.com/p/crypto-js/wiki/License + */ +(function(){var c="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";var d=window.Crypto={};var a=d.util={rotl:function(h,g){return(h<<g)|(h>>>(32-g))},rotr:function(h,g){return(h<<(32-g))|(h>>>g)},endian:function(h){if(h.constructor==Number){return a.rotl(h,8)&16711935|a.rotl(h,24)&4278255360}for(var g=0;g<h.length;g++){h[g]=a.endian(h[g])}return h},randomBytes:function(h){for(var g=[];h>0;h--){g.push(Math.floor(Math.random()*256))}return g},bytesToWords:function(h){for(var k=[],j=0,g=0;j<h.length;j++,g+=8){k[g>>>5]|=h[j]<<(24-g%32)}return k},wordsToBytes:function(i){for(var h=[],g=0;g<i.length*32;g+=8){h.push((i[g>>>5]>>>(24-g%32))&255)}return h},bytesToHex:function(g){for(var j=[],h=0;h<g.length;h++){j.push((g[h]>>>4).toString(16));j.push((g[h]&15).toString(16))}return j.join("")},hexToBytes:function(h){for(var g=[],i=0;i<h.length;i+=2){g.push(parseInt(h.substr(i,2),16))}return g},bytesToBase64:function(h){if(typeof btoa=="function"){return btoa(e.bytesToString(h))}for(var g=[],l=0;l<h.length;l+=3){var m=(h[l]<<16)|(h[l+1]<<8)|h[l+2];for(var k=0;k<4;k++){if(l*8+k*6<=h.length*8){g.push(c.charAt((m>>>6*(3-k))&63))}else{g.push("=")}}}return g.join("")},base64ToBytes:function(h){if(typeof atob=="function"){return e.stringToBytes(atob(h))}h=h.replace(/[^A-Z0-9+\/]/ig,"");for(var g=[],j=0,k=0;j<h.length;k=++j%4){if(k==0){continue}g.push(((c.indexOf(h.charAt(j-1))&(Math.pow(2,-2*k+8)-1))<<(k*2))|(c.indexOf(h.charAt(j))>>>(6-k*2)))}return g}};d.mode={};var b=d.charenc={};var f=b.UTF8={stringToBytes:function(g){return e.stringToBytes(unescape(encodeURIComponent(g)))},bytesToString:function(g){return decodeURIComponent(escape(e.bytesToString(g)))}};var e=b.Binary={stringToBytes:function(j){for(var g=[],h=0;h<j.length;h++){g.push(j.charCodeAt(h))}return g},bytesToString:function(g){for(var j=[],h=0;h<g.length;h++){j.push(String.fromCharCode(g[h]))}return j.join("")}}})();(function(){var g=Crypto,b=g.util,c=g.charenc,f=c.UTF8,e=c.Binary;var a=[1116352408,1899447441,3049323471,3921009573,961987163,1508970993,2453635748,2870763221,3624381080,310598401,607225278,1426881987,1925078388,2162078206,2614888103,3248222580,3835390401,4022224774,264347078,604807628,770255983,1249150122,1555081692,1996064986,2554220882,2821834349,2952996808,3210313671,3336571891,3584528711,113926993,338241895,666307205,773529912,1294757372,1396182291,1695183700,1986661051,2177026350,2456956037,2730485921,2820302411,3259730800,3345764771,3516065817,3600352804,4094571909,275423344,430227734,506948616,659060556,883997877,958139571,1322822218,1537002063,1747873779,1955562222,2024104815,2227730452,2361852424,2428436474,2756734187,3204031479,3329325298];var d=g.SHA256=function(j,h){var i=b.wordsToBytes(d._sha256(j));return h&&h.asBytes?i:h&&h.asString?e.bytesToString(i):b.bytesToHex(i)};d._sha256=function(q){if(q.constructor==String){q=f.stringToBytes(q)}var y=b.bytesToWords(q),z=q.length*8,r=[1779033703,3144134277,1013904242,2773480762,1359893119,2600822924,528734635,1541459225],s=[],K,J,I,G,F,E,D,C,B,A,p,o;y[z>>5]|=128<<(24-z%32);y[((z+64>>9)<<4)+15]=z;for(var B=0;B<y.length;B+=16){K=r[0];J=r[1];I=r[2];G=r[3];F=r[4];E=r[5];D=r[6];C=r[7];for(var A=0;A<64;A++){if(A<16){s[A]=y[A+B]}else{var n=s[A-15],u=s[A-2],M=((n<<25)|(n>>>7))^((n<<14)|(n>>>18))^(n>>>3),L=((u<<15)|(u>>>17))^((u<<13)|(u>>>19))^(u>>>10);s[A]=M+(s[A-7]>>>0)+L+(s[A-16]>>>0)}var t=F&E^~F&D,k=K&J^K&I^J&I,x=((K<<30)|(K>>>2))^((K<<19)|(K>>>13))^((K<<10)|(K>>>22)),v=((F<<26)|(F>>>6))^((F<<21)|(F>>>11))^((F<<7)|(F>>>25));p=(C>>>0)+v+t+(a[A])+(s[A]>>>0);o=x+k;C=D;D=E;E=F;F=G+p;G=I;I=J;J=K;K=p+o}r[0]+=K;r[1]+=J;r[2]+=I;r[3]+=G;r[4]+=F;r[5]+=E;r[6]+=D;r[7]+=C}return r};d._blocksize=16})(); \ No newline at end of file Modified: trunk/Toss/WebClient/index.html =================================================================== --- trunk/Toss/WebClient/index.html 2010-12-11 13:38:17 UTC (rev 1245) +++ trunk/Toss/WebClient/index.html 2010-12-12 00:01:22 UTC (rev 1246) @@ -1,5 +1,5 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> -<html xmlns="http://www.w3.org/1999/xhtml" xmlns:svg="http://www.w3.org/2000/svg" xmlns:fb="http://www.facebook.com/2008/fbml" xml:lang="en" lang="en"> +<html xmlns="http://www.w3.org/1999/xhtml" xmlns:svg="http://www.w3.org/2000/svg" xml:lang="en" lang="en"> <head> <meta http-equiv="Content-Type" content="text/xhtml+xml; charset=UTF-8" /> <title>tPlay</title> @@ -7,28 +7,30 @@ <link rel="icon" type="image/vnd.microsoft.icon" href="/favicon.ico" /> <link href="fontstyle.css" media="screen" rel="stylesheet" type="text/css" /> <link rel="stylesheet" type="text/css" href="TossStyle.css" media="screen" title="Default"/> - <link rel="alternate stylesheet" type="text/css" href="plays/TossAltStyle.css" media="screen" title="Alternate"/> + <script type="text/javascript" src="crypto-sha256.js"> </script> <script type="text/javascript" src="TossConnect.js"> </script> <script type="text/javascript" src="TossDefaultStyle.js"> </script> <script type="text/javascript" src="TossMain.js"> </script> - <script type="text/javascript" src="Hyphenator.js"> </script> - <script type="text/javascript"> - Hyphenator.config({minwordlength : 4}); - Hyphenator.run(); - </script> </head> -<body onload="svgMessage()"> +<body onload="startup()"> <div id="top"> <div id="logo"><a href="http://www.tplay.org">tPlay</a></div> <div id="topbar"> -Welcome <span id="fbuser">Guest</span> -<div id="fblogin"> - <fb:login-button></fb:login-button> +<span id="topuser"></span> +<form id="loginform" style="display: inline;"> +Username: <input type="text" name="username" id="username" /> +Password: <input type="password" name="password" id="password" /> + +<a id="login" href="#" onclick="login()">Login</a> + +<a href="register.html">Register</a> +</form> +<span id="topright"> + <a id="logout" href="#" onclick="logout()">Logout</a> +</span> </div> -<div id="fbpicture"></div> </div> -</div> <div id="sidebar"> <p id="menu-top-par"><span style="font-weight: bold;">Games:</span></p> @@ -167,13 +169,5 @@ <div style="margin-right: 0em; display: none;">Disclaimer</div> </div> -<div id="fb-root" style="display: none;"></div> -<script src="http://connect.facebook.net/en_US/all.js"></script> -<script> - FB.init({appId: 127638590595426, status: true, cookie: true, xfbml: true}); - FB.getLoginStatus(TossFBInit, true); - FB.Event.subscribe('auth.login', TossFBInit); - FB.Event.subscribe('auth.sessionChange', TossFBInit); -</script> </body> </html> Added: trunk/Toss/WebClient/make_db.py =================================================================== --- trunk/Toss/WebClient/make_db.py (rev 0) +++ trunk/Toss/WebClient/make_db.py 2010-12-12 00:01:22 UTC (rev 1246) @@ -0,0 +1,11 @@ +#!/usr/bin/python + +from pysqlite2 import dbapi2 as sqlite3 + +print "Creating empty Toss DB" + +conn = sqlite3.connect("tossdb.sqlite") +conn.execute("create table passwd(id string primary key, passwd string)") +conn.commit () + +print "Created tossdb.sqlite" Property changes on: trunk/Toss/WebClient/make_db.py ___________________________________________________________________ Added: svn:executable + * Added: trunk/Toss/WebClient/register.html =================================================================== --- trunk/Toss/WebClient/register.html (rev 0) +++ trunk/Toss/WebClient/register.html 2010-12-12 00:01:22 UTC (rev 1246) @@ -0,0 +1,40 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> +<head> + <meta http-equiv="Content-Type" content="text/xhtml+xml; charset=UTF-8" /> + <title>test register</title> + <script type="text/javascript" src="crypto-sha256.js"></script> +</head> + +<body> + +<h2>Registration</h2> + +<p> +Username: <input type="text" id="username" /> +Password: <input type="text" id="password" /> +<a id="click" href="#" onclick="register()">Register</a> </p> + +<script> +function sync_server_msg (msg) { + var xml_request = new XMLHttpRequest (); + xml_request.open ('POST', 'PyHandler.py', false); + xml_request.setRequestHeader ('Content-Type', + 'application/x-www-form-urlencoded; charset=UTF-8'); + xml_request.send (msg); + alert (xml_request.responseText); +} + +function crypt (s) { + var c = Crypto.SHA256(s, true); + return (c.replace("#", "$")); +} + +function register () { + un = document.getElementById('username').value; + pwd = document.getElementById('password').value; + sync_server_msg ("REGISTER#" + un + " " + crypt(pwd)); +} +</script> +</body> +</html> This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-11 13:38:24
|
Revision: 1245 http://toss.svn.sourceforge.net/toss/?rev=1245&view=rev Author: lukstafi Date: 2010-12-11 13:38:17 +0000 (Sat, 11 Dec 2010) Log Message: ----------- Postconditions handling bug fix. Modified Paths: -------------- trunk/Toss/Play/Game.ml trunk/Toss/Play/GameTest.ml Modified: trunk/Toss/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-10 21:47:45 UTC (rev 1244) +++ trunk/Toss/Play/Game.ml 2010-12-11 13:38:17 UTC (rev 1245) @@ -645,13 +645,15 @@ computation as updated "memory" for the current state. *) and toss ~grid_size ?(just_payoffs=false) ({game={Arena.rules=rules; graph=graph; num_players=num_players; - defined_rels=defined_rels}; + defined_rels=defined_rels}; agents=agents; delta=delta} as play_def) {game_state=state; memory=memory} = let loc = graph.(state.loc) in let moves = if just_payoffs then [| |] else gen_moves grid_size rules state.struc loc in + (* Don't forget to check after generating models as well -- + postconditions! *) if moves = [| |] then let payoff = Array.map (fun expr -> @@ -662,11 +664,12 @@ let agent = agents.(loc.Arena.player) in match agent with | Random_move -> - let pos = ref (Random.int (Array.length moves)) in + let mlen = Array.length moves in + let init_pos = Random.int mlen in + let pos = ref init_pos in let nstate = ref None in - while !nstate = None do - pos := (!pos + 1) mod Array.length moves; - let mv = moves.(!pos) in + while !nstate = None && (!pos <> init_pos || !pos < mlen) do + let mv = moves.(!pos mod mlen) in let rule = List.assoc mv.rule rules in nstate := Aux.map_option @@ -675,13 +678,21 @@ {loc=mv.next_loc; struc=model; time=time}) (ContinuousRule.rewrite_single state.struc state.time mv.embedding rule mv.mv_time mv.parameters); + incr pos done; - let state = Aux.unsome !nstate in - (* FIXME: [pos] refers to unfiltered array! *) - Aux.Left - (!pos, moves, memory, - {game_state = state; - memory = update_memory ~num_players state !pos memory}) + (match !nstate with + | None -> + let payoff = + Array.map (fun expr -> + Solver.M.get_real_val expr state.struc) + loc.Arena.payoffs_pp in + Aux.Right payoff + | Some state -> + (* FIXME: [pos] refers to unfiltered array! *) + Aux.Left + (!pos, moves, memory, + {game_state = state; + memory = update_memory ~num_players state !pos memory})) | Maximax_evgame (subgames, cooperative, depth, use_pruning, reorder) -> (* {{{ log entry *) @@ -734,81 +745,101 @@ let models = gen_models rules defined_rels model time moves in let n = Array.length models in - let player = location.Arena.player in - let now_pruning = use_pruning && prev_player <> player in - let new_betas = Array.make num_players infinity in - let index = - Array.init (Array.length models) (fun i->i) in - if reorder && depth > 1 then begin - let heuristics = - gen_scores grid_size subgames moves models location in - Array.sort (fun j i-> compare - heuristics.(i).(player) heuristics.(j).(player)) index; + if n = 0 then begin + (* terminal position, but we need to return heuristic + for consistency: heuristics are not bound by payoffs *) + let res = + play_evgame grid_size model time subgames.(loc) in (* {{{ log entry *) - if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && - (depth > 1 || !debug_level > 3) - then ( - printf ", best %d pre-heur: %F %!" player - heuristics.(index.(0)).(player)); + if !debug_level > 4 then ( + let player = graph.(loc).Arena.player in + printf ", terminal %d heur: %F %!" player res.(player) + ); (* }}} *) - end; - let rec aux best i = - if i < n && not !timeout then - let pos = index.(i) in - let state = models.(pos) in - let sub_heur = - maximax_tree player new_betas (depth-1) state in - (* note strong inequality: don't lose ordering info *) - if now_pruning && sub_heur.(player) > betas.(player) - then ( - (* {{{ log entry *) - if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && - (depth > 1 || !debug_level > 3) - then ( - printf ", best cut %d maximax: %F. %!" player - sub_heur.(player)); - (* }}} *) - sub_heur) - else if sub_heur.(player) > best.(player) - then aux sub_heur (i+1) - else aux best (i+1) - else if !timeout then best - else ( - betas.(player) <- best.(player); + res + end else + let player = location.Arena.player in + let now_pruning = use_pruning && prev_player <> player in + let new_betas = Array.make num_players infinity in + let index = + Array.init (Array.length models) (fun i->i) in + if reorder && depth > 1 then begin + let heuristics = + gen_scores grid_size subgames moves models location in + Array.sort (fun j i-> compare + heuristics.(i).(player) heuristics.(j).(player)) index; (* {{{ log entry *) if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && (depth > 1 || !debug_level > 3) - then ( - printf ", best %d maximax: %F. %!" player - best.(player)); - (* }}} *) - best) in - let alphas = Array.make num_players neg_infinity in - aux alphas 0 in + then + printf ", best %d pre-heur: %F %!" player + heuristics.(index.(0)).(player); + (* }}} *) + end; + let rec aux best i = + if i < n && not !timeout then + let pos = index.(i) in + let state = models.(pos) in + let sub_heur = + maximax_tree player new_betas (depth-1) state in + (* note strong inequality: don't lose ordering info *) + if now_pruning && sub_heur.(player) > betas.(player) + then ( + (* {{{ log entry *) + if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && + (depth > 1 || !debug_level > 3) + then ( + printf ", best cut %d maximax: %F. %!" player + sub_heur.(player)); + (* }}} *) + sub_heur) + else if sub_heur.(player) > best.(player) + then aux sub_heur (i+1) + else aux best (i+1) + else if !timeout then best + else ( + betas.(player) <- best.(player); + (* {{{ log entry *) + if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && + (depth > 1 || !debug_level > 3) + then ( + printf ", best %d maximax: %F. %!" player + best.(player)); + (* }}} *) + best) in + let alphas = Array.make num_players neg_infinity in + aux alphas 0 in let betas = Array.make num_players infinity in let player = loc.Arena.player in let models = gen_models rules defined_rels state.struc state.time moves in - let scores = - Array.map (maximax_tree player betas (depth-1)) models in - let _, best = - find_best_score cooperative player scores - (Array.map (fun _ -> 1) scores) in - let state = models.(best) in - (* {{{ log entry *) - if !debug_level > 0 && (depth > 1 || !debug_level > 3) - then printf " %d nodes, %d size, %f elapsed time\n%!" - !nodes_count !size_count - (Sys.time () -. !debug_playclock); - if !debug_level > 1 && (depth > 1 || !debug_level > 3) - then - Printf.printf "moving to state\n%s\n%!" - (Structure.str state.struc); - (* }}} *) - Aux.Left - (best, moves, memory, - {game_state=state; - memory=update_memory ~num_players state best memory}) + if models = [| |] then + let payoff = + Array.map (fun expr -> + Solver.M.get_real_val expr state.struc) + loc.Arena.payoffs_pp in + Aux.Right payoff + else + let scores = + Array.map (maximax_tree player betas (depth-1)) models in + let _, best = + find_best_score cooperative player scores + (Array.map (fun _ -> 1) scores) in + let state = models.(best) in + (* {{{ log entry *) + if !debug_level > 0 && (depth > 1 || !debug_level > 3) + then printf " %d nodes, %d size, %f elapsed time\n%!" + !nodes_count !size_count + (Sys.time () -. !debug_playclock); + if !debug_level > 1 && (depth > 1 || !debug_level > 3) + then + Printf.printf "moving to state\n%s\n%!" + (Structure.str state.struc); + (* }}} *) + Aux.Left + (best, moves, memory, + {game_state=state; + memory=update_memory ~num_players state best memory}) | Tree_search (subgames, evgame_horizon, params, agents) -> (* {{{ log entry *) @@ -829,11 +860,11 @@ print_endline "\ntoss: initial tree:"; print_uctree (print_string) params delta uctree; flush stdout); - (* }}} *) - (* {{{ log entry *) if !debug_level > 3 then printf "toss: %d iters\n" params.iters; (* }}} *) + (* [grow_uctree] will check if it is not a terminal + position *) let uctree = ref uctree and iteri = ref 0 in (* the score update is already stored in the tree *) while !iteri < params.iters && not !timeout do @@ -878,6 +909,9 @@ {game_state=state; memory= update_memory num_players state best memory}) + + | Terminal (game_state, score, heuristic, payoff) -> + Aux.Right payoff | _ -> failwith "toss: tree search -- unexpected end of tree") | External callback -> @@ -886,15 +920,22 @@ (* }}} *) let models = gen_models rules defined_rels state.struc state.time moves in - let descriptions = - Array.map (fun m -> Structure.str m.struc) models in - let best = callback descriptions in - let state = models.(best) in - Aux.Left - (best, moves, memory, - {game_state=state; - memory=update_memory num_players state best memory}) - + if models = [| |] then + let payoff = + Array.map (fun expr -> + Solver.M.get_real_val expr state.struc) + loc.Arena.payoffs_pp in + Aux.Right payoff + else + let descriptions = + Array.map (fun m -> Structure.str m.struc) models in + let best = callback descriptions in + let state = models.(best) in + Aux.Left + (best, moves, memory, + {game_state=state; + memory=update_memory num_players state best memory}) + (* Play a play, by applying {!toss}, till the end. Return the final structure and its payoff. @@ -903,21 +944,21 @@ suggestions, the timer is set by {!Server}. Tests use their own timers too, see {!GameTest}. *) and play ~grid_size ?set_timer ?horizon ?(plys=0) play_def state = - let () = match set_timer with - | None -> () - | Some timer -> - (* {{{ log entry *) - if !debug_level > 2 then printf "SET ALARM %d\n%!" timer; - (* }}} *) - ignore (Unix.alarm timer) in - let res = - toss ~grid_size - ~just_payoffs:(horizon <> None && plys >= Aux.unsome horizon) - play_def state in - let () = match set_timer with - | None -> () - | Some _ -> cancel_timeout () in - match res with + let () = match set_timer with + | None -> () + | Some timer -> + (* {{{ log entry *) + if !debug_level > 2 then printf "SET ALARM %d\n%!" timer; + (* }}} *) + ignore (Unix.alarm timer) in + let res = + toss ~grid_size + ~just_payoffs:(horizon <> None && plys >= Aux.unsome horizon) + play_def state in + let () = match set_timer with + | None -> () + | Some _ -> cancel_timeout () in + match res with | Aux.Left (_,_,_,state) -> (* {{{ log entry *) @@ -1030,53 +1071,61 @@ else let models = gen_models rules defined_rels state.struc state.time moves in - let heuristics = - gen_scores grid_size subgames moves models location in - let subt_sizes = Array.map (fun _ -> 0) heuristics in - let heuristic, bestheur = - find_best_score cooperative player heuristics subt_sizes in - let scores = - Array.map (fun payoffs -> payoffs.(location.Arena.player)) - heuristics in - let subtrees = - Array.mapi (fun i state -> Tip (state, heuristics.(i))) - models in - let best = Aux.array_argfind_all_max - (compare : float -> float -> int) scores in - let best = List.nth best (Random.int (List.length best)) in - let next_state = models.(best) in - let empty_mem = Array.make num_players No_memory in - let state = - {game_state=next_state; memory=empty_mem} in - if heur_effect = Heuristic_only then - let upscore = score_payoff (Array.make num_players 0.) in - (* we maintain score to: (1) count the number of node visits, - (2) keep info when the search tree hits terminal nodes *) - let score = match score with - | None -> upscore - | Some score -> add_score score upscore in - subtrees.(best) <- - Leaf (next_state, upscore, heuristics.(best), next_state.struc); - (upscore, - Node { - node_state=next_state; node_stats=score; - node_heuristic=heuristic; node_endstate=next_state.struc; - node_subtrees=subtrees; node_bestheur=bestheur; - }) + if models = [| |] then + let payoff = + Array.map (fun expr -> + Solver.M.get_real_val expr state.struc) + location.Arena.payoffs_pp in + let upscore = score_payoff payoff in + upscore, Terminal (state, upscore, heuristic, payoff) else - let endmodel, payoff = play ~grid_size ?horizon play_def state in - let upscore = score_payoff payoff in - let score = match score with - | None -> upscore - | Some score -> add_score score upscore in - subtrees.(best) <- - Leaf (next_state, upscore, heuristics.(best), endmodel); - (upscore, - Node { - node_state=next_state; node_stats=score; - node_heuristic=heuristic; node_endstate=endmodel; - node_subtrees=subtrees; node_bestheur=bestheur; - }) + let heuristics = + gen_scores grid_size subgames moves models location in + let subt_sizes = Array.map (fun _ -> 0) heuristics in + let heuristic, bestheur = + find_best_score cooperative player heuristics subt_sizes in + let scores = + Array.map (fun payoffs -> payoffs.(location.Arena.player)) + heuristics in + let subtrees = + Array.mapi (fun i state -> Tip (state, heuristics.(i))) + models in + let best = Aux.array_argfind_all_max + (compare : float -> float -> int) scores in + let best = List.nth best (Random.int (List.length best)) in + let next_state = models.(best) in + let empty_mem = Array.make num_players No_memory in + let state = + {game_state=next_state; memory=empty_mem} in + if heur_effect = Heuristic_only then + let upscore = score_payoff (Array.make num_players 0.) in + (* we maintain score to: (1) count the number of node visits, + (2) keep info when the search tree hits terminal nodes *) + let score = match score with + | None -> upscore + | Some score -> add_score score upscore in + subtrees.(best) <- + Leaf (next_state, upscore, heuristics.(best), next_state.struc); + (upscore, + Node { + node_state=next_state; node_stats=score; + node_heuristic=heuristic; node_endstate=next_state.struc; + node_subtrees=subtrees; node_bestheur=bestheur; + }) + else + let endmodel, payoff = play ~grid_size ?horizon play_def state in + let upscore = score_payoff payoff in + let score = match score with + | None -> upscore + | Some score -> add_score score upscore in + subtrees.(best) <- + Leaf (next_state, upscore, heuristics.(best), endmodel); + (upscore, + Node { + node_state=next_state; node_stats=score; + node_heuristic=heuristic; node_endstate=endmodel; + node_subtrees=subtrees; node_bestheur=bestheur; + }) let evgame_of_heuristic heuristics heuristics_pp game = let evgame gloc = Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-10 21:47:45 UTC (rev 1244) +++ trunk/Toss/Play/GameTest.ml 2010-12-11 13:38:17 UTC (rev 1245) @@ -617,12 +617,14 @@ [|Game.Random_move; Game.Random_move|]; delta = 2.0} in (* FIXME: give/calc delta *) let init_state = Game.initial_state play struc in - let endstate,payoff = - Game.play ~grid_size:Game.cGRID_SIZE - ~set_timer:360 ~horizon:30 play init_state in + (* let endstate,payoff = *) + ignore (Game.play ~grid_size:Game.cGRID_SIZE + ~set_timer:360 ~horizon:30 play init_state) (* in *) (* nothing to assert -- just check halting without exceptions *) + (* Printf.printf "Chess random play horizon=30 ended in:\n%s\n%!" (Structure.sprint endstate) + *) ); "breakthrough payoff" >:: @@ -674,6 +676,54 @@ ); + "chess draw" >:: + (fun () -> + let state = update_game (Lazy.force chess_game) +"[a1, b1, c1, d1, e1, f1, g1, h1, a2, b2, c2, d2, e2, f2, g2, h2, a3, b3, c3, d3, e3, f3, g3, h3, a4, b4, c4, d4, e4, f4, g4, h4, a5, b5, c5, d5, e5, f5, g5, h5, a6, b6, c6, d6, e6, f6, g6, h6, a7, b7, c7, d7, e7, f7, g7, h7, a8, b8, c8, d8, e8, f8, g8, h8 | D1 {(a1, b2); (b1, c2); (c1, d2); (d1, e2); (e1, f2); (f1, g2); (g1, h2); (a2, b3); (b2, a1); (b2, c3); (c2, b1); (c2, d3); (d2, c1); (d2, e3); (e2, d1); (e2, f3); (f2, e1); (f2, g3); (g2, f1); (g2, h3); (h2, g1); (a3, b4); (b3, a2); (b3, c4); (c3, b2); (c3, d4); (d3, c2); (d3, e4); (e3, d2); (e3, f4); (f3, e2); (f3, g4); (g3, f2); (g3, h4); (h3, g2); (a4, b5); (b4, a3); (b4, c5); (c4, b3); (c4, d5); (d4, c3); (d4, e5); (e4, d3); (e4, f5); (f4, e3); (f4, g5); (g4, f3); (g4, h5); (h4, g3); (a5, b6); (b5, a4); (b5, c6); (c5, b4); (c5, d6); (d5, c4); (d5, e6); (e5, d4); (e5, f6); (f5, e4); (f5, g6); (g5, f4); (g5, h6); (h5, g4); (a6, b7); (b6, a5); (b6, c7); (c6, b5); (c6, d7); (d6, c5); (d6, e7); (e6, d5); (e6, f7); (f6, e5); (f6, g7); (g6, f5); (g6, h7); (h6, g5); (a7, b8); (b7, a6); (b7, c8); (c7, b6); (c7, d8); (d7, c6); (d7, e8); (e7, d6); (e7, f8); (f7, e6); (f7, g8); (g7, f6); (g7, h8); (h7, g6); (b8, a7); (c8, b7); (d8, c7); (e8, d7); (f8, e7); (g8, f7); (h8, g7)}; D2 {(b1, a2); (c1, b2); (d1, c2); (e1, d2); (f1, e2); (g1, f2); (h1, g2); (a2, b1); (b2, c1); (b2, a3); (c2, d1); (c2, b3); (d2, e1); (d2, c3); (e2, f1); (e2, d3); (f2, g1); (f2, e3); (g2, h1); (g2, f3); (h2, g3); (a3, b2); (b3, c2); (b3, a4); (c3, d2); (c3, b4); (d3, e2); (d3, c4); (e3, f2); (e3, d4); (f3, g2); (f3, e4); (g3, h2); (g3, f4); (h3, g4); (a4, b3); (b4, c3); (b4, a5); (c4, d3); (c4, b5); (d4, e3); (d4, c5); (e4, f3); (e4, d5); (f4, g3); (f4, e5); (g4, h3); (g4, f5); (h4, g5); (a5, b4); (b5, c4); (b5, a6); (c5, d4); (c5, b6); (d5, e4); (d5, c6); (e5, f4); (e5, d6); (f5, g4); (f5, e6); (g5, h4); (g5, f6); (h5, g6); (a6, b5); (b6, c5); (b6, a7); (c6, d5); (c6, b7); (d6, e5); (d6, c7); (e6, f5); (e6, d7); (f6, g5); (f6, e7); (g6, h5); (g6, f7); (h6, g7); (a7, b6); (b7, c6); (b7, a8); (c7, d6); (c7, b8); (d7, e6); (d7, c8); (e7, f6); (e7, d8); (f7, g6); (f7, e8); (g7, h6); (g7, f8); (h7, g8); (a8, b7); (b8, c7); (c8, d7); (d8, e7); (e8, f7); (f8, g7); (g8, h7)}; bB:1 {}; wB:1 {}; wN:1 {}; wP:1 {}; wQ:1 {}; wR:1 {} | ] \" + ... ... ... ... + ... ... +bN ... + ... ... ... ... + ... ... ... ... + ... ... ... ... + ... bP. ...-bNwK. + ... ... ... ... + ...bP ... ... ... + ... ... ... ... + bR. ... ...bQ ... + ... ... ... ... + ... ...bK ... ...bP + ... ... ... ... + ... ... ... ... + ... ... ... ... + ... ... ... ... +\"" 0 in + + let heur_adv_ratio, state = state in + let payoffs = Array.to_list + (Array.mapi (fun i v->string_of_int i,v) + state.Arena.game.Arena.graph.(state.Arena.cur_loc).Arena.payoffs_pp) + in + let ev (p,e) = + p^": "^(string_of_float + (Solver.M.get_real_val e state.Arena.struc)) in + let answ = + String.concat ", " (List.sort compare (List.map ev payoffs)) in + assert_equal ~msg:"draw (white no move): direct" ~printer:(fun x->x) + "0: 0., 1: 0." answ; + + let move_opt = (let p,ps = Game.initialize_default state + ~heur_adv_ratio + ~loc:0 ~effort:1 + ~search_method:"alpha_beta_ord" () in + Game.toss ~grid_size:Game.cGRID_SIZE p ps) in + assert_equal ~msg:"draw (white no move): suggest" ~printer:(function + | Aux.Left (bpos, moves, _, _) -> + "game not over: "^move_gs_str state moves.(bpos) + | Aux.Right poffs -> + Printf.sprintf "{W: %F; B: %F}" poffs.(0) poffs.(1)) + (Aux.Right [| 0.0; 0.0 |]) move_opt; +); + "matching: breakthrough suggest start" >:: (fun () -> let (_,state) = breakthrough_game in @@ -1078,27 +1128,6 @@ (fun mov_s -> "1{1:d4}" = mov_s); ); -(* -[a1, b1, c1, d1, e1, f1, g1, h1, a2, b2, c2, d2, e2, f2, g2, h2, a3, b3, c3, d3, e3, f3, g3, h3, a4, b4, c4, d4, e4, f4, g4, h4, a5, b5, c5, d5, e5, f5, g5, h5, a6, b6, c6, d6, e6, f6, g6, h6, a7, b7, c7, d7, e7, f7, g7, h7, a8, b8, c8, d8, e8, f8, g8, h8 | D1 {(a1, b2); (b1, c2); (c1, d2); (d1, e2); (e1, f2); (f1, g2); (g1, h2); (a2, b3); (b2, a1); (b2, c3); (c2, b1); (c2, d3); (d2, c1); (d2, e3); (e2, d1); (e2, f3); (f2, e1); (f2, g3); (g2, f1); (g2, h3); (h2, g1); (a3, b4); (b3, a2); (b3, c4); (c3, b2); (c3, d4); (d3, c2); (d3, e4); (e3, d2); (e3, f4); (f3, e2); (f3, g4); (g3, f2); (g3, h4); (h3, g2); (a4, b5); (b4, a3); (b4, c5); (c4, b3); (c4, d5); (d4, c3); (d4, e5); (e4, d3); (e4, f5); (f4, e3); (f4, g5); (g4, f3); (g4, h5); (h4, g3); (a5, b6); (b5, a4); (b5, c6); (c5, b4); (c5, d6); (d5, c4); (d5, e6); (e5, d4); (e5, f6); (f5, e4); (f5, g6); (g5, f4); (g5, h6); (h5, g4); (a6, b7); (b6, a5); (b6, c7); (c6, b5); (c6, d7); (d6, c5); (d6, e7); (e6, d5); (e6, f7); (f6, e5); (f6, g7); (g6, f5); (g6, h7); (h6, g5); (a7, b8); (b7, a6); (b7, c8); (c7, b6); (c7, d8); (d7, c6); (d7, e8); (e7, d6); (e7, f8); (f7, e6); (f7, g8); (g7, f6); (g7, h8); (h7, g6); (b8, a7); (c8, b7); (d8, c7); (e8, d7); (f8, e7); (g8, f7); (h8, g7)}; D2 {(b1, a2); (c1, b2); (d1, c2); (e1, d2); (f1, e2); (g1, f2); (h1, g2); (a2, b1); (b2, c1); (b2, a3); (c2, d1); (c2, b3); (d2, e1); (d2, c3); (e2, f1); (e2, d3); (f2, g1); (f2, e3); (g2, h1); (g2, f3); (h2, g3); (a3, b2); (b3, c2); (b3, a4); (c3, d2); (c3, b4); (d3, e2); (d3, c4); (e3, f2); (e3, d4); (f3, g2); (f3, e4); (g3, h2); (g3, f4); (h3, g4); (a4, b3); (b4, c3); (b4, a5); (c4, d3); (c4, b5); (d4, e3); (d4, c5); (e4, f3); (e4, d5); (f4, g3); (f4, e5); (g4, h3); (g4, f5); (h4, g5); (a5, b4); (b5, c4); (b5, a6); (c5, d4); (c5, b6); (d5, e4); (d5, c6); (e5, f4); (e5, d6); (f5, g4); (f5, e6); (g5, h4); (g5, f6); (h5, g6); (a6, b5); (b6, c5); (b6, a7); (c6, d5); (c6, b7); (d6, e5); (d6, c7); (e6, f5); (e6, d7); (f6, g5); (f6, e7); (g6, h5); (g6, f7); (h6, g7); (a7, b6); (b7, c6); (b7, a8); (c7, d6); (c7, b8); (d7, e6); (d7, c8); (e7, f6); (e7, d8); (f7, g6); (f7, e8); (g7, h6); (g7, f8); (h7, g8); (a8, b7); (b8, c7); (c8, d7); (d8, e7); (e8, f7); (f8, g7); (g8, h7)}; bB:1 {}; wB:1 {}; wN:1 {}; wP:1 {}; wQ:1 {}; wR:1 {} | ] " - ... ... ... ... - ... ... +bN ... - ... ... ... ... - ... ... ... ... - ... ... ... ... - ... bP. ...-bNwK. - ... ... ... ... - ...bP ... ... ... - ... ... ... ... - bR. ... ...bQ ... - ... ... ... ... - ... ...bK ... ...bP - ... ... ... ... - ... ... ... ... - ... ... ... ... - ... ... ... ... -" - *) - ] let tests = "Game" >::: [ @@ -1159,7 +1188,7 @@ let a () = match test_filter - ["Game:0:misc:0:server: check ServerTest.in response"] + ["Game:0:misc:5:chess draw"] tests with | Some tests -> ignore (run_test_tt ~verbose:true tests) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-10 21:47:52
|
Revision: 1244 http://toss.svn.sourceforge.net/toss/?rev=1244&view=rev Author: lukstafi Date: 2010-12-10 21:47:45 +0000 (Fri, 10 Dec 2010) Log Message: ----------- Main test suite invocation fix. Modified Paths: -------------- trunk/Toss/Play/GameTest.ml trunk/Toss/Play/Server.ml Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-10 14:21:08 UTC (rev 1243) +++ trunk/Toss/Play/GameTest.ml 2010-12-10 21:47:45 UTC (rev 1244) @@ -1078,6 +1078,27 @@ (fun mov_s -> "1{1:d4}" = mov_s); ); +(* +[a1, b1, c1, d1, e1, f1, g1, h1, a2, b2, c2, d2, e2, f2, g2, h2, a3, b3, c3, d3, e3, f3, g3, h3, a4, b4, c4, d4, e4, f4, g4, h4, a5, b5, c5, d5, e5, f5, g5, h5, a6, b6, c6, d6, e6, f6, g6, h6, a7, b7, c7, d7, e7, f7, g7, h7, a8, b8, c8, d8, e8, f8, g8, h8 | D1 {(a1, b2); (b1, c2); (c1, d2); (d1, e2); (e1, f2); (f1, g2); (g1, h2); (a2, b3); (b2, a1); (b2, c3); (c2, b1); (c2, d3); (d2, c1); (d2, e3); (e2, d1); (e2, f3); (f2, e1); (f2, g3); (g2, f1); (g2, h3); (h2, g1); (a3, b4); (b3, a2); (b3, c4); (c3, b2); (c3, d4); (d3, c2); (d3, e4); (e3, d2); (e3, f4); (f3, e2); (f3, g4); (g3, f2); (g3, h4); (h3, g2); (a4, b5); (b4, a3); (b4, c5); (c4, b3); (c4, d5); (d4, c3); (d4, e5); (e4, d3); (e4, f5); (f4, e3); (f4, g5); (g4, f3); (g4, h5); (h4, g3); (a5, b6); (b5, a4); (b5, c6); (c5, b4); (c5, d6); (d5, c4); (d5, e6); (e5, d4); (e5, f6); (f5, e4); (f5, g6); (g5, f4); (g5, h6); (h5, g4); (a6, b7); (b6, a5); (b6, c7); (c6, b5); (c6, d7); (d6, c5); (d6, e7); (e6, d5); (e6, f7); (f6, e5); (f6, g7); (g6, f5); (g6, h7); (h6, g5); (a7, b8); (b7, a6); (b7, c8); (c7, b6); (c7, d8); (d7, c6); (d7, e8); (e7, d6); (e7, f8); (f7, e6); (f7, g8); (g7, f6); (g7, h8); (h7, g6); (b8, a7); (c8, b7); (d8, c7); (e8, d7); (f8, e7); (g8, f7); (h8, g7)}; D2 {(b1, a2); (c1, b2); (d1, c2); (e1, d2); (f1, e2); (g1, f2); (h1, g2); (a2, b1); (b2, c1); (b2, a3); (c2, d1); (c2, b3); (d2, e1); (d2, c3); (e2, f1); (e2, d3); (f2, g1); (f2, e3); (g2, h1); (g2, f3); (h2, g3); (a3, b2); (b3, c2); (b3, a4); (c3, d2); (c3, b4); (d3, e2); (d3, c4); (e3, f2); (e3, d4); (f3, g2); (f3, e4); (g3, h2); (g3, f4); (h3, g4); (a4, b3); (b4, c3); (b4, a5); (c4, d3); (c4, b5); (d4, e3); (d4, c5); (e4, f3); (e4, d5); (f4, g3); (f4, e5); (g4, h3); (g4, f5); (h4, g5); (a5, b4); (b5, c4); (b5, a6); (c5, d4); (c5, b6); (d5, e4); (d5, c6); (e5, f4); (e5, d6); (f5, g4); (f5, e6); (g5, h4); (g5, f6); (h5, g6); (a6, b5); (b6, c5); (b6, a7); (c6, d5); (c6, b7); (d6, e5); (d6, c7); (e6, f5); (e6, d7); (f6, g5); (f6, e7); (g6, h5); (g6, f7); (h6, g7); (a7, b6); (b7, c6); (b7, a8); (c7, d6); (c7, b8); (d7, e6); (d7, c8); (e7, f6); (e7, d8); (f7, g6); (f7, e8); (g7, h6); (g7, f8); (h7, g8); (a8, b7); (b8, c7); (c8, d7); (d8, e7); (e8, f7); (f8, g7); (g8, h7)}; bB:1 {}; wB:1 {}; wN:1 {}; wP:1 {}; wQ:1 {}; wR:1 {} | ] " + ... ... ... ... + ... ... +bN ... + ... ... ... ... + ... ... ... ... + ... ... ... ... + ... bP. ...-bNwK. + ... ... ... ... + ...bP ... ... ... + ... ... ... ... + bR. ... ...bQ ... + ... ... ... ... + ... ...bK ... ...bP + ... ... ... ... + ... ... ... ... + ... ... ... ... + ... ... ... ... +" + *) + ] let tests = "Game" >::: [ @@ -1096,10 +1117,10 @@ let play = {Game.game = game; agents= [| - Game.default_maximax state.Arena.struc ~depth:2 + Game.default_maximax state.Arena.struc ~depth:1 ~heur_adv_ratio ~pruning:true ~reorder:true game; - Game.default_maximax state.Arena.struc ~depth:2 + Game.default_maximax state.Arena.struc ~depth:1 ~heuristic:chess_piece_value_heur ~heur_adv_ratio ~pruning:true ~reorder:true game; |]; Modified: trunk/Toss/Play/Server.ml =================================================================== --- trunk/Toss/Play/Server.ml 2010-12-10 14:21:08 UTC (rev 1243) +++ trunk/Toss/Play/Server.ml 2010-12-10 21:47:45 UTC (rev 1244) @@ -277,14 +277,18 @@ ;; let _ = - (* Test against being called from GameTest... *) - let target_name = "GameTest" in + (* Test against being called from a test... *) + let target_name1 = "GameTest" + and target_name2 = "TossTest" in 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 + String.length fname >= String.length target_name1 && + String.sub fname 0 (String.length target_name1) = target_name1 || + String.length fname >= String.length target_name2 && + String.sub fname 0 (String.length target_name2) = target_name2 + in (* so that the server is not started by the test suite. *) if not test_fname then main ();; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-10 14:21:14
|
Revision: 1243 http://toss.svn.sourceforge.net/toss/?rev=1243&view=rev Author: lukstafi Date: 2010-12-10 14:21:08 +0000 (Fri, 10 Dec 2010) Log Message: ----------- input_file reads a file returning a string. Handle reported parse errors in Server. Server test suite invoked by GameTest. Modified Paths: -------------- trunk/Toss/Arena/Arena.ml trunk/Toss/Arena/ArenaTest.ml trunk/Toss/Formula/Aux.ml trunk/Toss/Formula/Aux.mli trunk/Toss/Play/GameTest.ml trunk/Toss/Play/Server.ml Added Paths: ----------- trunk/Toss/Play/ServerTest.in trunk/Toss/Play/ServerTest.out Modified: trunk/Toss/Arena/Arena.ml =================================================================== --- trunk/Toss/Arena/Arena.ml 2010-12-09 20:05:14 UTC (rev 1242) +++ trunk/Toss/Arena/Arena.ml 2010-12-10 14:21:08 UTC (rev 1243) @@ -561,8 +561,6 @@ AddElem loc -> apply_to_loc add_new_elem loc state "add elem" | AddRel (loc, rel, tp) -> - (* FIXME: remove this note if AddRel needs to add new - elements, otherwise simplify *) let add_rel struc = let struc, tp = List.fold_right (fun n (struc, tp) -> Modified: trunk/Toss/Arena/ArenaTest.ml =================================================================== --- trunk/Toss/Arena/ArenaTest.ml 2010-12-09 20:05:14 UTC (rev 1242) +++ trunk/Toss/Arena/ArenaTest.ml 2010-12-10 14:21:08 UTC (rev 1243) @@ -8,11 +8,6 @@ let gs_of_str s = ArenaParser.parse_game_state Lexer.lex (Lexing.from_string s) -let rec input_file file buf begpos buflen = - let nread = input file buf begpos buflen in - if nread > 0 && buflen - nread > 0 then - input_file file buf (begpos+nread) (buflen-nread) - let apply_rule gs rname match_str = let s = "SET RULE " ^ rname ^ " MODEL " ^ match_str ^ " 0.1" in snd (Arena.handle_request Arena.empty_state (req_of_str s)) @@ -116,10 +111,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 = String.make 4000 '$' in - input_file file contents 0 4000; - let contents = - String.sub contents 0 (String.index contents '$') in + let contents = Aux.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) = @@ -128,21 +120,6 @@ contents msg; )); -(* - "Chess taking a pawn and moving" >:: - (fun () -> backtrace ( - let fname = "./examples/Chess.toss" in - let file = open_in fname in - let contents = String.make 10000 '$' in - input_file file contents 0 10000; - let contents = - String.sub contents 0 (String.index contents '$') in - let s = "SET STATE #" ^ fname ^ "#" ^ contents in - let (gs,_) = - Arena.handle_request Arena.empty_state (req_of_str s) in - let gs = apply_rule "WhitePawnDbl" "a1: " - )); -*) ] let a = Modified: trunk/Toss/Formula/Aux.ml =================================================================== --- trunk/Toss/Formula/Aux.ml 2010-12-09 20:05:14 UTC (rev 1242) +++ trunk/Toss/Formula/Aux.ml 2010-12-10 14:21:08 UTC (rev 1243) @@ -390,3 +390,10 @@ (* So that the tests are not run twice while building TossTest. *) if test_fname then ignore (OUnit.run_test_tt ~verbose:true tests) + +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 Modified: trunk/Toss/Formula/Aux.mli =================================================================== --- trunk/Toss/Formula/Aux.mli 2010-12-09 20:05:14 UTC (rev 1242) +++ trunk/Toss/Formula/Aux.mli 2010-12-10 14:21:08 UTC (rev 1243) @@ -182,3 +182,6 @@ (** 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 Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-09 20:05:14 UTC (rev 1242) +++ trunk/Toss/Play/GameTest.ml 2010-12-10 14:21:08 UTC (rev 1243) @@ -545,6 +545,22 @@ let misc_tests = "misc" >::: [ + + "server: check ServerTest.in response" >:: + (fun () -> + let in_ch = open_in "./Play/ServerTest.in" in + let out_ch = open_out "./Play/ServerTest.temp" in + (try while true do + Server.req_handle in_ch out_ch done + with End_of_file -> ()); + close_in in_ch; close_out out_ch; + let result = + Aux.input_file (open_in "./Play/ServerTest.temp") in + let target = + Aux.input_file (open_in "./Play/ServerTest.out") in + Sys.remove "./Play/ServerTest.temp"; + assert_equal ~printer:(fun x->x) target result + ); "play: breakthrough suggest in game" >:: (fun () -> @@ -1107,10 +1123,10 @@ ); ] -let a () = +let a = Aux.run_test_if_target "GameTest" tests -let a = run_test_tt ~verbose:true experiments +let a () = run_test_tt ~verbose:true experiments (* The same content as in .toss files. *) @@ -1122,7 +1138,7 @@ let a () = match test_filter - ["Game:1:alpha_beta_ord:11:gomoku8x8 avoid endgame"] + ["Game:0:misc:0:server: check ServerTest.in response"] tests with | Some tests -> ignore (run_test_tt ~verbose:true tests) Modified: trunk/Toss/Play/Server.ml =================================================================== --- trunk/Toss/Play/Server.ml 2010-12-09 20:05:14 UTC (rev 1242) +++ trunk/Toss/Play/Server.ml 2010-12-10 14:21:08 UTC (rev 1243) @@ -140,117 +140,124 @@ !state.Arena.game.Arena.player_names) heur) in let p, ps = match !game_modified, !play, !play_state with - | false, Some play, Some play_state -> - play, play_state - | _ -> - let p, ps = Game.initialize_default - !state ~loc ~effort ~search_method:how - ?horizon ?heuristic ?heur_adv_ratio () in - game_modified := false; - play := Some p; play_state := Some ps; - p, ps in - ignore (Unix.alarm timer); - let res = Game.suggest ~effort p ps in - Game.cancel_timeout (); - match res with - | Some (move, new_state) -> - play_state := Some new_state; - Game.move_gs_str !state move - | None -> "None" - ) + | false, Some play, Some play_state -> + play, play_state + | _ -> + let p, ps = Game.initialize_default + !state ~loc ~effort ~search_method:how + ?horizon ?heuristic ?heur_adv_ratio () in + game_modified := false; + play := Some p; play_state := Some ps; + p, ps in + ignore (Unix.alarm timer); + let res = Game.suggest ~effort p ps in + Game.cancel_timeout (); + match res with + | Some (move, new_state) -> + play_state := Some new_state; + Game.move_gs_str !state move + | None -> "None" + ) | Arena.ApplyRule (r_name, mtch, t, p) -> ( - if !game_modified then - let (new_state, resp) = Arena.handle_request !state req in - state := new_state; resp - else + if !game_modified then + let (new_state, resp) = Arena.handle_request !state req in + state := new_state; resp + else (* trying to restore [Server.play_state] so as to avoid reinitialization *) - let {Arena.rules=rules; graph=graph} = !state.Arena.game in - let struc = !state.Arena.struc in - let fn s n = Structure.find_elem s n in - let r = List.assoc r_name rules in - let lhs = - r.ContinuousRule.discrete.DiscreteRule.lhs_struc in - let m = - List.map (fun (l, s) -> (fn lhs l, fn struc s)) mtch in - let moves = - Game.gen_moves Game.cGRID_SIZE rules - !state.Arena.struc graph.(!state.Arena.cur_loc) in - try - for i = 0 to Array.length moves - 1 do + let {Arena.rules=rules; graph=graph} = !state.Arena.game in + let struc = !state.Arena.struc in + let fn s n = Structure.find_elem s n in + let r = List.assoc r_name rules in + let lhs = + r.ContinuousRule.discrete.DiscreteRule.lhs_struc in + let m = + List.map (fun (l, s) -> (fn lhs l, fn struc s)) mtch in + let moves = + Game.gen_moves Game.cGRID_SIZE rules + !state.Arena.struc graph.(!state.Arena.cur_loc) in + try + for i = 0 to Array.length moves - 1 do (* FIXME: handle time and params! *) - let mov = moves.(i) in - if - r_name = mov.Game.rule && + let mov = moves.(i) in + if + r_name = mov.Game.rule && (* t = mov.Game.time && *) (* something wrong with this: List.for_all (fun (pn, pv) -> pv = List.assoc pn mov.Game.parameters) p && *) - List.for_all (fun (e, f) -> - f = List.assoc e mov.Game.embedding) m - (* TODO: handle location matching *) - then ( - expected_location := mov.Game.next_loc; - let _ = if !debug_level > 2 then + List.for_all (fun (e, f) -> + f = List.assoc e mov.Game.embedding) m + (* TODO: handle location matching *) + then ( + expected_location := mov.Game.next_loc; + let _ = if !debug_level > 2 then Printf.printf "expected_location = %d\n%!" !expected_location in - raise (Found i)) - done; + raise (Found i)) + done; (* TODO: if not due to only time or params mismatch, block or warn about invalid rule application *) - let (new_state, resp) = - Arena.handle_request !state req in - if !debug_level > 0 then - Printf.printf "ApplyRule: mismatched with play state!\n%!"; - state := new_state; resp - with Found pos -> - let old_struc = !state.Arena.struc in - let (new_state, resp) = Arena.handle_request !state req in - let memory = match !play, !play_state with - | Some play, Some {Game.memory=memory; game_state=pstate} -> - Game.update_memory - ~num_players:play.Game.game.Arena.num_players - {Game.struc=old_struc; - time = !state.Arena.time; - loc = !state.Arena.cur_loc} pos memory - | _ -> failwith "req_handle: impossible" in - state := new_state; + let (new_state, resp) = + Arena.handle_request !state req in + if !debug_level > 0 then + Printf.printf "ApplyRule: mismatched with play state!\n%!"; + state := new_state; resp + with Found pos -> + let old_struc = !state.Arena.struc in + let (new_state, resp) = Arena.handle_request !state req in + let memory = match !play, !play_state with + | Some play, Some {Game.memory=memory; game_state=pstate} -> + Game.update_memory + ~num_players:play.Game.game.Arena.num_players + {Game.struc=old_struc; + time = !state.Arena.time; + loc = !state.Arena.cur_loc} pos memory + | _ -> failwith "req_handle: impossible" in + state := new_state; (* Rewriting doesn't handle location update. *) - let new_game_state = { - Game.struc = new_state.Arena.struc; - loc = moves.(pos).Game.next_loc; - time = new_state.Arena.time; - } in - play_state := Some { - Game.game_state = new_game_state; - memory = memory; - }; - resp - ) + let new_game_state = { + Game.struc = new_state.Arena.struc; + loc = moves.(pos).Game.next_loc; + time = new_state.Arena.time; + } in + play_state := Some { + Game.game_state = new_game_state; + memory = memory; + }; + resp + ) | _ -> - game_modified := !game_modified || - possibly_modifies_game req; - let (new_state, resp) = Arena.handle_request !state req in - state := new_state; resp in + game_modified := !game_modified || + possibly_modifies_game req; + let (new_state, resp) = Arena.handle_request !state req in + state := new_state; resp in if !debug_level > 0 then print_endline ("Repl: " ^ resp ^ "\n"); output_string out_ch (resp ^ "\n"); flush out_ch; with - Parsing.Parse_error -> - Printf.printf "Toss Server: parse error\n%!"; - output_string out_ch ("ERR could not parse\n"); - flush out_ch + | Parsing.Parse_error -> + Printf.printf "Toss Server: parse error\n%!"; + output_string out_ch ("ERR could not parse\n"); + flush out_ch + | Lexer.Parsing_error msg -> + Printf.printf "Toss Server: parse error: %s\n%!" msg; + output_string out_ch ("ERR could not parse\n"); + flush out_ch + | End_of_file -> + output_string out_ch ("ERR processing completed -- EOF\n"); + flush out_ch; raise End_of_file | exn -> - Printf.printf "Toss Server: error -- exception %s\n%!" - (Printexc.to_string exn); - Printf.printf "Exception backtrace: %s\n%!" - (Printexc.get_backtrace ()); - output_string out_ch ("ERR internal error -- see server stdout\n") + Printf.printf "Toss Server: error -- exception %s\n%!" + (Printexc.to_string exn); + Printf.printf "Exception backtrace: %s\n%!" + (Printexc.get_backtrace ()); + output_string out_ch ("ERR internal error -- see server stdout\n") (* ----------------------- START SERVER WHEN CALLED ------------------------- *) -let _ = +let main () = Gc.set { (Gc.get()) with Gc.space_overhead = 300; (* 300% instead of 80% std *) Gc.minor_heap_size = 64*1024; (* 2*std, opt ~= L2 cache/proc *) @@ -268,3 +275,16 @@ start_server req_handle !port !server with Host_not_found -> print_endline "The host you specified was not found." ;; + +let _ = + (* Test against being called from GameTest... *) + let target_name = "GameTest" in + 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 + (* so that the server is not started by the test suite. *) + if not test_fname then main ();; Added: trunk/Toss/Play/ServerTest.in =================================================================== --- trunk/Toss/Play/ServerTest.in (rev 0) +++ trunk/Toss/Play/ServerTest.in 2010-12-10 14:21:08 UTC (rev 1243) @@ -0,0 +1,2 @@ +ADD REL MODEL R(a,b) +GET ALLOF REL MODEL R Added: trunk/Toss/Play/ServerTest.out =================================================================== --- trunk/Toss/Play/ServerTest.out (rev 0) +++ trunk/Toss/Play/ServerTest.out 2010-12-10 14:21:08 UTC (rev 1243) @@ -0,0 +1,3 @@ +REL ADDED +R (a, b) +ERR processing completed -- EOF This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-09 20:05:20
|
Revision: 1242 http://toss.svn.sourceforge.net/toss/?rev=1242&view=rev Author: lukstafi Date: 2010-12-09 20:05:14 +0000 (Thu, 09 Dec 2010) Log Message: ----------- Game.suggest fix (admit effort). Modified Paths: -------------- trunk/Toss/Play/Game.ml trunk/Toss/Play/Game.mli trunk/Toss/Play/GameTest.ml trunk/Toss/Play/Server.ml Modified: trunk/Toss/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-09 15:42:27 UTC (rev 1241) +++ trunk/Toss/Play/Game.ml 2010-12-09 20:05:14 UTC (rev 1242) @@ -1203,7 +1203,23 @@ let init_state = initial_state ?loc play struc in play, init_state -let suggest play play_state = +let suggest ?effort play play_state = + let play = match effort with + | None -> play + | Some effort -> + {play with agents=Array.map + (function + | Tree_search (subgames, sth, params, agents) -> + Tree_search ( + subgames, sth, {params with iters=effort}, + agents) + | Maximax_evgame ( + subgames, cooperative, depth, use_pruning, reorder) -> + Maximax_evgame + (subgames, cooperative, effort, use_pruning, + reorder) + | (Random_move | External _) as agent -> agent + ) play.agents} in (* {{{ log entry *) if !debug_level > 2 then printf "\nsuggest:\n%!"; (* }}} *) Modified: trunk/Toss/Play/Game.mli =================================================================== --- trunk/Toss/Play/Game.mli 2010-12-09 15:42:27 UTC (rev 1241) +++ trunk/Toss/Play/Game.mli 2010-12-09 20:05:14 UTC (rev 1242) @@ -210,7 +210,7 @@ (** Suggest a (currently, single) move for a state, return the same state but with accrued computation (i.e. bigger stored search trees). *) -val suggest : +val suggest : ?effort:int -> play -> play_state -> (move * play_state) option Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-09 15:42:27 UTC (rev 1241) +++ trunk/Toss/Play/GameTest.ml 2010-12-09 20:05:14 UTC (rev 1242) @@ -1089,7 +1089,7 @@ |]; delta = 2.0} in (* FIXME: give/calc delta *) let init_state = Game.initial_state play struc in - Game.set_debug_level 3; + Game.set_debug_level 2; let wins = ref 0 in Printf.printf "Chess experiment -- white: default heuristic, black: chess piece value heuristic.\n%!"; let n = 5 in @@ -1107,10 +1107,10 @@ ); ] -let a = +let a () = Aux.run_test_if_target "GameTest" tests -let a () = run_test_tt ~verbose:true experiments +let a = run_test_tt ~verbose:true experiments (* The same content as in .toss files. *) Modified: trunk/Toss/Play/Server.ml =================================================================== --- trunk/Toss/Play/Server.ml 2010-12-09 15:42:27 UTC (rev 1241) +++ trunk/Toss/Play/Server.ml 2010-12-09 20:05:14 UTC (rev 1242) @@ -150,7 +150,7 @@ play := Some p; play_state := Some ps; p, ps in ignore (Unix.alarm timer); - let res = Game.suggest ~uct_iters:effort p ps in + let res = Game.suggest ~effort p ps in Game.cancel_timeout (); match res with | Some (move, new_state) -> This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-09 15:42:33
|
Revision: 1241 http://toss.svn.sourceforge.net/toss/?rev=1241&view=rev Author: lukstafi Date: 2010-12-09 15:42:27 +0000 (Thu, 09 Dec 2010) Log Message: ----------- Fixing agents to be player-specific instead of location specific. Chess test. Modified Paths: -------------- trunk/Toss/Play/Game.ml trunk/Toss/Play/Game.mli trunk/Toss/Play/GameTest.ml Modified: trunk/Toss/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-08 17:33:16 UTC (rev 1240) +++ trunk/Toss/Play/Game.ml 2010-12-09 15:42:27 UTC (rev 1241) @@ -64,7 +64,7 @@ embedding : (int * int) list ; } -(* Analogous to {!Arena.game_state}. *) +(* Analogous to {!Arena.game_state}, but without the game component. *) type game_state = { struc : Structure.structure ; (* structure state *) time : float ; (* current time in game *) @@ -148,13 +148,14 @@ game is used to assess the value of its location. It contains the same data as {!play} plus {!play_state} (for initial state) below, only without the [struc] and [time] fields, and with some general - playout parameters. *) + playout parameters. [ev_agents] array can be empty but only if + every location of the [ev_game] subgame has empty moves list. *) type evgame_loc = { ev_game : Arena.game; - ev_agents : agent array; + ev_agents : agent array; (* player-indexed or empty *) ev_delta : float; ev_location : int; - ev_memory : memory array; + ev_memory : memory array; (* player-indexed *) ev_horizon : int option; } and evaluation_game = evgame_loc array @@ -175,7 +176,7 @@ reordering based on afterstate heuristic value *) | Tree_search of evaluation_game * int option * uct_params * agent array (* Monte-Carlo tree search; uses the evaluation game to compute - heuristic values for use within the tree, and the agents to for + heuristic values for use within the tree, and the agents for playout plays *) | External of (string array -> int) (* take an array of string representations of resulting structures @@ -192,7 +193,7 @@ remove dependency on [delta] (move it to Arena.game). *) type play = { game : Arena.game ; (* the game played *) - agents : agent array ; (* location.id-indexed *) + agents : agent array ; (* player-indexed *) delta : float ; (* expected width of payoffs *) } @@ -450,20 +451,20 @@ let initial_state ?(loc=0) {game=game; agents=agents} model = - let player_memory = - Aux.map_reduce (fun x->x) (fun x y -> - match x,y with - | _, Tree_search _ | UCTree _, _ -> UCTree TEmpty - | _ -> No_memory) No_memory - (Array.to_list ( - Array.mapi (fun i loc -> loc.Arena.player, agents.(i)) - game.Arena.graph)) in + (* {{{ log entry *) + if !debug_level > 5 then ( + Printf.printf "initial_state: agents #=%d, loc #=%d\n%!" + (Array.length agents) (Array.length game.Arena.graph); + ); + (* }}} *) + let player_memory = Array.map + (function Tree_search _ -> UCTree TEmpty | _ -> No_memory) agents in { game_state = {loc = loc; time = 0.0; struc = model}; - memory = Aux.array_from_assoc player_memory; + memory = player_memory; } - +(* TODO: [num_players] not used (remove if not needed). *) let update_memory_single num_players state pos = function | No_memory -> No_memory | State_history history -> State_history (state.struc::history) @@ -658,7 +659,7 @@ loc.Arena.payoffs_pp in Aux.Right payoff else - let agent = agents.(state.loc) in + let agent = agents.(loc.Arena.player) in match agent with | Random_move -> let pos = ref (Random.int (Array.length moves)) in @@ -899,13 +900,14 @@ structure and its payoff. The [set_timer] should be only provided for standalone plays. For - suggestions, the timer is set by {!Server}. *) + suggestions, the timer is set by {!Server}. Tests use their own + timers too, see {!GameTest}. *) and play ~grid_size ?set_timer ?horizon ?(plys=0) play_def state = let () = match set_timer with | None -> () | Some timer -> (* {{{ log entry *) - if !debug_level > 0 then printf "SET ALARM %d\n%!" timer; + if !debug_level > 2 then printf "SET ALARM %d\n%!" timer; (* }}} *) ignore (Unix.alarm timer) in let res = @@ -919,7 +921,7 @@ | Aux.Left (_,_,_,state) -> (* {{{ log entry *) - if !debug_level > 5 then + if !debug_level > 5 || (!debug_level > 1 && set_timer <> None) then printf "step-state:\n%s\n%!" (Structure.str state.game_state.struc); (* }}} *) @@ -1076,8 +1078,21 @@ node_subtrees=subtrees; node_bestheur=bestheur; }) +let evgame_of_heuristic heuristics heuristics_pp game = + let evgame gloc = + {ev_game = + {Arena.rules = []; + player_names = game.Arena.player_names; + defined_rels = game.Arena.defined_rels; + graph = [| + {Arena.id=0; player=gloc.Arena.player; + payoffs=heuristics.(gloc.Arena.id); + payoffs_pp=heuristics_pp.(gloc.Arena.id); moves=[]} |]; + num_players = game.Arena.num_players}; + ev_agents = [| |]; ev_delta = 0.0; ev_location = 0; + ev_horizon = Some 0; ev_memory = [| |]} in + Array.map evgame game.Arena.graph - (* An UCT-based agent that uses either random playouts (when [random_playout] is set to true) or the same location-dependent heuristic for maximax search as given for the inside-tree @@ -1086,48 +1101,26 @@ ?(heur_adv_ratio=default_adv_ratio) ?(random_playout=false) ?(playout_mm_depth=0) ?(heur_effect=default_params.heur_effect) ?horizon game = + (* heuristics are location-id indexed first, then player-indexed *) let heuristics = match heuristic with Some h -> h | None -> default_heuristic ~struc heur_adv_ratio game in let heuristics_pp = Array.map (Array.map Solver.M.register_real_expr) heuristics in - let evgame gloc = - {ev_game = - {Arena.rules = []; - player_names = game.Arena.player_names; - defined_rels = game.Arena.defined_rels; - graph = [| - {Arena.id=0; player=gloc.Arena.player; - payoffs=heuristics.(gloc.Arena.id); - payoffs_pp=heuristics_pp.(gloc.Arena.id); moves=[]} |]; - num_players = game.Arena.num_players}; - ev_agents = [| |]; ev_delta = 0.0; ev_location = 0; - ev_horizon = Some 0; ev_memory = [| |]} in - let agents = - Array.map (fun loc -> - {ev_game = - {Arena.rules=[]; - player_names = game.Arena.player_names; - defined_rels = game.Arena.defined_rels; - graph=[| - {Arena.id=0; player=loc.Arena.player; - payoffs=heuristics.(loc.Arena.id); - payoffs_pp=heuristics_pp.(loc.Arena.id); moves=[]} |]; - num_players=game.Arena.num_players}; - ev_agents = [| |]; ev_delta = 0.0; ev_location = 0; - ev_horizon = Some 0; ev_memory = [| |]} - ) game.Arena.graph in - let evgames = + let heur_evgame = + evgame_of_heuristic heuristics heuristics_pp game in + let playout_agents = if not (random_playout || heur_effect = Heuristic_only) then Array.map (fun _ -> - Maximax_evgame (agents, false, playout_mm_depth, true, false)) + Maximax_evgame + (heur_evgame, false, playout_mm_depth, true, false)) game.Arena.graph else Array.map (fun _ -> Random_move) game.Arena.graph in Tree_search - (Array.map evgame game.Arena.graph, Some 0, + (heur_evgame, Some 0, {default_params with iters=iters; horizon=horizon; heur_effect=heur_effect}, - evgames) + playout_agents) (* Plain limited depth maximax tree search. *) let default_maximax struc ~depth ?heuristic @@ -1138,24 +1131,10 @@ default_heuristic ~struc heur_adv_ratio game in let heuristics_pp = Array.map (Array.map Solver.M.register_real_expr) heuristics in - let agents = - Array.map (fun loc -> - {ev_game = - {Arena.rules=[]; - player_names = game.Arena.player_names; - defined_rels = game.Arena.defined_rels; - graph=[| - {Arena.id=0; player=loc.Arena.player; - payoffs=heuristics.(loc.Arena.id); - payoffs_pp=heuristics_pp.(loc.Arena.id); moves=[]} |]; - num_players=game.Arena.num_players}; - ev_agents = [| |]; ev_delta = 0.0; ev_location = 0; - ev_horizon = Some 0; ev_memory = [| |]} - ) game.Arena.graph in - Maximax_evgame (agents, false, depth, pruning, reorder) + let heur_evgame = + evgame_of_heuristic heuristics heuristics_pp game in + Maximax_evgame (heur_evgame, false, depth, pruning, reorder) - (* | Tree_search of evaluation_game * int option * uct_params * agent array *) - (* An UCT-based agent that uses UCT-based playouts. *) let nested_treesearch struc iters reciters ?heuristic ?(random_playout=false) ?horizon orig_game = @@ -1164,25 +1143,15 @@ default_heuristic ~struc default_adv_ratio orig_game in let heuristics_pp = Array.map (Array.map Solver.M.register_real_expr) heuristics in - let evgame gloc = - {ev_game = - {Arena.rules=[]; - player_names = orig_game.Arena.player_names; - defined_rels = orig_game.Arena.defined_rels; - graph=[| - {Arena.id=0; player=gloc.Arena.player; - payoffs=heuristics.(gloc.Arena.id); - payoffs_pp=heuristics_pp.(gloc.Arena.id); moves=[]} |]; - num_players=orig_game.Arena.num_players}; - ev_agents = [| |]; ev_delta = 0.0; ev_location = 0; - ev_horizon = Some 0; ev_memory = [| |]} in + let heur_evgame = + evgame_of_heuristic heuristics heuristics_pp orig_game in let agents = Array.map (fun ar_loc -> default_treesearch struc ~iters:reciters ~random_playout ?horizon ?heuristic orig_game) orig_game.Arena.graph in Tree_search - (Array.map evgame orig_game.Arena.graph, Some 0, + (heur_evgame, Some 0, {default_params with iters=iters; horizon=horizon}, agents) @@ -1199,13 +1168,13 @@ let agent = match search_method with | "maximax" -> - default_maximax state.Arena.struc ~depth:effort + default_maximax state.Arena.struc ~depth:effort ?heuristic ?heur_adv_ratio ~pruning:false ~reorder:false game | "alpha_beta" -> - default_maximax state.Arena.struc ~depth:effort + default_maximax state.Arena.struc ~depth:effort ?heuristic ?heur_adv_ratio ~pruning:true ~reorder:false game | "alpha_beta_ord" -> - default_maximax state.Arena.struc ~depth:effort + default_maximax state.Arena.struc ~depth:effort ?heuristic ?heur_adv_ratio ~pruning:true ~reorder:true game | "uct_random_playouts" -> default_treesearch state.Arena.struc @@ -1226,7 +1195,7 @@ | s -> failwith ("Game.initialize: unknown search method "^s) in let play = - {game = game; agents=Array.map (fun _ -> agent) graph; + {game = game; agents=Array.make num_players agent; delta = 2.0} in (* FIXME: give/calc delta *) (* {{{ log entry *) if !debug_level > 2 then printf "play initialized\n%!"; @@ -1234,18 +1203,7 @@ let init_state = initial_state ?loc play struc in play, init_state -let suggest ?uct_iters play play_state = - let play = match uct_iters with - | None -> play - | Some iters -> - {play with agents=Array.map - (function - | Tree_search (subgames, sth, params, agents) -> - Tree_search ( - subgames, sth, {params with iters=iters}, - agents) - | agent -> agent - ) play.agents} in +let suggest play play_state = (* {{{ log entry *) if !debug_level > 2 then printf "\nsuggest:\n%!"; (* }}} *) @@ -1256,8 +1214,10 @@ (* [suggest] does not update the state, rule application should do it *) (* {{{ log entry *) + if !debug_level > 1 then printf "suggest: pos %d\n%!" bpos; + (* }}} *) Some (moves.(bpos), {play_state with memory=memory}) | Aux.Right payoffs -> None) Modified: trunk/Toss/Play/Game.mli =================================================================== --- trunk/Toss/Play/Game.mli 2010-12-08 17:33:16 UTC (rev 1240) +++ trunk/Toss/Play/Game.mli 2010-12-09 15:42:27 UTC (rev 1241) @@ -210,7 +210,7 @@ (** Suggest a (currently, single) move for a state, return the same state but with accrued computation (i.e. bigger stored search trees). *) -val suggest : ?uct_iters:int -> +val suggest : play -> play_state -> (move * play_state) option Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-08 17:33:16 UTC (rev 1240) +++ trunk/Toss/Play/GameTest.ml 2010-12-09 15:42:27 UTC (rev 1241) @@ -470,6 +470,22 @@ let chess_game = lazy (2.0, state_of_file "./examples/Chess.toss") +let chess_piece_value_heur = + let white_val = + "Sum (x | wP(x): 1) + Sum (x | wN(x): 3.2) + + Sum (x | wB(x): 3.33) + Sum (x | wR(x): 5.1) + Sum (x | wQ(x): 8.8) + + Sum (x | wK(x): 100)" in + let black_val = + "Sum (x | bP(x): 1) + Sum (x | bN(x): 3.2) + + Sum (x | bB(x): 3.33) + Sum (x | bR(x): 5.1) + Sum (x | bQ(x): 8.8) + + Sum (x | bK(x): 100)" in + let white_heur = + real_expr_of_str ("("^white_val^") - ("^black_val^")") in + let black_heur = + real_expr_of_str ("("^black_val^") - ("^white_val^")") in + let heuristic = [|white_heur; black_heur|] in + Array.make 32 heuristic + let check_loc_random = function | Game.Tree_search (_,_,_,evgames) -> if @@ -483,7 +499,6 @@ else failwith "check_loc_random: inconsistent" | _ -> failwith "check_loc_random: not a Tree_search" - let payoff_str pay = String.concat ", " (List.map (fun (p,v)->p^": "^string_of_float v) pay) @@ -575,6 +590,25 @@ (move_opt <> None); ); + "play: chess random play" >:: + (fun () -> + let (heur_adv_ratio, state) = + Lazy.force chess_game in + let struc = state.Arena.struc in + let game = state.Arena.game in + let play = + {Game.game = game; agents= + [|Game.Random_move; Game.Random_move|]; + delta = 2.0} in (* FIXME: give/calc delta *) + let init_state = Game.initial_state play struc in + let endstate,payoff = + Game.play ~grid_size:Game.cGRID_SIZE + ~set_timer:360 ~horizon:30 play init_state in + (* nothing to assert -- just check halting without exceptions *) + Printf.printf "Chess random play horizon=30 ended in:\n%s\n%!" + (Structure.sprint endstate) + ); + "breakthrough payoff" >:: (fun () -> let state = update_game breakthrough_game @@ -1036,45 +1070,29 @@ ] let experiments = "Game" >::: [ - "" >:: + "ChessExperiment" >:: (fun () -> let (heur_adv_ratio, state) = - gomoku8x8_game (* breakthrough_game *) in + Lazy.force chess_game in let struc = state.Arena.struc in let game = state.Arena.game in (* TODO: default_heuristic redoes payoff normalization. *) let play = {Game.game = game; agents= [| - (* - Game.default_treesearch (fst state.Arena.nstruc) - ~iters:15 ~random_playout:false ~playout_mm_depth:1 - ~heur_adv_ratio:2.5 game; - Game.default_treesearch (fst state.Arena.nstruc) - ~iters:100 ~random_playout:false game; - Game.default_treesearch (fst state.Arena.nstruc) - ~iters:2000 ~heur_effect:Game.Heuristic_only game; - Game.default_maximax (fst state.Arena.nstruc) ~depth:3 - ~pruning:false ~reorder:false game; - Game.default_idpruning (fst state.Arena.nstruc) ~depth:40 - game; - Game.default_maximax (fst state.Arena.nstruc) ~depth:3 - ~pruning:true ~reorder:true game; - Game.default_idpruning (fst state.Arena.nstruc) ~depth:3 - game; - *) - Game.default_maximax state.Arena.struc ~depth:3 + Game.default_maximax state.Arena.struc ~depth:2 ~heur_adv_ratio ~pruning:true ~reorder:true game; Game.default_maximax state.Arena.struc ~depth:2 - ~heur_adv_ratio + ~heuristic:chess_piece_value_heur ~heur_adv_ratio ~pruning:true ~reorder:true game; |]; delta = 2.0} in (* FIXME: give/calc delta *) let init_state = Game.initial_state play struc in - Game.set_debug_level 2; + Game.set_debug_level 3; let wins = ref 0 in - let n = 2 in + Printf.printf "Chess experiment -- white: default heuristic, black: chess piece value heuristic.\n%!"; + let n = 5 in for i = 1 to n do Printf.printf "Experiment: Game nr %d of %d\n%!" i n; let _,payoff = @@ -1084,8 +1102,8 @@ done; assert_bool (Printf.sprintf "Hypothesis: -- wronged %d out of %d trials." - !wins n) - (!wins < 2) + (n - !wins) n) + (!wins > 2) ); ] This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-08 17:33:24
|
Revision: 1240 http://toss.svn.sourceforge.net/toss/?rev=1240&view=rev Author: lukaszkaiser Date: 2010-12-08 17:33:16 +0000 (Wed, 08 Dec 2010) Log Message: ----------- Final release changes. Modified Paths: -------------- trunk/Toss/Client/TossMainWindow.py trunk/Toss/Makefile trunk/Toss/README trunk/Toss/Solver/Structure.mli trunk/Toss/examples/Chess.toss Modified: trunk/Toss/Client/TossMainWindow.py =================================================================== --- trunk/Toss/Client/TossMainWindow.py 2010-12-08 15:17:50 UTC (rev 1239) +++ trunk/Toss/Client/TossMainWindow.py 2010-12-08 17:33:16 UTC (rev 1240) @@ -202,7 +202,7 @@ def about (self): about_text = ' \ - <h2>Toss 0.4</h2> \ + <h2>Toss 0.5</h2> \ <p>Visit Toss website at \ <a href="http://toss.sourceforge.net/">toss.sourceforge.net</a> \ for more information.</p> \ @@ -211,10 +211,6 @@ <li>Lukasz Kaiser</li> \ <li>Tobias Ganzow</li> \ <li>Lukasz Stafiniak</li> \ - <li>Dietmar Berwanger</li> \ - <li>Matko Botincan</li> \ - <li>Diana Fischer</li> \ - <li>Michal Wojcik</li> \ </ul> \ <p>Other contributors are listed on our \ <a href="http://toss.sourceforge.net/contact.html">\ Modified: trunk/Toss/Makefile =================================================================== --- trunk/Toss/Makefile 2010-12-08 15:17:50 UTC (rev 1239) +++ trunk/Toss/Makefile 2010-12-08 17:33:16 UTC (rev 1240) @@ -6,7 +6,19 @@ Server: Play/Server.native cp _build/Play/Server.native Server +Release: + make -C . clean + make -C . Client + make -C . Server + make -C . doc + mkdir ../toss_0.5 + cp -r * ../toss_0.5 + find ../toss_0.5 -name '.svn' -exec rm -rf {} \; + rm -rf ../toss_0.5/_build ../toss_0.5/gmon.out + zip -r toss_0.5.zip ../toss_0.5 + rm -rf ../toss_0.5 + # ------ NON OCAMLBUILD DEPENDENCIES -------- caml_extensions/pa_let_try.cmo: caml_extensions/pa_let_try.ml Modified: trunk/Toss/README =================================================================== --- trunk/Toss/README 2010-12-08 15:17:50 UTC (rev 1239) +++ trunk/Toss/README 2010-12-08 17:33:16 UTC (rev 1240) @@ -2,26 +2,16 @@ * RUNNING TOSS To run Toss you need python, Qt4 (>=4.6 recommended) and PyQt4. -(As a developer, you additionally need ocaml, menhir, ounit and pyqt4-dev-tools.) +Under Ubuntu do "sudo apt-get install python-qt4". +When you have these, just run "./Toss.py" or click on it. -When you have these, just run "python Toss.py". - * COMPILING TOSS -- Installing dependencies under Ubuntu Run the following in terminal: - sudo apt-get install python-qt4 python-dev pyqt4-dev-tools ocaml-findlib menhir -You will also need oUnit: starting from Lucid Lynx just - sudo apt-get install libounit-ocaml-dev -else, and *only if the above failed* do - # wget http://www.xs4all.nl/~mmzeeman/ocaml/ounit-1.0.3.tar.gz - # tar xzf ounit-1.0.3.tar.gz - # cd ounit-1.0.3 - # make allopt - # sudo make install - # cd ..; rm -rf ounit-1.0.3; rm ounit-1.0.3.tar.gz + sudo apt-get install python-qt4 python-dev pyqt4-dev-tools ocaml-findlib menhir libounit-ocaml-dev Finally to compile Toss just type make @@ -32,7 +22,7 @@ * AUTHORS The current version of Toss is developed by -- Łukasz Kaiser (ka...@lo...) +- Łukasz Kaiser (ka...@li...) - Tobias Ganzow - Łukasz Stafiniak Modified: trunk/Toss/Solver/Structure.mli =================================================================== --- trunk/Toss/Solver/Structure.mli 2010-12-08 15:17:50 UTC (rev 1239) +++ trunk/Toss/Solver/Structure.mli 2010-12-08 17:33:16 UTC (rev 1240) @@ -1,24 +1,24 @@ -(* Representing Structures *) +(** Representing Structures *) val debug_level : int ref -module IntMap : Map.S with type key = int (* Maps from int to 'alpha *) +module IntMap : Map.S with type key = int (** Maps from int to 'alpha *) -module StringMap : Map.S with type key = string (* Maps from string to 'alpha*) +module StringMap : Map.S with type key = string (** Maps from string to 'alpha*) -module Elems : Set.S with type elt = int (* Sets of integers *) +module Elems : Set.S with type elt = int (** Sets of integers *) val add_elems : int list -> Elems.t -> Elems.t val elems_of_list : int list -> Elems.t module Tuples : Set.S with type elt = int array -(* No element is named by a decimal numeral other than its +(** No element is named by a decimal numeral other than its number. Elements not appearing in [names] are assumed to be named by their decimal numeral. *) type structure = { rel_signature : int StringMap.t ; - elements : Elems.t ; (* Elements should be *positive* integers. *) + elements : Elems.t ; (** Elements should be *positive* integers. *) relations : Tuples.t StringMap.t ; functions : (float IntMap.t) StringMap.t ; incidence : (Tuples.t IntMap.t) StringMap.t ; @@ -31,59 +31,60 @@ val equal : structure -> structure -> bool -(* ----------------------- BASIC HELPER FUNCTIONS --------------------------- *) +(** {2 Basic helper functions} *) -(* Reverse a map: make a string IntMap from an int StringMap. *) + +(** Reverse a map: make a string IntMap from an int StringMap. *) val rev_string_to_int_map : int StringMap.t -> string IntMap.t -(* Reverse a map: make an int StringMap from a string IntMap. *) +(** Reverse a map: make an int StringMap from a string IntMap. *) val rev_int_to_string_map : string IntMap.t -> int StringMap.t -(* Return the empty structure (with empty signature). *) +(** Return the empty structure (with empty signature). *) val empty_structure : unit -> structure -(* Return the empty structure with given relational signature. *) +(** Return the empty structure with given relational signature. *) val empty_with_signat : (string * int) list -> structure -(* Return the list of relation tuples incident to an element [e] in [struc]. *) +(** Return the list of relation tuples incident to an element [e] in [struc]. *) val incident : structure -> int -> (string * int array list) list -(* Check if a relation holds for a tuple. *) +(** Check if a relation holds for a tuple. *) val check_rel : structure -> string -> int array -> bool -(* Return the value of function [f] on [e] in [struc]. *) +(** Return the value of function [f] on [e] in [struc]. *) val fun_val : structure -> string -> int -> float -(* Return the list of functions. *) +(** Return the list of functions. *) val f_signature : structure -> string list -(* ------------------------ PRINTING STRUCTURES ----------------------------- *) +(** {2 Printing structures} *) -(* Print the elements [e] as string. *) +(** Print the elements [e] as string. *) val elem_str : structure -> int -> string -(* Print the tuple [tp] as string. When [with_paren] is set to false, +(** Print the tuple [tp] as string. When [with_paren] is set to false, avoid printing parentheses around one-element tuple. *) val tuple_str : ?with_paren:bool -> structure -> int array -> string -(* Print the relation named [rel_name] with tuples [ts] as +(** Print the relation named [rel_name] with tuples [ts] as string. Unless [print_arity] is false, print the arity if [ts] is empty. *) val rel_str : ?print_arity:bool -> structure -> string -> Tuples.t -> string -(* Print the function named [fun_name] with values [vals] as string. *) +(** Print the function named [fun_name] with values [vals] as string. *) val fun_str : structure -> string -> float IntMap.t -> string -(* Print relational signature. *) +(** Print relational signature. *) val sig_str : structure -> string -(* Print the structure [struc] as string, in extensive form (not using +(** Print the structure [struc] as string, in extensive form (not using condensed representations like boards). *) val ext_str : structure -> string -(* Print the structure [struc] as string. *) +(** Print the structure [struc] as string. *) val str : structure -> string @@ -105,89 +106,94 @@ val sprint : structure -> string -(* ---------- ADDING ELEMENTS POSSIBLY WITH STRING NAMES ---------- *) +(** {2 Adding elements possibly with string names} *) -(* Nonexisting elements or relations, signature mismatch, etc. *) + +(** Nonexisting elements or relations, signature mismatch, etc. *) exception Structure_mismatch of string -(* Add element [e] to [struc] if it is not yet there. Return new structure. *) +(** Add element [e] to [struc] if it is not yet there. Return new structure. *) val add_elem : structure -> ?name:string -> int -> structure -(* Add new element to [struc], return the updated structure and the +(** Add new element to [struc], return the updated structure and the element. *) val add_new_elem : structure -> ?name:string -> unit -> structure * int val find_elem : structure -> string -> int -(* Find an element in the structure, and if not present, add new one. *) +(** Find an element in the structure, and if not present, add new one. *) val find_or_new_elem : structure -> string -> structure * int -(* --------- ADDING RELATION TUPLES POSSIBLY WITH NAMED ELEMENTS ---------- *) -(* Ensure relation named [rn] exists in [struc], add if needed. *) +(** {2 Adding relation tuples possibly with named elements} *) + + +(** Ensure relation named [rn] exists in [struc], add if needed. *) val add_rel_name : string -> int -> structure -> structure -(* Add relation named [rn] to [struc], with given arity, regardless of +(** Add relation named [rn] to [struc], with given arity, regardless of whether it already existed. *) val force_add_rel_name : string -> int -> structure -> structure -(* Add tuple [tp] to relation [rn] in structure [struc]. *) +(** Add tuple [tp] to relation [rn] in structure [struc]. *) val add_rel : structure -> string -> int array -> structure -(* Add tuples [tps] to relation [rn] in structure [struc]. *) +(** Add tuples [tps] to relation [rn] in structure [struc]. *) val add_rels : structure -> string -> int array list -> structure -(* Return a structure with a single relation of given arity, over a +(** Return a structure with a single relation of given arity, over a single tuple, of different elements. *) val free_for_rel : string -> int -> structure -(* --------- ADDING FUNCTION ASSINGMENTS POSSIBLY TO NAMED ELEMENTS --------- *) -(* Add function assignment [e] -> [x] to function [fn] in structure [struc]. *) +(** {2 Adding function assignments possibly to named elements} *) + + +(** Add function assignment [e] -> [x] to function [fn] in structure [struc]. *) val add_fun : structure -> string -> int * float -> structure -(* Add function assignments [assgns] to [fn] in structure [struc]. *) +(** Add function assignments [assgns] to [fn] in structure [struc]. *) val add_funs : structure -> string -> (int * float) list -> structure -(* ------------ GLOBAL FUNCTION TO CREATE STRUCTURES FROM LISTS ------------ *) +(** {2 Global function to create structures from lists} *) val create_from_lists : ?struc:structure -> string list -> (string * int option * string array list) list -> (string * (string * float) list) list -> structure -(* ---------- REMOVING RELATION TUPLES AND ELEMENTS FROM A STRUCTURE -------- *) +(** {2 Removing relation tuples and elements from a structure} *) -(* Remove the tuple [tp] from relation [rn] in structure [struc]. May +(** Remove the tuple [tp] from relation [rn] in structure [struc]. May raise [Not_found] if the tuple is not in the relation (but is not guaranteed to). *) val del_rel : structure -> string -> int array -> structure -(* Remove the tuples [tps] from relation [rn] in structure [struc]. May +(** Remove the tuples [tps] from relation [rn] in structure [struc]. May raise [Not_found] if some tuple is not in the relation (but is not guaranteed to). *) val del_rels : structure -> string -> int array list -> structure -(* Remove all relations matching the predicate. By default, also remove +(** Remove all relations matching the predicate. By default, also remove them from the signature. *) val clear_rels : ?remove_from_sig:bool -> structure -> (string -> bool) -> structure -(* Remove the element [e] and all incident relation tuples from [struc]. *) +(** Remove the element [e] and all incident relation tuples from [struc]. *) val del_elem : structure -> int -> structure -(* Remove elements [es] and all incident relation tuples from +(** Remove elements [es] and all incident relation tuples from [struc]. Return the resulting structure and deleted relation tuples. *) val del_elems : structure -> int list -> structure * (string * int array list) list -(* Remove the elements that are not incident to any relation (and have +(** Remove the elements that are not incident to any relation (and have no defined properties, unless [ignore_funs] is given). *) val gc_elems : ?ignore_funs:bool -> structure -> structure -(* -------------------- PARSER HELPERS -------------------- *) +(** {2 Parser Helpers} *) exception Board_parse_error of string Modified: trunk/Toss/examples/Chess.toss =================================================================== --- trunk/Toss/examples/Chess.toss 2010-12-08 15:17:50 UTC (rev 1239) +++ trunk/Toss/examples/Chess.toss 2010-12-08 17:33:16 UTC (rev 1240) @@ -1,4 +1,5 @@ PLAYERS 1, 2 +DATA depth: 1 REL IsFirst(x) = not ex z C(z, x) REL IsSecond(x) = ex y (C(y, x) and IsFirst(y)) REL IsEight(x) = not ex z C(x, z) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-08 15:17:57
|
Revision: 1239 http://toss.svn.sourceforge.net/toss/?rev=1239&view=rev Author: lukstafi Date: 2010-12-08 15:17:50 +0000 (Wed, 08 Dec 2010) Log Message: ----------- Memoization in Heuristic. Modified Paths: -------------- trunk/Toss/Play/Game.ml trunk/Toss/Play/GameTest.ml trunk/Toss/Play/Heuristic.ml Modified: trunk/Toss/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-08 13:34:43 UTC (rev 1238) +++ trunk/Toss/Play/Game.ml 2010-12-08 15:17:50 UTC (rev 1239) @@ -234,6 +234,7 @@ let drules = List.map (fun r -> (snd r).ContinuousRule.compiled) rules in let fluents = Aux.concat_map DiscreteRule.fluents drules in + let frels = Aux.strings_of_list fluents in let monotonic = List.for_all DiscreteRule.monotonic drules in let signat_struc = match struc with Some struc -> struc @@ -260,7 +261,7 @@ ); (* }}} *) Heuristic.of_payoff ?struc ?fluent_preconds advance_ratio - (Aux.strings_of_list fluents) payoff) + frels payoff) node.Arena.payoffs) graph Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-08 13:34:43 UTC (rev 1238) +++ trunk/Toss/Play/GameTest.ml 2010-12-08 15:17:50 UTC (rev 1239) @@ -566,9 +566,6 @@ "play: chess suggest first move" >:: (fun () -> let state = Lazy.force chess_game in - Game.set_debug_level 5; - (* Heuristic.debug_level := 7; *) - (* FFTNF.debug_level := 7; *) let move_opt = (let p,ps = Game.initialize_default (snd state) ~heur_adv_ratio:(fst state) ~loc:0 ~effort:1 @@ -576,7 +573,6 @@ Game.suggest p ps) in assert_bool "Game is not over yet -- some move expected." (move_opt <> None); - Game.set_debug_level 0; ); "breakthrough payoff" >:: @@ -1108,7 +1104,7 @@ let a () = match test_filter - ["Game:0:misc:1:play: chess suggest first move"] + ["Game:1:alpha_beta_ord:11:gomoku8x8 avoid endgame"] tests with | Some tests -> ignore (run_test_tt ~verbose:true tests) Modified: trunk/Toss/Play/Heuristic.ml =================================================================== --- trunk/Toss/Play/Heuristic.ml 2010-12-08 13:34:43 UTC (rev 1238) +++ trunk/Toss/Play/Heuristic.ml 2010-12-08 15:17:50 UTC (rev 1239) @@ -800,6 +800,13 @@ | hd::tl -> List.fold_left (fun acc e -> Plus (acc, e)) hd tl + +let cache_monotonic_context = ref [] +let cache_fluents_context = ref Aux.Strings.empty +let cache_expansion_context = ref (Structure.empty_structure ()) +let cache_monotonic = Hashtbl.create 5 +let cache_general = Hashtbl.create 15 + (* Heuristic for the monotonic case. *) let of_preconds preconds adv_ratio frels phi = let guards = FFTNF.ffsep frels phi in @@ -822,60 +829,116 @@ | Times (a, b) -> Times (aux gds a, aux gds b) | Plus (a, b) -> Plus (aux gds a, aux gds b) | Char phi -> - let parsimony_level = - match force_parsimony with - | Some parl -> parl - | None -> - let size = FormulaOps.size phi in - if size < !FFTNF.parsimony_threshold_1 then 0 - else if size < !FFTNF.parsimony_threshold_2 then 1 - else 2 in (match fluent_preconds with | None -> (* not monotonic *) - let phi' = - if parsimony_level > 1 then phi - else match struc with - | Some struc -> - (* TODO: summation guards [gds] are currently ignored *) - (* {{{ log entry *) - if !debug_level > 2 then ( - Printf.printf - "Heuristic: for expanding, get ff-tnf of %s...\n%!" - (Formula.sprint phi); - ); - (* }}} *) - let phi'' = - if parsimony_level > 0 then phi - else FFTNF.ff_tnf (FFTNF.promote_rels frels) phi in - (* {{{ log entry *) - if !debug_level > 2 then ( - Printf.printf - "Heuristic: computing expanded form of %s...\n%!" - (Formula.sprint phi''); - ); - (* }}} *) - expanded_form max_alt_descr frels struc phi'' - | None -> phi in - (* {{{ log entry *) - if !debug_level > 2 then ( - Printf.printf - "Heuristic: computing for (expanded) formula %s...\n%!" - (Formula.sprint phi') - ); - (* }}} *) - of_formula adv_ratio - (FFTNF.ff_tnf (FFTNF.promote_rels frels) phi') + (try + if (struc <> None && + !cache_expansion_context != Aux.unsome struc) || + (* perhaps check fluents structurally? *) + !cache_fluents_context != frels + then ( + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "of_payoff: resetting cache because %s\n%!" + (if (struc <> None && + !cache_expansion_context != Aux.unsome struc) + then "struc" + else if !cache_fluents_context != frels + then "frels" + else "no reason"); + ); + (* }}} *) + Hashtbl.clear cache_general; + if struc <> None then + cache_expansion_context := Aux.unsome struc; + cache_fluents_context := frels; + raise Not_found); + Hashtbl.find cache_general phi + with Not_found -> + let parsimony_level = + match force_parsimony with + | Some parl -> parl + | None -> + let size = FormulaOps.size phi in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "of_payoff: formula size=%d\n%!" size; + ); + (* }}} *) + if size < !FFTNF.parsimony_threshold_1 then 0 + else if size < !FFTNF.parsimony_threshold_2 then 1 + else 2 in + let phi' = + if parsimony_level > 1 then phi + else match struc with + | Some struc -> + (* TODO: summation guards [gds] are currently ignored *) + (* {{{ log entry *) + if !debug_level > 2 then ( + Printf.printf + "Heuristic: for expanding, get ff-tnf of %s...\n%!" + (Formula.sprint phi); + ); + (* }}} *) + let phi'' = + if parsimony_level > 0 then phi + else FFTNF.ff_tnf (FFTNF.promote_rels frels) phi in + (* {{{ log entry *) + if !debug_level > 2 then ( + Printf.printf + "Heuristic: computing expanded form of %s...\n%!" + (Formula.sprint phi''); + ); + (* }}} *) + expanded_form max_alt_descr frels struc phi'' + | None -> phi in + (* {{{ log entry *) + if !debug_level > 2 then ( + Printf.printf + "Heuristic: computing for (expanded) formula %s...\n%!" + (Formula.sprint phi') + ); + (* }}} *) + let res = + of_formula adv_ratio + (FFTNF.ff_tnf (FFTNF.promote_rels frels) phi') in + Hashtbl.add cache_general phi res; + res) | Some fluent_preconds -> (* monotonic case *) - (* {{{ log entry *) - if !debug_level > 2 then ( - Printf.printf - "Heuristic: computing monotonic for %s...\n%!" - (Formula.sprint phi); - ); - (* }}} *) - (* FIXME: shouldn't be expanding? *) - of_preconds fluent_preconds adv_ratio frels phi + (try + if !cache_monotonic_context != fluent_preconds || + (* perhaps check fluents structurally? *) + !cache_fluents_context != frels + then ( + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "of_payoff: resetting cache because %s\n%!" + (if !cache_monotonic_context != fluent_preconds + then "preconds" + else if !cache_fluents_context != frels + then "frels" + else "no reason"); + ); + (* }}} *) + Hashtbl.clear cache_monotonic; + cache_monotonic_context := fluent_preconds; + cache_fluents_context := frels; + raise Not_found); + Hashtbl.find cache_monotonic phi + with Not_found -> + (* {{{ log entry *) + if !debug_level > 2 then ( + Printf.printf + "Heuristic: computing monotonic for %s...\n%!" + (Formula.sprint phi); + ); + (* }}} *) + (* FIXME: shouldn't be expanding? *) + let res = + of_preconds fluent_preconds adv_ratio frels phi in + Hashtbl.add cache_monotonic phi res; + res) ) | Sum (vl, gd, e) -> Sum (vl, gd, aux (gd::gds) e) in let res = aux [] expr in This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-08 13:34:50
|
Revision: 1238 http://toss.svn.sourceforge.net/toss/?rev=1238&view=rev Author: lukstafi Date: 2010-12-08 13:34:43 +0000 (Wed, 08 Dec 2010) Log Message: ----------- Agent generation fix. Modified Paths: -------------- trunk/Toss/Play/Game.ml trunk/Toss/Play/GameTest.ml Modified: trunk/Toss/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-08 01:21:36 UTC (rev 1237) +++ trunk/Toss/Play/Game.ml 2010-12-08 13:34:43 UTC (rev 1238) @@ -89,7 +89,7 @@ and uctree = | Node of uctree_node | Leaf of game_state * score * f_table * Structure.structure - (* once played leaf: state, time, location, score, heuristic, end-game *) + (* once played leaf: state, time, location, score, heuristic, game-end *) | Tip of game_state * f_table (* unplayed leaf, with heuristic value (evaluation game result) *) @@ -249,12 +249,12 @@ Array.mapi (fun i node -> Array.map (fun payoff -> (* {{{ log entry *) - if !debug_level > 4 then ( + if !debug_level > 5 then ( Printf.printf "default_heuristic: Computing for loc %d of payoff %s...\n%!" i (Formula.sprint_real payoff); ); - if !debug_level = 4 then ( + if !debug_level = 5 then ( Printf.printf "default_heuristic: Computing for loc %d\n%!" i; ); @@ -687,7 +687,7 @@ let size_count = ref 1 in let depth0 = depth in let debug_playclock = ref 0. in - if !debug_level > 1 && depth > 1 + if !debug_level > 1 && depth > 1 || !debug_level > 3 then ( printf "toss: %s%s ev game, timer started...\n%!" (if use_pruning then "alpha_beta" else "maximax") @@ -702,10 +702,10 @@ (* {{{ log entry *) incr nodes_count; size_count := !size_count + Array.length moves; - if (depth0 > 2 || !debug_level > 6) + if (depth0 > 2 || !debug_level > 4) && depth > 1 && !debug_level > 0 then printf "%d,%!" !nodes_count; - if !debug_level > 2 && (depth0 > 2 || !debug_level > 6) + if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && (depth > 1 || !debug_level > 3) then printf "%s%!" (Str.global_replace (Str.regexp "\n") @@ -743,7 +743,7 @@ Array.sort (fun j i-> compare heuristics.(i).(player) heuristics.(j).(player)) index; (* {{{ log entry *) - if !debug_level > 2 && (depth0 > 2 || !debug_level > 6) && + if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && (depth > 1 || !debug_level > 3) then ( printf ", best %d pre-heur: %F %!" player @@ -760,7 +760,7 @@ if now_pruning && sub_heur.(player) > betas.(player) then ( (* {{{ log entry *) - if !debug_level > 2 && (depth0 > 2 || !debug_level > 6) && + if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && (depth > 1 || !debug_level > 3) then ( printf ", best cut %d maximax: %F. %!" player @@ -774,7 +774,7 @@ else ( betas.(player) <- best.(player); (* {{{ log entry *) - if !debug_level > 2 && (depth0 > 2 || !debug_level > 6) && + if !debug_level > 2 && (depth0 > 2 || !debug_level > 4) && (depth > 1 || !debug_level > 3) then ( printf ", best %d maximax: %F. %!" player @@ -794,11 +794,12 @@ (Array.map (fun _ -> 1) scores) in let state = models.(best) in (* {{{ log entry *) - if !debug_level > 0 && depth > 1 + if !debug_level > 0 && (depth > 1 || !debug_level > 3) then printf " %d nodes, %d size, %f elapsed time\n%!" !nodes_count !size_count (Sys.time () -. !debug_playclock); - if !debug_level > 1 && depth > 1 then + if !debug_level > 1 && (depth > 1 || !debug_level > 3) + then Printf.printf "moving to state\n%s\n%!" (Structure.str state.struc); (* }}} *) @@ -1194,37 +1195,37 @@ (* }}} *) (* TODO: default_heuristic redoes payoff normalization. *) let game = state.Arena.game in + let agent = + match search_method with + | "maximax" -> + default_maximax state.Arena.struc ~depth:effort + ?heur_adv_ratio ~pruning:false ~reorder:false game + | "alpha_beta" -> + default_maximax state.Arena.struc ~depth:effort + ?heur_adv_ratio ~pruning:true ~reorder:false game + | "alpha_beta_ord" -> + default_maximax state.Arena.struc ~depth:effort + ?heur_adv_ratio ~pruning:true ~reorder:true game + | "uct_random_playouts" -> + default_treesearch state.Arena.struc + ~iters:effort ?heuristic ?heur_adv_ratio ?horizon + ~random_playout:true game + | "uct_greedy_playouts" -> + default_treesearch state.Arena.struc + ~iters:effort ?heuristic ?heur_adv_ratio ?horizon + ~random_playout:false game + | "uct_maximax_playouts" -> + default_treesearch state.Arena.struc + ~iters:effort ?heuristic ?heur_adv_ratio ?horizon + ~random_playout:false ~playout_mm_depth:1 game + | "uct_no_playouts" -> + default_treesearch state.Arena.struc + ~iters:effort ?heuristic ?heur_adv_ratio ?horizon + ~heur_effect:Heuristic_only game + | s -> failwith ("Game.initialize: unknown search method "^s) + in let play = - {game = game; agents=Array.map - (fun _ -> - match search_method with - | "maximax" -> - default_maximax state.Arena.struc ~depth:effort - ?heur_adv_ratio ~pruning:false ~reorder:false game - | "alpha_beta" -> - default_maximax state.Arena.struc ~depth:effort - ?heur_adv_ratio ~pruning:true ~reorder:false game - | "alpha_beta_ord" -> - default_maximax state.Arena.struc ~depth:effort - ?heur_adv_ratio ~pruning:true ~reorder:true game - | "uct_random_playouts" -> - default_treesearch state.Arena.struc - ~iters:effort ?heuristic ?heur_adv_ratio ?horizon - ~random_playout:true game - | "uct_greedy_playouts" -> - default_treesearch state.Arena.struc - ~iters:effort ?heuristic ?heur_adv_ratio ?horizon - ~random_playout:false game - | "uct_maximax_playouts" -> - default_treesearch state.Arena.struc - ~iters:effort ?heuristic ?heur_adv_ratio ?horizon - ~random_playout:false ~playout_mm_depth:1 game - | "uct_no_playouts" -> - default_treesearch state.Arena.struc - ~iters:effort ?heuristic ?heur_adv_ratio ?horizon - ~heur_effect:Heuristic_only game - | s -> failwith ("Game.initialize: unknown search method "^s) - ) graph; + {game = game; agents=Array.map (fun _ -> agent) graph; delta = 2.0} in (* FIXME: give/calc delta *) (* {{{ log entry *) if !debug_level > 2 then printf "play initialized\n%!"; Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-08 01:21:36 UTC (rev 1237) +++ trunk/Toss/Play/GameTest.ml 2010-12-08 13:34:43 UTC (rev 1238) @@ -566,7 +566,7 @@ "play: chess suggest first move" >:: (fun () -> let state = Lazy.force chess_game in - Game.set_debug_level 3; + Game.set_debug_level 5; (* Heuristic.debug_level := 7; *) (* FFTNF.debug_level := 7; *) let move_opt = (let p,ps = Game.initialize_default (snd state) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-08 01:21:42
|
Revision: 1237 http://toss.svn.sourceforge.net/toss/?rev=1237&view=rev Author: lukstafi Date: 2010-12-08 01:21:36 +0000 (Wed, 08 Dec 2010) Log Message: ----------- Minor test streamlining. Modified Paths: -------------- trunk/Toss/Play/GameTest.ml Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-08 00:23:46 UTC (rev 1236) +++ trunk/Toss/Play/GameTest.ml 2010-12-08 01:21:36 UTC (rev 1237) @@ -467,12 +467,9 @@ let breakthrough_heur = breakthrough_heur_adv 1.5 -let chess_game () = - 2.0, state_of_file "./examples/Chess.toss" +let chess_game = + lazy (2.0, state_of_file "./examples/Chess.toss") -let breakthrough_file_game = - 2.0, state_of_file "./examples/Breakthrough.toss" - let check_loc_random = function | Game.Tree_search (_,_,_,evgames) -> if @@ -568,23 +565,23 @@ "play: chess suggest first move" >:: (fun () -> - (* todo "Payoff too difficult for heuristic generation."; *) - let state = chess_game () in + let state = Lazy.force chess_game in Game.set_debug_level 3; (* Heuristic.debug_level := 7; *) (* FFTNF.debug_level := 7; *) let move_opt = (let p,ps = Game.initialize_default (snd state) ~heur_adv_ratio:(fst state) - ~loc:0 ~effort:2 + ~loc:0 ~effort:1 ~search_method:"alpha_beta_ord" () in Game.suggest p ps) in assert_bool "Game is not over yet -- some move expected." - (move_opt <> None) + (move_opt <> None); + Game.set_debug_level 0; ); "breakthrough payoff" >:: (fun () -> - let state = update_game breakthrough_file_game + let state = update_game breakthrough_game "[ | | ] \" ... ... ... ... B ...B ...B B..B B.. @@ -1096,7 +1093,7 @@ ); ] -let a () = +let a = Aux.run_test_if_target "GameTest" tests let a () = run_test_tt ~verbose:true experiments @@ -1104,12 +1101,12 @@ (* The same content as in .toss files. *) let a () = - print_endline ("\n" ^ Arena.sprint_state (snd (chess_game ()))) + print_endline ("\n" ^ Arena.sprint_state (snd (Lazy.force chess_game))) let a () = - Game.set_debug_level 7 + Game.set_debug_level 3 -let a = +let a () = match test_filter ["Game:0:misc:1:play: chess suggest first move"] tests This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-08 00:23:56
|
Revision: 1236 http://toss.svn.sourceforge.net/toss/?rev=1236&view=rev Author: lukstafi Date: 2010-12-08 00:23:46 +0000 (Wed, 08 Dec 2010) Log Message: ----------- Parsimony model in Heuristic. Modified Paths: -------------- trunk/Toss/Formula/FFTNF.mli trunk/Toss/Play/Game.ml trunk/Toss/Play/GameTest.ml trunk/Toss/Play/Heuristic.ml trunk/Toss/Play/Heuristic.mli Modified: trunk/Toss/Formula/FFTNF.mli =================================================================== --- trunk/Toss/Formula/FFTNF.mli 2010-12-07 22:14:45 UTC (rev 1235) +++ trunk/Toss/Formula/FFTNF.mli 2010-12-08 00:23:46 UTC (rev 1236) @@ -14,6 +14,8 @@ *) +val parsimony_threshold_1 : int ref +val parsimony_threshold_2 : int ref val debug_level : int ref Modified: trunk/Toss/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-07 22:14:45 UTC (rev 1235) +++ trunk/Toss/Play/Game.ml 2010-12-08 00:23:46 UTC (rev 1236) @@ -246,15 +246,18 @@ if monotonic then Some (DiscreteRule.fluent_preconds drules signat fluents) else None in - Array.map (fun node -> Array.map + Array.mapi (fun i node -> Array.map (fun payoff -> (* {{{ log entry *) - - if !debug_level > 3 then ( - Printf.printf "default_heuristic: Computing of payoff %s...\n%!" - (Formula.sprint_real payoff); + if !debug_level > 4 then ( + Printf.printf + "default_heuristic: Computing for loc %d of payoff %s...\n%!" + i (Formula.sprint_real payoff); ); - + if !debug_level = 4 then ( + Printf.printf + "default_heuristic: Computing for loc %d\n%!" i; + ); (* }}} *) Heuristic.of_payoff ?struc ?fluent_preconds advance_ratio (Aux.strings_of_list fluents) payoff) Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-07 22:14:45 UTC (rev 1235) +++ trunk/Toss/Play/GameTest.ml 2010-12-08 00:23:46 UTC (rev 1236) @@ -568,11 +568,11 @@ "play: chess suggest first move" >:: (fun () -> - todo "Payoff too difficult for heuristic generation."; + (* todo "Payoff too difficult for heuristic generation."; *) let state = chess_game () in - Game.set_debug_level 7; - Heuristic.debug_level := 7; - FFTNF.debug_level := 4; + Game.set_debug_level 3; + (* Heuristic.debug_level := 7; *) + (* FFTNF.debug_level := 7; *) let move_opt = (let p,ps = Game.initialize_default (snd state) ~heur_adv_ratio:(fst state) ~loc:0 ~effort:2 @@ -1096,7 +1096,7 @@ ); ] -let a = +let a () = Aux.run_test_if_target "GameTest" tests let a () = run_test_tt ~verbose:true experiments @@ -1109,9 +1109,9 @@ let a () = Game.set_debug_level 7 -let a () = +let a = match test_filter - ["Game:0:misc:2:breakthrough payoff"] + ["Game:0:misc:1:play: chess suggest first move"] tests with | Some tests -> ignore (run_test_tt ~verbose:true tests) Modified: trunk/Toss/Play/Heuristic.ml =================================================================== --- trunk/Toss/Play/Heuristic.ml 2010-12-07 22:14:45 UTC (rev 1235) +++ trunk/Toss/Play/Heuristic.ml 2010-12-08 00:23:46 UTC (rev 1236) @@ -14,6 +14,19 @@ H(Phi) = Alg(FFTNF(promote relations F) of Phi', True) where Phi' = ExpandedForm(F, S, FFTNF(promote relations F) of Phi) + Since formula transformations involved in generating the heuristic + are costly, we use the parsimony model from FFTNF: + + (1) at parsimony level 1 (PARL1), we do not compute FFTNF prior to + expanding the formula: + + H(Phi) = Alg(FFTNF(promote relations F) of Phi', True) + where Phi' = ExpandedForm(F, S, Phi) + + (2) at parsimony level 2 (PARL2), we do not expand the formula: + + H(Phi) = Alg(FFTNF(promote relations F) of Phi, True) + Monotonic case (see also the definition of FFSEP(F) in {!FFTNF} module): @@ -800,8 +813,8 @@ ) guards in sum_exprs parts -let of_payoff ?(max_alt_descr=5) ?struc ?fluent_preconds adv_ratio frels expr = - (* FIXME: what [gds] should be doing? it's not doing anything *) +let of_payoff ?force_parsimony + ?(max_alt_descr=5) ?struc ?fluent_preconds adv_ratio frels expr = let rec aux gds = function | RVar _ | Const _ @@ -809,29 +822,40 @@ | Times (a, b) -> Times (aux gds a, aux gds b) | Plus (a, b) -> Plus (aux gds a, aux gds b) | Char phi -> + let parsimony_level = + match force_parsimony with + | Some parl -> parl + | None -> + let size = FormulaOps.size phi in + if size < !FFTNF.parsimony_threshold_1 then 0 + else if size < !FFTNF.parsimony_threshold_2 then 1 + else 2 in (match fluent_preconds with | None -> (* not monotonic *) - let phi' = match struc with - | Some struc -> - (* guards are currently ignored *) - (* {{{ log entry *) - if !debug_level > 2 then ( - Printf.printf - "Heuristic: for expanding, get ff-tnf of %s...\n%!" - (Formula.sprint phi); - ); - (* }}} *) - let phi'' = - FFTNF.ff_tnf (FFTNF.promote_rels frels) phi in - (* {{{ log entry *) - if !debug_level > 2 then ( - Printf.printf - "Heuristic: computing expanded form of %s...\n%!" - (Formula.sprint phi''); - ); - (* }}} *) - expanded_form max_alt_descr frels struc phi'' - | None -> phi in + let phi' = + if parsimony_level > 1 then phi + else match struc with + | Some struc -> + (* TODO: summation guards [gds] are currently ignored *) + (* {{{ log entry *) + if !debug_level > 2 then ( + Printf.printf + "Heuristic: for expanding, get ff-tnf of %s...\n%!" + (Formula.sprint phi); + ); + (* }}} *) + let phi'' = + if parsimony_level > 0 then phi + else FFTNF.ff_tnf (FFTNF.promote_rels frels) phi in + (* {{{ log entry *) + if !debug_level > 2 then ( + Printf.printf + "Heuristic: computing expanded form of %s...\n%!" + (Formula.sprint phi''); + ); + (* }}} *) + expanded_form max_alt_descr frels struc phi'' + | None -> phi in (* {{{ log entry *) if !debug_level > 2 then ( Printf.printf Modified: trunk/Toss/Play/Heuristic.mli =================================================================== --- trunk/Toss/Play/Heuristic.mli 2010-12-07 22:14:45 UTC (rev 1235) +++ trunk/Toss/Play/Heuristic.mli 2010-12-08 00:23:46 UTC (rev 1236) @@ -82,7 +82,8 @@ *) (** Heuristic of payoff expression. *) -val of_payoff : ?max_alt_descr:int -> ?struc:Structure.structure -> +val of_payoff : ?force_parsimony:int -> + ?max_alt_descr:int -> ?struc:Structure.structure -> ?fluent_preconds:(string * (string list * Formula.formula)) list -> float -> Aux.Strings.t -> Formula.real_expr -> Formula.real_expr This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-07 22:14:51
|
Revision: 1235 http://toss.svn.sourceforge.net/toss/?rev=1235&view=rev Author: lukstafi Date: 2010-12-07 22:14:45 +0000 (Tue, 07 Dec 2010) Log Message: ----------- DiscreteRule: streamlining rewrite_single, tests with integer-named elements. Examples: adapting rewriting_example for Arena test. Modified Paths: -------------- trunk/Toss/Arena/ArenaTest.ml trunk/Toss/Arena/DiscreteRule.ml trunk/Toss/Arena/DiscreteRule.mli trunk/Toss/Arena/DiscreteRuleTest.ml trunk/Toss/examples/rewriting_example.toss Modified: trunk/Toss/Arena/ArenaTest.ml =================================================================== --- trunk/Toss/Arena/ArenaTest.ml 2010-12-07 17:49:54 UTC (rev 1234) +++ trunk/Toss/Arena/ArenaTest.ml 2010-12-07 22:14:45 UTC (rev 1235) @@ -113,8 +113,8 @@ "setting states from examples dir" >:: (fun () -> backtrace ( - skip_if true "Change to simpler and stable example."; - let fname = "./examples/Breakthrough.toss" in + (* skip_if true "Change to simpler and stable example."; *) + let fname = "./examples/rewriting_example.toss" in let file = open_in fname in let contents = String.make 4000 '$' in input_file file contents 0 4000; @@ -126,20 +126,6 @@ Arena.handle_request gs (req_of_str "GET STATE") in assert_equal ~msg:("Set "^fname) ~printer:(fun x->x) contents msg; - (* - let fname = "../examples/Gomoku19x19.toss" in - let file = open_in fname in - let contents = String.make 10000 '$' in - let _ = input_file file contents 0 10000 in - let contents = - String.sub contents 0 (String.index contents '$') in - let s = "SET STATE #" ^ fname ^ "#" ^ contents in - let (gs,_) = Arena.handle_request Arena.empty_state (req_of_str s) in - let (_, msg) = - Arena.handle_request gs (req_of_str "GET STATE") in - assert_equal ~msg:("Set "^fname) ~printer:(fun x->x) - contents msg; - *) )); (* Modified: trunk/Toss/Arena/DiscreteRule.ml =================================================================== --- trunk/Toss/Arena/DiscreteRule.ml 2010-12-07 17:49:54 UTC (rev 1234) +++ trunk/Toss/Arena/DiscreteRule.ml 2010-12-07 22:14:45 UTC (rev 1235) @@ -443,8 +443,12 @@ end else model) model ctups) model neg_tuples -let rewrite_single_aux model ldmap - ({rlmap=rlmap} as rule_obj) = +(* Rewrite the model using the rule at the given matching. Does not + check invariants nor postconditions. *) +let rewrite_single model matching ({rlmap=rlmap} as rule_obj) = + let find_fst_name (name, x) = + elemvar_of_elem rule_obj.lhs_elem_inv_names name, x in + let ldmap = List.map find_fst_name matching in match rlmap with | None -> (* [ldmap = rmmap] *) @@ -454,23 +458,6 @@ rewrite_emb model ldmap rlmap rule_obj -(* Rewrite the model using the rule at the given matching. Does not - check invariants nor postconditions. *) -let rewrite_single model (matching : matching) rule_obj - : Structure.structure = - let find_fst_name simap (name, x) = - try (SIMap.find name simap, x) with Not_found -> - let mtch_str (a, b) = (string_of_int a) ^ " <- " ^ (string_of_int b) in - let m_s = "{ "^ String.concat ", " (List.map mtch_str matching) ^ " }" in - let bd_add_str a b acc = acc ^ ", " ^ (string_of_int a) ^ ": " ^ b in - let map_s = SIMap.fold bd_add_str simap "" in - let general_s = "rewrite_single: rule_obj inconsistent with matching " in - let name_s = string_of_int name in - failwith (general_s ^ m_s ^"; missing "^ name_s ^ " in: "^ map_s ^ ".") in - let ldmap = List.map (find_fst_name rule_obj.lhs_elem_inv_names) matching in - rewrite_single_aux model ldmap rule_obj - - (** {2 Building a rule.} *) open Formula Modified: trunk/Toss/Arena/DiscreteRule.mli =================================================================== --- trunk/Toss/Arena/DiscreteRule.mli 2010-12-07 17:49:54 UTC (rev 1234) +++ trunk/Toss/Arena/DiscreteRule.mli 2010-12-07 22:14:45 UTC (rev 1235) @@ -85,9 +85,9 @@ Rewriting introduces the following form of trace: - +R(tup) = R(tup) and not R_old(tup) - -R(tup) = not R(tup) and R_old(tup) - __right_e(emb[e]) + _new_R(tup) = +R(tup) = R(tup) and not R_old(tup) + _del_R(tup) = -R(tup) = not R(tup) and R_old(tup) + _right_e(emb[e]) where emb[e] is the model element corresponding to a RHS rule element e, or, when LHS and RHS structures have the same Modified: trunk/Toss/Arena/DiscreteRuleTest.ml =================================================================== --- trunk/Toss/Arena/DiscreteRuleTest.ml 2010-12-07 17:49:54 UTC (rev 1234) +++ trunk/Toss/Arena/DiscreteRuleTest.ml 2010-12-07 22:14:45 UTC (rev 1235) @@ -143,6 +143,94 @@ (Structure.str nmodel); ); + + "rewrite: compile_rule integers" >:: + (fun () -> + + let model = + struc_of_str "[ | P:1 {}; R:2 {}; Q{1} | ]" in + let lhs_struc = struc_of_str "[ 1 | | ]" in + let rhs_struc = struc_of_str "[ 1, 2 | P{ (1) } | ]" in + let signat = Structure.StringMap.fold + (fun r ar si -> (r,ar)::si) model.Structure.rel_signature [] in + let rule_obj = compile_rule signat [] + {lhs_struc = lhs_struc; + rhs_struc = rhs_struc; + emb_rels = []; + pre = Formula.And []; + rule_s = [1,1; 2,1]} in + let embs = find_matchings model rule_obj in + let emb = choose_match model rule_obj embs in + let nmodel = + rewrite_single model emb rule_obj in + assert_equal ~printer:(fun x->x) ~msg:"clone, add to twin" + "[1, 2 | P (1); Q {1; 2}; R:2 {}; _new_P (1); _right_1 (1); _right_2 (2) | ]" + (Structure.str nmodel); + + let model = + struc_of_str "[ | P{2}; Q{1} | ]" in + let lhs_struc = struc_of_str "[ | Q{1} | ]" in + let rhs_struc = struc_of_str "[ 1, 2 | Q:1{}; _opt_Q{2}; P{1} | ]" in + let signat = Structure.StringMap.fold + (fun r ar si -> (r,ar)::si) model.Structure.rel_signature [] in + let rule_obj = compile_rule signat [] + {lhs_struc = lhs_struc; + rhs_struc = rhs_struc; + emb_rels = ["P";"Q"]; + pre = Formula.And []; + rule_s = [1,1; 2,1]} in + let embs = find_matchings model rule_obj in + let emb = choose_match model rule_obj embs in + let nmodel = + rewrite_single model emb rule_obj in + assert_equal ~printer:(fun x->x) ~msg:"clone, remove from twin" + "[1, 2, 3 | P {1; 2}; Q (3); _del_Q (1); _new_P (1); _right_1 (1); _right_2 (3) | ]" + (Structure.str nmodel); + + let model = + struc_of_str "[ | R{1}; Q{1}; P:1{ } | ]" in + + let lhs_struc = struc_of_str "[ | Q{1} | ]" in + let rhs_struc = struc_of_str "[ 1, 2 | Q:1{}; P{1} | ]" in + let signat = Structure.StringMap.fold + (fun r ar si -> (r,ar)::si) model.Structure.rel_signature [] in + let rule_obj = compile_rule signat [] + {lhs_struc = lhs_struc; + rhs_struc = rhs_struc; + emb_rels = ["P";"Q"]; + pre = Formula.And []; + rule_s = [1,1; 2,1]} in + let embs = find_matchings model rule_obj in + let emb = choose_match model rule_obj embs in + let nmodel = + rewrite_single model emb rule_obj in + assert_equal ~printer:(fun x->x) ~msg:"clone, remove, add to twin" + "[1, 2 | P (1); Q:1 {}; R {1; 2}; _del_Q {1; 2}; _new_P (1); _right_1 (1); _right_2 (2) | ]" + (Structure.str nmodel); + + let model = + struc_of_str "[ | P:1{ }; R{(1,2)}; C{(2,3)}; D{(1,3)} | ]" in + let lhs_struc = struc_of_str "[ 1,2 | R{ (2,1) } | ]" in + let rhs_struc = struc_of_str "[ 1,2,3 | P{ (2) }; R:2{}; _opt_R { (1,1); (1,2); (1,3); (2,2); (2,3); (3,2); (3,3) } | ]" in + let signat = Structure.StringMap.fold + (fun r ar si -> (r,ar)::si) model.Structure.rel_signature [] in + let rule_obj = compile_rule signat [] + {lhs_struc = lhs_struc; + rhs_struc = rhs_struc; + emb_rels = ["P";"R"]; + pre = Formula.And []; + rule_s = [1,1; 2,2; 3,2]} in + let embs = find_matchings model rule_obj in + let emb = choose_match model rule_obj embs in + let nmodel = + rewrite_single model emb rule_obj in + assert_equal ~printer:(fun x->x) + ~msg:"clone, copy rels, remove, add to twin" + "[1, 2, 3, 4 | C (1, 3); D {(2, 3); (4, 3)}; P (2); R:2 {}; _del_R {(2, 1); (4, 1)}; _new_P (2); _right_1 (1); _right_2 (2); _right_3 (4) | ]" + (Structure.str nmodel); + + ); + "rewrite: compile_rule no change" >:: (fun () -> @@ -638,7 +726,9 @@ let a = Aux.run_test_if_target "DiscreteRuleTest" tests +let a () = DiscreteRule.debug_level := 7 + let a () = - match (test_filter ["DiscreteRule:11:rewrite: compile_rule adding and deleting elements"] tests) with + match (test_filter ["DiscreteRule:4:rewrite: compile_rule integers"] tests) with | Some tests -> ignore (run_test_tt ~verbose:true tests) | None -> () Modified: trunk/Toss/examples/rewriting_example.toss =================================================================== --- trunk/Toss/examples/rewriting_example.toss 2010-12-07 17:49:54 UTC (rev 1234) +++ trunk/Toss/examples/rewriting_example.toss 2010-12-07 22:14:45 UTC (rev 1235) @@ -1,51 +1,59 @@ PLAYERS 1, 2 RULE Rewrite: - [ 1, 2 | R { (1, 2) } | - vx { 1->0., 2->0. }; vy { 1->0., 2->0. }; - x { 1->-56.1, 2->12.1 }; y { 1->-19.8, 2->-16.5 } ] - -> - [ 1, 2, 3, 4 | R { (2, 4) }; S { (2, 1); (2, 3) } | - vx { 1->0., 2->0., 3->0., 4->0. }; vy { 1->0., 2->0., 3->0., 4->0. }; - x { 1->-53.9, 2->-13.2, 3->24.2, 4->-15.4 }; - y { 1->-28.6, 2->-30.8, 3->-29.7, 4->14.3 } ] - emb R with [ 3 <- 2, 2 <- 2, 1 <- 1 ] + [1, 2 | R (1, 2); S:2 {} | + vx {2->0., 1->0.}; vy {2->0., 1->0.}; x {2->12.1, 1->-56.1}; + y {2->-16.5, 1->-19.8} + ] -> + [1, 2, 3, 4 | R (2, 4); S {(2, 1); (2, 3)} | + vx {4->0., 3->0., 2->0., 1->0.}; vy {4->0., 3->0., 2->0., 1->0.}; + x {4->-15.4, 3->24.2, 2->-13.2, 1->-53.9}; + y {4->14.3, 3->-29.7, 2->-30.8, 1->-28.6} + ] emb R with [3 <- 2, 2 <- 2, 1 <- 1] dynamics - vy(2)' = 0.; - vy(1)' = 0.; - vx(2)' = 0.; - vx(1)' = 0.; - y(2)' = 0.; - y(1)' = 0.; - x(2)' = 0.; - x(1)' = 0. + vy(2)' = 0.; + vy(1)' = 0.; + vx(2)' = 0.; + vx(1)' = 0.; + y(2)' = 0.; + y(1)' = 0.; + x(2)' = 0.; + x(1)' = 0. update - vy(4) = 0.; - vy(3) = 0.; - vy(2) = 0.; - vy(1) = 0.; - vx(4) = 0.; - vx(3) = 0.; - vx(2) = 0.; - vx(1) = 0.; - y(4) = (0.5)*(y(2)); - y(3) = y(2); - y(2) = y(2); - y(1) = y(1); - x(4) = x(2); - x(3) = ((2.)*(x(2))) + ((-1.)*(x(1))); - x(2) = x(2); - x(1) = x(1) - pre true inv true post true - LOC 0 { - PLAYER 1 - PAYOFF { - 1: 0.; - 2: 0. - } - MOVES - [Rewrite, t: 1. -- 1. -> 0] - } + vy(4) = 0.; + vy(3) = 0.; + vy(2) = 0.; + vy(1) = 0.; + vx(4) = 0.; + vx(3) = 0.; + vx(2) = 0.; + vx(1) = 0.; + y(4) = 0.5 * y(2); + y(3) = y(2); + y(2) = y(2); + y(1) = y(1); + x(4) = x(2); + x(3) = 2. * x(2) - x(1); + x(2) = x(2); + x(1) = x(1) +LOC 0 {PLAYER 1 PAYOFF {1: 0.; 2: 0.} MOVES [Rewrite, t: 1. -- 1. -> 0]} MODEL - [ 1, 2, 3, 4, 5, 6, 7, 9, 10, 11 | - R { (1, 2) }; S { (1, 4); (1, 11); (2, 6); (2, 10); (3, 1); (5, 2); (7, 1); (9, 2) } | - vx { 1->0., 2->0., 3->0., 4->0., 5->0., 6->0., 7->0., 9->0., 10->0., 11->0. }; vy { 1->0., 2->0., 3->0., 4->0., 5->0., 6->0., 7->0., 9->0., 10->0., 11->0. }; x { 1->-146.255462055, 2->21.302749004, 3->-258.32323745, 4->-120.686436849, 5->-18.5442846716, 6->90.6508710148, 7->-232.262151394, 9->-9.62456175299, 10->103.945266932, 11->-125.119302789 }; y { 1->-198.131474104, 2->-199.490916335, 3->-389.602259761, 4->-388.668637651, 5->-373.881488196, 6->-383.007253961, 7->-11.1358565737, 9->-40.4231593625, 10->-39.0902989992, 11->-22.4325180255 } ] + [1, 2, 3, 4, 5, 6, 7, 9, 10, 11 | + R (1, 2); + S {(1, 4); (1, 11); (2, 6); (2, 10); (3, 1); (5, 2); (7, 1); (9, 2)} + | + vx { + 11->0., 10->0., 9->0., 7->0., 6->0., 5->0., 4->0., 3->0., 2->0., 1->0.}; + vy { + 11->0., 10->0., 9->0., 7->0., 6->0., 5->0., 4->0., 3->0., 2->0., 1->0.}; + x { + 11->-125.119302789, 10->103.945266932, 9->-9.62456175299, + 7->-232.262151394, 6->90.6508710148, 5->-18.5442846716, + 4->-120.686436849, 3->-258.32323745, 2->21.302749004, 1->-146.255462055 + }; + y { + 11->-22.4325180255, 10->-39.0902989992, 9->-40.4231593625, + 7->-11.1358565737, 6->-383.007253961, 5->-373.881488196, + 4->-388.668637651, 3->-389.602259761, 2->-199.490916335, + 1->-198.131474104 + } + ] This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-07 17:50:00
|
Revision: 1234 http://toss.svn.sourceforge.net/toss/?rev=1234&view=rev Author: lukstafi Date: 2010-12-07 17:49:54 +0000 (Tue, 07 Dec 2010) Log Message: ----------- Recent make_rule bug fixed. Modified Paths: -------------- trunk/Toss/Arena/ContinuousRule.ml trunk/Toss/Play/GameTest.ml Modified: trunk/Toss/Arena/ContinuousRule.ml =================================================================== --- trunk/Toss/Arena/ContinuousRule.ml 2010-12-07 16:19:19 UTC (rev 1233) +++ trunk/Toss/Arena/ContinuousRule.ml 2010-12-07 17:49:54 UTC (rev 1234) @@ -34,7 +34,9 @@ let discrete = { discr with DiscreteRule.pre = cpre } in let defrels = List.map (fun (rel,(args,body)) -> rel, (args, body, Solver.M.register_formula body)) defs in - let obj = DiscreteRule.compile_rule signat defrels discr in + (* we use [discrete] instead of [discr] because parser does not + insert precondition into discr! *) + let obj = DiscreteRule.compile_rule signat defrels discrete in { discrete = discrete; compiled = obj ; dynamics = dynamics ; Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-07 16:19:19 UTC (rev 1233) +++ trunk/Toss/Play/GameTest.ml 2010-12-07 17:49:54 UTC (rev 1234) @@ -1096,7 +1096,7 @@ ); ] -let a () = +let a = Aux.run_test_if_target "GameTest" tests let a () = run_test_tt ~verbose:true experiments @@ -1109,7 +1109,7 @@ let a () = Game.set_debug_level 7 -let a = +let a () = match test_filter ["Game:0:misc:2:breakthrough payoff"] tests This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-07 16:19:26
|
Revision: 1233 http://toss.svn.sourceforge.net/toss/?rev=1233&view=rev Author: lukstafi Date: 2010-12-07 16:19:19 +0000 (Tue, 07 Dec 2010) Log Message: ----------- Simple test fixes (mostly adjustments to new FFTNF). Modified Paths: -------------- trunk/Toss/Arena/ArenaTest.ml trunk/Toss/Arena/ContinuousRuleTest.ml trunk/Toss/Arena/DiscreteRuleTest.ml trunk/Toss/Play/Game.ml trunk/Toss/Play/GameTest.ml trunk/Toss/Play/HeuristicTest.ml trunk/Toss/Solver/FFSolverTest.ml Modified: trunk/Toss/Arena/ArenaTest.ml =================================================================== --- trunk/Toss/Arena/ArenaTest.ml 2010-12-07 14:35:28 UTC (rev 1232) +++ trunk/Toss/Arena/ArenaTest.ml 2010-12-07 16:19:19 UTC (rev 1233) @@ -71,8 +71,8 @@ PLAYER black PAYOFF {white: 0.3; black: :(ex x Q(x))} } STATE LOC 1" in - let res1 = "REL Q(x) {ex y R(y, x)} -REL P(x) {ex y R(x, y)} + let res1 = "REL P(x) {ex y R(x, y)} +REL Q(x) {ex y R(y, x)} PLAYERS white, black RULE finish: [a, b | R (a, b) | ] -> [a, c, b | R {(a, c); (c, b)} | ] emb R @@ -90,8 +90,8 @@ Arena.equational_def_style := false; assert_equal ~printer:(fun x->x) ~msg:"curly braces style" res1 (Arena.sprint_state gs); - let res2 = "REL Q(x) = ex y R(y, x) -REL P(x) = ex y R(x, y) + let res2 = "REL P(x) = ex y R(x, y) +REL Q(x) = ex y R(y, x) PLAYERS white, black RULE finish: [a, b | R (a, b) | ] -> [a, c, b | R {(a, c); (c, b)} | ] emb R Modified: trunk/Toss/Arena/ContinuousRuleTest.ml =================================================================== --- trunk/Toss/Arena/ContinuousRuleTest.ml 2010-12-07 14:35:28 UTC (rev 1232) +++ trunk/Toss/Arena/ContinuousRuleTest.ml 2010-12-07 16:19:19 UTC (rev 1233) @@ -26,24 +26,24 @@ "[a, b | R (a, b) | ] -> [c, d | R (c, d) | ] emb R with [c <- a, d <- b] " in let s = discr ^ " pre true inv true post true" in let signat = ["R", 2] in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule1" in assert_equal ~msg:"1. no continuous" ~printer:(fun x->x) s (str r); let upd_eq = " f(c) = 2. * f(a);\n f(d) = f(b)\n" in let s = discr ^ "\nupdate\n" ^ upd_eq ^ " pre true inv true post true" in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule2" in assert_equal ~msg:"2. update" ~printer:(fun x->x) s (str r); let dyn_eq = " f(a)' = (2. * f(a)) + t;\n f(b)' = f(b)" in let s = discr ^ "\ndynamics\n" ^ dyn_eq ^ " pre true inv true post true" in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule3" in assert_equal ~msg:"3. dynamics" ~printer:(fun x->x) s (str r); let dyn_eq = " f(a)' = (2. * f(a)) + t;\n f(b)' = f(b)" in let upd_eq = " f(c) = 2. * f(a);\n f(d) = f(b)\n" in let s = discr ^ "\ndynamics\n" ^ dyn_eq ^ "\nupdate\n" ^ upd_eq ^ " pre true inv true post true" in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule4" in assert_equal ~msg:"4. dynamics+update" ~printer:(fun x->x) s (str r); ); @@ -53,25 +53,25 @@ "[a, b | R (a, b) | ] -> [c, d | R (c, d) | ] emb R with [c <- a, d <- b]" in let s = discr in let signat = ["R", 2] in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule1" in assert_equal ~msg:"1. no continuous" ~printer:(fun x->x) s (sprint r); let upd_eq1 = " f(c) = 2. * f(a);" and upd_eq2 = " f(d) = f(b)" in let upd_eq = upd_eq1 ^ upd_eq2 in let s = discr ^ "\n update" ^ upd_eq in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule2" in assert_equal ~msg:"2. update" ~printer:(fun x->x) s (sprint r); let dyn_eq1 = " f(a)' = 2. * f(a) + t;" and dyn_eq2 = " f(b)' = f(b)" in let dyn_eq = dyn_eq1 ^ dyn_eq2 in let s = discr ^ "\n dynamics" ^ dyn_eq in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule3" in assert_equal ~msg:"3. dynamics" ~printer:(fun x->x) s (sprint r); let s = discr ^ "\n dynamics" ^ dyn_eq ^ "\n update" ^ upd_eq in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule4" in assert_equal ~msg:"4. dynamics+update" ~printer:(fun x->x) s (sprint r); let dyn_eq = dyn_eq1 ^ "\n" ^ dyn_eq2 ^ ";\n" ^ dyn_eq1 ^ "\n" ^ dyn_eq2 @@ -79,7 +79,7 @@ let upd_eq = upd_eq1 ^ "\n" ^ upd_eq2 ^ ";\n" ^ upd_eq1 ^ "\n" ^ upd_eq2 ^ ";\n" ^ upd_eq1 ^ "\n" ^ upd_eq2 in let s = discr ^ "\n dynamics\n" ^ dyn_eq ^ "\n update\n" ^ upd_eq in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule5" in assert_equal ~msg:"5. many equations" ~printer:(fun x->x) s (sprint r); ); @@ -93,7 +93,7 @@ let s = dr ^ " dynamics " ^ dyn_eq ^ " update " ^ upd_eq ^ " pre true inv true post true " in let struc = struc_of_str "[ | P {a}; Q:1{} | x { a -> 0.0 } ]" in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule1" in let m = List.hd (matches struc r) in let res, _, _ = Aux.unsome (rewrite_single struc 0.0 m r 1. []) in @@ -113,7 +113,7 @@ " pre true inv true post true " in let signat = ["P", 1; "Q", 1] in let struc = struc_of_str "[ | P {a}; Q:1{} | x { a -> 0.0 } ]" in - let r = rule_of_str s signat [] in + let r = rule_of_str s signat [] "rule1" in let m = List.hd (matches struc r) in let res, _, _ = Aux.unsome (rewrite_single struc 0.0 m r 1. []) in Modified: trunk/Toss/Arena/DiscreteRuleTest.ml =================================================================== --- trunk/Toss/Arena/DiscreteRuleTest.ml 2010-12-07 14:35:28 UTC (rev 1232) +++ trunk/Toss/Arena/DiscreteRuleTest.ml 2010-12-07 16:19:19 UTC (rev 1233) @@ -613,7 +613,7 @@ pre = Formula.And []; rule_s = [1,1]} in assert_one_of ~msg:"del defrel" - ["(O(b) and (not P(b)) and (not Q(b)) and (_del_P(b) or _del_Q(b)))-> (P(b) and (not O(b)))";"((_del_Q(b) or _del_P(b)) and O(b) and (not P(b)) and (not Q(b)))-> (P(b) and (not O(b)))"] + ["(O(b) and (not P(b)) and (not Q(b)) and (_del_P(b) or _del_Q(b)))-> (P(b) and (not O(b)))";"((_del_Q(b) or _del_P(b)) and O(b) and (not P(b)) and (not Q(b)))-> (P(b) and (not O(b)))";"((_del_P(b) and O(b) and (not P(b)) and (not Q(b))) or (_del_Q(b) and O(b) and (not P(b)) and (not Q(b))))-> (P(b) and (not O(b)))"] (rule_obj_str rule_obj); let lhs_struc = struc_of_str "[ e | _opt_D (e); _diffthan_P(e) | ]" in Modified: trunk/Toss/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-07 14:35:28 UTC (rev 1232) +++ trunk/Toss/Play/Game.ml 2010-12-07 16:19:19 UTC (rev 1233) @@ -251,7 +251,7 @@ (* {{{ log entry *) if !debug_level > 3 then ( - Printf.printf "default_hauristic: Computing of payoff %s...\n%!" + Printf.printf "default_heuristic: Computing of payoff %s...\n%!" (Formula.sprint_real payoff); ); Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-07 14:35:28 UTC (rev 1232) +++ trunk/Toss/Play/GameTest.ml 2010-12-07 16:19:19 UTC (rev 1233) @@ -467,9 +467,12 @@ let breakthrough_heur = breakthrough_heur_adv 1.5 -let chess_game = +let chess_game () = 2.0, state_of_file "./examples/Chess.toss" +let breakthrough_file_game = + 2.0, state_of_file "./examples/Breakthrough.toss" + let check_loc_random = function | Game.Tree_search (_,_,_,evgames) -> if @@ -566,7 +569,7 @@ "play: chess suggest first move" >:: (fun () -> todo "Payoff too difficult for heuristic generation."; - let state = chess_game in + let state = chess_game () in Game.set_debug_level 7; Heuristic.debug_level := 7; FFTNF.debug_level := 4; @@ -581,7 +584,7 @@ "breakthrough payoff" >:: (fun () -> - let state = update_game breakthrough_game + let state = update_game breakthrough_file_game "[ | | ] \" ... ... ... ... B ...B ...B B..B B.. @@ -596,16 +599,16 @@ ... ... ... ... ... B.. ... B.. ... ... ... ... - -B ... ...W ...W ... - ...B ... ... ... - W..+B W..W W..W W..W -\"" 1 in + ... ...W ...W ... + ... ... ... ... + W..B W..W W..W W..W +\"" 0 in (* Game.set_debug_level 5; *) let move_opt = (let p,ps = Game.initialize_default (snd state) ~heur_adv_ratio:(fst state) - ~loc:0 ~effort:5 + ~loc:0 ~effort:2 ~heuristic:breakthrough_heur - ~search_method:"uct_greedy_playouts" () in + ~search_method:"alpha_beta_ord" () in Game.toss ~grid_size:Game.cGRID_SIZE p ps) in assert_equal ~msg:"black wins: suggest" ~printer:(function | Aux.Left (bpos, moves, _, _) -> @@ -1093,7 +1096,7 @@ ); ] -let a = +let a () = Aux.run_test_if_target "GameTest" tests let a () = run_test_tt ~verbose:true experiments @@ -1101,14 +1104,14 @@ (* The same content as in .toss files. *) let a () = - print_endline ("\n" ^ Arena.sprint_state (snd chess_game)) + print_endline ("\n" ^ Arena.sprint_state (snd (chess_game ()))) let a () = Game.set_debug_level 7 -let a () = +let a = match test_filter - ["Game:0:misc:0:play: chess suggest first move"] + ["Game:0:misc:2:breakthrough payoff"] tests with | Some tests -> ignore (run_test_tt ~verbose:true tests) Modified: trunk/Toss/Play/HeuristicTest.ml =================================================================== --- trunk/Toss/Play/HeuristicTest.ml 2010-12-07 14:35:28 UTC (rev 1232) +++ trunk/Toss/Play/HeuristicTest.ml 2010-12-07 16:19:19 UTC (rev 1233) @@ -288,7 +288,7 @@ "of_payoff: tic-tac-toe non monotonic" >:: (fun () -> backtrace ( assert_equal ~printer:(fun x->x) ~msg:"adv_ratio=1.5" - "(Sum (z | P(z) : ((((0.64 + Sum (y | (R(y, z) and P(y)) : (0.96 + Sum (x | (R(x, y) and P(x)) : 1.44)))) + Sum (y | (C(y, z) and P(y)) : (0.96 + Sum (x | (C(x, y) and P(x)) : 1.44)))) + Sum (u | C(z, u) : (0.29 + Sum (y | (R(y, u) and P(y)) : (0.44 + Sum (v | C(y, v) : (0.66 + Sum (x | (R(x, v) and P(x)) : 1.)))))))) + Sum (u0 | C(u0, z) : (0.29 + Sum (y | (R(y, u0) and P(y)) : (0.44 + Sum (v0 | C(v0, y) : (0.66 + Sum (x | (R(x, v0) and P(x)) : 1.))))))))) + (-1. * Sum (z | Q(z) : ((((0.64 + Sum (y | (R(y, z) and Q(y)) : (0.96 + Sum (x | (R(x, y) and Q(x)) : 1.44)))) + Sum (y | (C(y, z) and Q(y)) : (0.96 + Sum (x | (C(x, y) and Q(x)) : 1.44)))) + Sum (u | C(z, u) : (0.29 + Sum (y | (R(y, u) and Q(y)) : (0.44 + Sum (v | C(y, v) : (0.66 + Sum (x | (R(x, v) and Q(x)) : 1.)))))))) + Sum (u0 | C(u0, z) : (0.29 + Sum (y | (R(y, u0) and Q(y)) : (0.44 + Sum (v0 | C(v0, y) : (0.66 + Sum (x | (R(x, v0) and Q(x)) : 1.)))))))))))" + "(Sum (x | P(x) : ((((0.64 + Sum (y | (R(x, y) and P(y)) : (0.96 + Sum (z | (R(y, z) and P(z)) : 1.44)))) + Sum (y | (C(x, y) and P(y)) : (0.96 + Sum (z | (C(y, z) and P(z)) : 1.44)))) + Sum (v0 | R(x, v0) : (0.29 + Sum (y | (C(v0, y) and P(y)) : (0.44 + Sum (u0 | R(y, u0) : (0.66 + Sum (z | (C(u0, z) and P(z)) : 1.)))))))) + Sum (v | R(x, v) : (0.29 + Sum (y | (C(y, v) and P(y)) : (0.44 + Sum (u | R(y, u) : (0.66 + Sum (z | (C(z, u) and P(z)) : 1.))))))))) + (-1. * Sum (x | Q(x) : ((((0.64 + Sum (y | (R(x, y) and Q(y)) : (0.96 + Sum (z | (R(y, z) and Q(z)) : 1.44)))) + Sum (y | (C(x, y) and Q(y)) : (0.96 + Sum (z | (C(y, z) and Q(z)) : 1.44)))) + Sum (v0 | R(x, v0) : (0.29 + Sum (y | (C(v0, y) and Q(y)) : (0.44 + Sum (u0 | R(y, u0) : (0.66 + Sum (z | (C(u0, z) and Q(z)) : 1.)))))))) + Sum (v | R(x, v) : (0.29 + Sum (y | (C(y, v) and Q(y)) : (0.44 + Sum (u | R(y, u) : (0.66 + Sum (z | (C(z, u) and Q(z)) : 1.)))))))))))" (Formula.real_str (Heuristic.map_constants (fun c->(floor (c*.100.))/.100.) (Heuristic.of_payoff 1.5 @@ -296,7 +296,7 @@ (real_of_str (":("^winPxyz^") - :("^winQxyz^")"))))); assert_equal ~printer:(fun x->x) ~msg:"adv_ratio=10" - "(Sum (z | P(z) : ((((0.0101 + Sum (y | (R(y, z) and P(y)) : (0.101 + Sum (x | (R(x, y) and P(x)) : 1.01)))) + Sum (y | (C(y, z) and P(y)) : (0.101 + Sum (x | (C(x, y) and P(x)) : 1.01)))) + Sum (u | C(z, u) : (0.001 + Sum (y | (R(y, u) and P(y)) : (0.01 + Sum (v | C(y, v) : (0.1 + Sum (x | (R(x, v) and P(x)) : 1.)))))))) + Sum (u0 | C(u0, z) : (0.001 + Sum (y | (R(y, u0) and P(y)) : (0.01 + Sum (v0 | C(v0, y) : (0.1 + Sum (x | (R(x, v0) and P(x)) : 1.))))))))) + (-1. * Sum (z | Q(z) : ((((0.0101 + Sum (y | (R(y, z) and Q(y)) : (0.101 + Sum (x | (R(x, y) and Q(x)) : 1.01)))) + Sum (y | (C(y, z) and Q(y)) : (0.101 + Sum (x | (C(x, y) and Q(x)) : 1.01)))) + Sum (u | C(z, u) : (0.001 + Sum (y | (R(y, u) and Q(y)) : (0.01 + Sum (v | C(y, v) : (0.1 + Sum (x | (R(x, v) and Q(x)) : 1.)))))))) + Sum (u0 | C(u0, z) : (0.001 + Sum (y | (R(y, u0) and Q(y)) : (0.01 + Sum (v0 | C(v0, y) : (0.1 + Sum (x | (R(x, v0) and Q(x)) : 1.)))))))))))" + "(Sum (x | P(x) : ((((0.0101 + Sum (y | (R(x, y) and P(y)) : (0.101 + Sum (z | (R(y, z) and P(z)) : 1.01)))) + Sum (y | (C(x, y) and P(y)) : (0.101 + Sum (z | (C(y, z) and P(z)) : 1.01)))) + Sum (v0 | R(x, v0) : (0.001 + Sum (y | (C(v0, y) and P(y)) : (0.01 + Sum (u0 | R(y, u0) : (0.1 + Sum (z | (C(u0, z) and P(z)) : 1.)))))))) + Sum (v | R(x, v) : (0.001 + Sum (y | (C(y, v) and P(y)) : (0.01 + Sum (u | R(y, u) : (0.1 + Sum (z | (C(z, u) and P(z)) : 1.))))))))) + (-1. * Sum (x | Q(x) : ((((0.0101 + Sum (y | (R(x, y) and Q(y)) : (0.101 + Sum (z | (R(y, z) and Q(z)) : 1.01)))) + Sum (y | (C(x, y) and Q(y)) : (0.101 + Sum (z | (C(y, z) and Q(z)) : 1.01)))) + Sum (v0 | R(x, v0) : (0.001 + Sum (y | (C(v0, y) and Q(y)) : (0.01 + Sum (u0 | R(y, u0) : (0.1 + Sum (z | (C(u0, z) and Q(z)) : 1.)))))))) + Sum (v | R(x, v) : (0.001 + Sum (y | (C(y, v) and Q(y)) : (0.01 + Sum (u | R(y, u) : (0.1 + Sum (z | (C(z, u) and Q(z)) : 1.)))))))))))" (Formula.real_str (Heuristic.map_constants (fun c->(floor (c*.10000.))/.10000.) (Heuristic.of_payoff 10. Modified: trunk/Toss/Solver/FFSolverTest.ml =================================================================== --- trunk/Toss/Solver/FFSolverTest.ml 2010-12-07 14:35:28 UTC (rev 1232) +++ trunk/Toss/Solver/FFSolverTest.ml 2010-12-07 16:19:19 UTC (rev 1233) @@ -91,7 +91,7 @@ "eval: first-order quantifier free more" >:: (fun () -> eval_eq "[ | R {(a, b); (c, d)}; P {a; b}; Q{a; c} | ]" "P(x) or Q(x)" - "{ x->b, x->a, x->c }"; + "{ x->c, x->a, x->b }"; ); "eval: first-order with quantifiers more" >:: @@ -177,11 +177,12 @@ . Q . \"" heur_phi - "{ y->b1{ z->c1{ x->a1 } } , y->a2{ z->a3{ x->a1 } } }"; + "{ z->a3{ y->a2{ x->a1 } } , z->c1{ y->b1{ x->a1 } } }"; ); "eval: gomoku heuristic from SolverTest.ml" >:: (fun () -> + todo "Problem: uneliminated Empty inside assignment set"; let heur_phi = "(((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) @@ -215,6 +216,26 @@ \"" heur_phi "{ y->d6{ z->e7{ x->c5{ w->b4{ v->a3 } } } } , y->e1{ x->d1{ v->b1{ z->f1{ w->c1 } } } } , y->f1{ x->e1{ v->c1{ z->g1{ w->d1 } } } } , y->g1{ x->f1{ v->d1{ w->e1{ z->h1 } } } } , y->d2{ x->c3{ v->a5{ z->e1{ w->b4 } } } } , y->g5{ x->f6{ v->d8{ w->e7{ z->h4 } } } } , y->g6{ x->f6{ v->d6{ w->e6{ z->h6 } } } } , y->b7{ x->b6{ v->b4{ w->b5{ z->b8 } } } } , y->e7{ x->d6{ z->f8{ w->c5{ v->b4 } } } } , y->f7{ x->e6{ z->g8{ w->d5{ v->c4 } } } } }"); + (* + + { + w->f6{} , + w->e6{ v->d6{ x->f6{ y->g6{ z->h6 } } } } , + w->d6{} , + w->d5{ x->e6{ v->c4{ y->f7{ z->g8 } } } } , + w->c5{ x->d6{ v->b4{ y->e7{ z->f8 } } } } , + w->b5{ v->b4{ x->b6{ y->b7{ z->b8 } } } } , + w->e4{} , + w->c4{} , + w->b4{ x->c5{ v->a3{ y->d6{ z->e7 } } } , x->c3{ v->a5{ y->d2{ z->e1 } } } } , + w->c3{} , + w->f1{} , + w->c1{ x->d1{ y->e1{ v->b1{ z->f1 } } } } , + w->d1{ x->e1{ y->f1{ z->g1{ v->c1 } } } } , + w->e1{ x->f1{ y->g1{ v->d1{ z->h1 } } } } , + w->e7{ x->f6{ y->g5{ z->h4{ v->d8 } } } } } + *) + "get_real_val: tic-tac-toe winning" >:: (fun () -> let heur = real_of_str @@ -271,7 +292,7 @@ W..W W..W W..W W..W \"" in assert_equal ~printer:(fun x->x) - "((not ex x ((B(x) and all y ((not C(y, x)))))) and (W(b1) and (not B(b1)) and (C(b1, b2) and (not (b2 = b1)) and (R(a1, b1) and (not (b1 = a1)) and (not (b2 = a1)) and ((not (b1 = a2)) and R(a2, b2) and (not (b2 = a2)) and C(a1, a2) and (not (a2 = a1)) and (not W(a2)))))))" + "((not ex x ((B(x) and all y ((not C(y, x)))))) and (W(b1) and (not B(b1)) and (R(a1, b1) and (not (b1 = a1)) and (C(b1, b2) and (not (b2 = b1)) and (not (b2 = a1)) and ((not (b1 = a2)) and C(a1, a2) and (not (a2 = a1)) and R(a2, b2) and (not (b2 = a2)) and (not W(a2)))))))" (Formula.str (FFSolver.normalize_for_model brkthr_init brkthr_LHS)); ); @@ -290,7 +311,7 @@ . . . \"" in assert_equal ~printer:(fun x->x) - "((not ex x ((Q(x) and (ex y ((C(x, y) and Q(y) and ex z ((C(y, z) and Q(z))))) or ex y ((R(x, y) and Q(y) and ex z ((R(y, z) and Q(z))))) or ex v0 ((R(x, v0) and ex y ((C(y, v0) and Q(y) and ex u0 ((R(y, u0) and ex z ((C(z, u0) and Q(z))))))))) or ex v ((R(x, v) and ex y ((C(v, y) and Q(y) and ex u ((R(y, u) and ex z ((C(u, z) and Q(z))))))))))))) and ((not P(a1)) and (not Q(a1))))" + "((not ex z ((Q(z) and (ex y ((C(y, z) and Q(y) and ex x ((C(x, y) and Q(x))))) or ex u0 ((C(z, u0) and ex y ((R(y, u0) and Q(y) and ex v0 ((C(y, v0) and ex x ((R(x, v0) and Q(x))))))))) or ex y ((R(y, z) and Q(y) and ex x ((R(x, y) and Q(x))))) or ex u ((C(u, z) and ex y ((R(y, u) and Q(y) and ex v ((C(v, y) and ex x ((R(x, v) and Q(x))))))))))))) and ((not P(a1)) and (not Q(a1))))" (Formula.str (FFSolver.normalize_for_model tictactoe_init tictactoe_LHS)); ); @@ -311,8 +332,9 @@ . . . \"" in + (* not quite completely reviewed, but looks good... *) assert_equal ~printer:(fun x->x) -"((not ex z0 ((P(z0) and (ex y0 ((R(y0, z0) and P(y0) and ex x0 ((R(x0, y0) and P(x0))))) or ex y0 ((C(y0, z0) and P(y0) and ex x0 ((C(x0, y0) and P(x0))))) or ex u ((C(z0, u) and ex y0 ((R(y0, u) and P(y0) and ex v ((C(y0, v) and ex x0 ((R(x0, v) and P(x0))))))))) or ex u0 ((C(u0, z0) and ex y0 ((R(y0, u0) and P(y0) and ex v0 ((C(v0, y0) and ex x0 ((R(x0, v0) and P(x0))))))))))))) and ((P(z) and (not Q(z)) and (C(y, z) and (not Q(y)) and (C(x, y) and (not Q(x))))) or (P(y) and (not Q(y)) and (C(y, z) and (not Q(z)) and (C(x, y) and (not Q(x))))) or (P(z) and (not Q(z)) and (R(y, z) and (not Q(y)) and (R(x, y) and (not Q(x))))) or (P(y) and (not Q(y)) and (R(y, z) and (not Q(z)) and (R(x, y) and (not Q(x))))) or (P(x) and (not Q(x)) and (R(x, y) and (not Q(y)) and (R(y, z) and (not Q(z))))) or (P(x) and (not Q(x)) and (C(x, y) and (not Q(y)) and (C(y, z) and (not Q(z))))) or ((not Q(z)) and ex u ((C(u, z) and (R(y, u) and P(y) and (not Q(y)) and ex v ((C(v, y) and (R(x, v) and (not Q(x))))))))) or (P(x) and (not Q(x)) and ex v0 ((R(x, v0) and (C(y, v0) and (not Q(y)) and ex u0 ((R(y, u0) and (C(z, u0) and (not Q(z))))))))) or (P(z) and (not Q(z)) and ex u0 ((C(z, u0) and (R(y, u0) and (not Q(y)) and ex v0 ((C(y, v0) and (R(x, v0) and (not Q(x))))))))) or (P(x) and (not Q(x)) and ex v ((R(x, v) and (C(v, y) and (not Q(y)) and ex u ((R(y, u) and (C(u, z) and (not Q(z))))))))) or (P(z) and (not Q(z)) and ex u ((C(u, z) and (R(y, u) and (not Q(y)) and ex v ((C(v, y) and (R(x, v) and (not Q(x))))))))) or (P(y) and (not Q(y)) and ex u0 ((R(y, u0) and ex v0 ((C(y, v0) and (C(z, u0) and (not Q(z)) and (R(x, v0) and (not Q(x)))))))))))" +"((not ex x0 ((P(x0) and (ex y0 ((R(x0, y0) and P(y0) and ex z0 ((R(y0, z0) and P(z0))))) or ex y0 ((C(x0, y0) and P(y0) and ex z0 ((C(y0, z0) and P(z0))))) or ex v0 ((R(x0, v0) and ex y0 ((C(v0, y0) and P(y0) and ex u0 ((R(y0, u0) and ex z0 ((C(u0, z0) and P(z0))))))))) or ex v ((R(x0, v) and ex y0 ((C(y0, v) and P(y0) and ex u ((R(y0, u) and ex z0 ((C(z0, u) and P(z0))))))))))))) and ((P(z) and (not Q(z)) and (R(y, z) and (not Q(y)) and (R(x, y) and (not Q(x))))) or (P(x) and (not Q(x)) and (R(x, y) and (not Q(y)) and (R(y, z) and (not Q(z))))) or (P(y) and (not Q(y)) and (R(x, y) and (not Q(x)) and (R(y, z) and (not Q(z))))) or (P(z) and (not Q(z)) and (C(y, z) and (not Q(y)) and (C(x, y) and (not Q(x))))) or (P(x) and (not Q(x)) and (C(x, y) and (not Q(y)) and (C(y, z) and (not Q(z))))) or (P(y) and (not Q(y)) and (C(x, y) and (not Q(x)) and (C(y, z) and (not Q(z))))) or (P(z) and (not Q(z)) and ex u0 ((C(z, u0) and (R(y, u0) and (not Q(y)) and ex v0 ((C(y, v0) and (R(x, v0) and (not Q(x))))))))) or (P(x) and (not Q(x)) and ex v0 ((R(x, v0) and (C(y, v0) and (not Q(y)) and ex u0 ((R(y, u0) and (C(z, u0) and (not Q(z))))))))) or (P(y) and (not Q(y)) and ex v0 ((C(y, v0) and ex u0 ((R(y, u0) and (R(x, v0) and (not Q(x)) and (C(z, u0) and (not Q(z))))))))) or (P(z) and (not Q(z)) and ex u ((C(u, z) and (R(y, u) and (not Q(y)) and ex v ((C(v, y) and (R(x, v) and (not Q(x))))))))) or (P(x) and (not Q(x)) and ex v ((R(x, v) and (C(v, y) and (not Q(y)) and ex u ((R(y, u) and (C(u, z) and (not Q(z))))))))) or (P(y) and (not Q(y)) and ex u ((R(y, u) and ex v ((C(v, y) and (C(u, z) and (not Q(z)) and (R(x, v) and (not Q(x)))))))))))" (* old variant: "((not ex z0 ((P(z0) and (ex y0 ((R(y0, z0) and P(y0) and ex x0 ((R(x0, y0) and P(x0))))) or ex y0 ((C(y0, z0) and P(y0) and ex x0 ((C(x0, y0) and P(x0))))) or ex y0 ((P(y0) and ex x0 ((P(x0) and (ex u ((C(z0, u) and R(y0, u) and ex v ((C(y0, v) and R(x0, v))))) or ex u0 ((C(u0, z0) and R(y0, u0) and ex v0 ((C(v0, y0) and R(x0, v0)))))))))))))) and ((P(z) and (not Q(z)) and (C(y, z) and (not Q(y)) and (C(x, y) and (not Q(x))))) or (P(y) and (not Q(y)) and (C(y, z) and (not Q(z)) and (C(x, y) and (not Q(x))))) or (P(z) and (not Q(z)) and (R(y, z) and (not Q(y)) and (R(x, y) and (not Q(x))))) or (P(y) and (not Q(y)) and (R(y, z) and (not Q(z)) and (R(x, y) and (not Q(x))))) or (P(x) and (not Q(x)) and (R(x, y) and (not Q(y)) and (R(y, z) and (not Q(z))))) or (P(x) and (not Q(x)) and (C(x, y) and (not Q(y)) and (C(y, z) and (not Q(z))))) or ((not Q(z)) and ex u ((C(u, z) and (R(y, u) and P(y) and (not Q(y)) and ex v ((C(v, y) and (R(x, v) and (not Q(x))))))))) or (P(x) and (not Q(x)) and ex v0 ((R(x, v0) and (C(y, v0) and (not Q(y)) and ex u0 ((R(y, u0) and (C(z, u0) and (not Q(z))))))))) or (P(z) and (not Q(z)) and ex u0 ((C(z, u0) and (R(y, u0) and (not Q(y)) and ex v0 ((C(y, v0) and (R(x, v0) and (not Q(x))))))))) or (P(x) and (not Q(x)) and ex v ((R(x, v) and (C(v, y) and (not Q(y)) and ex u ((R(y, u) and (C(u, z) and (not Q(z))))))))) or (P(z) and (not Q(z)) and ex u ((C(u, z) and (R(y, u) and (not Q(y)) and ex v ((C(v, y) and (R(x, v) and (not Q(x))))))))) or (P(y) and (not Q(y)) and ex u0 ((R(y, u0) and ex v0 ((C(y, v0) and (C(z, u0) and (not Q(z)) and (R(x, v0) and (not Q(x)))))))))))"*) (Formula.str (FFSolver.normalize_for_model This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-07 14:35:35
|
Revision: 1232 http://toss.svn.sourceforge.net/toss/?rev=1232&view=rev Author: lukstafi Date: 2010-12-07 14:35:28 +0000 (Tue, 07 Dec 2010) Log Message: ----------- FFTNF parsimony options. FFTNF moved from breadth-first to depth-first traversal (more duplication in some cases, but simpler code). FFSEP inverted context bug fix. FFTNF/FFSEP tests review and extensions. Modified Paths: -------------- trunk/Toss/Formula/FFTNF.ml trunk/Toss/Formula/FFTNF.mli trunk/Toss/Formula/FFTNFTest.ml trunk/Toss/Formula/FormulaOps.ml trunk/Toss/Formula/FormulaOps.mli Modified: trunk/Toss/Formula/FFTNF.ml =================================================================== --- trunk/Toss/Formula/FFTNF.ml 2010-12-07 00:26:40 UTC (rev 1231) +++ trunk/Toss/Formula/FFTNF.ml 2010-12-07 14:35:28 UTC (rev 1232) @@ -1,9 +1,21 @@ (* Computing the FF Type Normal Form, and the FF Separation. - ********** {2 Computing the FF Type Normal Form} + Because FFTNF adds considerably to the already high computational + cost of computing TNF, we turn off some of its flexibility + depending on the size of the normalized formula: + + (1) at parsimony level 1 (PARL1), we do not move atoms that are + already protected (in the TNF sense) if that leads to formula + duplication; + + (2) at parsimony level 2 (PARL2), we do not reduce to PNF and do + not move protected atoms at all. + + + {3 Algorithm for calculating FFTNF(_<_):} 1: Reduce to partially negation-normal prenex-normal form with @@ -12,15 +24,16 @@ nonalternating quantifiers into quantifying over sets of variables. We call a negated existentially quantified ground subformula -- or equivalently a universally quantified ground - subformula -- a subtask. + subformula -- a subtask. PARL2: do partial NNF but not PNF. 2: Collapse conjunctions and disjunctions using associativity. 3: The processed part is maintained explicitly; the zipper is - built during the breadth-first search for unprocessed literal and - is then zipped by pulling-out the selected literal. + built during the depth-first search for unprocessed literal and + is then zipped by pulling-out the selected literal. PARL2: mark + protected literals as processed. - The whole term is searched breadth-first for a subtask or the best + The whole term is searched depth-first for a subtask or the best literal to pull-out. A subtask is preferred, otherwise the first best literal is selected. @@ -41,7 +54,7 @@ 4: When a subtask/literal is placed in its final location it is marked as processed. Denote by Qn, Qn', etc., a quantifier over a set of variables, and by -Qn a quantifier that is complementary to - Qn (i.e. -ex vs.Phi = all vs.Phi). The result of pulling out a + Qn (e.g. -ex vs.Phi = all vs.Phi). The result of pulling out a literal L of a location (context[],[fill-loc]) (denoted also as context[][fill-loc]) by cases on context[]: @@ -59,6 +72,9 @@ Qn4=Qn & Var(D) \ Qn3, Qn5=Qn & Var([fill-loc]) \ Qn1 \ Qn3, Qn6=Qn & Var([fill-loc],D) + (c0) PARL1 and Qn1=Qn: + context[L /\ [fill-loc]] + (c1) empty Qn3: pull-out(context'[Qn2.[] \/ Qn4.D],[fill-loc]) @@ -77,6 +93,9 @@ Qn4=Qn & Var(C) \ Qn3, Qn5=Qn & Var(D,C), Qn6=Qn & Var(L,[fill-loc],C) + (d0) PARL1 and Qn1=Qn: + context[L /\ [fill-loc]] + (d1) empty Qn3: pull-out(context'[Qn2.([] \/ D) /\ Qn4.C],[fill-loc]) @@ -87,7 +106,7 @@ pull-out(context'[Qn6.([] /\ C) \/ Qn5.(D /\ C)],[fill-loc]) (e) context'[[] \/ D] when no quantifier in context': - context[fill-loc] + context[L /\ [fill-loc]] (f) context'[([] \/ D) /\ C] when neither case (d) nor (e): @@ -120,9 +139,6 @@ FIXME: the above specification is not correct (too weak). - TODO: rethink whether breadth-first search is better than - depth-first! (Present the arguments.) - *) (* @@ -132,6 +148,9 @@ open Aux open Printf +let parsimony_threshold_1 = ref 100 +let parsimony_threshold_2 = ref 200 + let debug_level = ref 0 @@ -145,8 +164,10 @@ "ex z all x ex y (R(x,y) and Q(z))" Additionally, in a subformula "not ex vs.phi", negation is is not pushed over the existential quantification if the subformula - "ex vs.phi" has no free variables. *) -let p_pn_nnf phi = + "ex vs.phi" has no free variables. + + Optionally (PARL=2) don't reduce to PNF, just compute partial NNF. *) +let p_pn_nnf ?(do_pnf=true) phi = let pack_vs xs vs = List.map2 (fun v -> function | `FO _ -> `FO v @@ -231,10 +252,12 @@ pnf false (add_strings vs vars) sb psi in (Right (pack_vs xs vs))::pref, vars, psi in - let pref, _, phi = pnf true Strings.empty [] (nnf phi) in - List.fold_right (fun q phi -> match q with - | Left vs -> Ex (vs, phi) - | Right vs -> All (vs, phi)) pref phi in + if do_pnf then + let pref, _, phi = pnf true Strings.empty [] (nnf phi) in + List.fold_right (fun q phi -> match q with + | Left vs -> Ex (vs, phi) + | Right vs -> All (vs, phi)) pref phi + else nnf phi in pn_nnf phi @@ -517,8 +540,10 @@ (* Steps 1, 2 and initial part of 3: reduce to pnf, collapse the prefix - and form the initial context, flatten conjunctions and disjunctions. *) -let rec init phi = + and form the initial context, flatten conjunctions and + disjunctions. When not computing PNF, mark all protected literals + as processed. *) +let rec init ?(do_pnf=true) phi = let rec prefix res = function | Ex (vs, psi) -> (match res with @@ -532,63 +557,75 @@ | _ -> prefix (AllNode (res, vars_of_list vs)) psi) | phi -> res, phi in let revpref, phi = - prefix Top (p_pn_nnf phi) in + prefix Top (p_pn_nnf ~do_pnf phi) in let phi = FormulaOps.flatten_formula phi in - let rec to_tree = function + let protected lit qvs = + let lit_vs = FormulaOps.all_vars lit in + List.for_all (fun v->List.mem v lit_vs) qvs in + let rec to_tree last_qvs = function | Not (Ex _ as phi) -> (* assumes [phi] is ground! *) {fvs=Vars.empty; t=TNot_subtask phi} + | (Rel _ | Eq _ | In _ | RealExpr _ | Not _) as lit + when not do_pnf && protected lit last_qvs -> + {fvs=vars_of_list (FormulaOps.all_vars lit); t=TProc (0,lit)} + | (Rel _ | Eq _ | In _ | RealExpr _ | Not _) as lit -> {fvs=vars_of_list (FormulaOps.all_vars lit); t=TLit lit} | And conjs -> List.fold_right (fun conj -> function {fvs=vs; t=TAnd conjs} -> - let conj = to_tree conj in + let conj = to_tree last_qvs conj in {fvs=Vars.union conj.fvs vs; t=TAnd (conj::conjs)} | _ -> assert false) conjs {fvs=Vars.empty; t=TAnd []} | Or disjs -> List.fold_right (fun disj -> function {fvs=vs; t=TOr disjs} -> - let disj = to_tree disj in + let disj = to_tree last_qvs disj in {fvs=Vars.union disj.fvs vs; t=TOr (disj::disjs)} | _ -> assert false) disjs {fvs=Vars.empty; t=TOr []} | Ex (vs, phi) -> - let ({fvs=fvs} as phi) = to_tree phi in + let ({fvs=fvs} as phi) = to_tree vs phi in let vs = vars_of_list vs in {fvs=Vars.diff fvs vs; t=TEx (vs, phi)} | All (vs, phi) -> - let ({fvs=fvs} as phi) = to_tree phi in + let ({fvs=fvs} as phi) = to_tree vs phi in let vs = vars_of_list vs in {fvs=Vars.diff fvs vs; t=TAll (vs, phi)} in - {x=revpref; n=to_tree phi} + {x=revpref; n=to_tree [] phi} -(* Build a list of all locations just below the given location, - together with the variables they are directly in scope of (which is - default for TAnd/TOr but changes for TAll/TEx). *) -let build_locs loc = - match loc.n with - | {t=TAnd subts} | {t=TOr subts} -> - let rec aux res left = function - | [] -> res - | hd::tl -> - let ctx = - snap_flat loc.n.t (loc.x, left @ tl) in - aux ({x=ctx; n=hd}::res) (hd::left) tl in - aux [] [] subts - | {t=TAll (vs, subt)} -> [{x=AllNode (loc.x, vs); n=subt}] - | {t=TEx (vs, subt)} -> [{x=ExNode (loc.x, vs); n=subt}] - | {t=TProc _} | {t=TLit _} | {t=TNot_subtask _} -> [] -(* Safer than using the generic [Not_found] exception. *) -exception Lit_not_found - -(* Return the minimal-depth subtask or best literal and its location - but with the subtask/literal removed. Best literal: there is no literal - with older oldest variable, and is smallest wrt. [cmp_lits] among - such. Remember to mark protected literals before. +(* Map a prefix of [Left] elements (returned in reverse order) till + the first [Right] element (if any). Construct the context argument. *) +let loc_find_first f g l = + let rec aux accu = function + | [] -> None + | a::tl -> + match f (g accu tl) a with + | None -> aux (a :: accu) tl + | r -> r in + aux [] l + +(* Not tail-recursive. [cmp a b] means that [a] is strictly + preferred to [b]. *) +let loc_find_best cmp f g l = + let rec aux accu = function + | [] -> None + | a::tl -> + match f (g accu tl) a, aux (a :: accu) tl with + | None, None -> None + | None, Some r | Some r, None -> Some r + | (Some r1 as sr1), (Some r2 as sr2) -> + if cmp r2 r1 then sr2 else sr1 in + aux [] l + +(* Return the depth-first (i.e. leftmost) subtask or best literal and + its location but with the subtask/literal removed. Best literal: + there is no literal with older oldest variable, and is smallest + wrt. [cmp_lits] among such. *) -let rec find_unprot cmp_lits best_loc bfstack loc = +let find_unprotected cmp_lits loc = (* check which vars are older in the prefix and then which literals are preferred, return true if vs1,lit1 are strictly older/preferred *) - let cmp_vars_lits vs1 vs2 lit1 lit2 = + let cmp_vars_lits ctx vs1 vs2 lit1 lit2 = let rec aux vs1 vs2 = function | Top -> cmp_lits lit1 lit2 | AndNode (ctx, _) | OrNode (ctx, _) -> @@ -596,52 +633,57 @@ | ExNode (ctx, vs) | AllNode (ctx, vs) -> let vs1' = Vars.diff vs1 vs and vs2' = Vars.diff vs2 vs in + (* {{{ log entry *) + if !debug_level > 6 then ( + printf "cmp_vars_lits: Q=%s; vs1'=%s; vs2'=%s\n%!" + (String.concat ", " + (List.map Formula.var_str (Vars.elements vs))) + (String.concat ", " + (List.map Formula.var_str (Vars.elements vs1'))) + (String.concat ", " + (List.map Formula.var_str (Vars.elements vs2'))) + ); + (* }}} *) if Vars.is_empty vs1' && Vars.is_empty vs2' then cmp_lits lit1 lit2 else not (Vars.is_empty vs1') && (Vars.is_empty vs2' || aux vs1' vs2' ctx) in - aux vs1 vs2 loc.x in - (* add locations that are just below current loc to the queue and repeat *) - let advance best_loc = - let bfstack = bfstack @ build_locs loc in - match bfstack with - | [] -> - (match best_loc with - | Some (best,loc) -> Right best, loc - | None -> raise Lit_not_found) - | next::tl_stack -> - find_unprot cmp_lits best_loc tl_stack next in - (* check location *) - match loc.n with + aux vs1 vs2 ctx in + let cmp_find ctx (a, _) (b, _) = + match a, b with + | Left _, Left _ -> false + | Left _, Right _ -> true + | Right _, Left _ -> false + | Right (vs1, lit1), Right (vs2, lit2) -> + let res = cmp_vars_lits ctx vs1 vs2 lit1 lit2 in + (* {{{ log entry *) + if !debug_level > 3 then ( + printf "find_unprot: comparing lits %s < %s = %s\n%!" + (Formula.str lit1) (Formula.str lit2) (if res then "T" else "F") + ); + (* }}} *) + res in + (* find next location in the tree *) + let rec aux ctx = function | {t=TNot_subtask subt} -> - Left subt, {loc with n={fvs=Vars.empty; t=TAnd[]}} + Some (Left subt, {x=ctx; n={fvs=Vars.empty; t=TAnd[]}}) | {fvs=lit_vs; t=TLit lit} -> - let _ = if !debug_level > 4 then - printf "find_unprot: processing literal %s, loc %s\n" - (Formula.str lit) (location_str loc) in - let best_loc = (* store if first *) - match best_loc with - | Some ((lit2,lit_vs2), _) - when not (cmp_vars_lits lit_vs lit_vs2 lit lit2) -> - let _ = if !debug_level > 3 then begin - printf "find_unprot: keeping %s\n" - (Formula.str lit2) end in - best_loc - | _ -> - let _ = if !debug_level > 3 then begin - printf "find_unprot: selecting %s\n" (Formula.str lit) end in - Some ((lit,lit_vs), {loc with n={fvs=Vars.empty; t=TAnd[]}}) in - advance best_loc + Some (Right (lit_vs, lit), {x=ctx; n={fvs=Vars.empty; t=TAnd[]}}) + | {t=TProc _} -> None + | {t=(TAnd js | TOr js) as templ} -> + let build_ctx lsubt rsubt = + snap_flat templ (ctx, List.rev_append lsubt rsubt) in + (* pass [ctx] to check the quantifiers *) + loc_find_best (cmp_find ctx) aux build_ctx js + | {t=TAll (vs, subt)} -> + aux (AllNode (ctx, vs)) subt + | {t=TEx (vs, subt)} -> + aux (ExNode (ctx, vs)) subt in + aux loc.x loc.n - | _ -> - advance best_loc -let find_unprotected cmp_lits loc = - find_unprot cmp_lits None [] loc - - let rec quant_in_scope = function | Top -> false | AllNode (_, vs) | ExNode (_, vs) -> true @@ -660,16 +702,16 @@ (* The rewriting steps. Uses a callback to process subtasks recursively before putting them in their final locations. *) -let rec pull_out subproc (task_id, task_lit as task) loc = +let rec pull_out parl1 subproc (task_id, task_lit as task) loc = let _ = if !debug_level > 4 then - printf "\npull-out_step_location: %s\n" (location_str loc) in + printf "\npull-out_step_location: %s\n" (location_str loc) in let lit_vs, put_result = match task_lit with | Left subt -> Vars.empty, (* it's a TNot_subtask, the negation is added by [subproc] *) lazy {fvs=Vars.empty; t=TProc (task_id, subproc subt)} - | Right (lit, lit_vs) -> + | Right (lit_vs, lit) -> lit_vs, lazy {fvs=lit_vs; t=TProc (task_id, lit)} in match loc.x with | Top -> conj_flat (Lazy.force put_result, loc.n) @@ -677,155 +719,167 @@ (* a *) | AllNode (ctx', vs) | ExNode (ctx', vs) -> - let vs' = Vars.inter vs lit_vs in - let vs'' = Vars.diff vs vs' in - (* a1 - pull-out(context'[],[Qn.[fill-loc]]) *) - if Vars.is_empty vs' then - let _ = if !debug_level > 2 then printf "a1\n" in - pull_out subproc task {x=ctx'; n=qT loc.x (vs,loc.n)} + let vs' = Vars.inter vs lit_vs in + let vs'' = Vars.diff vs vs' in + (* a1 + pull-out(context'[],[Qn.[fill-loc]]) *) + if Vars.is_empty vs' then + let _ = if !debug_level > 2 then printf "a1\n" in + pull_out parl1 subproc task {x=ctx'; n=qT loc.x (vs,loc.n)} - (* a2 - context'[Qn'.(L /\ Qn''.[fill-loc])] *) - else - let _ = if !debug_level > 2 then printf "a2\n" in - zip {x=ctx'; n=qT loc.x (vs', conj_flat ( - Lazy.force put_result, qT loc.x (vs'', loc.n)))} + (* a2 + context'[Qn'.(L /\ Qn''.[fill-loc])] *) + else + let _ = if !debug_level > 2 then printf "a2\n" in + zip {x=ctx'; n=qT loc.x (vs', conj_flat ( + Lazy.force put_result, qT loc.x (vs'', loc.n)))} (* b pull-out(context'[],[[fill-loc] /\ C]) *) | AndNode (ctx', subts) -> - let _ = if !debug_level > 2 then printf "b\n" in - pull_out subproc task - {x=ctx'; n=zip {loc with x=AndNode (Top, subts)}} + let _ = if !debug_level > 2 then printf "b\n" in + pull_out parl1 subproc task + {x=ctx'; n=zip {loc with x=AndNode (Top, subts)}} (* c *) | OrNode (AllNode (ctx', vs) as qN, subts) | OrNode (ExNode (ctx', vs) as qN, subts) -> - let vs1 = Vars.inter vs lit_vs in - let vsF = Vars.inter vs loc.n.fvs in - let vs0 = Vars.union vs1 vsF in - let vsSibl = free_vars_siblings loc.x in - let vsD = Vars.inter vs vsSibl in - let vs2 = Vars.diff vs0 vsD in - let vs3 = Vars.inter vs0 vsD in - let vs4 = Vars.diff vsD vs3 in - let vs5 = Vars.diff (Vars.diff vsF vs1) vs3 in - let disj = {fvs=vsSibl; t=TOr subts} in - let vs1_3 = Vars.diff vs1 vs3 in + let vs1 = Vars.inter vs lit_vs in + let vsF = Vars.inter vs loc.n.fvs in + let vs0 = Vars.union vs1 vsF in + let vsSibl = free_vars_siblings loc.x in + let vsD = Vars.inter vs vsSibl in + let vs2 = Vars.diff vs0 vsD in + let vs3 = Vars.inter vs0 vsD in + let vs4 = Vars.diff vsD vs3 in + let vs5 = Vars.diff (Vars.diff vsF vs1) vs3 in + let disj = {fvs=vsSibl; t=TOr subts} in + let vs1_3 = Vars.diff vs1 vs3 in - (* c1 - pull-out(context'[Qn2.[] \/ Qn4.D],[fill-loc]) *) - if Vars.is_empty vs3 then - let _ = if !debug_level > 2 then printf "c1\n" in - pull_out subproc task - {loc with x= qNode qN ( - orNode_flat (ctx', [qT qN (vs4, disj)]), vs2)} + (* c0 + context[L /\ [fill-loc]] *) + if parl1 && Vars.is_empty (Vars.diff vs vs1) then + zip {loc with n=conj_flat (Lazy.force put_result, loc.n)} - (* c2 - context'[Qn3.(Qn1\Qn3.(L /\ Qn5.[fill-loc]) \/ Qn4.D)] *) - else if not (Vars.is_empty vs1) && + (* c1 + pull-out(context'[Qn2.[] \/ Qn4.D],[fill-loc]) *) + else if Vars.is_empty vs3 then + let _ = if !debug_level > 2 then printf "c1\n" in + pull_out parl1 subproc task + {loc with x= qNode qN ( + orNode_flat (ctx', [qT qN (vs4, disj)]), vs2)} + + (* c2 + context'[Qn3.(Qn1\Qn3.(L /\ Qn5.[fill-loc]) \/ Qn4.D)] *) + else if not (Vars.is_empty vs1) && (not (Vars.is_empty vs1_3) || - Vars.is_empty (Vars.diff vs3 vs1)) - then - let _ = if !debug_level > 2 then printf "c2\n" in - let subt = - disj_flat ( - qT qN (vs1_3, conj_flat - (Lazy.force put_result, qT qN (vs5, loc.n))), - qT qN (vs4, disj)) in - zip {x=ctx'; n=qT qN (vs3, subt)} + Vars.is_empty (Vars.diff vs3 vs1)) + then + let _ = if !debug_level > 2 then printf "c2\n" in + let subt = + disj_flat ( + qT qN (vs1_3, conj_flat + (Lazy.force put_result, qT qN (vs5, loc.n))), + qT qN (vs4, disj)) in + zip {x=ctx'; n=qT qN (vs3, subt)} - (* c3 - pull-out(context'[Qn2+3.[] \/ Qn3+4.D],[fill-loc]) *) - else if match qN with ExNode _ -> true | _ -> false then - let _ = if !debug_level > 2 then printf "c3\n" in - pull_out subproc task - {loc with x=qNode qN - (orNode_flat (ctx', [qT qN (vsD, disj)]), vs0)} - - (* c4 - pull-out(context'[Qn.(([] \/ D) /\ ([fill-loc] \/ - D))],[T]) *) - else - let _ = if !debug_level > 2 then printf "c4\n" in - pull_out subproc task - {x= - orNode_flat ( - (* no need for andNode_flat here *) - AndNode ( - qNode qN (ctx', vs), [ - disj_flat (loc.n, disj)]), - [disj]); - n= {fvs=Vars.empty; t=TAnd []}} - + (* c3 + pull-out(context'[Qn2+3.[] \/ Qn3+4.D],[fill-loc]) *) + else if (match qN with ExNode _ -> true | _ -> false) + then ( + if !debug_level > 2 then printf "c3\n"; + pull_out parl1 subproc task + {loc with x=qNode qN + (orNode_flat (ctx', [qT qN (vsD, disj)]), vs0)} + + (* c4 + pull-out(context'[Qn.(([] \/ D) /\ ([fill-loc] \/ + D))],[T]) *) + ) else ( + if !debug_level > 2 then printf "c4\n"; + pull_out parl1 subproc task + {x= + orNode_flat ( + (* no need for andNode_flat here *) + AndNode ( + qNode qN (ctx', vs), [ + disj_flat (loc.n, disj)]), + [disj]); + n= {fvs=Vars.empty; t=TAnd []}} + ) (* d *) | OrNode ( - AndNode ((AllNode (ctx', vs) | ExNode (ctx', vs)) as qN - , and_subts) as and_ctx, - or_subts) -> - let vs1 = Vars.inter vs lit_vs in - let vsF = Vars.inter vs loc.n.fvs in - let vsFL = Vars.union vsF vs1 in - let vsSiblOr = free_vars_siblings loc.x in - let vsD = Vars.inter vs vsSiblOr in - let vsFLD = Vars.union vsFL vsD in - let vsSiblAnd = free_vars_siblings and_ctx in - let vsC = Vars.inter vs vsSiblAnd in - let vs2 = Vars.diff vsFLD vsC in - let vs3 = Vars.inter vsFLD vsC in - let vs4 = Vars.diff vsC vs3 in - let disj = {fvs=vsSiblOr; t=TOr or_subts} in - let conj = {fvs=vsSiblAnd; t=TAnd and_subts} in + AndNode ((AllNode (ctx', vs) | ExNode (ctx', vs)) as qN + , and_subts) as and_ctx, + or_subts) -> + let vs1 = Vars.inter vs lit_vs in + let vsF = Vars.inter vs loc.n.fvs in + let vsFL = Vars.union vsF vs1 in + let vsSiblOr = free_vars_siblings loc.x in + let vsD = Vars.inter vs vsSiblOr in + let vsFLD = Vars.union vsFL vsD in + let vsSiblAnd = free_vars_siblings and_ctx in + let vsC = Vars.inter vs vsSiblAnd in + let vs2 = Vars.diff vsFLD vsC in + let vs3 = Vars.inter vsFLD vsC in + let vs4 = Vars.diff vsC vs3 in + let disj = {fvs=vsSiblOr; t=TOr or_subts} in + let conj = {fvs=vsSiblAnd; t=TAnd and_subts} in - (* d1 - pull-out(context'[Qn2.([] \/ D) /\ Qn4.C],[fill-loc]) *) - if Vars.is_empty vs3 then - let _ = if !debug_level > 2 then printf "d1\n" in - pull_out subproc task - {loc with x= orNode_flat ( - qNode qN (andNode_flat ( - ctx', qT qN (vs4, conj)), vs2), - or_subts)} + (* d0 + context[L /\ [fill-loc]] *) + if parl1 && Vars.is_empty (Vars.diff vs vs1) then + zip {loc with n=conj_flat (Lazy.force put_result, loc.n)} - (* d2 - pull-out(context'[Qn2+3.([] \/ D) /\ Qn3+4.C]) *) - else if match qN with AllNode _ -> true | _ -> false then - let _ = if !debug_level > 2 then printf "d2\n" in - pull_out subproc task - {loc with x= orNode_flat ( - qNode qN (andNode_flat (ctx', qT qN (vsC, conj)), vsFLD) - , or_subts)} + (* d1 + pull-out(context'[Qn2.([] \/ D) /\ Qn4.C],[fill-loc]) *) + else if Vars.is_empty vs3 then + let _ = if !debug_level > 2 then printf "d1\n" in + pull_out parl1 subproc task + {loc with x= orNode_flat ( + qNode qN (andNode_flat ( + ctx', qT qN (vs4, conj)), vs2), + or_subts)} + (* d2 + pull-out(context'[Qn2+3.([] \/ D) /\ Qn3+4.C]) *) + else if (match qN with AllNode _ -> true | _ -> false) + then + let _ = if !debug_level > 2 then printf "d2\n" in + pull_out parl1 subproc task + {loc with x= orNode_flat ( + qNode qN (andNode_flat (ctx', qT qN (vsC, conj)), vsFLD) + , or_subts)} + (* d3 pull-out(context'[Qn6.([] /\ C) \/ Qn5.(D /\ C)],[fill-loc]) *) - else - let vs5 = Vars.union vsD vsC in - let vs6 = Vars.union vsFL vsC in - let _ = if !debug_level > 2 then printf "d3\n" in - pull_out subproc task - {loc with x= andNode_flat ( - qNode qN ( - orNode_flat( - ctx', [qT qN (vs5, conj_flat (disj,conj))]), vs6), - conj)} + else + let vs5 = Vars.union vsD vsC in + let vs6 = Vars.union vsFL vsC in + let _ = if !debug_level > 2 then printf "d3\n" in + pull_out parl1 subproc task + {loc with x= andNode_flat ( + qNode qN ( + orNode_flat( + ctx', [qT qN (vs5, conj_flat (disj,conj))]), vs6), + conj)} | OrNode (OrNode _,_) -> - failwith "pull_out: malformed context (nonflat disjunction)" + failwith "pull_out: malformed context (nonflat disjunction)" - (* e - context[fill-loc] *) + (* e + context[fill-loc] *) | OrNode (Top, _) -> - let _ = if !debug_level > 2 then printf "e\n" in - zip {loc with n=conj_flat (Lazy.force put_result, loc.n)} + let _ = if !debug_level > 2 then printf "e\n" in + zip {loc with n=conj_flat (Lazy.force put_result, loc.n)} | OrNode (ctx',_) when not (quant_in_scope ctx') -> - let _ = if !debug_level > 2 then printf "e\n" in - zip {loc with n=conj_flat (Lazy.force put_result, loc.n)} + let _ = if !debug_level > 2 then printf "e\n" in + zip {loc with n=conj_flat (Lazy.force put_result, loc.n)} - (* f1 - context[L /\ [fill-loc]] *) + (* f1 + context[L /\ [fill-loc]] *) | OrNode (AndNode (Top, _), _) -> let _ = if !debug_level > 2 then printf "f1\n" in zip {loc with n= @@ -836,9 +890,9 @@ zip {loc with n= conj_flat (Lazy.force put_result, loc.n)} - (* f2 - pull-out(context'[([] /\ C) \/ (D /\ C)], [fill-loc]) *) - (* same as (d) of FFSEP *) + (* f2 + pull-out(context'[([] /\ C) \/ (D /\ C)], [fill-loc]) *) + (* same as (d) of FFSEP *) | OrNode (AndNode (ctx', conjs), disjs) when not (univ_next_in_scope ctx') -> let _ = if !debug_level > 2 then printf "f2\n" in @@ -846,53 +900,79 @@ {fvs=Vars.empty; t=TOr []} in let c = List.fold_right (fun a b->conj_flat (a,b)) conjs {fvs=Vars.empty; t=TAnd []} in - pull_out subproc task + pull_out parl1 subproc task {loc with x= andNode_flat ( orNode_flat (ctx', [conj_flat (d,c)]), c)} - (* f3 - pull-out(context'[([] \/ D \/ E) /\ (C \/ E)], [fill-loc]) *) - (* same as (f) of FFSEP *) + (* f3 + pull-out(context'[([] \/ D \/ E) /\ (C \/ E)], [fill-loc]) *) + (* same as (f) of FFSEP *) | OrNode (AndNode (OrNode (ctx', esjs), conjs), disjs) -> let _ = if !debug_level > 2 then printf "f3\n" in let e = List.fold_right (fun a b->disj_flat (a,b)) esjs {fvs=Vars.empty; t=TOr []} in let c = List.fold_right (fun a b->conj_flat (a,b)) conjs {fvs=Vars.empty; t=TAnd []} in - pull_out subproc task + pull_out parl1 subproc task {loc with x= orNode_flat ( AndNode (ctx', [disj_flat (c,e)]), disjs @ esjs)} | OrNode (AndNode (AndNode (_, _), _), _) -> - failwith "pull_out: malformed context (nonflat conjunction)" + failwith "pull_out: malformed context (nonflat conjunction)" -let ff_tnf cmp_lits phi = - let loc = init phi in - let _ = if !debug_level > 2 then - printf "\ninit_location: %s\n" (location_str loc) in +let ff_tnf ?force_parsimony cmp_lits phi = + let parsimony_level = + match force_parsimony with + | Some parl -> parl + | None -> + let size = FormulaOps.size phi in + if size < !parsimony_threshold_1 then 0 + else if size < !parsimony_threshold_2 then 1 + else 2 in + (* {{{ log entry *) + if !debug_level > 1 then ( + printf "ff_tnf: parsimony_level=%d\n%!" parsimony_level + ); + (* }}} *) + let loc = init ~do_pnf:(parsimony_level<2) phi in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "\ninit_location: %s\n" (location_str loc) + ); + (* }}} *) (* a bit redundant -- only the first call is a nontrivial location *) let rec loop i loc = - try - let subt_lit, loc = find_unprotected cmp_lits loc in - let _ = if !debug_level > 2 then begin - printf "\nfound_subtask-literal: %s\n" - (match subt_lit with - | Left subt -> Formula.sprint (Not subt) - | Right (lit,_) -> Formula.str lit); - printf "location: %s\n" (location_str loc) end in - let phi = pull_out subproc (i, subt_lit) loc in - if !debug_level > 2 then - printf "\npull-out_result: %s\n" - (Formula.sprint (formula_of_tree phi)); - loop (i+1) {x=Top; n=phi} - with Lit_not_found -> - let result = zip loc in - let _ = if !debug_level > 2 then begin - printf "\nff_tnf-result: %s\n" - (Formula.sprint (formula_of_tree result)) end in - result - + match find_unprotected cmp_lits loc with + | Some (subt_lit, loc) -> + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "\nfound_subtask-literal: %s\n" + (match subt_lit with + | Left subt -> Formula.sprint (Not subt) + | Right (_,lit) -> Formula.str lit); + printf "location: %s\n" (location_str loc) + ); + (* }}} *) + let phi = + pull_out (parsimony_level>0) subproc (i, subt_lit) loc in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "\npull-out_result: %s\n" + (Formula.sprint (formula_of_tree phi)); + ); + (* }}} *) + loop (i+1) {x=Top; n=phi} + | None -> + let result = zip loc in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "\nff_tnf-result: %s\n" + (Formula.sprint (formula_of_tree result)) + ); + (* }}} *) + result + and subproc subt = let loc = init subt in let _ = if !debug_level > 2 then @@ -902,11 +982,17 @@ Not (flatten_tree_to_formula (loop 0 loc)) in let res = loop 0 loc in - if !debug_level > 1 then - printf "ff_tnf: res=%s\n%!" (Formula.sprint (formula_of_tree res)); + (* {{{ log entry *) + if !debug_level > 1 then ( + printf "ff_tnf: res=%s\n%!" (Formula.sprint (formula_of_tree res)) + ); + (* }}} *) let flat = flatten_tree_to_formula res in - if !debug_level > 1 then - printf "ff_tnf: flat=%s\n%!" (Formula.sprint flat); + (* {{{ log entry *) + if !debug_level > 1 then ( + printf "ff_tnf: flat=%s\n%!" (Formula.sprint flat) + ); + (* }}} *) flat @@ -929,6 +1015,8 @@ Strings.mem r frels | _ -> false) + + (* ************************************************** {2 Computing the FF Separation} @@ -964,7 +1052,8 @@ (FM1,...,FMN_M,GuardM)). 4: Find a positive atom R(tup) with [R \in F] and [tup \in EV], - building a zipper to it. + building a zipper to it. (Preprocessing guarantees that all other + literals are packed into [TProc] during the main loop.) The atom to be pulled out is replaced by T = And[], forming the initial location (context[],[T]). @@ -1077,46 +1166,25 @@ (* build will flatten the formula *) fvs, evs, build false phi -(* Map a prefix of [Left] elements (returned in reverse order) till - the first [Right] element (if any), also return the unmapped tail - of the list. *) -let rev_map_choose f l = - let rec rmap_f accu = function - | [] -> None, accu, [] - | a::tl -> - match f a with - | Left r -> rmap_f (r :: accu) tl - | Right r -> Some r, accu, tl in - rmap_f [] l (* Step 4. Search depth-first since it's simpler, perhaps results in less duplication, and there are no clear advantages of breadth-first. *) -let find_active frels evs t = - let rec aux = function - | {t=TProc _} as subt -> Left subt +let find_active t = + let rec aux ctx = function + | {t=TProc _} -> None | {t=TLit (Rel (rel, vs) as atom)} -> (* is active by constr. *) - Right (atom, {x=Top; n={fvs=Vars.empty; t=TAnd []}}) + Some (atom, {x=ctx; n={fvs=Vars.empty; t=TAnd []}}) | {t=TLit _} -> assert false | {t=TNot_subtask _} -> assert false - | {t=(TAnd js | TOr js) as templ} as tr -> - let loc, lsubts, rsubts = rev_map_choose aux js in - let subts = List.rev_append lsubts rsubts in - (match loc with None -> Left tr - | Some (atom, loc) -> - Right (atom, {loc with x=snap_flat templ (loc.x, subts)})) - | {t=TAll (vs, subt)} as tr -> - (match aux subt with - | Right (atom, loc) -> - Right (atom, {loc with x=AllNode (loc.x, vs)}) - | Left _ -> Left tr) - | {t=TEx (vs, subt)} as tr -> - (match aux subt with - | Right (atom, loc) -> - Right (atom, {loc with x=ExNode (loc.x, vs)}) - | Left _ -> Left tr) in - match aux t with - | Left _ -> None - | Right res -> Some res + | {t=(TAnd js | TOr js) as templ} -> + let build_ctx lsubt rsubt = + snap_flat templ (ctx, List.rev_append lsubt rsubt) in + loc_find_first aux build_ctx js + | {t=TAll (vs, subt)} -> + aux (AllNode (ctx, vs)) subt + | {t=TEx (vs, subt)} -> + aux (ExNode (ctx, vs)) subt in + aux Top t (* Step 5 without the final split (g). *) let rec ffsep_pull loc = @@ -1198,7 +1266,7 @@ let rec loop solved climbed = match climbed with [] -> solved | (atoms, tree)::climbed -> - match find_active frels evs tree with + match find_active tree with | None -> loop ((atoms, tree)::solved) climbed | Some (atom, loc) -> match ffsep_pull loc with Modified: trunk/Toss/Formula/FFTNF.mli =================================================================== --- trunk/Toss/Formula/FFTNF.mli 2010-12-07 00:26:40 UTC (rev 1231) +++ trunk/Toss/Formula/FFTNF.mli 2010-12-07 14:35:28 UTC (rev 1232) @@ -19,13 +19,13 @@ (** Prenex-normal negation normal form of a formula with minimized alternation and preference to start from existential quantification. *) -val p_pn_nnf : Formula.formula -> Formula.formula +val p_pn_nnf : ?do_pnf:bool -> Formula.formula -> Formula.formula (** FF Type Normal Form: a variant of Type Normal Form that promotes literals with older (earlier quantified) variables, and if undecisive, according to the given relation. *) val ff_tnf : - (Formula.formula -> Formula.formula -> bool) + ?force_parsimony:int -> (Formula.formula -> Formula.formula -> bool) -> Formula.formula -> Formula.formula (** Promote relations from the given set. *) Modified: trunk/Toss/Formula/FFTNFTest.ml =================================================================== --- trunk/Toss/Formula/FFTNFTest.ml 2010-12-07 00:26:40 UTC (rev 1231) +++ trunk/Toss/Formula/FFTNFTest.ml 2010-12-07 14:35:28 UTC (rev 1232) @@ -27,12 +27,17 @@ let breakW_expanded = "ex y8 ((W(y8) and ex y7 ((C(y7, y8) and ex y6 ((C(y6, y7) and ex y5 ((C(y5, y6) and ex y4 ((C(y4, y5) and ex y3 ((C(y3, y4) and ex y2 ((C(y2, y3) and ex y1 (C(y1, y2))))))))))))))))" -let winQvwxyz_expanded = "ex z ((Q(z) and (ex y ((R(y, z) and Q(y) and ex x ((R(x, y) and Q(x) and ex w ((R(w, x) and Q(w) and ex v ((R(v, w) and Q(v))))))))) or ex y ((C(y, z) and Q(y) and ex x ((C(x, y) and Q(x) and ex w ((C(w, x) and Q(w) and ex v ((C(v, w) and Q(v))))))))) or ex u ((C(z, u) and ex y ((R(y, u) and Q(y) and ex t ((C(y, t) and ex x ((R(x, t) and Q(x) and ex s ((C(x, s) and ex w ((R(w, s) and Q(w) and ex r ((C(w, r) and ex v ((R(v, r) and Q(v))))))))))))))))) or ex u0 ((C(u0, z) and ex y ((R(y, u0) and Q(y) and ex t0 ((C(t0, y) and ex x ((R(x, t0) and Q(x) and ex s0 ((C(s0, x) and ex w ((R(w, s0) and Q(w) and ex r0 ((C(r0, w) and ex v ((R(v, r0) and Q(v))))))))))))))))))))" +let winQvwxyz_expanded = "ex v ((Q(v) and (ex w ((R(v, w) and Q(w) and ex x ((R(w, x) and Q(x) and ex y ((R(x, y) and Q(y) and ex z ((R(y, z) and Q(z))))))))) or ex w ((C(v, w) and Q(w) and ex x ((C(w, x) and Q(x) and ex y ((C(x, y) and Q(y) and ex z ((C(y, z) and Q(z))))))))) or ex r0 ((R(v, r0) and ex w ((C(r0, w) and Q(w) and ex s0 ((R(w, s0) and ex x ((C(s0, x) and Q(x) and ex t0 ((R(x, t0) and ex y ((C(t0, y) and Q(y) and ex u0 ((R(y, u0) and ex z ((C(u0, z) and Q(z))))))))))))))))) or ex r ((R(v, r) and ex w ((C(w, r) and Q(w) and ex s ((R(w, s) and ex x ((C(x, s) and Q(x) and ex t ((R(x, t) and ex y ((C(y, t) and Q(y) and ex u ((R(y, u) and ex z ((C(z, u) and Q(z))))))))))))))))))))" +(* Alpha-conversion of the above. *) +let winQvwxyz_idempotent = "ex v ((Q(v) and (ex w2 ((R(v, w2) and Q(w2) and ex x2 ((R(w2, x2) and Q(x2) and ex y2 ((R(x2, y2) and Q(y2) and ex z2 ((R(y2, z2) and Q(z2))))))))) or ex w1 ((C(v, w1) and Q(w1) and ex x1 ((C(w1, x1) and Q(x1) and ex y1 ((C(x1, y1) and Q(y1) and ex z1 ((C(y1, z1) and Q(z1))))))))) or ex r0 ((R(v, r0) and ex w0 ((C(r0, w0) and Q(w0) and ex s0 ((R(w0, s0) and ex x0 ((C(s0, x0) and Q(x0) and ex t0 ((R(x0, t0) and ex y0 ((C(t0, y0) and Q(y0) and ex u0 ((R(y0, u0) and ex z0 ((C(u0, z0) and Q(z0))))))))))))))))) or ex r ((R(v, r) and ex w ((C(w, r) and Q(w) and ex s ((R(w, s) and ex x ((C(x, s) and Q(x) and ex t ((R(x, t) and ex y ((C(y, t) and Q(y) and ex u ((R(y, u) and ex z ((C(z, u) and Q(z))))))))))))))))))))" + let formula_of_guards frels phi = let guards = FFTNF.ffsep frels phi in let parts = List.map (fun (avs, atoms, guard) -> - Formula.Ex ((avs :> Formula.var list), Formula.And (atoms @ [guard])) + if avs = [] then Formula.And (atoms @ [guard]) + else + Formula.Ex ((avs :> Formula.var list), Formula.And (atoms @ [guard])) ) guards in match parts with | [hd] -> hd @@ -89,25 +94,55 @@ (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (Formula.And [])); - (* actual P / Q order doesn't matter much, though I expected it - would not be inverted... *) assert_equal ~printer:(fun x->x) - "(Q(y) and P(x) and R(x, y))" + "(P(x) and Q(y) and R(x, y))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (formula_of_str "R(x, y) and P(x) and Q(y)"))); ); + + "ffsep: simple formulas" >:: + (fun () -> + assert_equal ~printer:(fun x->x) + "true" + (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) + (Formula.And []))); + + assert_equal ~printer:(fun x->x) + "(P(x) and Q(y) and R(x, y))" + (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) + (formula_of_str "R(x, y) and P(x) and Q(y)"))); + + ); + + "ff_tnf: tic-tac-toe" >:: (fun () -> + (* R(x, y) comes before Q(y) etc. because x is an older + variable in the result. *) assert_equal ~printer:(fun x->x) - "ex z ((Q(z) and (ex y ((R(y, z) and Q(y) and ex x ((R(x, y) and Q(x))))) or ex y ((C(y, z) and Q(y) and ex x ((C(x, y) and Q(x))))) or ex u ((C(z, u) and ex y ((R(y, u) and Q(y) and ex v ((C(y, v) and ex x ((R(x, v) and Q(x))))))))) or ex u0 ((C(u0, z) and ex y ((R(y, u0) and Q(y) and ex v0 ((C(v0, y) and ex x ((R(x, v0) and Q(x))))))))))))" + "ex x ((Q(x) and (ex y ((R(x, y) and Q(y) and ex z ((R(y, z) and Q(z))))) or ex y ((C(x, y) and Q(y) and ex z ((C(y, z) and Q(z))))) or ex v0 ((R(x, v0) and ex y ((C(v0, y) and Q(y) and ex u0 ((R(y, u0) and ex z ((C(u0, z) and Q(z))))))))) or ex v ((R(x, v) and ex y ((C(y, v) and Q(y) and ex u ((R(y, u) and ex z ((C(z, u) and Q(z))))))))))))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (formula_of_str winQxyz))); ); + "ffsep: tic-tac-toe" >:: + (fun () -> + assert_equal ~printer:(fun x->x) ~msg:"simple idempotence" + winQzyx + (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) + (formula_of_str winQzyx))); + + assert_equal ~printer:(fun x->x) ~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)))))" + (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) + (formula_of_str "ex z ((Q(z) and (ex y ((C(y, z) and Q(y) and ex x ((C(x, y) and Q(x))))) or ex y ((R(y, z) and Q(y) and ex x ((R(x, y) and Q(x))))) or ex u ((C(z, u) and ex y ((R(y, u) and Q(y) and ex v ((C(y, v) and ex x ((R(x, v) and Q(x))))))))) or ex u0 ((C(u0, z) and ex y ((R(y, u0) and Q(y) and ex v0 ((C(v0, y) and ex x ((R(x, v0) and Q(x))))))))))))"))); + ); + + "ff_tnf: breakthrough" >:: (fun () -> assert_equal ~printer:(fun x->x) @@ -135,57 +170,95 @@ (formula_of_str winQvwxyz))); ); - "ffsep: tic-tac-toe" >:: + "ff_tnf: idempotent gomoku" >:: (fun () -> - assert_equal ~printer:(fun x->x) ~msg:"simple idempotence" - winQzyx - (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) - (formula_of_str winQzyx))); - - assert_equal ~printer:(fun x->x) ~msg:"reversing ff_tnf" - "(ex z, y, x ((Q(z) and Q(y) and Q(x) and (ex v0 ((ex u0 (ex u ((ex v ((R(x, v) and C(y, v))) and R(y, u) and C(z, u)))) and C(u0, z) and R(y, u0))) and C(v0, y) and R(x, v0)))) or ex z, y, x ((Q(z) and Q(y) and Q(x) and (ex v ((ex u ((R(x, y) and R(y, z))) and C(z, u) and R(y, u))) and C(y, v) and R(x, v)))) or ex z, y, x ((Q(z) and Q(y) and Q(x) and (C(x, y) and C(y, z) and R(y, z) and R(x, y)))) or ex z, y, x ((Q(z) and Q(y) and Q(x) and (C(y, z) and C(x, y)))))" - (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) - (formula_of_str "ex z ((Q(z) and (ex y ((C(y, z) and Q(y) and ex x ((C(x, y) and Q(x))))) or ex y ((R(y, z) and Q(y) and ex x ((R(x, y) and Q(x))))) or ex u ((C(z, u) and ex y ((R(y, u) and Q(y) and ex v ((C(y, v) and ex x ((R(x, v) and Q(x))))))))) or ex u0 ((C(u0, z) and ex y ((R(y, u0) and Q(y) and ex v0 ((C(v0, y) and ex x ((R(x, v0) and Q(x))))))))))))"))); + assert_equal ~printer:(fun x->x) + winQvwxyz_idempotent + (Formula.str (FFTNF.ff_tnf + (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) + (formula_of_str winQvwxyz_idempotent))); ); - "ff_tnf: deep" >:: (fun () -> - (* FFTNF.debug_level := 7; *) - assert_equal ~printer:(fun x->x) - "ex z (((not Q(z)) and (ex x, y ((not R(x, y))) or ex y ((C(y, z) and ex x (P(x)))))))" + (* pulling out P first breaks the disjunction *) + assert_equal ~printer:(fun x->x) ~msg:"#1" + "(ex z (((not Q(z)) and ex x, y ((not R(x, y))))) or ex x ((P(x) and ex z (((not Q(z)) and ex y (C(y, z)))))))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (formula_of_str "ex x, y, z ((not R(x,y) or (P(x) and C(y,z))) and not Q(z))"))); - assert_equal ~printer:(fun x->x) - "ex z (((not Q(z)) and (ex x, y ((not R(x, y))) or ex y (((not C(y, z)) and ex x ((not P(x))))))))" + assert_equal ~printer:(fun x->x) ~msg:"#1.5" + "ex z (((not Q(z)) and (ex y ((C(y, z) and ex x (P(x)))) or ex x, y ((not R(x, y))))))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) + (formula_of_str "ex x, y, z (not Q(z) and (not R(x,y) or (P(x) and C(y,z))))"))); + + assert_equal ~printer:(fun x->x) ~msg:"#2" + "(ex z (((not Q(z)) and ex x, y ((not R(x, y))))) or ex x (((not P(x)) and ex z (((not Q(z)) and ex y ((not C(y, z))))))))" + (Formula.str (FFTNF.ff_tnf + (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (formula_of_str "ex x, y, z not ((R(x,y) and (P(x) or C(y,z))) or Q(z))"))); - assert_equal ~printer:(fun x->x) - "ex z ((Q(z) or ex x ((P(x) and ex y (R(x, y)))) or ex y ((C(y, z) and ex x (R(x, y))))))" + assert_equal ~printer:(fun x->x) ~msg:"#2.5" + "ex z (((not Q(z)) and (ex y (((not C(y, z)) and ex x ((not P(x))))) or ex x, y ((not R(x, y))))))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) + (formula_of_str "ex x, y, z not (Q(z) or (R(x,y) and (P(x) or C(y,z))))"))); + + assert_equal ~printer:(fun x->x) ~msg:"#3" + "(ex x ((P(x) and ex y (R(x, y)))) or ex z ((Q(z) or ex y ((C(y, z) and ex x (R(x, y)))))))" + (Formula.str (FFTNF.ff_tnf + (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (formula_of_str "ex x, y, z ((R(x,y) and (P(x) or C(y,z))) or Q(z))"))); - assert_equal ~printer:(fun x->x) - "(ex z ((Q(z) and ex x (C(x, z)))) or ex x ((P(x) and ex y ((R(x, y) and ex z (C(x, z)))))) or ex x, y ((R(x, y) and ex z ((C(x, z) and C(y, z))))))" + assert_equal ~printer:(fun x->x) ~msg:"#4" + "(ex z ((Q(z) and ex x (C(x, z)))) or ex x ((P(x) and ex y ((R(x, y) and ex z (C(x, z)))))) or ex y, z ((C(y, z) and ex x ((C(x, z) and R(x, y))))))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (formula_of_str "ex x, y, z (C(x, z) and ((R(x,y) and (P(x) or C(y,z))) or Q(z)))"))); ); + "ffsep: deep" >:: + (fun () -> + (* only pulls out positive fluents *) + assert_equal ~printer:(fun x->x) ~msg:"#1" + "(ex y, z (((not R(x, y)) and (not Q(z)))) or ex x ((P(x) and ex y, z ((C(y, z) and (not Q(z)))))))" + (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) + (formula_of_str "ex x, y, z ((not R(x,y) or (P(x) and C(y,z))) and not Q(z))"))); + + assert_equal ~printer:(fun x->x) ~msg:"#2" + "ex z ((Q(z) and ex x, y ((not (R(x, y) and (P(x) or C(y, z)))))))" + (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) + (formula_of_str "ex x, y, z not ((R(x,y) and (P(x) or C(y,z))) or not Q(z))"))); + + (* TODO? simplify the result *) + assert_equal ~printer:(fun x->x) ~msg:"#3" + "(ex y ((C(y, z) and R(x, y))) or ex z ((Q(z) and ex y (true))) or ex x ((P(x) and ex y (R(x, y)))))" + (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) + (formula_of_str "ex x, y, z ((R(x,y) and (P(x) or C(y,z))) or Q(z))"))); + + assert_equal ~printer:(fun x->x) ~msg:"#4" + "(ex y ((C(y, z) and R(x, y) and C(x, z))) or ex z ((Q(z) and ex y (C(x, z)))) or ex x ((P(x) and ex y ((R(x, y) and C(x, z))))))" + (Formula.str (formula_of_guards (Aux.strings_of_list ["P"; "Q"]) + (formula_of_str "ex x, y, z (C(x, z) and ((R(x,y) and (P(x) or C(y,z))) or Q(z)))"))); + ); + "ff_tnf: simple subtasks" >:: (fun () -> - assert_equal ~printer:(fun x->x) - "(not ex z (((not Q(z)) and (ex x, y ((not R(x, y))) or ex y (((not C(y, z)) and ex x ((not P(x)))))))))" + assert_equal ~printer:(fun x->x) ~msg:"#1" + "(not (ex z (((not Q(z)) and ex x, y ((not R(x, y))))) or ex x (((not P(x)) and ex z (((not Q(z)) and ex y ((not C(y, z)))))))))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (formula_of_str "all x, y, z ((R(x,y) and (P(x) or C(y,z))) or Q(z))"))); - assert_equal ~printer:(fun x->x) + assert_equal ~printer:(fun x->x) ~msg:"#1.5" + "(not ex z (((not Q(z)) and (ex y (((not C(y, z)) and ex x ((not P(x))))) or ex x, y ((not R(x, y)))))))" + (Formula.str (FFTNF.ff_tnf + (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) + (formula_of_str "all x, y, z (Q(z) or (R(x,y) and (P(x) or C(y,z))))"))); + + assert_equal ~printer:(fun x->x) ~msg:"#2" "(((not ex z ((not Q(z)))) and ex y (P(y))) or ex x, y (C(x, y)))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) @@ -204,7 +277,7 @@ and C(t, y))) or ex t, u ((C(z, u) and R(y, u) and C(y, t) and R(x, t)))) and P(z) and P(y) and P(x)))))" in assert_equal ~printer:(fun x->x) - "((not ex x ((P(x) and (ex y ((C(x, y) and P(y) and ex z ((C(y, z) and P(z))))) or ex y ((R(x, y) and P(y) and ex z ((R(y, z) and P(z))))) or ex t ((R(x, t) and ex y ((C(y, t) and P(y) and ex u ((R(y, u) and ex z ((C(z, u) and P(z))))))))) or ex t0 ((R(x, t0) and ex y ((C(t0, y) and P(y) and ex u0 ((R(y, u0) and ex z ((C(u0, z) and P(z))))))))))))) and (not P(x)) and (not P(z)) and (not P(y)) and ((R(y, z) and R(x, y)) or (C(y, z) and C(x, y)) or ex t ((C(t, y) and R(x, t) and ex u ((R(y, u) and C(u, z))))) or ex t0 ((R(x, t0) and C(y, t0) and ex u0 ((C(z, u0) and R(y, u0)))))) and (Q(x) or Q(z) or Q(y)))" + "((not ex z ((P(z) and (ex y ((C(y, z) and P(y) and ex x ((C(x, y) and P(x))))) or ex y ((R(y, z) and P(y) and ex x ((R(x, y) and P(x))))) or ex u0 ((C(u0, z) and ex y ((R(y, u0) and P(y) and ex t0 ((C(t0, y) and ex x ((R(x, t0) and P(x))))))))) or ex u ((C(z, u) and ex y ((R(y, u) and P(y) and ex t ((C(y, t) and ex x ((R(x, t) and P(x))))))))))))) and (not P(x)) and (not P(y)) and (not P(z)) and ((R(x, y) and R(y, z)) or (C(x, y) and C(y, z)) or ex u0 ((C(z, u0) and R(y, u0) and ex t0 ((C(y, t0) and R(x, t0))))) or ex u ((R(y, u) and C(u, z) and ex t ((R(x, t) and C(t, y)))))) and (Q(z) or Q(y) or Q(x)))" (Formula.str (FFTNF.ff_tnf (FFTNF.promote_rels (Aux.strings_of_list ["P"; "Q"])) (formula_of_str heur_phi))); @@ -214,3 +287,12 @@ let a = Aux.run_test_if_target "FFTNFTest" tests + +let a () = FFTNF.debug_level := 7 + +let a () = + match test_filter ["FFTNF:6:ff_tnf: breakthrough"] + tests + with + | Some tests -> ignore (run_test_tt ~verbose:true tests) + | None -> () Modified: trunk/Toss/Formula/FormulaOps.ml =================================================================== --- trunk/Toss/Formula/FormulaOps.ml 2010-12-07 00:26:40 UTC (rev 1231) +++ trunk/Toss/Formula/FormulaOps.ml 2010-12-07 14:35:28 UTC (rev 1232) @@ -626,8 +626,13 @@ | Ex (vs, phi) -> Ex (vs, flatten_formula phi) | Not phi -> Not (flatten_formula phi) | (Rel _ | Eq _ | In _ | RealExpr _) as atom -> atom - +(* Compute size of a formula (currently w/o descending the real part). *) +let rec size = function + | Or js | And js -> List.fold_left (+) 1 (List.map size js) + | All (_, phi) | Ex (_, phi) | Not phi -> size phi + 1 + | Rel _ | Eq _ | In _ | RealExpr _ -> 1 + (* -------------------------- TYPE NORMAL FORM ----------------------------- *) Modified: trunk/Toss/Formula/FormulaOps.mli =================================================================== --- trunk/Toss/Formula/FormulaOps.mli 2010-12-07 00:26:40 UTC (rev 1231) +++ trunk/Toss/Formula/FormulaOps.mli 2010-12-07 14:35:28 UTC (rev 1232) @@ -74,6 +74,8 @@ (** Flatten "and"s and "or"s in a formula -- i.e. associativity. *) val flatten_formula : formula -> formula +(** Compute size of a formula (currently w/o descending the real part). *) +val size : formula -> int (** {2 TNF} *) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-07 00:26:46
|
Revision: 1231 http://toss.svn.sourceforge.net/toss/?rev=1231&view=rev Author: lukaszkaiser Date: 2010-12-07 00:26:40 +0000 (Tue, 07 Dec 2010) Log Message: ----------- Correct bounce, add debugging info. Modified Paths: -------------- trunk/Toss/Arena/ContinuousRule.ml trunk/Toss/Arena/DiscreteRule.ml trunk/Toss/examples/bounce.toss Modified: trunk/Toss/Arena/ContinuousRule.ml =================================================================== --- trunk/Toss/Arena/ContinuousRule.ml 2010-12-06 22:12:51 UTC (rev 1230) +++ trunk/Toss/Arena/ContinuousRule.ml 2010-12-07 00:26:40 UTC (rev 1231) @@ -4,7 +4,9 @@ let get_time_step () = !time_step let set_time_step x = (time_step := x) +let debug_level = ref 0; + (* ---------------- BASIC TYPE DEFINITION AND CONSTRUCTOR ------------------- *) (* Specification of a continuous rewriting rule, as in modelling document. *) @@ -82,6 +84,7 @@ (* For now, we rewrite only single rules. Does not check postcondition. *) let rewrite_single_nocheck struc cur_time m r t params = let time = ref cur_time in + if !debug_level > 1 then print_endline ("ct: " ^ (string_of_float !time)); let left_elname le = Structure.elem_str r.discrete.DiscreteRule.lhs_struc le in let subst_params tm = @@ -108,6 +111,7 @@ let cur_vals = ref init_vals in let all_vals = ref [] in let end_time = !time +. t -. (0.01 *. !time_step) in (*TODO: 1% is decimals!*) + if !debug_level > 1 then print_endline ("et: " ^ (string_of_float end_time)); let is_inv s = Solver.M.check_formula s r.inv_pp in let lhs_to_model ((f, a), _) = (* dynamics refer to elements by LHS matches *) @@ -129,8 +133,14 @@ if (is_inv !cur_struc) then ( all_vals := !cur_vals :: !all_vals ; last_struc := !cur_struc - ) else - cur_vals := List.hd !all_vals ; + ) else ( + if (!debug_level > 1) then ( + print_endline "Invariant failed."; + print_endline (Structure.str !cur_struc); + print_endline (Formula.sprint r.inv); + ) ; + cur_vals := List.hd !all_vals; + ) ; let lhs_to_model_str x = let (f, i) = lhs_to_model x in f, Structure.elem_str struc i in Modified: trunk/Toss/Arena/DiscreteRule.ml =================================================================== --- trunk/Toss/Arena/DiscreteRule.ml 2010-12-06 22:12:51 UTC (rev 1230) +++ trunk/Toss/Arena/DiscreteRule.ml 2010-12-07 00:26:40 UTC (rev 1231) @@ -458,12 +458,16 @@ check invariants nor postconditions. *) let rewrite_single model (matching : matching) rule_obj : Structure.structure = - let ldmap = - try - List.map (fun (l,d)-> - SIMap.find l rule_obj.lhs_elem_inv_names, d) matching - with _ -> - failwith "rewrite_single: rule_obj inconsistent with matching" in + let find_fst_name simap (name, x) = + try (SIMap.find name simap, x) with Not_found -> + let mtch_str (a, b) = (string_of_int a) ^ " <- " ^ (string_of_int b) in + let m_s = "{ "^ String.concat ", " (List.map mtch_str matching) ^ " }" in + let bd_add_str a b acc = acc ^ ", " ^ (string_of_int a) ^ ": " ^ b in + let map_s = SIMap.fold bd_add_str simap "" in + let general_s = "rewrite_single: rule_obj inconsistent with matching " in + let name_s = string_of_int name in + failwith (general_s ^ m_s ^"; missing "^ name_s ^ " in: "^ map_s ^ ".") in + let ldmap = List.map (find_fst_name rule_obj.lhs_elem_inv_names) matching in rewrite_single_aux model ldmap rule_obj Modified: trunk/Toss/examples/bounce.toss =================================================================== --- trunk/Toss/examples/bounce.toss 2010-12-06 22:12:51 UTC (rev 1230) +++ trunk/Toss/examples/bounce.toss 2010-12-07 00:26:40 UTC (rev 1231) @@ -14,7 +14,7 @@ y(1) = y(1); x(1) = x(1) pre true - inv ex x ((lhs_1(x) and ((((:y(x) + (-1. * 0.)) + + inv ex x ((_lhs_1(x) and ((((:y(x) + (-1. * 0.)) + (-1. * 0.)) + (-1. * 0.)) < 0))) post true LOC 0 { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-06 22:12:57
|
Revision: 1230 http://toss.svn.sourceforge.net/toss/?rev=1230&view=rev Author: lukaszkaiser Date: 2010-12-06 22:12:51 +0000 (Mon, 06 Dec 2010) Log Message: ----------- Examples moved to current syntax. Modified Paths: -------------- trunk/Toss/examples/bounce.toss trunk/Toss/examples/rewriting_example.toss Modified: trunk/Toss/examples/bounce.toss =================================================================== --- trunk/Toss/examples/bounce.toss 2010-12-06 00:46:05 UTC (rev 1229) +++ trunk/Toss/examples/bounce.toss 2010-12-06 22:12:51 UTC (rev 1230) @@ -1,12 +1,31 @@ -1: [ 1 | | vx { 1->0. }; vy { 1->0. }; x { 1->-11. }; y { 1->-60.5 } ] -> [ 1 | | vx { 1->0. }; vy { 1->0. }; x { 1->-14.3 }; y { 1->-34.1 } ] with 1 <- 1 -dynamics - vy(1)' = 50.; - vx(1)' = 0.; - y(1)' = vy(1); - x(1)' = vx(1) -update - vy(1) = (-1.)*(vy(1)); - vx(1) = vx(1); - y(1) = y(1); - x(1) = x(1) - pre true inv ex x ((lhs_1(x) and ((((:y(x) + (-1. * 0.)) + (-1. * 0.)) + (-1. * 0.)) < 0))) post true; < 0 : PAYOFF 1: 0.; 0: 0. MOVES [1, t: 3. -- 3. -> 0] >; [ 1, 2, 3 | G { (2, 3); (3, 2) } | vx { 1->0., 2->0., 3->0. }; vy { 1->27., 2->0., 3->0. }; x { 1->-140., 2->-160., 3->-120. }; y { 1->-40.2673662018, 2->3.5, 3->3.5 } ]; 0.; 0; r1: none; G: 2 +PLAYERS 1, 2 +RULE Move: + [ 1 | | vx { 1->0. }; vy { 1->0. }; x { 1->-11. }; y { 1->-60.5 } ] + -> + [ 1 | | vx { 1->0. }; vy { 1->0. }; x { 1->-14.3 }; y { 1->-34.1 } ] + dynamics + vy(1)' = 50.; + vx(1)' = 0.; + y(1)' = vy(1); + x(1)' = vx(1) + update + vy(1) = (-1.)*(vy(1)); + vx(1) = vx(1); + y(1) = y(1); + x(1) = x(1) + pre true + inv ex x ((lhs_1(x) and ((((:y(x) + (-1. * 0.)) + + (-1. * 0.)) + (-1. * 0.)) < 0))) + post true +LOC 0 { + PLAYER 1 + PAYOFF { + 1: 0.; + 2: 0. + } + MOVES + [Move, t: 3. -- 3. -> 0] +} +MODEL [ 1, 2, 3 | G { (2, 3); (3, 2) } | + vx { 1->0., 2->0., 3->0. }; vy { 1->27., 2->0., 3->0. }; + x { 1->-140., 2->-160., 3->-120. }; y { 1->-40.2673662018, 2->3.5, 3->3.5 } ] Modified: trunk/Toss/examples/rewriting_example.toss =================================================================== --- trunk/Toss/examples/rewriting_example.toss 2010-12-06 00:46:05 UTC (rev 1229) +++ trunk/Toss/examples/rewriting_example.toss 2010-12-06 22:12:51 UTC (rev 1230) @@ -1,28 +1,51 @@ -1: [ 1, 2 | R { (1, 2) } | vx { 1->0., 2->0. }; vy { 1->0., 2->0. }; x { 1->-56.1, 2->12.1 }; y { 1->-19.8, 2->-16.5 } ] -> [ 1, 2, 3, 4 | R { (2, 4) }; S { (2, 1); (2, 3) } | vx { 1->0., 2->0., 3->0., 4->0. }; vy { 1->0., 2->0., 3->0., 4->0. }; x { 1->-53.9, 2->-13.2, 3->24.2, 4->-15.4 }; y { 1->-28.6, 2->-30.8, 3->-29.7, 4->14.3 } ] emb R with 3 <- 2, 2 <- 2, 1 <- 1 -dynamics - vy(2)' = 0.; - vy(1)' = 0.; - vx(2)' = 0.; - vx(1)' = 0.; - y(2)' = 0.; - y(1)' = 0.; - x(2)' = 0.; - x(1)' = 0. -update - vy(4) = 0.; - vy(3) = 0.; - vy(2) = 0.; - vy(1) = 0.; - vx(4) = 0.; - vx(3) = 0.; - vx(2) = 0.; - vx(1) = 0.; - y(4) = (0.5)*(y(2)); - y(3) = y(2); - y(2) = y(2); - y(1) = y(1); - x(4) = x(2); - x(3) = ((2.)*(x(2))) + ((-1.)*(x(1))); - x(2) = x(2); - x(1) = x(1) - pre true inv true post true; < 0 : 0 PAYOFF 1: 0.; 0: 0. MOVES [1, t: 1. -- 1. -> 0] >; [ 1, 2, 3, 4, 5, 6, 7, 9, 10, 11 | R { (1, 2) }; S { (1, 4); (1, 11); (2, 6); (2, 10); (3, 1); (5, 2); (7, 1); (9, 2) } | vx { 1->0., 2->0., 3->0., 4->0., 5->0., 6->0., 7->0., 9->0., 10->0., 11->0. }; vy { 1->0., 2->0., 3->0., 4->0., 5->0., 6->0., 7->0., 9->0., 10->0., 11->0. }; x { 1->-146.255462055, 2->21.302749004, 3->-258.32323745, 4->-120.686436849, 5->-18.5442846716, 6->90.6508710148, 7->-232.262151394, 9->-9.62456175299, 10->103.945266932, 11->-125.119302789 }; y { 1->-198.131474104, 2->-199.490916335, 3->-389.602259761, 4->-388.668637651, 5->-373.881488196, 6->-383.007253961, 7->-11.1358565737, 9->-40.4231593625, 10->-39.0902989992, 11->-22.4325180255 } ]; 0.; 0; r1: none; S: 2, R: 2 \ No newline at end of file +PLAYERS 1, 2 +RULE Rewrite: + [ 1, 2 | R { (1, 2) } | + vx { 1->0., 2->0. }; vy { 1->0., 2->0. }; + x { 1->-56.1, 2->12.1 }; y { 1->-19.8, 2->-16.5 } ] + -> + [ 1, 2, 3, 4 | R { (2, 4) }; S { (2, 1); (2, 3) } | + vx { 1->0., 2->0., 3->0., 4->0. }; vy { 1->0., 2->0., 3->0., 4->0. }; + x { 1->-53.9, 2->-13.2, 3->24.2, 4->-15.4 }; + y { 1->-28.6, 2->-30.8, 3->-29.7, 4->14.3 } ] + emb R with [ 3 <- 2, 2 <- 2, 1 <- 1 ] + dynamics + vy(2)' = 0.; + vy(1)' = 0.; + vx(2)' = 0.; + vx(1)' = 0.; + y(2)' = 0.; + y(1)' = 0.; + x(2)' = 0.; + x(1)' = 0. + update + vy(4) = 0.; + vy(3) = 0.; + vy(2) = 0.; + vy(1) = 0.; + vx(4) = 0.; + vx(3) = 0.; + vx(2) = 0.; + vx(1) = 0.; + y(4) = (0.5)*(y(2)); + y(3) = y(2); + y(2) = y(2); + y(1) = y(1); + x(4) = x(2); + x(3) = ((2.)*(x(2))) + ((-1.)*(x(1))); + x(2) = x(2); + x(1) = x(1) + pre true inv true post true + LOC 0 { + PLAYER 1 + PAYOFF { + 1: 0.; + 2: 0. + } + MOVES + [Rewrite, t: 1. -- 1. -> 0] + } +MODEL + [ 1, 2, 3, 4, 5, 6, 7, 9, 10, 11 | + R { (1, 2) }; S { (1, 4); (1, 11); (2, 6); (2, 10); (3, 1); (5, 2); (7, 1); (9, 2) } | + vx { 1->0., 2->0., 3->0., 4->0., 5->0., 6->0., 7->0., 9->0., 10->0., 11->0. }; vy { 1->0., 2->0., 3->0., 4->0., 5->0., 6->0., 7->0., 9->0., 10->0., 11->0. }; x { 1->-146.255462055, 2->21.302749004, 3->-258.32323745, 4->-120.686436849, 5->-18.5442846716, 6->90.6508710148, 7->-232.262151394, 9->-9.62456175299, 10->103.945266932, 11->-125.119302789 }; y { 1->-198.131474104, 2->-199.490916335, 3->-389.602259761, 4->-388.668637651, 5->-373.881488196, 6->-383.007253961, 7->-11.1358565737, 9->-40.4231593625, 10->-39.0902989992, 11->-22.4325180255 } ] This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-06 00:46:11
|
Revision: 1229 http://toss.svn.sourceforge.net/toss/?rev=1229&view=rev Author: lukstafi Date: 2010-12-06 00:46:05 +0000 (Mon, 06 Dec 2010) Log Message: ----------- Modified shortcut selection for board predicates (fixed single-character case). Revert to test suite in GameTest. Modified Paths: -------------- trunk/Toss/Play/GameTest.ml trunk/Toss/Solver/Structure.ml trunk/Toss/Solver/StructureTest.ml Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-06 00:34:31 UTC (rev 1228) +++ trunk/Toss/Play/GameTest.ml 2010-12-06 00:46:05 UTC (rev 1229) @@ -565,7 +565,7 @@ "play: chess suggest first move" >:: (fun () -> - (* todo "Payoff too difficult for heuristic generation."; *) + todo "Payoff too difficult for heuristic generation."; let state = chess_game in Game.set_debug_level 7; Heuristic.debug_level := 7; @@ -1093,14 +1093,14 @@ ); ] -let a () = +let a = Aux.run_test_if_target "GameTest" tests let a () = run_test_tt ~verbose:true experiments (* The same content as in .toss files. *) -let a = +let a () = print_endline ("\n" ^ Arena.sprint_state (snd chess_game)) let a () = Modified: trunk/Toss/Solver/Structure.ml =================================================================== --- trunk/Toss/Solver/Structure.ml 2010-12-06 00:34:31 UTC (rev 1228) +++ trunk/Toss/Solver/Structure.ml 2010-12-06 00:46:05 UTC (rev 1229) @@ -544,10 +544,13 @@ - when there is no element in a position, the upper line is changed to " " and the lower line to "* " - - the predicates on an element are expressed using the least - amount of chars and the parsing/printing rules and written over - the default lower, then upper, line, remaining predicates are - stored to print separately + - the predicates on an element longer than one character are + expressed using two characters for relations with unique two + character prefix, and using three characters for unique three + character prefix (but 3 chars only for cases without + modifiers), and the parsing/printing rules, and written over the + default lower, then upper, line, remaining predicates are stored + to print separately - the row and column relations are determined such that they hold for all (existing) elements as required (they need not be @@ -569,25 +572,17 @@ (* Ignore special relations. *) let find_unique all_preds = - (* FIXME: don't force prefix-free *) let all_preds = List.filter (fun r -> r.[0] <> '_') all_preds in (* build a fixed depth trie *) + let uniq1, more_preds = + List.partition (fun r -> String.length r = 1) all_preds in + let uniq1 = List.map (fun p -> p,p) uniq1 in let trie1 = List.fold_left (fun trie pred -> if List.mem_assoc pred.[0] trie then let preds, trie = Aux.pop_assoc pred.[0] trie in (pred.[0], pred::preds)::trie else (pred.[0], [pred])::trie - ) [] all_preds in - let trie1 = List.map (fun (k,preds) -> - let trunc = - List.filter (fun r -> String.length r = 1) preds in - if trunc = [] then k, preds else k, trunc) trie1 in - let uniq1, trie1 = Aux.partition_map - (function (k,[pred]) -> Aux.Left (pred, Char.escaped k) - | subt -> Aux.Right subt) trie1 in - let trie1 = List.map - (fun (k, preds) -> k, List.filter - (fun pred -> String.length pred > 1) preds) trie1 in + ) [] more_preds in let trie2 = Aux.concat_map (fun (key, preds) -> let trie2 = @@ -600,13 +595,11 @@ List.map (fun (key2, preds) -> Char.escaped key ^ Char.escaped key2, preds) trie2 ) trie1 in - let trie2 = List.map (fun (k,preds) -> - let trunc = - List.filter (fun r -> String.length r = 2) preds in - if trunc = [] then k, preds else k, trunc) trie2 in let uniq2, trie2 = Aux.partition_map (function (k,[pred]) -> Aux.Left (pred, k) | subt -> Aux.Right subt) trie2 in + (* deliberately losing two-char long predicates that are not + prefix-unique: they might be confusing *) let trie2 = List.map (fun (k, preds) -> k, List.filter (fun pred -> String.length pred > 2) preds) trie2 in Modified: trunk/Toss/Solver/StructureTest.ml =================================================================== --- trunk/Toss/Solver/StructureTest.ml 2010-12-06 00:34:31 UTC (rev 1228) +++ trunk/Toss/Solver/StructureTest.ml 2010-12-06 00:46:05 UTC (rev 1229) @@ -221,10 +221,25 @@ test_parse ~msg:"Unique by 1 character" "[ | Alpha:1 {}; Beta:1 {} | ] \" - A B + Al Be + Al + . Be +\""; + (* "A" not in signature, because its name is recoverable from board *) + test_parse ~msg:"Single character + unique by 1 character" +"[ | Alpha:1 {}; Beta:1 {} | ] \" + + Al Be A - . B + . Be \""; + test_parse ~msg:"Single character + unique by 2 characters" +"[ | Alpha:1 {}; Ampr:1 {} | ] \" + + Al Am + A + . Am +\""; test_parse ~msg:"Unique by 3 characters" "[ | Aleph:1 {}; Alpha:1 {} | ] \" @@ -240,16 +255,16 @@ test_parse ~msg:"3 predicates" "[ | Alpha:1 {}; Beta:1 {}; Gamma:1 {} | ] \" - ? ?B + ? ?Be - #A B? + #AlBe? \""; test_parse ~msg:"2 predicates" "[ | Alpha:1 {}; Beta:1 {} | ] \" - ? ?B + ? ?Be - #A B? + #AlBe? \""; ); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-06 00:34:39
|
Revision: 1228 http://toss.svn.sourceforge.net/toss/?rev=1228&view=rev Author: lukaszkaiser Date: 2010-12-06 00:34:31 +0000 (Mon, 06 Dec 2010) Log Message: ----------- Documentation corrections, removing SolverIntf. Modified Paths: -------------- trunk/Toss/Arena/Arena.ml trunk/Toss/Arena/Arena.mli trunk/Toss/Arena/ContinuousRule.ml trunk/Toss/Arena/ContinuousRule.mli trunk/Toss/Arena/DiscreteRule.ml trunk/Toss/Arena/DiscreteRule.mli trunk/Toss/Arena/DiscreteRuleTest.ml trunk/Toss/Arena/Term.mli trunk/Toss/Formula/BoolFormula.ml trunk/Toss/Formula/BoolFormula.mli trunk/Toss/Formula/Formula.mli trunk/Toss/Formula/FormulaOps.mli trunk/Toss/Play/Game.ml trunk/Toss/Play/GameTest.ml trunk/Toss/Play/Heuristic.ml trunk/Toss/Solver/AssignmentSet.mli trunk/Toss/Solver/Assignments.mli trunk/Toss/Solver/Class.mli trunk/Toss/Solver/Solver.ml trunk/Toss/Solver/Solver.mli trunk/Toss/Toss.odocl Removed Paths: ------------- trunk/Toss/Solver/SolverIntf.ml trunk/Toss/Solver/SolverIntf.mli Modified: trunk/Toss/Arena/Arena.ml =================================================================== --- trunk/Toss/Arena/Arena.ml 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Arena/Arena.ml 2010-12-06 00:34:31 UTC (rev 1228) @@ -22,7 +22,7 @@ id : int ; player : int ; payoffs : Formula.real_expr array ; - payoffs_pp : SolverIntf.M.registered_real_expr array ; + payoffs_pp : Solver.M.registered_real_expr array ; moves : (label * int) list ; } @@ -33,7 +33,7 @@ num_players : int; player_names : (string * int) list ; defined_rels : (string * (string list * Formula.formula * - SolverIntf.M.registered_formula)) list ; + Solver.M.registered_formula)) list ; } (* State of the game and additional information. *) @@ -54,7 +54,7 @@ graph=Array.make 1 { id = 0; player = 0; payoffs = [|zero|]; payoffs_pp = - [|SolverIntf.M.register_real_expr zero|]; + [|Solver.M.register_real_expr zero|]; moves = [] }; player_names = ["1", 0] ; defined_rels = [] ; @@ -71,8 +71,8 @@ (* Add a defined relation to a structure. *) let add_def_rel_single struc (r_name, vars, def_phi) = - let def_asg = SolverIntf.M.evaluate struc - (SolverIntf.M.register_formula def_phi) in + let def_asg = Solver.M.evaluate struc + (Solver.M.register_formula def_phi) in match def_asg with | AssignmentSet.Empty -> Structure.add_rel_name r_name (List.length vars) struc @@ -144,7 +144,7 @@ let payoffs = array_of_players zero player_names payoffs in let payoffs_pp = - Array.map SolverIntf.M.register_real_expr payoffs in + Array.map Solver.M.register_real_expr payoffs in { id = id; player = player; payoffs = payoffs; payoffs_pp = payoffs_pp; moves = moves } @@ -215,7 +215,7 @@ List.map (fun (rel, args, body) -> (rel, (args, body))) defined_rels in let defined_rels = List.map (fun (rel, args, body) -> - rel, (args, body, SolverIntf.M.register_formula body)) + rel, (args, body, Solver.M.register_formula body)) defined_rels in let player_names = Array.to_list (Array.mapi (fun i pname->pname, i) @@ -242,7 +242,7 @@ if old_locs = [] then old_locs else let zero = Formula.Const 0.0 in - let pp_zero = SolverIntf.M.register_real_expr zero in + let pp_zero = Solver.M.register_real_expr zero in let add_payoffs loc = let more = num_players - Array.length loc.payoffs in {loc with @@ -255,7 +255,7 @@ let add_def_rel loc = let ps = Array.map (FormulaOps.subst_rels_expr def_rels_pure) loc.payoffs in let reg_ps = - Array.map SolverIntf.M.register_real_expr ps in + Array.map Solver.M.register_real_expr ps in { loc with payoffs = ps; payoffs_pp = reg_ps } in (* {{{ log entry *) if !debug_level > 2 then ( @@ -389,7 +389,7 @@ let add_new_player state pname = let player = state.game.num_players in let zero = Formula.Const 0.0 in - let pp_zero = SolverIntf.M.register_real_expr zero in + let pp_zero = Solver.M.register_real_expr zero in let add_payoff loc = {loc with payoffs = Array.append loc.payoffs [|zero|]; @@ -694,7 +694,7 @@ (Array.mapi (fun i v->string_of_int i,v) state.game.graph.(state.cur_loc).payoffs_pp) in let ev (p,e) = - p^": "^(string_of_float (SolverIntf.M.get_real_val e struc)) in + p^": "^(string_of_float (Solver.M.get_real_val e struc)) in (state, String.concat ", " (List.sort compare (List.map ev payoffs))) | SetLocMoves (i, moves) -> if i < 0 || i > Array.length state.game.graph then Modified: trunk/Toss/Arena/Arena.mli =================================================================== --- trunk/Toss/Arena/Arena.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Arena/Arena.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -1,10 +1,8 @@ -(* Represent the game arena and operate on it. *) +(** Represent the game arena and operate on it. *) val debug_level : int ref -(* ------------------------ BASIC TYPE DEFINITIONS -------------------------- *) - -(* A single move consists of applying a rewrite rule for a time from the +(** A single move consists of applying a rewrite rule for a time from the [time_in] interval, and parameters from the interval list. *) type label = { rule : string ; @@ -12,29 +10,29 @@ parameters_in : (string * (float * float)) list ; } -(* A game has locations from which a player (single for now) can move, +(** A game has locations from which a player (single for now) can move, with a label, to one of the next positions, or get a payoff. Players are indexed continuously starting from 0. *) type location = { id : int ; player : int ; payoffs : Formula.real_expr array ; - payoffs_pp : SolverIntf.M.registered_real_expr array ; + payoffs_pp : Solver.M.registered_real_expr array ; moves : (label * int) list ; } -(* The basic type of Arena. *) +(** The basic type of Arena. *) type game = { rules : (string * ContinuousRule.rule) list; graph : location array; num_players : int; player_names : (string * int) list ; defined_rels : (string * (string list * Formula.formula * - SolverIntf.M.registered_formula)) list ; + Solver.M.registered_formula)) list ; } -(* State of the game. *) +(** State of the game. *) type game_state = { game : game ; struc : Structure.structure ; @@ -49,18 +47,16 @@ (string * string list * Formula.formula) list -> Structure.structure -(* ------------------------ PRINTING FUNCTIONS ------------------------------ *) - -(* Print a label as a string. *) +(** Print a label as a string. *) val label_str : label -> string val move_str : (label * int) -> string -(* Print a game as a string. *) +(** Print a game as a string. *) val str : game -> string -(* Print the whole state: the game, structure, time and aux data. *) +(** Print the whole state: the game, structure, time and aux data. *) val state_str : game_state -> string -(* Whether to print relation definitions as equations, or using the C +(** Whether to print relation definitions as equations, or using the C syntax. Defaults to [true]. *) val equational_def_style : bool ref @@ -68,9 +64,7 @@ val print_state : game_state -> unit val sprint_state : game_state -> string -(* -------------------- PARSER HELPER ------------------------------ *) - -(* The order of following entries matters: [DefPlayers] adds more +(** The order of following entries matters: [DefPlayers] adds more players, with consecutive numbers starting from first available; later [StateStruc], [StateTime] and [StateLoc] entries override earlier ones; later [DefLoc] with already existing location ID @@ -82,16 +76,16 @@ (string * int) list -> (string * (string list * Formula.formula)) list -> string -> ContinuousRule.rule) - (* add a rule *) + (** add a rule *) | DefLoc of ((string * int) list -> location) - (* add location to graph *) - | DefPlayers of string list (* add players (fresh numbers) *) + (** add location to graph *) + | DefPlayers of string list (** add players (fresh numbers) *) | DefRel of string * string list * Formula.formula - (* add a defined relation *) - | StateStruc of Structure.structure (* initial/saved state *) - | StateTime of float (* initial/saved time *) - | StateLoc of int (* initial/saved location *) - | StateData of (string * string) list (* saved data *) + (** add a defined relation *) + | StateStruc of Structure.structure (** initial/saved state *) + | StateTime of float (** initial/saved time *) + | StateLoc of int (** initial/saved location *) + | StateData of (string * string) list (** saved data *) exception Arena_definition_error of string @@ -109,45 +103,45 @@ | `PlayerName of string ] list -> (string * int) list -> location -(* Create a game state, possibly by extending an old state, from a +(** Create a game state, possibly by extending an old state, from a list of definitions (usually corresponding to a ".toss" file.) *) val process_definition : ?extend_state:game_state -> definition list -> game_state -(* ------------------ REQUESTS TO THE ARENA USED IN OPERATION --------------- *) +(** ------------------ REQUESTS TO THE ARENA USED IN OPERATION --------------- *) -(* Location of a structure: either arena or left or right-hand side of a rule *) +(** Location of a structure: either arena or left or right-hand side of a rule *) type struct_loc = Struct | Left of string | Right of string -(* Requests which we handle. *) +(** Requests which we handle. *) type request = - AddElem of struct_loc (* Add element to location *) - | AddRel of struct_loc * string * string list (* Add relation tuple *) - | DelElem of struct_loc * string (* Del element at location *) - | DelRel of struct_loc * string * string list (* Del relation tuple *) - | GetRelSignature of struct_loc (* List rel names and arities *) - | GetFunSignature of struct_loc (* List function names *) - | GetAllTuples of struct_loc * string (* Get all tuples in relation *) - | GetAllElems of struct_loc (* List all elements *) - | SetFun of struct_loc * string * string * float (* Set function value *) - | GetFun of struct_loc * string * string (* Get function value *) - | SetData of string * string (* Set data under a name *) - | GetData of string (* Get data *) - | SetArity of string * int (* Set arity of a relation *) - | GetArity of string (* Get arity of a relation *) - | RenamePlayer of string * string (* Replace player name *) - | SetLoc of int (* Set current location *) - | GetLoc (* Get current and # locs. *) - | SetLocPlayer of int * string (* Set player at location *) - | GetLocPlayer of int (* Get player at location *) - | SetLocPayoff of int * string * Formula.real_expr(* Set payoff for player *) - | GetLocPayoff of int * string (* Get payoff for player *) - | GetCurPayoffs (* Payoffs in current loc *) - | SetLocMoves of int * (label * int) list (* Set moves at location *) - | GetLocMoves of int (* Get moves at location *) + AddElem of struct_loc (** Add element to location *) + | AddRel of struct_loc * string * string list (** Add relation tuple *) + | DelElem of struct_loc * string (** Del element at location *) + | DelRel of struct_loc * string * string list (** Del relation tuple *) + | GetRelSignature of struct_loc (** List rel names and arities *) + | GetFunSignature of struct_loc (** List function names *) + | GetAllTuples of struct_loc * string (** Get all tuples in relation *) + | GetAllElems of struct_loc (** List all elements *) + | SetFun of struct_loc * string * string * float (** Set function value *) + | GetFun of struct_loc * string * string (** Get function value *) + | SetData of string * string (** Set data under a name *) + | GetData of string (** Get data *) + | SetArity of string * int (** Set arity of a relation *) + | GetArity of string (** Get arity of a relation *) + | RenamePlayer of string * string (** Replace player name *) + | SetLoc of int (** Set current location *) + | GetLoc (** Get current and # locs. *) + | SetLocPlayer of int * string (** Set player at location *) + | GetLocPlayer of int (** Get player at location *) + | SetLocPayoff of int * string * Formula.real_expr(** Set payoff for player *) + | GetLocPayoff of int * string (** Get payoff for player *) + | GetCurPayoffs (** Payoffs in current loc *) + | SetLocMoves of int * (label * int) list (** Set moves at location *) + | GetLocMoves of int (** Get moves at location *) | SuggestLocMoves of int * int * int * string * int option * (string * Formula.real_expr) list array option * float option - (* Suggested moves at loc, with timeout in so many seconds, for so + (** Suggested moves at loc, with timeout in so many seconds, for so much computational effort if possible before timeout, using given search method ("maximax", "alpha_beta", "alpha_beta_ord", "uct_random_playouts", @@ -155,32 +149,32 @@ "uct_no_playouts"), with optional horizon for playouts, with location-dependent heuristics, with advancement ratio for generating heuristics if they're not given *) - | EvalFormula of Formula.formula (* Evaluate formula *) - | EvalRealExpr of Formula.real_expr (* Evaluate real expr *) + | EvalFormula of Formula.formula (** Evaluate formula *) + | EvalRealExpr of Formula.real_expr (** Evaluate real expr *) | SetRule of string * ((string * int) list -> (string * (string list * Formula.formula)) list -> string -> ContinuousRule.rule) - (* Set a rule as given *) - | GetRule of string (* Get a rule as string *) - | SetRuleUpd of string*string *string *Term.term (* Set a rule update eq *) - | GetRuleUpd of string * string * string (* Get a rule update eq *) - | SetRuleDyn of string*string *string *Term.term (* Set a rule dynamics eq *) - | GetRuleDyn of string * string * string (* Get a rule dynamics eq *) + (** Set a rule as given *) + | GetRule of string (** Get a rule as string *) + | SetRuleUpd of string*string *string *Term.term (** Set a rule update eq *) + | GetRuleUpd of string * string * string (** Get a rule update eq *) + | SetRuleDyn of string*string *string *Term.term (** Set a rule dynamics eq *) + | GetRuleDyn of string * string * string (** Get a rule dynamics eq *) | SetRuleCond of string * Formula.formula * Formula.formula * Formula.formula - (* Set a rule's precondition, invariant and postconsition *) - | GetRuleCond of string (* Get a rule conditions *) - | SetRuleEmb of string * string list (* Set relations to embed *) - | GetRuleEmb of string (* Get relations to embed *) - | SetRuleAssoc of string * string * string list (* Set an association *) - | GetRuleAssoc of string * string (* Get an association *) - | GetRuleMatches of string (* Get matches of a rule *) + (** Set a rule's precondition, invariant and postconsition *) + | GetRuleCond of string (** Get a rule conditions *) + | SetRuleEmb of string * string list (** Set relations to embed *) + | GetRuleEmb of string (** Get relations to embed *) + | SetRuleAssoc of string * string * string list (** Set an association *) + | GetRuleAssoc of string * string (** Get an association *) + | GetRuleMatches of string (** Get matches of a rule *) | ApplyRule of string * (string * string) list * float * (string * float) list - (* Apply rule at match for given time and with params *) - | GetRuleNames (* Get names of rules *) - | SetTime of float * float (* Set time step and time *) - | GetTime (* Get time step and time *) - | SetState of game_state (* Set the full state *) - | GetState (* Return the state *) + (** Apply rule at match for given time and with params *) + | GetRuleNames (** Get names of rules *) + | SetTime of float * float (** Set time step and time *) + | GetTime (** Get time step and time *) + | SetState of game_state (** Set the full state *) + | GetState (** Return the state *) val handle_request : game_state -> request -> game_state * string Modified: trunk/Toss/Arena/ContinuousRule.ml =================================================================== --- trunk/Toss/Arena/ContinuousRule.ml 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Arena/ContinuousRule.ml 2010-12-06 00:34:31 UTC (rev 1228) @@ -15,10 +15,10 @@ update : ((string * string) * Term.term) list; (* Update equations calT *) (* Note that, for efficiency, the precondition is part of DiscreteRule. *) inv : Formula.formula; (* Invariant for the evolution *) - inv_pp : SolverIntf.M.registered_formula; + inv_pp : Solver.M.registered_formula; (* Optimized invariant *) post : Formula.formula; (* Postcondition for application *) - post_pp : SolverIntf.M.registered_formula; + post_pp : Solver.M.registered_formula; (* Optimized postcondition *) } @@ -31,16 +31,16 @@ let cpost = FormulaOps.subst_rels defs post in let discrete = { discr with DiscreteRule.pre = cpre } in let defrels = List.map (fun (rel,(args,body)) -> - rel, (args, body, SolverIntf.M.register_formula body)) defs in + rel, (args, body, Solver.M.register_formula body)) defs in let obj = DiscreteRule.compile_rule signat defrels discr in { discrete = discrete; compiled = obj ; dynamics = dynamics ; update = update ; inv = cinv ; - inv_pp = SolverIntf.M.register_formula cinv; + inv_pp = Solver.M.register_formula cinv; post = cpost ; - post_pp = SolverIntf.M.register_formula cpost; + post_pp = Solver.M.register_formula cpost; } @@ -108,7 +108,7 @@ let cur_vals = ref init_vals in let all_vals = ref [] in let end_time = !time +. t -. (0.01 *. !time_step) in (*TODO: 1% is decimals!*) - let is_inv s = SolverIntf.M.check_formula s r.inv_pp in + let is_inv s = Solver.M.check_formula s r.inv_pp in let lhs_to_model ((f, a), _) = (* dynamics refer to elements by LHS matches *) let e = Structure.find_elem r.discrete.DiscreteRule.lhs_struc a in @@ -164,7 +164,7 @@ let is_ok m = let (res_struc, _, _) = rewrite_single_nocheck struc cur_time m r 1. [] in - SolverIntf.M.check_formula res_struc r.post_pp in + Solver.M.check_formula res_struc r.post_pp in if r.post = Formula.And [] then matches struc r else List.filter is_ok (matches struc r) @@ -174,7 +174,7 @@ let (res_struc, _, _ as res_struc_n_shifts) = rewrite_single_nocheck struc cur_time m r t params in if r.post = Formula.And [] || - SolverIntf.M.check_formula res_struc r.post_pp + Solver.M.check_formula res_struc r.post_pp then Some res_struc_n_shifts else None Modified: trunk/Toss/Arena/ContinuousRule.mli =================================================================== --- trunk/Toss/Arena/ContinuousRule.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Arena/ContinuousRule.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -1,40 +1,41 @@ -(* Structure rewriting with continuous dynamics. *) +(** Structure rewriting with continuous dynamics. *) val get_time_step : unit -> float val set_time_step : float -> unit -(* ---------------- BASIC TYPE DEFINITION AND CONSTRUCTOR ------------------- *) +(** {2 Basic Type Definition} *) -(* Specification of a continuous rewriting rule, as in modelling document. +(** Specification of a continuous rewriting rule, as in modelling document. Function named foo on element i is, in a term, given by variable foo_i. *) type rule = { - discrete : DiscreteRule.rule; (* The discrete part *) - compiled : DiscreteRule.rule_obj ; (* Compiled discrete part *) - dynamics : ((string * string) * Term.term) list; (* Equation system calD *) - update : ((string * string) * Term.term) list; (* Update equations calT *) - (* Note that, for efficiency, the precondition is part of DiscreteRule. *) - inv : Formula.formula; (* Invariant for the evolution *) - inv_pp : SolverIntf.M.registered_formula; - (* Optimized invariant *) - post : Formula.formula; (* Postcondition for application *) - post_pp : SolverIntf.M.registered_formula; -(* Optimized postcondition *) + discrete : DiscreteRule.rule; (** The discrete part *) + compiled : DiscreteRule.rule_obj ; (** Compiled discrete part *) + dynamics : ((string * string) * Term.term) list; (** Equation system calD *) + update : ((string * string) * Term.term) list; (** Update equations calT *) + (** Note that, for efficiency, the precondition is part of DiscreteRule. *) + inv : Formula.formula; (** Invariant for the evolution *) + inv_pp : Solver.M.registered_formula; + (** Optimized invariant *) + post : Formula.formula; (** Postcondition for application *) + post_pp : Solver.M.registered_formula; + (** Optimized postcondition *) } -(* Create a continuous rule given a named discrete rule and other params. *) +(** Create a continuous rule given a named discrete rule and other params. *) val make_rule : - (string * int) list -> (* signature *) - (string * (string list * Formula.formula)) list -> (* defined rels *) + (string * int) list -> (** signature *) + (string * (string list * Formula.formula)) list -> (** defined rels *) (DiscreteRule.rule) -> Term.eq_sys -> Term.eq_sys -> ?pre:Formula.formula -> ?inv:Formula.formula -> ?post:Formula.formula -> unit -> rule -(* -------------------------- PRINTING FUNCTION ----------------------------- *) +(** {2 Printing function} *) -(* Print a rule to string. *) + +(** Print a rule to string. *) val str : rule -> string val fprint : Format.formatter -> rule -> unit @@ -42,32 +43,35 @@ val sprint : rule -> string -(* ------------------ APPLYING FUNCTIONS TO SIDE STRUCTURES ----------------- *) +(** {2 Applying function to side structures} *) -(* Apply [f] to left (if [to_left]) or right side of the given rule. + +(** Apply [f] to left (if [to_left]) or right side of the given rule. Return the new rule and an additional result which [f] returns. *) val apply_to_side : bool -> (Structure.structure -> Structure.structure * 'a) -> - (string * int) list -> (* signature *) - (string * (string list * Formula.formula)) list -> (* defined rels *) + (string * int) list -> (** signature *) + (string * (string list * Formula.formula)) list -> (** defined rels *) rule -> rule * 'a val lhs : rule -> Structure.structure val rhs : rule -> Structure.structure -(* ---------------------- FINDING APPLICABLE MATCHES ------------------------ *) -(* Find all matches of [r] in [struc] which satisfy [r]'s precondition. *) +(** {2 Finding applicable matches} *) + + +(** Find all matches of [r] in [struc] which satisfy [r]'s precondition. *) val matches : Structure.structure -> rule -> (int * int) list list -(* Matches which satisfy postcondition with time 1 and empty params *) +(** Matches which satisfy postcondition with time 1 and empty params *) val matches_post : Structure.structure -> rule -> float -> (int * int) list list -(* --------------------------- REWRITING ------------------------------------ *) +(** {2 Rewriting} *) -(* For now, we rewrite only single rules. +(** For now, we rewrite only single rules. [rewrite_single struc cur_time m r t params def_rels] rewrites [struc] for the period [t] (unless invariant stops holding earlier) starting in [cur_time], at matching [m], and returns the rewritten @@ -78,8 +82,7 @@ (int * int) list -> rule -> float -> (string * float) list -> Structure.structure * float * ((string * string) * Term.term list) list -(* For now, we rewrite only single rules. - +(** For now, we rewrite only single rules. Same as {!ContinuousRule.rewrite_single_nocheck}, but check if the postcondition holds. Returns [None] if rewriting fails. *) val rewrite_single : Modified: trunk/Toss/Arena/DiscreteRule.ml =================================================================== --- trunk/Toss/Arena/DiscreteRule.ml 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Arena/DiscreteRule.ml 2010-12-06 00:34:31 UTC (rev 1228) @@ -36,7 +36,7 @@ lhs_elem_inv_names : elem_inv_names; lhs_elem_vars : string list; lhs_form : Formula.formula; - lhs_form_pp : SolverIntf.M.registered_formula; + lhs_form_pp : Solver.M.registered_formula; (* gets instantiated in the model *) (* the precondition [pre] is compiled as part of [lhs_form] *) rhs_elem_names : elem_names; @@ -165,7 +165,7 @@ (* Find all embeddings of a rule. Does not guarantee that rewriting will succeed for all of them. *) let find_matchings model rule_obj = - SolverIntf.M.evaluate model rule_obj.lhs_form_pp + Solver.M.evaluate model rule_obj.lhs_form_pp (* Convert assignment to an embedding of the LHS structure. *) let assignment_to_embedding rule_obj assgn = @@ -564,7 +564,7 @@ if List.mem_assoc rel defined_rels then let args, _, rphi = List.assoc rel defined_rels in List.map fst (List.filter (fun (rel, ar) -> - SolverIntf.M.check_formula (Structure.free_for_rel rel ar) rphi + Solver.M.check_formula (Structure.free_for_rel rel ar) rphi ) signat) else [rel] in let expand_defrel_tups (drel, tups) = @@ -575,7 +575,7 @@ map_some (fun (brel, ar) -> let selector = Structure.free_for_rel brel ar in let assgn = - SolverIntf.M.evaluate selector rphi in + Solver.M.evaluate selector rphi in let btup = Array.init ar (fun i->i+1) in (* [selector] has only [btup] with its elements *) let selvars = @@ -836,7 +836,7 @@ rhs_neg_tuples in (* Optimizing the embedding formula. *) let lhs_form_pp = - SolverIntf.M.register_formula emb in + Solver.M.register_formula emb in { lhs_elem_names = lhs_elem_names; lhs_elem_inv_names = lhs_elem_inv_names; @@ -913,7 +913,7 @@ List.map (fun tup->Not (Rel (r,Array.map (fun v->`FO v) tup))) tups) obj.rhs_neg_tuples in - SolverIntf.M.formula_str obj.lhs_form_pp ^ "-> " ^ + Solver.M.formula_str obj.lhs_form_pp ^ "-> " ^ Formula.str (And (plits @ nlits)) Modified: trunk/Toss/Arena/DiscreteRule.mli =================================================================== --- trunk/Toss/Arena/DiscreteRule.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Arena/DiscreteRule.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -31,7 +31,7 @@ lhs_elem_inv_names : elem_inv_names; lhs_elem_vars : string list; lhs_form : Formula.formula; - lhs_form_pp : SolverIntf.M.registered_formula; + lhs_form_pp : Solver.M.registered_formula; (* gets instantiated in the model *) (* the precondition [pre] is compiled as part of [lhs_form] *) rhs_elem_names : elem_names; @@ -104,7 +104,7 @@ val compile_rule : (string * int) list -> (string * - (string list * Formula.formula * SolverIntf.M.registered_formula)) + (string list * Formula.formula * Solver.M.registered_formula)) list -> rule -> rule_obj (** Relations that can explicitly change state by rewriting (i.e. not Modified: trunk/Toss/Arena/DiscreteRuleTest.ml =================================================================== --- trunk/Toss/Arena/DiscreteRuleTest.ml 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Arena/DiscreteRuleTest.ml 2010-12-06 00:34:31 UTC (rev 1228) @@ -520,7 +520,7 @@ let signat = ["O", 1; "P", 1; "Q", 1] in let defrels = ["D", (["a"], formula_of_str "P(a) or Q(a)")] in let defrels = List.map (fun (rel,(args,body)) -> - rel, (args, body, SolverIntf.M.register_formula body)) defrels in + rel, (args, body, Solver.M.register_formula body)) defrels in let rule_obj = compile_rule signat defrels {lhs_struc = lhs_struc; rhs_struc = rhs_struc; @@ -536,7 +536,7 @@ let signat = ["O", 1; "P", 1; "Q", 1] in let defrels = ["D", (["a"], formula_of_str "P(a) or Q(a)")] in let defrels = List.map (fun (rel,(args,body)) -> - rel, (args, body, SolverIntf.M.register_formula body)) defrels in + rel, (args, body, Solver.M.register_formula body)) defrels in let rule_obj = compile_rule signat defrels {lhs_struc = lhs_struc; rhs_struc = rhs_struc; @@ -552,7 +552,7 @@ let signat = ["O", 1; "P", 1; "Q", 1] in let defrels = ["D", (["a"], formula_of_str "P(a) or Q(a)")] in let defrels = List.map (fun (rel,(args,body)) -> - rel, (args, body, SolverIntf.M.register_formula body)) defrels in + rel, (args, body, Solver.M.register_formula body)) defrels in let rule_obj = compile_rule signat defrels {lhs_struc = lhs_struc; rhs_struc = rhs_struc; @@ -568,7 +568,7 @@ let signat = ["O", 1; "P", 1; "Q", 1] in let defrels = ["D", (["a"], formula_of_str "P(a) or Q(a)")] in let defrels = List.map (fun (rel,(args,body)) -> - rel, (args, body, SolverIntf.M.register_formula body)) defrels in + rel, (args, body, Solver.M.register_formula body)) defrels in let rule_obj = compile_rule signat defrels {lhs_struc = lhs_struc; rhs_struc = rhs_struc; @@ -589,7 +589,7 @@ let signat = ["O", 1; "P", 1; "Q", 1] in let defrels = ["D", (["a"], formula_of_str "P(a) or Q(a)")] in let defrels = List.map (fun (rel,(args,body)) -> - rel, (args, body, SolverIntf.M.register_formula body)) defrels in + rel, (args, body, Solver.M.register_formula body)) defrels in let rule_obj = compile_rule signat defrels {lhs_struc = lhs_struc; rhs_struc = rhs_struc; @@ -605,7 +605,7 @@ let signat = ["O", 1; "P", 1; "Q", 1] in let defrels = ["D", (["a"], formula_of_str "P(a) or Q(a)")] in let defrels = List.map (fun (rel,(args,body)) -> - rel, (args, body, SolverIntf.M.register_formula body)) defrels in + rel, (args, body, Solver.M.register_formula body)) defrels in let rule_obj = compile_rule signat defrels {lhs_struc = lhs_struc; rhs_struc = rhs_struc; @@ -621,7 +621,7 @@ let signat = ["O", 1; "P", 1; "Q", 1] in let defrels = ["D", (["a"], formula_of_str "P(a) or Q(a)")] in let defrels = List.map (fun (rel,(args,body)) -> - rel, (args, body, SolverIntf.M.register_formula body)) defrels in + rel, (args, body, Solver.M.register_formula body)) defrels in let rule_obj = compile_rule signat defrels {lhs_struc = lhs_struc; rhs_struc = rhs_struc; Modified: trunk/Toss/Arena/Term.mli =================================================================== --- trunk/Toss/Arena/Term.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Arena/Term.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -1,6 +1,6 @@ -(* Represent terms and their operations. *) +(** Represent terms and their operations. *) -(* ---------------------- BASIC TYPE DEFINITION ----------------------------- *) +(** {2 Basic Type Definition.} *) type term = Var of string @@ -13,12 +13,13 @@ type eq_sys = ((string * string) * term) list -(* ------------------------ BASIC FUNCTIONS -------------------------------- *) +(** {2 Basic functions.} *) -(* Print a term as a string. *) + +(** Print a term as a string. *) val str : term -> string -(* Print an equation system as a string. *) +(** Print an equation system as a string. *) val eq_str : ?diff : bool -> eq_sys -> string val fprint : @@ -32,20 +33,20 @@ val sprint_eqs : ?diff : bool -> eq_sys -> string -(* Power function used in parser. *) +(** Power function used in parser. *) val pow : term -> int -> term -(* Basic simplification, reduces constant terms to floats. *) +(** Basic simplification, reduces constant terms to floats. *) val simp_const : term -> term -(* Convert a term to float, fail on non-constant term. *) +(** Convert a term to float, fail on non-constant term. *) val term_val : term -> float -(* Convert an equation system to float assciation list, fail on non-consts. *) +(** Convert an equation system to float assciation list, fail on non-consts. *) val eq_vals : eq_sys -> ((string * string) * float) list -(* ----------------------- SIMPLE OPERATIONS ------------------------------- *) +(** {2 Simple operations.} *) val add : term -> term -> term val ladd1 : term -> term list -> term list @@ -56,27 +57,28 @@ val lmul : term list -> term list -> term list -(* ------------------ SUBSTITUTION FOR VARIABLES --------------------------- *) +(** {2 Substitution for variables.} *) -(* Substitute term [t] for variable [v] in the given term. *) +(** Substitute term [t] for variable [v] in the given term. *) val subst : string * term -> term -> term -(* Substitute [vals] for [vars] in [terms] and simplify. *) +(** Substitute [vals] for [vars] in [terms] and simplify. *) val subst_simp : string list -> term list -> term list -> term list -(* Substitute term [t] for function variable [f, a] in the given term. *) +(** Substitute term [t] for function variable [f, a] in the given term. *) val subst_f : (string * string) * term -> term -> term -(* Substitute [vals] for function [vars] in [terms] and simplify. *) +(** Substitute [vals] for function [vars] in [terms] and simplify. *) val subst_simp_f : (string * string) list -> term list -> term list -> term list -(* Substitute variables and function vals in an equation system and simplify. *) +(** Substitute variables and function vals in an eq. system and simplify. *) val subst_simp_eq : (string * term) list -> ((string * string) * term) list -> eq_sys -> eq_sys -(* ---------------- RUNGE - KUTTA METHOD FOR TERM EQUATIONS ---------------- *) +(** {2 Runge-Kutta Method for Term Equations *) -(* Perform a Runge-Kutta (RK4) step for [vars] with [vals_init] and right-hand + +(** Perform a Runge-Kutta (RK4) step for [vars] with [vals_init] and right-hand side [eq_terms]. Time variable [tvar] starts at [tinit] and moves [tstep]. *) val rk4_step : string -> term -> term -> eq_sys -> term list -> term list Modified: trunk/Toss/Formula/BoolFormula.ml =================================================================== --- trunk/Toss/Formula/BoolFormula.ml 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Formula/BoolFormula.ml 2010-12-06 00:34:31 UTC (rev 1228) @@ -38,10 +38,10 @@ (* ----------------------- PRINTING FUNCTIONS ------------------------------- *) -(* Print a variable as a string. *) +(** Print a variable as a string. *) let var_str = string_of_int -(* Print a Boolean formula as a string. *) +(** Print a Boolean formula as a string. *) let rec str = function BVar v -> var_str v | BNot phi -> "(not " ^ (str phi) ^ ")" @@ -58,7 +58,7 @@ (* ------------------------ ORDER ON FORMULAS ------------------------------- *) -(* Compare two variables. We assume that FO < MSO < Real. *) +(** Compare two variables. We assume that FO < MSO < Real. *) let compare_vars x y = let abs lit = if lit < 0 then (-lit) else lit in (abs x) - (abs y) Modified: trunk/Toss/Formula/BoolFormula.mli =================================================================== --- trunk/Toss/Formula/BoolFormula.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Formula/BoolFormula.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -1,8 +1,8 @@ -(* Represent Boolean combinations of integer literals. *) +(** Represent Boolean combinations of integer literals. *) -(* ----------------------- BASIC TYPE DEFINITIONS -------------------------- *) +(** {2 Basic type definitions.} *) -(* This type describes formulas of relational logic with equality. +(** This type describes formulas of relational logic with equality. We allow only simple boolean junctors, other are resolved during parsing. *) type bool_formula = BVar of int @@ -10,58 +10,55 @@ | BAnd of bool_formula list | BOr of bool_formula list -(* ---------------------- PRINTING FUNCTIONS ------------------------------- *) +(** {2 Printing functions.} *) -(* Print a variable as a string. *) +(** Print a variable as a string. *) val var_str : int -> string -(* Print a formula as a string. *) +(** Print a formula as a string. *) val str : bool_formula -> string - -(* Helper function to flatten multiple or's and and's. *) +(** Helper function to flatten multiple or's and and's. *) val flatten_sort : bool_formula -> bool_formula -(* ------------------------- Boolean Formulas ------------------------------ *) +(** {3 Boolean Formulas.} *) -(* Convert an arbitrary formula to a Boolean combination of literals *) +(** Convert an arbitrary formula to a Boolean combination of literals *) val bool_formula_of_formula : Formula.formula -> bool_formula -(* Convert a Boolean combination back to a formula *) -(*val formula_of_bool_formula : bool_formula -> Formula.formula*) - +(** Convert a Boolean combination back to a formula *) val formula_of_bool_formula_arg : bool_formula -> (Formula.formula, int) Hashtbl.t * (int, Formula.formula) Hashtbl.t * int ref -> Formula.formula val bool_formula_of_formula_arg : Formula.formula -> (Formula.formula, int) Hashtbl.t * (int, Formula.formula) Hashtbl.t * int ref -> bool_formula -(* Simplify a Boolean combination *) +(** Simplify a Boolean combination *) val simplify : bool_formula -> bool_formula -(* Sort a Boolean combination *) +(** Sort a Boolean combination *) val sort : bool_formula -> bool_formula -(* Convert a reduced Boolean combination into a CNF with auxiliary variables *) +(** Convert a reduced Boolean combination into a CNF with auxiliary variables *) val auxcnf_of_bool_formula : bool_formula -> int * bool_formula val pg_auxcnf_of_bool_formula : bool_formula -> int * bool_formula -(* Convert a Boolean combination into reduced form (over 'not' and 'or') *) +(** Convert a Boolean combination into reduced form (over 'not' and 'or') *) val to_reduced_form : ?neg:bool -> bool_formula -> bool_formula -(* Convert a Boolean formula to NNF and additionally negate if [neg] is set. *) +(** Convert a Boolean formula to NNF and additionally negate if [neg] is set. *) val to_nnf : ?neg : bool -> bool_formula -> bool_formula val convert : bool_formula -> int list list -(* Convert an arbitrary formula to CNF via Boolean combinations. *) +(** Convert an arbitrary formula to CNF via Boolean combinations. *) val formula_to_cnf : Formula.formula -> Formula.formula -(* ------------------------- 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/Formula/Formula.mli =================================================================== --- trunk/Toss/Formula/Formula.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Formula/Formula.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -1,46 +1,46 @@ -(* Represent formulas with first-order, mso, and real variables. *) +(** Represent formulas with first-order, mso, and real variables. *) -(* ----------------------- BASIC TYPE DEFINITIONS -------------------------- *) +(** {2 Basic Type Definitions.} *) -(* Our variables can be first-order, monadic second-order or reals. *) +(** Our variables can be first-order, monadic second-order or reals. *) type var = [ `FO of string | `MSO of string | `Real of string ] ;; type fo_var = [ `FO of string ];; type mso_var = [ `MSO of string ];; type real_var = [ `Real of string ];; -(* We recognize if the variable is FO (x, y) or MSO (X, Y) or Real (r1, r2). *) +(** We recognize if the variable is FO (x, y) or MSO (X, Y) or Real (r1, r2). *) val var_of_string : string -> var val fo_var_of_string : string -> fo_var val mso_var_of_string : string -> mso_var val real_var_of_string : string -> real_var -(* Check variable type. *) +(** Check variable type. *) val is_fo : var -> bool val is_mso : var -> bool val is_real : var -> bool -(* Casts to particular variable types. *) +(** Casts to particular variable types. *) val to_fo : var -> fo_var val to_mso : var -> mso_var val to_real : var -> real_var val var_tup : [< var] array -> var array -(* Compare two variables. We assume FO < MSO < Real. *) +(** Compare two variables. We assume FO < MSO < Real. *) val compare_vars : ([< var ] as 'a) -> 'a -> int val compare_var_lists : ([< var ] as 'a) list -> 'a list -> int val compare_var_tups : ([< var ] as 'a) array -> 'a array -> int -(* Sign operands. *) +(** Sign operands. *) type sign_op = EQZero | GZero | LZero | GEQZero | LEQZero | NEQZero -(* Print a sign_op as string. *) +(** Print a sign_op as string. *) val sign_op_str : sign_op -> string -(* This type describes formulas of relational logic with equality. +(** This type describes formulas of relational logic with equality. We allow only simple boolean junctors, other are resolved during parsing. *) type formula = Rel of string * fo_var array @@ -68,23 +68,23 @@ val compare : formula -> formula -> int -(* ---------------------- PRINTING FUNCTIONS ------------------------------- *) +(** {2 Printing Functions} *) -(* Print a variable as a string. *) +(** Print a variable as a string. *) val var_str : [< `FO of string | `MSO of string | `Real of string ] -> string -(* Print a variable list as a string. *) +(** Print a variable list as a string. *) val var_list_str: [< `FO of string | `MSO of string | `Real of string ] list -> string -(* Print a formula as a string. *) +(** Print a formula as a string. *) val str : formula -> string val mona_str : formula -> string val print : formula -> unit val sprint : formula -> string val fprint : Format.formatter -> formula -> unit -(* Print a real_expr as a string. *) +(** Print a real_expr as a string. *) val real_str : real_expr -> string val print_real : real_expr -> unit val sprint_real : real_expr -> string @@ -93,13 +93,13 @@ val fprint_prec : int -> Format.formatter -> formula -> unit val fprint_real_prec : int -> Format.formatter -> real_expr -> unit -(* --------------- BASIC HELPER FUNCTIONS USED IN PARSER ------------------- *) +(** {2 Basic flattening functions.} *) -(* Only flatten the formula. *) +(** Only flatten the formula. *) val flatten : formula -> formula val flatten_re : real_expr -> real_expr -(* Flatten and sort multiple or's and and's. *) +(** Flatten and sort multiple or's and and's. *) val flatten_sort : formula -> formula val flatten_sort_re : real_expr -> real_expr Modified: trunk/Toss/Formula/FormulaOps.mli =================================================================== --- trunk/Toss/Formula/FormulaOps.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Formula/FormulaOps.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -1,35 +1,35 @@ -(* Operations on formulas. *) +(** Operations on formulas. *) open Formula -(* ------------------------------- NNF ------------------------------------ *) +(** {2 NNF} *) -(* Convert formula to NNF and additionally negate if [neg] is set. *) +(** Convert formula to NNF and additionally negate if [neg] is set. *) val nnf : ?neg : bool -> formula -> formula -(* ------------------------------- VARS ------------------------------------ *) +(** {2 Vars} *) val all_vars : formula -> var list val free_vars : formula -> var list -(* Delete top-most quantification of [vs] in the formula. *) +(** Delete top-most quantification of [vs] in the formula. *) val del_vars_quant : var list -> formula -> formula -(* ----------------- MAPPING TO ATOMS AND VAR SUBSTITUTION ------------------ *) +(** {2 Mapping to atoms and variable substitution.} *) -(* Map [f] to all literals (i.e. atoms or not(atom)'s) in the given +(** Map [f] to all literals (i.e. atoms or not(atom)'s) in the given formula. Preserves order of subformulas. *) val map_to_literals : (formula -> formula) -> formula -> formula val map_to_literals_expr : (formula -> formula) -> real_expr -> real_expr -(* Map [f] to all atoms in the given formula. *) +(** Map [f] to all atoms in the given formula. *) val map_to_atoms : (formula -> formula) -> formula -> formula val map_to_atoms_expr : (formula -> formula) -> real_expr -> real_expr -(** Map [f] to all variables occurring in the formula. - Preserves order of subformulas. *) +(** Map @param f to all variables occurring in the formula. + Preserves order of subformulas. @param phi The formula to substitute in. *) val map_to_all_vars : (var -> var) -> formula -> formula (** Apply substitution [subst] to all free variables in the given formula @@ -41,59 +41,59 @@ and the above-quantified ones. Does not go into real_expr. *) val rename_quant_avoiding : var list -> formula -> formula -(* Substitute once relations in [defs] by corresponding subformulas +(** Substitute once relations in [defs] by corresponding subformulas (with instantiated parameters). *) val subst_once_rels : (string * (string list * formula)) list -> formula -> formula val subst_once_rels_expr : (string * (string list * formula)) list -> real_expr -> real_expr -(* Substitute recursively relations defined in [defs] by their definitions. *) +(** Substitute recursively relations defined in [defs] by their definitions. *) val subst_rels : (string * (string list * formula)) list -> formula -> formula val subst_rels_expr : (string * (string list * formula)) list -> real_expr -> real_expr -(* Assign emptyset to an MSO-variable. *) +(** Assign emptyset to an MSO-variable. *) val assign_emptyset : string -> formula -> formula -(* ------------------------ Transitive Closure ---------------------------- *) +(** {2 Transitive Closure} *) -(* Transitive closure of phi(x, y, z) over x and y, an MSO formula. *) +(** Transitive closure of phi(x, y, z) over x and y, an MSO formula. *) val make_tc : string -> string -> formula -> formula -(* First-order [k]-step refl. transitive closure of [phi] over [x] and [y]. *) +(** 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 -(* -------------------------- Simplification ------------------------------ *) +(** {2 Simplification} *) -(* Recursively simplify a formula *) +(** Recursively simplify a formula *) val simplify : ?do_pnf : bool -> formula -> formula val pnf : formula -> formula -(* Flatten "and"s and "or"s in a formula -- i.e. associativity. *) +(** Flatten "and"s and "or"s in a formula -- i.e. associativity. *) val flatten_formula : formula -> formula -(* ------------------------------- TNF ------------------------------------ *) +(** {2 TNF} *) -(* Convert formula to TNF; or negTNF when [neg] is set. Type normal form +(** Convert formula to TNF; or negTNF when [neg] is set. Type normal form in a NNF form which pushes quantifiers inside as strongly as possible. *) val tnf : formula -> formula val tnf_re : real_expr -> real_expr val tnf_fv : formula -> formula (** first existentially quantifies free vars *) -(* ----------------------------- CNF/DNF ---------------------------------- *) +(** {2 Convert to CNF or DNF} *) -(* Convert an arbitrary boolean combination to DNF. *) +(** Convert an arbitrary boolean combination to DNF. *) val to_dnf : formula -> formula list -(* Convert an arbitrary boolean combination to CNF. *) +(** Convert an arbitrary boolean combination to CNF. *) val to_cnf : formula -> formula list -(* ------------------------- 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/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Play/Game.ml 2010-12-06 00:34:31 UTC (rev 1228) @@ -612,7 +612,7 @@ let subloc = evgame.ev_game.Arena.graph.(evgame.ev_location) in if subloc.Arena.moves = [] then (* optimization *) Array.map (fun expr -> - SolverIntf.M.get_real_val expr model) subloc.Arena.payoffs_pp + Solver.M.get_real_val expr model) subloc.Arena.payoffs_pp else let state = {game_state={loc=evgame.ev_location; struc=model; time=time}; @@ -650,7 +650,7 @@ if moves = [| |] then let payoff = Array.map (fun expr -> - SolverIntf.M.get_real_val expr state.struc) + Solver.M.get_real_val expr state.struc) loc.Arena.payoffs_pp in Aux.Right payoff else @@ -1015,7 +1015,7 @@ if moves = [| |] then let payoff = Array.map (fun expr -> - SolverIntf.M.get_real_val expr state.struc) + Solver.M.get_real_val expr state.struc) location.Arena.payoffs_pp in let upscore = score_payoff payoff in upscore, Terminal (state, upscore, heuristic, payoff) @@ -1085,7 +1085,7 @@ | None -> default_heuristic ~struc heur_adv_ratio game in let heuristics_pp = - Array.map (Array.map SolverIntf.M.register_real_expr) heuristics in + Array.map (Array.map Solver.M.register_real_expr) heuristics in let evgame gloc = {ev_game = {Arena.rules = []; @@ -1132,7 +1132,7 @@ | None -> default_heuristic ~struc heur_adv_ratio game in let heuristics_pp = - Array.map (Array.map SolverIntf.M.register_real_expr) heuristics in + Array.map (Array.map Solver.M.register_real_expr) heuristics in let agents = Array.map (fun loc -> {ev_game = @@ -1158,7 +1158,7 @@ | None -> default_heuristic ~struc default_adv_ratio orig_game in let heuristics_pp = - Array.map (Array.map SolverIntf.M.register_real_expr) heuristics in + Array.map (Array.map Solver.M.register_real_expr) heuristics in let evgame gloc = {ev_game = {Arena.rules=[]; Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Play/GameTest.ml 2010-12-06 00:34:31 UTC (rev 1228) @@ -124,7 +124,7 @@ player = 0; payoffs = payoffs; payoffs_pp = - Array.map SolverIntf.M.register_real_expr payoffs; + Array.map Solver.M.register_real_expr payoffs; moves = Array.to_list (Array.map (fun (rname, rule) -> {Arena.rule = rname; time_in = 0.1, 0.1; parameters_in = []}, 1) rules1); @@ -134,7 +134,7 @@ player = 1; payoffs = payoffs; payoffs_pp = - Array.map SolverIntf.M.register_real_expr payoffs; + Array.map Solver.M.register_real_expr payoffs; moves = Array.to_list (Array.map (fun (rname, rule) -> {Arena.rule = rname; time_in = 0.1, 0.1; parameters_in = []}, 0) rules2); @@ -620,7 +620,7 @@ in let ev (p,e) = p^": "^(string_of_float - (SolverIntf.M.get_real_val e state.Arena.struc)) in + (Solver.M.get_real_val e state.Arena.struc)) in let answ = String.concat ", " (List.sort compare (List.map ev payoffs)) in assert_equal ~msg:"black wins: direct" ~printer:(fun x->x) Modified: trunk/Toss/Play/Heuristic.ml =================================================================== --- trunk/Toss/Play/Heuristic.ml 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Play/Heuristic.ml 2010-12-06 00:34:31 UTC (rev 1228) @@ -584,8 +584,8 @@ List.map Formula.to_fo (FormulaOps.free_vars phi) in if vars = [] then Or [] else - let aset = SolverIntf.M.evaluate struc - (SolverIntf.M.register_formula phi) in + let aset = Solver.M.evaluate struc + (Solver.M.register_formula phi) in let substs = AssignmentSet.fo_assgn_to_list elems vars aset in (* sort substitutions; TODO: optimizable *) @@ -633,8 +633,8 @@ (* }}} *) let substs = AssignmentSet.fo_assgn_to_list elems vars - (SolverIntf.M.evaluate struc - (SolverIntf.M.register_formula phi)) in + (Solver.M.evaluate struc + (Solver.M.register_formula phi)) in (* sort substitutions; TODO: optimizable *) let substs = trunc_to_vars vars substs in let all_vars = add_strings (List.map var_str vars) all_vars in Modified: trunk/Toss/Solver/AssignmentSet.mli =================================================================== --- trunk/Toss/Solver/AssignmentSet.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Solver/AssignmentSet.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -1,9 +1,9 @@ -(* This module contains the main type for partial assignments of +(** This module contains the main type for partial assignments of values to variables. *) -(* ------------------------- BASIC TYPE DEFINITION -------------------------- *) +(** {2 Basic type definition.} *) -(* We represent assignment sets as trees. Below a variable we keep a +(** We represent assignment sets as trees. Below a variable we keep a tree of all assignments which assign this variable the same value. For an MSO variable X, we keep a list of elements which must be and which must not be in X. For real-valued variables, we keep @@ -18,32 +18,32 @@ | Real of (Poly.polynomial * Formula.sign_op) list list -(* --------------------- PRINTING AND HELPER FUNCTIONS --------------------- *) +(** {2 Printing and small helper functions.} *) -(* Variables assigned in an assignement set. *) +(** Variables assigned in an assignement set. *) val assigned_vars : Formula.var list -> assignment_set -> Formula.var list -(* Print the given assignment as string. *) +(** Print the given assignment as string. *) val str : assignment_set -> string -(* Print the given assignment as string, using element names. *) +(** Print the given assignment as string, using element names. *) val named_str : Structure.structure -> assignment_set -> string -(* Select an arbitrary assignment for first-order variables with the +(** Select an arbitrary assignment for first-order variables with the given names and default values. Raise [Not_found] if the assignment set is empty. *) val choose_fo : (string * int) list -> assignment_set -> (string * int) list -(* List all tuples the first-order assignment [asg] assigns to [vars] +(** List all tuples the first-order assignment [asg] assigns to [vars] in order in which [vars] are given. [elems] are are all elements. *) val tuples : Structure.Elems.t -> string list -> assignment_set -> int array list -(* Check if a variable is actually present in the assignments tree. *) +(** Check if a variable is actually present in the assignments tree. *) val mem_assoc : [< Formula.var ] -> assignment_set -> bool -(* Convert the FO part of an assingment set into a list of substitutions. *) +(** Convert the FO part of an assingment set into a list of substitutions. *) val fo_assgn_to_list : int list -> Formula.fo_var list -> assignment_set -> (Formula.fo_var * Structure.Elems.elt) list list Modified: trunk/Toss/Solver/Assignments.mli =================================================================== --- trunk/Toss/Solver/Assignments.mli 2010-12-05 22:48:17 UTC (rev 1227) +++ trunk/Toss/Solver/Assignments.mli 2010-12-06 00:34:31 UTC (rev 1228) @@ -1,61 +1,69 @@ -(* This module contains functions for handling partial assignments of +(** 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. *) -(* ------------------------- BASIC TYPE DEFINITION -------------------------- *) -(* We represent assignment sets as trees. +(** {2 Basic Type Definition} *) + + +(** We represent assignment sets as trees. Variables must occur in order and below a variable we keep a table of all assignments which assign this variable the same value. If an assignment set is not Empty, then it cannot contain Empty leafs. *) type assignment_set = AssignmentSet.assignment_set -(* ------------------------------ LIST SET ---------------------------------- *) +(** {2 List or Set Type} *) -(* Helper type to represent a set or a list of elements with length. *) + +(** Helper type to represent a set or a list of elements with length. *) type set_list = List of int * int list | Set of int * Structure.Elems.t -(* List a set or list ref; changes from set to list if required. *) +(** List a set or list ref; changes from set to list if required. *) val slist : set_list ref -> int list val sllen : set_list ref -> int -(* -------------------------------- JOIN ------------------------------------ *) +(** {2 Join} *) -(* This function joins two assignment sets, i.e. if these represent + +(** This function joins two assignment sets, i.e. if these represent valuations of two formulas, it computes one for the conjunction. *) val join : assignment_set -> assignment_set -> assignment_set -(* -------------------------------- EQUAL ----------------------------------- *) +(** {2 Equality} *) -(* Enforce that in [aset] the variable [u] is equal to [w]. *) + +(** Enforce that in [aset] the variable [u] is equal to [w]. *) val equal_vars : set_list ref -> Formula.fo_var -> Formula.fo_var -> assignment_set -> assignment_set -(* -------------------------------- SUM ------------------------------------- *) +(** {2 Sum} *) -(* Sum of two assignments, assuming that [elems] are all assignable elements. + +(** Sum of two assignments, assuming that [elems] are all assignable elements. We assume that [elems] are sorted. Corresponds to disjunction of formulas. *) val sum : set_list ref -> assignment_set -> assignment_set -> assignment_set -(* ----------------------------- PROJECTION --------------------------------- *) +(** {2 Projection} *) -(* Project assignments on a given variable. We assume that [elems] are all + +(** Project assignments on a given variable. We assume that [elems] are all elements and are sorted. C... [truncated message content] |
From: <luk...@us...> - 2010-12-05 22:48:23
|
Revision: 1227 http://toss.svn.sourceforge.net/toss/?rev=1227&view=rev Author: lukaszkaiser Date: 2010-12-05 22:48:17 +0000 (Sun, 05 Dec 2010) Log Message: ----------- Correcting chess, now hopefully complete. Modified Paths: -------------- trunk/Toss/examples/Chess.toss Modified: trunk/Toss/examples/Chess.toss =================================================================== --- trunk/Toss/examples/Chess.toss 2010-12-05 22:29:15 UTC (rev 1226) +++ trunk/Toss/examples/Chess.toss 2010-12-05 22:48:17 UTC (rev 1227) @@ -427,10 +427,6 @@ [WhiteRookA1 -> 7]; [WhiteRookH1 -> 3]; [WhiteQueen -> 3]; - [WhiteLeftCastle -> 1]; - [WhiteRightCastle -> 1]; - [WhiteLeftCastle -> 1]; - [WhiteRightCastle -> 1]; [WhiteLeftCastle -> 7]; [WhiteKing -> 7] } @@ -1102,7 +1098,7 @@ MODEL [ | | ] " ... ... ... ... - bR ... ...bK bB.bN bR. + bR bN.bB bQ.bK bB.bN bR. ... ... ... ... bP.bP bP.bP bP.bP bP.bP ... ... ... ... @@ -1116,7 +1112,7 @@ ... ... ... ... wP wP.wP wP.wP wP.wP wP. ... ... ... ... - wR.wN wB.wQ wK. ...wR + wR.wN wB.wQ wK.wB wN.wR " with D1(x, y) = ex z ( (R(x, z) and C(z, y)) or (R(y, z) and C(z, x)) ) ; D2(x, y) = ex z ( (R(x, z) and C(y, z)) or (R(y, z) and C(x, z)) ) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-05 22:29:21
|
Revision: 1226 http://toss.svn.sourceforge.net/toss/?rev=1226&view=rev Author: lukaszkaiser Date: 2010-12-05 22:29:15 +0000 (Sun, 05 Dec 2010) Log Message: ----------- Correcting IsEight, adding Castling move. Modified Paths: -------------- trunk/Toss/examples/Chess.toss Modified: trunk/Toss/examples/Chess.toss =================================================================== --- trunk/Toss/examples/Chess.toss 2010-12-05 21:51:48 UTC (rev 1225) +++ trunk/Toss/examples/Chess.toss 2010-12-05 22:29:15 UTC (rev 1226) @@ -1,7 +1,7 @@ PLAYERS 1, 2 REL IsFirst(x) = not ex z C(z, x) REL IsSecond(x) = ex y (C(y, x) and IsFirst(y)) -REL IsEight(x) = not ex z C(y, z) +REL IsEight(x) = not ex z C(x, z) REL IsSeventh(x) = ex y (C(x, y) and IsEight(y)) REL IsA1(x) = not ex z R(z, x) and IsFirst(x) REL IsH1(x) = not ex z R(x, z) and IsFirst(x) @@ -327,6 +327,38 @@ [ a, b | bK { b } | vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] emb w, b pre Near(a, b) post not CheckB() +RULE WhiteLeftCastle: + [ | | ] " + ... ... ... + wR. ... wK. +" -> [ | | ] " + ... ... ... + ... wK.wR ... +" emb w,b pre not(bBeats(b1) or bBeats(c1) or bBeats(d1) or bBeats(e1))post true +RULE WhiteRightCastle: + [ | | ] " + ... ... + wK. ...wR +" -> [ | | ] " + ... ... + ...wR wK. +" emb w,b pre not (bBeats(a1) or bBeats(b1) or bBeats(c1)) post true +RULE BlackLeftCastle: + [ | | ] " + ... ... ... + bR. ... bK. +" -> [ | | ] " + ... ... ... + ... bK.bR ... +" emb w,b pre not(wBeats(b1) or wBeats(c1) or wBeats(d1) or wBeats(e1))post true +RULE BlackRightCastle: + [ | | ] " + ... ... + bK. ...bR +" -> [ | | ] " + ... ... + ...bR bK. +" emb w,b pre not (wBeats(a1) or wBeats(b1) or wBeats(c1)) post true LOC 0 { // both can castle PLAYER 1 PAYOFF { @@ -347,6 +379,8 @@ [WhiteRookA1 -> 5]; [WhiteRookH1 -> 3]; [WhiteQueen -> 1]; + [WhiteLeftCastle -> 7]; + [WhiteRightCastle -> 7]; [WhiteKing -> 7] } LOC 1 { // both can castle @@ -369,6 +403,8 @@ [BlackRookA8 -> 16]; [BlackRookH8 -> 8]; [BlackQueen -> 0]; + [BlackLeftCastle -> 24]; + [BlackRightCastle -> 24]; [BlackKing -> 24] } LOC 2 { // w left, b can castle @@ -391,6 +427,11 @@ [WhiteRookA1 -> 7]; [WhiteRookH1 -> 3]; [WhiteQueen -> 3]; + [WhiteLeftCastle -> 1]; + [WhiteRightCastle -> 1]; + [WhiteLeftCastle -> 1]; + [WhiteRightCastle -> 1]; + [WhiteLeftCastle -> 7]; [WhiteKing -> 7] } LOC 3 { // w left, b can castle @@ -413,6 +454,8 @@ [BlackRookA8 -> 18]; [BlackRookH8 -> 10]; [BlackQueen -> 2]; + [BlackLeftCastle -> 26]; + [BlackRightCastle -> 26]; [BlackKing -> 26] } LOC 4 { // w right, b can castle @@ -435,6 +478,7 @@ [WhiteRookA1 -> 5]; [WhiteRookH1 -> 7]; [WhiteQueen -> 5]; + [WhiteRightCastle -> 7]; [WhiteKing -> 7] } LOC 5 { // w right, b can castle @@ -457,6 +501,8 @@ [BlackRookA8 -> 20]; [BlackRookH8 -> 12]; [BlackQueen -> 4]; + [BlackLeftCastle -> 28]; + [BlackRightCastle -> 28]; [BlackKing -> 28] } LOC 6 { // w no, b can castle @@ -501,6 +547,8 @@ [BlackRookA8 -> 22]; [BlackRookH8 -> 14]; [BlackQueen -> 6]; + [BlackLeftCastle -> 30]; + [BlackRightCastle -> 30]; [BlackKing -> 30] } LOC 8 { // w can, b left castle @@ -523,6 +571,8 @@ [WhiteRookA1 -> 13]; [WhiteRookH1 -> 11]; [WhiteQueen -> 9]; + [WhiteLeftCastle -> 15]; + [WhiteRightCastle -> 15]; [WhiteKing -> 15] } LOC 9 { // w can, b left castle @@ -545,6 +595,7 @@ [BlackRookA8 -> 24]; [BlackRookH8 -> 8]; [BlackQueen -> 8]; + [BlackLeftCastle -> 24]; [BlackKing -> 24] } LOC 10 { // w left, b left castle @@ -567,6 +618,7 @@ [WhiteRookA1 -> 15]; [WhiteRookH1 -> 11]; [WhiteQueen -> 11]; + [WhiteLeftCastle -> 15]; [WhiteKing -> 15] } LOC 11 { // w left, b left castle @@ -589,6 +641,7 @@ [BlackRookA8 -> 26]; [BlackRookH8 -> 10]; [BlackQueen -> 10]; + [BlackLeftCastle -> 26]; [BlackKing -> 26] } LOC 12 { // w right, b left castle @@ -611,6 +664,7 @@ [WhiteRookA1 -> 13]; [WhiteRookH1 -> 15]; [WhiteQueen -> 13]; + [WhiteRightCastle -> 15]; [WhiteKing -> 15] } LOC 13 { // w right, b left castle @@ -633,6 +687,7 @@ [BlackRookA8 -> 28]; [BlackRookH8 -> 12]; [BlackQueen -> 12]; + [BlackLeftCastle -> 28]; [BlackKing -> 28] } LOC 14 { // w no, b left castle @@ -677,6 +732,7 @@ [BlackRookA8 -> 30]; [BlackRookH8 -> 14]; [BlackQueen -> 14]; + [BlackLeftCastle -> 30]; [BlackKing -> 30] } LOC 16 { // w can, b right castle @@ -699,6 +755,8 @@ [WhiteRookA1 -> 21]; [WhiteRookH1 -> 19]; [WhiteQueen -> 17]; + [WhiteLeftCastle -> 23]; + [WhiteRightCastle -> 23]; [WhiteKing -> 23] } LOC 17 { // w can, b right castle @@ -721,6 +779,7 @@ [BlackRookA8 -> 16]; [BlackRookH8 -> 24]; [BlackQueen -> 16]; + [BlackRightCastle -> 24]; [BlackKing -> 24] } LOC 18 { // w left, b right castle @@ -743,6 +802,7 @@ [WhiteRookA1 -> 23]; [WhiteRookH1 -> 19]; [WhiteQueen -> 19]; + [WhiteLeftCastle -> 23]; [WhiteKing -> 23] } LOC 19 { // w left, b right castle @@ -765,6 +825,7 @@ [BlackRookA8 -> 18]; [BlackRookH8 -> 26]; [BlackQueen -> 18]; + [BlackRightCastle -> 26]; [BlackKing -> 26] } LOC 20 { // w right, b right castle @@ -787,6 +848,7 @@ [WhiteRookA1 -> 21]; [WhiteRookH1 -> 23]; [WhiteQueen -> 21]; + [WhiteRightCastle -> 23]; [WhiteKing -> 23] } LOC 21 { // w right, b right castle @@ -809,6 +871,7 @@ [BlackRookA8 -> 20]; [BlackRookH8 -> 28]; [BlackQueen -> 20]; + [BlackRightCastle -> 28]; [BlackKing -> 28] } LOC 22 { // w no, b right castle @@ -853,6 +916,7 @@ [BlackRookA8 -> 22]; [BlackRookH8 -> 30]; [BlackQueen -> 22]; + [BlackRightCastle -> 30]; [BlackKing -> 30] } LOC 24 { // w can, b no castle @@ -875,6 +939,8 @@ [WhiteRookA1 -> 29]; [WhiteRookH1 -> 27]; [WhiteQueen -> 25]; + [WhiteLeftCastle -> 31]; + [WhiteRightCastle -> 31]; [WhiteKing -> 31] } LOC 25 { // w can, b no castle @@ -919,6 +985,7 @@ [WhiteRookA1 -> 31]; [WhiteRookH1 -> 27]; [WhiteQueen -> 27]; + [WhiteLeftCastle -> 31]; [WhiteKing -> 31] } LOC 27 { // w left, b no castle @@ -963,6 +1030,7 @@ [WhiteRookA1 -> 29]; [WhiteRookH1 -> 31]; [WhiteQueen -> 29]; + [WhiteRightCastle -> 31]; [WhiteKing -> 31] } LOC 29 { // w right, b no castle @@ -1034,7 +1102,7 @@ MODEL [ | | ] " ... ... ... ... - bR bN.bB bQ.bK bB.bN bR. + bR ... ...bK bB.bN bR. ... ... ... ... bP.bP bP.bP bP.bP bP.bP ... ... ... ... @@ -1048,7 +1116,7 @@ ... ... ... ... wP wP.wP wP.wP wP.wP wP. ... ... ... ... - wR.wN wB.wQ wK.wB wN.wR + wR.wN wB.wQ wK. ...wR " with D1(x, y) = ex z ( (R(x, z) and C(z, y)) or (R(y, z) and C(z, x)) ) ; D2(x, y) = ex z ( (R(x, z) and C(y, z)) or (R(y, z) and C(x, z)) ) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-05 21:51:56
|
Revision: 1225 http://toss.svn.sourceforge.net/toss/?rev=1225&view=rev Author: lukstafi Date: 2010-12-05 21:51:48 +0000 (Sun, 05 Dec 2010) Log Message: ----------- Better rule parsing error messages. More diagnostic logging. Small board handling fix (one pending). Endline comments syntax C++ style. Signature-related fixes in DiscreteRule. Modified Paths: -------------- trunk/Toss/Arena/Arena.ml trunk/Toss/Arena/Arena.mli trunk/Toss/Arena/ArenaParser.mly trunk/Toss/Arena/ContinuousRule.ml trunk/Toss/Arena/ContinuousRuleParser.mly trunk/Toss/Arena/DiscreteRule.ml trunk/Toss/Arena/DiscreteRule.mli trunk/Toss/Formula/FFTNF.ml trunk/Toss/Formula/Lexer.mll trunk/Toss/Play/Game.ml trunk/Toss/Play/GameTest.ml trunk/Toss/Play/Heuristic.ml trunk/Toss/Solver/Structure.ml trunk/Toss/Solver/Structure.mli trunk/Toss/examples/Chess.toss Modified: trunk/Toss/Arena/Arena.ml =================================================================== --- trunk/Toss/Arena/Arena.ml 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Arena/Arena.ml 2010-12-05 21:51:48 UTC (rev 1225) @@ -1,5 +1,7 @@ (* Represent the game arena and operate on it. *) +let debug_level = ref 0 + (* The label's time interval defaults to this point. *) let cDEFAULT_TIMESTEP = 0.1 @@ -88,8 +90,10 @@ default location is 0, default time is 0.0, default data is empty. *) type definition = - | DefRule of string * ((string * int) list -> - (string * (string list * Formula.formula)) list -> ContinuousRule.rule) + | DefRule of string * ( + (string * int) list -> + (string * (string list * Formula.formula)) list -> string -> + ContinuousRule.rule) (* add a rule *) | DefLoc of ((string * int) list -> location) (* add location to graph *) @@ -145,6 +149,8 @@ payoffs = payoffs; payoffs_pp = payoffs_pp; moves = moves } +open Printf + (* Create a game state, possibly by extending an old state, from a list of definitions (usually corresponding to a ".toss" file.) *) let process_definition ?extend_state defs = @@ -161,37 +167,50 @@ state.game.defined_rels, state.struc, state.time, state.cur_loc, state.data in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "process_definition: %d old rules, %d old locs\n%!" + (List.length old_rules) (List.length old_locs); + ); + (* }}} *) let rules, locations, players, defined_rels, state, time, cur_loc, data = - List.fold_left (fun (rules, locations, players, defined_rels, - state, time, cur_loc, data) -> function - | DefRule (rname, r) -> - ((rname, r)::rules, locations, players, defined_rels, - state, time, cur_loc, data) - | DefLoc loc -> - (rules, loc::locations, players, defined_rels, - state, time, cur_loc, data) - | DefPlayers more_players -> - (rules, locations, players @ more_players, defined_rels, - state, time, cur_loc, data) - | DefRel (rel, args, body) -> - (rules, locations, players, - (rel, args, body)::defined_rels, - state, time, cur_loc, data) - | StateStruc struc -> - (rules, locations, players, defined_rels, - struc, time, cur_loc, data) - | StateTime ntime -> - (rules, locations, players, defined_rels, - state, ntime, cur_loc, data) - | StateLoc ncur_loc -> - (rules, locations, players, defined_rels, - state, time, ncur_loc, data) - | StateData more_data -> - (rules, locations, players, defined_rels, - state, time, cur_loc, data @ more_data) - ) ([], [], players, defined_rels, - state, time, cur_loc, data) defs in + List.fold_right (fun def (rules, locations, players, defined_rels, + state, time, cur_loc, data) -> + match def with + | DefRule (rname, r) -> + ((rname, r)::rules, locations, players, defined_rels, + state, time, cur_loc, data) + | DefLoc loc -> + (rules, loc::locations, players, defined_rels, + state, time, cur_loc, data) + | DefPlayers more_players -> + (rules, locations, players @ more_players, defined_rels, + state, time, cur_loc, data) + | DefRel (rel, args, body) -> + (rules, locations, players, + (rel, args, body)::defined_rels, + state, time, cur_loc, data) + | StateStruc struc -> + (rules, locations, players, defined_rels, + struc, time, cur_loc, data) + | StateTime ntime -> + (rules, locations, players, defined_rels, + state, ntime, cur_loc, data) + | StateLoc ncur_loc -> + (rules, locations, players, defined_rels, + state, time, ncur_loc, data) + | StateData more_data -> + (rules, locations, players, defined_rels, + state, time, cur_loc, data @ more_data) + ) defs ([], [], players, defined_rels, + state, time, cur_loc, data) in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "process_definition: %d new rules, %d defined rels\n%!" + (List.length rules) (List.length defined_rels); + ); + (* }}} *) let def_rels_pure = List.map (fun (rel, args, body) -> (rel, (args, body))) defined_rels in let defined_rels = @@ -204,9 +223,19 @@ let num_players = List.length player_names in let signature = Structure.StringMap.fold (fun rel ar si -> (rel, ar)::si) state.Structure.rel_signature [] in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "process_definition: parsing new rules...%!"; + ); + (* }}} *) let rules = old_rules @ List.map (fun (name, r) -> - name, r signature def_rels_pure) rules in + name, r signature def_rels_pure name) rules in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf " parsed\n%!"; + ); + (* }}} *) let rules = List.sort (fun (rn1,_) (rn2,_)->String.compare rn1 rn2) rules in let updated_locs = @@ -228,8 +257,18 @@ let reg_ps = Array.map SolverIntf.M.register_real_expr ps in { loc with payoffs = ps; payoffs_pp = reg_ps } in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf "process_definition: parsing locations (registering payoffs)...%!"; + ); + (* }}} *) let locations = updated_locs @ List.map (fun loc -> add_def_rel (loc player_names)) locations in + (* {{{ log entry *) + if !debug_level > 2 then ( + printf " parsed\n%!"; + ); + (* }}} *) let graph = try Aux.array_from_assoc @@ -313,11 +352,11 @@ if !equational_def_style then Format.fprintf ppf "@[<1>REL@ %s@,(@[<1>%a@])@ =@ @[<1>%a@]" drel (Aux.fprint_sep_list "," Format.pp_print_string) args - (Formula.fprint(* _nobra 0 *)) body + Formula.fprint body else Format.fprintf ppf "@[<1>REL@ %s@,(@[<1>%a@])@ {@,@[<1>%a@,@]}" drel (Aux.fprint_sep_list "," Format.pp_print_string) args - (Formula.fprint(* _nobra 0 *)) body; + Formula.fprint body; Format.fprintf ppf "@]@ "; ) defined_rels; Format.fprintf ppf "@[<1>PLAYERS@ %a@]@ " @@ -408,7 +447,8 @@ | EvalRealExpr of Formula.real_expr (* Evaluate real expr *) | SetRule of string * ((string * int) list -> - (string * (string list * Formula.formula)) list -> ContinuousRule.rule) + (string * (string list * Formula.formula)) list -> string -> + ContinuousRule.rule) (* Set a rule as given *) | GetRule of string (* Get a rule as string *) | SetRuleUpd of string*string *string *Term.term (* Set a rule update eq *) @@ -681,7 +721,7 @@ (fun (drel, (args, body, _)) -> drel,(args,body)) state.game.defined_rels in let new_rules = - Aux.replace_assoc r_name (r signat defs) + Aux.replace_assoc r_name (r signat defs r_name) state.game.rules in ({ state with game = {state.game with rules=new_rules} }, "SET RULE") with Modified: trunk/Toss/Arena/Arena.mli =================================================================== --- trunk/Toss/Arena/Arena.mli 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Arena/Arena.mli 2010-12-05 21:51:48 UTC (rev 1225) @@ -1,5 +1,7 @@ (* Represent the game arena and operate on it. *) +val debug_level : int ref + (* ------------------------ BASIC TYPE DEFINITIONS -------------------------- *) (* A single move consists of applying a rewrite rule for a time from the @@ -76,8 +78,10 @@ default location is 0, default time is 0.0, default data is empty. *) type definition = - | DefRule of string * ((string * int) list -> - (string * (string list * Formula.formula)) list -> ContinuousRule.rule) + | DefRule of string * ( + (string * int) list -> + (string * (string list * Formula.formula)) list -> string -> + ContinuousRule.rule) (* add a rule *) | DefLoc of ((string * int) list -> location) (* add location to graph *) @@ -155,7 +159,8 @@ | EvalRealExpr of Formula.real_expr (* Evaluate real expr *) | SetRule of string * ((string * int) list -> - (string * (string list * Formula.formula)) list -> ContinuousRule.rule) + (string * (string list * Formula.formula)) list -> string -> + ContinuousRule.rule) (* Set a rule as given *) | GetRule of string (* Get a rule as string *) | SetRuleUpd of string*string *string *Term.term (* Set a rule update eq *) Modified: trunk/Toss/Arena/ArenaParser.mly =================================================================== --- trunk/Toss/Arena/ArenaParser.mly 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Arena/ArenaParser.mly 2010-12-05 21:51:48 UTC (rev 1225) @@ -94,7 +94,7 @@ | REL_MOD rel = ID arg = delimited (OPEN, separated_list (COMMA, ID), CLOSE) EQ - body = formula_expr %prec COND + body = formula_expr { DefRel (rel, arg, body) } | MODEL_SPEC model = struct_expr { StateStruc model } Modified: trunk/Toss/Arena/ContinuousRule.ml =================================================================== --- trunk/Toss/Arena/ContinuousRule.ml 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Arena/ContinuousRule.ml 2010-12-05 21:51:48 UTC (rev 1225) @@ -32,7 +32,7 @@ let discrete = { discr with DiscreteRule.pre = cpre } in let defrels = List.map (fun (rel,(args,body)) -> rel, (args, body, SolverIntf.M.register_formula body)) defs in - let obj = DiscreteRule.compile_rule signat defrels discrete in + let obj = DiscreteRule.compile_rule signat defrels discr in { discrete = discrete; compiled = obj ; dynamics = dynamics ; Modified: trunk/Toss/Arena/ContinuousRuleParser.mly =================================================================== --- trunk/Toss/Arena/ContinuousRuleParser.mly 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Arena/ContinuousRuleParser.mly 2010-12-05 21:51:48 UTC (rev 1225) @@ -8,7 +8,7 @@ %start parse_rule %type < (string * int) list -> - (string * (string list * Formula.formula)) list -> + (string * (string list * Formula.formula)) list -> string -> ContinuousRule.rule> parse_rule rule_expr @@ -22,10 +22,15 @@ pre = option (preceded (PRE, formula_expr)) inv = option (preceded (INV, formula_expr)) post = option (preceded (POST, formula_expr)) - { fun signat defs -> + { fun signat defs rname -> (* no need to bother passing [pre] to [discr] *) - ContinuousRule.make_rule signat defs (discr signat (And [])) - dyn upd ?pre ?inv ?post () } + try + ContinuousRule.make_rule signat defs (discr signat (And [])) + dyn upd ?pre ?inv ?post () + with Failure s -> + report_parsing_error $startpos $endpos + ("Error in rule "^rname^": "^s) + } parse_rule: rule_expr EOF { $1 }; Modified: trunk/Toss/Arena/DiscreteRule.ml =================================================================== --- trunk/Toss/Arena/DiscreteRule.ml 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Arena/DiscreteRule.ml 2010-12-05 21:51:48 UTC (rev 1225) @@ -1,5 +1,7 @@ (* Discrete structure rewriting. *) +let debug_level = ref 0 + type matching = (int * int) list type matchings = Assignments.assignment_set @@ -123,8 +125,7 @@ r, negative_trace rel r.lhs_form, args_l) rel_prods) in let precond = match disjs with - | [] -> raise (Invalid_argument - ("fluent_preconds: not a fluent: "^rel)) + | [] -> failwith ("fluent_preconds: not a fluent: "^rel) | [phi] -> phi | _ -> Formula.Or disjs in rel, (nu_args, precond) in @@ -553,6 +554,12 @@ embedding condition). *) let compile_rule signat defined_rels rule_src = + (* TODO: but these shouldn't get into the signature in the first + place... See also [rhs_rels] -- empty defined relations appear in + RHS structure. *) + let signat = List.filter (fun (rel,_) -> + special_rel_of rel = None && + not (List.mem_assoc rel defined_rels)) signat in let expand_def_rels rel = if List.mem_assoc rel defined_rels then let args, _, rphi = List.assoc rel defined_rels in @@ -594,7 +601,13 @@ (* expand defined rels in embedding list *) let base_emb_rels = unique (=) (concat_map expand_def_rels rule_src.emb_rels) in - + (* {{{ log entry *) + if !debug_level > 1 then ( + Printf.printf "compile_rule: emb=%s -- base_emb_rels=%s\n%!" + (String.concat ", " rule_src.emb_rels) + (String.concat ", " base_emb_rels); + ); + (* }}} *) let tups_union ts1 ts2 = Aux.unique (=) (ts1 @ ts2) and tups_empty = [] and tups_diff ts1 ts2 = @@ -763,13 +776,19 @@ (* RHS *) let rhs_rels = SSMap.fold (fun rel tups rels -> - (rel, STups.elements tups) :: rels) + if STups.is_empty tups then rels + else (rel, STups.elements tups) :: rels) rule_src.rhs_struc.Structure.relations [] in let rhs_opt_rels, rhs_rels, _ = compile_opt_rels rhs_rels in if List.exists (fun (drel, _) -> List.mem_assoc drel rhs_rels) defined_rels - then failwith "Non-optional defined relation on RHS."; + then failwith + ("Non-optional defined relation(s) "^ + String.concat ", " (Aux.map_some (fun (drel,_) -> + if List.mem_assoc drel rhs_rels then Some drel else None) + defined_rels) + ^" on RHS."); (* if the rule is optimized for "nonstructural" rewriting, elements are already renamed; raises Not_found when adding elements *) let mapf_rn = if rlmap = None then fun x->x else @@ -934,20 +953,21 @@ let build_rule_s ?rule_s lhs rhs = let l_elem le = try Structure.find_elem lhs le - with Not_found -> raise (Invalid_argument ( - "\"with\" clause element "^le^" not found in LHS.")) in + with Not_found -> failwith + ("\"with\" clause element "^le^" not found in LHS.") in let r_elem re = try Structure.find_elem rhs re - with Not_found -> raise (Invalid_argument ( - "\"with\" clause element "^re^" not found in RHS.")) in + with Not_found -> failwith + ("\"with\" clause element "^re^" not found in RHS.") in let r_str re = Structure.elem_str rhs re in match rule_s with | None -> - if Structure.Elems.cardinal lhs.Structure.elements <> - Structure.Elems.cardinal rhs.Structure.elements - then raise (Invalid_argument - ("\"with\" clause not given but LHS and RHS "^ - "structures have different size")) + let lnum = Structure.Elems.cardinal lhs.Structure.elements in + let rnum = Structure.Elems.cardinal rhs.Structure.elements in + if lnum <> rnum + then failwith + (Printf.sprintf "\"with\" clause not given but LHS and RHS \ + structures have different sizes %d and %d" lnum rnum) else Structure.Elems.fold (fun re acc -> (re, l_elem (r_str re))::acc) rhs.Structure.elements [] Modified: trunk/Toss/Arena/DiscreteRule.mli =================================================================== --- trunk/Toss/Arena/DiscreteRule.mli 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Arena/DiscreteRule.mli 2010-12-05 21:51:48 UTC (rev 1225) @@ -1,5 +1,7 @@ (* Discrete Structure Rewriting Rules and Rewriting. *) +val debug_level : int ref + (* Single match of a rule, and a set of matches. *) type matching = (int * int) list type matchings = Assignments.assignment_set Modified: trunk/Toss/Formula/FFTNF.ml =================================================================== --- trunk/Toss/Formula/FFTNF.ml 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Formula/FFTNF.ml 2010-12-05 21:51:48 UTC (rev 1225) @@ -441,11 +441,11 @@ let location_str loc = sprintf "%s#[%s]" - (Formula.str (unpack_flat ( + (Formula.sprint (unpack_flat ( formula_of_tree (zip_nonflat {loc with n={ fvs=Vars.empty; t=TProc (-1,Rel("[HOLE]",[||]))}})))) - (Formula.str (unpack_flat (formula_of_tree loc.n))) + (Formula.sprint (unpack_flat (formula_of_tree loc.n))) (* Flatten and convert to a formula. *) (* While translating, also simplify constant truth values. *) @@ -618,7 +618,7 @@ | {t=TNot_subtask subt} -> Left subt, {loc with n={fvs=Vars.empty; t=TAnd[]}} | {fvs=lit_vs; t=TLit lit} -> - let _ = if !debug_level > 3 then + let _ = if !debug_level > 4 then printf "find_unprot: processing literal %s, loc %s\n" (Formula.str lit) (location_str loc) in let best_loc = (* store if first *) @@ -631,7 +631,7 @@ best_loc | _ -> let _ = if !debug_level > 3 then begin - printf "find_unprot: selecting it\n" end in + printf "find_unprot: selecting %s\n" (Formula.str lit) end in Some ((lit,lit_vs), {loc with n={fvs=Vars.empty; t=TAnd[]}}) in advance best_loc @@ -661,7 +661,7 @@ (* The rewriting steps. Uses a callback to process subtasks recursively before putting them in their final locations. *) let rec pull_out subproc (task_id, task_lit as task) loc = - let _ = if !debug_level > 2 then + let _ = if !debug_level > 4 then printf "\npull-out_step_location: %s\n" (location_str loc) in let lit_vs, put_result = match task_lit with @@ -878,19 +878,19 @@ let _ = if !debug_level > 2 then begin printf "\nfound_subtask-literal: %s\n" (match subt_lit with - | Left subt -> Formula.str (Not subt) + | Left subt -> Formula.sprint (Not subt) | Right (lit,_) -> Formula.str lit); printf "location: %s\n" (location_str loc) end in let phi = pull_out subproc (i, subt_lit) loc in if !debug_level > 2 then printf "\npull-out_result: %s\n" - (Formula.str (formula_of_tree phi)); + (Formula.sprint (formula_of_tree phi)); loop (i+1) {x=Top; n=phi} with Lit_not_found -> let result = zip loc in let _ = if !debug_level > 2 then begin printf "\nff_tnf-result: %s\n" - (Formula.str (formula_of_tree result)) end in + (Formula.sprint (formula_of_tree result)) end in result and subproc subt = @@ -903,10 +903,10 @@ let res = loop 0 loc in if !debug_level > 1 then - printf "ff_tnf: res=%s\n%!" (Formula.str (formula_of_tree res)); + printf "ff_tnf: res=%s\n%!" (Formula.sprint (formula_of_tree res)); let flat = flatten_tree_to_formula res in if !debug_level > 1 then - printf "ff_tnf: flat=%s\n%!" (Formula.str flat); + printf "ff_tnf: flat=%s\n%!" (Formula.sprint flat); flat Modified: trunk/Toss/Formula/Lexer.mll =================================================================== --- trunk/Toss/Formula/Lexer.mll 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Formula/Lexer.mll 2010-12-05 21:51:48 UTC (rev 1225) @@ -95,6 +95,19 @@ pos_bol = pos.Lexing.pos_cnum; } +let move_lines_by lexbuf s = + let nbrk = ref 0 in + for i = 0 to String.length s - 1 do + if s.[i] = '\n' then incr nbrk + done; + if !nbrk > 0 then + let pos = lexbuf.Lexing.lex_curr_p in + lexbuf.Lexing.lex_curr_p <- { pos with + Lexing.pos_lnum = pos.Lexing.pos_lnum + !nbrk; + pos_bol = pos.Lexing.pos_cnum; + } + + (* Parsing errors are about both syntax and semantics. *) exception Parsing_error of string @@ -195,16 +208,17 @@ | "STATE" { STATE_SPEC } | "LEFT" { LEFT_SPEC } | "RIGHT" { RIGHT_SPEC } - | ['0'-'9']+ as n { INT (int_of_string n) } - | '-' ['0'-'9']+ as n { INT (int_of_string n) } - | ['0'-'9']* '.' ['0'-'9']+ as x { FLOAT (float_of_string x) } - | ['0'-'9']+ '.' ['0'-'9']* as x { FLOAT (float_of_string x) } + | ['0'-'9']+ as n { INT (int_of_string n) } + | '-' ['0'-'9']+ as n { INT (int_of_string n) } + | ['0'-'9']* '.' ['0'-'9']+ as x { FLOAT (float_of_string x) } + | ['0'-'9']+ '.' ['0'-'9']* as x { FLOAT (float_of_string x) } | '-' ['0'-'9']* '.' ['0'-'9']+ as x { FLOAT (float_of_string x) } | '-' ['0'-'9']+ '.' ['0'-'9']* as x { FLOAT (float_of_string x) } | ['A'-'Z' 'a'-'z' '_']['0'-'9' 'A'-'Z' 'a'-'z' '_']* as s { ID (s) } | '"'(['0'-'9' 'A'-'Z' 'a'-'z' ' ' '.' '_' '\t' '\n' '*' '+' '-' '?' '#']+ - as s)'"' { BOARD_STRING (s) } + as s)'"' { move_lines_by lexbuf s; BOARD_STRING (s) } | '#' (['0'-'9' 'A'-'Z' 'a'-'z' ' ' '.' ':' '_' '\t' '*' '+' '-' '?' '/' '\\']+ - as s) '#' { reset_as_file lexbuf s; lex lexbuf } + as s) '#' { reset_as_file lexbuf s; lex lexbuf } + | "//" [^ '\n']* '\n' { incr_lineno lexbuf; lex lexbuf } | eof { EOF } Modified: trunk/Toss/Play/Game.ml =================================================================== --- trunk/Toss/Play/Game.ml 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Play/Game.ml 2010-12-05 21:51:48 UTC (rev 1225) @@ -249,10 +249,12 @@ Array.map (fun node -> Array.map (fun payoff -> (* {{{ log entry *) + if !debug_level > 3 then ( Printf.printf "default_hauristic: Computing of payoff %s...\n%!" - (Formula.real_str payoff); + (Formula.sprint_real payoff); ); + (* }}} *) Heuristic.of_payoff ?struc ?fluent_preconds advance_ratio (Aux.strings_of_list fluents) payoff) Modified: trunk/Toss/Play/GameTest.ml =================================================================== --- trunk/Toss/Play/GameTest.ml 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Play/GameTest.ml 2010-12-05 21:51:48 UTC (rev 1225) @@ -72,7 +72,7 @@ *) let emb_rels = Structure.StringMap.fold (fun rel arity acc -> - if arity = 1 && not (DiscreteRule.special_rel_of rel = Some "opt") + if arity = 1 && DiscreteRule.special_rel_of rel = None then rel::acc else acc) lhs_struc.Structure.rel_signature [] in let pre = formula_of_str precond in @@ -565,11 +565,11 @@ "play: chess suggest first move" >:: (fun () -> - todo "Payoff too difficult for heuristic generation."; + (* todo "Payoff too difficult for heuristic generation."; *) let state = chess_game in Game.set_debug_level 7; Heuristic.debug_level := 7; - FFTNF.debug_level := 7; + FFTNF.debug_level := 4; let move_opt = (let p,ps = Game.initialize_default (snd state) ~heur_adv_ratio:(fst state) ~loc:0 ~effort:2 @@ -1101,7 +1101,7 @@ (* The same content as in .toss files. *) let a = - print_endline ("\n" ^ Arena.sprint_state (snd gomoku19x19_game)) + print_endline ("\n" ^ Arena.sprint_state (snd chess_game)) let a () = Game.set_debug_level 7 Modified: trunk/Toss/Play/Heuristic.ml =================================================================== --- trunk/Toss/Play/Heuristic.ml 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Play/Heuristic.ml 2010-12-05 21:51:48 UTC (rev 1225) @@ -592,7 +592,7 @@ let substs = trunc_to_vars vars substs in if !debug_level > 2 then ( printf "expanded_descritpion: phi=%s; aset=%s\nsubsts=%s\n%!" - (Formula.str phi) + (Formula.sprint phi) (AssignmentSet.str aset) (String.concat "; " (List.map (fun sb->String.concat ", " @@ -628,7 +628,7 @@ if !debug_level > 3 then ( Printf.printf "Heuristic: computing expanded description for %s...\n%!" - (Formula.str phi) + (Formula.sprint phi) ); (* }}} *) let substs = @@ -818,7 +818,7 @@ if !debug_level > 2 then ( Printf.printf "Heuristic: for expanding, get ff-tnf of %s...\n%!" - (Formula.str phi); + (Formula.sprint phi); ); (* }}} *) let phi'' = @@ -827,7 +827,7 @@ if !debug_level > 2 then ( Printf.printf "Heuristic: computing expanded form of %s...\n%!" - (Formula.str phi''); + (Formula.sprint phi''); ); (* }}} *) expanded_form max_alt_descr frels struc phi'' @@ -836,7 +836,7 @@ if !debug_level > 2 then ( Printf.printf "Heuristic: computing for (expanded) formula %s...\n%!" - (Formula.str phi') + (Formula.sprint phi') ); (* }}} *) of_formula adv_ratio @@ -847,7 +847,7 @@ if !debug_level > 2 then ( Printf.printf "Heuristic: computing monotonic for %s...\n%!" - (Formula.str phi); + (Formula.sprint phi); ); (* }}} *) (* FIXME: shouldn't be expanding? *) Modified: trunk/Toss/Solver/Structure.ml =================================================================== --- trunk/Toss/Solver/Structure.ml 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Solver/Structure.ml 2010-12-05 21:51:48 UTC (rev 1225) @@ -4,6 +4,8 @@ let cBOARD_DX = 15.0 let cBOARD_DY = -15.0 +let debug_level = ref 0 + (* ------------------------- TYPE DEFINITIONS -------------------------- *) module IntMap = Map.Make (* Maps from int to 'alpha *) @@ -141,6 +143,9 @@ if Elems.mem e struc.elements then e else raise Not_found +(* Add an element by name, return the updated structure and the + element. Search for an element with the given name in the + structure, and if not found, add new element with this name. *) let find_or_new_elem struc name = if StringMap.mem name struc.names then struc, StringMap.find name struc.names @@ -564,52 +569,61 @@ (* Ignore special relations. *) let find_unique all_preds = + (* FIXME: don't force prefix-free *) let all_preds = List.filter (fun r -> r.[0] <> '_') all_preds in (* build a fixed depth trie *) - let trie1 = List.fold_left (fun trie rel -> - if List.mem_assoc rel.[0] trie then - let rels, trie = Aux.pop_assoc rel.[0] trie in - (rel.[0], rel::rels)::trie - else (rel.[0], [rel])::trie + let trie1 = List.fold_left (fun trie pred -> + if List.mem_assoc pred.[0] trie then + let preds, trie = Aux.pop_assoc pred.[0] trie in + (pred.[0], pred::preds)::trie + else (pred.[0], [pred])::trie ) [] all_preds in + let trie1 = List.map (fun (k,preds) -> + let trunc = + List.filter (fun r -> String.length r = 1) preds in + if trunc = [] then k, preds else k, trunc) trie1 in let uniq1, trie1 = Aux.partition_map - (function (k,[rel]) -> Aux.Left (rel, Char.escaped k) + (function (k,[pred]) -> Aux.Left (pred, Char.escaped k) | subt -> Aux.Right subt) trie1 in let trie1 = List.map - (fun (k, rels) -> k, List.filter - (fun rel -> String.length rel > 1) rels) trie1 in + (fun (k, preds) -> k, List.filter + (fun pred -> String.length pred > 1) preds) trie1 in let trie2 = Aux.concat_map (fun (key, preds) -> let trie2 = - List.fold_left (fun trie rel -> - if List.mem_assoc rel.[1] trie then - let rels, trie = Aux.pop_assoc rel.[1] trie in - (rel.[1], rel::rels)::trie - else (rel.[1], [rel])::trie + List.fold_left (fun trie pred -> + if List.mem_assoc pred.[1] trie then + let preds, trie = Aux.pop_assoc pred.[1] trie in + (pred.[1], pred::preds)::trie + else (pred.[1], [pred])::trie ) [] preds in List.map (fun (key2, preds) -> Char.escaped key ^ Char.escaped key2, preds) trie2 ) trie1 in + let trie2 = List.map (fun (k,preds) -> + let trunc = + List.filter (fun r -> String.length r = 2) preds in + if trunc = [] then k, preds else k, trunc) trie2 in let uniq2, trie2 = Aux.partition_map - (function (k,[rel]) -> Aux.Left (rel, k) + (function (k,[pred]) -> Aux.Left (pred, k) | subt -> Aux.Right subt) trie2 in let trie2 = List.map - (fun (k, rels) -> k, List.filter - (fun rel -> String.length rel > 2) rels) trie2 in + (fun (k, preds) -> k, List.filter + (fun pred -> String.length pred > 2) preds) trie2 in let trie3 = Aux.concat_map (fun (key, preds) -> let trie3 = - List.fold_left (fun trie rel -> - if List.mem_assoc rel.[2] trie then - let rels, trie = Aux.pop_assoc rel.[2] trie in - (rel.[2], rel::rels)::trie - else (rel.[2], [rel])::trie + List.fold_left (fun trie pred -> + if List.mem_assoc pred.[2] trie then + let preds, trie = Aux.pop_assoc pred.[2] trie in + (pred.[2], pred::preds)::trie + else (pred.[2], [pred])::trie ) [] preds in List.map (fun (key2, preds) -> key ^ Char.escaped key2, preds) trie3 ) trie2 in let uniq3 = Aux.map_some - (function (k,[rel]) -> Some (rel,k) | _ -> None) trie3 in + (function (k,[pred]) -> Some (pred,k) | _ -> None) trie3 in uniq1, uniq2, uniq3 @@ -710,7 +724,16 @@ inferred parameters (row / column relations and position increments), and the structure with information already extracted into the string removed. *) -let board_to_string struc = +let rec board_to_string struc = + (* {{{ log entry *) + if !debug_level > 1 then ( + let old_level = !debug_level in + debug_level := 0; + let bstr,_ = board_to_string struc in + Printf.printf "board_to_string: printing of %s\n%!" bstr; + debug_level := old_level; + ); + (* }}} *) let col_index = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" in (* find the spanning rectangle *) @@ -833,10 +856,22 @@ StringMap.fold (fun rel arity predicates -> if arity = 1 then rel::predicates else predicates) struc.rel_signature [] in + (* {{{ log entry *) + if !debug_level > 1 then ( + Printf.printf "board_to_string: all_predicates=%s\n%!" + (String.concat ", " all_predicates); + ); + (* }}} *) let uniq1, uniq2, uniq3 = find_unique all_predicates in let uniq_long = uniq1 @ uniq2 @ uniq3 in let uniq_short = uniq1 @ uniq2 in + (* {{{ log entry *) + if !debug_level > 1 then ( + Printf.printf "board_to_string: uniq_long=%s\n%!" + (String.concat ", " (List.map fst uniq_long)); + ); + (* }}} *) let ret = ref struc in for c=1 to c_max do for r=1 to r_max do @@ -850,7 +885,7 @@ c_max*3*(r_max - r)*2 + c_max*3 + 2*(r_max - r)*2 + (c-1)*3 + 3 in if elem = -1 then board.[lower_left] <- '*' else begin - (* collect the predicates *) + (* collect the predicates *) let tup = [|elem|] in let predicates = List.filter (fun pred -> @@ -858,12 +893,12 @@ try StringMap.find pred !ret.relations with Not_found -> Tuples.empty in Tuples.mem tup tmap && - let rmap = - try StringMap.find pred !ret.incidence - with Not_found -> IntMap.empty in - not (Tuples.is_empty ( - try IntMap.find elem rmap - with Not_found -> Tuples.empty))) + let rmap = + try StringMap.find pred !ret.incidence + with Not_found -> IntMap.empty in + not (Tuples.is_empty ( + try IntMap.find elem rmap + with Not_found -> Tuples.empty))) all_predicates in let up_line = String.make 3 ' ' and lo_line = String.make 3 ' ' in @@ -902,18 +937,18 @@ init_pos_x +. float_of_int (c - 1) *. pos_dx in let pos_y = init_pos_y +. float_of_int (r - 1) *. pos_dy in - if try fun_val !ret "x" elem = pos_x - with Not_found -> false then - ret := del_fun !ret "x" elem; - if try fun_val !ret "y" elem = pos_y - with Not_found -> false then - ret := del_fun !ret "y" elem; - if try fun_val !ret "vx" elem = 0.0 - with Not_found -> false then - ret := del_fun !ret "vx" elem; - if try fun_val !ret "vy" elem = 0.0 - with Not_found -> false then - ret := del_fun !ret "vy" elem; + if (try fun_val !ret "x" elem = pos_x + with Not_found -> false) + then ret := del_fun !ret "x" elem; + if (try fun_val !ret "y" elem = pos_y + with Not_found -> false) + then ret := del_fun !ret "y" elem; + if (try fun_val !ret "vx" elem = 0.0 + with Not_found -> false) + then ret := del_fun !ret "vx" elem; + if (try fun_val !ret "vy" elem = 0.0 + with Not_found -> false) + then ret := del_fun !ret "vy" elem; end done done; @@ -936,8 +971,8 @@ else struc with Not_found -> struc in ret := List.fold_left clear_empty !ret ["x"; "y"; "vx"; "vy"]; - (* relations that are in the structure for the sake of - signature, i.e. they're empty *) + (* relations that are in the structure for the sake of + signature, i.e. they're empty *) let signat_rels = StringMap.fold (fun rel tups acc -> if Tuples.is_empty tups then rel::acc else acc) @@ -1100,7 +1135,7 @@ then ( let elname = Char.escaped col_index.[c-1] ^ string_of_int r in let nstruc, elem = - add_new_elem !struc ~name:elname () in + find_or_new_elem !struc elname in board_els.(c-1).(r-1) <- elem; struc := nstruc; let tup = [|elem|] in Modified: trunk/Toss/Solver/Structure.mli =================================================================== --- trunk/Toss/Solver/Structure.mli 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/Solver/Structure.mli 2010-12-05 21:51:48 UTC (rev 1225) @@ -1,5 +1,6 @@ (* Representing Structures *) +val debug_level : int ref module IntMap : Map.S with type key = int (* Maps from int to 'alpha *) Modified: trunk/Toss/examples/Chess.toss =================================================================== --- trunk/Toss/examples/Chess.toss 2010-12-05 20:52:32 UTC (rev 1224) +++ trunk/Toss/examples/Chess.toss 2010-12-05 21:51:48 UTC (rev 1225) @@ -327,7 +327,7 @@ [ a, b | bK { b } | vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] emb w, b pre Near(a, b) post not CheckB() -LOC 0 { # both can castle # +LOC 0 { // both can castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -349,7 +349,7 @@ [WhiteQueen -> 1]; [WhiteKing -> 7] } -LOC 1 { # both can castle # +LOC 1 { // both can castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -371,7 +371,7 @@ [BlackQueen -> 0]; [BlackKing -> 24] } -LOC 2 { # w left, b can castle # +LOC 2 { // w left, b can castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -393,7 +393,7 @@ [WhiteQueen -> 3]; [WhiteKing -> 7] } -LOC 3 { # w left, b can castle # +LOC 3 { // w left, b can castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -415,7 +415,7 @@ [BlackQueen -> 2]; [BlackKing -> 26] } -LOC 4 { # w right, b can castle # +LOC 4 { // w right, b can castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -437,7 +437,7 @@ [WhiteQueen -> 5]; [WhiteKing -> 7] } -LOC 5 { # w right, b can castle # +LOC 5 { // w right, b can castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -459,7 +459,7 @@ [BlackQueen -> 4]; [BlackKing -> 28] } -LOC 6 { # w no, b can castle # +LOC 6 { // w no, b can castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -481,7 +481,7 @@ [WhiteQueen -> 7]; [WhiteKing -> 7] } -LOC 7 { # w no, b can castle # +LOC 7 { // w no, b can castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -503,7 +503,7 @@ [BlackQueen -> 6]; [BlackKing -> 30] } -LOC 8 { # w can, b left castle # +LOC 8 { // w can, b left castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -525,7 +525,7 @@ [WhiteQueen -> 9]; [WhiteKing -> 15] } -LOC 9 { # w can, b left castle # +LOC 9 { // w can, b left castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -547,7 +547,7 @@ [BlackQueen -> 8]; [BlackKing -> 24] } -LOC 10 { # w left, b left castle # +LOC 10 { // w left, b left castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -569,7 +569,7 @@ [WhiteQueen -> 11]; [WhiteKing -> 15] } -LOC 11 { # w left, b left castle # +LOC 11 { // w left, b left castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -591,7 +591,7 @@ [BlackQueen -> 10]; [BlackKing -> 26] } -LOC 12 { # w right, b left castle # +LOC 12 { // w right, b left castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -613,7 +613,7 @@ [WhiteQueen -> 13]; [WhiteKing -> 15] } -LOC 13 { # w right, b left castle # +LOC 13 { // w right, b left castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -635,7 +635,7 @@ [BlackQueen -> 12]; [BlackKing -> 28] } -LOC 14 { # w no, b left castle # +LOC 14 { // w no, b left castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -657,7 +657,7 @@ [WhiteQueen -> 15]; [WhiteKing -> 15] } -LOC 15 { # w no, b left castle # +LOC 15 { // w no, b left castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -679,7 +679,7 @@ [BlackQueen -> 14]; [BlackKing -> 30] } -LOC 16 { # w can, b right castle # +LOC 16 { // w can, b right castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -701,7 +701,7 @@ [WhiteQueen -> 17]; [WhiteKing -> 23] } -LOC 17 { # w can, b right castle # +LOC 17 { // w can, b right castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -723,7 +723,7 @@ [BlackQueen -> 16]; [BlackKing -> 24] } -LOC 18 { # w left, b right castle # +LOC 18 { // w left, b right castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -745,7 +745,7 @@ [WhiteQueen -> 19]; [WhiteKing -> 23] } -LOC 19 { # w left, b right castle # +LOC 19 { // w left, b right castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -767,7 +767,7 @@ [BlackQueen -> 18]; [BlackKing -> 26] } -LOC 20 { # w right, b right castle # +LOC 20 { // w right, b right castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -789,7 +789,7 @@ [WhiteQueen -> 21]; [WhiteKing -> 23] } -LOC 21 { # w right, b right castle # +LOC 21 { // w right, b right castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -811,7 +811,7 @@ [BlackQueen -> 20]; [BlackKing -> 28] } -LOC 22 { # w no, b right castle # +LOC 22 { // w no, b right castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -833,7 +833,7 @@ [WhiteQueen -> 23]; [WhiteKing -> 23] } -LOC 23 { # w no, b right castle # +LOC 23 { // w no, b right castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -855,7 +855,7 @@ [BlackQueen -> 22]; [BlackKing -> 30] } - LOC 24 { # w can, b no castle # + LOC 24 { // w can, b no castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -877,7 +877,7 @@ [WhiteQueen -> 25]; [WhiteKing -> 31] } -LOC 25 { # w can, b no castle # +LOC 25 { // w can, b no castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -899,7 +899,7 @@ [BlackQueen -> 24]; [BlackKing -> 24] } -LOC 26 { # w left, b no castle # +LOC 26 { // w left, b no castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -921,7 +921,7 @@ [WhiteQueen -> 27]; [WhiteKing -> 31] } -LOC 27 { # w left, b no castle # +LOC 27 { // w left, b no castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -943,7 +943,7 @@ [BlackQueen -> 26]; [BlackKing -> 26] } -LOC 28 { # w right, b no castle # +LOC 28 { // w right, b no castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -965,7 +965,7 @@ [WhiteQueen -> 29]; [WhiteKing -> 31] } -LOC 29 { # w right, b no castle # +LOC 29 { // w right, b no castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -987,7 +987,7 @@ [BlackQueen -> 28]; [BlackKing -> 28] } -LOC 30 { # w no, b no castle # +LOC 30 { // w no, b no castle PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -1009,7 +1009,7 @@ [WhiteQueen -> 31]; [WhiteKing -> 31] } -LOC 31 { # w no, b no castle # +LOC 31 { // w no, b no castle PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <luk...@us...> - 2010-12-05 20:52:38
|
Revision: 1224 http://toss.svn.sourceforge.net/toss/?rev=1224&view=rev Author: lukaszkaiser Date: 2010-12-05 20:52:32 +0000 (Sun, 05 Dec 2010) Log Message: ----------- Track castling possibility in chess. Modified Paths: -------------- trunk/Toss/examples/Chess.toss Modified: trunk/Toss/examples/Chess.toss =================================================================== --- trunk/Toss/examples/Chess.toss 2010-12-05 19:01:10 UTC (rev 1223) +++ trunk/Toss/examples/Chess.toss 2010-12-05 20:52:32 UTC (rev 1224) @@ -3,6 +3,10 @@ REL IsSecond(x) = ex y (C(y, x) and IsFirst(y)) REL IsEight(x) = not ex z C(y, z) REL IsSeventh(x) = ex y (C(x, y) and IsEight(y)) +REL IsA1(x) = not ex z R(z, x) and IsFirst(x) +REL IsH1(x) = not ex z R(x, z) and IsFirst(x) +REL IsA8(x) = not ex z R(z, x) and IsEight(x) +REL IsH8(x) = not ex z R(x, z) and IsEight(x) REL w(x) = wP(x) or wR(x) or wN(x) or wB(x) or wQ(x) or wK(x) REL b(x) = bP(x) or bR(x) or bN(x) or bB(x) or bQ(x) or bK(x) REL DoubleC(x, y) = ex z ((C(x, z) and C(z, y)) or (C(y, z) and C(z, x))) @@ -259,14 +263,42 @@ -> [ a, b | wR { b } | vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] - emb w, b pre Line(a, b) post not CheckW() + emb w, b pre not IsA1(a) and not IsH1(a) and Line(a, b) post not CheckW() +RULE WhiteRookA1: + [ a, b | wR { a }; _opt_b { b } | + vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] + -> + [ a, b | wR { b } | + vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] + emb w, b pre IsA1(a) and Line(a, b) post not CheckW() +RULE WhiteRookH1: + [ a, b | wR { a }; _opt_b { b } | + vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] + -> + [ a, b | wR { b } | + vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] + emb w, b pre IsH1(a) and Line(a, b) post not CheckW() RULE BlackRook: [ a, b | bR { a }; _opt_w { b } | vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] -> [ a, b | bR { b } | vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] - emb w, b pre Line(a, b) post not CheckB() + emb w, b pre not IsA8(a) and not IsH8(a) and Line(a, b) post not CheckB() +RULE BlackRookA8: + [ a, b | bR { a }; _opt_w { b } | + vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] + -> + [ a, b | bR { b } | + vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] + emb w, b pre IsA8(a) and Line(a, b) post not CheckB() +RULE BlackRookH8: + [ a, b | bR { a }; _opt_w { b } | + vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] + -> + [ a, b | bR { b } | + vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] + emb w, b pre IsH8(a) and Line(a, b) post not CheckB() RULE WhiteQueen: [ a, b | wQ { a }; _opt_b { b } | vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] @@ -295,7 +327,7 @@ [ a, b | bK { b } | vx {a->0.,b->10.}; vy {a->0.,b->0.}; x {a->0.,b->10.}; y {a->0.,b->10.} ] emb w, b pre Near(a, b) post not CheckB() -LOC 0 { +LOC 0 { # both can castle # PLAYER 1 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -312,10 +344,12 @@ [WhiteKnight -> 1]; [WhiteBishop -> 1]; [WhiteRook -> 1]; + [WhiteRookA1 -> 5]; + [WhiteRookH1 -> 3]; [WhiteQueen -> 1]; - [WhiteKing -> 1] + [WhiteKing -> 7] } -LOC 1 { +LOC 1 { # both can castle # PLAYER 2 PAYOFF { 1: :(CheckB()) - :(CheckW()); @@ -332,9 +366,671 @@ [BlackKnight -> 0]; [BlackBishop -> 0]; [BlackRook -> 0]; + [BlackRookA8 -> 16]; + [BlackRookH8 -> 8]; [BlackQueen -> 0]; - [BlackKing -> 0] + [BlackKing -> 24] } +LOC 2 { # w left, b can castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 3]; + [WhitePawnMoveDbl -> 3]; + [WhitePawnLeft -> 3]; + [WhitePawnLeftDbl -> 3]; + [WhitePawnRight -> 3]; + [WhitePawnRightDbl -> 3]; + [WhitePawnPromote -> 3]; + [WhiteKnight -> 3]; + [WhiteBishop -> 3]; + [WhiteRook -> 3]; + [WhiteRookA1 -> 7]; + [WhiteRookH1 -> 3]; + [WhiteQueen -> 3]; + [WhiteKing -> 7] + } +LOC 3 { # w left, b can castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 2]; + [BlackPawnMoveDbl -> 2]; + [BlackPawnLeft -> 2]; + [BlackPawnLeftDbl -> 2]; + [BlackPawnRight -> 2]; + [BlackPawnRightDbl -> 2]; + [BlackPawnPromote -> 2]; + [BlackKnight -> 2]; + [BlackBishop -> 2]; + [BlackRook -> 2]; + [BlackRookA8 -> 18]; + [BlackRookH8 -> 10]; + [BlackQueen -> 2]; + [BlackKing -> 26] + } +LOC 4 { # w right, b can castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 5]; + [WhitePawnMoveDbl -> 5]; + [WhitePawnLeft -> 5]; + [WhitePawnLeftDbl -> 5]; + [WhitePawnRight -> 5]; + [WhitePawnRightDbl -> 5]; + [WhitePawnPromote -> 5]; + [WhiteKnight -> 5]; + [WhiteBishop -> 5]; + [WhiteRook -> 5]; + [WhiteRookA1 -> 5]; + [WhiteRookH1 -> 7]; + [WhiteQueen -> 5]; + [WhiteKing -> 7] + } +LOC 5 { # w right, b can castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 4]; + [BlackPawnMoveDbl -> 4]; + [BlackPawnLeft -> 4]; + [BlackPawnLeftDbl -> 4]; + [BlackPawnRight -> 4]; + [BlackPawnRightDbl -> 4]; + [BlackPawnPromote -> 4]; + [BlackKnight -> 4]; + [BlackBishop -> 4]; + [BlackRook -> 4]; + [BlackRookA8 -> 20]; + [BlackRookH8 -> 12]; + [BlackQueen -> 4]; + [BlackKing -> 28] + } +LOC 6 { # w no, b can castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 7]; + [WhitePawnMoveDbl -> 7]; + [WhitePawnLeft -> 7]; + [WhitePawnLeftDbl -> 7]; + [WhitePawnRight -> 7]; + [WhitePawnRightDbl -> 7]; + [WhitePawnPromote -> 7]; + [WhiteKnight -> 7]; + [WhiteBishop -> 7]; + [WhiteRook -> 7]; + [WhiteRookA1 -> 7]; + [WhiteRookH1 -> 7]; + [WhiteQueen -> 7]; + [WhiteKing -> 7] + } +LOC 7 { # w no, b can castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 6]; + [BlackPawnMoveDbl -> 6]; + [BlackPawnLeft -> 6]; + [BlackPawnLeftDbl -> 6]; + [BlackPawnRight -> 6]; + [BlackPawnRightDbl -> 6]; + [BlackPawnPromote -> 6]; + [BlackKnight -> 6]; + [BlackBishop -> 6]; + [BlackRook -> 6]; + [BlackRookA8 -> 22]; + [BlackRookH8 -> 14]; + [BlackQueen -> 6]; + [BlackKing -> 30] + } +LOC 8 { # w can, b left castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 9]; + [WhitePawnMoveDbl -> 9]; + [WhitePawnLeft -> 9]; + [WhitePawnLeftDbl -> 9]; + [WhitePawnRight -> 9]; + [WhitePawnRightDbl -> 9]; + [WhitePawnPromote -> 9]; + [WhiteKnight -> 9]; + [WhiteBishop -> 9]; + [WhiteRook -> 9]; + [WhiteRookA1 -> 13]; + [WhiteRookH1 -> 11]; + [WhiteQueen -> 9]; + [WhiteKing -> 15] + } +LOC 9 { # w can, b left castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 8]; + [BlackPawnMoveDbl -> 8]; + [BlackPawnLeft -> 8]; + [BlackPawnLeftDbl -> 8]; + [BlackPawnRight -> 8]; + [BlackPawnRightDbl -> 8]; + [BlackPawnPromote -> 8]; + [BlackKnight -> 8]; + [BlackBishop -> 8]; + [BlackRook -> 8]; + [BlackRookA8 -> 24]; + [BlackRookH8 -> 8]; + [BlackQueen -> 8]; + [BlackKing -> 24] + } +LOC 10 { # w left, b left castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 11]; + [WhitePawnMoveDbl -> 11]; + [WhitePawnLeft -> 11]; + [WhitePawnLeftDbl -> 11]; + [WhitePawnRight -> 11]; + [WhitePawnRightDbl -> 11]; + [WhitePawnPromote -> 11]; + [WhiteKnight -> 11]; + [WhiteBishop -> 11]; + [WhiteRook -> 11]; + [WhiteRookA1 -> 15]; + [WhiteRookH1 -> 11]; + [WhiteQueen -> 11]; + [WhiteKing -> 15] + } +LOC 11 { # w left, b left castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 10]; + [BlackPawnMoveDbl -> 10]; + [BlackPawnLeft -> 10]; + [BlackPawnLeftDbl -> 10]; + [BlackPawnRight -> 10]; + [BlackPawnRightDbl -> 10]; + [BlackPawnPromote -> 10]; + [BlackKnight -> 10]; + [BlackBishop -> 10]; + [BlackRook -> 10]; + [BlackRookA8 -> 26]; + [BlackRookH8 -> 10]; + [BlackQueen -> 10]; + [BlackKing -> 26] + } +LOC 12 { # w right, b left castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 13]; + [WhitePawnMoveDbl -> 13]; + [WhitePawnLeft -> 13]; + [WhitePawnLeftDbl -> 13]; + [WhitePawnRight -> 13]; + [WhitePawnRightDbl -> 13]; + [WhitePawnPromote -> 13]; + [WhiteKnight -> 13]; + [WhiteBishop -> 13]; + [WhiteRook -> 13]; + [WhiteRookA1 -> 13]; + [WhiteRookH1 -> 15]; + [WhiteQueen -> 13]; + [WhiteKing -> 15] + } +LOC 13 { # w right, b left castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 12]; + [BlackPawnMoveDbl -> 12]; + [BlackPawnLeft -> 12]; + [BlackPawnLeftDbl -> 12]; + [BlackPawnRight -> 12]; + [BlackPawnRightDbl -> 12]; + [BlackPawnPromote -> 12]; + [BlackKnight -> 12]; + [BlackBishop -> 12]; + [BlackRook -> 12]; + [BlackRookA8 -> 28]; + [BlackRookH8 -> 12]; + [BlackQueen -> 12]; + [BlackKing -> 28] + } +LOC 14 { # w no, b left castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 15]; + [WhitePawnMoveDbl -> 15]; + [WhitePawnLeft -> 15]; + [WhitePawnLeftDbl -> 15]; + [WhitePawnRight -> 15]; + [WhitePawnRightDbl -> 15]; + [WhitePawnPromote -> 15]; + [WhiteKnight -> 15]; + [WhiteBishop -> 15]; + [WhiteRook -> 15]; + [WhiteRookA1 -> 15]; + [WhiteRookH1 -> 15]; + [WhiteQueen -> 15]; + [WhiteKing -> 15] + } +LOC 15 { # w no, b left castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 14]; + [BlackPawnMoveDbl -> 14]; + [BlackPawnLeft -> 14]; + [BlackPawnLeftDbl -> 14]; + [BlackPawnRight -> 14]; + [BlackPawnRightDbl -> 14]; + [BlackPawnPromote -> 14]; + [BlackKnight -> 14]; + [BlackBishop -> 14]; + [BlackRook -> 14]; + [BlackRookA8 -> 30]; + [BlackRookH8 -> 14]; + [BlackQueen -> 14]; + [BlackKing -> 30] + } +LOC 16 { # w can, b right castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 17]; + [WhitePawnMoveDbl -> 17]; + [WhitePawnLeft -> 17]; + [WhitePawnLeftDbl -> 17]; + [WhitePawnRight -> 17]; + [WhitePawnRightDbl -> 17]; + [WhitePawnPromote -> 17]; + [WhiteKnight -> 17]; + [WhiteBishop -> 17]; + [WhiteRook -> 17]; + [WhiteRookA1 -> 21]; + [WhiteRookH1 -> 19]; + [WhiteQueen -> 17]; + [WhiteKing -> 23] + } +LOC 17 { # w can, b right castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 16]; + [BlackPawnMoveDbl -> 16]; + [BlackPawnLeft -> 16]; + [BlackPawnLeftDbl -> 16]; + [BlackPawnRight -> 16]; + [BlackPawnRightDbl -> 16]; + [BlackPawnPromote -> 16]; + [BlackKnight -> 16]; + [BlackBishop -> 16]; + [BlackRook -> 16]; + [BlackRookA8 -> 16]; + [BlackRookH8 -> 24]; + [BlackQueen -> 16]; + [BlackKing -> 24] + } +LOC 18 { # w left, b right castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 19]; + [WhitePawnMoveDbl -> 19]; + [WhitePawnLeft -> 19]; + [WhitePawnLeftDbl -> 19]; + [WhitePawnRight -> 19]; + [WhitePawnRightDbl -> 19]; + [WhitePawnPromote -> 19]; + [WhiteKnight -> 19]; + [WhiteBishop -> 19]; + [WhiteRook -> 19]; + [WhiteRookA1 -> 23]; + [WhiteRookH1 -> 19]; + [WhiteQueen -> 19]; + [WhiteKing -> 23] + } +LOC 19 { # w left, b right castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 18]; + [BlackPawnMoveDbl -> 18]; + [BlackPawnLeft -> 18]; + [BlackPawnLeftDbl -> 18]; + [BlackPawnRight -> 18]; + [BlackPawnRightDbl -> 18]; + [BlackPawnPromote -> 18]; + [BlackKnight -> 18]; + [BlackBishop -> 18]; + [BlackRook -> 18]; + [BlackRookA8 -> 18]; + [BlackRookH8 -> 26]; + [BlackQueen -> 18]; + [BlackKing -> 26] + } +LOC 20 { # w right, b right castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 21]; + [WhitePawnMoveDbl -> 21]; + [WhitePawnLeft -> 21]; + [WhitePawnLeftDbl -> 21]; + [WhitePawnRight -> 21]; + [WhitePawnRightDbl -> 21]; + [WhitePawnPromote -> 21]; + [WhiteKnight -> 21]; + [WhiteBishop -> 21]; + [WhiteRook -> 21]; + [WhiteRookA1 -> 21]; + [WhiteRookH1 -> 23]; + [WhiteQueen -> 21]; + [WhiteKing -> 23] + } +LOC 21 { # w right, b right castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 20]; + [BlackPawnMoveDbl -> 20]; + [BlackPawnLeft -> 20]; + [BlackPawnLeftDbl -> 20]; + [BlackPawnRight -> 20]; + [BlackPawnRightDbl -> 20]; + [BlackPawnPromote -> 20]; + [BlackKnight -> 20]; + [BlackBishop -> 20]; + [BlackRook -> 20]; + [BlackRookA8 -> 20]; + [BlackRookH8 -> 28]; + [BlackQueen -> 20]; + [BlackKing -> 28] + } +LOC 22 { # w no, b right castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 23]; + [WhitePawnMoveDbl -> 23]; + [WhitePawnLeft -> 23]; + [WhitePawnLeftDbl -> 23]; + [WhitePawnRight -> 23]; + [WhitePawnRightDbl -> 23]; + [WhitePawnPromote -> 23]; + [WhiteKnight -> 23]; + [WhiteBishop -> 23]; + [WhiteRook -> 23]; + [WhiteRookA1 -> 23]; + [WhiteRookH1 -> 23]; + [WhiteQueen -> 23]; + [WhiteKing -> 23] + } +LOC 23 { # w no, b right castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 22]; + [BlackPawnMoveDbl -> 22]; + [BlackPawnLeft -> 22]; + [BlackPawnLeftDbl -> 22]; + [BlackPawnRight -> 22]; + [BlackPawnRightDbl -> 22]; + [BlackPawnPromote -> 22]; + [BlackKnight -> 22]; + [BlackBishop -> 22]; + [BlackRook -> 22]; + [BlackRookA8 -> 22]; + [BlackRookH8 -> 30]; + [BlackQueen -> 22]; + [BlackKing -> 30] + } + LOC 24 { # w can, b no castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 25]; + [WhitePawnMoveDbl -> 25]; + [WhitePawnLeft -> 25]; + [WhitePawnLeftDbl -> 25]; + [WhitePawnRight -> 25]; + [WhitePawnRightDbl -> 25]; + [WhitePawnPromote -> 25]; + [WhiteKnight -> 25]; + [WhiteBishop -> 25]; + [WhiteRook -> 25]; + [WhiteRookA1 -> 29]; + [WhiteRookH1 -> 27]; + [WhiteQueen -> 25]; + [WhiteKing -> 31] + } +LOC 25 { # w can, b no castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 24]; + [BlackPawnMoveDbl -> 24]; + [BlackPawnLeft -> 24]; + [BlackPawnLeftDbl -> 24]; + [BlackPawnRight -> 24]; + [BlackPawnRightDbl -> 24]; + [BlackPawnPromote -> 24]; + [BlackKnight -> 24]; + [BlackBishop -> 24]; + [BlackRook -> 24]; + [BlackRookA8 -> 24]; + [BlackRookH8 -> 24]; + [BlackQueen -> 24]; + [BlackKing -> 24] + } +LOC 26 { # w left, b no castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 27]; + [WhitePawnMoveDbl -> 27]; + [WhitePawnLeft -> 27]; + [WhitePawnLeftDbl -> 27]; + [WhitePawnRight -> 27]; + [WhitePawnRightDbl -> 27]; + [WhitePawnPromote -> 27]; + [WhiteKnight -> 27]; + [WhiteBishop -> 27]; + [WhiteRook -> 27]; + [WhiteRookA1 -> 31]; + [WhiteRookH1 -> 27]; + [WhiteQueen -> 27]; + [WhiteKing -> 31] + } +LOC 27 { # w left, b no castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 26]; + [BlackPawnMoveDbl -> 26]; + [BlackPawnLeft -> 26]; + [BlackPawnLeftDbl -> 26]; + [BlackPawnRight -> 26]; + [BlackPawnRightDbl -> 26]; + [BlackPawnPromote -> 26]; + [BlackKnight -> 26]; + [BlackBishop -> 26]; + [BlackRook -> 26]; + [BlackRookA8 -> 26]; + [BlackRookH8 -> 26]; + [BlackQueen -> 26]; + [BlackKing -> 26] + } +LOC 28 { # w right, b no castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 29]; + [WhitePawnMoveDbl -> 29]; + [WhitePawnLeft -> 29]; + [WhitePawnLeftDbl -> 29]; + [WhitePawnRight -> 29]; + [WhitePawnRightDbl -> 29]; + [WhitePawnPromote -> 29]; + [WhiteKnight -> 29]; + [WhiteBishop -> 29]; + [WhiteRook -> 29]; + [WhiteRookA1 -> 29]; + [WhiteRookH1 -> 31]; + [WhiteQueen -> 29]; + [WhiteKing -> 31] + } +LOC 29 { # w right, b no castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 28]; + [BlackPawnMoveDbl -> 28]; + [BlackPawnLeft -> 28]; + [BlackPawnLeftDbl -> 28]; + [BlackPawnRight -> 28]; + [BlackPawnRightDbl -> 28]; + [BlackPawnPromote -> 28]; + [BlackKnight -> 28]; + [BlackBishop -> 28]; + [BlackRook -> 28]; + [BlackRookA8 -> 28]; + [BlackRookH8 -> 28]; + [BlackQueen -> 28]; + [BlackKing -> 28] + } +LOC 30 { # w no, b no castle # + PLAYER 1 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [WhitePawnMove -> 31]; + [WhitePawnMoveDbl -> 31]; + [WhitePawnLeft -> 31]; + [WhitePawnLeftDbl -> 31]; + [WhitePawnRight -> 31]; + [WhitePawnRightDbl -> 31]; + [WhitePawnPromote -> 31]; + [WhiteKnight -> 31]; + [WhiteBishop -> 31]; + [WhiteRook -> 31]; + [WhiteRookA1 -> 31]; + [WhiteRookH1 -> 31]; + [WhiteQueen -> 31]; + [WhiteKing -> 31] + } +LOC 31 { # w no, b no castle # + PLAYER 2 + PAYOFF { + 1: :(CheckB()) - :(CheckW()); + 2: :(CheckW()) - :(CheckB()) + } + MOVES + [BlackPawnMove -> 30]; + [BlackPawnMoveDbl -> 30]; + [BlackPawnLeft -> 30]; + [BlackPawnLeftDbl -> 30]; + [BlackPawnRight -> 30]; + [BlackPawnRightDbl -> 30]; + [BlackPawnPromote -> 30]; + [BlackKnight -> 30]; + [BlackBishop -> 30]; + [BlackRook -> 30]; + [BlackRookA8 -> 30]; + [BlackRookH8 -> 30]; + [BlackQueen -> 30]; + [BlackKing -> 30] + } MODEL [ | | ] " ... ... ... ... This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |