src/HOL/Multivariate_Analysis/Brouwer_Fixpoint.thy
changeset 53248 7a4b4b3b9ecd
parent 53186 0f4d9df1eaec
child 53252 4766fbe322b5
equal deleted inserted replaced
53247:bd595338ca18 53248:7a4b4b3b9ecd
    27   assumes "a \<ge> 0" "b \<ge> 0"
    27   assumes "a \<ge> 0" "b \<ge> 0"
    28   shows "0 \<le> a / (b::real)"
    28   shows "0 \<le> a / (b::real)"
    29   apply (cases "b=0")
    29   apply (cases "b=0")
    30   defer
    30   defer
    31   apply (rule divide_nonneg_pos)
    31   apply (rule divide_nonneg_pos)
    32   using assms apply auto
    32   using assms
       
    33   apply auto
    33   done
    34   done
    34 
    35 
    35 lemma brouwer_compactness_lemma:
    36 lemma brouwer_compactness_lemma:
    36   fixes f :: "'a::metric_space \<Rightarrow> 'b::euclidean_space"
    37   fixes f :: "'a::metric_space \<Rightarrow> 'b::euclidean_space"
    37   assumes "compact s" "continuous_on s f" "\<not> (\<exists>x\<in>s. (f x = 0))"
    38   assumes "compact s" "continuous_on s f" "\<not> (\<exists>x\<in>s. (f x = 0))"
   173   have *: "s = insert x {}"
   174   have *: "s = insert x {}"
   174     apply (rule set_eqI, rule) unfolding singleton_iff
   175     apply (rule set_eqI, rule) unfolding singleton_iff
   175     apply (rule as(2)[rule_format]) using as(1)
   176     apply (rule as(2)[rule_format]) using as(1)
   176     apply auto
   177     apply auto
   177     done
   178     done
   178   show "card s = Suc 0" unfolding * using card_insert by auto
   179   show "card s = Suc 0"
       
   180     unfolding * using card_insert by auto
   179 qed auto
   181 qed auto
   180 
   182 
   181 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)))"
   183 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)))"
   182 proof
   184 proof
   183   assume "card s = 2"
   185   assume "card s = 2"
   651         "kle n x b" "m \<le> card {k \<in> {1..n}. x k < b k}"
   653         "kle n x b" "m \<le> card {k \<in> {1..n}. x k < b k}"
   652         using Suc(1)[of "s - {a}"] using Suc(5) `finite s` by auto
   654         using Suc(1)[of "s - {a}"] using Suc(5) `finite s` by auto
   653       have "1 \<le> card {k \<in> {1..n}. a k < x k}" "m \<le> card {k \<in> {1..n}. x k < b k}"
   655       have "1 \<le> card {k \<in> {1..n}. a k < x k}" "m \<le> card {k \<in> {1..n}. x k < b k}"
   654         apply (rule kle_strict_set)
   656         apply (rule kle_strict_set)
   655         apply (rule a(2)[rule_format])
   657         apply (rule a(2)[rule_format])
   656         using a and xb apply auto
   658         using a and xb
       
   659         apply auto
   657         done
   660         done
   658       thus ?thesis
   661       thus ?thesis
   659         apply (rule_tac x=a in bexI, rule_tac x=b in bexI)
   662         apply (rule_tac x=a in bexI, rule_tac x=b in bexI)
   660         using kle_range_combine[OF a(2)[rule_format] xb(3) Suc(5)[rule_format], of 1 "m"]
   663         using kle_range_combine[OF a(2)[rule_format] xb(3) Suc(5)[rule_format], of 1 "m"]
   661         using a(1) xb(1-2) apply auto
   664         using a(1) xb(1-2)
       
   665         apply auto
   662         done
   666         done
   663     next
   667     next
   664       case True
   668       case True
   665       hence "s = {a}" using Suc(3) by auto
   669       hence "s = {a}" using Suc(3) by auto
   666       hence "card s = 1" by auto
   670       hence "card s = 1" by auto
   762 next
   766 next
   763   case False
   767   case False
   764   show ?thesis apply(rule disjI2,rule ext)
   768   show ?thesis apply(rule disjI2,rule ext)
   765   proof -
   769   proof -
   766     fix j
   770     fix j
   767     have "x j \<ge> b j" using kle_imp_pointwise[OF assms(2),THEN spec[where x=j]]
   771     have "x j \<ge> b j"
   768       unfolding assms(1)[rule_format] apply-apply(cases "j=k")
   772       using kle_imp_pointwise[OF assms(2),THEN spec[where x=j]]
       
   773       unfolding assms(1)[rule_format]
       
   774       apply -
       
   775       apply(cases "j = k")
   769       using False by auto
   776       using False by auto
   770     thus "x j = b j" using kle_imp_pointwise[OF assms(3),THEN spec[where x=j]]
   777     thus "x j = b j"
       
   778       using kle_imp_pointwise[OF assms(3),THEN spec[where x=j]]
   771     by auto
   779     by auto
   772   qed
   780   qed
   773 qed
   781 qed
   774 
   782 
   775 
   783 
   816   have "s\<noteq>{}" using assm by auto
   824   have "s\<noteq>{}" using assm by auto
   817   obtain a where a: "a \<in> s" "\<forall>x\<in>s. kle n a x"
   825   obtain a where a: "a \<in> s" "\<forall>x\<in>s. kle n a x"
   818     using `s\<noteq>{}` assm using kle_minimal[of s n] by auto
   826     using `s\<noteq>{}` assm using kle_minimal[of s n] by auto
   819   obtain b where b: "b \<in> s" "\<forall>x\<in>s. kle n x b"
   827   obtain b where b: "b \<in> s" "\<forall>x\<in>s. kle n x b"
   820     using `s\<noteq>{}` assm using kle_maximal[of s n] by auto
   828     using `s\<noteq>{}` assm using kle_maximal[of s n] by auto
   821   obtain c d where c_d: "c\<in>s" "d\<in>s" "kle n c d" "n \<le> card {k \<in> {1..n}. c k < d k}"
   829   obtain c d where c_d: "c \<in> s" "d \<in> s" "kle n c d" "n \<le> card {k \<in> {1..n}. c k < d k}"
   822     using kle_range_induct[of s n n] using assm by auto
   830     using kle_range_induct[of s n n] using assm by auto
   823   have "kle n c b \<and> n \<le> card {k \<in> {1..n}. c k < b k}"
   831   have "kle n c b \<and> n \<le> card {k \<in> {1..n}. c k < b k}"
   824     apply (rule kle_range_combine_r[where y=d])
   832     apply (rule kle_range_combine_r[where y=d])
   825     using c_d a b apply auto
   833     using c_d a b apply auto
   826     done
   834     done
   827   hence "kle n a b \<and> n \<le> card {k\<in>{1..n}. a(k) < b(k)}"
   835   hence "kle n a b \<and> n \<le> card {k\<in>{1..n}. a(k) < b(k)}"
   828     apply -
   836     apply -
   829     apply (rule kle_range_combine_l[where y=c])
   837     apply (rule kle_range_combine_l[where y=c])
   830     using a `c\<in>s` `b\<in>s` apply auto
   838     using a `c \<in> s` `b \<in> s` apply auto
   831     done
   839     done
   832   moreover
   840   moreover
   833   have "card {1..n} \<ge> card {k\<in>{1..n}. a(k) < b(k)}"
   841   have "card {1..n} \<ge> card {k\<in>{1..n}. a(k) < b(k)}"
   834     by (rule card_mono) auto
   842     by (rule card_mono) auto
   835   ultimately
   843   ultimately
  2772 
  2780 
  2773 subsection {* Hence we get just about the nice induction. *}
  2781 subsection {* Hence we get just about the nice induction. *}
  2774 
  2782 
  2775 lemma kuhn_induction:
  2783 lemma kuhn_induction:
  2776   assumes "0 < p" "\<forall>x. \<forall>j\<in>{1..n+1}. (\<forall>j. x j \<le> p) \<and> (x j = 0) \<longrightarrow> (lab x j = 0)"
  2784   assumes "0 < p" "\<forall>x. \<forall>j\<in>{1..n+1}. (\<forall>j. x j \<le> p) \<and> (x j = 0) \<longrightarrow> (lab x j = 0)"
  2777                   "\<forall>x. \<forall>j\<in>{1..n+1}. (\<forall>j. x j \<le> p) \<and> (x j = p) \<longrightarrow> (lab x j = 1)"
  2785     "\<forall>x. \<forall>j\<in>{1..n+1}. (\<forall>j. x j \<le> p) \<and> (x j = p) \<longrightarrow> (lab x j = 1)"
  2778         "odd (card {f. ksimplex p n f \<and> ((reduced lab n) ` f = {0..n})})"
  2786     "odd (card {f. ksimplex p n f \<and> ((reduced lab n) ` f = {0..n})})"
  2779   shows "odd (card {s. ksimplex p (n+1) s \<and>((reduced lab (n+1)) `  s = {0..n+1})})" proof-
  2787   shows "odd (card {s. ksimplex p (n+1) s \<and>((reduced lab (n+1)) `  s = {0..n+1})})"
  2780   have *:"\<And>s t. odd (card s) \<Longrightarrow> s = t \<Longrightarrow> odd (card t)" "\<And>s f. (\<And>x. f x \<le> n +1 ) \<Longrightarrow> f ` s \<subseteq> {0..n+1}" by auto
  2788 proof -
  2781   show ?thesis apply(rule kuhn_simplex_lemma[unfolded mem_Collect_eq]) apply(rule,rule,rule *,rule reduced_labelling)
  2789   have *: "\<And>s t. odd (card s) \<Longrightarrow> s = t \<Longrightarrow> odd (card t)"
  2782     apply(rule *(1)[OF assms(4)]) apply(rule set_eqI) unfolding mem_Collect_eq apply(rule,erule conjE) defer apply(rule) proof-(*(rule,rule)*)
  2790     "\<And>s f. (\<And>x. f x \<le> n +1 ) \<Longrightarrow> f ` s \<subseteq> {0..n+1}" by auto
  2783     fix f assume as:"ksimplex p n f" "reduced lab n ` f = {0..n}"
  2791   show ?thesis
  2784     have *:"\<forall>x\<in>f. \<forall>j\<in>{1..n + 1}. x j = 0 \<longrightarrow> lab x j = 0" "\<forall>x\<in>f. \<forall>j\<in>{1..n + 1}. x j = p \<longrightarrow> lab x j = 1"
  2792     apply (rule kuhn_simplex_lemma[unfolded mem_Collect_eq])
       
  2793     apply (rule, rule, rule *, rule reduced_labelling)
       
  2794     apply (rule *(1)[OF assms(4)])
       
  2795     apply (rule set_eqI)
       
  2796     unfolding mem_Collect_eq
       
  2797     apply (rule, erule conjE)
       
  2798     defer
       
  2799     apply rule
       
  2800   proof -
       
  2801     fix f
       
  2802     assume as: "ksimplex p n f" "reduced lab n ` f = {0..n}"
       
  2803     have *: "\<forall>x\<in>f. \<forall>j\<in>{1..n + 1}. x j = 0 \<longrightarrow> lab x j = 0"
       
  2804       "\<forall>x\<in>f. \<forall>j\<in>{1..n + 1}. x j = p \<longrightarrow> lab x j = 1"
  2785       using assms(2-3) using as(1)[unfolded ksimplex_def] by auto
  2805       using assms(2-3) using as(1)[unfolded ksimplex_def] by auto
  2786     have allp:"\<forall>x\<in>f. x (n + 1) = p" using assms(2) using as(1)[unfolded ksimplex_def] by auto
  2806     have allp: "\<forall>x\<in>f. x (n + 1) = p"
  2787     { fix x assume "x\<in>f" hence "reduced lab (n + 1) x < n + 1" apply-apply(rule reduced_labelling_nonzero)
  2807       using assms(2) using as(1)[unfolded ksimplex_def] by auto
  2788         defer using assms(3) using as(1)[unfolded ksimplex_def] by auto
  2808     {
  2789       hence "reduced lab (n + 1) x = reduced lab n x" apply-apply(rule reduced_labelling_Suc) using reduced_labelling(1) by auto }
  2809       fix x
  2790     hence "reduced lab (n + 1) ` f = {0..n}" unfolding as(2)[symmetric] apply- apply(rule set_eqI) unfolding image_iff by auto
  2810       assume "x \<in> f"
  2791     moreover guess s using as(1)[unfolded simplex_top_face[OF assms(1) allp,symmetric]] .. then guess a ..
  2811       hence "reduced lab (n + 1) x < n + 1"
       
  2812         apply -
       
  2813         apply (rule reduced_labelling_nonzero)
       
  2814         defer using assms(3) using as(1)[unfolded ksimplex_def]
       
  2815         apply auto
       
  2816         done
       
  2817       hence "reduced lab (n + 1) x = reduced lab n x"
       
  2818         apply -
       
  2819         apply (rule reduced_labelling_Suc)
       
  2820         using reduced_labelling(1)
       
  2821         apply auto
       
  2822         done
       
  2823     }
       
  2824     hence "reduced lab (n + 1) ` f = {0..n}"
       
  2825       unfolding as(2)[symmetric]
       
  2826       apply -
       
  2827       apply (rule set_eqI)
       
  2828       unfolding image_iff
       
  2829       apply auto
       
  2830       done
       
  2831     moreover guess s using as(1)[unfolded simplex_top_face[OF assms(1) allp,symmetric]] ..
       
  2832     then guess a ..
  2792     ultimately show "\<exists>s a. ksimplex p (n + 1) s \<and>
  2833     ultimately show "\<exists>s a. ksimplex p (n + 1) s \<and>
  2793       a \<in> s \<and> f = s - {a} \<and> reduced lab (n + 1) ` f = {0..n} \<and> ((\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = p))" (is ?ex)
  2834       a \<in> s \<and> f = s - {a} \<and> reduced lab (n + 1) ` f = {0..n} \<and> ((\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = p))" (is ?ex)
  2794       apply(rule_tac x=s in exI,rule_tac x=a in exI) unfolding complete_face_top[OF *] using allp as(1) by auto
  2835       apply (rule_tac x = s in exI)
  2795   next fix f assume as:"\<exists>s a. ksimplex p (n + 1) s \<and>
  2836       apply (rule_tac x = a in exI)
       
  2837       unfolding complete_face_top[OF *]
       
  2838       using allp as(1)
       
  2839       apply auto
       
  2840       done
       
  2841   next
       
  2842     fix f
       
  2843     assume as: "\<exists>s a. ksimplex p (n + 1) s \<and>
  2796       a \<in> s \<and> f = s - {a} \<and> reduced lab (n + 1) ` f = {0..n} \<and> ((\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = p))" (is ?ex)
  2844       a \<in> s \<and> f = s - {a} \<and> reduced lab (n + 1) ` f = {0..n} \<and> ((\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = p))" (is ?ex)
  2797     then guess s .. then guess a apply-apply(erule exE,(erule conjE)+) . note sa=this
  2845     then guess s ..
  2798     { fix x assume "x\<in>f" hence "reduced lab (n + 1) x \<in> reduced lab (n + 1) ` f" by auto
  2846     then guess a
  2799       hence "reduced lab (n + 1) x < n + 1" using sa(4) by auto
  2847       apply -
  2800       hence "reduced lab (n + 1) x = reduced lab n x" apply-apply(rule reduced_labelling_Suc)
  2848       apply (erule exE,(erule conjE)+)
  2801         using reduced_labelling(1) by auto }
  2849       done
  2802     thus part1:"reduced lab n ` f = {0..n}" unfolding sa(4)[symmetric] apply-apply(rule set_eqI) unfolding image_iff by auto
  2850     note sa = this
  2803     have *:"\<forall>x\<in>f. x (n + 1) = p" proof(cases "\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = 0")
  2851     {
  2804       case True then guess j .. hence "\<And>x. x\<in>f \<Longrightarrow> reduced lab (n + 1) x \<noteq> j - 1" apply-apply(rule reduced_labelling_zero) apply assumption
  2852       fix x
  2805         apply(rule assms(2)[rule_format]) using sa(1)[unfolded ksimplex_def] unfolding sa by auto moreover
  2853       assume "x \<in> f"
       
  2854       hence "reduced lab (n + 1) x \<in> reduced lab (n + 1) ` f"
       
  2855         by auto
       
  2856       hence "reduced lab (n + 1) x < n + 1"
       
  2857         using sa(4) by auto
       
  2858       hence "reduced lab (n + 1) x = reduced lab n x"
       
  2859         apply -
       
  2860         apply (rule reduced_labelling_Suc)
       
  2861         using reduced_labelling(1)
       
  2862         apply auto
       
  2863         done
       
  2864     }
       
  2865     thus part1: "reduced lab n ` f = {0..n}"
       
  2866       unfolding sa(4)[symmetric]
       
  2867       apply -
       
  2868       apply (rule set_eqI)
       
  2869       unfolding image_iff
       
  2870       apply auto
       
  2871       done
       
  2872     have *: "\<forall>x\<in>f. x (n + 1) = p"
       
  2873     proof (cases "\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = 0")
       
  2874       case True
       
  2875       then guess j ..
       
  2876       hence "\<And>x. x \<in> f \<Longrightarrow> reduced lab (n + 1) x \<noteq> j - 1"
       
  2877         apply -
       
  2878         apply (rule reduced_labelling_zero)
       
  2879         apply assumption
       
  2880         apply (rule assms(2)[rule_format])
       
  2881         using sa(1)[unfolded ksimplex_def]
       
  2882         unfolding sa
       
  2883         apply auto
       
  2884         done
       
  2885       moreover
  2806       have "j - 1 \<in> {0..n}" using `j\<in>{1..n+1}` by auto
  2886       have "j - 1 \<in> {0..n}" using `j\<in>{1..n+1}` by auto
  2807       ultimately have False unfolding sa(4)[symmetric] unfolding image_iff by fastforce thus ?thesis by auto next
  2887       ultimately have False
  2808       case False hence "\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = p" using sa(5) by fastforce then guess j .. note j=this
  2888         unfolding sa(4)[symmetric]
  2809       thus ?thesis proof(cases "j = n+1")
  2889         unfolding image_iff
  2810         case False hence *:"j\<in>{1..n}" using j by auto
  2890         by fastforce
  2811         hence "\<And>x. x\<in>f \<Longrightarrow> reduced lab n x < j" apply(rule reduced_labelling_nonzero) proof- fix x assume "x\<in>f"
  2891       thus ?thesis by auto
  2812           hence "lab x j = 1" apply-apply(rule assms(3)[rule_format,OF j(1)])
  2892     next
  2813             using sa(1)[unfolded ksimplex_def] using j unfolding sa by auto thus "lab x j \<noteq> 0" by auto qed
  2893       case False
  2814         moreover have "j\<in>{0..n}" using * by auto
  2894       hence "\<exists>j\<in>{1..n + 1}. \<forall>x\<in>f. x j = p"
  2815         ultimately have False unfolding part1[symmetric] using * unfolding image_iff by auto thus ?thesis by auto qed auto qed
  2895         using sa(5) by fastforce then guess j .. note j=this
  2816     thus "ksimplex p n f" using as unfolding simplex_top_face[OF assms(1) *,symmetric] by auto qed qed
  2896       thus ?thesis
       
  2897       proof (cases "j = n + 1")
       
  2898         case False hence *: "j \<in> {1..n}"
       
  2899           using j by auto
       
  2900         hence "\<And>x. x \<in> f \<Longrightarrow> reduced lab n x < j"
       
  2901           apply (rule reduced_labelling_nonzero)
       
  2902         proof -
       
  2903           fix x
       
  2904           assume "x \<in> f"
       
  2905           hence "lab x j = 1"
       
  2906             apply -
       
  2907             apply (rule assms(3)[rule_format,OF j(1)])
       
  2908             using sa(1)[unfolded ksimplex_def]
       
  2909             using j
       
  2910             unfolding sa
       
  2911             apply auto
       
  2912             done
       
  2913           thus "lab x j \<noteq> 0" by auto
       
  2914         qed
       
  2915         moreover have "j \<in> {0..n}" using * by auto
       
  2916         ultimately have False
       
  2917           unfolding part1[symmetric]
       
  2918           using * unfolding image_iff
       
  2919           by auto
       
  2920         thus ?thesis by auto
       
  2921       qed auto
       
  2922     qed
       
  2923     thus "ksimplex p n f"
       
  2924       using as unfolding simplex_top_face[OF assms(1) *,symmetric] by auto
       
  2925   qed
       
  2926 qed
  2817 
  2927 
  2818 lemma kuhn_induction_Suc:
  2928 lemma kuhn_induction_Suc:
  2819   assumes "0 < p" "\<forall>x. \<forall>j\<in>{1..Suc n}. (\<forall>j. x j \<le> p) \<and> (x j = 0) \<longrightarrow> (lab x j = 0)"
  2929   assumes "0 < p" "\<forall>x. \<forall>j\<in>{1..Suc n}. (\<forall>j. x j \<le> p) \<and> (x j = 0) \<longrightarrow> (lab x j = 0)"
  2820                   "\<forall>x. \<forall>j\<in>{1..Suc n}. (\<forall>j. x j \<le> p) \<and> (x j = p) \<longrightarrow> (lab x j = 1)"
  2930                   "\<forall>x. \<forall>j\<in>{1..Suc n}. (\<forall>j. x j \<le> p) \<and> (x j = p) \<longrightarrow> (lab x j = 1)"
  2821         "odd (card {f. ksimplex p n f \<and> ((reduced lab n) ` f = {0..n})})"
  2931         "odd (card {f. ksimplex p n f \<and> ((reduced lab n) ` f = {0..n})})"
  2822   shows "odd (card {s. ksimplex p (Suc n) s \<and>((reduced lab (Suc n)) `  s = {0..Suc n})})"
  2932   shows "odd (card {s. ksimplex p (Suc n) s \<and>((reduced lab (Suc n)) `  s = {0..Suc n})})"
  2823   using assms unfolding Suc_eq_plus1 by(rule kuhn_induction)
  2933   using assms unfolding Suc_eq_plus1 by(rule kuhn_induction)
  2824 
  2934 
       
  2935 
  2825 subsection {* And so we get the final combinatorial result. *}
  2936 subsection {* And so we get the final combinatorial result. *}
  2826 
  2937 
  2827 lemma ksimplex_0: "ksimplex p 0 s \<longleftrightarrow> s = {(\<lambda>x. p)}" (is "?l = ?r") proof
  2938 lemma ksimplex_0: "ksimplex p 0 s \<longleftrightarrow> s = {(\<lambda>x. p)}" (is "?l = ?r")
  2828   assume l:?l guess a using ksimplexD(3)[OF l, unfolded add_0] unfolding card_1_exists .. note a=this
  2939 proof
  2829   have "a = (\<lambda>x. p)" using ksimplexD(5)[OF l, rule_format, OF a(1)] by(rule,auto) thus ?r using a by auto next
  2940   assume l: ?l
  2830   assume r:?r show ?l unfolding r ksimplex_eq by auto qed
  2941   guess a using ksimplexD(3)[OF l, unfolded add_0] unfolding card_1_exists .. note a = this
  2831 
  2942   have "a = (\<lambda>x. p)"
  2832 lemma reduce_labelling_zero[simp]: "reduced lab 0 x = 0" apply(rule reduced_labelling_unique) by auto
  2943     using ksimplexD(5)[OF l, rule_format, OF a(1)] by rule auto
       
  2944   thus ?r using a by auto
       
  2945 next
       
  2946   assume r: ?r
       
  2947   show ?l unfolding r ksimplex_eq by auto
       
  2948 qed
       
  2949 
       
  2950 lemma reduce_labelling_zero[simp]: "reduced lab 0 x = 0"
       
  2951   by (rule reduced_labelling_unique) auto
  2833 
  2952 
  2834 lemma kuhn_combinatorial:
  2953 lemma kuhn_combinatorial:
  2835   assumes "0 < p" "\<forall>x j. (\<forall>j. x(j) \<le> p) \<and> 1 \<le> j \<and> j \<le> n \<and> (x j = 0) \<longrightarrow> (lab x j = 0)"
  2954   assumes "0 < p" "\<forall>x j. (\<forall>j. x(j) \<le> p) \<and> 1 \<le> j \<and> j \<le> n \<and> (x j = 0) \<longrightarrow> (lab x j = 0)"
  2836   "\<forall>x j. (\<forall>j. x(j) \<le> p) \<and> 1 \<le> j \<and> j \<le> n  \<and> (x j = p) \<longrightarrow> (lab x j = 1)"
  2955     "\<forall>x j. (\<forall>j. x(j) \<le> p) \<and> 1 \<le> j \<and> j \<le> n  \<and> (x j = p) \<longrightarrow> (lab x j = 1)"
  2837   shows " odd (card {s. ksimplex p n s \<and> ((reduced lab n) ` s = {0..n})})" using assms proof(induct n)
  2956   shows " odd (card {s. ksimplex p n s \<and> ((reduced lab n) ` s = {0..n})})"
       
  2957   using assms
       
  2958 proof (induct n)
  2838   let ?M = "\<lambda>n. {s. ksimplex p n s \<and> ((reduced lab n) ` s = {0..n})}"
  2959   let ?M = "\<lambda>n. {s. ksimplex p n s \<and> ((reduced lab n) ` s = {0..n})}"
  2839   { case 0 have *:"?M 0 = {{(\<lambda>x. p)}}" unfolding ksimplex_0 by auto show ?case unfolding * by auto }
  2960   {
  2840   case (Suc n) have "odd (card (?M n))" apply(rule Suc(1)[OF Suc(2)]) using Suc(3-) by auto
  2961     case 0
  2841   thus ?case apply-apply(rule kuhn_induction_Suc) using Suc(2-) by auto qed
  2962     have *: "?M 0 = {{(\<lambda>x. p)}}"
  2842 
  2963       unfolding ksimplex_0 by auto
  2843 lemma kuhn_lemma: assumes "0 < (p::nat)" "0 < (n::nat)"
  2964     show ?case unfolding * by auto
  2844   "\<forall>x. (\<forall>i\<in>{1..n}. x i \<le> p) \<longrightarrow> (\<forall>i\<in>{1..n}. (label x i = (0::nat)) \<or> (label x i = 1))"
  2965   next
  2845   "\<forall>x. (\<forall>i\<in>{1..n}. x i \<le> p) \<longrightarrow> (\<forall>i\<in>{1..n}. (x i = 0) \<longrightarrow> (label x i = 0))"
  2966     case (Suc n)
  2846   "\<forall>x. (\<forall>i\<in>{1..n}. x i \<le> p) \<longrightarrow> (\<forall>i\<in>{1..n}. (x i = p) \<longrightarrow> (label x i = 1))"
  2967     have "odd (card (?M n))"
       
  2968       apply (rule Suc(1)[OF Suc(2)])
       
  2969       using Suc(3-)
       
  2970       apply auto
       
  2971       done
       
  2972     thus ?case
       
  2973       apply -
       
  2974       apply (rule kuhn_induction_Suc)
       
  2975       using Suc(2-)
       
  2976       apply auto
       
  2977       done
       
  2978   }
       
  2979 qed
       
  2980 
       
  2981 lemma kuhn_lemma:
       
  2982   assumes "0 < (p::nat)" "0 < (n::nat)"
       
  2983     "\<forall>x. (\<forall>i\<in>{1..n}. x i \<le> p) \<longrightarrow> (\<forall>i\<in>{1..n}. (label x i = (0::nat)) \<or> (label x i = 1))"
       
  2984     "\<forall>x. (\<forall>i\<in>{1..n}. x i \<le> p) \<longrightarrow> (\<forall>i\<in>{1..n}. (x i = 0) \<longrightarrow> (label x i = 0))"
       
  2985     "\<forall>x. (\<forall>i\<in>{1..n}. x i \<le> p) \<longrightarrow> (\<forall>i\<in>{1..n}. (x i = p) \<longrightarrow> (label x i = 1))"
  2847   obtains q where "\<forall>i\<in>{1..n}. q i < p"
  2986   obtains q where "\<forall>i\<in>{1..n}. q i < p"
  2848   "\<forall>i\<in>{1..n}. \<exists>r s. (\<forall>j\<in>{1..n}. q(j) \<le> r(j) \<and> r(j) \<le> q(j) + 1) \<and>
  2987     "\<forall>i\<in>{1..n}. \<exists>r s. (\<forall>j\<in>{1..n}. q(j) \<le> r(j) \<and> r(j) \<le> q(j) + 1) \<and>
  2849                                (\<forall>j\<in>{1..n}. q(j) \<le> s(j) \<and> s(j) \<le> q(j) + 1) \<and>
  2988                                  (\<forall>j\<in>{1..n}. q(j) \<le> s(j) \<and> s(j) \<le> q(j) + 1) \<and>
  2850                                ~(label r i = label s i)" proof-
  2989                                  ~(label r i = label s i)"
  2851   let ?A = "{s. ksimplex p n s \<and> reduced label n ` s = {0..n}}" have "n\<noteq>0" using assms by auto
  2990 proof -
  2852   have conjD:"\<And>P Q. P \<and> Q \<Longrightarrow> P" "\<And>P Q. P \<and> Q \<Longrightarrow> Q" by auto
  2991   let ?A = "{s. ksimplex p n s \<and> reduced label n ` s = {0..n}}"
  2853   have "odd (card ?A)" apply(rule kuhn_combinatorial[of p n label]) using assms by auto
  2992   have "n \<noteq> 0" using assms by auto
  2854   hence "card ?A \<noteq> 0" apply-apply(rule ccontr) by auto hence "?A \<noteq> {}" unfolding card_eq_0_iff by auto
  2993   have conjD:"\<And>P Q. P \<and> Q \<Longrightarrow> P" "\<And>P Q. P \<and> Q \<Longrightarrow> Q"
  2855   then obtain s where "s\<in>?A" by auto note s=conjD[OF this[unfolded mem_Collect_eq]]
  2994     by auto
  2856   guess a b apply(rule ksimplex_extrema_strong[OF s(1) `n\<noteq>0`]) . note ab=this
  2995   have "odd (card ?A)"
  2857   show ?thesis apply(rule that[of a]) proof(rule_tac[!] ballI) fix i assume "i\<in>{1..n}"
  2996     apply (rule kuhn_combinatorial[of p n label])
  2858     hence "a i + 1 \<le> p" apply-apply(rule order_trans[of _ "b i"]) apply(subst ab(5)[THEN spec[where x=i]])
  2997     using assms
  2859       using s(1)[unfolded ksimplex_def] defer apply- apply(erule conjE)+ apply(drule_tac bspec[OF _ ab(2)])+ by auto
  2998     apply auto
       
  2999     done
       
  3000   hence "card ?A \<noteq> 0"
       
  3001     apply -
       
  3002     apply (rule ccontr)
       
  3003     apply auto
       
  3004     done
       
  3005   hence "?A \<noteq> {}" unfolding card_eq_0_iff by auto
       
  3006   then obtain s where "s \<in> ?A"
       
  3007     by auto note s=conjD[OF this[unfolded mem_Collect_eq]]
       
  3008   guess a b by (rule ksimplex_extrema_strong[OF s(1) `n\<noteq>0`]) note ab = this
       
  3009   show ?thesis
       
  3010     apply (rule that[of a])
       
  3011     apply (rule_tac[!] ballI)
       
  3012   proof -
       
  3013     fix i
       
  3014     assume "i\<in>{1..n}"
       
  3015     hence "a i + 1 \<le> p"
       
  3016       apply -
       
  3017       apply (rule order_trans[of _ "b i"])
       
  3018       apply (subst ab(5)[THEN spec[where x=i]])
       
  3019       using s(1)[unfolded ksimplex_def]
       
  3020       defer
       
  3021       apply -
       
  3022       apply (erule conjE)+
       
  3023       apply (drule_tac bspec[OF _ ab(2)])+
       
  3024       apply auto
       
  3025       done
  2860     thus "a i < p" by auto
  3026     thus "a i < p" by auto
  2861     case goal2 hence "i \<in> reduced label n ` s" using s by auto then guess u unfolding image_iff .. note u=this
  3027   next
  2862     from goal2 have "i - 1 \<in> reduced label n ` s" using s by auto then guess v unfolding image_iff .. note v=this
  3028     case goal2
  2863     show ?case apply(rule_tac x=u in exI, rule_tac x=v in exI) apply(rule conjI) defer apply(rule conjI) defer 2 proof(rule_tac[1-2] ballI)
  3029     hence "i \<in> reduced label n ` s" using s by auto
  2864       show "label u i \<noteq> label v i" using reduced_labelling[of label n u] reduced_labelling[of label n v]
  3030     then guess u unfolding image_iff .. note u = this
  2865         unfolding u(2)[symmetric] v(2)[symmetric] using goal2 by auto
  3031     from goal2 have "i - 1 \<in> reduced label n ` s"
  2866       fix j assume j:"j\<in>{1..n}" show "a j \<le> u j \<and> u j \<le> a j + 1" "a j \<le> v j \<and> v j \<le> a j + 1"
  3032       using s by auto
  2867         using conjD[OF ab(4)[rule_format, OF u(1)]] and conjD[OF ab(4)[rule_format, OF v(1)]] apply-
  3033     then guess v unfolding image_iff .. note v = this
  2868         apply(drule_tac[!] kle_imp_pointwise)+ apply(erule_tac[!] x=j in allE)+ unfolding ab(5)[rule_format] using j
  3034     show ?case
  2869         by auto qed qed qed
  3035       apply (rule_tac x = u in exI)
       
  3036       apply (rule_tac x = v in exI)
       
  3037       apply (rule conjI)
       
  3038       defer
       
  3039       apply (rule conjI)
       
  3040       defer 2
       
  3041       apply (rule_tac[1-2] ballI)
       
  3042     proof -
       
  3043       show "label u i \<noteq> label v i"
       
  3044         using reduced_labelling [of label n u] reduced_labelling [of label n v]
       
  3045         unfolding u(2)[symmetric] v(2)[symmetric]
       
  3046         using goal2
       
  3047         apply auto
       
  3048         done
       
  3049       fix j
       
  3050       assume j: "j \<in> {1..n}"
       
  3051       show "a j \<le> u j \<and> u j \<le> a j + 1" "a j \<le> v j \<and> v j \<le> a j + 1"
       
  3052         using conjD[OF ab(4)[rule_format, OF u(1)]]
       
  3053           and conjD[OF ab(4)[rule_format, OF v(1)]]
       
  3054         apply -
       
  3055         apply (drule_tac[!] kle_imp_pointwise)+
       
  3056         apply (erule_tac[!] x=j in allE)+
       
  3057         unfolding ab(5)[rule_format]
       
  3058         using j
       
  3059         apply auto
       
  3060         done
       
  3061     qed
       
  3062   qed
       
  3063 qed
  2870 
  3064 
  2871 
  3065 
  2872 subsection {* The main result for the unit cube. *}
  3066 subsection {* The main result for the unit cube. *}
  2873 
  3067 
  2874 lemma kuhn_labelling_lemma':
  3068 lemma kuhn_labelling_lemma':
  2984       by (rule compact_uniformly_continuous[OF assms(1) compact_interval])
  3178       by (rule compact_uniformly_continuous[OF assms(1) compact_interval])
  2985     guess e using *[unfolded uniformly_continuous_on_def,rule_format,OF d'] by (elim exE conjE)
  3179     guess e using *[unfolded uniformly_continuous_on_def,rule_format,OF d'] by (elim exE conjE)
  2986     note e=this[rule_format,unfolded dist_norm]
  3180     note e=this[rule_format,unfolded dist_norm]
  2987     show ?thesis
  3181     show ?thesis
  2988       apply (rule_tac x="min (e/2) (d/real n/8)" in exI)
  3182       apply (rule_tac x="min (e/2) (d/real n/8)" in exI)
  2989     proof safe
  3183       apply safe
       
  3184     proof -
  2990       show "0 < min (e / 2) (d / real n / 8)"
  3185       show "0 < min (e / 2) (d / real n / 8)"
  2991         using d' e by auto
  3186         using d' e by auto
  2992       fix x y z i
  3187       fix x y z i
  2993       assume as: "x \<in> {0..\<Sum>Basis}" "y \<in> {0..\<Sum>Basis}" "z \<in> {0..\<Sum>Basis}"
  3188       assume as: "x \<in> {0..\<Sum>Basis}" "y \<in> {0..\<Sum>Basis}" "z \<in> {0..\<Sum>Basis}"
  2994         "norm (x - z) < min (e / 2) (d / real n / 8)"
  3189         "norm (x - z) < min (e / 2) (d / real n / 8)"
  3214 lemma homeomorphic_fixpoint_property:
  3409 lemma homeomorphic_fixpoint_property:
  3215   fixes s :: "('a::euclidean_space) set"
  3410   fixes s :: "('a::euclidean_space) set"
  3216     and t :: "('b::euclidean_space) set"
  3411     and t :: "('b::euclidean_space) set"
  3217   assumes "s homeomorphic t"
  3412   assumes "s homeomorphic t"
  3218   shows "(\<forall>f. continuous_on s f \<and> f ` s \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. f x = x)) \<longleftrightarrow>
  3413   shows "(\<forall>f. continuous_on s f \<and> f ` s \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. f x = x)) \<longleftrightarrow>
  3219          (\<forall>g. continuous_on t g \<and> g ` t \<subseteq> t \<longrightarrow> (\<exists>y\<in>t. g y = y))"
  3414     (\<forall>g. continuous_on t g \<and> g ` t \<subseteq> t \<longrightarrow> (\<exists>y\<in>t. g y = y))"
  3220 proof -
  3415 proof -
  3221   guess r using assms[unfolded homeomorphic_def homeomorphism_def] ..
  3416   guess r using assms[unfolded homeomorphic_def homeomorphism_def] ..
  3222   then guess i ..
  3417   then guess i ..
  3223   thus ?thesis
  3418   thus ?thesis
  3224     apply -
  3419     apply -
  3242   thus ?thesis
  3437   thus ?thesis
  3243     unfolding retraction_def
  3438     unfolding retraction_def
  3244     apply -
  3439     apply -
  3245     apply (rule invertible_fixpoint_property[OF continuous_on_id _ _ _ _ assms(2), of t h g])
  3440     apply (rule invertible_fixpoint_property[OF continuous_on_id _ _ _ _ assms(2), of t h g])
  3246     prefer 7
  3441     prefer 7
  3247     apply (rule_tac y=y in that)
  3442     apply (rule_tac y = y in that)
  3248     using assms apply auto
  3443     using assms
       
  3444     apply auto
  3249     done
  3445     done
  3250 qed
  3446 qed
  3251 
  3447 
  3252 
  3448 
  3253 subsection {*So the Brouwer theorem for any set with nonempty interior. *}
  3449 subsection {*So the Brouwer theorem for any set with nonempty interior. *}
  3254 
  3450 
  3255 lemma brouwer_weak:
  3451 lemma brouwer_weak:
  3256   fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'a::ordered_euclidean_space"
  3452   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'a::ordered_euclidean_space"
  3257   assumes "compact s" "convex s" "interior s \<noteq> {}" "continuous_on s f" "f ` s \<subseteq> s"
  3453   assumes "compact s" "convex s" "interior s \<noteq> {}" "continuous_on s f" "f ` s \<subseteq> s"
  3258   obtains x where "x \<in> s" "f x = x"
  3454   obtains x where "x \<in> s" "f x = x"
  3259 proof -
  3455 proof -
  3260   have *: "interior {0::'a..\<Sum>Basis} \<noteq> {}"
  3456   have *: "interior {0::'a..\<Sum>Basis} \<noteq> {}"
  3261     unfolding interior_closed_interval interval_eq_empty by auto
  3457     unfolding interior_closed_interval interval_eq_empty by auto
  3288 
  3484 
  3289 text {*Still more general form; could derive this directly without using the
  3485 text {*Still more general form; could derive this directly without using the
  3290   rather involved @{text "HOMEOMORPHIC_CONVEX_COMPACT"} theorem, just using
  3486   rather involved @{text "HOMEOMORPHIC_CONVEX_COMPACT"} theorem, just using
  3291   a scaling and translation to put the set inside the unit cube. *}
  3487   a scaling and translation to put the set inside the unit cube. *}
  3292 
  3488 
  3293 lemma brouwer: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'a"
  3489 lemma brouwer:
       
  3490   fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'a"
  3294   assumes "compact s" "convex s" "s \<noteq> {}" "continuous_on s f" "f ` s \<subseteq> s"
  3491   assumes "compact s" "convex s" "s \<noteq> {}" "continuous_on s f" "f ` s \<subseteq> s"
  3295   obtains x where "x \<in> s" "f x = x"
  3492   obtains x where "x \<in> s" "f x = x"
  3296 proof -
  3493 proof -
  3297   have "\<exists>e>0. s \<subseteq> cball 0 e"
  3494   have "\<exists>e>0. s \<subseteq> cball 0 e"
  3298     using compact_imp_bounded[OF assms(1)] unfolding bounded_pos
  3495     using compact_imp_bounded[OF assms(1)] unfolding bounded_pos
  3351     apply (rule,rule,erule bexE)
  3548     apply (rule,rule,erule bexE)
  3352     unfolding dist_norm
  3549     unfolding dist_norm
  3353     apply (simp add: * norm_minus_commute)
  3550     apply (simp add: * norm_minus_commute)
  3354     done
  3551     done
  3355   note x = this
  3552   note x = this
  3356   hence "scaleR 2 a = scaleR 1 x + scaleR 1 x" by (auto simp add:algebra_simps)
  3553   hence "scaleR 2 a = scaleR 1 x + scaleR 1 x"
       
  3554     by (auto simp add: algebra_simps)
  3357   hence "a = x" unfolding scaleR_left_distrib[symmetric] by auto
  3555   hence "a = x" unfolding scaleR_left_distrib[symmetric] by auto
  3358   thus False using x assms by auto
  3556   thus False using x assms by auto
  3359 qed
  3557 qed
  3360 
  3558 
  3361 
  3559 
  3362 subsection {*Bijections between intervals. *}
  3560 subsection {*Bijections between intervals. *}
  3363 
  3561 
  3364 definition interval_bij :: "'a \<times> 'a \<Rightarrow> 'a \<times> 'a \<Rightarrow> 'a \<Rightarrow> 'a::ordered_euclidean_space" where
  3562 definition interval_bij :: "'a \<times> 'a \<Rightarrow> 'a \<times> 'a \<Rightarrow> 'a \<Rightarrow> 'a::ordered_euclidean_space"
  3365   "interval_bij \<equiv> \<lambda>(a, b) (u, v) x. (\<Sum>i\<in>Basis. (u\<bullet>i + (x\<bullet>i - a\<bullet>i) / (b\<bullet>i - a\<bullet>i) * (v\<bullet>i - u\<bullet>i)) *\<^sub>R i)"
  3563   where "interval_bij =
       
  3564     (\<lambda>(a, b) (u, v) x. (\<Sum>i\<in>Basis. (u\<bullet>i + (x\<bullet>i - a\<bullet>i) / (b\<bullet>i - a\<bullet>i) * (v\<bullet>i - u\<bullet>i)) *\<^sub>R i))"
  3366 
  3565 
  3367 lemma interval_bij_affine:
  3566 lemma interval_bij_affine:
  3368   "interval_bij (a,b) (u,v) = (\<lambda>x. (\<Sum>i\<in>Basis. ((v\<bullet>i - u\<bullet>i) / (b\<bullet>i - a\<bullet>i) * (x\<bullet>i)) *\<^sub>R i) +
  3567   "interval_bij (a,b) (u,v) = (\<lambda>x. (\<Sum>i\<in>Basis. ((v\<bullet>i - u\<bullet>i) / (b\<bullet>i - a\<bullet>i) * (x\<bullet>i)) *\<^sub>R i) +
  3369     (\<Sum>i\<in>Basis. (u\<bullet>i - (v\<bullet>i - u\<bullet>i) / (b\<bullet>i - a\<bullet>i) * (a\<bullet>i)) *\<^sub>R i))"
  3568     (\<Sum>i\<in>Basis. (u\<bullet>i - (v\<bullet>i - u\<bullet>i) / (b\<bullet>i - a\<bullet>i) * (a\<bullet>i)) *\<^sub>R i))"
  3370   by (auto simp: setsum_addf[symmetric] scaleR_add_left[symmetric] interval_bij_def fun_eq_iff
  3569   by (auto simp: setsum_addf[symmetric] scaleR_add_left[symmetric] interval_bij_def fun_eq_iff
  3371                  field_simps inner_simps add_divide_distrib[symmetric] intro!: setsum_cong)
  3570     field_simps inner_simps add_divide_distrib[symmetric] intro!: setsum_cong)
  3372 
  3571 
  3373 lemma continuous_interval_bij:
  3572 lemma continuous_interval_bij:
  3374   "continuous (at x) (interval_bij (a,b::'a::ordered_euclidean_space) (u,v::'a))"
  3573   "continuous (at x) (interval_bij (a,b::'a::ordered_euclidean_space) (u,v::'a))"
  3375   by (auto simp add: divide_inverse interval_bij_def intro!: continuous_setsum continuous_intros)
  3574   by (auto simp add: divide_inverse interval_bij_def intro!: continuous_setsum continuous_intros)
  3376 
  3575 
  3382 lemma in_interval_interval_bij:
  3581 lemma in_interval_interval_bij:
  3383   fixes a b u v x :: "'a::ordered_euclidean_space"
  3582   fixes a b u v x :: "'a::ordered_euclidean_space"
  3384   assumes "x \<in> {a..b}" "{u..v} \<noteq> {}"
  3583   assumes "x \<in> {a..b}" "{u..v} \<noteq> {}"
  3385   shows "interval_bij (a,b) (u,v) x \<in> {u..v}"
  3584   shows "interval_bij (a,b) (u,v) x \<in> {u..v}"
  3386   apply (simp only: interval_bij_def split_conv mem_interval inner_setsum_left_Basis cong: ball_cong)
  3585   apply (simp only: interval_bij_def split_conv mem_interval inner_setsum_left_Basis cong: ball_cong)
  3387 proof safe
  3586   apply safe
       
  3587 proof -
  3388   fix i :: 'a
  3588   fix i :: 'a
  3389   assume i: "i \<in> Basis"
  3589   assume i: "i \<in> Basis"
  3390   have "{a..b} \<noteq> {}" using assms by auto
  3590   have "{a..b} \<noteq> {}" using assms by auto
  3391   with i have *: "a\<bullet>i \<le> b\<bullet>i" "u\<bullet>i \<le> v\<bullet>i"
  3591   with i have *: "a\<bullet>i \<le> b\<bullet>i" "u\<bullet>i \<le> v\<bullet>i"
  3392     using assms(2) by (auto simp add: interval_eq_empty not_less)
  3592     using assms(2) by (auto simp add: interval_eq_empty not_less)