| 
									
										
										
										
											2018-03-01 16:20:30 +01:00
										 |  |  | (* types à définir
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | (*** regexp ***) | 
					
						
							|  |  |  | type 'a regexp = | 
					
						
							|  |  |  |   | Vide | 
					
						
							|  |  |  |   | Epsilon | 
					
						
							|  |  |  |   | Lettre of 'a | 
					
						
							|  |  |  |   | Union of 'a regexp list | 
					
						
							|  |  |  |   | Concat of 'a regexp list | 
					
						
							|  |  |  |   | Etoile of 'a regexp;; | 
					
						
							|  |  |  | (*** regexp_fin ***) | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | (*** langloc ***) | 
					
						
							|  |  |  | type 'a langloc = { | 
					
						
							|  |  |  |         eps : bool;           (* indique si ε est dans le langage *) | 
					
						
							|  |  |  |         p     : 'a list;        (* liste représentant P(L) *) | 
					
						
							|  |  |  |         s     : 'a list;        (* liste représentant S(L) *) | 
					
						
							|  |  |  |         f     : ('a * 'a) list;};;(* liste représentant F(L) *) | 
					
						
							|  |  |  | (*** langloc_fin ***) | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | (*** automate ***) | 
					
						
							|  |  |  | type 'a nda = | 
					
						
							|  |  |  |     {nQ : int ;      (* nombre d'états *) | 
					
						
							|  |  |  |     i : int list;         (* états initiaux *) | 
					
						
							|  |  |  |     f : int list; (* états finals *) | 
					
						
							|  |  |  |     t : (int * 'a * int) list;};;  (* table de transition *) | 
					
						
							|  |  |  | (*** automate_fin ***) | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |  *) | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2018-02-21 19:12:43 +01:00
										 |  |  | #require "unix";; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | module Affichage = | 
					
						
							|  |  |  |   struct | 
					
						
							|  |  |  |     let s_o_c a =  if a = '"' then | 
					
						
							|  |  |  |                      "\\\\guill" | 
					
						
							|  |  |  |                    else if a = '\\' then | 
					
						
							|  |  |  |                      "\\\\ligne" | 
					
						
							|  |  |  |                    else if a = ' ' then | 
					
						
							|  |  |  |                      "\\\\espace" | 
					
						
							|  |  |  |                    else | 
					
						
							|  |  |  |                      String.make 1 a;; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let s_o_l a = | 
					
						
							|  |  |  |       let lettre = s_o_c a | 
					
						
							|  |  |  |       in "\"" ^ lettre ^ "\"";; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let s_o_m (a, n) = | 
					
						
							|  |  |  |       let lettre  = s_o_c a in | 
					
						
							|  |  |  |       "\"$\\text{" ^ lettre ^ "}_{" ^ (string_of_int n) ^ "}$\"";; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let dot_auto print string_of_lettre auto = | 
					
						
							|  |  |  |       let lien = "->" in | 
					
						
							|  |  |  |       print ("digraph G {\n"); | 
					
						
							|  |  |  |       for x = 0 to auto.nQ - 1 do | 
					
						
							|  |  |  |         print ((string_of_int x) ^ "[style=\"state"); | 
					
						
							|  |  |  |         if List.mem x  auto.i  then | 
					
						
							|  |  |  |           print ",initial"; | 
					
						
							|  |  |  |         if List.mem x auto.f then | 
					
						
							|  |  |  |           print ",accepting"; | 
					
						
							|  |  |  |         print ("\", label=\"" ^ (string_of_int x) ^ "\"];\n") | 
					
						
							|  |  |  |       done; | 
					
						
							|  |  |  |       List.iter ( | 
					
						
							|  |  |  |           fun (q, a, q') -> | 
					
						
							|  |  |  |       print ((string_of_int q) ^ lien ^ (string_of_int q')); | 
					
						
							|  |  |  |       print (" [label=" ^ (string_of_lettre a) ^ "]"); | 
					
						
							|  |  |  |       print ";\n" | 
					
						
							|  |  |  |         ) | 
					
						
							|  |  |  |         auto.t; | 
					
						
							|  |  |  |       print "}\n";; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let auto_to_file fn string_of_lettre auto = | 
					
						
							|  |  |  |       let os = open_out fn in | 
					
						
							|  |  |  |       let print = output_string os in | 
					
						
							|  |  |  |       print "\\documentclass[tikz]{standalone}\n"; | 
					
						
							|  |  |  |       print "\\usetikzlibrary{automata, positioning, shapes, snakes, arrows}\n"; | 
					
						
							|  |  |  |       print "\\usepackage{dot2texi, amsmath}\n"; | 
					
						
							|  |  |  |       print "\\def\\guill{\"}\n\\def\\ligne{\\textbackslash\\textbackslash}\n\\def\\espace{\\textvisiblespace}\n"; | 
					
						
							|  |  |  |       print "\\begin{document}\n"; | 
					
						
							|  |  |  |       print "\\begin{tikzpicture}[scale=.75,shorten >=1pt,node distance=1cm,auto, initial text={}]\n"; | 
					
						
							|  |  |  |       print "\\begin{dot2tex}[tikz, codeonly, styleonly, options={-t raw}]\n"; | 
					
						
							|  |  |  |       dot_auto (output_string os) string_of_lettre auto; | 
					
						
							|  |  |  |       print "\\end{dot2tex}\n"; | 
					
						
							|  |  |  |       (*flush os;
 | 
					
						
							|  |  |  |       let fd_pipe_exit, fd_pipe_input = Unix.pipe () in | 
					
						
							|  |  |  |       let outch_input = Unix.out_channel_of_descr fd_pipe_input in | 
					
						
							|  |  |  |       let pid = Unix.create_process "dot2tex" [|"-f"; "tikz"; "-t"; "raw"; "--codeonly"; "--styleonly"|] (Unix.descr_of_out_channel os) fd_pipe_input Unix.stderr | 
					
						
							|  |  |  |       in | 
					
						
							|  |  |  |       dot_auto (output_string outch_input) string_of_lettre auto; | 
					
						
							|  |  |  |       flush outch_input; | 
					
						
							|  |  |  |       ignore (Unix.waitpid [Unix.WNOHANG] pid); | 
					
						
							|  |  |  |       flush os;*) | 
					
						
							|  |  |  |       print "\\end{tikzpicture}\n"; | 
					
						
							|  |  |  |       print "\\end{document}"; | 
					
						
							|  |  |  |       close_out os;; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let run wait cmd = | 
					
						
							|  |  |  |       if wait then | 
					
						
							|  |  |  |         ignore (Unix.system cmd) | 
					
						
							|  |  |  |       else | 
					
						
							|  |  |  |         ignore (Unix.open_process cmd);; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let rundot fn = | 
					
						
							|  |  |  |       let bn = try Filename.chop_extension fn with Invalid_argument _ -> fn in | 
					
						
							|  |  |  |       let pdfn = bn^".pdf" in | 
					
						
							|  |  |  |       run true ("latexmk -xelatex -cd -shell-escape " ^ (Filename.quote fn)); | 
					
						
							|  |  |  |       pdfn;; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let openPDF wait fn = | 
					
						
							|  |  |  |       run wait ("xdg-open " ^ (Filename.quote fn));; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let vizgraph wait fn = | 
					
						
							|  |  |  |       let pdfn = rundot fn in | 
					
						
							|  |  |  |       openPDF wait pdfn;; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     let rec string_of_regexp sol = function | 
					
						
							|  |  |  |       | Vide -> "∅" | 
					
						
							|  |  |  |       | Epsilon -> "ε" | 
					
						
							|  |  |  |       | Lettre(x) -> sol x | 
					
						
							|  |  |  |       | Union([]) ->  "∅" | 
					
						
							|  |  |  |       | Union([x]) -> string_of_regexp sol x | 
					
						
							|  |  |  |       | Union(le) -> "(" ^ (String.concat "|" (List.map (fun x -> string_of_regexp sol x) le)) ^ ")" | 
					
						
							|  |  |  |       | Concat(le) -> String.concat "" (List.map (fun x -> string_of_regexp sol x) le) | 
					
						
							|  |  |  |       | Etoile(x) -> (string_of_regexp sol x)^"*";; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | end | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | let string_of_char = String.make 1;; | 
					
						
							|  |  |  | let string_of_charint (a, n) = (String.make 1 a) ^ (string_of_int n);; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | let string_of_regexp = Affichage.string_of_regexp string_of_char;; | 
					
						
							|  |  |  | let string_of_regexp_marques = Affichage.string_of_regexp string_of_charint;; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | let afficher_auto a = let fn = (Filename.temp_file "auto" ".tex") in | 
					
						
							|  |  |  |                       Affichage.auto_to_file fn Affichage.s_o_l a; | 
					
						
							|  |  |  |                       Affichage.vizgraph false fn;; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | let afficher_auto_marques a = let fn = (Filename.temp_file "auto" ".tex") in | 
					
						
							|  |  |  |                       Affichage.auto_to_file fn Affichage.s_o_m a; | 
					
						
							|  |  |  |                       Affichage.vizgraph false fn;; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | let string_of_list f l = "[" ^ (String.concat "; " (List.map f l)) ^"]";; |