author | paulson <lp15@cam.ac.uk> |
Thu, 16 Jun 2016 12:05:04 +0100 | |
changeset 63306 | 00090a0cd17f |
parent 63305 | 3b6975875633 |
child 63332 | f164526d8727 |
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 |
(* ========================================================================= *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
6 |
(* Results connected with topological dimension. *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
7 |
(* *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
8 |
(* 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
|
9 |
(* 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
|
10 |
(* 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
|
11 |
(* *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
12 |
(* 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
|
13 |
(* 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
|
14 |
(* 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
|
15 |
(* *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
16 |
(* (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
|
17 |
(* ========================================================================= *) |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
18 |
|
60420 | 19 |
section \<open>Results connected with topological dimension.\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
20 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
21 |
theory Brouwer_Fixpoint |
63129 | 22 |
imports Path_Connected Homeomorphism |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
23 |
begin |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
24 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
25 |
lemma bij_betw_singleton_eq: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
26 |
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
|
27 |
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
|
28 |
shows "f a = g a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
29 |
proof - |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
30 |
have "f ` (A - {a}) = g ` (A - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
31 |
by (intro image_cong) (simp_all add: eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
32 |
then have "B - {f a} = B - {g a}" |
60303 | 33 |
using f g a by (auto simp: bij_betw_def inj_on_image_set_diff set_eq_iff Diff_subset) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
34 |
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
|
35 |
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
|
36 |
ultimately show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
37 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
38 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
39 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
40 |
lemma swap_image: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
41 |
"Fun.swap i j f ` A = (if i \<in> A then (if j \<in> A then f ` A else f ` ((A - {i}) \<union> {j})) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
42 |
else (if j \<in> A then f ` ((A - {j}) \<union> {i}) else f ` A))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
43 |
apply (auto simp: Fun.swap_def image_iff) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
44 |
apply metis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
45 |
apply (metis member_remove remove_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
46 |
apply (metis member_remove remove_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
47 |
done |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
48 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
49 |
lemma swap_apply1: "Fun.swap x y f x = f y" |
56545 | 50 |
by (simp add: Fun.swap_def) |
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
|
51 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
52 |
lemma swap_apply2: "Fun.swap x y f y = f x" |
56545 | 53 |
by (simp add: Fun.swap_def) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
54 |
|
62061 | 55 |
lemma lessThan_empty_iff: "{..< n::nat} = {} \<longleftrightarrow> n = 0" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
56 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
57 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
58 |
lemma Zero_notin_Suc: "0 \<notin> Suc ` A" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
59 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
60 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
61 |
lemma atMost_Suc_eq_insert_0: "{.. Suc n} = insert 0 (Suc ` {.. n})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
62 |
apply auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
63 |
apply (case_tac x) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
64 |
apply auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
65 |
done |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
66 |
|
57418 | 67 |
lemma setsum_union_disjoint': |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
68 |
assumes "finite A" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
69 |
and "finite B" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
70 |
and "A \<inter> B = {}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
71 |
and "A \<union> B = C" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
72 |
shows "setsum g C = setsum g A + setsum g B" |
57418 | 73 |
using setsum.union_disjoint[OF assms(1-3)] and assms(4) by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
74 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
75 |
lemma pointwise_minimal_pointwise_maximal: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
76 |
fixes s :: "(nat \<Rightarrow> nat) set" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
77 |
assumes "finite s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
78 |
and "s \<noteq> {}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
79 |
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
|
80 |
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
|
81 |
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
|
82 |
using assms |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
83 |
proof (induct s rule: finite_ne_induct) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
84 |
case (insert b s) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
85 |
assume *: "\<forall>x\<in>insert b s. \<forall>y\<in>insert b s. x \<le> y \<or> y \<le> x" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
86 |
moreover 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" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
87 |
using insert by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
88 |
ultimately 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" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
89 |
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
|
90 |
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
|
91 |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
92 |
lemma brouwer_compactness_lemma: |
56226 | 93 |
fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector" |
53674 | 94 |
assumes "compact s" |
95 |
and "continuous_on s f" |
|
53688 | 96 |
and "\<not> (\<exists>x\<in>s. f x = 0)" |
53674 | 97 |
obtains d where "0 < d" and "\<forall>x\<in>s. d \<le> norm (f x)" |
53185 | 98 |
proof (cases "s = {}") |
53674 | 99 |
case True |
53688 | 100 |
show thesis |
101 |
by (rule that [of 1]) (auto simp: True) |
|
53674 | 102 |
next |
49374 | 103 |
case False |
104 |
have "continuous_on s (norm \<circ> f)" |
|
56371
fb9ae0727548
extend continuous_intros; remove continuous_on_intros and isCont_intros
hoelzl
parents:
56273
diff
changeset
|
105 |
by (rule continuous_intros continuous_on_norm assms(2))+ |
53674 | 106 |
with False obtain x where x: "x \<in> s" "\<forall>y\<in>s. (norm \<circ> f) x \<le> (norm \<circ> f) y" |
107 |
using continuous_attains_inf[OF assms(1), of "norm \<circ> f"] |
|
108 |
unfolding o_def |
|
109 |
by auto |
|
110 |
have "(norm \<circ> f) x > 0" |
|
111 |
using assms(3) and x(1) |
|
112 |
by auto |
|
113 |
then show ?thesis |
|
114 |
by (rule that) (insert x(2), auto simp: o_def) |
|
49555 | 115 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
116 |
|
49555 | 117 |
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
|
118 |
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
|
119 |
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
|
120 |
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
|
121 |
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
|
122 |
(\<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
|
123 |
(\<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
|
124 |
(\<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
|
125 |
(\<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 | 126 |
proof - |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
127 |
{ fix x i |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
128 |
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
|
129 |
(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
|
130 |
(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
|
131 |
(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
|
132 |
{ 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
|
133 |
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
|
134 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
135 |
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
|
136 |
by (subst choice_iff[symmetric])+ blast |
49374 | 137 |
qed |
138 |
||
53185 | 139 |
|
60420 | 140 |
subsection \<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
|
141 |
|
53252 | 142 |
lemma kuhn_counting_lemma: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
143 |
fixes bnd compo compo' face S F |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
144 |
defines "nF s == card {f\<in>F. face f s \<and> compo' f}" |
61808 | 145 |
assumes [simp, intro]: "finite F" \<comment> "faces" and [simp, intro]: "finite S" \<comment> "simplices" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
146 |
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
|
147 |
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
|
148 |
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
|
149 |
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
|
150 |
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
|
151 |
shows "odd (card {s\<in>S. compo s})" |
53185 | 152 |
proof - |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
153 |
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)" |
57418 | 154 |
by (subst setsum.union_disjoint[symmetric]) (auto intro!: setsum.cong) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
155 |
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
|
156 |
(\<Sum>s\<in>S. card {f \<in> {f\<in>F. compo' f \<and> \<not> bnd f}. face f s})" |
57418 | 157 |
unfolding setsum.distrib[symmetric] |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
158 |
by (subst card_Un_disjoint[symmetric]) |
57418 | 159 |
(auto simp: nF_def intro!: setsum.cong arg_cong[where f=card]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
160 |
also have "\<dots> = 1 * card {f\<in>F. compo' f \<and> bnd f} + 2 * card {f\<in>F. compo' f \<and> \<not> bnd f}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
161 |
using assms(4,5) by (fastforce intro!: arg_cong2[where f="op +"] setsum_multicount) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
162 |
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
|
163 |
using assms(6,8) by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
164 |
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
|
165 |
(\<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)" |
57418 | 166 |
using assms(7) by (subst setsum.union_disjoint[symmetric]) (fastforce intro!: setsum.cong)+ |
53688 | 167 |
ultimately show ?thesis |
168 |
by auto |
|
53186 | 169 |
qed |
170 |
||
60420 | 171 |
subsection \<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
|
172 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
173 |
lemma kuhn_complete_lemma: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
174 |
assumes [simp]: "finite simplices" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
175 |
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
|
176 |
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
|
177 |
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
|
178 |
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
|
179 |
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
|
180 |
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
|
181 |
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
|
182 |
proof (rule kuhn_counting_lemma) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
183 |
have finite_s[simp]: "\<And>s. s \<in> simplices \<Longrightarrow> finite s" |
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
|
184 |
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
|
185 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
186 |
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
|
187 |
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
|
188 |
by (auto simp: face) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
189 |
show "finite ?F" |
60420 | 190 |
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
|
191 |
|
60421 | 192 |
show "card {s \<in> simplices. face f s} = 1" if "f \<in> ?F" "bnd f" for f |
60449 | 193 |
using bnd that by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
194 |
|
60421 | 195 |
show "card {s \<in> simplices. face f s} = 2" if "f \<in> ?F" "\<not> bnd f" for f |
60449 | 196 |
using nbnd that by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
197 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
198 |
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
|
199 |
using odd_card by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
200 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
201 |
fix s assume s[simp]: "s \<in> simplices" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
202 |
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
|
203 |
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
|
204 |
using s by (fastforce simp: face) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
205 |
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
|
206 |
by (auto intro!: card_image inj_onI) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
207 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
208 |
{ assume rl: "rl ` s = {..Suc n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
209 |
then have inj_rl: "inj_on rl s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
210 |
by (intro eq_card_imp_inj_on) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
211 |
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
|
212 |
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
|
213 |
ultimately have n: "{..n} = rl ` (s - {a})" |
60303 | 214 |
by (auto simp add: inj_on_image_set_diff Diff_subset rl) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
215 |
have "{a\<in>s. rl ` (s - {a}) = {..n}} = {a}" |
60420 | 216 |
using inj_rl \<open>a \<in> s\<close> by (auto simp add: n inj_on_image_eq_iff[OF inj_rl] Diff_subset) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
217 |
then show "card ?S = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
218 |
unfolding card_S by simp } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
219 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
220 |
{ assume rl: "rl ` s \<noteq> {..Suc n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
221 |
show "card ?S = 0 \<or> card ?S = 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
222 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
223 |
assume *: "{..n} \<subseteq> rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
224 |
with rl rl_bd[OF s] have rl_s: "rl ` s = {..n}" |
62390 | 225 |
by (auto simp add: 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
|
226 |
then have "\<not> inj_on rl s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
227 |
by (intro pigeonhole) simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
228 |
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
|
229 |
by (auto simp: inj_on_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
230 |
then have eq: "rl ` (s - {a}) = rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
231 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
232 |
with ab have inj: "inj_on rl (s - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
233 |
by (intro eq_card_imp_inj_on) (auto simp add: rl_s card_Diff_singleton_if) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
234 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
235 |
{ 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
|
236 |
then have "rl ` s - {rl x} = rl ` ((s - {a}) - {x})" |
60303 | 237 |
by (auto simp: eq Diff_subset inj_on_image_set_diff[OF inj]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
238 |
also have "\<dots> = rl ` (s - {x})" |
60420 | 239 |
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
|
240 |
also assume "\<dots> = rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
241 |
finally have False |
60420 | 242 |
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
|
243 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
244 |
{ 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
|
245 |
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
|
246 |
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
|
247 |
unfolding rl_s[symmetric] by fastforce |
60420 | 248 |
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
|
249 |
unfolding card_S by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
250 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
251 |
assume "\<not> {..n} \<subseteq> rl ` s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
252 |
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
|
253 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
254 |
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
|
255 |
unfolding card_S by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
256 |
qed } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
257 |
qed fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
258 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
259 |
locale kuhn_simplex = |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
260 |
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
|
261 |
assumes base: "base \<in> {..< n} \<rightarrow> {..< p}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
262 |
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
|
263 |
assumes upd: "bij_betw upd {..< n} {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
264 |
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
|
265 |
begin |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
266 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
267 |
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
|
268 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
269 |
lemma s_eq: "s = enum ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
270 |
unfolding s_pre enum_def[abs_def] .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
271 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
272 |
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
|
273 |
using upd by (auto dest!: bij_betwE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
274 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
275 |
lemma s_space: "s \<subseteq> {..< n} \<rightarrow> {.. p}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
276 |
proof - |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
277 |
{ 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
|
278 |
proof (induct i) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
279 |
case 0 then show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
280 |
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
|
281 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
282 |
case (Suc i) with base show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
283 |
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
|
284 |
qed } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
285 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
286 |
by (auto simp: s_eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
287 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
288 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
289 |
lemma inj_upd: "inj_on upd {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
290 |
using upd by (simp add: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
291 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
292 |
lemma inj_enum: "inj_on enum {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
293 |
proof - |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
294 |
{ 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
|
295 |
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
|
296 |
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
|
297 |
then have "enum x \<noteq> enum y" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
298 |
by (auto simp add: enum_def fun_eq_iff) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
299 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
300 |
by (auto simp: inj_on_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
301 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
302 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
303 |
lemma enum_0: "enum 0 = base" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
304 |
by (simp add: enum_def[abs_def]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
305 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
306 |
lemma base_in_s: "base \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
307 |
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
|
308 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
309 |
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
|
310 |
unfolding s_eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
311 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
312 |
lemma one_step: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
313 |
assumes a: "a \<in> s" "j < n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
314 |
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
|
315 |
shows "a j \<noteq> p'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
316 |
proof |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
317 |
assume "a j = p'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
318 |
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
|
319 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
320 |
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
|
321 |
unfolding s_eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
322 |
from this[of 0] this[of n] have "j \<notin> upd ` {..< n}" |
62390 | 323 |
by (auto simp: enum_def fun_eq_iff split: if_split_asm) |
60420 | 324 |
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
|
325 |
by (auto simp: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
326 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
327 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
328 |
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
|
329 |
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
|
330 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
331 |
lemma upd_surj: "upd ` {..< n} = {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
332 |
using upd by (auto simp: bij_betw_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
333 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
334 |
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
|
335 |
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
|
336 |
by (auto simp: bij_betw_def) |
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 |
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
|
339 |
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
|
340 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
341 |
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
|
342 |
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
|
343 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
344 |
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
|
345 |
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
|
346 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
347 |
lemma enum_strict_mono: "i \<le> n \<Longrightarrow> j \<le> n \<Longrightarrow> enum i < enum j \<longleftrightarrow> i < j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
348 |
using enum_mono[of i j] enum_inj[of i j] by (auto simp add: le_less) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
349 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
350 |
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
|
351 |
by (auto simp: s_eq enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
352 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
353 |
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
|
354 |
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
|
355 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
356 |
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
|
357 |
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
|
358 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
359 |
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
|
360 |
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
|
361 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
362 |
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
|
363 |
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
|
364 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
365 |
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
|
366 |
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
|
367 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
368 |
lemma out_eq_p: "a \<in> s \<Longrightarrow> n \<le> j \<Longrightarrow> a j = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
369 |
unfolding s_eq by (auto simp add: enum_eq_p) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
370 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
371 |
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
|
372 |
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
|
373 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
374 |
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
|
375 |
unfolding s_eq by (auto simp: enum_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
376 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
377 |
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
|
378 |
unfolding s_eq by (auto simp: enum_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
379 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
380 |
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
|
381 |
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
|
382 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
383 |
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
|
384 |
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
|
385 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
386 |
lemma ksimplex_0: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
387 |
"n = 0 \<Longrightarrow> s = {(\<lambda>x. p)}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
388 |
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
|
389 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
390 |
lemma replace_0: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
391 |
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
|
392 |
shows "x \<le> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
393 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
394 |
assume "x \<noteq> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
395 |
have "a j \<noteq> 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
396 |
using assms by (intro one_step[where a=a]) auto |
60420 | 397 |
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
|
398 |
show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
399 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
400 |
qed simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
401 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
402 |
lemma replace_1: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
403 |
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
|
404 |
shows "a \<le> x" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
405 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
406 |
assume "x \<noteq> a" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
407 |
have "a j \<noteq> p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
408 |
using assms by (intro one_step[where a=a]) auto |
60420 | 409 |
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
|
410 |
have "a j < p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
411 |
by (auto simp: less_le s_eq) |
60420 | 412 |
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
|
413 |
show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
414 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
415 |
qed simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
416 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
417 |
end |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
418 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
419 |
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
|
420 |
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
|
421 |
begin |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
422 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
423 |
lemma enum_eq: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
424 |
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
|
425 |
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
|
426 |
shows "s.enum l = t.enum (l + d)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
427 |
using l proof (induct l rule: dec_induct) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
428 |
case base |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
429 |
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
|
430 |
using eq by auto |
60420 | 431 |
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
|
432 |
by (auto simp: s.enum_mono) |
60420 | 433 |
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
|
434 |
by (auto simp: t.enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
435 |
ultimately show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
436 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
437 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
438 |
case (step l) |
60420 | 439 |
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
|
440 |
"s.enum l < s.enum (Suc l)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
441 |
"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
|
442 |
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
|
443 |
moreover have |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
444 |
"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
|
445 |
"t.enum (Suc l + d) \<in> s.enum ` {i .. j}" |
60420 | 446 |
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
|
447 |
ultimately have "s.enum (Suc l) = t.enum (Suc (l + d))" |
60420 | 448 |
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
|
449 |
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
|
450 |
(auto intro!: s.enum_in t.enum_in) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
451 |
then show ?case by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
452 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
453 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
454 |
lemma ksimplex_eq_bot: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
455 |
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
|
456 |
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
|
457 |
assumes eq: "s - {a} = t - {b}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
458 |
shows "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
459 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
460 |
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
|
461 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
462 |
assume "n \<noteq> 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
463 |
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
|
464 |
"t.enum 0 = (t.enum (Suc 0)) (u_t 0 := t.enum (Suc 0) (u_t 0) - 1)" |
60420 | 465 |
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
|
466 |
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
|
467 |
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
|
468 |
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
|
469 |
{ 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
|
470 |
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
|
471 |
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
|
472 |
ultimately have "s.enum j = t.enum j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
473 |
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
|
474 |
note enum_eq = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
475 |
then have "s.enum (Suc 0) = t.enum (Suc 0)" |
60420 | 476 |
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
|
477 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
478 |
{ fix j assume "Suc j < n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
479 |
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
|
480 |
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
|
481 |
using s.enum_Suc[of "Suc j"] t.enum_Suc[of "Suc j"] |
62390 | 482 |
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
|
483 |
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
|
484 |
by (auto simp: gr0_conv_Suc) |
60420 | 485 |
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
|
486 |
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
|
487 |
ultimately have "a = b" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
488 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
489 |
with assms show "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
490 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
491 |
qed |
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 ksimplex_eq_top: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
494 |
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
|
495 |
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
|
496 |
assumes eq: "s - {a} = t - {b}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
497 |
shows "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
498 |
proof (cases n) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
499 |
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
|
500 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
501 |
case (Suc n') |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
502 |
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
|
503 |
"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
|
504 |
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
|
505 |
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
|
506 |
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
|
507 |
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
|
508 |
{ fix j assume "j < n" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
509 |
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
|
510 |
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
|
511 |
ultimately have "s.enum j = t.enum j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
512 |
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
|
513 |
note enum_eq = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
514 |
then have "s.enum n' = t.enum n'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
515 |
using Suc by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
516 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
517 |
{ fix j assume "j < n'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
518 |
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
|
519 |
have "u_s j = u_t j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
520 |
using s.enum_Suc[of j] t.enum_Suc[of j] |
62390 | 521 |
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
|
522 |
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
|
523 |
by (auto simp: gr0_conv_Suc) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
524 |
then have "u_t n' = u_s n'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
525 |
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
|
526 |
ultimately have "a = b" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
527 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
528 |
with assms show "s = t" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
529 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
530 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
531 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
532 |
end |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
533 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
534 |
inductive ksimplex for p n :: nat where |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
535 |
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
|
536 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
537 |
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
|
538 |
proof (rule finite_subset) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
539 |
{ 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
|
540 |
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
|
541 |
then interpret kuhn_simplex p n b u s . |
60420 | 542 |
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
|
543 |
have "a \<in> (\<lambda>f x. if n \<le> x then p else f x) ` ({..< n} \<rightarrow>\<^sub>E {.. p})" |
62390 | 544 |
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
|
545 |
intro!: bexI[of _ "restrict a {..< n}"]) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
546 |
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
|
547 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
548 |
qed (simp add: finite_PiE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
549 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
550 |
lemma ksimplex_card: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
551 |
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
|
552 |
using assms proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
553 |
case (ksimplex u b) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
554 |
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
|
555 |
show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
556 |
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
|
557 |
qed |
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 |
lemma simplex_top_face: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
560 |
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
|
561 |
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
|
562 |
using assms |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
563 |
proof safe |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
564 |
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
|
565 |
then show "ksimplex p n (s - {a})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
566 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
567 |
case (ksimplex base upd) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
568 |
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
|
569 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
570 |
have "a n < p" |
60420 | 571 |
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
|
572 |
then have "a = enum 0" |
60420 | 573 |
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
|
574 |
then have s_eq: "s - {a} = enum ` Suc ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
575 |
using s_eq by (simp add: atMost_Suc_eq_insert_0 insert_ident Zero_notin_Suc in_enum_image subset_eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
576 |
then have "enum 1 \<in> s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
577 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
578 |
then have "upd 0 = n" |
60420 | 579 |
using \<open>a n < p\<close> \<open>a = enum 0\<close> na[rule_format, of "enum 1"] |
62390 | 580 |
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
|
581 |
then have "bij_betw upd (Suc ` {..< n}) {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
582 |
using upd |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
583 |
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
|
584 |
(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
|
585 |
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
|
586 |
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
|
587 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
588 |
have "a n = p - 1" |
60420 | 589 |
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
|
590 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
591 |
show ?thesis |
61169 | 592 |
proof (rule ksimplex.intros, standard) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
593 |
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
|
594 |
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
|
595 |
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
|
596 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
597 |
have "\<And>i. Suc ` {..< i} = {..< Suc i} - {0}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
598 |
by (auto simp: image_iff Ball_def) arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
599 |
then have upd_Suc: "\<And>i. i \<le> n \<Longrightarrow> (upd\<circ>Suc) ` {..< i} = upd ` {..< Suc i} - {n}" |
60420 | 600 |
using \<open>upd 0 = n\<close> upd_inj |
60303 | 601 |
by (auto simp add: image_comp[symmetric] inj_on_image_set_diff[OF inj_upd]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
602 |
have n_in_upd: "\<And>i. n \<in> upd ` {..< Suc i}" |
60420 | 603 |
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
|
604 |
|
63040 | 605 |
define f' where "f' i j = |
606 |
(if j \<in> (upd\<circ>Suc)`{..< i} then Suc ((base(n := p)) j) else (base(n := p)) j)" for i j |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
607 |
{ fix x i assume i[arith]: "i \<le> n" then have "enum (Suc i) x = f' i x" |
60420 | 608 |
unfolding f'_def enum_def using \<open>a n < p\<close> \<open>a = enum 0\<close> \<open>upd 0 = n\<close> \<open>a n = p - 1\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
609 |
by (simp add: upd_Suc enum_0 n_in_upd) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
610 |
then show "s - {a} = f' ` {.. n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
611 |
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
|
612 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
613 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
614 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
615 |
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
|
616 |
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
|
617 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
618 |
case (ksimplex base upd) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
619 |
then interpret kuhn_simplex p n base upd s' . |
63040 | 620 |
define b where "b = base (n := p - 1)" |
621 |
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
|
622 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
623 |
have "ksimplex p (Suc n) (s' \<union> {b})" |
61169 | 624 |
proof (rule ksimplex.intros, standard) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
625 |
show "b \<in> {..<Suc n} \<rightarrow> {..<p}" |
60420 | 626 |
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
|
627 |
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
|
628 |
using base_out by (auto simp: b_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
629 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
630 |
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
|
631 |
using upd |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
632 |
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
|
633 |
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
|
634 |
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
|
635 |
|
63040 | 636 |
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
|
637 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
638 |
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
|
639 |
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
|
640 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
641 |
{ 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
|
642 |
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
|
643 |
note n_not_upd = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
644 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
645 |
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
|
646 |
unfolding atMost_Suc_eq_insert_0 by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
647 |
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
|
648 |
by (auto simp: f'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
649 |
also have "(f' \<circ> Suc) ` {.. n} = s'" |
60420 | 650 |
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
|
651 |
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
|
652 |
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
|
653 |
finally show "s' \<union> {b} = f' ` {.. Suc n}" .. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
654 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
655 |
moreover have "b \<notin> s'" |
60420 | 656 |
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
|
657 |
ultimately show ?thesis by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
658 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
659 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
660 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
661 |
lemma ksimplex_replace_0: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
662 |
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
|
663 |
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
|
664 |
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
|
665 |
using s |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
666 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
667 |
case (ksimplex b_s u_s) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
668 |
|
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
|
669 |
{ 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
|
670 |
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
|
671 |
by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
672 |
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
|
673 |
by intro_locales fact+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
674 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
675 |
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
|
676 |
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
|
677 |
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
|
678 |
then have "{s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = {s}" |
60420 | 679 |
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
|
680 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
681 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
682 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
683 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
684 |
lemma ksimplex_replace_1: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
685 |
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
|
686 |
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
|
687 |
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
|
688 |
using s |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
689 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
690 |
case (ksimplex b_s u_s) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
691 |
|
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
|
692 |
{ 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
|
693 |
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
|
694 |
by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
695 |
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
|
696 |
by intro_locales fact+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
697 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
698 |
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
|
699 |
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
|
700 |
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
|
701 |
then have "{s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = {s}" |
60420 | 702 |
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
|
703 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
704 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
705 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
706 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
707 |
lemma card_2_exists: "card s = 2 \<longleftrightarrow> (\<exists>x\<in>s. \<exists>y\<in>s. x \<noteq> y \<and> (\<forall>z\<in>s. z = x \<or> z = y))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
708 |
by (auto simp add: card_Suc_eq eval_nat_numeral) |
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 |
lemma ksimplex_replace_2: |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
711 |
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
|
712 |
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
|
713 |
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
|
714 |
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
|
715 |
using s |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
716 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
717 |
case (ksimplex base upd) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
718 |
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
|
719 |
|
60420 | 720 |
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
|
721 |
unfolding s_eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
722 |
|
60420 | 723 |
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
|
724 |
by linarith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
725 |
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
|
726 |
proof (elim disjE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
727 |
assume "i = 0" |
63040 | 728 |
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
|
729 |
let ?upd = "upd \<circ> rot" |
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 |
have rot: "bij_betw rot {..< n} {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
732 |
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
|
733 |
arith+ |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
734 |
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
|
735 |
by (rule bij_betw_trans) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
736 |
|
63040 | 737 |
define f' where [abs_def]: "f' i j = |
738 |
(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
|
739 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
740 |
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
|
741 |
proof |
60420 | 742 |
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
|
743 |
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
|
744 |
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
|
745 |
then have "enum 1 \<le> enum i'" "enum i' (upd 0) < p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
746 |
using enum_le_p[of i' "upd 0"] by (auto simp add: enum_inj enum_mono upd_space) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
747 |
then have "enum 1 (upd 0) < p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
748 |
by (auto simp add: le_fun_def intro: le_less_trans) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
749 |
then show "enum (Suc 0) \<in> {..<n} \<rightarrow> {..<p}" |
60420 | 750 |
using base \<open>n \<noteq> 0\<close> by (auto simp add: 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
|
751 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
752 |
{ fix i assume "n \<le> i" then show "enum (Suc 0) i = p" |
60420 | 753 |
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
|
754 |
show "bij_betw ?upd {..<n} {..<n}" by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
755 |
qed (simp add: f'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
756 |
have ks_f': "ksimplex p n (f' ` {.. n})" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
757 |
by rule unfold_locales |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
758 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
759 |
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
|
760 |
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
|
761 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
762 |
have [simp]: "\<And>j. j < n \<Longrightarrow> rot ` {..< j} = {0 <..< Suc j}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
763 |
by (auto simp: rot_def image_iff Ball_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
764 |
arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
765 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
766 |
{ fix j assume j: "j < n" |
60420 | 767 |
from j \<open>n \<noteq> 0\<close> have "f' j = enum (Suc j)" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
768 |
by (auto simp add: f'_def enum_def upd_inj in_upd_image image_comp[symmetric] fun_eq_iff) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
769 |
note f'_eq_enum = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
770 |
then have "enum ` Suc ` {..< n} = f' ` {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
771 |
by (force simp: enum_inj) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
772 |
also have "Suc ` {..< n} = {.. n} - {0}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
773 |
by (auto simp: image_iff Ball_def) arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
774 |
also have "{..< n} = {.. n} - {n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
775 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
776 |
finally have eq: "s - {a} = f' ` {.. n} - {f' n}" |
60420 | 777 |
unfolding s_eq \<open>a = enum i\<close> \<open>i = 0\<close> |
60303 | 778 |
by (simp add: Diff_subset 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
|
779 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
780 |
have "enum 0 < f' 0" |
60420 | 781 |
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
|
782 |
also have "\<dots> < f' n" |
60420 | 783 |
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
|
784 |
finally have "a \<noteq> f' n" |
60420 | 785 |
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
|
786 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
787 |
{ 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
|
788 |
obtain b u where "kuhn_simplex p n b u t" |
60420 | 789 |
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
|
790 |
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
|
791 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
792 |
{ 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
|
793 |
then have "x (upd 0) = enum (Suc 0) (upd 0)" |
60420 | 794 |
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
|
795 |
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
|
796 |
unfolding eq_sma[symmetric] by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
797 |
then have "c (upd 0) \<noteq> enum (Suc 0) (upd 0)" |
60420 | 798 |
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
|
799 |
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
|
800 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
801 |
then have "t = s \<or> t = f' ` {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
802 |
proof (elim disjE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
803 |
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
|
804 |
interpret st: kuhn_simplex_pair p n base upd s b u t .. |
60420 | 805 |
{ 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
|
806 |
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
|
807 |
note top = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
808 |
have "s = t" |
60420 | 809 |
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
|
810 |
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
|
811 |
(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
|
812 |
then show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
813 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
814 |
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
|
815 |
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
|
816 |
have eq: "f' ` {..n} - {f' n} = t - {c}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
817 |
using eq_sma eq by simp |
60420 | 818 |
{ 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
|
819 |
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
|
820 |
note top = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
821 |
have "f' ` {..n} = t" |
60420 | 822 |
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
|
823 |
by (intro st.ksimplex_eq_top[OF _ _ _ _ eq]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
824 |
(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
|
825 |
then show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
826 |
qed } |
60420 | 827 |
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
|
828 |
apply (intro ex1I[of _ "f' ` {.. n}"]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
829 |
apply auto [] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
830 |
apply metis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
831 |
done |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
832 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
833 |
assume "i = n" |
60420 | 834 |
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
|
835 |
by (cases n) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
836 |
|
63040 | 837 |
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
|
838 |
let ?upd = "upd \<circ> rot" |
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 |
have rot: "bij_betw rot {..< n} {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
841 |
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
|
842 |
arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
843 |
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
|
844 |
by (rule bij_betw_trans) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
845 |
|
63040 | 846 |
define b where "b = base (upd n' := base (upd n') - 1)" |
847 |
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
|
848 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
849 |
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
|
850 |
proof |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
851 |
{ 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
|
852 |
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
|
853 |
show "b \<in> {..<n} \<rightarrow> {..<p}" |
60420 | 854 |
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
|
855 |
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
|
856 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
857 |
show "bij_betw ?upd {..<n} {..<n}" by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
858 |
qed (simp add: f'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
859 |
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
|
860 |
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
|
861 |
unfolding f' by rule unfold_locales |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
862 |
|
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
|
863 |
have "0 < n" |
60420 | 864 |
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
|
865 |
|
60420 | 866 |
{ 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
|
867 |
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
|
868 |
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
|
869 |
moreover have "enum i' (upd n') = base (upd n')" |
60420 | 870 |
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
|
871 |
ultimately have "0 < base (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
872 |
by auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
873 |
then have benum1: "b.enum (Suc 0) = base" |
60420 | 874 |
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
|
875 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
876 |
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
|
877 |
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
|
878 |
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
|
879 |
by (simp_all add: rot_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
880 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
881 |
{ fix j assume j: "Suc j \<le> n" then have "b.enum (Suc j) = enum j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
882 |
by (induct j) (auto simp add: benum1 enum_0 b.enum_Suc enum_Suc rot_simps) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
883 |
note b_enum_eq_enum = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
884 |
then have "enum ` {..< n} = b.enum ` Suc ` {..< n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
885 |
by (auto simp add: image_comp intro!: image_cong) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
886 |
also have "Suc ` {..< n} = {.. n} - {0}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
887 |
by (auto simp: image_iff Ball_def) arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
888 |
also have "{..< n} = {.. n} - {n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
889 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
890 |
finally have eq: "s - {a} = b.enum ` {.. n} - {b.enum 0}" |
60420 | 891 |
unfolding s_eq \<open>a = enum i\<close> \<open>i = n\<close> |
60303 | 892 |
using inj_on_image_set_diff[OF inj_enum Diff_subset, of "{n}"] |
893 |
inj_on_image_set_diff[OF b.inj_enum Diff_subset, of "{0}"] |
|
894 |
by (simp add: comp_def ) |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
895 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
896 |
have "b.enum 0 \<le> b.enum n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
897 |
by (simp add: b.enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
898 |
also have "b.enum n < enum n" |
60420 | 899 |
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
|
900 |
finally have "a \<noteq> b.enum 0" |
60420 | 901 |
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
|
902 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
903 |
{ 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
|
904 |
obtain b' u where "kuhn_simplex p n b' u t" |
60420 | 905 |
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
|
906 |
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
|
907 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
908 |
{ 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
|
909 |
then have "x (upd n') = enum n' (upd n')" |
60420 | 910 |
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
|
911 |
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
|
912 |
unfolding eq_sma[symmetric] by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
913 |
then have "c (upd n') \<noteq> enum n' (upd n')" |
60420 | 914 |
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
|
915 |
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
|
916 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
917 |
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
|
918 |
proof (elim disjE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
919 |
assume *: "c (upd n') > enum n' (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
920 |
interpret st: kuhn_simplex_pair p n base upd s b' u t .. |
60420 | 921 |
{ 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
|
922 |
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
|
923 |
note top = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
924 |
have "s = t" |
60420 | 925 |
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
|
926 |
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
|
927 |
(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
|
928 |
then show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
929 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
930 |
assume *: "c (upd n') < enum n' (upd n')" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
931 |
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
|
932 |
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
|
933 |
using eq_sma eq f' by simp |
60420 | 934 |
{ 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
|
935 |
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
|
936 |
note bot = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
937 |
have "f' ` {..n} = t" |
60420 | 938 |
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
|
939 |
by (intro st.ksimplex_eq_bot[OF _ _ _ _ eq]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
940 |
(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
|
941 |
with f' show ?thesis by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
942 |
qed } |
60420 | 943 |
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
|
944 |
apply (intro ex1I[of _ "b.enum ` {.. n}"]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
945 |
apply auto [] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
946 |
apply metis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
947 |
done |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
948 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
949 |
assume i: "0 < i" "i < n" |
63040 | 950 |
define i' where "i' = i - 1" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
951 |
with i have "Suc i' < n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
952 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
953 |
with i have Suc_i': "Suc i' = i" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
954 |
by (simp add: i'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
955 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
956 |
let ?upd = "Fun.swap i' i upd" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
957 |
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
|
958 |
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
|
959 |
|
63040 | 960 |
define f' where [abs_def]: "f' i j = (if j \<in> ?upd`{..< i} then Suc (base j) else base j)" |
961 |
for i j |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
962 |
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
|
963 |
proof |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
964 |
show "base \<in> {..<n} \<rightarrow> {..<p}" by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
965 |
{ fix i assume "n \<le> i" then show "base i = p" by fact } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
966 |
show "bij_betw ?upd {..<n} {..<n}" by fact |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
967 |
qed (simp add: f'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
968 |
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
|
969 |
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
|
970 |
unfolding f' by rule unfold_locales |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
971 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
972 |
have "{i} \<subseteq> {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
973 |
using i by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
974 |
{ fix j assume "j \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
975 |
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
|
976 |
moreover note i |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
977 |
ultimately have "enum j = b.enum j \<longleftrightarrow> j \<noteq> i" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
978 |
unfolding enum_def[abs_def] b.enum_def[abs_def] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
979 |
by (auto simp add: fun_eq_iff swap_image i'_def |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
980 |
in_upd_image inj_on_image_set_diff[OF inj_upd]) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
981 |
note enum_eq_benum = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
982 |
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
|
983 |
by (intro image_cong) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
984 |
then have eq: "s - {a} = b.enum ` {.. n} - {b.enum i}" |
60420 | 985 |
unfolding s_eq \<open>a = enum i\<close> |
986 |
using inj_on_image_set_diff[OF inj_enum Diff_subset \<open>{i} \<subseteq> {..n}\<close>] |
|
987 |
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
|
988 |
by (simp add: comp_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
989 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
990 |
have "a \<noteq> b.enum i" |
60420 | 991 |
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
|
992 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
993 |
{ 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
|
994 |
obtain b' u where "kuhn_simplex p n b' u t" |
60420 | 995 |
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
|
996 |
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
|
997 |
have "enum i' \<in> s - {a}" "enum (i + 1) \<in> s - {a}" |
60420 | 998 |
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
|
999 |
then obtain l k where |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1000 |
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
|
1001 |
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
|
1002 |
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
|
1003 |
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
|
1004 |
by (simp add: enum_strict_mono i'_def) |
60420 | 1005 |
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
|
1006 |
by (simp add: t.enum_strict_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1007 |
{ assume "Suc l = k" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1008 |
have "enum (Suc (Suc i')) = t.enum (Suc l)" |
60420 | 1009 |
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
|
1010 |
then have False |
60420 | 1011 |
using \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close> |
62390 | 1012 |
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
|
1013 |
(metis Suc_lessD n_not_Suc_n upd_inj) } |
60420 | 1014 |
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
|
1015 |
by arith |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1016 |
have c_eq: "c = t.enum (Suc l)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1017 |
proof (rule ccontr) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1018 |
assume "c \<noteq> t.enum (Suc l)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1019 |
then have "t.enum (Suc l) \<in> s - {a}" |
60420 | 1020 |
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
|
1021 |
then obtain j where "t.enum (Suc l) = enum j" "j \<le> n" "enum j \<noteq> enum i" |
60420 | 1022 |
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
|
1023 |
with i have "t.enum (Suc l) \<le> t.enum l \<or> t.enum k \<le> t.enum (Suc l)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1024 |
by (auto simp add: i'_def enum_mono enum_inj l k) |
60420 | 1025 |
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
|
1026 |
by (simp add: t.enum_mono) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1027 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1028 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1029 |
{ have "t.enum (Suc (Suc l)) \<in> s - {a}" |
60420 | 1030 |
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
|
1031 |
then obtain j where eq: "t.enum (Suc (Suc l)) = enum j" and "j \<le> n" "j \<noteq> i" |
60420 | 1032 |
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
|
1033 |
moreover have "enum i' < t.enum (Suc (Suc l))" |
60420 | 1034 |
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
|
1035 |
ultimately have "i' < j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1036 |
using i by (simp add: enum_strict_mono i'_def) |
60420 | 1037 |
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
|
1038 |
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
|
1039 |
then have "k \<le> Suc (Suc l)" |
60420 | 1040 |
using \<open>k \<le> n\<close> \<open>Suc l < k\<close> by (simp add: t.enum_mono) } |
1041 |
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
|
1042 |
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
|
1043 |
using i by (simp add: k i'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1044 |
also have "\<dots> = (enum i') (u l := Suc (enum i' (u l)), u (Suc l) := Suc (enum i' (u (Suc l))))" |
60420 | 1045 |
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
|
1046 |
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
|
1047 |
(u l = upd (Suc i') \<and> u (Suc l) = upd i')" |
62390 | 1048 |
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
|
1049 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1050 |
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
|
1051 |
proof (elim disjE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1052 |
assume u: "u l = upd i'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1053 |
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
|
1054 |
also have "t.enum (Suc l) = enum (Suc i')" |
60420 | 1055 |
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
|
1056 |
also have "\<dots> = a" |
60420 | 1057 |
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
|
1058 |
finally show ?thesis |
60420 | 1059 |
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
|
1060 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1061 |
assume u: "u l = upd (Suc i')" |
63040 | 1062 |
define B where "B = b.enum ` {..n}" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1063 |
have "b.enum i' = enum i'" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1064 |
using enum_eq_benum[of i'] i by (auto simp add: i'_def gr0_conv_Suc) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1065 |
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
|
1066 |
also have "t.enum (Suc l) = b.enum (Suc i')" |
60420 | 1067 |
using u \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close> |
1068 |
by (simp_all add: enum_Suc t.enum_Suc l b.enum_Suc \<open>b.enum i' = enum i'\<close> swap_apply1) |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1069 |
(simp add: Suc_i') |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1070 |
also have "\<dots> = b.enum i" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1071 |
using i by (simp add: i'_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1072 |
finally have "c = b.enum i" . |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1073 |
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
|
1074 |
unfolding eq_sma[symmetric] eq B_def using i by auto |
60420 | 1075 |
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
|
1076 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1077 |
then show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1078 |
by (simp add: B_def) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1079 |
qed } |
60420 | 1080 |
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
|
1081 |
apply (intro ex1I[of _ "b.enum ` {.. n}"]) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1082 |
apply auto [] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1083 |
apply metis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1084 |
done |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1085 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1086 |
then show ?thesis |
60420 | 1087 |
using s \<open>a \<in> s\<close> by (simp add: card_2_exists Ex1_def) metis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1088 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1089 |
|
60420 | 1090 |
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
|
1091 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1092 |
lemma kuhn_simplex_lemma: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1093 |
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
|
1094 |
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
|
1095 |
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
|
1096 |
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
|
1097 |
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
|
1098 |
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
|
1099 |
safe del: notI) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1100 |
|
53186 | 1101 |
have *: "\<And>x y. x = y \<Longrightarrow> odd (card x) \<Longrightarrow> odd (card y)" |
1102 |
by auto |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1103 |
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
|
1104 |
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 | 1105 |
apply (rule *[OF _ assms(2)]) |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1106 |
apply (auto simp: atLeast0AtMost) |
53186 | 1107 |
done |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1108 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1109 |
next |
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 |
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
|
1112 |
then show "card s = n + 2" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1113 |
by (simp add: ksimplex_card) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1114 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1115 |
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
|
1116 |
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
|
1117 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1118 |
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
|
1119 |
{ 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
|
1120 |
with s a show "card ?S = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1121 |
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
|
1122 |
by (subst eq_commute) simp } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1123 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1124 |
{ 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
|
1125 |
with s a show "card ?S = 1" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1126 |
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
|
1127 |
by (subst eq_commute) simp } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1128 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1129 |
{ 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
|
1130 |
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
|
1131 |
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
|
1132 |
by (subst (asm) eq_commute) auto } |
53186 | 1133 |
qed |
1134 |
||
60420 | 1135 |
subsection \<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
|
1136 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1137 |
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
|
1138 |
|
53186 | 1139 |
lemma reduced_labelling: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1140 |
shows "reduced n x \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1141 |
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
|
1142 |
and "reduced n x = n \<or> x (reduced n x) \<noteq> 0" |
53186 | 1143 |
proof - |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1144 |
show "reduced n x \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1145 |
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
|
1146 |
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
|
1147 |
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
|
1148 |
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
|
1149 |
unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) fastforce+ |
53186 | 1150 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1151 |
|
53186 | 1152 |
lemma reduced_labelling_unique: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1153 |
"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
|
1154 |
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
|
1155 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1156 |
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
|
1157 |
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
|
1158 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1159 |
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
|
1160 |
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
|
1161 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1162 |
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
|
1163 |
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
|
1164 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1165 |
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
|
1166 |
using reduced_labelling[of "Suc n" x] |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1167 |
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
|
1168 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1169 |
lemma complete_face_top: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1170 |
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
|
1171 |
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
|
1172 |
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
|
1173 |
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
|
1174 |
proof (safe del: disjCI) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1175 |
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
|
1176 |
{ 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
|
1177 |
by (intro reduced_labelling_zero) auto } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1178 |
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
|
1179 |
using j eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1180 |
ultimately show "x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1181 |
by force |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1182 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1183 |
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
|
1184 |
have "j = n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1185 |
proof (rule ccontr) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1186 |
assume "\<not> ?thesis" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1187 |
{ fix x assume "x \<in> f" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1188 |
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
|
1189 |
by (intro reduced_labelling_nonzero) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1190 |
then have "reduced (Suc n) (lab x) \<noteq> n" |
60420 | 1191 |
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
|
1192 |
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
|
1193 |
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
|
1194 |
using eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1195 |
ultimately show False |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1196 |
by force |
53186 | 1197 |
qed |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1198 |
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
|
1199 |
using j eq by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1200 |
ultimately show "x n = p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1201 |
using j x by auto |
53688 | 1202 |
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
|
1203 |
|
60420 | 1204 |
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
|
1205 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1206 |
lemma kuhn_induction: |
53688 | 1207 |
assumes "0 < p" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1208 |
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
|
1209 |
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
|
1210 |
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
|
1211 |
shows "odd (card {s. ksimplex p (Suc n) s \<and> (reduced (Suc n)\<circ>lab) ` s = {..Suc n}})" |
53248 | 1212 |
proof - |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1213 |
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
|
1214 |
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
|
1215 |
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
|
1216 |
by (simp add: reduced_labelling subset_eq) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1217 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1218 |
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
|
1219 |
{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
|
1220 |
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
|
1221 |
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
|
1222 |
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
|
1223 |
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
|
1224 |
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
|
1225 |
by (auto simp: out_eq_p) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1226 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1227 |
{ fix x assume "x \<in> s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1228 |
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
|
1229 |
have "?rl x \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1230 |
by (auto intro!: reduced_labelling_nonzero) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1231 |
then have "?rl x = reduced n (lab x)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1232 |
by (auto intro!: reduced_labelling_Suc) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1233 |
then have "?rl ` s = {..n}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1234 |
using rl by (simp cong: image_cong) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1235 |
moreover |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1236 |
obtain t a where "ksimplex p (Suc n) t" "a \<in> t" "s = t - {a}" |
60420 | 1237 |
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
|
1238 |
ultimately |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1239 |
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 | 1240 |
by auto |
53248 | 1241 |
next |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1242 |
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
|
1243 |
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
|
1244 |
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
|
1245 |
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
|
1246 |
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
|
1247 |
by (auto simp: out_eq_p) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1248 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1249 |
{ fix x assume "x \<in> s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1250 |
then have "?rl x \<in> ?rl ` (s - {a})" |
53248 | 1251 |
by auto |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1252 |
then have "?rl x \<le> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1253 |
unfolding rl by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1254 |
then have "?rl x = reduced n (lab x)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1255 |
by (auto intro!: reduced_labelling_Suc) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1256 |
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
|
1257 |
unfolding rl[symmetric] by (intro image_cong) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1258 |
|
60420 | 1259 |
from \<open>?ext (s - {a})\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1260 |
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
|
1261 |
proof (elim disjE exE conjE) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1262 |
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
|
1263 |
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
|
1264 |
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
|
1265 |
by (intro reduced_labelling_zero) auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1266 |
moreover have "j \<in> ?rl ` (s - {a})" |
60420 | 1267 |
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
|
1268 |
ultimately show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1269 |
by force |
53248 | 1270 |
next |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1271 |
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
|
1272 |
show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1273 |
proof cases |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1274 |
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
|
1275 |
next |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1276 |
assume "j \<noteq> n" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1277 |
{ fix x assume x: "x \<in> s - {a}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1278 |
have "reduced n (lab x) \<le> j" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1279 |
proof (rule reduced_labelling_nonzero) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1280 |
show "lab x j \<noteq> 0" |
60420 | 1281 |
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
|
1282 |
show "j < n" |
60420 | 1283 |
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
|
1284 |
qed |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1285 |
then have "reduced n (lab x) \<noteq> n" |
60420 | 1286 |
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
|
1287 |
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
|
1288 |
unfolding rl' by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1289 |
ultimately show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1290 |
by force |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1291 |
qed |
53248 | 1292 |
qed |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1293 |
show "ksimplex p n (s - {a})" |
60420 | 1294 |
unfolding simplex_top_face[OF \<open>0 < p\<close> all_eq_p] using s a by auto |
53248 | 1295 |
qed |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1296 |
ultimately show ?thesis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1297 |
using assms by (intro kuhn_simplex_lemma) auto |
53248 | 1298 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1299 |
|
60420 | 1300 |
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
|
1301 |
|
53688 | 1302 |
lemma ksimplex_0: "ksimplex p 0 s \<longleftrightarrow> s = {(\<lambda>x. p)}" |
53248 | 1303 |
proof |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1304 |
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
|
1305 |
by (blast dest: kuhn_simplex.ksimplex_0 elim: ksimplex.cases) |
53248 | 1306 |
next |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1307 |
assume s: "s = {(\<lambda>x. p)}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1308 |
show "ksimplex p 0 s" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1309 |
proof (intro ksimplex, unfold_locales) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1310 |
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
|
1311 |
show "bij_betw id {..<0} {..<0}" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1312 |
by simp |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1313 |
qed (auto simp: s) |
53248 | 1314 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1315 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1316 |
lemma kuhn_combinatorial: |
53688 | 1317 |
assumes "0 < p" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1318 |
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
|
1319 |
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
|
1320 |
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
|
1321 |
(is "odd (card (?M n))") |
53248 | 1322 |
using assms |
1323 |
proof (induct n) |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1324 |
case 0 then show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1325 |
by (simp add: ksimplex_0 cong: conj_cong) |
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 |
case (Suc n) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1328 |
then have "odd (card (?M n))" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1329 |
by force |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1330 |
with Suc show ?case |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1331 |
using kuhn_induction[of p n] by (auto simp: comp_def) |
53248 | 1332 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1333 |
|
53248 | 1334 |
lemma kuhn_lemma: |
53688 | 1335 |
fixes n p :: nat |
1336 |
assumes "0 < p" |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1337 |
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
|
1338 |
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
|
1339 |
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
|
1340 |
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
|
1341 |
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 | 1342 |
proof - |
60580 | 1343 |
let ?rl = "reduced n \<circ> label" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1344 |
let ?A = "{s. ksimplex p n s \<and> ?rl ` s = {..n}}" |
53248 | 1345 |
have "odd (card ?A)" |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1346 |
using assms by (intro kuhn_combinatorial[of p n label]) auto |
53688 | 1347 |
then have "?A \<noteq> {}" |
60580 | 1348 |
by fastforce |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1349 |
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
|
1350 |
by (auto elim: ksimplex.cases) |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1351 |
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
|
1352 |
|
53248 | 1353 |
show ?thesis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1354 |
proof (intro that[of b] allI impI) |
60580 | 1355 |
fix i |
1356 |
assume "i < n" |
|
1357 |
then show "b i < p" |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1358 |
using base by auto |
53248 | 1359 |
next |
60580 | 1360 |
fix i |
1361 |
assume "i < n" |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1362 |
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
|
1363 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1364 |
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
|
1365 |
unfolding rl[symmetric] by blast |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1366 |
|
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1367 |
have "label u i \<noteq> label v i" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1368 |
using reduced_labelling [of n "label u"] reduced_labelling [of n "label v"] |
60420 | 1369 |
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
|
1370 |
by auto |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1371 |
moreover |
60580 | 1372 |
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 |
1373 |
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>] |
|
1374 |
by auto |
|
1375 |
ultimately show "\<exists>r s. (\<forall>j<n. b j \<le> r j \<and> r j \<le> b j + 1) \<and> |
|
1376 |
(\<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
|
1377 |
by blast |
53248 | 1378 |
qed |
1379 |
qed |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1380 |
|
60420 | 1381 |
subsection \<open>The 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
|
1382 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1383 |
lemma kuhn_labelling_lemma': |
53688 | 1384 |
assumes "(\<forall>x::nat\<Rightarrow>real. P x \<longrightarrow> P (f x))" |
1385 |
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
|
1386 |
shows "\<exists>l. (\<forall>x i. l x i \<le> (1::nat)) \<and> |
53688 | 1387 |
(\<forall>x i. P x \<and> Q i \<and> x i = 0 \<longrightarrow> l x i = 0) \<and> |
1388 |
(\<forall>x i. P x \<and> Q i \<and> x i = 1 \<longrightarrow> l x i = 1) \<and> |
|
1389 |
(\<forall>x i. P x \<and> Q i \<and> l x i = 0 \<longrightarrow> x i \<le> f x i) \<and> |
|
1390 |
(\<forall>x i. P x \<and> Q i \<and> l x i = 1 \<longrightarrow> f x i \<le> x i)" |
|
53185 | 1391 |
proof - |
53688 | 1392 |
have and_forall_thm: "\<And>P Q. (\<forall>x. P x) \<and> (\<forall>x. Q x) \<longleftrightarrow> (\<forall>x. P x \<and> Q x)" |
1393 |
by auto |
|
1394 |
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 | 1395 |
by auto |
1396 |
show ?thesis |
|
1397 |
unfolding and_forall_thm |
|
1398 |
apply (subst choice_iff[symmetric])+ |
|
53688 | 1399 |
apply rule |
1400 |
apply rule |
|
1401 |
proof - |
|
60580 | 1402 |
fix x x' |
53688 | 1403 |
let ?R = "\<lambda>y::nat. |
60580 | 1404 |
(P x \<and> Q x' \<and> x x' = 0 \<longrightarrow> y = 0) \<and> |
1405 |
(P x \<and> Q x' \<and> x x' = 1 \<longrightarrow> y = 1) \<and> |
|
1406 |
(P x \<and> Q x' \<and> y = 0 \<longrightarrow> x x' \<le> (f x) x') \<and> |
|
1407 |
(P x \<and> Q x' \<and> y = 1 \<longrightarrow> (f x) x' \<le> x x')" |
|
1408 |
have "0 \<le> f x x' \<and> f x x' \<le> 1" if "P x" "Q x'" |
|
1409 |
using assms(2)[rule_format,of "f x" x'] that |
|
1410 |
apply (drule_tac assms(1)[rule_format]) |
|
1411 |
apply auto |
|
1412 |
done |
|
53688 | 1413 |
then have "?R 0 \<or> ?R 1" |
1414 |
by auto |
|
60580 | 1415 |
then show "\<exists>y\<le>1. ?R y" |
53688 | 1416 |
by auto |
53185 | 1417 |
qed |
1418 |
qed |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1419 |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1420 |
definition unit_cube :: "'a::euclidean_space set" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1421 |
where "unit_cube = {x. \<forall>i\<in>Basis. 0 \<le> x \<bullet> i \<and> x \<bullet> i \<le> 1}" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1422 |
|
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1423 |
lemma mem_unit_cube: "x \<in> unit_cube \<longleftrightarrow> (\<forall>i\<in>Basis. 0 \<le> x \<bullet> i \<and> x \<bullet> i \<le> 1)" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1424 |
unfolding unit_cube_def by simp |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1425 |
|
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1426 |
lemma bounded_unit_cube: "bounded unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1427 |
unfolding bounded_def |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1428 |
proof (intro exI ballI) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1429 |
fix y :: 'a assume y: "y \<in> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1430 |
have "dist 0 y = norm y" by (rule dist_0_norm) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1431 |
also have "\<dots> = norm (\<Sum>i\<in>Basis. (y \<bullet> i) *\<^sub>R i)" unfolding euclidean_representation .. |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1432 |
also have "\<dots> \<le> (\<Sum>i\<in>Basis. norm ((y \<bullet> i) *\<^sub>R i))" by (rule norm_setsum) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1433 |
also have "\<dots> \<le> (\<Sum>i::'a\<in>Basis. 1)" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1434 |
by (rule setsum_mono, simp add: y [unfolded mem_unit_cube]) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1435 |
finally show "dist 0 y \<le> (\<Sum>i::'a\<in>Basis. 1)" . |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1436 |
qed |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1437 |
|
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1438 |
lemma closed_unit_cube: "closed unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1439 |
unfolding unit_cube_def Collect_ball_eq Collect_conj_eq |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1440 |
by (rule closed_INT, auto intro!: closed_Collect_le) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1441 |
|
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1442 |
lemma compact_unit_cube: "compact unit_cube" (is "compact ?C") |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1443 |
unfolding compact_eq_seq_compact_metric |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1444 |
using bounded_unit_cube closed_unit_cube |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1445 |
by (rule bounded_closed_imp_seq_compact) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1446 |
|
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
|
1447 |
lemma brouwer_cube: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1448 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1449 |
assumes "continuous_on unit_cube f" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1450 |
and "f ` unit_cube \<subseteq> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1451 |
shows "\<exists>x\<in>unit_cube. f x = x" |
53185 | 1452 |
proof (rule ccontr) |
63040 | 1453 |
define n where "n = DIM('a)" |
53185 | 1454 |
have n: "1 \<le> n" "0 < n" "n \<noteq> 0" |
1455 |
unfolding n_def by (auto simp add: Suc_le_eq DIM_positive) |
|
53674 | 1456 |
assume "\<not> ?thesis" |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1457 |
then have *: "\<not> (\<exists>x\<in>unit_cube. f x - x = 0)" |
53674 | 1458 |
by auto |
55522 | 1459 |
obtain d where |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1460 |
d: "d > 0" "\<And>x. x \<in> unit_cube \<Longrightarrow> d \<le> norm (f x - x)" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1461 |
apply (rule brouwer_compactness_lemma[OF compact_unit_cube _ *]) |
56371
fb9ae0727548
extend continuous_intros; remove continuous_on_intros and isCont_intros
hoelzl
parents:
56273
diff
changeset
|
1462 |
apply (rule continuous_intros assms)+ |
55522 | 1463 |
apply blast |
53185 | 1464 |
done |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1465 |
have *: "\<forall>x. x \<in> unit_cube \<longrightarrow> f x \<in> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1466 |
"\<forall>x. x \<in> (unit_cube::'a set) \<longrightarrow> (\<forall>i\<in>Basis. True \<longrightarrow> 0 \<le> x \<bullet> i \<and> x \<bullet> i \<le> 1)" |
53185 | 1467 |
using assms(2)[unfolded image_subset_iff Ball_def] |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1468 |
unfolding mem_unit_cube |
55522 | 1469 |
by auto |
1470 |
obtain label :: "'a \<Rightarrow> 'a \<Rightarrow> nat" where |
|
1471 |
"\<forall>x. \<forall>i\<in>Basis. label x i \<le> 1" |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1472 |
"\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> True \<and> x \<bullet> i = 0 \<longrightarrow> label x i = 0" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1473 |
"\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> True \<and> x \<bullet> i = 1 \<longrightarrow> label x i = 1" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1474 |
"\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> True \<and> label x i = 0 \<longrightarrow> x \<bullet> i \<le> f x \<bullet> i" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1475 |
"\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> True \<and> label x i = 1 \<longrightarrow> f x \<bullet> i \<le> x \<bullet> i" |
55522 | 1476 |
using kuhn_labelling_lemma[OF *] by blast |
53185 | 1477 |
note label = this [rule_format] |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1478 |
have lem1: "\<forall>x\<in>unit_cube. \<forall>y\<in>unit_cube. \<forall>i\<in>Basis. label x i \<noteq> label y i \<longrightarrow> |
61945 | 1479 |
\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y - f x) + norm (y - x)" |
53185 | 1480 |
proof safe |
1481 |
fix x y :: 'a |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1482 |
assume x: "x \<in> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1483 |
assume y: "y \<in> unit_cube" |
53185 | 1484 |
fix i |
1485 |
assume i: "label x i \<noteq> label y i" "i \<in> Basis" |
|
1486 |
have *: "\<And>x y fx fy :: real. x \<le> fx \<and> fy \<le> y \<or> fx \<le> x \<and> y \<le> fy \<Longrightarrow> |
|
61945 | 1487 |
\<bar>fx - x\<bar> \<le> \<bar>fy - fx\<bar> + \<bar>y - x\<bar>" by auto |
1488 |
have "\<bar>(f x - x) \<bullet> i\<bar> \<le> \<bar>(f y - f x)\<bullet>i\<bar> + \<bar>(y - x)\<bullet>i\<bar>" |
|
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
|
1489 |
unfolding inner_simps |
53185 | 1490 |
apply (rule *) |
1491 |
apply (cases "label x i = 0") |
|
53688 | 1492 |
apply (rule disjI1) |
1493 |
apply rule |
|
53185 | 1494 |
prefer 3 |
53688 | 1495 |
apply (rule disjI2) |
1496 |
apply rule |
|
1497 |
proof - |
|
53185 | 1498 |
assume lx: "label x i = 0" |
53674 | 1499 |
then have ly: "label y i = 1" |
53688 | 1500 |
using i label(1)[of i y] |
1501 |
by auto |
|
53185 | 1502 |
show "x \<bullet> i \<le> f x \<bullet> i" |
1503 |
apply (rule label(4)[rule_format]) |
|
53674 | 1504 |
using x y lx i(2) |
53252 | 1505 |
apply auto |
53185 | 1506 |
done |
1507 |
show "f y \<bullet> i \<le> y \<bullet> i" |
|
1508 |
apply (rule label(5)[rule_format]) |
|
53674 | 1509 |
using x y ly i(2) |
53252 | 1510 |
apply auto |
53185 | 1511 |
done |
1512 |
next |
|
1513 |
assume "label x i \<noteq> 0" |
|
53688 | 1514 |
then have l: "label x i = 1" "label y i = 0" |
1515 |
using i label(1)[of i x] label(1)[of i y] |
|
1516 |
by auto |
|
53185 | 1517 |
show "f x \<bullet> i \<le> x \<bullet> i" |
1518 |
apply (rule label(5)[rule_format]) |
|
53674 | 1519 |
using x y l i(2) |
53252 | 1520 |
apply auto |
53185 | 1521 |
done |
1522 |
show "y \<bullet> i \<le> f y \<bullet> i" |
|
1523 |
apply (rule label(4)[rule_format]) |
|
53674 | 1524 |
using x y l i(2) |
53252 | 1525 |
apply auto |
53185 | 1526 |
done |
1527 |
qed |
|
1528 |
also have "\<dots> \<le> norm (f y - f x) + norm (y - x)" |
|
1529 |
apply (rule add_mono) |
|
1530 |
apply (rule Basis_le_norm[OF i(2)])+ |
|
1531 |
done |
|
1532 |
finally show "\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y - f x) + norm (y - x)" |
|
1533 |
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
|
1534 |
qed |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1535 |
have "\<exists>e>0. \<forall>x\<in>unit_cube. \<forall>y\<in>unit_cube. \<forall>z\<in>unit_cube. \<forall>i\<in>Basis. |
53688 | 1536 |
norm (x - z) < e \<and> norm (y - z) < e \<and> label x i \<noteq> label y i \<longrightarrow> |
61945 | 1537 |
\<bar>(f(z) - z)\<bullet>i\<bar> < d / (real n)" |
53185 | 1538 |
proof - |
53688 | 1539 |
have d': "d / real n / 8 > 0" |
56541 | 1540 |
using d(1) by (simp add: n_def DIM_positive) |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1541 |
have *: "uniformly_continuous_on unit_cube f" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1542 |
by (rule compact_uniformly_continuous[OF assms(1) compact_unit_cube]) |
55522 | 1543 |
obtain e where e: |
1544 |
"e > 0" |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1545 |
"\<And>x x'. x \<in> unit_cube \<Longrightarrow> |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1546 |
x' \<in> unit_cube \<Longrightarrow> |
55522 | 1547 |
norm (x' - x) < e \<Longrightarrow> |
1548 |
norm (f x' - f x) < d / real n / 8" |
|
1549 |
using *[unfolded uniformly_continuous_on_def,rule_format,OF d'] |
|
1550 |
unfolding dist_norm |
|
1551 |
by blast |
|
53185 | 1552 |
show ?thesis |
1553 |
apply (rule_tac x="min (e/2) (d/real n/8)" in exI) |
|
53248 | 1554 |
apply safe |
1555 |
proof - |
|
53185 | 1556 |
show "0 < min (e / 2) (d / real n / 8)" |
1557 |
using d' e by auto |
|
1558 |
fix x y z i |
|
53688 | 1559 |
assume as: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1560 |
"x \<in> unit_cube" "y \<in> unit_cube" "z \<in> unit_cube" |
37489
44e42d392c6e
Introduce a type class for euclidean spaces, port most lemmas from real^'n to this type class.
hoelzl
parents:
36587
diff
changeset
|
1561 |
"norm (x - z) < min (e / 2) (d / real n / 8)" |
53688 | 1562 |
"norm (y - z) < min (e / 2) (d / real n / 8)" |
1563 |
"label x i \<noteq> label y i" |
|
1564 |
assume i: "i \<in> Basis" |
|
61945 | 1565 |
have *: "\<And>z fz x fx n1 n2 n3 n4 d4 d :: real. \<bar>fx - x\<bar> \<le> n1 + n2 \<Longrightarrow> |
1566 |
\<bar>fx - fz\<bar> \<le> n3 \<Longrightarrow> \<bar>x - z\<bar> \<le> n4 \<Longrightarrow> |
|
53185 | 1567 |
n1 < d4 \<Longrightarrow> n2 < 2 * d4 \<Longrightarrow> n3 < d4 \<Longrightarrow> n4 < d4 \<Longrightarrow> |
61945 | 1568 |
(8 * d4 = d) \<Longrightarrow> \<bar>fz - z\<bar> < d" |
53688 | 1569 |
by auto |
1570 |
show "\<bar>(f z - z) \<bullet> i\<bar> < d / real n" |
|
1571 |
unfolding inner_simps |
|
53185 | 1572 |
proof (rule *) |
1573 |
show "\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y -f x) + norm (y - x)" |
|
1574 |
apply (rule lem1[rule_format]) |
|
53688 | 1575 |
using as i |
1576 |
apply auto |
|
53185 | 1577 |
done |
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
|
1578 |
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 | 1579 |
unfolding inner_diff_left[symmetric] |
53688 | 1580 |
by (rule Basis_le_norm[OF i])+ |
1581 |
have tria: "norm (y - x) \<le> norm (y - z) + norm (x - z)" |
|
53185 | 1582 |
using dist_triangle[of y x z, unfolded dist_norm] |
53688 | 1583 |
unfolding norm_minus_commute |
1584 |
by auto |
|
53185 | 1585 |
also have "\<dots> < e / 2 + e / 2" |
1586 |
apply (rule add_strict_mono) |
|
53252 | 1587 |
using as(4,5) |
1588 |
apply auto |
|
53185 | 1589 |
done |
1590 |
finally show "norm (f y - f x) < d / real n / 8" |
|
1591 |
apply - |
|
1592 |
apply (rule e(2)) |
|
53252 | 1593 |
using as |
1594 |
apply auto |
|
53185 | 1595 |
done |
1596 |
have "norm (y - z) + norm (x - z) < d / real n / 8 + d / real n / 8" |
|
1597 |
apply (rule add_strict_mono) |
|
53252 | 1598 |
using as |
1599 |
apply auto |
|
53185 | 1600 |
done |
53688 | 1601 |
then show "norm (y - x) < 2 * (d / real n / 8)" |
1602 |
using tria |
|
1603 |
by auto |
|
53185 | 1604 |
show "norm (f x - f z) < d / real n / 8" |
1605 |
apply (rule e(2)) |
|
53252 | 1606 |
using as e(1) |
1607 |
apply auto |
|
53185 | 1608 |
done |
1609 |
qed (insert as, auto) |
|
1610 |
qed |
|
1611 |
qed |
|
55522 | 1612 |
then |
1613 |
obtain e where e: |
|
1614 |
"e > 0" |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1615 |
"\<And>x y z i. x \<in> unit_cube \<Longrightarrow> |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1616 |
y \<in> unit_cube \<Longrightarrow> |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1617 |
z \<in> unit_cube \<Longrightarrow> |
55522 | 1618 |
i \<in> Basis \<Longrightarrow> |
1619 |
norm (x - z) < e \<and> norm (y - z) < e \<and> label x i \<noteq> label y i \<Longrightarrow> |
|
1620 |
\<bar>(f z - z) \<bullet> i\<bar> < d / real n" |
|
1621 |
by blast |
|
1622 |
obtain p :: nat where p: "1 + real n / e \<le> real p" |
|
1623 |
using real_arch_simple .. |
|
53185 | 1624 |
have "1 + real n / e > 0" |
56541 | 1625 |
using e(1) n by (simp add: add_pos_pos) |
53688 | 1626 |
then have "p > 0" |
1627 |
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
|
1628 |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1629 |
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
|
1630 |
by atomize_elim (auto simp: n_def intro!: finite_same_card_bij) |
63040 | 1631 |
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
|
1632 |
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
|
1633 |
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
|
1634 |
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
|
1635 |
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
|
1636 |
have bb'[simp]:"\<And>i. i \<in> Basis \<Longrightarrow> b (b' i) = i" |
53688 | 1637 |
unfolding b'_def |
1638 |
using b |
|
1639 |
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
|
1640 |
have b'b[simp]:"\<And>i. i < n \<Longrightarrow> b' (b i) = i" |
53688 | 1641 |
unfolding b'_def |
1642 |
using b |
|
1643 |
by (auto simp: inv_into_f_eq bij_betw_def) |
|
1644 |
have *: "\<And>x :: nat. x = 0 \<or> x = 1 \<longleftrightarrow> x \<le> 1" |
|
1645 |
by auto |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1646 |
have b'': "\<And>j. j < n \<Longrightarrow> b j \<in> Basis" |
53185 | 1647 |
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
|
1648 |
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
|
1649 |
(\<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
|
1650 |
(label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 1)" |
53688 | 1651 |
unfolding * |
60420 | 1652 |
using \<open>p > 0\<close> \<open>n > 0\<close> |
53688 | 1653 |
using label(1)[OF b''] |
1654 |
by auto |
|
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1655 |
{ fix x :: "nat \<Rightarrow> nat" and i assume "\<forall>i<n. x i \<le> p" "i < n" "x i = p \<or> x i = 0" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1656 |
then have "(\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<in> (unit_cube::'a set)" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1657 |
using b'_Basis |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1658 |
by (auto simp add: mem_unit_cube inner_simps bij_betw_def zero_le_divide_iff divide_le_eq_1) } |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1659 |
note cube = this |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1660 |
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
|
1661 |
(label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 0)" |
60420 | 1662 |
unfolding o_def using cube \<open>p > 0\<close> by (intro allI impI label(2)) (auto simp add: 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
|
1663 |
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
|
1664 |
(label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 1)" |
60420 | 1665 |
using cube \<open>p > 0\<close> unfolding o_def by (intro allI impI label(3)) (auto simp add: b'') |
55522 | 1666 |
obtain q where q: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1667 |
"\<forall>i<n. q i < p" |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1668 |
"\<forall>i<n. |
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1669 |
\<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
|
1670 |
(\<forall>j<n. q j \<le> s j \<and> s j \<le> q j + 1) \<and> |
55522 | 1671 |
(label (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i) \<circ> b) i \<noteq> |
1672 |
(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
|
1673 |
by (rule kuhn_lemma[OF q1 q2 q3]) |
63040 | 1674 |
define z :: 'a where "z = (\<Sum>i\<in>Basis. (real (q (b' i)) / real p) *\<^sub>R i)" |
61945 | 1675 |
have "\<exists>i\<in>Basis. d / real n \<le> \<bar>(f z - z)\<bullet>i\<bar>" |
53185 | 1676 |
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
|
1677 |
have "\<forall>i\<in>Basis. q (b' i) \<in> {0..p}" |
53688 | 1678 |
using q(1) b' |
1679 |
by (auto intro: less_imp_le simp: bij_betw_def) |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1680 |
then have "z \<in> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1681 |
unfolding z_def mem_unit_cube |
53688 | 1682 |
using b'_Basis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1683 |
by (auto simp add: bij_betw_def zero_le_divide_iff divide_le_eq_1) |
53688 | 1684 |
then have d_fz_z: "d \<le> norm (f z - z)" |
1685 |
by (rule d) |
|
1686 |
assume "\<not> ?thesis" |
|
53674 | 1687 |
then have as: "\<forall>i\<in>Basis. \<bar>f z \<bullet> i - z \<bullet> i\<bar> < d / real n" |
60420 | 1688 |
using \<open>n > 0\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1689 |
by (auto simp add: 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
|
1690 |
have "norm (f z - z) \<le> (\<Sum>i\<in>Basis. \<bar>f z \<bullet> i - z \<bullet> i\<bar>)" |
53688 | 1691 |
unfolding inner_diff_left[symmetric] |
1692 |
by (rule norm_le_l1) |
|
53185 | 1693 |
also have "\<dots> < (\<Sum>(i::'a) \<in> Basis. d / real n)" |
1694 |
apply (rule setsum_strict_mono) |
|
53688 | 1695 |
using as |
1696 |
apply auto |
|
53185 | 1697 |
done |
1698 |
also have "\<dots> = d" |
|
53688 | 1699 |
using DIM_positive[where 'a='a] |
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
|
1700 |
by (auto simp: n_def) |
53688 | 1701 |
finally show False |
1702 |
using d_fz_z by auto |
|
53185 | 1703 |
qed |
55522 | 1704 |
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
|
1705 |
have *: "b' i < n" |
55522 | 1706 |
using i and b'[unfolded bij_betw_def] |
53688 | 1707 |
by auto |
55522 | 1708 |
obtain r s where rs: |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1709 |
"\<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
|
1710 |
"\<And>j. j < n \<Longrightarrow> q j \<le> s j \<and> s j \<le> q j + 1" |
55522 | 1711 |
"(label (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i) \<circ> b) (b' i) \<noteq> |
1712 |
(label (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i) \<circ> b) (b' i)" |
|
1713 |
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
|
1714 |
have b'_im: "\<And>i. i \<in> Basis \<Longrightarrow> b' i < n" |
53185 | 1715 |
using b' unfolding bij_betw_def by auto |
63040 | 1716 |
define r' ::'a where "r' = (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i)" |
53185 | 1717 |
have "\<And>i. i \<in> Basis \<Longrightarrow> r (b' i) \<le> p" |
1718 |
apply (rule order_trans) |
|
1719 |
apply (rule rs(1)[OF b'_im,THEN conjunct2]) |
|
53252 | 1720 |
using q(1)[rule_format,OF b'_im] |
1721 |
apply (auto simp add: Suc_le_eq) |
|
53185 | 1722 |
done |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1723 |
then have "r' \<in> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1724 |
unfolding r'_def mem_unit_cube |
53688 | 1725 |
using b'_Basis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1726 |
by (auto simp add: bij_betw_def zero_le_divide_iff divide_le_eq_1) |
63040 | 1727 |
define s' :: 'a where "s' = (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i)" |
53688 | 1728 |
have "\<And>i. i \<in> Basis \<Longrightarrow> s (b' i) \<le> p" |
53185 | 1729 |
apply (rule order_trans) |
1730 |
apply (rule rs(2)[OF b'_im, THEN conjunct2]) |
|
53252 | 1731 |
using q(1)[rule_format,OF b'_im] |
1732 |
apply (auto simp add: Suc_le_eq) |
|
53185 | 1733 |
done |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1734 |
then have "s' \<in> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1735 |
unfolding s'_def mem_unit_cube |
53688 | 1736 |
using b'_Basis |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1737 |
by (auto simp add: bij_betw_def zero_le_divide_iff divide_le_eq_1) |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1738 |
have "z \<in> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1739 |
unfolding z_def mem_unit_cube |
60420 | 1740 |
using b'_Basis q(1)[rule_format,OF b'_im] \<open>p > 0\<close> |
56273
def3bbe6f2a5
cleanup auxiliary proofs for Brouwer fixpoint theorem (removes ~2400 lines)
hoelzl
parents:
56226
diff
changeset
|
1741 |
by (auto simp add: bij_betw_def zero_le_divide_iff divide_le_eq_1 less_imp_le) |
53688 | 1742 |
have *: "\<And>x. 1 + real x = real (Suc x)" |
1743 |
by auto |
|
1744 |
{ |
|
1745 |
have "(\<Sum>i\<in>Basis. \<bar>real (r (b' i)) - real (q (b' i))\<bar>) \<le> (\<Sum>(i::'a)\<in>Basis. 1)" |
|
53185 | 1746 |
apply (rule setsum_mono) |
53252 | 1747 |
using rs(1)[OF b'_im] |
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
|
1748 |
apply (auto simp add:* field_simps simp del: of_nat_Suc) |
53185 | 1749 |
done |
53688 | 1750 |
also have "\<dots> < e * real p" |
60420 | 1751 |
using p \<open>e > 0\<close> \<open>p > 0\<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
|
1752 |
by (auto simp add: field_simps n_def) |
53185 | 1753 |
finally have "(\<Sum>i\<in>Basis. \<bar>real (r (b' i)) - real (q (b' i))\<bar>) < e * real p" . |
1754 |
} |
|
1755 |
moreover |
|
53688 | 1756 |
{ |
1757 |
have "(\<Sum>i\<in>Basis. \<bar>real (s (b' i)) - real (q (b' i))\<bar>) \<le> (\<Sum>(i::'a)\<in>Basis. 1)" |
|
53185 | 1758 |
apply (rule setsum_mono) |
53252 | 1759 |
using rs(2)[OF b'_im] |
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
|
1760 |
apply (auto simp add:* field_simps simp del: of_nat_Suc) |
53185 | 1761 |
done |
53688 | 1762 |
also have "\<dots> < e * real p" |
60420 | 1763 |
using p \<open>e > 0\<close> \<open>p > 0\<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
|
1764 |
by (auto simp add: field_simps n_def) |
53185 | 1765 |
finally have "(\<Sum>i\<in>Basis. \<bar>real (s (b' i)) - real (q (b' i))\<bar>) < e * real p" . |
1766 |
} |
|
1767 |
ultimately |
|
53688 | 1768 |
have "norm (r' - z) < e" and "norm (s' - z) < e" |
53185 | 1769 |
unfolding r'_def s'_def z_def |
60420 | 1770 |
using \<open>p > 0\<close> |
53185 | 1771 |
apply (rule_tac[!] le_less_trans[OF norm_le_l1]) |
1772 |
apply (auto simp add: field_simps setsum_divide_distrib[symmetric] inner_diff_left) |
|
1773 |
done |
|
53674 | 1774 |
then have "\<bar>(f z - z) \<bullet> i\<bar> < d / real n" |
53688 | 1775 |
using rs(3) i |
1776 |
unfolding r'_def[symmetric] s'_def[symmetric] o_def bb' |
|
60420 | 1777 |
by (intro e(2)[OF \<open>r'\<in>unit_cube\<close> \<open>s'\<in>unit_cube\<close> \<open>z\<in>unit_cube\<close>]) auto |
53688 | 1778 |
then show False |
1779 |
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
|
1780 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1781 |
|
53185 | 1782 |
|
60420 | 1783 |
subsection \<open>Retractions\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1784 |
|
53688 | 1785 |
definition "retraction s t r \<longleftrightarrow> t \<subseteq> s \<and> continuous_on s r \<and> r ` s \<subseteq> t \<and> (\<forall>x\<in>t. r x = x)" |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1786 |
|
62843
313d3b697c9a
Mostly renaming (from HOL Light to Isabelle conventions), with a couple of new results
paulson <lp15@cam.ac.uk>
parents:
62393
diff
changeset
|
1787 |
definition retract_of (infixl "retract'_of" 50) |
53185 | 1788 |
where "(t retract_of s) \<longleftrightarrow> (\<exists>r. retraction s t r)" |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1789 |
|
53674 | 1790 |
lemma retraction_idempotent: "retraction s t r \<Longrightarrow> x \<in> s \<Longrightarrow> r (r x) = r x" |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1791 |
unfolding retraction_def by auto |
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1792 |
|
60420 | 1793 |
subsection \<open>Preservation of fixpoints under (more general notion of) retraction\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1794 |
|
53185 | 1795 |
lemma invertible_fixpoint_property: |
53674 | 1796 |
fixes s :: "'a::euclidean_space set" |
1797 |
and t :: "'b::euclidean_space set" |
|
1798 |
assumes "continuous_on t i" |
|
1799 |
and "i ` t \<subseteq> s" |
|
53688 | 1800 |
and "continuous_on s r" |
1801 |
and "r ` s \<subseteq> t" |
|
53674 | 1802 |
and "\<forall>y\<in>t. r (i y) = y" |
1803 |
and "\<forall>f. continuous_on s f \<and> f ` s \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. f x = x)" |
|
1804 |
and "continuous_on t g" |
|
1805 |
and "g ` t \<subseteq> t" |
|
1806 |
obtains y where "y \<in> t" and "g y = y" |
|
53185 | 1807 |
proof - |
1808 |
have "\<exists>x\<in>s. (i \<circ> g \<circ> r) x = x" |
|
53688 | 1809 |
apply (rule assms(6)[rule_format]) |
1810 |
apply rule |
|
53185 | 1811 |
apply (rule continuous_on_compose assms)+ |
53688 | 1812 |
apply ((rule continuous_on_subset)?, rule assms)+ |
1813 |
using assms(2,4,8) |
|
53185 | 1814 |
apply auto |
1815 |
apply blast |
|
1816 |
done |
|
55522 | 1817 |
then obtain x where x: "x \<in> s" "(i \<circ> g \<circ> r) x = x" .. |
53674 | 1818 |
then have *: "g (r x) \<in> t" |
1819 |
using assms(4,8) by auto |
|
1820 |
have "r ((i \<circ> g \<circ> r) x) = r x" |
|
1821 |
using x by auto |
|
1822 |
then show ?thesis |
|
53185 | 1823 |
apply (rule_tac that[of "r x"]) |
53674 | 1824 |
using x |
1825 |
unfolding o_def |
|
1826 |
unfolding assms(5)[rule_format,OF *] |
|
1827 |
using assms(4) |
|
53185 | 1828 |
apply auto |
1829 |
done |
|
1830 |
qed |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1831 |
|
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1832 |
lemma homeomorphic_fixpoint_property: |
53674 | 1833 |
fixes s :: "'a::euclidean_space set" |
1834 |
and t :: "'b::euclidean_space set" |
|
53185 | 1835 |
assumes "s homeomorphic t" |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1836 |
shows "(\<forall>f. continuous_on s f \<and> f ` s \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. f x = x)) \<longleftrightarrow> |
53248 | 1837 |
(\<forall>g. continuous_on t g \<and> g ` t \<subseteq> t \<longrightarrow> (\<exists>y\<in>t. g y = y))" |
53185 | 1838 |
proof - |
55522 | 1839 |
obtain r i where |
1840 |
"\<forall>x\<in>s. i (r x) = x" |
|
1841 |
"r ` s = t" |
|
1842 |
"continuous_on s r" |
|
1843 |
"\<forall>y\<in>t. r (i y) = y" |
|
1844 |
"i ` t = s" |
|
1845 |
"continuous_on t i" |
|
1846 |
using assms |
|
1847 |
unfolding homeomorphic_def homeomorphism_def |
|
1848 |
by blast |
|
53674 | 1849 |
then show ?thesis |
53185 | 1850 |
apply - |
1851 |
apply rule |
|
1852 |
apply (rule_tac[!] allI impI)+ |
|
1853 |
apply (rule_tac g=g in invertible_fixpoint_property[of t i s r]) |
|
1854 |
prefer 10 |
|
1855 |
apply (rule_tac g=f in invertible_fixpoint_property[of s r t i]) |
|
1856 |
apply auto |
|
1857 |
done |
|
1858 |
qed |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1859 |
|
53185 | 1860 |
lemma retract_fixpoint_property: |
53688 | 1861 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" |
53674 | 1862 |
and s :: "'a set" |
53185 | 1863 |
assumes "t retract_of s" |
53674 | 1864 |
and "\<forall>f. continuous_on s f \<and> f ` s \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. f x = x)" |
1865 |
and "continuous_on t g" |
|
1866 |
and "g ` t \<subseteq> t" |
|
1867 |
obtains y where "y \<in> t" and "g y = y" |
|
53185 | 1868 |
proof - |
55522 | 1869 |
obtain h where "retraction s t h" |
1870 |
using assms(1) unfolding retract_of_def .. |
|
53674 | 1871 |
then show ?thesis |
53185 | 1872 |
unfolding retraction_def |
1873 |
apply - |
|
1874 |
apply (rule invertible_fixpoint_property[OF continuous_on_id _ _ _ _ assms(2), of t h g]) |
|
1875 |
prefer 7 |
|
53248 | 1876 |
apply (rule_tac y = y in that) |
1877 |
using assms |
|
1878 |
apply auto |
|
53185 | 1879 |
done |
1880 |
qed |
|
1881 |
||
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1882 |
|
60420 | 1883 |
subsection \<open>The Brouwer theorem for any set with nonempty interior\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1884 |
|
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1885 |
lemma convex_unit_cube: "convex unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1886 |
apply (rule is_interval_convex) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1887 |
apply (clarsimp simp add: is_interval_def mem_unit_cube) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1888 |
apply (drule (1) bspec)+ |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1889 |
apply auto |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1890 |
done |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1891 |
|
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
|
1892 |
lemma brouwer_weak: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1893 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
53674 | 1894 |
assumes "compact s" |
1895 |
and "convex s" |
|
1896 |
and "interior s \<noteq> {}" |
|
1897 |
and "continuous_on s f" |
|
1898 |
and "f ` s \<subseteq> s" |
|
1899 |
obtains x where "x \<in> s" and "f x = x" |
|
53185 | 1900 |
proof - |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1901 |
let ?U = "unit_cube :: 'a set" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1902 |
have "\<Sum>Basis /\<^sub>R 2 \<in> interior ?U" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1903 |
proof (rule interiorI) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1904 |
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
|
1905 |
show "open ?I" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1906 |
by (intro open_INT finite_Basis ballI open_Int, auto intro: open_Collect_less) |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1907 |
show "\<Sum>Basis /\<^sub>R 2 \<in> ?I" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1908 |
by simp |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1909 |
show "?I \<subseteq> unit_cube" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1910 |
unfolding unit_cube_def by force |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1911 |
qed |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1912 |
then have *: "interior ?U \<noteq> {}" by fast |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1913 |
have *: "?U homeomorphic s" |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1914 |
using homeomorphic_convex_compact[OF convex_unit_cube compact_unit_cube * assms(2,1,3)] . |
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1915 |
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
|
1916 |
(\<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
|
1917 |
using brouwer_cube by auto |
53674 | 1918 |
then show ?thesis |
53185 | 1919 |
unfolding homeomorphic_fixpoint_property[OF *] |
53252 | 1920 |
using assms |
59765
26d1c71784f1
tweaked a few slow or very ugly proofs
paulson <lp15@cam.ac.uk>
parents:
58877
diff
changeset
|
1921 |
by (auto simp: intro: that) |
53185 | 1922 |
qed |
1923 |
||
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1924 |
|
60420 | 1925 |
text \<open>And in particular for a closed ball.\<close> |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1926 |
|
53185 | 1927 |
lemma brouwer_ball: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1928 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
53674 | 1929 |
assumes "e > 0" |
1930 |
and "continuous_on (cball a e) f" |
|
53688 | 1931 |
and "f ` cball a e \<subseteq> cball a e" |
53674 | 1932 |
obtains x where "x \<in> cball a e" and "f x = x" |
53185 | 1933 |
using brouwer_weak[OF compact_cball convex_cball, of a e f] |
1934 |
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
|
1935 |
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
|
1936 |
|
60420 | 1937 |
text \<open>Still more general form; could derive this directly without using the |
61808 | 1938 |
rather involved \<open>HOMEOMORPHIC_CONVEX_COMPACT\<close> theorem, just using |
60420 | 1939 |
a scaling and translation to put the set inside 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
|
1940 |
|
53248 | 1941 |
lemma brouwer: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1942 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'a" |
53674 | 1943 |
assumes "compact s" |
1944 |
and "convex s" |
|
1945 |
and "s \<noteq> {}" |
|
1946 |
and "continuous_on s f" |
|
1947 |
and "f ` s \<subseteq> s" |
|
1948 |
obtains x where "x \<in> s" and "f x = x" |
|
53185 | 1949 |
proof - |
1950 |
have "\<exists>e>0. s \<subseteq> cball 0 e" |
|
53688 | 1951 |
using compact_imp_bounded[OF assms(1)] |
1952 |
unfolding bounded_pos |
|
53674 | 1953 |
apply (erule_tac exE) |
1954 |
apply (rule_tac x=b in exI) |
|
53185 | 1955 |
apply (auto simp add: dist_norm) |
1956 |
done |
|
55522 | 1957 |
then obtain e where e: "e > 0" "s \<subseteq> cball 0 e" |
1958 |
by blast |
|
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1959 |
have "\<exists>x\<in> cball 0 e. (f \<circ> closest_point s) x = x" |
53185 | 1960 |
apply (rule_tac brouwer_ball[OF e(1), of 0 "f \<circ> closest_point s"]) |
1961 |
apply (rule continuous_on_compose ) |
|
1962 |
apply (rule continuous_on_closest_point[OF assms(2) compact_imp_closed[OF assms(1)] assms(3)]) |
|
1963 |
apply (rule continuous_on_subset[OF assms(4)]) |
|
1964 |
apply (insert closest_point_in_set[OF compact_imp_closed[OF assms(1)] assms(3)]) |
|
1965 |
using assms(5)[unfolded subset_eq] |
|
1966 |
using e(2)[unfolded subset_eq mem_cball] |
|
1967 |
apply (auto simp add: dist_norm) |
|
1968 |
done |
|
55522 | 1969 |
then obtain x where x: "x \<in> cball 0 e" "(f \<circ> closest_point s) x = x" .. |
53185 | 1970 |
have *: "closest_point s x = x" |
1971 |
apply (rule closest_point_self) |
|
1972 |
apply (rule assms(5)[unfolded subset_eq,THEN bspec[where x="x"], unfolded image_iff]) |
|
1973 |
apply (rule_tac x="closest_point s x" in bexI) |
|
1974 |
using x |
|
1975 |
unfolding o_def |
|
1976 |
using closest_point_in_set[OF compact_imp_closed[OF assms(1)] assms(3), of x] |
|
1977 |
apply auto |
|
1978 |
done |
|
1979 |
show thesis |
|
1980 |
apply (rule_tac x="closest_point s x" in that) |
|
1981 |
unfolding x(2)[unfolded o_def] |
|
1982 |
apply (rule closest_point_in_set[OF compact_imp_closed[OF assms(1)] assms(3)]) |
|
53674 | 1983 |
using * |
1984 |
apply auto |
|
1985 |
done |
|
53185 | 1986 |
qed |
33741
4c414d0835ab
Added derivation and Brouwer's fixpoint theorem in Multivariate Analysis (translated by Robert Himmelmann from HOL-light)
hoelzl
parents:
diff
changeset
|
1987 |
|
60420 | 1988 |
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
|
1989 |
|
53185 | 1990 |
lemma no_retraction_cball: |
56117
2dbf84ee3deb
remove ordered_euclidean_space constraint from brouwer/derivative lemmas;
huffman
parents:
55522
diff
changeset
|
1991 |
fixes a :: "'a::euclidean_space" |
53674 | 1992 |
assumes "e > 0" |
1993 |
shows "\<not> (frontier (cball a e) retract_of (cball a e))" |
|
53185 | 1994 |
proof |
60580 | 1995 |
assume *: "frontier (cball a e) retract_of (cball a e)" |
1996 |
have **: "\<And>xa. a - (2 *\<^sub>R a - xa) = - (a - xa)" |
|
53185 | 1997 |
using scaleR_left_distrib[of 1 1 a] by auto |
55522 | 1998 |
obtain x where x: |
1999 |
"x \<in> {x. norm (a - x) = e}" |
|
2000 |
"2 *\<^sub>R a - x = x" |
|
60580 | 2001 |
apply (rule retract_fixpoint_property[OF *, of "\<lambda>x. scaleR 2 a - x"]) |
59765
26d1c71784f1
tweaked a few slow or very ugly proofs
paulson <lp15@cam.ac.uk>
parents:
58877
diff
changeset
|
2002 |
apply (blast intro: brouwer_ball[OF assms]) |
26d1c71784f1
tweaked a few slow or very ugly proofs
paulson <lp15@cam.ac.uk>
parents:
58877
diff
changeset
|
2003 |
apply (intro continuous_intros) |
62381
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62061
diff
changeset
|
2004 |
unfolding frontier_cball subset_eq Ball_def image_iff dist_norm sphere_def |
60580 | 2005 |
apply (auto simp add: ** norm_minus_commute) |
53185 | 2006 |
done |
53674 | 2007 |
then have "scaleR 2 a = scaleR 1 x + scaleR 1 x" |
53248 | 2008 |
by (auto simp add: algebra_simps) |
53674 | 2009 |
then have "a = x" |
53688 | 2010 |
unfolding scaleR_left_distrib[symmetric] |
2011 |
by auto |
|
53674 | 2012 |
then show False |
2013 |
using x assms by auto |
|
53185 | 2014 |
qed |
2015 |
||
62948
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2016 |
subsection\<open>Retractions\<close> |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2017 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2018 |
lemma retraction: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2019 |
"retraction s t r \<longleftrightarrow> |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2020 |
t \<subseteq> s \<and> continuous_on s r \<and> r ` s = t \<and> (\<forall>x \<in> t. r x = x)" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2021 |
by (force simp: retraction_def) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2022 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2023 |
lemma retract_of_imp_extensible: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2024 |
assumes "s retract_of t" and "continuous_on s f" and "f ` s \<subseteq> u" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2025 |
obtains g where "continuous_on t g" "g ` t \<subseteq> u" "\<And>x. x \<in> s \<Longrightarrow> g x = f x" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2026 |
using assms |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2027 |
apply (clarsimp simp add: retract_of_def retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2028 |
apply (rule_tac g = "f o r" in that) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2029 |
apply (auto simp: continuous_on_compose2) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2030 |
done |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2031 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2032 |
lemma idempotent_imp_retraction: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2033 |
assumes "continuous_on s f" and "f ` s \<subseteq> s" and "\<And>x. x \<in> s \<Longrightarrow> f(f x) = f x" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2034 |
shows "retraction s (f ` s) f" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2035 |
by (simp add: assms retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2036 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2037 |
lemma retraction_subset: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2038 |
assumes "retraction s t r" and "t \<subseteq> s'" and "s' \<subseteq> s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2039 |
shows "retraction s' t r" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2040 |
apply (simp add: retraction_def) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2041 |
by (metis assms continuous_on_subset image_mono retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2042 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2043 |
lemma retract_of_subset: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2044 |
assumes "t retract_of s" and "t \<subseteq> s'" and "s' \<subseteq> s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2045 |
shows "t retract_of s'" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2046 |
by (meson assms retract_of_def retraction_subset) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2047 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2048 |
lemma retraction_refl [simp]: "retraction s s (\<lambda>x. x)" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2049 |
by (simp add: continuous_on_id retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2050 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2051 |
lemma retract_of_refl [iff]: "s retract_of s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2052 |
using continuous_on_id retract_of_def retraction_def by fastforce |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2053 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2054 |
lemma retract_of_imp_subset: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2055 |
"s retract_of t \<Longrightarrow> s \<subseteq> t" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2056 |
by (simp add: retract_of_def retraction_def) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2057 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2058 |
lemma retract_of_empty [simp]: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2059 |
"({} retract_of s) \<longleftrightarrow> s = {}" "(s retract_of {}) \<longleftrightarrow> s = {}" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2060 |
by (auto simp: retract_of_def retraction_def) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2061 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2062 |
lemma retract_of_singleton [iff]: "({x} retract_of s) \<longleftrightarrow> x \<in> s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2063 |
using continuous_on_const |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2064 |
by (auto simp: retract_of_def retraction_def) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2065 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2066 |
lemma retraction_comp: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2067 |
"\<lbrakk>retraction s t f; retraction t u g\<rbrakk> |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2068 |
\<Longrightarrow> retraction s u (g o f)" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2069 |
apply (auto simp: retraction_def intro: continuous_on_compose2) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2070 |
by blast |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2071 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2072 |
lemma retract_of_trans: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2073 |
assumes "s retract_of t" and "t retract_of u" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2074 |
shows "s retract_of u" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2075 |
using assms by (auto simp: retract_of_def intro: retraction_comp) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2076 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2077 |
lemma closedin_retract: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2078 |
fixes s :: "'a :: real_normed_vector set" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2079 |
assumes "s retract_of t" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2080 |
shows "closedin (subtopology euclidean t) s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2081 |
proof - |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2082 |
obtain r where "s \<subseteq> t" "continuous_on t r" "r ` t \<subseteq> s" "\<And>x. x \<in> s \<Longrightarrow> r x = x" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2083 |
using assms by (auto simp: retract_of_def retraction_def) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2084 |
then have s: "s = {x \<in> t. (norm(r x - x)) = 0}" by auto |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2085 |
show ?thesis |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2086 |
apply (subst s) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2087 |
apply (rule continuous_closedin_preimage_constant) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2088 |
by (simp add: \<open>continuous_on t r\<close> continuous_on_diff continuous_on_id continuous_on_norm) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2089 |
qed |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2090 |
|
63301 | 2091 |
lemma closedin_self [simp]: |
2092 |
fixes S :: "'a :: real_normed_vector set" |
|
2093 |
shows "closedin (subtopology euclidean S) S" |
|
2094 |
by (simp add: closedin_retract) |
|
2095 |
||
62948
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2096 |
lemma retract_of_contractible: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2097 |
assumes "contractible t" "s retract_of t" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2098 |
shows "contractible s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2099 |
using assms |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2100 |
apply (clarsimp simp add: retract_of_def contractible_def retraction_def homotopic_with) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2101 |
apply (rule_tac x="r a" in exI) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2102 |
apply (rule_tac x="r o h" in exI) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2103 |
apply (intro conjI continuous_intros continuous_on_compose) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2104 |
apply (erule continuous_on_subset | force)+ |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2105 |
done |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2106 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2107 |
lemma retract_of_compact: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2108 |
"\<lbrakk>compact t; s retract_of t\<rbrakk> \<Longrightarrow> compact s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2109 |
by (metis compact_continuous_image retract_of_def retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2110 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2111 |
lemma retract_of_closed: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2112 |
fixes s :: "'a :: real_normed_vector set" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2113 |
shows "\<lbrakk>closed t; s retract_of t\<rbrakk> \<Longrightarrow> closed s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2114 |
by (metis closedin_retract closedin_closed_eq) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2115 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2116 |
lemma retract_of_connected: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2117 |
"\<lbrakk>connected t; s retract_of t\<rbrakk> \<Longrightarrow> connected s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2118 |
by (metis Topological_Spaces.connected_continuous_image retract_of_def retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2119 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2120 |
lemma retract_of_path_connected: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2121 |
"\<lbrakk>path_connected t; s retract_of t\<rbrakk> \<Longrightarrow> path_connected s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2122 |
by (metis path_connected_continuous_image retract_of_def retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2123 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2124 |
lemma retract_of_simply_connected: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2125 |
"\<lbrakk>simply_connected t; s retract_of t\<rbrakk> \<Longrightarrow> simply_connected s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2126 |
apply (simp add: retract_of_def retraction_def, clarify) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2127 |
apply (rule simply_connected_retraction_gen) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2128 |
apply (force simp: continuous_on_id elim!: continuous_on_subset)+ |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2129 |
done |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2130 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2131 |
lemma retract_of_homotopically_trivial: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2132 |
assumes ts: "t retract_of s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2133 |
and hom: "\<And>f g. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2134 |
continuous_on u g; g ` u \<subseteq> s\<rbrakk> |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2135 |
\<Longrightarrow> homotopic_with (\<lambda>x. True) u s f g" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2136 |
and "continuous_on u f" "f ` u \<subseteq> t" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2137 |
and "continuous_on u g" "g ` u \<subseteq> t" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2138 |
shows "homotopic_with (\<lambda>x. True) u t f g" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2139 |
proof - |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2140 |
obtain r where "r ` s \<subseteq> s" "continuous_on s r" "\<forall>x\<in>s. r (r x) = r x" "t = r ` s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2141 |
using ts by (auto simp: retract_of_def retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2142 |
then obtain k where "Retracts s r t k" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2143 |
unfolding Retracts_def |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2144 |
by (metis continuous_on_subset dual_order.trans image_iff image_mono) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2145 |
then show ?thesis |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2146 |
apply (rule Retracts.homotopically_trivial_retraction_gen) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2147 |
using assms |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2148 |
apply (force simp: hom)+ |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2149 |
done |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2150 |
qed |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2151 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2152 |
lemma retract_of_homotopically_trivial_null: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2153 |
assumes ts: "t retract_of s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2154 |
and hom: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> s\<rbrakk> |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2155 |
\<Longrightarrow> \<exists>c. homotopic_with (\<lambda>x. True) u s f (\<lambda>x. c)" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2156 |
and "continuous_on u f" "f ` u \<subseteq> t" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2157 |
obtains c where "homotopic_with (\<lambda>x. True) u t f (\<lambda>x. c)" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2158 |
proof - |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2159 |
obtain r where "r ` s \<subseteq> s" "continuous_on s r" "\<forall>x\<in>s. r (r x) = r x" "t = r ` s" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2160 |
using ts by (auto simp: retract_of_def retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2161 |
then obtain k where "Retracts s r t k" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2162 |
unfolding Retracts_def |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2163 |
by (metis continuous_on_subset dual_order.trans image_iff image_mono) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2164 |
then show ?thesis |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2165 |
apply (rule Retracts.homotopically_trivial_retraction_null_gen) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2166 |
apply (rule TrueI refl assms that | assumption)+ |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2167 |
done |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2168 |
qed |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2169 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2170 |
lemma retraction_imp_quotient_map: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2171 |
"retraction s t r |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2172 |
\<Longrightarrow> u \<subseteq> t |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2173 |
\<Longrightarrow> (openin (subtopology euclidean s) {x. x \<in> s \<and> r x \<in> u} \<longleftrightarrow> |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2174 |
openin (subtopology euclidean t) u)" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2175 |
apply (clarsimp simp add: retraction) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2176 |
apply (rule continuous_right_inverse_imp_quotient_map [where g=r]) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2177 |
apply (auto simp: elim: continuous_on_subset) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2178 |
done |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2179 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2180 |
lemma retract_of_locally_compact: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2181 |
fixes s :: "'a :: {heine_borel,real_normed_vector} set" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2182 |
shows "\<lbrakk> locally compact s; t retract_of s\<rbrakk> \<Longrightarrow> locally compact t" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2183 |
by (metis locally_compact_closedin closedin_retract) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2184 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2185 |
lemma retract_of_times: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2186 |
"\<lbrakk>s retract_of s'; t retract_of t'\<rbrakk> \<Longrightarrow> (s \<times> t) retract_of (s' \<times> t')" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2187 |
apply (simp add: retract_of_def retraction_def Sigma_mono, clarify) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2188 |
apply (rename_tac f g) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2189 |
apply (rule_tac x="\<lambda>z. ((f o fst) z, (g o snd) z)" in exI) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2190 |
apply (rule conjI continuous_intros | erule continuous_on_subset | force)+ |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2191 |
done |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2192 |
|
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2193 |
lemma homotopic_into_retract: |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2194 |
"\<lbrakk>f ` s \<subseteq> t; g ` s \<subseteq> t; t retract_of u; |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2195 |
homotopic_with (\<lambda>x. True) s u f g\<rbrakk> |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2196 |
\<Longrightarrow> homotopic_with (\<lambda>x. True) s t f g" |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2197 |
apply (subst (asm) homotopic_with_def) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2198 |
apply (simp add: homotopic_with retract_of_def retraction_def, clarify) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2199 |
apply (rule_tac x="r o h" in exI) |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2200 |
apply (rule conjI continuous_intros | erule continuous_on_subset | force simp: image_subset_iff)+ |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2201 |
done |
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
2202 |
|
63301 | 2203 |
subsection\<open>Borsuk-style characterization of separation\<close> |
2204 |
||
2205 |
lemma continuous_on_Borsuk_map: |
|
2206 |
"a \<notin> s \<Longrightarrow> continuous_on s (\<lambda>x. inverse(norm (x - a)) *\<^sub>R (x - a))" |
|
2207 |
by (rule continuous_intros | force)+ |
|
2208 |
||
2209 |
lemma Borsuk_map_into_sphere: |
|
2210 |
"(\<lambda>x. inverse(norm (x - a)) *\<^sub>R (x - a)) ` s \<subseteq> sphere 0 1 \<longleftrightarrow> (a \<notin> s)" |
|
2211 |
by auto (metis eq_iff_diff_eq_0 left_inverse norm_eq_zero) |
|
2212 |
||
2213 |
lemma Borsuk_maps_homotopic_in_path_component: |
|
2214 |
assumes "path_component (- s) a b" |
|
2215 |
shows "homotopic_with (\<lambda>x. True) s (sphere 0 1) |
|
2216 |
(\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) |
|
2217 |
(\<lambda>x. inverse(norm(x - b)) *\<^sub>R (x - b))" |
|
2218 |
proof - |
|
2219 |
obtain g where "path g" "path_image g \<subseteq> -s" "pathstart g = a" "pathfinish g = b" |
|
2220 |
using assms by (auto simp: path_component_def) |
|
2221 |
then show ?thesis |
|
2222 |
apply (simp add: path_def path_image_def pathstart_def pathfinish_def homotopic_with_def) |
|
2223 |
apply (rule_tac x = "\<lambda>z. inverse(norm(snd z - (g o fst)z)) *\<^sub>R (snd z - (g o fst)z)" in exI) |
|
2224 |
apply (intro conjI continuous_intros) |
|
2225 |
apply (rule continuous_intros | erule continuous_on_subset | fastforce simp: divide_simps sphere_def)+ |
|
2226 |
done |
|
2227 |
qed |
|
2228 |
||
2229 |
lemma non_extensible_Borsuk_map: |
|
2230 |
fixes a :: "'a :: euclidean_space" |
|
2231 |
assumes "compact s" and cin: "c \<in> components(- s)" and boc: "bounded c" and "a \<in> c" |
|
2232 |
shows "~ (\<exists>g. continuous_on (s \<union> c) g \<and> |
|
2233 |
g ` (s \<union> c) \<subseteq> sphere 0 1 \<and> |
|
2234 |
(\<forall>x \<in> s. g x = inverse(norm(x - a)) *\<^sub>R (x - a)))" |
|
2235 |
proof - |
|
2236 |
have "closed s" using assms by (simp add: compact_imp_closed) |
|
2237 |
have "c \<subseteq> -s" |
|
2238 |
using assms by (simp add: in_components_subset) |
|
2239 |
with \<open>a \<in> c\<close> have "a \<notin> s" by blast |
|
2240 |
then have ceq: "c = connected_component_set (- s) a" |
|
2241 |
by (metis \<open>a \<in> c\<close> cin components_iff connected_component_eq) |
|
2242 |
then have "bounded (s \<union> connected_component_set (- s) a)" |
|
2243 |
using \<open>compact s\<close> boc compact_imp_bounded by auto |
|
2244 |
with bounded_subset_ballD obtain r where "0 < r" and r: "(s \<union> connected_component_set (- s) a) \<subseteq> ball a r" |
|
2245 |
by blast |
|
2246 |
{ fix g |
|
2247 |
assume "continuous_on (s \<union> c) g" |
|
2248 |
"g ` (s \<union> c) \<subseteq> sphere 0 1" |
|
2249 |
and [simp]: "\<And>x. x \<in> s \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)" |
|
2250 |
then have [simp]: "\<And>x. x \<in> s \<union> c \<Longrightarrow> norm (g x) = 1" |
|
2251 |
by force |
|
2252 |
have cb_eq: "cball a r = (s \<union> connected_component_set (- s) a) \<union> |
|
2253 |
(cball a r - connected_component_set (- s) a)" |
|
2254 |
using ball_subset_cball [of a r] r by auto |
|
2255 |
have cont1: "continuous_on (s \<union> connected_component_set (- s) a) |
|
2256 |
(\<lambda>x. a + r *\<^sub>R g x)" |
|
2257 |
apply (rule continuous_intros)+ |
|
2258 |
using \<open>continuous_on (s \<union> c) g\<close> ceq by blast |
|
2259 |
have cont2: "continuous_on (cball a r - connected_component_set (- s) a) |
|
2260 |
(\<lambda>x. a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))" |
|
2261 |
by (rule continuous_intros | force simp: \<open>a \<notin> s\<close>)+ |
|
2262 |
have 1: "continuous_on (cball a r) |
|
2263 |
(\<lambda>x. if connected_component (- s) a x |
|
2264 |
then a + r *\<^sub>R g x |
|
2265 |
else a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))" |
|
2266 |
apply (subst cb_eq) |
|
2267 |
apply (rule continuous_on_cases [OF _ _ cont1 cont2]) |
|
2268 |
using ceq cin |
|
2269 |
apply (auto intro: closed_Un_complement_component |
|
2270 |
simp: \<open>closed s\<close> open_Compl open_connected_component) |
|
2271 |
done |
|
2272 |
have 2: "(\<lambda>x. a + r *\<^sub>R g x) ` (cball a r \<inter> connected_component_set (- s) a) |
|
2273 |
\<subseteq> sphere a r " |
|
2274 |
using \<open>0 < r\<close> by (force simp: dist_norm ceq) |
|
2275 |
have "retraction (cball a r) (sphere a r) |
|
2276 |
(\<lambda>x. if x \<in> connected_component_set (- s) a |
|
2277 |
then a + r *\<^sub>R g x |
|
2278 |
else a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))" |
|
2279 |
using \<open>0 < r\<close> |
|
2280 |
apply (simp add: retraction_def dist_norm 1 2, safe) |
|
2281 |
apply (force simp: dist_norm abs_if mult_less_0_iff divide_simps \<open>a \<notin> s\<close>) |
|
2282 |
using r |
|
2283 |
by (auto simp: dist_norm norm_minus_commute) |
|
2284 |
then have False |
|
2285 |
using no_retraction_cball |
|
2286 |
[OF \<open>0 < r\<close>, of a, unfolded retract_of_def, simplified, rule_format, |
|
2287 |
of "\<lambda>x. if x \<in> connected_component_set (- s) a |
|
2288 |
then a + r *\<^sub>R g x |
|
2289 |
else a + r *\<^sub>R inverse(norm(x - a)) *\<^sub>R (x - a)"] |
|
2290 |
by blast |
|
2291 |
} |
|
2292 |
then show ?thesis |
|
2293 |
by blast |
|
2294 |
qed |
|
2295 |
||
63305
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2296 |
subsection\<open>Absolute retracts, Etc.\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2297 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2298 |
text\<open>Absolute retracts (AR), absolute neighbourhood retracts (ANR) and also |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2299 |
Euclidean neighbourhood retracts (ENR). We define AR and ANR by |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2300 |
specializing the standard definitions for a set to embedding in |
63306
00090a0cd17f
Removed instances of ^ from theory markup
paulson <lp15@cam.ac.uk>
parents:
63305
diff
changeset
|
2301 |
spaces of higher dimension. \<close> |
00090a0cd17f
Removed instances of ^ from theory markup
paulson <lp15@cam.ac.uk>
parents:
63305
diff
changeset
|
2302 |
|
00090a0cd17f
Removed instances of ^ from theory markup
paulson <lp15@cam.ac.uk>
parents:
63305
diff
changeset
|
2303 |
(*This turns out to be sufficient (since any set in |
63305
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2304 |
R^n can be embedded as a closed subset of a convex subset of R^{n+1}) to |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2305 |
derive the usual definitions, but we need to split them into two |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2306 |
implications because of the lack of type quantifiers. Then ENR turns out |
63306
00090a0cd17f
Removed instances of ^ from theory markup
paulson <lp15@cam.ac.uk>
parents:
63305
diff
changeset
|
2307 |
to be equivalent to ANR plus local compactness. -- JRH*) |
63305
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2308 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2309 |
definition AR :: "'a::topological_space set => bool" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2310 |
where |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2311 |
"AR S \<equiv> \<forall>U. \<forall>S'::('a * real) set. S homeomorphic S' \<and> closedin (subtopology euclidean U) S' |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2312 |
\<longrightarrow> S' retract_of U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2313 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2314 |
definition ANR :: "'a::topological_space set => bool" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2315 |
where |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2316 |
"ANR S \<equiv> \<forall>U. \<forall>S'::('a * real) set. S homeomorphic S' \<and> closedin (subtopology euclidean U) S' |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2317 |
\<longrightarrow> (\<exists>T. openin (subtopology euclidean U) T \<and> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2318 |
S' retract_of T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2319 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2320 |
definition ENR :: "'a::topological_space set => bool" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2321 |
where "ENR S \<equiv> \<exists>U. open U \<and> S retract_of U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2322 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2323 |
text\<open> First, show that we do indeed get the "usual" properties of ARs and ANRs.\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2324 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2325 |
proposition AR_imp_absolute_extensor: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2326 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2327 |
assumes "AR S" and contf: "continuous_on T f" and "f ` T \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2328 |
and cloUT: "closedin (subtopology euclidean U) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2329 |
obtains g where "continuous_on U g" "g ` U \<subseteq> S" "\<And>x. x \<in> T \<Longrightarrow> g x = f x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2330 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2331 |
have "aff_dim S < int (DIM('b \<times> real))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2332 |
using aff_dim_le_DIM [of S] by simp |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2333 |
then obtain C and S' :: "('b * real) set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2334 |
where C: "convex C" "C \<noteq> {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2335 |
and cloCS: "closedin (subtopology euclidean C) S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2336 |
and hom: "S homeomorphic S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2337 |
by (metis that homeomorphic_closedin_convex) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2338 |
then have "S' retract_of C" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2339 |
using \<open>AR S\<close> by (simp add: AR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2340 |
then obtain r where "S' \<subseteq> C" and contr: "continuous_on C r" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2341 |
and "r ` C \<subseteq> S'" and rid: "\<And>x. x\<in>S' \<Longrightarrow> r x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2342 |
by (auto simp: retraction_def retract_of_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2343 |
obtain g h where "homeomorphism S S' g h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2344 |
using hom by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2345 |
then have "continuous_on (f ` T) g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2346 |
by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2347 |
then have contgf: "continuous_on T (g o f)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2348 |
by (metis continuous_on_compose contf) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2349 |
have gfTC: "(g \<circ> f) ` T \<subseteq> C" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2350 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2351 |
have "g ` S = S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2352 |
by (metis (no_types) \<open>homeomorphism S S' g h\<close> homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2353 |
with \<open>S' \<subseteq> C\<close> \<open>f ` T \<subseteq> S\<close> show ?thesis by force |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2354 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2355 |
obtain f' where f': "continuous_on U f'" "f' ` U \<subseteq> C" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2356 |
"\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2357 |
by (metis Dugundji [OF C cloUT contgf gfTC]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2358 |
show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2359 |
proof (rule_tac g = "h o r o f'" in that) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2360 |
show "continuous_on U (h \<circ> r \<circ> f')" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2361 |
apply (intro continuous_on_compose f') |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2362 |
using continuous_on_subset contr f' apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2363 |
by (meson \<open>homeomorphism S S' g h\<close> \<open>r ` C \<subseteq> S'\<close> continuous_on_subset \<open>f' ` U \<subseteq> C\<close> homeomorphism_def image_mono) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2364 |
show "(h \<circ> r \<circ> f') ` U \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2365 |
using \<open>homeomorphism S S' g h\<close> \<open>r ` C \<subseteq> S'\<close> \<open>f' ` U \<subseteq> C\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2366 |
by (fastforce simp: homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2367 |
show "\<And>x. x \<in> T \<Longrightarrow> (h \<circ> r \<circ> f') x = f x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2368 |
using \<open>homeomorphism S S' g h\<close> \<open>f ` T \<subseteq> S\<close> f' |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2369 |
by (auto simp: rid homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2370 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2371 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2372 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2373 |
lemma AR_imp_absolute_retract: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2374 |
fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2375 |
assumes "AR S" "S homeomorphic S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2376 |
and clo: "closedin (subtopology euclidean U) S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2377 |
shows "S' retract_of U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2378 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2379 |
obtain g h where hom: "homeomorphism S S' g h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2380 |
using assms by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2381 |
have h: "continuous_on S' h" " h ` S' \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2382 |
using hom homeomorphism_def apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2383 |
apply (metis hom equalityE homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2384 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2385 |
obtain h' where h': "continuous_on U h'" "h' ` U \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2386 |
and h'h: "\<And>x. x \<in> S' \<Longrightarrow> h' x = h x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2387 |
by (blast intro: AR_imp_absolute_extensor [OF \<open>AR S\<close> h clo]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2388 |
have [simp]: "S' \<subseteq> U" using clo closedin_limpt by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2389 |
show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2390 |
proof (simp add: retraction_def retract_of_def, intro exI conjI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2391 |
show "continuous_on U (g o h')" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2392 |
apply (intro continuous_on_compose h') |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2393 |
apply (meson hom continuous_on_subset h' homeomorphism_cont1) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2394 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2395 |
show "(g \<circ> h') ` U \<subseteq> S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2396 |
using h' by clarsimp (metis hom subsetD homeomorphism_def imageI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2397 |
show "\<forall>x\<in>S'. (g \<circ> h') x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2398 |
by clarsimp (metis h'h hom homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2399 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2400 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2401 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2402 |
lemma AR_imp_absolute_retract_UNIV: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2403 |
fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2404 |
assumes "AR S" and hom: "S homeomorphic S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2405 |
and clo: "closed S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2406 |
shows "S' retract_of UNIV" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2407 |
apply (rule AR_imp_absolute_retract [OF \<open>AR S\<close> hom]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2408 |
using clo closed_closedin by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2409 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2410 |
lemma absolute_extensor_imp_AR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2411 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2412 |
assumes "\<And>f :: 'a * real \<Rightarrow> 'a. |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2413 |
\<And>U T. \<lbrakk>continuous_on T f; f ` T \<subseteq> S; |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2414 |
closedin (subtopology euclidean U) T\<rbrakk> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2415 |
\<Longrightarrow> \<exists>g. continuous_on U g \<and> g ` U \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2416 |
shows "AR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2417 |
proof (clarsimp simp: AR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2418 |
fix U and T :: "('a * real) set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2419 |
assume "S homeomorphic T" and clo: "closedin (subtopology euclidean U) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2420 |
then obtain g h where hom: "homeomorphism S T g h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2421 |
by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2422 |
have h: "continuous_on T h" " h ` T \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2423 |
using hom homeomorphism_def apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2424 |
apply (metis hom equalityE homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2425 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2426 |
obtain h' where h': "continuous_on U h'" "h' ` U \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2427 |
and h'h: "\<forall>x\<in>T. h' x = h x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2428 |
using assms [OF h clo] by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2429 |
have [simp]: "T \<subseteq> U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2430 |
using clo closedin_imp_subset by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2431 |
show "T retract_of U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2432 |
proof (simp add: retraction_def retract_of_def, intro exI conjI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2433 |
show "continuous_on U (g o h')" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2434 |
apply (intro continuous_on_compose h') |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2435 |
apply (meson hom continuous_on_subset h' homeomorphism_cont1) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2436 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2437 |
show "(g \<circ> h') ` U \<subseteq> T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2438 |
using h' by clarsimp (metis hom subsetD homeomorphism_def imageI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2439 |
show "\<forall>x\<in>T. (g \<circ> h') x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2440 |
by clarsimp (metis h'h hom homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2441 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2442 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2443 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2444 |
lemma AR_eq_absolute_extensor: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2445 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2446 |
shows "AR S \<longleftrightarrow> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2447 |
(\<forall>f :: 'a * real \<Rightarrow> 'a. |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2448 |
\<forall>U T. continuous_on T f \<longrightarrow> f ` T \<subseteq> S \<longrightarrow> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2449 |
closedin (subtopology euclidean U) T \<longrightarrow> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2450 |
(\<exists>g. continuous_on U g \<and> g ` U \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2451 |
apply (rule iffI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2452 |
apply (metis AR_imp_absolute_extensor) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2453 |
apply (simp add: absolute_extensor_imp_AR) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2454 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2455 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2456 |
lemma AR_imp_retract: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2457 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2458 |
assumes "AR S \<and> closedin (subtopology euclidean U) S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2459 |
shows "S retract_of U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2460 |
using AR_imp_absolute_retract assms homeomorphic_refl by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2461 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2462 |
lemma AR_homeomorphic_AR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2463 |
fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2464 |
assumes "AR T" "S homeomorphic T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2465 |
shows "AR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2466 |
unfolding AR_def |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2467 |
by (metis assms AR_imp_absolute_retract homeomorphic_trans [of _ S] homeomorphic_sym) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2468 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2469 |
lemma homeomorphic_AR_iff_AR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2470 |
fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2471 |
shows "S homeomorphic T \<Longrightarrow> AR S \<longleftrightarrow> AR T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2472 |
by (metis AR_homeomorphic_AR homeomorphic_sym) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2473 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2474 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2475 |
proposition ANR_imp_absolute_neighbourhood_extensor: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2476 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2477 |
assumes "ANR S" and contf: "continuous_on T f" and "f ` T \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2478 |
and cloUT: "closedin (subtopology euclidean U) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2479 |
obtains V g where "T \<subseteq> V" "openin (subtopology euclidean U) V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2480 |
"continuous_on V g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2481 |
"g ` V \<subseteq> S" "\<And>x. x \<in> T \<Longrightarrow> g x = f x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2482 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2483 |
have "aff_dim S < int (DIM('b \<times> real))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2484 |
using aff_dim_le_DIM [of S] by simp |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2485 |
then obtain C and S' :: "('b * real) set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2486 |
where C: "convex C" "C \<noteq> {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2487 |
and cloCS: "closedin (subtopology euclidean C) S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2488 |
and hom: "S homeomorphic S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2489 |
by (metis that homeomorphic_closedin_convex) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2490 |
then obtain D where opD: "openin (subtopology euclidean C) D" and "S' retract_of D" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2491 |
using \<open>ANR S\<close> by (auto simp: ANR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2492 |
then obtain r where "S' \<subseteq> D" and contr: "continuous_on D r" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2493 |
and "r ` D \<subseteq> S'" and rid: "\<And>x. x \<in> S' \<Longrightarrow> r x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2494 |
by (auto simp: retraction_def retract_of_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2495 |
obtain g h where homgh: "homeomorphism S S' g h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2496 |
using hom by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2497 |
have "continuous_on (f ` T) g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2498 |
by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def homgh) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2499 |
then have contgf: "continuous_on T (g o f)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2500 |
by (intro continuous_on_compose contf) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2501 |
have gfTC: "(g \<circ> f) ` T \<subseteq> C" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2502 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2503 |
have "g ` S = S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2504 |
by (metis (no_types) homeomorphism_def homgh) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2505 |
then show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2506 |
by (metis (no_types) assms(3) cloCS closedin_def image_comp image_mono order.trans topspace_euclidean_subtopology) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2507 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2508 |
obtain f' where contf': "continuous_on U f'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2509 |
and "f' ` U \<subseteq> C" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2510 |
and eq: "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2511 |
by (metis Dugundji [OF C cloUT contgf gfTC]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2512 |
show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2513 |
proof (rule_tac V = "{x \<in> U. f' x \<in> D}" and g = "h o r o f'" in that) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2514 |
show "T \<subseteq> {x \<in> U. f' x \<in> D}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2515 |
using cloUT closedin_imp_subset \<open>S' \<subseteq> D\<close> \<open>f ` T \<subseteq> S\<close> eq homeomorphism_image1 homgh |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2516 |
by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2517 |
show ope: "openin (subtopology euclidean U) {x \<in> U. f' x \<in> D}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2518 |
using \<open>f' ` U \<subseteq> C\<close> by (auto simp: opD contf' continuous_openin_preimage) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2519 |
have conth: "continuous_on (r ` f' ` {x \<in> U. f' x \<in> D}) h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2520 |
apply (rule continuous_on_subset [of S']) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2521 |
using homeomorphism_def homgh apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2522 |
using \<open>r ` D \<subseteq> S'\<close> by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2523 |
show "continuous_on {x \<in> U. f' x \<in> D} (h \<circ> r \<circ> f')" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2524 |
apply (intro continuous_on_compose conth |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2525 |
continuous_on_subset [OF contr] continuous_on_subset [OF contf'], auto) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2526 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2527 |
show "(h \<circ> r \<circ> f') ` {x \<in> U. f' x \<in> D} \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2528 |
using \<open>homeomorphism S S' g h\<close> \<open>f' ` U \<subseteq> C\<close> \<open>r ` D \<subseteq> S'\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2529 |
by (auto simp: homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2530 |
show "\<And>x. x \<in> T \<Longrightarrow> (h \<circ> r \<circ> f') x = f x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2531 |
using \<open>homeomorphism S S' g h\<close> \<open>f ` T \<subseteq> S\<close> eq |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2532 |
by (auto simp: rid homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2533 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2534 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2535 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2536 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2537 |
corollary ANR_imp_absolute_neighbourhood_retract: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2538 |
fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2539 |
assumes "ANR S" "S homeomorphic S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2540 |
and clo: "closedin (subtopology euclidean U) S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2541 |
obtains V where "openin (subtopology euclidean U) V" "S' retract_of V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2542 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2543 |
obtain g h where hom: "homeomorphism S S' g h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2544 |
using assms by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2545 |
have h: "continuous_on S' h" " h ` S' \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2546 |
using hom homeomorphism_def apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2547 |
apply (metis hom equalityE homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2548 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2549 |
from ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo] |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2550 |
obtain V h' where "S' \<subseteq> V" and opUV: "openin (subtopology euclidean U) V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2551 |
and h': "continuous_on V h'" "h' ` V \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2552 |
and h'h:"\<And>x. x \<in> S' \<Longrightarrow> h' x = h x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2553 |
by (blast intro: ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2554 |
have "S' retract_of V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2555 |
proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>S' \<subseteq> V\<close>) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2556 |
show "continuous_on V (g o h')" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2557 |
apply (intro continuous_on_compose h') |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2558 |
apply (meson hom continuous_on_subset h' homeomorphism_cont1) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2559 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2560 |
show "(g \<circ> h') ` V \<subseteq> S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2561 |
using h' by clarsimp (metis hom subsetD homeomorphism_def imageI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2562 |
show "\<forall>x\<in>S'. (g \<circ> h') x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2563 |
by clarsimp (metis h'h hom homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2564 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2565 |
then show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2566 |
by (rule that [OF opUV]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2567 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2568 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2569 |
corollary ANR_imp_absolute_neighbourhood_retract_UNIV: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2570 |
fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2571 |
assumes "ANR S" and hom: "S homeomorphic S'" and clo: "closed S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2572 |
obtains V where "open V" "S' retract_of V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2573 |
using ANR_imp_absolute_neighbourhood_retract [OF \<open>ANR S\<close> hom] |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2574 |
by (metis clo closed_closedin open_openin subtopology_UNIV) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2575 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2576 |
lemma absolute_neighbourhood_extensor_imp_ANR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2577 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2578 |
assumes "\<And>f :: 'a * real \<Rightarrow> 'a. |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2579 |
\<And>U T. \<lbrakk>continuous_on T f; f ` T \<subseteq> S; |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2580 |
closedin (subtopology euclidean U) T\<rbrakk> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2581 |
\<Longrightarrow> \<exists>V g. T \<subseteq> V \<and> openin (subtopology euclidean U) V \<and> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2582 |
continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2583 |
shows "ANR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2584 |
proof (clarsimp simp: ANR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2585 |
fix U and T :: "('a * real) set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2586 |
assume "S homeomorphic T" and clo: "closedin (subtopology euclidean U) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2587 |
then obtain g h where hom: "homeomorphism S T g h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2588 |
by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2589 |
have h: "continuous_on T h" " h ` T \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2590 |
using hom homeomorphism_def apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2591 |
apply (metis hom equalityE homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2592 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2593 |
obtain V h' where "T \<subseteq> V" and opV: "openin (subtopology euclidean U) V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2594 |
and h': "continuous_on V h'" "h' ` V \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2595 |
and h'h: "\<forall>x\<in>T. h' x = h x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2596 |
using assms [OF h clo] by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2597 |
have [simp]: "T \<subseteq> U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2598 |
using clo closedin_imp_subset by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2599 |
have "T retract_of V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2600 |
proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>T \<subseteq> V\<close>) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2601 |
show "continuous_on V (g o h')" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2602 |
apply (intro continuous_on_compose h') |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2603 |
apply (meson hom continuous_on_subset h' homeomorphism_cont1) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2604 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2605 |
show "(g \<circ> h') ` V \<subseteq> T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2606 |
using h' by clarsimp (metis hom subsetD homeomorphism_def imageI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2607 |
show "\<forall>x\<in>T. (g \<circ> h') x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2608 |
by clarsimp (metis h'h hom homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2609 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2610 |
then show "\<exists>V. openin (subtopology euclidean U) V \<and> T retract_of V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2611 |
using opV by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2612 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2613 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2614 |
lemma ANR_eq_absolute_neighbourhood_extensor: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2615 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2616 |
shows "ANR S \<longleftrightarrow> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2617 |
(\<forall>f :: 'a * real \<Rightarrow> 'a. |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2618 |
\<forall>U T. continuous_on T f \<longrightarrow> f ` T \<subseteq> S \<longrightarrow> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2619 |
closedin (subtopology euclidean U) T \<longrightarrow> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2620 |
(\<exists>V g. T \<subseteq> V \<and> openin (subtopology euclidean U) V \<and> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2621 |
continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2622 |
apply (rule iffI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2623 |
apply (metis ANR_imp_absolute_neighbourhood_extensor) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2624 |
apply (simp add: absolute_neighbourhood_extensor_imp_ANR) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2625 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2626 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2627 |
lemma ANR_imp_neighbourhood_retract: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2628 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2629 |
assumes "ANR S" "closedin (subtopology euclidean U) S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2630 |
obtains V where "openin (subtopology euclidean U) V" "S retract_of V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2631 |
using ANR_imp_absolute_neighbourhood_retract assms homeomorphic_refl by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2632 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2633 |
lemma ANR_imp_absolute_closed_neighbourhood_retract: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2634 |
fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2635 |
assumes "ANR S" "S homeomorphic S'" and US': "closedin (subtopology euclidean U) S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2636 |
obtains V W |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2637 |
where "openin (subtopology euclidean U) V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2638 |
"closedin (subtopology euclidean U) W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2639 |
"S' \<subseteq> V" "V \<subseteq> W" "S' retract_of W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2640 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2641 |
obtain Z where "openin (subtopology euclidean U) Z" and S'Z: "S' retract_of Z" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2642 |
by (blast intro: assms ANR_imp_absolute_neighbourhood_retract) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2643 |
then have UUZ: "closedin (subtopology euclidean U) (U - Z)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2644 |
by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2645 |
have "S' \<inter> (U - Z) = {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2646 |
using \<open>S' retract_of Z\<close> closedin_retract closedin_subtopology by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2647 |
then obtain V W |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2648 |
where "openin (subtopology euclidean U) V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2649 |
and "openin (subtopology euclidean U) W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2650 |
and "S' \<subseteq> V" "U - Z \<subseteq> W" "V \<inter> W = {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2651 |
using separation_normal_local [OF US' UUZ] by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2652 |
moreover have "S' retract_of U - W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2653 |
apply (rule retract_of_subset [OF S'Z]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2654 |
using US' \<open>S' \<subseteq> V\<close> \<open>V \<inter> W = {}\<close> closedin_subset apply fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2655 |
using Diff_subset_conv \<open>U - Z \<subseteq> W\<close> by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2656 |
ultimately show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2657 |
apply (rule_tac V=V and W = "U-W" in that) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2658 |
using openin_imp_subset apply (force simp:)+ |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2659 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2660 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2661 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2662 |
lemma ANR_imp_closed_neighbourhood_retract: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2663 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2664 |
assumes "ANR S" "closedin (subtopology euclidean U) S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2665 |
obtains V W where "openin (subtopology euclidean U) V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2666 |
"closedin (subtopology euclidean U) W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2667 |
"S \<subseteq> V" "V \<subseteq> W" "S retract_of W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2668 |
by (meson ANR_imp_absolute_closed_neighbourhood_retract assms homeomorphic_refl) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2669 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2670 |
lemma ANR_homeomorphic_ANR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2671 |
fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2672 |
assumes "ANR T" "S homeomorphic T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2673 |
shows "ANR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2674 |
unfolding ANR_def |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2675 |
by (metis assms ANR_imp_absolute_neighbourhood_retract homeomorphic_trans [of _ S] homeomorphic_sym) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2676 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2677 |
lemma homeomorphic_ANR_iff_ANR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2678 |
fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2679 |
shows "S homeomorphic T \<Longrightarrow> ANR S \<longleftrightarrow> ANR T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2680 |
by (metis ANR_homeomorphic_ANR homeomorphic_sym) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2681 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2682 |
subsection\<open> Analogous properties of ENRs.\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2683 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2684 |
proposition ENR_imp_absolute_neighbourhood_retract: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2685 |
fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2686 |
assumes "ENR S" and hom: "S homeomorphic S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2687 |
and "S' \<subseteq> U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2688 |
obtains V where "openin (subtopology euclidean U) V" "S' retract_of V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2689 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2690 |
obtain X where "open X" "S retract_of X" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2691 |
using \<open>ENR S\<close> by (auto simp: ENR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2692 |
then obtain r where "retraction X S r" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2693 |
by (auto simp: retract_of_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2694 |
have "locally compact S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2695 |
using retract_of_locally_compact open_imp_locally_compact |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2696 |
homeomorphic_local_compactness \<open>S retract_of X\<close> \<open>open X\<close> hom by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2697 |
then obtain W where UW: "openin (subtopology euclidean U) W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2698 |
and WS': "closedin (subtopology euclidean W) S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2699 |
apply (rule locally_compact_closedin_open) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2700 |
apply (rename_tac W) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2701 |
apply (rule_tac W = "U \<inter> W" in that, blast) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2702 |
by (simp add: \<open>S' \<subseteq> U\<close> closedin_limpt) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2703 |
obtain f g where hom: "homeomorphism S S' f g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2704 |
using assms by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2705 |
have contg: "continuous_on S' g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2706 |
using hom homeomorphism_def by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2707 |
moreover have "g ` S' \<subseteq> S" by (metis hom equalityE homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2708 |
ultimately obtain h where conth: "continuous_on W h" and hg: "\<And>x. x \<in> S' \<Longrightarrow> h x = g x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2709 |
using Tietze_unbounded [of S' g W] WS' by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2710 |
have "W \<subseteq> U" using UW openin_open by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2711 |
have "S' \<subseteq> W" using WS' closedin_closed by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2712 |
have him: "\<And>x. x \<in> S' \<Longrightarrow> h x \<in> X" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2713 |
by (metis (no_types) \<open>S retract_of X\<close> hg hom homeomorphism_def image_insert insert_absorb insert_iff retract_of_imp_subset subset_eq) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2714 |
have "S' retract_of {x \<in> W. h x \<in> X}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2715 |
proof (simp add: retraction_def retract_of_def, intro exI conjI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2716 |
show "S' \<subseteq> {x \<in> W. h x \<in> X}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2717 |
using him WS' closedin_imp_subset by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2718 |
show "continuous_on {x \<in> W. h x \<in> X} (f o r o h)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2719 |
proof (intro continuous_on_compose) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2720 |
show "continuous_on {x \<in> W. h x \<in> X} h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2721 |
by (metis (no_types) Collect_restrict conth continuous_on_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2722 |
show "continuous_on (h ` {x \<in> W. h x \<in> X}) r" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2723 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2724 |
have "h ` {b \<in> W. h b \<in> X} \<subseteq> X" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2725 |
by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2726 |
then show "continuous_on (h ` {b \<in> W. h b \<in> X}) r" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2727 |
by (meson \<open>retraction X S r\<close> continuous_on_subset retraction) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2728 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2729 |
show "continuous_on (r ` h ` {x \<in> W. h x \<in> X}) f" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2730 |
apply (rule continuous_on_subset [of S]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2731 |
using hom homeomorphism_def apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2732 |
apply clarify |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2733 |
apply (meson \<open>retraction X S r\<close> subsetD imageI retraction_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2734 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2735 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2736 |
show "(f \<circ> r \<circ> h) ` {x \<in> W. h x \<in> X} \<subseteq> S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2737 |
using \<open>retraction X S r\<close> hom |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2738 |
by (auto simp: retraction_def homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2739 |
show "\<forall>x\<in>S'. (f \<circ> r \<circ> h) x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2740 |
using \<open>retraction X S r\<close> hom by (auto simp: retraction_def homeomorphism_def hg) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2741 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2742 |
then show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2743 |
apply (rule_tac V = "{x. x \<in> W \<and> h x \<in> X}" in that) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2744 |
apply (rule openin_trans [OF _ UW]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2745 |
using \<open>continuous_on W h\<close> \<open>open X\<close> continuous_openin_preimage_eq apply blast+ |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2746 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2747 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2748 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2749 |
corollary ENR_imp_absolute_neighbourhood_retract_UNIV: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2750 |
fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2751 |
assumes "ENR S" "S homeomorphic S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2752 |
obtains T' where "open T'" "S' retract_of T'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2753 |
by (metis ENR_imp_absolute_neighbourhood_retract UNIV_I assms(1) assms(2) open_openin subsetI subtopology_UNIV) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2754 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2755 |
lemma ENR_homeomorphic_ENR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2756 |
fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2757 |
assumes "ENR T" "S homeomorphic T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2758 |
shows "ENR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2759 |
unfolding ENR_def |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2760 |
by (meson ENR_imp_absolute_neighbourhood_retract_UNIV assms homeomorphic_sym) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2761 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2762 |
lemma homeomorphic_ENR_iff_ENR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2763 |
fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2764 |
assumes "S homeomorphic T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2765 |
shows "ENR S \<longleftrightarrow> ENR T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2766 |
by (meson ENR_homeomorphic_ENR assms homeomorphic_sym) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2767 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2768 |
lemma ENR_translation: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2769 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2770 |
shows "ENR(image (\<lambda>x. a + x) S) \<longleftrightarrow> ENR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2771 |
by (meson homeomorphic_sym homeomorphic_translation homeomorphic_ENR_iff_ENR) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2772 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2773 |
lemma ENR_linear_image_eq: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2774 |
fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2775 |
assumes "linear f" "inj f" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2776 |
shows "ENR (image f S) \<longleftrightarrow> ENR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2777 |
apply (rule homeomorphic_ENR_iff_ENR) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2778 |
using assms homeomorphic_sym linear_homeomorphic_image by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2779 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2780 |
subsection\<open>Some relations among the concepts\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2781 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2782 |
text\<open>We also relate AR to being a retract of UNIV, which is often a more convenient proxy in the closed case.\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2783 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2784 |
lemma AR_imp_ANR: "AR S \<Longrightarrow> ANR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2785 |
using ANR_def AR_def by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2786 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2787 |
lemma ENR_imp_ANR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2788 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2789 |
shows "ENR S \<Longrightarrow> ANR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2790 |
apply (simp add: ANR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2791 |
by (metis ENR_imp_absolute_neighbourhood_retract closedin_imp_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2792 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2793 |
lemma ENR_ANR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2794 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2795 |
shows "ENR S \<longleftrightarrow> ANR S \<and> locally compact S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2796 |
proof |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2797 |
assume "ENR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2798 |
then have "locally compact S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2799 |
using ENR_def open_imp_locally_compact retract_of_locally_compact by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2800 |
then show "ANR S \<and> locally compact S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2801 |
using ENR_imp_ANR \<open>ENR S\<close> by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2802 |
next |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2803 |
assume "ANR S \<and> locally compact S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2804 |
then have "ANR S" "locally compact S" by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2805 |
then obtain T :: "('a * real) set" where "closed T" "S homeomorphic T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2806 |
using locally_compact_homeomorphic_closed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2807 |
by (metis DIM_prod DIM_real Suc_eq_plus1 lessI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2808 |
then show "ENR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2809 |
using \<open>ANR S\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2810 |
apply (simp add: ANR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2811 |
apply (drule_tac x=UNIV in spec) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2812 |
apply (drule_tac x=T in spec) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2813 |
apply (auto simp: closed_closedin) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2814 |
apply (meson ENR_def ENR_homeomorphic_ENR open_openin) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2815 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2816 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2817 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2818 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2819 |
proposition AR_ANR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2820 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2821 |
shows "AR S \<longleftrightarrow> ANR S \<and> contractible S \<and> S \<noteq> {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2822 |
(is "?lhs = ?rhs") |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2823 |
proof |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2824 |
assume ?lhs |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2825 |
obtain C and S' :: "('a * real) set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2826 |
where "convex C" "C \<noteq> {}" "closedin (subtopology euclidean C) S'" "S homeomorphic S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2827 |
apply (rule homeomorphic_closedin_convex [of S, where 'n = "'a * real"]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2828 |
using aff_dim_le_DIM [of S] by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2829 |
with \<open>AR S\<close> have "contractible S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2830 |
apply (simp add: AR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2831 |
apply (drule_tac x=C in spec) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2832 |
apply (drule_tac x="S'" in spec, simp) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2833 |
using convex_imp_contractible homeomorphic_contractible_eq retract_of_contractible by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2834 |
with \<open>AR S\<close> show ?rhs |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2835 |
apply (auto simp: AR_imp_ANR) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2836 |
apply (force simp: AR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2837 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2838 |
next |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2839 |
assume ?rhs |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2840 |
then obtain a and h:: "real \<times> 'a \<Rightarrow> 'a" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2841 |
where conth: "continuous_on ({0..1} \<times> S) h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2842 |
and hS: "h ` ({0..1} \<times> S) \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2843 |
and [simp]: "\<And>x. h(0, x) = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2844 |
and [simp]: "\<And>x. h(1, x) = a" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2845 |
and "ANR S" "S \<noteq> {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2846 |
by (auto simp: contractible_def homotopic_with_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2847 |
then have "a \<in> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2848 |
by (metis all_not_in_conv atLeastAtMost_iff image_subset_iff mem_Sigma_iff order_refl zero_le_one) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2849 |
have "\<exists>g. continuous_on W g \<and> g ` W \<subseteq> S \<and> (\<forall>x\<in>T. g x = f x)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2850 |
if f: "continuous_on T f" "f ` T \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2851 |
and WT: "closedin (subtopology euclidean W) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2852 |
for W T and f :: "'a \<times> real \<Rightarrow> 'a" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2853 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2854 |
obtain U g |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2855 |
where "T \<subseteq> U" and WU: "openin (subtopology euclidean W) U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2856 |
and contg: "continuous_on U g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2857 |
and "g ` U \<subseteq> S" and gf: "\<And>x. x \<in> T \<Longrightarrow> g x = f x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2858 |
using iffD1 [OF ANR_eq_absolute_neighbourhood_extensor \<open>ANR S\<close>, rule_format, OF f WT] |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2859 |
by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2860 |
have WWU: "closedin (subtopology euclidean W) (W - U)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2861 |
using WU closedin_diff by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2862 |
moreover have "(W - U) \<inter> T = {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2863 |
using \<open>T \<subseteq> U\<close> by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2864 |
ultimately obtain V V' |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2865 |
where WV': "openin (subtopology euclidean W) V'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2866 |
and WV: "openin (subtopology euclidean W) V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2867 |
and "W - U \<subseteq> V'" "T \<subseteq> V" "V' \<inter> V = {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2868 |
using separation_normal_local [of W "W-U" T] WT by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2869 |
then have WVT: "T \<inter> (W - V) = {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2870 |
by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2871 |
have WWV: "closedin (subtopology euclidean W) (W - V)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2872 |
using WV closedin_diff by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2873 |
obtain j :: " 'a \<times> real \<Rightarrow> real" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2874 |
where contj: "continuous_on W j" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2875 |
and j: "\<And>x. x \<in> W \<Longrightarrow> j x \<in> {0..1}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2876 |
and j0: "\<And>x. x \<in> W - V \<Longrightarrow> j x = 1" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2877 |
and j1: "\<And>x. x \<in> T \<Longrightarrow> j x = 0" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2878 |
by (rule Urysohn_local [OF WT WWV WVT, of 0 "1::real"]) (auto simp: in_segment) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2879 |
have Weq: "W = (W - V) \<union> (W - V')" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2880 |
using \<open>V' \<inter> V = {}\<close> by force |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2881 |
show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2882 |
proof (intro conjI exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2883 |
have *: "continuous_on (W - V') (\<lambda>x. h (j x, g x))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2884 |
apply (rule continuous_on_compose2 [OF conth continuous_on_Pair]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2885 |
apply (rule continuous_on_subset [OF contj Diff_subset]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2886 |
apply (rule continuous_on_subset [OF contg]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2887 |
apply (metis Diff_subset_conv Un_commute \<open>W - U \<subseteq> V'\<close>) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2888 |
using j \<open>g ` U \<subseteq> S\<close> \<open>W - U \<subseteq> V'\<close> apply fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2889 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2890 |
show "continuous_on W (\<lambda>x. if x \<in> W - V then a else h (j x, g x))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2891 |
apply (subst Weq) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2892 |
apply (rule continuous_on_cases_local) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2893 |
apply (simp_all add: Weq [symmetric] WWV continuous_on_const *) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2894 |
using WV' closedin_diff apply fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2895 |
apply (auto simp: j0 j1) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2896 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2897 |
next |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2898 |
have "h (j (x, y), g (x, y)) \<in> S" if "(x, y) \<in> W" "(x, y) \<in> V" for x y |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2899 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2900 |
have "j(x, y) \<in> {0..1}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2901 |
using j that by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2902 |
moreover have "g(x, y) \<in> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2903 |
using \<open>V' \<inter> V = {}\<close> \<open>W - U \<subseteq> V'\<close> \<open>g ` U \<subseteq> S\<close> that by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2904 |
ultimately show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2905 |
using hS by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2906 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2907 |
with \<open>a \<in> S\<close> \<open>g ` U \<subseteq> S\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2908 |
show "(\<lambda>x. if x \<in> W - V then a else h (j x, g x)) ` W \<subseteq> S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2909 |
by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2910 |
next |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2911 |
show "\<forall>x\<in>T. (if x \<in> W - V then a else h (j x, g x)) = f x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2912 |
using \<open>T \<subseteq> V\<close> by (auto simp: j0 j1 gf) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2913 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2914 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2915 |
then show ?lhs |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2916 |
by (simp add: AR_eq_absolute_extensor) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2917 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2918 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2919 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2920 |
lemma ANR_retract_of_ANR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2921 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2922 |
assumes "ANR T" "S retract_of T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2923 |
shows "ANR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2924 |
using assms |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2925 |
apply (simp add: ANR_eq_absolute_neighbourhood_extensor retract_of_def retraction_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2926 |
apply (clarsimp elim!: all_forward) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2927 |
apply (erule impCE, metis subset_trans) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2928 |
apply (clarsimp elim!: ex_forward) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2929 |
apply (rule_tac x="r o g" in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2930 |
by (metis comp_apply continuous_on_compose continuous_on_subset subsetD imageI image_comp image_mono subset_trans) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2931 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2932 |
lemma AR_retract_of_AR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2933 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2934 |
shows "\<lbrakk>AR T; S retract_of T\<rbrakk> \<Longrightarrow> AR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2935 |
using ANR_retract_of_ANR AR_ANR retract_of_contractible by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2936 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2937 |
lemma ENR_retract_of_ENR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2938 |
"\<lbrakk>ENR T; S retract_of T\<rbrakk> \<Longrightarrow> ENR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2939 |
by (meson ENR_def retract_of_trans) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2940 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2941 |
lemma retract_of_UNIV: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2942 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2943 |
shows "S retract_of UNIV \<longleftrightarrow> AR S \<and> closed S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2944 |
by (metis AR_ANR AR_imp_retract ENR_def ENR_imp_ANR closed_UNIV closed_closedin contractible_UNIV empty_not_UNIV open_UNIV retract_of_closed retract_of_contractible retract_of_empty(1) subtopology_UNIV) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2945 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2946 |
lemma compact_AR [simp]: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2947 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2948 |
shows "compact S \<and> AR S \<longleftrightarrow> compact S \<and> S retract_of UNIV" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2949 |
using compact_imp_closed retract_of_UNIV by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2950 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2951 |
subsection\<open>More properties of ARs, ANRs and ENRs\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2952 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2953 |
lemma not_AR_empty [simp]: "~ AR({})" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2954 |
by (auto simp: AR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2955 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2956 |
lemma ENR_empty [simp]: "ENR {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2957 |
by (simp add: ENR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2958 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2959 |
lemma ANR_empty [simp]: "ANR ({} :: 'a::euclidean_space set)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2960 |
by (simp add: ENR_imp_ANR) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2961 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2962 |
lemma convex_imp_AR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2963 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2964 |
shows "\<lbrakk>convex S; S \<noteq> {}\<rbrakk> \<Longrightarrow> AR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2965 |
apply (rule absolute_extensor_imp_AR) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2966 |
apply (rule Dugundji, assumption+) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2967 |
by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2968 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2969 |
lemma convex_imp_ANR: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2970 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2971 |
shows "convex S \<Longrightarrow> ANR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2972 |
using ANR_empty AR_imp_ANR convex_imp_AR by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2973 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2974 |
lemma ENR_convex_closed: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2975 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2976 |
shows "\<lbrakk>closed S; convex S\<rbrakk> \<Longrightarrow> ENR S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2977 |
using ENR_def ENR_empty convex_imp_AR retract_of_UNIV by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2978 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2979 |
lemma AR_UNIV [simp]: "AR (UNIV :: 'a::euclidean_space set)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2980 |
using retract_of_UNIV by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2981 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2982 |
lemma ANR_UNIV [simp]: "ANR (UNIV :: 'a::euclidean_space set)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2983 |
by (simp add: AR_imp_ANR) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2984 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2985 |
lemma ENR_UNIV [simp]:"ENR UNIV" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2986 |
using ENR_def by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2987 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2988 |
lemma AR_singleton: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2989 |
fixes a :: "'a::euclidean_space" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2990 |
shows "AR {a}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2991 |
using retract_of_UNIV by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2992 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2993 |
lemma ANR_singleton: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2994 |
fixes a :: "'a::euclidean_space" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2995 |
shows "ANR {a}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2996 |
by (simp add: AR_imp_ANR AR_singleton) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2997 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2998 |
lemma ENR_singleton: "ENR {a}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
2999 |
using ENR_def by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3000 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3001 |
subsection\<open>ARs closed under union\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3002 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3003 |
lemma AR_closed_Un_local_aux: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3004 |
fixes U :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3005 |
assumes "closedin (subtopology euclidean U) S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3006 |
"closedin (subtopology euclidean U) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3007 |
"AR S" "AR T" "AR(S \<inter> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3008 |
shows "(S \<union> T) retract_of U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3009 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3010 |
have "S \<inter> T \<noteq> {}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3011 |
using assms AR_def by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3012 |
have "S \<subseteq> U" "T \<subseteq> U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3013 |
using assms by (auto simp: closedin_imp_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3014 |
define S' where "S' \<equiv> {x \<in> U. setdist {x} S \<le> setdist {x} T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3015 |
define T' where "T' \<equiv> {x \<in> U. setdist {x} T \<le> setdist {x} S}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3016 |
define W where "W \<equiv> {x \<in> U. setdist {x} S = setdist {x} T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3017 |
have US': "closedin (subtopology euclidean U) S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3018 |
using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} S - setdist {x} T" "{..0}"] |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3019 |
by (simp add: S'_def continuous_intros) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3020 |
have UT': "closedin (subtopology euclidean U) T'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3021 |
using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} T - setdist {x} S" "{..0}"] |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3022 |
by (simp add: T'_def continuous_intros) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3023 |
have "S \<subseteq> S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3024 |
using S'_def \<open>S \<subseteq> U\<close> setdist_sing_in_set by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3025 |
have "T \<subseteq> T'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3026 |
using T'_def \<open>T \<subseteq> U\<close> setdist_sing_in_set by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3027 |
have "S \<inter> T \<subseteq> W" "W \<subseteq> U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3028 |
using \<open>S \<subseteq> U\<close> by (auto simp: W_def setdist_sing_in_set) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3029 |
have "(S \<inter> T) retract_of W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3030 |
apply (rule AR_imp_absolute_retract [OF \<open>AR(S \<inter> T)\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3031 |
apply (simp add: homeomorphic_refl) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3032 |
apply (rule closedin_subset_trans [of U]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3033 |
apply (simp_all add: assms closedin_Int \<open>S \<inter> T \<subseteq> W\<close> \<open>W \<subseteq> U\<close>) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3034 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3035 |
then obtain r0 |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3036 |
where "S \<inter> T \<subseteq> W" and contr0: "continuous_on W r0" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3037 |
and "r0 ` W \<subseteq> S \<inter> T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3038 |
and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3039 |
by (auto simp: retract_of_def retraction_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3040 |
have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3041 |
using setdist_eq_0_closedin \<open>S \<inter> T \<noteq> {}\<close> assms |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3042 |
by (force simp: W_def setdist_sing_in_set) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3043 |
have "S' \<inter> T' = W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3044 |
by (auto simp: S'_def T'_def W_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3045 |
then have cloUW: "closedin (subtopology euclidean U) W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3046 |
using closedin_Int US' UT' by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3047 |
define r where "r \<equiv> \<lambda>x. if x \<in> W then r0 x else x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3048 |
have "r ` (W \<union> S) \<subseteq> S" "r ` (W \<union> T) \<subseteq> T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3049 |
using \<open>r0 ` W \<subseteq> S \<inter> T\<close> r_def by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3050 |
have contr: "continuous_on (W \<union> (S \<union> T)) r" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3051 |
unfolding r_def |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3052 |
proof (rule continuous_on_cases_local [OF _ _ contr0 continuous_on_id]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3053 |
show "closedin (subtopology euclidean (W \<union> (S \<union> T))) W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3054 |
using \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W \<subseteq> U\<close> \<open>closedin (subtopology euclidean U) W\<close> closedin_subset_trans by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3055 |
show "closedin (subtopology euclidean (W \<union> (S \<union> T))) (S \<union> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3056 |
by (meson \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W \<subseteq> U\<close> assms closedin_Un closedin_subset_trans sup.bounded_iff sup.cobounded2) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3057 |
show "\<And>x. x \<in> W \<and> x \<notin> W \<or> x \<in> S \<union> T \<and> x \<in> W \<Longrightarrow> r0 x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3058 |
by (auto simp: ST) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3059 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3060 |
have cloUWS: "closedin (subtopology euclidean U) (W \<union> S)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3061 |
by (simp add: cloUW assms closedin_Un) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3062 |
obtain g where contg: "continuous_on U g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3063 |
and "g ` U \<subseteq> S" and geqr: "\<And>x. x \<in> W \<union> S \<Longrightarrow> g x = r x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3064 |
apply (rule AR_imp_absolute_extensor [OF \<open>AR S\<close> _ _ cloUWS]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3065 |
apply (rule continuous_on_subset [OF contr]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3066 |
using \<open>r ` (W \<union> S) \<subseteq> S\<close> apply auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3067 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3068 |
have cloUWT: "closedin (subtopology euclidean U) (W \<union> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3069 |
by (simp add: cloUW assms closedin_Un) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3070 |
obtain h where conth: "continuous_on U h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3071 |
and "h ` U \<subseteq> T" and heqr: "\<And>x. x \<in> W \<union> T \<Longrightarrow> h x = r x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3072 |
apply (rule AR_imp_absolute_extensor [OF \<open>AR T\<close> _ _ cloUWT]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3073 |
apply (rule continuous_on_subset [OF contr]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3074 |
using \<open>r ` (W \<union> T) \<subseteq> T\<close> apply auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3075 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3076 |
have "U = S' \<union> T'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3077 |
by (force simp: S'_def T'_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3078 |
then have cont: "continuous_on U (\<lambda>x. if x \<in> S' then g x else h x)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3079 |
apply (rule ssubst) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3080 |
apply (rule continuous_on_cases_local) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3081 |
using US' UT' \<open>S' \<inter> T' = W\<close> \<open>U = S' \<union> T'\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3082 |
contg conth continuous_on_subset geqr heqr apply auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3083 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3084 |
have UST: "(\<lambda>x. if x \<in> S' then g x else h x) ` U \<subseteq> S \<union> T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3085 |
using \<open>g ` U \<subseteq> S\<close> \<open>h ` U \<subseteq> T\<close> by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3086 |
show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3087 |
apply (simp add: retract_of_def retraction_def \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close>) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3088 |
apply (rule_tac x="\<lambda>x. if x \<in> S' then g x else h x" in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3089 |
apply (intro conjI cont UST) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3090 |
by (metis IntI ST Un_iff \<open>S \<subseteq> S'\<close> \<open>S' \<inter> T' = W\<close> \<open>T \<subseteq> T'\<close> subsetD geqr heqr r0 r_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3091 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3092 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3093 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3094 |
proposition AR_closed_Un_local: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3095 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3096 |
assumes STS: "closedin (subtopology euclidean (S \<union> T)) S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3097 |
and STT: "closedin (subtopology euclidean (S \<union> T)) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3098 |
and "AR S" "AR T" "AR(S \<inter> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3099 |
shows "AR(S \<union> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3100 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3101 |
have "C retract_of U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3102 |
if hom: "S \<union> T homeomorphic C" and UC: "closedin (subtopology euclidean U) C" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3103 |
for U and C :: "('a * real) set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3104 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3105 |
obtain f g where hom: "homeomorphism (S \<union> T) C f g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3106 |
using hom by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3107 |
have US: "closedin (subtopology euclidean U) {x \<in> C. g x \<in> S}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3108 |
apply (rule closedin_trans [OF _ UC]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3109 |
apply (rule continuous_closedin_preimage_gen [OF _ _ STS]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3110 |
using hom homeomorphism_def apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3111 |
apply (metis hom homeomorphism_def set_eq_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3112 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3113 |
have UT: "closedin (subtopology euclidean U) {x \<in> C. g x \<in> T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3114 |
apply (rule closedin_trans [OF _ UC]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3115 |
apply (rule continuous_closedin_preimage_gen [OF _ _ STT]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3116 |
using hom homeomorphism_def apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3117 |
apply (metis hom homeomorphism_def set_eq_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3118 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3119 |
have ARS: "AR {x \<in> C. g x \<in> S}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3120 |
apply (rule AR_homeomorphic_AR [OF \<open>AR S\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3121 |
apply (simp add: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3122 |
apply (rule_tac x=g in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3123 |
apply (rule_tac x=f in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3124 |
using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3125 |
apply (rule_tac x="f x" in image_eqI, auto) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3126 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3127 |
have ART: "AR {x \<in> C. g x \<in> T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3128 |
apply (rule AR_homeomorphic_AR [OF \<open>AR T\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3129 |
apply (simp add: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3130 |
apply (rule_tac x=g in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3131 |
apply (rule_tac x=f in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3132 |
using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3133 |
apply (rule_tac x="f x" in image_eqI, auto) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3134 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3135 |
have ARI: "AR ({x \<in> C. g x \<in> S} \<inter> {x \<in> C. g x \<in> T})" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3136 |
apply (rule AR_homeomorphic_AR [OF \<open>AR (S \<inter> T)\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3137 |
apply (simp add: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3138 |
apply (rule_tac x=g in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3139 |
apply (rule_tac x=f in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3140 |
using hom |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3141 |
apply (auto simp: homeomorphism_def elim!: continuous_on_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3142 |
apply (rule_tac x="f x" in image_eqI, auto) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3143 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3144 |
have "C = {x \<in> C. g x \<in> S} \<union> {x \<in> C. g x \<in> T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3145 |
using hom by (auto simp: homeomorphism_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3146 |
then show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3147 |
by (metis AR_closed_Un_local_aux [OF US UT ARS ART ARI]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3148 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3149 |
then show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3150 |
by (force simp: AR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3151 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3152 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3153 |
corollary AR_closed_Un: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3154 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3155 |
shows "\<lbrakk>closed S; closed T; AR S; AR T; AR (S \<inter> T)\<rbrakk> \<Longrightarrow> AR (S \<union> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3156 |
by (metis AR_closed_Un_local_aux closed_closedin retract_of_UNIV subtopology_UNIV) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3157 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3158 |
subsection\<open>ANRs closed under union\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3159 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3160 |
lemma ANR_closed_Un_local_aux: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3161 |
fixes U :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3162 |
assumes US: "closedin (subtopology euclidean U) S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3163 |
and UT: "closedin (subtopology euclidean U) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3164 |
and "ANR S" "ANR T" "ANR(S \<inter> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3165 |
obtains V where "openin (subtopology euclidean U) V" "(S \<union> T) retract_of V" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3166 |
proof (cases "S = {} \<or> T = {}") |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3167 |
case True with assms that show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3168 |
by (auto simp: intro: ANR_imp_neighbourhood_retract) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3169 |
next |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3170 |
case False |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3171 |
then have [simp]: "S \<noteq> {}" "T \<noteq> {}" by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3172 |
have "S \<subseteq> U" "T \<subseteq> U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3173 |
using assms by (auto simp: closedin_imp_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3174 |
define S' where "S' \<equiv> {x \<in> U. setdist {x} S \<le> setdist {x} T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3175 |
define T' where "T' \<equiv> {x \<in> U. setdist {x} T \<le> setdist {x} S}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3176 |
define W where "W \<equiv> {x \<in> U. setdist {x} S = setdist {x} T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3177 |
have cloUS': "closedin (subtopology euclidean U) S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3178 |
using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} S - setdist {x} T" "{..0}"] |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3179 |
by (simp add: S'_def continuous_intros) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3180 |
have cloUT': "closedin (subtopology euclidean U) T'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3181 |
using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} T - setdist {x} S" "{..0}"] |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3182 |
by (simp add: T'_def continuous_intros) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3183 |
have "S \<subseteq> S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3184 |
using S'_def \<open>S \<subseteq> U\<close> setdist_sing_in_set by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3185 |
have "T \<subseteq> T'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3186 |
using T'_def \<open>T \<subseteq> U\<close> setdist_sing_in_set by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3187 |
have "S' \<union> T' = U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3188 |
by (auto simp: S'_def T'_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3189 |
have "W \<subseteq> S'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3190 |
by (simp add: Collect_mono S'_def W_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3191 |
have "W \<subseteq> T'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3192 |
by (simp add: Collect_mono T'_def W_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3193 |
have ST_W: "S \<inter> T \<subseteq> W" and "W \<subseteq> U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3194 |
using \<open>S \<subseteq> U\<close> by (force simp: W_def setdist_sing_in_set)+ |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3195 |
have "S' \<inter> T' = W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3196 |
by (auto simp: S'_def T'_def W_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3197 |
then have cloUW: "closedin (subtopology euclidean U) W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3198 |
using closedin_Int cloUS' cloUT' by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3199 |
obtain W' W0 where "openin (subtopology euclidean W) W'" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3200 |
and cloWW0: "closedin (subtopology euclidean W) W0" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3201 |
and "S \<inter> T \<subseteq> W'" "W' \<subseteq> W0" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3202 |
and ret: "(S \<inter> T) retract_of W0" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3203 |
apply (rule ANR_imp_closed_neighbourhood_retract [OF \<open>ANR(S \<inter> T)\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3204 |
apply (rule closedin_subset_trans [of U, OF _ ST_W \<open>W \<subseteq> U\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3205 |
apply (blast intro: assms)+ |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3206 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3207 |
then obtain U0 where opeUU0: "openin (subtopology euclidean U) U0" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3208 |
and U0: "S \<inter> T \<subseteq> U0" "U0 \<inter> W \<subseteq> W0" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3209 |
unfolding openin_open using \<open>W \<subseteq> U\<close> by blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3210 |
have "W0 \<subseteq> U" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3211 |
using \<open>W \<subseteq> U\<close> cloWW0 closedin_subset by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3212 |
obtain r0 |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3213 |
where "S \<inter> T \<subseteq> W0" and contr0: "continuous_on W0 r0" and "r0 ` W0 \<subseteq> S \<inter> T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3214 |
and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3215 |
using ret by (force simp add: retract_of_def retraction_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3216 |
have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3217 |
using assms by (auto simp: W_def setdist_sing_in_set dest!: setdist_eq_0_closedin) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3218 |
define r where "r \<equiv> \<lambda>x. if x \<in> W0 then r0 x else x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3219 |
have "r ` (W0 \<union> S) \<subseteq> S" "r ` (W0 \<union> T) \<subseteq> T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3220 |
using \<open>r0 ` W0 \<subseteq> S \<inter> T\<close> r_def by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3221 |
have contr: "continuous_on (W0 \<union> (S \<union> T)) r" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3222 |
unfolding r_def |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3223 |
proof (rule continuous_on_cases_local [OF _ _ contr0 continuous_on_id]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3224 |
show "closedin (subtopology euclidean (W0 \<union> (S \<union> T))) W0" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3225 |
apply (rule closedin_subset_trans [of U]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3226 |
using cloWW0 cloUW closedin_trans \<open>W0 \<subseteq> U\<close> \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> apply blast+ |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3227 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3228 |
show "closedin (subtopology euclidean (W0 \<union> (S \<union> T))) (S \<union> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3229 |
by (meson \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W0 \<subseteq> U\<close> assms closedin_Un closedin_subset_trans sup.bounded_iff sup.cobounded2) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3230 |
show "\<And>x. x \<in> W0 \<and> x \<notin> W0 \<or> x \<in> S \<union> T \<and> x \<in> W0 \<Longrightarrow> r0 x = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3231 |
using ST cloWW0 closedin_subset by fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3232 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3233 |
have cloS'WS: "closedin (subtopology euclidean S') (W0 \<union> S)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3234 |
by (meson closedin_subset_trans US cloUS' \<open>S \<subseteq> S'\<close> \<open>W \<subseteq> S'\<close> cloUW cloWW0 |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3235 |
closedin_Un closedin_imp_subset closedin_trans) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3236 |
obtain W1 g where "W0 \<union> S \<subseteq> W1" and contg: "continuous_on W1 g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3237 |
and opeSW1: "openin (subtopology euclidean S') W1" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3238 |
and "g ` W1 \<subseteq> S" and geqr: "\<And>x. x \<in> W0 \<union> S \<Longrightarrow> g x = r x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3239 |
apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> _ \<open>r ` (W0 \<union> S) \<subseteq> S\<close> cloS'WS]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3240 |
apply (rule continuous_on_subset [OF contr]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3241 |
apply (blast intro: elim: )+ |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3242 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3243 |
have cloT'WT: "closedin (subtopology euclidean T') (W0 \<union> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3244 |
by (meson closedin_subset_trans UT cloUT' \<open>T \<subseteq> T'\<close> \<open>W \<subseteq> T'\<close> cloUW cloWW0 |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3245 |
closedin_Un closedin_imp_subset closedin_trans) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3246 |
obtain W2 h where "W0 \<union> T \<subseteq> W2" and conth: "continuous_on W2 h" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3247 |
and opeSW2: "openin (subtopology euclidean T') W2" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3248 |
and "h ` W2 \<subseteq> T" and heqr: "\<And>x. x \<in> W0 \<union> T \<Longrightarrow> h x = r x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3249 |
apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> _ \<open>r ` (W0 \<union> T) \<subseteq> T\<close> cloT'WT]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3250 |
apply (rule continuous_on_subset [OF contr]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3251 |
apply (blast intro: elim: )+ |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3252 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3253 |
have "S' \<inter> T' = W" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3254 |
by (force simp: S'_def T'_def W_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3255 |
obtain O1 O2 where "open O1" "W1 = S' \<inter> O1" "open O2" "W2 = T' \<inter> O2" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3256 |
using opeSW1 opeSW2 by (force simp add: openin_open) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3257 |
show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3258 |
proof |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3259 |
have eq: "W1 - (W - U0) \<union> (W2 - (W - U0)) = |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3260 |
((U - T') \<inter> O1 \<union> (U - S') \<inter> O2 \<union> U \<inter> O1 \<inter> O2) - (W - U0)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3261 |
using \<open>U0 \<inter> W \<subseteq> W0\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3262 |
by (auto simp: \<open>S' \<union> T' = U\<close> [symmetric] \<open>S' \<inter> T' = W\<close> [symmetric] \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close>) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3263 |
show "openin (subtopology euclidean U) (W1 - (W - U0) \<union> (W2 - (W - U0)))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3264 |
apply (subst eq) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3265 |
apply (intro openin_Un openin_Int_open openin_diff closedin_diff cloUW opeUU0 cloUS' cloUT' \<open>open O1\<close> \<open>open O2\<close>) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3266 |
apply simp_all |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3267 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3268 |
have cloW1: "closedin (subtopology euclidean (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W1 - (W - U0))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3269 |
using cloUS' apply (simp add: closedin_closed) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3270 |
apply (erule ex_forward) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3271 |
using U0 \<open>W0 \<union> S \<subseteq> W1\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3272 |
apply (auto simp add: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3273 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3274 |
have cloW2: "closedin (subtopology euclidean (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W2 - (W - U0))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3275 |
using cloUT' apply (simp add: closedin_closed) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3276 |
apply (erule ex_forward) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3277 |
using U0 \<open>W0 \<union> T \<subseteq> W2\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3278 |
apply (auto simp add: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3279 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3280 |
have *: "\<forall>x\<in>S \<union> T. (if x \<in> S' then g x else h x) = x" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3281 |
using ST \<open>S' \<inter> T' = W\<close> cloT'WT closedin_subset geqr heqr |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3282 |
apply (auto simp: r_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3283 |
apply fastforce |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3284 |
using \<open>S \<subseteq> S'\<close> \<open>T \<subseteq> T'\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W1 = S' \<inter> O1\<close> by auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3285 |
have "\<exists>r. continuous_on (W1 - (W - U0) \<union> (W2 - (W - U0))) r \<and> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3286 |
r ` (W1 - (W - U0) \<union> (W2 - (W - U0))) \<subseteq> S \<union> T \<and> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3287 |
(\<forall>x\<in>S \<union> T. r x = x)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3288 |
apply (rule_tac x = "\<lambda>x. if x \<in> S' then g x else h x" in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3289 |
apply (intro conjI *) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3290 |
apply (rule continuous_on_cases_local |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3291 |
[OF cloW1 cloW2 continuous_on_subset [OF contg] continuous_on_subset [OF conth]]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3292 |
using \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<inter> T' = W\<close> |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3293 |
\<open>g ` W1 \<subseteq> S\<close> \<open>h ` W2 \<subseteq> T\<close> apply auto |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3294 |
using \<open>U0 \<inter> W \<subseteq> W0\<close> \<open>W0 \<union> S \<subseteq> W1\<close> apply (fastforce simp add: geqr heqr)+ |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3295 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3296 |
then show "S \<union> T retract_of W1 - (W - U0) \<union> (W2 - (W - U0))" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3297 |
using \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close> ST opeUU0 U0 |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3298 |
by (auto simp add: retract_of_def retraction_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3299 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3300 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3301 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3302 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3303 |
proposition ANR_closed_Un_local: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3304 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3305 |
assumes STS: "closedin (subtopology euclidean (S \<union> T)) S" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3306 |
and STT: "closedin (subtopology euclidean (S \<union> T)) T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3307 |
and "ANR S" "ANR T" "ANR(S \<inter> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3308 |
shows "ANR(S \<union> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3309 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3310 |
have "\<exists>T. openin (subtopology euclidean U) T \<and> C retract_of T" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3311 |
if hom: "S \<union> T homeomorphic C" and UC: "closedin (subtopology euclidean U) C" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3312 |
for U and C :: "('a * real) set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3313 |
proof - |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3314 |
obtain f g where hom: "homeomorphism (S \<union> T) C f g" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3315 |
using hom by (force simp: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3316 |
have US: "closedin (subtopology euclidean U) {x \<in> C. g x \<in> S}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3317 |
apply (rule closedin_trans [OF _ UC]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3318 |
apply (rule continuous_closedin_preimage_gen [OF _ _ STS]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3319 |
using hom [unfolded homeomorphism_def] apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3320 |
apply (metis hom homeomorphism_def set_eq_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3321 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3322 |
have UT: "closedin (subtopology euclidean U) {x \<in> C. g x \<in> T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3323 |
apply (rule closedin_trans [OF _ UC]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3324 |
apply (rule continuous_closedin_preimage_gen [OF _ _ STT]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3325 |
using hom [unfolded homeomorphism_def] apply blast |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3326 |
apply (metis hom homeomorphism_def set_eq_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3327 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3328 |
have ANRS: "ANR {x \<in> C. g x \<in> S}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3329 |
apply (rule ANR_homeomorphic_ANR [OF \<open>ANR S\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3330 |
apply (simp add: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3331 |
apply (rule_tac x=g in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3332 |
apply (rule_tac x=f in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3333 |
using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3334 |
apply (rule_tac x="f x" in image_eqI, auto) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3335 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3336 |
have ANRT: "ANR {x \<in> C. g x \<in> T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3337 |
apply (rule ANR_homeomorphic_ANR [OF \<open>ANR T\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3338 |
apply (simp add: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3339 |
apply (rule_tac x=g in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3340 |
apply (rule_tac x=f in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3341 |
using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3342 |
apply (rule_tac x="f x" in image_eqI, auto) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3343 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3344 |
have ANRI: "ANR ({x \<in> C. g x \<in> S} \<inter> {x \<in> C. g x \<in> T})" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3345 |
apply (rule ANR_homeomorphic_ANR [OF \<open>ANR (S \<inter> T)\<close>]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3346 |
apply (simp add: homeomorphic_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3347 |
apply (rule_tac x=g in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3348 |
apply (rule_tac x=f in exI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3349 |
using hom |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3350 |
apply (auto simp: homeomorphism_def elim!: continuous_on_subset) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3351 |
apply (rule_tac x="f x" in image_eqI, auto) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3352 |
done |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3353 |
have "C = {x. x \<in> C \<and> g x \<in> S} \<union> {x. x \<in> C \<and> g x \<in> T}" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3354 |
by auto (metis Un_iff hom homeomorphism_def imageI) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3355 |
then show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3356 |
by (metis ANR_closed_Un_local_aux [OF US UT ANRS ANRT ANRI]) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3357 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3358 |
then show ?thesis |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3359 |
by (auto simp: ANR_def) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3360 |
qed |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3361 |
|
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3362 |
corollary ANR_closed_Un: |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3363 |
fixes S :: "'a::euclidean_space set" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3364 |
shows "\<lbrakk>closed S; closed T; ANR S; ANR T; ANR (S \<inter> T)\<rbrakk> \<Longrightarrow> ANR (S \<union> T)" |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3365 |
by (simp add: ANR_closed_Un_local closedin_def diff_eq open_Compl openin_open_Int) |
3b6975875633
Urysohn's lemma, Dugundji extension theorem and many other proofs
paulson <lp15@cam.ac.uk>
parents:
63301
diff
changeset
|
3366 |
|
34291
4e896680897e
finite annotation on cartesian product is now implicit.
hoelzl
parents:
34289
diff
changeset
|
3367 |
end |