author | haftmann |
Sun, 09 May 2021 05:48:50 +0000 | |
changeset 73648 | 1bd3463e30b8 |
parent 73466 | ee1c4962671c |
child 73932 | fd21b4a93043 |
permissions | -rw-r--r-- |
53674 | 1 |
(* Author: John Harrison |
63305
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2 |
Author: Robert Himmelmann, TU Muenchen (Translation from HOL light) and LCP |
53674 | 3 |
*) |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
4 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
5 |
(* At the moment this is just Brouwer's fixpoint theorem. The proof is from *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
6 |
(* Kuhn: "some combinatorial lemmas in topology", IBM J. v4. (1960) p. 518 *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
7 |
(* See "http://www.research.ibm.com/journal/rd/045/ibmrd0405K.pdf". *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
8 |
(* *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
9 |
(* The script below is quite messy, but at least we avoid formalizing any *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
10 |
(* topological machinery; we don't even use barycentric subdivision; this is *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
11 |
(* the big advantage of Kuhn's proof over the usual Sperner's lemma one. *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
12 |
(* *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
13 |
(* (c) Copyright, John Harrison 1998-2008 *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
14 |
|
68617 | 15 |
section \<open>Brouwer's Fixed Point Theorem\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
16 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
17 |
theory Brouwer_Fixpoint |
70643
93a7a85de312
Removal of the redundant ancestor Continuous_Extension
paulson <lp15@cam.ac.uk>
parents:
70642
diff
changeset
|
18 |
imports Homeomorphism Derivative |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
19 |
begin |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
20 |
|
68617 | 21 |
subsection \<open>Retractions\<close> |
22 |
||
23 |
lemma retract_of_contractible: |
|
24 |
assumes "contractible T" "S retract_of T" |
|
25 |
shows "contractible S" |
|
26 |
using assms |
|
27 |
apply (clarsimp simp add: retract_of_def contractible_def retraction_def homotopic_with) |
|
28 |
apply (rule_tac x="r a" in exI) |
|
29 |
apply (rule_tac x="r \<circ> h" in exI) |
|
30 |
apply (intro conjI continuous_intros continuous_on_compose) |
|
31 |
apply (erule continuous_on_subset | force)+ |
|
32 |
done |
|
33 |
||
34 |
lemma retract_of_path_connected: |
|
35 |
"\<lbrakk>path_connected T; S retract_of T\<rbrakk> \<Longrightarrow> path_connected S" |
|
36 |
by (metis path_connected_continuous_image retract_of_def retraction) |
|
37 |
||
38 |
lemma retract_of_simply_connected: |
|
39 |
"\<lbrakk>simply_connected T; S retract_of T\<rbrakk> \<Longrightarrow> simply_connected S" |
|
40 |
apply (simp add: retract_of_def retraction_def, clarify) |
|
41 |
apply (rule simply_connected_retraction_gen) |
|
69738 | 42 |
apply (force elim!: continuous_on_subset)+ |
68617 | 43 |
done |
44 |
||
45 |
lemma retract_of_homotopically_trivial: |
|
46 |
assumes ts: "T retract_of S" |
|
47 |
and hom: "\<And>f g. \<lbrakk>continuous_on U f; f ` U \<subseteq> S; |
|
48 |
continuous_on U g; g ` U \<subseteq> S\<rbrakk> |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
49 |
\<Longrightarrow> homotopic_with_canon (\<lambda>x. True) U S f g" |
68617 | 50 |
and "continuous_on U f" "f ` U \<subseteq> T" |
51 |
and "continuous_on U g" "g ` U \<subseteq> T" |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
52 |
shows "homotopic_with_canon (\<lambda>x. True) U T f g" |
68617 | 53 |
proof - |
54 |
obtain r where "r ` S \<subseteq> S" "continuous_on S r" "\<forall>x\<in>S. r (r x) = r x" "T = r ` S" |
|
55 |
using ts by (auto simp: retract_of_def retraction) |
|
56 |
then obtain k where "Retracts S r T k" |
|
57 |
unfolding Retracts_def |
|
58 |
by (metis continuous_on_subset dual_order.trans image_iff image_mono) |
|
59 |
then show ?thesis |
|
60 |
apply (rule Retracts.homotopically_trivial_retraction_gen) |
|
61 |
using assms |
|
62 |
apply (force simp: hom)+ |
|
63 |
done |
|
64 |
qed |
|
65 |
||
66 |
lemma retract_of_homotopically_trivial_null: |
|
67 |
assumes ts: "T retract_of S" |
|
68 |
and hom: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S\<rbrakk> |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
69 |
\<Longrightarrow> \<exists>c. homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. c)" |
68617 | 70 |
and "continuous_on U f" "f ` U \<subseteq> T" |
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
71 |
obtains c where "homotopic_with_canon (\<lambda>x. True) U T f (\<lambda>x. c)" |
68617 | 72 |
proof - |
73 |
obtain r where "r ` S \<subseteq> S" "continuous_on S r" "\<forall>x\<in>S. r (r x) = r x" "T = r ` S" |
|
74 |
using ts by (auto simp: retract_of_def retraction) |
|
75 |
then obtain k where "Retracts S r T k" |
|
76 |
unfolding Retracts_def |
|
77 |
by (metis continuous_on_subset dual_order.trans image_iff image_mono) |
|
78 |
then show ?thesis |
|
79 |
apply (rule Retracts.homotopically_trivial_retraction_null_gen) |
|
80 |
apply (rule TrueI refl assms that | assumption)+ |
|
81 |
done |
|
82 |
qed |
|
83 |
||
69945
35ba13ac6e5c
New abstract topological material
paulson <lp15@cam.ac.uk>
parents:
69922
diff
changeset
|
84 |
lemma retraction_openin_vimage_iff: |
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69738
diff
changeset
|
85 |
"openin (top_of_set S) (S \<inter> r -` U) \<longleftrightarrow> openin (top_of_set T) U" |
69661 | 86 |
if retraction: "retraction S T r" and "U \<subseteq> T" |
87 |
using retraction apply (rule retractionE) |
|
88 |
apply (rule continuous_right_inverse_imp_quotient_map [where g=r]) |
|
89 |
using \<open>U \<subseteq> T\<close> apply (auto elim: continuous_on_subset) |
|
90 |
done |
|
68617 | 91 |
|
92 |
lemma retract_of_locally_compact: |
|
93 |
fixes S :: "'a :: {heine_borel,real_normed_vector} set" |
|
94 |
shows "\<lbrakk> locally compact S; T retract_of S\<rbrakk> \<Longrightarrow> locally compact T" |
|
95 |
by (metis locally_compact_closedin closedin_retract) |
|
96 |
||
97 |
lemma homotopic_into_retract: |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
98 |
"\<lbrakk>f ` S \<subseteq> T; g ` S \<subseteq> T; T retract_of U; homotopic_with_canon (\<lambda>x. True) S U f g\<rbrakk> |
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
99 |
\<Longrightarrow> homotopic_with_canon (\<lambda>x. True) S T f g" |
68617 | 100 |
apply (subst (asm) homotopic_with_def) |
101 |
apply (simp add: homotopic_with retract_of_def retraction_def, clarify) |
|
102 |
apply (rule_tac x="r \<circ> h" in exI) |
|
103 |
apply (rule conjI continuous_intros | erule continuous_on_subset | force simp: image_subset_iff)+ |
|
104 |
done |
|
105 |
||
106 |
lemma retract_of_locally_connected: |
|
107 |
assumes "locally connected T" "S retract_of T" |
|
69661 | 108 |
shows "locally connected S" |
68617 | 109 |
using assms |
69945
35ba13ac6e5c
New abstract topological material
paulson <lp15@cam.ac.uk>
parents:
69922
diff
changeset
|
110 |
by (auto simp: idempotent_imp_retraction intro!: retraction_openin_vimage_iff elim!: locally_connected_quotient_image retract_ofE) |
68617 | 111 |
|
112 |
lemma retract_of_locally_path_connected: |
|
113 |
assumes "locally path_connected T" "S retract_of T" |
|
69661 | 114 |
shows "locally path_connected S" |
68617 | 115 |
using assms |
69945
35ba13ac6e5c
New abstract topological material
paulson <lp15@cam.ac.uk>
parents:
69922
diff
changeset
|
116 |
by (auto simp: idempotent_imp_retraction intro!: retraction_openin_vimage_iff elim!: locally_path_connected_quotient_image retract_ofE) |
68617 | 117 |
|
118 |
text \<open>A few simple lemmas about deformation retracts\<close> |
|
119 |
||
120 |
lemma deformation_retract_imp_homotopy_eqv: |
|
121 |
fixes S :: "'a::euclidean_space set" |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
122 |
assumes "homotopic_with_canon (\<lambda>x. True) S S id r" and r: "retraction S T r" |
68617 | 123 |
shows "S homotopy_eqv T" |
124 |
proof - |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
125 |
have "homotopic_with_canon (\<lambda>x. True) S S (id \<circ> r) id" |
68617 | 126 |
by (simp add: assms(1) homotopic_with_symD) |
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
127 |
moreover have "homotopic_with_canon (\<lambda>x. True) T T (r \<circ> id) id" |
68617 | 128 |
using r unfolding retraction_def |
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
129 |
by (metis eq_id_iff homotopic_with_id2 topspace_euclidean_subtopology) |
68617 | 130 |
ultimately |
131 |
show ?thesis |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
132 |
unfolding homotopy_equivalent_space_def |
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
133 |
by (metis (no_types, lifting) continuous_map_subtopology_eu continuous_on_id' id_def image_id r retraction_def) |
68617 | 134 |
qed |
135 |
||
136 |
lemma deformation_retract: |
|
137 |
fixes S :: "'a::euclidean_space set" |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
138 |
shows "(\<exists>r. homotopic_with_canon (\<lambda>x. True) S S id r \<and> retraction S T r) \<longleftrightarrow> |
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
139 |
T retract_of S \<and> (\<exists>f. homotopic_with_canon (\<lambda>x. True) S S id f \<and> f ` S \<subseteq> T)" |
68617 | 140 |
(is "?lhs = ?rhs") |
141 |
proof |
|
142 |
assume ?lhs |
|
143 |
then show ?rhs |
|
144 |
by (auto simp: retract_of_def retraction_def) |
|
145 |
next |
|
146 |
assume ?rhs |
|
147 |
then show ?lhs |
|
148 |
apply (clarsimp simp add: retract_of_def retraction_def) |
|
149 |
apply (rule_tac x=r in exI, simp) |
|
150 |
apply (rule homotopic_with_trans, assumption) |
|
151 |
apply (rule_tac f = "r \<circ> f" and g="r \<circ> id" in homotopic_with_eq) |
|
71745 | 152 |
apply (rule_tac Y=S in homotopic_with_compose_continuous_left) |
68617 | 153 |
apply (auto simp: homotopic_with_sym) |
154 |
done |
|
155 |
qed |
|
156 |
||
157 |
lemma deformation_retract_of_contractible_sing: |
|
158 |
fixes S :: "'a::euclidean_space set" |
|
159 |
assumes "contractible S" "a \<in> S" |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
160 |
obtains r where "homotopic_with_canon (\<lambda>x. True) S S id r" "retraction S {a} r" |
68617 | 161 |
proof - |
162 |
have "{a} retract_of S" |
|
163 |
by (simp add: \<open>a \<in> S\<close>) |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
164 |
moreover have "homotopic_with_canon (\<lambda>x. True) S S id (\<lambda>x. a)" |
68617 | 165 |
using assms |
69738 | 166 |
by (auto simp: contractible_def homotopic_into_contractible image_subset_iff) |
68617 | 167 |
moreover have "(\<lambda>x. a) ` S \<subseteq> {a}" |
168 |
by (simp add: image_subsetI) |
|
169 |
ultimately show ?thesis |
|
170 |
using that deformation_retract by metis |
|
171 |
qed |
|
172 |
||
173 |
||
174 |
lemma continuous_on_compact_surface_projection_aux: |
|
175 |
fixes S :: "'a::t2_space set" |
|
176 |
assumes "compact S" "S \<subseteq> T" "image q T \<subseteq> S" |
|
177 |
and contp: "continuous_on T p" |
|
178 |
and "\<And>x. x \<in> S \<Longrightarrow> q x = x" |
|
179 |
and [simp]: "\<And>x. x \<in> T \<Longrightarrow> q(p x) = q x" |
|
180 |
and "\<And>x. x \<in> T \<Longrightarrow> p(q x) = p x" |
|
181 |
shows "continuous_on T q" |
|
182 |
proof - |
|
183 |
have *: "image p T = image p S" |
|
184 |
using assms by auto (metis imageI subset_iff) |
|
185 |
have contp': "continuous_on S p" |
|
186 |
by (rule continuous_on_subset [OF contp \<open>S \<subseteq> T\<close>]) |
|
187 |
have "continuous_on (p ` T) q" |
|
188 |
by (simp add: "*" assms(1) assms(2) assms(5) continuous_on_inv contp' rev_subsetD) |
|
189 |
then have "continuous_on T (q \<circ> p)" |
|
190 |
by (rule continuous_on_compose [OF contp]) |
|
191 |
then show ?thesis |
|
192 |
by (rule continuous_on_eq [of _ "q \<circ> p"]) (simp add: o_def) |
|
193 |
qed |
|
194 |
||
195 |
lemma continuous_on_compact_surface_projection: |
|
196 |
fixes S :: "'a::real_normed_vector set" |
|
197 |
assumes "compact S" |
|
198 |
and S: "S \<subseteq> V - {0}" and "cone V" |
|
199 |
and iff: "\<And>x k. x \<in> V - {0} \<Longrightarrow> 0 < k \<and> (k *\<^sub>R x) \<in> S \<longleftrightarrow> d x = k" |
|
200 |
shows "continuous_on (V - {0}) (\<lambda>x. d x *\<^sub>R x)" |
|
201 |
proof (rule continuous_on_compact_surface_projection_aux [OF \<open>compact S\<close> S]) |
|
202 |
show "(\<lambda>x. d x *\<^sub>R x) ` (V - {0}) \<subseteq> S" |
|
203 |
using iff by auto |
|
204 |
show "continuous_on (V - {0}) (\<lambda>x. inverse(norm x) *\<^sub>R x)" |
|
205 |
by (intro continuous_intros) force |
|
206 |
show "\<And>x. x \<in> S \<Longrightarrow> d x *\<^sub>R x = x" |
|
207 |
by (metis S zero_less_one local.iff scaleR_one subset_eq) |
|
208 |
show "d (x /\<^sub>R norm x) *\<^sub>R (x /\<^sub>R norm x) = d x *\<^sub>R x" if "x \<in> V - {0}" for x |
|
209 |
using iff [of "inverse(norm x) *\<^sub>R x" "norm x * d x", symmetric] iff that \<open>cone V\<close> |
|
210 |
by (simp add: field_simps cone_def zero_less_mult_iff) |
|
211 |
show "d x *\<^sub>R x /\<^sub>R norm (d x *\<^sub>R x) = x /\<^sub>R norm x" if "x \<in> V - {0}" for x |
|
212 |
proof - |
|
213 |
have "0 < d x" |
|
214 |
using local.iff that by blast |
|
215 |
then show ?thesis |
|
216 |
by simp |
|
217 |
qed |
|
218 |
qed |
|
219 |
||
220 |
subsection \<open>Kuhn Simplices\<close> |
|
221 |
||
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
222 |
lemma bij_betw_singleton_eq: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
223 |
assumes f: "bij_betw f A B" and g: "bij_betw g A B" and a: "a \<in> A" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
224 |
assumes eq: "(\<And>x. x \<in> A \<Longrightarrow> x \<noteq> a \<Longrightarrow> f x = g x)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
225 |
shows "f a = g a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
226 |
proof - |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
227 |
have "f ` (A - {a}) = g ` (A - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
228 |
by (intro image_cong) (simp_all add: eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
229 |
then have "B - {f a} = B - {g a}" |
69286 | 230 |
using f g a by (auto simp: bij_betw_def inj_on_image_set_diff set_eq_iff) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
231 |
moreover have "f a \<in> B" "g a \<in> B" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
232 |
using f g a by (auto simp: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
233 |
ultimately show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
234 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
235 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
236 |
|
63365 | 237 |
lemmas swap_apply1 = swap_apply(1) |
238 |
lemmas swap_apply2 = swap_apply(2) |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
239 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
240 |
lemma pointwise_minimal_pointwise_maximal: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
241 |
fixes s :: "(nat \<Rightarrow> nat) set" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
242 |
assumes "finite s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
243 |
and "s \<noteq> {}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
244 |
and "\<forall>x\<in>s. \<forall>y\<in>s. x \<le> y \<or> y \<le> x" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
245 |
shows "\<exists>a\<in>s. \<forall>x\<in>s. a \<le> x" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
246 |
and "\<exists>a\<in>s. \<forall>x\<in>s. x \<le> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
247 |
using assms |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
248 |
proof (induct s rule: finite_ne_induct) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
249 |
case (insert b s) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
250 |
assume *: "\<forall>x\<in>insert b s. \<forall>y\<in>insert b s. x \<le> y \<or> y \<le> x" |
63540 | 251 |
then obtain u l where "l \<in> s" "\<forall>b\<in>s. l \<le> b" "u \<in> s" "\<forall>b\<in>s. b \<le> u" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
252 |
using insert by auto |
63540 | 253 |
with * show "\<exists>a\<in>insert b s. \<forall>x\<in>insert b s. a \<le> x" "\<exists>a\<in>insert b s. \<forall>x\<in>insert b s. x \<le> a" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
254 |
using *[rule_format, of b u] *[rule_format, of b l] by (metis insert_iff order.trans)+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
255 |
qed auto |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
256 |
|
49555 | 257 |
lemma kuhn_labelling_lemma: |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
258 |
fixes P Q :: "'a::euclidean_space \<Rightarrow> bool" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
259 |
assumes "\<forall>x. P x \<longrightarrow> P (f x)" |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
260 |
and "\<forall>x. P x \<longrightarrow> (\<forall>i\<in>Basis. Q i \<longrightarrow> 0 \<le> x\<bullet>i \<and> x\<bullet>i \<le> 1)" |
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
261 |
shows "\<exists>l. (\<forall>x.\<forall>i\<in>Basis. l x i \<le> (1::nat)) \<and> |
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
262 |
(\<forall>x.\<forall>i\<in>Basis. P x \<and> Q i \<and> (x\<bullet>i = 0) \<longrightarrow> (l x i = 0)) \<and> |
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
263 |
(\<forall>x.\<forall>i\<in>Basis. P x \<and> Q i \<and> (x\<bullet>i = 1) \<longrightarrow> (l x i = 1)) \<and> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
264 |
(\<forall>x.\<forall>i\<in>Basis. P x \<and> Q i \<and> (l x i = 0) \<longrightarrow> x\<bullet>i \<le> f x\<bullet>i) \<and> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
265 |
(\<forall>x.\<forall>i\<in>Basis. P x \<and> Q i \<and> (l x i = 1) \<longrightarrow> f x\<bullet>i \<le> x\<bullet>i)" |
49374 | 266 |
proof - |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
267 |
{ fix x i |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
268 |
let ?R = "\<lambda>y. (P x \<and> Q i \<and> x \<bullet> i = 0 \<longrightarrow> y = (0::nat)) \<and> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
269 |
(P x \<and> Q i \<and> x \<bullet> i = 1 \<longrightarrow> y = 1) \<and> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
270 |
(P x \<and> Q i \<and> y = 0 \<longrightarrow> x \<bullet> i \<le> f x \<bullet> i) \<and> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
271 |
(P x \<and> Q i \<and> y = 1 \<longrightarrow> f x \<bullet> i \<le> x \<bullet> i)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
272 |
{ assume "P x" "Q i" "i \<in> Basis" with assms have "0 \<le> f x \<bullet> i \<and> f x \<bullet> i \<le> 1" by auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
273 |
then have "i \<in> Basis \<Longrightarrow> ?R 0 \<or> ?R 1" by auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
274 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
275 |
unfolding all_conj_distrib[symmetric] Ball_def (* FIXME: shouldn't this work by metis? *) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
276 |
by (subst choice_iff[symmetric])+ blast |
49374 | 277 |
qed |
278 |
||
53185 | 279 |
|
68617 | 280 |
subsubsection \<open>The key "counting" observation, somewhat abstracted\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
281 |
|
53252 | 282 |
lemma kuhn_counting_lemma: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
283 |
fixes bnd compo compo' face S F |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
284 |
defines "nF s == card {f\<in>F. face f s \<and> compo' f}" |
67443
3abf6a722518
standardized towards new-style formal comments: isabelle update_comments;
wenzelm
parents:
67399
diff
changeset
|
285 |
assumes [simp, intro]: "finite F" \<comment> \<open>faces\<close> and [simp, intro]: "finite S" \<comment> \<open>simplices\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
286 |
and "\<And>f. f \<in> F \<Longrightarrow> bnd f \<Longrightarrow> card {s\<in>S. face f s} = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
287 |
and "\<And>f. f \<in> F \<Longrightarrow> \<not> bnd f \<Longrightarrow> card {s\<in>S. face f s} = 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
288 |
and "\<And>s. s \<in> S \<Longrightarrow> compo s \<Longrightarrow> nF s = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
289 |
and "\<And>s. s \<in> S \<Longrightarrow> \<not> compo s \<Longrightarrow> nF s = 0 \<or> nF s = 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
290 |
and "odd (card {f\<in>F. compo' f \<and> bnd f})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
291 |
shows "odd (card {s\<in>S. compo s})" |
53185 | 292 |
proof - |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
293 |
have "(\<Sum>s | s \<in> S \<and> \<not> compo s. nF s) + (\<Sum>s | s \<in> S \<and> compo s. nF s) = (\<Sum>s\<in>S. nF s)" |
64267 | 294 |
by (subst sum.union_disjoint[symmetric]) (auto intro!: sum.cong) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
295 |
also have "\<dots> = (\<Sum>s\<in>S. card {f \<in> {f\<in>F. compo' f \<and> bnd f}. face f s}) + |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
296 |
(\<Sum>s\<in>S. card {f \<in> {f\<in>F. compo' f \<and> \<not> bnd f}. face f s})" |
64267 | 297 |
unfolding sum.distrib[symmetric] |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
298 |
by (subst card_Un_disjoint[symmetric]) |
64267 | 299 |
(auto simp: nF_def intro!: sum.cong arg_cong[where f=card]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
300 |
also have "\<dots> = 1 * card {f\<in>F. compo' f \<and> bnd f} + 2 * card {f\<in>F. compo' f \<and> \<not> bnd f}" |
67399 | 301 |
using assms(4,5) by (fastforce intro!: arg_cong2[where f="(+)"] sum_multicount) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
302 |
finally have "odd ((\<Sum>s | s \<in> S \<and> \<not> compo s. nF s) + card {s\<in>S. compo s})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
303 |
using assms(6,8) by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
304 |
moreover have "(\<Sum>s | s \<in> S \<and> \<not> compo s. nF s) = |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
305 |
(\<Sum>s | s \<in> S \<and> \<not> compo s \<and> nF s = 0. nF s) + (\<Sum>s | s \<in> S \<and> \<not> compo s \<and> nF s = 2. nF s)" |
64267 | 306 |
using assms(7) by (subst sum.union_disjoint[symmetric]) (fastforce intro!: sum.cong)+ |
53688 | 307 |
ultimately show ?thesis |
308 |
by auto |
|
53186 | 309 |
qed |
310 |
||
68617 | 311 |
subsubsection \<open>The odd/even result for faces of complete vertices, generalized\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
312 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
313 |
lemma kuhn_complete_lemma: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
314 |
assumes [simp]: "finite simplices" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
315 |
and face: "\<And>f s. face f s \<longleftrightarrow> (\<exists>a\<in>s. f = s - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
316 |
and card_s[simp]: "\<And>s. s \<in> simplices \<Longrightarrow> card s = n + 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
317 |
and rl_bd: "\<And>s. s \<in> simplices \<Longrightarrow> rl ` s \<subseteq> {..Suc n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
318 |
and bnd: "\<And>f s. s \<in> simplices \<Longrightarrow> face f s \<Longrightarrow> bnd f \<Longrightarrow> card {s\<in>simplices. face f s} = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
319 |
and nbnd: "\<And>f s. s \<in> simplices \<Longrightarrow> face f s \<Longrightarrow> \<not> bnd f \<Longrightarrow> card {s\<in>simplices. face f s} = 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
320 |
and odd_card: "odd (card {f. (\<exists>s\<in>simplices. face f s) \<and> rl ` f = {..n} \<and> bnd f})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
321 |
shows "odd (card {s\<in>simplices. (rl ` s = {..Suc n})})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
322 |
proof (rule kuhn_counting_lemma) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
323 |
have finite_s[simp]: "\<And>s. s \<in> simplices \<Longrightarrow> finite s" |
72302
d7d90ed4c74e
fixed some remarkably ugly proofs
paulson <lp15@cam.ac.uk>
parents:
71745
diff
changeset
|
324 |
by (metis add_is_0 zero_neq_numeral card.infinite assms(3)) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
325 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
326 |
let ?F = "{f. \<exists>s\<in>simplices. face f s}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
327 |
have F_eq: "?F = (\<Union>s\<in>simplices. \<Union>a\<in>s. {s - {a}})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
328 |
by (auto simp: face) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
329 |
show "finite ?F" |
60420 | 330 |
using \<open>finite simplices\<close> unfolding F_eq by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
331 |
|
60421 | 332 |
show "card {s \<in> simplices. face f s} = 1" if "f \<in> ?F" "bnd f" for f |
60449 | 333 |
using bnd that by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
334 |
|
60421 | 335 |
show "card {s \<in> simplices. face f s} = 2" if "f \<in> ?F" "\<not> bnd f" for f |
60449 | 336 |
using nbnd that by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
337 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
338 |
show "odd (card {f \<in> {f. \<exists>s\<in>simplices. face f s}. rl ` f = {..n} \<and> bnd f})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
339 |
using odd_card by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
340 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
341 |
fix s assume s[simp]: "s \<in> simplices" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
342 |
let ?S = "{f \<in> {f. \<exists>s\<in>simplices. face f s}. face f s \<and> rl ` f = {..n}}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
343 |
have "?S = (\<lambda>a. s - {a}) ` {a\<in>s. rl ` (s - {a}) = {..n}}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
344 |
using s by (fastforce simp: face) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
345 |
then have card_S: "card ?S = card {a\<in>s. rl ` (s - {a}) = {..n}}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
346 |
by (auto intro!: card_image inj_onI) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
347 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
348 |
{ assume rl: "rl ` s = {..Suc n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
349 |
then have inj_rl: "inj_on rl s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
350 |
by (intro eq_card_imp_inj_on) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
351 |
moreover obtain a where "rl a = Suc n" "a \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
352 |
by (metis atMost_iff image_iff le_Suc_eq rl) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
353 |
ultimately have n: "{..n} = rl ` (s - {a})" |
69286 | 354 |
by (auto simp: inj_on_image_set_diff rl) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
355 |
have "{a\<in>s. rl ` (s - {a}) = {..n}} = {a}" |
69286 | 356 |
using inj_rl \<open>a \<in> s\<close> by (auto simp: n inj_on_image_eq_iff[OF inj_rl]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
357 |
then show "card ?S = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
358 |
unfolding card_S by simp } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
359 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
360 |
{ assume rl: "rl ` s \<noteq> {..Suc n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
361 |
show "card ?S = 0 \<or> card ?S = 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
362 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
363 |
assume *: "{..n} \<subseteq> rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
364 |
with rl rl_bd[OF s] have rl_s: "rl ` s = {..n}" |
68022 | 365 |
by (auto simp: atMost_Suc subset_insert_iff split: if_split_asm) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
366 |
then have "\<not> inj_on rl s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
367 |
by (intro pigeonhole) simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
368 |
then obtain a b where ab: "a \<in> s" "b \<in> s" "rl a = rl b" "a \<noteq> b" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
369 |
by (auto simp: inj_on_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
370 |
then have eq: "rl ` (s - {a}) = rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
371 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
372 |
with ab have inj: "inj_on rl (s - {a})" |
68022 | 373 |
by (intro eq_card_imp_inj_on) (auto simp: rl_s card_Diff_singleton_if) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
374 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
375 |
{ fix x assume "x \<in> s" "x \<notin> {a, b}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
376 |
then have "rl ` s - {rl x} = rl ` ((s - {a}) - {x})" |
69286 | 377 |
by (auto simp: eq inj_on_image_set_diff[OF inj]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
378 |
also have "\<dots> = rl ` (s - {x})" |
60420 | 379 |
using ab \<open>x \<notin> {a, b}\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
380 |
also assume "\<dots> = rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
381 |
finally have False |
60420 | 382 |
using \<open>x\<in>s\<close> by auto } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
383 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
384 |
{ fix x assume "x \<in> {a, b}" with ab have "x \<in> s \<and> rl ` (s - {x}) = rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
385 |
by (simp add: set_eq_iff image_iff Bex_def) metis } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
386 |
ultimately have "{a\<in>s. rl ` (s - {a}) = {..n}} = {a, b}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
387 |
unfolding rl_s[symmetric] by fastforce |
60420 | 388 |
with \<open>a \<noteq> b\<close> show "card ?S = 0 \<or> card ?S = 2" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
389 |
unfolding card_S by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
390 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
391 |
assume "\<not> {..n} \<subseteq> rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
392 |
then have "\<And>x. rl ` (s - {x}) \<noteq> {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
393 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
394 |
then show "card ?S = 0 \<or> card ?S = 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
395 |
unfolding card_S by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
396 |
qed } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
397 |
qed fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
398 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
399 |
locale kuhn_simplex = |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
400 |
fixes p n and base upd and s :: "(nat \<Rightarrow> nat) set" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
401 |
assumes base: "base \<in> {..< n} \<rightarrow> {..< p}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
402 |
assumes base_out: "\<And>i. n \<le> i \<Longrightarrow> base i = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
403 |
assumes upd: "bij_betw upd {..< n} {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
404 |
assumes s_pre: "s = (\<lambda>i j. if j \<in> upd`{..< i} then Suc (base j) else base j) ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
405 |
begin |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
406 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
407 |
definition "enum i j = (if j \<in> upd`{..< i} then Suc (base j) else base j)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
408 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
409 |
lemma s_eq: "s = enum ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
410 |
unfolding s_pre enum_def[abs_def] .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
411 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
412 |
lemma upd_space: "i < n \<Longrightarrow> upd i < n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
413 |
using upd by (auto dest!: bij_betwE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
414 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
415 |
lemma s_space: "s \<subseteq> {..< n} \<rightarrow> {.. p}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
416 |
proof - |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
417 |
{ fix i assume "i \<le> n" then have "enum i \<in> {..< n} \<rightarrow> {.. p}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
418 |
proof (induct i) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
419 |
case 0 then show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
420 |
using base by (auto simp: Pi_iff less_imp_le enum_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
421 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
422 |
case (Suc i) with base show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
423 |
by (auto simp: Pi_iff Suc_le_eq less_imp_le enum_def intro: upd_space) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
424 |
qed } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
425 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
426 |
by (auto simp: s_eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
427 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
428 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
429 |
lemma inj_upd: "inj_on upd {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
430 |
using upd by (simp add: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
431 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
432 |
lemma inj_enum: "inj_on enum {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
433 |
proof - |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
434 |
{ fix x y :: nat assume "x \<noteq> y" "x \<le> n" "y \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
435 |
with upd have "upd ` {..< x} \<noteq> upd ` {..< y}" |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
436 |
by (subst inj_on_image_eq_iff[where C="{..< n}"]) (auto simp: bij_betw_def) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
437 |
then have "enum x \<noteq> enum y" |
68022 | 438 |
by (auto simp: enum_def fun_eq_iff) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
439 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
440 |
by (auto simp: inj_on_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
441 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
442 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
443 |
lemma enum_0: "enum 0 = base" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
444 |
by (simp add: enum_def[abs_def]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
445 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
446 |
lemma base_in_s: "base \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
447 |
unfolding s_eq by (subst enum_0[symmetric]) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
448 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
449 |
lemma enum_in: "i \<le> n \<Longrightarrow> enum i \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
450 |
unfolding s_eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
451 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
452 |
lemma one_step: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
453 |
assumes a: "a \<in> s" "j < n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
454 |
assumes *: "\<And>a'. a' \<in> s \<Longrightarrow> a' \<noteq> a \<Longrightarrow> a' j = p'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
455 |
shows "a j \<noteq> p'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
456 |
proof |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
457 |
assume "a j = p'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
458 |
with * a have "\<And>a'. a' \<in> s \<Longrightarrow> a' j = p'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
459 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
460 |
then have "\<And>i. i \<le> n \<Longrightarrow> enum i j = p'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
461 |
unfolding s_eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
462 |
from this[of 0] this[of n] have "j \<notin> upd ` {..< n}" |
62390 | 463 |
by (auto simp: enum_def fun_eq_iff split: if_split_asm) |
60420 | 464 |
with upd \<open>j < n\<close> show False |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
465 |
by (auto simp: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
466 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
467 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
468 |
lemma upd_inj: "i < n \<Longrightarrow> j < n \<Longrightarrow> upd i = upd j \<longleftrightarrow> i = j" |
61520
8f85bb443d33
Cauchy's integral formula, required lemmas, and a bit of reorganisation
paulson <lp15@cam.ac.uk>
parents:
61284
diff
changeset
|
469 |
using upd by (auto simp: bij_betw_def inj_on_eq_iff) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
470 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
471 |
lemma upd_surj: "upd ` {..< n} = {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
472 |
using upd by (auto simp: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
473 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
474 |
lemma in_upd_image: "A \<subseteq> {..< n} \<Longrightarrow> i < n \<Longrightarrow> upd i \<in> upd ` A \<longleftrightarrow> i \<in> A" |
61520
8f85bb443d33
Cauchy's integral formula, required lemmas, and a bit of reorganisation
paulson <lp15@cam.ac.uk>
parents:
61284
diff
changeset
|
475 |
using inj_on_image_mem_iff[of upd "{..< n}"] upd |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
476 |
by (auto simp: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
477 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
478 |
lemma enum_inj: "i \<le> n \<Longrightarrow> j \<le> n \<Longrightarrow> enum i = enum j \<longleftrightarrow> i = j" |
61520
8f85bb443d33
Cauchy's integral formula, required lemmas, and a bit of reorganisation
paulson <lp15@cam.ac.uk>
parents:
61284
diff
changeset
|
479 |
using inj_enum by (auto simp: inj_on_eq_iff) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
480 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
481 |
lemma in_enum_image: "A \<subseteq> {.. n} \<Longrightarrow> i \<le> n \<Longrightarrow> enum i \<in> enum ` A \<longleftrightarrow> i \<in> A" |
61520
8f85bb443d33
Cauchy's integral formula, required lemmas, and a bit of reorganisation
paulson <lp15@cam.ac.uk>
parents:
61284
diff
changeset
|
482 |
using inj_on_image_mem_iff[OF inj_enum] by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
483 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
484 |
lemma enum_mono: "i \<le> n \<Longrightarrow> j \<le> n \<Longrightarrow> enum i \<le> enum j \<longleftrightarrow> i \<le> j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
485 |
by (auto simp: enum_def le_fun_def in_upd_image Ball_def[symmetric]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
486 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
487 |
lemma enum_strict_mono: "i \<le> n \<Longrightarrow> j \<le> n \<Longrightarrow> enum i < enum j \<longleftrightarrow> i < j" |
68022 | 488 |
using enum_mono[of i j] enum_inj[of i j] by (auto simp: le_less) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
489 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
490 |
lemma chain: "a \<in> s \<Longrightarrow> b \<in> s \<Longrightarrow> a \<le> b \<or> b \<le> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
491 |
by (auto simp: s_eq enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
492 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
493 |
lemma less: "a \<in> s \<Longrightarrow> b \<in> s \<Longrightarrow> a i < b i \<Longrightarrow> a < b" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
494 |
using chain[of a b] by (auto simp: less_fun_def le_fun_def not_le[symmetric]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
495 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
496 |
lemma enum_0_bot: "a \<in> s \<Longrightarrow> a = enum 0 \<longleftrightarrow> (\<forall>a'\<in>s. a \<le> a')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
497 |
unfolding s_eq by (auto simp: enum_mono Ball_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
498 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
499 |
lemma enum_n_top: "a \<in> s \<Longrightarrow> a = enum n \<longleftrightarrow> (\<forall>a'\<in>s. a' \<le> a)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
500 |
unfolding s_eq by (auto simp: enum_mono Ball_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
501 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
502 |
lemma enum_Suc: "i < n \<Longrightarrow> enum (Suc i) = (enum i)(upd i := Suc (enum i (upd i)))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
503 |
by (auto simp: fun_eq_iff enum_def upd_inj) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
504 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
505 |
lemma enum_eq_p: "i \<le> n \<Longrightarrow> n \<le> j \<Longrightarrow> enum i j = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
506 |
by (induct i) (auto simp: enum_Suc enum_0 base_out upd_space not_less[symmetric]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
507 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
508 |
lemma out_eq_p: "a \<in> s \<Longrightarrow> n \<le> j \<Longrightarrow> a j = p" |
68022 | 509 |
unfolding s_eq by (auto simp: enum_eq_p) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
510 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
511 |
lemma s_le_p: "a \<in> s \<Longrightarrow> a j \<le> p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
512 |
using out_eq_p[of a j] s_space by (cases "j < n") auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
513 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
514 |
lemma le_Suc_base: "a \<in> s \<Longrightarrow> a j \<le> Suc (base j)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
515 |
unfolding s_eq by (auto simp: enum_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
516 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
517 |
lemma base_le: "a \<in> s \<Longrightarrow> base j \<le> a j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
518 |
unfolding s_eq by (auto simp: enum_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
519 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
520 |
lemma enum_le_p: "i \<le> n \<Longrightarrow> j < n \<Longrightarrow> enum i j \<le> p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
521 |
using enum_in[of i] s_space by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
522 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
523 |
lemma enum_less: "a \<in> s \<Longrightarrow> i < n \<Longrightarrow> enum i < a \<longleftrightarrow> enum (Suc i) \<le> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
524 |
unfolding s_eq by (auto simp: enum_strict_mono enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
525 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
526 |
lemma ksimplex_0: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
527 |
"n = 0 \<Longrightarrow> s = {(\<lambda>x. p)}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
528 |
using s_eq enum_def base_out by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
529 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
530 |
lemma replace_0: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
531 |
assumes "j < n" "a \<in> s" and p: "\<forall>x\<in>s - {a}. x j = 0" and "x \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
532 |
shows "x \<le> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
533 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
534 |
assume "x \<noteq> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
535 |
have "a j \<noteq> 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
536 |
using assms by (intro one_step[where a=a]) auto |
60420 | 537 |
with less[OF \<open>x\<in>s\<close> \<open>a\<in>s\<close>, of j] p[rule_format, of x] \<open>x \<in> s\<close> \<open>x \<noteq> a\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
538 |
show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
539 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
540 |
qed simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
541 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
542 |
lemma replace_1: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
543 |
assumes "j < n" "a \<in> s" and p: "\<forall>x\<in>s - {a}. x j = p" and "x \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
544 |
shows "a \<le> x" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
545 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
546 |
assume "x \<noteq> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
547 |
have "a j \<noteq> p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
548 |
using assms by (intro one_step[where a=a]) auto |
60420 | 549 |
with enum_le_p[of _ j] \<open>j < n\<close> \<open>a\<in>s\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
550 |
have "a j < p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
551 |
by (auto simp: less_le s_eq) |
60420 | 552 |
with less[OF \<open>a\<in>s\<close> \<open>x\<in>s\<close>, of j] p[rule_format, of x] \<open>x \<in> s\<close> \<open>x \<noteq> a\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
553 |
show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
554 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
555 |
qed simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
556 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
557 |
end |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
558 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
559 |
locale kuhn_simplex_pair = s: kuhn_simplex p n b_s u_s s + t: kuhn_simplex p n b_t u_t t |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
560 |
for p n b_s u_s s b_t u_t t |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
561 |
begin |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
562 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
563 |
lemma enum_eq: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
564 |
assumes l: "i \<le> l" "l \<le> j" and "j + d \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
565 |
assumes eq: "s.enum ` {i .. j} = t.enum ` {i + d .. j + d}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
566 |
shows "s.enum l = t.enum (l + d)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
567 |
using l proof (induct l rule: dec_induct) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
568 |
case base |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
569 |
then have s: "s.enum i \<in> t.enum ` {i + d .. j + d}" and t: "t.enum (i + d) \<in> s.enum ` {i .. j}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
570 |
using eq by auto |
60420 | 571 |
from t \<open>i \<le> j\<close> \<open>j + d \<le> n\<close> have "s.enum i \<le> t.enum (i + d)" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
572 |
by (auto simp: s.enum_mono) |
60420 | 573 |
moreover from s \<open>i \<le> j\<close> \<open>j + d \<le> n\<close> have "t.enum (i + d) \<le> s.enum i" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
574 |
by (auto simp: t.enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
575 |
ultimately show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
576 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
577 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
578 |
case (step l) |
60420 | 579 |
moreover from step.prems \<open>j + d \<le> n\<close> have |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
580 |
"s.enum l < s.enum (Suc l)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
581 |
"t.enum (l + d) < t.enum (Suc l + d)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
582 |
by (simp_all add: s.enum_strict_mono t.enum_strict_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
583 |
moreover have |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
584 |
"s.enum (Suc l) \<in> t.enum ` {i + d .. j + d}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
585 |
"t.enum (Suc l + d) \<in> s.enum ` {i .. j}" |
60420 | 586 |
using step \<open>j + d \<le> n\<close> eq by (auto simp: s.enum_inj t.enum_inj) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
587 |
ultimately have "s.enum (Suc l) = t.enum (Suc (l + d))" |
60420 | 588 |
using \<open>j + d \<le> n\<close> |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
589 |
by (intro antisym s.enum_less[THEN iffD1] t.enum_less[THEN iffD1]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
590 |
(auto intro!: s.enum_in t.enum_in) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
591 |
then show ?case by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
592 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
593 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
594 |
lemma ksimplex_eq_bot: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
595 |
assumes a: "a \<in> s" "\<And>a'. a' \<in> s \<Longrightarrow> a \<le> a'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
596 |
assumes b: "b \<in> t" "\<And>b'. b' \<in> t \<Longrightarrow> b \<le> b'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
597 |
assumes eq: "s - {a} = t - {b}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
598 |
shows "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
599 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
600 |
assume "n = 0" with s.ksimplex_0 t.ksimplex_0 show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
601 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
602 |
assume "n \<noteq> 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
603 |
have "s.enum 0 = (s.enum (Suc 0)) (u_s 0 := s.enum (Suc 0) (u_s 0) - 1)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
604 |
"t.enum 0 = (t.enum (Suc 0)) (u_t 0 := t.enum (Suc 0) (u_t 0) - 1)" |
60420 | 605 |
using \<open>n \<noteq> 0\<close> by (simp_all add: s.enum_Suc t.enum_Suc) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
606 |
moreover have e0: "a = s.enum 0" "b = t.enum 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
607 |
using a b by (simp_all add: s.enum_0_bot t.enum_0_bot) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
608 |
moreover |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
609 |
{ fix j assume "0 < j" "j \<le> n" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
610 |
moreover have "s - {a} = s.enum ` {Suc 0 .. n}" "t - {b} = t.enum ` {Suc 0 .. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
611 |
unfolding s.s_eq t.s_eq e0 by (auto simp: s.enum_inj t.enum_inj) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
612 |
ultimately have "s.enum j = t.enum j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
613 |
using enum_eq[of "1" j n 0] eq by auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
614 |
note enum_eq = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
615 |
then have "s.enum (Suc 0) = t.enum (Suc 0)" |
60420 | 616 |
using \<open>n \<noteq> 0\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
617 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
618 |
{ fix j assume "Suc j < n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
619 |
with enum_eq[of "Suc j"] enum_eq[of "Suc (Suc j)"] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
620 |
have "u_s (Suc j) = u_t (Suc j)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
621 |
using s.enum_Suc[of "Suc j"] t.enum_Suc[of "Suc j"] |
62390 | 622 |
by (auto simp: fun_eq_iff split: if_split_asm) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
623 |
then have "\<And>j. 0 < j \<Longrightarrow> j < n \<Longrightarrow> u_s j = u_t j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
624 |
by (auto simp: gr0_conv_Suc) |
60420 | 625 |
with \<open>n \<noteq> 0\<close> have "u_t 0 = u_s 0" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
626 |
by (intro bij_betw_singleton_eq[OF t.upd s.upd, of 0]) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
627 |
ultimately have "a = b" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
628 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
629 |
with assms show "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
630 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
631 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
632 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
633 |
lemma ksimplex_eq_top: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
634 |
assumes a: "a \<in> s" "\<And>a'. a' \<in> s \<Longrightarrow> a' \<le> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
635 |
assumes b: "b \<in> t" "\<And>b'. b' \<in> t \<Longrightarrow> b' \<le> b" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
636 |
assumes eq: "s - {a} = t - {b}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
637 |
shows "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
638 |
proof (cases n) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
639 |
assume "n = 0" with s.ksimplex_0 t.ksimplex_0 show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
640 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
641 |
case (Suc n') |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
642 |
have "s.enum n = (s.enum n') (u_s n' := Suc (s.enum n' (u_s n')))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
643 |
"t.enum n = (t.enum n') (u_t n' := Suc (t.enum n' (u_t n')))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
644 |
using Suc by (simp_all add: s.enum_Suc t.enum_Suc) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
645 |
moreover have en: "a = s.enum n" "b = t.enum n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
646 |
using a b by (simp_all add: s.enum_n_top t.enum_n_top) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
647 |
moreover |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
648 |
{ fix j assume "j < n" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
649 |
moreover have "s - {a} = s.enum ` {0 .. n'}" "t - {b} = t.enum ` {0 .. n'}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
650 |
unfolding s.s_eq t.s_eq en by (auto simp: s.enum_inj t.enum_inj Suc) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
651 |
ultimately have "s.enum j = t.enum j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
652 |
using enum_eq[of "0" j n' 0] eq Suc by auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
653 |
note enum_eq = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
654 |
then have "s.enum n' = t.enum n'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
655 |
using Suc by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
656 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
657 |
{ fix j assume "j < n'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
658 |
with enum_eq[of j] enum_eq[of "Suc j"] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
659 |
have "u_s j = u_t j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
660 |
using s.enum_Suc[of j] t.enum_Suc[of j] |
62390 | 661 |
by (auto simp: Suc fun_eq_iff split: if_split_asm) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
662 |
then have "\<And>j. j < n' \<Longrightarrow> u_s j = u_t j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
663 |
by (auto simp: gr0_conv_Suc) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
664 |
then have "u_t n' = u_s n'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
665 |
by (intro bij_betw_singleton_eq[OF t.upd s.upd, of n']) (auto simp: Suc) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
666 |
ultimately have "a = b" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
667 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
668 |
with assms show "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
669 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
670 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
671 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
672 |
end |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
673 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
674 |
inductive ksimplex for p n :: nat where |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
675 |
ksimplex: "kuhn_simplex p n base upd s \<Longrightarrow> ksimplex p n s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
676 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
677 |
lemma finite_ksimplexes: "finite {s. ksimplex p n s}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
678 |
proof (rule finite_subset) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
679 |
{ fix a s assume "ksimplex p n s" "a \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
680 |
then obtain b u where "kuhn_simplex p n b u s" by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
681 |
then interpret kuhn_simplex p n b u s . |
60420 | 682 |
from s_space \<open>a \<in> s\<close> out_eq_p[OF \<open>a \<in> s\<close>] |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
683 |
have "a \<in> (\<lambda>f x. if n \<le> x then p else f x) ` ({..< n} \<rightarrow>\<^sub>E {.. p})" |
62390 | 684 |
by (auto simp: image_iff subset_eq Pi_iff split: if_split_asm |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
685 |
intro!: bexI[of _ "restrict a {..< n}"]) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
686 |
then show "{s. ksimplex p n s} \<subseteq> Pow ((\<lambda>f x. if n \<le> x then p else f x) ` ({..< n} \<rightarrow>\<^sub>E {.. p}))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
687 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
688 |
qed (simp add: finite_PiE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
689 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
690 |
lemma ksimplex_card: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
691 |
assumes "ksimplex p n s" shows "card s = Suc n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
692 |
using assms proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
693 |
case (ksimplex u b) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
694 |
then interpret kuhn_simplex p n u b s . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
695 |
show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
696 |
by (simp add: card_image s_eq inj_enum) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
697 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
698 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
699 |
lemma simplex_top_face: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
700 |
assumes "0 < p" "\<forall>x\<in>s'. x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
701 |
shows "ksimplex p n s' \<longleftrightarrow> (\<exists>s a. ksimplex p (Suc n) s \<and> a \<in> s \<and> s' = s - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
702 |
using assms |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
703 |
proof safe |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
704 |
fix s a assume "ksimplex p (Suc n) s" and a: "a \<in> s" and na: "\<forall>x\<in>s - {a}. x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
705 |
then show "ksimplex p n (s - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
706 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
707 |
case (ksimplex base upd) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
708 |
then interpret kuhn_simplex p "Suc n" base upd "s" . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
709 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
710 |
have "a n < p" |
60420 | 711 |
using one_step[of a n p] na \<open>a\<in>s\<close> s_space by (auto simp: less_le) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
712 |
then have "a = enum 0" |
60420 | 713 |
using \<open>a \<in> s\<close> na by (subst enum_0_bot) (auto simp: le_less intro!: less[of a _ n]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
714 |
then have s_eq: "s - {a} = enum ` Suc ` {.. n}" |
71172 | 715 |
using s_eq by (simp add: atMost_Suc_eq_insert_0 insert_ident in_enum_image subset_eq) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
716 |
then have "enum 1 \<in> s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
717 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
718 |
then have "upd 0 = n" |
60420 | 719 |
using \<open>a n < p\<close> \<open>a = enum 0\<close> na[rule_format, of "enum 1"] |
62390 | 720 |
by (auto simp: fun_eq_iff enum_Suc split: if_split_asm) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
721 |
then have "bij_betw upd (Suc ` {..< n}) {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
722 |
using upd |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
723 |
by (subst notIn_Un_bij_betw3[where b=0]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
724 |
(auto simp: lessThan_Suc[symmetric] lessThan_Suc_eq_insert_0) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
725 |
then have "bij_betw (upd\<circ>Suc) {..<n} {..<n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
726 |
by (rule bij_betw_trans[rotated]) (auto simp: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
727 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
728 |
have "a n = p - 1" |
60420 | 729 |
using enum_Suc[of 0] na[rule_format, OF \<open>enum 1 \<in> s - {a}\<close>] \<open>a = enum 0\<close> by (auto simp: \<open>upd 0 = n\<close>) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
730 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
731 |
show ?thesis |
61169 | 732 |
proof (rule ksimplex.intros, standard) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
733 |
show "bij_betw (upd\<circ>Suc) {..< n} {..< n}" by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
734 |
show "base(n := p) \<in> {..<n} \<rightarrow> {..<p}" "\<And>i. n\<le>i \<Longrightarrow> (base(n := p)) i = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
735 |
using base base_out by (auto simp: Pi_iff) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
736 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
737 |
have "\<And>i. Suc ` {..< i} = {..< Suc i} - {0}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
738 |
by (auto simp: image_iff Ball_def) arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
739 |
then have upd_Suc: "\<And>i. i \<le> n \<Longrightarrow> (upd\<circ>Suc) ` {..< i} = upd ` {..< Suc i} - {n}" |
69661 | 740 |
using \<open>upd 0 = n\<close> upd_inj by (auto simp add: image_iff less_Suc_eq_0_disj) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
741 |
have n_in_upd: "\<And>i. n \<in> upd ` {..< Suc i}" |
60420 | 742 |
using \<open>upd 0 = n\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
743 |
|
63040 | 744 |
define f' where "f' i j = |
745 |
(if j \<in> (upd\<circ>Suc)`{..< i} then Suc ((base(n := p)) j) else (base(n := p)) j)" for i j |
|
69661 | 746 |
{ fix x i |
747 |
assume i [arith]: "i \<le> n" |
|
748 |
with upd_Suc have "(upd \<circ> Suc) ` {..<i} = upd ` {..<Suc i} - {n}" . |
|
749 |
with \<open>a n < p\<close> \<open>a = enum 0\<close> \<open>upd 0 = n\<close> \<open>a n = p - 1\<close> |
|
750 |
have "enum (Suc i) x = f' i x" |
|
751 |
by (auto simp add: f'_def enum_def) } |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
752 |
then show "s - {a} = f' ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
753 |
unfolding s_eq image_comp by (intro image_cong) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
754 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
755 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
756 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
757 |
assume "ksimplex p n s'" and *: "\<forall>x\<in>s'. x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
758 |
then show "\<exists>s a. ksimplex p (Suc n) s \<and> a \<in> s \<and> s' = s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
759 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
760 |
case (ksimplex base upd) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
761 |
then interpret kuhn_simplex p n base upd s' . |
63040 | 762 |
define b where "b = base (n := p - 1)" |
763 |
define u where "u i = (case i of 0 \<Rightarrow> n | Suc i \<Rightarrow> upd i)" for i |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
764 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
765 |
have "ksimplex p (Suc n) (s' \<union> {b})" |
61169 | 766 |
proof (rule ksimplex.intros, standard) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
767 |
show "b \<in> {..<Suc n} \<rightarrow> {..<p}" |
60420 | 768 |
using base \<open>0 < p\<close> unfolding lessThan_Suc b_def by (auto simp: PiE_iff) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
769 |
show "\<And>i. Suc n \<le> i \<Longrightarrow> b i = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
770 |
using base_out by (auto simp: b_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
771 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
772 |
have "bij_betw u (Suc ` {..< n} \<union> {0}) ({..<n} \<union> {u 0})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
773 |
using upd |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
774 |
by (intro notIn_Un_bij_betw) (auto simp: u_def bij_betw_def image_comp comp_def inj_on_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
775 |
then show "bij_betw u {..<Suc n} {..<Suc n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
776 |
by (simp add: u_def lessThan_Suc[symmetric] lessThan_Suc_eq_insert_0) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
777 |
|
63040 | 778 |
define f' where "f' i j = (if j \<in> u`{..< i} then Suc (b j) else b j)" for i j |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
779 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
780 |
have u_eq: "\<And>i. i \<le> n \<Longrightarrow> u ` {..< Suc i} = upd ` {..< i} \<union> { n }" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
781 |
by (auto simp: u_def image_iff upd_inj Ball_def split: nat.split) arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
782 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
783 |
{ fix x have "x \<le> n \<Longrightarrow> n \<notin> upd ` {..<x}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
784 |
using upd_space by (simp add: image_iff neq_iff) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
785 |
note n_not_upd = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
786 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
787 |
have *: "f' ` {.. Suc n} = f' ` (Suc ` {.. n} \<union> {0})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
788 |
unfolding atMost_Suc_eq_insert_0 by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
789 |
also have "\<dots> = (f' \<circ> Suc) ` {.. n} \<union> {b}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
790 |
by (auto simp: f'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
791 |
also have "(f' \<circ> Suc) ` {.. n} = s'" |
60420 | 792 |
using \<open>0 < p\<close> base_out[of n] |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
793 |
unfolding s_eq enum_def[abs_def] f'_def[abs_def] upd_space |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
794 |
by (intro image_cong) (simp_all add: u_eq b_def fun_eq_iff n_not_upd) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
795 |
finally show "s' \<union> {b} = f' ` {.. Suc n}" .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
796 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
797 |
moreover have "b \<notin> s'" |
60420 | 798 |
using * \<open>0 < p\<close> by (auto simp: b_def) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
799 |
ultimately show ?thesis by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
800 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
801 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
802 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
803 |
lemma ksimplex_replace_0: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
804 |
assumes s: "ksimplex p n s" and a: "a \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
805 |
assumes j: "j < n" and p: "\<forall>x\<in>s - {a}. x j = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
806 |
shows "card {s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
807 |
using s |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
808 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
809 |
case (ksimplex b_s u_s) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
810 |
|
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
811 |
{ fix t b assume "ksimplex p n t" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
812 |
then obtain b_t u_t where "kuhn_simplex p n b_t u_t t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
813 |
by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
814 |
interpret kuhn_simplex_pair p n b_s u_s s b_t u_t t |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
815 |
by intro_locales fact+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
816 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
817 |
assume b: "b \<in> t" "t - {b} = s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
818 |
with a j p s.replace_0[of _ a] t.replace_0[of _ b] have "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
819 |
by (intro ksimplex_eq_top[of a b]) auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
820 |
then have "{s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = {s}" |
60420 | 821 |
using s \<open>a \<in> s\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
822 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
823 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
824 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
825 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
826 |
lemma ksimplex_replace_1: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
827 |
assumes s: "ksimplex p n s" and a: "a \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
828 |
assumes j: "j < n" and p: "\<forall>x\<in>s - {a}. x j = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
829 |
shows "card {s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
830 |
using s |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
831 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
832 |
case (ksimplex b_s u_s) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
833 |
|
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
834 |
{ fix t b assume "ksimplex p n t" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
835 |
then obtain b_t u_t where "kuhn_simplex p n b_t u_t t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
836 |
by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
837 |
interpret kuhn_simplex_pair p n b_s u_s s b_t u_t t |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
838 |
by intro_locales fact+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
839 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
840 |
assume b: "b \<in> t" "t - {b} = s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
841 |
with a j p s.replace_1[of _ a] t.replace_1[of _ b] have "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
842 |
by (intro ksimplex_eq_bot[of a b]) auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
843 |
then have "{s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = {s}" |
60420 | 844 |
using s \<open>a \<in> s\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
845 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
846 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
847 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
848 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
849 |
lemma ksimplex_replace_2: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
850 |
assumes s: "ksimplex p n s" and "a \<in> s" and "n \<noteq> 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
851 |
and lb: "\<forall>j<n. \<exists>x\<in>s - {a}. x j \<noteq> 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
852 |
and ub: "\<forall>j<n. \<exists>x\<in>s - {a}. x j \<noteq> p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
853 |
shows "card {s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
854 |
using s |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
855 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
856 |
case (ksimplex base upd) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
857 |
then interpret kuhn_simplex p n base upd s . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
858 |
|
60420 | 859 |
from \<open>a \<in> s\<close> obtain i where "i \<le> n" "a = enum i" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
860 |
unfolding s_eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
861 |
|
60420 | 862 |
from \<open>i \<le> n\<close> have "i = 0 \<or> i = n \<or> (0 < i \<and> i < n)" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
863 |
by linarith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
864 |
then have "\<exists>!s'. s' \<noteq> s \<and> ksimplex p n s' \<and> (\<exists>b\<in>s'. s - {a} = s'- {b})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
865 |
proof (elim disjE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
866 |
assume "i = 0" |
63040 | 867 |
define rot where [abs_def]: "rot i = (if i + 1 = n then 0 else i + 1)" for i |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
868 |
let ?upd = "upd \<circ> rot" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
869 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
870 |
have rot: "bij_betw rot {..< n} {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
871 |
by (auto simp: bij_betw_def inj_on_def image_iff Ball_def rot_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
872 |
arith+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
873 |
from rot upd have "bij_betw ?upd {..<n} {..<n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
874 |
by (rule bij_betw_trans) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
875 |
|
63040 | 876 |
define f' where [abs_def]: "f' i j = |
877 |
(if j \<in> ?upd`{..< i} then Suc (enum (Suc 0) j) else enum (Suc 0) j)" for i j |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
878 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
879 |
interpret b: kuhn_simplex p n "enum (Suc 0)" "upd \<circ> rot" "f' ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
880 |
proof |
60420 | 881 |
from \<open>a = enum i\<close> ub \<open>n \<noteq> 0\<close> \<open>i = 0\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
882 |
obtain i' where "i' \<le> n" "enum i' \<noteq> enum 0" "enum i' (upd 0) \<noteq> p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
883 |
unfolding s_eq by (auto intro: upd_space simp: enum_inj) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
884 |
then have "enum 1 \<le> enum i'" "enum i' (upd 0) < p" |
68022 | 885 |
using enum_le_p[of i' "upd 0"] by (auto simp: enum_inj enum_mono upd_space) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
886 |
then have "enum 1 (upd 0) < p" |
68022 | 887 |
by (auto simp: le_fun_def intro: le_less_trans) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
888 |
then show "enum (Suc 0) \<in> {..<n} \<rightarrow> {..<p}" |
68022 | 889 |
using base \<open>n \<noteq> 0\<close> by (auto simp: enum_0 enum_Suc PiE_iff extensional_def upd_space) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
890 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
891 |
{ fix i assume "n \<le> i" then show "enum (Suc 0) i = p" |
60420 | 892 |
using \<open>n \<noteq> 0\<close> by (auto simp: enum_eq_p) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
893 |
show "bij_betw ?upd {..<n} {..<n}" by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
894 |
qed (simp add: f'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
895 |
have ks_f': "ksimplex p n (f' ` {.. n})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
896 |
by rule unfold_locales |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
897 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
898 |
have b_enum: "b.enum = f'" unfolding f'_def b.enum_def[abs_def] .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
899 |
with b.inj_enum have inj_f': "inj_on f' {.. n}" by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
900 |
|
69661 | 901 |
have f'_eq_enum: "f' j = enum (Suc j)" if "j < n" for j |
902 |
proof - |
|
903 |
from that have "rot ` {..< j} = {0 <..< Suc j}" |
|
904 |
by (auto simp: rot_def image_Suc_lessThan cong: image_cong_simp) |
|
905 |
with that \<open>n \<noteq> 0\<close> show ?thesis |
|
906 |
by (simp only: f'_def enum_def fun_eq_iff image_comp [symmetric]) |
|
907 |
(auto simp add: upd_inj) |
|
908 |
qed |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
909 |
then have "enum ` Suc ` {..< n} = f' ` {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
910 |
by (force simp: enum_inj) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
911 |
also have "Suc ` {..< n} = {.. n} - {0}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
912 |
by (auto simp: image_iff Ball_def) arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
913 |
also have "{..< n} = {.. n} - {n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
914 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
915 |
finally have eq: "s - {a} = f' ` {.. n} - {f' n}" |
60420 | 916 |
unfolding s_eq \<open>a = enum i\<close> \<open>i = 0\<close> |
69286 | 917 |
by (simp add: inj_on_image_set_diff[OF inj_enum] inj_on_image_set_diff[OF inj_f']) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
918 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
919 |
have "enum 0 < f' 0" |
60420 | 920 |
using \<open>n \<noteq> 0\<close> by (simp add: enum_strict_mono f'_eq_enum) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
921 |
also have "\<dots> < f' n" |
60420 | 922 |
using \<open>n \<noteq> 0\<close> b.enum_strict_mono[of 0 n] unfolding b_enum by simp |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
923 |
finally have "a \<noteq> f' n" |
60420 | 924 |
using \<open>a = enum i\<close> \<open>i = 0\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
925 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
926 |
{ fix t c assume "ksimplex p n t" "c \<in> t" and eq_sma: "s - {a} = t - {c}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
927 |
obtain b u where "kuhn_simplex p n b u t" |
60420 | 928 |
using \<open>ksimplex p n t\<close> by (auto elim: ksimplex.cases) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
929 |
then interpret t: kuhn_simplex p n b u t . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
930 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
931 |
{ fix x assume "x \<in> s" "x \<noteq> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
932 |
then have "x (upd 0) = enum (Suc 0) (upd 0)" |
60420 | 933 |
by (auto simp: \<open>a = enum i\<close> \<open>i = 0\<close> s_eq enum_def enum_inj) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
934 |
then have eq_upd0: "\<forall>x\<in>t-{c}. x (upd 0) = enum (Suc 0) (upd 0)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
935 |
unfolding eq_sma[symmetric] by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
936 |
then have "c (upd 0) \<noteq> enum (Suc 0) (upd 0)" |
60420 | 937 |
using \<open>n \<noteq> 0\<close> by (intro t.one_step[OF \<open>c\<in>t\<close> ]) (auto simp: upd_space) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
938 |
then have "c (upd 0) < enum (Suc 0) (upd 0) \<or> c (upd 0) > enum (Suc 0) (upd 0)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
939 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
940 |
then have "t = s \<or> t = f' ` {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
941 |
proof (elim disjE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
942 |
assume *: "c (upd 0) < enum (Suc 0) (upd 0)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
943 |
interpret st: kuhn_simplex_pair p n base upd s b u t .. |
60420 | 944 |
{ fix x assume "x \<in> t" with * \<open>c\<in>t\<close> eq_upd0[rule_format, of x] have "c \<le> x" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
945 |
by (auto simp: le_less intro!: t.less[of _ _ "upd 0"]) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
946 |
note top = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
947 |
have "s = t" |
60420 | 948 |
using \<open>a = enum i\<close> \<open>i = 0\<close> \<open>c \<in> t\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
949 |
by (intro st.ksimplex_eq_bot[OF _ _ _ _ eq_sma]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
950 |
(auto simp: s_eq enum_mono t.s_eq t.enum_mono top) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
951 |
then show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
952 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
953 |
assume *: "c (upd 0) > enum (Suc 0) (upd 0)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
954 |
interpret st: kuhn_simplex_pair p n "enum (Suc 0)" "upd \<circ> rot" "f' ` {.. n}" b u t .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
955 |
have eq: "f' ` {..n} - {f' n} = t - {c}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
956 |
using eq_sma eq by simp |
60420 | 957 |
{ fix x assume "x \<in> t" with * \<open>c\<in>t\<close> eq_upd0[rule_format, of x] have "x \<le> c" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
958 |
by (auto simp: le_less intro!: t.less[of _ _ "upd 0"]) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
959 |
note top = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
960 |
have "f' ` {..n} = t" |
60420 | 961 |
using \<open>a = enum i\<close> \<open>i = 0\<close> \<open>c \<in> t\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
962 |
by (intro st.ksimplex_eq_top[OF _ _ _ _ eq]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
963 |
(auto simp: b.s_eq b.enum_mono t.s_eq t.enum_mono b_enum[symmetric] top) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
964 |
then show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
965 |
qed } |
60420 | 966 |
with ks_f' eq \<open>a \<noteq> f' n\<close> \<open>n \<noteq> 0\<close> show ?thesis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
967 |
apply (intro ex1I[of _ "f' ` {.. n}"]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
968 |
apply auto [] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
969 |
apply metis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
970 |
done |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
971 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
972 |
assume "i = n" |
60420 | 973 |
from \<open>n \<noteq> 0\<close> obtain n' where n': "n = Suc n'" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
974 |
by (cases n) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
975 |
|
63040 | 976 |
define rot where "rot i = (case i of 0 \<Rightarrow> n' | Suc i \<Rightarrow> i)" for i |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
977 |
let ?upd = "upd \<circ> rot" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
978 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
979 |
have rot: "bij_betw rot {..< n} {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
980 |
by (auto simp: bij_betw_def inj_on_def image_iff Bex_def rot_def n' split: nat.splits) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
981 |
arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
982 |
from rot upd have "bij_betw ?upd {..<n} {..<n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
983 |
by (rule bij_betw_trans) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
984 |
|
63040 | 985 |
define b where "b = base (upd n' := base (upd n') - 1)" |
986 |
define f' where [abs_def]: "f' i j = (if j \<in> ?upd`{..< i} then Suc (b j) else b j)" for i j |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
987 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
988 |
interpret b: kuhn_simplex p n b "upd \<circ> rot" "f' ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
989 |
proof |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
990 |
{ fix i assume "n \<le> i" then show "b i = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
991 |
using base_out[of i] upd_space[of n'] by (auto simp: b_def n') } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
992 |
show "b \<in> {..<n} \<rightarrow> {..<p}" |
60420 | 993 |
using base \<open>n \<noteq> 0\<close> upd_space[of n'] |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
994 |
by (auto simp: b_def PiE_def Pi_iff Ball_def upd_space extensional_def n') |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
995 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
996 |
show "bij_betw ?upd {..<n} {..<n}" by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
997 |
qed (simp add: f'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
998 |
have f': "b.enum = f'" unfolding f'_def b.enum_def[abs_def] .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
999 |
have ks_f': "ksimplex p n (b.enum ` {.. n})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1000 |
unfolding f' by rule unfold_locales |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1001 |
|
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
1002 |
have "0 < n" |
60420 | 1003 |
using \<open>n \<noteq> 0\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1004 |
|
60420 | 1005 |
{ from \<open>a = enum i\<close> \<open>n \<noteq> 0\<close> \<open>i = n\<close> lb upd_space[of n'] |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1006 |
obtain i' where "i' \<le> n" "enum i' \<noteq> enum n" "0 < enum i' (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1007 |
unfolding s_eq by (auto simp: enum_inj n') |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1008 |
moreover have "enum i' (upd n') = base (upd n')" |
60420 | 1009 |
unfolding enum_def using \<open>i' \<le> n\<close> \<open>enum i' \<noteq> enum n\<close> by (auto simp: n' upd_inj enum_inj) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1010 |
ultimately have "0 < base (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1011 |
by auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1012 |
then have benum1: "b.enum (Suc 0) = base" |
60420 | 1013 |
unfolding b.enum_Suc[OF \<open>0<n\<close>] b.enum_0 by (auto simp: b_def rot_def) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1014 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1015 |
have [simp]: "\<And>j. Suc j < n \<Longrightarrow> rot ` {..< Suc j} = {n'} \<union> {..< j}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1016 |
by (auto simp: rot_def image_iff Ball_def split: nat.splits) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1017 |
have rot_simps: "\<And>j. rot (Suc j) = j" "rot 0 = n'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1018 |
by (simp_all add: rot_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1019 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1020 |
{ fix j assume j: "Suc j \<le> n" then have "b.enum (Suc j) = enum j" |
68022 | 1021 |
by (induct j) (auto simp: benum1 enum_0 b.enum_Suc enum_Suc rot_simps) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1022 |
note b_enum_eq_enum = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1023 |
then have "enum ` {..< n} = b.enum ` Suc ` {..< n}" |
68022 | 1024 |
by (auto simp: image_comp intro!: image_cong) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1025 |
also have "Suc ` {..< n} = {.. n} - {0}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1026 |
by (auto simp: image_iff Ball_def) arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1027 |
also have "{..< n} = {.. n} - {n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1028 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1029 |
finally have eq: "s - {a} = b.enum ` {.. n} - {b.enum 0}" |
60420 | 1030 |
unfolding s_eq \<open>a = enum i\<close> \<open>i = n\<close> |
60303 | 1031 |
using inj_on_image_set_diff[OF inj_enum Diff_subset, of "{n}"] |
1032 |
inj_on_image_set_diff[OF b.inj_enum Diff_subset, of "{0}"] |
|
68022 | 1033 |
by (simp add: comp_def) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1034 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1035 |
have "b.enum 0 \<le> b.enum n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1036 |
by (simp add: b.enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1037 |
also have "b.enum n < enum n" |
60420 | 1038 |
using \<open>n \<noteq> 0\<close> by (simp add: enum_strict_mono b_enum_eq_enum n') |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1039 |
finally have "a \<noteq> b.enum 0" |
60420 | 1040 |
using \<open>a = enum i\<close> \<open>i = n\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1041 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1042 |
{ fix t c assume "ksimplex p n t" "c \<in> t" and eq_sma: "s - {a} = t - {c}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1043 |
obtain b' u where "kuhn_simplex p n b' u t" |
60420 | 1044 |
using \<open>ksimplex p n t\<close> by (auto elim: ksimplex.cases) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1045 |
then interpret t: kuhn_simplex p n b' u t . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1046 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1047 |
{ fix x assume "x \<in> s" "x \<noteq> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1048 |
then have "x (upd n') = enum n' (upd n')" |
60420 | 1049 |
by (auto simp: \<open>a = enum i\<close> n' \<open>i = n\<close> s_eq enum_def enum_inj in_upd_image) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1050 |
then have eq_upd0: "\<forall>x\<in>t-{c}. x (upd n') = enum n' (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1051 |
unfolding eq_sma[symmetric] by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1052 |
then have "c (upd n') \<noteq> enum n' (upd n')" |
60420 | 1053 |
using \<open>n \<noteq> 0\<close> by (intro t.one_step[OF \<open>c\<in>t\<close> ]) (auto simp: n' upd_space[unfolded n']) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1054 |
then have "c (upd n') < enum n' (upd n') \<or> c (upd n') > enum n' (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1055 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1056 |
then have "t = s \<or> t = b.enum ` {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1057 |
proof (elim disjE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1058 |
assume *: "c (upd n') > enum n' (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1059 |
interpret st: kuhn_simplex_pair p n base upd s b' u t .. |
60420 | 1060 |
{ fix x assume "x \<in> t" with * \<open>c\<in>t\<close> eq_upd0[rule_format, of x] have "x \<le> c" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1061 |
by (auto simp: le_less intro!: t.less[of _ _ "upd n'"]) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1062 |
note top = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1063 |
have "s = t" |
60420 | 1064 |
using \<open>a = enum i\<close> \<open>i = n\<close> \<open>c \<in> t\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1065 |
by (intro st.ksimplex_eq_top[OF _ _ _ _ eq_sma]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1066 |
(auto simp: s_eq enum_mono t.s_eq t.enum_mono top) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1067 |
then show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1068 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1069 |
assume *: "c (upd n') < enum n' (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1070 |
interpret st: kuhn_simplex_pair p n b "upd \<circ> rot" "f' ` {.. n}" b' u t .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1071 |
have eq: "f' ` {..n} - {b.enum 0} = t - {c}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1072 |
using eq_sma eq f' by simp |
60420 | 1073 |
{ fix x assume "x \<in> t" with * \<open>c\<in>t\<close> eq_upd0[rule_format, of x] have "c \<le> x" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1074 |
by (auto simp: le_less intro!: t.less[of _ _ "upd n'"]) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1075 |
note bot = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1076 |
have "f' ` {..n} = t" |
60420 | 1077 |
using \<open>a = enum i\<close> \<open>i = n\<close> \<open>c \<in> t\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1078 |
by (intro st.ksimplex_eq_bot[OF _ _ _ _ eq]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1079 |
(auto simp: b.s_eq b.enum_mono t.s_eq t.enum_mono bot) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1080 |
with f' show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1081 |
qed } |
60420 | 1082 |
with ks_f' eq \<open>a \<noteq> b.enum 0\<close> \<open>n \<noteq> 0\<close> show ?thesis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1083 |
apply (intro ex1I[of _ "b.enum ` {.. n}"]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1084 |
apply auto [] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1085 |
apply metis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1086 |
done |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1087 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1088 |
assume i: "0 < i" "i < n" |
63040 | 1089 |
define i' where "i' = i - 1" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1090 |
with i have "Suc i' < n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1091 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1092 |
with i have Suc_i': "Suc i' = i" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1093 |
by (simp add: i'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1094 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1095 |
let ?upd = "Fun.swap i' i upd" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1096 |
from i upd have "bij_betw ?upd {..< n} {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1097 |
by (subst bij_betw_swap_iff) (auto simp: i'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1098 |
|
63040 | 1099 |
define f' where [abs_def]: "f' i j = (if j \<in> ?upd`{..< i} then Suc (base j) else base j)" |
1100 |
for i j |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1101 |
interpret b: kuhn_simplex p n base ?upd "f' ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1102 |
proof |
67682
00c436488398
tuned proofs -- prefer explicit names for facts from 'interpret';
wenzelm
parents:
67673
diff
changeset
|
1103 |
show "base \<in> {..<n} \<rightarrow> {..<p}" by (rule base) |
00c436488398
tuned proofs -- prefer explicit names for facts from 'interpret';
wenzelm
parents:
67673
diff
changeset
|
1104 |
{ fix i assume "n \<le> i" then show "base i = p" by (rule base_out) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1105 |
show "bij_betw ?upd {..<n} {..<n}" by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1106 |
qed (simp add: f'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1107 |
have f': "b.enum = f'" unfolding f'_def b.enum_def[abs_def] .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1108 |
have ks_f': "ksimplex p n (b.enum ` {.. n})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1109 |
unfolding f' by rule unfold_locales |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1110 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1111 |
have "{i} \<subseteq> {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1112 |
using i by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1113 |
{ fix j assume "j \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1114 |
moreover have "j < i \<or> i = j \<or> i < j" by arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1115 |
moreover note i |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1116 |
ultimately have "enum j = b.enum j \<longleftrightarrow> j \<noteq> i" |
73648 | 1117 |
apply (simp only: fun_eq_iff enum_def b.enum_def flip: image_comp) |
1118 |
apply (cases \<open>i = j\<close>) |
|
1119 |
apply simp |
|
1120 |
apply (metis Suc_i' \<open>i \<le> n\<close> imageI in_upd_image lessI lessThan_iff lessThan_subset_iff less_irrefl_nat transpose_apply_second transpose_commute) |
|
1121 |
apply (subst transpose_image_eq) |
|
1122 |
apply (auto simp add: i'_def) |
|
1123 |
done |
|
1124 |
} |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1125 |
note enum_eq_benum = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1126 |
then have "enum ` ({.. n} - {i}) = b.enum ` ({.. n} - {i})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1127 |
by (intro image_cong) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1128 |
then have eq: "s - {a} = b.enum ` {.. n} - {b.enum i}" |
60420 | 1129 |
unfolding s_eq \<open>a = enum i\<close> |
1130 |
using inj_on_image_set_diff[OF inj_enum Diff_subset \<open>{i} \<subseteq> {..n}\<close>] |
|
1131 |
inj_on_image_set_diff[OF b.inj_enum Diff_subset \<open>{i} \<subseteq> {..n}\<close>] |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1132 |
by (simp add: comp_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1133 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1134 |
have "a \<noteq> b.enum i" |
60420 | 1135 |
using \<open>a = enum i\<close> enum_eq_benum i by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1136 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1137 |
{ fix t c assume "ksimplex p n t" "c \<in> t" and eq_sma: "s - {a} = t - {c}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1138 |
obtain b' u where "kuhn_simplex p n b' u t" |
60420 | 1139 |
using \<open>ksimplex p n t\<close> by (auto elim: ksimplex.cases) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1140 |
then interpret t: kuhn_simplex p n b' u t . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1141 |
have "enum i' \<in> s - {a}" "enum (i + 1) \<in> s - {a}" |
60420 | 1142 |
using \<open>a = enum i\<close> i enum_in by (auto simp: enum_inj i'_def) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1143 |
then obtain l k where |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1144 |
l: "t.enum l = enum i'" "l \<le> n" "t.enum l \<noteq> c" and |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1145 |
k: "t.enum k = enum (i + 1)" "k \<le> n" "t.enum k \<noteq> c" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1146 |
unfolding eq_sma by (auto simp: t.s_eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1147 |
with i have "t.enum l < t.enum k" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1148 |
by (simp add: enum_strict_mono i'_def) |
60420 | 1149 |
with \<open>l \<le> n\<close> \<open>k \<le> n\<close> have "l < k" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1150 |
by (simp add: t.enum_strict_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1151 |
{ assume "Suc l = k" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1152 |
have "enum (Suc (Suc i')) = t.enum (Suc l)" |
60420 | 1153 |
using i by (simp add: k \<open>Suc l = k\<close> i'_def) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1154 |
then have False |
60420 | 1155 |
using \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close> |
62390 | 1156 |
by (auto simp: t.enum_Suc enum_Suc l upd_inj fun_eq_iff split: if_split_asm) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1157 |
(metis Suc_lessD n_not_Suc_n upd_inj) } |
60420 | 1158 |
with \<open>l < k\<close> have "Suc l < k" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1159 |
by arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1160 |
have c_eq: "c = t.enum (Suc l)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1161 |
proof (rule ccontr) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1162 |
assume "c \<noteq> t.enum (Suc l)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1163 |
then have "t.enum (Suc l) \<in> s - {a}" |
60420 | 1164 |
using \<open>l < k\<close> \<open>k \<le> n\<close> by (simp add: t.s_eq eq_sma) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1165 |
then obtain j where "t.enum (Suc l) = enum j" "j \<le> n" "enum j \<noteq> enum i" |
60420 | 1166 |
unfolding s_eq \<open>a = enum i\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1167 |
with i have "t.enum (Suc l) \<le> t.enum l \<or> t.enum k \<le> t.enum (Suc l)" |
68022 | 1168 |
by (auto simp: i'_def enum_mono enum_inj l k) |
60420 | 1169 |
with \<open>Suc l < k\<close> \<open>k \<le> n\<close> show False |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1170 |
by (simp add: t.enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1171 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1172 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1173 |
{ have "t.enum (Suc (Suc l)) \<in> s - {a}" |
60420 | 1174 |
unfolding eq_sma c_eq t.s_eq using \<open>Suc l < k\<close> \<open>k \<le> n\<close> by (auto simp: t.enum_inj) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1175 |
then obtain j where eq: "t.enum (Suc (Suc l)) = enum j" and "j \<le> n" "j \<noteq> i" |
60420 | 1176 |
by (auto simp: s_eq \<open>a = enum i\<close>) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1177 |
moreover have "enum i' < t.enum (Suc (Suc l))" |
60420 | 1178 |
unfolding l(1)[symmetric] using \<open>Suc l < k\<close> \<open>k \<le> n\<close> by (auto simp: t.enum_strict_mono) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1179 |
ultimately have "i' < j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1180 |
using i by (simp add: enum_strict_mono i'_def) |
60420 | 1181 |
with \<open>j \<noteq> i\<close> \<open>j \<le> n\<close> have "t.enum k \<le> t.enum (Suc (Suc l))" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1182 |
unfolding i'_def by (simp add: enum_mono k eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1183 |
then have "k \<le> Suc (Suc l)" |
60420 | 1184 |
using \<open>k \<le> n\<close> \<open>Suc l < k\<close> by (simp add: t.enum_mono) } |
1185 |
with \<open>Suc l < k\<close> have "Suc (Suc l) = k" by simp |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1186 |
then have "enum (Suc (Suc i')) = t.enum (Suc (Suc l))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1187 |
using i by (simp add: k i'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1188 |
also have "\<dots> = (enum i') (u l := Suc (enum i' (u l)), u (Suc l) := Suc (enum i' (u (Suc l))))" |
60420 | 1189 |
using \<open>Suc l < k\<close> \<open>k \<le> n\<close> by (simp add: t.enum_Suc l t.upd_inj) |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
1190 |
finally have "(u l = upd i' \<and> u (Suc l) = upd (Suc i')) \<or> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1191 |
(u l = upd (Suc i') \<and> u (Suc l) = upd i')" |
62390 | 1192 |
using \<open>Suc i' < n\<close> by (auto simp: enum_Suc fun_eq_iff split: if_split_asm) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1193 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1194 |
then have "t = s \<or> t = b.enum ` {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1195 |
proof (elim disjE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1196 |
assume u: "u l = upd i'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1197 |
have "c = t.enum (Suc l)" unfolding c_eq .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1198 |
also have "t.enum (Suc l) = enum (Suc i')" |
60420 | 1199 |
using u \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close> by (simp add: enum_Suc t.enum_Suc l) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1200 |
also have "\<dots> = a" |
60420 | 1201 |
using \<open>a = enum i\<close> i by (simp add: i'_def) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1202 |
finally show ?thesis |
60420 | 1203 |
using eq_sma \<open>a \<in> s\<close> \<open>c \<in> t\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1204 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1205 |
assume u: "u l = upd (Suc i')" |
63040 | 1206 |
define B where "B = b.enum ` {..n}" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1207 |
have "b.enum i' = enum i'" |
68022 | 1208 |
using enum_eq_benum[of i'] i by (auto simp: i'_def gr0_conv_Suc) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1209 |
have "c = t.enum (Suc l)" unfolding c_eq .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1210 |
also have "t.enum (Suc l) = b.enum (Suc i')" |
60420 | 1211 |
using u \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close> |
71172 | 1212 |
by (simp_all add: enum_Suc t.enum_Suc l b.enum_Suc \<open>b.enum i' = enum i'\<close>) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1213 |
(simp add: Suc_i') |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1214 |
also have "\<dots> = b.enum i" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1215 |
using i by (simp add: i'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1216 |
finally have "c = b.enum i" . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1217 |
then have "t - {c} = B - {c}" "c \<in> B" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1218 |
unfolding eq_sma[symmetric] eq B_def using i by auto |
60420 | 1219 |
with \<open>c \<in> t\<close> have "t = B" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1220 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1221 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1222 |
by (simp add: B_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1223 |
qed } |
60420 | 1224 |
with ks_f' eq \<open>a \<noteq> b.enum i\<close> \<open>n \<noteq> 0\<close> \<open>i \<le> n\<close> show ?thesis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1225 |
apply (intro ex1I[of _ "b.enum ` {.. n}"]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1226 |
apply auto [] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1227 |
apply metis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1228 |
done |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1229 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1230 |
then show ?thesis |
71449
3cf130a896a3
lemmas about "card A = 2"; prefer iff to implications
nipkow
parents:
71172
diff
changeset
|
1231 |
using s \<open>a \<in> s\<close> by (simp add: card_2_iff' Ex1_def) metis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1232 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1233 |
|
60420 | 1234 |
text \<open>Hence another step towards concreteness.\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1235 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1236 |
lemma kuhn_simplex_lemma: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1237 |
assumes "\<forall>s. ksimplex p (Suc n) s \<longrightarrow> rl ` s \<subseteq> {.. Suc n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1238 |
and "odd (card {f. \<exists>s a. ksimplex p (Suc n) s \<and> a \<in> s \<and> (f = s - {a}) \<and> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1239 |
rl ` f = {..n} \<and> ((\<exists>j\<le>n. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<le>n. \<forall>x\<in>f. x j = p))})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1240 |
shows "odd (card {s. ksimplex p (Suc n) s \<and> rl ` s = {..Suc n}})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1241 |
proof (rule kuhn_complete_lemma[OF finite_ksimplexes refl, unfolded mem_Collect_eq, |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1242 |
where bnd="\<lambda>f. (\<exists>j\<in>{..n}. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<in>{..n}. \<forall>x\<in>f. x j = p)"], |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1243 |
safe del: notI) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1244 |
|
53186 | 1245 |
have *: "\<And>x y. x = y \<Longrightarrow> odd (card x) \<Longrightarrow> odd (card y)" |
1246 |
by auto |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1247 |
show "odd (card {f. (\<exists>s\<in>{s. ksimplex p (Suc n) s}. \<exists>a\<in>s. f = s - {a}) \<and> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1248 |
rl ` f = {..n} \<and> ((\<exists>j\<in>{..n}. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<in>{..n}. \<forall>x\<in>f. x j = p))})" |
53186 | 1249 |
apply (rule *[OF _ assms(2)]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1250 |
apply (auto simp: atLeast0AtMost) |
53186 | 1251 |
done |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1252 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1253 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1254 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1255 |
fix s assume s: "ksimplex p (Suc n) s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1256 |
then show "card s = n + 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1257 |
by (simp add: ksimplex_card) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1258 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1259 |
fix a assume a: "a \<in> s" then show "rl a \<le> Suc n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1260 |
using assms(1) s by (auto simp: subset_eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1261 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1262 |
let ?S = "{t. ksimplex p (Suc n) t \<and> (\<exists>b\<in>t. s - {a} = t - {b})}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1263 |
{ fix j assume j: "j \<le> n" "\<forall>x\<in>s - {a}. x j = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1264 |
with s a show "card ?S = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1265 |
using ksimplex_replace_0[of p "n + 1" s a j] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1266 |
by (subst eq_commute) simp } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1267 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1268 |
{ fix j assume j: "j \<le> n" "\<forall>x\<in>s - {a}. x j = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1269 |
with s a show "card ?S = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1270 |
using ksimplex_replace_1[of p "n + 1" s a j] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1271 |
by (subst eq_commute) simp } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1272 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1273 |
{ assume "card ?S \<noteq> 2" "\<not> (\<exists>j\<in>{..n}. \<forall>x\<in>s - {a}. x j = p)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1274 |
with s a show "\<exists>j\<in>{..n}. \<forall>x\<in>s - {a}. x j = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1275 |
using ksimplex_replace_2[of p "n + 1" s a] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1276 |
by (subst (asm) eq_commute) auto } |
53186 | 1277 |
qed |
1278 |
||
68617 | 1279 |
subsubsection \<open>Reduced labelling\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1280 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1281 |
definition reduced :: "nat \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> nat" where "reduced n x = (LEAST k. k = n \<or> x k \<noteq> 0)" |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1282 |
|
53186 | 1283 |
lemma reduced_labelling: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1284 |
shows "reduced n x \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1285 |
and "\<forall>i<reduced n x. x i = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1286 |
and "reduced n x = n \<or> x (reduced n x) \<noteq> 0" |
53186 | 1287 |
proof - |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1288 |
show "reduced n x \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1289 |
unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1290 |
show "\<forall>i<reduced n x. x i = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1291 |
unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) fastforce+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1292 |
show "reduced n x = n \<or> x (reduced n x) \<noteq> 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1293 |
unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) fastforce+ |
53186 | 1294 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1295 |
|
53186 | 1296 |
lemma reduced_labelling_unique: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1297 |
"r \<le> n \<Longrightarrow> \<forall>i<r. x i = 0 \<Longrightarrow> r = n \<or> x r \<noteq> 0 \<Longrightarrow> reduced n x = r" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1298 |
unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) (metis le_less not_le)+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1299 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1300 |
lemma reduced_labelling_zero: "j < n \<Longrightarrow> x j = 0 \<Longrightarrow> reduced n x \<noteq> j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1301 |
using reduced_labelling[of n x] by auto |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1302 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1303 |
lemma reduce_labelling_zero[simp]: "reduced 0 x = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1304 |
by (rule reduced_labelling_unique) auto |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1305 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1306 |
lemma reduced_labelling_nonzero: "j < n \<Longrightarrow> x j \<noteq> 0 \<Longrightarrow> reduced n x \<le> j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1307 |
using reduced_labelling[of n x] by (elim allE[where x=j]) auto |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1308 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1309 |
lemma reduced_labelling_Suc: "reduced (Suc n) x \<noteq> Suc n \<Longrightarrow> reduced (Suc n) x = reduced n x" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1310 |
using reduced_labelling[of "Suc n" x] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1311 |
by (intro reduced_labelling_unique[symmetric]) auto |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1312 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1313 |
lemma complete_face_top: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1314 |
assumes "\<forall>x\<in>f. \<forall>j\<le>n. x j = 0 \<longrightarrow> lab x j = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1315 |
and "\<forall>x\<in>f. \<forall>j\<le>n. x j = p \<longrightarrow> lab x j = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1316 |
and eq: "(reduced (Suc n) \<circ> lab) ` f = {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1317 |
shows "((\<exists>j\<le>n. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<le>n. \<forall>x\<in>f. x j = p)) \<longleftrightarrow> (\<forall>x\<in>f. x n = p)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1318 |
proof (safe del: disjCI) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1319 |
fix x j assume j: "j \<le> n" "\<forall>x\<in>f. x j = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1320 |
{ fix x assume "x \<in> f" with assms j have "reduced (Suc n) (lab x) \<noteq> j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1321 |
by (intro reduced_labelling_zero) auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1322 |
moreover have "j \<in> (reduced (Suc n) \<circ> lab) ` f" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1323 |
using j eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1324 |
ultimately show "x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1325 |
by force |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1326 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1327 |
fix x j assume j: "j \<le> n" "\<forall>x\<in>f. x j = p" and x: "x \<in> f" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1328 |
have "j = n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1329 |
proof (rule ccontr) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1330 |
assume "\<not> ?thesis" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1331 |
{ fix x assume "x \<in> f" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1332 |
with assms j have "reduced (Suc n) (lab x) \<le> j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1333 |
by (intro reduced_labelling_nonzero) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1334 |
then have "reduced (Suc n) (lab x) \<noteq> n" |
60420 | 1335 |
using \<open>j \<noteq> n\<close> \<open>j \<le> n\<close> by simp } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1336 |
moreover |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
1337 |
have "n \<in> (reduced (Suc n) \<circ> lab) ` f" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1338 |
using eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1339 |
ultimately show False |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1340 |
by force |
53186 | 1341 |
qed |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1342 |
moreover have "j \<in> (reduced (Suc n) \<circ> lab) ` f" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1343 |
using j eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1344 |
ultimately show "x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1345 |
using j x by auto |
53688 | 1346 |
qed auto |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1347 |
|
60420 | 1348 |
text \<open>Hence we get just about the nice induction.\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1349 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1350 |
lemma kuhn_induction: |
53688 | 1351 |
assumes "0 < p" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1352 |
and lab_0: "\<forall>x. \<forall>j\<le>n. (\<forall>j. x j \<le> p) \<and> x j = 0 \<longrightarrow> lab x j = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1353 |
and lab_1: "\<forall>x. \<forall>j\<le>n. (\<forall>j. x j \<le> p) \<and> x j = p \<longrightarrow> lab x j = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1354 |
and odd: "odd (card {s. ksimplex p n s \<and> (reduced n\<circ>lab) ` s = {..n}})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1355 |
shows "odd (card {s. ksimplex p (Suc n) s \<and> (reduced (Suc n)\<circ>lab) ` s = {..Suc n}})" |
53248 | 1356 |
proof - |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1357 |
let ?rl = "reduced (Suc n) \<circ> lab" and ?ext = "\<lambda>f v. \<exists>j\<le>n. \<forall>x\<in>f. x j = v" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1358 |
let ?ext = "\<lambda>s. (\<exists>j\<le>n. \<forall>x\<in>s. x j = 0) \<or> (\<exists>j\<le>n. \<forall>x\<in>s. x j = p)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1359 |
have "\<forall>s. ksimplex p (Suc n) s \<longrightarrow> ?rl ` s \<subseteq> {..Suc n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1360 |
by (simp add: reduced_labelling subset_eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1361 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1362 |
have "{s. ksimplex p n s \<and> (reduced n \<circ> lab) ` s = {..n}} = |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1363 |
{f. \<exists>s a. ksimplex p (Suc n) s \<and> a \<in> s \<and> f = s - {a} \<and> ?rl ` f = {..n} \<and> ?ext f}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1364 |
proof (intro set_eqI, safe del: disjCI equalityI disjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1365 |
fix s assume s: "ksimplex p n s" and rl: "(reduced n \<circ> lab) ` s = {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1366 |
from s obtain u b where "kuhn_simplex p n u b s" by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1367 |
then interpret kuhn_simplex p n u b s . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1368 |
have all_eq_p: "\<forall>x\<in>s. x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1369 |
by (auto simp: out_eq_p) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1370 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1371 |
{ fix x assume "x \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1372 |
with lab_1[rule_format, of n x] all_eq_p s_le_p[of x] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1373 |
have "?rl x \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1374 |
by (auto intro!: reduced_labelling_nonzero) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1375 |
then have "?rl x = reduced n (lab x)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1376 |
by (auto intro!: reduced_labelling_Suc) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1377 |
then have "?rl ` s = {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1378 |
using rl by (simp cong: image_cong) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1379 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1380 |
obtain t a where "ksimplex p (Suc n) t" "a \<in> t" "s = t - {a}" |
60420 | 1381 |
using s unfolding simplex_top_face[OF \<open>0 < p\<close> all_eq_p] by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1382 |
ultimately |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1383 |
show "\<exists>t a. ksimplex p (Suc n) t \<and> a \<in> t \<and> s = t - {a} \<and> ?rl ` s = {..n} \<and> ?ext s" |
53688 | 1384 |
by auto |
53248 | 1385 |
next |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1386 |
fix x s a assume s: "ksimplex p (Suc n) s" and rl: "?rl ` (s - {a}) = {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1387 |
and a: "a \<in> s" and "?ext (s - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1388 |
from s obtain u b where "kuhn_simplex p (Suc n) u b s" by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1389 |
then interpret kuhn_simplex p "Suc n" u b s . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1390 |
have all_eq_p: "\<forall>x\<in>s. x (Suc n) = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1391 |
by (auto simp: out_eq_p) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1392 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1393 |
{ fix x assume "x \<in> s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1394 |
then have "?rl x \<in> ?rl ` (s - {a})" |
53248 | 1395 |
by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1396 |
then have "?rl x \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1397 |
unfolding rl by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1398 |
then have "?rl x = reduced n (lab x)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1399 |
by (auto intro!: reduced_labelling_Suc) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1400 |
then show rl': "(reduced n\<circ>lab) ` (s - {a}) = {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1401 |
unfolding rl[symmetric] by (intro image_cong) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1402 |
|
60420 | 1403 |
from \<open>?ext (s - {a})\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1404 |
have all_eq_p: "\<forall>x\<in>s - {a}. x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1405 |
proof (elim disjE exE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1406 |
fix j assume "j \<le> n" "\<forall>x\<in>s - {a}. x j = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1407 |
with lab_0[rule_format, of j] all_eq_p s_le_p |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1408 |
have "\<And>x. x \<in> s - {a} \<Longrightarrow> reduced (Suc n) (lab x) \<noteq> j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1409 |
by (intro reduced_labelling_zero) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1410 |
moreover have "j \<in> ?rl ` (s - {a})" |
60420 | 1411 |
using \<open>j \<le> n\<close> unfolding rl by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1412 |
ultimately show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1413 |
by force |
53248 | 1414 |
next |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1415 |
fix j assume "j \<le> n" and eq_p: "\<forall>x\<in>s - {a}. x j = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1416 |
show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1417 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1418 |
assume "j = n" with eq_p show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1419 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1420 |
assume "j \<noteq> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1421 |
{ fix x assume x: "x \<in> s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1422 |
have "reduced n (lab x) \<le> j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1423 |
proof (rule reduced_labelling_nonzero) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1424 |
show "lab x j \<noteq> 0" |
60420 | 1425 |
using lab_1[rule_format, of j x] x s_le_p[of x] eq_p \<open>j \<le> n\<close> by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1426 |
show "j < n" |
60420 | 1427 |
using \<open>j \<le> n\<close> \<open>j \<noteq> n\<close> by simp |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1428 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1429 |
then have "reduced n (lab x) \<noteq> n" |
60420 | 1430 |
using \<open>j \<le> n\<close> \<open>j \<noteq> n\<close> by simp } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1431 |
moreover have "n \<in> (reduced n\<circ>lab) ` (s - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1432 |
unfolding rl' by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1433 |
ultimately show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1434 |
by force |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1435 |
qed |
53248 | 1436 |
qed |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1437 |
show "ksimplex p n (s - {a})" |
60420 | 1438 |
unfolding simplex_top_face[OF \<open>0 < p\<close> all_eq_p] using s a by auto |
53248 | 1439 |
qed |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1440 |
ultimately show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1441 |
using assms by (intro kuhn_simplex_lemma) auto |
53248 | 1442 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1443 |
|
60420 | 1444 |
text \<open>And so we get the final combinatorial result.\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1445 |
|
53688 | 1446 |
lemma ksimplex_0: "ksimplex p 0 s \<longleftrightarrow> s = {(\<lambda>x. p)}" |
53248 | 1447 |
proof |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1448 |
assume "ksimplex p 0 s" then show "s = {(\<lambda>x. p)}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1449 |
by (blast dest: kuhn_simplex.ksimplex_0 elim: ksimplex.cases) |
53248 | 1450 |
next |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1451 |
assume s: "s = {(\<lambda>x. p)}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1452 |
show "ksimplex p 0 s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1453 |
proof (intro ksimplex, unfold_locales) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1454 |
show "(\<lambda>_. p) \<in> {..<0::nat} \<rightarrow> {..<p}" by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1455 |
show "bij_betw id {..<0} {..<0}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1456 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1457 |
qed (auto simp: s) |
53248 | 1458 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1459 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1460 |
lemma kuhn_combinatorial: |
53688 | 1461 |
assumes "0 < p" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1462 |
and "\<forall>x j. (\<forall>j. x j \<le> p) \<and> j < n \<and> x j = 0 \<longrightarrow> lab x j = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1463 |
and "\<forall>x j. (\<forall>j. x j \<le> p) \<and> j < n \<and> x j = p \<longrightarrow> lab x j = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1464 |
shows "odd (card {s. ksimplex p n s \<and> (reduced n\<circ>lab) ` s = {..n}})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1465 |
(is "odd (card (?M n))") |
53248 | 1466 |
using assms |
1467 |
proof (induct n) |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1468 |
case 0 then show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1469 |
by (simp add: ksimplex_0 cong: conj_cong) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1470 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1471 |
case (Suc n) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1472 |
then have "odd (card (?M n))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1473 |
by force |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1474 |
with Suc show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1475 |
using kuhn_induction[of p n] by (auto simp: comp_def) |
53248 | 1476 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1477 |
|
53248 | 1478 |
lemma kuhn_lemma: |
53688 | 1479 |
fixes n p :: nat |
1480 |
assumes "0 < p" |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1481 |
and "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. label x i = (0::nat) \<or> label x i = 1)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1482 |
and "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = 0 \<longrightarrow> label x i = 0)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1483 |
and "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = p \<longrightarrow> label x i = 1)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1484 |
obtains q where "\<forall>i<n. q i < p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1485 |
and "\<forall>i<n. \<exists>r s. (\<forall>j<n. q j \<le> r j \<and> r j \<le> q j + 1) \<and> (\<forall>j<n. q j \<le> s j \<and> s j \<le> q j + 1) \<and> label r i \<noteq> label s i" |
53248 | 1486 |
proof - |
60580 | 1487 |
let ?rl = "reduced n \<circ> label" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1488 |
let ?A = "{s. ksimplex p n s \<and> ?rl ` s = {..n}}" |
53248 | 1489 |
have "odd (card ?A)" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1490 |
using assms by (intro kuhn_combinatorial[of p n label]) auto |
53688 | 1491 |
then have "?A \<noteq> {}" |
69661 | 1492 |
by (rule odd_card_imp_not_empty) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1493 |
then obtain s b u where "kuhn_simplex p n b u s" and rl: "?rl ` s = {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1494 |
by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1495 |
interpret kuhn_simplex p n b u s by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1496 |
|
53248 | 1497 |
show ?thesis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1498 |
proof (intro that[of b] allI impI) |
60580 | 1499 |
fix i |
1500 |
assume "i < n" |
|
1501 |
then show "b i < p" |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1502 |
using base by auto |
53248 | 1503 |
next |
60580 | 1504 |
fix i |
1505 |
assume "i < n" |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1506 |
then have "i \<in> {.. n}" "Suc i \<in> {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1507 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1508 |
then obtain u v where u: "u \<in> s" "Suc i = ?rl u" and v: "v \<in> s" "i = ?rl v" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1509 |
unfolding rl[symmetric] by blast |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1510 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1511 |
have "label u i \<noteq> label v i" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1512 |
using reduced_labelling [of n "label u"] reduced_labelling [of n "label v"] |
60420 | 1513 |
u(2)[symmetric] v(2)[symmetric] \<open>i < n\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1514 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1515 |
moreover |
60580 | 1516 |
have "b j \<le> u j" "u j \<le> b j + 1" "b j \<le> v j" "v j \<le> b j + 1" if "j < n" for j |
1517 |
using that base_le[OF \<open>u\<in>s\<close>] le_Suc_base[OF \<open>u\<in>s\<close>] base_le[OF \<open>v\<in>s\<close>] le_Suc_base[OF \<open>v\<in>s\<close>] |
|
1518 |
by auto |
|
1519 |
ultimately show "\<exists>r s. (\<forall>j<n. b j \<le> r j \<and> r j \<le> b j + 1) \<and> |
|
1520 |
(\<forall>j<n. b j \<le> s j \<and> s j \<le> b j + 1) \<and> label r i \<noteq> label s i" |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1521 |
by blast |
53248 | 1522 |
qed |
1523 |
qed |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1524 |
|
68617 | 1525 |
subsubsection \<open>Main result for the unit cube\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1526 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1527 |
lemma kuhn_labelling_lemma': |
53688 | 1528 |
assumes "(\<forall>x::nat\<Rightarrow>real. P x \<longrightarrow> P (f x))" |
1529 |
and "\<forall>x. P x \<longrightarrow> (\<forall>i::nat. Q i \<longrightarrow> 0 \<le> x i \<and> x i \<le> 1)" |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1530 |
shows "\<exists>l. (\<forall>x i. l x i \<le> (1::nat)) \<and> |
53688 | 1531 |
(\<forall>x i. P x \<and> Q i \<and> x i = 0 \<longrightarrow> l x i = 0) \<and> |
1532 |
(\<forall>x i. P x \<and> Q i \<and> x i = 1 \<longrightarrow> l x i = 1) \<and> |
|
1533 |
(\<forall>x i. P x \<and> Q i \<and> l x i = 0 \<longrightarrow> x i \<le> f x i) \<and> |
|
1534 |
(\<forall>x i. P x \<and> Q i \<and> l x i = 1 \<longrightarrow> f x i \<le> x i)" |
|
53185 | 1535 |
proof - |
53688 | 1536 |
have and_forall_thm: "\<And>P Q. (\<forall>x. P x) \<and> (\<forall>x. Q x) \<longleftrightarrow> (\<forall>x. P x \<and> Q x)" |
1537 |
by auto |
|
1538 |
have *: "\<forall>x y::real. 0 \<le> x \<and> x \<le> 1 \<and> 0 \<le> y \<and> y \<le> 1 \<longrightarrow> x \<noteq> 1 \<and> x \<le> y \<or> x \<noteq> 0 \<and> y \<le> x" |
|
53185 | 1539 |
by auto |
1540 |
show ?thesis |
|
1541 |
unfolding and_forall_thm |
|
1542 |
apply (subst choice_iff[symmetric])+ |
|
53688 | 1543 |
apply rule |
1544 |
apply rule |
|
1545 |
proof - |
|
60580 | 1546 |
fix x x' |
53688 | 1547 |
let ?R = "\<lambda>y::nat. |
60580 | 1548 |
(P x \<and> Q x' \<and> x x' = 0 \<longrightarrow> y = 0) \<and> |
1549 |
(P x \<and> Q x' \<and> x x' = 1 \<longrightarrow> y = 1) \<and> |
|
1550 |
(P x \<and> Q x' \<and> y = 0 \<longrightarrow> x x' \<le> (f x) x') \<and> |
|
1551 |
(P x \<and> Q x' \<and> y = 1 \<longrightarrow> (f x) x' \<le> x x')" |
|
1552 |
have "0 \<le> f x x' \<and> f x x' \<le> 1" if "P x" "Q x'" |
|
1553 |
using assms(2)[rule_format,of "f x" x'] that |
|
1554 |
apply (drule_tac assms(1)[rule_format]) |
|
1555 |
apply auto |
|
1556 |
done |
|
53688 | 1557 |
then have "?R 0 \<or> ?R 1" |
1558 |
by auto |
|
60580 | 1559 |
then show "\<exists>y\<le>1. ?R y" |
53688 | 1560 |
by auto |
53185 | 1561 |
qed |
1562 |
qed |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1563 |
|
68617 | 1564 |
subsection \<open>Brouwer's fixed point theorem\<close> |
1565 |
||
68621 | 1566 |
text \<open>We start proving Brouwer's fixed point theorem for the unit cube = \<open>cbox 0 One\<close>.\<close> |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1567 |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1568 |
lemma brouwer_cube: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1569 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
68621 | 1570 |
assumes "continuous_on (cbox 0 One) f" |
1571 |
and "f ` cbox 0 One \<subseteq> cbox 0 One" |
|
1572 |
shows "\<exists>x\<in>cbox 0 One. f x = x" |
|
53185 | 1573 |
proof (rule ccontr) |
63040 | 1574 |
define n where "n = DIM('a)" |
53185 | 1575 |
have n: "1 \<le> n" "0 < n" "n \<noteq> 0" |
71172 | 1576 |
unfolding n_def by (auto simp: Suc_le_eq) |
53674 | 1577 |
assume "\<not> ?thesis" |
68621 | 1578 |
then have *: "\<not> (\<exists>x\<in>cbox 0 One. f x - x = 0)" |
53674 | 1579 |
by auto |
55522 | 1580 |
obtain d where |
68621 | 1581 |
d: "d > 0" "\<And>x. x \<in> cbox 0 One \<Longrightarrow> d \<le> norm (f x - x)" |
1582 |
apply (rule brouwer_compactness_lemma[OF compact_cbox _ *]) |
|
56371
fb9ae0727548
extend continuous_intros; remove continuous_on_intros and isCont_intros
hoelzl
parents:
56273
diff
changeset
|
1583 |
apply (rule continuous_intros assms)+ |
55522 | 1584 |
apply blast |
53185 | 1585 |
done |
68621 | 1586 |
have *: "\<forall>x. x \<in> cbox 0 One \<longrightarrow> f x \<in> cbox 0 One" |
1587 |
"\<forall>x. x \<in> (cbox 0 One::'a set) \<longrightarrow> (\<forall>i\<in>Basis. True \<longrightarrow> 0 \<le> x \<bullet> i \<and> x \<bullet> i \<le> 1)" |
|
53185 | 1588 |
using assms(2)[unfolded image_subset_iff Ball_def] |
68621 | 1589 |
unfolding cbox_def |
55522 | 1590 |
by auto |
68022 | 1591 |
obtain label :: "'a \<Rightarrow> 'a \<Rightarrow> nat" where label [rule_format]: |
55522 | 1592 |
"\<forall>x. \<forall>i\<in>Basis. label x i \<le> 1" |
68621 | 1593 |
"\<forall>x. \<forall>i\<in>Basis. x \<in> cbox 0 One \<and> x \<bullet> i = 0 \<longrightarrow> label x i = 0" |
1594 |
"\<forall>x. \<forall>i\<in>Basis. x \<in> cbox 0 One \<and> x \<bullet> i = 1 \<longrightarrow> label x i = 1" |
|
1595 |
"\<forall>x. \<forall>i\<in>Basis. x \<in> cbox 0 One \<and> label x i = 0 \<longrightarrow> x \<bullet> i \<le> f x \<bullet> i" |
|
1596 |
"\<forall>x. \<forall>i\<in>Basis. x \<in> cbox 0 One \<and> label x i = 1 \<longrightarrow> f x \<bullet> i \<le> x \<bullet> i" |
|
68022 | 1597 |
using kuhn_labelling_lemma[OF *] by auto |
53185 | 1598 |
note label = this [rule_format] |
68621 | 1599 |
have lem1: "\<forall>x\<in>cbox 0 One. \<forall>y\<in>cbox 0 One. \<forall>i\<in>Basis. label x i \<noteq> label y i \<longrightarrow> |
61945 | 1600 |
\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y - f x) + norm (y - x)" |
53185 | 1601 |
proof safe |
1602 |
fix x y :: 'a |
|
68621 | 1603 |
assume x: "x \<in> cbox 0 One" and y: "y \<in> cbox 0 One" |
53185 | 1604 |
fix i |
1605 |
assume i: "label x i \<noteq> label y i" "i \<in> Basis" |
|
1606 |
have *: "\<And>x y fx fy :: real. x \<le> fx \<and> fy \<le> y \<or> fx \<le> x \<and> y \<le> fy \<Longrightarrow> |
|
61945 | 1607 |
\<bar>fx - x\<bar> \<le> \<bar>fy - fx\<bar> + \<bar>y - x\<bar>" by auto |
1608 |
have "\<bar>(f x - x) \<bullet> i\<bar> \<le> \<bar>(f y - f x)\<bullet>i\<bar> + \<bar>(y - x)\<bullet>i\<bar>" |
|
68022 | 1609 |
proof (cases "label x i = 0") |
1610 |
case True |
|
1611 |
then have fxy: "\<not> f y \<bullet> i \<le> y \<bullet> i \<Longrightarrow> f x \<bullet> i \<le> x \<bullet> i" |
|
1612 |
by (metis True i label(1) label(5) le_antisym less_one not_le_imp_less y) |
|
1613 |
show ?thesis |
|
1614 |
unfolding inner_simps |
|
1615 |
by (rule *) (auto simp: True i label x y fxy) |
|
53185 | 1616 |
next |
68022 | 1617 |
case False |
1618 |
then show ?thesis |
|
1619 |
using label [OF \<open>i \<in> Basis\<close>] i(1) x y |
|
1620 |
apply (auto simp: inner_diff_left le_Suc_eq) |
|
1621 |
by (metis "*") |
|
53185 | 1622 |
qed |
1623 |
also have "\<dots> \<le> norm (f y - f x) + norm (y - x)" |
|
68022 | 1624 |
by (simp add: add_mono i(2) norm_bound_Basis_le) |
53185 | 1625 |
finally show "\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y - f x) + norm (y - x)" |
1626 |
unfolding inner_simps . |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1627 |
qed |
68621 | 1628 |
have "\<exists>e>0. \<forall>x\<in>cbox 0 One. \<forall>y\<in>cbox 0 One. \<forall>z\<in>cbox 0 One. \<forall>i\<in>Basis. |
68022 | 1629 |
norm (x - z) < e \<longrightarrow> norm (y - z) < e \<longrightarrow> label x i \<noteq> label y i \<longrightarrow> |
61945 | 1630 |
\<bar>(f(z) - z)\<bullet>i\<bar> < d / (real n)" |
53185 | 1631 |
proof - |
53688 | 1632 |
have d': "d / real n / 8 > 0" |
71172 | 1633 |
using d(1) by (simp add: n_def) |
68621 | 1634 |
have *: "uniformly_continuous_on (cbox 0 One) f" |
1635 |
by (rule compact_uniformly_continuous[OF assms(1) compact_cbox]) |
|
55522 | 1636 |
obtain e where e: |
1637 |
"e > 0" |
|
68621 | 1638 |
"\<And>x x'. x \<in> cbox 0 One \<Longrightarrow> |
1639 |
x' \<in> cbox 0 One \<Longrightarrow> |
|
55522 | 1640 |
norm (x' - x) < e \<Longrightarrow> |
1641 |
norm (f x' - f x) < d / real n / 8" |
|
1642 |
using *[unfolded uniformly_continuous_on_def,rule_format,OF d'] |
|
1643 |
unfolding dist_norm |
|
1644 |
by blast |
|
53185 | 1645 |
show ?thesis |
68022 | 1646 |
proof (intro exI conjI ballI impI) |
53185 | 1647 |
show "0 < min (e / 2) (d / real n / 8)" |
1648 |
using d' e by auto |
|
1649 |
fix x y z i |
|
53688 | 1650 |
assume as: |
68621 | 1651 |
"x \<in> cbox 0 One" "y \<in> cbox 0 One" "z \<in> cbox 0 One" |
37489
44e42d392c6e
Introduce a type class for euclidean spaces, port most lemmas from real^'n to this type class.
hoelzl
parents:
36587
diff
changeset
|
1652 |
"norm (x - z) < min (e / 2) (d / real n / 8)" |
53688 | 1653 |
"norm (y - z) < min (e / 2) (d / real n / 8)" |
1654 |
"label x i \<noteq> label y i" |
|
1655 |
assume i: "i \<in> Basis" |
|
61945 | 1656 |
have *: "\<And>z fz x fx n1 n2 n3 n4 d4 d :: real. \<bar>fx - x\<bar> \<le> n1 + n2 \<Longrightarrow> |
1657 |
\<bar>fx - fz\<bar> \<le> n3 \<Longrightarrow> \<bar>x - z\<bar> \<le> n4 \<Longrightarrow> |
|
53185 | 1658 |
n1 < d4 \<Longrightarrow> n2 < 2 * d4 \<Longrightarrow> n3 < d4 \<Longrightarrow> n4 < d4 \<Longrightarrow> |
61945 | 1659 |
(8 * d4 = d) \<Longrightarrow> \<bar>fz - z\<bar> < d" |
53688 | 1660 |
by auto |
1661 |
show "\<bar>(f z - z) \<bullet> i\<bar> < d / real n" |
|
1662 |
unfolding inner_simps |
|
53185 | 1663 |
proof (rule *) |
1664 |
show "\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y -f x) + norm (y - x)" |
|
68022 | 1665 |
using as(1) as(2) as(6) i lem1 by blast |
1666 |
show "norm (f x - f z) < d / real n / 8" |
|
1667 |
using d' e as by auto |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1668 |
show "\<bar>f x \<bullet> i - f z \<bullet> i\<bar> \<le> norm (f x - f z)" "\<bar>x \<bullet> i - z \<bullet> i\<bar> \<le> norm (x - z)" |
55522 | 1669 |
unfolding inner_diff_left[symmetric] |
53688 | 1670 |
by (rule Basis_le_norm[OF i])+ |
1671 |
have tria: "norm (y - x) \<le> norm (y - z) + norm (x - z)" |
|
53185 | 1672 |
using dist_triangle[of y x z, unfolded dist_norm] |
53688 | 1673 |
unfolding norm_minus_commute |
1674 |
by auto |
|
53185 | 1675 |
also have "\<dots> < e / 2 + e / 2" |
68022 | 1676 |
using as(4) as(5) by auto |
53185 | 1677 |
finally show "norm (f y - f x) < d / real n / 8" |
68022 | 1678 |
using as(1) as(2) e(2) by auto |
53185 | 1679 |
have "norm (y - z) + norm (x - z) < d / real n / 8 + d / real n / 8" |
68022 | 1680 |
using as(4) as(5) by auto |
1681 |
with tria show "norm (y - x) < 2 * (d / real n / 8)" |
|
53688 | 1682 |
by auto |
68022 | 1683 |
qed (use as in auto) |
53185 | 1684 |
qed |
1685 |
qed |
|
55522 | 1686 |
then |
1687 |
obtain e where e: |
|
1688 |
"e > 0" |
|
68621 | 1689 |
"\<And>x y z i. x \<in> cbox 0 One \<Longrightarrow> |
1690 |
y \<in> cbox 0 One \<Longrightarrow> |
|
1691 |
z \<in> cbox 0 One \<Longrightarrow> |
|
55522 | 1692 |
i \<in> Basis \<Longrightarrow> |
1693 |
norm (x - z) < e \<and> norm (y - z) < e \<and> label x i \<noteq> label y i \<Longrightarrow> |
|
1694 |
\<bar>(f z - z) \<bullet> i\<bar> < d / real n" |
|
1695 |
by blast |
|
1696 |
obtain p :: nat where p: "1 + real n / e \<le> real p" |
|
1697 |
using real_arch_simple .. |
|
53185 | 1698 |
have "1 + real n / e > 0" |
56541 | 1699 |
using e(1) n by (simp add: add_pos_pos) |
53688 | 1700 |
then have "p > 0" |
1701 |
using p by auto |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1702 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1703 |
obtain b :: "nat \<Rightarrow> 'a" where b: "bij_betw b {..< n} Basis" |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1704 |
by atomize_elim (auto simp: n_def intro!: finite_same_card_bij) |
63040 | 1705 |
define b' where "b' = inv_into {..< n} b" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1706 |
then have b': "bij_betw b' Basis {..< n}" |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1707 |
using bij_betw_inv_into[OF b] by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1708 |
then have b'_Basis: "\<And>i. i \<in> Basis \<Longrightarrow> b' i \<in> {..< n}" |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1709 |
unfolding bij_betw_def by (auto simp: set_eq_iff) |
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1710 |
have bb'[simp]:"\<And>i. i \<in> Basis \<Longrightarrow> b (b' i) = i" |
53688 | 1711 |
unfolding b'_def |
1712 |
using b |
|
1713 |
by (auto simp: f_inv_into_f bij_betw_def) |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1714 |
have b'b[simp]:"\<And>i. i < n \<Longrightarrow> b' (b i) = i" |
53688 | 1715 |
unfolding b'_def |
1716 |
using b |
|
1717 |
by (auto simp: inv_into_f_eq bij_betw_def) |
|
1718 |
have *: "\<And>x :: nat. x = 0 \<or> x = 1 \<longleftrightarrow> x \<le> 1" |
|
1719 |
by auto |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1720 |
have b'': "\<And>j. j < n \<Longrightarrow> b j \<in> Basis" |
53185 | 1721 |
using b unfolding bij_betw_def by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1722 |
have q1: "0 < p" "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1723 |
(\<forall>i<n. (label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 0 \<or> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1724 |
(label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 1)" |
53688 | 1725 |
unfolding * |
60420 | 1726 |
using \<open>p > 0\<close> \<open>n > 0\<close> |
53688 | 1727 |
using label(1)[OF b''] |
1728 |
by auto |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1729 |
{ fix x :: "nat \<Rightarrow> nat" and i assume "\<forall>i<n. x i \<le> p" "i < n" "x i = p \<or> x i = 0" |
68621 | 1730 |
then have "(\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<in> (cbox 0 One::'a set)" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1731 |
using b'_Basis |
71172 | 1732 |
by (auto simp: cbox_def bij_betw_def zero_le_divide_iff divide_le_eq_1) } |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1733 |
note cube = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1734 |
have q2: "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = 0 \<longrightarrow> |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1735 |
(label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 0)" |
68022 | 1736 |
unfolding o_def using cube \<open>p > 0\<close> by (intro allI impI label(2)) (auto simp: b'') |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61520
diff
changeset
|
1737 |
have q3: "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = p \<longrightarrow> |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1738 |
(label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 1)" |
68022 | 1739 |
using cube \<open>p > 0\<close> unfolding o_def by (intro allI impI label(3)) (auto simp: b'') |
55522 | 1740 |
obtain q where q: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1741 |
"\<forall>i<n. q i < p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1742 |
"\<forall>i<n. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1743 |
\<exists>r s. (\<forall>j<n. q j \<le> r j \<and> r j \<le> q j + 1) \<and> |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1744 |
(\<forall>j<n. q j \<le> s j \<and> s j \<le> q j + 1) \<and> |
55522 | 1745 |
(label (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i) \<circ> b) i \<noteq> |
1746 |
(label (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i) \<circ> b) i" |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1747 |
by (rule kuhn_lemma[OF q1 q2 q3]) |
63040 | 1748 |
define z :: 'a where "z = (\<Sum>i\<in>Basis. (real (q (b' i)) / real p) *\<^sub>R i)" |
61945 | 1749 |
have "\<exists>i\<in>Basis. d / real n \<le> \<bar>(f z - z)\<bullet>i\<bar>" |
53185 | 1750 |
proof (rule ccontr) |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1751 |
have "\<forall>i\<in>Basis. q (b' i) \<in> {0..p}" |
53688 | 1752 |
using q(1) b' |
1753 |
by (auto intro: less_imp_le simp: bij_betw_def) |
|
68621 | 1754 |
then have "z \<in> cbox 0 One" |
1755 |
unfolding z_def cbox_def |
|
53688 | 1756 |
using b'_Basis |
68022 | 1757 |
by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1) |
53688 | 1758 |
then have d_fz_z: "d \<le> norm (f z - z)" |
1759 |
by (rule d) |
|
1760 |
assume "\<not> ?thesis" |
|
53674 | 1761 |
then have as: "\<forall>i\<in>Basis. \<bar>f z \<bullet> i - z \<bullet> i\<bar> < d / real n" |
60420 | 1762 |
using \<open>n > 0\<close> |
68022 | 1763 |
by (auto simp: not_le inner_diff) |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1764 |
have "norm (f z - z) \<le> (\<Sum>i\<in>Basis. \<bar>f z \<bullet> i - z \<bullet> i\<bar>)" |
53688 | 1765 |
unfolding inner_diff_left[symmetric] |
1766 |
by (rule norm_le_l1) |
|
53185 | 1767 |
also have "\<dots> < (\<Sum>(i::'a) \<in> Basis. d / real n)" |
68022 | 1768 |
by (meson as finite_Basis nonempty_Basis sum_strict_mono) |
53185 | 1769 |
also have "\<dots> = d" |
68022 | 1770 |
using DIM_positive[where 'a='a] by (auto simp: n_def) |
53688 | 1771 |
finally show False |
1772 |
using d_fz_z by auto |
|
53185 | 1773 |
qed |
55522 | 1774 |
then obtain i where i: "i \<in> Basis" "d / real n \<le> \<bar>(f z - z) \<bullet> i\<bar>" .. |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1775 |
have *: "b' i < n" |
55522 | 1776 |
using i and b'[unfolded bij_betw_def] |
53688 | 1777 |
by auto |
55522 | 1778 |
obtain r s where rs: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1779 |
"\<And>j. j < n \<Longrightarrow> q j \<le> r j \<and> r j \<le> q j + 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1780 |
"\<And>j. j < n \<Longrightarrow> q j \<le> s j \<and> s j \<le> q j + 1" |
55522 | 1781 |
"(label (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i) \<circ> b) (b' i) \<noteq> |
1782 |
(label (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i) \<circ> b) (b' i)" |
|
1783 |
using q(2)[rule_format,OF *] by blast |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1784 |
have b'_im: "\<And>i. i \<in> Basis \<Longrightarrow> b' i < n" |
53185 | 1785 |
using b' unfolding bij_betw_def by auto |
63040 | 1786 |
define r' ::'a where "r' = (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i)" |
53185 | 1787 |
have "\<And>i. i \<in> Basis \<Longrightarrow> r (b' i) \<le> p" |
1788 |
apply (rule order_trans) |
|
1789 |
apply (rule rs(1)[OF b'_im,THEN conjunct2]) |
|
53252 | 1790 |
using q(1)[rule_format,OF b'_im] |
68022 | 1791 |
apply (auto simp: Suc_le_eq) |
53185 | 1792 |
done |
68621 | 1793 |
then have "r' \<in> cbox 0 One" |
1794 |
unfolding r'_def cbox_def |
|
53688 | 1795 |
using b'_Basis |
68022 | 1796 |
by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1) |
63040 | 1797 |
define s' :: 'a where "s' = (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i)" |
53688 | 1798 |
have "\<And>i. i \<in> Basis \<Longrightarrow> s (b' i) \<le> p" |
68022 | 1799 |
using b'_im q(1) rs(2) by fastforce |
68621 | 1800 |
then have "s' \<in> cbox 0 One" |
1801 |
unfolding s'_def cbox_def |
|
68022 | 1802 |
using b'_Basis by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1) |
68621 | 1803 |
have "z \<in> cbox 0 One" |
1804 |
unfolding z_def cbox_def |
|
60420 | 1805 |
using b'_Basis q(1)[rule_format,OF b'_im] \<open>p > 0\<close> |
68022 | 1806 |
by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1 less_imp_le) |
53688 | 1807 |
{ |
1808 |
have "(\<Sum>i\<in>Basis. \<bar>real (r (b' i)) - real (q (b' i))\<bar>) \<le> (\<Sum>(i::'a)\<in>Basis. 1)" |
|
68022 | 1809 |
by (rule sum_mono) (use rs(1)[OF b'_im] in force) |
53688 | 1810 |
also have "\<dots> < e * real p" |
60420 | 1811 |
using p \<open>e > 0\<close> \<open>p > 0\<close> |
68022 | 1812 |
by (auto simp: field_simps n_def) |
53185 | 1813 |
finally have "(\<Sum>i\<in>Basis. \<bar>real (r (b' i)) - real (q (b' i))\<bar>) < e * real p" . |
1814 |
} |
|
1815 |
moreover |
|
53688 | 1816 |
{ |
1817 |
have "(\<Sum>i\<in>Basis. \<bar>real (s (b' i)) - real (q (b' i))\<bar>) \<le> (\<Sum>(i::'a)\<in>Basis. 1)" |
|
68022 | 1818 |
by (rule sum_mono) (use rs(2)[OF b'_im] in force) |
53688 | 1819 |
also have "\<dots> < e * real p" |
60420 | 1820 |
using p \<open>e > 0\<close> \<open>p > 0\<close> |
68022 | 1821 |
by (auto simp: field_simps n_def) |
53185 | 1822 |
finally have "(\<Sum>i\<in>Basis. \<bar>real (s (b' i)) - real (q (b' i))\<bar>) < e * real p" . |
1823 |
} |
|
1824 |
ultimately |
|
53688 | 1825 |
have "norm (r' - z) < e" and "norm (s' - z) < e" |
53185 | 1826 |
unfolding r'_def s'_def z_def |
60420 | 1827 |
using \<open>p > 0\<close> |
53185 | 1828 |
apply (rule_tac[!] le_less_trans[OF norm_le_l1]) |
68022 | 1829 |
apply (auto simp: field_simps sum_divide_distrib[symmetric] inner_diff_left) |
53185 | 1830 |
done |
53674 | 1831 |
then have "\<bar>(f z - z) \<bullet> i\<bar> < d / real n" |
53688 | 1832 |
using rs(3) i |
1833 |
unfolding r'_def[symmetric] s'_def[symmetric] o_def bb' |
|
68621 | 1834 |
by (intro e(2)[OF \<open>r'\<in>cbox 0 One\<close> \<open>s'\<in>cbox 0 One\<close> \<open>z\<in>cbox 0 One\<close>]) auto |
53688 | 1835 |
then show False |
1836 |
using i by auto |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1837 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1838 |
|
68617 | 1839 |
text \<open>Next step is to prove it for nonempty interiors.\<close> |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1840 |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50514
diff
changeset
|
1841 |
lemma brouwer_weak: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1842 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
68022 | 1843 |
assumes "compact S" |
1844 |
and "convex S" |
|
1845 |
and "interior S \<noteq> {}" |
|
1846 |
and "continuous_on S f" |
|
1847 |
and "f ` S \<subseteq> S" |
|
1848 |
obtains x where "x \<in> S" and "f x = x" |
|
53185 | 1849 |
proof - |
68621 | 1850 |
let ?U = "cbox 0 One :: 'a set" |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1851 |
have "\<Sum>Basis /\<^sub>R 2 \<in> interior ?U" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1852 |
proof (rule interiorI) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1853 |
let ?I = "(\<Inter>i\<in>Basis. {x::'a. 0 < x \<bullet> i} \<inter> {x. x \<bullet> i < 1})" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1854 |
show "open ?I" |
71172 | 1855 |
by (intro open_INT finite_Basis ballI open_Int, auto intro: open_Collect_less simp: continuous_on_inner) |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1856 |
show "\<Sum>Basis /\<^sub>R 2 \<in> ?I" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1857 |
by simp |
68621 | 1858 |
show "?I \<subseteq> cbox 0 One" |
1859 |
unfolding cbox_def by force |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1860 |
qed |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1861 |
then have *: "interior ?U \<noteq> {}" by fast |
68022 | 1862 |
have *: "?U homeomorphic S" |
68621 | 1863 |
using homeomorphic_convex_compact[OF convex_box(1) compact_cbox * assms(2,1,3)] . |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1864 |
have "\<forall>f. continuous_on ?U f \<and> f ` ?U \<subseteq> ?U \<longrightarrow> |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1865 |
(\<exists>x\<in>?U. f x = x)" |
37489
44e42d392c6e
Introduce a type class for euclidean spaces, port most lemmas from real^'n to this type class.
hoelzl
parents:
36587
diff
changeset
|
1866 |
using brouwer_cube by auto |
53674 | 1867 |
then show ?thesis |
53185 | 1868 |
unfolding homeomorphic_fixpoint_property[OF *] |
53252 | 1869 |
using assms |
68022 | 1870 |
by (auto intro: that) |
53185 | 1871 |
qed |
1872 |
||
68617 | 1873 |
text \<open>Then the particular case for closed balls.\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1874 |
|
53185 | 1875 |
lemma brouwer_ball: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1876 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
53674 | 1877 |
assumes "e > 0" |
1878 |
and "continuous_on (cball a e) f" |
|
53688 | 1879 |
and "f ` cball a e \<subseteq> cball a e" |
53674 | 1880 |
obtains x where "x \<in> cball a e" and "f x = x" |
53185 | 1881 |
using brouwer_weak[OF compact_cball convex_cball, of a e f] |
1882 |
unfolding interior_cball ball_eq_empty |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1883 |
using assms by auto |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1884 |
|
68617 | 1885 |
text \<open>And finally we prove Brouwer's fixed point theorem in its general version.\<close> |
1886 |
||
1887 |
theorem brouwer: |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1888 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
68022 | 1889 |
assumes S: "compact S" "convex S" "S \<noteq> {}" |
1890 |
and contf: "continuous_on S f" |
|
1891 |
and fim: "f ` S \<subseteq> S" |
|
1892 |
obtains x where "x \<in> S" and "f x = x" |
|
53185 | 1893 |
proof - |
68022 | 1894 |
have "\<exists>e>0. S \<subseteq> cball 0 e" |
1895 |
using compact_imp_bounded[OF \<open>compact S\<close>] unfolding bounded_pos |
|
1896 |
by auto |
|
1897 |
then obtain e where e: "e > 0" "S \<subseteq> cball 0 e" |
|
55522 | 1898 |
by blast |
68022 | 1899 |
have "\<exists>x\<in> cball 0 e. (f \<circ> closest_point S) x = x" |
1900 |
proof (rule_tac brouwer_ball[OF e(1)]) |
|
1901 |
show "continuous_on (cball 0 e) (f \<circ> closest_point S)" |
|
1902 |
apply (rule continuous_on_compose) |
|
1903 |
using S compact_eq_bounded_closed continuous_on_closest_point apply blast |
|
1904 |
by (meson S contf closest_point_in_set compact_imp_closed continuous_on_subset image_subsetI) |
|
1905 |
show "(f \<circ> closest_point S) ` cball 0 e \<subseteq> cball 0 e" |
|
1906 |
by clarsimp (metis S fim closest_point_exists(1) compact_eq_bounded_closed e(2) image_subset_iff mem_cball_0 subsetCE) |
|
1907 |
qed (use assms in auto) |
|
1908 |
then obtain x where x: "x \<in> cball 0 e" "(f \<circ> closest_point S) x = x" .. |
|
1909 |
have "x \<in> S" |
|
1910 |
by (metis closest_point_in_set comp_apply compact_imp_closed fim image_eqI S(1) S(3) subset_iff x(2)) |
|
1911 |
then have *: "closest_point S x = x" |
|
1912 |
by (rule closest_point_self) |
|
53185 | 1913 |
show thesis |
68022 | 1914 |
proof |
1915 |
show "closest_point S x \<in> S" |
|
1916 |
by (simp add: "*" \<open>x \<in> S\<close>) |
|
1917 |
show "f (closest_point S x) = closest_point S x" |
|
1918 |
using "*" x(2) by auto |
|
1919 |
qed |
|
53185 | 1920 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1921 |
|
68617 | 1922 |
subsection \<open>Applications\<close> |
1923 |
||
60420 | 1924 |
text \<open>So we get the no-retraction theorem.\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1925 |
|
68617 | 1926 |
corollary no_retraction_cball: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1927 |
fixes a :: "'a::euclidean_space" |
53674 | 1928 |
assumes "e > 0" |
1929 |
shows "\<not> (frontier (cball a e) retract_of (cball a e))" |
|
53185 | 1930 |
proof |
60580 | 1931 |
assume *: "frontier (cball a e) retract_of (cball a e)" |
1932 |
have **: "\<And>xa. a - (2 *\<^sub>R a - xa) = - (a - xa)" |
|
53185 | 1933 |
using scaleR_left_distrib[of 1 1 a] by auto |
68022 | 1934 |
obtain x where x: "x \<in> {x. norm (a - x) = e}" "2 *\<^sub>R a - x = x" |
1935 |
proof (rule retract_fixpoint_property[OF *, of "\<lambda>x. scaleR 2 a - x"]) |
|
1936 |
show "continuous_on (frontier (cball a e)) ((-) (2 *\<^sub>R a))" |
|
1937 |
by (intro continuous_intros) |
|
1938 |
show "(-) (2 *\<^sub>R a) ` frontier (cball a e) \<subseteq> frontier (cball a e)" |
|
1939 |
by clarsimp (metis "**" dist_norm norm_minus_cancel) |
|
1940 |
qed (auto simp: dist_norm intro: brouwer_ball[OF assms]) |
|
53674 | 1941 |
then have "scaleR 2 a = scaleR 1 x + scaleR 1 x" |
68022 | 1942 |
by (auto simp: algebra_simps) |
53674 | 1943 |
then have "a = x" |
53688 | 1944 |
unfolding scaleR_left_distrib[symmetric] |
1945 |
by auto |
|
53674 | 1946 |
then show False |
1947 |
using x assms by auto |
|
53185 | 1948 |
qed |
1949 |
||
64006
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1950 |
corollary contractible_sphere: |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1951 |
fixes a :: "'a::euclidean_space" |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1952 |
shows "contractible(sphere a r) \<longleftrightarrow> r \<le> 0" |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1953 |
proof (cases "0 < r") |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1954 |
case True |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1955 |
then show ?thesis |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1956 |
unfolding contractible_def nullhomotopic_from_sphere_extension |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1957 |
using no_retraction_cball [OF True, of a] |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1958 |
by (auto simp: retract_of_def retraction_def) |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1959 |
next |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1960 |
case False |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1961 |
then show ?thesis |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1962 |
unfolding contractible_def nullhomotopic_from_sphere_extension |
71172 | 1963 |
using less_eq_real_def by auto |
64006
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1964 |
qed |
0de4736dad8b
new theorems including the theory FurtherTopology
paulson <lp15@cam.ac.uk>
parents:
63928
diff
changeset
|
1965 |
|
68617 | 1966 |
corollary connected_sphere_eq: |
64789
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1967 |
fixes a :: "'a :: euclidean_space" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1968 |
shows "connected(sphere a r) \<longleftrightarrow> 2 \<le> DIM('a) \<or> r \<le> 0" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1969 |
(is "?lhs = ?rhs") |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1970 |
proof (cases r "0::real" rule: linorder_cases) |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1971 |
case less |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1972 |
then show ?thesis by auto |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1973 |
next |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1974 |
case equal |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1975 |
then show ?thesis by auto |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1976 |
next |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1977 |
case greater |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1978 |
show ?thesis |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1979 |
proof |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1980 |
assume L: ?lhs |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1981 |
have "False" if 1: "DIM('a) = 1" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1982 |
proof - |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1983 |
obtain x y where xy: "sphere a r = {x,y}" "x \<noteq> y" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1984 |
using sphere_1D_doubleton [OF 1 greater] |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1985 |
by (metis dist_self greater insertI1 less_add_same_cancel1 mem_sphere mult_2 not_le zero_le_dist) |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1986 |
then have "finite (sphere a r)" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1987 |
by auto |
68022 | 1988 |
with L \<open>r > 0\<close> xy show "False" |
1989 |
using connected_finite_iff_sing by auto |
|
64789
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1990 |
qed |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1991 |
with greater show ?rhs |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1992 |
by (metis DIM_ge_Suc0 One_nat_def Suc_1 le_antisym not_less_eq_eq) |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1993 |
next |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1994 |
assume ?rhs |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1995 |
then show ?lhs |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1996 |
using connected_sphere greater by auto |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1997 |
qed |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1998 |
qed |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1999 |
|
68617 | 2000 |
corollary path_connected_sphere_eq: |
64789
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2001 |
fixes a :: "'a :: euclidean_space" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2002 |
shows "path_connected(sphere a r) \<longleftrightarrow> 2 \<le> DIM('a) \<or> r \<le> 0" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2003 |
(is "?lhs = ?rhs") |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2004 |
proof |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2005 |
assume ?lhs |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2006 |
then show ?rhs |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2007 |
using connected_sphere_eq path_connected_imp_connected by blast |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2008 |
next |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2009 |
assume R: ?rhs |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2010 |
then show ?lhs |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2011 |
by (auto simp: contractible_imp_path_connected contractible_sphere path_connected_sphere) |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2012 |
qed |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2013 |
|
64122 | 2014 |
proposition frontier_subset_retraction: |
2015 |
fixes S :: "'a::euclidean_space set" |
|
2016 |
assumes "bounded S" and fros: "frontier S \<subseteq> T" |
|
2017 |
and contf: "continuous_on (closure S) f" |
|
2018 |
and fim: "f ` S \<subseteq> T" |
|
2019 |
and fid: "\<And>x. x \<in> T \<Longrightarrow> f x = x" |
|
2020 |
shows "S \<subseteq> T" |
|
2021 |
proof (rule ccontr) |
|
2022 |
assume "\<not> S \<subseteq> T" |
|
2023 |
then obtain a where "a \<in> S" "a \<notin> T" by blast |
|
2024 |
define g where "g \<equiv> \<lambda>z. if z \<in> closure S then f z else z" |
|
2025 |
have "continuous_on (closure S \<union> closure(-S)) g" |
|
2026 |
unfolding g_def |
|
2027 |
apply (rule continuous_on_cases) |
|
71172 | 2028 |
using fros fid frontier_closures by (auto simp: contf) |
64122 | 2029 |
moreover have "closure S \<union> closure(- S) = UNIV" |
2030 |
using closure_Un by fastforce |
|
2031 |
ultimately have contg: "continuous_on UNIV g" by metis |
|
2032 |
obtain B where "0 < B" and B: "closure S \<subseteq> ball a B" |
|
2033 |
using \<open>bounded S\<close> bounded_subset_ballD by blast |
|
2034 |
have notga: "g x \<noteq> a" for x |
|
2035 |
unfolding g_def using fros fim \<open>a \<notin> T\<close> |
|
2036 |
apply (auto simp: frontier_def) |
|
2037 |
using fid interior_subset apply fastforce |
|
2038 |
by (simp add: \<open>a \<in> S\<close> closure_def) |
|
2039 |
define h where "h \<equiv> (\<lambda>y. a + (B / norm(y - a)) *\<^sub>R (y - a)) \<circ> g" |
|
2040 |
have "\<not> (frontier (cball a B) retract_of (cball a B))" |
|
2041 |
by (metis no_retraction_cball \<open>0 < B\<close>) |
|
2042 |
then have "\<And>k. \<not> retraction (cball a B) (frontier (cball a B)) k" |
|
2043 |
by (simp add: retract_of_def) |
|
2044 |
moreover have "retraction (cball a B) (frontier (cball a B)) h" |
|
2045 |
unfolding retraction_def |
|
2046 |
proof (intro conjI ballI) |
|
2047 |
show "frontier (cball a B) \<subseteq> cball a B" |
|
68022 | 2048 |
by force |
64122 | 2049 |
show "continuous_on (cball a B) h" |
2050 |
unfolding h_def |
|
68022 | 2051 |
by (intro continuous_intros) (use contg continuous_on_subset notga in auto) |
64122 | 2052 |
show "h ` cball a B \<subseteq> frontier (cball a B)" |
2053 |
using \<open>0 < B\<close> by (auto simp: h_def notga dist_norm) |
|
2054 |
show "\<And>x. x \<in> frontier (cball a B) \<Longrightarrow> h x = x" |
|
2055 |
apply (auto simp: h_def algebra_simps) |
|
2056 |
apply (simp add: vector_add_divide_simps notga) |
|
2057 |
by (metis (no_types, hide_lams) B add.commute dist_commute dist_norm g_def mem_ball not_less_iff_gr_or_eq subset_eq) |
|
2058 |
qed |
|
2059 |
ultimately show False by simp |
|
2060 |
qed |
|
2061 |
||
68617 | 2062 |
subsubsection \<open>Punctured affine hulls, etc\<close> |
2063 |
||
2064 |
lemma rel_frontier_deformation_retract_of_punctured_convex: |
|
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2065 |
fixes S :: "'a::euclidean_space set" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2066 |
assumes "convex S" "convex T" "bounded S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2067 |
and arelS: "a \<in> rel_interior S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2068 |
and relS: "rel_frontier S \<subseteq> T" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2069 |
and affS: "T \<subseteq> affine hull S" |
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
2070 |
obtains r where "homotopic_with_canon (\<lambda>x. True) (T - {a}) (T - {a}) id r" |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2071 |
"retraction (T - {a}) (rel_frontier S) r" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2072 |
proof - |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2073 |
have "\<exists>d. 0 < d \<and> (a + d *\<^sub>R l) \<in> rel_frontier S \<and> |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2074 |
(\<forall>e. 0 \<le> e \<and> e < d \<longrightarrow> (a + e *\<^sub>R l) \<in> rel_interior S)" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2075 |
if "(a + l) \<in> affine hull S" "l \<noteq> 0" for l |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2076 |
apply (rule ray_to_rel_frontier [OF \<open>bounded S\<close> arelS]) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2077 |
apply (rule that)+ |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2078 |
by metis |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2079 |
then obtain dd |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2080 |
where dd1: "\<And>l. \<lbrakk>(a + l) \<in> affine hull S; l \<noteq> 0\<rbrakk> \<Longrightarrow> 0 < dd l \<and> (a + dd l *\<^sub>R l) \<in> rel_frontier S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2081 |
and dd2: "\<And>l e. \<lbrakk>(a + l) \<in> affine hull S; e < dd l; 0 \<le> e; l \<noteq> 0\<rbrakk> |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2082 |
\<Longrightarrow> (a + e *\<^sub>R l) \<in> rel_interior S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2083 |
by metis+ |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2084 |
have aaffS: "a \<in> affine hull S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2085 |
by (meson arelS subsetD hull_inc rel_interior_subset) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2086 |
have "((\<lambda>z. z - a) ` (affine hull S - {a})) = ((\<lambda>z. z - a) ` (affine hull S)) - {0}" |
68022 | 2087 |
by auto |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2088 |
moreover have "continuous_on (((\<lambda>z. z - a) ` (affine hull S)) - {0}) (\<lambda>x. dd x *\<^sub>R x)" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2089 |
proof (rule continuous_on_compact_surface_projection) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2090 |
show "compact (rel_frontier ((\<lambda>z. z - a) ` S))" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2091 |
by (simp add: \<open>bounded S\<close> bounded_translation_minus compact_rel_frontier_bounded) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2092 |
have releq: "rel_frontier ((\<lambda>z. z - a) ` S) = (\<lambda>z. z - a) ` rel_frontier S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2093 |
using rel_frontier_translation [of "-a"] add.commute by simp |
68022 | 2094 |
also have "\<dots> \<subseteq> (\<lambda>z. z - a) ` (affine hull S) - {0}" |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2095 |
using rel_frontier_affine_hull arelS rel_frontier_def by fastforce |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2096 |
finally show "rel_frontier ((\<lambda>z. z - a) ` S) \<subseteq> (\<lambda>z. z - a) ` (affine hull S) - {0}" . |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2097 |
show "cone ((\<lambda>z. z - a) ` (affine hull S))" |
68022 | 2098 |
by (rule subspace_imp_cone) |
2099 |
(use aaffS in \<open>simp add: subspace_affine image_comp o_def affine_translation_aux [of a]\<close>) |
|
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2100 |
show "(0 < k \<and> k *\<^sub>R x \<in> rel_frontier ((\<lambda>z. z - a) ` S)) \<longleftrightarrow> (dd x = k)" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2101 |
if x: "x \<in> (\<lambda>z. z - a) ` (affine hull S) - {0}" for k x |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2102 |
proof |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2103 |
show "dd x = k \<Longrightarrow> 0 < k \<and> k *\<^sub>R x \<in> rel_frontier ((\<lambda>z. z - a) ` S)" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2104 |
using dd1 [of x] that image_iff by (fastforce simp add: releq) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2105 |
next |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2106 |
assume k: "0 < k \<and> k *\<^sub>R x \<in> rel_frontier ((\<lambda>z. z - a) ` S)" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2107 |
have False if "dd x < k" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2108 |
proof - |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2109 |
have "k \<noteq> 0" "a + k *\<^sub>R x \<in> closure S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2110 |
using k closure_translation [of "-a"] |
69661 | 2111 |
by (auto simp: rel_frontier_def cong: image_cong_simp) |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2112 |
then have segsub: "open_segment a (a + k *\<^sub>R x) \<subseteq> rel_interior S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2113 |
by (metis rel_interior_closure_convex_segment [OF \<open>convex S\<close> arelS]) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2114 |
have "x \<noteq> 0" and xaffS: "a + x \<in> affine hull S" |
68022 | 2115 |
using x by auto |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2116 |
then have "0 < dd x" and inS: "a + dd x *\<^sub>R x \<in> rel_frontier S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2117 |
using dd1 by auto |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2118 |
moreover have "a + dd x *\<^sub>R x \<in> open_segment a (a + k *\<^sub>R x)" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2119 |
using k \<open>x \<noteq> 0\<close> \<open>0 < dd x\<close> |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2120 |
apply (simp add: in_segment) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2121 |
apply (rule_tac x = "dd x / k" in exI) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2122 |
apply (simp add: field_simps that) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2123 |
apply (simp add: vector_add_divide_simps algebra_simps) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2124 |
done |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2125 |
ultimately show ?thesis |
68022 | 2126 |
using segsub by (auto simp: rel_frontier_def) |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2127 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2128 |
moreover have False if "k < dd x" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2129 |
using x k that rel_frontier_def |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2130 |
by (fastforce simp: algebra_simps releq dest!: dd2) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2131 |
ultimately show "dd x = k" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2132 |
by fastforce |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2133 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2134 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2135 |
ultimately have *: "continuous_on ((\<lambda>z. z - a) ` (affine hull S - {a})) (\<lambda>x. dd x *\<^sub>R x)" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2136 |
by auto |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2137 |
have "continuous_on (affine hull S - {a}) ((\<lambda>x. a + dd x *\<^sub>R x) \<circ> (\<lambda>z. z - a))" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2138 |
by (intro * continuous_intros continuous_on_compose) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2139 |
with affS have contdd: "continuous_on (T - {a}) ((\<lambda>x. a + dd x *\<^sub>R x) \<circ> (\<lambda>z. z - a))" |
68022 | 2140 |
by (blast intro: continuous_on_subset) |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2141 |
show ?thesis |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2142 |
proof |
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
2143 |
show "homotopic_with_canon (\<lambda>x. True) (T - {a}) (T - {a}) id (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))" |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2144 |
proof (rule homotopic_with_linear) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2145 |
show "continuous_on (T - {a}) id" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2146 |
by (intro continuous_intros continuous_on_compose) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2147 |
show "continuous_on (T - {a}) (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2148 |
using contdd by (simp add: o_def) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2149 |
show "closed_segment (id x) (a + dd (x - a) *\<^sub>R (x - a)) \<subseteq> T - {a}" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2150 |
if "x \<in> T - {a}" for x |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2151 |
proof (clarsimp simp: in_segment, intro conjI) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2152 |
fix u::real assume u: "0 \<le> u" "u \<le> 1" |
68022 | 2153 |
have "a + dd (x - a) *\<^sub>R (x - a) \<in> T" |
2154 |
by (metis DiffD1 DiffD2 add.commute add.right_neutral affS dd1 diff_add_cancel relS singletonI subsetCE that) |
|
2155 |
then show "(1 - u) *\<^sub>R x + u *\<^sub>R (a + dd (x - a) *\<^sub>R (x - a)) \<in> T" |
|
2156 |
using convexD [OF \<open>convex T\<close>] that u by simp |
|
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2157 |
have iff: "(1 - u) *\<^sub>R x + u *\<^sub>R (a + d *\<^sub>R (x - a)) = a \<longleftrightarrow> |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2158 |
(1 - u + u * d) *\<^sub>R (x - a) = 0" for d |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2159 |
by (auto simp: algebra_simps) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2160 |
have "x \<in> T" "x \<noteq> a" using that by auto |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2161 |
then have axa: "a + (x - a) \<in> affine hull S" |
69712 | 2162 |
by (metis (no_types) add.commute affS diff_add_cancel rev_subsetD) |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2163 |
then have "\<not> dd (x - a) \<le> 0 \<and> a + dd (x - a) *\<^sub>R (x - a) \<in> rel_frontier S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2164 |
using \<open>x \<noteq> a\<close> dd1 by fastforce |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2165 |
with \<open>x \<noteq> a\<close> show "(1 - u) *\<^sub>R x + u *\<^sub>R (a + dd (x - a) *\<^sub>R (x - a)) \<noteq> a" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2166 |
apply (auto simp: iff) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2167 |
using less_eq_real_def mult_le_0_iff not_less u by fastforce |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2168 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2169 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2170 |
show "retraction (T - {a}) (rel_frontier S) (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2171 |
proof (simp add: retraction_def, intro conjI ballI) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2172 |
show "rel_frontier S \<subseteq> T - {a}" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2173 |
using arelS relS rel_frontier_def by fastforce |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2174 |
show "continuous_on (T - {a}) (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2175 |
using contdd by (simp add: o_def) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2176 |
show "(\<lambda>x. a + dd (x - a) *\<^sub>R (x - a)) ` (T - {a}) \<subseteq> rel_frontier S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2177 |
apply (auto simp: rel_frontier_def) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2178 |
apply (metis Diff_subset add.commute affS dd1 diff_add_cancel eq_iff_diff_eq_0 rel_frontier_def subset_iff) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2179 |
by (metis DiffE add.commute affS dd1 diff_add_cancel eq_iff_diff_eq_0 rel_frontier_def rev_subsetD) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2180 |
show "a + dd (x - a) *\<^sub>R (x - a) = x" if x: "x \<in> rel_frontier S" for x |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2181 |
proof - |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2182 |
have "x \<noteq> a" |
68022 | 2183 |
using that arelS by (auto simp: rel_frontier_def) |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2184 |
have False if "dd (x - a) < 1" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2185 |
proof - |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2186 |
have "x \<in> closure S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2187 |
using x by (auto simp: rel_frontier_def) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2188 |
then have segsub: "open_segment a x \<subseteq> rel_interior S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2189 |
by (metis rel_interior_closure_convex_segment [OF \<open>convex S\<close> arelS]) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2190 |
have xaffS: "x \<in> affine hull S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2191 |
using affS relS x by auto |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2192 |
then have "0 < dd (x - a)" and inS: "a + dd (x - a) *\<^sub>R (x - a) \<in> rel_frontier S" |
68022 | 2193 |
using dd1 by (auto simp: \<open>x \<noteq> a\<close>) |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2194 |
moreover have "a + dd (x - a) *\<^sub>R (x - a) \<in> open_segment a x" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2195 |
using \<open>x \<noteq> a\<close> \<open>0 < dd (x - a)\<close> |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2196 |
apply (simp add: in_segment) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2197 |
apply (rule_tac x = "dd (x - a)" in exI) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2198 |
apply (simp add: algebra_simps that) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2199 |
done |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2200 |
ultimately show ?thesis |
68022 | 2201 |
using segsub by (auto simp: rel_frontier_def) |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2202 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2203 |
moreover have False if "1 < dd (x - a)" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2204 |
using x that dd2 [of "x - a" 1] \<open>x \<noteq> a\<close> closure_affine_hull |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2205 |
by (auto simp: rel_frontier_def) |
67443
3abf6a722518
standardized towards new-style formal comments: isabelle update_comments;
wenzelm
parents:
67399
diff
changeset
|
2206 |
ultimately have "dd (x - a) = 1" \<comment> \<open>similar to another proof above\<close> |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2207 |
by fastforce |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2208 |
with that show ?thesis |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2209 |
by (simp add: rel_frontier_def) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2210 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2211 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2212 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2213 |
qed |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2214 |
|
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2215 |
corollary rel_frontier_retract_of_punctured_affine_hull: |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2216 |
fixes S :: "'a::euclidean_space set" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2217 |
assumes "bounded S" "convex S" "a \<in> rel_interior S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2218 |
shows "rel_frontier S retract_of (affine hull S - {a})" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2219 |
apply (rule rel_frontier_deformation_retract_of_punctured_convex [of S "affine hull S" a]) |
68022 | 2220 |
apply (auto simp: affine_imp_convex rel_frontier_affine_hull retract_of_def assms) |
63492
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2221 |
done |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2222 |
|
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2223 |
corollary rel_boundary_retract_of_punctured_affine_hull: |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2224 |
fixes S :: "'a::euclidean_space set" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2225 |
assumes "compact S" "convex S" "a \<in> rel_interior S" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2226 |
shows "(S - rel_interior S) retract_of (affine hull S - {a})" |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2227 |
by (metis assms closure_closed compact_eq_bounded_closed rel_frontier_def |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2228 |
rel_frontier_retract_of_punctured_affine_hull) |
a662e8139804
More advanced theorems about retracts, homotopies., etc
paulson <lp15@cam.ac.uk>
parents:
63469
diff
changeset
|
2229 |
|
64789
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2230 |
lemma homotopy_eqv_rel_frontier_punctured_convex: |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2231 |
fixes S :: "'a::euclidean_space set" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2232 |
assumes "convex S" "bounded S" "a \<in> rel_interior S" "convex T" "rel_frontier S \<subseteq> T" "T \<subseteq> affine hull S" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2233 |
shows "(rel_frontier S) homotopy_eqv (T - {a})" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2234 |
apply (rule rel_frontier_deformation_retract_of_punctured_convex [of S T]) |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2235 |
using assms |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2236 |
apply auto |
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
2237 |
using deformation_retract_imp_homotopy_eqv homotopy_equivalent_space_sym by blast |
64789
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2238 |
|
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2239 |
lemma homotopy_eqv_rel_frontier_punctured_affine_hull: |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2240 |
fixes S :: "'a::euclidean_space set" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2241 |
assumes "convex S" "bounded S" "a \<in> rel_interior S" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2242 |
shows "(rel_frontier S) homotopy_eqv (affine hull S - {a})" |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2243 |
apply (rule homotopy_eqv_rel_frontier_punctured_convex) |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2244 |
using assms rel_frontier_affine_hull by force+ |
6440577e34ee
connectedness, circles not simply connected , punctured universe
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
2245 |
|
64394 | 2246 |
lemma path_connected_sphere_gen: |
2247 |
assumes "convex S" "bounded S" "aff_dim S \<noteq> 1" |
|
2248 |
shows "path_connected(rel_frontier S)" |
|
2249 |
proof (cases "rel_interior S = {}") |
|
2250 |
case True |
|
2251 |
then show ?thesis |
|
2252 |
by (simp add: \<open>convex S\<close> convex_imp_path_connected rel_frontier_def) |
|
2253 |
next |
|
2254 |
case False |
|
2255 |
then show ?thesis |
|
2256 |
by (metis aff_dim_affine_hull affine_affine_hull affine_imp_convex all_not_in_conv assms path_connected_punctured_convex rel_frontier_retract_of_punctured_affine_hull retract_of_path_connected) |
|
2257 |
qed |
|
2258 |
||
2259 |
lemma connected_sphere_gen: |
|
2260 |
assumes "convex S" "bounded S" "aff_dim S \<noteq> 1" |
|
2261 |
shows "connected(rel_frontier S)" |
|
2262 |
by (simp add: assms path_connected_imp_connected path_connected_sphere_gen) |
|
2263 |
||
68617 | 2264 |
subsubsection\<open>Borsuk-style characterization of separation\<close> |
63301 | 2265 |
|
2266 |
lemma continuous_on_Borsuk_map: |
|
2267 |
"a \<notin> s \<Longrightarrow> continuous_on s (\<lambda>x. inverse(norm (x - a)) *\<^sub>R (x - a))" |
|
2268 |
by (rule continuous_intros | force)+ |
|
2269 |
||
2270 |
lemma Borsuk_map_into_sphere: |
|
2271 |
"(\<lambda>x. inverse(norm (x - a)) *\<^sub>R (x - a)) ` s \<subseteq> sphere 0 1 \<longleftrightarrow> (a \<notin> s)" |
|
2272 |
by auto (metis eq_iff_diff_eq_0 left_inverse norm_eq_zero) |
|
2273 |
||
2274 |
lemma Borsuk_maps_homotopic_in_path_component: |
|
2275 |
assumes "path_component (- s) a b" |
|
69986
f2d327275065
generalised homotopic_with to topologies; homotopic_with_canon is the old version
paulson <lp15@cam.ac.uk>
parents:
69945
diff
changeset
|
2276 |
shows "homotopic_with_canon (\<lambda>x. True) s (sphere 0 1) |
63301 | 2277 |
(\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) |
2278 |
(\<lambda>x. inverse(norm(x - b)) *\<^sub>R (x - b))" |
|
2279 |
proof - |
|
2280 |
obtain g where "path g" "path_image g \<subseteq> -s" "pathstart g = a" "pathfinish g = b" |
|
2281 |
using assms by (auto simp: path_component_def) |
|
2282 |
then show ?thesis |
|
2283 |
apply (simp add: path_def path_image_def pathstart_def pathfinish_def homotopic_with_def) |
|
68022 | 2284 |
apply (rule_tac x = "\<lambda>z. inverse(norm(snd z - (g \<circ> fst)z)) *\<^sub>R (snd z - (g \<circ> fst)z)" in exI) |
63301 | 2285 |
apply (intro conjI continuous_intros) |
2286 |
apply (rule continuous_intros | erule continuous_on_subset | fastforce simp: divide_simps sphere_def)+ |
|
2287 |
done |
|
2288 |
qed |
|
2289 |
||
2290 |
lemma non_extensible_Borsuk_map: |
|
2291 |
fixes a :: "'a :: euclidean_space" |
|
2292 |
assumes "compact s" and cin: "c \<in> components(- s)" and boc: "bounded c" and "a \<in> c" |
|
69508 | 2293 |
shows "\<not> (\<exists>g. continuous_on (s \<union> c) g \<and> |
63301 | 2294 |
g ` (s \<union> c) \<subseteq> sphere 0 1 \<and> |
2295 |
(\<forall>x \<in> s. g x = inverse(norm(x - a)) *\<^sub>R (x - a)))" |
|
2296 |
proof - |
|
2297 |
have "closed s" using assms by (simp add: compact_imp_closed) |
|
2298 |
have "c \<subseteq> -s" |
|
2299 |
using assms by (simp add: in_components_subset) |
|
2300 |
with \<open>a \<in> c\<close> have "a \<notin> s" by blast |
|
2301 |
then have ceq: "c = connected_component_set (- s) a" |
|
2302 |
by (metis \<open>a \<in> c\<close> cin components_iff connected_component_eq) |
|
2303 |
then have "bounded (s \<union> connected_component_set (- s) a)" |
|
2304 |
using \<open>compact s\<close> boc compact_imp_bounded by auto |
|
2305 |
with bounded_subset_ballD obtain r where "0 < r" and r: "(s \<union> connected_component_set (- s) a) \<subseteq> ball a r" |
|
2306 |
by blast |
|
2307 |
{ fix g |
|
2308 |
assume "continuous_on (s \<union> c) g" |
|
2309 |
"g ` (s \<union> c) \<subseteq> sphere 0 1" |
|
2310 |
and [simp]: "\<And>x. x \<in> s \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)" |
|
2311 |
then have [simp]: "\<And>x. x \<in> s \<union> c \<Longrightarrow> norm (g x) = 1" |
|
2312 |
by force |
|
2313 |
have cb_eq: "cball a r = (s \<union> connected_component_set (- s) a) \<union> |
|
2314 |
(cball a r - connected_component_set (- s) a)" |
|
2315 |
using ball_subset_cball [of a r] r by auto |
|
2316 |
have cont1: "continuous_on (s \<union> connected_component_set (- s) a) |
|
2317 |
(\<lambda>x. a + r *\<^sub>R g x)" |
|
2318 |
apply (rule continuous_intros)+ |
|
2319 |
using \<open>continuous_on (s \<union> c) g\<close> ceq by blast |
|
2320 |
have cont2: "continuous_on (cball a r - connected_component_set (- s) a) |
|
2321 |
(\<lambda>x. a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))" |
|
2322 |
by (rule continuous_intros | force simp: \<open>a \<notin> s\<close>)+ |
|
2323 |
have 1: "continuous_on (cball a r) |
|
2324 |
(\<lambda>x. if connected_component (- s) a x |
|
2325 |
then a + r *\<^sub>R g x |
|
2326 |
else a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))" |
|
2327 |
apply (subst cb_eq) |
|
2328 |
apply (rule continuous_on_cases [OF _ _ cont1 cont2]) |
|
2329 |
using ceq cin |
|
2330 |
apply (auto intro: closed_Un_complement_component |
|
2331 |
simp: \<open>closed s\<close> open_Compl open_connected_component) |
|
2332 |
done |
|
2333 |
have 2: "(\<lambda>x. a + r *\<^sub>R g x) ` (cball a r \<inter> connected_component_set (- s) a) |
|
2334 |
\<subseteq> sphere a r " |
|
2335 |
using \<open>0 < r\<close> by (force simp: dist_norm ceq) |
|
2336 |
have "retraction (cball a r) (sphere a r) |
|
2337 |
(\<lambda>x. if x \<in> connected_component_set (- s) a |
|
2338 |
then a + r *\<^sub>R g x |
|
2339 |
else a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))" |
|
2340 |
using \<open>0 < r\<close> |
|
2341 |
apply (simp add: retraction_def dist_norm 1 2, safe) |
|
2342 |
apply (force simp: dist_norm abs_if mult_less_0_iff divide_simps \<open>a \<notin> s\<close>) |
|
2343 |
using r |
|
2344 |
by (auto simp: dist_norm norm_minus_commute) |
|
2345 |
then have False |
|
2346 |
using no_retraction_cball |
|
2347 |
[OF \<open>0 < r\<close>, of a, unfolded retract_of_def, simplified, rule_format, |
|
2348 |
of "\<lambda>x. if x \<in> connected_component_set (- s) a |
|
2349 |
then a + r *\<^sub>R g x |
|
2350 |
else a + r *\<^sub>R inverse(norm(x - a)) *\<^sub>R (x - a)"] |
|
2351 |
by blast |
|
2352 |
} |
|
2353 |
then show ?thesis |
|
2354 |
by blast |
|
2355 |
qed |
|
2356 |
||
70620
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2357 |
subsubsection \<open>Proving surjectivity via Brouwer fixpoint theorem\<close> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2358 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2359 |
lemma brouwer_surjective: |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2360 |
fixes f :: "'n::euclidean_space \<Rightarrow> 'n" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2361 |
assumes "compact T" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2362 |
and "convex T" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2363 |
and "T \<noteq> {}" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2364 |
and "continuous_on T f" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2365 |
and "\<And>x y. \<lbrakk>x\<in>S; y\<in>T\<rbrakk> \<Longrightarrow> x + (y - f y) \<in> T" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2366 |
and "x \<in> S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2367 |
shows "\<exists>y\<in>T. f y = x" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2368 |
proof - |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2369 |
have *: "\<And>x y. f y = x \<longleftrightarrow> x + (y - f y) = y" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2370 |
by (auto simp add: algebra_simps) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2371 |
show ?thesis |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2372 |
unfolding * |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2373 |
apply (rule brouwer[OF assms(1-3), of "\<lambda>y. x + (y - f y)"]) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2374 |
apply (intro continuous_intros) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2375 |
using assms |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2376 |
apply auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2377 |
done |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2378 |
qed |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2379 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2380 |
lemma brouwer_surjective_cball: |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2381 |
fixes f :: "'n::euclidean_space \<Rightarrow> 'n" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2382 |
assumes "continuous_on (cball a e) f" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2383 |
and "e > 0" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2384 |
and "x \<in> S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2385 |
and "\<And>x y. \<lbrakk>x\<in>S; y\<in>cball a e\<rbrakk> \<Longrightarrow> x + (y - f y) \<in> cball a e" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2386 |
shows "\<exists>y\<in>cball a e. f y = x" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2387 |
apply (rule brouwer_surjective) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2388 |
apply (rule compact_cball convex_cball)+ |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2389 |
unfolding cball_eq_empty |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2390 |
using assms |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2391 |
apply auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2392 |
done |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2393 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2394 |
subsubsection \<open>Inverse function theorem\<close> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2395 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2396 |
text \<open>See Sussmann: "Multidifferential calculus", Theorem 2.1.1\<close> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2397 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2398 |
lemma sussmann_open_mapping: |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2399 |
fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2400 |
assumes "open S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2401 |
and contf: "continuous_on S f" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2402 |
and "x \<in> S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2403 |
and derf: "(f has_derivative f') (at x)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2404 |
and "bounded_linear g'" "f' \<circ> g' = id" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2405 |
and "T \<subseteq> S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2406 |
and x: "x \<in> interior T" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2407 |
shows "f x \<in> interior (f ` T)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2408 |
proof - |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2409 |
interpret f': bounded_linear f' |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2410 |
using assms unfolding has_derivative_def by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2411 |
interpret g': bounded_linear g' |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2412 |
using assms by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2413 |
obtain B where B: "0 < B" "\<forall>x. norm (g' x) \<le> norm x * B" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2414 |
using bounded_linear.pos_bounded[OF assms(5)] by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2415 |
hence *: "1 / (2 * B) > 0" by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2416 |
obtain e0 where e0: |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2417 |
"0 < e0" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2418 |
"\<forall>y. norm (y - x) < e0 \<longrightarrow> norm (f y - f x - f' (y - x)) \<le> 1 / (2 * B) * norm (y - x)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2419 |
using derf unfolding has_derivative_at_alt |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2420 |
using * by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2421 |
obtain e1 where e1: "0 < e1" "cball x e1 \<subseteq> T" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2422 |
using mem_interior_cball x by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2423 |
have *: "0 < e0 / B" "0 < e1 / B" using e0 e1 B by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2424 |
obtain e where e: "0 < e" "e < e0 / B" "e < e1 / B" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2425 |
using field_lbound_gt_zero[OF *] by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2426 |
have lem: "\<exists>y\<in>cball (f x) e. f (x + g' (y - f x)) = z" if "z\<in>cball (f x) (e / 2)" for z |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2427 |
proof (rule brouwer_surjective_cball) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2428 |
have z: "z \<in> S" if as: "y \<in>cball (f x) e" "z = x + (g' y - g' (f x))" for y z |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2429 |
proof- |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2430 |
have "dist x z = norm (g' (f x) - g' y)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2431 |
unfolding as(2) and dist_norm by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2432 |
also have "\<dots> \<le> norm (f x - y) * B" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2433 |
by (metis B(2) g'.diff) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2434 |
also have "\<dots> \<le> e * B" |
72569
d56e4eeae967
mult_le_cancel_iff1, mult_le_cancel_iff2, mult_less_iff1 generalised from the real_ versions
paulson <lp15@cam.ac.uk>
parents:
72302
diff
changeset
|
2435 |
by (metis B(1) dist_norm mem_cball mult_le_cancel_iff1 that(1)) |
70620
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2436 |
also have "\<dots> \<le> e1" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2437 |
using B(1) e(3) pos_less_divide_eq by fastforce |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2438 |
finally have "z \<in> cball x e1" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2439 |
by force |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2440 |
then show "z \<in> S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2441 |
using e1 assms(7) by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2442 |
qed |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2443 |
show "continuous_on (cball (f x) e) (\<lambda>y. f (x + g' (y - f x)))" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2444 |
unfolding g'.diff |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2445 |
proof (rule continuous_on_compose2 [OF _ _ order_refl, of _ _ f]) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2446 |
show "continuous_on ((\<lambda>y. x + (g' y - g' (f x))) ` cball (f x) e) f" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2447 |
by (rule continuous_on_subset[OF contf]) (use z in blast) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2448 |
show "continuous_on (cball (f x) e) (\<lambda>y. x + (g' y - g' (f x)))" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2449 |
by (intro continuous_intros linear_continuous_on[OF \<open>bounded_linear g'\<close>]) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2450 |
qed |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2451 |
next |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2452 |
fix y z |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2453 |
assume y: "y \<in> cball (f x) (e / 2)" and z: "z \<in> cball (f x) e" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2454 |
have "norm (g' (z - f x)) \<le> norm (z - f x) * B" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2455 |
using B by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2456 |
also have "\<dots> \<le> e * B" |
72569
d56e4eeae967
mult_le_cancel_iff1, mult_le_cancel_iff2, mult_less_iff1 generalised from the real_ versions
paulson <lp15@cam.ac.uk>
parents:
72302
diff
changeset
|
2457 |
by (metis B(1) z dist_norm mem_cball norm_minus_commute mult_le_cancel_iff1) |
70620
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2458 |
also have "\<dots> < e0" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2459 |
using B(1) e(2) pos_less_divide_eq by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2460 |
finally have *: "norm (x + g' (z - f x) - x) < e0" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2461 |
by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2462 |
have **: "f x + f' (x + g' (z - f x) - x) = z" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2463 |
using assms(6)[unfolded o_def id_def,THEN cong] |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2464 |
by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2465 |
have "norm (f x - (y + (z - f (x + g' (z - f x))))) \<le> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2466 |
norm (f (x + g' (z - f x)) - z) + norm (f x - y)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2467 |
using norm_triangle_ineq[of "f (x + g'(z - f x)) - z" "f x - y"] |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2468 |
by (auto simp add: algebra_simps) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2469 |
also have "\<dots> \<le> 1 / (B * 2) * norm (g' (z - f x)) + norm (f x - y)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2470 |
using e0(2)[rule_format, OF *] |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2471 |
by (simp only: algebra_simps **) auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2472 |
also have "\<dots> \<le> 1 / (B * 2) * norm (g' (z - f x)) + e/2" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2473 |
using y by (auto simp: dist_norm) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2474 |
also have "\<dots> \<le> 1 / (B * 2) * B * norm (z - f x) + e/2" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2475 |
using * B by (auto simp add: field_simps) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2476 |
also have "\<dots> \<le> 1 / 2 * norm (z - f x) + e/2" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2477 |
by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2478 |
also have "\<dots> \<le> e/2 + e/2" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2479 |
using B(1) \<open>norm (z - f x) * B \<le> e * B\<close> by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2480 |
finally show "y + (z - f (x + g' (z - f x))) \<in> cball (f x) e" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2481 |
by (auto simp: dist_norm) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2482 |
qed (use e that in auto) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2483 |
show ?thesis |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2484 |
unfolding mem_interior |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2485 |
proof (intro exI conjI subsetI) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2486 |
fix y |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2487 |
assume "y \<in> ball (f x) (e / 2)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2488 |
then have *: "y \<in> cball (f x) (e / 2)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2489 |
by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2490 |
obtain z where z: "z \<in> cball (f x) e" "f (x + g' (z - f x)) = y" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2491 |
using lem * by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2492 |
then have "norm (g' (z - f x)) \<le> norm (z - f x) * B" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2493 |
using B |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2494 |
by (auto simp add: field_simps) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2495 |
also have "\<dots> \<le> e * B" |
72569
d56e4eeae967
mult_le_cancel_iff1, mult_le_cancel_iff2, mult_less_iff1 generalised from the real_ versions
paulson <lp15@cam.ac.uk>
parents:
72302
diff
changeset
|
2496 |
by (metis B(1) dist_norm mem_cball norm_minus_commute mult_le_cancel_iff1 z(1)) |
70620
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2497 |
also have "\<dots> \<le> e1" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2498 |
using e B unfolding less_divide_eq by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2499 |
finally have "x + g'(z - f x) \<in> T" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2500 |
by (metis add_diff_cancel diff_diff_add dist_norm e1(2) mem_cball norm_minus_commute subset_eq) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2501 |
then show "y \<in> f ` T" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2502 |
using z by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2503 |
qed (use e in auto) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2504 |
qed |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2505 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2506 |
text \<open>Hence the following eccentric variant of the inverse function theorem. |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2507 |
This has no continuity assumptions, but we do need the inverse function. |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2508 |
We could put \<open>f' \<circ> g = I\<close> but this happens to fit with the minimal linear |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2509 |
algebra theory I've set up so far.\<close> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2510 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2511 |
lemma has_derivative_inverse_strong: |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2512 |
fixes f :: "'n::euclidean_space \<Rightarrow> 'n" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2513 |
assumes "open S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2514 |
and "x \<in> S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2515 |
and contf: "continuous_on S f" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2516 |
and gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2517 |
and derf: "(f has_derivative f') (at x)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2518 |
and id: "f' \<circ> g' = id" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2519 |
shows "(g has_derivative g') (at (f x))" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2520 |
proof - |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2521 |
have linf: "bounded_linear f'" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2522 |
using derf unfolding has_derivative_def by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2523 |
then have ling: "bounded_linear g'" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2524 |
unfolding linear_conv_bounded_linear[symmetric] |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2525 |
using id right_inverse_linear by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2526 |
moreover have "g' \<circ> f' = id" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2527 |
using id linf ling |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2528 |
unfolding linear_conv_bounded_linear[symmetric] |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2529 |
using linear_inverse_left |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2530 |
by auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2531 |
moreover have *: "\<And>T. \<lbrakk>T \<subseteq> S; x \<in> interior T\<rbrakk> \<Longrightarrow> f x \<in> interior (f ` T)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2532 |
apply (rule sussmann_open_mapping) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2533 |
apply (rule assms ling)+ |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2534 |
apply auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2535 |
done |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2536 |
have "continuous (at (f x)) g" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2537 |
unfolding continuous_at Lim_at |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2538 |
proof (rule, rule) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2539 |
fix e :: real |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2540 |
assume "e > 0" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2541 |
then have "f x \<in> interior (f ` (ball x e \<inter> S))" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2542 |
using *[rule_format,of "ball x e \<inter> S"] \<open>x \<in> S\<close> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2543 |
by (auto simp add: interior_open[OF open_ball] interior_open[OF assms(1)]) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2544 |
then obtain d where d: "0 < d" "ball (f x) d \<subseteq> f ` (ball x e \<inter> S)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2545 |
unfolding mem_interior by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2546 |
show "\<exists>d>0. \<forall>y. 0 < dist y (f x) \<and> dist y (f x) < d \<longrightarrow> dist (g y) (g (f x)) < e" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2547 |
proof (intro exI allI impI conjI) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2548 |
fix y |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2549 |
assume "0 < dist y (f x) \<and> dist y (f x) < d" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2550 |
then have "g y \<in> g ` f ` (ball x e \<inter> S)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2551 |
by (metis d(2) dist_commute mem_ball rev_image_eqI subset_iff) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2552 |
then show "dist (g y) (g (f x)) < e" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2553 |
using gf[OF \<open>x \<in> S\<close>] |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2554 |
by (simp add: assms(4) dist_commute image_iff) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2555 |
qed (use d in auto) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2556 |
qed |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2557 |
moreover have "f x \<in> interior (f ` S)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2558 |
apply (rule sussmann_open_mapping) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2559 |
apply (rule assms ling)+ |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2560 |
using interior_open[OF assms(1)] and \<open>x \<in> S\<close> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2561 |
apply auto |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2562 |
done |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2563 |
moreover have "f (g y) = y" if "y \<in> interior (f ` S)" for y |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2564 |
by (metis gf imageE interiorE subsetD that) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2565 |
ultimately show ?thesis using assms |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2566 |
by (metis has_derivative_inverse_basic_x open_interior) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2567 |
qed |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2568 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2569 |
text \<open>A rewrite based on the other domain.\<close> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2570 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2571 |
lemma has_derivative_inverse_strong_x: |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2572 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2573 |
assumes "open S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2574 |
and "g y \<in> S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2575 |
and "continuous_on S f" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2576 |
and "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2577 |
and "(f has_derivative f') (at (g y))" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2578 |
and "f' \<circ> g' = id" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2579 |
and "f (g y) = y" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2580 |
shows "(g has_derivative g') (at y)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2581 |
using has_derivative_inverse_strong[OF assms(1-6)] |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2582 |
unfolding assms(7) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2583 |
by simp |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2584 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2585 |
text \<open>On a region.\<close> |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2586 |
|
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2587 |
theorem has_derivative_inverse_on: |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2588 |
fixes f :: "'n::euclidean_space \<Rightarrow> 'n" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2589 |
assumes "open S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2590 |
and derf: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f'(x)) (at x)" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2591 |
and "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2592 |
and "f' x \<circ> g' x = id" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2593 |
and "x \<in> S" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2594 |
shows "(g has_derivative g'(x)) (at (f x))" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2595 |
proof (rule has_derivative_inverse_strong[where g'="g' x" and f=f]) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2596 |
show "continuous_on S f" |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2597 |
unfolding continuous_on_eq_continuous_at[OF \<open>open S\<close>] |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2598 |
using derf has_derivative_continuous by blast |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2599 |
qed (use assms in auto) |
f95193669ad7
removed Brouwer_Fixpoint from imports of Derivative
immler
parents:
70136
diff
changeset
|
2600 |
|
34291
4e896680897e
finite annotation on cartesian product is now implicit.
hoelzl
parents:
34289
diff
changeset
|
2601 |
end |