[Toss-devel-svn] SF.net SVN: toss:[1722] trunk/Toss
Status: Beta
Brought to you by:
lukaszkaiser
Menu
▾
▴
[Toss-devel-svn] SF.net SVN: toss:[1722] trunk/Toss
|
From: <luk...@us...> - 2012-06-07 21:55:48
|
Revision: 1722
http://toss.svn.sourceforge.net/toss/?rev=1722&view=rev
Author: lukaszkaiser
Date: 2012-06-07 21:55:42 +0000 (Thu, 07 Jun 2012)
Log Message:
-----------
Using the new ODE solver in ContinuousRule and in the interface.
Modified Paths:
--------------
trunk/Toss/Arena/ContinuousRule.ml
trunk/Toss/Arena/ContinuousRule.mli
trunk/Toss/Client/JsHandler.ml
trunk/Toss/Client/Play.js
trunk/Toss/Formula/Formula.ml
trunk/Toss/Formula/FormulaTest.ml
Modified: trunk/Toss/Arena/ContinuousRule.ml
===================================================================
--- trunk/Toss/Arena/ContinuousRule.ml 2012-06-05 20:13:57 UTC (rev 1721)
+++ trunk/Toss/Arena/ContinuousRule.ml 2012-06-07 21:55:42 UTC (rev 1722)
@@ -1,9 +1,8 @@
(* Structure rewriting with continuous dynamics. *)
-let time_step = ref 0.1
-let get_time_step () = !time_step
-let set_time_step x = (time_step := x)
-let dIFFM = 10 (* So many differentiation steps for one time step. *)
+let time_step = 0.01
+let min_time_step = 0.1
+let max_registered_step = 0.05
(* ---------------- BASIC TYPE DEFINITION AND CONSTRUCTOR ------------------- *)
@@ -124,40 +123,73 @@
let dyn_c = Formula.compile ":t" dyn in
LOG 1 "current time: %f" cur_time;
let time = ref cur_time in
- let diff_step, t_mod_diff = !time_step /. (float_of_int dIFFM), ref 0 in
+ let diff_step, t_mod_diff = ref time_step, ref 0 in
let step vals t0 =
LOG 1 "step at time %F" t0;
- Formula.rk4_step t0 diff_step dyn_c vals in
+ (* (Formula.rk4_step t0 !diff_step dyn_c vals, !diff_step, !diff_step) in *)
+ Formula.rkCK_step (Formula.rkCK_default_start()) t0 !diff_step dyn_c vals in
(* add the trace of the embedding to the structure, for invariants *)
let cur_struc = ref (List.fold_left (fun s (le, se) ->
Structure.add_rel s ("_lhs_" ^ le) [|se|]) struc m) in
- let last_struc, cur_vals, all_vals = ref !cur_struc, ref init_vals, ref [] in
- let end_time = !time +. t -. (0.01 *. diff_step) in
+ let last_struc, cur_vals = ref !cur_struc, ref init_vals in
+ let all_vals, reg_vals, old_time = ref [], ref [], ref 0. in
+ let end_time, reg_dtime = !time +. t, ref (max_registered_step +. 1.) in
LOG 1 "end time: %f" end_time;
let upd_struct st = List.fold_left2 (fun s ((f, e), _) v ->
Structure.change_fun s f e v) st dyn (Array.to_list !cur_vals) in
- while (!time < end_time) && (Solver.M.check !cur_struc r.inv) do
- if !t_mod_diff = 0 || dIFFM = 1 then all_vals := !cur_vals :: !all_vals;
- t_mod_diff := (!t_mod_diff + 1) mod dIFFM;
- cur_vals := step !cur_vals !time ;
- time := !time +. diff_step ;
- last_struc := !cur_struc ;
- cur_struc := upd_struct !cur_struc ;
- done ;
+ while (!time < end_time) && (Solver.M.check !cur_struc r.inv) do
+ all_vals := ( !time :: (Array.to_list !cur_vals) ) :: !all_vals;
+ if !reg_dtime > max_registered_step then (
+ reg_vals := ( !time :: (Array.to_list !cur_vals) ) :: !reg_vals;
+ reg_dtime := 0.;
+ );
+ old_time := !time;
+ diff_step := min !diff_step (end_time -. !time);
+ while !time = !old_time do
+ let (new_cur_vals, new_time, new_dstep) = step !cur_vals !time in
+ time := !time +. new_time;
+ cur_vals := new_cur_vals;
+ diff_step := min min_time_step new_dstep;
+ done;
+ LOG 1 "step to time %F new size %F" !time !diff_step;
+ reg_dtime := !reg_dtime +. (!time -. !old_time);
+ last_struc := !cur_struc;
+ cur_struc := upd_struct !cur_struc;
+ done;
if (Solver.M.check !cur_struc r.inv) then (
- all_vals := !cur_vals :: !all_vals ;
+ all_vals := ( !time :: (Array.to_list !cur_vals) ) :: !all_vals;
+ reg_vals := ( !time :: (Array.to_list !cur_vals) ) :: !reg_vals ;
last_struc := !cur_struc
) else (
LOG 2 "Inv failed.\n%s\n%s" (Structure.str !cur_struc) (Formula.str r.inv);
if !all_vals = [] then
failwith "rewriting invariant failed in the first step; rule inapplicable"
- else cur_vals := List.hd !all_vals;
+ else (
+ cur_vals := Array.of_list (List.tl (List.hd !all_vals));
+ all_vals := List.tl !all_vals;
+ time := !old_time;
+ diff_step := !diff_step /. 10.;
+ cur_struc := !last_struc;
+ while Solver.M.check !cur_struc r.inv do ( (* repeat w/ small step size *)
+ all_vals := ( !time :: (Array.to_list !cur_vals) ) :: !all_vals;
+ let (new_cur_vals, new_time, new_dstep) = step !cur_vals !time in
+ cur_vals := new_cur_vals;
+ time := !time +. new_time;
+ last_struc := !cur_struc;
+ cur_struc := upd_struct !cur_struc;
+ ) done;
+ if (Solver.M.check !cur_struc r.inv) then (
+ failwith "ContinuousRule: rewrite_single_nocheck: error: impossible";
+ ) else (
+ cur_vals := Array.of_list (List.tl (List.hd !all_vals));
+ )
+ )
);
let rec select_pos ids llst =
if ids = [] then [] else (List.hd ids, List.map List.hd llst) ::
(select_pos (List.tl ids) (List.map List.tl llst)) in
- let all_vals_assoc =
- select_pos (List.map fst dyn) (List.rev_map Array.to_list !all_vals) in
+ let all_vals_assoc = if dyn = [] then [] else
+ select_pos (("t", "") :: (List.map fst dyn)) (List.rev !reg_vals) in
LOG 1 "%s" (String.concat "\n" (List.map (fun ((a, b), tl)-> a ^"("^ b ^")" ^
(String.concat ", " (List.map string_of_float tl))) all_vals_assoc));
let re_sb = List.map (fun (p,v) -> p, Formula.Const v) params in
Modified: trunk/Toss/Arena/ContinuousRule.mli
===================================================================
--- trunk/Toss/Arena/ContinuousRule.mli 2012-06-05 20:13:57 UTC (rev 1721)
+++ trunk/Toss/Arena/ContinuousRule.mli 2012-06-07 21:55:42 UTC (rev 1722)
@@ -1,9 +1,5 @@
(** Structure rewriting with continuous dynamics. *)
-val get_time_step : unit -> float
-val set_time_step : float -> unit
-
-
(** {2 Basic Type Definition} *)
(** Specification of a continuous rewriting rule, as in modelling document.
Modified: trunk/Toss/Client/JsHandler.ml
===================================================================
--- trunk/Toss/Client/JsHandler.ml 2012-06-05 20:13:57 UTC (rev 1721)
+++ trunk/Toss/Client/JsHandler.ml 2012-06-07 21:55:42 UTC (rev 1722)
@@ -167,7 +167,7 @@
minl posx, maxl posx, minl posy, maxl posy
(* Translate current structure into an "info_obj" format. *)
-let js_of_game_state ?(show_payoffs=true) ?dims game state =
+let js_of_game_state ?(show_payoffs=true) ?dims game (time, state) =
let struc = state.Arena.struc in
let elems = Structure.elements struc in
LOG 1 "js_of_game_state: Preparing game elements...";
@@ -196,6 +196,7 @@
(Structure.rel_signature struc)) in
let rels, rel_names = List.split rels_all in
let info_obj = jsnew js_object () in
+ Js.Unsafe.set info_obj (js"time") (num time);
Js.Unsafe.set info_obj (js"maxx") (num maxx);
Js.Unsafe.set info_obj (js"minx") (num minx);
Js.Unsafe.set info_obj (js"maxy") (num maxy);
@@ -245,7 +246,7 @@
cur_all_moves := Arena.list_moves_shifts game state;
cur_move := 0;
LOG 1 "new_play (%s): calling js_of_game_state." game_name;
- js_of_game_state game state
+ js_of_game_state game (0., state)
let _ = set_handle "new_play" new_play
@@ -254,19 +255,21 @@
if n < 0 then Js.null else
let game, _ = !cur_game.game_state in
let state = List.nth !play_states n in
- Js.some (js_of_game_state ~show_payoffs:(n = 0) game state)
+ Js.some (js_of_game_state ~show_payoffs:(n = 0) game (0., state))
let _ = set_handle "prev_move" preview_move
(* Compute all copies of [state] given by [shifts], including [state]. *)
let shifted_state state shifts =
- if shifts = [] then [state] else
- let len, res = List.length (snd (List.hd shifts)), ref [state] in
+ if shifts = [] then [(0., state)] else
+ let times, shifts = snd (List.hd shifts), List.tl shifts in
+ LOG 1 "%s" (String.concat ", " (List.map string_of_float times));
+ let len, res, t0 = List.length times, ref [(0., state)], List.hd times in
for i = 0 to len - 1 do
let new_struc = List.fold_left (fun struc ((fname, elem), ts) ->
let v = (List.nth ts i) in
Structure.change_fun struc fname elem v) state.Arena.struc shifts in
- res := { state with Arena.struc = new_struc } :: !res;
+ res := (List.nth times i -. t0, {state with Arena.struc=new_struc})::!res;
done;
!res
@@ -280,8 +283,10 @@
play_states := n_state :: !play_states;
cur_all_moves := Arena.list_moves_shifts game n_state;
cur_move := 0;
- let states = List.rev (n_state :: (shifted_state old_state shifts)) in
- let dims = List.fold_left (fun (a, b, c, d) s ->
+ let last_state = if shifts = [] then (0.1, n_state) else
+ (n_state.Arena.time -. (List.hd (snd (List.hd shifts))), n_state) in
+ let states = List.rev (last_state :: shifted_state old_state shifts) in
+ let dims = List.fold_left (fun (a, b, c, d) (_, s) ->
let (x, y, z, v) = state_dim s in
(min a x, max b y, min c z, max d v)) (state_dim n_state) states in
Js.some (Js.array (Array.of_list (List.map
Modified: trunk/Toss/Client/Play.js
===================================================================
--- trunk/Toss/Client/Play.js 2012-06-05 20:13:57 UTC (rev 1721)
+++ trunk/Toss/Client/Play.js 2012-06-07 21:55:42 UTC (rev 1722)
@@ -149,13 +149,12 @@
function play_move_continue (info, suggest_f) {
PlayDISP.free ();
- var TIMESTEP = 100;
for (var i = 1; i < info.length-1; i++) {
setTimeout (function (_this, cur_info) {
_this.cur_state =
new State (_this.game, cur_info, _this.cur_state.mirror);
_this.redraw ();
- }, i*TIMESTEP, this, info[i]);
+ }, info[i].time * 1000, this, info[i]);
}
setTimeout (function (_this, cur_info) {
_this.new_state (cur_info);
@@ -165,7 +164,7 @@
var mv_time = document.getElementById("speed").value;
suggest_f (mv_time);
}
- }, (info.length-1)*TIMESTEP, this, info[info.length - 1])
+ }, info[info.length-1].time * 1000, this, info[info.length - 1])
}
Play.prototype.move_continue = play_move_continue;
Modified: trunk/Toss/Formula/Formula.ml
===================================================================
--- trunk/Toss/Formula/Formula.ml 2012-06-05 20:13:57 UTC (rev 1721)
+++ trunk/Toss/Formula/Formula.ml 2012-06-07 21:55:42 UTC (rev 1722)
@@ -653,7 +653,7 @@
The interface is as in rk4_step above, except now the tolerance is used
(given by [epsilon]) and some initial references must be set (use the ones
from rkCK_default_start). We also return time passed and next step size.*)
-let rkCK_step ?(epsilon=0.0001) (twiddle1, twiddle2, quit1, quit2) tn h f yn =
+let rkCK_step ?(epsilon=0.00001) (twiddle1, twiddle2, quit1, quit2) tn h f yn =
let k1 = f tn yn in
let k2 = f (tn +. (h/.5.)) (aadd yn (amul (h/.5.) k1)) in
let y1 = aadd yn (amul h k1) in
Modified: trunk/Toss/Formula/FormulaTest.ml
===================================================================
--- trunk/Toss/Formula/FormulaTest.ml 2012-06-05 20:13:57 UTC (rev 1721)
+++ trunk/Toss/Formula/FormulaTest.ml 2012-06-07 21:55:42 UTC (rev 1722)
@@ -106,9 +106,9 @@
let (_, t, _) = rkCK_step (rkCK_default_start()) 0. 0.02 ceqs init in
assert_equal ~printer:(fun x -> string_of_float x) 0. t;
(* Now it is ok, should report results. *)
- let (res, _, _) = rkCK_step (rkCK_default_start()) 0. 0.003 ceqs init in
+ let (res, _, _) = rkCK_step (rkCK_default_start()) 0. 0.002 ceqs init in
assert_equal ~printer:(fun x -> x)
- "4.28845, 1.90309, 0.77440, 0.22559, 3.00456, 2.11544"
+ "2.93178, 2.62576, 0.83515, 0.16483, 6.34473, 6.82189"
(float_arr_str 7 res);
);
]
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
