moved and renamed Integ/Equiv.thy
authorpaulson
Fri Nov 19 17:31:49 2004 +0100 (2004-11-19)
changeset 153007dd5853a4812
parent 15299 576fd0b65ed8
child 15301 26724034de5e
moved and renamed Integ/Equiv.thy
src/HOL/Equiv_Relations.thy
src/HOL/Integ/Equiv.thy
src/HOL/Integ/IntDef.thy
src/HOL/IsaMakefile
     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.140 +by(simp add: quotient_def)
   1.141 +
   1.142 +lemma quotient_is_empty [iff]: "(A//r = {}) = (A = {})"
   1.143 +by(simp add: quotient_def)
   1.144 +
   1.145 +lemma quotient_is_empty2 [iff]: "({} = A//r) = (A = {})"
   1.146 +by(simp add: quotient_def)
   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 [3] commute [THEN trans, symmetric])
   1.281 +       apply (rule_tac [5] 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 [2] 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.141 -by(simp add: quotient_def)
   2.142 -
   2.143 -lemma quotient_is_empty [iff]: "(A//r = {}) = (A = {})"
   2.144 -by(simp add: quotient_def)
   2.145 -
   2.146 -lemma quotient_is_empty2 [iff]: "({} = A//r) = (A = {})"
   2.147 -by(simp add: quotient_def)
   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 [3] commute [THEN trans, symmetric])
   2.282 -       apply (rule_tac [5] 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 [2] 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 \