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.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