[Toss-devel-svn] SF.net SVN: toss:[1388] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1388] trunk/Toss
|
From: <luk...@us...> - 2011-03-24 21:21:48
|
Revision: 1388
http://toss.svn.sourceforge.net/toss/?rev=1388&view=rev
Author: lukaszkaiser
Date: 2011-03-24 21:21:42 +0000 (Thu, 24 Mar 2011)
Log Message:
-----------
Small corrections, timeout settings.
Modified Paths:
--------------
trunk/Toss/Formula/FormulaOps.ml
trunk/Toss/Formula/FormulaOps.mli
trunk/Toss/GGP/GDL.ml
trunk/Toss/Makefile
trunk/Toss/Play/Play.ml
trunk/Toss/Server/Server.ml
trunk/Toss/Solver/Solver.ml
trunk/Toss/WebClient/index.html
Modified: trunk/Toss/Formula/FormulaOps.ml
===================================================================
--- trunk/Toss/Formula/FormulaOps.ml 2011-03-24 18:05:50 UTC (rev 1387)
+++ trunk/Toss/Formula/FormulaOps.ml 2011-03-24 21:21:42 UTC (rev 1388)
@@ -1307,9 +1307,9 @@
let is_fo = function `FO _ -> true | _ -> false in
List.filter is_fo (free_vars f)
-let rec order_by_fv structure acc_fv = function
+let rec order_by_fv sizes acc_fv = function
| [] -> []
- | [f] -> [order_by_fv_phi structure acc_fv f]
+ | [f] -> [order_by_fv_phi sizes acc_fv f]
| l ->
let cross x =
let fv = free_vars x in
@@ -1317,36 +1317,38 @@
let (cf, o) = List.partition cross l in
if cf = [] then (
let new_fv = free_vars (List.hd l) in
- order_by_fv structure new_fv l
+ order_by_fv sizes new_fv l
) else (
let new_fv = acc_fv @ (free_vars_fo (And cf)) in
- (List.map (order_by_fv_phi structure acc_fv) cf) @
- (order_by_fv structure new_fv o)
+ (List.map (order_by_fv_phi sizes acc_fv) cf) @
+ (order_by_fv sizes new_fv o)
)
-and order_by_fv_phi structure acc_fv = function
+and order_by_fv_phi sizes acc_fv = function
| And fl ->
let is_pred = function Rel (_, [|_|]) -> true | _ -> false in
let (p_raw, np) = List.partition is_pred fl in
- let p = match structure with | None -> p_raw | Some struc ->
- let card = function | Rel (r,_) -> Structure.rel_size struc r | _-> 0 in
- let cmp x y = (card x) - (card y) in
- List.sort cmp p_raw in
- let res = And (order_by_fv structure acc_fv (p @ np)) in
+ let p = match sizes with | None -> p_raw | Some slist ->
+ let card = function
+ | Rel (r, _) -> (try List.assoc r slist with Not_found -> 0)
+ | _-> 0 in
+ List.sort (fun x y -> (card x) - (card y)) p_raw in
+ let res = And (order_by_fv sizes acc_fv (p @ np)) in
if !debug_level > 1 then print_endline ("fvordered and: " ^ (str res));
res
| Or fl ->
let is_pred = function Rel (_, [|_|]) -> true | _ -> false in
let (p_raw, np) = List.partition is_pred fl in
- let p = match structure with | None -> p_raw | Some struc ->
- let card = function | Rel (r,_) -> Structure.rel_size struc r | _-> 0 in
- let cmp x y = (card x) - (card y) in
- List.sort cmp p_raw in
- let res = Or (order_by_fv structure acc_fv (p @ np)) in
+ let p = match sizes with | None -> p_raw | Some slist ->
+ let card = function
+ | Rel (r, _) -> (try List.assoc r slist with Not_found -> 0)
+ | _-> 0 in
+ List.sort (fun x y -> (card x) - (card y)) p_raw in
+ let res = Or (order_by_fv sizes acc_fv (p @ np)) in
if !debug_level > 1 then print_endline ("fvordered or: " ^ (str res));
res
- | Ex (vs, phi) -> Ex (vs, order_by_fv_phi structure acc_fv phi)
- | All (vs, phi) -> All (vs, order_by_fv_phi structure acc_fv phi)
+ | Ex (vs, phi) -> Ex (vs, order_by_fv_phi sizes acc_fv phi)
+ | All (vs, phi) -> All (vs, order_by_fv_phi sizes acc_fv phi)
| f -> f
let rec push_in_quant phi =
@@ -1373,12 +1375,12 @@
let rec push_quant f = push_in_quant (flatten_sort (f))
-let tnf_fv ?structure phi =
+let tnf_fv ?sizes phi =
let fv = free_vars phi in
let psi = rename_quant_avoiding [] (Ex (fv, phi)) in
match mso_last (flatten (del_vars_quant fv (tnf psi))) with
- | Or fl -> Or (List.map (order_by_fv_phi structure []) fl)
- | f -> order_by_fv_phi structure [] f
+ | Or fl -> Or (List.map (order_by_fv_phi sizes []) fl)
+ | f -> order_by_fv_phi sizes [] f
(* Assign emptyset to the MSO-variable v by replacing "x in X" with "false". *)
let assign_emptyset v phi =
Modified: trunk/Toss/Formula/FormulaOps.mli
===================================================================
--- trunk/Toss/Formula/FormulaOps.mli 2011-03-24 18:05:50 UTC (rev 1387)
+++ trunk/Toss/Formula/FormulaOps.mli 2011-03-24 21:21:42 UTC (rev 1388)
@@ -187,7 +187,7 @@
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 : ?structure : Structure.structure ->
+val tnf_fv : ?sizes : (string * int) list ->
formula -> formula (** first existentially quantifies free vars *)
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-03-24 18:05:50 UTC (rev 1387)
+++ trunk/Toss/GGP/GDL.ml 2011-03-24 21:21:42 UTC (rev 1388)
@@ -3498,7 +3498,7 @@
let file = open_out ("./GGP/tests/"^game_name^"-simpl.toss") in
output_string file (Arena.state_str result);
close_out file);
- if !debug_level > -1 then (
+ if !debug_level > 1 then (
Printf.printf "\n\nGDL.translate_game: simplified rel sizes --\n%s\n%!"
(String.concat ", "(List.map (fun (rel,ar) ->
rel^":"^string_of_int ar) (Structure.rel_sizes
Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile 2011-03-24 18:05:50 UTC (rev 1387)
+++ trunk/Toss/Makefile 2011-03-24 21:21:42 UTC (rev 1388)
@@ -57,8 +57,8 @@
OCAMLBUILDNOPP=ocamlbuild -log build.log -j 8 -menhir ../menhir_conf \
$(OCB_LIB) $(OCB_CFLAG) $(OCB_LFLAG)
-FormulaINC=Formula/Sat,Formula,Solver
-SolverINC=Formula,Solver,Formula/Sat,Solver/RealQuantElim
+FormulaINC=Formula/Sat
+SolverINC=Formula,Formula/Sat,Solver/RealQuantElim
ArenaINC=Formula,Formula/Sat,Solver/RealQuantElim,Solver
PlayINC=Formula,Formula/Sat,Solver/RealQuantElim,Solver,Arena
GGPINC=Formula,Formula/Sat,Solver/RealQuantElim,Solver,Arena,Play
Modified: trunk/Toss/Play/Play.ml
===================================================================
--- trunk/Toss/Play/Play.ml 2011-03-24 18:05:50 UTC (rev 1387)
+++ trunk/Toss/Play/Play.ml 2011-03-24 21:21:42 UTC (rev 1388)
@@ -47,8 +47,8 @@
(* Maximax unfolding upto depth. *)
let rec unfold_maximax_upto ?(ab=false) count game heur t =
- if count = 0 || Game.get_timeout () || timed_out () then (
- if !debug_level > 1 && (Game.get_timeout() || timed_out()) then
+ if count = 0 || timed_out () then (
+ if !debug_level > 1 && timed_out() then
print_endline "Timeout";
t
) else
Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml 2011-03-24 18:05:50 UTC (rev 1387)
+++ trunk/Toss/Server/Server.ml 2011-03-24 21:21:42 UTC (rev 1388)
@@ -394,15 +394,14 @@
else
let mov_msg =
if GDL.our_turn !gdl_transl !state then (
- let time_used =
- int_of_float time_started -
- int_of_float (ceil (Sys.time ())) in
+ let time_used = time_started -. Sys.time () in
let p, ps =
match !play, !play_state with
| Some play, Some play_state ->
play, play_state
| _ -> assert false in
- ignore (Unix.alarm (!playclock - time_used - 1));
+ ignore (Unix.alarm (!playclock - (int_of_float time_used) - 1));
+ Play.set_timeout (float(!playclock) -. time_used -. 1.5);
if !no_gtree then
let res = Game.suggest p ps in
Game.cancel_timeout ();
Modified: trunk/Toss/Solver/Solver.ml
===================================================================
--- trunk/Toss/Solver/Solver.ml 2011-03-24 18:05:50 UTC (rev 1387)
+++ trunk/Toss/Solver/Solver.ml 2011-03-24 21:21:42 UTC (rev 1388)
@@ -49,7 +49,7 @@
(Hashtbl.find solver.formulas_eval res, res)
with Not_found ->
if !debug_level > 0 then print_endline ("Entered " ^ (str phi));
- let psi = FormulaOps.tnf_fv ~structure:struc phi in
+ let psi = FormulaOps.tnf_fv ~sizes:(Structure.rel_sizes struc) phi in
if !debug_level > 0 then print_endline ("Registering " ^ (str psi));
let id = Hashtbl.length solver.formulas_eval + 1 in
Hashtbl.add solver.reg_formulas phi id;
Modified: trunk/Toss/WebClient/index.html
===================================================================
--- trunk/Toss/WebClient/index.html 2011-03-24 18:05:50 UTC (rev 1387)
+++ trunk/Toss/WebClient/index.html 2011-03-24 21:21:42 UTC (rev 1388)
@@ -115,7 +115,21 @@
</p>
<ul class="welcome-list">
-<li>Play Breakthrough, Checkers, Chess, Connect4, Gomoku, Pawn Whopping
+ <li>Play
+ <a href="http://en.wikipedia.org/wiki/Breakthrough_(board_game)"
+ >Breakthrough,</a>
+ <a href="http://en.wikipedia.org/wiki/English_draughts"
+ >Checkers,</a>
+ <a href="http://en.wikipedia.org/wiki/Chess"
+ >Chess,</a>
+ <a href="http://en.wikipedia.org/wiki/Connect4"
+ >Connect4,</a>
+ <a href="http://en.wikipedia.org/wiki/Entanglement_(graph_measure)"
+ >Entanglement,</a>
+ <a href="http://en.wikipedia.org/wiki/Gomoku"
+ >Gomoku,</a>
+ <a href="http://en.wikipedia.org/wiki/Pawn_(chess)"
+ >Pawn-Whopping,</a>
and many other board games</li>
<li>Challenge your friends or play a fast game against the computer for fun</li>
<li>Focus fully on the game thanks to our intuitive clean interface</li>
@@ -198,7 +212,7 @@
<p class="game-par">
<button onclick="new_play('Pawn-Whopping')"
class="boldobt">Pawn-Whopping</button>
- (<a href="http://en.wikipedia.org/wiki/Pawn-Whopping">info</a>)
+ (<a href="http://en.wikipedia.org/wiki/Pawn_(chess)">info</a>)
</p>
<ul class="plays-list" id="plays-list-Pawn-Whopping">
<li style="display: none;"/>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
