author paulson Fri Nov 19 17:31:49 2004 +0100 (2004-11-19) changeset 15300 7dd5853a4812 parent 15299 576fd0b65ed8 child 15301 26724034de5e
moved and renamed Integ/Equiv.thy
 src/HOL/Equiv_Relations.thy file | annotate | diff | revisions src/HOL/Integ/Equiv.thy file | annotate | diff | revisions src/HOL/Integ/IntDef.thy file | annotate | diff | revisions src/HOL/IsaMakefile file | annotate | diff | revisions
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/src/HOL/Equiv_Relations.thy	Fri Nov 19 17:31:49 2004 +0100
1.3 @@ -0,0 +1,352 @@
1.4 +(*  ID:         $Id$
1.5 +    Authors:    Lawrence C Paulson, Cambridge University Computer Laboratory
1.6 +    Copyright   1996  University of Cambridge
1.7 +*)
1.8 +
1.9 +header {* Equivalence Relations in Higher-Order Set Theory *}
1.10 +
1.11 +theory Equiv_Relations
1.12 +imports Relation Finite_Set
1.13 +begin
1.14 +
1.15 +subsection {* Equivalence relations *}
1.16 +
1.17 +locale equiv =
1.18 +  fixes A and r
1.19 +  assumes refl: "refl A r"
1.20 +    and sym: "sym r"
1.21 +    and trans: "trans r"
1.22 +
1.23 +text {*
1.24 +  Suppes, Theorem 70: @{text r} is an equiv relation iff @{text "r\<inverse> O
1.25 +  r = r"}.
1.26 +
1.27 +  First half: @{text "equiv A r ==> r\<inverse> O r = r"}.
1.28 +*}
1.29 +
1.30 +lemma sym_trans_comp_subset:
1.31 +    "sym r ==> trans r ==> r\<inverse> O r \<subseteq> r"
1.32 +  by (unfold trans_def sym_def converse_def) blast
1.33 +
1.34 +lemma refl_comp_subset: "refl A r ==> r \<subseteq> r\<inverse> O r"
1.35 +  by (unfold refl_def) blast
1.36 +
1.37 +lemma equiv_comp_eq: "equiv A r ==> r\<inverse> O r = r"
1.38 +  apply (unfold equiv_def)
1.39 +  apply clarify
1.40 +  apply (rule equalityI)
1.41 +   apply (rules intro: sym_trans_comp_subset refl_comp_subset)+
1.42 +  done
1.43 +
1.44 +text {* Second half. *}
1.45 +
1.46 +lemma comp_equivI:
1.47 +    "r\<inverse> O r = r ==> Domain r = A ==> equiv A r"
1.48 +  apply (unfold equiv_def refl_def sym_def trans_def)
1.49 +  apply (erule equalityE)
1.50 +  apply (subgoal_tac "\<forall>x y. (x, y) \<in> r --> (y, x) \<in> r")
1.51 +   apply fast
1.52 +  apply fast
1.53 +  done
1.54 +
1.55 +
1.56 +subsection {* Equivalence classes *}
1.57 +
1.58 +lemma equiv_class_subset:
1.59 +  "equiv A r ==> (a, b) \<in> r ==> r{a} \<subseteq> r{b}"
1.60 +  -- {* lemma for the next result *}
1.61 +  by (unfold equiv_def trans_def sym_def) blast
1.62 +
1.63 +theorem equiv_class_eq: "equiv A r ==> (a, b) \<in> r ==> r{a} = r{b}"
1.64 +  apply (assumption | rule equalityI equiv_class_subset)+
1.65 +  apply (unfold equiv_def sym_def)
1.66 +  apply blast
1.67 +  done
1.68 +
1.69 +lemma equiv_class_self: "equiv A r ==> a \<in> A ==> a \<in> r{a}"
1.70 +  by (unfold equiv_def refl_def) blast
1.71 +
1.72 +lemma subset_equiv_class:
1.73 +    "equiv A r ==> r{b} \<subseteq> r{a} ==> b \<in> A ==> (a,b) \<in> r"
1.74 +  -- {* lemma for the next result *}
1.75 +  by (unfold equiv_def refl_def) blast
1.76 +
1.77 +lemma eq_equiv_class:
1.78 +    "r{a} = r{b} ==> equiv A r ==> b \<in> A ==> (a, b) \<in> r"
1.79 +  by (rules intro: equalityD2 subset_equiv_class)
1.80 +
1.81 +lemma equiv_class_nondisjoint:
1.82 +    "equiv A r ==> x \<in> (r{a} \<inter> r{b}) ==> (a, b) \<in> r"
1.83 +  by (unfold equiv_def trans_def sym_def) blast
1.84 +
1.85 +lemma equiv_type: "equiv A r ==> r \<subseteq> A \<times> A"
1.86 +  by (unfold equiv_def refl_def) blast
1.87 +
1.88 +theorem equiv_class_eq_iff:
1.89 +  "equiv A r ==> ((x, y) \<in> r) = (r{x} = r{y} & x \<in> A & y \<in> A)"
1.90 +  by (blast intro!: equiv_class_eq dest: eq_equiv_class equiv_type)
1.91 +
1.92 +theorem eq_equiv_class_iff:
1.93 +  "equiv A r ==> x \<in> A ==> y \<in> A ==> (r{x} = r{y}) = ((x, y) \<in> r)"
1.94 +  by (blast intro!: equiv_class_eq dest: eq_equiv_class equiv_type)
1.95 +
1.96 +
1.97 +subsection {* Quotients *}
1.98 +
1.99 +constdefs
1.100 +  quotient :: "['a set, ('a*'a) set] => 'a set set"  (infixl "'/'/" 90)
1.101 +  "A//r == \<Union>x \<in> A. {r{x}}"  -- {* set of equiv classes *}
1.102 +
1.103 +lemma quotientI: "x \<in> A ==> r{x} \<in> A//r"
1.104 +  by (unfold quotient_def) blast
1.105 +
1.106 +lemma quotientE:
1.107 +  "X \<in> A//r ==> (!!x. X = r{x} ==> x \<in> A ==> P) ==> P"
1.108 +  by (unfold quotient_def) blast
1.109 +
1.110 +lemma Union_quotient: "equiv A r ==> Union (A//r) = A"
1.111 +  by (unfold equiv_def refl_def quotient_def) blast
1.112 +
1.113 +lemma quotient_disj:
1.114 +  "equiv A r ==> X \<in> A//r ==> Y \<in> A//r ==> X = Y | (X \<inter> Y = {})"
1.115 +  apply (unfold quotient_def)
1.116 +  apply clarify
1.117 +  apply (rule equiv_class_eq)
1.118 +   apply assumption
1.119 +  apply (unfold equiv_def trans_def sym_def)
1.120 +  apply blast
1.121 +  done
1.122 +
1.123 +lemma quotient_eqI:
1.124 +  "[|equiv A r; X \<in> A//r; Y \<in> A//r; x \<in> X; y \<in> Y; (x,y) \<in> r|] ==> X = Y"
1.125 +  apply (clarify elim!: quotientE)
1.126 +  apply (rule equiv_class_eq, assumption)
1.127 +  apply (unfold equiv_def sym_def trans_def, blast)
1.128 +  done
1.129 +
1.130 +lemma quotient_eq_iff:
1.131 +  "[|equiv A r; X \<in> A//r; Y \<in> A//r; x \<in> X; y \<in> Y|] ==> (X = Y) = ((x,y) \<in> r)"
1.132 +  apply (rule iffI)
1.133 +   prefer 2 apply (blast del: equalityI intro: quotient_eqI)
1.134 +  apply (clarify elim!: quotientE)
1.135 +  apply (unfold equiv_def sym_def trans_def, blast)
1.136 +  done
1.137 +
1.138 +
1.139 +lemma quotient_empty [simp]: "{}//r = {}"
1.141 +
1.142 +lemma quotient_is_empty [iff]: "(A//r = {}) = (A = {})"
1.144 +
1.145 +lemma quotient_is_empty2 [iff]: "({} = A//r) = (A = {})"
1.147 +
1.148 +
1.149 +subsection {* Defining unary operations upon equivalence classes *}
1.150 +
1.151 +text{*A congruence-preserving function*}
1.152 +locale congruent =
1.153 +  fixes r and f
1.154 +  assumes congruent: "(y,z) \<in> r ==> f y = f z"
1.155 +
1.156 +syntax
1.157 +  RESPECTS ::"['a => 'b, ('a * 'a) set] => bool"  (infixr "respects" 80)
1.158 +
1.159 +translations
1.160 +  "f respects r" == "congruent r f"
1.161 +
1.162 +
1.163 +lemma UN_constant_eq: "a \<in> A ==> \<forall>y \<in> A. f y = c ==> (\<Union>y \<in> A. f(y))=c"
1.164 +  -- {* lemma required to prove @{text UN_equiv_class} *}
1.165 +  by auto
1.166 +
1.167 +lemma UN_equiv_class:
1.168 +  "equiv A r ==> f respects r ==> a \<in> A
1.169 +    ==> (\<Union>x \<in> r{a}. f x) = f a"
1.170 +  -- {* Conversion rule *}
1.171 +  apply (rule equiv_class_self [THEN UN_constant_eq], assumption+)
1.172 +  apply (unfold equiv_def congruent_def sym_def)
1.173 +  apply (blast del: equalityI)
1.174 +  done
1.175 +
1.176 +lemma UN_equiv_class_type:
1.177 +  "equiv A r ==> f respects r ==> X \<in> A//r ==>
1.178 +    (!!x. x \<in> A ==> f x \<in> B) ==> (\<Union>x \<in> X. f x) \<in> B"
1.179 +  apply (unfold quotient_def)
1.180 +  apply clarify
1.181 +  apply (subst UN_equiv_class)
1.182 +     apply auto
1.183 +  done
1.184 +
1.185 +text {*
1.186 +  Sufficient conditions for injectiveness.  Could weaken premises!
1.187 +  major premise could be an inclusion; bcong could be @{text "!!y. y \<in>
1.188 +  A ==> f y \<in> B"}.
1.189 +*}
1.190 +
1.191 +lemma UN_equiv_class_inject:
1.192 +  "equiv A r ==> f respects r ==>
1.193 +    (\<Union>x \<in> X. f x) = (\<Union>y \<in> Y. f y) ==> X \<in> A//r ==> Y \<in> A//r
1.194 +    ==> (!!x y. x \<in> A ==> y \<in> A ==> f x = f y ==> (x, y) \<in> r)
1.195 +    ==> X = Y"
1.196 +  apply (unfold quotient_def)
1.197 +  apply clarify
1.198 +  apply (rule equiv_class_eq)
1.199 +   apply assumption
1.200 +  apply (subgoal_tac "f x = f xa")
1.201 +   apply blast
1.202 +  apply (erule box_equals)
1.203 +   apply (assumption | rule UN_equiv_class)+
1.204 +  done
1.205 +
1.206 +
1.207 +subsection {* Defining binary operations upon equivalence classes *}
1.208 +
1.209 +text{*A congruence-preserving function of two arguments*}
1.210 +locale congruent2 =
1.211 +  fixes r1 and r2 and f
1.212 +  assumes congruent2:
1.213 +    "(y1,z1) \<in> r1 ==> (y2,z2) \<in> r2 ==> f y1 y2 = f z1 z2"
1.214 +
1.215 +text{*Abbreviation for the common case where the relations are identical*}
1.216 +syntax
1.217 +  RESPECTS2 ::"['a => 'b, ('a * 'a) set] => bool"  (infixr "respects2 " 80)
1.218 +
1.219 +translations
1.220 +  "f respects2 r" => "congruent2 r r f"
1.221 +
1.222 +lemma congruent2_implies_congruent:
1.223 +    "equiv A r1 ==> congruent2 r1 r2 f ==> a \<in> A ==> congruent r2 (f a)"
1.224 +  by (unfold congruent_def congruent2_def equiv_def refl_def) blast
1.225 +
1.226 +lemma congruent2_implies_congruent_UN:
1.227 +  "equiv A1 r1 ==> equiv A2 r2 ==> congruent2 r1 r2 f ==> a \<in> A2 ==>
1.228 +    congruent r1 (\<lambda>x1. \<Union>x2 \<in> r2{a}. f x1 x2)"
1.229 +  apply (unfold congruent_def)
1.230 +  apply clarify
1.231 +  apply (rule equiv_type [THEN subsetD, THEN SigmaE2], assumption+)
1.232 +  apply (simp add: UN_equiv_class congruent2_implies_congruent)
1.233 +  apply (unfold congruent2_def equiv_def refl_def)
1.234 +  apply (blast del: equalityI)
1.235 +  done
1.236 +
1.237 +lemma UN_equiv_class2:
1.238 +  "equiv A1 r1 ==> equiv A2 r2 ==> congruent2 r1 r2 f ==> a1 \<in> A1 ==> a2 \<in> A2
1.239 +    ==> (\<Union>x1 \<in> r1{a1}. \<Union>x2 \<in> r2{a2}. f x1 x2) = f a1 a2"
1.240 +  by (simp add: UN_equiv_class congruent2_implies_congruent
1.241 +    congruent2_implies_congruent_UN)
1.242 +
1.243 +lemma UN_equiv_class_type2:
1.244 +  "equiv A1 r1 ==> equiv A2 r2 ==> congruent2 r1 r2 f
1.245 +    ==> X1 \<in> A1//r1 ==> X2 \<in> A2//r2
1.246 +    ==> (!!x1 x2. x1 \<in> A1 ==> x2 \<in> A2 ==> f x1 x2 \<in> B)
1.247 +    ==> (\<Union>x1 \<in> X1. \<Union>x2 \<in> X2. f x1 x2) \<in> B"
1.248 +  apply (unfold quotient_def)
1.249 +  apply clarify
1.250 +  apply (blast intro: UN_equiv_class_type congruent2_implies_congruent_UN
1.251 +    congruent2_implies_congruent quotientI)
1.252 +  done
1.253 +
1.254 +lemma UN_UN_split_split_eq:
1.255 +  "(\<Union>(x1, x2) \<in> X. \<Union>(y1, y2) \<in> Y. A x1 x2 y1 y2) =
1.256 +    (\<Union>x \<in> X. \<Union>y \<in> Y. (\<lambda>(x1, x2). (\<lambda>(y1, y2). A x1 x2 y1 y2) y) x)"
1.257 +  -- {* Allows a natural expression of binary operators, *}
1.258 +  -- {* without explicit calls to @{text split} *}
1.259 +  by auto
1.260 +
1.261 +lemma congruent2I:
1.262 +  "equiv A1 r1 ==> equiv A2 r2
1.263 +    ==> (!!y z w. w \<in> A2 ==> (y,z) \<in> r1 ==> f y w = f z w)
1.264 +    ==> (!!y z w. w \<in> A1 ==> (y,z) \<in> r2 ==> f w y = f w z)
1.265 +    ==> congruent2 r1 r2 f"
1.266 +  -- {* Suggested by John Harrison -- the two subproofs may be *}
1.267 +  -- {* \emph{much} simpler than the direct proof. *}
1.268 +  apply (unfold congruent2_def equiv_def refl_def)
1.269 +  apply clarify
1.270 +  apply (blast intro: trans)
1.271 +  done
1.272 +
1.273 +lemma congruent2_commuteI:
1.274 +  assumes equivA: "equiv A r"
1.275 +    and commute: "!!y z. y \<in> A ==> z \<in> A ==> f y z = f z y"
1.276 +    and congt: "!!y z w. w \<in> A ==> (y,z) \<in> r ==> f w y = f w z"
1.277 +  shows "f respects2 r"
1.278 +  apply (rule congruent2I [OF equivA equivA])
1.279 +   apply (rule commute [THEN trans])
1.280 +     apply (rule_tac  commute [THEN trans, symmetric])
1.281 +       apply (rule_tac  sym)
1.282 +       apply (assumption | rule congt |
1.283 +         erule equivA [THEN equiv_type, THEN subsetD, THEN SigmaE2])+
1.284 +  done
1.285 +
1.286 +
1.287 +subsection {* Cardinality results *}
1.288 +
1.289 +text {*Suggested by Florian Kamm�ller*}
1.290 +
1.291 +lemma finite_quotient: "finite A ==> r \<subseteq> A \<times> A ==> finite (A//r)"
1.292 +  -- {* recall @{thm equiv_type} *}
1.293 +  apply (rule finite_subset)
1.294 +   apply (erule_tac  finite_Pow_iff [THEN iffD2])
1.295 +  apply (unfold quotient_def)
1.296 +  apply blast
1.297 +  done
1.298 +
1.299 +lemma finite_equiv_class:
1.300 +  "finite A ==> r \<subseteq> A \<times> A ==> X \<in> A//r ==> finite X"
1.301 +  apply (unfold quotient_def)
1.302 +  apply (rule finite_subset)
1.303 +   prefer 2 apply assumption
1.304 +  apply blast
1.305 +  done
1.306 +
1.307 +lemma equiv_imp_dvd_card:
1.308 +  "finite A ==> equiv A r ==> \<forall>X \<in> A//r. k dvd card X
1.309 +    ==> k dvd card A"
1.310 +  apply (rule Union_quotient [THEN subst])
1.311 +   apply assumption
1.312 +  apply (rule dvd_partition)
1.313 +     prefer 4 apply (blast dest: quotient_disj)
1.314 +    apply (simp_all add: Union_quotient equiv_type finite_quotient)
1.315 +  done
1.316 +
1.317 +ML
1.318 +{*
1.319 +val UN_UN_split_split_eq = thm "UN_UN_split_split_eq";
1.320 +val UN_constant_eq = thm "UN_constant_eq";
1.321 +val UN_equiv_class = thm "UN_equiv_class";
1.322 +val UN_equiv_class2 = thm "UN_equiv_class2";
1.323 +val UN_equiv_class_inject = thm "UN_equiv_class_inject";
1.324 +val UN_equiv_class_type = thm "UN_equiv_class_type";
1.325 +val UN_equiv_class_type2 = thm "UN_equiv_class_type2";
1.326 +val Union_quotient = thm "Union_quotient";
1.327 +val comp_equivI = thm "comp_equivI";
1.328 +val congruent2I = thm "congruent2I";
1.329 +val congruent2_commuteI = thm "congruent2_commuteI";
1.330 +val congruent2_def = thm "congruent2_def";
1.331 +val congruent2_implies_congruent = thm "congruent2_implies_congruent";
1.332 +val congruent2_implies_congruent_UN = thm "congruent2_implies_congruent_UN";
1.333 +val congruent_def = thm "congruent_def";
1.334 +val eq_equiv_class = thm "eq_equiv_class";
1.335 +val eq_equiv_class_iff = thm "eq_equiv_class_iff";
1.336 +val equiv_class_eq = thm "equiv_class_eq";
1.337 +val equiv_class_eq_iff = thm "equiv_class_eq_iff";
1.338 +val equiv_class_nondisjoint = thm "equiv_class_nondisjoint";
1.339 +val equiv_class_self = thm "equiv_class_self";
1.340 +val equiv_comp_eq = thm "equiv_comp_eq";
1.341 +val equiv_def = thm "equiv_def";
1.342 +val equiv_imp_dvd_card = thm "equiv_imp_dvd_card";
1.343 +val equiv_type = thm "equiv_type";
1.344 +val finite_equiv_class = thm "finite_equiv_class";
1.345 +val finite_quotient = thm "finite_quotient";
1.346 +val quotientE = thm "quotientE";
1.347 +val quotientI = thm "quotientI";
1.348 +val quotient_def = thm "quotient_def";
1.349 +val quotient_disj = thm "quotient_disj";
1.350 +val refl_comp_subset = thm "refl_comp_subset";
1.351 +val subset_equiv_class = thm "subset_equiv_class";
1.352 +val sym_trans_comp_subset = thm "sym_trans_comp_subset";
1.353 +*}
1.354 +
1.355 +end

     2.1 --- a/src/HOL/Integ/Equiv.thy	Fri Nov 19 15:05:10 2004 +0100
2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
2.3 @@ -1,353 +0,0 @@
2.4 -(*  Title:      HOL/Integ/Equiv.thy
2.5 -    ID:         $Id$
2.6 -    Authors:    Lawrence C Paulson, Cambridge University Computer Laboratory
2.7 -    Copyright   1996  University of Cambridge
2.8 -*)
2.9 -
2.10 -header {* Equivalence relations in Higher-Order Set Theory *}
2.11 -
2.12 -theory Equiv
2.13 -imports Relation Finite_Set
2.14 -begin
2.15 -
2.16 -subsection {* Equivalence relations *}
2.17 -
2.18 -locale equiv =
2.19 -  fixes A and r
2.20 -  assumes refl: "refl A r"
2.21 -    and sym: "sym r"
2.22 -    and trans: "trans r"
2.23 -
2.24 -text {*
2.25 -  Suppes, Theorem 70: @{text r} is an equiv relation iff @{text "r\<inverse> O
2.26 -  r = r"}.
2.27 -
2.28 -  First half: @{text "equiv A r ==> r\<inverse> O r = r"}.
2.29 -*}
2.30 -
2.31 -lemma sym_trans_comp_subset:
2.32 -    "sym r ==> trans r ==> r\<inverse> O r \<subseteq> r"
2.33 -  by (unfold trans_def sym_def converse_def) blast
2.34 -
2.35 -lemma refl_comp_subset: "refl A r ==> r \<subseteq> r\<inverse> O r"
2.36 -  by (unfold refl_def) blast
2.37 -
2.38 -lemma equiv_comp_eq: "equiv A r ==> r\<inverse> O r = r"
2.39 -  apply (unfold equiv_def)
2.40 -  apply clarify
2.41 -  apply (rule equalityI)
2.42 -   apply (rules intro: sym_trans_comp_subset refl_comp_subset)+
2.43 -  done
2.44 -
2.45 -text {* Second half. *}
2.46 -
2.47 -lemma comp_equivI:
2.48 -    "r\<inverse> O r = r ==> Domain r = A ==> equiv A r"
2.49 -  apply (unfold equiv_def refl_def sym_def trans_def)
2.50 -  apply (erule equalityE)
2.51 -  apply (subgoal_tac "\<forall>x y. (x, y) \<in> r --> (y, x) \<in> r")
2.52 -   apply fast
2.53 -  apply fast
2.54 -  done
2.55 -
2.56 -
2.57 -subsection {* Equivalence classes *}
2.58 -
2.59 -lemma equiv_class_subset:
2.60 -  "equiv A r ==> (a, b) \<in> r ==> r{a} \<subseteq> r{b}"
2.61 -  -- {* lemma for the next result *}
2.62 -  by (unfold equiv_def trans_def sym_def) blast
2.63 -
2.64 -theorem equiv_class_eq: "equiv A r ==> (a, b) \<in> r ==> r{a} = r{b}"
2.65 -  apply (assumption | rule equalityI equiv_class_subset)+
2.66 -  apply (unfold equiv_def sym_def)
2.67 -  apply blast
2.68 -  done
2.69 -
2.70 -lemma equiv_class_self: "equiv A r ==> a \<in> A ==> a \<in> r{a}"
2.71 -  by (unfold equiv_def refl_def) blast
2.72 -
2.73 -lemma subset_equiv_class:
2.74 -    "equiv A r ==> r{b} \<subseteq> r{a} ==> b \<in> A ==> (a,b) \<in> r"
2.75 -  -- {* lemma for the next result *}
2.76 -  by (unfold equiv_def refl_def) blast
2.77 -
2.78 -lemma eq_equiv_class:
2.79 -    "r{a} = r{b} ==> equiv A r ==> b \<in> A ==> (a, b) \<in> r"
2.80 -  by (rules intro: equalityD2 subset_equiv_class)
2.81 -
2.82 -lemma equiv_class_nondisjoint:
2.83 -    "equiv A r ==> x \<in> (r{a} \<inter> r{b}) ==> (a, b) \<in> r"
2.84 -  by (unfold equiv_def trans_def sym_def) blast
2.85 -
2.86 -lemma equiv_type: "equiv A r ==> r \<subseteq> A \<times> A"
2.87 -  by (unfold equiv_def refl_def) blast
2.88 -
2.89 -theorem equiv_class_eq_iff:
2.90 -  "equiv A r ==> ((x, y) \<in> r) = (r{x} = r{y} & x \<in> A & y \<in> A)"
2.91 -  by (blast intro!: equiv_class_eq dest: eq_equiv_class equiv_type)
2.92 -
2.93 -theorem eq_equiv_class_iff:
2.94 -  "equiv A r ==> x \<in> A ==> y \<in> A ==> (r{x} = r{y}) = ((x, y) \<in> r)"
2.95 -  by (blast intro!: equiv_class_eq dest: eq_equiv_class equiv_type)
2.96 -
2.97 -
2.98 -subsection {* Quotients *}
2.99 -
2.100 -constdefs
2.101 -  quotient :: "['a set, ('a*'a) set] => 'a set set"  (infixl "'/'/" 90)
2.102 -  "A//r == \<Union>x \<in> A. {r{x}}"  -- {* set of equiv classes *}
2.103 -
2.104 -lemma quotientI: "x \<in> A ==> r{x} \<in> A//r"
2.105 -  by (unfold quotient_def) blast
2.106 -
2.107 -lemma quotientE:
2.108 -  "X \<in> A//r ==> (!!x. X = r{x} ==> x \<in> A ==> P) ==> P"
2.109 -  by (unfold quotient_def) blast
2.110 -
2.111 -lemma Union_quotient: "equiv A r ==> Union (A//r) = A"
2.112 -  by (unfold equiv_def refl_def quotient_def) blast
2.113 -
2.114 -lemma quotient_disj:
2.115 -  "equiv A r ==> X \<in> A//r ==> Y \<in> A//r ==> X = Y | (X \<inter> Y = {})"
2.116 -  apply (unfold quotient_def)
2.117 -  apply clarify
2.118 -  apply (rule equiv_class_eq)
2.119 -   apply assumption
2.120 -  apply (unfold equiv_def trans_def sym_def)
2.121 -  apply blast
2.122 -  done
2.123 -
2.124 -lemma quotient_eqI:
2.125 -  "[|equiv A r; X \<in> A//r; Y \<in> A//r; x \<in> X; y \<in> Y; (x,y) \<in> r|] ==> X = Y"
2.126 -  apply (clarify elim!: quotientE)
2.127 -  apply (rule equiv_class_eq, assumption)
2.128 -  apply (unfold equiv_def sym_def trans_def, blast)
2.129 -  done
2.130 -
2.131 -lemma quotient_eq_iff:
2.132 -  "[|equiv A r; X \<in> A//r; Y \<in> A//r; x \<in> X; y \<in> Y|] ==> (X = Y) = ((x,y) \<in> r)"
2.133 -  apply (rule iffI)
2.134 -   prefer 2 apply (blast del: equalityI intro: quotient_eqI)
2.135 -  apply (clarify elim!: quotientE)
2.136 -  apply (unfold equiv_def sym_def trans_def, blast)
2.137 -  done
2.138 -
2.139 -
2.140 -lemma quotient_empty [simp]: "{}//r = {}"
2.142 -
2.143 -lemma quotient_is_empty [iff]: "(A//r = {}) = (A = {})"
2.145 -
2.146 -lemma quotient_is_empty2 [iff]: "({} = A//r) = (A = {})"
2.148 -
2.149 -
2.150 -subsection {* Defining unary operations upon equivalence classes *}
2.151 -
2.152 -text{*A congruence-preserving function*}
2.153 -locale congruent =
2.154 -  fixes r and f
2.155 -  assumes congruent: "(y,z) \<in> r ==> f y = f z"
2.156 -
2.157 -syntax
2.158 -  RESPECTS ::"['a => 'b, ('a * 'a) set] => bool"  (infixr "respects" 80)
2.159 -
2.160 -translations
2.161 -  "f respects r" == "congruent r f"
2.162 -
2.163 -
2.164 -lemma UN_constant_eq: "a \<in> A ==> \<forall>y \<in> A. f y = c ==> (\<Union>y \<in> A. f(y))=c"
2.165 -  -- {* lemma required to prove @{text UN_equiv_class} *}
2.166 -  by auto
2.167 -
2.168 -lemma UN_equiv_class:
2.169 -  "equiv A r ==> f respects r ==> a \<in> A
2.170 -    ==> (\<Union>x \<in> r{a}. f x) = f a"
2.171 -  -- {* Conversion rule *}
2.172 -  apply (rule equiv_class_self [THEN UN_constant_eq], assumption+)
2.173 -  apply (unfold equiv_def congruent_def sym_def)
2.174 -  apply (blast del: equalityI)
2.175 -  done
2.176 -
2.177 -lemma UN_equiv_class_type:
2.178 -  "equiv A r ==> f respects r ==> X \<in> A//r ==>
2.179 -    (!!x. x \<in> A ==> f x \<in> B) ==> (\<Union>x \<in> X. f x) \<in> B"
2.180 -  apply (unfold quotient_def)
2.181 -  apply clarify
2.182 -  apply (subst UN_equiv_class)
2.183 -     apply auto
2.184 -  done
2.185 -
2.186 -text {*
2.187 -  Sufficient conditions for injectiveness.  Could weaken premises!
2.188 -  major premise could be an inclusion; bcong could be @{text "!!y. y \<in>
2.189 -  A ==> f y \<in> B"}.
2.190 -*}
2.191 -
2.192 -lemma UN_equiv_class_inject:
2.193 -  "equiv A r ==> f respects r ==>
2.194 -    (\<Union>x \<in> X. f x) = (\<Union>y \<in> Y. f y) ==> X \<in> A//r ==> Y \<in> A//r
2.195 -    ==> (!!x y. x \<in> A ==> y \<in> A ==> f x = f y ==> (x, y) \<in> r)
2.196 -    ==> X = Y"
2.197 -  apply (unfold quotient_def)
2.198 -  apply clarify
2.199 -  apply (rule equiv_class_eq)
2.200 -   apply assumption
2.201 -  apply (subgoal_tac "f x = f xa")
2.202 -   apply blast
2.203 -  apply (erule box_equals)
2.204 -   apply (assumption | rule UN_equiv_class)+
2.205 -  done
2.206 -
2.207 -
2.208 -subsection {* Defining binary operations upon equivalence classes *}
2.209 -
2.210 -text{*A congruence-preserving function of two arguments*}
2.211 -locale congruent2 =
2.212 -  fixes r1 and r2 and f
2.213 -  assumes congruent2:
2.214 -    "(y1,z1) \<in> r1 ==> (y2,z2) \<in> r2 ==> f y1 y2 = f z1 z2"
2.215 -
2.216 -text{*Abbreviation for the common case where the relations are identical*}
2.217 -syntax
2.218 -  RESPECTS2 ::"['a => 'b, ('a * 'a) set] => bool"  (infixr "respects2 " 80)
2.219 -
2.220 -translations
2.221 -  "f respects2 r" => "congruent2 r r f"
2.222 -
2.223 -lemma congruent2_implies_congruent:
2.224 -    "equiv A r1 ==> congruent2 r1 r2 f ==> a \<in> A ==> congruent r2 (f a)"
2.225 -  by (unfold congruent_def congruent2_def equiv_def refl_def) blast
2.226 -
2.227 -lemma congruent2_implies_congruent_UN:
2.228 -  "equiv A1 r1 ==> equiv A2 r2 ==> congruent2 r1 r2 f ==> a \<in> A2 ==>
2.229 -    congruent r1 (\<lambda>x1. \<Union>x2 \<in> r2{a}. f x1 x2)"
2.230 -  apply (unfold congruent_def)
2.231 -  apply clarify
2.232 -  apply (rule equiv_type [THEN subsetD, THEN SigmaE2], assumption+)
2.233 -  apply (simp add: UN_equiv_class congruent2_implies_congruent)
2.234 -  apply (unfold congruent2_def equiv_def refl_def)
2.235 -  apply (blast del: equalityI)
2.236 -  done
2.237 -
2.238 -lemma UN_equiv_class2:
2.239 -  "equiv A1 r1 ==> equiv A2 r2 ==> congruent2 r1 r2 f ==> a1 \<in> A1 ==> a2 \<in> A2
2.240 -    ==> (\<Union>x1 \<in> r1{a1}. \<Union>x2 \<in> r2{a2}. f x1 x2) = f a1 a2"
2.241 -  by (simp add: UN_equiv_class congruent2_implies_congruent
2.242 -    congruent2_implies_congruent_UN)
2.243 -
2.244 -lemma UN_equiv_class_type2:
2.245 -  "equiv A1 r1 ==> equiv A2 r2 ==> congruent2 r1 r2 f
2.246 -    ==> X1 \<in> A1//r1 ==> X2 \<in> A2//r2
2.247 -    ==> (!!x1 x2. x1 \<in> A1 ==> x2 \<in> A2 ==> f x1 x2 \<in> B)
2.248 -    ==> (\<Union>x1 \<in> X1. \<Union>x2 \<in> X2. f x1 x2) \<in> B"
2.249 -  apply (unfold quotient_def)
2.250 -  apply clarify
2.251 -  apply (blast intro: UN_equiv_class_type congruent2_implies_congruent_UN
2.252 -    congruent2_implies_congruent quotientI)
2.253 -  done
2.254 -
2.255 -lemma UN_UN_split_split_eq:
2.256 -  "(\<Union>(x1, x2) \<in> X. \<Union>(y1, y2) \<in> Y. A x1 x2 y1 y2) =
2.257 -    (\<Union>x \<in> X. \<Union>y \<in> Y. (\<lambda>(x1, x2). (\<lambda>(y1, y2). A x1 x2 y1 y2) y) x)"
2.258 -  -- {* Allows a natural expression of binary operators, *}
2.259 -  -- {* without explicit calls to @{text split} *}
2.260 -  by auto
2.261 -
2.262 -lemma congruent2I:
2.263 -  "equiv A1 r1 ==> equiv A2 r2
2.264 -    ==> (!!y z w. w \<in> A2 ==> (y,z) \<in> r1 ==> f y w = f z w)
2.265 -    ==> (!!y z w. w \<in> A1 ==> (y,z) \<in> r2 ==> f w y = f w z)
2.266 -    ==> congruent2 r1 r2 f"
2.267 -  -- {* Suggested by John Harrison -- the two subproofs may be *}
2.268 -  -- {* \emph{much} simpler than the direct proof. *}
2.269 -  apply (unfold congruent2_def equiv_def refl_def)
2.270 -  apply clarify
2.271 -  apply (blast intro: trans)
2.272 -  done
2.273 -
2.274 -lemma congruent2_commuteI:
2.275 -  assumes equivA: "equiv A r"
2.276 -    and commute: "!!y z. y \<in> A ==> z \<in> A ==> f y z = f z y"
2.277 -    and congt: "!!y z w. w \<in> A ==> (y,z) \<in> r ==> f w y = f w z"
2.278 -  shows "f respects2 r"
2.279 -  apply (rule congruent2I [OF equivA equivA])
2.280 -   apply (rule commute [THEN trans])
2.281 -     apply (rule_tac  commute [THEN trans, symmetric])
2.282 -       apply (rule_tac  sym)
2.283 -       apply (assumption | rule congt |
2.284 -         erule equivA [THEN equiv_type, THEN subsetD, THEN SigmaE2])+
2.285 -  done
2.286 -
2.287 -
2.288 -subsection {* Cardinality results *}
2.289 -
2.290 -text {*Suggested by Florian Kamm�ller*}
2.291 -
2.292 -lemma finite_quotient: "finite A ==> r \<subseteq> A \<times> A ==> finite (A//r)"
2.293 -  -- {* recall @{thm equiv_type} *}
2.294 -  apply (rule finite_subset)
2.295 -   apply (erule_tac  finite_Pow_iff [THEN iffD2])
2.296 -  apply (unfold quotient_def)
2.297 -  apply blast
2.298 -  done
2.299 -
2.300 -lemma finite_equiv_class:
2.301 -  "finite A ==> r \<subseteq> A \<times> A ==> X \<in> A//r ==> finite X"
2.302 -  apply (unfold quotient_def)
2.303 -  apply (rule finite_subset)
2.304 -   prefer 2 apply assumption
2.305 -  apply blast
2.306 -  done
2.307 -
2.308 -lemma equiv_imp_dvd_card:
2.309 -  "finite A ==> equiv A r ==> \<forall>X \<in> A//r. k dvd card X
2.310 -    ==> k dvd card A"
2.311 -  apply (rule Union_quotient [THEN subst])
2.312 -   apply assumption
2.313 -  apply (rule dvd_partition)
2.314 -     prefer 4 apply (blast dest: quotient_disj)
2.315 -    apply (simp_all add: Union_quotient equiv_type finite_quotient)
2.316 -  done
2.317 -
2.318 -ML
2.319 -{*
2.320 -val UN_UN_split_split_eq = thm "UN_UN_split_split_eq";
2.321 -val UN_constant_eq = thm "UN_constant_eq";
2.322 -val UN_equiv_class = thm "UN_equiv_class";
2.323 -val UN_equiv_class2 = thm "UN_equiv_class2";
2.324 -val UN_equiv_class_inject = thm "UN_equiv_class_inject";
2.325 -val UN_equiv_class_type = thm "UN_equiv_class_type";
2.326 -val UN_equiv_class_type2 = thm "UN_equiv_class_type2";
2.327 -val Union_quotient = thm "Union_quotient";
2.328 -val comp_equivI = thm "comp_equivI";
2.329 -val congruent2I = thm "congruent2I";
2.330 -val congruent2_commuteI = thm "congruent2_commuteI";
2.331 -val congruent2_def = thm "congruent2_def";
2.332 -val congruent2_implies_congruent = thm "congruent2_implies_congruent";
2.333 -val congruent2_implies_congruent_UN = thm "congruent2_implies_congruent_UN";
2.334 -val congruent_def = thm "congruent_def";
2.335 -val eq_equiv_class = thm "eq_equiv_class";
2.336 -val eq_equiv_class_iff = thm "eq_equiv_class_iff";
2.337 -val equiv_class_eq = thm "equiv_class_eq";
2.338 -val equiv_class_eq_iff = thm "equiv_class_eq_iff";
2.339 -val equiv_class_nondisjoint = thm "equiv_class_nondisjoint";
2.340 -val equiv_class_self = thm "equiv_class_self";
2.341 -val equiv_comp_eq = thm "equiv_comp_eq";
2.342 -val equiv_def = thm "equiv_def";
2.343 -val equiv_imp_dvd_card = thm "equiv_imp_dvd_card";
2.344 -val equiv_type = thm "equiv_type";
2.345 -val finite_equiv_class = thm "finite_equiv_class";
2.346 -val finite_quotient = thm "finite_quotient";
2.347 -val quotientE = thm "quotientE";
2.348 -val quotientI = thm "quotientI";
2.349 -val quotient_def = thm "quotient_def";
2.350 -val quotient_disj = thm "quotient_disj";
2.351 -val refl_comp_subset = thm "refl_comp_subset";
2.352 -val subset_equiv_class = thm "subset_equiv_class";
2.353 -val sym_trans_comp_subset = thm "sym_trans_comp_subset";
2.354 -*}
2.355 -
2.356 -end

     3.1 --- a/src/HOL/Integ/IntDef.thy	Fri Nov 19 15:05:10 2004 +0100
3.2 +++ b/src/HOL/Integ/IntDef.thy	Fri Nov 19 17:31:49 2004 +0100
3.3 @@ -8,7 +8,7 @@
3.4  header{*The Integers as Equivalence Classes over Pairs of Natural Numbers*}
3.5
3.6  theory IntDef
3.7 -imports Equiv NatArith
3.8 +imports Equiv_Relations NatArith
3.9  begin
3.10
3.11  constdefs

     4.1 --- a/src/HOL/IsaMakefile	Fri Nov 19 15:05:10 2004 +0100
4.2 +++ b/src/HOL/IsaMakefile	Fri Nov 19 17:31:49 2004 +0100
4.3 @@ -82,11 +82,11 @@
4.4    $(SRC)/TFL/tfl.ML$(SRC)/TFL/thms.ML $(SRC)/TFL/thry.ML \ 4.5$(SRC)/TFL/usyntax.ML \$(SRC)/TFL/utils.ML \
4.6    Datatype.thy Datatype_Universe.ML Datatype_Universe.thy \
4.7 -  Divides.thy Extraction.thy Finite_Set.ML Finite_Set.thy \
4.8 +  Divides.thy Equiv_Relations.thy Extraction.thy Finite_Set.ML Finite_Set.thy \
4.9    Fun.thy Gfp.ML Gfp.thy Hilbert_Choice.thy HOL.ML \
4.10    HOL.thy HOL_lemmas.ML Inductive.thy Infinite_Set.thy Integ/Numeral.thy \
4.11    Integ/cooper_dec.ML Integ/cooper_proof.ML \
4.12 -  Integ/Equiv.thy Integ/IntArith.thy Integ/IntDef.thy \
4.13 +  Integ/IntArith.thy Integ/IntDef.thy \
4.14    Integ/IntDiv.thy Integ/NatBin.thy Integ/NatSimprocs.thy Integ/Parity.thy \
4.15    Integ/int_arith1.ML Integ/int_factor_simprocs.ML Integ/nat_simprocs.ML \
4.16    Integ/Presburger.thy Integ/presburger.ML Integ/qelim.ML \