Commit 6e693ab4 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

lurette 0.8 Wed, 24 Oct 2001 16:08:10 +0200 by jahier

Parent-Version:      0.7
Version-Log:

graph.[ml,mli]:
env.[ml,mli]:
        env__step only needs a node, not the whole arc.

        Also, handle the choice of the transition properly in presence
        of epsilon.

Project-Description: empty
parent 2a25effc
;; This file is automatically generated, editing may cause PRCS to do
;; REALLY bad things.
(Created-By-Prcs-Version 1 3 3)
(env.mli 3433 1003928781 15_env.mli 1.1)
(env.mli 3428 1003932490 15_env.mli 1.2)
(test.aut 644 1003928781 22_test.aut 1.1)
(Mercury/graph.m 15076 1002205313 7_graph.m 1.1)
(Mercury/lurette.m 4239 1002789994 5_lurette.m 1.5)
(ID_EN_VRAC 2184 1002196285 0_ID_EN_VRAC 1.1)
(env.ml 21337 1003928781 16_env.ml 1.1)
(env.ml 21466 1003932490 16_env.ml 1.2)
(Mercury/test.aut 1231 1002546062 8_test2.aut 1.1)
(doc/Interface_draft 5232 1003928781 19_Interface_ 1.1)
(Mercury/Mmakefile 102 1002789994 1_Mmakefile 1.3)
......@@ -18,8 +18,8 @@
(Mercury/dot_automata.m 5814 1002546062 9_dot_automa 1.1)
(Mercury/dot.m 3636 1002298322 6_dot.m 1.2)
(Mercury/memory.m 3884 1002196285 3_memory.m 1.1)
(graph.mli 1143 1003928781 13_graph.mli 1.1)
(graph.ml 2425 1003928781 14_graph.ml 1.1)
(graph.mli 1305 1003932490 13_graph.mli 1.2)
(graph.ml 2397 1003932490 14_graph.ml 1.2)
(lurette.mli 514 1003928781 11_lurette.ml 1.1)
(TAGS 1048 1003928781 21_TAGS 1.1)
(lurette.ml 180 1003928781 12_lurette.ml 1.1)
......@@ -473,24 +473,24 @@ let rec (gen_list: (f:'a -> 'b) -> 'a -> int -> 'b list) =
| n -> (f i)::(gen_list f i (n-1))
let (env__try : int -> env_in -> (arc * env_out * env_loc) list) =
let (env__try : int -> env_in -> (node * env_out * env_loc) list) =
(*
** [env__try n input] returns a list of `n' possible outputs of the environment
** with input `input'. This function actually returns a list of 3-tuple
** `arc * env_out * env_loc' because we need to know which arcs produced which
** `node * env_out * env_loc' because we need to know which arcs produced which
** outputs later (namely, when performing `env__step').
**
** Also sets (side effect) the environment input values to `input'.
*)
fun n input ->
let (choose_transition: unit -> arc * formula_eps) =
(* Choosing a transition according to their weigth in the graph *)
fun () ->
let (arc_label_weighted_list: (arc * arc_info) list) =
(Graph.get_arc_label_list_from_node
env_state.graph env_state.current_node) in
let rec (choose_transition: node -> node * formula_eps) =
(*
** Choosing a transition from the current node according to
** their weight in the graph.
*)
fun node_from ->
let rec (weigthed_list_to_list:
(arc * arc_info) list -> (arc * formula_eps) list) =
(node * arc_info) list -> (node * formula_eps) list) =
(*
** E.g., `weigthed_list_to_list [((1, 2), (3, f1)); ((3, 4), (1, f2))]'
** returns the list
......@@ -498,15 +498,19 @@ let (env__try : int -> env_in -> (arc * env_out * env_loc) list) =
*)
function
[] -> []
| (arc, (weigth, f))::tail ->
| (node, (weigth, f))::tail ->
(List.append
(gen_list (fun () -> (arc, f)) () weigth)
(gen_list (fun () -> (node, f)) () weigth)
(weigthed_list_to_list tail))
in
let arc_label_weighted_list = (Graph.get_list_of_target_nodes
env_state.graph node_from) in
let arc_label_list = (weigthed_list_to_list arc_label_weighted_list) in
let n = Random.int (List.length arc_label_list) in
(List.nth arc_label_list n)
let (node_to, f) = (List.nth arc_label_list n) in
if (f = Eps) then (choose_transition node_to) else (node_to, f)
in
let (solve_formula: formula -> env_out * env_loc) =
(*
** [solve_formula f] randomly assigns values to free variables occuring in
......@@ -515,29 +519,31 @@ let (env__try : int -> env_in -> (arc * env_out * env_loc) list) =
fun f ->
([], []) (* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *)
in
let (generate_one_output: env_in -> arc * env_out * env_loc) =
let (generate_one_output: env_in -> node * env_out * env_loc) =
fun input ->
let (arc, fe) = choose_transition () in
let (node_to, fe) = choose_transition env_state.current_node in
match fe with
Eps -> (arc, [], []) (* XXX que fait-on sur ces transitions ??? *)
Eps -> (node_to, [], []) (* XXX que fait-on sur ces transitions ??? *)
| F(f) ->
let (output, local) = solve_formula (eval f input) in
(arc, output, local)
(node_to, output, local)
in
let l = (gen_list (generate_one_output) input n) in
env_state.input <- input;
l
(* %-----------------------------------------------------------------------% *)
let (env__step : arc -> env_out -> env_loc -> unit) =
let (env__step : node -> env_out -> env_loc -> unit) =
(*
** [env__step (node_from, node_to) output local ] modifies the
** [env__step node_to output local ] modifies the
** environment state by:
** 1 - performing a transition from `node_from' to `node_to'
** 1 - performing a transition from the current node to `node_to'
** 2 - updating the memory (using `output' and `local').
*)
fun (node_from, node_to) output local ->
fun node_to output local ->
env_state.current_node <- node_to ;
env_state.output <- output ;
env_state.local <- local
......
......@@ -77,21 +77,21 @@ val read_env_state : string ->
*)
val env__try : int -> env_in -> (arc * env_out * env_loc) list
val env__try : int -> env_in -> (node * env_out * env_loc) list
(*
** [env__try n input] returns a list of `n' possible outputs of the environment
** with input `input'. This function actually returns a list of 3-tuple
** `arc * env_out * env_loc' because we need to know which arcs produced which
** `node * env_out * env_loc' because we need to know which arcs produced which
** outputs later (namely, when performing `env__step').
**
** Also sets (side effect) the environment input values to `input'.
*)
val env__step : arc -> env_out -> env_loc -> unit
val env__step : node -> env_out -> env_loc -> unit
(*
** [env__step (node_from, node_to) output local ] modifies the
** [env__step node_to output local ] modifies the
** environment state by:
** 1 - performing a transition from `node_from' to `node_to'
** 1 - performing a transition from the current_node to `node_to'
** 2 - updating the memory (using `output' and `local').
*)
......
......@@ -16,7 +16,7 @@
open Hashtbl
type ('a, 'b) t = {
mutable table : ('a, (('b * 'a) list)) Hashtbl.t ;
mutable table : ('a, (('a * 'b) list)) Hashtbl.t ;
mutable nodes : 'a list ;
mutable trans : ('a * 'b * 'a) list
}
......@@ -45,24 +45,27 @@ let (add_trans: ('a, 'b) t -> 'a -> 'b -> 'a -> unit) =
let l2 = if (List.mem node_to l1) then l1 else (List.append l1 [node_to]) in
if (Hashtbl.mem g.table node_from) then
let list = Hashtbl.find g.table node_from in
Hashtbl.replace g.table node_from ((arc_info, node_to)::list)
Hashtbl.replace g.table node_from ((node_to, arc_info)::list)
else
Hashtbl.add g.table node_from [(arc_info, node_to)] ;
Hashtbl.add g.table node_from [(node_to, arc_info)] ;
g.nodes <- l2 ;
g.trans <- (List.append g.trans [(node_from, arc_info, node_to)])
exception GraphError of string
let (get_arc_label_list_from_node: ('a, 'b) t -> 'a -> (('a * 'a) * 'b) list) =
let (get_list_of_target_nodes: ('a, 'b) t -> 'a -> ('a * 'b) list) =
(*
** [get_arc_label_list_from_node g node] returns the list of pairs (arc, arc labels)
** which have `node' as origin node.
** [get_list_of_target_nodes g node] returns the list of target nodes
** starting from `node_from' in the graph `g'. Actually, it does not only
** return a list of nodes but a list of pairs `(node_to, arc_label)' where
** `arc_label' is the arc label of the arc from `node_from' to `node_to'.
*)
fun g node ->
let list =
try Hashtbl.find g.table node
with Not_found -> []
in (List.map (fun (arc, node_to) -> ((node, node_to), arc)) list)
try Hashtbl.find g.table node
with Not_found -> raise (GraphError "This node does not have any transition.")
let (get_all_nodes: ('a, 'b) t -> 'a list) =
(*
......@@ -79,8 +82,3 @@ let (get_all_trans: ('a, 'b) t -> ('a * 'b * 'a) list ) =
(* fun g -> *)
(* let ns = nodes g in *)
(* let (get_arcs_from_node: 'a -> ('a, 'b) t -> ('a * 'b * 'a) list) = *)
(* fun node g -> *)
(* let (arc, node_to) = find g node *)
......@@ -29,10 +29,12 @@ val add_trans: ('a, 'b) t -> 'a -> 'b -> 'a -> unit
*)
val get_arc_label_list_from_node: ('a, 'b) t -> 'a -> (('a * 'a) * 'b) list
val get_list_of_target_nodes: ('a, 'b) t -> 'a -> ('a * 'b) list
(*
** [get_arc_label_list_from_node g node] returns the list of pairs (arc, arc labels)
** which have `node' as origin node.
** [get_list_of_target_nodes g node] returns the list of target nodes
** starting from `node_from' in the graph `g'. Actually, it does not only
** return a list of nodes but a list of pairs `(node_to, arc_label)' where
** `arc_label' is the arc label of the arc from `node_from' to `node_to'.
*)
......
;; -*- Prcs -*-
(Created-By-Prcs-Version 1 3 3)
(Project-Description "")
(Project-Version lurette 0 7)
(Parent-Version lurette 0 6)
(Project-Version lurette 0 8)
(Parent-Version lurette 0 7)
(Version-Log "
At this stage, the environement should work. Several things remain to be done
tough; e.g., connecting the sut, the orcle and the constraint solver...
graph.[ml,mli]:
env.[ml,mli]:
env__step only needs a node, not the whole arc.
Also, handle the choice of the transition properly in presence
of epsilon.
")
(New-Version-Log "")
(Checkin-Time "Wed, 24 Oct 2001 14:06:21 +0100")
(Checkin-Time "Wed, 24 Oct 2001 15:08:10 +0100")
(Checkin-Login jahier)
(Populate-Ignore ())
(Project-Keywords)
......@@ -22,11 +26,11 @@ tough; e.g., connecting the sut, the orcle and the constraint solver...
(lurette.mli (lurette/11_lurette.ml 1.1 644))
(lurette.ml (lurette/12_lurette.ml 1.1 644))
(graph.mli (lurette/13_graph.mli 1.1 644))
(graph.ml (lurette/14_graph.ml 1.1 644))
(graph.mli (lurette/13_graph.mli 1.2 644))
(graph.ml (lurette/14_graph.ml 1.2 644))
(env.mli (lurette/15_env.mli 1.1 644))
(env.ml (lurette/16_env.ml 1.1 644))
(env.mli (lurette/15_env.mli 1.2 644))
(env.ml (lurette/16_env.ml 1.2 644))
;; Make files
(OcamlMakefile (lurette/17_OcamlMakef 1.1 644))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment