[Toss-devel-svn] SF.net SVN: toss:[1388] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
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. |