Print equivalence classes in Coq format - ocaml

Follow the counter example from my previous question: Error when convert to Boolean matrix .
let entries = [("name", ["string"]); ("label", ["nonNegativeInteger"; "symbol"]);
("symbol", ["name"; "symbol"; "symbol"; "label"]); ("var", ["string"]);
("term", ["var"; "symbol"; "term"]); ("rule", ["term"; "term"]);
("rules", ["rule"]); ("dps", ["rules"]); ("trs", ["rules"]);
("usableRules", ["rules"]);
("number", ["integer"; "integer"; "positiveInteger"]);
("coefficient",["number"; "minusInfinity"; "plusInfinity"; "vector"; "matrix"])
("vector", ["coefficient"]); ("matrix", ["vector"])]
let defined = ["name"; "label"; "symbol"; "var"; "term"; "rule"; "rules";
"dps"; "trs"; "usableRules"; "number"; "coefficient"; "vector"; "matrix"]
let undefined = ["string"; "nonNegativeInteger"; "integer"; "positiveInteger";
"minusInfinity"; "plusInfinity"]
I computed with these functions: (more details please see here: Transitive closure and equivalence classes and Asking about return type, list and set data structure in OCaml)
let rec position x = function
| [] -> raise Not_found
| y :: ys -> if x = y then 0 else 1 + position x ys
let len_undefined = List.length undefined
let num_of_name xsds undefined len_undefined s =
try (position s xsds) + len_undefined;
with Not_found -> position s undefined
let name_of_num xsds undefined len_undefined k =
if k < len_undefined then
List.nth undefined k else
List.nth xsds (k - len_undefined)
let matrix =
let len = List.length defined + len_undefined in
let boolmat = Array.make_matrix len len false in
List.iter (fun (s, strs) ->
let pos1 = num_of_name defined undefined len_undefined s in
List.iter (fun t ->
let pos2 = num_of_name defined undefined len_undefined t in
boolmat.(pos1).(pos2) <- true) strs) entries;
boolmat
let transClosure m =
let n = Array.length m in
for k = 0 to n - 1 do
let mk = m.(k) in
for i = 0 to n - 1 do
let mi = m.(i) in
for j = 0 to n - 1 do
mi.(j) <- max mi.(j) (min mi.(k) mk.(j))
done;
done;
done;
m;;
let eq_class m i =
let column = m.(i)
and set = ref [] in
Array.iteri begin fun j l ->
if j = i || column.(j) && m.(j).(i) then
set := j :: !set else ignore l
end column;
!set;;
let eq_classes m =
let classes = ref [] in
Array.iteri begin fun e _ ->
if not (List.exists (List.mem e) !classes) then
classes := eq_class m e :: !classes
end m;
!classes;;
let cmp_classes m c c' = if c = c' then 0 else
match c, c' with
| i :: _, j :: _ -> if m.(i).(j) then 1 else -1
| _ -> assert false
let sort_eq_classes m = List.sort (cmp_classes m);;
let order_xsds =
let tc_xsds = transClosure matrix in
let eq_xsds = eq_classes tc_xsds in
let sort_eq_xsds = sort_eq_classes tc_xsds eq_xsds in
sort_eq_xsds
let print =
let f elem =
print_int elem ; print_string " "
in List.iter f (List.flatten order_xsds);;
let xsds_of_int =
List.map (List.map (name_of_num defined undefined len_undefined))
let xsds_sort = xsds_of_int order_xsds
let print_string =
let f elem =
print_string elem ; print_string " \n"
in List.iter f (List.flatten xsds_sort);;
I try to print the result to see the sorted equivalence classes :
var name symbol label plusInfinity minusInfinity positiveInteger integer number
matrix vector coefficient nonNegativeInteger string term rule rules usableRules
trs dps
Because I have to print in Coq format, I have to make the file output combine, so the result I want to print in order of the results of the equivalence classes, when it see an equivalence classes ("label" -"symbol"; "coefficient" - "matrix" - "vector") it should print:
EDIT:
Inductive label := all the type label depends
with symbol := all the type symbol depends.
For example:
Inductive label :=
| Label : nonNegativeInteger -> symbol -> label
with symbol :=
| Symbol : name -> symbol -> symbol -> label -> symbol.
when it is one type depends it will print for me, for example:
Definition name := string.
and when it is more than 2 depends type,
Inductive numer := all the type number depends.
for example:
Inductive number :=
|Number : integer -> integer -> positiveInteger -> number.
I think the list of type in undefined type should print before and after it will print in the result of the list after sorted (and all the type of undefined list should not print again), for example the result I expect like this:
Definition string := string.
Definition nonNegative := int.
...
Definition var := string.
Definition name := string.
Inductive label := ...
with symbol := ...
and so on
Could you please help me?

