# HG changeset patch # User wenzelm # Date 1348501964 -7200 # Node ID fb2128470345af01f91f5e575198c8fe850d2f10 # Parent 7b7bd2d7661d7d4baae07c933b7044f6bca1101a tuned proofs; diff -r 7b7bd2d7661d -r fb2128470345 src/HOL/Multivariate_Analysis/Brouwer_Fixpoint.thy --- a/src/HOL/Multivariate_Analysis/Brouwer_Fixpoint.thy Mon Sep 24 17:28:36 2012 +0200 +++ b/src/HOL/Multivariate_Analysis/Brouwer_Fixpoint.thy Mon Sep 24 17:52:44 2012 +0200 @@ -28,15 +28,20 @@ proof (cases "s={}") case False have "continuous_on s (norm \ f)" - by(rule continuous_on_intros continuous_on_norm assms(2))+ + by (rule continuous_on_intros continuous_on_norm assms(2))+ with False obtain x where x: "x\s" "\y\s. (norm \ f) x \ (norm \ f) y" using continuous_attains_inf[OF assms(1), of "norm \ f"] unfolding o_def by auto have "(norm \ f) x > 0" using assms(3) and x(1) by auto then show ?thesis by (rule that) (insert x(2), auto simp: o_def) -qed (rule that [of 1], auto) +next + case True + show thesis by (rule that [of 1]) (auto simp: True) +qed -lemma kuhn_labelling_lemma: fixes type::"'a::euclidean_space" - assumes "(\x::'a. P x \ P (f x))" "\x. P x \ (\i 0 \ x$$i \ x$$i \ 1)" +lemma kuhn_labelling_lemma: + fixes type::"'a::euclidean_space" + assumes "(\x::'a. P x \ P (f x))" + and "\x. P x \ (\i 0 \ x$$i \ x$$i \ 1)" shows "\l. (\x.\ i (1::nat)) \ (\x.\ i Q i \ (x$$i = 0) \ (l x i = 0)) \ (\x.\ i Q i \ (x$$i = 1) \ (l x i = 1)) \ @@ -45,7 +50,7 @@ proof - have and_forall_thm:"\P Q. (\x. P x) \ (\x. Q x) \ (\x. P x \ Q x)" by auto - have *:"\x y::real. 0 \ x \ x \ 1 \ 0 \ y \ y \ 1 \ (x \ 1 \ x \ y \ x \ 0 \ y \ x)" + have *: "\x y::real. 0 \ x \ x \ 1 \ 0 \ y \ y \ 1 \ (x \ 1 \ x \ y \ x \ 0 \ y \ x)" by auto show ?thesis unfolding and_forall_thm @@ -150,12 +155,11 @@ apply rule apply (drule card_eq_SucD) defer - apply(erule ex1E) + apply (erule ex1E) proof - fix x assume as:"x \ s" "\y. y \ s \ y = x" have *: "s = insert x {}" - apply - - apply (rule set_eqI,rule) unfolding singleton_iff + apply (rule set_eqI, rule) unfolding singleton_iff apply (rule as(2)[rule_format]) using as(1) apply auto done @@ -166,72 +170,132 @@ proof assume "card s = 2" then obtain x y where obt:"s = {x, y}" "x\y" unfolding numeral_2_eq_2 - apply - apply(erule exE conjE|drule card_eq_SucD)+ apply auto done - show "\x\s. \y\s. x \ y \ (\z\s. z = x \ z = y)" using obt by auto next + apply - apply (erule exE conjE | drule card_eq_SucD)+ apply auto done + show "\x\s. \y\s. x \ y \ (\z\s. z = x \ z = y)" using obt by auto +next assume "\x\s. \y\s. x \ y \ (\z\s. z = x \ z = y)" - then guess x .. - from this(2) guess y .. - with `x\s` have *: "s = {x, y}" "x\y" by auto - from this(2) show "card s = 2" unfolding * by auto + then obtain x y where "x\s" "y\s" "x \ y" "\z\s. z = x \ z = y" by auto + then have "s = {x, y}" by auto + with `x \ y` show "card s = 2" by auto +qed + +lemma image_lemma_0: + assumes "card {a\s. f ` (s - {a}) = t - {b}} = n" + shows "card {s'. \a\s. (s' = s - {a}) \ (f ` s' = t - {b})} = n" +proof - + have *:"{s'. \a\s. (s' = s - {a}) \ (f ` s' = t - {b})} = (\a. s - {a}) ` {a\s. f ` (s - {a}) = t - {b}}" + by auto + show ?thesis unfolding * unfolding assms[THEN sym] apply(rule card_image) unfolding inj_on_def + apply (rule, rule, rule) unfolding mem_Collect_eq apply auto done +qed + +lemma image_lemma_1: + assumes "finite s" "finite t" "card s = card t" "f ` s = t" "b \ t" + shows "card {s'. \a\s. s' = s - {a} \ f ` s' = t - {b}} = 1" +proof - + obtain a where a: "b = f a" "a\s" using assms(4-5) by auto + have inj: "inj_on f s" apply (rule eq_card_imp_inj_on) using assms(1-4) apply auto done + have *: "{a \ s. f ` (s - {a}) = t - {b}} = {a}" apply (rule set_eqI) unfolding singleton_iff + apply (rule, rule inj[unfolded inj_on_def, rule_format]) + unfolding a using a(2) and assms and inj[unfolded inj_on_def] apply auto + done + show ?thesis apply (rule image_lemma_0) unfolding * apply auto done qed -lemma image_lemma_0: assumes "card {a\s. f ` (s - {a}) = t - {b}} = n" - shows "card {s'. \a\s. (s' = s - {a}) \ (f ` s' = t - {b})} = n" proof- - have *:"{s'. \a\s. (s' = s - {a}) \ (f ` s' = t - {b})} = (\a. s - {a}) ` {a\s. f ` (s - {a}) = t - {b}}" by auto - show ?thesis unfolding * unfolding assms[THEN sym] apply(rule card_image) unfolding inj_on_def - apply(rule,rule,rule) unfolding mem_Collect_eq by auto qed - -lemma image_lemma_1: assumes "finite s" "finite t" "card s = card t" "f ` s = t" "b \ t" - shows "card {s'. \a\s. s' = s - {a} \ f ` s' = t - {b}} = 1" proof- - obtain a where a:"b = f a" "a\s" using assms(4-5) by auto - have inj:"inj_on f s" apply(rule eq_card_imp_inj_on) using assms(1-4) by auto - have *:"{a \ s. f ` (s - {a}) = t - {b}} = {a}" apply(rule set_eqI) unfolding singleton_iff - apply(rule,rule inj[unfolded inj_on_def,rule_format]) unfolding a using a(2) and assms and inj[unfolded inj_on_def] by auto - show ?thesis apply(rule image_lemma_0) unfolding * by auto qed - -lemma image_lemma_2: assumes "finite s" "finite t" "card s = card t" "f ` s \ t" "f ` s \ t" "b \ t" +lemma image_lemma_2: + assumes "finite s" "finite t" "card s = card t" "f ` s \ t" "f ` s \ t" "b \ t" shows "(card {s'. \a\s. (s' = s - {a}) \ f ` s' = t - {b}} = 0) \ - (card {s'. \a\s. (s' = s - {a}) \ f ` s' = t - {b}} = 2)" proof(cases "{a\s. f ` (s - {a}) = t - {b}} = {}") - case True thus ?thesis apply-apply(rule disjI1, rule image_lemma_0) using assms(1) by auto -next let ?M = "{a\s. f ` (s - {a}) = t - {b}}" - case False then obtain a where "a\?M" by auto hence a:"a\s" "f ` (s - {a}) = t - {b}" by auto + (card {s'. \a\s. (s' = s - {a}) \ f ` s' = t - {b}} = 2)" +proof (cases "{a\s. f ` (s - {a}) = t - {b}} = {}") + case True + then show ?thesis + apply - + apply (rule disjI1, rule image_lemma_0) using assms(1) apply auto done +next + let ?M = "{a\s. f ` (s - {a}) = t - {b}}" + case False + then obtain a where "a\?M" by auto + then have a: "a\s" "f ` (s - {a}) = t - {b}" by auto have "f a \ t - {b}" using a and assms by auto - hence "\c \ s - {a}. f a = f c" unfolding image_iff[symmetric] and a by auto + then have "\c \ s - {a}. f a = f c" unfolding image_iff[symmetric] and a by auto then obtain c where c:"c \ s" "a \ c" "f a = f c" by auto - hence *:"f ` (s - {c}) = f ` (s - {a})" apply-apply(rule set_eqI,rule) proof- - fix x assume "x \ f ` (s - {a})" then obtain y where y:"f y = x" "y\s- {a}" by auto - thus "x \ f ` (s - {c})" unfolding image_iff apply(rule_tac x="if y = c then a else y" in bexI) using c a by auto qed auto + then have *: "f ` (s - {c}) = f ` (s - {a})" + apply - + apply (rule set_eqI, rule) + proof - + fix x + assume "x \ f ` (s - {a})" + then obtain y where y: "f y = x" "y\s- {a}" by auto + then show "x \ f ` (s - {c})" + unfolding image_iff + apply (rule_tac x = "if y = c then a else y" in bexI) + using c a apply auto done + qed auto have "c\?M" unfolding mem_Collect_eq and * using a and c(1) by auto - show ?thesis apply(rule disjI2, rule image_lemma_0) unfolding card_2_exists - apply(rule bexI[OF _ `a\?M`], rule bexI[OF _ `c\?M`],rule,rule `a\c`) proof(rule,unfold mem_Collect_eq,erule conjE) - fix z assume as:"z \ s" "f ` (s - {z}) = t - {b}" - have inj:"inj_on f (s - {z})" apply(rule eq_card_imp_inj_on) unfolding as using as(1) and assms by auto - show "z = a \ z = c" proof(rule ccontr) - assume "\ (z = a \ z = c)" thus False using inj[unfolded inj_on_def,THEN bspec[where x=a],THEN bspec[where x=c]] - using `a\s` `c\s` `f a = f c` `a\c` by auto qed qed qed + show ?thesis + apply (rule disjI2, rule image_lemma_0) unfolding card_2_exists + apply (rule bexI[OF _ `a\?M`], rule bexI[OF _ `c\?M`],rule,rule `a\c`) + proof (rule, unfold mem_Collect_eq, erule conjE) + fix z + assume as: "z \ s" "f ` (s - {z}) = t - {b}" + have inj: "inj_on f (s - {z})" + apply (rule eq_card_imp_inj_on) + unfolding as using as(1) and assms apply auto + done + show "z = a \ z = c" + proof (rule ccontr) + assume "\ ?thesis" + then show False + using inj[unfolded inj_on_def, THEN bspec[where x=a], THEN bspec[where x=c]] + using `a\s` `c\s` `f a = f c` `a\c` apply auto + done + qed + qed +qed + subsection {* Combine this with the basic counting lemma. *} lemma kuhn_complete_lemma: assumes "finite simplices" - "\f s. face f s \ (\a\s. f = s - {a})" "\s\simplices. card s = n + 2" "\s\simplices. (rl ` s) \ {0..n+1}" - "\f\ {f. \s\simplices. face f s}. bnd f \ (card {s\simplices. face f s} = 1)" - "\f\ {f. \s\simplices. face f s}. \bnd f \ (card {s\simplices. face f s} = 2)" - "odd(card {f\{f. \s\simplices. face f s}. rl ` f = {0..n} \ bnd f})" + "\f s. face f s \ (\a\s. f = s - {a})" + "\s\simplices. card s = n + 2" "\s\simplices. (rl ` s) \ {0..n+1}" + "\f\ {f. \s\simplices. face f s}. bnd f \ (card {s\simplices. face f s} = 1)" + "\f\ {f. \s\simplices. face f s}. \bnd f \ (card {s\simplices. face f s} = 2)" + "odd(card {f\{f. \s\simplices. face f s}. rl ` f = {0..n} \ bnd f})" shows "odd (card {s\simplices. (rl ` s = {0..n+1})})" - apply(rule kuhn_counting_lemma) defer apply(rule assms)+ prefer 3 apply(rule assms) proof(rule_tac[1-2] ballI impI)+ - have *:"{f. \s\simplices. \a\s. f = s - {a}} = (\s\simplices. {f. \a\s. (f = s - {a})})" by auto - have **: "\s\simplices. card s = n + 2 \ finite s" using assms(3) by (auto intro: card_ge_0_finite) - show "finite {f. \s\simplices. face f s}" unfolding assms(2)[rule_format] and * - apply(rule finite_UN_I[OF assms(1)]) using ** by auto - have *:"\ P f s. s\simplices \ (f \ {f. \s\simplices. \a\s. f = s - {a}}) \ + apply (rule kuhn_counting_lemma) + defer + apply (rule assms)+ + prefer 3 + apply (rule assms) +proof (rule_tac[1-2] ballI impI)+ + have *: "{f. \s\simplices. \a\s. f = s - {a}} = (\s\simplices. {f. \a\s. (f = s - {a})})" + by auto + have **: "\s\simplices. card s = n + 2 \ finite s" + using assms(3) by (auto intro: card_ge_0_finite) + show "finite {f. \s\simplices. face f s}" + unfolding assms(2)[rule_format] and * + apply (rule finite_UN_I[OF assms(1)]) using ** apply auto + done + have *: "\P f s. s\simplices \ (f \ {f. \s\simplices. \a\s. f = s - {a}}) \ (\a\s. (f = s - {a})) \ P f \ (\a\s. (f = s - {a}) \ P f)" by auto - fix s assume s:"s\simplices" let ?S = "{f \ {f. \s\simplices. face f s}. face f s \ rl ` f = {0..n}}" - have "{0..n + 1} - {n + 1} = {0..n}" by auto - hence S:"?S = {s'. \a\s. s' = s - {a} \ rl ` s' = {0..n + 1} - {n + 1}}" apply- apply(rule set_eqI) - unfolding assms(2)[rule_format] mem_Collect_eq and *[OF s, unfolded mem_Collect_eq, where P="\x. rl ` x = {0..n}"] by auto - show "rl ` s = {0..n+1} \ card ?S = 1" "rl ` s \ {0..n+1} \ card ?S = 0 \ card ?S = 2" unfolding S - apply(rule_tac[!] image_lemma_1 image_lemma_2) using ** assms(4) and s by auto qed + fix s assume s: "s\simplices" + let ?S = "{f \ {f. \s\simplices. face f s}. face f s \ rl ` f = {0..n}}" + have "{0..n + 1} - {n + 1} = {0..n}" by auto + then have S: "?S = {s'. \a\s. s' = s - {a} \ rl ` s' = {0..n + 1} - {n + 1}}" + apply - + apply (rule set_eqI) + unfolding assms(2)[rule_format] mem_Collect_eq and *[OF s, unfolded mem_Collect_eq, where P="\x. rl ` x = {0..n}"] + apply auto + done + show "rl ` s = {0..n+1} \ card ?S = 1" "rl ` s \ {0..n+1} \ card ?S = 0 \ card ?S = 2" + unfolding S + apply(rule_tac[!] image_lemma_1 image_lemma_2) + using ** assms(4) and s apply auto + done +qed + subsection {*We use the following notion of ordering rather than pointwise indexing. *} @@ -243,49 +307,125 @@ unfolding kle_def apply rule apply(rule ext) by auto lemma pointwise_minimal_pointwise_maximal: fixes s::"(nat\nat) set" - assumes "finite s" "s \ {}" "\x\s. \y\s. (\j. x j \ y j) \ (\j. y j \ x j)" + assumes "finite s" "s \ {}" "\x\s. \y\s. (\j. x j \ y j) \ (\j. y j \ x j)" shows "\a\s. \x\s. \j. a j \ x j" "\a\s. \x\s. \j. x j \ a j" - using assms unfolding atomize_conj apply- proof(induct s rule:finite_induct) - fix x and F::"(nat\nat) set" assume as:"finite F" "x \ F" + using assms unfolding atomize_conj +proof (induct s rule:finite_induct) + fix x and F::"(nat\nat) set" + assume as:"finite F" "x \ F" "\F \ {}; \x\F. \y\F. (\j. x j \ y j) \ (\j. y j \ x j)\ \ (\a\F. \x\F. \j. a j \ x j) \ (\a\F. \x\F. \j. x j \ a j)" "insert x F \ {}" "\xa\insert x F. \y\insert x F. (\j. xa j \ y j) \ (\j. y j \ xa j)" - show "(\a\insert x F. \x\insert x F. \j. a j \ x j) \ (\a\insert x F. \x\insert x F. \j. x j \ a j)" proof(cases "F={}") - case True thus ?thesis apply-apply(rule,rule_tac[!] x=x in bexI) by auto next - case False obtain a b where a:"a\insert x F" "\x\F. \j. a j \ x j" and - b:"b\insert x F" "\x\F. \j. x j \ b j" using as(3)[OF False] using as(5) by auto + show "(\a\insert x F. \x\insert x F. \j. a j \ x j) \ (\a\insert x F. \x\insert x F. \j. x j \ a j)" + proof (cases "F = {}") + case True + then show ?thesis + apply - + apply (rule, rule_tac[!] x=x in bexI) + apply auto + done + next + case False + obtain a b where a: "a\insert x F" "\x\F. \j. a j \ x j" and + b: "b\insert x F" "\x\F. \j. x j \ b j" using as(3)[OF False] using as(5) by auto have "\a\insert x F. \x\insert x F. \j. a j \ x j" - using as(5)[rule_format,OF a(1) insertI1] apply- proof(erule disjE) - assume "\j. a j \ x j" thus ?thesis apply(rule_tac x=a in bexI) using a by auto next - assume "\j. x j \ a j" thus ?thesis apply(rule_tac x=x in bexI) apply(rule,rule) using a apply - - apply(erule_tac x=xa in ballE) apply(erule_tac x=j in allE)+ by auto qed moreover + using as(5)[rule_format,OF a(1) insertI1] + apply - + proof (erule disjE) + assume "\j. a j \ x j" + then show ?thesis + apply (rule_tac x=a in bexI) using a apply auto done + next + assume "\j. x j \ a j" + then show ?thesis + apply (rule_tac x=x in bexI) + apply (rule, rule) using a apply - + apply (erule_tac x=xa in ballE) + apply (erule_tac x=j in allE)+ + apply auto + done + qed + moreover have "\b\insert x F. \x\insert x F. \j. x j \ b j" - using as(5)[rule_format,OF b(1) insertI1] apply- proof(erule disjE) - assume "\j. x j \ b j" thus ?thesis apply(rule_tac x=b in bexI) using b by auto next - assume "\j. b j \ x j" thus ?thesis apply(rule_tac x=x in bexI) apply(rule,rule) using b apply - - apply(erule_tac x=xa in ballE) apply(erule_tac x=j in allE)+ by auto qed - ultimately show ?thesis by auto qed qed(auto) + using as(5)[rule_format,OF b(1) insertI1] apply- + proof (erule disjE) + assume "\j. x j \ b j" + then show ?thesis + apply(rule_tac x=b in bexI) using b + apply auto + done + next + assume "\j. b j \ x j" + then show ?thesis + apply (rule_tac x=x in bexI) + apply (rule, rule) using b apply - + apply (erule_tac x=xa in ballE) + apply (erule_tac x=j in allE)+ + apply auto + done + qed + ultimately show ?thesis by auto + qed +qed auto + lemma kle_imp_pointwise: "kle n x y \ (\j. x j \ y j)" unfolding kle_def by auto -lemma pointwise_antisym: fixes x::"nat \ nat" +lemma pointwise_antisym: + fixes x :: "nat \ nat" shows "(\j. x j \ y j) \ (\j. y j \ x j) \ (x = y)" - apply(rule, rule ext,erule conjE) apply(erule_tac x=xa in allE)+ by auto + apply (rule, rule ext, erule conjE) + apply (erule_tac x=xa in allE)+ + apply auto + done -lemma kle_trans: assumes "kle n x y" "kle n y z" "kle n x z \ kle n z x" shows "kle n x z" - using assms apply- apply(erule disjE) apply assumption proof- case goal1 - hence "x=z" apply- apply(rule ext) apply(drule kle_imp_pointwise)+ - apply(erule_tac x=xa in allE)+ by auto thus ?case by auto qed +lemma kle_trans: + assumes "kle n x y" "kle n y z" "kle n x z \ kle n z x" + shows "kle n x z" + using assms + apply - + apply (erule disjE) + apply assumption +proof - + case goal1 + then have "x = z" + apply - + apply (rule ext) + apply (drule kle_imp_pointwise)+ + apply (erule_tac x=xa in allE)+ + apply auto + done + then show ?case by auto +qed -lemma kle_strict: assumes "kle n x y" "x \ y" +lemma kle_strict: + assumes "kle n x y" "x \ y" shows "\j. x j \ y j" "\k. 1 \ k \ k \ n \ x(k) < y(k)" - apply(rule kle_imp_pointwise[OF assms(1)]) proof- + apply (rule kle_imp_pointwise[OF assms(1)]) +proof - guess k using assms(1)[unfolded kle_def] .. note k = this - show "\k. 1 \ k \ k \ n \ x(k) < y(k)" proof(cases "k={}") - case True hence "x=y" apply-apply(rule ext) using k by auto - thus ?thesis using assms(2) by auto next - case False hence "(SOME k'. k' \ k) \ k" apply-apply(rule someI_ex) by auto - thus ?thesis apply(rule_tac x="SOME k'. k' \ k" in exI) using k by auto qed qed + show "\k. 1 \ k \ k \ n \ x(k) < y(k)" +proof (cases "k={}") + case True + then have "x = y" + apply - + apply (rule ext) + using k apply auto + done + then show ?thesis using assms(2) by auto +next + case False + then have "(SOME k'. k' \ k) \ k" + apply - + apply (rule someI_ex) + apply auto + done + then show ?thesis + apply (rule_tac x = "SOME k'. k' \ k" in exI) + using k apply auto + done + qed +qed lemma kle_minimal: assumes "finite s" "s \ {}" "\x\s. \y\s. kle n x y \ kle n y x" shows "\a\s. \x\s. kle n a x" proof-