Permalink
Browse files

KaSim update 3.2

  • Loading branch information...
1 parent b691034 commit 92a95999aeaf93d68a75e45789786d4e64596f56 Krivine committed Jan 4, 2013
Showing with 97 additions and 81 deletions.
  1. +1 −0 .paths
  2. +6 −6 grammar/eval.ml
  3. +1 −1 main/main.ml
  4. +8 −8 pattern/dynamics.ml
  5. +2 −2 simulation/run.ml
  6. +79 −64 simulation/state.ml
View
1 .paths
@@ -123,3 +123,4 @@ models/debug/LFCI
models/dna
zarith
zarith/trunk
+models/TP
View
@@ -532,7 +532,7 @@ let rule_of_ast ?(backwards=false) env (ast_rule_label, ast_rule) tolerate_new_s
in
let lhs = match k_alt with None -> lhs | Some _ -> Mixture.set_unary lhs in
let rhs,env = mixture_of_ast ~tolerate_new_state:tolerate_new_state None true env ast_rule.rhs in
- let (script, balance,added,modif_sites,side_effect) = Dynamics.diff ast_rule.rule_pos lhs rhs ast_rule_label.lbl_nme env
+ let (script, balance,added,modif_sites(*,side_effects*)) = Dynamics.diff ast_rule.rule_pos lhs rhs ast_rule_label.lbl_nme env
and kappa_lhs = Mixture.to_kappa false lhs env
@@ -682,7 +682,7 @@ let rule_of_ast ?(backwards=false) env (ast_rule_label, ast_rule) tolerate_new_s
Dynamics.rhs = rhs;
Dynamics.r_id = r_id;
Dynamics.added = List.fold_left (fun set i -> IntSet.add i set) IntSet.empty added ;
- Dynamics.side_effect = side_effect ;
+ (*Dynamics.side_effect = side_effect ; *)
Dynamics.modif_sites = modif_sites ;
Dynamics.is_pert = false ;
Dynamics.pre_causal = pre_causal ;
@@ -898,7 +898,7 @@ let pert_of_result variables env res =
let lhs = Mixture.empty (Some id)
and rhs = mix
in
- let (script,balance,added,modif_sites,side_effect) = Dynamics.diff pos lhs rhs (Some (str_pert,pos)) env
+ let (script,balance,added,modif_sites(*,side_effect*)) = Dynamics.diff pos lhs rhs (Some (str_pert,pos)) env
and kappa_lhs = ""
and kappa_rhs = Mixture.to_kappa false rhs env in
let r_id = Mixture.get_id lhs in
@@ -925,7 +925,7 @@ let pert_of_result variables env res =
Dynamics.rhs = rhs;
Dynamics.r_id = r_id;
Dynamics.added = List.fold_left (fun set i -> IntSet.add i set) IntSet.empty added ;
- Dynamics.side_effect = side_effect ;
+ (*Dynamics.side_effect = side_effect ; *)
Dynamics.modif_sites = modif_sites ;
Dynamics.is_pert = true ;
Dynamics.pre_causal = pre_causal ;
@@ -939,7 +939,7 @@ let pert_of_result variables env res =
let lhs = mix
and rhs = Mixture.empty None
in
- let (script,balance,added,modif_sites,side_effect) = Dynamics.diff pos lhs rhs (Some (str_pert,pos)) env
+ let (script,balance,added,modif_sites(*,side_effect*)) = Dynamics.diff pos lhs rhs (Some (str_pert,pos)) env
and kappa_lhs = Mixture.to_kappa false lhs env
and kappa_rhs = "" in
let r_id = Mixture.get_id lhs in
@@ -966,7 +966,7 @@ let pert_of_result variables env res =
Dynamics.rhs = rhs;
Dynamics.r_id = r_id;
Dynamics.added = List.fold_left (fun set i -> IntSet.add i set) IntSet.empty added ;
- Dynamics.side_effect = side_effect ;
+ (*Dynamics.side_effect = side_effect ; *)
Dynamics.modif_sites = modif_sites ;
Dynamics.pre_causal = pre_causal ;
Dynamics.is_pert = true ;
View
@@ -3,7 +3,7 @@ open Mods
open State
open Random_tree
-let version = "3.1-191112"
+let version = "3.2-040113"
let usage_msg = "KaSim "^version^": \n"^"Usage is KaSim -i input_file [-e events | -t time] [-p points] [-o output_file]\n"
let version_msg = "Kappa Simulator: "^version^"\n"
View
@@ -33,7 +33,7 @@ type rule = {
refines: int option ; (*mixture id that is refined by lhs*)
r_id : int ;
added : IntSet.t;
- side_effect : bool ;
+ (*side_effect : bool ;*)
modif_sites : Int2Set.t IdMap.t ;
pre_causal : int Id2Map.t ; (* INTERNAL_TESTED (8) | INTERNAL_MODIF (4) | LINK_TESTED (2) | LINK_MODIF (1) *)
is_pert : bool ;
@@ -201,7 +201,7 @@ let diff pos m0 m1 label_opt env =
in
IdMap.add id (Int2Set.add site_type set) map
in
- let side_effect = ref false in
+ (*let side_effect = ref false in*)
let label = match label_opt with Some (_,pos) -> (string_of_pos pos) | None -> "" in
let compile_error pos msg = raise (ExceptionDefn.Semantics_Error (pos,msg)) in
let id_preserving ag1 ag2 = (*check whether ag2 can be the residual of ag1 for (same name)*)
@@ -230,7 +230,7 @@ let diff pos m0 m1 label_opt env =
and instructions = (*adding deletion instructions*)
List.fold_left
(fun inst id ->
- side_effect := true ;
+ (*side_effect := true ;*)
(DEL id):: inst
)
[] deleted
@@ -366,7 +366,7 @@ let diff pos m0 m1 label_opt env =
let inst = (FREE (((KEPT id), site_id),false)):: inst
and idmap = add_map (KEPT id) (site_id,1) idmap
in
- side_effect := true ;
+ (*side_effect := true ;*)
let _ =
warning
(Printf.sprintf
@@ -401,7 +401,7 @@ let diff pos m0 m1 label_opt env =
begin
let inst = BND((KEPT id, site_id), (id'',i1')):: inst
in
- side_effect := true ;
+ (*side_effect := true ;*)
(inst,idmap')
end
else (inst,idmap')
@@ -477,7 +477,7 @@ let diff pos m0 m1 label_opt env =
let inst = (FREE ((KEPT id, site_id),false))::inst
and idmap = add_map (KEPT id) (site_id,1) idmap
in
- (side_effect := true ;
+ ((*side_effect := true ;*)
(inst,idmap))
| (Node.WLD, Node.BND) -> (*wildcard -> connected*)
let opt' = Mixture.follow (id, site_id) m1 in
@@ -502,7 +502,7 @@ let diff pos m0 m1 label_opt env =
if (id'< id) or (id'= id && i'< site_id) then
let inst = BND((KEPT id, site_id), (id'', i')):: inst
in
- (side_effect:= true;
+ ((*side_effect:= true;*)
(inst,idmap'))
else (inst,idmap')
end
@@ -525,7 +525,7 @@ let diff pos m0 m1 label_opt env =
in
compare (weight inst) (weight inst')
in
- ((List.fast_sort sort instructions),balance,added,modif_sites,!side_effect)
+ ((List.fast_sort sort instructions),balance,added,modif_sites (*,!side_effect*))
(*List.rev instructions, balance, added, modif_sites,!side_effect*)
let rec superpose todo_list lhs rhs map already_done added codomain env =
View
@@ -143,14 +143,14 @@ let event state (*grid*) story_profiling event_list counter plot env =
if !Parameter.debugModeOn then Debug.tag "Null (clash or doesn't satisfy constraints)";
Counter.inc_null_events counter ;
Counter.inc_consecutive_null_events counter ;
- (env,state,IntSet.empty,story_profiling,event_list)
+ (env,state,pert_ids_time,story_profiling,event_list)
end
(**************END CFLOW PRODUCTION********************)
in
+
(*Applying perturbation if any*)
- (*Printf.printf "Applying %s perturbations \n" (Tools.string_of_set string_of_int IntSet.fold pert_ids) ;*)
let state,env,obs_from_perturbation,pert_events =
External.try_perturbate state pert_ids counter env
in
View
@@ -842,59 +842,59 @@ let wake_up state modif_type modifs wake_up_map env =
) modifs wake_up_map
(*Note: update_dep is recursive but the first call should always be with dep_in = (KAPPA mix_id) or EVENT or TIME*)
-let rec update_dep state cause dep_in pert_ids counter env =
- let env,depset,pert_ids =
- match dep_in with
- | Mods.TOK t_id -> (*token counter is changed*)
- let depset =
- Environment.get_dependencies (Mods.TOK t_id) env
- in
- begin
- if !Parameter.debugModeOn then
- Debug.tag
- (Printf.sprintf "Token %d is changed, updating %s" t_id (string_of_set Mods.string_of_dep DepSet.fold depset))
- end;
- (env,depset,pert_ids)
- | Mods.ALG v_id -> (*variable v_id is changed*)
- let depset =
- Environment.get_dependencies (Mods.ALG v_id) env
- in
- begin
- if !Parameter.debugModeOn then
- Debug.tag
- (Printf.sprintf "Variable %d is changed, updating %s" v_id (string_of_set Mods.string_of_dep DepSet.fold depset))
- end;
- (env,depset,pert_ids)
- | Mods.RULE r_id ->
- (update_activity state cause r_id counter env;
- let depset = Environment.get_dependencies (Mods.RULE r_id) env
- in
- if !Parameter.debugModeOn then if !Parameter.debugModeOn then Debug.tag (Printf.sprintf "Rule %d is changed, updating %s" r_id (string_of_set Mods.string_of_dep DepSet.fold depset)) ;
- (env,depset,pert_ids)
- )
- | Mods.PERT p_id ->
- if IntMap.mem p_id state.perturbations then (*pertubation p_id is still alive and should be tried*)
- (env,DepSet.empty,IntSet.add p_id pert_ids)
- else (*pertubation p_id is removed and should be discarded from dependencies*)
- (Environment.remove_dependencies dep_in (Mods.PERT p_id) env,DepSet.empty,pert_ids)
- | Mods.ABORT p_id ->
- if IntMap.mem p_id state.perturbations then (env,DepSet.empty,IntSet.add p_id pert_ids)
- else
- (Environment.remove_dependencies dep_in (Mods.PERT p_id) env,DepSet.empty,pert_ids)
- | Mods.KAPPA i -> (*No need to update kappa observable, it will be updated if plotted*)
- let depset =
- Environment.get_dependencies (Mods.KAPPA i) env
- in
- if !Parameter.debugModeOn && not (DepSet.is_empty depset) then Debug.tag (Printf.sprintf "Observable %d is changed, updating %s" i (string_of_set Mods.string_of_dep DepSet.fold depset)) ;
- (env,depset,pert_ids)
- | Mods.EVENT | Mods.TIME ->
- let depset = Environment.get_dependencies dep_in env in
- (env,depset,pert_ids)
- in
- DepSet.fold
- (fun dep (env,pert_ids) -> update_dep state cause dep pert_ids counter env
- )
- depset (env,pert_ids)
+let update_dep state cause dep_in pert_ids counter env =
+ let rec iter env dep_to_check pert_ids =
+ if DepSet.is_empty dep_to_check then (env,pert_ids)
+ else
+ let dep_in = DepSet.choose dep_to_check in
+ match dep_in with
+ | Mods.TOK t_id -> (*token counter is changed*)
+ let depset =
+ Environment.get_dependencies (Mods.TOK t_id) env
+ in
+ begin
+ if !Parameter.debugModeOn then
+ Debug.tag
+ (Printf.sprintf "Token %d is changed, updating %s" t_id (string_of_set Mods.string_of_dep DepSet.fold depset))
+ end;
+ iter env (DepSet.union (DepSet.remove dep_in dep_to_check) depset) pert_ids
+ | Mods.ALG v_id -> (*variable v_id is changed*)
+ let depset =
+ Environment.get_dependencies (Mods.ALG v_id) env
+ in
+ begin
+ if !Parameter.debugModeOn then
+ Debug.tag
+ (Printf.sprintf "Variable %d is changed, updating %s" v_id (string_of_set Mods.string_of_dep DepSet.fold depset))
+ end;
+ iter env (DepSet.union (DepSet.remove dep_in dep_to_check) depset) pert_ids
+ | Mods.RULE r_id ->
+ (update_activity state cause r_id counter env;
+ let depset = Environment.get_dependencies (Mods.RULE r_id) env
+ in
+ if !Parameter.debugModeOn then if !Parameter.debugModeOn then Debug.tag (Printf.sprintf "Rule %d is changed, updating %s" r_id (string_of_set Mods.string_of_dep DepSet.fold depset)) ;
+ iter env (DepSet.union (DepSet.remove dep_in dep_to_check) depset) pert_ids
+ )
+ | Mods.PERT p_id ->
+ if IntMap.mem p_id state.perturbations then (*pertubation p_id is still alive and should be tried*)
+ iter env (DepSet.remove dep_in dep_to_check) (IntSet.add p_id pert_ids)
+ else (*pertubation p_id is removed and should be discarded from dependencies*)
+ iter (Environment.remove_dependencies dep_in (Mods.PERT p_id) env) (DepSet.remove dep_in dep_to_check) pert_ids
+ | Mods.ABORT p_id ->
+ if IntMap.mem p_id state.perturbations then iter env (DepSet.remove dep_in dep_to_check) (IntSet.add p_id pert_ids)
+ else
+ iter (Environment.remove_dependencies dep_in (Mods.PERT p_id) env) (DepSet.remove dep_in dep_to_check) pert_ids
+ | Mods.KAPPA i -> (*No need to update kappa observable, it will be updated if plotted*)
+ let depset =
+ Environment.get_dependencies (Mods.KAPPA i) env
+ in
+ if !Parameter.debugModeOn && not (DepSet.is_empty depset) then Debug.tag (Printf.sprintf "Observable %d is changed, updating %s" i (string_of_set Mods.string_of_dep DepSet.fold depset)) ;
+ iter env (DepSet.union (DepSet.remove dep_in dep_to_check) depset) pert_ids
+ | Mods.EVENT | Mods.TIME ->
+ let depset = Environment.get_dependencies dep_in env in
+ iter env (DepSet.union (DepSet.remove dep_in dep_to_check) depset) pert_ids
+ in
+ iter env (DepSet.singleton dep_in) pert_ids
let enabled r state =
let r_id = Mixture.get_id r.lhs in
@@ -1083,13 +1083,14 @@ let positive_update ?(with_tracked=[]) state r ((phi: int IntMap.t),psi) (side_m
) (env,pert_ids) r.Dynamics.rm_token
in
-
- if not r.Dynamics.side_effect then (env,state,pert_ids,new_injs,tracked)
+ (*Checking if any side effect needs to be checked*)
+ if Int2Set.is_empty side_modifs then (env,state,pert_ids,new_injs,tracked)
else (*Handling side effects*)
-
let wu_map = IntMap.empty
in
+ if !Parameter.debugModeOn then Debug.tag "Checking positive update entailed by side effects";
+
let wu_map = wake_up state 1 side_modifs wu_map env in
let wu_map = wake_up state 2 pert_intro wu_map env in
let (env,state, pert_ids,_,new_injs,tracked) =
@@ -1236,8 +1237,8 @@ let bind state cause (u, i) (v, j) side_effects pert_ids counter env =
| Node.Ptr (u', i') ->
begin
Node.set_ptr (u', i') Node.Null;
- let env,pert_ids = negative_upd state cause (u', i') 1 counter env in
- try (env,Int2Set.add ((Node.get_address u'), i') side_effects, pert_ids)
+ let env,pert_ids' = negative_upd state cause (u', i') 1 counter env in
+ try (env,Int2Set.add ((Node.get_address u'), i') side_effects, IntSet.union pert_ids' pert_ids)
with Not_found -> invalid_arg "State.bind: Not_found"
end
in
@@ -1277,11 +1278,11 @@ let break state cause (u, i) side_effects pert_ids counter env side_effect_free
in
(intf_u.(i) <-
{ (intf_u.(i)) with Node.status = (int_u_i, Node.Null); };
- let env,pert_ids = negative_upd state cause (u, i) 1 counter env in
+ let env,pert_ids' = negative_upd state cause (u, i) 1 counter env in
intf_v.(j) <-
{ (intf_v.(j)) with Node.status = (int_v_j, Node.Null); };
- let env,pert_ids' = negative_upd state cause (v, j) 1 counter env in
- let pert_ids = IntSet.union pert_ids pert_ids' in
+ let env,pert_ids'' = negative_upd state cause (v, j) 1 counter env in
+ let pert_ids = IntSet.union pert_ids (IntSet.union pert_ids' pert_ids'') in
if side_effect_free then
(warn,env,side_effects,pert_ids)
else
@@ -1300,8 +1301,8 @@ let modify state cause (u, i) s pert_ids counter env =
let warn = if s = j then warn + 1 else warn
in
(* if s=j then null event *)
- let env,pert_ids = (*if s <> j then*) negative_upd state cause (u, i) 0 counter env in
- (warn,env,pert_ids)
+ let env,pert_ids' = (*if s <> j then*) negative_upd state cause (u, i) 0 counter env in
+ (warn,env,IntSet.union pert_ids pert_ids')
)
| None ->
invalid_arg
@@ -1433,7 +1434,7 @@ let dump state counter env =
in
let a2,a1 = eval_activity r state counter env in
if Environment.is_rule i env then
- Printf.printf "#\t%s %s @ %f[upd:%f(%f)]\n" nme (Dynamics.to_kappa r env)
+ Printf.printf "#rule[%d]: \t%s %s @ %f[upd:%f(%f)]\n" i nme (Dynamics.to_kappa r env)
(Random_tree.find i state.activity_tree)
(Num.float_of_num a2) (Num.float_of_num a1)
else
@@ -1502,6 +1503,20 @@ let dump state counter env =
((fun (s,_) -> s) (Environment.alg_of_num var_id env))
x
) state.alg_variables;
+ Array.iteri
+ (fun mix_id mix_opt ->
+ match mix_opt with
+ | None -> ()
+ | Some m ->
+ let num = instance_number mix_id state env
+ and name = Environment.kappa_of_num mix_id env
+ in
+ Printf.printf "kappa[%d] '%s' %s\n" mix_id name (Num.to_string num)
+ ) state.kappa_variables ;
+ Array.iteri
+ (fun tk_id v ->
+ Printf.printf "token[%d]: '%s' %f\n" tk_id (Environment.token_of_num tk_id env) v
+ ) state.token_vector ;
IntMap.fold
(fun i pert _ ->
Printf.printf "#pert[%d]: %s\n" i (Environment.pert_of_num i env)

0 comments on commit 92a9599

Please sign in to comment.