author | bulwahn |
Sun, 11 Mar 2012 20:18:38 +0100 | |
changeset 46871 | 9100e6aa9272 |
parent 46395 | f56be74d7f51 |
child 47097 | 987cb55cac44 |
permissions | -rw-r--r-- |
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
1 |
theory Executable_Relation |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
2 |
imports Main |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
3 |
begin |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
4 |
|
46871 | 5 |
subsection {* Preliminaries on the raw type of relations *} |
6 |
||
7 |
definition rel_raw :: "'a set => ('a * 'a) set => ('a * 'a) set" |
|
8 |
where |
|
9 |
"rel_raw X R = Id_on X Un R" |
|
10 |
||
11 |
lemma member_raw: |
|
12 |
"(x, y) : (rel_raw X R) = ((x = y \<and> x : X) \<or> (x, y) : R)" |
|
13 |
unfolding rel_raw_def by auto |
|
14 |
||
15 |
lemma Id_raw: |
|
16 |
"Id = rel_raw UNIV {}" |
|
17 |
unfolding rel_raw_def by auto |
|
18 |
||
19 |
lemma converse_raw: |
|
20 |
"converse (rel_raw X R) = rel_raw X (converse R)" |
|
21 |
unfolding rel_raw_def by auto |
|
22 |
||
23 |
lemma union_raw: |
|
24 |
"(rel_raw X R) Un (rel_raw Y S) = rel_raw (X Un Y) (R Un S)" |
|
25 |
unfolding rel_raw_def by auto |
|
26 |
||
27 |
lemma comp_Id_on: |
|
28 |
"Id_on X O R = Set.project (%(x, y). x : X) R" |
|
29 |
by (auto intro!: rel_compI) |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
30 |
|
46871 | 31 |
lemma comp_Id_on': |
32 |
"R O Id_on X = Set.project (%(x, y). y : X) R" |
|
33 |
by auto |
|
34 |
||
35 |
lemma project_Id_on: |
|
36 |
"Set.project (%(x, y). x : X) (Id_on Y) = Id_on (X Int Y)" |
|
37 |
by auto |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
38 |
|
46871 | 39 |
lemma rel_comp_raw: |
40 |
"(rel_raw X R) O (rel_raw Y S) = rel_raw (X Int Y) (Set.project (%(x, y). y : Y) R Un (Set.project (%(x, y). x : X) S Un R O S))" |
|
41 |
unfolding rel_raw_def |
|
42 |
apply simp |
|
43 |
apply (simp add: comp_Id_on) |
|
44 |
apply (simp add: project_Id_on) |
|
45 |
apply (simp add: comp_Id_on') |
|
46 |
apply auto |
|
47 |
done |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
48 |
|
46871 | 49 |
lemma rtrancl_raw: |
50 |
"(rel_raw X R)^* = rel_raw UNIV (R^+)" |
|
51 |
unfolding rel_raw_def |
|
52 |
apply auto |
|
53 |
apply (metis Id_on_iff Un_commute iso_tuple_UNIV_I rtrancl_Un_separatorE rtrancl_eq_or_trancl) |
|
54 |
by (metis in_rtrancl_UnI trancl_into_rtrancl) |
|
55 |
||
56 |
lemma Image_raw: |
|
57 |
"(rel_raw X R) `` S = (X Int S) Un (R `` S)" |
|
58 |
unfolding rel_raw_def by auto |
|
59 |
||
60 |
subsection {* A dedicated type for relations *} |
|
61 |
||
62 |
subsubsection {* Definition of the dedicated type for relations *} |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
63 |
|
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
64 |
quotient_type 'a rel = "('a * 'a) set" / "(op =)" |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
65 |
morphisms set_of_rel rel_of_set by (metis identity_equivp) |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
66 |
|
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
67 |
lemma [simp]: |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
68 |
"rel_of_set (set_of_rel S) = S" |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
69 |
by (rule Quotient_abs_rep[OF Quotient_rel]) |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
70 |
|
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
71 |
lemma [simp]: |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
72 |
"set_of_rel (rel_of_set R) = R" |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
73 |
by (rule Quotient_rep_abs[OF Quotient_rel]) (rule refl) |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
74 |
|
46871 | 75 |
lemmas rel_raw_of_set_eqI[intro!] = arg_cong[where f="rel_of_set"] |
76 |
||
77 |
definition rel :: "'a set => ('a * 'a) set => 'a rel" |
|
78 |
where |
|
79 |
"rel X R = rel_of_set (rel_raw X R)" |
|
80 |
||
81 |
subsubsection {* Constant definitions on relations *} |
|
82 |
||
83 |
hide_const (open) converse rel_comp rtrancl Image |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
84 |
|
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
85 |
quotient_definition member :: "'a * 'a => 'a rel => bool" where |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
86 |
"member" is "Set.member :: 'a * 'a => ('a * 'a) set => bool" |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
87 |
|
46871 | 88 |
quotient_definition converse :: "'a rel => 'a rel" |
89 |
where |
|
90 |
"converse" is "Relation.converse :: ('a * 'a) set => ('a * 'a) set" |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
91 |
|
46871 | 92 |
quotient_definition union :: "'a rel => 'a rel => 'a rel" |
93 |
where |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
94 |
"union" is "Set.union :: ('a * 'a) set => ('a * 'a) set => ('a * 'a) set" |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
95 |
|
46871 | 96 |
quotient_definition rel_comp :: "'a rel => 'a rel => 'a rel" |
97 |
where |
|
98 |
"rel_comp" is "Relation.rel_comp :: ('a * 'a) set => ('a * 'a) set => ('a * 'a) set" |
|
99 |
||
100 |
quotient_definition rtrancl :: "'a rel => 'a rel" |
|
101 |
where |
|
102 |
"rtrancl" is "Transitive_Closure.rtrancl :: ('a * 'a) set => ('a * 'a) set" |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
103 |
|
46871 | 104 |
quotient_definition Image :: "'a rel => 'a set => 'a set" |
105 |
where |
|
106 |
"Image" is "Relation.Image :: ('a * 'a) set => 'a set => 'a set" |
|
107 |
||
108 |
subsubsection {* Code generation *} |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
109 |
|
46871 | 110 |
code_datatype rel |
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
111 |
|
46871 | 112 |
lemma [code]: |
113 |
"member (x, y) (rel X R) = ((x = y \<and> x : X) \<or> (x, y) : R)" |
|
114 |
unfolding rel_def member_def |
|
115 |
by (simp add: member_raw) |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
116 |
|
46871 | 117 |
lemma [code]: |
118 |
"converse (rel X R) = rel X (R^-1)" |
|
119 |
unfolding rel_def converse_def |
|
120 |
by (simp add: converse_raw) |
|
121 |
||
122 |
lemma [code]: |
|
123 |
"union (rel X R) (rel Y S) = rel (X Un Y) (R Un S)" |
|
124 |
unfolding rel_def union_def |
|
125 |
by (simp add: union_raw) |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
126 |
|
46871 | 127 |
lemma [code]: |
128 |
"rel_comp (rel X R) (rel Y S) = rel (X Int Y) (Set.project (%(x, y). y : Y) R Un (Set.project (%(x, y). x : X) S Un R O S))" |
|
129 |
unfolding rel_def rel_comp_def |
|
130 |
by (simp add: rel_comp_raw) |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
131 |
|
46871 | 132 |
lemma [code]: |
133 |
"rtrancl (rel X R) = rel UNIV (R^+)" |
|
134 |
unfolding rel_def rtrancl_def |
|
135 |
by (simp add: rtrancl_raw) |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
136 |
|
46871 | 137 |
lemma [code]: |
138 |
"Image (rel X R) S = (X Int S) Un (R `` S)" |
|
139 |
unfolding rel_def Image_def |
|
140 |
by (simp add: Image_raw) |
|
141 |
||
142 |
quickcheck_generator rel constructors: rel |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
143 |
|
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
144 |
lemma |
46871 | 145 |
"member (x, (y :: nat)) (rtrancl (union R S)) \<Longrightarrow> member (x, y) (union (rtrancl R) (rtrancl S))" |
146 |
quickcheck[exhaustive, expect = counterexample] |
|
46395
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
147 |
oops |
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
148 |
|
f56be74d7f51
adding an example for a datatype refinement which would allow rtrancl to be executable on an infinite type
bulwahn
parents:
diff
changeset
|
149 |
end |