working day

Author: Ioana

ast.ml

@@ -16,26 +16,16 @@ type agent = (string * port list)
 
 type mixture = agent list
 
-type lnk_or_int = INT of string
-                | LNK of link
-
-type q = int*string*lnk_or_int
-
-type quarks = Tested of q list
-            | TestedMod of (q*q) list
-            | Modified of q list
-
 type rule = {
   lhs: mixture ;
   bidirectional: bool ;
   rhs: mixture ;
-  prefix_map : quarks list;
 }
+
 type t = INIT of mixture
        | OBS of string*mixture
        | RULE of string*rule
 
-
 let add_free_to_port_lnk plinks = match plinks with
   | [] -> [FREE]
   | ls -> ls
@@ -53,25 +43,35 @@ let add_free_to_mix mix =
 let split_ports_quarks count port =
   let quark_int = match port.port_int with
     | [] -> []
-    | s::_ -> [(count,port.port_nme,(INT s))] in
+    | s::_ -> [(count,port.port_nme,(Rule.INT s))] in
   match port.port_lnk with
   | [] -> []
-  | l::_ -> (count,port.port_nme,(LNK l))::quark_int
+  | l::_ -> match l with
+            | LNK_VALUE i ->
+               let rule_lnk = Rule.LNK (Idgraph.LNK_VALUE i) in
+               (count,port.port_nme,rule_lnk)::quark_int
+            | FREE ->
+               let rule_lnk = Rule.LNK (Idgraph.FREE) in
+               (count,port.port_nme,rule_lnk)::quark_int
+            | LNK_ANY -> quark_int
+            | LNK_SOME | LNK_TYPE _ ->
+               (raise (ExceptionDefn.Not_Supported
+                         ("rules with side effects not supported")))
 
 let create_quarks mixture count =
   List.fold_left
