initial version
cleaned-up the sources of the ITP course - remove internal notes - remove exercise solutions - remove KTH logo - add Creative Commons license
This commit is contained in:
24
exercises/e4-material/dot_graphsLib.sig
Normal file
24
exercises/e4-material/dot_graphsLib.sig
Normal file
@ -0,0 +1,24 @@
|
||||
signature dot_graphsLib =
|
||||
sig
|
||||
type array_graph
|
||||
|
||||
(* binary for running dot *)
|
||||
val dot_binary : string ref;
|
||||
|
||||
(* a fresh, empty one *)
|
||||
val new_array_graph : array_graph
|
||||
|
||||
(* add a node to a graph with number n and the term option content *)
|
||||
val add_node : array_graph -> int -> Abbrev.term option -> array_graph
|
||||
|
||||
(* adds a link between two nodes in the graph *)
|
||||
val add_node_link : array_graph -> int -> int -> string -> array_graph
|
||||
|
||||
(* Various outputs *)
|
||||
val print_graph : array_graph -> unit
|
||||
val graph_to_string : array_graph -> string
|
||||
val show_graph : array_graph -> unit
|
||||
val write_graph_to_dot_file : array_graph -> string -> unit
|
||||
val write_graph_to_png_file : array_graph -> string -> unit
|
||||
|
||||
end
|
||||
62
exercises/e4-material/dot_graphsLib.sml
Normal file
62
exercises/e4-material/dot_graphsLib.sml
Normal file
@ -0,0 +1,62 @@
|
||||
structure dot_graphsLib :> dot_graphsLib =
|
||||
struct
|
||||
|
||||
open HolKernel Parse
|
||||
|
||||
datatype array_graph = AG of string
|
||||
|
||||
val new_array_graph = AG "";
|
||||
|
||||
(* Auxiliary functions *)
|
||||
fun AG_add (AG s) s' = AG (s ^ " " ^ s' ^ "\n")
|
||||
fun node_name n = ("node_"^(int_to_string n))
|
||||
|
||||
(* create a new node with number n and value v in graph ag *)
|
||||
fun add_node ag (n:int) (v : term option) = let
|
||||
val n_s = node_name n;
|
||||
val v_s = case v of NONE => "-"
|
||||
| SOME t => "'" ^ (term_to_string t) ^ "'"
|
||||
val new_s = (n_s ^ " [label=\"" ^ (int_to_string n) ^": "^v_s^"\"]")
|
||||
in
|
||||
AG_add ag new_s
|
||||
end
|
||||
|
||||
(* Add a link between nodes n1 and n2 *)
|
||||
fun add_node_link ag (n1:int) (n2 : int) (label : string) = let
|
||||
val new_s = (node_name n1) ^ " -> " ^ (node_name n2) ^ " [label=\""^label^"\"]";
|
||||
in
|
||||
AG_add ag new_s
|
||||
end
|
||||
|
||||
fun graph_to_string (AG s) = "digraph G {\n" ^ s ^ "}\n\n"
|
||||
fun print_graph ag = (TextIO.print (graph_to_string ag))
|
||||
|
||||
fun write_graph_to_dot_file ag file_name = let
|
||||
val os = TextIO.openOut file_name;
|
||||
val _ = TextIO.output (os, graph_to_string ag);
|
||||
val _ = TextIO.closeOut os
|
||||
in
|
||||
()
|
||||
end
|
||||
|
||||
val dot_binary = ref "/usr/bin/dot";
|
||||
|
||||
fun show_graph ag = let
|
||||
val p = Unix.execute (!dot_binary, ["-Tx11"])
|
||||
val os = Unix.textOutstreamOf p
|
||||
val _ = TextIO.output (os, graph_to_string ag)
|
||||
val _ = TextIO.closeOut os
|
||||
in
|
||||
()
|
||||
end
|
||||
|
||||
fun write_graph_to_png_file ag filename = let
|
||||
val p = Unix.execute (!dot_binary, ["-Tpng", "-o", filename])
|
||||
val os = Unix.textOutstreamOf p
|
||||
val _ = TextIO.output (os, graph_to_string ag)
|
||||
val _ = TextIO.closeOut os
|
||||
in
|
||||
()
|
||||
end
|
||||
|
||||
end
|
||||
116
exercises/e4-material/e4_arraysLib.sml
Normal file
116
exercises/e4-material/e4_arraysLib.sml
Normal file
@ -0,0 +1,116 @@
|
||||
structure e4_arraysLib :> e4_arraysLib =
|
||||
struct
|
||||
|
||||
open HolKernel Parse bossLib e4_arraysTheory dot_graphsLib
|
||||
|
||||
(* Example
|
||||
|
||||
val ag = let
|
||||
val ag = new_array_graph
|
||||
val ag = add_node ag 1 NONE
|
||||
val ag = add_node ag 2 NONE
|
||||
val ag = add_node ag 3 NONE
|
||||
val ag = add_node ag 4 (SOME ``A /\ B``)
|
||||
val ag = add_node ag 5 NONE
|
||||
val ag = add_node_link ag 1 2 "a";
|
||||
val ag = add_node_link ag 1 3 "b";
|
||||
val ag = add_node_link ag 3 4 "c";
|
||||
val ag = add_node_link ag 4 5 "d";
|
||||
in
|
||||
ag
|
||||
end
|
||||
|
||||
val _ = (dot_binary := "/usr/bin/dot");
|
||||
|
||||
|
||||
val _ = print_graph ag
|
||||
val _ = show_graph ag
|
||||
|
||||
|
||||
*)
|
||||
|
||||
fun simple_array n = let
|
||||
val n_t = numSyntax.term_of_int n
|
||||
val thm = EVAL ``FOLDL (\a n. UPDATE n a n) EMPTY_ARRAY (COUNT_LIST ^n_t)``
|
||||
in
|
||||
rhs (concl thm)
|
||||
end
|
||||
|
||||
fun sparse_array n = let
|
||||
val n_t = numSyntax.term_of_int n
|
||||
val thm = EVAL ``FOLDL (\a n. UPDATE n a (n*3)) EMPTY_ARRAY (COUNT_LIST ^n_t)``
|
||||
in
|
||||
rhs (concl thm)
|
||||
end
|
||||
|
||||
val a1 = simple_array 10;
|
||||
val a2 = sparse_array 10;
|
||||
val a3 = simple_array 20;
|
||||
val a4 = simple_array 100;
|
||||
|
||||
|
||||
fun is_array_leaf t = same_const t ``Leaf``
|
||||
|
||||
fun dest_array_node t = let
|
||||
val (c, args) = strip_comb t
|
||||
val _ = if (same_const c ``Node``) then () else fail()
|
||||
|
||||
val vo = SOME (optionSyntax.dest_some (el 2 args)) handle HOL_ERR _ => NONE
|
||||
in
|
||||
(el 1 args, vo, el 3 args)
|
||||
end
|
||||
|
||||
val is_array_node = can dest_array_node
|
||||
|
||||
fun graph_of_array_aux ag level suff t =
|
||||
if (is_array_leaf t) then (NONE, ag) else
|
||||
let
|
||||
val (l, vo, r) = dest_array_node t
|
||||
val n = level + suff
|
||||
val m = n - 1;
|
||||
val ag = add_node ag m vo
|
||||
val (l_n, ag) = graph_of_array_aux ag (level*2) n l
|
||||
val ag = case l_n of NONE => ag
|
||||
| SOME ln => add_node_link ag m ln "l"
|
||||
val (r_n, ag) = graph_of_array_aux ag (level*2) suff r
|
||||
val ag = case r_n of NONE => ag
|
||||
| SOME rn => add_node_link ag m rn "r"
|
||||
in
|
||||
(SOME m, ag)
|
||||
end handle HOL_ERR _ => (NONE, ag)
|
||||
|
||||
fun graph_of_array t =
|
||||
snd (graph_of_array_aux new_array_graph 1 0 t)
|
||||
|
||||
|
||||
show_graph (graph_of_array a1)
|
||||
show_graph (graph_of_array a2)
|
||||
|
||||
print_graph (graph_of_array a1)
|
||||
|
||||
EVAL ``num2boolList 5``
|
||||
a1
|
||||
|
||||
Node
|
||||
(Node (Node Leaf (SOME 6) Leaf)
|
||||
(SOME 2)
|
||||
(Node Leaf (SOME 5) Leaf))
|
||||
|
||||
(SOME 0)
|
||||
|
||||
(Node
|
||||
(Node Leaf (SOME 4) (Node Leaf (SOME 9) Leaf))
|
||||
|
||||
(SOME 1)
|
||||
|
||||
(Node (Node Leaf (SOME 8) Leaf) (SOME 3)
|
||||
|
||||
(Node Leaf (SOME 7) Leaf)))
|
||||
|
||||
end
|
||||
|
||||
|
||||
print_graph (graph_of_array a2);
|
||||
|
||||
|
||||
show_graph (graph_of_array (simple_array 15));
|
||||
235
exercises/e4-material/e4_arraysScript.sml
Normal file
235
exercises/e4-material/e4_arraysScript.sml
Normal file
@ -0,0 +1,235 @@
|
||||
open HolKernel Parse boolLib bossLib;
|
||||
|
||||
val _ = new_theory "e4_arrays";
|
||||
|
||||
|
||||
(**************************************************)
|
||||
(* Provided part *)
|
||||
(**************************************************)
|
||||
|
||||
val num2boolList_def = Define `
|
||||
(num2boolList 0 = []) /\
|
||||
(num2boolList 1 = []) /\
|
||||
(num2boolList n = (EVEN n) :: num2boolList (n DIV 2))`
|
||||
|
||||
(* The resulting definition is hard to apply and
|
||||
rewriting with it loops easily. So let's provide
|
||||
a decent lemma capturing the semantics *)
|
||||
|
||||
val num2boolList_REWRS = store_thm ("num2boolList_REWRS",
|
||||
``(num2boolList 0 = []) /\
|
||||
(num2boolList 1 = []) /\
|
||||
(!n. 2 <= n ==> ((num2boolList n = (EVEN n) :: num2boolList (n DIV 2))))``,
|
||||
REPEAT STRIP_TAC >| [
|
||||
METIS_TAC[num2boolList_def],
|
||||
METIS_TAC[num2boolList_def],
|
||||
|
||||
`n <> 0 /\ n <> 1` by DECIDE_TAC >>
|
||||
METIS_TAC[num2boolList_def]
|
||||
]);
|
||||
|
||||
|
||||
(* It is aslo useful to show when the list is empty *)
|
||||
val num2boolList_EQ_NIL = store_thm ("num2boolList_EQ_NIL",
|
||||
``!n. (num2boolList n = []) <=> ((n = 0) \/ (n = 1))``,
|
||||
GEN_TAC >> EQ_TAC >| [
|
||||
REPEAT STRIP_TAC >>
|
||||
CCONTR_TAC >>
|
||||
FULL_SIMP_TAC list_ss [num2boolList_REWRS],
|
||||
|
||||
REPEAT STRIP_TAC >> (
|
||||
ASM_SIMP_TAC std_ss [num2boolList_REWRS]
|
||||
)
|
||||
]);
|
||||
|
||||
|
||||
(* Now the awkward arithmetic part. Let's show that num2boolList is injective *)
|
||||
|
||||
(* For demonstration, let's define our own induction theorem *)
|
||||
val MY_NUM_INDUCT = store_thm ("MY_NUM_INDUCT",
|
||||
``!P. P 1 /\ (!n. (2 <= n /\ (!m. (m < n /\ m <> 0) ==> P m)) ==> P n) ==> (!n. n <> 0 ==> P n)``,
|
||||
REPEAT STRIP_TAC >>
|
||||
completeInduct_on `n` >>
|
||||
Cases_on `n` >> FULL_SIMP_TAC arith_ss [] >>
|
||||
Cases_on `n'` >> ASM_SIMP_TAC arith_ss [])
|
||||
|
||||
val num2boolList_INJ = store_thm ("num2boolList_INJ",
|
||||
``!n. n <> 0 ==> !m. m <> 0 ==> (num2boolList n = num2boolList m) ==> (n = m)``,
|
||||
|
||||
HO_MATCH_MP_TAC MY_NUM_INDUCT >>
|
||||
CONJ_TAC >- (
|
||||
SIMP_TAC list_ss [num2boolList_REWRS, num2boolList_EQ_NIL]
|
||||
) >>
|
||||
GEN_TAC >> STRIP_TAC >> GEN_TAC >> STRIP_TAC >>
|
||||
Cases_on `m = 1` >- (
|
||||
ASM_SIMP_TAC list_ss [num2boolList_REWRS]
|
||||
) >>
|
||||
ASM_SIMP_TAC list_ss [num2boolList_REWRS] >>
|
||||
REPEAT STRIP_TAC >>
|
||||
`n DIV 2 = m DIV 2` by (
|
||||
`(m DIV 2 <> 0) /\ (n DIV 2 <> 0) /\ (n DIV 2 < n)` suffices_by METIS_TAC[] >>
|
||||
|
||||
ASM_SIMP_TAC arith_ss [arithmeticTheory.NOT_ZERO_LT_ZERO,
|
||||
arithmeticTheory.X_LT_DIV]
|
||||
) >>
|
||||
`n MOD 2 = m MOD 2` by (
|
||||
ASM_SIMP_TAC std_ss [arithmeticTheory.MOD_2]
|
||||
) >>
|
||||
`0 < 2` by DECIDE_TAC >>
|
||||
METIS_TAC[arithmeticTheory.DIVISION]);
|
||||
|
||||
|
||||
|
||||
|
||||
(* Shifting the keys by one is trivial and by this we get rid of the
|
||||
preconditions of the injectivity theorem *)
|
||||
val num2arrayIndex_def = Define `num2arrayIndex n = (num2boolList (SUC n))`
|
||||
val num2arrayIndex_INJ = store_thm ("num2arrayIndex_INJ",
|
||||
``!n m. (num2arrayIndex n = num2arrayIndex m) <=> (n = m)``,
|
||||
|
||||
SIMP_TAC list_ss [num2arrayIndex_def] >>
|
||||
METIS_TAC [numTheory.NOT_SUC, num2boolList_INJ, numTheory.INV_SUC]);
|
||||
|
||||
|
||||
(* Now let's define the inverse operation *)
|
||||
val boolList2num_def = Define `
|
||||
(boolList2num [] = 1) /\
|
||||
(boolList2num (F::idx) = 2 * boolList2num idx + 1) /\
|
||||
(boolList2num (T::idx) = 2 * boolList2num idx)`
|
||||
|
||||
(* We can show that the inverse is never 0 ... *)
|
||||
val boolList2num_GT_0 = prove (``!idx. 0 < boolList2num idx``,
|
||||
Induct >- SIMP_TAC arith_ss [boolList2num_def] >>
|
||||
Cases >> ASM_SIMP_TAC arith_ss [boolList2num_def]);
|
||||
|
||||
(* ... so we can subtract 1 for the index shift *)
|
||||
val arrayIndex2num_def = Define `arrayIndex2num idx = PRE (boolList2num idx)`
|
||||
|
||||
|
||||
|
||||
(* Now a fiddly prove that we indeed defined the inverse *)
|
||||
val boolList2num_inv = prove (``!idx. num2boolList (boolList2num idx) = idx``,
|
||||
Induct >- (
|
||||
SIMP_TAC arith_ss [boolList2num_def, num2boolList_REWRS]
|
||||
) >>
|
||||
`0 < boolList2num idx` by METIS_TAC[boolList2num_GT_0] >>
|
||||
`0 < 2` by DECIDE_TAC >>
|
||||
Cases >| [
|
||||
`!x. (2 * x) MOD 2 = 0` by
|
||||
METIS_TAC[arithmeticTheory.MOD_EQ_0, arithmeticTheory.MULT_COMM] >>
|
||||
`!x. (2 * x) DIV 2 = x` by
|
||||
METIS_TAC[arithmeticTheory.MULT_DIV, arithmeticTheory.MULT_COMM] >>
|
||||
ASM_SIMP_TAC list_ss [boolList2num_def, num2boolList_REWRS,
|
||||
arithmeticTheory.EVEN_MOD2],
|
||||
|
||||
`!x y. (2 * x + y) MOD 2 = (y MOD 2)` by
|
||||
METIS_TAC[arithmeticTheory.MOD_TIMES, arithmeticTheory.MULT_COMM] >>
|
||||
`!x y. (2 * x + y) DIV 2 = x + y DIV 2` by
|
||||
METIS_TAC[arithmeticTheory.ADD_DIV_ADD_DIV, arithmeticTheory.MULT_COMM] >>
|
||||
ASM_SIMP_TAC list_ss [boolList2num_def, num2boolList_REWRS,
|
||||
arithmeticTheory.EVEN_MOD2]
|
||||
]);
|
||||
|
||||
(* Shifting is easy then *)
|
||||
val arrayIndex2num_inv = store_thm ("arrayIndex2num_inv",
|
||||
``!idx. num2arrayIndex (arrayIndex2num idx) = idx``,
|
||||
GEN_TAC >>
|
||||
REWRITE_TAC[num2arrayIndex_def, arrayIndex2num_def] >>
|
||||
`0 < boolList2num idx` by METIS_TAC[boolList2num_GT_0] >>
|
||||
FULL_SIMP_TAC arith_ss [arithmeticTheory.SUC_PRE] >>
|
||||
ASM_SIMP_TAC std_ss [boolList2num_inv]);
|
||||
|
||||
|
||||
(* It is also very easy to derive other useful properties. *)
|
||||
val num2arrayIndex_inv = store_thm ("num2arrayIndex_inv",
|
||||
``!n. arrayIndex2num (num2arrayIndex n) = n``,
|
||||
METIS_TAC[ num2arrayIndex_INJ, arrayIndex2num_inv]);
|
||||
|
||||
val arrayIndex2num_INJ = store_thm ("arrayIndex2num_INJ",
|
||||
``!idx1 idx2. (arrayIndex2num idx1 = arrayIndex2num idx2) <=> (idx1 = idx2)``,
|
||||
METIS_TAC[ num2arrayIndex_INJ, arrayIndex2num_inv]);
|
||||
|
||||
|
||||
(* A rewrite for the top-level inverse might be handy *)
|
||||
val num2arrayIndex_REWRS = store_thm ("num2arrayIndex_REWRS", ``
|
||||
!n. num2arrayIndex n =
|
||||
if (n = 0) then [] else
|
||||
ODD n :: num2arrayIndex ((n - 1) DIV 2)``,
|
||||
|
||||
REWRITE_TAC[num2arrayIndex_def] >>
|
||||
Cases >> SIMP_TAC arith_ss [num2boolList_REWRS] >>
|
||||
SIMP_TAC arith_ss [arithmeticTheory.ODD, arithmeticTheory.EVEN,
|
||||
arithmeticTheory.ODD_EVEN] >>
|
||||
`(!x r. (2 * x + r) DIV 2 = x + r DIV 2) /\ (!x. (2*x) DIV 2 = x)` by (
|
||||
`0 < 2` by DECIDE_TAC >>
|
||||
METIS_TAC[arithmeticTheory.ADD_DIV_ADD_DIV, arithmeticTheory.MULT_COMM,
|
||||
arithmeticTheory.MULT_DIV]
|
||||
) >>
|
||||
Cases_on `EVEN n'` >> ASM_REWRITE_TAC[] >| [
|
||||
`?m. n' = 2* m` by METIS_TAC[arithmeticTheory.EVEN_ODD_EXISTS] >>
|
||||
ASM_SIMP_TAC arith_ss [arithmeticTheory.ADD1],
|
||||
|
||||
`?m. n' = SUC (2* m)` by METIS_TAC[arithmeticTheory.EVEN_ODD_EXISTS,
|
||||
arithmeticTheory.ODD_EVEN] >>
|
||||
ASM_SIMP_TAC arith_ss [arithmeticTheory.ADD1]
|
||||
]);
|
||||
|
||||
|
||||
(**************************************************)
|
||||
(* YOU SHOULD WORK FROM HERE ON *)
|
||||
(**************************************************)
|
||||
|
||||
(* TODO: Define a datatype for arrays storing values of type 'a. *)
|
||||
val _ = Datatype `array = DUMMY 'a`
|
||||
|
||||
|
||||
(* TODO: Define a new, empty array *)
|
||||
val EMPTY_ARRAY_def = Define `EMPTY_ARRAY : 'a array = ARB`
|
||||
|
||||
(* TODO: define ILOOKUP, IUPDATE and IREMOVE *)
|
||||
val IUPDATE_def = Define `IUPDATE (v : 'a) (a : 'a array) (k : bool list) = a:'a array`
|
||||
val ILOOKUP_def = Define `ILOOKUP (a : 'a array) (k : bool list) = NONE:'a option`
|
||||
val IREMOVE_def = Define `IREMOVE (a : 'a array) (k : bool list) = a:'a array`
|
||||
|
||||
|
||||
(* With these, we can define the lifted operations *)
|
||||
val LOOKUP_def = Define `LOOKUP a n = ILOOKUP a (num2arrayIndex n)`
|
||||
val UPDATE_def = Define `UPDATE v a n = IUPDATE v a (num2arrayIndex n)`
|
||||
val REMOVE_def = Define `REMOVE a n = IREMOVE a (num2arrayIndex n)`
|
||||
|
||||
|
||||
(* TODO: show a few properties *)
|
||||
val LOOKUP_EMPTY = store_thm ("LOOKUP_EMPTY",
|
||||
``!k. LOOKUP EMPTY_ARRAY k = NONE``,
|
||||
cheat);
|
||||
|
||||
val LOOKUP_UPDATE = store_thm ("LOOKUP_UPDATE",
|
||||
``!v n n' a. LOOKUP (UPDATE v a n) n' =
|
||||
(if (n = n') then SOME v else LOOKUP a n')``,
|
||||
cheat);
|
||||
|
||||
val LOOKUP_REMOVE = store_thm ("LOOKUP_REMOVE",
|
||||
``!n n' a. LOOKUP (REMOVE a n) n' =
|
||||
(if (n = n') then NONE else LOOKUP a n')``,
|
||||
cheat);
|
||||
|
||||
|
||||
val UPDATE_REMOVE_EQ = store_thm ("UPDATE_REMOVE_EQ", ``
|
||||
(!v1 v2 n a. UPDATE v1 (UPDATE v2 a n) n = UPDATE v1 a n) /\
|
||||
(!v n a. UPDATE v (REMOVE a n) n = UPDATE v a n) /\
|
||||
(!v n a. REMOVE (UPDATE v a n) n = REMOVE a n)
|
||||
``,
|
||||
cheat);
|
||||
|
||||
|
||||
val UPDATE_REMOVE_NEQ = store_thm ("UPDATE_REMOVE_NEQ", ``
|
||||
(!v1 v2 a n1 n2. n1 <> n2 ==>
|
||||
((UPDATE v1 (UPDATE v2 a n2) n1) = (UPDATE v2 (UPDATE v1 a n1) n2))) /\
|
||||
(!v a n1 n2. n1 <> n2 ==>
|
||||
((UPDATE v (REMOVE a n2) n1) = (REMOVE (UPDATE v a n1) n2))) /\
|
||||
(!a n1 n2. n1 <> n2 ==>
|
||||
((REMOVE (REMOVE a n2) n1) = (REMOVE (REMOVE a n1) n2)))``,
|
||||
cheat);
|
||||
|
||||
|
||||
val _ = export_theory();
|
||||
Reference in New Issue
Block a user