src/HOL/Equiv_Relations.thy
 changeset 15300 7dd5853a4812 child 15302 a643fcbc3468
     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