-    (fun (qs,agent_names,count) (name,plist) ->
+    (fun (qs,agent_names,count) ((name:string),plist) ->
       let qs' =
         List.fold_left
           (fun acc port -> (split_ports_quarks count port)@acc) [] plist in
-      (qs'@qs,(name,count)::agent_names,count+1))
+      (qs'@qs,(count,name)::agent_names,count+1))
     ([],[],count) mixture
 
 let create_rhs_quarks agent_names mixture =
   let rec aux qs mixt count ag_nm =
     match mixt with
     | (name,plist)::mixt' ->
-       if (List.mem (name,count) ag_nm) then
+       if (List.mem (count,name) ag_nm) then
          let qs' =
            List.fold_left
              (fun acc port -> (split_ports_quarks count port)@acc) [] plist in
@@ -83,7 +83,7 @@ let create_rhs_quarks agent_names mixture =
   aux [] mixture 0 agent_names
 
 let match_il il il' = match (il,il') with
-  | (INT _,INT _) | (LNK _,LNK _) -> true
+  | (Rule.INT _,Rule.INT _) | (Rule.LNK _,Rule.LNK _) -> true
   | _ -> false
 
 let remove_quark (n,p,il) ls =
@@ -95,52 +95,55 @@ let partition_quarks lhs_quarks rhs_quarks =
   let find (n,p,il) rhs =
     List.find (fun (n',p',il') ->
                 (n=n')&&(String.equal p p')&&(match_il il il')) rhs in
-  let (tested,tested_mod,rhs)=
+  let (qlist,rhs)=
     List.fold_left
-      (fun (tested,tested_mod,rhs) (n,p,il) ->
-        if (List.mem (n,p,il) rhs_quarks) then
-          (((n,p,il)::tested),tested_mod,(remove_quark (n,p,il) rhs))
+      (fun (qlist',rhs') (n,p,il) ->
+        if (List.mem (n,p,il) rhs') then
+          let new_quark = Rule.Tested (n,p,il) in
+          (new_quark::qlist',(remove_quark (n,p,il) rhs'))
         else
           let (n',p',il') =
-            (try (find (n,p,il) rhs)
+            (try (find (n,p,il) rhs')
              with _ ->
                (raise
                   (ExceptionDefn.Syntax_Error
                      ("agent does not have the same ports in lhs and rhs")))) in
-          (tested,((n,p,il),(n',p',il'))::tested_mod,
-           (remove_quark (n,p,il) rhs)))
-      ([],[],rhs_quarks) lhs_quarks in
-  let () =
-    List.iter (fun (ag,_,_) ->
-                List.iter
-                  (fun (ag',_,_) ->
-                    if (ag=ag') then
-                      (raise
-                         (ExceptionDefn.Syntax_Error
-                            ("agent does not have the same ports
-                              in lhs and rhs")))) rhs)
-              tested in
-  (tested,tested_mod,rhs)
+          let new_quark = Rule.TestedMod ((n,p,il),(n',p',il')) in
+          (new_quark::qlist',(remove_quark (n,p,il) rhs')))
+      ([],rhs_quarks) lhs_quarks in
+  let modified =
+    List.map
+      (fun ((ag,_,_) as q) ->
+        let () =
+          List.iter (fun q -> if (ag=(Rule.get_agent q)) then
+                                (raise
+                                   (ExceptionDefn.Syntax_Error
+                                      ("agent does not have the same ports
+                                        in lhs and rhs")))) qlist in
+               Rule.Modified q) rhs in
+  (modified@qlist)
 
 let create_prefix_map lhs rhs =
   let (lhs_quarks,lhs_agent_nm,_) = create_quarks lhs 0 in
   let (rhs_quarks,rhs_agent_nm) = create_rhs_quarks lhs_agent_nm rhs in
-  let (t_quarks,tm_quarks,m_quarks) =
-    partition_quarks lhs_quarks rhs_quarks in
-  [Tested t_quarks; TestedMod tm_quarks; Modified m_quarks]
-
-let clean_rules = function
-  | INIT mix -> INIT (add_free_to_mix mix)
-  | OBS (name,mix) -> OBS (name,add_free_to_mix mix)
+  (partition_quarks lhs_quarks rhs_quarks,rhs_agent_nm)
+
+let clean_rule = function
+  | INIT mix ->
+     let (quarks,agent_names) = create_prefix_map (add_free_to_mix mix) [] in
+     let label = List.fold_left (fun acc (nme,_) -> acc^nme) "" mix in
+     Rule.INIT (label,quarks,agent_names)
+  | OBS (name,mix) ->
+     let (quarks,agent_names) = create_prefix_map [] (add_free_to_mix mix) in
+     Rule.OBS (name,quarks,agent_names)
   | RULE (name,r) ->
      let () = if (r.bidirectional) then
                 (raise (ExceptionDefn.Not_Supported
                           ("bidirectional rules not supported"))) in
      let lhs = add_free_to_mix r.lhs in
      let rhs = add_free_to_mix r.rhs in
-     let r' = {lhs; bidirectional=r.bidirectional;rhs;
-               prefix_map = (create_prefix_map lhs rhs)} in
-     RULE (name,r')
+     let (quarks,agent_names) = create_prefix_map lhs rhs in
+     Rule.RULE (name,quarks,agent_names)
 
 let print_link = function
   | LNK_VALUE i -> Format.printf "!%d" i
@@ -149,27 +152,6 @@ let print_link = function
   | LNK_SOME -> Format.printf "!_"
   | LNK_TYPE (i,a) -> Format.printf "!%s.%s" i a
 
-let print_quarks qs =
-  let print_q (n,p,il) =
-    Format.printf "(%d,%s," n p;
-    (match il with
-      INT i -> Format.printf "int=%s " i
-    | LNK lnk ->
-       Format.printf "lnk= "; print_link lnk);
-    Format.printf ")" in
-  let print_qlist qlist =
-    List.iter (fun q -> print_q q) qlist in
-  match qs with
-  | Tested qlist ->
-     Format.printf "\nTested: "; print_qlist qlist
-  | Modified qlist ->
-     Format.printf "\nModified: "; print_qlist qlist
-  |TestedMod qqlist ->
-    Format.printf "\nTestedMod ";
-    List.iter (fun (q1,q2) ->
-                Format.printf"[before = ";print_q q1;Format.printf "]  ";
-                Format.printf"[after = ";print_q q2;Format.printf "]  ") qqlist
-
 let print_port p =
   Format.printf "%s~[" p.port_nme;
   List.iter (fun intern -> Format.printf "%s " intern;) p.port_int;
@@ -185,42 +167,13 @@ let print_rule r =
   List.iter (fun a -> print_agent a) r.lhs;
   if (r.bidirectional) then Format.printf " <-> "
   else Format.printf " -> ";
-  List.iter (fun a -> print_agent a) r.rhs;
-  List.iter (fun quarks -> print_quarks quarks) r.prefix_map
+  List.iter (fun a -> print_agent a) r.rhs
 
 let print = function
   | INIT mix -> Format.printf "\n init "; List.iter (fun a -> print_agent a) mix
   | OBS (name,mix) -> Format.printf "\n obs '%s' " name;
                       List.iter (fun a -> print_agent a) mix
   | RULE (name,r) -> Format.printf "\n rule '%s' " name; print_rule r
 
-let empty_rule = {lhs =[];rhs=[];bidirectional=false;prefix_map=[]}
-
+let empty_rule = {lhs =[];rhs=[];bidirectional=false;}
 let empty = RULE ("empty",empty_rule)
-
-let get_label = function
-  | INIT mix -> List.fold_left (fun acc (nme,_) -> acc^nme) "" mix
-  | OBS (name,_) -> name
-  | RULE (name,_) ->  name
-
-let get_rule_by_label nme rules =
-  List.find
-    (fun r -> String.equal (get_label r) nme) rules
-
-let get_lhs = function
-  | INIT mix -> []
-  | OBS (name,mix) -> mix
-  | RULE (name,r) -> r.lhs
-
-let get_rhs = function
-  | INIT mix -> mix
-  | OBS (name,mix) -> mix
-  | RULE (name,r) -> r.rhs
-
-let is_init = function
-  | INIT _ -> true
-  | OBS _ | RULE _ -> false
-
-let is_obs = function
-  | OBS _ -> true
-  | INIT _ | RULE _  -> false

ast.mli

@@ -16,19 +16,10 @@ type agent = (string * port list)
 
 type mixture = agent list
 
-type lnk_or_int = INT of string
-                | LNK of link
-
-type q = int*string*lnk_or_int
-
-type quarks = Tested of q list
-            | TestedMod of (q*q) list
-            | Modified of q list
 type rule = {
   lhs: mixture ;
   bidirectional:bool ;
   rhs: mixture ;
-  prefix_map : quarks list ;
 }
 
 type t = INIT of mixture
@@ -42,12 +33,4 @@ val print : t -> unit
 
 (* the parser returns the empty list for a free link
    we replace the empty list in link with [FREE] *)
-val clean_rules : t -> t
-
-val get_label : t -> String.t
-val get_rule_by_label : String.t -> t list -> t
-
-val get_lhs : t -> mixture
-val get_rhs : t -> mixture
-val is_init : t -> bool
-val is_obs : t -> bool
+val clean_rule : t -> Rule.t

concret.ml

@@ -1,8 +1,7 @@
-
 let linears s =
   LinearPoset.linearisations(s)
 
-let concretise (s:LinearPoset.t) (rs:Ast.t list) =
+let concretise (s:LinearPoset.t) (rs:Rule.t list) =
   let () = if (!Parameter.debug_mode) then
              (Format.printf "concretise linear poset :";
               List.iter (fun i -> Format.printf "%d " i) s.LinearPoset.seq) in
@@ -11,31 +10,32 @@ let concretise (s:LinearPoset.t) (rs:Ast.t list) =
       (fun (trace,rf) eid ->
         let event = Poset.get_event_by_id eid s.LinearPoset.pos in
         let rname = Event.get_label event in
-        let rule = Ast.get_rule_by_label rname rs in
+        let rule = Rule.get_rule_by_label rname rs in
         let m = Transition.get_rhs (Trace.get_first_transition trace) in
-        let trans = Transition.make m rule (Event.get_quarks event) in
-        ((Trace.add_transition trace trans), ((eid,trans)::rf)))
-          (* else (raise (ExceptionDefn.NotKappa_Poset *)
-          (*                ("quarks of event "^rname^" not valid")))) *)
+        let (trans,new_nodes,new_ports) =
+          Transition.make m rule (Event.get_quarks event)
+                          trace.Trace.node_names trace.Trace.port_names in
+        ((Trace.add_transition trace trans new_nodes new_ports),
+         ((eid,trans)::rf)))
       (Trace.empty,[]) s.LinearPoset.seq in
   trace
 
-let test_concret (s:LinearPoset.t) (rs:Ast.t list) =
+let test_concret (s:LinearPoset.t) (rs:Rule.t list) =
   let () = if (!Parameter.debug_mode) then
              (Format.printf "concretise linear poset :";
               List.iter (fun i -> Format.printf "%d " i) s.LinearPoset.seq) in
   let event = Poset.get_event_by_id 4 s.LinearPoset.pos in
   let rname = Event.get_label event in
-  let rule = Ast.get_rule_by_label rname rs in
+  let rule = Rule.get_rule_by_label rname rs in
 
   let () = if (!Parameter.debug_mode) then
              (Format.printf "info on first event ";
               Event.print_event event;
-              Ast.print rule) in
+              Rule.print rule) in
 
-  let trans = Transition.make [] rule (Event.get_quarks event) in
+  let (trans,_,_) = Transition.make [] rule (Event.get_quarks event) [] [] in
   let () = if (!Parameter.debug_mode) then
               Transition.print trans in
   Trace.empty
 
-let concret (s:Poset.t) (rs:Ast.t list) = concretise (linears s) rs
+let concret (s:Poset.t) (rs:Rule.t list) = concretise (linears s) rs

concret.mli

@@ -1,2 +1,2 @@
 
-val concret : Poset.t -> Ast.t list -> Trace.t
+val concret : Poset.t -> Rule.t list -> Trace.t

formulas.mli

@@ -21,7 +21,7 @@ val holds : (string -> Domain.domain list -> Domain.domain) *
                 (Domain.domain list) ->
             (string -> Domain.domain) -> Domain.domain fol formula -> bool
 
-val interpretation : Domain.t -> Ast.t list ->
+val interpretation : Domain.t -> Rule.t list ->
                      (string -> Domain.domain list -> Domain.domain) *
                        (string -> Domain.domain list -> bool) *
                          Domain.domain list

grammar/parserRule.mly

@@ -24,7 +24,7 @@ start_rule:
 rule_expression:
     | rule_label lhs_rhs arrow lhs_rhs
 		 { Ast.RULE ($1,({Ast.lhs=$2; Ast.bidirectional=$3;
-			    Ast.rhs=$4;Ast.prefix_map=[]}))}
+			    Ast.rhs=$4}))}
     ;
 
 arrow:

main.ml

@@ -61,10 +61,11 @@ let parse_rules () =
     let lexbuf = Lexing.from_channel chan in
     while true do
       let result = ParserRule.newline LexerRule.token lexbuf in
-      let free_res = Ast.clean_rules result in
-      read_rule := free_res::(!read_rule);
+      let rule = Ast.clean_rule result in
+      read_rule := rule::(!read_rule);
       if (!Parameter.debug_mode) then
-        (Format.printf "parsing \n"; Ast.print result;Format.printf"\n")
+        (Format.printf "parsing \n"; Ast.print result;
+         Format.printf " becomes \n"; Rule.print rule;Format.printf "\n")
     done
   with LexerRule.Eof -> ()
 

notes/bio.bib

@@ -92,4 +92,13 @@ @proceedings{DBLP:conf/fsttcs/1992
   timestamp = {Wed, 03 Jul 2002 10:23:36 +0200},
   biburl    = {http://dblp.uni-trier.de/rec/bib/conf/fsttcs/1992},
   bibsource = {dblp computer science bibliography, http://dblp.org}
+}
+
+@misc{RussInfluence,
+  author        = {Russ Harmer},
+  title         = {Lecture notes in Rule-based modeling},
+  month         = {October},
+  year          = {2016},
+  publisher={ENS Lyon},
+  url = {http://perso.ens-lyon.fr/russell.harmer/rbm.html}
 }

notes/grammar.tex

@@ -32,8 +32,8 @@ \section{Logic on posets}
 
 \subsection{Grammar}
 
-Let $R$ a set of labels, $\mathcal{S}$ a set of posets and let $\varepsilon = \cup_{s_i\in S} E_i$ be the set of events in $\mathcal{S}$, where $E_i$ is the set of events in $s_i$.
-We denote $A,B$ elements of $R$ and $s$ elements of $\mathcal{S}$.
+Let $\mathcal{R}$ be a set of labels, $\mathcal{S}$ be a set of posets and let $\varepsilon = \cup_{s_i\in S} E_i$ be the set of events in $\mathcal{S}$, where $E_i$ is the set of events in $s_i$.
+We denote $A,B$ elements of $\mathcal{R}$ and $s$ elements of $\mathcal{S}$.
 
 \begin{align*}
   x ::= & x^e ~|~ x^s & \tag{variables on events and posets} \\