[Toss-devel-svn] SF.net SVN: toss:[1305] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1305] trunk/Toss
|
From: <luk...@us...> - 2011-02-02 00:00:32
|
Revision: 1305
http://toss.svn.sourceforge.net/toss/?rev=1305&view=rev
Author: lukstafi
Date: 2011-02-02 00:00:24 +0000 (Wed, 02 Feb 2011)
Log Message:
-----------
GDL translation: in progress (final assignment of GDL branches to Toss rules but not filtered yet). Minor fixes in iterative deepening. Restored Server tests.
Modified Paths:
--------------
trunk/Toss/Formula/Aux.ml
trunk/Toss/GGP/GDL.ml
trunk/Toss/GGP/GDLTest.ml
trunk/Toss/Play/Game.ml
trunk/Toss/Play/GameTest.ml
trunk/Toss/Server/Server.ml
trunk/Toss/Server/ServerGDLTest.in
trunk/Toss/Server/ServerGDLTest.out
trunk/Toss/Server/ServerTest.ml
Modified: trunk/Toss/Formula/Aux.ml
===================================================================
--- trunk/Toss/Formula/Aux.ml 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/Formula/Aux.ml 2011-02-02 00:00:24 UTC (rev 1305)
@@ -457,8 +457,8 @@
let strip_spaces s =
let (b, e) = (ref 0, ref ((String.length s) - 1)) in
- while !b < !e && is_space (s.[!b]) do b := !b + 1 done;
- while !b <= !e && is_space (s.[!e]) do e := !e - 1 done;
+ while !b < !e && is_space (s.[!b]) do incr b done;
+ while !b <= !e && is_space (s.[!e]) do decr e done;
if !e < !b then "" else String.sub s !b (!e - !b + 1)
let rec input_http_message file =
Modified: trunk/Toss/GGP/GDL.ml
===================================================================
--- trunk/Toss/GGP/GDL.ml 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/GGP/GDL.ml 2011-02-02 00:00:24 UTC (rev 1305)
@@ -349,7 +349,10 @@
associated with every bit. The unique resulting sets are exactly
the Toss rules precursors.
- (7m) Include translated negation of the terminal condition. (Now we
+ (7m) Filter the final rule candidates by satisfiability in at
+ least one of aggregate playout states.
+
+ (7n) Include translated negation of the terminal condition. (Now we
build rewrite rules for a refinement of an equivalence class of
(7b): from the branches with unifiers in the equiv class, from
branches with unifiers more general than the equiv class, and from
@@ -712,6 +715,11 @@
" " ^ neg_facts_str neg_body ^ ")"
) branches)
+let rule_pretransl_str (heads, bodies, neg_bodies) =
+ "("^ facts_str bodies ^
+ " " ^ neg_facts_str neg_bodies ^ "==>" ^
+ String.concat "; " (List.map term_str heads) ^ ")"
+
let sb_str sb =
String.concat ", " (List.map (fun (v,t)->v^":="^term_str t) sb)
@@ -1772,71 +1780,69 @@
let toss_var term =
let mask, _, _, blank = term_to_blank term in
mask, Formula.fo_var_of_string (term_to_name blank) in
- (* 7i *)
- let state_terms =
- Array.fold_left (fun acc rules_brs ->
- List.fold_left (fun acc (lead, brs) ->
- List.fold_left (fun acc -> function
- | [next_arg], body, neg_body ->
- let res =
- List.fold_left (fun acc -> function
- | "true", [true_arg] -> Terms.add true_arg acc
- | "true", _ -> assert false
- | _ -> acc) acc body in
- let res =
- List.fold_left (List.fold_left (fun acc -> function
- | "true", [true_arg] -> Terms.add true_arg acc
- | "true", _ -> assert false
- | _ -> acc)) res neg_body in
- Terms.add next_arg res
- | _ -> assert false
- ) acc brs
- ) acc rules_brs) Terms.empty loc_next_classes in
- let state_terms = Terms.elements state_terms in
- (* {{{ log entry *)
- if !debug_level > 2 then (
- Printf.printf "state_terms: %s\n%!" (
- String.concat ", " (List.map term_str state_terms))
- );
- (* }}} *)
- let state_subterms =
- Aux.concat_map (fun term ->
- let mask, sb, m_sb, blanked = term_to_blank term in
- List.map (fun (v,t) -> t, (mask, v, term)) sb
- ) state_terms in
- let conjs_4a rel args =
- let ptups = List.map (fun arg ->
- Aux.assoc_all arg state_subterms) args in
- (* {{{ log entry *)
- if !debug_level > 3 then (
- Printf.printf "conjs_4a: of %s = subterms %s\n%!"
- (fact_str (rel,args)) (String.concat "; " (
- List.map (fun l -> String.concat ", "
- (List.map (fun (_,_,term)->term_str term) l)) ptups))
- );
- (* }}} *)
- let ptups = Aux.product ptups in
- let res =
- List.map (fun ptup ->
- let rname = rel ^ "__" ^ String.concat "__"
- (List.map (fun (mask,v,_)->
- term_to_name mask ^ "_" ^ v) ptup) in
- let tup = List.map (fun (_,_,term) ->
- snd (toss_var term)) ptup in
- Formula.Rel (rname, Array.of_list tup)) ptups in
- let res = Aux.unique_sorted res in
- (* {{{ log entry *)
- if !debug_level > 3 then (
- Printf.printf "conjs_4a: of %s = %s\n%!"
- (fact_str (rel,args)) (Formula.str (Formula.And res))
- );
- (* }}} *)
- res in
let loc_toss_rules =
Array.mapi (fun loc rules_brs ->
Aux.concat_map (fun (lead, brs) ->
+ (* 7i *)
+ (* Do not flatten the already built super-partition. *)
+ let state_terms =
+ List.fold_left (fun acc -> function
+ | [next_arg], body, neg_body ->
+ let res =
+ List.fold_left (fun acc -> function
+ | "true", [true_arg] -> Terms.add true_arg acc
+ | "true", _ -> assert false
+ | _ -> acc) acc body in
+ let res =
+ List.fold_left (List.fold_left (fun acc -> function
+ | "true", [true_arg] -> Terms.add true_arg acc
+ | "true", _ -> assert false
+ | _ -> acc)) res neg_body in
+ Terms.add next_arg res
+ | _ -> assert false
+ ) Terms.empty brs in
+ let state_terms = Terms.elements state_terms in
+ (* {{{ log entry *)
+ if !debug_level > 2 then (
+ Printf.printf "state_terms: %s\n%!" (
+ String.concat ", " (List.map term_str state_terms))
+ );
+ (* }}} *)
+ let state_subterms =
+ Aux.concat_map (fun term ->
+ let mask, sb, m_sb, blanked = term_to_blank term in
+ List.map (fun (v,t) -> t, (mask, v, term)) sb
+ ) state_terms in
+ let conjs_4a rel args =
+ let ptups = List.map (fun arg ->
+ Aux.assoc_all arg state_subterms) args in
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "conjs_4a: of %s = subterms %s\n%!"
+ (fact_str (rel,args)) (String.concat "; " (
+ List.map (fun l -> String.concat ", "
+ (List.map (fun (_,_,term)->term_str term) l)) ptups))
+ );
+ (* }}} *)
+ let ptups = Aux.product ptups in
+ let res =
+ List.map (fun ptup ->
+ let rname = rel ^ "__" ^ String.concat "__"
+ (List.map (fun (mask,v,_)->
+ term_to_name mask ^ "_" ^ v) ptup) in
+ let tup = List.map (fun (_,_,term) ->
+ snd (toss_var term)) ptup in
+ Formula.Rel (rname, Array.of_list tup)) ptups in
+ let res = Aux.unique_sorted res in
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ Printf.printf "conjs_4a: of %s = %s\n%!"
+ (fact_str (rel,args)) (Formula.str (Formula.And res))
+ );
+ (* }}} *)
+ res in
let brs = Aux.map_some (function
- | [next_arg],body,neg_body as br ->
+ | [next_arg],body,neg_body ->
let mask, sb, m_sb, blanked = term_to_blank next_arg in
let rname = term_to_name mask in
let _, svar = toss_var next_arg in
@@ -1930,7 +1936,7 @@
Printf.printf "holds\n%!"
);
(* }}} *)
- Some (phi, br))
+ Some (phi, (next_arg,body,neg_body)))
else None
| _ -> assert false) brs in
(* 7j: TODO *)
@@ -1942,8 +1948,13 @@
(List.fold_right (List.fold_right Atoms.add)
neg_body acc)
) Atoms.empty brs in
+ Printf.printf "\na\n%!";
let atoms = Atoms.elements atoms in
+ Printf.printf "\nb\n%!";
let brs = Array.of_list brs in (* indexing branches *)
+ let full_set = Aux.ints_of_list
+ (Array.to_list (Array.mapi (fun i _ -> i) brs)) in
+ Printf.printf "\nc\n%!";
let table = List.map (fun atom ->
let positives = Array.mapi (fun i (_,(_,body,_)) ->
if List.mem atom body then Some i else None) brs in
@@ -1954,32 +1965,72 @@
else None) brs in
let negatives = Aux.map_some (fun x->x)
(Array.to_list negatives) in
- [Aux.Ints.empty; Aux.Ints.empty] (* TODO *)
+ Printf.printf "\nd\n%!";
+ (* first those that allow "P" then those that allow "not P" *)
+ [Aux.Ints.diff full_set (Aux.ints_of_list negatives);
+ Aux.Ints.diff full_set (Aux.ints_of_list positives)]
) atoms in
+ Printf.printf "\ne\n%!";
let cases = Aux.product table in
- let full_set = Aux.ints_of_list
- (Array.to_list (Array.mapi (fun i _ -> i) brs)) in
+ Printf.printf "\nf\n%!";
let cases =
List.map (List.fold_left Aux.Ints.inter full_set) cases in
-
- [lead, brs]
+ Printf.printf "\ng\n%!";
+ let cases =
+ Aux.unique_sorted (List.map Aux.Ints.elements cases) in
+ Printf.printf "\nh\n%!";
+ let cases = List.map (fun c_brs ->
+ let c_brs = List.map (Array.get brs) c_brs in
+ List.fold_left (fun (phis,heads,bodies,neg_bodies)
+ (phi,(head,body,neg_body)) ->
+ phi::phis,head::heads,body@bodies,neg_body@neg_bodies)
+ ([],[],[],[]) c_brs
+ ) cases in
+ Printf.printf "\ni\n%!";
+ let cases = List.filter (fun (phis,heads,bodies,neg_bodies) ->
+ let phi = Formula.And phis in
+ let rphi = Solver.M.register_formula phi in
+ (* {{{ log entry *)
+ if !debug_level > 3 then (
+ (* do not print, because it generates too many
+ answers -- too little constraints per number of
+ variables when considering a single branch *)
+ (*
+ let assgn = Solver.M.evaluate struc rphi in
+ let avars = List.map Formula.var_str
+ (FormulaOps.free_vars phi) in
+ let atups =
+ AssignmentSet.tuples struc.Structure.elements
+ avars assgn in *)
+ Printf.printf "evaluating: %s -- simpl %s\n%!"
+ (Formula.str phi)
+ (Solver.M.formula_str rphi)
+ (* (List.length atups) *)
+ );
+ (* }}} *)
+ let res = Solver.M.check_formula struc rphi in
+ (* {{{ log entry *)
+ if !debug_level > 3 && res then (
+ Printf.printf "holds\n%!"
+ );
+ (* }}} *)
+ res) cases in
+ Printf.printf "\nj\n%!";
+ List.map (fun case -> lead, case) cases
) rules_brs
) loc_next_classes in
- (*
(* {{{ log entry *)
if !debug_level > 1 then (
Array.iteri (fun loc rules_brs ->
Printf.printf "Rule translations for loc %d:\n%!" loc;
- List.iter (fun ((lead,_,_), brs) ->
- let brs = List.map snd brs in
+ List.iter (fun ((lead,_,_), (phis,heads,bodies,neg_bodies)) ->
Printf.printf "Rule-translation: player %s move %s\n%s\n%!"
(term_str loc_players.(loc)) (term_str lead)
- (def_str ("action", brs))
+ (rule_pretransl_str (heads,bodies,neg_bodies))
) rules_brs;
) loc_toss_rules;
);
(* }}} *)
- *)
struc
(*
@@ -2060,6 +2111,12 @@
if (Some game_descr) = !connect5_descr then manual_game := "connect5";
if (Some game_descr) = !connect4_descr then manual_game := "connect4";
if (Some game_descr) = !pawn_whopping_descr then manual_game:="pawn_whopping";
+ (* {{{ log entry *)
+ if !debug_level > 0 then (
+ Printf.printf "GDL.initialize_game: player=%s, game=%s, startcl=%d\n%!"
+ (term_str player) !manual_game startcl
+ );
+ (* }}} *)
match !manual_translation, !manual_game with
| true, "tictactoe" ->
initialize_game_tictactoe state player game_descr startcl
@@ -2209,10 +2266,18 @@
let loc = state.Arena.cur_loc in
let loc_player =
state.Arena.game.Arena.graph.(loc).Arena.player in
+ (* {{{ log entry *)
+ if !debug_level > 0 then (
+ Printf.printf
+ "GDL.our_turn: loc=%d, loc_player=%d, playing_as=%s, player_name=%s, res=%b\n%!"
+ loc loc_player (term_str !playing_as)
+ (term_str !player_name_terms.(loc_player))
+ (!player_name_terms.(loc_player) = !playing_as)
+ );
+ (* }}} *)
!player_name_terms.(loc_player) = !playing_as
let translate_move_tictactoe rule emb new_state =
- print_endline "Translate";
let struc = new_state.Arena.struc in
let elem = snd (List.hd emb) in
let c, r =
@@ -2270,6 +2335,7 @@
| _ -> assert false
let translate_move rule emb new_state =
+ let res =
match !manual_translation, !manual_game with
| true, "tictactoe" ->
translate_move_tictactoe rule emb new_state
@@ -2285,3 +2351,10 @@
failwith ("GDL: manual translation of unknown game "^game)
| false, _ ->
failwith "GDL: automatic translation not finished yet"
+ in
+ (* {{{ log entry *)
+ if !debug_level > 0 then (
+ Printf.printf "GDL.translate_move: %s\n%!" res
+ );
+ (* }}} *)
+ res
Modified: trunk/Toss/GGP/GDLTest.ml
===================================================================
--- trunk/Toss/GGP/GDLTest.ml 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/GGP/GDLTest.ml 2011-02-02 00:00:24 UTC (rev 1305)
@@ -78,7 +78,8 @@
"connect5" >::
(fun () ->
- GDL.debug_level := 3;
+ todo "Only log would be interesting at this point.";
+ (* GDL.debug_level := 3; *)
let connect5 = load_rules "./GGP/examples/connect5.gdl" in
let gdef = GDL.translate_game connect5 in
()
@@ -86,6 +87,7 @@
"breakthrough" >::
(fun () ->
+ todo "Only log would be interesting at this point.";
let breakthrough = load_rules "./GGP/examples/breakthrough.gdl" in
let gdef = GDL.translate_game breakthrough in
()
@@ -95,7 +97,7 @@
]
-let a () =
+let a =
Aux.run_test_if_target "GDLTest" tests
let a () =
@@ -106,7 +108,7 @@
| Some tests -> ignore (run_test_tt ~verbose:true tests)
| None -> ()
-let a =
+let a () =
GDL.debug_level := 4;
let breakthrough = load_rules "./GGP/examples/breakthrough.gdl" in
let gdef = GDL.translate_game breakthrough in
Modified: trunk/Toss/Play/Game.ml
===================================================================
--- trunk/Toss/Play/Game.ml 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/Play/Game.ml 2011-02-02 00:00:24 UTC (rev 1305)
@@ -757,7 +757,9 @@
("\n"^Str.first_chars "|||||||||||" (depth0-depth))
("\n" ^ Structure.str model));
(* }}} *)
- if depth < 1 || !timeout then ( (* leaf position *)
+ if !timeout then (* will be handled by i.deep. *)
+ Array.map (fun _ -> 0.) graph.(loc).Arena.payoffs
+ else if depth < 1 then ( (* leaf position *)
let res =
match pre_heur with
| Some h -> h
@@ -769,21 +771,21 @@
printf ", leaf %d heur: %F %!" player res.(player)
);
(* }}} *)
- res
+ res
) else
let location = graph.(loc) in
let moves =
gen_moves grid_size rules model location in
if moves = [| |] then (* terminal position *)
let res =
- (* *)
+ (* *
Array.map (fun expr ->
100000. *.
Solver.M.get_real_val expr model)
location.Arena.payoffs_pp (* see [let payoff] above *)
- (* *
+ * *)
play_evgame grid_size model time subgames.(loc)
- * *)
+ (* *)
in
(* {{{ log entry *)
if !debug_level > 4 then (
@@ -793,22 +795,24 @@
(* }}} *)
res
else if !timeout then
- play_evgame grid_size model time subgames.(loc)
+ Array.map (fun _ -> 0.) graph.(loc).Arena.payoffs
else
let models =
gen_models rules defined_rels model time moves in
let n = Array.length models in
- if n = 0 then begin (* terminal after postconditions *)
+ if !timeout then
+ Array.map (fun _ -> 0.) graph.(loc).Arena.payoffs
+ else if n = 0 then begin (* terminal after postconditions *)
let res =
(* play_evgame grid_size model time subgames.(loc) *)
- (* *)
- Array.map (fun expr ->
- 100000. *.
- Solver.M.get_real_val expr model)
- location.Arena.payoffs_pp
- (* *
+ (* *
+ Array.map (fun expr ->
+ 100000. *.
+ Solver.M.get_real_val expr model)
+ location.Arena.payoffs_pp
+ * *)
play_evgame grid_size model time subgames.(loc)
- * *)
+ (* *)
in
(* {{{ log entry *)
if !debug_level > 4 then (
@@ -839,7 +843,7 @@
Some heuristics
end else None in
let rec aux best i =
- if i < n && not !timeout then
+ if i < n && not !timeout then (
let pos = index.(i) in
let state = models.(pos) in
let sub_heur =
@@ -859,18 +863,18 @@
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);
+ 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));
+ 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
+ best) in
let alphas = Array.make num_players neg_infinity in
aux alphas 0 in
let betas = Array.make num_players infinity in
@@ -885,23 +889,45 @@
Aux.Right payoff
else
let cur_depth = ref 0 in
+ (* {{{ log entry *)
+ if !debug_level > 1 && (depth > 2 || !debug_level > 3) then (
+ Printf.printf "\n\nIterative-deepening: depth %d\n%!"
+ (!cur_depth + 1)
+ );
+ (* }}} *)
let scores =
Array.map (maximax_tree None player betas !cur_depth) models in
+ incr cur_depth;
while not !timeout && !cur_depth < depth do
+ (* {{{ log entry *)
+ if !debug_level > 1 && (depth > 2 || !debug_level > 3) then (
+ Printf.printf "\n\nIterative-deepening: depth %d\n%!"
+ (!cur_depth + 1)
+ );
+ (* }}} *)
let index =
Array.init (Array.length models) (fun i->i) in
Array.sort (fun j i-> compare
scores.(i).(player) scores.(j).(player)) index;
let betas = Array.make num_players infinity in
let new_scores =
- Array.map (fun i ->
- maximax_tree None player betas !cur_depth models.(i))
+ Array.map (fun j ->
+ maximax_tree None player betas !cur_depth models.(j))
index in
incr cur_depth;
if not !timeout then
Array.iteri (fun i j ->
(* inverting the permutation *)
- scores.(j) <- new_scores.(i)) index
+ scores.(j) <- new_scores.(i)) index;
+ (* {{{ log entry *)
+ if !debug_level > 1 && (depth > 2 || !debug_level > 3) then (
+ Printf.printf "\nIterative-deepening: depth %d scores:\n%!"
+ !cur_depth;
+ Array.iteri (fun i score ->
+ Printf.printf "Structure:%s -- score %F\n"
+ (Structure.str models.(i).struc) score.(player)) scores
+ );
+ (* }}} *)
done;
let _, best =
find_best_score ~use_det_setting:true cooperative player scores
Modified: trunk/Toss/Play/GameTest.ml
===================================================================
--- trunk/Toss/Play/GameTest.ml 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/Play/GameTest.ml 2011-02-02 00:00:24 UTC (rev 1305)
@@ -806,6 +806,29 @@
(fun mov_s -> "Cross{1:d4}" = mov_s);
);
+ "connect4 simple" >::
+ (fun () ->
+ let state = update_game connect4_game
+"[ | |
+ ] \"
+
+ . . . . . . .
+
+ . . . . . . .
+
+ . . . . . . .
+
+ P . . . . . .
+
+ P . . . . . .
+
+ P Q Q +Q . . .
+\"" 0 in
+ easy_case state 0 "should attack"
+ (fun mov_s -> "Cross{1:a4}" = mov_s);
+);
+
+
"connect4 endgame" >::
(fun () ->
let state = update_game connect4_game
@@ -888,9 +911,11 @@
let a () =
Game.set_debug_level 10
-let a =
+let a () = Game.use_monotonic := false
+
+let a () =
match test_filter
- ["Game:1:alpha_beta_ord:1:tictactoe suggest optimal single"]
+ ["Game:1:alpha_beta_ord:15:connect4 simple"]
tests
with
| Some tests -> ignore (run_test_tt ~verbose:true tests)
Modified: trunk/Toss/Server/Server.ml
===================================================================
--- trunk/Toss/Server/Server.ml 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/Server/Server.ml 2011-02-02 00:00:24 UTC (rev 1305)
@@ -517,8 +517,6 @@
let _ =
(* 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
@@ -526,10 +524,9 @@
String.sub p 0 (String.rindex p '/') in
let test_fname =
let fname = file_from_path Sys.executable_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
+ Printf.printf "fname: %s\n%!" fname;
+ let len = String.length fname in
+ Str.string_match (Str.regexp ".*Test.*") fname 0
in
(* so that the server is not started by the test suite. *)
if not test_fname then (
Modified: trunk/Toss/Server/ServerGDLTest.in
===================================================================
--- trunk/Toss/Server/ServerGDLTest.in 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/Server/ServerGDLTest.in 2011-02-02 00:00:24 UTC (rev 1305)
@@ -3,9 +3,9 @@
Sender: GAMEMASTER
Receiver: GAMEPLAYER
Content-type: text/acl
-Content-length: 1589
+Content-length: 1661
-(START MATCH.3316980891 X ((ROLE X) (ROLE O) (INIT (CELL 1 1 B)) (INIT (CELL 1 2 B)) (INIT (CELL 1 3 B)) (INIT (CELL 2 1 B)) (INIT (CELL 2 2 B)) (INIT (CELL 2 3 B)) (INIT (CELL 3 1 B)) (INIT (CELL 3 2 B)) (INIT (CELL 3 3 B)) (INIT (CONTROL X)) (<= (NEXT (CELL ?X ?Y ?PLAYER)) (DOES ?PLAYER (MARK ?X ?Y))) (<= (NEXT (CELL ?X ?Y ?MARK)) (TRUE (CELL ?X ?Y ?MARK)) (DOES ?PLAYER (MARK ?M ?N)) (DISTINCTCELL ?X ?Y ?M ?N)) (<= (NEXT (CONTROL X)) (TRUE (CONTROL O))) (<= (NEXT (CONTROL O)) (TRUE (CONTROL X))) (<= (ROW ?X ?PLAYER) (TRUE (CELL ?X 1 ?PLAYER)) (TRUE (CELL ?X 2 ?PLAYER)) (TRUE (CELL ?X 3 ?PLAYER))) (<= (COLUMN ?Y ?PLAYER) (TRUE (CELL 1 ?Y ?PLAYER)) (TRUE (CELL 2 ?Y ?PLAYER)) (TRUE (CELL 3 ?Y ?PLAYER))) (<= (DIAGONAL ?PLAYER) (TRUE (CELL 1 1 ?PLAYER)) (TRUE (CELL 2 2 ?PLAYER)) (TRUE (CELL 3 3 ?PLAYER))) (<= (DIAGONAL ?PLAYER) (TRUE (CELL 1 3 ?PLAYER)) (TRUE (CELL 2 2 ?PLAYER)) (TRUE (CELL 3 1 ?PLAYER))) (<= (LINE ?PLAYER) (ROW ?X ?PLAYER)) (<= (LINE ?PLAYER) (COLUMN ?Y ?PLAYER)) (<= (LINE ?PLAYER) (DIAGONAL ?PLAYER)) (<= OPEN (TRUE (CELL ?X ?Y B))) (<= (DISTINCTCELL ?X ?Y ?M ?N) (DISTINCT ?X ?M)) (<= (DISTINCTCELL ?X ?Y ?M ?N) (DISTINCT ?Y ?N)) (<= (LEGAL ?PLAYER (MARK ?X ?Y)) (TRUE (CELL ?X ?Y B)) (TRUE (CONTROL ?PLAYER))) (<= (LEGAL ?PLAYER NOOP) (NOT (TRUE (CONTROL ?PLAYER)))) (<= (GOAL ?PLAYER 100) (LINE ?PLAYER)) (<= (GOAL ?PLAYER 50) (NOT (LINE X)) (NOT (LINE O)) (NOT OPEN)) (<= (GOAL ?PLAYER1 0) (LINE ?PLAYER2) (DISTINCT ?PLAYER1 ?PLAYER2)) (<= (GOAL ?PLAYER 0) (NOT (LINE X)) (NOT (LINE O)) OPEN) (<= TERMINAL (LINE ?PLAYER)) (<= TERMINAL (NOT OPEN))) 30 30)
+(START MATCH.3316980891 XPLAYER ((ROLE XPLAYER) (ROLE OPLAYER) (INIT (CELL 1 1 B)) (INIT (CELL 1 2 B)) (INIT (CELL 1 3 B)) (INIT (CELL 2 1 B)) (INIT (CELL 2 2 B)) (INIT (CELL 2 3 B)) (INIT (CELL 3 1 B)) (INIT (CELL 3 2 B)) (INIT (CELL 3 3 B)) (INIT (CONTROL XPLAYER)) (<= (NEXT (CELL ?X ?Y ?PLAYER)) (DOES ?PLAYER (MARK ?X ?Y))) (<= (NEXT (CELL ?X ?Y ?MARK)) (TRUE (CELL ?X ?Y ?MARK)) (DOES ?PLAYER (MARK ?M ?N)) (DISTINCTCELL ?X ?Y ?M ?N)) (<= (NEXT (CONTROL XPLAYER)) (TRUE (CONTROL OPLAYER))) (<= (NEXT (CONTROL OPLAYER)) (TRUE (CONTROL XPLAYER))) (<= (ROW ?X ?PLAYER) (TRUE (CELL ?X 1 ?PLAYER)) (TRUE (CELL ?X 2 ?PLAYER)) (TRUE (CELL ?X 3 ?PLAYER))) (<= (COLUMN ?Y ?PLAYER) (TRUE (CELL 1 ?Y ?PLAYER)) (TRUE (CELL 2 ?Y ?PLAYER)) (TRUE (CELL 3 ?Y ?PLAYER))) (<= (DIAGONAL ?PLAYER) (TRUE (CELL 1 1 ?PLAYER)) (TRUE (CELL 2 2 ?PLAYER)) (TRUE (CELL 3 3 ?PLAYER))) (<= (DIAGONAL ?PLAYER) (TRUE (CELL 1 3 ?PLAYER)) (TRUE (CELL 2 2 ?PLAYER)) (TRUE (CELL 3 1 ?PLAYER))) (<= (LINE ?PLAYER) (ROW ?X ?PLAYER)) (<= (LINE ?PLAYER) (COLUMN ?Y ?PLAYER)) (<= (LINE ?PLAYER) (DIAGONAL ?PLAYER)) (<= OPEN (TRUE (CELL ?X ?Y B))) (<= (DISTINCTCELL ?X ?Y ?M ?N) (DISTINCT ?X ?M)) (<= (DISTINCTCELL ?X ?Y ?M ?N) (DISTINCT ?Y ?N)) (<= (LEGAL ?PLAYER (MARK ?X ?Y)) (TRUE (CELL ?X ?Y B)) (TRUE (CONTROL ?PLAYER))) (<= (LEGAL ?PLAYER NOOP) (NOT (TRUE (CONTROL ?PLAYER)))) (<= (GOAL ?PLAYER 100) (LINE ?PLAYER)) (<= (GOAL ?PLAYER 50) (NOT (LINE XPLAYER)) (NOT (LINE OPLAYER)) (NOT OPEN)) (<= (GOAL ?PLAYER1 0) (LINE ?PLAYER2) (DISTINCT ?PLAYER1 ?PLAYER2)) (<= (GOAL ?PLAYER 0) (NOT (LINE XPLAYER)) (NOT (LINE OPLAYER)) OPEN) (<= TERMINAL (LINE ?PLAYER)) (<= TERMINAL (NOT OPEN))) 30 30)
POST / HTTP/1.0
Accept: text/delim
Modified: trunk/Toss/Server/ServerGDLTest.out
===================================================================
--- trunk/Toss/Server/ServerGDLTest.out 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/Server/ServerGDLTest.out 2011-02-02 00:00:24 UTC (rev 1305)
@@ -27,7 +27,7 @@
Content-type: text/acl
Content-length: 10
-(MARK 3 3)
+(MARK 1 2)
HTTP/1.0 200 OK
Content-type: text/acl
Content-length: 4
Modified: trunk/Toss/Server/ServerTest.ml
===================================================================
--- trunk/Toss/Server/ServerTest.ml 2011-02-01 01:47:19 UTC (rev 1304)
+++ trunk/Toss/Server/ServerTest.ml 2011-02-02 00:00:24 UTC (rev 1305)
@@ -2,20 +2,22 @@
open Aux
let tests = "server" >::: [
+
"check ServerTest.in response" >::
(fun () ->
let in_ch = open_in "./Server/ServerTest.in" in
let out_ch = open_out "./Server/ServerTest.temp" in
- (*(try while true do
+ (try while true do
Server.req_handle in_ch out_ch done
- with End_of_file -> ());*)
+ with End_of_file -> ());
close_in in_ch; close_out out_ch;
let result =
Aux.input_file (open_in "./Server/ServerTest.temp") in
let target =
Aux.input_file (open_in "./Server/ServerTest.out") in
Sys.remove "./Server/ServerTest.temp";
- assert_equal ~printer:(fun x->x) target result
+ assert_equal ~printer:(fun x->x)
+ (strip_spaces target) (strip_spaces result)
);
"ServerGDLTest.in GDL Tic-Tac-Toe" >::
@@ -27,9 +29,10 @@
GDL.manual_game := "tictactoe";
let in_ch = open_in "./Server/ServerGDLTest.in" in
let out_ch = open_out "./Server/ServerGDLTest.temp" in
- (* (try while true do
+ Game.deterministic_suggest := true;
+ (try while true do
Server.req_handle in_ch out_ch done
- with End_of_file -> ()); *)
+ with End_of_file -> ());
close_in in_ch; close_out out_ch;
Game.deterministic_suggest := old_det_suggest;
let result =
@@ -37,9 +40,12 @@
let target =
Aux.input_file (open_in "./Server/ServerGDLTest.out") in
Sys.remove "./Server/ServerGDLTest.temp";
- assert_equal ~printer:(fun x->x) target result
+ assert_equal ~printer:(fun x->x)
+ (strip_spaces target) (strip_spaces result)
);
+
]
let a =
+ GDL.top_exec_path := ".";
Aux.run_test_if_target "ServerTest" tests
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