I might be confused but I think you're just looking for the Printf module and String.concat? e.g.
List.iter
(fun name ->
Printf.printf "Definition %s := %s.\n" name (defn_of name))
undefined;
List.iter
(fun eqvclass ->
Printf.printf "Inductive %s.\n"
(String.concat "\nwith "
(List.map
(fun name ->
Printf.sprintf "%s := %s" name (defn_of name))
eqvclass)))
order_xsds
(where defn_of gives you the right-hand side of the definitions).

Related

Is this use of Obj.magic necessary?

I am reading a repository and I encountered this function in the body of some Yojson json parsing code:
let load_problems channel =
let open Yojson.Basic.Util in
let j = Yojson.Basic.from_channel channel in
...
let rec unpack x =
try magical (x |> to_int) with _ ->
try magical (x |> to_float) with _ ->
try magical (x |> to_bool) with _ ->
try
let v = x |> to_string in
if String.length v = 1 then magical v.[0] else magical v
with _ ->
try
x |> to_list |> List.map ~f:unpack |> magical
with _ -> raise (Failure "could not unpack")
in
...
where magical = Obj.magic. I understand what Obj.magic is (it's the equivalent to Unsafe.Coerce in Haskell), but I don't see why a type coercion is necessary here. The Yojson.Basic.Util functions the author uses should already either succeed or fail to do this conversion. Any intuition?
EDIT:
I feel I was depriving #glennsl of context, so here is the immediately following passage in which unpack is used:
let tf = j |> member "tasks" |> to_list |> List.map ~f:(fun j ->
let e = j |> member "examples" |> to_list in
let task_type = j |> member "request" |> deserialize_type in
let examples = e |> List.map ~f:(fun ex -> (ex |> member "inputs" |> to_list |> List.map ~f:unpack,
ex |> member "output" |> unpack)) in
let maximum_frontier = j |> member "maximumFrontier" |> to_int in
let name = j |> member "name" |> to_string in
let task =
(try
let special = j |> member "specialTask" |> to_string in
match special |> Hashtbl.find task_handler with
| Some(handler) -> handler (j |> member "extras")
| None -> (Printf.eprintf " (ocaml) FATAL: Could not find handler for %s\n" special;
exit 1)
with _ -> supervised_task) ~timeout:timeout name task_type examples
in
(task, maximum_frontier))
in
There are a number of different task_handlers, but the one I happen to be concerned with is defined as follows:
(fun extras ?timeout:(timeout = 0.001) name ty examples ->
let open Yojson.Basic.Util in
let cost_matters =
try
extras |> member "costMatters" |> to_bool
with _ -> assert false
in
let by = match examples with
| [([0],y)] ->
Bigarray.(Array1.of_array int8_unsigned c_layout (Array.of_list y))
| [([1],y)] ->
Bigarray.(Array1.of_array int8_unsigned c_layout (Array.of_list y))
| _ -> failwith "not a turtle task" in
{ name = name ;
task_type = ty ;
log_likelihood =
(fun p ->
try
match run_recent_logo ~timeout p with
| Some(bx,cost) when (LogoLib.LogoInterpreter.fp_equal bx by 0) ->
(if cost_matters then (0.-.cost)*.10. else 0.)
| _ -> log 0.
with (* We have to be a bit careful with exceptions if the
* synthesized program generated an exception, then we just
* terminate w/ false but if the enumeration timeout was
* triggered during program evaluation, we need to pass the
* exception on
*)
| UnknownPrimitive(n) -> raise (Failure ("Unknown primitive: "^n))
| EnumerationTimeout -> raise EnumerationTimeout
| _ -> log 0.0)
});;
The author also uses ;; in a lot of files..another quirk.

Ocaml won't let me name my List

the code :
open Hashtbl;;
type 'a option = None | Some of 'a;;
let ht = create 0;;
let rec charCount fd =
let x =
try Some (input_char fd)
with End_of_file -> None
in
match x with
| Some c ->
let v =
try find ht c
with Not_found -> 0
in
replace ht c (v+1);
charCount fd
| None -> ();;
let loadHisto fn =
let fd = open_in fn in
charCount fd;;
let rec printList l = match l with
| [] -> print_newline ()
| h::t -> print_char h; print_string " "; printList t;;
let hashtbl_keys h = Hashtbl.fold (fun key _ l -> key :: l) h [];;
let compare_function a b = compare (find ht b) (find ht a);;
let akeys = List.sort compare_function (hashtbl_keys ht);;
printList (List.sort compare_function (hashtbl_keys ht));;
printList akeys;;
and the result :
ocaml histo.ml
e t s u a i n p j (*here is the first printList*)
(*and here should be the second one, but there is only a blank*)
Here is the problem :
I sorted a list, and tried to display it's content but as you can see, it doesn't seem like I can give a name to my resulting List
Edit :
I don't think it's a buffer problem because even if I only print akeys, there is nothing
Edit : I added the code asked for below
And ht is a hashtbl, and it contains what it should contain (I checked this)

To convert a a string list list to an string array array in OCaml

I'm trying to get a pretty print function to print the query result of my database in OCaml. I've been following this approach http://mancoosi.org/~abate/ocaml-format-module
I have this code so far:
let pp_cell fmt cell = Format.fprintf fmt "%s" cell;;
let pp_header widths fmt header =
let first_row = Array.map (fun x -> String.make (x + 1) ' ') widths in
Array.iteri (fun j cell ->
Format.pp_set_tab fmt ();
for z=0 to (String.length header.(j)) - 1 do cell.[z] <- header.(j).[z] done;
Format.fprintf fmt "%s" cell
) first_row
let pp_row pp_cell fmt row =
Array.iteri (fun j cell ->
Format.pp_print_tab fmt ();
Format.fprintf fmt "%a" pp_cell cell
) row
let pp_tables pp_row fmt (header,table) =
(* we build with the largest length of each column of the
* table and header *)
let widths = Array.create (Array.length table.(0)) 0 in
Array.iter (fun row ->
Array.iteri (fun j cell ->
widths.(j) <- max (String.length cell) widths.(j)
) row
) table;
Array.iteri (fun j cell ->
widths.(j) <- max (String.length cell) widths.(j)
) header;
(* open the table box *)
Format.pp_open_tbox fmt ();
(* print the header *)
Format.fprintf fmt "%a#\n" (pp_header widths) header;
(* print the table *)
Array.iter (pp_row fmt) table;
(* close the box *)
Format.pp_close_tbox fmt ();
;;
(** Pretty print answer set of a query in format of
* col_name 1 | col_name 2 | col_name 3 |
* result1.1 | result2.1 | result3.1 |
* result1.2 | result2.2 | result3.2 |
* #param col_names provides the names of columns in result outp ut *)
let pretty_print fmt pp_cell (col_names, tuples) =
match col_names with
| [] -> printf "Empty query\n"
| _ ->
printf "Tuples ok\n";
printf "%i tuples with %i fields\n" (List.length tuples) (List.length col_names);
print_endline(String.concat "\t|" col_names);
for i = 1 to List.length col_names do printf "--------" done; print_newline() ;
let print_row = List.iter (printf "%s\t|") in
List.iter (fun r -> print_row r ; print_newline ()) tuples;
for i = 1 to List.length col_names do printf "--------" done; print_newline() ;
let fmt = Format.std_formatter in
Format.fprintf fmt "%a" (pp_tables (pp_row pp_cell)) (Array.of_list col_names,tuples);
flush stdout
;;
let print_res (col_names, tuples) =
let fmt = Format.std_formatter in
pretty_print fmt pp_cell (col_names, tuples)
;;
The problem is in the line
Format.fprintf fmt "%a" (pp_tables (pp_row pp_cell)) (Array.of_list col_names,tuples);
basically because I need tuples to be and string array array (a matrix) while its type is string list list. So I tried to solve it by converting the list list into a matrix following this approach http://www.siteduzero.com/forum-83-589601-p1-ocaml-convertir-un-list-list-en-array-array.html with this code:
let listToMatrix lli =
let result = Array.init 6 (fun _ -> Array.create 7 2)
let rec outer = function
| h :: tl, col ->
let rec inner = function
| h :: tl, row ->
result.[row].[col] <- h
inner (tl, row + 1)
| _ -> ()
inner (h, 6 - List.length h)
outer (tl, col + 1)
| _ -> ()
outer (lli, 0)
result
;;
But I just a syntax error while compiling:
File "src/conn_ops.ml", line 137, characters 2-5:
Error: Syntax error
make: *** [bin/conn_ops.cmo] Error 2
I don't really know what to do, or how I can accomplish the conversation of the list list into the matrix. My approach is the correct? This has been the first time I've worked with OCaml and it's been quite a pain in the *, so please, try to be kind with me :D
This is a lot of code to read in detail, but it looks like you're missing a semicolon after result.[row].[col] <- h. However, this code looks suspicious to me. The notation .[xxx] is for accessing individual characters of a string. You want to use array index notation .(xxx), seems to me.
Here is a function that changes a string list list to a string array array. Maybe it will be useful:
let sll_to_saa sll = Array.of_list (List.map Array.of_list sll)
Actually, this function changes any list of lists to an array of arrays; it doesn't have to be strings.
I'm not sure I understood your entire post, but if you want to convert
a string list list into a string array array, you can do this
quite easily with the Array.of_list function:
# let strings = [["hello"; "world"]; ["foo"; "bar"]];;
val strings : string list list = [["hello"; "world"]; ["foo"; "bar"]]
# Array.of_list (List.map Array.of_list strings);;
- : string array array = [|[|"hello"; "world"|]; [|"foo"; "bar"|]|]
I hope this helped.
Your function is not syntacticly correct. Below is a fixed version:
let listToMatrix lli =
let result = Array.init 6 (fun _ -> Array.create 7 2) in
let rec outer = function
| h :: tl, col ->
let rec inner = function
| h :: tl, row ->
result.(row).(col) <- h;
inner (tl, row + 1)
| _ -> ()
in
inner (h, 6 - List.length h);
outer (tl, col + 1)
| _ -> ()
in
outer (lli, 0);
result
;;
As noted in other answers:
the subscript operators for arrays are parentheses,
some semi-colons are missing,
sometimes you forget to use the keyword in to mark the expression where your definition will be used.
Please note that I didn't check if the function does what it is supposed to do.

string to list of char

I want to write a function that taking a string and return a list of char. Here is a function, but I think it is not do what I want ( I want to take a string and return a list of characters).
let rec string_to_char_list s =
match s with
| "" -> []
| n -> string_to_char_list n
Aside, but very important:
Your code is obviously wrong because you have a recursive call for which all the parameters are the exact same one you got in. It is going to induce an infinite sequence of calls with the same values in, thus looping forever (a stack overflow won't happen in tail-rec position).
The code that does what you want would be:
let explode s =
let rec exp i l =
if i < 0 then l else exp (i - 1) (s.[i] :: l) in
exp (String.length s - 1) []
Source:
http://caml.inria.fr/pub/old_caml_site/FAQ/FAQ_EXPERT-eng.html#strings
Alternatively, you can choose to use a library: batteries String.to_list or extlib String.explode
Try this:
let explode s = List.init (String.length s) (String.get s)
Nice and simple:
let rec list_car ch =
match ch with
| "" -> []
| ch -> String.get ch 0 :: list_car (String.sub ch 1 (String.length ch - 1));;
How about something like this:
let string_to_list str =
let rec loop i limit =
if i = limit then []
else (String.get str i) :: (loop (i + 1) limit)
in
loop 0 (String.length str);;
let list_to_string s =
let rec loop s n =
match s with
[] -> String.make n '?'
| car :: cdr ->
let result = loop cdr (n + 1) in
String.set result n car;
result
in
loop s 0;;
As of OCaml 4.07 (released 2018), this can be straightforwardly accomplished with sequences.
let string_to_char_list s =
s |> String.to_seq |> List.of_seq
Here is an Iterative version to get a char list from a string:
let string_to_list s =
let l = ref [] in
for i = 0 to String.length s - 1 do
l := (!l) # [s.[i]]
done;
!l;;
My code, suitable for modern OCaml:
let charlist_of_string s =
let rec trav l i =
if i = l then [] else s.[i]::trav l (i+1)
in
trav (String.length s) 0;;
let rec string_of_charlist l =
match l with
[] -> ""
| h::t -> String.make 1 h ^ string_of_charlist t;;

Error when convert to Boolean matrix

I have this problem still bother me a lots. I have a (string * string list) list and I want to convert it to Boolean matrix.
I have a special condition when transform it. For example I have this list:
let entries = [("name", ["string"; "label"]); ("label", ["int"; "name"]);
("symbol", ["string"])]
where "string" and "int" are undefined type, undefined type because in my real data, I don't have a definition describe this type. So I built a list of undefined type.
let undefined = ["string"; "int"]
And the first position in the list ("name", "label", "symbol") are defined type, defined type is the type I have definition in my data.
let defined = ["name"; "label"; "symbol"]
I am trying to do this: from entries, there position should be:
name: 2; string: 0; label: 3; int: 1; symbol: 4
And when showing the depend relation from the list entries, it doesn't change their position. For example: name(2) link to string(0) and label(3), and label (3) has an edge to int(1) and name (2),` and so on...
I have these functions return a position(num_of_name) and element (name_of_num) in a list.
let rec position x = function
| [] -> raise Not_found
| y :: ys -> if x = y then 0 else 1 + position x ys
let len_undefined = List.length undefined
let num_of_name defined undefined len_undefined s =
try (position s defined) + len_undefined;
with Not_found -> position s undefined
let name_of_num defined undefined len_undefined k =
if k < len_undefined then
List.nth undefined k else
List.nth defined (k - len_undefined)
So from the entries list I want to build a boolean matrix show there relation using the function num_of_name. So I write my function:
let matrix =
let len = List.length defined + len_undefined in
let boolmat = Array.make_matrix len len false in
List.iter (fun (s, strs) ->
let pos1 = num_of_name defined undefined len_undefined s in
List.iter (fun t ->
let pos2 = num_of_name defined undefined len_undefined t in
boolmat.(pos1).(pos2) <- true) strs) entries;
boolmat
let print_mat m =
for i = 0 to Array.length m - 1 do
for j = 0 to Array.length m.(0) - 1 do
print_string (string_of_bool m.(i).(j));
Printf.printf " ";
done;
Printf.printf " \n";
done;
;;
let test_print = print_mat matrix
It return an error "Fatal error: exception Not_found"
I need your help.
Thank you very much!!
As I said in the comment, your num_of_name function is fragile since it throws Not_found exception when its input is not an element of either defined or undefined. One way to fix is using Option type:
let num_of_name defined undefined len_undefined s =
try
let p = position s defined in
Some (p + len_undefined)
with Not_found ->
try
let p = position s undefined in
Some p
with Not_found -> None
and matrix is calculated as:
let matrix =
let len = List.length defined + len_undefined in
let boolmat = Array.make_matrix len len false in
List.iter (fun (s, strs) ->
match num_of_name defined undefined len_undefined s with
| Some pos1 -> List.iter (fun t ->
match num_of_name defined undefined len_undefined t with
| Some pos2 -> boolmat.(pos1).(pos2) <- true
| None -> ()) strs
| None -> ()
) entries;
boolmat
Of course, if you enforce your program by extracting defined and undefined from entries, your code is correct.