From: Kim Nguyễn Date: Thu, 15 Aug 2013 15:11:02 +0000 (+0200) Subject: Rewrite the HTML debugging output to generate an svg file directly instead going X-Git-Tag: v0.1~46 X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=commitdiff_plain;h=20ef25a27a326b250ae7f32997fa6d249a6b1751 Rewrite the HTML debugging output to generate an svg file directly instead going through graphviz. --- diff --git a/src/html.ml b/src/html.ml index c7990b3..d592658 100644 --- a/src/html.ml +++ b/src/html.ml @@ -31,10 +31,11 @@ let finalize_node n r b = Hashtbl.replace final n (b,r) -let gen_trace (type s) = (); fun t tree -> +let gen_trace (type s) = fun auto t tree -> let module T = (val (t) : Tree.S with type t = s) in - let rec loop odot ohtml node parent = - if node == T.nil then () else begin + let root = T.root tree in + let rec loop osvg ohtml node parent x y = + if node != T.nil then begin let m = try Hashtbl.find info (T.preorder tree node) @@ -44,56 +45,65 @@ let gen_trace (type s) = (); fun t tree -> let marked, last_round = try Hashtbl.find final node_id with Not_found -> Printf.eprintf ">>> %i\n%!" node_id; false, !max_round; in + let pc = if !max_round == 0 then 1. else float_of_int last_round /. float_of_int !max_round in + let color = int_of_float (255. *. (1. -. pc)) in + let tag = QName.to_string (T.tag tree node) in + let lbox = (String.length tag + 2) * 10 in let s_node = "node" ^ (string_of_int node_id) in - fprintf odot "%s[ id=\"%s\" label=\"%s\" style=filled fillcolor=\"%f,1.0,1.0\"\ -shape=\"%s\" ];\n" - s_node - s_node - (QName.to_string (T.tag tree node)) - (1.0 -. (float (last_round+1) /. float (!max_round+1))) - (if marked then "oval" else "box") ; + fprintf osvg "\n%!" + s_node s_node x y lbox color color (if marked then "" else ";stroke-dasharray:2,2"); + fprintf osvg "%s\n" (x+10) (y+15) s_node tag; fprintf ohtml "data['%s'] = new Array();\n" s_node; M.iter (fun i s -> fprintf ohtml "data['%s'][%i] = '%s';\n" s_node i s) m; - if parent != T.nil then - fprintf odot "node%i -> %s;\n" - (T.preorder tree parent) s_node; - loop odot ohtml (T.first_child tree node) node; - loop odot ohtml (T.next_sibling tree node) parent + let first = T.first_child tree node in + let maxw1, maxy1 = loop osvg ohtml first node x (y + 40) in + let next = T.next_sibling tree node in + let x_next = max (x+lbox) (maxw1+10) in + if node != root then begin + if node == T.first_child tree parent then + fprintf osvg "\n" + (x + lbox / 2) (y-20) (x + lbox / 2) (y); + if next != T.nil then + fprintf osvg "\n" + (x + lbox) (y+10) x_next (y+10); + end; + let maxw2, maxy2 = loop osvg ohtml next node x_next y in + maxw2, max maxy1 maxy2 end + else x, y in ignore (Sys.command "mkdir -p tests/trace"); - let odot_ = open_out "tests/trace/trace.dot" in + let osvg_ = open_out "tests/trace/trace.svg" in let ohtml_ = open_out "tests/trace/trace.html" in - let odot = formatter_of_out_channel odot_ in + let osvg = formatter_of_out_channel osvg_ in let ohtml = formatter_of_out_channel ohtml_ in - fprintf odot "digraph G {\n node[shape=box, style=filled, fillcolor=white];splines=false;"; fprintf ohtml "\ \ \ \ \ +

%a +

\ -\n

\n"; - let fi = open_in "tests/trace/trace2.svg" in + fprintf ohtml "\n

\n%!"; + fprintf ohtml "\n

