merged
authorhaftmann
Thu Mar 11 17:39:45 2010 +0100 (2010-03-11)
changeset 35733b57070d54cd5
parent 35713 428284ee1465
parent 35732 3b17dff14c4f
child 35734 0e5ba3d3c265
merged
src/HOL/IsaMakefile
     1.1 --- a/NEWS	Thu Mar 11 16:56:22 2010 +0100
     1.2 +++ b/NEWS	Thu Mar 11 17:39:45 2010 +0100
     1.3 @@ -83,6 +83,9 @@
     1.4  
     1.5  *** HOL ***
     1.6  
     1.7 +* Split off theory Big_Operators containing setsum, setprod, Inf_fin, Sup_fin,
     1.8 +Min, Max from theory Finite_Set.  INCOMPATIBILITY.
     1.9 +
    1.10  * Theory "Rational" renamed to "Rat", for consistency with "Nat", "Int" etc.
    1.11  INCOMPATIBILITY.
    1.12  
    1.13 @@ -102,7 +105,7 @@
    1.14  
    1.15  INCOMPATIBILITY.
    1.16  
    1.17 -* Class division ring also requires proof of fact divide_inverse.  However instantiation
    1.18 +* Class division_ring also requires proof of fact divide_inverse.  However instantiation
    1.19  of parameter divide has also been required previously.  INCOMPATIBILITY.
    1.20  
    1.21  * More consistent naming of type classes involving orderings (and lattices):
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/HOL/Big_Operators.thy	Thu Mar 11 17:39:45 2010 +0100
     2.3 @@ -0,0 +1,1711 @@
     2.4 +(*  Title:      HOL/Big_Operators.thy
     2.5 +    Author:     Tobias Nipkow, Lawrence C Paulson and Markus Wenzel
     2.6 +                with contributions by Jeremy Avigad
     2.7 +*)
     2.8 +
     2.9 +header {* Big operators and finite (non-empty) sets *}
    2.10 +
    2.11 +theory Big_Operators
    2.12 +imports Plain
    2.13 +begin
    2.14 +
    2.15 +subsection {* Generalized summation over a set *}
    2.16 +
    2.17 +interpretation comm_monoid_add: comm_monoid_mult "op +" "0::'a::comm_monoid_add"
    2.18 +  proof qed (auto intro: add_assoc add_commute)
    2.19 +
    2.20 +definition setsum :: "('a => 'b) => 'a set => 'b::comm_monoid_add"
    2.21 +where "setsum f A == if finite A then fold_image (op +) f 0 A else 0"
    2.22 +
    2.23 +abbreviation
    2.24 +  Setsum  ("\<Sum>_" [1000] 999) where
    2.25 +  "\<Sum>A == setsum (%x. x) A"
    2.26 +
    2.27 +text{* Now: lot's of fancy syntax. First, @{term "setsum (%x. e) A"} is
    2.28 +written @{text"\<Sum>x\<in>A. e"}. *}
    2.29 +
    2.30 +syntax
    2.31 +  "_setsum" :: "pttrn => 'a set => 'b => 'b::comm_monoid_add"    ("(3SUM _:_. _)" [0, 51, 10] 10)
    2.32 +syntax (xsymbols)
    2.33 +  "_setsum" :: "pttrn => 'a set => 'b => 'b::comm_monoid_add"    ("(3\<Sum>_\<in>_. _)" [0, 51, 10] 10)
    2.34 +syntax (HTML output)
    2.35 +  "_setsum" :: "pttrn => 'a set => 'b => 'b::comm_monoid_add"    ("(3\<Sum>_\<in>_. _)" [0, 51, 10] 10)
    2.36 +
    2.37 +translations -- {* Beware of argument permutation! *}
    2.38 +  "SUM i:A. b" == "CONST setsum (%i. b) A"
    2.39 +  "\<Sum>i\<in>A. b" == "CONST setsum (%i. b) A"
    2.40 +
    2.41 +text{* Instead of @{term"\<Sum>x\<in>{x. P}. e"} we introduce the shorter
    2.42 + @{text"\<Sum>x|P. e"}. *}
    2.43 +
    2.44 +syntax
    2.45 +  "_qsetsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3SUM _ |/ _./ _)" [0,0,10] 10)
    2.46 +syntax (xsymbols)
    2.47 +  "_qsetsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3\<Sum>_ | (_)./ _)" [0,0,10] 10)
    2.48 +syntax (HTML output)
    2.49 +  "_qsetsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3\<Sum>_ | (_)./ _)" [0,0,10] 10)
    2.50 +
    2.51 +translations
    2.52 +  "SUM x|P. t" => "CONST setsum (%x. t) {x. P}"
    2.53 +  "\<Sum>x|P. t" => "CONST setsum (%x. t) {x. P}"
    2.54 +
    2.55 +print_translation {*
    2.56 +let
    2.57 +  fun setsum_tr' [Abs (x, Tx, t), Const (@{const_syntax Collect}, _) $ Abs (y, Ty, P)] =
    2.58 +        if x <> y then raise Match
    2.59 +        else
    2.60 +          let
    2.61 +            val x' = Syntax.mark_bound x;
    2.62 +            val t' = subst_bound (x', t);
    2.63 +            val P' = subst_bound (x', P);
    2.64 +          in Syntax.const @{syntax_const "_qsetsum"} $ Syntax.mark_bound x $ P' $ t' end
    2.65 +    | setsum_tr' _ = raise Match;
    2.66 +in [(@{const_syntax setsum}, setsum_tr')] end
    2.67 +*}
    2.68 +
    2.69 +
    2.70 +lemma setsum_empty [simp]: "setsum f {} = 0"
    2.71 +by (simp add: setsum_def)
    2.72 +
    2.73 +lemma setsum_insert [simp]:
    2.74 +  "finite F ==> a \<notin> F ==> setsum f (insert a F) = f a + setsum f F"
    2.75 +by (simp add: setsum_def)
    2.76 +
    2.77 +lemma setsum_infinite [simp]: "~ finite A ==> setsum f A = 0"
    2.78 +by (simp add: setsum_def)
    2.79 +
    2.80 +lemma setsum_reindex:
    2.81 +     "inj_on f B ==> setsum h (f ` B) = setsum (h \<circ> f) B"
    2.82 +by(auto simp add: setsum_def comm_monoid_add.fold_image_reindex dest!:finite_imageD)
    2.83 +
    2.84 +lemma setsum_reindex_id:
    2.85 +     "inj_on f B ==> setsum f B = setsum id (f ` B)"
    2.86 +by (auto simp add: setsum_reindex)
    2.87 +
    2.88 +lemma setsum_reindex_nonzero: 
    2.89 +  assumes fS: "finite S"
    2.90 +  and nz: "\<And> x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x \<noteq> y \<Longrightarrow> f x = f y \<Longrightarrow> h (f x) = 0"
    2.91 +  shows "setsum h (f ` S) = setsum (h o f) S"
    2.92 +using nz
    2.93 +proof(induct rule: finite_induct[OF fS])
    2.94 +  case 1 thus ?case by simp
    2.95 +next
    2.96 +  case (2 x F) 
    2.97 +  {assume fxF: "f x \<in> f ` F" hence "\<exists>y \<in> F . f y = f x" by auto
    2.98 +    then obtain y where y: "y \<in> F" "f x = f y" by auto 
    2.99 +    from "2.hyps" y have xy: "x \<noteq> y" by auto
   2.100 +    
   2.101 +    from "2.prems"[of x y] "2.hyps" xy y have h0: "h (f x) = 0" by simp
   2.102 +    have "setsum h (f ` insert x F) = setsum h (f ` F)" using fxF by auto
   2.103 +    also have "\<dots> = setsum (h o f) (insert x F)" 
   2.104 +      unfolding setsum_insert[OF `finite F` `x\<notin>F`]
   2.105 +      using h0 
   2.106 +      apply simp
   2.107 +      apply (rule "2.hyps"(3))
   2.108 +      apply (rule_tac y="y" in  "2.prems")
   2.109 +      apply simp_all
   2.110 +      done
   2.111 +    finally have ?case .}
   2.112 +  moreover
   2.113 +  {assume fxF: "f x \<notin> f ` F"
   2.114 +    have "setsum h (f ` insert x F) = h (f x) + setsum h (f ` F)" 
   2.115 +      using fxF "2.hyps" by simp 
   2.116 +    also have "\<dots> = setsum (h o f) (insert x F)"
   2.117 +      unfolding setsum_insert[OF `finite F` `x\<notin>F`]
   2.118 +      apply simp
   2.119 +      apply (rule cong[OF refl[of "op + (h (f x))"]])
   2.120 +      apply (rule "2.hyps"(3))
   2.121 +      apply (rule_tac y="y" in  "2.prems")
   2.122 +      apply simp_all
   2.123 +      done
   2.124 +    finally have ?case .}
   2.125 +  ultimately show ?case by blast
   2.126 +qed
   2.127 +
   2.128 +lemma setsum_cong:
   2.129 +  "A = B ==> (!!x. x:B ==> f x = g x) ==> setsum f A = setsum g B"
   2.130 +by(fastsimp simp: setsum_def intro: comm_monoid_add.fold_image_cong)
   2.131 +
   2.132 +lemma strong_setsum_cong[cong]:
   2.133 +  "A = B ==> (!!x. x:B =simp=> f x = g x)
   2.134 +   ==> setsum (%x. f x) A = setsum (%x. g x) B"
   2.135 +by(fastsimp simp: simp_implies_def setsum_def intro: comm_monoid_add.fold_image_cong)
   2.136 +
   2.137 +lemma setsum_cong2: "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setsum f A = setsum g A"
   2.138 +by (rule setsum_cong[OF refl], auto)
   2.139 +
   2.140 +lemma setsum_reindex_cong:
   2.141 +   "[|inj_on f A; B = f ` A; !!a. a:A \<Longrightarrow> g a = h (f a)|] 
   2.142 +    ==> setsum h B = setsum g A"
   2.143 +by (simp add: setsum_reindex cong: setsum_cong)
   2.144 +
   2.145 +
   2.146 +lemma setsum_0[simp]: "setsum (%i. 0) A = 0"
   2.147 +apply (clarsimp simp: setsum_def)
   2.148 +apply (erule finite_induct, auto)
   2.149 +done
   2.150 +
   2.151 +lemma setsum_0': "ALL a:A. f a = 0 ==> setsum f A = 0"
   2.152 +by(simp add:setsum_cong)
   2.153 +
   2.154 +lemma setsum_Un_Int: "finite A ==> finite B ==>
   2.155 +  setsum g (A Un B) + setsum g (A Int B) = setsum g A + setsum g B"
   2.156 +  -- {* The reversed orientation looks more natural, but LOOPS as a simprule! *}
   2.157 +by(simp add: setsum_def comm_monoid_add.fold_image_Un_Int [symmetric])
   2.158 +
   2.159 +lemma setsum_Un_disjoint: "finite A ==> finite B
   2.160 +  ==> A Int B = {} ==> setsum g (A Un B) = setsum g A + setsum g B"
   2.161 +by (subst setsum_Un_Int [symmetric], auto)
   2.162 +
   2.163 +lemma setsum_mono_zero_left: 
   2.164 +  assumes fT: "finite T" and ST: "S \<subseteq> T"
   2.165 +  and z: "\<forall>i \<in> T - S. f i = 0"
   2.166 +  shows "setsum f S = setsum f T"
   2.167 +proof-
   2.168 +  have eq: "T = S \<union> (T - S)" using ST by blast
   2.169 +  have d: "S \<inter> (T - S) = {}" using ST by blast
   2.170 +  from fT ST have f: "finite S" "finite (T - S)" by (auto intro: finite_subset)
   2.171 +  show ?thesis 
   2.172 +  by (simp add: setsum_Un_disjoint[OF f d, unfolded eq[symmetric]] setsum_0'[OF z])
   2.173 +qed
   2.174 +
   2.175 +lemma setsum_mono_zero_right: 
   2.176 +  "finite T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> \<forall>i \<in> T - S. f i = 0 \<Longrightarrow> setsum f T = setsum f S"
   2.177 +by(blast intro!: setsum_mono_zero_left[symmetric])
   2.178 +
   2.179 +lemma setsum_mono_zero_cong_left: 
   2.180 +  assumes fT: "finite T" and ST: "S \<subseteq> T"
   2.181 +  and z: "\<forall>i \<in> T - S. g i = 0"
   2.182 +  and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   2.183 +  shows "setsum f S = setsum g T"
   2.184 +proof-
   2.185 +  have eq: "T = S \<union> (T - S)" using ST by blast
   2.186 +  have d: "S \<inter> (T - S) = {}" using ST by blast
   2.187 +  from fT ST have f: "finite S" "finite (T - S)" by (auto intro: finite_subset)
   2.188 +  show ?thesis 
   2.189 +    using fg by (simp add: setsum_Un_disjoint[OF f d, unfolded eq[symmetric]] setsum_0'[OF z])
   2.190 +qed
   2.191 +
   2.192 +lemma setsum_mono_zero_cong_right: 
   2.193 +  assumes fT: "finite T" and ST: "S \<subseteq> T"
   2.194 +  and z: "\<forall>i \<in> T - S. f i = 0"
   2.195 +  and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   2.196 +  shows "setsum f T = setsum g S"
   2.197 +using setsum_mono_zero_cong_left[OF fT ST z] fg[symmetric] by auto 
   2.198 +
   2.199 +lemma setsum_delta: 
   2.200 +  assumes fS: "finite S"
   2.201 +  shows "setsum (\<lambda>k. if k=a then b k else 0) S = (if a \<in> S then b a else 0)"
   2.202 +proof-
   2.203 +  let ?f = "(\<lambda>k. if k=a then b k else 0)"
   2.204 +  {assume a: "a \<notin> S"
   2.205 +    hence "\<forall> k\<in> S. ?f k = 0" by simp
   2.206 +    hence ?thesis  using a by simp}
   2.207 +  moreover 
   2.208 +  {assume a: "a \<in> S"
   2.209 +    let ?A = "S - {a}"
   2.210 +    let ?B = "{a}"
   2.211 +    have eq: "S = ?A \<union> ?B" using a by blast 
   2.212 +    have dj: "?A \<inter> ?B = {}" by simp
   2.213 +    from fS have fAB: "finite ?A" "finite ?B" by auto  
   2.214 +    have "setsum ?f S = setsum ?f ?A + setsum ?f ?B"
   2.215 +      using setsum_Un_disjoint[OF fAB dj, of ?f, unfolded eq[symmetric]]
   2.216 +      by simp
   2.217 +    then have ?thesis  using a by simp}
   2.218 +  ultimately show ?thesis by blast
   2.219 +qed
   2.220 +lemma setsum_delta': 
   2.221 +  assumes fS: "finite S" shows 
   2.222 +  "setsum (\<lambda>k. if a = k then b k else 0) S = 
   2.223 +     (if a\<in> S then b a else 0)"
   2.224 +  using setsum_delta[OF fS, of a b, symmetric] 
   2.225 +  by (auto intro: setsum_cong)
   2.226 +
   2.227 +lemma setsum_restrict_set:
   2.228 +  assumes fA: "finite A"
   2.229 +  shows "setsum f (A \<inter> B) = setsum (\<lambda>x. if x \<in> B then f x else 0) A"
   2.230 +proof-
   2.231 +  from fA have fab: "finite (A \<inter> B)" by auto
   2.232 +  have aba: "A \<inter> B \<subseteq> A" by blast
   2.233 +  let ?g = "\<lambda>x. if x \<in> A\<inter>B then f x else 0"
   2.234 +  from setsum_mono_zero_left[OF fA aba, of ?g]
   2.235 +  show ?thesis by simp
   2.236 +qed
   2.237 +
   2.238 +lemma setsum_cases:
   2.239 +  assumes fA: "finite A"
   2.240 +  shows "setsum (\<lambda>x. if P x then f x else g x) A =
   2.241 +         setsum f (A \<inter> {x. P x}) + setsum g (A \<inter> - {x. P x})"
   2.242 +proof-
   2.243 +  have a: "A = A \<inter> {x. P x} \<union> A \<inter> -{x. P x}" 
   2.244 +          "(A \<inter> {x. P x}) \<inter> (A \<inter> -{x. P x}) = {}" 
   2.245 +    by blast+
   2.246 +  from fA 
   2.247 +  have f: "finite (A \<inter> {x. P x})" "finite (A \<inter> -{x. P x})" by auto
   2.248 +  let ?g = "\<lambda>x. if P x then f x else g x"
   2.249 +  from setsum_Un_disjoint[OF f a(2), of ?g] a(1)
   2.250 +  show ?thesis by simp
   2.251 +qed
   2.252 +
   2.253 +
   2.254 +(*But we can't get rid of finite I. If infinite, although the rhs is 0, 
   2.255 +  the lhs need not be, since UNION I A could still be finite.*)
   2.256 +lemma setsum_UN_disjoint:
   2.257 +    "finite I ==> (ALL i:I. finite (A i)) ==>
   2.258 +        (ALL i:I. ALL j:I. i \<noteq> j --> A i Int A j = {}) ==>
   2.259 +      setsum f (UNION I A) = (\<Sum>i\<in>I. setsum f (A i))"
   2.260 +by(simp add: setsum_def comm_monoid_add.fold_image_UN_disjoint cong: setsum_cong)
   2.261 +
   2.262 +text{*No need to assume that @{term C} is finite.  If infinite, the rhs is
   2.263 +directly 0, and @{term "Union C"} is also infinite, hence the lhs is also 0.*}
   2.264 +lemma setsum_Union_disjoint:
   2.265 +  "[| (ALL A:C. finite A);
   2.266 +      (ALL A:C. ALL B:C. A \<noteq> B --> A Int B = {}) |]
   2.267 +   ==> setsum f (Union C) = setsum (setsum f) C"
   2.268 +apply (cases "finite C") 
   2.269 + prefer 2 apply (force dest: finite_UnionD simp add: setsum_def)
   2.270 +  apply (frule setsum_UN_disjoint [of C id f])
   2.271 + apply (unfold Union_def id_def, assumption+)
   2.272 +done
   2.273 +
   2.274 +(*But we can't get rid of finite A. If infinite, although the lhs is 0, 
   2.275 +  the rhs need not be, since SIGMA A B could still be finite.*)
   2.276 +lemma setsum_Sigma: "finite A ==> ALL x:A. finite (B x) ==>
   2.277 +    (\<Sum>x\<in>A. (\<Sum>y\<in>B x. f x y)) = (\<Sum>(x,y)\<in>(SIGMA x:A. B x). f x y)"
   2.278 +by(simp add:setsum_def comm_monoid_add.fold_image_Sigma split_def cong:setsum_cong)
   2.279 +
   2.280 +text{*Here we can eliminate the finiteness assumptions, by cases.*}
   2.281 +lemma setsum_cartesian_product: 
   2.282 +   "(\<Sum>x\<in>A. (\<Sum>y\<in>B. f x y)) = (\<Sum>(x,y) \<in> A <*> B. f x y)"
   2.283 +apply (cases "finite A") 
   2.284 + apply (cases "finite B") 
   2.285 +  apply (simp add: setsum_Sigma)
   2.286 + apply (cases "A={}", simp)
   2.287 + apply (simp) 
   2.288 +apply (auto simp add: setsum_def
   2.289 +            dest: finite_cartesian_productD1 finite_cartesian_productD2) 
   2.290 +done
   2.291 +
   2.292 +lemma setsum_addf: "setsum (%x. f x + g x) A = (setsum f A + setsum g A)"
   2.293 +by(simp add:setsum_def comm_monoid_add.fold_image_distrib)
   2.294 +
   2.295 +
   2.296 +subsubsection {* Properties in more restricted classes of structures *}
   2.297 +
   2.298 +lemma setsum_SucD: "setsum f A = Suc n ==> EX a:A. 0 < f a"
   2.299 +apply (case_tac "finite A")
   2.300 + prefer 2 apply (simp add: setsum_def)
   2.301 +apply (erule rev_mp)
   2.302 +apply (erule finite_induct, auto)
   2.303 +done
   2.304 +
   2.305 +lemma setsum_eq_0_iff [simp]:
   2.306 +    "finite F ==> (setsum f F = 0) = (ALL a:F. f a = (0::nat))"
   2.307 +by (induct set: finite) auto
   2.308 +
   2.309 +lemma setsum_eq_Suc0_iff: "finite A \<Longrightarrow>
   2.310 +  (setsum f A = Suc 0) = (EX a:A. f a = Suc 0 & (ALL b:A. a\<noteq>b \<longrightarrow> f b = 0))"
   2.311 +apply(erule finite_induct)
   2.312 +apply (auto simp add:add_is_1)
   2.313 +done
   2.314 +
   2.315 +lemmas setsum_eq_1_iff = setsum_eq_Suc0_iff[simplified One_nat_def[symmetric]]
   2.316 +
   2.317 +lemma setsum_Un_nat: "finite A ==> finite B ==>
   2.318 +  (setsum f (A Un B) :: nat) = setsum f A + setsum f B - setsum f (A Int B)"
   2.319 +  -- {* For the natural numbers, we have subtraction. *}
   2.320 +by (subst setsum_Un_Int [symmetric], auto simp add: algebra_simps)
   2.321 +
   2.322 +lemma setsum_Un: "finite A ==> finite B ==>
   2.323 +  (setsum f (A Un B) :: 'a :: ab_group_add) =
   2.324 +   setsum f A + setsum f B - setsum f (A Int B)"
   2.325 +by (subst setsum_Un_Int [symmetric], auto simp add: algebra_simps)
   2.326 +
   2.327 +lemma (in comm_monoid_mult) fold_image_1: "finite S \<Longrightarrow> (\<forall>x\<in>S. f x = 1) \<Longrightarrow> fold_image op * f 1 S = 1"
   2.328 +  apply (induct set: finite)
   2.329 +  apply simp by auto
   2.330 +
   2.331 +lemma (in comm_monoid_mult) fold_image_Un_one:
   2.332 +  assumes fS: "finite S" and fT: "finite T"
   2.333 +  and I0: "\<forall>x \<in> S\<inter>T. f x = 1"
   2.334 +  shows "fold_image (op *) f 1 (S \<union> T) = fold_image (op *) f 1 S * fold_image (op *) f 1 T"
   2.335 +proof-
   2.336 +  have "fold_image op * f 1 (S \<inter> T) = 1" 
   2.337 +    apply (rule fold_image_1)
   2.338 +    using fS fT I0 by auto 
   2.339 +  with fold_image_Un_Int[OF fS fT] show ?thesis by simp
   2.340 +qed
   2.341 +
   2.342 +lemma setsum_eq_general_reverses:
   2.343 +  assumes fS: "finite S" and fT: "finite T"
   2.344 +  and kh: "\<And>y. y \<in> T \<Longrightarrow> k y \<in> S \<and> h (k y) = y"
   2.345 +  and hk: "\<And>x. x \<in> S \<Longrightarrow> h x \<in> T \<and> k (h x) = x \<and> g (h x) = f x"
   2.346 +  shows "setsum f S = setsum g T"
   2.347 +  apply (simp add: setsum_def fS fT)
   2.348 +  apply (rule comm_monoid_add.fold_image_eq_general_inverses[OF fS])
   2.349 +  apply (erule kh)
   2.350 +  apply (erule hk)
   2.351 +  done
   2.352 +
   2.353 +
   2.354 +
   2.355 +lemma setsum_Un_zero:  
   2.356 +  assumes fS: "finite S" and fT: "finite T"
   2.357 +  and I0: "\<forall>x \<in> S\<inter>T. f x = 0"
   2.358 +  shows "setsum f (S \<union> T) = setsum f S  + setsum f T"
   2.359 +  using fS fT
   2.360 +  apply (simp add: setsum_def)
   2.361 +  apply (rule comm_monoid_add.fold_image_Un_one)
   2.362 +  using I0 by auto
   2.363 +
   2.364 +
   2.365 +lemma setsum_UNION_zero: 
   2.366 +  assumes fS: "finite S" and fSS: "\<forall>T \<in> S. finite T"
   2.367 +  and f0: "\<And>T1 T2 x. T1\<in>S \<Longrightarrow> T2\<in>S \<Longrightarrow> T1 \<noteq> T2 \<Longrightarrow> x \<in> T1 \<Longrightarrow> x \<in> T2 \<Longrightarrow> f x = 0"
   2.368 +  shows "setsum f (\<Union>S) = setsum (\<lambda>T. setsum f T) S"
   2.369 +  using fSS f0
   2.370 +proof(induct rule: finite_induct[OF fS])
   2.371 +  case 1 thus ?case by simp
   2.372 +next
   2.373 +  case (2 T F)
   2.374 +  then have fTF: "finite T" "\<forall>T\<in>F. finite T" "finite F" and TF: "T \<notin> F" 
   2.375 +    and H: "setsum f (\<Union> F) = setsum (setsum f) F" by auto
   2.376 +  from fTF have fUF: "finite (\<Union>F)" by auto
   2.377 +  from "2.prems" TF fTF
   2.378 +  show ?case 
   2.379 +    by (auto simp add: H[symmetric] intro: setsum_Un_zero[OF fTF(1) fUF, of f])
   2.380 +qed
   2.381 +
   2.382 +
   2.383 +lemma setsum_diff1_nat: "(setsum f (A - {a}) :: nat) =
   2.384 +  (if a:A then setsum f A - f a else setsum f A)"
   2.385 +apply (case_tac "finite A")
   2.386 + prefer 2 apply (simp add: setsum_def)
   2.387 +apply (erule finite_induct)
   2.388 + apply (auto simp add: insert_Diff_if)
   2.389 +apply (drule_tac a = a in mk_disjoint_insert, auto)
   2.390 +done
   2.391 +
   2.392 +lemma setsum_diff1: "finite A \<Longrightarrow>
   2.393 +  (setsum f (A - {a}) :: ('a::ab_group_add)) =
   2.394 +  (if a:A then setsum f A - f a else setsum f A)"
   2.395 +by (erule finite_induct) (auto simp add: insert_Diff_if)
   2.396 +
   2.397 +lemma setsum_diff1'[rule_format]:
   2.398 +  "finite A \<Longrightarrow> a \<in> A \<longrightarrow> (\<Sum> x \<in> A. f x) = f a + (\<Sum> x \<in> (A - {a}). f x)"
   2.399 +apply (erule finite_induct[where F=A and P="% A. (a \<in> A \<longrightarrow> (\<Sum> x \<in> A. f x) = f a + (\<Sum> x \<in> (A - {a}). f x))"])
   2.400 +apply (auto simp add: insert_Diff_if add_ac)
   2.401 +done
   2.402 +
   2.403 +lemma setsum_diff1_ring: assumes "finite A" "a \<in> A"
   2.404 +  shows "setsum f (A - {a}) = setsum f A - (f a::'a::ring)"
   2.405 +unfolding setsum_diff1'[OF assms] by auto
   2.406 +
   2.407 +(* By Jeremy Siek: *)
   2.408 +
   2.409 +lemma setsum_diff_nat: 
   2.410 +assumes "finite B" and "B \<subseteq> A"
   2.411 +shows "(setsum f (A - B) :: nat) = (setsum f A) - (setsum f B)"
   2.412 +using assms
   2.413 +proof induct
   2.414 +  show "setsum f (A - {}) = (setsum f A) - (setsum f {})" by simp
   2.415 +next
   2.416 +  fix F x assume finF: "finite F" and xnotinF: "x \<notin> F"
   2.417 +    and xFinA: "insert x F \<subseteq> A"
   2.418 +    and IH: "F \<subseteq> A \<Longrightarrow> setsum f (A - F) = setsum f A - setsum f F"
   2.419 +  from xnotinF xFinA have xinAF: "x \<in> (A - F)" by simp
   2.420 +  from xinAF have A: "setsum f ((A - F) - {x}) = setsum f (A - F) - f x"
   2.421 +    by (simp add: setsum_diff1_nat)
   2.422 +  from xFinA have "F \<subseteq> A" by simp
   2.423 +  with IH have "setsum f (A - F) = setsum f A - setsum f F" by simp
   2.424 +  with A have B: "setsum f ((A - F) - {x}) = setsum f A - setsum f F - f x"
   2.425 +    by simp
   2.426 +  from xnotinF have "A - insert x F = (A - F) - {x}" by auto
   2.427 +  with B have C: "setsum f (A - insert x F) = setsum f A - setsum f F - f x"
   2.428 +    by simp
   2.429 +  from finF xnotinF have "setsum f (insert x F) = setsum f F + f x" by simp
   2.430 +  with C have "setsum f (A - insert x F) = setsum f A - setsum f (insert x F)"
   2.431 +    by simp
   2.432 +  thus "setsum f (A - insert x F) = setsum f A - setsum f (insert x F)" by simp
   2.433 +qed
   2.434 +
   2.435 +lemma setsum_diff:
   2.436 +  assumes le: "finite A" "B \<subseteq> A"
   2.437 +  shows "setsum f (A - B) = setsum f A - ((setsum f B)::('a::ab_group_add))"
   2.438 +proof -
   2.439 +  from le have finiteB: "finite B" using finite_subset by auto
   2.440 +  show ?thesis using finiteB le
   2.441 +  proof induct
   2.442 +    case empty
   2.443 +    thus ?case by auto
   2.444 +  next
   2.445 +    case (insert x F)
   2.446 +    thus ?case using le finiteB 
   2.447 +      by (simp add: Diff_insert[where a=x and B=F] setsum_diff1 insert_absorb)
   2.448 +  qed
   2.449 +qed
   2.450 +
   2.451 +lemma setsum_mono:
   2.452 +  assumes le: "\<And>i. i\<in>K \<Longrightarrow> f (i::'a) \<le> ((g i)::('b::{comm_monoid_add, ordered_ab_semigroup_add}))"
   2.453 +  shows "(\<Sum>i\<in>K. f i) \<le> (\<Sum>i\<in>K. g i)"
   2.454 +proof (cases "finite K")
   2.455 +  case True
   2.456 +  thus ?thesis using le
   2.457 +  proof induct
   2.458 +    case empty
   2.459 +    thus ?case by simp
   2.460 +  next
   2.461 +    case insert
   2.462 +    thus ?case using add_mono by fastsimp
   2.463 +  qed
   2.464 +next
   2.465 +  case False
   2.466 +  thus ?thesis
   2.467 +    by (simp add: setsum_def)
   2.468 +qed
   2.469 +
   2.470 +lemma setsum_strict_mono:
   2.471 +  fixes f :: "'a \<Rightarrow> 'b::{ordered_cancel_ab_semigroup_add,comm_monoid_add}"
   2.472 +  assumes "finite A"  "A \<noteq> {}"
   2.473 +    and "!!x. x:A \<Longrightarrow> f x < g x"
   2.474 +  shows "setsum f A < setsum g A"
   2.475 +  using prems
   2.476 +proof (induct rule: finite_ne_induct)
   2.477 +  case singleton thus ?case by simp
   2.478 +next
   2.479 +  case insert thus ?case by (auto simp: add_strict_mono)
   2.480 +qed
   2.481 +
   2.482 +lemma setsum_negf:
   2.483 +  "setsum (%x. - (f x)::'a::ab_group_add) A = - setsum f A"
   2.484 +proof (cases "finite A")
   2.485 +  case True thus ?thesis by (induct set: finite) auto
   2.486 +next
   2.487 +  case False thus ?thesis by (simp add: setsum_def)
   2.488 +qed
   2.489 +
   2.490 +lemma setsum_subtractf:
   2.491 +  "setsum (%x. ((f x)::'a::ab_group_add) - g x) A =
   2.492 +    setsum f A - setsum g A"
   2.493 +proof (cases "finite A")
   2.494 +  case True thus ?thesis by (simp add: diff_minus setsum_addf setsum_negf)
   2.495 +next
   2.496 +  case False thus ?thesis by (simp add: setsum_def)
   2.497 +qed
   2.498 +
   2.499 +lemma setsum_nonneg:
   2.500 +  assumes nn: "\<forall>x\<in>A. (0::'a::{ordered_ab_semigroup_add,comm_monoid_add}) \<le> f x"
   2.501 +  shows "0 \<le> setsum f A"
   2.502 +proof (cases "finite A")
   2.503 +  case True thus ?thesis using nn
   2.504 +  proof induct
   2.505 +    case empty then show ?case by simp
   2.506 +  next
   2.507 +    case (insert x F)
   2.508 +    then have "0 + 0 \<le> f x + setsum f F" by (blast intro: add_mono)
   2.509 +    with insert show ?case by simp
   2.510 +  qed
   2.511 +next
   2.512 +  case False thus ?thesis by (simp add: setsum_def)
   2.513 +qed
   2.514 +
   2.515 +lemma setsum_nonpos:
   2.516 +  assumes np: "\<forall>x\<in>A. f x \<le> (0::'a::{ordered_ab_semigroup_add,comm_monoid_add})"
   2.517 +  shows "setsum f A \<le> 0"
   2.518 +proof (cases "finite A")
   2.519 +  case True thus ?thesis using np
   2.520 +  proof induct
   2.521 +    case empty then show ?case by simp
   2.522 +  next
   2.523 +    case (insert x F)
   2.524 +    then have "f x + setsum f F \<le> 0 + 0" by (blast intro: add_mono)
   2.525 +    with insert show ?case by simp
   2.526 +  qed
   2.527 +next
   2.528 +  case False thus ?thesis by (simp add: setsum_def)
   2.529 +qed
   2.530 +
   2.531 +lemma setsum_mono2:
   2.532 +fixes f :: "'a \<Rightarrow> 'b :: {ordered_ab_semigroup_add_imp_le,comm_monoid_add}"
   2.533 +assumes fin: "finite B" and sub: "A \<subseteq> B" and nn: "\<And>b. b \<in> B-A \<Longrightarrow> 0 \<le> f b"
   2.534 +shows "setsum f A \<le> setsum f B"
   2.535 +proof -
   2.536 +  have "setsum f A \<le> setsum f A + setsum f (B-A)"
   2.537 +    by(simp add: add_increasing2[OF setsum_nonneg] nn Ball_def)
   2.538 +  also have "\<dots> = setsum f (A \<union> (B-A))" using fin finite_subset[OF sub fin]
   2.539 +    by (simp add:setsum_Un_disjoint del:Un_Diff_cancel)
   2.540 +  also have "A \<union> (B-A) = B" using sub by blast
   2.541 +  finally show ?thesis .
   2.542 +qed
   2.543 +
   2.544 +lemma setsum_mono3: "finite B ==> A <= B ==> 
   2.545 +    ALL x: B - A. 
   2.546 +      0 <= ((f x)::'a::{comm_monoid_add,ordered_ab_semigroup_add}) ==>
   2.547 +        setsum f A <= setsum f B"
   2.548 +  apply (subgoal_tac "setsum f B = setsum f A + setsum f (B - A)")
   2.549 +  apply (erule ssubst)
   2.550 +  apply (subgoal_tac "setsum f A + 0 <= setsum f A + setsum f (B - A)")
   2.551 +  apply simp
   2.552 +  apply (rule add_left_mono)
   2.553 +  apply (erule setsum_nonneg)
   2.554 +  apply (subst setsum_Un_disjoint [THEN sym])
   2.555 +  apply (erule finite_subset, assumption)
   2.556 +  apply (rule finite_subset)
   2.557 +  prefer 2
   2.558 +  apply assumption
   2.559 +  apply (auto simp add: sup_absorb2)
   2.560 +done
   2.561 +
   2.562 +lemma setsum_right_distrib: 
   2.563 +  fixes f :: "'a => ('b::semiring_0)"
   2.564 +  shows "r * setsum f A = setsum (%n. r * f n) A"
   2.565 +proof (cases "finite A")
   2.566 +  case True
   2.567 +  thus ?thesis
   2.568 +  proof induct
   2.569 +    case empty thus ?case by simp
   2.570 +  next
   2.571 +    case (insert x A) thus ?case by (simp add: right_distrib)
   2.572 +  qed
   2.573 +next
   2.574 +  case False thus ?thesis by (simp add: setsum_def)
   2.575 +qed
   2.576 +
   2.577 +lemma setsum_left_distrib:
   2.578 +  "setsum f A * (r::'a::semiring_0) = (\<Sum>n\<in>A. f n * r)"
   2.579 +proof (cases "finite A")
   2.580 +  case True
   2.581 +  then show ?thesis
   2.582 +  proof induct
   2.583 +    case empty thus ?case by simp
   2.584 +  next
   2.585 +    case (insert x A) thus ?case by (simp add: left_distrib)
   2.586 +  qed
   2.587 +next
   2.588 +  case False thus ?thesis by (simp add: setsum_def)
   2.589 +qed
   2.590 +
   2.591 +lemma setsum_divide_distrib:
   2.592 +  "setsum f A / (r::'a::field) = (\<Sum>n\<in>A. f n / r)"
   2.593 +proof (cases "finite A")
   2.594 +  case True
   2.595 +  then show ?thesis
   2.596 +  proof induct
   2.597 +    case empty thus ?case by simp
   2.598 +  next
   2.599 +    case (insert x A) thus ?case by (simp add: add_divide_distrib)
   2.600 +  qed
   2.601 +next
   2.602 +  case False thus ?thesis by (simp add: setsum_def)
   2.603 +qed
   2.604 +
   2.605 +lemma setsum_abs[iff]: 
   2.606 +  fixes f :: "'a => ('b::ordered_ab_group_add_abs)"
   2.607 +  shows "abs (setsum f A) \<le> setsum (%i. abs(f i)) A"
   2.608 +proof (cases "finite A")
   2.609 +  case True
   2.610 +  thus ?thesis
   2.611 +  proof induct
   2.612 +    case empty thus ?case by simp
   2.613 +  next
   2.614 +    case (insert x A)
   2.615 +    thus ?case by (auto intro: abs_triangle_ineq order_trans)
   2.616 +  qed
   2.617 +next
   2.618 +  case False thus ?thesis by (simp add: setsum_def)
   2.619 +qed
   2.620 +
   2.621 +lemma setsum_abs_ge_zero[iff]: 
   2.622 +  fixes f :: "'a => ('b::ordered_ab_group_add_abs)"
   2.623 +  shows "0 \<le> setsum (%i. abs(f i)) A"
   2.624 +proof (cases "finite A")
   2.625 +  case True
   2.626 +  thus ?thesis
   2.627 +  proof induct
   2.628 +    case empty thus ?case by simp
   2.629 +  next
   2.630 +    case (insert x A) thus ?case by (auto simp: add_nonneg_nonneg)
   2.631 +  qed
   2.632 +next
   2.633 +  case False thus ?thesis by (simp add: setsum_def)
   2.634 +qed
   2.635 +
   2.636 +lemma abs_setsum_abs[simp]: 
   2.637 +  fixes f :: "'a => ('b::ordered_ab_group_add_abs)"
   2.638 +  shows "abs (\<Sum>a\<in>A. abs(f a)) = (\<Sum>a\<in>A. abs(f a))"
   2.639 +proof (cases "finite A")
   2.640 +  case True
   2.641 +  thus ?thesis
   2.642 +  proof induct
   2.643 +    case empty thus ?case by simp
   2.644 +  next
   2.645 +    case (insert a A)
   2.646 +    hence "\<bar>\<Sum>a\<in>insert a A. \<bar>f a\<bar>\<bar> = \<bar>\<bar>f a\<bar> + (\<Sum>a\<in>A. \<bar>f a\<bar>)\<bar>" by simp
   2.647 +    also have "\<dots> = \<bar>\<bar>f a\<bar> + \<bar>\<Sum>a\<in>A. \<bar>f a\<bar>\<bar>\<bar>"  using insert by simp
   2.648 +    also have "\<dots> = \<bar>f a\<bar> + \<bar>\<Sum>a\<in>A. \<bar>f a\<bar>\<bar>"
   2.649 +      by (simp del: abs_of_nonneg)
   2.650 +    also have "\<dots> = (\<Sum>a\<in>insert a A. \<bar>f a\<bar>)" using insert by simp
   2.651 +    finally show ?case .
   2.652 +  qed
   2.653 +next
   2.654 +  case False thus ?thesis by (simp add: setsum_def)
   2.655 +qed
   2.656 +
   2.657 +
   2.658 +lemma setsum_Plus:
   2.659 +  fixes A :: "'a set" and B :: "'b set"
   2.660 +  assumes fin: "finite A" "finite B"
   2.661 +  shows "setsum f (A <+> B) = setsum (f \<circ> Inl) A + setsum (f \<circ> Inr) B"
   2.662 +proof -
   2.663 +  have "A <+> B = Inl ` A \<union> Inr ` B" by auto
   2.664 +  moreover from fin have "finite (Inl ` A :: ('a + 'b) set)" "finite (Inr ` B :: ('a + 'b) set)"
   2.665 +    by(auto intro: finite_imageI)
   2.666 +  moreover have "Inl ` A \<inter> Inr ` B = ({} :: ('a + 'b) set)" by auto
   2.667 +  moreover have "inj_on (Inl :: 'a \<Rightarrow> 'a + 'b) A" "inj_on (Inr :: 'b \<Rightarrow> 'a + 'b) B" by(auto intro: inj_onI)
   2.668 +  ultimately show ?thesis using fin by(simp add: setsum_Un_disjoint setsum_reindex)
   2.669 +qed
   2.670 +
   2.671 +
   2.672 +text {* Commuting outer and inner summation *}
   2.673 +
   2.674 +lemma swap_inj_on:
   2.675 +  "inj_on (%(i, j). (j, i)) (A \<times> B)"
   2.676 +  by (unfold inj_on_def) fast
   2.677 +
   2.678 +lemma swap_product:
   2.679 +  "(%(i, j). (j, i)) ` (A \<times> B) = B \<times> A"
   2.680 +  by (simp add: split_def image_def) blast
   2.681 +
   2.682 +lemma setsum_commute:
   2.683 +  "(\<Sum>i\<in>A. \<Sum>j\<in>B. f i j) = (\<Sum>j\<in>B. \<Sum>i\<in>A. f i j)"
   2.684 +proof (simp add: setsum_cartesian_product)
   2.685 +  have "(\<Sum>(x,y) \<in> A <*> B. f x y) =
   2.686 +    (\<Sum>(y,x) \<in> (%(i, j). (j, i)) ` (A \<times> B). f x y)"
   2.687 +    (is "?s = _")
   2.688 +    apply (simp add: setsum_reindex [where f = "%(i, j). (j, i)"] swap_inj_on)
   2.689 +    apply (simp add: split_def)
   2.690 +    done
   2.691 +  also have "... = (\<Sum>(y,x)\<in>B \<times> A. f x y)"
   2.692 +    (is "_ = ?t")
   2.693 +    apply (simp add: swap_product)
   2.694 +    done
   2.695 +  finally show "?s = ?t" .
   2.696 +qed
   2.697 +
   2.698 +lemma setsum_product:
   2.699 +  fixes f :: "'a => ('b::semiring_0)"
   2.700 +  shows "setsum f A * setsum g B = (\<Sum>i\<in>A. \<Sum>j\<in>B. f i * g j)"
   2.701 +  by (simp add: setsum_right_distrib setsum_left_distrib) (rule setsum_commute)
   2.702 +
   2.703 +lemma setsum_mult_setsum_if_inj:
   2.704 +fixes f :: "'a => ('b::semiring_0)"
   2.705 +shows "inj_on (%(a,b). f a * g b) (A \<times> B) ==>
   2.706 +  setsum f A * setsum g B = setsum id {f a * g b|a b. a:A & b:B}"
   2.707 +by(auto simp: setsum_product setsum_cartesian_product
   2.708 +        intro!:  setsum_reindex_cong[symmetric])
   2.709 +
   2.710 +lemma setsum_constant [simp]: "(\<Sum>x \<in> A. y) = of_nat(card A) * y"
   2.711 +apply (cases "finite A")
   2.712 +apply (erule finite_induct)
   2.713 +apply (auto simp add: algebra_simps)
   2.714 +done
   2.715 +
   2.716 +lemma setsum_bounded:
   2.717 +  assumes le: "\<And>i. i\<in>A \<Longrightarrow> f i \<le> (K::'a::{semiring_1, ordered_ab_semigroup_add})"
   2.718 +  shows "setsum f A \<le> of_nat(card A) * K"
   2.719 +proof (cases "finite A")
   2.720 +  case True
   2.721 +  thus ?thesis using le setsum_mono[where K=A and g = "%x. K"] by simp
   2.722 +next
   2.723 +  case False thus ?thesis by (simp add: setsum_def)
   2.724 +qed
   2.725 +
   2.726 +
   2.727 +subsubsection {* Cardinality as special case of @{const setsum} *}
   2.728 +
   2.729 +lemma card_eq_setsum:
   2.730 +  "card A = setsum (\<lambda>x. 1) A"
   2.731 +  by (simp only: card_def setsum_def)
   2.732 +
   2.733 +lemma card_UN_disjoint:
   2.734 +  "finite I ==> (ALL i:I. finite (A i)) ==>
   2.735 +   (ALL i:I. ALL j:I. i \<noteq> j --> A i Int A j = {})
   2.736 +   ==> card (UNION I A) = (\<Sum>i\<in>I. card(A i))"
   2.737 +apply (simp add: card_eq_setsum del: setsum_constant)
   2.738 +apply (subgoal_tac
   2.739 +         "setsum (%i. card (A i)) I = setsum (%i. (setsum (%x. 1) (A i))) I")
   2.740 +apply (simp add: setsum_UN_disjoint del: setsum_constant)
   2.741 +apply (simp cong: setsum_cong)
   2.742 +done
   2.743 +
   2.744 +lemma card_Union_disjoint:
   2.745 +  "finite C ==> (ALL A:C. finite A) ==>
   2.746 +   (ALL A:C. ALL B:C. A \<noteq> B --> A Int B = {})
   2.747 +   ==> card (Union C) = setsum card C"
   2.748 +apply (frule card_UN_disjoint [of C id])
   2.749 +apply (unfold Union_def id_def, assumption+)
   2.750 +done
   2.751 +
   2.752 +text{*The image of a finite set can be expressed using @{term fold_image}.*}
   2.753 +lemma image_eq_fold_image:
   2.754 +  "finite A ==> f ` A = fold_image (op Un) (%x. {f x}) {} A"
   2.755 +proof (induct rule: finite_induct)
   2.756 +  case empty then show ?case by simp
   2.757 +next
   2.758 +  interpret ab_semigroup_mult "op Un"
   2.759 +    proof qed auto
   2.760 +  case insert 
   2.761 +  then show ?case by simp
   2.762 +qed
   2.763 +
   2.764 +subsubsection {* Cardinality of products *}
   2.765 +
   2.766 +lemma card_SigmaI [simp]:
   2.767 +  "\<lbrakk> finite A; ALL a:A. finite (B a) \<rbrakk>
   2.768 +  \<Longrightarrow> card (SIGMA x: A. B x) = (\<Sum>a\<in>A. card (B a))"
   2.769 +by(simp add: card_eq_setsum setsum_Sigma del:setsum_constant)
   2.770 +
   2.771 +(*
   2.772 +lemma SigmaI_insert: "y \<notin> A ==>
   2.773 +  (SIGMA x:(insert y A). B x) = (({y} <*> (B y)) \<union> (SIGMA x: A. B x))"
   2.774 +  by auto
   2.775 +*)
   2.776 +
   2.777 +lemma card_cartesian_product: "card (A <*> B) = card(A) * card(B)"
   2.778 +  by (cases "finite A \<and> finite B")
   2.779 +    (auto simp add: card_eq_0_iff dest: finite_cartesian_productD1 finite_cartesian_productD2)
   2.780 +
   2.781 +lemma card_cartesian_product_singleton:  "card({x} <*> A) = card(A)"
   2.782 +by (simp add: card_cartesian_product)
   2.783 +
   2.784 +
   2.785 +subsection {* Generalized product over a set *}
   2.786 +
   2.787 +definition setprod :: "('a => 'b) => 'a set => 'b::comm_monoid_mult"
   2.788 +where "setprod f A == if finite A then fold_image (op *) f 1 A else 1"
   2.789 +
   2.790 +abbreviation
   2.791 +  Setprod  ("\<Prod>_" [1000] 999) where
   2.792 +  "\<Prod>A == setprod (%x. x) A"
   2.793 +
   2.794 +syntax
   2.795 +  "_setprod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult"  ("(3PROD _:_. _)" [0, 51, 10] 10)
   2.796 +syntax (xsymbols)
   2.797 +  "_setprod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult"  ("(3\<Prod>_\<in>_. _)" [0, 51, 10] 10)
   2.798 +syntax (HTML output)
   2.799 +  "_setprod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult"  ("(3\<Prod>_\<in>_. _)" [0, 51, 10] 10)
   2.800 +
   2.801 +translations -- {* Beware of argument permutation! *}
   2.802 +  "PROD i:A. b" == "CONST setprod (%i. b) A" 
   2.803 +  "\<Prod>i\<in>A. b" == "CONST setprod (%i. b) A" 
   2.804 +
   2.805 +text{* Instead of @{term"\<Prod>x\<in>{x. P}. e"} we introduce the shorter
   2.806 + @{text"\<Prod>x|P. e"}. *}
   2.807 +
   2.808 +syntax
   2.809 +  "_qsetprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3PROD _ |/ _./ _)" [0,0,10] 10)
   2.810 +syntax (xsymbols)
   2.811 +  "_qsetprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3\<Prod>_ | (_)./ _)" [0,0,10] 10)
   2.812 +syntax (HTML output)
   2.813 +  "_qsetprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3\<Prod>_ | (_)./ _)" [0,0,10] 10)
   2.814 +
   2.815 +translations
   2.816 +  "PROD x|P. t" => "CONST setprod (%x. t) {x. P}"
   2.817 +  "\<Prod>x|P. t" => "CONST setprod (%x. t) {x. P}"
   2.818 +
   2.819 +
   2.820 +lemma setprod_empty [simp]: "setprod f {} = 1"
   2.821 +by (auto simp add: setprod_def)
   2.822 +
   2.823 +lemma setprod_insert [simp]: "[| finite A; a \<notin> A |] ==>
   2.824 +    setprod f (insert a A) = f a * setprod f A"
   2.825 +by (simp add: setprod_def)
   2.826 +
   2.827 +lemma setprod_infinite [simp]: "~ finite A ==> setprod f A = 1"
   2.828 +by (simp add: setprod_def)
   2.829 +
   2.830 +lemma setprod_reindex:
   2.831 +   "inj_on f B ==> setprod h (f ` B) = setprod (h \<circ> f) B"
   2.832 +by(auto simp: setprod_def fold_image_reindex dest!:finite_imageD)
   2.833 +
   2.834 +lemma setprod_reindex_id: "inj_on f B ==> setprod f B = setprod id (f ` B)"
   2.835 +by (auto simp add: setprod_reindex)
   2.836 +
   2.837 +lemma setprod_cong:
   2.838 +  "A = B ==> (!!x. x:B ==> f x = g x) ==> setprod f A = setprod g B"
   2.839 +by(fastsimp simp: setprod_def intro: fold_image_cong)
   2.840 +
   2.841 +lemma strong_setprod_cong[cong]:
   2.842 +  "A = B ==> (!!x. x:B =simp=> f x = g x) ==> setprod f A = setprod g B"
   2.843 +by(fastsimp simp: simp_implies_def setprod_def intro: fold_image_cong)
   2.844 +
   2.845 +lemma setprod_reindex_cong: "inj_on f A ==>
   2.846 +    B = f ` A ==> g = h \<circ> f ==> setprod h B = setprod g A"
   2.847 +by (frule setprod_reindex, simp)
   2.848 +
   2.849 +lemma strong_setprod_reindex_cong: assumes i: "inj_on f A"
   2.850 +  and B: "B = f ` A" and eq: "\<And>x. x \<in> A \<Longrightarrow> g x = (h \<circ> f) x"
   2.851 +  shows "setprod h B = setprod g A"
   2.852 +proof-
   2.853 +    have "setprod h B = setprod (h o f) A"
   2.854 +      by (simp add: B setprod_reindex[OF i, of h])
   2.855 +    then show ?thesis apply simp
   2.856 +      apply (rule setprod_cong)
   2.857 +      apply simp
   2.858 +      by (simp add: eq)
   2.859 +qed
   2.860 +
   2.861 +lemma setprod_Un_one:  
   2.862 +  assumes fS: "finite S" and fT: "finite T"
   2.863 +  and I0: "\<forall>x \<in> S\<inter>T. f x = 1"
   2.864 +  shows "setprod f (S \<union> T) = setprod f S  * setprod f T"
   2.865 +  using fS fT
   2.866 +  apply (simp add: setprod_def)
   2.867 +  apply (rule fold_image_Un_one)
   2.868 +  using I0 by auto
   2.869 +
   2.870 +
   2.871 +lemma setprod_1: "setprod (%i. 1) A = 1"
   2.872 +apply (case_tac "finite A")
   2.873 +apply (erule finite_induct, auto simp add: mult_ac)
   2.874 +done
   2.875 +
   2.876 +lemma setprod_1': "ALL a:F. f a = 1 ==> setprod f F = 1"
   2.877 +apply (subgoal_tac "setprod f F = setprod (%x. 1) F")
   2.878 +apply (erule ssubst, rule setprod_1)
   2.879 +apply (rule setprod_cong, auto)
   2.880 +done
   2.881 +
   2.882 +lemma setprod_Un_Int: "finite A ==> finite B
   2.883 +    ==> setprod g (A Un B) * setprod g (A Int B) = setprod g A * setprod g B"
   2.884 +by(simp add: setprod_def fold_image_Un_Int[symmetric])
   2.885 +
   2.886 +lemma setprod_Un_disjoint: "finite A ==> finite B
   2.887 +  ==> A Int B = {} ==> setprod g (A Un B) = setprod g A * setprod g B"
   2.888 +by (subst setprod_Un_Int [symmetric], auto)
   2.889 +
   2.890 +lemma setprod_mono_one_left: 
   2.891 +  assumes fT: "finite T" and ST: "S \<subseteq> T"
   2.892 +  and z: "\<forall>i \<in> T - S. f i = 1"
   2.893 +  shows "setprod f S = setprod f T"
   2.894 +proof-
   2.895 +  have eq: "T = S \<union> (T - S)" using ST by blast
   2.896 +  have d: "S \<inter> (T - S) = {}" using ST by blast
   2.897 +  from fT ST have f: "finite S" "finite (T - S)" by (auto intro: finite_subset)
   2.898 +  show ?thesis
   2.899 +  by (simp add: setprod_Un_disjoint[OF f d, unfolded eq[symmetric]] setprod_1'[OF z])
   2.900 +qed
   2.901 +
   2.902 +lemmas setprod_mono_one_right = setprod_mono_one_left [THEN sym]
   2.903 +
   2.904 +lemma setprod_delta: 
   2.905 +  assumes fS: "finite S"
   2.906 +  shows "setprod (\<lambda>k. if k=a then b k else 1) S = (if a \<in> S then b a else 1)"
   2.907 +proof-
   2.908 +  let ?f = "(\<lambda>k. if k=a then b k else 1)"
   2.909 +  {assume a: "a \<notin> S"
   2.910 +    hence "\<forall> k\<in> S. ?f k = 1" by simp
   2.911 +    hence ?thesis  using a by (simp add: setprod_1 cong add: setprod_cong) }
   2.912 +  moreover 
   2.913 +  {assume a: "a \<in> S"
   2.914 +    let ?A = "S - {a}"
   2.915 +    let ?B = "{a}"
   2.916 +    have eq: "S = ?A \<union> ?B" using a by blast 
   2.917 +    have dj: "?A \<inter> ?B = {}" by simp
   2.918 +    from fS have fAB: "finite ?A" "finite ?B" by auto  
   2.919 +    have fA1: "setprod ?f ?A = 1" apply (rule setprod_1') by auto
   2.920 +    have "setprod ?f ?A * setprod ?f ?B = setprod ?f S"
   2.921 +      using setprod_Un_disjoint[OF fAB dj, of ?f, unfolded eq[symmetric]]
   2.922 +      by simp
   2.923 +    then have ?thesis  using a by (simp add: fA1 cong add: setprod_cong cong del: if_weak_cong)}
   2.924 +  ultimately show ?thesis by blast
   2.925 +qed
   2.926 +
   2.927 +lemma setprod_delta': 
   2.928 +  assumes fS: "finite S" shows 
   2.929 +  "setprod (\<lambda>k. if a = k then b k else 1) S = 
   2.930 +     (if a\<in> S then b a else 1)"
   2.931 +  using setprod_delta[OF fS, of a b, symmetric] 
   2.932 +  by (auto intro: setprod_cong)
   2.933 +
   2.934 +
   2.935 +lemma setprod_UN_disjoint:
   2.936 +    "finite I ==> (ALL i:I. finite (A i)) ==>
   2.937 +        (ALL i:I. ALL j:I. i \<noteq> j --> A i Int A j = {}) ==>
   2.938 +      setprod f (UNION I A) = setprod (%i. setprod f (A i)) I"
   2.939 +by(simp add: setprod_def fold_image_UN_disjoint cong: setprod_cong)
   2.940 +
   2.941 +lemma setprod_Union_disjoint:
   2.942 +  "[| (ALL A:C. finite A);
   2.943 +      (ALL A:C. ALL B:C. A \<noteq> B --> A Int B = {}) |] 
   2.944 +   ==> setprod f (Union C) = setprod (setprod f) C"
   2.945 +apply (cases "finite C") 
   2.946 + prefer 2 apply (force dest: finite_UnionD simp add: setprod_def)
   2.947 +  apply (frule setprod_UN_disjoint [of C id f])
   2.948 + apply (unfold Union_def id_def, assumption+)
   2.949 +done
   2.950 +
   2.951 +lemma setprod_Sigma: "finite A ==> ALL x:A. finite (B x) ==>
   2.952 +    (\<Prod>x\<in>A. (\<Prod>y\<in> B x. f x y)) =
   2.953 +    (\<Prod>(x,y)\<in>(SIGMA x:A. B x). f x y)"
   2.954 +by(simp add:setprod_def fold_image_Sigma split_def cong:setprod_cong)
   2.955 +
   2.956 +text{*Here we can eliminate the finiteness assumptions, by cases.*}
   2.957 +lemma setprod_cartesian_product: 
   2.958 +     "(\<Prod>x\<in>A. (\<Prod>y\<in> B. f x y)) = (\<Prod>(x,y)\<in>(A <*> B). f x y)"
   2.959 +apply (cases "finite A") 
   2.960 + apply (cases "finite B") 
   2.961 +  apply (simp add: setprod_Sigma)
   2.962 + apply (cases "A={}", simp)
   2.963 + apply (simp add: setprod_1) 
   2.964 +apply (auto simp add: setprod_def
   2.965 +            dest: finite_cartesian_productD1 finite_cartesian_productD2) 
   2.966 +done
   2.967 +
   2.968 +lemma setprod_timesf:
   2.969 +     "setprod (%x. f x * g x) A = (setprod f A * setprod g A)"
   2.970 +by(simp add:setprod_def fold_image_distrib)
   2.971 +
   2.972 +
   2.973 +subsubsection {* Properties in more restricted classes of structures *}
   2.974 +
   2.975 +lemma setprod_eq_1_iff [simp]:
   2.976 +  "finite F ==> (setprod f F = 1) = (ALL a:F. f a = (1::nat))"
   2.977 +by (induct set: finite) auto
   2.978 +
   2.979 +lemma setprod_zero:
   2.980 +     "finite A ==> EX x: A. f x = (0::'a::comm_semiring_1) ==> setprod f A = 0"
   2.981 +apply (induct set: finite, force, clarsimp)
   2.982 +apply (erule disjE, auto)
   2.983 +done
   2.984 +
   2.985 +lemma setprod_nonneg [rule_format]:
   2.986 +   "(ALL x: A. (0::'a::linordered_semidom) \<le> f x) --> 0 \<le> setprod f A"
   2.987 +by (cases "finite A", induct set: finite, simp_all add: mult_nonneg_nonneg)
   2.988 +
   2.989 +lemma setprod_pos [rule_format]: "(ALL x: A. (0::'a::linordered_semidom) < f x)
   2.990 +  --> 0 < setprod f A"
   2.991 +by (cases "finite A", induct set: finite, simp_all add: mult_pos_pos)
   2.992 +
   2.993 +lemma setprod_zero_iff[simp]: "finite A ==> 
   2.994 +  (setprod f A = (0::'a::{comm_semiring_1,no_zero_divisors})) =
   2.995 +  (EX x: A. f x = 0)"
   2.996 +by (erule finite_induct, auto simp:no_zero_divisors)
   2.997 +
   2.998 +lemma setprod_pos_nat:
   2.999 +  "finite S ==> (ALL x : S. f x > (0::nat)) ==> setprod f S > 0"
  2.1000 +using setprod_zero_iff by(simp del:neq0_conv add:neq0_conv[symmetric])
  2.1001 +
  2.1002 +lemma setprod_pos_nat_iff[simp]:
  2.1003 +  "finite S ==> (setprod f S > 0) = (ALL x : S. f x > (0::nat))"
  2.1004 +using setprod_zero_iff by(simp del:neq0_conv add:neq0_conv[symmetric])
  2.1005 +
  2.1006 +lemma setprod_Un: "finite A ==> finite B ==> (ALL x: A Int B. f x \<noteq> 0) ==>
  2.1007 +  (setprod f (A Un B) :: 'a ::{field})
  2.1008 +   = setprod f A * setprod f B / setprod f (A Int B)"
  2.1009 +by (subst setprod_Un_Int [symmetric], auto)
  2.1010 +
  2.1011 +lemma setprod_diff1: "finite A ==> f a \<noteq> 0 ==>
  2.1012 +  (setprod f (A - {a}) :: 'a :: {field}) =
  2.1013 +  (if a:A then setprod f A / f a else setprod f A)"
  2.1014 +by (erule finite_induct) (auto simp add: insert_Diff_if)
  2.1015 +
  2.1016 +lemma setprod_inversef: 
  2.1017 +  fixes f :: "'b \<Rightarrow> 'a::{field,division_by_zero}"
  2.1018 +  shows "finite A ==> setprod (inverse \<circ> f) A = inverse (setprod f A)"
  2.1019 +by (erule finite_induct) auto
  2.1020 +
  2.1021 +lemma setprod_dividef:
  2.1022 +  fixes f :: "'b \<Rightarrow> 'a::{field,division_by_zero}"
  2.1023 +  shows "finite A
  2.1024 +    ==> setprod (%x. f x / g x) A = setprod f A / setprod g A"
  2.1025 +apply (subgoal_tac
  2.1026 +         "setprod (%x. f x / g x) A = setprod (%x. f x * (inverse \<circ> g) x) A")
  2.1027 +apply (erule ssubst)
  2.1028 +apply (subst divide_inverse)
  2.1029 +apply (subst setprod_timesf)
  2.1030 +apply (subst setprod_inversef, assumption+, rule refl)
  2.1031 +apply (rule setprod_cong, rule refl)
  2.1032 +apply (subst divide_inverse, auto)
  2.1033 +done
  2.1034 +
  2.1035 +lemma setprod_dvd_setprod [rule_format]: 
  2.1036 +    "(ALL x : A. f x dvd g x) \<longrightarrow> setprod f A dvd setprod g A"
  2.1037 +  apply (cases "finite A")
  2.1038 +  apply (induct set: finite)
  2.1039 +  apply (auto simp add: dvd_def)
  2.1040 +  apply (rule_tac x = "k * ka" in exI)
  2.1041 +  apply (simp add: algebra_simps)
  2.1042 +done
  2.1043 +
  2.1044 +lemma setprod_dvd_setprod_subset:
  2.1045 +  "finite B \<Longrightarrow> A <= B \<Longrightarrow> setprod f A dvd setprod f B"
  2.1046 +  apply (subgoal_tac "setprod f B = setprod f A * setprod f (B - A)")
  2.1047 +  apply (unfold dvd_def, blast)
  2.1048 +  apply (subst setprod_Un_disjoint [symmetric])
  2.1049 +  apply (auto elim: finite_subset intro: setprod_cong)
  2.1050 +done
  2.1051 +
  2.1052 +lemma setprod_dvd_setprod_subset2:
  2.1053 +  "finite B \<Longrightarrow> A <= B \<Longrightarrow> ALL x : A. (f x::'a::comm_semiring_1) dvd g x \<Longrightarrow> 
  2.1054 +      setprod f A dvd setprod g B"
  2.1055 +  apply (rule dvd_trans)
  2.1056 +  apply (rule setprod_dvd_setprod, erule (1) bspec)
  2.1057 +  apply (erule (1) setprod_dvd_setprod_subset)
  2.1058 +done
  2.1059 +
  2.1060 +lemma dvd_setprod: "finite A \<Longrightarrow> i:A \<Longrightarrow> 
  2.1061 +    (f i ::'a::comm_semiring_1) dvd setprod f A"
  2.1062 +by (induct set: finite) (auto intro: dvd_mult)
  2.1063 +
  2.1064 +lemma dvd_setsum [rule_format]: "(ALL i : A. d dvd f i) \<longrightarrow> 
  2.1065 +    (d::'a::comm_semiring_1) dvd (SUM x : A. f x)"
  2.1066 +  apply (cases "finite A")
  2.1067 +  apply (induct set: finite)
  2.1068 +  apply auto
  2.1069 +done
  2.1070 +
  2.1071 +lemma setprod_mono:
  2.1072 +  fixes f :: "'a \<Rightarrow> 'b\<Colon>linordered_semidom"
  2.1073 +  assumes "\<forall>i\<in>A. 0 \<le> f i \<and> f i \<le> g i"
  2.1074 +  shows "setprod f A \<le> setprod g A"
  2.1075 +proof (cases "finite A")
  2.1076 +  case True
  2.1077 +  hence ?thesis "setprod f A \<ge> 0" using subset_refl[of A]
  2.1078 +  proof (induct A rule: finite_subset_induct)
  2.1079 +    case (insert a F)
  2.1080 +    thus "setprod f (insert a F) \<le> setprod g (insert a F)" "0 \<le> setprod f (insert a F)"
  2.1081 +      unfolding setprod_insert[OF insert(1,3)]
  2.1082 +      using assms[rule_format,OF insert(2)] insert
  2.1083 +      by (auto intro: mult_mono mult_nonneg_nonneg)
  2.1084 +  qed auto
  2.1085 +  thus ?thesis by simp
  2.1086 +qed auto
  2.1087 +
  2.1088 +lemma abs_setprod:
  2.1089 +  fixes f :: "'a \<Rightarrow> 'b\<Colon>{linordered_field,abs}"
  2.1090 +  shows "abs (setprod f A) = setprod (\<lambda>x. abs (f x)) A"
  2.1091 +proof (cases "finite A")
  2.1092 +  case True thus ?thesis
  2.1093 +    by induct (auto simp add: field_simps abs_mult)
  2.1094 +qed auto
  2.1095 +
  2.1096 +lemma setprod_constant: "finite A ==> (\<Prod>x\<in> A. (y::'a::{comm_monoid_mult})) = y^(card A)"
  2.1097 +apply (erule finite_induct)
  2.1098 +apply auto
  2.1099 +done
  2.1100 +
  2.1101 +lemma setprod_gen_delta:
  2.1102 +  assumes fS: "finite S"
  2.1103 +  shows "setprod (\<lambda>k. if k=a then b k else c) S = (if a \<in> S then (b a ::'a::{comm_monoid_mult}) * c^ (card S - 1) else c^ card S)"
  2.1104 +proof-
  2.1105 +  let ?f = "(\<lambda>k. if k=a then b k else c)"
  2.1106 +  {assume a: "a \<notin> S"
  2.1107 +    hence "\<forall> k\<in> S. ?f k = c" by simp
  2.1108 +    hence ?thesis  using a setprod_constant[OF fS, of c] by (simp add: setprod_1 cong add: setprod_cong) }
  2.1109 +  moreover 
  2.1110 +  {assume a: "a \<in> S"
  2.1111 +    let ?A = "S - {a}"
  2.1112 +    let ?B = "{a}"
  2.1113 +    have eq: "S = ?A \<union> ?B" using a by blast 
  2.1114 +    have dj: "?A \<inter> ?B = {}" by simp
  2.1115 +    from fS have fAB: "finite ?A" "finite ?B" by auto  
  2.1116 +    have fA0:"setprod ?f ?A = setprod (\<lambda>i. c) ?A"
  2.1117 +      apply (rule setprod_cong) by auto
  2.1118 +    have cA: "card ?A = card S - 1" using fS a by auto
  2.1119 +    have fA1: "setprod ?f ?A = c ^ card ?A"  unfolding fA0 apply (rule setprod_constant) using fS by auto
  2.1120 +    have "setprod ?f ?A * setprod ?f ?B = setprod ?f S"
  2.1121 +      using setprod_Un_disjoint[OF fAB dj, of ?f, unfolded eq[symmetric]]
  2.1122 +      by simp
  2.1123 +    then have ?thesis using a cA
  2.1124 +      by (simp add: fA1 ring_simps cong add: setprod_cong cong del: if_weak_cong)}
  2.1125 +  ultimately show ?thesis by blast
  2.1126 +qed
  2.1127 +
  2.1128 +
  2.1129 +subsubsection {* Fold1 in lattices with @{const inf} and @{const sup} *}
  2.1130 +
  2.1131 +text{*
  2.1132 +  As an application of @{text fold1} we define infimum
  2.1133 +  and supremum in (not necessarily complete!) lattices
  2.1134 +  over (non-empty) sets by means of @{text fold1}.
  2.1135 +*}
  2.1136 +
  2.1137 +context semilattice_inf
  2.1138 +begin
  2.1139 +
  2.1140 +lemma below_fold1_iff:
  2.1141 +  assumes "finite A" "A \<noteq> {}"
  2.1142 +  shows "x \<le> fold1 inf A \<longleftrightarrow> (\<forall>a\<in>A. x \<le> a)"
  2.1143 +proof -
  2.1144 +  interpret ab_semigroup_idem_mult inf
  2.1145 +    by (rule ab_semigroup_idem_mult_inf)
  2.1146 +  show ?thesis using assms by (induct rule: finite_ne_induct) simp_all
  2.1147 +qed
  2.1148 +
  2.1149 +lemma fold1_belowI:
  2.1150 +  assumes "finite A"
  2.1151 +    and "a \<in> A"
  2.1152 +  shows "fold1 inf A \<le> a"
  2.1153 +proof -
  2.1154 +  from assms have "A \<noteq> {}" by auto
  2.1155 +  from `finite A` `A \<noteq> {}` `a \<in> A` show ?thesis
  2.1156 +  proof (induct rule: finite_ne_induct)
  2.1157 +    case singleton thus ?case by simp
  2.1158 +  next
  2.1159 +    interpret ab_semigroup_idem_mult inf
  2.1160 +      by (rule ab_semigroup_idem_mult_inf)
  2.1161 +    case (insert x F)
  2.1162 +    from insert(5) have "a = x \<or> a \<in> F" by simp
  2.1163 +    thus ?case
  2.1164 +    proof
  2.1165 +      assume "a = x" thus ?thesis using insert
  2.1166 +        by (simp add: mult_ac)
  2.1167 +    next
  2.1168 +      assume "a \<in> F"
  2.1169 +      hence bel: "fold1 inf F \<le> a" by (rule insert)
  2.1170 +      have "inf (fold1 inf (insert x F)) a = inf x (inf (fold1 inf F) a)"
  2.1171 +        using insert by (simp add: mult_ac)
  2.1172 +      also have "inf (fold1 inf F) a = fold1 inf F"
  2.1173 +        using bel by (auto intro: antisym)
  2.1174 +      also have "inf x \<dots> = fold1 inf (insert x F)"
  2.1175 +        using insert by (simp add: mult_ac)
  2.1176 +      finally have aux: "inf (fold1 inf (insert x F)) a = fold1 inf (insert x F)" .
  2.1177 +      moreover have "inf (fold1 inf (insert x F)) a \<le> a" by simp
  2.1178 +      ultimately show ?thesis by simp
  2.1179 +    qed
  2.1180 +  qed
  2.1181 +qed
  2.1182 +
  2.1183 +end
  2.1184 +
  2.1185 +context lattice
  2.1186 +begin
  2.1187 +
  2.1188 +definition
  2.1189 +  Inf_fin :: "'a set \<Rightarrow> 'a" ("\<Sqinter>\<^bsub>fin\<^esub>_" [900] 900)
  2.1190 +where
  2.1191 +  "Inf_fin = fold1 inf"
  2.1192 +
  2.1193 +definition
  2.1194 +  Sup_fin :: "'a set \<Rightarrow> 'a" ("\<Squnion>\<^bsub>fin\<^esub>_" [900] 900)
  2.1195 +where
  2.1196 +  "Sup_fin = fold1 sup"
  2.1197 +
  2.1198 +lemma Inf_le_Sup [simp]: "\<lbrakk> finite A; A \<noteq> {} \<rbrakk> \<Longrightarrow> \<Sqinter>\<^bsub>fin\<^esub>A \<le> \<Squnion>\<^bsub>fin\<^esub>A"
  2.1199 +apply(unfold Sup_fin_def Inf_fin_def)
  2.1200 +apply(subgoal_tac "EX a. a:A")
  2.1201 +prefer 2 apply blast
  2.1202 +apply(erule exE)
  2.1203 +apply(rule order_trans)
  2.1204 +apply(erule (1) fold1_belowI)
  2.1205 +apply(erule (1) semilattice_inf.fold1_belowI [OF dual_semilattice])
  2.1206 +done
  2.1207 +
  2.1208 +lemma sup_Inf_absorb [simp]:
  2.1209 +  "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> sup a (\<Sqinter>\<^bsub>fin\<^esub>A) = a"
  2.1210 +apply(subst sup_commute)
  2.1211 +apply(simp add: Inf_fin_def sup_absorb2 fold1_belowI)
  2.1212 +done
  2.1213 +
  2.1214 +lemma inf_Sup_absorb [simp]:
  2.1215 +  "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> inf a (\<Squnion>\<^bsub>fin\<^esub>A) = a"
  2.1216 +by (simp add: Sup_fin_def inf_absorb1
  2.1217 +  semilattice_inf.fold1_belowI [OF dual_semilattice])
  2.1218 +
  2.1219 +end
  2.1220 +
  2.1221 +context distrib_lattice
  2.1222 +begin
  2.1223 +
  2.1224 +lemma sup_Inf1_distrib:
  2.1225 +  assumes "finite A"
  2.1226 +    and "A \<noteq> {}"
  2.1227 +  shows "sup x (\<Sqinter>\<^bsub>fin\<^esub>A) = \<Sqinter>\<^bsub>fin\<^esub>{sup x a|a. a \<in> A}"
  2.1228 +proof -
  2.1229 +  interpret ab_semigroup_idem_mult inf
  2.1230 +    by (rule ab_semigroup_idem_mult_inf)
  2.1231 +  from assms show ?thesis
  2.1232 +    by (simp add: Inf_fin_def image_def
  2.1233 +      hom_fold1_commute [where h="sup x", OF sup_inf_distrib1])
  2.1234 +        (rule arg_cong [where f="fold1 inf"], blast)
  2.1235 +qed
  2.1236 +
  2.1237 +lemma sup_Inf2_distrib:
  2.1238 +  assumes A: "finite A" "A \<noteq> {}" and B: "finite B" "B \<noteq> {}"
  2.1239 +  shows "sup (\<Sqinter>\<^bsub>fin\<^esub>A) (\<Sqinter>\<^bsub>fin\<^esub>B) = \<Sqinter>\<^bsub>fin\<^esub>{sup a b|a b. a \<in> A \<and> b \<in> B}"
  2.1240 +using A proof (induct rule: finite_ne_induct)
  2.1241 +  case singleton thus ?case
  2.1242 +    by (simp add: sup_Inf1_distrib [OF B] fold1_singleton_def [OF Inf_fin_def])
  2.1243 +next
  2.1244 +  interpret ab_semigroup_idem_mult inf
  2.1245 +    by (rule ab_semigroup_idem_mult_inf)
  2.1246 +  case (insert x A)
  2.1247 +  have finB: "finite {sup x b |b. b \<in> B}"
  2.1248 +    by(rule finite_surj[where f = "sup x", OF B(1)], auto)
  2.1249 +  have finAB: "finite {sup a b |a b. a \<in> A \<and> b \<in> B}"
  2.1250 +  proof -
  2.1251 +    have "{sup a b |a b. a \<in> A \<and> b \<in> B} = (UN a:A. UN b:B. {sup a b})"
  2.1252 +      by blast
  2.1253 +    thus ?thesis by(simp add: insert(1) B(1))
  2.1254 +  qed
  2.1255 +  have ne: "{sup a b |a b. a \<in> A \<and> b \<in> B} \<noteq> {}" using insert B by blast
  2.1256 +  have "sup (\<Sqinter>\<^bsub>fin\<^esub>(insert x A)) (\<Sqinter>\<^bsub>fin\<^esub>B) = sup (inf x (\<Sqinter>\<^bsub>fin\<^esub>A)) (\<Sqinter>\<^bsub>fin\<^esub>B)"
  2.1257 +    using insert by (simp add: fold1_insert_idem_def [OF Inf_fin_def])
  2.1258 +  also have "\<dots> = inf (sup x (\<Sqinter>\<^bsub>fin\<^esub>B)) (sup (\<Sqinter>\<^bsub>fin\<^esub>A) (\<Sqinter>\<^bsub>fin\<^esub>B))" by(rule sup_inf_distrib2)
  2.1259 +  also have "\<dots> = inf (\<Sqinter>\<^bsub>fin\<^esub>{sup x b|b. b \<in> B}) (\<Sqinter>\<^bsub>fin\<^esub>{sup a b|a b. a \<in> A \<and> b \<in> B})"
  2.1260 +    using insert by(simp add:sup_Inf1_distrib[OF B])
  2.1261 +  also have "\<dots> = \<Sqinter>\<^bsub>fin\<^esub>({sup x b |b. b \<in> B} \<union> {sup a b |a b. a \<in> A \<and> b \<in> B})"
  2.1262 +    (is "_ = \<Sqinter>\<^bsub>fin\<^esub>?M")
  2.1263 +    using B insert
  2.1264 +    by (simp add: Inf_fin_def fold1_Un2 [OF finB _ finAB ne])
  2.1265 +  also have "?M = {sup a b |a b. a \<in> insert x A \<and> b \<in> B}"
  2.1266 +    by blast
  2.1267 +  finally show ?case .
  2.1268 +qed
  2.1269 +
  2.1270 +lemma inf_Sup1_distrib:
  2.1271 +  assumes "finite A" and "A \<noteq> {}"
  2.1272 +  shows "inf x (\<Squnion>\<^bsub>fin\<^esub>A) = \<Squnion>\<^bsub>fin\<^esub>{inf x a|a. a \<in> A}"
  2.1273 +proof -
  2.1274 +  interpret ab_semigroup_idem_mult sup
  2.1275 +    by (rule ab_semigroup_idem_mult_sup)
  2.1276 +  from assms show ?thesis
  2.1277 +    by (simp add: Sup_fin_def image_def hom_fold1_commute [where h="inf x", OF inf_sup_distrib1])
  2.1278 +      (rule arg_cong [where f="fold1 sup"], blast)
  2.1279 +qed
  2.1280 +
  2.1281 +lemma inf_Sup2_distrib:
  2.1282 +  assumes A: "finite A" "A \<noteq> {}" and B: "finite B" "B \<noteq> {}"
  2.1283 +  shows "inf (\<Squnion>\<^bsub>fin\<^esub>A) (\<Squnion>\<^bsub>fin\<^esub>B) = \<Squnion>\<^bsub>fin\<^esub>{inf a b|a b. a \<in> A \<and> b \<in> B}"
  2.1284 +using A proof (induct rule: finite_ne_induct)
  2.1285 +  case singleton thus ?case
  2.1286 +    by(simp add: inf_Sup1_distrib [OF B] fold1_singleton_def [OF Sup_fin_def])
  2.1287 +next
  2.1288 +  case (insert x A)
  2.1289 +  have finB: "finite {inf x b |b. b \<in> B}"
  2.1290 +    by(rule finite_surj[where f = "%b. inf x b", OF B(1)], auto)
  2.1291 +  have finAB: "finite {inf a b |a b. a \<in> A \<and> b \<in> B}"
  2.1292 +  proof -
  2.1293 +    have "{inf a b |a b. a \<in> A \<and> b \<in> B} = (UN a:A. UN b:B. {inf a b})"
  2.1294 +      by blast
  2.1295 +    thus ?thesis by(simp add: insert(1) B(1))
  2.1296 +  qed
  2.1297 +  have ne: "{inf a b |a b. a \<in> A \<and> b \<in> B} \<noteq> {}" using insert B by blast
  2.1298 +  interpret ab_semigroup_idem_mult sup
  2.1299 +    by (rule ab_semigroup_idem_mult_sup)
  2.1300 +  have "inf (\<Squnion>\<^bsub>fin\<^esub>(insert x A)) (\<Squnion>\<^bsub>fin\<^esub>B) = inf (sup x (\<Squnion>\<^bsub>fin\<^esub>A)) (\<Squnion>\<^bsub>fin\<^esub>B)"
  2.1301 +    using insert by (simp add: fold1_insert_idem_def [OF Sup_fin_def])
  2.1302 +  also have "\<dots> = sup (inf x (\<Squnion>\<^bsub>fin\<^esub>B)) (inf (\<Squnion>\<^bsub>fin\<^esub>A) (\<Squnion>\<^bsub>fin\<^esub>B))" by(rule inf_sup_distrib2)
  2.1303 +  also have "\<dots> = sup (\<Squnion>\<^bsub>fin\<^esub>{inf x b|b. b \<in> B}) (\<Squnion>\<^bsub>fin\<^esub>{inf a b|a b. a \<in> A \<and> b \<in> B})"
  2.1304 +    using insert by(simp add:inf_Sup1_distrib[OF B])
  2.1305 +  also have "\<dots> = \<Squnion>\<^bsub>fin\<^esub>({inf x b |b. b \<in> B} \<union> {inf a b |a b. a \<in> A \<and> b \<in> B})"
  2.1306 +    (is "_ = \<Squnion>\<^bsub>fin\<^esub>?M")
  2.1307 +    using B insert
  2.1308 +    by (simp add: Sup_fin_def fold1_Un2 [OF finB _ finAB ne])
  2.1309 +  also have "?M = {inf a b |a b. a \<in> insert x A \<and> b \<in> B}"
  2.1310 +    by blast
  2.1311 +  finally show ?case .
  2.1312 +qed
  2.1313 +
  2.1314 +end
  2.1315 +
  2.1316 +context complete_lattice
  2.1317 +begin
  2.1318 +
  2.1319 +lemma Inf_fin_Inf:
  2.1320 +  assumes "finite A" and "A \<noteq> {}"
  2.1321 +  shows "\<Sqinter>\<^bsub>fin\<^esub>A = Inf A"
  2.1322 +proof -
  2.1323 +  interpret ab_semigroup_idem_mult inf
  2.1324 +    by (rule ab_semigroup_idem_mult_inf)
  2.1325 +  from `A \<noteq> {}` obtain b B where "A = insert b B" by auto
  2.1326 +  moreover with `finite A` have "finite B" by simp
  2.1327 +  ultimately show ?thesis  
  2.1328 +  by (simp add: Inf_fin_def fold1_eq_fold_idem inf_Inf_fold_inf [symmetric])
  2.1329 +    (simp add: Inf_fold_inf)
  2.1330 +qed
  2.1331 +
  2.1332 +lemma Sup_fin_Sup:
  2.1333 +  assumes "finite A" and "A \<noteq> {}"
  2.1334 +  shows "\<Squnion>\<^bsub>fin\<^esub>A = Sup A"
  2.1335 +proof -
  2.1336 +  interpret ab_semigroup_idem_mult sup
  2.1337 +    by (rule ab_semigroup_idem_mult_sup)
  2.1338 +  from `A \<noteq> {}` obtain b B where "A = insert b B" by auto
  2.1339 +  moreover with `finite A` have "finite B" by simp
  2.1340 +  ultimately show ?thesis  
  2.1341 +  by (simp add: Sup_fin_def fold1_eq_fold_idem sup_Sup_fold_sup [symmetric])
  2.1342 +    (simp add: Sup_fold_sup)
  2.1343 +qed
  2.1344 +
  2.1345 +end
  2.1346 +
  2.1347 +
  2.1348 +subsubsection {* Fold1 in linear orders with @{const min} and @{const max} *}
  2.1349 +
  2.1350 +text{*
  2.1351 +  As an application of @{text fold1} we define minimum
  2.1352 +  and maximum in (not necessarily complete!) linear orders
  2.1353 +  over (non-empty) sets by means of @{text fold1}.
  2.1354 +*}
  2.1355 +
  2.1356 +context linorder
  2.1357 +begin
  2.1358 +
  2.1359 +lemma ab_semigroup_idem_mult_min:
  2.1360 +  "ab_semigroup_idem_mult min"
  2.1361 +  proof qed (auto simp add: min_def)
  2.1362 +
  2.1363 +lemma ab_semigroup_idem_mult_max:
  2.1364 +  "ab_semigroup_idem_mult max"
  2.1365 +  proof qed (auto simp add: max_def)
  2.1366 +
  2.1367 +lemma max_lattice:
  2.1368 +  "semilattice_inf (op \<ge>) (op >) max"
  2.1369 +  by (fact min_max.dual_semilattice)
  2.1370 +
  2.1371 +lemma dual_max:
  2.1372 +  "ord.max (op \<ge>) = min"
  2.1373 +  by (auto simp add: ord.max_def_raw min_def expand_fun_eq)
  2.1374 +
  2.1375 +lemma dual_min:
  2.1376 +  "ord.min (op \<ge>) = max"
  2.1377 +  by (auto simp add: ord.min_def_raw max_def expand_fun_eq)
  2.1378 +
  2.1379 +lemma strict_below_fold1_iff:
  2.1380 +  assumes "finite A" and "A \<noteq> {}"
  2.1381 +  shows "x < fold1 min A \<longleftrightarrow> (\<forall>a\<in>A. x < a)"
  2.1382 +proof -
  2.1383 +  interpret ab_semigroup_idem_mult min
  2.1384 +    by (rule ab_semigroup_idem_mult_min)
  2.1385 +  from assms show ?thesis
  2.1386 +  by (induct rule: finite_ne_induct)
  2.1387 +    (simp_all add: fold1_insert)
  2.1388 +qed
  2.1389 +
  2.1390 +lemma fold1_below_iff:
  2.1391 +  assumes "finite A" and "A \<noteq> {}"
  2.1392 +  shows "fold1 min A \<le> x \<longleftrightarrow> (\<exists>a\<in>A. a \<le> x)"
  2.1393 +proof -
  2.1394 +  interpret ab_semigroup_idem_mult min
  2.1395 +    by (rule ab_semigroup_idem_mult_min)
  2.1396 +  from assms show ?thesis
  2.1397 +  by (induct rule: finite_ne_induct)
  2.1398 +    (simp_all add: fold1_insert min_le_iff_disj)
  2.1399 +qed
  2.1400 +
  2.1401 +lemma fold1_strict_below_iff:
  2.1402 +  assumes "finite A" and "A \<noteq> {}"
  2.1403 +  shows "fold1 min A < x \<longleftrightarrow> (\<exists>a\<in>A. a < x)"
  2.1404 +proof -
  2.1405 +  interpret ab_semigroup_idem_mult min
  2.1406 +    by (rule ab_semigroup_idem_mult_min)
  2.1407 +  from assms show ?thesis
  2.1408 +  by (induct rule: finite_ne_induct)
  2.1409 +    (simp_all add: fold1_insert min_less_iff_disj)
  2.1410 +qed
  2.1411 +
  2.1412 +lemma fold1_antimono:
  2.1413 +  assumes "A \<noteq> {}" and "A \<subseteq> B" and "finite B"
  2.1414 +  shows "fold1 min B \<le> fold1 min A"
  2.1415 +proof cases
  2.1416 +  assume "A = B" thus ?thesis by simp
  2.1417 +next
  2.1418 +  interpret ab_semigroup_idem_mult min
  2.1419 +    by (rule ab_semigroup_idem_mult_min)
  2.1420 +  assume "A \<noteq> B"
  2.1421 +  have B: "B = A \<union> (B-A)" using `A \<subseteq> B` by blast
  2.1422 +  have "fold1 min B = fold1 min (A \<union> (B-A))" by(subst B)(rule refl)
  2.1423 +  also have "\<dots> = min (fold1 min A) (fold1 min (B-A))"
  2.1424 +  proof -
  2.1425 +    have "finite A" by(rule finite_subset[OF `A \<subseteq> B` `finite B`])
  2.1426 +    moreover have "finite(B-A)" by(rule finite_Diff[OF `finite B`]) (* by(blast intro:finite_Diff prems) fails *)
  2.1427 +    moreover have "(B-A) \<noteq> {}" using prems by blast
  2.1428 +    moreover have "A Int (B-A) = {}" using prems by blast
  2.1429 +    ultimately show ?thesis using `A \<noteq> {}` by (rule_tac fold1_Un)
  2.1430 +  qed
  2.1431 +  also have "\<dots> \<le> fold1 min A" by (simp add: min_le_iff_disj)
  2.1432 +  finally show ?thesis .
  2.1433 +qed
  2.1434 +
  2.1435 +definition
  2.1436 +  Min :: "'a set \<Rightarrow> 'a"
  2.1437 +where
  2.1438 +  "Min = fold1 min"
  2.1439 +
  2.1440 +definition
  2.1441 +  Max :: "'a set \<Rightarrow> 'a"
  2.1442 +where
  2.1443 +  "Max = fold1 max"
  2.1444 +
  2.1445 +lemmas Min_singleton [simp] = fold1_singleton_def [OF Min_def]
  2.1446 +lemmas Max_singleton [simp] = fold1_singleton_def [OF Max_def]
  2.1447 +
  2.1448 +lemma Min_insert [simp]:
  2.1449 +  assumes "finite A" and "A \<noteq> {}"
  2.1450 +  shows "Min (insert x A) = min x (Min A)"
  2.1451 +proof -
  2.1452 +  interpret ab_semigroup_idem_mult min
  2.1453 +    by (rule ab_semigroup_idem_mult_min)
  2.1454 +  from assms show ?thesis by (rule fold1_insert_idem_def [OF Min_def])
  2.1455 +qed
  2.1456 +
  2.1457 +lemma Max_insert [simp]:
  2.1458 +  assumes "finite A" and "A \<noteq> {}"
  2.1459 +  shows "Max (insert x A) = max x (Max A)"
  2.1460 +proof -
  2.1461 +  interpret ab_semigroup_idem_mult max
  2.1462 +    by (rule ab_semigroup_idem_mult_max)
  2.1463 +  from assms show ?thesis by (rule fold1_insert_idem_def [OF Max_def])
  2.1464 +qed
  2.1465 +
  2.1466 +lemma Min_in [simp]:
  2.1467 +  assumes "finite A" and "A \<noteq> {}"
  2.1468 +  shows "Min A \<in> A"
  2.1469 +proof -
  2.1470 +  interpret ab_semigroup_idem_mult min
  2.1471 +    by (rule ab_semigroup_idem_mult_min)
  2.1472 +  from assms fold1_in show ?thesis by (fastsimp simp: Min_def min_def)
  2.1473 +qed
  2.1474 +
  2.1475 +lemma Max_in [simp]:
  2.1476 +  assumes "finite A" and "A \<noteq> {}"
  2.1477 +  shows "Max A \<in> A"
  2.1478 +proof -
  2.1479 +  interpret ab_semigroup_idem_mult max
  2.1480 +    by (rule ab_semigroup_idem_mult_max)
  2.1481 +  from assms fold1_in [of A] show ?thesis by (fastsimp simp: Max_def max_def)
  2.1482 +qed
  2.1483 +
  2.1484 +lemma Min_Un:
  2.1485 +  assumes "finite A" and "A \<noteq> {}" and "finite B" and "B \<noteq> {}"
  2.1486 +  shows "Min (A \<union> B) = min (Min A) (Min B)"
  2.1487 +proof -
  2.1488 +  interpret ab_semigroup_idem_mult min
  2.1489 +    by (rule ab_semigroup_idem_mult_min)
  2.1490 +  from assms show ?thesis
  2.1491 +    by (simp add: Min_def fold1_Un2)
  2.1492 +qed
  2.1493 +
  2.1494 +lemma Max_Un:
  2.1495 +  assumes "finite A" and "A \<noteq> {}" and "finite B" and "B \<noteq> {}"
  2.1496 +  shows "Max (A \<union> B) = max (Max A) (Max B)"
  2.1497 +proof -
  2.1498 +  interpret ab_semigroup_idem_mult max
  2.1499 +    by (rule ab_semigroup_idem_mult_max)
  2.1500 +  from assms show ?thesis
  2.1501 +    by (simp add: Max_def fold1_Un2)
  2.1502 +qed
  2.1503 +
  2.1504 +lemma hom_Min_commute:
  2.1505 +  assumes "\<And>x y. h (min x y) = min (h x) (h y)"
  2.1506 +    and "finite N" and "N \<noteq> {}"
  2.1507 +  shows "h (Min N) = Min (h ` N)"
  2.1508 +proof -
  2.1509 +  interpret ab_semigroup_idem_mult min
  2.1510 +    by (rule ab_semigroup_idem_mult_min)
  2.1511 +  from assms show ?thesis
  2.1512 +    by (simp add: Min_def hom_fold1_commute)
  2.1513 +qed
  2.1514 +
  2.1515 +lemma hom_Max_commute:
  2.1516 +  assumes "\<And>x y. h (max x y) = max (h x) (h y)"
  2.1517 +    and "finite N" and "N \<noteq> {}"
  2.1518 +  shows "h (Max N) = Max (h ` N)"
  2.1519 +proof -
  2.1520 +  interpret ab_semigroup_idem_mult max
  2.1521 +    by (rule ab_semigroup_idem_mult_max)
  2.1522 +  from assms show ?thesis
  2.1523 +    by (simp add: Max_def hom_fold1_commute [of h])
  2.1524 +qed
  2.1525 +
  2.1526 +lemma Min_le [simp]:
  2.1527 +  assumes "finite A" and "x \<in> A"
  2.1528 +  shows "Min A \<le> x"
  2.1529 +  using assms by (simp add: Min_def min_max.fold1_belowI)
  2.1530 +
  2.1531 +lemma Max_ge [simp]:
  2.1532 +  assumes "finite A" and "x \<in> A"
  2.1533 +  shows "x \<le> Max A"
  2.1534 +proof -
  2.1535 +  interpret semilattice_inf "op \<ge>" "op >" max
  2.1536 +    by (rule max_lattice)
  2.1537 +  from assms show ?thesis by (simp add: Max_def fold1_belowI)
  2.1538 +qed
  2.1539 +
  2.1540 +lemma Min_ge_iff [simp, noatp]:
  2.1541 +  assumes "finite A" and "A \<noteq> {}"
  2.1542 +  shows "x \<le> Min A \<longleftrightarrow> (\<forall>a\<in>A. x \<le> a)"
  2.1543 +  using assms by (simp add: Min_def min_max.below_fold1_iff)
  2.1544 +
  2.1545 +lemma Max_le_iff [simp, noatp]:
  2.1546 +  assumes "finite A" and "A \<noteq> {}"
  2.1547 +  shows "Max A \<le> x \<longleftrightarrow> (\<forall>a\<in>A. a \<le> x)"
  2.1548 +proof -
  2.1549 +  interpret semilattice_inf "op \<ge>" "op >" max
  2.1550 +    by (rule max_lattice)
  2.1551 +  from assms show ?thesis by (simp add: Max_def below_fold1_iff)
  2.1552 +qed
  2.1553 +
  2.1554 +lemma Min_gr_iff [simp, noatp]:
  2.1555 +  assumes "finite A" and "A \<noteq> {}"
  2.1556 +  shows "x < Min A \<longleftrightarrow> (\<forall>a\<in>A. x < a)"
  2.1557 +  using assms by (simp add: Min_def strict_below_fold1_iff)
  2.1558 +
  2.1559 +lemma Max_less_iff [simp, noatp]:
  2.1560 +  assumes "finite A" and "A \<noteq> {}"
  2.1561 +  shows "Max A < x \<longleftrightarrow> (\<forall>a\<in>A. a < x)"
  2.1562 +proof -
  2.1563 +  interpret dual: linorder "op \<ge>" "op >"
  2.1564 +    by (rule dual_linorder)
  2.1565 +  from assms show ?thesis
  2.1566 +    by (simp add: Max_def dual.strict_below_fold1_iff [folded dual.dual_max])
  2.1567 +qed
  2.1568 +
  2.1569 +lemma Min_le_iff [noatp]:
  2.1570 +  assumes "finite A" and "A \<noteq> {}"
  2.1571 +  shows "Min A \<le> x \<longleftrightarrow> (\<exists>a\<in>A. a \<le> x)"
  2.1572 +  using assms by (simp add: Min_def fold1_below_iff)
  2.1573 +
  2.1574 +lemma Max_ge_iff [noatp]:
  2.1575 +  assumes "finite A" and "A \<noteq> {}"
  2.1576 +  shows "x \<le> Max A \<longleftrightarrow> (\<exists>a\<in>A. x \<le> a)"
  2.1577 +proof -
  2.1578 +  interpret dual: linorder "op \<ge>" "op >"
  2.1579 +    by (rule dual_linorder)
  2.1580 +  from assms show ?thesis
  2.1581 +    by (simp add: Max_def dual.fold1_below_iff [folded dual.dual_max])
  2.1582 +qed
  2.1583 +
  2.1584 +lemma Min_less_iff [noatp]:
  2.1585 +  assumes "finite A" and "A \<noteq> {}"
  2.1586 +  shows "Min A < x \<longleftrightarrow> (\<exists>a\<in>A. a < x)"
  2.1587 +  using assms by (simp add: Min_def fold1_strict_below_iff)
  2.1588 +
  2.1589 +lemma Max_gr_iff [noatp]:
  2.1590 +  assumes "finite A" and "A \<noteq> {}"
  2.1591 +  shows "x < Max A \<longleftrightarrow> (\<exists>a\<in>A. x < a)"
  2.1592 +proof -
  2.1593 +  interpret dual: linorder "op \<ge>" "op >"
  2.1594 +    by (rule dual_linorder)
  2.1595 +  from assms show ?thesis
  2.1596 +    by (simp add: Max_def dual.fold1_strict_below_iff [folded dual.dual_max])
  2.1597 +qed
  2.1598 +
  2.1599 +lemma Min_eqI:
  2.1600 +  assumes "finite A"
  2.1601 +  assumes "\<And>y. y \<in> A \<Longrightarrow> y \<ge> x"
  2.1602 +    and "x \<in> A"
  2.1603 +  shows "Min A = x"
  2.1604 +proof (rule antisym)
  2.1605 +  from `x \<in> A` have "A \<noteq> {}" by auto
  2.1606 +  with assms show "Min A \<ge> x" by simp
  2.1607 +next
  2.1608 +  from assms show "x \<ge> Min A" by simp
  2.1609 +qed
  2.1610 +
  2.1611 +lemma Max_eqI:
  2.1612 +  assumes "finite A"
  2.1613 +  assumes "\<And>y. y \<in> A \<Longrightarrow> y \<le> x"
  2.1614 +    and "x \<in> A"
  2.1615 +  shows "Max A = x"
  2.1616 +proof (rule antisym)
  2.1617 +  from `x \<in> A` have "A \<noteq> {}" by auto
  2.1618 +  with assms show "Max A \<le> x" by simp
  2.1619 +next
  2.1620 +  from assms show "x \<le> Max A" by simp
  2.1621 +qed
  2.1622 +
  2.1623 +lemma Min_antimono:
  2.1624 +  assumes "M \<subseteq> N" and "M \<noteq> {}" and "finite N"
  2.1625 +  shows "Min N \<le> Min M"
  2.1626 +  using assms by (simp add: Min_def fold1_antimono)
  2.1627 +
  2.1628 +lemma Max_mono:
  2.1629 +  assumes "M \<subseteq> N" and "M \<noteq> {}" and "finite N"
  2.1630 +  shows "Max M \<le> Max N"
  2.1631 +proof -
  2.1632 +  interpret dual: linorder "op \<ge>" "op >"
  2.1633 +    by (rule dual_linorder)
  2.1634 +  from assms show ?thesis
  2.1635 +    by (simp add: Max_def dual.fold1_antimono [folded dual.dual_max])
  2.1636 +qed
  2.1637 +
  2.1638 +lemma finite_linorder_max_induct[consumes 1, case_names empty insert]:
  2.1639 + "finite A \<Longrightarrow> P {} \<Longrightarrow>
  2.1640 +  (!!b A. finite A \<Longrightarrow> ALL a:A. a < b \<Longrightarrow> P A \<Longrightarrow> P(insert b A))
  2.1641 +  \<Longrightarrow> P A"
  2.1642 +proof (induct rule: finite_psubset_induct)
  2.1643 +  fix A :: "'a set"
  2.1644 +  assume IH: "!! B. finite B \<Longrightarrow> B < A \<Longrightarrow> P {} \<Longrightarrow>
  2.1645 +                 (!!b A. finite A \<Longrightarrow> (\<forall>a\<in>A. a<b) \<Longrightarrow> P A \<Longrightarrow> P (insert b A))
  2.1646 +                  \<Longrightarrow> P B"
  2.1647 +  and "finite A" and "P {}"
  2.1648 +  and step: "!!b A. \<lbrakk>finite A; \<forall>a\<in>A. a < b; P A\<rbrakk> \<Longrightarrow> P (insert b A)"
  2.1649 +  show "P A"
  2.1650 +  proof (cases "A = {}")
  2.1651 +    assume "A = {}" thus "P A" using `P {}` by simp
  2.1652 +  next
  2.1653 +    let ?B = "A - {Max A}" let ?A = "insert (Max A) ?B"
  2.1654 +    assume "A \<noteq> {}"
  2.1655 +    with `finite A` have "Max A : A" by auto
  2.1656 +    hence A: "?A = A" using insert_Diff_single insert_absorb by auto
  2.1657 +    moreover have "finite ?B" using `finite A` by simp
  2.1658 +    ultimately have "P ?B" using `P {}` step IH[of ?B] by blast
  2.1659 +    moreover have "\<forall>a\<in>?B. a < Max A" using Max_ge [OF `finite A`] by fastsimp
  2.1660 +    ultimately show "P A" using A insert_Diff_single step[OF `finite ?B`] by fastsimp
  2.1661 +  qed
  2.1662 +qed
  2.1663 +
  2.1664 +lemma finite_linorder_min_induct[consumes 1, case_names empty insert]:
  2.1665 + "\<lbrakk>finite A; P {}; \<And>b A. \<lbrakk>finite A; \<forall>a\<in>A. b < a; P A\<rbrakk> \<Longrightarrow> P (insert b A)\<rbrakk> \<Longrightarrow> P A"
  2.1666 +by(rule linorder.finite_linorder_max_induct[OF dual_linorder])
  2.1667 +
  2.1668 +end
  2.1669 +
  2.1670 +context linordered_ab_semigroup_add
  2.1671 +begin
  2.1672 +
  2.1673 +lemma add_Min_commute:
  2.1674 +  fixes k
  2.1675 +  assumes "finite N" and "N \<noteq> {}"
  2.1676 +  shows "k + Min N = Min {k + m | m. m \<in> N}"
  2.1677 +proof -
  2.1678 +  have "\<And>x y. k + min x y = min (k + x) (k + y)"
  2.1679 +    by (simp add: min_def not_le)
  2.1680 +      (blast intro: antisym less_imp_le add_left_mono)
  2.1681 +  with assms show ?thesis
  2.1682 +    using hom_Min_commute [of "plus k" N]
  2.1683 +    by simp (blast intro: arg_cong [where f = Min])
  2.1684 +qed
  2.1685 +
  2.1686 +lemma add_Max_commute:
  2.1687 +  fixes k
  2.1688 +  assumes "finite N" and "N \<noteq> {}"
  2.1689 +  shows "k + Max N = Max {k + m | m. m \<in> N}"
  2.1690 +proof -
  2.1691 +  have "\<And>x y. k + max x y = max (k + x) (k + y)"
  2.1692 +    by (simp add: max_def not_le)
  2.1693 +      (blast intro: antisym less_imp_le add_left_mono)
  2.1694 +  with assms show ?thesis
  2.1695 +    using hom_Max_commute [of "plus k" N]
  2.1696 +    by simp (blast intro: arg_cong [where f = Max])
  2.1697 +qed
  2.1698 +
  2.1699 +end
  2.1700 +
  2.1701 +context linordered_ab_group_add
  2.1702 +begin
  2.1703 +
  2.1704 +lemma minus_Max_eq_Min [simp]:
  2.1705 +  "finite S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> - (Max S) = Min (uminus ` S)"
  2.1706 +  by (induct S rule: finite_ne_induct) (simp_all add: minus_max_eq_min)
  2.1707 +
  2.1708 +lemma minus_Min_eq_Max [simp]:
  2.1709 +  "finite S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> - (Min S) = Max (uminus ` S)"
  2.1710 +  by (induct S rule: finite_ne_induct) (simp_all add: minus_min_eq_max)
  2.1711 +
  2.1712 +end
  2.1713 +
  2.1714 +end
     3.1 --- a/src/HOL/Equiv_Relations.thy	Thu Mar 11 16:56:22 2010 +0100
     3.2 +++ b/src/HOL/Equiv_Relations.thy	Thu Mar 11 17:39:45 2010 +0100
     3.3 @@ -5,7 +5,7 @@
     3.4  header {* Equivalence Relations in Higher-Order Set Theory *}
     3.5  
     3.6  theory Equiv_Relations
     3.7 -imports Finite_Set Relation Plain
     3.8 +imports Big_Operators Relation Plain
     3.9  begin
    3.10  
    3.11  subsection {* Equivalence relations *}
     4.1 --- a/src/HOL/Finite_Set.thy	Thu Mar 11 16:56:22 2010 +0100
     4.2 +++ b/src/HOL/Finite_Set.thy	Thu Mar 11 17:39:45 2010 +0100
     4.3 @@ -6,7 +6,7 @@
     4.4  header {* Finite sets *}
     4.5  
     4.6  theory Finite_Set
     4.7 -imports Power Product_Type Sum_Type
     4.8 +imports Power Option
     4.9  begin
    4.10  
    4.11  subsection {* Definition and basic properties *}
    4.12 @@ -527,17 +527,24 @@
    4.13  lemma UNIV_unit [noatp]:
    4.14    "UNIV = {()}" by auto
    4.15  
    4.16 -instance unit :: finite
    4.17 -  by default (simp add: UNIV_unit)
    4.18 +instance unit :: finite proof
    4.19 +qed (simp add: UNIV_unit)
    4.20  
    4.21  lemma UNIV_bool [noatp]:
    4.22    "UNIV = {False, True}" by auto
    4.23  
    4.24 -instance bool :: finite
    4.25 -  by default (simp add: UNIV_bool)
    4.26 +instance bool :: finite proof
    4.27 +qed (simp add: UNIV_bool)
    4.28 +
    4.29 +instance * :: (finite, finite) finite proof
    4.30 +qed (simp only: UNIV_Times_UNIV [symmetric] finite_cartesian_product finite)
    4.31  
    4.32 -instance * :: (finite, finite) finite
    4.33 -  by default (simp only: UNIV_Times_UNIV [symmetric] finite_cartesian_product finite)
    4.34 +lemma finite_option_UNIV [simp]:
    4.35 +  "finite (UNIV :: 'a option set) = finite (UNIV :: 'a set)"
    4.36 +  by (auto simp add: UNIV_option_conv elim: finite_imageD intro: inj_Some)
    4.37 +
    4.38 +instance option :: (finite) finite proof
    4.39 +qed (simp add: UNIV_option_conv)
    4.40  
    4.41  lemma inj_graph: "inj (%f. {(x, y). y = f x})"
    4.42    by (rule inj_onI, auto simp add: expand_set_eq expand_fun_eq)
    4.43 @@ -556,8 +563,8 @@
    4.44    qed
    4.45  qed
    4.46  
    4.47 -instance "+" :: (finite, finite) finite
    4.48 -  by default (simp only: UNIV_Plus_UNIV [symmetric] finite_Plus finite)
    4.49 +instance "+" :: (finite, finite) finite proof
    4.50 +qed (simp only: UNIV_Plus_UNIV [symmetric] finite_Plus finite)
    4.51  
    4.52  
    4.53  subsection {* A fold functional for finite sets *}
    4.54 @@ -1053,1470 +1060,6 @@
    4.55  
    4.56  end
    4.57  
    4.58 -subsection {* Generalized summation over a set *}
    4.59 -
    4.60 -interpretation comm_monoid_add: comm_monoid_mult "op +" "0::'a::comm_monoid_add"
    4.61 -  proof qed (auto intro: add_assoc add_commute)
    4.62 -
    4.63 -definition setsum :: "('a => 'b) => 'a set => 'b::comm_monoid_add"
    4.64 -where "setsum f A == if finite A then fold_image (op +) f 0 A else 0"
    4.65 -
    4.66 -abbreviation
    4.67 -  Setsum  ("\<Sum>_" [1000] 999) where
    4.68 -  "\<Sum>A == setsum (%x. x) A"
    4.69 -
    4.70 -text{* Now: lot's of fancy syntax. First, @{term "setsum (%x. e) A"} is
    4.71 -written @{text"\<Sum>x\<in>A. e"}. *}
    4.72 -
    4.73 -syntax
    4.74 -  "_setsum" :: "pttrn => 'a set => 'b => 'b::comm_monoid_add"    ("(3SUM _:_. _)" [0, 51, 10] 10)
    4.75 -syntax (xsymbols)
    4.76 -  "_setsum" :: "pttrn => 'a set => 'b => 'b::comm_monoid_add"    ("(3\<Sum>_\<in>_. _)" [0, 51, 10] 10)
    4.77 -syntax (HTML output)
    4.78 -  "_setsum" :: "pttrn => 'a set => 'b => 'b::comm_monoid_add"    ("(3\<Sum>_\<in>_. _)" [0, 51, 10] 10)
    4.79 -
    4.80 -translations -- {* Beware of argument permutation! *}
    4.81 -  "SUM i:A. b" == "CONST setsum (%i. b) A"
    4.82 -  "\<Sum>i\<in>A. b" == "CONST setsum (%i. b) A"
    4.83 -
    4.84 -text{* Instead of @{term"\<Sum>x\<in>{x. P}. e"} we introduce the shorter
    4.85 - @{text"\<Sum>x|P. e"}. *}
    4.86 -
    4.87 -syntax
    4.88 -  "_qsetsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3SUM _ |/ _./ _)" [0,0,10] 10)
    4.89 -syntax (xsymbols)
    4.90 -  "_qsetsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3\<Sum>_ | (_)./ _)" [0,0,10] 10)
    4.91 -syntax (HTML output)
    4.92 -  "_qsetsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3\<Sum>_ | (_)./ _)" [0,0,10] 10)
    4.93 -
    4.94 -translations
    4.95 -  "SUM x|P. t" => "CONST setsum (%x. t) {x. P}"
    4.96 -  "\<Sum>x|P. t" => "CONST setsum (%x. t) {x. P}"
    4.97 -
    4.98 -print_translation {*
    4.99 -let
   4.100 -  fun setsum_tr' [Abs (x, Tx, t), Const (@{const_syntax Collect}, _) $ Abs (y, Ty, P)] =
   4.101 -        if x <> y then raise Match
   4.102 -        else
   4.103 -          let
   4.104 -            val x' = Syntax.mark_bound x;
   4.105 -            val t' = subst_bound (x', t);
   4.106 -            val P' = subst_bound (x', P);
   4.107 -          in Syntax.const @{syntax_const "_qsetsum"} $ Syntax.mark_bound x $ P' $ t' end
   4.108 -    | setsum_tr' _ = raise Match;
   4.109 -in [(@{const_syntax setsum}, setsum_tr')] end
   4.110 -*}
   4.111 -
   4.112 -
   4.113 -lemma setsum_empty [simp]: "setsum f {} = 0"
   4.114 -by (simp add: setsum_def)
   4.115 -
   4.116 -lemma setsum_insert [simp]:
   4.117 -  "finite F ==> a \<notin> F ==> setsum f (insert a F) = f a + setsum f F"
   4.118 -by (simp add: setsum_def)
   4.119 -
   4.120 -lemma setsum_infinite [simp]: "~ finite A ==> setsum f A = 0"
   4.121 -by (simp add: setsum_def)
   4.122 -
   4.123 -lemma setsum_reindex:
   4.124 -     "inj_on f B ==> setsum h (f ` B) = setsum (h \<circ> f) B"
   4.125 -by(auto simp add: setsum_def comm_monoid_add.fold_image_reindex dest!:finite_imageD)
   4.126 -
   4.127 -lemma setsum_reindex_id:
   4.128 -     "inj_on f B ==> setsum f B = setsum id (f ` B)"
   4.129 -by (auto simp add: setsum_reindex)
   4.130 -
   4.131 -lemma setsum_reindex_nonzero: 
   4.132 -  assumes fS: "finite S"
   4.133 -  and nz: "\<And> x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x \<noteq> y \<Longrightarrow> f x = f y \<Longrightarrow> h (f x) = 0"
   4.134 -  shows "setsum h (f ` S) = setsum (h o f) S"
   4.135 -using nz
   4.136 -proof(induct rule: finite_induct[OF fS])
   4.137 -  case 1 thus ?case by simp
   4.138 -next
   4.139 -  case (2 x F) 
   4.140 -  {assume fxF: "f x \<in> f ` F" hence "\<exists>y \<in> F . f y = f x" by auto
   4.141 -    then obtain y where y: "y \<in> F" "f x = f y" by auto 
   4.142 -    from "2.hyps" y have xy: "x \<noteq> y" by auto
   4.143 -    
   4.144 -    from "2.prems"[of x y] "2.hyps" xy y have h0: "h (f x) = 0" by simp
   4.145 -    have "setsum h (f ` insert x F) = setsum h (f ` F)" using fxF by auto
   4.146 -    also have "\<dots> = setsum (h o f) (insert x F)" 
   4.147 -      unfolding setsum_insert[OF `finite F` `x\<notin>F`]
   4.148 -      using h0 
   4.149 -      apply simp
   4.150 -      apply (rule "2.hyps"(3))
   4.151 -      apply (rule_tac y="y" in  "2.prems")
   4.152 -      apply simp_all
   4.153 -      done
   4.154 -    finally have ?case .}
   4.155 -  moreover
   4.156 -  {assume fxF: "f x \<notin> f ` F"
   4.157 -    have "setsum h (f ` insert x F) = h (f x) + setsum h (f ` F)" 
   4.158 -      using fxF "2.hyps" by simp 
   4.159 -    also have "\<dots> = setsum (h o f) (insert x F)"
   4.160 -      unfolding setsum_insert[OF `finite F` `x\<notin>F`]
   4.161 -      apply simp
   4.162 -      apply (rule cong[OF refl[of "op + (h (f x))"]])
   4.163 -      apply (rule "2.hyps"(3))
   4.164 -      apply (rule_tac y="y" in  "2.prems")
   4.165 -      apply simp_all
   4.166 -      done
   4.167 -    finally have ?case .}
   4.168 -  ultimately show ?case by blast
   4.169 -qed
   4.170 -
   4.171 -lemma setsum_cong:
   4.172 -  "A = B ==> (!!x. x:B ==> f x = g x) ==> setsum f A = setsum g B"
   4.173 -by(fastsimp simp: setsum_def intro: comm_monoid_add.fold_image_cong)
   4.174 -
   4.175 -lemma strong_setsum_cong[cong]:
   4.176 -  "A = B ==> (!!x. x:B =simp=> f x = g x)
   4.177 -   ==> setsum (%x. f x) A = setsum (%x. g x) B"
   4.178 -by(fastsimp simp: simp_implies_def setsum_def intro: comm_monoid_add.fold_image_cong)
   4.179 -
   4.180 -lemma setsum_cong2: "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setsum f A = setsum g A"
   4.181 -by (rule setsum_cong[OF refl], auto)
   4.182 -
   4.183 -lemma setsum_reindex_cong:
   4.184 -   "[|inj_on f A; B = f ` A; !!a. a:A \<Longrightarrow> g a = h (f a)|] 
   4.185 -    ==> setsum h B = setsum g A"
   4.186 -by (simp add: setsum_reindex cong: setsum_cong)
   4.187 -
   4.188 -
   4.189 -lemma setsum_0[simp]: "setsum (%i. 0) A = 0"
   4.190 -apply (clarsimp simp: setsum_def)
   4.191 -apply (erule finite_induct, auto)
   4.192 -done
   4.193 -
   4.194 -lemma setsum_0': "ALL a:A. f a = 0 ==> setsum f A = 0"
   4.195 -by(simp add:setsum_cong)
   4.196 -
   4.197 -lemma setsum_Un_Int: "finite A ==> finite B ==>
   4.198 -  setsum g (A Un B) + setsum g (A Int B) = setsum g A + setsum g B"
   4.199 -  -- {* The reversed orientation looks more natural, but LOOPS as a simprule! *}
   4.200 -by(simp add: setsum_def comm_monoid_add.fold_image_Un_Int [symmetric])
   4.201 -
   4.202 -lemma setsum_Un_disjoint: "finite A ==> finite B
   4.203 -  ==> A Int B = {} ==> setsum g (A Un B) = setsum g A + setsum g B"
   4.204 -by (subst setsum_Un_Int [symmetric], auto)
   4.205 -
   4.206 -lemma setsum_mono_zero_left: 
   4.207 -  assumes fT: "finite T" and ST: "S \<subseteq> T"
   4.208 -  and z: "\<forall>i \<in> T - S. f i = 0"
   4.209 -  shows "setsum f S = setsum f T"
   4.210 -proof-
   4.211 -  have eq: "T = S \<union> (T - S)" using ST by blast
   4.212 -  have d: "S \<inter> (T - S) = {}" using ST by blast
   4.213 -  from fT ST have f: "finite S" "finite (T - S)" by (auto intro: finite_subset)
   4.214 -  show ?thesis 
   4.215 -  by (simp add: setsum_Un_disjoint[OF f d, unfolded eq[symmetric]] setsum_0'[OF z])
   4.216 -qed
   4.217 -
   4.218 -lemma setsum_mono_zero_right: 
   4.219 -  "finite T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> \<forall>i \<in> T - S. f i = 0 \<Longrightarrow> setsum f T = setsum f S"
   4.220 -by(blast intro!: setsum_mono_zero_left[symmetric])
   4.221 -
   4.222 -lemma setsum_mono_zero_cong_left: 
   4.223 -  assumes fT: "finite T" and ST: "S \<subseteq> T"
   4.224 -  and z: "\<forall>i \<in> T - S. g i = 0"
   4.225 -  and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   4.226 -  shows "setsum f S = setsum g T"
   4.227 -proof-
   4.228 -  have eq: "T = S \<union> (T - S)" using ST by blast
   4.229 -  have d: "S \<inter> (T - S) = {}" using ST by blast
   4.230 -  from fT ST have f: "finite S" "finite (T - S)" by (auto intro: finite_subset)
   4.231 -  show ?thesis 
   4.232 -    using fg by (simp add: setsum_Un_disjoint[OF f d, unfolded eq[symmetric]] setsum_0'[OF z])
   4.233 -qed
   4.234 -
   4.235 -lemma setsum_mono_zero_cong_right: 
   4.236 -  assumes fT: "finite T" and ST: "S \<subseteq> T"
   4.237 -  and z: "\<forall>i \<in> T - S. f i = 0"
   4.238 -  and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   4.239 -  shows "setsum f T = setsum g S"
   4.240 -using setsum_mono_zero_cong_left[OF fT ST z] fg[symmetric] by auto 
   4.241 -
   4.242 -lemma setsum_delta: 
   4.243 -  assumes fS: "finite S"
   4.244 -  shows "setsum (\<lambda>k. if k=a then b k else 0) S = (if a \<in> S then b a else 0)"
   4.245 -proof-
   4.246 -  let ?f = "(\<lambda>k. if k=a then b k else 0)"
   4.247 -  {assume a: "a \<notin> S"
   4.248 -    hence "\<forall> k\<in> S. ?f k = 0" by simp
   4.249 -    hence ?thesis  using a by simp}
   4.250 -  moreover 
   4.251 -  {assume a: "a \<in> S"
   4.252 -    let ?A = "S - {a}"
   4.253 -    let ?B = "{a}"
   4.254 -    have eq: "S = ?A \<union> ?B" using a by blast 
   4.255 -    have dj: "?A \<inter> ?B = {}" by simp
   4.256 -    from fS have fAB: "finite ?A" "finite ?B" by auto  
   4.257 -    have "setsum ?f S = setsum ?f ?A + setsum ?f ?B"
   4.258 -      using setsum_Un_disjoint[OF fAB dj, of ?f, unfolded eq[symmetric]]
   4.259 -      by simp
   4.260 -    then have ?thesis  using a by simp}
   4.261 -  ultimately show ?thesis by blast
   4.262 -qed
   4.263 -lemma setsum_delta': 
   4.264 -  assumes fS: "finite S" shows 
   4.265 -  "setsum (\<lambda>k. if a = k then b k else 0) S = 
   4.266 -     (if a\<in> S then b a else 0)"
   4.267 -  using setsum_delta[OF fS, of a b, symmetric] 
   4.268 -  by (auto intro: setsum_cong)
   4.269 -
   4.270 -lemma setsum_restrict_set:
   4.271 -  assumes fA: "finite A"
   4.272 -  shows "setsum f (A \<inter> B) = setsum (\<lambda>x. if x \<in> B then f x else 0) A"
   4.273 -proof-
   4.274 -  from fA have fab: "finite (A \<inter> B)" by auto
   4.275 -  have aba: "A \<inter> B \<subseteq> A" by blast
   4.276 -  let ?g = "\<lambda>x. if x \<in> A\<inter>B then f x else 0"
   4.277 -  from setsum_mono_zero_left[OF fA aba, of ?g]
   4.278 -  show ?thesis by simp
   4.279 -qed
   4.280 -
   4.281 -lemma setsum_cases:
   4.282 -  assumes fA: "finite A"
   4.283 -  shows "setsum (\<lambda>x. if P x then f x else g x) A =
   4.284 -         setsum f (A \<inter> {x. P x}) + setsum g (A \<inter> - {x. P x})"
   4.285 -proof-
   4.286 -  have a: "A = A \<inter> {x. P x} \<union> A \<inter> -{x. P x}" 
   4.287 -          "(A \<inter> {x. P x}) \<inter> (A \<inter> -{x. P x}) = {}" 
   4.288 -    by blast+
   4.289 -  from fA 
   4.290 -  have f: "finite (A \<inter> {x. P x})" "finite (A \<inter> -{x. P x})" by auto
   4.291 -  let ?g = "\<lambda>x. if P x then f x else g x"
   4.292 -  from setsum_Un_disjoint[OF f a(2), of ?g] a(1)
   4.293 -  show ?thesis by simp
   4.294 -qed
   4.295 -
   4.296 -
   4.297 -(*But we can't get rid of finite I. If infinite, although the rhs is 0, 
   4.298 -  the lhs need not be, since UNION I A could still be finite.*)
   4.299 -lemma setsum_UN_disjoint:
   4.300 -    "finite I ==> (ALL i:I. finite (A i)) ==>
   4.301 -        (ALL i:I. ALL j:I. i \<noteq> j --> A i Int A j = {}) ==>
   4.302 -      setsum f (UNION I A) = (\<Sum>i\<in>I. setsum f (A i))"
   4.303 -by(simp add: setsum_def comm_monoid_add.fold_image_UN_disjoint cong: setsum_cong)
   4.304 -
   4.305 -text{*No need to assume that @{term C} is finite.  If infinite, the rhs is
   4.306 -directly 0, and @{term "Union C"} is also infinite, hence the lhs is also 0.*}
   4.307 -lemma setsum_Union_disjoint:
   4.308 -  "[| (ALL A:C. finite A);
   4.309 -      (ALL A:C. ALL B:C. A \<noteq> B --> A Int B = {}) |]
   4.310 -   ==> setsum f (Union C) = setsum (setsum f) C"
   4.311 -apply (cases "finite C") 
   4.312 - prefer 2 apply (force dest: finite_UnionD simp add: setsum_def)
   4.313 -  apply (frule setsum_UN_disjoint [of C id f])
   4.314 - apply (unfold Union_def id_def, assumption+)
   4.315 -done
   4.316 -
   4.317 -(*But we can't get rid of finite A. If infinite, although the lhs is 0, 
   4.318 -  the rhs need not be, since SIGMA A B could still be finite.*)
   4.319 -lemma setsum_Sigma: "finite A ==> ALL x:A. finite (B x) ==>
   4.320 -    (\<Sum>x\<in>A. (\<Sum>y\<in>B x. f x y)) = (\<Sum>(x,y)\<in>(SIGMA x:A. B x). f x y)"
   4.321 -by(simp add:setsum_def comm_monoid_add.fold_image_Sigma split_def cong:setsum_cong)
   4.322 -
   4.323 -text{*Here we can eliminate the finiteness assumptions, by cases.*}
   4.324 -lemma setsum_cartesian_product: 
   4.325 -   "(\<Sum>x\<in>A. (\<Sum>y\<in>B. f x y)) = (\<Sum>(x,y) \<in> A <*> B. f x y)"
   4.326 -apply (cases "finite A") 
   4.327 - apply (cases "finite B") 
   4.328 -  apply (simp add: setsum_Sigma)
   4.329 - apply (cases "A={}", simp)
   4.330 - apply (simp) 
   4.331 -apply (auto simp add: setsum_def
   4.332 -            dest: finite_cartesian_productD1 finite_cartesian_productD2) 
   4.333 -done
   4.334 -
   4.335 -lemma setsum_addf: "setsum (%x. f x + g x) A = (setsum f A + setsum g A)"
   4.336 -by(simp add:setsum_def comm_monoid_add.fold_image_distrib)
   4.337 -
   4.338 -
   4.339 -subsubsection {* Properties in more restricted classes of structures *}
   4.340 -
   4.341 -lemma setsum_SucD: "setsum f A = Suc n ==> EX a:A. 0 < f a"
   4.342 -apply (case_tac "finite A")
   4.343 - prefer 2 apply (simp add: setsum_def)
   4.344 -apply (erule rev_mp)
   4.345 -apply (erule finite_induct, auto)
   4.346 -done
   4.347 -
   4.348 -lemma setsum_eq_0_iff [simp]:
   4.349 -    "finite F ==> (setsum f F = 0) = (ALL a:F. f a = (0::nat))"
   4.350 -by (induct set: finite) auto
   4.351 -
   4.352 -lemma setsum_eq_Suc0_iff: "finite A \<Longrightarrow>
   4.353 -  (setsum f A = Suc 0) = (EX a:A. f a = Suc 0 & (ALL b:A. a\<noteq>b \<longrightarrow> f b = 0))"
   4.354 -apply(erule finite_induct)
   4.355 -apply (auto simp add:add_is_1)
   4.356 -done
   4.357 -
   4.358 -lemmas setsum_eq_1_iff = setsum_eq_Suc0_iff[simplified One_nat_def[symmetric]]
   4.359 -
   4.360 -lemma setsum_Un_nat: "finite A ==> finite B ==>
   4.361 -  (setsum f (A Un B) :: nat) = setsum f A + setsum f B - setsum f (A Int B)"
   4.362 -  -- {* For the natural numbers, we have subtraction. *}
   4.363 -by (subst setsum_Un_Int [symmetric], auto simp add: algebra_simps)
   4.364 -
   4.365 -lemma setsum_Un: "finite A ==> finite B ==>
   4.366 -  (setsum f (A Un B) :: 'a :: ab_group_add) =
   4.367 -   setsum f A + setsum f B - setsum f (A Int B)"
   4.368 -by (subst setsum_Un_Int [symmetric], auto simp add: algebra_simps)
   4.369 -
   4.370 -lemma (in comm_monoid_mult) fold_image_1: "finite S \<Longrightarrow> (\<forall>x\<in>S. f x = 1) \<Longrightarrow> fold_image op * f 1 S = 1"
   4.371 -  apply (induct set: finite)
   4.372 -  apply simp by auto
   4.373 -
   4.374 -lemma (in comm_monoid_mult) fold_image_Un_one:
   4.375 -  assumes fS: "finite S" and fT: "finite T"
   4.376 -  and I0: "\<forall>x \<in> S\<inter>T. f x = 1"
   4.377 -  shows "fold_image (op *) f 1 (S \<union> T) = fold_image (op *) f 1 S * fold_image (op *) f 1 T"
   4.378 -proof-
   4.379 -  have "fold_image op * f 1 (S \<inter> T) = 1" 
   4.380 -    apply (rule fold_image_1)
   4.381 -    using fS fT I0 by auto 
   4.382 -  with fold_image_Un_Int[OF fS fT] show ?thesis by simp
   4.383 -qed
   4.384 -
   4.385 -lemma setsum_eq_general_reverses:
   4.386 -  assumes fS: "finite S" and fT: "finite T"
   4.387 -  and kh: "\<And>y. y \<in> T \<Longrightarrow> k y \<in> S \<and> h (k y) = y"
   4.388 -  and hk: "\<And>x. x \<in> S \<Longrightarrow> h x \<in> T \<and> k (h x) = x \<and> g (h x) = f x"
   4.389 -  shows "setsum f S = setsum g T"
   4.390 -  apply (simp add: setsum_def fS fT)
   4.391 -  apply (rule comm_monoid_add.fold_image_eq_general_inverses[OF fS])
   4.392 -  apply (erule kh)
   4.393 -  apply (erule hk)
   4.394 -  done
   4.395 -
   4.396 -
   4.397 -
   4.398 -lemma setsum_Un_zero:  
   4.399 -  assumes fS: "finite S" and fT: "finite T"
   4.400 -  and I0: "\<forall>x \<in> S\<inter>T. f x = 0"
   4.401 -  shows "setsum f (S \<union> T) = setsum f S  + setsum f T"
   4.402 -  using fS fT
   4.403 -  apply (simp add: setsum_def)
   4.404 -  apply (rule comm_monoid_add.fold_image_Un_one)
   4.405 -  using I0 by auto
   4.406 -
   4.407 -
   4.408 -lemma setsum_UNION_zero: 
   4.409 -  assumes fS: "finite S" and fSS: "\<forall>T \<in> S. finite T"
   4.410 -  and f0: "\<And>T1 T2 x. T1\<in>S \<Longrightarrow> T2\<in>S \<Longrightarrow> T1 \<noteq> T2 \<Longrightarrow> x \<in> T1 \<Longrightarrow> x \<in> T2 \<Longrightarrow> f x = 0"
   4.411 -  shows "setsum f (\<Union>S) = setsum (\<lambda>T. setsum f T) S"
   4.412 -  using fSS f0
   4.413 -proof(induct rule: finite_induct[OF fS])
   4.414 -  case 1 thus ?case by simp
   4.415 -next
   4.416 -  case (2 T F)
   4.417 -  then have fTF: "finite T" "\<forall>T\<in>F. finite T" "finite F" and TF: "T \<notin> F" 
   4.418 -    and H: "setsum f (\<Union> F) = setsum (setsum f) F" by auto
   4.419 -  from fTF have fUF: "finite (\<Union>F)" by auto
   4.420 -  from "2.prems" TF fTF
   4.421 -  show ?case 
   4.422 -    by (auto simp add: H[symmetric] intro: setsum_Un_zero[OF fTF(1) fUF, of f])
   4.423 -qed
   4.424 -
   4.425 -
   4.426 -lemma setsum_diff1_nat: "(setsum f (A - {a}) :: nat) =
   4.427 -  (if a:A then setsum f A - f a else setsum f A)"
   4.428 -apply (case_tac "finite A")
   4.429 - prefer 2 apply (simp add: setsum_def)
   4.430 -apply (erule finite_induct)
   4.431 - apply (auto simp add: insert_Diff_if)
   4.432 -apply (drule_tac a = a in mk_disjoint_insert, auto)
   4.433 -done
   4.434 -
   4.435 -lemma setsum_diff1: "finite A \<Longrightarrow>
   4.436 -  (setsum f (A - {a}) :: ('a::ab_group_add)) =
   4.437 -  (if a:A then setsum f A - f a else setsum f A)"
   4.438 -by (erule finite_induct) (auto simp add: insert_Diff_if)
   4.439 -
   4.440 -lemma setsum_diff1'[rule_format]:
   4.441 -  "finite A \<Longrightarrow> a \<in> A \<longrightarrow> (\<Sum> x \<in> A. f x) = f a + (\<Sum> x \<in> (A - {a}). f x)"
   4.442 -apply (erule finite_induct[where F=A and P="% A. (a \<in> A \<longrightarrow> (\<Sum> x \<in> A. f x) = f a + (\<Sum> x \<in> (A - {a}). f x))"])
   4.443 -apply (auto simp add: insert_Diff_if add_ac)
   4.444 -done
   4.445 -
   4.446 -lemma setsum_diff1_ring: assumes "finite A" "a \<in> A"
   4.447 -  shows "setsum f (A - {a}) = setsum f A - (f a::'a::ring)"
   4.448 -unfolding setsum_diff1'[OF assms] by auto
   4.449 -
   4.450 -(* By Jeremy Siek: *)
   4.451 -
   4.452 -lemma setsum_diff_nat: 
   4.453 -assumes "finite B" and "B \<subseteq> A"
   4.454 -shows "(setsum f (A - B) :: nat) = (setsum f A) - (setsum f B)"
   4.455 -using assms
   4.456 -proof induct
   4.457 -  show "setsum f (A - {}) = (setsum f A) - (setsum f {})" by simp
   4.458 -next
   4.459 -  fix F x assume finF: "finite F" and xnotinF: "x \<notin> F"
   4.460 -    and xFinA: "insert x F \<subseteq> A"
   4.461 -    and IH: "F \<subseteq> A \<Longrightarrow> setsum f (A - F) = setsum f A - setsum f F"
   4.462 -  from xnotinF xFinA have xinAF: "x \<in> (A - F)" by simp
   4.463 -  from xinAF have A: "setsum f ((A - F) - {x}) = setsum f (A - F) - f x"
   4.464 -    by (simp add: setsum_diff1_nat)
   4.465 -  from xFinA have "F \<subseteq> A" by simp
   4.466 -  with IH have "setsum f (A - F) = setsum f A - setsum f F" by simp
   4.467 -  with A have B: "setsum f ((A - F) - {x}) = setsum f A - setsum f F - f x"
   4.468 -    by simp
   4.469 -  from xnotinF have "A - insert x F = (A - F) - {x}" by auto
   4.470 -  with B have C: "setsum f (A - insert x F) = setsum f A - setsum f F - f x"
   4.471 -    by simp
   4.472 -  from finF xnotinF have "setsum f (insert x F) = setsum f F + f x" by simp
   4.473 -  with C have "setsum f (A - insert x F) = setsum f A - setsum f (insert x F)"
   4.474 -    by simp
   4.475 -  thus "setsum f (A - insert x F) = setsum f A - setsum f (insert x F)" by simp
   4.476 -qed
   4.477 -
   4.478 -lemma setsum_diff:
   4.479 -  assumes le: "finite A" "B \<subseteq> A"
   4.480 -  shows "setsum f (A - B) = setsum f A - ((setsum f B)::('a::ab_group_add))"
   4.481 -proof -
   4.482 -  from le have finiteB: "finite B" using finite_subset by auto
   4.483 -  show ?thesis using finiteB le
   4.484 -  proof induct
   4.485 -    case empty
   4.486 -    thus ?case by auto
   4.487 -  next
   4.488 -    case (insert x F)
   4.489 -    thus ?case using le finiteB 
   4.490 -      by (simp add: Diff_insert[where a=x and B=F] setsum_diff1 insert_absorb)
   4.491 -  qed
   4.492 -qed
   4.493 -
   4.494 -lemma setsum_mono:
   4.495 -  assumes le: "\<And>i. i\<in>K \<Longrightarrow> f (i::'a) \<le> ((g i)::('b::{comm_monoid_add, ordered_ab_semigroup_add}))"
   4.496 -  shows "(\<Sum>i\<in>K. f i) \<le> (\<Sum>i\<in>K. g i)"
   4.497 -proof (cases "finite K")
   4.498 -  case True
   4.499 -  thus ?thesis using le
   4.500 -  proof induct
   4.501 -    case empty
   4.502 -    thus ?case by simp
   4.503 -  next
   4.504 -    case insert
   4.505 -    thus ?case using add_mono by fastsimp
   4.506 -  qed
   4.507 -next
   4.508 -  case False
   4.509 -  thus ?thesis
   4.510 -    by (simp add: setsum_def)
   4.511 -qed
   4.512 -
   4.513 -lemma setsum_strict_mono:
   4.514 -  fixes f :: "'a \<Rightarrow> 'b::{ordered_cancel_ab_semigroup_add,comm_monoid_add}"
   4.515 -  assumes "finite A"  "A \<noteq> {}"
   4.516 -    and "!!x. x:A \<Longrightarrow> f x < g x"
   4.517 -  shows "setsum f A < setsum g A"
   4.518 -  using prems
   4.519 -proof (induct rule: finite_ne_induct)
   4.520 -  case singleton thus ?case by simp
   4.521 -next
   4.522 -  case insert thus ?case by (auto simp: add_strict_mono)
   4.523 -qed
   4.524 -
   4.525 -lemma setsum_negf:
   4.526 -  "setsum (%x. - (f x)::'a::ab_group_add) A = - setsum f A"
   4.527 -proof (cases "finite A")
   4.528 -  case True thus ?thesis by (induct set: finite) auto
   4.529 -next
   4.530 -  case False thus ?thesis by (simp add: setsum_def)
   4.531 -qed
   4.532 -
   4.533 -lemma setsum_subtractf:
   4.534 -  "setsum (%x. ((f x)::'a::ab_group_add) - g x) A =
   4.535 -    setsum f A - setsum g A"
   4.536 -proof (cases "finite A")
   4.537 -  case True thus ?thesis by (simp add: diff_minus setsum_addf setsum_negf)
   4.538 -next
   4.539 -  case False thus ?thesis by (simp add: setsum_def)
   4.540 -qed
   4.541 -
   4.542 -lemma setsum_nonneg:
   4.543 -  assumes nn: "\<forall>x\<in>A. (0::'a::{ordered_ab_semigroup_add,comm_monoid_add}) \<le> f x"
   4.544 -  shows "0 \<le> setsum f A"
   4.545 -proof (cases "finite A")
   4.546 -  case True thus ?thesis using nn
   4.547 -  proof induct
   4.548 -    case empty then show ?case by simp
   4.549 -  next
   4.550 -    case (insert x F)
   4.551 -    then have "0 + 0 \<le> f x + setsum f F" by (blast intro: add_mono)
   4.552 -    with insert show ?case by simp
   4.553 -  qed
   4.554 -next
   4.555 -  case False thus ?thesis by (simp add: setsum_def)
   4.556 -qed
   4.557 -
   4.558 -lemma setsum_nonpos:
   4.559 -  assumes np: "\<forall>x\<in>A. f x \<le> (0::'a::{ordered_ab_semigroup_add,comm_monoid_add})"
   4.560 -  shows "setsum f A \<le> 0"
   4.561 -proof (cases "finite A")
   4.562 -  case True thus ?thesis using np
   4.563 -  proof induct
   4.564 -    case empty then show ?case by simp
   4.565 -  next
   4.566 -    case (insert x F)
   4.567 -    then have "f x + setsum f F \<le> 0 + 0" by (blast intro: add_mono)
   4.568 -    with insert show ?case by simp
   4.569 -  qed
   4.570 -next
   4.571 -  case False thus ?thesis by (simp add: setsum_def)
   4.572 -qed
   4.573 -
   4.574 -lemma setsum_mono2:
   4.575 -fixes f :: "'a \<Rightarrow> 'b :: {ordered_ab_semigroup_add_imp_le,comm_monoid_add}"
   4.576 -assumes fin: "finite B" and sub: "A \<subseteq> B" and nn: "\<And>b. b \<in> B-A \<Longrightarrow> 0 \<le> f b"
   4.577 -shows "setsum f A \<le> setsum f B"
   4.578 -proof -
   4.579 -  have "setsum f A \<le> setsum f A + setsum f (B-A)"
   4.580 -    by(simp add: add_increasing2[OF setsum_nonneg] nn Ball_def)
   4.581 -  also have "\<dots> = setsum f (A \<union> (B-A))" using fin finite_subset[OF sub fin]
   4.582 -    by (simp add:setsum_Un_disjoint del:Un_Diff_cancel)
   4.583 -  also have "A \<union> (B-A) = B" using sub by blast
   4.584 -  finally show ?thesis .
   4.585 -qed
   4.586 -
   4.587 -lemma setsum_mono3: "finite B ==> A <= B ==> 
   4.588 -    ALL x: B - A. 
   4.589 -      0 <= ((f x)::'a::{comm_monoid_add,ordered_ab_semigroup_add}) ==>
   4.590 -        setsum f A <= setsum f B"
   4.591 -  apply (subgoal_tac "setsum f B = setsum f A + setsum f (B - A)")
   4.592 -  apply (erule ssubst)
   4.593 -  apply (subgoal_tac "setsum f A + 0 <= setsum f A + setsum f (B - A)")
   4.594 -  apply simp
   4.595 -  apply (rule add_left_mono)
   4.596 -  apply (erule setsum_nonneg)
   4.597 -  apply (subst setsum_Un_disjoint [THEN sym])
   4.598 -  apply (erule finite_subset, assumption)
   4.599 -  apply (rule finite_subset)
   4.600 -  prefer 2
   4.601 -  apply assumption
   4.602 -  apply (auto simp add: sup_absorb2)
   4.603 -done
   4.604 -
   4.605 -lemma setsum_right_distrib: 
   4.606 -  fixes f :: "'a => ('b::semiring_0)"
   4.607 -  shows "r * setsum f A = setsum (%n. r * f n) A"
   4.608 -proof (cases "finite A")
   4.609 -  case True
   4.610 -  thus ?thesis
   4.611 -  proof induct
   4.612 -    case empty thus ?case by simp
   4.613 -  next
   4.614 -    case (insert x A) thus ?case by (simp add: right_distrib)
   4.615 -  qed
   4.616 -next
   4.617 -  case False thus ?thesis by (simp add: setsum_def)
   4.618 -qed
   4.619 -
   4.620 -lemma setsum_left_distrib:
   4.621 -  "setsum f A * (r::'a::semiring_0) = (\<Sum>n\<in>A. f n * r)"
   4.622 -proof (cases "finite A")
   4.623 -  case True
   4.624 -  then show ?thesis
   4.625 -  proof induct
   4.626 -    case empty thus ?case by simp
   4.627 -  next
   4.628 -    case (insert x A) thus ?case by (simp add: left_distrib)
   4.629 -  qed
   4.630 -next
   4.631 -  case False thus ?thesis by (simp add: setsum_def)
   4.632 -qed
   4.633 -
   4.634 -lemma setsum_divide_distrib:
   4.635 -  "setsum f A / (r::'a::field) = (\<Sum>n\<in>A. f n / r)"
   4.636 -proof (cases "finite A")
   4.637 -  case True
   4.638 -  then show ?thesis
   4.639 -  proof induct
   4.640 -    case empty thus ?case by simp
   4.641 -  next
   4.642 -    case (insert x A) thus ?case by (simp add: add_divide_distrib)
   4.643 -  qed
   4.644 -next
   4.645 -  case False thus ?thesis by (simp add: setsum_def)
   4.646 -qed
   4.647 -
   4.648 -lemma setsum_abs[iff]: 
   4.649 -  fixes f :: "'a => ('b::ordered_ab_group_add_abs)"
   4.650 -  shows "abs (setsum f A) \<le> setsum (%i. abs(f i)) A"
   4.651 -proof (cases "finite A")
   4.652 -  case True
   4.653 -  thus ?thesis
   4.654 -  proof induct
   4.655 -    case empty thus ?case by simp
   4.656 -  next
   4.657 -    case (insert x A)
   4.658 -    thus ?case by (auto intro: abs_triangle_ineq order_trans)
   4.659 -  qed
   4.660 -next
   4.661 -  case False thus ?thesis by (simp add: setsum_def)
   4.662 -qed
   4.663 -
   4.664 -lemma setsum_abs_ge_zero[iff]: 
   4.665 -  fixes f :: "'a => ('b::ordered_ab_group_add_abs)"
   4.666 -  shows "0 \<le> setsum (%i. abs(f i)) A"
   4.667 -proof (cases "finite A")
   4.668 -  case True
   4.669 -  thus ?thesis
   4.670 -  proof induct
   4.671 -    case empty thus ?case by simp
   4.672 -  next
   4.673 -    case (insert x A) thus ?case by (auto simp: add_nonneg_nonneg)
   4.674 -  qed
   4.675 -next
   4.676 -  case False thus ?thesis by (simp add: setsum_def)
   4.677 -qed
   4.678 -
   4.679 -lemma abs_setsum_abs[simp]: 
   4.680 -  fixes f :: "'a => ('b::ordered_ab_group_add_abs)"
   4.681 -  shows "abs (\<Sum>a\<in>A. abs(f a)) = (\<Sum>a\<in>A. abs(f a))"
   4.682 -proof (cases "finite A")
   4.683 -  case True
   4.684 -  thus ?thesis
   4.685 -  proof induct
   4.686 -    case empty thus ?case by simp
   4.687 -  next
   4.688 -    case (insert a A)
   4.689 -    hence "\<bar>\<Sum>a\<in>insert a A. \<bar>f a\<bar>\<bar> = \<bar>\<bar>f a\<bar> + (\<Sum>a\<in>A. \<bar>f a\<bar>)\<bar>" by simp
   4.690 -    also have "\<dots> = \<bar>\<bar>f a\<bar> + \<bar>\<Sum>a\<in>A. \<bar>f a\<bar>\<bar>\<bar>"  using insert by simp
   4.691 -    also have "\<dots> = \<bar>f a\<bar> + \<bar>\<Sum>a\<in>A. \<bar>f a\<bar>\<bar>"
   4.692 -      by (simp del: abs_of_nonneg)
   4.693 -    also have "\<dots> = (\<Sum>a\<in>insert a A. \<bar>f a\<bar>)" using insert by simp
   4.694 -    finally show ?case .
   4.695 -  qed
   4.696 -next
   4.697 -  case False thus ?thesis by (simp add: setsum_def)
   4.698 -qed
   4.699 -
   4.700 -
   4.701 -lemma setsum_Plus:
   4.702 -  fixes A :: "'a set" and B :: "'b set"
   4.703 -  assumes fin: "finite A" "finite B"
   4.704 -  shows "setsum f (A <+> B) = setsum (f \<circ> Inl) A + setsum (f \<circ> Inr) B"
   4.705 -proof -
   4.706 -  have "A <+> B = Inl ` A \<union> Inr ` B" by auto
   4.707 -  moreover from fin have "finite (Inl ` A :: ('a + 'b) set)" "finite (Inr ` B :: ('a + 'b) set)"
   4.708 -    by(auto intro: finite_imageI)
   4.709 -  moreover have "Inl ` A \<inter> Inr ` B = ({} :: ('a + 'b) set)" by auto
   4.710 -  moreover have "inj_on (Inl :: 'a \<Rightarrow> 'a + 'b) A" "inj_on (Inr :: 'b \<Rightarrow> 'a + 'b) B" by(auto intro: inj_onI)
   4.711 -  ultimately show ?thesis using fin by(simp add: setsum_Un_disjoint setsum_reindex)
   4.712 -qed
   4.713 -
   4.714 -
   4.715 -text {* Commuting outer and inner summation *}
   4.716 -
   4.717 -lemma swap_inj_on:
   4.718 -  "inj_on (%(i, j). (j, i)) (A \<times> B)"
   4.719 -  by (unfold inj_on_def) fast
   4.720 -
   4.721 -lemma swap_product:
   4.722 -  "(%(i, j). (j, i)) ` (A \<times> B) = B \<times> A"
   4.723 -  by (simp add: split_def image_def) blast
   4.724 -
   4.725 -lemma setsum_commute:
   4.726 -  "(\<Sum>i\<in>A. \<Sum>j\<in>B. f i j) = (\<Sum>j\<in>B. \<Sum>i\<in>A. f i j)"
   4.727 -proof (simp add: setsum_cartesian_product)
   4.728 -  have "(\<Sum>(x,y) \<in> A <*> B. f x y) =
   4.729 -    (\<Sum>(y,x) \<in> (%(i, j). (j, i)) ` (A \<times> B). f x y)"
   4.730 -    (is "?s = _")
   4.731 -    apply (simp add: setsum_reindex [where f = "%(i, j). (j, i)"] swap_inj_on)
   4.732 -    apply (simp add: split_def)
   4.733 -    done
   4.734 -  also have "... = (\<Sum>(y,x)\<in>B \<times> A. f x y)"
   4.735 -    (is "_ = ?t")
   4.736 -    apply (simp add: swap_product)
   4.737 -    done
   4.738 -  finally show "?s = ?t" .
   4.739 -qed
   4.740 -
   4.741 -lemma setsum_product:
   4.742 -  fixes f :: "'a => ('b::semiring_0)"
   4.743 -  shows "setsum f A * setsum g B = (\<Sum>i\<in>A. \<Sum>j\<in>B. f i * g j)"
   4.744 -  by (simp add: setsum_right_distrib setsum_left_distrib) (rule setsum_commute)
   4.745 -
   4.746 -lemma setsum_mult_setsum_if_inj:
   4.747 -fixes f :: "'a => ('b::semiring_0)"
   4.748 -shows "inj_on (%(a,b). f a * g b) (A \<times> B) ==>
   4.749 -  setsum f A * setsum g B = setsum id {f a * g b|a b. a:A & b:B}"
   4.750 -by(auto simp: setsum_product setsum_cartesian_product
   4.751 -        intro!:  setsum_reindex_cong[symmetric])
   4.752 -
   4.753 -
   4.754 -subsection {* Generalized product over a set *}
   4.755 -
   4.756 -definition setprod :: "('a => 'b) => 'a set => 'b::comm_monoid_mult"
   4.757 -where "setprod f A == if finite A then fold_image (op *) f 1 A else 1"
   4.758 -
   4.759 -abbreviation
   4.760 -  Setprod  ("\<Prod>_" [1000] 999) where
   4.761 -  "\<Prod>A == setprod (%x. x) A"
   4.762 -
   4.763 -syntax
   4.764 -  "_setprod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult"  ("(3PROD _:_. _)" [0, 51, 10] 10)
   4.765 -syntax (xsymbols)
   4.766 -  "_setprod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult"  ("(3\<Prod>_\<in>_. _)" [0, 51, 10] 10)
   4.767 -syntax (HTML output)
   4.768 -  "_setprod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult"  ("(3\<Prod>_\<in>_. _)" [0, 51, 10] 10)
   4.769 -
   4.770 -translations -- {* Beware of argument permutation! *}
   4.771 -  "PROD i:A. b" == "CONST setprod (%i. b) A" 
   4.772 -  "\<Prod>i\<in>A. b" == "CONST setprod (%i. b) A" 
   4.773 -
   4.774 -text{* Instead of @{term"\<Prod>x\<in>{x. P}. e"} we introduce the shorter
   4.775 - @{text"\<Prod>x|P. e"}. *}
   4.776 -
   4.777 -syntax
   4.778 -  "_qsetprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3PROD _ |/ _./ _)" [0,0,10] 10)
   4.779 -syntax (xsymbols)
   4.780 -  "_qsetprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3\<Prod>_ | (_)./ _)" [0,0,10] 10)
   4.781 -syntax (HTML output)
   4.782 -  "_qsetprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3\<Prod>_ | (_)./ _)" [0,0,10] 10)
   4.783 -
   4.784 -translations
   4.785 -  "PROD x|P. t" => "CONST setprod (%x. t) {x. P}"
   4.786 -  "\<Prod>x|P. t" => "CONST setprod (%x. t) {x. P}"
   4.787 -
   4.788 -
   4.789 -lemma setprod_empty [simp]: "setprod f {} = 1"
   4.790 -by (auto simp add: setprod_def)
   4.791 -
   4.792 -lemma setprod_insert [simp]: "[| finite A; a \<notin> A |] ==>
   4.793 -    setprod f (insert a A) = f a * setprod f A"
   4.794 -by (simp add: setprod_def)
   4.795 -
   4.796 -lemma setprod_infinite [simp]: "~ finite A ==> setprod f A = 1"
   4.797 -by (simp add: setprod_def)
   4.798 -
   4.799 -lemma setprod_reindex:
   4.800 -   "inj_on f B ==> setprod h (f ` B) = setprod (h \<circ> f) B"
   4.801 -by(auto simp: setprod_def fold_image_reindex dest!:finite_imageD)
   4.802 -
   4.803 -lemma setprod_reindex_id: "inj_on f B ==> setprod f B = setprod id (f ` B)"
   4.804 -by (auto simp add: setprod_reindex)
   4.805 -
   4.806 -lemma setprod_cong:
   4.807 -  "A = B ==> (!!x. x:B ==> f x = g x) ==> setprod f A = setprod g B"
   4.808 -by(fastsimp simp: setprod_def intro: fold_image_cong)
   4.809 -
   4.810 -lemma strong_setprod_cong[cong]:
   4.811 -  "A = B ==> (!!x. x:B =simp=> f x = g x) ==> setprod f A = setprod g B"
   4.812 -by(fastsimp simp: simp_implies_def setprod_def intro: fold_image_cong)
   4.813 -
   4.814 -lemma setprod_reindex_cong: "inj_on f A ==>
   4.815 -    B = f ` A ==> g = h \<circ> f ==> setprod h B = setprod g A"
   4.816 -by (frule setprod_reindex, simp)
   4.817 -
   4.818 -lemma strong_setprod_reindex_cong: assumes i: "inj_on f A"
   4.819 -  and B: "B = f ` A" and eq: "\<And>x. x \<in> A \<Longrightarrow> g x = (h \<circ> f) x"
   4.820 -  shows "setprod h B = setprod g A"
   4.821 -proof-
   4.822 -    have "setprod h B = setprod (h o f) A"
   4.823 -      by (simp add: B setprod_reindex[OF i, of h])
   4.824 -    then show ?thesis apply simp
   4.825 -      apply (rule setprod_cong)
   4.826 -      apply simp
   4.827 -      by (simp add: eq)
   4.828 -qed
   4.829 -
   4.830 -lemma setprod_Un_one:  
   4.831 -  assumes fS: "finite S" and fT: "finite T"
   4.832 -  and I0: "\<forall>x \<in> S\<inter>T. f x = 1"
   4.833 -  shows "setprod f (S \<union> T) = setprod f S  * setprod f T"
   4.834 -  using fS fT
   4.835 -  apply (simp add: setprod_def)
   4.836 -  apply (rule fold_image_Un_one)
   4.837 -  using I0 by auto
   4.838 -
   4.839 -
   4.840 -lemma setprod_1: "setprod (%i. 1) A = 1"
   4.841 -apply (case_tac "finite A")
   4.842 -apply (erule finite_induct, auto simp add: mult_ac)
   4.843 -done
   4.844 -
   4.845 -lemma setprod_1': "ALL a:F. f a = 1 ==> setprod f F = 1"
   4.846 -apply (subgoal_tac "setprod f F = setprod (%x. 1) F")
   4.847 -apply (erule ssubst, rule setprod_1)
   4.848 -apply (rule setprod_cong, auto)
   4.849 -done
   4.850 -
   4.851 -lemma setprod_Un_Int: "finite A ==> finite B
   4.852 -    ==> setprod g (A Un B) * setprod g (A Int B) = setprod g A * setprod g B"
   4.853 -by(simp add: setprod_def fold_image_Un_Int[symmetric])
   4.854 -
   4.855 -lemma setprod_Un_disjoint: "finite A ==> finite B
   4.856 -  ==> A Int B = {} ==> setprod g (A Un B) = setprod g A * setprod g B"
   4.857 -by (subst setprod_Un_Int [symmetric], auto)
   4.858 -
   4.859 -lemma setprod_mono_one_left: 
   4.860 -  assumes fT: "finite T" and ST: "S \<subseteq> T"
   4.861 -  and z: "\<forall>i \<in> T - S. f i = 1"
   4.862 -  shows "setprod f S = setprod f T"
   4.863 -proof-
   4.864 -  have eq: "T = S \<union> (T - S)" using ST by blast
   4.865 -  have d: "S \<inter> (T - S) = {}" using ST by blast
   4.866 -  from fT ST have f: "finite S" "finite (T - S)" by (auto intro: finite_subset)
   4.867 -  show ?thesis
   4.868 -  by (simp add: setprod_Un_disjoint[OF f d, unfolded eq[symmetric]] setprod_1'[OF z])
   4.869 -qed
   4.870 -
   4.871 -lemmas setprod_mono_one_right = setprod_mono_one_left [THEN sym]
   4.872 -
   4.873 -lemma setprod_delta: 
   4.874 -  assumes fS: "finite S"
   4.875 -  shows "setprod (\<lambda>k. if k=a then b k else 1) S = (if a \<in> S then b a else 1)"
   4.876 -proof-
   4.877 -  let ?f = "(\<lambda>k. if k=a then b k else 1)"
   4.878 -  {assume a: "a \<notin> S"
   4.879 -    hence "\<forall> k\<in> S. ?f k = 1" by simp
   4.880 -    hence ?thesis  using a by (simp add: setprod_1 cong add: setprod_cong) }
   4.881 -  moreover 
   4.882 -  {assume a: "a \<in> S"
   4.883 -    let ?A = "S - {a}"
   4.884 -    let ?B = "{a}"
   4.885 -    have eq: "S = ?A \<union> ?B" using a by blast 
   4.886 -    have dj: "?A \<inter> ?B = {}" by simp
   4.887 -    from fS have fAB: "finite ?A" "finite ?B" by auto  
   4.888 -    have fA1: "setprod ?f ?A = 1" apply (rule setprod_1') by auto
   4.889 -    have "setprod ?f ?A * setprod ?f ?B = setprod ?f S"
   4.890 -      using setprod_Un_disjoint[OF fAB dj, of ?f, unfolded eq[symmetric]]
   4.891 -      by simp
   4.892 -    then have ?thesis  using a by (simp add: fA1 cong add: setprod_cong cong del: if_weak_cong)}
   4.893 -  ultimately show ?thesis by blast
   4.894 -qed
   4.895 -
   4.896 -lemma setprod_delta': 
   4.897 -  assumes fS: "finite S" shows 
   4.898 -  "setprod (\<lambda>k. if a = k then b k else 1) S = 
   4.899 -     (if a\<in> S then b a else 1)"
   4.900 -  using setprod_delta[OF fS, of a b, symmetric] 
   4.901 -  by (auto intro: setprod_cong)
   4.902 -
   4.903 -
   4.904 -lemma setprod_UN_disjoint:
   4.905 -    "finite I ==> (ALL i:I. finite (A i)) ==>
   4.906 -        (ALL i:I. ALL j:I. i \<noteq> j --> A i Int A j = {}) ==>
   4.907 -      setprod f (UNION I A) = setprod (%i. setprod f (A i)) I"
   4.908 -by(simp add: setprod_def fold_image_UN_disjoint cong: setprod_cong)
   4.909 -
   4.910 -lemma setprod_Union_disjoint:
   4.911 -  "[| (ALL A:C. finite A);
   4.912 -      (ALL A:C. ALL B:C. A \<noteq> B --> A Int B = {}) |] 
   4.913 -   ==> setprod f (Union C) = setprod (setprod f) C"
   4.914 -apply (cases "finite C") 
   4.915 - prefer 2 apply (force dest: finite_UnionD simp add: setprod_def)
   4.916 -  apply (frule setprod_UN_disjoint [of C id f])
   4.917 - apply (unfold Union_def id_def, assumption+)
   4.918 -done
   4.919 -
   4.920 -lemma setprod_Sigma: "finite A ==> ALL x:A. finite (B x) ==>
   4.921 -    (\<Prod>x\<in>A. (\<Prod>y\<in> B x. f x y)) =
   4.922 -    (\<Prod>(x,y)\<in>(SIGMA x:A. B x). f x y)"
   4.923 -by(simp add:setprod_def fold_image_Sigma split_def cong:setprod_cong)
   4.924 -
   4.925 -text{*Here we can eliminate the finiteness assumptions, by cases.*}
   4.926 -lemma setprod_cartesian_product: 
   4.927 -     "(\<Prod>x\<in>A. (\<Prod>y\<in> B. f x y)) = (\<Prod>(x,y)\<in>(A <*> B). f x y)"
   4.928 -apply (cases "finite A") 
   4.929 - apply (cases "finite B") 
   4.930 -  apply (simp add: setprod_Sigma)
   4.931 - apply (cases "A={}", simp)
   4.932 - apply (simp add: setprod_1) 
   4.933 -apply (auto simp add: setprod_def
   4.934 -            dest: finite_cartesian_productD1 finite_cartesian_productD2) 
   4.935 -done
   4.936 -
   4.937 -lemma setprod_timesf:
   4.938 -     "setprod (%x. f x * g x) A = (setprod f A * setprod g A)"
   4.939 -by(simp add:setprod_def fold_image_distrib)
   4.940 -
   4.941 -
   4.942 -subsubsection {* Properties in more restricted classes of structures *}
   4.943 -
   4.944 -lemma setprod_eq_1_iff [simp]:
   4.945 -  "finite F ==> (setprod f F = 1) = (ALL a:F. f a = (1::nat))"
   4.946 -by (induct set: finite) auto
   4.947 -
   4.948 -lemma setprod_zero:
   4.949 -     "finite A ==> EX x: A. f x = (0::'a::comm_semiring_1) ==> setprod f A = 0"
   4.950 -apply (induct set: finite, force, clarsimp)
   4.951 -apply (erule disjE, auto)
   4.952 -done
   4.953 -
   4.954 -lemma setprod_nonneg [rule_format]:
   4.955 -   "(ALL x: A. (0::'a::linordered_semidom) \<le> f x) --> 0 \<le> setprod f A"
   4.956 -by (cases "finite A", induct set: finite, simp_all add: mult_nonneg_nonneg)
   4.957 -
   4.958 -lemma setprod_pos [rule_format]: "(ALL x: A. (0::'a::linordered_semidom) < f x)
   4.959 -  --> 0 < setprod f A"
   4.960 -by (cases "finite A", induct set: finite, simp_all add: mult_pos_pos)
   4.961 -
   4.962 -lemma setprod_zero_iff[simp]: "finite A ==> 
   4.963 -  (setprod f A = (0::'a::{comm_semiring_1,no_zero_divisors})) =
   4.964 -  (EX x: A. f x = 0)"
   4.965 -by (erule finite_induct, auto simp:no_zero_divisors)
   4.966 -
   4.967 -lemma setprod_pos_nat:
   4.968 -  "finite S ==> (ALL x : S. f x > (0::nat)) ==> setprod f S > 0"
   4.969 -using setprod_zero_iff by(simp del:neq0_conv add:neq0_conv[symmetric])
   4.970 -
   4.971 -lemma setprod_pos_nat_iff[simp]:
   4.972 -  "finite S ==> (setprod f S > 0) = (ALL x : S. f x > (0::nat))"
   4.973 -using setprod_zero_iff by(simp del:neq0_conv add:neq0_conv[symmetric])
   4.974 -
   4.975 -lemma setprod_Un: "finite A ==> finite B ==> (ALL x: A Int B. f x \<noteq> 0) ==>
   4.976 -  (setprod f (A Un B) :: 'a ::{field})
   4.977 -   = setprod f A * setprod f B / setprod f (A Int B)"
   4.978 -by (subst setprod_Un_Int [symmetric], auto)
   4.979 -
   4.980 -lemma setprod_diff1: "finite A ==> f a \<noteq> 0 ==>
   4.981 -  (setprod f (A - {a}) :: 'a :: {field}) =
   4.982 -  (if a:A then setprod f A / f a else setprod f A)"
   4.983 -by (erule finite_induct) (auto simp add: insert_Diff_if)
   4.984 -
   4.985 -lemma setprod_inversef: 
   4.986 -  fixes f :: "'b \<Rightarrow> 'a::{field,division_by_zero}"
   4.987 -  shows "finite A ==> setprod (inverse \<circ> f) A = inverse (setprod f A)"
   4.988 -by (erule finite_induct) auto
   4.989 -
   4.990 -lemma setprod_dividef:
   4.991 -  fixes f :: "'b \<Rightarrow> 'a::{field,division_by_zero}"
   4.992 -  shows "finite A
   4.993 -    ==> setprod (%x. f x / g x) A = setprod f A / setprod g A"
   4.994 -apply (subgoal_tac
   4.995 -         "setprod (%x. f x / g x) A = setprod (%x. f x * (inverse \<circ> g) x) A")
   4.996 -apply (erule ssubst)
   4.997 -apply (subst divide_inverse)
   4.998 -apply (subst setprod_timesf)
   4.999 -apply (subst setprod_inversef, assumption+, rule refl)
  4.1000 -apply (rule setprod_cong, rule refl)
  4.1001 -apply (subst divide_inverse, auto)
  4.1002 -done
  4.1003 -
  4.1004 -lemma setprod_dvd_setprod [rule_format]: 
  4.1005 -    "(ALL x : A. f x dvd g x) \<longrightarrow> setprod f A dvd setprod g A"
  4.1006 -  apply (cases "finite A")
  4.1007 -  apply (induct set: finite)
  4.1008 -  apply (auto simp add: dvd_def)
  4.1009 -  apply (rule_tac x = "k * ka" in exI)
  4.1010 -  apply (simp add: algebra_simps)
  4.1011 -done
  4.1012 -
  4.1013 -lemma setprod_dvd_setprod_subset:
  4.1014 -  "finite B \<Longrightarrow> A <= B \<Longrightarrow> setprod f A dvd setprod f B"
  4.1015 -  apply (subgoal_tac "setprod f B = setprod f A * setprod f (B - A)")
  4.1016 -  apply (unfold dvd_def, blast)
  4.1017 -  apply (subst setprod_Un_disjoint [symmetric])
  4.1018 -  apply (auto elim: finite_subset intro: setprod_cong)
  4.1019 -done
  4.1020 -
  4.1021 -lemma setprod_dvd_setprod_subset2:
  4.1022 -  "finite B \<Longrightarrow> A <= B \<Longrightarrow> ALL x : A. (f x::'a::comm_semiring_1) dvd g x \<Longrightarrow> 
  4.1023 -      setprod f A dvd setprod g B"
  4.1024 -  apply (rule dvd_trans)
  4.1025 -  apply (rule setprod_dvd_setprod, erule (1) bspec)
  4.1026 -  apply (erule (1) setprod_dvd_setprod_subset)
  4.1027 -done
  4.1028 -
  4.1029 -lemma dvd_setprod: "finite A \<Longrightarrow> i:A \<Longrightarrow> 
  4.1030 -    (f i ::'a::comm_semiring_1) dvd setprod f A"
  4.1031 -by (induct set: finite) (auto intro: dvd_mult)
  4.1032 -
  4.1033 -lemma dvd_setsum [rule_format]: "(ALL i : A. d dvd f i) \<longrightarrow> 
  4.1034 -    (d::'a::comm_semiring_1) dvd (SUM x : A. f x)"
  4.1035 -  apply (cases "finite A")
  4.1036 -  apply (induct set: finite)
  4.1037 -  apply auto
  4.1038 -done
  4.1039 -
  4.1040 -lemma setprod_mono:
  4.1041 -  fixes f :: "'a \<Rightarrow> 'b\<Colon>linordered_semidom"
  4.1042 -  assumes "\<forall>i\<in>A. 0 \<le> f i \<and> f i \<le> g i"
  4.1043 -  shows "setprod f A \<le> setprod g A"
  4.1044 -proof (cases "finite A")
  4.1045 -  case True
  4.1046 -  hence ?thesis "setprod f A \<ge> 0" using subset_refl[of A]
  4.1047 -  proof (induct A rule: finite_subset_induct)
  4.1048 -    case (insert a F)
  4.1049 -    thus "setprod f (insert a F) \<le> setprod g (insert a F)" "0 \<le> setprod f (insert a F)"
  4.1050 -      unfolding setprod_insert[OF insert(1,3)]
  4.1051 -      using assms[rule_format,OF insert(2)] insert
  4.1052 -      by (auto intro: mult_mono mult_nonneg_nonneg)
  4.1053 -  qed auto
  4.1054 -  thus ?thesis by simp
  4.1055 -qed auto
  4.1056 -
  4.1057 -lemma abs_setprod:
  4.1058 -  fixes f :: "'a \<Rightarrow> 'b\<Colon>{linordered_field,abs}"
  4.1059 -  shows "abs (setprod f A) = setprod (\<lambda>x. abs (f x)) A"
  4.1060 -proof (cases "finite A")
  4.1061 -  case True thus ?thesis
  4.1062 -    by induct (auto simp add: field_simps abs_mult)
  4.1063 -qed auto
  4.1064 -
  4.1065 -
  4.1066 -subsection {* Finite cardinality *}
  4.1067 -
  4.1068 -text {* This definition, although traditional, is ugly to work with:
  4.1069 -@{text "card A == LEAST n. EX f. A = {f i | i. i < n}"}.
  4.1070 -But now that we have @{text setsum} things are easy:
  4.1071 -*}
  4.1072 -
  4.1073 -definition card :: "'a set \<Rightarrow> nat" where
  4.1074 -  "card A = setsum (\<lambda>x. 1) A"
  4.1075 -
  4.1076 -lemmas card_eq_setsum = card_def
  4.1077 -
  4.1078 -lemma card_empty [simp]: "card {} = 0"
  4.1079 -  by (simp add: card_def)
  4.1080 -
  4.1081 -lemma card_insert_disjoint [simp]:
  4.1082 -  "finite A ==> x \<notin> A ==> card (insert x A) = Suc(card A)"
  4.1083 -  by (simp add: card_def)
  4.1084 -
  4.1085 -lemma card_insert_if:
  4.1086 -  "finite A ==> card (insert x A) = (if x:A then card A else Suc(card(A)))"
  4.1087 -  by (simp add: insert_absorb)
  4.1088 -
  4.1089 -lemma card_infinite [simp]: "~ finite A ==> card A = 0"
  4.1090 -  by (simp add: card_def)
  4.1091 -
  4.1092 -lemma card_ge_0_finite:
  4.1093 -  "card A > 0 \<Longrightarrow> finite A"
  4.1094 -  by (rule ccontr) simp
  4.1095 -
  4.1096 -lemma card_0_eq [simp,noatp]: "finite A ==> (card A = 0) = (A = {})"
  4.1097 -  apply auto
  4.1098 -  apply (drule_tac a = x in mk_disjoint_insert, clarify, auto)
  4.1099 -  done
  4.1100 -
  4.1101 -lemma finite_UNIV_card_ge_0:
  4.1102 -  "finite (UNIV :: 'a set) \<Longrightarrow> card (UNIV :: 'a set) > 0"
  4.1103 -  by (rule ccontr) simp
  4.1104 -
  4.1105 -lemma card_eq_0_iff: "(card A = 0) = (A = {} | ~ finite A)"
  4.1106 -  by auto
  4.1107 -
  4.1108 -lemma card_gt_0_iff: "(0 < card A) = (A \<noteq> {} & finite A)"
  4.1109 -  by (simp add: neq0_conv [symmetric] card_eq_0_iff) 
  4.1110 -
  4.1111 -lemma card_Suc_Diff1: "finite A ==> x: A ==> Suc (card (A - {x})) = card A"
  4.1112 -apply(rule_tac t = A in insert_Diff [THEN subst], assumption)
  4.1113 -apply(simp del:insert_Diff_single)
  4.1114 -done
  4.1115 -
  4.1116 -lemma card_Diff_singleton:
  4.1117 -  "finite A ==> x: A ==> card (A - {x}) = card A - 1"
  4.1118 -by (simp add: card_Suc_Diff1 [symmetric])
  4.1119 -
  4.1120 -lemma card_Diff_singleton_if:
  4.1121 -  "finite A ==> card (A-{x}) = (if x : A then card A - 1 else card A)"
  4.1122 -by (simp add: card_Diff_singleton)
  4.1123 -
  4.1124 -lemma card_Diff_insert[simp]:
  4.1125 -assumes "finite A" and "a:A" and "a ~: B"
  4.1126 -shows "card(A - insert a B) = card(A - B) - 1"
  4.1127 -proof -
  4.1128 -  have "A - insert a B = (A - B) - {a}" using assms by blast
  4.1129 -  then show ?thesis using assms by(simp add:card_Diff_singleton)
  4.1130 -qed
  4.1131 -
  4.1132 -lemma card_insert: "finite A ==> card (insert x A) = Suc (card (A - {x}))"
  4.1133 -by (simp add: card_insert_if card_Suc_Diff1 del:card_Diff_insert)
  4.1134 -
  4.1135 -lemma card_insert_le: "finite A ==> card A <= card (insert x A)"
  4.1136 -by (simp add: card_insert_if)
  4.1137 -
  4.1138 -lemma card_mono: "\<lbrakk> finite B; A \<subseteq> B \<rbrakk> \<Longrightarrow> card A \<le> card B"
  4.1139 -by (simp add: card_def setsum_mono2)
  4.1140 -
  4.1141 -lemma card_seteq: "finite B ==> (!!A. A <= B ==> card B <= card A ==> A = B)"
  4.1142 -apply (induct set: finite, simp, clarify)
  4.1143 -apply (subgoal_tac "finite A & A - {x} <= F")
  4.1144 - prefer 2 apply (blast intro: finite_subset, atomize)
  4.1145 -apply (drule_tac x = "A - {x}" in spec)
  4.1146 -apply (simp add: card_Diff_singleton_if split add: split_if_asm)
  4.1147 -apply (case_tac "card A", auto)
  4.1148 -done
  4.1149 -
  4.1150 -lemma psubset_card_mono: "finite B ==> A < B ==> card A < card B"
  4.1151 -apply (simp add: psubset_eq linorder_not_le [symmetric])
  4.1152 -apply (blast dest: card_seteq)
  4.1153 -done
  4.1154 -
  4.1155 -lemma card_Un_Int: "finite A ==> finite B
  4.1156 -    ==> card A + card B = card (A Un B) + card (A Int B)"
  4.1157 -by(simp add:card_def setsum_Un_Int)
  4.1158 -
  4.1159 -lemma card_Un_disjoint: "finite A ==> finite B
  4.1160 -    ==> A Int B = {} ==> card (A Un B) = card A + card B"
  4.1161 -by (simp add: card_Un_Int)
  4.1162 -
  4.1163 -lemma card_Diff_subset:
  4.1164 -  "finite B ==> B <= A ==> card (A - B) = card A - card B"
  4.1165 -by(simp add:card_def setsum_diff_nat)
  4.1166 -
  4.1167 -lemma card_Diff_subset_Int:
  4.1168 -  assumes AB: "finite (A \<inter> B)" shows "card (A - B) = card A - card (A \<inter> B)"
  4.1169 -proof -
  4.1170 -  have "A - B = A - A \<inter> B" by auto
  4.1171 -  thus ?thesis
  4.1172 -    by (simp add: card_Diff_subset AB) 
  4.1173 -qed
  4.1174 -
  4.1175 -lemma card_Diff1_less: "finite A ==> x: A ==> card (A - {x}) < card A"
  4.1176 -apply (rule Suc_less_SucD)
  4.1177 -apply (simp add: card_Suc_Diff1 del:card_Diff_insert)
  4.1178 -done
  4.1179 -
  4.1180 -lemma card_Diff2_less:
  4.1181 -  "finite A ==> x: A ==> y: A ==> card (A - {x} - {y}) < card A"
  4.1182 -apply (case_tac "x = y")
  4.1183 - apply (simp add: card_Diff1_less del:card_Diff_insert)
  4.1184 -apply (rule less_trans)
  4.1185 - prefer 2 apply (auto intro!: card_Diff1_less simp del:card_Diff_insert)
  4.1186 -done
  4.1187 -
  4.1188 -lemma card_Diff1_le: "finite A ==> card (A - {x}) <= card A"
  4.1189 -apply (case_tac "x : A")
  4.1190 - apply (simp_all add: card_Diff1_less less_imp_le)
  4.1191 -done
  4.1192 -
  4.1193 -lemma card_psubset: "finite B ==> A \<subseteq> B ==> card A < card B ==> A < B"
  4.1194 -by (erule psubsetI, blast)
  4.1195 -
  4.1196 -lemma insert_partition:
  4.1197 -  "\<lbrakk> x \<notin> F; \<forall>c1 \<in> insert x F. \<forall>c2 \<in> insert x F. c1 \<noteq> c2 \<longrightarrow> c1 \<inter> c2 = {} \<rbrakk>
  4.1198 -  \<Longrightarrow> x \<inter> \<Union> F = {}"
  4.1199 -by auto
  4.1200 -
  4.1201 -lemma finite_psubset_induct[consumes 1, case_names psubset]:
  4.1202 -  assumes "finite A" and "!!A. finite A \<Longrightarrow> (!!B. finite B \<Longrightarrow> B \<subset> A \<Longrightarrow> P(B)) \<Longrightarrow> P(A)" shows "P A"
  4.1203 -using assms(1)
  4.1204 -proof (induct A rule: measure_induct_rule[where f=card])
  4.1205 -  case (less A)
  4.1206 -  show ?case
  4.1207 -  proof(rule assms(2)[OF less(2)])
  4.1208 -    fix B assume "finite B" "B \<subset> A"
  4.1209 -    show "P B" by(rule less(1)[OF psubset_card_mono[OF less(2) `B \<subset> A`] `finite B`])
  4.1210 -  qed
  4.1211 -qed
  4.1212 -
  4.1213 -text{* main cardinality theorem *}
  4.1214 -lemma card_partition [rule_format]:
  4.1215 -  "finite C ==>
  4.1216 -     finite (\<Union> C) -->
  4.1217 -     (\<forall>c\<in>C. card c = k) -->
  4.1218 -     (\<forall>c1 \<in> C. \<forall>c2 \<in> C. c1 \<noteq> c2 --> c1 \<inter> c2 = {}) -->
  4.1219 -     k * card(C) = card (\<Union> C)"
  4.1220 -apply (erule finite_induct, simp)
  4.1221 -apply (simp add: card_Un_disjoint insert_partition 
  4.1222 -       finite_subset [of _ "\<Union> (insert x F)"])
  4.1223 -done
  4.1224 -
  4.1225 -lemma card_eq_UNIV_imp_eq_UNIV:
  4.1226 -  assumes fin: "finite (UNIV :: 'a set)"
  4.1227 -  and card: "card A = card (UNIV :: 'a set)"
  4.1228 -  shows "A = (UNIV :: 'a set)"
  4.1229 -proof
  4.1230 -  show "A \<subseteq> UNIV" by simp
  4.1231 -  show "UNIV \<subseteq> A"
  4.1232 -  proof
  4.1233 -    fix x
  4.1234 -    show "x \<in> A"
  4.1235 -    proof (rule ccontr)
  4.1236 -      assume "x \<notin> A"
  4.1237 -      then have "A \<subset> UNIV" by auto
  4.1238 -      with fin have "card A < card (UNIV :: 'a set)" by (fact psubset_card_mono)
  4.1239 -      with card show False by simp
  4.1240 -    qed
  4.1241 -  qed
  4.1242 -qed
  4.1243 -
  4.1244 -text{*The form of a finite set of given cardinality*}
  4.1245 -
  4.1246 -lemma card_eq_SucD:
  4.1247 -assumes "card A = Suc k"
  4.1248 -shows "\<exists>b B. A = insert b B & b \<notin> B & card B = k & (k=0 \<longrightarrow> B={})"
  4.1249 -proof -
  4.1250 -  have fin: "finite A" using assms by (auto intro: ccontr)
  4.1251 -  moreover have "card A \<noteq> 0" using assms by auto
  4.1252 -  ultimately obtain b where b: "b \<in> A" by auto
  4.1253 -  show ?thesis
  4.1254 -  proof (intro exI conjI)
  4.1255 -    show "A = insert b (A-{b})" using b by blast
  4.1256 -    show "b \<notin> A - {b}" by blast
  4.1257 -    show "card (A - {b}) = k" and "k = 0 \<longrightarrow> A - {b} = {}"
  4.1258 -      using assms b fin by(fastsimp dest:mk_disjoint_insert)+
  4.1259 -  qed
  4.1260 -qed
  4.1261 -
  4.1262 -lemma card_Suc_eq:
  4.1263 -  "(card A = Suc k) =
  4.1264 -   (\<exists>b B. A = insert b B & b \<notin> B & card B = k & (k=0 \<longrightarrow> B={}))"
  4.1265 -apply(rule iffI)
  4.1266 - apply(erule card_eq_SucD)
  4.1267 -apply(auto)
  4.1268 -apply(subst card_insert)
  4.1269 - apply(auto intro:ccontr)
  4.1270 -done
  4.1271 -
  4.1272 -lemma finite_fun_UNIVD2:
  4.1273 -  assumes fin: "finite (UNIV :: ('a \<Rightarrow> 'b) set)"
  4.1274 -  shows "finite (UNIV :: 'b set)"
  4.1275 -proof -
  4.1276 -  from fin have "finite (range (\<lambda>f :: 'a \<Rightarrow> 'b. f arbitrary))"
  4.1277 -    by(rule finite_imageI)
  4.1278 -  moreover have "UNIV = range (\<lambda>f :: 'a \<Rightarrow> 'b. f arbitrary)"
  4.1279 -    by(rule UNIV_eq_I) auto
  4.1280 -  ultimately show "finite (UNIV :: 'b set)" by simp
  4.1281 -qed
  4.1282 -
  4.1283 -lemma setsum_constant [simp]: "(\<Sum>x \<in> A. y) = of_nat(card A) * y"
  4.1284 -apply (cases "finite A")
  4.1285 -apply (erule finite_induct)
  4.1286 -apply (auto simp add: algebra_simps)
  4.1287 -done
  4.1288 -
  4.1289 -lemma setprod_constant: "finite A ==> (\<Prod>x\<in> A. (y::'a::{comm_monoid_mult})) = y^(card A)"
  4.1290 -apply (erule finite_induct)
  4.1291 -apply auto
  4.1292 -done
  4.1293 -
  4.1294 -lemma setprod_gen_delta:
  4.1295 -  assumes fS: "finite S"
  4.1296 -  shows "setprod (\<lambda>k. if k=a then b k else c) S = (if a \<in> S then (b a ::'a::{comm_monoid_mult}) * c^ (card S - 1) else c^ card S)"
  4.1297 -proof-
  4.1298 -  let ?f = "(\<lambda>k. if k=a then b k else c)"
  4.1299 -  {assume a: "a \<notin> S"
  4.1300 -    hence "\<forall> k\<in> S. ?f k = c" by simp
  4.1301 -    hence ?thesis  using a setprod_constant[OF fS, of c] by (simp add: setprod_1 cong add: setprod_cong) }
  4.1302 -  moreover 
  4.1303 -  {assume a: "a \<in> S"
  4.1304 -    let ?A = "S - {a}"
  4.1305 -    let ?B = "{a}"
  4.1306 -    have eq: "S = ?A \<union> ?B" using a by blast 
  4.1307 -    have dj: "?A \<inter> ?B = {}" by simp
  4.1308 -    from fS have fAB: "finite ?A" "finite ?B" by auto  
  4.1309 -    have fA0:"setprod ?f ?A = setprod (\<lambda>i. c) ?A"
  4.1310 -      apply (rule setprod_cong) by auto
  4.1311 -    have cA: "card ?A = card S - 1" using fS a by auto
  4.1312 -    have fA1: "setprod ?f ?A = c ^ card ?A"  unfolding fA0 apply (rule setprod_constant) using fS by auto
  4.1313 -    have "setprod ?f ?A * setprod ?f ?B = setprod ?f S"
  4.1314 -      using setprod_Un_disjoint[OF fAB dj, of ?f, unfolded eq[symmetric]]
  4.1315 -      by simp
  4.1316 -    then have ?thesis using a cA
  4.1317 -      by (simp add: fA1 ring_simps cong add: setprod_cong cong del: if_weak_cong)}
  4.1318 -  ultimately show ?thesis by blast
  4.1319 -qed
  4.1320 -
  4.1321 -
  4.1322 -lemma setsum_bounded:
  4.1323 -  assumes le: "\<And>i. i\<in>A \<Longrightarrow> f i \<le> (K::'a::{semiring_1, ordered_ab_semigroup_add})"
  4.1324 -  shows "setsum f A \<le> of_nat(card A) * K"
  4.1325 -proof (cases "finite A")
  4.1326 -  case True
  4.1327 -  thus ?thesis using le setsum_mono[where K=A and g = "%x. K"] by simp
  4.1328 -next
  4.1329 -  case False thus ?thesis by (simp add: setsum_def)
  4.1330 -qed
  4.1331 -
  4.1332 -
  4.1333 -lemma card_UNIV_unit: "card (UNIV :: unit set) = 1"
  4.1334 -  unfolding UNIV_unit by simp
  4.1335 -
  4.1336 -
  4.1337 -subsubsection {* Cardinality of unions *}
  4.1338 -
  4.1339 -lemma card_UN_disjoint:
  4.1340 -  "finite I ==> (ALL i:I. finite (A i)) ==>
  4.1341 -   (ALL i:I. ALL j:I. i \<noteq> j --> A i Int A j = {})
  4.1342 -   ==> card (UNION I A) = (\<Sum>i\<in>I. card(A i))"
  4.1343 -apply (simp add: card_def del: setsum_constant)
  4.1344 -apply (subgoal_tac
  4.1345 -         "setsum (%i. card (A i)) I = setsum (%i. (setsum (%x. 1) (A i))) I")
  4.1346 -apply (simp add: setsum_UN_disjoint del: setsum_constant)
  4.1347 -apply (simp cong: setsum_cong)
  4.1348 -done
  4.1349 -
  4.1350 -lemma card_Union_disjoint:
  4.1351 -  "finite C ==> (ALL A:C. finite A) ==>
  4.1352 -   (ALL A:C. ALL B:C. A \<noteq> B --> A Int B = {})
  4.1353 -   ==> card (Union C) = setsum card C"
  4.1354 -apply (frule card_UN_disjoint [of C id])
  4.1355 -apply (unfold Union_def id_def, assumption+)
  4.1356 -done
  4.1357 -
  4.1358 -
  4.1359 -subsubsection {* Cardinality of image *}
  4.1360 -
  4.1361 -text{*The image of a finite set can be expressed using @{term fold_image}.*}
  4.1362 -lemma image_eq_fold_image:
  4.1363 -  "finite A ==> f ` A = fold_image (op Un) (%x. {f x}) {} A"
  4.1364 -proof (induct rule: finite_induct)
  4.1365 -  case empty then show ?case by simp
  4.1366 -next
  4.1367 -  interpret ab_semigroup_mult "op Un"
  4.1368 -    proof qed auto
  4.1369 -  case insert 
  4.1370 -  then show ?case by simp
  4.1371 -qed
  4.1372 -
  4.1373 -lemma card_image_le: "finite A ==> card (f ` A) <= card A"
  4.1374 -apply (induct set: finite)
  4.1375 - apply simp
  4.1376 -apply (simp add: le_SucI card_insert_if)
  4.1377 -done
  4.1378 -
  4.1379 -lemma card_image: "inj_on f A ==> card (f ` A) = card A"
  4.1380 -by(simp add:card_def setsum_reindex o_def del:setsum_constant)
  4.1381 -
  4.1382 -lemma bij_betw_same_card: "bij_betw f A B \<Longrightarrow> card A = card B"
  4.1383 -by(auto simp: card_image bij_betw_def)
  4.1384 -
  4.1385 -lemma endo_inj_surj: "finite A ==> f ` A \<subseteq> A ==> inj_on f A ==> f ` A = A"
  4.1386 -by (simp add: card_seteq card_image)
  4.1387 -
  4.1388 -lemma eq_card_imp_inj_on:
  4.1389 -  "[| finite A; card(f ` A) = card A |] ==> inj_on f A"
  4.1390 -apply (induct rule:finite_induct)
  4.1391 -apply simp
  4.1392 -apply(frule card_image_le[where f = f])
  4.1393 -apply(simp add:card_insert_if split:if_splits)
  4.1394 -done
  4.1395 -
  4.1396 -lemma inj_on_iff_eq_card:
  4.1397 -  "finite A ==> inj_on f A = (card(f ` A) = card A)"
  4.1398 -by(blast intro: card_image eq_card_imp_inj_on)
  4.1399 -
  4.1400 -
  4.1401 -lemma card_inj_on_le:
  4.1402 -  "[|inj_on f A; f ` A \<subseteq> B; finite B |] ==> card A \<le> card B"
  4.1403 -apply (subgoal_tac "finite A") 
  4.1404 - apply (force intro: card_mono simp add: card_image [symmetric])
  4.1405 -apply (blast intro: finite_imageD dest: finite_subset) 
  4.1406 -done
  4.1407 -
  4.1408 -lemma card_bij_eq:
  4.1409 -  "[|inj_on f A; f ` A \<subseteq> B; inj_on g B; g ` B \<subseteq> A;
  4.1410 -     finite A; finite B |] ==> card A = card B"
  4.1411 -by (auto intro: le_antisym card_inj_on_le)
  4.1412 -
  4.1413 -
  4.1414 -subsubsection {* Cardinality of products *}
  4.1415 -
  4.1416 -(*
  4.1417 -lemma SigmaI_insert: "y \<notin> A ==>
  4.1418 -  (SIGMA x:(insert y A). B x) = (({y} <*> (B y)) \<union> (SIGMA x: A. B x))"
  4.1419 -  by auto
  4.1420 -*)
  4.1421 -
  4.1422 -lemma card_SigmaI [simp]:
  4.1423 -  "\<lbrakk> finite A; ALL a:A. finite (B a) \<rbrakk>
  4.1424 -  \<Longrightarrow> card (SIGMA x: A. B x) = (\<Sum>a\<in>A. card (B a))"
  4.1425 -by(simp add:card_def setsum_Sigma del:setsum_constant)
  4.1426 -
  4.1427 -lemma card_cartesian_product: "card (A <*> B) = card(A) * card(B)"
  4.1428 -apply (cases "finite A") 
  4.1429 -apply (cases "finite B") 
  4.1430 -apply (auto simp add: card_eq_0_iff
  4.1431 -            dest: finite_cartesian_productD1 finite_cartesian_productD2)
  4.1432 -done
  4.1433 -
  4.1434 -lemma card_cartesian_product_singleton:  "card({x} <*> A) = card(A)"
  4.1435 -by (simp add: card_cartesian_product)
  4.1436 -
  4.1437 -
  4.1438 -subsubsection {* Cardinality of sums *}
  4.1439 -
  4.1440 -lemma card_Plus:
  4.1441 -  assumes "finite A" and "finite B"
  4.1442 -  shows "card (A <+> B) = card A + card B"
  4.1443 -proof -
  4.1444 -  have "Inl`A \<inter> Inr`B = {}" by fast
  4.1445 -  with assms show ?thesis
  4.1446 -    unfolding Plus_def
  4.1447 -    by (simp add: card_Un_disjoint card_image)
  4.1448 -qed
  4.1449 -
  4.1450 -lemma card_Plus_conv_if:
  4.1451 -  "card (A <+> B) = (if finite A \<and> finite B then card(A) + card(B) else 0)"
  4.1452 -by(auto simp: card_def setsum_Plus simp del: setsum_constant)
  4.1453 -
  4.1454 -
  4.1455 -subsubsection {* Cardinality of the Powerset *}
  4.1456 -
  4.1457 -lemma card_Pow: "finite A ==> card (Pow A) = Suc (Suc 0) ^ card A"  (* FIXME numeral 2 (!?) *)
  4.1458 -apply (induct set: finite)
  4.1459 - apply (simp_all add: Pow_insert)
  4.1460 -apply (subst card_Un_disjoint, blast)
  4.1461 -  apply (blast intro: finite_imageI, blast)
  4.1462 -apply (subgoal_tac "inj_on (insert x) (Pow F)")
  4.1463 - apply (simp add: card_image Pow_insert)
  4.1464 -apply (unfold inj_on_def)
  4.1465 -apply (blast elim!: equalityE)
  4.1466 -done
  4.1467 -
  4.1468 -text {* Relates to equivalence classes.  Based on a theorem of F. Kammüller.  *}
  4.1469 -
  4.1470 -lemma dvd_partition:
  4.1471 -  "finite (Union C) ==>
  4.1472 -    ALL c : C. k dvd card c ==>
  4.1473 -    (ALL c1: C. ALL c2: C. c1 \<noteq> c2 --> c1 Int c2 = {}) ==>
  4.1474 -  k dvd card (Union C)"
  4.1475 -apply(frule finite_UnionD)
  4.1476 -apply(rotate_tac -1)
  4.1477 -apply (induct set: finite, simp_all, clarify)
  4.1478 -apply (subst card_Un_disjoint)
  4.1479 -   apply (auto simp add: disjoint_eq_subset_Compl)
  4.1480 -done
  4.1481 -
  4.1482 -
  4.1483 -subsubsection {* Relating injectivity and surjectivity *}
  4.1484 -
  4.1485 -lemma finite_surj_inj: "finite(A) \<Longrightarrow> A <= f`A \<Longrightarrow> inj_on f A"
  4.1486 -apply(rule eq_card_imp_inj_on, assumption)
  4.1487 -apply(frule finite_imageI)
  4.1488 -apply(drule (1) card_seteq)
  4.1489 - apply(erule card_image_le)
  4.1490 -apply simp
  4.1491 -done
  4.1492 -
  4.1493 -lemma finite_UNIV_surj_inj: fixes f :: "'a \<Rightarrow> 'a"
  4.1494 -shows "finite(UNIV:: 'a set) \<Longrightarrow> surj f \<Longrightarrow> inj f"
  4.1495 -by (blast intro: finite_surj_inj subset_UNIV dest:surj_range)
  4.1496 -
  4.1497 -lemma finite_UNIV_inj_surj: fixes f :: "'a \<Rightarrow> 'a"
  4.1498 -shows "finite(UNIV:: 'a set) \<Longrightarrow> inj f \<Longrightarrow> surj f"
  4.1499 -by(fastsimp simp:surj_def dest!: endo_inj_surj)
  4.1500 -
  4.1501 -corollary infinite_UNIV_nat[iff]: "~finite(UNIV::nat set)"
  4.1502 -proof
  4.1503 -  assume "finite(UNIV::nat set)"
  4.1504 -  with finite_UNIV_inj_surj[of Suc]
  4.1505 -  show False by simp (blast dest: Suc_neq_Zero surjD)
  4.1506 -qed
  4.1507 -
  4.1508 -(* Often leads to bogus ATP proofs because of reduced type information, hence noatp *)
  4.1509 -lemma infinite_UNIV_char_0[noatp]:
  4.1510 -  "\<not> finite (UNIV::'a::semiring_char_0 set)"
  4.1511 -proof
  4.1512 -  assume "finite (UNIV::'a set)"
  4.1513 -  with subset_UNIV have "finite (range of_nat::'a set)"
  4.1514 -    by (rule finite_subset)
  4.1515 -  moreover have "inj (of_nat::nat \<Rightarrow> 'a)"
  4.1516 -    by (simp add: inj_on_def)
  4.1517 -  ultimately have "finite (UNIV::nat set)"
  4.1518 -    by (rule finite_imageD)
  4.1519 -  then show "False"
  4.1520 -    by simp
  4.1521 -qed
  4.1522  
  4.1523  subsection{* A fold functional for non-empty sets *}
  4.1524  
  4.1525 @@ -2811,561 +1354,6 @@
  4.1526  qed
  4.1527  
  4.1528  
  4.1529 -subsubsection {* Fold1 in lattices with @{const inf} and @{const sup} *}
  4.1530 -
  4.1531 -text{*
  4.1532 -  As an application of @{text fold1} we define infimum
  4.1533 -  and supremum in (not necessarily complete!) lattices
  4.1534 -  over (non-empty) sets by means of @{text fold1}.
  4.1535 -*}
  4.1536 -
  4.1537 -context semilattice_inf
  4.1538 -begin
  4.1539 -
  4.1540 -lemma below_fold1_iff:
  4.1541 -  assumes "finite A" "A \<noteq> {}"
  4.1542 -  shows "x \<le> fold1 inf A \<longleftrightarrow> (\<forall>a\<in>A. x \<le> a)"
  4.1543 -proof -
  4.1544 -  interpret ab_semigroup_idem_mult inf
  4.1545 -    by (rule ab_semigroup_idem_mult_inf)
  4.1546 -  show ?thesis using assms by (induct rule: finite_ne_induct) simp_all
  4.1547 -qed
  4.1548 -
  4.1549 -lemma fold1_belowI:
  4.1550 -  assumes "finite A"
  4.1551 -    and "a \<in> A"
  4.1552 -  shows "fold1 inf A \<le> a"
  4.1553 -proof -
  4.1554 -  from assms have "A \<noteq> {}" by auto
  4.1555 -  from `finite A` `A \<noteq> {}` `a \<in> A` show ?thesis
  4.1556 -  proof (induct rule: finite_ne_induct)
  4.1557 -    case singleton thus ?case by simp
  4.1558 -  next
  4.1559 -    interpret ab_semigroup_idem_mult inf
  4.1560 -      by (rule ab_semigroup_idem_mult_inf)
  4.1561 -    case (insert x F)
  4.1562 -    from insert(5) have "a = x \<or> a \<in> F" by simp
  4.1563 -    thus ?case
  4.1564 -    proof
  4.1565 -      assume "a = x" thus ?thesis using insert
  4.1566 -        by (simp add: mult_ac)
  4.1567 -    next
  4.1568 -      assume "a \<in> F"
  4.1569 -      hence bel: "fold1 inf F \<le> a" by (rule insert)
  4.1570 -      have "inf (fold1 inf (insert x F)) a = inf x (inf (fold1 inf F) a)"
  4.1571 -        using insert by (simp add: mult_ac)
  4.1572 -      also have "inf (fold1 inf F) a = fold1 inf F"
  4.1573 -        using bel by (auto intro: antisym)
  4.1574 -      also have "inf x \<dots> = fold1 inf (insert x F)"
  4.1575 -        using insert by (simp add: mult_ac)
  4.1576 -      finally have aux: "inf (fold1 inf (insert x F)) a = fold1 inf (insert x F)" .
  4.1577 -      moreover have "inf (fold1 inf (insert x F)) a \<le> a" by simp
  4.1578 -      ultimately show ?thesis by simp
  4.1579 -    qed
  4.1580 -  qed
  4.1581 -qed
  4.1582 -
  4.1583 -end
  4.1584 -
  4.1585 -context lattice
  4.1586 -begin
  4.1587 -
  4.1588 -definition
  4.1589 -  Inf_fin :: "'a set \<Rightarrow> 'a" ("\<Sqinter>\<^bsub>fin\<^esub>_" [900] 900)
  4.1590 -where
  4.1591 -  "Inf_fin = fold1 inf"
  4.1592 -
  4.1593 -definition
  4.1594 -  Sup_fin :: "'a set \<Rightarrow> 'a" ("\<Squnion>\<^bsub>fin\<^esub>_" [900] 900)
  4.1595 -where
  4.1596 -  "Sup_fin = fold1 sup"
  4.1597 -
  4.1598 -lemma Inf_le_Sup [simp]: "\<lbrakk> finite A; A \<noteq> {} \<rbrakk> \<Longrightarrow> \<Sqinter>\<^bsub>fin\<^esub>A \<le> \<Squnion>\<^bsub>fin\<^esub>A"
  4.1599 -apply(unfold Sup_fin_def Inf_fin_def)
  4.1600 -apply(subgoal_tac "EX a. a:A")
  4.1601 -prefer 2 apply blast
  4.1602 -apply(erule exE)
  4.1603 -apply(rule order_trans)
  4.1604 -apply(erule (1) fold1_belowI)
  4.1605 -apply(erule (1) semilattice_inf.fold1_belowI [OF dual_semilattice])
  4.1606 -done
  4.1607 -
  4.1608 -lemma sup_Inf_absorb [simp]:
  4.1609 -  "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> sup a (\<Sqinter>\<^bsub>fin\<^esub>A) = a"
  4.1610 -apply(subst sup_commute)
  4.1611 -apply(simp add: Inf_fin_def sup_absorb2 fold1_belowI)
  4.1612 -done
  4.1613 -
  4.1614 -lemma inf_Sup_absorb [simp]:
  4.1615 -  "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> inf a (\<Squnion>\<^bsub>fin\<^esub>A) = a"
  4.1616 -by (simp add: Sup_fin_def inf_absorb1
  4.1617 -  semilattice_inf.fold1_belowI [OF dual_semilattice])
  4.1618 -
  4.1619 -end
  4.1620 -
  4.1621 -context distrib_lattice
  4.1622 -begin
  4.1623 -
  4.1624 -lemma sup_Inf1_distrib:
  4.1625 -  assumes "finite A"
  4.1626 -    and "A \<noteq> {}"
  4.1627 -  shows "sup x (\<Sqinter>\<^bsub>fin\<^esub>A) = \<Sqinter>\<^bsub>fin\<^esub>{sup x a|a. a \<in> A}"
  4.1628 -proof -
  4.1629 -  interpret ab_semigroup_idem_mult inf
  4.1630 -    by (rule ab_semigroup_idem_mult_inf)
  4.1631 -  from assms show ?thesis
  4.1632 -    by (simp add: Inf_fin_def image_def
  4.1633 -      hom_fold1_commute [where h="sup x", OF sup_inf_distrib1])
  4.1634 -        (rule arg_cong [where f="fold1 inf"], blast)
  4.1635 -qed
  4.1636 -
  4.1637 -lemma sup_Inf2_distrib:
  4.1638 -  assumes A: "finite A" "A \<noteq> {}" and B: "finite B" "B \<noteq> {}"
  4.1639 -  shows "sup (\<Sqinter>\<^bsub>fin\<^esub>A) (\<Sqinter>\<^bsub>fin\<^esub>B) = \<Sqinter>\<^bsub>fin\<^esub>{sup a b|a b. a \<in> A \<and> b \<in> B}"
  4.1640 -using A proof (induct rule: finite_ne_induct)
  4.1641 -  case singleton thus ?case
  4.1642 -    by (simp add: sup_Inf1_distrib [OF B] fold1_singleton_def [OF Inf_fin_def])
  4.1643 -next
  4.1644 -  interpret ab_semigroup_idem_mult inf
  4.1645 -    by (rule ab_semigroup_idem_mult_inf)
  4.1646 -  case (insert x A)
  4.1647 -  have finB: "finite {sup x b |b. b \<in> B}"
  4.1648 -    by(rule finite_surj[where f = "sup x", OF B(1)], auto)
  4.1649 -  have finAB: "finite {sup a b |a b. a \<in> A \<and> b \<in> B}"
  4.1650 -  proof -
  4.1651 -    have "{sup a b |a b. a \<in> A \<and> b \<in> B} = (UN a:A. UN b:B. {sup a b})"
  4.1652 -      by blast
  4.1653 -    thus ?thesis by(simp add: insert(1) B(1))
  4.1654 -  qed
  4.1655 -  have ne: "{sup a b |a b. a \<in> A \<and> b \<in> B} \<noteq> {}" using insert B by blast
  4.1656 -  have "sup (\<Sqinter>\<^bsub>fin\<^esub>(insert x A)) (\<Sqinter>\<^bsub>fin\<^esub>B) = sup (inf x (\<Sqinter>\<^bsub>fin\<^esub>A)) (\<Sqinter>\<^bsub>fin\<^esub>B)"
  4.1657 -    using insert by (simp add: fold1_insert_idem_def [OF Inf_fin_def])
  4.1658 -  also have "\<dots> = inf (sup x (\<Sqinter>\<^bsub>fin\<^esub>B)) (sup (\<Sqinter>\<^bsub>fin\<^esub>A) (\<Sqinter>\<^bsub>fin\<^esub>B))" by(rule sup_inf_distrib2)
  4.1659 -  also have "\<dots> = inf (\<Sqinter>\<^bsub>fin\<^esub>{sup x b|b. b \<in> B}) (\<Sqinter>\<^bsub>fin\<^esub>{sup a b|a b. a \<in> A \<and> b \<in> B})"
  4.1660 -    using insert by(simp add:sup_Inf1_distrib[OF B])
  4.1661 -  also have "\<dots> = \<Sqinter>\<^bsub>fin\<^esub>({sup x b |b. b \<in> B} \<union> {sup a b |a b. a \<in> A \<and> b \<in> B})"
  4.1662 -    (is "_ = \<Sqinter>\<^bsub>fin\<^esub>?M")
  4.1663 -    using B insert
  4.1664 -    by (simp add: Inf_fin_def fold1_Un2 [OF finB _ finAB ne])
  4.1665 -  also have "?M = {sup a b |a b. a \<in> insert x A \<and> b \<in> B}"
  4.1666 -    by blast
  4.1667 -  finally show ?case .
  4.1668 -qed
  4.1669 -
  4.1670 -lemma inf_Sup1_distrib:
  4.1671 -  assumes "finite A" and "A \<noteq> {}"
  4.1672 -  shows "inf x (\<Squnion>\<^bsub>fin\<^esub>A) = \<Squnion>\<^bsub>fin\<^esub>{inf x a|a. a \<in> A}"
  4.1673 -proof -
  4.1674 -  interpret ab_semigroup_idem_mult sup
  4.1675 -    by (rule ab_semigroup_idem_mult_sup)
  4.1676 -  from assms show ?thesis
  4.1677 -    by (simp add: Sup_fin_def image_def hom_fold1_commute [where h="inf x", OF inf_sup_distrib1])
  4.1678 -      (rule arg_cong [where f="fold1 sup"], blast)
  4.1679 -qed
  4.1680 -
  4.1681 -lemma inf_Sup2_distrib:
  4.1682 -  assumes A: "finite A" "A \<noteq> {}" and B: "finite B" "B \<noteq> {}"
  4.1683 -  shows "inf (\<Squnion>\<^bsub>fin\<^esub>A) (\<Squnion>\<^bsub>fin\<^esub>B) = \<Squnion>\<^bsub>fin\<^esub>{inf a b|a b. a \<in> A \<and> b \<in> B}"
  4.1684 -using A proof (induct rule: finite_ne_induct)
  4.1685 -  case singleton thus ?case
  4.1686 -    by(simp add: inf_Sup1_distrib [OF B] fold1_singleton_def [OF Sup_fin_def])
  4.1687 -next
  4.1688 -  case (insert x A)
  4.1689 -  have finB: "finite {inf x b |b. b \<in> B}"
  4.1690 -    by(rule finite_surj[where f = "%b. inf x b", OF B(1)], auto)
  4.1691 -  have finAB: "finite {inf a b |a b. a \<in> A \<and> b \<in> B}"
  4.1692 -  proof -
  4.1693 -    have "{inf a b |a b. a \<in> A \<and> b \<in> B} = (UN a:A. UN b:B. {inf a b})"
  4.1694 -      by blast
  4.1695 -    thus ?thesis by(simp add: insert(1) B(1))
  4.1696 -  qed
  4.1697 -  have ne: "{inf a b |a b. a \<in> A \<and> b \<in> B} \<noteq> {}" using insert B by blast
  4.1698 -  interpret ab_semigroup_idem_mult sup
  4.1699 -    by (rule ab_semigroup_idem_mult_sup)
  4.1700 -  have "inf (\<Squnion>\<^bsub>fin\<^esub>(insert x A)) (\<Squnion>\<^bsub>fin\<^esub>B) = inf (sup x (\<Squnion>\<^bsub>fin\<^esub>A)) (\<Squnion>\<^bsub>fin\<^esub>B)"
  4.1701 -    using insert by (simp add: fold1_insert_idem_def [OF Sup_fin_def])
  4.1702 -  also have "\<dots> = sup (inf x (\<Squnion>\<^bsub>fin\<^esub>B)) (inf (\<Squnion>\<^bsub>fin\<^esub>A) (\<Squnion>\<^bsub>fin\<^esub>B))" by(rule inf_sup_distrib2)
  4.1703 -  also have "\<dots> = sup (\<Squnion>\<^bsub>fin\<^esub>{inf x b|b. b \<in> B}) (\<Squnion>\<^bsub>fin\<^esub>{inf a b|a b. a \<in> A \<and> b \<in> B})"
  4.1704 -    using insert by(simp add:inf_Sup1_distrib[OF B])
  4.1705 -  also have "\<dots> = \<Squnion>\<^bsub>fin\<^esub>({inf x b |b. b \<in> B} \<union> {inf a b |a b. a \<in> A \<and> b \<in> B})"
  4.1706 -    (is "_ = \<Squnion>\<^bsub>fin\<^esub>?M")
  4.1707 -    using B insert
  4.1708 -    by (simp add: Sup_fin_def fold1_Un2 [OF finB _ finAB ne])
  4.1709 -  also have "?M = {inf a b |a b. a \<in> insert x A \<and> b \<in> B}"
  4.1710 -    by blast
  4.1711 -  finally show ?case .
  4.1712 -qed
  4.1713 -
  4.1714 -end
  4.1715 -
  4.1716 -
  4.1717 -subsubsection {* Fold1 in linear orders with @{const min} and @{const max} *}
  4.1718 -
  4.1719 -text{*
  4.1720 -  As an application of @{text fold1} we define minimum
  4.1721 -  and maximum in (not necessarily complete!) linear orders
  4.1722 -  over (non-empty) sets by means of @{text fold1}.
  4.1723 -*}
  4.1724 -
  4.1725 -context linorder
  4.1726 -begin
  4.1727 -
  4.1728 -lemma ab_semigroup_idem_mult_min:
  4.1729 -  "ab_semigroup_idem_mult min"
  4.1730 -  proof qed (auto simp add: min_def)
  4.1731 -
  4.1732 -lemma ab_semigroup_idem_mult_max:
  4.1733 -  "ab_semigroup_idem_mult max"
  4.1734 -  proof qed (auto simp add: max_def)
  4.1735 -
  4.1736 -lemma max_lattice:
  4.1737 -  "semilattice_inf (op \<ge>) (op >) max"
  4.1738 -  by (fact min_max.dual_semilattice)
  4.1739 -
  4.1740 -lemma dual_max:
  4.1741 -  "ord.max (op \<ge>) = min"
  4.1742 -  by (auto simp add: ord.max_def_raw min_def expand_fun_eq)
  4.1743 -
  4.1744 -lemma dual_min:
  4.1745 -  "ord.min (op \<ge>) = max"
  4.1746 -  by (auto simp add: ord.min_def_raw max_def expand_fun_eq)
  4.1747 -
  4.1748 -lemma strict_below_fold1_iff:
  4.1749 -  assumes "finite A" and "A \<noteq> {}"
  4.1750 -  shows "x < fold1 min A \<longleftrightarrow> (\<forall>a\<in>A. x < a)"
  4.1751 -proof -
  4.1752 -  interpret ab_semigroup_idem_mult min
  4.1753 -    by (rule ab_semigroup_idem_mult_min)
  4.1754 -  from assms show ?thesis
  4.1755 -  by (induct rule: finite_ne_induct)
  4.1756 -    (simp_all add: fold1_insert)
  4.1757 -qed
  4.1758 -
  4.1759 -lemma fold1_below_iff:
  4.1760 -  assumes "finite A" and "A \<noteq> {}"
  4.1761 -  shows "fold1 min A \<le> x \<longleftrightarrow> (\<exists>a\<in>A. a \<le> x)"
  4.1762 -proof -
  4.1763 -  interpret ab_semigroup_idem_mult min
  4.1764 -    by (rule ab_semigroup_idem_mult_min)
  4.1765 -  from assms show ?thesis
  4.1766 -  by (induct rule: finite_ne_induct)
  4.1767 -    (simp_all add: fold1_insert min_le_iff_disj)
  4.1768 -qed
  4.1769 -
  4.1770 -lemma fold1_strict_below_iff:
  4.1771 -  assumes "finite A" and "A \<noteq> {}"
  4.1772 -  shows "fold1 min A < x \<longleftrightarrow> (\<exists>a\<in>A. a < x)"
  4.1773 -proof -
  4.1774 -  interpret ab_semigroup_idem_mult min
  4.1775 -    by (rule ab_semigroup_idem_mult_min)
  4.1776 -  from assms show ?thesis
  4.1777 -  by (induct rule: finite_ne_induct)
  4.1778 -    (simp_all add: fold1_insert min_less_iff_disj)
  4.1779 -qed
  4.1780 -
  4.1781 -lemma fold1_antimono:
  4.1782 -  assumes "A \<noteq> {}" and "A \<subseteq> B" and "finite B"
  4.1783 -  shows "fold1 min B \<le> fold1 min A"
  4.1784 -proof cases
  4.1785 -  assume "A = B" thus ?thesis by simp
  4.1786 -next
  4.1787 -  interpret ab_semigroup_idem_mult min
  4.1788 -    by (rule ab_semigroup_idem_mult_min)
  4.1789 -  assume "A \<noteq> B"
  4.1790 -  have B: "B = A \<union> (B-A)" using `A \<subseteq> B` by blast
  4.1791 -  have "fold1 min B = fold1 min (A \<union> (B-A))" by(subst B)(rule refl)
  4.1792 -  also have "\<dots> = min (fold1 min A) (fold1 min (B-A))"
  4.1793 -  proof -
  4.1794 -    have "finite A" by(rule finite_subset[OF `A \<subseteq> B` `finite B`])
  4.1795 -    moreover have "finite(B-A)" by(rule finite_Diff[OF `finite B`]) (* by(blast intro:finite_Diff prems) fails *)
  4.1796 -    moreover have "(B-A) \<noteq> {}" using prems by blast
  4.1797 -    moreover have "A Int (B-A) = {}" using prems by blast
  4.1798 -    ultimately show ?thesis using `A \<noteq> {}` by (rule_tac fold1_Un)
  4.1799 -  qed
  4.1800 -  also have "\<dots> \<le> fold1 min A" by (simp add: min_le_iff_disj)
  4.1801 -  finally show ?thesis .
  4.1802 -qed
  4.1803 -
  4.1804 -definition
  4.1805 -  Min :: "'a set \<Rightarrow> 'a"
  4.1806 -where
  4.1807 -  "Min = fold1 min"
  4.1808 -
  4.1809 -definition
  4.1810 -  Max :: "'a set \<Rightarrow> 'a"
  4.1811 -where
  4.1812 -  "Max = fold1 max"
  4.1813 -
  4.1814 -lemmas Min_singleton [simp] = fold1_singleton_def [OF Min_def]
  4.1815 -lemmas Max_singleton [simp] = fold1_singleton_def [OF Max_def]
  4.1816 -
  4.1817 -lemma Min_insert [simp]:
  4.1818 -  assumes "finite A" and "A \<noteq> {}"
  4.1819 -  shows "Min (insert x A) = min x (Min A)"
  4.1820 -proof -
  4.1821 -  interpret ab_semigroup_idem_mult min
  4.1822 -    by (rule ab_semigroup_idem_mult_min)
  4.1823 -  from assms show ?thesis by (rule fold1_insert_idem_def [OF Min_def])
  4.1824 -qed
  4.1825 -
  4.1826 -lemma Max_insert [simp]:
  4.1827 -  assumes "finite A" and "A \<noteq> {}"
  4.1828 -  shows "Max (insert x A) = max x (Max A)"
  4.1829 -proof -
  4.1830 -  interpret ab_semigroup_idem_mult max
  4.1831 -    by (rule ab_semigroup_idem_mult_max)
  4.1832 -  from assms show ?thesis by (rule fold1_insert_idem_def [OF Max_def])
  4.1833 -qed
  4.1834 -
  4.1835 -lemma Min_in [simp]:
  4.1836 -  assumes "finite A" and "A \<noteq> {}"
  4.1837 -  shows "Min A \<in> A"
  4.1838 -proof -
  4.1839 -  interpret ab_semigroup_idem_mult min
  4.1840 -    by (rule ab_semigroup_idem_mult_min)
  4.1841 -  from assms fold1_in show ?thesis by (fastsimp simp: Min_def min_def)
  4.1842 -qed
  4.1843 -
  4.1844 -lemma Max_in [simp]:
  4.1845 -  assumes "finite A" and "A \<noteq> {}"
  4.1846 -  shows "Max A \<in> A"
  4.1847 -proof -
  4.1848 -  interpret ab_semigroup_idem_mult max
  4.1849 -    by (rule ab_semigroup_idem_mult_max)
  4.1850 -  from assms fold1_in [of A] show ?thesis by (fastsimp simp: Max_def max_def)
  4.1851 -qed
  4.1852 -
  4.1853 -lemma Min_Un:
  4.1854 -  assumes "finite A" and "A \<noteq> {}" and "finite B" and "B \<noteq> {}"
  4.1855 -  shows "Min (A \<union> B) = min (Min A) (Min B)"
  4.1856 -proof -
  4.1857 -  interpret ab_semigroup_idem_mult min
  4.1858 -    by (rule ab_semigroup_idem_mult_min)
  4.1859 -  from assms show ?thesis
  4.1860 -    by (simp add: Min_def fold1_Un2)
  4.1861 -qed
  4.1862 -
  4.1863 -lemma Max_Un:
  4.1864 -  assumes "finite A" and "A \<noteq> {}" and "finite B" and "B \<noteq> {}"
  4.1865 -  shows "Max (A \<union> B) = max (Max A) (Max B)"
  4.1866 -proof -
  4.1867 -  interpret ab_semigroup_idem_mult max
  4.1868 -    by (rule ab_semigroup_idem_mult_max)
  4.1869 -  from assms show ?thesis
  4.1870 -    by (simp add: Max_def fold1_Un2)
  4.1871 -qed
  4.1872 -
  4.1873 -lemma hom_Min_commute:
  4.1874 -  assumes "\<And>x y. h (min x y) = min (h x) (h y)"
  4.1875 -    and "finite N" and "N \<noteq> {}"
  4.1876 -  shows "h (Min N) = Min (h ` N)"
  4.1877 -proof -
  4.1878 -  interpret ab_semigroup_idem_mult min
  4.1879 -    by (rule ab_semigroup_idem_mult_min)
  4.1880 -  from assms show ?thesis
  4.1881 -    by (simp add: Min_def hom_fold1_commute)
  4.1882 -qed
  4.1883 -
  4.1884 -lemma hom_Max_commute:
  4.1885 -  assumes "\<And>x y. h (max x y) = max (h x) (h y)"
  4.1886 -    and "finite N" and "N \<noteq> {}"
  4.1887 -  shows "h (Max N) = Max (h ` N)"
  4.1888 -proof -
  4.1889 -  interpret ab_semigroup_idem_mult max
  4.1890 -    by (rule ab_semigroup_idem_mult_max)
  4.1891 -  from assms show ?thesis
  4.1892 -    by (simp add: Max_def hom_fold1_commute [of h])
  4.1893 -qed
  4.1894 -
  4.1895 -lemma Min_le [simp]:
  4.1896 -  assumes "finite A" and "x \<in> A"
  4.1897 -  shows "Min A \<le> x"
  4.1898 -  using assms by (simp add: Min_def min_max.fold1_belowI)
  4.1899 -
  4.1900 -lemma Max_ge [simp]:
  4.1901 -  assumes "finite A" and "x \<in> A"
  4.1902 -  shows "x \<le> Max A"
  4.1903 -proof -
  4.1904 -  interpret semilattice_inf "op \<ge>" "op >" max
  4.1905 -    by (rule max_lattice)
  4.1906 -  from assms show ?thesis by (simp add: Max_def fold1_belowI)
  4.1907 -qed
  4.1908 -
  4.1909 -lemma Min_ge_iff [simp, noatp]:
  4.1910 -  assumes "finite A" and "A \<noteq> {}"
  4.1911 -  shows "x \<le> Min A \<longleftrightarrow> (\<forall>a\<in>A. x \<le> a)"
  4.1912 -  using assms by (simp add: Min_def min_max.below_fold1_iff)
  4.1913 -
  4.1914 -lemma Max_le_iff [simp, noatp]:
  4.1915 -  assumes "finite A" and "A \<noteq> {}"
  4.1916 -  shows "Max A \<le> x \<longleftrightarrow> (\<forall>a\<in>A. a \<le> x)"
  4.1917 -proof -
  4.1918 -  interpret semilattice_inf "op \<ge>" "op >" max
  4.1919 -    by (rule max_lattice)
  4.1920 -  from assms show ?thesis by (simp add: Max_def below_fold1_iff)
  4.1921 -qed
  4.1922 -
  4.1923 -lemma Min_gr_iff [simp, noatp]:
  4.1924 -  assumes "finite A" and "A \<noteq> {}"
  4.1925 -  shows "x < Min A \<longleftrightarrow> (\<forall>a\<in>A. x < a)"
  4.1926 -  using assms by (simp add: Min_def strict_below_fold1_iff)
  4.1927 -
  4.1928 -lemma Max_less_iff [simp, noatp]:
  4.1929 -  assumes "finite A" and "A \<noteq> {}"
  4.1930 -  shows "Max A < x \<longleftrightarrow> (\<forall>a\<in>A. a < x)"
  4.1931 -proof -
  4.1932 -  interpret dual: linorder "op \<ge>" "op >"
  4.1933 -    by (rule dual_linorder)
  4.1934 -  from assms show ?thesis
  4.1935 -    by (simp add: Max_def dual.strict_below_fold1_iff [folded dual.dual_max])
  4.1936 -qed
  4.1937 -
  4.1938 -lemma Min_le_iff [noatp]:
  4.1939 -  assumes "finite A" and "A \<noteq> {}"
  4.1940 -  shows "Min A \<le> x \<longleftrightarrow> (\<exists>a\<in>A. a \<le> x)"
  4.1941 -  using assms by (simp add: Min_def fold1_below_iff)
  4.1942 -
  4.1943 -lemma Max_ge_iff [noatp]:
  4.1944 -  assumes "finite A" and "A \<noteq> {}"
  4.1945 -  shows "x \<le> Max A \<longleftrightarrow> (\<exists>a\<in>A. x \<le> a)"
  4.1946 -proof -
  4.1947 -  interpret dual: linorder "op \<ge>" "op >"
  4.1948 -    by (rule dual_linorder)
  4.1949 -  from assms show ?thesis
  4.1950 -    by (simp add: Max_def dual.fold1_below_iff [folded dual.dual_max])
  4.1951 -qed
  4.1952 -
  4.1953 -lemma Min_less_iff [noatp]:
  4.1954 -  assumes "finite A" and "A \<noteq> {}"
  4.1955 -  shows "Min A < x \<longleftrightarrow> (\<exists>a\<in>A. a < x)"
  4.1956 -  using assms by (simp add: Min_def fold1_strict_below_iff)
  4.1957 -
  4.1958 -lemma Max_gr_iff [noatp]:
  4.1959 -  assumes "finite A" and "A \<noteq> {}"
  4.1960 -  shows "x < Max A \<longleftrightarrow> (\<exists>a\<in>A. x < a)"
  4.1961 -proof -
  4.1962 -  interpret dual: linorder "op \<ge>" "op >"
  4.1963 -    by (rule dual_linorder)
  4.1964 -  from assms show ?thesis
  4.1965 -    by (simp add: Max_def dual.fold1_strict_below_iff [folded dual.dual_max])
  4.1966 -qed
  4.1967 -
  4.1968 -lemma Min_eqI:
  4.1969 -  assumes "finite A"
  4.1970 -  assumes "\<And>y. y \<in> A \<Longrightarrow> y \<ge> x"
  4.1971 -    and "x \<in> A"
  4.1972 -  shows "Min A = x"
  4.1973 -proof (rule antisym)
  4.1974 -  from `x \<in> A` have "A \<noteq> {}" by auto
  4.1975 -  with assms show "Min A \<ge> x" by simp
  4.1976 -next
  4.1977 -  from assms show "x \<ge> Min A" by simp
  4.1978 -qed
  4.1979 -
  4.1980 -lemma Max_eqI:
  4.1981 -  assumes "finite A"
  4.1982 -  assumes "\<And>y. y \<in> A \<Longrightarrow> y \<le> x"
  4.1983 -    and "x \<in> A"
  4.1984 -  shows "Max A = x"
  4.1985 -proof (rule antisym)
  4.1986 -  from `x \<in> A` have "A \<noteq> {}" by auto
  4.1987 -  with assms show "Max A \<le> x" by simp
  4.1988 -next
  4.1989 -  from assms show "x \<le> Max A" by simp
  4.1990 -qed
  4.1991 -
  4.1992 -lemma Min_antimono:
  4.1993 -  assumes "M \<subseteq> N" and "M \<noteq> {}" and "finite N"
  4.1994 -  shows "Min N \<le> Min M"
  4.1995 -  using assms by (simp add: Min_def fold1_antimono)
  4.1996 -
  4.1997 -lemma Max_mono:
  4.1998 -  assumes "M \<subseteq> N" and "M \<noteq> {}" and "finite N"
  4.1999 -  shows "Max M \<le> Max N"
  4.2000 -proof -
  4.2001 -  interpret dual: linorder "op \<ge>" "op >"
  4.2002 -    by (rule dual_linorder)
  4.2003 -  from assms show ?thesis
  4.2004 -    by (simp add: Max_def dual.fold1_antimono [folded dual.dual_max])
  4.2005 -qed
  4.2006 -
  4.2007 -lemma finite_linorder_max_induct[consumes 1, case_names empty insert]:
  4.2008 - "finite A \<Longrightarrow> P {} \<Longrightarrow>
  4.2009 -  (!!b A. finite A \<Longrightarrow> ALL a:A. a < b \<Longrightarrow> P A \<Longrightarrow> P(insert b A))
  4.2010 -  \<Longrightarrow> P A"
  4.2011 -proof (induct rule: finite_psubset_induct)
  4.2012 -  fix A :: "'a set"
  4.2013 -  assume IH: "!! B. finite B \<Longrightarrow> B < A \<Longrightarrow> P {} \<Longrightarrow>
  4.2014 -                 (!!b A. finite A \<Longrightarrow> (\<forall>a\<in>A. a<b) \<Longrightarrow> P A \<Longrightarrow> P (insert b A))
  4.2015 -                  \<Longrightarrow> P B"
  4.2016 -  and "finite A" and "P {}"
  4.2017 -  and step: "!!b A. \<lbrakk>finite A; \<forall>a\<in>A. a < b; P A\<rbrakk> \<Longrightarrow> P (insert b A)"
  4.2018 -  show "P A"
  4.2019 -  proof (cases "A = {}")
  4.2020 -    assume "A = {}" thus "P A" using `P {}` by simp
  4.2021 -  next
  4.2022 -    let ?B = "A - {Max A}" let ?A = "insert (Max A) ?B"
  4.2023 -    assume "A \<noteq> {}"
  4.2024 -    with `finite A` have "Max A : A" by auto
  4.2025 -    hence A: "?A = A" using insert_Diff_single insert_absorb by auto
  4.2026 -    moreover have "finite ?B" using `finite A` by simp
  4.2027 -    ultimately have "P ?B" using `P {}` step IH[of ?B] by blast
  4.2028 -    moreover have "\<forall>a\<in>?B. a < Max A" using Max_ge [OF `finite A`] by fastsimp
  4.2029 -    ultimately show "P A" using A insert_Diff_single step[OF `finite ?B`] by fastsimp
  4.2030 -  qed
  4.2031 -qed
  4.2032 -
  4.2033 -lemma finite_linorder_min_induct[consumes 1, case_names empty insert]:
  4.2034 - "\<lbrakk>finite A; P {}; \<And>b A. \<lbrakk>finite A; \<forall>a\<in>A. b < a; P A\<rbrakk> \<Longrightarrow> P (insert b A)\<rbrakk> \<Longrightarrow> P A"
  4.2035 -by(rule linorder.finite_linorder_max_induct[OF dual_linorder])
  4.2036 -
  4.2037 -end
  4.2038 -
  4.2039 -context linordered_ab_semigroup_add
  4.2040 -begin
  4.2041 -
  4.2042 -lemma add_Min_commute:
  4.2043 -  fixes k
  4.2044 -  assumes "finite N" and "N \<noteq> {}"
  4.2045 -  shows "k + Min N = Min {k + m | m. m \<in> N}"
  4.2046 -proof -
  4.2047 -  have "\<And>x y. k + min x y = min (k + x) (k + y)"
  4.2048 -    by (simp add: min_def not_le)
  4.2049 -      (blast intro: antisym less_imp_le add_left_mono)
  4.2050 -  with assms show ?thesis
  4.2051 -    using hom_Min_commute [of "plus k" N]
  4.2052 -    by simp (blast intro: arg_cong [where f = Min])
  4.2053 -qed
  4.2054 -
  4.2055 -lemma add_Max_commute:
  4.2056 -  fixes k
  4.2057 -  assumes "finite N" and "N \<noteq> {}"
  4.2058 -  shows "k + Max N = Max {k + m | m. m \<in> N}"
  4.2059 -proof -
  4.2060 -  have "\<And>x y. k + max x y = max (k + x) (k + y)"
  4.2061 -    by (simp add: max_def not_le)
  4.2062 -      (blast intro: antisym less_imp_le add_left_mono)
  4.2063 -  with assms show ?thesis
  4.2064 -    using hom_Max_commute [of "plus k" N]
  4.2065 -    by simp (blast intro: arg_cong [where f = Max])
  4.2066 -qed
  4.2067 -
  4.2068 -end
  4.2069 -
  4.2070 -context linordered_ab_group_add
  4.2071 -begin
  4.2072 -
  4.2073 -lemma minus_Max_eq_Min [simp]:
  4.2074 -  "finite S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> - (Max S) = Min (uminus ` S)"
  4.2075 -  by (induct S rule: finite_ne_induct) (simp_all add: minus_max_eq_min)
  4.2076 -
  4.2077 -lemma minus_Min_eq_Max [simp]:
  4.2078 -  "finite S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> - (Min S) = Max (uminus ` S)"
  4.2079 -  by (induct S rule: finite_ne_induct) (simp_all add: minus_min_eq_max)
  4.2080 -
  4.2081 -end
  4.2082 -
  4.2083 -
  4.2084  subsection {* Expressing set operations via @{const fold} *}
  4.2085  
  4.2086  lemma (in fun_left_comm) fun_left_comm_apply:
  4.2087 @@ -3445,32 +1433,6 @@
  4.2088    shows "Sup A = fold sup bot A"
  4.2089    using assms sup_Sup_fold_sup [of A bot] by (simp add: sup_absorb2)
  4.2090  
  4.2091 -lemma Inf_fin_Inf:
  4.2092 -  assumes "finite A" and "A \<noteq> {}"
  4.2093 -  shows "\<Sqinter>\<^bsub>fin\<^esub>A = Inf A"
  4.2094 -proof -
  4.2095 -  interpret ab_semigroup_idem_mult inf
  4.2096 -    by (rule ab_semigroup_idem_mult_inf)
  4.2097 -  from `A \<noteq> {}` obtain b B where "A = insert b B" by auto
  4.2098 -  moreover with `finite A` have "finite B" by simp
  4.2099 -  ultimately show ?thesis  
  4.2100 -  by (simp add: Inf_fin_def fold1_eq_fold_idem inf_Inf_fold_inf [symmetric])
  4.2101 -    (simp add: Inf_fold_inf)
  4.2102 -qed
  4.2103 -
  4.2104 -lemma Sup_fin_Sup:
  4.2105 -  assumes "finite A" and "A \<noteq> {}"
  4.2106 -  shows "\<Squnion>\<^bsub>fin\<^esub>A = Sup A"
  4.2107 -proof -
  4.2108 -  interpret ab_semigroup_idem_mult sup
  4.2109 -    by (rule ab_semigroup_idem_mult_sup)
  4.2110 -  from `A \<noteq> {}` obtain b B where "A = insert b B" by auto
  4.2111 -  moreover with `finite A` have "finite B" by simp
  4.2112 -  ultimately show ?thesis  
  4.2113 -  by (simp add: Sup_fin_def fold1_eq_fold_idem sup_Sup_fold_sup [symmetric])
  4.2114 -    (simp add: Sup_fold_sup)
  4.2115 -qed
  4.2116 -
  4.2117  lemma inf_INFI_fold_inf:
  4.2118    assumes "finite A"
  4.2119    shows "inf B (INFI A f) = fold (\<lambda>A. inf (f A)) B A" (is "?inf = ?fold") 
  4.2120 @@ -3505,4 +1467,661 @@
  4.2121  
  4.2122  end
  4.2123  
  4.2124 +
  4.2125 +subsection {* Locales as mini-packages *}
  4.2126 +
  4.2127 +locale folding =
  4.2128 +  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'b"
  4.2129 +  fixes F :: "'a set \<Rightarrow> 'b \<Rightarrow> 'b"
  4.2130 +  assumes commute_comp: "f x \<circ> f y = f y \<circ> f x"
  4.2131 +  assumes eq_fold: "finite A \<Longrightarrow> F A s = fold f s A"
  4.2132 +begin
  4.2133 +
  4.2134 +lemma fun_left_commute:
  4.2135 +  "f x (f y s) = f y (f x s)"
  4.2136 +  using commute_comp [of x y] by (simp add: expand_fun_eq)
  4.2137 +
  4.2138 +lemma fun_left_comm:
  4.2139 +  "fun_left_comm f"
  4.2140 +proof
  4.2141 +qed (fact fun_left_commute)
  4.2142 +
  4.2143 +lemma empty [simp]:
  4.2144 +  "F {} = id"
  4.2145 +  by (simp add: eq_fold expand_fun_eq)
  4.2146 +
  4.2147 +lemma insert [simp]:
  4.2148 +  assumes "finite A" and "x \<notin> A"
  4.2149 +  shows "F (insert x A) = F A \<circ> f x"
  4.2150 +proof -
  4.2151 +  interpret fun_left_comm f by (fact fun_left_comm)
  4.2152 +  from fold_insert2 assms
  4.2153 +  have "\<And>s. fold f s (insert x A) = fold f (f x s) A" .
  4.2154 +  with `finite A` show ?thesis by (simp add: eq_fold expand_fun_eq)
  4.2155 +qed
  4.2156 +
  4.2157 +lemma remove:
  4.2158 +  assumes "finite A" and "x \<in> A"
  4.2159 +  shows "F A = F (A - {x}) \<circ> f x"
  4.2160 +proof -
  4.2161 +  from `x \<in> A` obtain B where A: "A = insert x B" and "x \<notin> B"
  4.2162 +    by (auto dest: mk_disjoint_insert)
  4.2163 +  moreover from `finite A` this have "finite B" by simp
  4.2164 +  ultimately show ?thesis by simp
  4.2165 +qed
  4.2166 +
  4.2167 +lemma insert_remove:
  4.2168 +  assumes "finite A"
  4.2169 +  shows "F (insert x A) = F (A - {x}) \<circ> f x"
  4.2170 +  using assms by (cases "x \<in> A") (simp_all add: remove insert_absorb)
  4.2171 +
  4.2172 +lemma commute_comp':
  4.2173 +  assumes "finite A"
  4.2174 +  shows "f x \<circ> F A = F A \<circ> f x"
  4.2175 +proof (rule ext)
  4.2176 +  fix s
  4.2177 +  from assms show "(f x \<circ> F A) s = (F A \<circ> f x) s"
  4.2178 +    by (induct A arbitrary: s) (simp_all add: fun_left_commute)
  4.2179 +qed
  4.2180 +
  4.2181 +lemma fun_left_commute':
  4.2182 +  assumes "finite A"
  4.2183 +  shows "f x (F A s) = F A (f x s)"
  4.2184 +  using commute_comp' assms by (simp add: expand_fun_eq)
  4.2185 +
  4.2186 +lemma union:
  4.2187 +  assumes "finite A" and "finite B"
  4.2188 +  and "A \<inter> B = {}"
  4.2189 +  shows "F (A \<union> B) = F A \<circ> F B"
  4.2190 +using `finite A` `A \<inter> B = {}` proof (induct A)
  4.2191 +  case empty show ?case by simp
  4.2192 +next
  4.2193 +  case (insert x A)
  4.2194 +  then have "A \<inter> B = {}" by auto
  4.2195 +  with insert(3) have "F (A \<union> B) = F A \<circ> F B" .
  4.2196 +  moreover from insert have "x \<notin> B" by simp
  4.2197 +  moreover from `finite A` `finite B` have fin: "finite (A \<union> B)" by simp
  4.2198 +  moreover from `x \<notin> A` `x \<notin> B` have "x \<notin> A \<union> B" by simp
  4.2199 +  ultimately show ?case by (simp add: fun_left_commute')
  4.2200 +qed
  4.2201 +
  4.2202  end
  4.2203 +
  4.2204 +locale folding_idem = folding +
  4.2205 +  assumes idem_comp: "f x \<circ> f x = f x"
  4.2206 +begin
  4.2207 +
  4.2208 +declare insert [simp del]
  4.2209 +
  4.2210 +lemma fun_idem:
  4.2211 +  "f x (f x s) = f x s"
  4.2212 +  using idem_comp [of x] by (simp add: expand_fun_eq)
  4.2213 +
  4.2214 +lemma fun_left_comm_idem:
  4.2215 +  "fun_left_comm_idem f"
  4.2216 +proof
  4.2217 +qed (fact fun_left_commute fun_idem)+
  4.2218 +
  4.2219 +lemma insert_idem [simp]:
  4.2220 +  assumes "finite A"
  4.2221 +  shows "F (insert x A) = F A \<circ> f x"
  4.2222 +proof -
  4.2223 +  interpret fun_left_comm_idem f by (fact fun_left_comm_idem)
  4.2224 +  from fold_insert_idem2 assms
  4.2225 +  have "\<And>s. fold f s (insert x A) = fold f (f x s) A" .
  4.2226 +  with assms show ?thesis by (simp add: eq_fold expand_fun_eq)
  4.2227 +qed
  4.2228 +
  4.2229 +lemma union_idem:
  4.2230 +  assumes "finite A" and "finite B"
  4.2231 +  shows "F (A \<union> B) = F A \<circ> F B"
  4.2232 +using `finite A` proof (induct A)
  4.2233 +  case empty show ?case by simp
  4.2234 +next
  4.2235 +  case (insert x A)
  4.2236 +  from insert(3) have "F (A \<union> B) = F A \<circ> F B" .
  4.2237 +  moreover from `finite A` `finite B` have fin: "finite (A \<union> B)" by simp
  4.2238 +  ultimately show ?case by (simp add: fun_left_commute')
  4.2239 +qed
  4.2240 +
  4.2241 +end
  4.2242 +
  4.2243 +no_notation (in times) times (infixl "*" 70)
  4.2244 +no_notation (in one) Groups.one ("1")
  4.2245 +
  4.2246 +locale folding_image_simple = comm_monoid +
  4.2247 +  fixes g :: "('b \<Rightarrow> 'a)"
  4.2248 +  fixes F :: "'b set \<Rightarrow> 'a"
  4.2249 +  assumes eq_fold: "finite A \<Longrightarrow> F A = fold_image f g 1 A"
  4.2250 +begin
  4.2251 +
  4.2252 +lemma empty [simp]:
  4.2253 +  "F {} = 1"
  4.2254 +  by (simp add: eq_fold)
  4.2255 +
  4.2256 +lemma insert [simp]:
  4.2257 +  assumes "finite A" and "x \<notin> A"
  4.2258 +  shows "F (insert x A) = g x * F A"
  4.2259 +proof -
  4.2260 +  interpret fun_left_comm "%x y. (g x) * y" proof
  4.2261 +  qed (simp add: ac_simps)
  4.2262 +  with assms have "fold_image (op *) g 1 (insert x A) = g x * fold_image (op *) g 1 A"
  4.2263 +    by (simp add: fold_image_def)
  4.2264 +  with `finite A` show ?thesis by (simp add: eq_fold)
  4.2265 +qed
  4.2266 +
  4.2267 +lemma remove:
  4.2268 +  assumes "finite A" and "x \<in> A"
  4.2269 +  shows "F A = g x * F (A - {x})"
  4.2270 +proof -
  4.2271 +  from `x \<in> A` obtain B where A: "A = insert x B" and "x \<notin> B"
  4.2272 +    by (auto dest: mk_disjoint_insert)
  4.2273 +  moreover from `finite A` this have "finite B" by simp
  4.2274 +  ultimately show ?thesis by simp
  4.2275 +qed
  4.2276 +
  4.2277 +lemma insert_remove:
  4.2278 +  assumes "finite A"
  4.2279 +  shows "F (insert x A) = g x * F (A - {x})"
  4.2280 +  using assms by (cases "x \<in> A") (simp_all add: remove insert_absorb)
  4.2281 +
  4.2282 +lemma union_inter:
  4.2283 +  assumes "finite A" and "finite B"
  4.2284 +  shows "F A * F B = F (A \<union> B) * F (A \<inter> B)"
  4.2285 +using assms proof (induct A)
  4.2286 +  case empty then show ?case by simp
  4.2287 +next
  4.2288 +  case (insert x A) then show ?case
  4.2289 +    by (auto simp add: insert_absorb Int_insert_left commute [of _ "g x"] assoc left_commute)
  4.2290 +qed
  4.2291 +
  4.2292 +corollary union_disjoint:
  4.2293 +  assumes "finite A" and "finite B"
  4.2294 +  assumes "A \<inter> B = {}"
  4.2295 +  shows "F (A \<union> B) = F A * F B"
  4.2296 +  using assms by (simp add: union_inter)
  4.2297 +
  4.2298 +end
  4.2299 +
  4.2300 +locale folding_image = comm_monoid +
  4.2301 +  fixes F :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b set \<Rightarrow> 'a"
  4.2302 +  assumes eq_fold: "\<And>g. finite A \<Longrightarrow> F g A = fold_image f g 1 A"
  4.2303 +
  4.2304 +sublocale folding_image < folding_image_simple "op *" 1 g "F g" proof
  4.2305 +qed (fact eq_fold)
  4.2306 +
  4.2307 +context folding_image
  4.2308 +begin
  4.2309 +
  4.2310 +lemma reindex:
  4.2311 +  assumes "finite A" and "inj_on h A"
  4.2312 +  shows "F g (h ` A) = F (g \<circ> h) A"
  4.2313 +  using assms by (induct A) auto
  4.2314 +
  4.2315 +lemma cong:
  4.2316 +  assumes "finite A" and "\<And>x. x \<in> A \<Longrightarrow> g x = h x"
  4.2317 +  shows "F g A = F h A"
  4.2318 +proof -
  4.2319 +  from assms have "ALL C. C <= A --> (ALL x:C. g x = h x) --> F g C = F h C"
  4.2320 +  apply - apply (erule finite_induct) apply simp
  4.2321 +  apply (simp add: subset_insert_iff, clarify)
  4.2322 +  apply (subgoal_tac "finite C")
  4.2323 +  prefer 2 apply (blast dest: finite_subset [COMP swap_prems_rl])
  4.2324 +  apply (subgoal_tac "C = insert x (C - {x})")
  4.2325 +  prefer 2 apply blast
  4.2326 +  apply (erule ssubst)
  4.2327 +  apply (drule spec)
  4.2328 +  apply (erule (1) notE impE)
  4.2329 +  apply (simp add: Ball_def del: insert_Diff_single)
  4.2330 +  done
  4.2331 +  with assms show ?thesis by simp
  4.2332 +qed
  4.2333 +
  4.2334 +lemma UNION_disjoint:
  4.2335 +  assumes "finite I" and "\<forall>i\<in>I. finite (A i)"
  4.2336 +  and "\<forall>i\<in>I. \<forall>j\<in>I. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}"
  4.2337 +  shows "F g (UNION I A) = F (F g \<circ> A) I"
  4.2338 +apply (insert assms)
  4.2339 +apply (induct set: finite, simp, atomize)
  4.2340 +apply (subgoal_tac "\<forall>i\<in>Fa. x \<noteq> i")
  4.2341 + prefer 2 apply blast
  4.2342 +apply (subgoal_tac "A x Int UNION Fa A = {}")
  4.2343 + prefer 2 apply blast
  4.2344 +apply (simp add: union_disjoint)
  4.2345 +done
  4.2346 +
  4.2347 +lemma distrib:
  4.2348 +  assumes "finite A"
  4.2349 +  shows "F (\<lambda>x. g x * h x) A = F g A * F h A"
  4.2350 +  using assms by (rule finite_induct) (simp_all add: assoc commute left_commute)
  4.2351 +
  4.2352 +lemma related: 
  4.2353 +  assumes Re: "R 1 1" 
  4.2354 +  and Rop: "\<forall>x1 y1 x2 y2. R x1 x2 \<and> R y1 y2 \<longrightarrow> R (x1 * y1) (x2 * y2)" 
  4.2355 +  and fS: "finite S" and Rfg: "\<forall>x\<in>S. R (h x) (g x)"
  4.2356 +  shows "R (F h S) (F g S)"
  4.2357 +  using fS by (rule finite_subset_induct) (insert assms, auto)
  4.2358 +
  4.2359 +lemma eq_general:
  4.2360 +  assumes fS: "finite S"
  4.2361 +  and h: "\<forall>y\<in>S'. \<exists>!x. x \<in> S \<and> h x = y" 
  4.2362 +  and f12:  "\<forall>x\<in>S. h x \<in> S' \<and> f2 (h x) = f1 x"
  4.2363 +  shows "F f1 S = F f2 S'"
  4.2364 +proof-
  4.2365 +  from h f12 have hS: "h ` S = S'" by blast
  4.2366 +  {fix x y assume H: "x \<in> S" "y \<in> S" "h x = h y"
  4.2367 +    from f12 h H  have "x = y" by auto }
  4.2368 +  hence hinj: "inj_on h S" unfolding inj_on_def Ex1_def by blast
  4.2369 +  from f12 have th: "\<And>x. x \<in> S \<Longrightarrow> (f2 \<circ> h) x = f1 x" by auto 
  4.2370 +  from hS have "F f2 S' = F f2 (h ` S)" by simp
  4.2371 +  also have "\<dots> = F (f2 o h) S" using reindex [OF fS hinj, of f2] .
  4.2372 +  also have "\<dots> = F f1 S " using th cong [OF fS, of "f2 o h" f1]
  4.2373 +    by blast
  4.2374 +  finally show ?thesis ..
  4.2375 +qed
  4.2376 +
  4.2377 +lemma eq_general_inverses:
  4.2378 +  assumes fS: "finite S" 
  4.2379 +  and kh: "\<And>y. y \<in> T \<Longrightarrow> k y \<in> S \<and> h (k y) = y"
  4.2380 +  and hk: "\<And>x. x \<in> S \<Longrightarrow> h x \<in> T \<and> k (h x) = x \<and> g (h x) = j x"
  4.2381 +  shows "F j S = F g T"
  4.2382 +  (* metis solves it, but not yet available here *)
  4.2383 +  apply (rule eq_general [OF fS, of T h g j])
  4.2384 +  apply (rule ballI)
  4.2385 +  apply (frule kh)
  4.2386 +  apply (rule ex1I[])
  4.2387 +  apply blast
  4.2388 +  apply clarsimp
  4.2389 +  apply (drule hk) apply simp
  4.2390 +  apply (rule sym)
  4.2391 +  apply (erule conjunct1[OF conjunct2[OF hk]])
  4.2392 +  apply (rule ballI)
  4.2393 +  apply (drule hk)
  4.2394 +  apply blast
  4.2395 +  done
  4.2396 +
  4.2397 +end
  4.2398 +
  4.2399 +notation (in times) times (infixl "*" 70)
  4.2400 +notation (in one) Groups.one ("1")
  4.2401 +
  4.2402 +
  4.2403 +subsection {* Finite cardinality *}
  4.2404 +
  4.2405 +text {* This definition, although traditional, is ugly to work with:
  4.2406 +@{text "card A == LEAST n. EX f. A = {f i | i. i < n}"}.
  4.2407 +But now that we have @{text fold_image} things are easy:
  4.2408 +*}
  4.2409 +
  4.2410 +definition card :: "'a set \<Rightarrow> nat" where
  4.2411 +  "card A = (if finite A then fold_image (op +) (\<lambda>x. 1) 0 A else 0)"
  4.2412 +
  4.2413 +interpretation card!: folding_image_simple "op +" 0 "\<lambda>x. 1" card proof
  4.2414 +qed (simp add: card_def)
  4.2415 +
  4.2416 +lemma card_infinite [simp]:
  4.2417 +  "\<not> finite A \<Longrightarrow> card A = 0"
  4.2418 +  by (simp add: card_def)
  4.2419 +
  4.2420 +lemma card_empty:
  4.2421 +  "card {} = 0"
  4.2422 +  by (fact card.empty)
  4.2423 +
  4.2424 +lemma card_insert_disjoint:
  4.2425 +  "finite A ==> x \<notin> A ==> card (insert x A) = Suc (card A)"
  4.2426 +  by simp
  4.2427 +
  4.2428 +lemma card_insert_if:
  4.2429 +  "finite A ==> card (insert x A) = (if x \<in> A then card A else Suc (card A))"
  4.2430 +  by auto (simp add: card.insert_remove card.remove)
  4.2431 +
  4.2432 +lemma card_ge_0_finite:
  4.2433 +  "card A > 0 \<Longrightarrow> finite A"
  4.2434 +  by (rule ccontr) simp
  4.2435 +
  4.2436 +lemma card_0_eq [simp, noatp]:
  4.2437 +  "finite A \<Longrightarrow> card A = 0 \<longleftrightarrow> A = {}"
  4.2438 +  by (auto dest: mk_disjoint_insert)
  4.2439 +
  4.2440 +lemma finite_UNIV_card_ge_0:
  4.2441 +  "finite (UNIV :: 'a set) \<Longrightarrow> card (UNIV :: 'a set) > 0"
  4.2442 +  by (rule ccontr) simp
  4.2443 +
  4.2444 +lemma card_eq_0_iff:
  4.2445 +  "card A = 0 \<longleftrightarrow> A = {} \<or> \<not> finite A"
  4.2446 +  by auto
  4.2447 +
  4.2448 +lemma card_gt_0_iff:
  4.2449 +  "0 < card A \<longleftrightarrow> A \<noteq> {} \<and> finite A"
  4.2450 +  by (simp add: neq0_conv [symmetric] card_eq_0_iff) 
  4.2451 +
  4.2452 +lemma card_Suc_Diff1: "finite A ==> x: A ==> Suc (card (A - {x})) = card A"
  4.2453 +apply(rule_tac t = A in insert_Diff [THEN subst], assumption)
  4.2454 +apply(simp del:insert_Diff_single)
  4.2455 +done
  4.2456 +
  4.2457 +lemma card_Diff_singleton:
  4.2458 +  "finite A ==> x: A ==> card (A - {x}) = card A - 1"
  4.2459 +by (simp add: card_Suc_Diff1 [symmetric])
  4.2460 +
  4.2461 +lemma card_Diff_singleton_if:
  4.2462 +  "finite A ==> card (A-{x}) = (if x : A then card A - 1 else card A)"
  4.2463 +by (simp add: card_Diff_singleton)
  4.2464 +
  4.2465 +lemma card_Diff_insert[simp]:
  4.2466 +assumes "finite A" and "a:A" and "a ~: B"
  4.2467 +shows "card(A - insert a B) = card(A - B) - 1"
  4.2468 +proof -
  4.2469 +  have "A - insert a B = (A - B) - {a}" using assms by blast
  4.2470 +  then show ?thesis using assms by(simp add:card_Diff_singleton)
  4.2471 +qed
  4.2472 +
  4.2473 +lemma card_insert: "finite A ==> card (insert x A) = Suc (card (A - {x}))"
  4.2474 +by (simp add: card_insert_if card_Suc_Diff1 del:card_Diff_insert)
  4.2475 +
  4.2476 +lemma card_insert_le: "finite A ==> card A <= card (insert x A)"
  4.2477 +by (simp add: card_insert_if)
  4.2478 +
  4.2479 +lemma card_mono:
  4.2480 +  assumes "finite B" and "A \<subseteq> B"
  4.2481 +  shows "card A \<le> card B"
  4.2482 +proof -
  4.2483 +  from assms have "finite A" by (auto intro: finite_subset)
  4.2484 +  then show ?thesis using assms proof (induct A arbitrary: B)
  4.2485 +    case empty then show ?case by simp
  4.2486 +  next
  4.2487 +    case (insert x A)
  4.2488 +    then have "x \<in> B" by simp
  4.2489 +    from insert have "A \<subseteq> B - {x}" and "finite (B - {x})" by auto
  4.2490 +    with insert.hyps have "card A \<le> card (B - {x})" by auto
  4.2491 +    with `finite A` `x \<notin> A` `finite B` `x \<in> B` show ?case by simp (simp only: card.remove)
  4.2492 +  qed
  4.2493 +qed
  4.2494 +
  4.2495 +lemma card_seteq: "finite B ==> (!!A. A <= B ==> card B <= card A ==> A = B)"
  4.2496 +apply (induct set: finite, simp, clarify)
  4.2497 +apply (subgoal_tac "finite A & A - {x} <= F")
  4.2498 + prefer 2 apply (blast intro: finite_subset, atomize)
  4.2499 +apply (drule_tac x = "A - {x}" in spec)
  4.2500 +apply (simp add: card_Diff_singleton_if split add: split_if_asm)
  4.2501 +apply (case_tac "card A", auto)
  4.2502 +done
  4.2503 +
  4.2504 +lemma psubset_card_mono: "finite B ==> A < B ==> card A < card B"
  4.2505 +apply (simp add: psubset_eq linorder_not_le [symmetric])
  4.2506 +apply (blast dest: card_seteq)
  4.2507 +done
  4.2508 +
  4.2509 +lemma card_Un_Int: "finite A ==> finite B
  4.2510 +    ==> card A + card B = card (A Un B) + card (A Int B)"
  4.2511 +  by (fact card.union_inter)
  4.2512 +
  4.2513 +lemma card_Un_disjoint: "finite A ==> finite B
  4.2514 +    ==> A Int B = {} ==> card (A Un B) = card A + card B"
  4.2515 +  by (fact card.union_disjoint)
  4.2516 +
  4.2517 +lemma card_Diff_subset:
  4.2518 +  assumes "finite B" and "B \<subseteq> A"
  4.2519 +  shows "card (A - B) = card A - card B"
  4.2520 +proof (cases "finite A")
  4.2521 +  case False with assms show ?thesis by simp
  4.2522 +next
  4.2523 +  case True with assms show ?thesis by (induct B arbitrary: A) simp_all
  4.2524 +qed
  4.2525 +
  4.2526 +lemma card_Diff_subset_Int:
  4.2527 +  assumes AB: "finite (A \<inter> B)" shows "card (A - B) = card A - card (A \<inter> B)"
  4.2528 +proof -
  4.2529 +  have "A - B = A - A \<inter> B" by auto
  4.2530 +  thus ?thesis
  4.2531 +    by (simp add: card_Diff_subset AB) 
  4.2532 +qed
  4.2533 +
  4.2534 +lemma card_Diff1_less: "finite A ==> x: A ==> card (A - {x}) < card A"
  4.2535 +apply (rule Suc_less_SucD)
  4.2536 +apply (simp add: card_Suc_Diff1 del:card_Diff_insert)
  4.2537 +done
  4.2538 +
  4.2539 +lemma card_Diff2_less:
  4.2540 +  "finite A ==> x: A ==> y: A ==> card (A - {x} - {y}) < card A"
  4.2541 +apply (case_tac "x = y")
  4.2542 + apply (simp add: card_Diff1_less del:card_Diff_insert)
  4.2543 +apply (rule less_trans)
  4.2544 + prefer 2 apply (auto intro!: card_Diff1_less simp del:card_Diff_insert)
  4.2545 +done
  4.2546 +
  4.2547 +lemma card_Diff1_le: "finite A ==> card (A - {x}) <= card A"
  4.2548 +apply (case_tac "x : A")
  4.2549 + apply (simp_all add: card_Diff1_less less_imp_le)
  4.2550 +done
  4.2551 +
  4.2552 +lemma card_psubset: "finite B ==> A \<subseteq> B ==> card A < card B ==> A < B"
  4.2553 +by (erule psubsetI, blast)
  4.2554 +
  4.2555 +lemma insert_partition:
  4.2556 +  "\<lbrakk> x \<notin> F; \<forall>c1 \<in> insert x F. \<forall>c2 \<in> insert x F. c1 \<noteq> c2 \<longrightarrow> c1 \<inter> c2 = {} \<rbrakk>
  4.2557 +  \<Longrightarrow> x \<inter> \<Union> F = {}"
  4.2558 +by auto
  4.2559 +
  4.2560 +lemma finite_psubset_induct[consumes 1, case_names psubset]:
  4.2561 +  assumes "finite A" and "!!A. finite A \<Longrightarrow> (!!B. finite B \<Longrightarrow> B \<subset> A \<Longrightarrow> P(B)) \<Longrightarrow> P(A)" shows "P A"
  4.2562 +using assms(1)
  4.2563 +proof (induct A rule: measure_induct_rule[where f=card])
  4.2564 +  case (less A)
  4.2565 +  show ?case
  4.2566 +  proof(rule assms(2)[OF less(2)])
  4.2567 +    fix B assume "finite B" "B \<subset> A"
  4.2568 +    show "P B" by(rule less(1)[OF psubset_card_mono[OF less(2) `B \<subset> A`] `finite B`])
  4.2569 +  qed
  4.2570 +qed
  4.2571 +
  4.2572 +text{* main cardinality theorem *}
  4.2573 +lemma card_partition [rule_format]:
  4.2574 +  "finite C ==>
  4.2575 +     finite (\<Union> C) -->
  4.2576 +     (\<forall>c\<in>C. card c = k) -->
  4.2577 +     (\<forall>c1 \<in> C. \<forall>c2 \<in> C. c1 \<noteq> c2 --> c1 \<inter> c2 = {}) -->
  4.2578 +     k * card(C) = card (\<Union> C)"
  4.2579 +apply (erule finite_induct, simp)
  4.2580 +apply (simp add: card_Un_disjoint insert_partition 
  4.2581 +       finite_subset [of _ "\<Union> (insert x F)"])
  4.2582 +done
  4.2583 +
  4.2584 +lemma card_eq_UNIV_imp_eq_UNIV:
  4.2585 +  assumes fin: "finite (UNIV :: 'a set)"
  4.2586 +  and card: "card A = card (UNIV :: 'a set)"
  4.2587 +  shows "A = (UNIV :: 'a set)"
  4.2588 +proof
  4.2589 +  show "A \<subseteq> UNIV" by simp
  4.2590 +  show "UNIV \<subseteq> A"
  4.2591 +  proof
  4.2592 +    fix x
  4.2593 +    show "x \<in> A"
  4.2594 +    proof (rule ccontr)
  4.2595 +      assume "x \<notin> A"
  4.2596 +      then have "A \<subset> UNIV" by auto
  4.2597 +      with fin have "card A < card (UNIV :: 'a set)" by (fact psubset_card_mono)
  4.2598 +      with card show False by simp
  4.2599 +    qed
  4.2600 +  qed
  4.2601 +qed
  4.2602 +
  4.2603 +text{*The form of a finite set of given cardinality*}
  4.2604 +
  4.2605 +lemma card_eq_SucD:
  4.2606 +assumes "card A = Suc k"
  4.2607 +shows "\<exists>b B. A = insert b B & b \<notin> B & card B = k & (k=0 \<longrightarrow> B={})"
  4.2608 +proof -
  4.2609 +  have fin: "finite A" using assms by (auto intro: ccontr)
  4.2610 +  moreover have "card A \<noteq> 0" using assms by auto
  4.2611 +  ultimately obtain b where b: "b \<in> A" by auto
  4.2612 +  show ?thesis
  4.2613 +  proof (intro exI conjI)
  4.2614 +    show "A = insert b (A-{b})" using b by blast
  4.2615 +    show "b \<notin> A - {b}" by blast
  4.2616 +    show "card (A - {b}) = k" and "k = 0 \<longrightarrow> A - {b} = {}"
  4.2617 +      using assms b fin by(fastsimp dest:mk_disjoint_insert)+
  4.2618 +  qed
  4.2619 +qed
  4.2620 +
  4.2621 +lemma card_Suc_eq:
  4.2622 +  "(card A = Suc k) =
  4.2623 +   (\<exists>b B. A = insert b B & b \<notin> B & card B = k & (k=0 \<longrightarrow> B={}))"
  4.2624 +apply(rule iffI)
  4.2625 + apply(erule card_eq_SucD)
  4.2626 +apply(auto)
  4.2627 +apply(subst card_insert)
  4.2628 + apply(auto intro:ccontr)
  4.2629 +done
  4.2630 +
  4.2631 +lemma finite_fun_UNIVD2:
  4.2632 +  assumes fin: "finite (UNIV :: ('a \<Rightarrow> 'b) set)"
  4.2633 +  shows "finite (UNIV :: 'b set)"
  4.2634 +proof -
  4.2635 +  from fin have "finite (range (\<lambda>f :: 'a \<Rightarrow> 'b. f arbitrary))"
  4.2636 +    by(rule finite_imageI)
  4.2637 +  moreover have "UNIV = range (\<lambda>f :: 'a \<Rightarrow> 'b. f arbitrary)"
  4.2638 +    by(rule UNIV_eq_I) auto
  4.2639 +  ultimately show "finite (UNIV :: 'b set)" by simp
  4.2640 +qed
  4.2641 +
  4.2642 +lemma card_UNIV_unit: "card (UNIV :: unit set) = 1"
  4.2643 +  unfolding UNIV_unit by simp
  4.2644 +
  4.2645 +
  4.2646 +subsubsection {* Cardinality of image *}
  4.2647 +
  4.2648 +lemma card_image_le: "finite A ==> card (f ` A) <= card A"
  4.2649 +apply (induct set: finite)
  4.2650 + apply simp
  4.2651 +apply (simp add: le_SucI card_insert_if)
  4.2652 +done
  4.2653 +
  4.2654 +lemma card_image:
  4.2655 +  assumes "inj_on f A"
  4.2656 +  shows "card (f ` A) = card A"
  4.2657 +proof (cases "finite A")
  4.2658 +  case True then show ?thesis using assms by (induct A) simp_all
  4.2659 +next
  4.2660 +  case False then have "\<not> finite (f ` A)" using assms by (auto dest: finite_imageD)
  4.2661 +  with False show ?thesis by simp
  4.2662 +qed
  4.2663 +
  4.2664 +lemma bij_betw_same_card: "bij_betw f A B \<Longrightarrow> card A = card B"
  4.2665 +by(auto simp: card_image bij_betw_def)
  4.2666 +
  4.2667 +lemma endo_inj_surj: "finite A ==> f ` A \<subseteq> A ==> inj_on f A ==> f ` A = A"
  4.2668 +by (simp add: card_seteq card_image)
  4.2669 +
  4.2670 +lemma eq_card_imp_inj_on:
  4.2671 +  "[| finite A; card(f ` A) = card A |] ==> inj_on f A"
  4.2672 +apply (induct rule:finite_induct)
  4.2673 +apply simp
  4.2674 +apply(frule card_image_le[where f = f])
  4.2675 +apply(simp add:card_insert_if split:if_splits)
  4.2676 +done
  4.2677 +
  4.2678 +lemma inj_on_iff_eq_card:
  4.2679 +  "finite A ==> inj_on f A = (card(f ` A) = card A)"
  4.2680 +by(blast intro: card_image eq_card_imp_inj_on)
  4.2681 +
  4.2682 +
  4.2683 +lemma card_inj_on_le:
  4.2684 +  "[|inj_on f A; f ` A \<subseteq> B; finite B |] ==> card A \<le> card B"
  4.2685 +apply (subgoal_tac "finite A") 
  4.2686 + apply (force intro: card_mono simp add: card_image [symmetric])
  4.2687 +apply (blast intro: finite_imageD dest: finite_subset) 
  4.2688 +done
  4.2689 +
  4.2690 +lemma card_bij_eq:
  4.2691 +  "[|inj_on f A; f ` A \<subseteq> B; inj_on g B; g ` B \<subseteq> A;
  4.2692 +     finite A; finite B |] ==> card A = card B"
  4.2693 +by (auto intro: le_antisym card_inj_on_le)
  4.2694 +
  4.2695 +
  4.2696 +subsubsection {* Cardinality of sums *}
  4.2697 +
  4.2698 +lemma card_Plus:
  4.2699 +  assumes "finite A" and "finite B"
  4.2700 +  shows "card (A <+> B) = card A + card B"
  4.2701 +proof -
  4.2702 +  have "Inl`A \<inter> Inr`B = {}" by fast
  4.2703 +  with assms show ?thesis
  4.2704 +    unfolding Plus_def
  4.2705 +    by (simp add: card_Un_disjoint card_image)
  4.2706 +qed
  4.2707 +
  4.2708 +lemma card_Plus_conv_if:
  4.2709 +  "card (A <+> B) = (if finite A \<and> finite B then card A + card B else 0)"
  4.2710 +  by (auto simp add: card_Plus)
  4.2711 +
  4.2712 +
  4.2713 +subsubsection {* Cardinality of the Powerset *}
  4.2714 +
  4.2715 +lemma card_Pow: "finite A ==> card (Pow A) = Suc (Suc 0) ^ card A"  (* FIXME numeral 2 (!?) *)
  4.2716 +apply (induct set: finite)
  4.2717 + apply (simp_all add: Pow_insert)
  4.2718 +apply (subst card_Un_disjoint, blast)
  4.2719 +  apply (blast intro: finite_imageI, blast)
  4.2720 +apply (subgoal_tac "inj_on (insert x) (Pow F)")
  4.2721 + apply (simp add: card_image Pow_insert)
  4.2722 +apply (unfold inj_on_def)
  4.2723 +apply (blast elim!: equalityE)
  4.2724 +done
  4.2725 +
  4.2726 +text {* Relates to equivalence classes.  Based on a theorem of F. Kammüller.  *}
  4.2727 +
  4.2728 +lemma dvd_partition:
  4.2729 +  "finite (Union C) ==>
  4.2730 +    ALL c : C. k dvd card c ==>
  4.2731 +    (ALL c1: C. ALL c2: C. c1 \<noteq> c2 --> c1 Int c2 = {}) ==>
  4.2732 +  k dvd card (Union C)"
  4.2733 +apply(frule finite_UnionD)
  4.2734 +apply(rotate_tac -1)
  4.2735 +apply (induct set: finite, simp_all, clarify)
  4.2736 +apply (subst card_Un_disjoint)
  4.2737 +   apply (auto simp add: disjoint_eq_subset_Compl)
  4.2738 +done
  4.2739 +
  4.2740 +
  4.2741 +subsubsection {* Relating injectivity and surjectivity *}
  4.2742 +
  4.2743 +lemma finite_surj_inj: "finite(A) \<Longrightarrow> A <= f`A \<Longrightarrow> inj_on f A"
  4.2744 +apply(rule eq_card_imp_inj_on, assumption)
  4.2745 +apply(frule finite_imageI)
  4.2746 +apply(drule (1) card_seteq)
  4.2747 + apply(erule card_image_le)
  4.2748 +apply simp
  4.2749 +done
  4.2750 +
  4.2751 +lemma finite_UNIV_surj_inj: fixes f :: "'a \<Rightarrow> 'a"
  4.2752 +shows "finite(UNIV:: 'a set) \<Longrightarrow> surj f \<Longrightarrow> inj f"
  4.2753 +by (blast intro: finite_surj_inj subset_UNIV dest:surj_range)
  4.2754 +
  4.2755 +lemma finite_UNIV_inj_surj: fixes f :: "'a \<Rightarrow> 'a"
  4.2756 +shows "finite(UNIV:: 'a set) \<Longrightarrow> inj f \<Longrightarrow> surj f"
  4.2757 +by(fastsimp simp:surj_def dest!: endo_inj_surj)
  4.2758 +
  4.2759 +corollary infinite_UNIV_nat[iff]: "~finite(UNIV::nat set)"
  4.2760 +proof
  4.2761 +  assume "finite(UNIV::nat set)"
  4.2762 +  with finite_UNIV_inj_surj[of Suc]
  4.2763 +  show False by simp (blast dest: Suc_neq_Zero surjD)
  4.2764 +qed
  4.2765 +
  4.2766 +(* Often leads to bogus ATP proofs because of reduced type information, hence noatp *)
  4.2767 +lemma infinite_UNIV_char_0[noatp]:
  4.2768 +  "\<not> finite (UNIV::'a::semiring_char_0 set)"
  4.2769 +proof
  4.2770 +  assume "finite (UNIV::'a set)"
  4.2771 +  with subset_UNIV have "finite (range of_nat::'a set)"
  4.2772 +    by (rule finite_subset)
  4.2773 +  moreover have "inj (of_nat::nat \<Rightarrow> 'a)"
  4.2774 +    by (simp add: inj_on_def)
  4.2775 +  ultimately have "finite (UNIV::nat set)"
  4.2776 +    by (rule finite_imageD)
  4.2777 +  then show "False"
  4.2778 +    by simp
  4.2779 +qed
  4.2780 +
  4.2781 +end
     5.1 --- a/src/HOL/GCD.thy	Thu Mar 11 16:56:22 2010 +0100
     5.2 +++ b/src/HOL/GCD.thy	Thu Mar 11 17:39:45 2010 +0100
     5.3 @@ -1358,10 +1358,10 @@
     5.4  done
     5.5  
     5.6  lemma lcm_dvd2_nat: "(n::nat) dvd lcm m n"
     5.7 -  using lcm_dvd1_nat [of n m] by (simp only: lcm_nat_def times.commute gcd_nat.commute)
     5.8 +  using lcm_dvd1_nat [of n m] by (simp only: lcm_nat_def mult.commute gcd_nat.commute)
     5.9  
    5.10  lemma lcm_dvd2_int: "(n::int) dvd lcm m n"
    5.11 -  using lcm_dvd1_int [of n m] by (simp only: lcm_int_def lcm_nat_def times.commute gcd_nat.commute)
    5.12 +  using lcm_dvd1_int [of n m] by (simp only: lcm_int_def lcm_nat_def mult.commute gcd_nat.commute)
    5.13  
    5.14  lemma dvd_lcm_I1_nat[simp]: "(k::nat) dvd m \<Longrightarrow> k dvd lcm m n"
    5.15  by(metis lcm_dvd1_nat dvd_trans)
     6.1 --- a/src/HOL/Groups.thy	Thu Mar 11 16:56:22 2010 +0100
     6.2 +++ b/src/HOL/Groups.thy	Thu Mar 11 17:39:45 2010 +0100
     6.3 @@ -67,6 +67,18 @@
     6.4  
     6.5  end
     6.6  
     6.7 +locale monoid = semigroup +
     6.8 +  fixes z :: 'a ("1")
     6.9 +  assumes left_neutral [simp]: "1 * a = a"
    6.10 +  assumes right_neutral [simp]: "a * 1 = a"
    6.11 +
    6.12 +locale comm_monoid = abel_semigroup +
    6.13 +  fixes z :: 'a ("1")
    6.14 +  assumes comm_neutral: "a * 1 = a"
    6.15 +
    6.16 +sublocale comm_monoid < monoid proof
    6.17 +qed (simp_all add: commute comm_neutral)
    6.18 +
    6.19  
    6.20  subsection {* Generic operations *}
    6.21  
    6.22 @@ -129,19 +141,19 @@
    6.23  class semigroup_add = plus +
    6.24    assumes add_assoc [algebra_simps]: "(a + b) + c = a + (b + c)"
    6.25  
    6.26 -sublocale semigroup_add < plus!: semigroup plus proof
    6.27 +sublocale semigroup_add < add!: semigroup plus proof
    6.28  qed (fact add_assoc)
    6.29  
    6.30  class ab_semigroup_add = semigroup_add +
    6.31    assumes add_commute [algebra_simps]: "a + b = b + a"
    6.32  
    6.33 -sublocale ab_semigroup_add < plus!: abel_semigroup plus proof
    6.34 +sublocale ab_semigroup_add < add!: abel_semigroup plus proof
    6.35  qed (fact add_commute)
    6.36  
    6.37  context ab_semigroup_add
    6.38  begin
    6.39  
    6.40 -lemmas add_left_commute [algebra_simps] = plus.left_commute
    6.41 +lemmas add_left_commute [algebra_simps] = add.left_commute
    6.42  
    6.43  theorems add_ac = add_assoc add_commute add_left_commute
    6.44  
    6.45 @@ -152,19 +164,19 @@
    6.46  class semigroup_mult = times +
    6.47    assumes mult_assoc [algebra_simps]: "(a * b) * c = a * (b * c)"
    6.48  
    6.49 -sublocale semigroup_mult < times!: semigroup times proof
    6.50 +sublocale semigroup_mult < mult!: semigroup times proof
    6.51  qed (fact mult_assoc)
    6.52  
    6.53  class ab_semigroup_mult = semigroup_mult +
    6.54    assumes mult_commute [algebra_simps]: "a * b = b * a"
    6.55  
    6.56 -sublocale ab_semigroup_mult < times!: abel_semigroup times proof
    6.57 +sublocale ab_semigroup_mult < mult!: abel_semigroup times proof
    6.58  qed (fact mult_commute)
    6.59  
    6.60  context ab_semigroup_mult
    6.61  begin
    6.62  
    6.63 -lemmas mult_left_commute [algebra_simps] = times.left_commute
    6.64 +lemmas mult_left_commute [algebra_simps] = mult.left_commute
    6.65  
    6.66  theorems mult_ac = mult_assoc mult_commute mult_left_commute
    6.67  
    6.68 @@ -173,36 +185,42 @@
    6.69  theorems mult_ac = mult_assoc mult_commute mult_left_commute
    6.70  
    6.71  class monoid_add = zero + semigroup_add +
    6.72 -  assumes add_0_left [simp]: "0 + a = a"
    6.73 -    and add_0_right [simp]: "a + 0 = a"
    6.74 +  assumes add_0_left: "0 + a = a"
    6.75 +    and add_0_right: "a + 0 = a"
    6.76 +
    6.77 +sublocale monoid_add < add!: monoid plus 0 proof
    6.78 +qed (fact add_0_left add_0_right)+
    6.79  
    6.80  lemma zero_reorient: "0 = x \<longleftrightarrow> x = 0"
    6.81  by (rule eq_commute)
    6.82  
    6.83  class comm_monoid_add = zero + ab_semigroup_add +
    6.84    assumes add_0: "0 + a = a"
    6.85 -begin
    6.86  
    6.87 -subclass monoid_add
    6.88 -  proof qed (insert add_0, simp_all add: add_commute)
    6.89 +sublocale comm_monoid_add < add!: comm_monoid plus 0 proof
    6.90 +qed (insert add_0, simp add: ac_simps)
    6.91  
    6.92 -end
    6.93 +subclass (in comm_monoid_add) monoid_add proof
    6.94 +qed (fact add.left_neutral add.right_neutral)+
    6.95  
    6.96  class monoid_mult = one + semigroup_mult +
    6.97 -  assumes mult_1_left [simp]: "1 * a  = a"
    6.98 -  assumes mult_1_right [simp]: "a * 1 = a"
    6.99 +  assumes mult_1_left: "1 * a  = a"
   6.100 +    and mult_1_right: "a * 1 = a"
   6.101 +
   6.102 +sublocale monoid_mult < mult!: monoid times 1 proof
   6.103 +qed (fact mult_1_left mult_1_right)+
   6.104  
   6.105  lemma one_reorient: "1 = x \<longleftrightarrow> x = 1"
   6.106  by (rule eq_commute)
   6.107  
   6.108  class comm_monoid_mult = one + ab_semigroup_mult +
   6.109    assumes mult_1: "1 * a = a"
   6.110 -begin
   6.111  
   6.112 -subclass monoid_mult
   6.113 -  proof qed (insert mult_1, simp_all add: mult_commute)
   6.114 +sublocale comm_monoid_mult < mult!: comm_monoid times 1 proof
   6.115 +qed (insert mult_1, simp add: ac_simps)
   6.116  
   6.117 -end
   6.118 +subclass (in comm_monoid_mult) monoid_mult proof
   6.119 +qed (fact mult.left_neutral mult.right_neutral)+
   6.120  
   6.121  class cancel_semigroup_add = semigroup_add +
   6.122    assumes add_left_imp_eq: "a + b = a + c \<Longrightarrow> b = c"
     7.1 --- a/src/HOL/IsaMakefile	Thu Mar 11 16:56:22 2010 +0100
     7.2 +++ b/src/HOL/IsaMakefile	Thu Mar 11 17:39:45 2010 +0100
     7.3 @@ -247,6 +247,7 @@
     7.4  
     7.5  MAIN_DEPENDENCIES = $(PLAIN_DEPENDENCIES) \
     7.6    ATP_Linkup.thy \
     7.7 +  Big_Operators.thy \
     7.8    Code_Evaluation.thy \
     7.9    Code_Numeral.thy \
    7.10    Divides.thy \
     8.1 --- a/src/HOL/Lattices.thy	Thu Mar 11 16:56:22 2010 +0100
     8.2 +++ b/src/HOL/Lattices.thy	Thu Mar 11 17:39:45 2010 +0100
     8.3 @@ -43,7 +43,7 @@
     8.4  end
     8.5  
     8.6  
     8.7 -subsection {* Conrete lattices *}
     8.8 +subsection {* Concrete lattices *}
     8.9  
    8.10  notation
    8.11    less_eq  (infix "\<sqsubseteq>" 50) and
     9.1 --- a/src/HOL/Multivariate_Analysis/Brouwer_Fixpoint.thy	Thu Mar 11 16:56:22 2010 +0100
     9.2 +++ b/src/HOL/Multivariate_Analysis/Brouwer_Fixpoint.thy	Thu Mar 11 17:39:45 2010 +0100
     9.3 @@ -94,8 +94,8 @@
     9.4      using lem1[unfolded lem3 lem2 lem5] by auto
     9.5    have even_minus_odd:"\<And>x y. even x \<Longrightarrow> odd (y::int) \<Longrightarrow> odd (x - y)" using assms by auto
     9.6    have odd_minus_even:"\<And>x y. odd x \<Longrightarrow> even (y::int) \<Longrightarrow> odd (x - y)" using assms by auto
     9.7 -  show ?thesis unfolding even_nat_def unfolding card_def and lem4[THEN sym] and *[unfolded card_def]
     9.8 -    unfolding card_def[THEN sym] apply(rule odd_minus_even) unfolding zadd_int[THEN sym] apply(rule odd_plus_even)
     9.9 +  show ?thesis unfolding even_nat_def unfolding card_eq_setsum and lem4[THEN sym] and *[unfolded card_eq_setsum]
    9.10 +    unfolding card_eq_setsum[THEN sym] apply (rule odd_minus_even) unfolding zadd_int[THEN sym] apply(rule odd_plus_even)
    9.11      apply(rule assms(7)[unfolded even_nat_def]) unfolding int_mult by auto qed
    9.12  
    9.13  subsection {* The odd/even result for faces of complete vertices, generalized. *}
    10.1 --- a/src/HOL/Multivariate_Analysis/Integration.cert	Thu Mar 11 16:56:22 2010 +0100
    10.2 +++ b/src/HOL/Multivariate_Analysis/Integration.cert	Thu Mar 11 17:39:45 2010 +0100
    10.3 @@ -3294,3 +3294,215 @@
    10.4    else -> val!7
    10.5  }
    10.6  sat
    10.7 +qkVrmXMcHAG5MLuJ9d8jXQ 211 0
    10.8 +#2 := false
    10.9 +#33 := 0::real
   10.10 +decl uf_11 :: (-> T5 T6 real)
   10.11 +decl uf_15 :: T6
   10.12 +#28 := uf_15
   10.13 +decl uf_16 :: T5
   10.14 +#30 := uf_16
   10.15 +#31 := (uf_11 uf_16 uf_15)
   10.16 +decl uf_12 :: (-> T7 T8 T5)
   10.17 +decl uf_14 :: T8
   10.18 +#26 := uf_14
   10.19 +decl uf_13 :: (-> T1 T7)
   10.20 +decl uf_8 :: T1
   10.21 +#16 := uf_8
   10.22 +#25 := (uf_13 uf_8)
   10.23 +#27 := (uf_12 #25 uf_14)
   10.24 +#29 := (uf_11 #27 uf_15)
   10.25 +#73 := -1::real
   10.26 +#84 := (* -1::real #29)
   10.27 +#85 := (+ #84 #31)
   10.28 +#74 := (* -1::real #31)
   10.29 +#75 := (+ #29 #74)
   10.30 +#112 := (>= #75 0::real)
   10.31 +#119 := (ite #112 #75 #85)
   10.32 +#127 := (* -1::real #119)
   10.33 +decl uf_17 :: T5
   10.34 +#37 := uf_17
   10.35 +#38 := (uf_11 uf_17 uf_15)
   10.36 +#102 := -1/3::real
   10.37 +#103 := (* -1/3::real #38)
   10.38 +#128 := (+ #103 #127)
   10.39 +#100 := 1/3::real
   10.40 +#101 := (* 1/3::real #31)
   10.41 +#129 := (+ #101 #128)
   10.42 +#130 := (<= #129 0::real)
   10.43 +#131 := (not #130)
   10.44 +#40 := 3::real
   10.45 +#39 := (- #31 #38)
   10.46 +#41 := (/ #39 3::real)
   10.47 +#32 := (- #29 #31)
   10.48 +#35 := (- #32)
   10.49 +#34 := (< #32 0::real)
   10.50 +#36 := (ite #34 #35 #32)
   10.51 +#42 := (< #36 #41)
   10.52 +#136 := (iff #42 #131)
   10.53 +#104 := (+ #101 #103)
   10.54 +#78 := (< #75 0::real)
   10.55 +#90 := (ite #78 #85 #75)
   10.56 +#109 := (< #90 #104)
   10.57 +#134 := (iff #109 #131)
   10.58 +#124 := (< #119 #104)
   10.59 +#132 := (iff #124 #131)
   10.60 +#133 := [rewrite]: #132
   10.61 +#125 := (iff #109 #124)
   10.62 +#122 := (= #90 #119)
   10.63 +#113 := (not #112)
   10.64 +#116 := (ite #113 #85 #75)
   10.65 +#120 := (= #116 #119)
   10.66 +#121 := [rewrite]: #120
   10.67 +#117 := (= #90 #116)
   10.68 +#114 := (iff #78 #113)
   10.69 +#115 := [rewrite]: #114
   10.70 +#118 := [monotonicity #115]: #117
   10.71 +#123 := [trans #118 #121]: #122
   10.72 +#126 := [monotonicity #123]: #125
   10.73 +#135 := [trans #126 #133]: #134
   10.74 +#110 := (iff #42 #109)
   10.75 +#107 := (= #41 #104)
   10.76 +#93 := (* -1::real #38)
   10.77 +#94 := (+ #31 #93)
   10.78 +#97 := (/ #94 3::real)
   10.79 +#105 := (= #97 #104)
   10.80 +#106 := [rewrite]: #105
   10.81 +#98 := (= #41 #97)
   10.82 +#95 := (= #39 #94)
   10.83 +#96 := [rewrite]: #95
   10.84 +#99 := [monotonicity #96]: #98
   10.85 +#108 := [trans #99 #106]: #107
   10.86 +#91 := (= #36 #90)
   10.87 +#76 := (= #32 #75)
   10.88 +#77 := [rewrite]: #76
   10.89 +#88 := (= #35 #85)
   10.90 +#81 := (- #75)
   10.91 +#86 := (= #81 #85)
   10.92 +#87 := [rewrite]: #86
   10.93 +#82 := (= #35 #81)
   10.94 +#83 := [monotonicity #77]: #82
   10.95 +#89 := [trans #83 #87]: #88
   10.96 +#79 := (iff #34 #78)
   10.97 +#80 := [monotonicity #77]: #79
   10.98 +#92 := [monotonicity #80 #89 #77]: #91
   10.99 +#111 := [monotonicity #92 #108]: #110
  10.100 +#137 := [trans #111 #135]: #136
  10.101 +#72 := [asserted]: #42
  10.102 +#138 := [mp #72 #137]: #131
  10.103 +decl uf_1 :: T1
  10.104 +#4 := uf_1
  10.105 +#43 := (uf_13 uf_1)
  10.106 +#44 := (uf_12 #43 uf_14)
  10.107 +#45 := (uf_11 #44 uf_15)
  10.108 +#149 := (* -1::real #45)
  10.109 +#150 := (+ #38 #149)
  10.110 +#140 := (+ #93 #45)
  10.111 +#161 := (<= #150 0::real)
  10.112 +#168 := (ite #161 #140 #150)
  10.113 +#176 := (* -1::real #168)
  10.114 +#177 := (+ #103 #176)
  10.115 +#178 := (+ #101 #177)
  10.116 +#179 := (<= #178 0::real)
  10.117 +#180 := (not #179)
  10.118 +#46 := (- #45 #38)
  10.119 +#48 := (- #46)
  10.120 +#47 := (< #46 0::real)
  10.121 +#49 := (ite #47 #48 #46)
  10.122 +#50 := (< #49 #41)
  10.123 +#185 := (iff #50 #180)
  10.124 +#143 := (< #140 0::real)
  10.125 +#155 := (ite #143 #150 #140)
  10.126 +#158 := (< #155 #104)
  10.127 +#183 := (iff #158 #180)
  10.128 +#173 := (< #168 #104)
  10.129 +#181 := (iff #173 #180)
  10.130 +#182 := [rewrite]: #181
  10.131 +#174 := (iff #158 #173)
  10.132 +#171 := (= #155 #168)
  10.133 +#162 := (not #161)
  10.134 +#165 := (ite #162 #150 #140)
  10.135 +#169 := (= #165 #168)
  10.136 +#170 := [rewrite]: #169
  10.137 +#166 := (= #155 #165)
  10.138 +#163 := (iff #143 #162)
  10.139 +#164 := [rewrite]: #163
  10.140 +#167 := [monotonicity #164]: #166
  10.141 +#172 := [trans #167 #170]: #171
  10.142 +#175 := [monotonicity #172]: #174
  10.143 +#184 := [trans #175 #182]: #183
  10.144 +#159 := (iff #50 #158)
  10.145 +#156 := (= #49 #155)
  10.146 +#141 := (= #46 #140)
  10.147 +#142 := [rewrite]: #141
  10.148 +#153 := (= #48 #150)
  10.149 +#146 := (- #140)
  10.150 +#151 := (= #146 #150)
  10.151 +#152 := [rewrite]: #151
  10.152 +#147 := (= #48 #146)
  10.153 +#148 := [monotonicity #142]: #147
  10.154 +#154 := [trans #148 #152]: #153
  10.155 +#144 := (iff #47 #143)
  10.156 +#145 := [monotonicity #142]: #144
  10.157 +#157 := [monotonicity #145 #154 #142]: #156
  10.158 +#160 := [monotonicity #157 #108]: #159
  10.159 +#186 := [trans #160 #184]: #185
  10.160 +#139 := [asserted]: #50
  10.161 +#187 := [mp #139 #186]: #180
  10.162 +#299 := (+ #140 #176)
  10.163 +#300 := (<= #299 0::real)
  10.164 +#290 := (= #140 #168)
  10.165 +#329 := [hypothesis]: #162
  10.166 +#191 := (+ #29 #149)
  10.167 +#192 := (<= #191 0::real)
  10.168 +#51 := (<= #29 #45)
  10.169 +#193 := (iff #51 #192)
  10.170 +#194 := [rewrite]: #193
  10.171 +#188 := [asserted]: #51
  10.172 +#195 := [mp #188 #194]: #192
  10.173 +#298 := (+ #75 #127)
  10.174 +#301 := (<= #298 0::real)
  10.175 +#284 := (= #75 #119)
  10.176 +#302 := [hypothesis]: #113
  10.177 +#296 := (+ #85 #127)
  10.178 +#297 := (<= #296 0::real)
  10.179 +#285 := (= #85 #119)
  10.180 +#288 := (or #112 #285)
  10.181 +#289 := [def-axiom]: #288
  10.182 +#303 := [unit-resolution #289 #302]: #285
  10.183 +#304 := (not #285)
  10.184 +#305 := (or #304 #297)
  10.185 +#306 := [th-lemma]: #305
  10.186 +#307 := [unit-resolution #306 #303]: #297
  10.187 +#315 := (not #290)
  10.188 +#310 := (not #300)
  10.189 +#311 := (or #310 #112)
  10.190 +#308 := [hypothesis]: #300
  10.191 +#309 := [th-lemma #308 #307 #138 #302 #187 #195]: false
  10.192 +#312 := [lemma #309]: #311
  10.193 +#322 := [unit-resolution #312 #302]: #310
  10.194 +#316 := (or #315 #300)
  10.195 +#313 := [hypothesis]: #310
  10.196 +#314 := [hypothesis]: #290
  10.197 +#317 := [th-lemma]: #316
  10.198 +#318 := [unit-resolution #317 #314 #313]: false
  10.199 +#319 := [lemma #318]: #316
  10.200 +#323 := [unit-resolution #319 #322]: #315
  10.201 +#292 := (or #162 #290)
  10.202 +#293 := [def-axiom]: #292
  10.203 +#324 := [unit-resolution #293 #323]: #162
  10.204 +#325 := [th-lemma #324 #307 #138 #302 #195]: false
  10.205 +#326 := [lemma #325]: #112
  10.206 +#286 := (or #113 #284)
  10.207 +#287 := [def-axiom]: #286
  10.208 +#330 := [unit-resolution #287 #326]: #284
  10.209 +#331 := (not #284)
  10.210 +#332 := (or #331 #301)
  10.211 +#333 := [th-lemma]: #332
  10.212 +#334 := [unit-resolution #333 #330]: #301
  10.213 +#335 := [th-lemma #326 #334 #195 #329 #138]: false
  10.214 +#336 := [lemma #335]: #161
  10.215 +#327 := [unit-resolution #293 #336]: #290
  10.216 +#328 := [unit-resolution #319 #327]: #300
  10.217 +[th-lemma #326 #334 #195 #328 #187 #138]: false
  10.218 +unsat
    11.1 --- a/src/HOL/Number_Theory/Binomial.thy	Thu Mar 11 16:56:22 2010 +0100
    11.2 +++ b/src/HOL/Number_Theory/Binomial.thy	Thu Mar 11 17:39:45 2010 +0100
    11.3 @@ -364,7 +364,7 @@
    11.4          finally have "card ({T. T \<le> insert x F \<and> card T = k + 1}) = 
    11.5            card F choose (k + 1) + (card F choose k)".
    11.6          with iassms choose_plus_one_nat show ?thesis
    11.7 -          by auto
    11.8 +          by (auto simp del: card.insert)
    11.9        qed
   11.10      qed
   11.11    qed
    12.1 --- a/src/HOL/Option.thy	Thu Mar 11 16:56:22 2010 +0100
    12.2 +++ b/src/HOL/Option.thy	Thu Mar 11 17:39:45 2010 +0100
    12.3 @@ -5,7 +5,7 @@
    12.4  header {* Datatype option *}
    12.5  
    12.6  theory Option
    12.7 -imports Datatype Finite_Set
    12.8 +imports Datatype
    12.9  begin
   12.10  
   12.11  datatype 'a option = None | Some 'a
   12.12 @@ -33,13 +33,6 @@
   12.13  lemma UNIV_option_conv: "UNIV = insert None (range Some)"
   12.14  by(auto intro: classical)
   12.15  
   12.16 -lemma finite_option_UNIV[simp]:
   12.17 -  "finite (UNIV :: 'a option set) = finite (UNIV :: 'a set)"
   12.18 -by(auto simp add: UNIV_option_conv elim: finite_imageD intro: inj_Some)
   12.19 -
   12.20 -instance option :: (finite) finite proof
   12.21 -qed (simp add: UNIV_option_conv)
   12.22 -
   12.23  
   12.24  subsubsection {* Operations *}
   12.25  
    13.1 --- a/src/HOL/Rat.thy	Thu Mar 11 16:56:22 2010 +0100
    13.2 +++ b/src/HOL/Rat.thy	Thu Mar 11 17:39:45 2010 +0100
    13.3 @@ -1104,11 +1104,11 @@
    13.4  
    13.5  lemma rat_less_eq_code [code]:
    13.6    "p \<le> q \<longleftrightarrow> (let (a, c) = quotient_of p; (b, d) = quotient_of q in a * d \<le> c * b)"
    13.7 -  by (cases p, cases q) (simp add: quotient_of_Fract times.commute)
    13.8 +  by (cases p, cases q) (simp add: quotient_of_Fract mult.commute)
    13.9  
   13.10  lemma rat_less_code [code]:
   13.11    "p < q \<longleftrightarrow> (let (a, c) = quotient_of p; (b, d) = quotient_of q in a * d < c * b)"
   13.12 -  by (cases p, cases q) (simp add: quotient_of_Fract times.commute)
   13.13 +  by (cases p, cases q) (simp add: quotient_of_Fract mult.commute)
   13.14  
   13.15  lemma [code]:
   13.16    "of_rat p = (let (a, b) = quotient_of p in of_int a / of_int b)"
    14.1 --- a/src/HOL/Wellfounded.thy	Thu Mar 11 16:56:22 2010 +0100
    14.2 +++ b/src/HOL/Wellfounded.thy	Thu Mar 11 17:39:45 2010 +0100
    14.3 @@ -8,7 +8,7 @@
    14.4  header {*Well-founded Recursion*}
    14.5  
    14.6  theory Wellfounded
    14.7 -imports Finite_Set Transitive_Closure
    14.8 +imports Transitive_Closure
    14.9  uses ("Tools/Function/size.ML")
   14.10  begin
   14.11  
    15.1 --- a/src/HOL/ex/Summation.thy	Thu Mar 11 16:56:22 2010 +0100
    15.2 +++ b/src/HOL/ex/Summation.thy	Thu Mar 11 17:39:45 2010 +0100
    15.3 @@ -10,7 +10,7 @@
    15.4  
    15.5  lemma add_setsum_orient:
    15.6    "setsum f {k..<j} + setsum f {l..<k} = setsum f {l..<k} + setsum f {k..<j}"
    15.7 -  by (fact plus.commute)
    15.8 +  by (fact add.commute)
    15.9  
   15.10  lemma add_setsum_int:
   15.11    fixes j k l :: int