\n%!"; pp_print_flush ohtml (); close_out ohtml_; close_in fi + diff --git a/src/html.mli b/src/html.mli index 91dacaf..0772863 100644 --- a/src/html.mli +++ b/src/html.mli @@ -1,3 +1,3 @@ val trace : int -> int -> ('a, Format.formatter, unit, unit) format4 -> 'a val finalize_node : int -> int -> bool -> unit -val gen_trace : (module Tree.S with type t = 'a) -> 'a -> unit +val gen_trace : Ata.t -> (module Tree.S with type t = 'a) -> 'a -> unit diff --git a/src/run.ml b/src/run.ml index 53cecb4..d7f4ba7 100644 --- a/src/run.ml +++ b/src/run.ml @@ -153,12 +153,11 @@ END let html tree node i config msg = let config = config.NodeStatus.node in Html.trace (T.preorder tree node) i - "node: %i
%s
sat: %a
todo: %a
round: %i
" + "node: %i
%s
sat: %a
todo: %a
_______________________
" (T.preorder tree node) msg StateSet.print config.sat StateSet.print config.todo - i let debug msg tree node i config = @@ -293,6 +292,7 @@ DEFINE AND_(t1,t2) = let top_down run = + let _i = run.pass in let tree = run.tree in let auto = run.auto in let status = run.status in @@ -327,7 +327,7 @@ DEFINE AND_(t1,t2) = } else c in - TRACE(html tree node _i config0 "Entering node"); + TRACE(html tree node _i status0 "Entering node"); (* get the node_statuses for the first child, next sibling and parent *) let ps = unsafe_get_status status (T.preorder tree parent) in @@ -335,7 +335,7 @@ DEFINE AND_(t1,t2) = let nss = unsafe_get_status status ns_id in (* evaluate the transitions with all this statuses *) let status1 = eval_trans auto cache2 cache5 tag fcs nss ps status0 in - TRACE(html tree node _i config1 "Updating transitions"); + TRACE(html tree node _i status1 "Updating transitions"); (* update the cache if the status of the node changed *) @@ -348,14 +348,14 @@ DEFINE AND_(t1,t2) = (* update the status *) let status2 = eval_trans auto cache2 cache5 tag fcs1 nss ps status1 in - TRACE(html tree node _i config2 "Updating transitions (after first-child)"); + TRACE(html tree node _i status2 "Updating transitions (after first-child)"); if status2 != status1 then status.(node_id) <- status2; let unstable_right = loop ns in let nss1 = unsafe_get_status status ns_id in let status3 = eval_trans auto cache2 cache5 tag fcs1 nss1 ps status2 in - TRACE(html tree node _i config3 "Updating transitions (after next-sibling)"); + TRACE(html tree node _i status3 "Updating transitions (after next-sibling)"); if status3 != status2 then status.(node_id) <- status3; @@ -371,50 +371,13 @@ DEFINE AND_(t1,t2) = Html.finalize_node node_id _i - Ata.(StateSet.intersect config3.Config.node.sat auto.selection_states))); + Ata.(StateSet.intersect status3.NodeStatus.node.sat (get_selecting_states auto)))); unstable_self end in run.redo <- loop (T.root tree); run.pass <- run.pass + 1 -(* - let stats run = - let count = ref 0 in - let len = Bitvector.length run.unstable in - for i = 0 to len - 1 do - if not (Bitvector.unsafe_get run.unstable i) then - incr count - done; - Logger.msg `STATS - "%i nodes over %i were skipped in iteration %i (%.2f %%), redo is: %b" - !count len run.pass (100. *. (float !count /. float len)) - run.redo - - - let eval auto tree node = - let len = T.size tree in - let run = { config = Array.create len Ata.dummy_config; - unstable = Bitvector.create ~init:true len; - redo = true; - pass = 0 - } - in - while run.redo do - run.redo <- false; - Ata.reset auto; (* prevents the .cache2 and .cache4 memoization tables from growing too much *) - run.redo <- top_down_run auto tree node run; - stats run; - run.pass <- run.pass + 1; - done; - at_exit (fun () -> Logger.msg `STATS "%i iterations" run.pass); - at_exit (fun () -> stats run); - let r = get_results auto tree node run.config in - - TRACE(Html.gen_trace (module T : Tree.S with type t = T.t) (tree)); - - r -*) let get_results run = let cache = run.status in @@ -469,6 +432,7 @@ DEFINE AND_(t1,t2) = (fun q acc -> (q, Cache.N1.find res_mapper (q :> int))::acc) (Ata.get_selecting_states auto) []) + let prepare_run run list = let tree = run.tree in let auto = run.auto in @@ -494,23 +458,21 @@ DEFINE AND_(t1,t2) = status.(node_id) <- status0) list - let eval full auto tree nodes = + let compute_run auto tree nodes = let run = make auto tree in prepare_run run nodes; while run.redo do top_down run done; - if full then `Full (get_full_results run) - else `Normal (get_results run) + TRACE(Html.gen_trace auto (module T : Tree.S with type t = T.t) tree); + run let full_eval auto tree nodes = - match eval true auto tree nodes with - `Full l -> l - | _ -> assert false + let r = compute_run auto tree nodes in + get_full_results r let eval auto tree nodes = - match eval false auto tree nodes with - `Normal l -> l - | _ -> assert false + let r = compute_run auto tree nodes in + get_results r end diff --git a/tests/trace/trace.css b/tests/trace/trace.css index 1cd40ab..effe42e 100644 --- a/tests/trace/trace.css +++ b/tests/trace/trace.css @@ -1,9 +1,9 @@ div#data { position: absolute; - top: 0%; + top: 50%; left: 0%; width: 30%; - height: 100%; + height: 50%; overflow: auto; } div#svg { @@ -14,3 +14,13 @@ div#svg { height: 100%; overflow: auto; } + +div#automata { + white-space: pre; + overflow: auto; + position: absolute; + width: 30%; + top: 0%; + left: 0%; + height: 50%; +} \ No newline at end of file diff --git a/tools/add_onclick.sh b/tools/add_onclick.sh deleted file mode 100755 index 98028a2..0000000 --- a/tools/add_onclick.sh +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -cat "$1" | sed -e "s/id=\$\"node[0-9]*\"\$/id=\\1 onclick='activate(\\1);' /"