src/HOL/Analysis/Linear_Algebra.thy
changeset 68062 ee88c0fccbae
parent 68058 69715dfdc286
child 68069 36209dfb981e
equal deleted inserted replaced
68060:3931ed905e93 68062:ee88c0fccbae
    24   show "f (a - b) = f a - f b" by (rule f.diff)
    24   show "f (a - b) = f a - f b" by (rule f.diff)
    25   show "f 0 = 0" by (rule f.zero)
    25   show "f 0 = 0" by (rule f.zero)
    26   show "f (- a) = - f a" by (rule f.minus)
    26   show "f (- a) = - f a" by (rule f.minus)
    27   show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scaleR)
    27   show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scaleR)
    28 qed
    28 qed
    29 
       
    30 lemma bounded_linearI:
       
    31   assumes "\<And>x y. f (x + y) = f x + f y"
       
    32     and "\<And>r x. f (r *\<^sub>R x) = r *\<^sub>R f x"
       
    33     and "\<And>x. norm (f x) \<le> norm x * K"
       
    34   shows "bounded_linear f"
       
    35   using assms by (rule bounded_linear_intro) (* FIXME: duplicate *)
       
    36 
    29 
    37 subsection \<open>A generic notion of "hull" (convex, affine, conic hull and closure).\<close>
    30 subsection \<open>A generic notion of "hull" (convex, affine, conic hull and closure).\<close>
    38 
    31 
    39 definition%important hull :: "('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'a set"  (infixl "hull" 75)
    32 definition%important hull :: "('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'a set"  (infixl "hull" 75)
    40   where "S hull s = \<Inter>{t. S t \<and> s \<subseteq> t}"
    33   where "S hull s = \<Inter>{t. S t \<and> s \<subseteq> t}"
  2512     and fi: "inj_on f B"
  2505     and fi: "inj_on f B"
  2513     and xsB: "x \<in> span B"
  2506     and xsB: "x \<in> span B"
  2514     and fx: "f x = 0"
  2507     and fx: "f x = 0"
  2515   shows "x = 0"
  2508   shows "x = 0"
  2516   using fB ifB fi xsB fx
  2509   using fB ifB fi xsB fx
  2517 proof (induct arbitrary: x rule: finite_induct[OF fB])
  2510 proof (induction B arbitrary: x rule: finite_induct)
  2518   case 1
  2511   case empty
  2519   then show ?case by auto
  2512   then show ?case by auto
  2520 next
  2513 next
  2521   case (2 a b x)
  2514   case (insert a b x)
  2522   have fb: "finite b" using "2.prems" by simp
       
  2523   have th0: "f ` b \<subseteq> f ` (insert a b)"
  2515   have th0: "f ` b \<subseteq> f ` (insert a b)"
  2524     apply (rule image_mono)
  2516     by (simp add: subset_insertI)
  2525     apply blast
  2517   have ifb: "independent (f ` b)"
  2526     done
  2518     using independent_mono insert.prems(1) th0 by blast  
  2527   from independent_mono[ OF "2.prems"(2) th0]
       
  2528   have ifb: "independent (f ` b)"  .
       
  2529   have fib: "inj_on f b"
  2519   have fib: "inj_on f b"
  2530     apply (rule subset_inj_on [OF "2.prems"(3)])
  2520     using insert.prems(2) by blast
  2531     apply blast
  2521   from span_breakdown[of a "insert a b", simplified, OF insert.prems(3)]
  2532     done
       
  2533   from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
       
  2534   obtain k where k: "x - k*\<^sub>R a \<in> span (b - {a})"
  2522   obtain k where k: "x - k*\<^sub>R a \<in> span (b - {a})"
  2535     by blast
  2523     by blast
  2536   have "f (x - k*\<^sub>R a) \<in> span (f ` b)"
  2524   have "f (x - k*\<^sub>R a) \<in> span (f ` b)"
  2537     unfolding span_linear_image[OF lf]
  2525     unfolding span_linear_image[OF lf]
  2538     apply (rule imageI)
  2526     using "insert.hyps"(2) k by auto
  2539     using k span_mono[of "b - {a}" b]
       
  2540     apply blast
       
  2541     done
       
  2542   then have "f x - k*\<^sub>R f a \<in> span (f ` b)"
  2527   then have "f x - k*\<^sub>R f a \<in> span (f ` b)"
  2543     by (simp add: linear_diff[OF lf] linear_cmul[OF lf])
  2528     by (simp add: linear_diff[OF lf] linear_cmul[OF lf])
  2544   then have th: "-k *\<^sub>R f a \<in> span (f ` b)"
  2529   then have th: "-k *\<^sub>R f a \<in> span (f ` b)"
  2545     using "2.prems"(5) by simp
  2530     using insert.prems(4) by simp
  2546   have xsb: "x \<in> span b"
  2531   have xsb: "x \<in> span b"
  2547   proof (cases "k = 0")
  2532   proof (cases "k = 0")
  2548     case True
  2533     case True
  2549     with k have "x \<in> span (b - {a})" by simp
  2534     with k have "x \<in> span (b - {a})" by simp
  2550     then show ?thesis using span_mono[of "b - {a}" b]
  2535     then show ?thesis using span_mono[of "b - {a}" b]
  2551       by blast
  2536       by blast
  2552   next
  2537   next
  2553     case False
  2538     case False
  2554     with span_mul[OF th, of "- 1/ k"]
  2539     from inj_on_image_set_diff[OF insert.prems(2), of "insert a b " "{a}", symmetric]
  2555     have th1: "f a \<in> span (f ` b)"
  2540     have "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
  2556       by auto
  2541     then have "f a \<notin> span (f ` b)" 
  2557     from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
  2542       using dependent_def insert.hyps(2) insert.prems(1) by fastforce
  2558     have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
  2543     moreover have "f a \<in> span (f ` b)"
  2559     from "2.prems"(2) [unfolded dependent_def bex_simps(8), rule_format, of "f a"]
  2544       using False span_mul[OF th, of "- 1/ k"] by auto
  2560     have "f a \<notin> span (f ` b)" using tha
  2545     ultimately have False
  2561       using "2.hyps"(2)
  2546       by blast
  2562       "2.prems"(3) by auto
       
  2563     with th1 have False by blast
       
  2564     then show ?thesis by blast
  2547     then show ?thesis by blast
  2565   qed
  2548   qed
  2566   from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" .
  2549   show "x = 0" 
       
  2550     using ifb fib xsb insert.IH insert.prems(4) by blast
  2567 qed
  2551 qed
  2568 
  2552 
  2569 text \<open>Can construct an isomorphism between spaces of same dimension.\<close>
  2553 text \<open>Can construct an isomorphism between spaces of same dimension.\<close>
  2570 
  2554 
  2571 lemma subspace_isomorphism:
  2555 lemma subspace_isomorphism:
  2642   shows "f x y = g x y"
  2626   shows "f x y = g x y"
  2643 proof -
  2627 proof -
  2644   let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
  2628   let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
  2645   from bf bg have sp: "subspace ?P"
  2629   from bf bg have sp: "subspace ?P"
  2646     unfolding bilinear_def linear_iff subspace_def bf bg
  2630     unfolding bilinear_def linear_iff subspace_def bf bg
  2647     by (auto simp add: span_0 bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def
  2631     by (auto simp add: bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add 
  2648       intro: bilinear_ladd[OF bf])
  2632       intro: bilinear_ladd[OF bf])
  2649 
       
  2650   have sfg: "\<And>x. x \<in> B \<Longrightarrow> subspace {a. f x a = g x a}"
  2633   have sfg: "\<And>x. x \<in> B \<Longrightarrow> subspace {a. f x a = g x a}"
  2651     apply (auto simp add: subspace_def)
  2634     apply (auto simp add: subspace_def)
  2652     using bf bg unfolding bilinear_def linear_iff
  2635     using bf bg unfolding bilinear_def linear_iff
  2653     apply (auto simp add: bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add 
  2636     apply (auto simp add: bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add 
  2654       intro: bilinear_ladd[OF bf])
  2637       intro: bilinear_ladd[OF bf])
  2655     done
  2638     done
  2656   have "\<forall>y\<in> span C. f x y = g x y" if "x \<in> span B" for x
  2639   have "\<forall>y\<in> span C. f x y = g x y" if "x \<in> span B" for x
  2657     apply (rule span_induct [OF that sp])
  2640     apply (rule span_induct [OF that sp])
  2658     apply (rule ballI)
  2641     using fg sfg span_induct by blast
  2659     apply (erule span_induct)
       
  2660     apply (simp_all add: sfg fg)
       
  2661     done
       
  2662   then show ?thesis
  2642   then show ?thesis
  2663     using SB TC assms by auto
  2643     using SB TC assms by auto
  2664 qed
  2644 qed
  2665 
  2645 
  2666 lemma bilinear_eq_stdbasis:
  2646 lemma bilinear_eq_stdbasis:
  2705     and ST: "f ` S \<subseteq> T"
  2685     and ST: "f ` S \<subseteq> T"
  2706   shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S"
  2686   shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S"
  2707   (is "?lhs \<longleftrightarrow> ?rhs")
  2687   (is "?lhs \<longleftrightarrow> ?rhs")
  2708 proof
  2688 proof
  2709   assume h: "?lhs"
  2689   assume h: "?lhs"
  2710   {
  2690   { fix x y
  2711     fix x y
  2691     assume x: "x \<in> S" and y: "y \<in> S" and f: "f x = f y"
  2712     assume x: "x \<in> S"
       
  2713     assume y: "y \<in> S"
       
  2714     assume f: "f x = f y"
       
  2715     from x fS have S0: "card S \<noteq> 0"
  2692     from x fS have S0: "card S \<noteq> 0"
  2716       by auto
  2693       by auto
  2717     have "x = y"
  2694     have "x = y"
  2718     proof (rule ccontr)
  2695     proof (rule ccontr)
  2719       assume xy: "\<not> ?thesis"
  2696       assume xy: "\<not> ?thesis"
  2720       have th: "card S \<le> card (f ` (S - {y}))"
  2697       have th: "card S \<le> card (f ` (S - {y}))"
  2721         unfolding c
  2698         unfolding c
  2722         apply (rule card_mono)
  2699       proof (rule card_mono)
  2723         apply (rule finite_imageI)
  2700         show "finite (f ` (S - {y}))"
  2724         using fS apply simp
  2701           by (simp add: fS)
  2725         using h xy x y f unfolding subset_eq image_iff
  2702         show "T \<subseteq> f ` (S - {y})"
  2726         apply auto
  2703           using h xy x y f unfolding subset_eq image_iff
  2727         apply (case_tac "xa = f x")
  2704           by (metis member_remove remove_def)
  2728         apply (rule bexI[where x=x])
  2705       qed
  2729         apply auto
       
  2730         done
       
  2731       also have " \<dots> \<le> card (S - {y})"
  2706       also have " \<dots> \<le> card (S - {y})"
  2732         apply (rule card_image_le)
  2707         apply (rule card_image_le)
  2733         using fS by simp
  2708         using fS by simp
  2734       also have "\<dots> \<le> card S - 1" using y fS by simp
  2709       also have "\<dots> \<le> card S - 1" using y fS by simp
  2735       finally show False using S0 by arith
  2710       finally show False using S0 by arith
  2738   then show ?rhs
  2713   then show ?rhs
  2739     unfolding inj_on_def by blast
  2714     unfolding inj_on_def by blast
  2740 next
  2715 next
  2741   assume h: ?rhs
  2716   assume h: ?rhs
  2742   have "f ` S = T"
  2717   have "f ` S = T"
  2743     apply (rule card_subset_eq[OF fT ST])
  2718     by (simp add: ST c card_image card_subset_eq fT h)
  2744     unfolding card_image[OF h]
       
  2745     apply (rule c)
       
  2746     done
       
  2747   then show ?lhs by blast
  2719   then show ?lhs by blast
  2748 qed
  2720 qed
  2749 
  2721 
  2750 lemma linear_surjective_imp_injective:
  2722 lemma linear_surjective_imp_injective:
  2751   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2723   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2752   assumes lf: "linear f"
  2724   assumes lf: "linear f" and sf: "surj f"
  2753     and sf: "surj f"
       
  2754   shows "inj f"
  2725   shows "inj f"
  2755 proof -
  2726 proof -
  2756   let ?U = "UNIV :: 'a set"
  2727   let ?U = "UNIV :: 'a set"
  2757   from basis_exists[of ?U] obtain B
  2728   from basis_exists[of ?U] obtain B
  2758     where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" and d: "card B = dim ?U"
  2729     where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" and d: "card B = dim ?U"
  2759     by blast
  2730     by blast
  2760   {
  2731   {
  2761     fix x
  2732     fix x
  2762     assume x: "x \<in> span B"
  2733     assume x: "x \<in> span B" and fx: "f x = 0"
  2763     assume fx: "f x = 0"
       
  2764     from B(2) have fB: "finite B"
  2734     from B(2) have fB: "finite B"
  2765       using independent_bound by auto
  2735       using independent_bound by auto
       
  2736     have Uspan: "UNIV \<subseteq> span (f ` B)"
       
  2737       by (simp add: B(3) lf sf spanning_surjective_image)
  2766     have fBi: "independent (f ` B)"
  2738     have fBi: "independent (f ` B)"
  2767       apply (rule card_le_dim_spanning[of "f ` B" ?U])
  2739     proof (rule card_le_dim_spanning)
  2768       apply blast
  2740       show "card (f ` B) \<le> dim ?U"
  2769       using sf B(3)
  2741         using card_image_le d fB by fastforce
  2770       unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
  2742     qed (use fB Uspan in auto)
  2771       apply blast
       
  2772       using fB apply blast
       
  2773       unfolding d[symmetric]
       
  2774       apply (rule card_image_le)
       
  2775       apply (rule fB)
       
  2776       done
       
  2777     have th0: "dim ?U \<le> card (f ` B)"
  2743     have th0: "dim ?U \<le> card (f ` B)"
  2778       apply (rule span_card_ge_dim)
  2744       by (rule span_card_ge_dim) (use Uspan fB in auto)
  2779       apply blast
       
  2780       unfolding span_linear_image[OF lf]
       
  2781       apply (rule subset_trans[where B = "f ` UNIV"])
       
  2782       using sf unfolding surj_def
       
  2783       apply blast
       
  2784       apply (rule image_mono)
       
  2785       apply (rule B(3))
       
  2786       apply (metis finite_imageI fB)
       
  2787       done
       
  2788     moreover have "card (f ` B) \<le> card B"
  2745     moreover have "card (f ` B) \<le> card B"
  2789       by (rule card_image_le, rule fB)
  2746       by (rule card_image_le, rule fB)
  2790     ultimately have th1: "card B = card (f ` B)"
  2747     ultimately have th1: "card B = card (f ` B)"
  2791       unfolding d by arith
  2748       unfolding d by arith
  2792     have fiB: "inj_on f B"
  2749     have fiB: "inj_on f B"
  2793       unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric]
  2750       by (simp add: eq_card_imp_inj_on fB th1)
  2794       by blast
       
  2795     from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
  2751     from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
  2796     have "x = 0" by blast
  2752     have "x = 0" by blast
  2797   }
  2753   }
  2798   then show ?thesis
  2754   then show ?thesis
  2799     unfolding linear_injective_0[OF lf]
  2755     unfolding linear_injective_0[OF lf] using B(3) by blast
  2800     using B(3)
       
  2801     by blast
       
  2802 qed
  2756 qed
  2803 
  2757 
  2804 text \<open>Hence either is enough for isomorphism.\<close>
  2758 text \<open>Hence either is enough for isomorphism.\<close>
  2805 
  2759 
  2806 lemma left_right_inverse_eq:
  2760 lemma left_right_inverse_eq:
  2852   {
  2806   {
  2853     fix f f':: "'a \<Rightarrow> 'a"
  2807     fix f f':: "'a \<Rightarrow> 'a"
  2854     assume lf: "linear f" "linear f'"
  2808     assume lf: "linear f" "linear f'"
  2855     assume f: "f \<circ> f' = id"
  2809     assume f: "f \<circ> f' = id"
  2856     from f have sf: "surj f"
  2810     from f have sf: "surj f"
  2857       apply (auto simp add: o_def id_def surj_def)
  2811       by (auto simp add: o_def id_def surj_def) metis
  2858       apply metis
       
  2859       done
       
  2860     from linear_surjective_isomorphism[OF lf(1) sf] lf f
  2812     from linear_surjective_isomorphism[OF lf(1) sf] lf f
  2861     have "f' \<circ> f = id"
  2813     have "f' \<circ> f = id"
  2862       unfolding fun_eq_iff o_def id_def by metis
  2814       unfolding fun_eq_iff o_def id_def by metis
  2863   }
  2815   }
  2864   then show ?thesis
  2816   then show ?thesis
  2872   assumes lf: "linear f"
  2824   assumes lf: "linear f"
  2873     and gf: "g \<circ> f = id"
  2825     and gf: "g \<circ> f = id"
  2874   shows "linear g"
  2826   shows "linear g"
  2875 proof -
  2827 proof -
  2876   from gf have fi: "inj f"
  2828   from gf have fi: "inj f"
  2877     apply (auto simp add: inj_on_def o_def id_def fun_eq_iff)
  2829     by (auto simp add: inj_on_def o_def id_def fun_eq_iff) metis
  2878     apply metis
       
  2879     done
       
  2880   from linear_injective_isomorphism[OF lf fi]
  2830   from linear_injective_isomorphism[OF lf fi]
  2881   obtain h :: "'a \<Rightarrow> 'a" where h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
  2831   obtain h :: "'a \<Rightarrow> 'a" where "linear h" and h: "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
  2882     by blast
  2832     by blast
  2883   have "h = g"
  2833   have "h = g"
  2884     apply (rule ext) using gf h(2,3)
  2834     by (metis gf h isomorphism_expand left_right_inverse_eq)
  2885     apply (simp add: o_def id_def fun_eq_iff)
  2835   with \<open>linear h\<close> show ?thesis by blast
  2886     apply metis
       
  2887     done
       
  2888   with h(1) show ?thesis by blast
       
  2889 qed
  2836 qed
  2890 
  2837 
  2891 lemma inj_linear_imp_inv_linear:
  2838 lemma inj_linear_imp_inv_linear:
  2892   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2839   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
  2893   assumes "linear f" "inj f" shows "linear (inv f)"
  2840   assumes "linear f" "inj f" shows "linear (inv f)"
  2942 
  2889 
  2943 lemma infnorm_0: "infnorm 0 = 0"
  2890 lemma infnorm_0: "infnorm 0 = 0"
  2944   by (simp add: infnorm_eq_0)
  2891   by (simp add: infnorm_eq_0)
  2945 
  2892 
  2946 lemma infnorm_neg: "infnorm (- x) = infnorm x"
  2893 lemma infnorm_neg: "infnorm (- x) = infnorm x"
  2947   unfolding infnorm_def
  2894   unfolding infnorm_def by simp
  2948   apply (rule cong[of "Sup" "Sup"])
       
  2949   apply blast
       
  2950   apply auto
       
  2951   done
       
  2952 
  2895 
  2953 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
  2896 lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
  2954 proof -
  2897   by (metis infnorm_neg minus_diff_eq)
  2955   have "y - x = - (x - y)" by simp
  2898 
  2956   then show ?thesis
  2899 lemma absdiff_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
  2957     by (metis infnorm_neg)
  2900 proof -
  2958 qed
  2901   have *: "\<And>(nx::real) n ny. nx \<le> n + ny \<Longrightarrow> ny \<le> n + nx \<Longrightarrow> \<bar>nx - ny\<bar> \<le> n"
  2959 
       
  2960 lemma real_abs_sub_infnorm: "\<bar>infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
       
  2961 proof -
       
  2962   have th: "\<And>(nx::real) n ny. nx \<le> n + ny \<Longrightarrow> ny \<le> n + nx \<Longrightarrow> \<bar>nx - ny\<bar> \<le> n"
       
  2963     by arith
  2902     by arith
  2964   from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
  2903   show ?thesis
  2965   have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
  2904   proof (rule *)
  2966     "infnorm y \<le> infnorm (x - y) + infnorm x"
  2905     from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
  2967     by (simp_all add: field_simps infnorm_neg)
  2906     show "infnorm x \<le> infnorm (x - y) + infnorm y" "infnorm y \<le> infnorm (x - y) + infnorm x"
  2968   from th[OF ths] show ?thesis .
  2907       by (simp_all add: field_simps infnorm_neg)
       
  2908   qed
  2969 qed
  2909 qed
  2970 
  2910 
  2971 lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
  2911 lemma real_abs_infnorm: "\<bar>infnorm x\<bar> = infnorm x"
  2972   using infnorm_pos_le[of x] by arith
  2912   using infnorm_pos_le[of x] by arith
  2973 
  2913 
  2978 
  2918 
  2979 lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
  2919 lemma infnorm_mul: "infnorm (a *\<^sub>R x) = \<bar>a\<bar> * infnorm x"
  2980   unfolding infnorm_Max
  2920   unfolding infnorm_Max
  2981 proof (safe intro!: Max_eqI)
  2921 proof (safe intro!: Max_eqI)
  2982   let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  2922   let ?B = "(\<lambda>i. \<bar>x \<bullet> i\<bar>) ` Basis"
  2983   {
  2923   { fix b :: 'a
  2984     fix b :: 'a
       
  2985     assume "b \<in> Basis"
  2924     assume "b \<in> Basis"
  2986     then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
  2925     then show "\<bar>a *\<^sub>R x \<bullet> b\<bar> \<le> \<bar>a\<bar> * Max ?B"
  2987       by (simp add: abs_mult mult_left_mono)
  2926       by (simp add: abs_mult mult_left_mono)
  2988   next
  2927   next
  2989     from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
  2928     from Max_in[of ?B] obtain b where "b \<in> Basis" "Max ?B = \<bar>x \<bullet> b\<bar>"
  3005   by (simp add: Basis_le_norm infnorm_Max)
  2944   by (simp add: Basis_le_norm infnorm_Max)
  3006 
  2945 
  3007 lemma norm_le_infnorm:
  2946 lemma norm_le_infnorm:
  3008   fixes x :: "'a::euclidean_space"
  2947   fixes x :: "'a::euclidean_space"
  3009   shows "norm x \<le> sqrt DIM('a) * infnorm x"
  2948   shows "norm x \<le> sqrt DIM('a) * infnorm x"
  3010 proof -
  2949   unfolding norm_eq_sqrt_inner id_def 
  3011   let ?d = "DIM('a)"
  2950 proof (rule real_le_lsqrt[OF inner_ge_zero])
  3012   have "real ?d \<ge> 0"
  2951   show "sqrt DIM('a) * infnorm x \<ge> 0"
  3013     by simp
       
  3014   then have d2: "(sqrt (real ?d))\<^sup>2 = real ?d"
       
  3015     by (auto intro: real_sqrt_pow2)
       
  3016   have th: "sqrt (real ?d) * infnorm x \<ge> 0"
       
  3017     by (simp add: zero_le_mult_iff infnorm_pos_le)
  2952     by (simp add: zero_le_mult_iff infnorm_pos_le)
  3018   have th1: "x \<bullet> x \<le> (sqrt (real ?d) * infnorm x)\<^sup>2"
  2953   have "x \<bullet> x \<le> (\<Sum>b\<in>Basis. x \<bullet> b * (x \<bullet> b))"
  3019     unfolding power_mult_distrib d2
  2954     by (metis euclidean_inner order_refl)
  3020     apply (subst euclidean_inner)
  2955   also have "... \<le> DIM('a) * \<bar>infnorm x\<bar>\<^sup>2"
  3021     apply (subst power2_abs[symmetric])
  2956     by (rule sum_bounded_above) (metis Basis_le_infnorm abs_le_square_iff power2_eq_square real_abs_infnorm)
  3022     apply (rule order_trans[OF sum_bounded_above[where K="\<bar>infnorm x\<bar>\<^sup>2"]])
  2957   also have "... \<le> (sqrt DIM('a) * infnorm x)\<^sup>2"
  3023     apply (auto simp add: power2_eq_square[symmetric])
  2958     by (simp add: power_mult_distrib)
  3024     apply (subst power2_abs[symmetric])
  2959   finally show "x \<bullet> x \<le> (sqrt DIM('a) * infnorm x)\<^sup>2" .
  3025     apply (rule power_mono)
       
  3026     apply (auto simp: infnorm_Max)
       
  3027     done
       
  3028   from real_le_lsqrt[OF inner_ge_zero th th1]
       
  3029   show ?thesis
       
  3030     unfolding norm_eq_sqrt_inner id_def .
       
  3031 qed
  2960 qed
  3032 
  2961 
  3033 lemma tendsto_infnorm [tendsto_intros]:
  2962 lemma tendsto_infnorm [tendsto_intros]:
  3034   assumes "(f \<longlongrightarrow> a) F"
  2963   assumes "(f \<longlongrightarrow> a) F"
  3035   shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
  2964   shows "((\<lambda>x. infnorm (f x)) \<longlongrightarrow> infnorm a) F"
  3036 proof (rule tendsto_compose [OF LIM_I assms])
  2965 proof (rule tendsto_compose [OF LIM_I assms])
  3037   fix r :: real
  2966   fix r :: real
  3038   assume "r > 0"
  2967   assume "r > 0"
  3039   then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
  2968   then show "\<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (infnorm x - infnorm a) < r"
  3040     by (metis real_norm_def le_less_trans real_abs_sub_infnorm infnorm_le_norm)
  2969     by (metis real_norm_def le_less_trans absdiff_infnorm infnorm_le_norm)
  3041 qed
  2970 qed
  3042 
  2971 
  3043 text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
  2972 text \<open>Equality in Cauchy-Schwarz and triangle inequalities.\<close>
  3044 
  2973 
  3045 lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  2974 lemma norm_cauchy_schwarz_eq: "x \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3046   (is "?lhs \<longleftrightarrow> ?rhs")
  2975   (is "?lhs \<longleftrightarrow> ?rhs")
  3047 proof -
  2976 proof (cases "x=0")
  3048   {
  2977   case True
  3049     assume h: "x = 0"
  2978   then show ?thesis 
  3050     then have ?thesis by simp
  2979     by auto
  3051   }
  2980 next
  3052   moreover
  2981   case False
  3053   {
  2982   from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
  3054     assume h: "y = 0"
  2983   have "?rhs \<longleftrightarrow>
  3055     then have ?thesis by simp
       
  3056   }
       
  3057   moreover
       
  3058   {
       
  3059     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
       
  3060     from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"]
       
  3061     have "?rhs \<longleftrightarrow>
       
  3062       (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
  2984       (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) -
  3063         norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) =  0)"
  2985         norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) =  0)"
  3064       using x y
  2986     using False unfolding inner_simps
  3065       unfolding inner_simps
  2987     by (auto simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
  3066       unfolding power2_norm_eq_inner[symmetric] power2_eq_square right_minus_eq
  2988   also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" 
  3067       apply (simp add: inner_commute)
  2989     using False  by (simp add: field_simps inner_commute)
  3068       apply (simp add: field_simps)
  2990   also have "\<dots> \<longleftrightarrow> ?lhs" 
  3069       apply metis
  2991     using False by auto
  3070       done
  2992   finally show ?thesis by metis
  3071     also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
       
  3072       by (simp add: field_simps inner_commute)
       
  3073     also have "\<dots> \<longleftrightarrow> ?lhs" using x y
       
  3074       apply simp
       
  3075       apply metis
       
  3076       done
       
  3077     finally have ?thesis by blast
       
  3078   }
       
  3079   ultimately show ?thesis by blast
       
  3080 qed
  2993 qed
  3081 
  2994 
  3082 lemma norm_cauchy_schwarz_abs_eq:
  2995 lemma norm_cauchy_schwarz_abs_eq:
  3083   "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
  2996   "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow>
  3084     norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
  2997     norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm x *\<^sub>R y = - norm y *\<^sub>R x"
  3086 proof -
  2999 proof -
  3087   have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> \<bar>x\<bar> = a \<longleftrightarrow> x = a \<or> x = - a"
  3000   have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> \<bar>x\<bar> = a \<longleftrightarrow> x = a \<or> x = - a"
  3088     by arith
  3001     by arith
  3089   have "?rhs \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)"
  3002   have "?rhs \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x \<or> norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)"
  3090     by simp
  3003     by simp
  3091   also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or> (- x) \<bullet> y = norm x * norm y)"
  3004   also have "\<dots> \<longleftrightarrow> (x \<bullet> y = norm x * norm y \<or> (- x) \<bullet> y = norm x * norm y)"
  3092     unfolding norm_cauchy_schwarz_eq[symmetric]
  3005     unfolding norm_cauchy_schwarz_eq[symmetric]
  3093     unfolding norm_minus_cancel norm_scaleR ..
  3006     unfolding norm_minus_cancel norm_scaleR ..
  3094   also have "\<dots> \<longleftrightarrow> ?lhs"
  3007   also have "\<dots> \<longleftrightarrow> ?lhs"
  3095     unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps
  3008     unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps
  3096     by auto
  3009     by auto
  3098 qed
  3011 qed
  3099 
  3012 
  3100 lemma norm_triangle_eq:
  3013 lemma norm_triangle_eq:
  3101   fixes x y :: "'a::real_inner"
  3014   fixes x y :: "'a::real_inner"
  3102   shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3015   shows "norm (x + y) = norm x + norm y \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3103 proof -
  3016 proof (cases "x = 0 \<or> y = 0")
  3104   {
  3017   case True
  3105     assume x: "x = 0 \<or> y = 0"
  3018   then show ?thesis 
  3106     then have ?thesis
  3019     by force
  3107       by (cases "x = 0") simp_all
  3020 next
  3108   }
  3021   case False
  3109   moreover
  3022   then have n: "norm x > 0" "norm y > 0"
  3110   {
  3023     by auto
  3111     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3024   have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
  3112     then have "norm x \<noteq> 0" "norm y \<noteq> 0"
  3025     by simp
  3113       by simp_all
  3026   also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
  3114     then have n: "norm x > 0" "norm y > 0"
  3027     unfolding norm_cauchy_schwarz_eq[symmetric]
  3115       using norm_ge_zero[of x] norm_ge_zero[of y] by arith+
  3028     unfolding power2_norm_eq_inner inner_simps
  3116     have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 \<Longrightarrow> a = b + c \<longleftrightarrow> a\<^sup>2 = (b + c)\<^sup>2"
  3029     by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
  3117       by algebra
  3030   finally show ?thesis .
  3118     have "norm (x + y) = norm x + norm y \<longleftrightarrow> (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2"
       
  3119       apply (rule th)
       
  3120       using n norm_ge_zero[of "x + y"]
       
  3121       apply arith
       
  3122       done
       
  3123     also have "\<dots> \<longleftrightarrow> norm x *\<^sub>R y = norm y *\<^sub>R x"
       
  3124       unfolding norm_cauchy_schwarz_eq[symmetric]
       
  3125       unfolding power2_norm_eq_inner inner_simps
       
  3126       by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps)
       
  3127     finally have ?thesis .
       
  3128   }
       
  3129   ultimately show ?thesis by blast
       
  3130 qed
  3031 qed
  3131 
  3032 
  3132 
  3033 
  3133 subsection \<open>Collinearity\<close>
  3034 subsection \<open>Collinearity\<close>
  3134 
  3035 
  3183   by (simp add: collinear_def)
  3084   by (simp add: collinear_def)
  3184 
  3085 
  3185 lemma collinear_2 [iff]: "collinear {x, y}"
  3086 lemma collinear_2 [iff]: "collinear {x, y}"
  3186   apply (simp add: collinear_def)
  3087   apply (simp add: collinear_def)
  3187   apply (rule exI[where x="x - y"])
  3088   apply (rule exI[where x="x - y"])
  3188   apply auto
  3089   by (metis minus_diff_eq scaleR_left.minus scaleR_one)
  3189   apply (rule exI[where x=1], simp)
       
  3190   apply (rule exI[where x="- 1"], simp)
       
  3191   done
       
  3192 
  3090 
  3193 lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
  3091 lemma collinear_lemma: "collinear {0, x, y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *\<^sub>R x)"
  3194   (is "?lhs \<longleftrightarrow> ?rhs")
  3092   (is "?lhs \<longleftrightarrow> ?rhs")
  3195 proof -
  3093 proof (cases "x = 0 \<or> y = 0")
  3196   {
  3094   case True
  3197     assume "x = 0 \<or> y = 0"
  3095   then show ?thesis
  3198     then have ?thesis
  3096     by (auto simp: insert_commute)
  3199       by (cases "x = 0") (simp_all add: collinear_2 insert_commute)
  3097 next
  3200   }
  3098   case False
  3201   moreover
  3099   show ?thesis 
  3202   {
  3100   proof
  3203     assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
  3101     assume h: "?lhs"
  3204     have ?thesis
  3102     then obtain u where u: "\<forall> x\<in> {0,x,y}. \<forall>y\<in> {0,x,y}. \<exists>c. x - y = c *\<^sub>R u"
  3205     proof
  3103       unfolding collinear_def by blast
  3206       assume h: "?lhs"
  3104     from u[rule_format, of x 0] u[rule_format, of y 0]
  3207       then obtain u where u: "\<forall> x\<in> {0,x,y}. \<forall>y\<in> {0,x,y}. \<exists>c. x - y = c *\<^sub>R u"
  3105     obtain cx and cy where
  3208         unfolding collinear_def by blast
  3106       cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
  3209       from u[rule_format, of x 0] u[rule_format, of y 0]
  3107       by auto
  3210       obtain cx and cy where
  3108     from cx cy False have cx0: "cx \<noteq> 0" and cy0: "cy \<noteq> 0" by auto
  3211         cx: "x = cx *\<^sub>R u" and cy: "y = cy *\<^sub>R u"
  3109     let ?d = "cy / cx"
  3212         by auto
  3110     from cx cy cx0 have "y = ?d *\<^sub>R x"
  3213       from cx x have cx0: "cx \<noteq> 0" by auto
  3111       by simp
  3214       from cy y have cy0: "cy \<noteq> 0" by auto
  3112     then show ?rhs using False by blast
  3215       let ?d = "cy / cx"
  3113   next
  3216       from cx cy cx0 have "y = ?d *\<^sub>R x"
  3114     assume h: "?rhs"
  3217         by simp
  3115     then obtain c where c: "y = c *\<^sub>R x"
  3218       then show ?rhs using x y by blast
  3116       using False by blast
  3219     next
  3117     show ?lhs
  3220       assume h: "?rhs"
  3118       unfolding collinear_def c
  3221       then obtain c where c: "y = c *\<^sub>R x"
  3119       apply (rule exI[where x=x])
  3222         using x y by blast
  3120       apply auto
  3223       show ?lhs
  3121           apply (rule exI[where x="- 1"], simp)
  3224         unfolding collinear_def c
  3122          apply (rule exI[where x= "-c"], simp)
  3225         apply (rule exI[where x=x])
       
  3226         apply auto
       
  3227         apply (rule exI[where x="- 1"], simp)
       
  3228         apply (rule exI[where x= "-c"], simp)
       
  3229         apply (rule exI[where x=1], simp)
  3123         apply (rule exI[where x=1], simp)
  3230         apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib)
  3124        apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib)
  3231         apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib)
  3125       apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib)
  3232         done
  3126       done
  3233     qed
  3127   qed
  3234   }
       
  3235   ultimately show ?thesis by blast
       
  3236 qed
  3128 qed
  3237 
  3129 
  3238 lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
  3130 lemma norm_cauchy_schwarz_equal: "\<bar>x \<bullet> y\<bar> = norm x * norm y \<longleftrightarrow> collinear {0, x, y}"
  3239   unfolding norm_cauchy_schwarz_abs_eq
  3131 proof (cases "x=0")
  3240   apply (cases "x=0", simp_all)
  3132   case True
  3241   apply (cases "y=0", simp_all add: insert_commute)
  3133   then show ?thesis
  3242   unfolding collinear_lemma
  3134     by (auto simp: insert_commute)
  3243   apply simp
  3135 next
  3244   apply (subgoal_tac "norm x \<noteq> 0")
  3136   case False
  3245   apply (subgoal_tac "norm y \<noteq> 0")
  3137   then have nnz: "norm x \<noteq> 0"
  3246   apply (rule iffI)
  3138     by auto
  3247   apply (cases "norm x *\<^sub>R y = norm y *\<^sub>R x")
  3139   show ?thesis
  3248   apply (rule exI[where x="(1/norm x) * norm y"])
  3140   proof
  3249   apply (drule sym)
  3141     assume "\<bar>x \<bullet> y\<bar> = norm x * norm y"
  3250   unfolding scaleR_scaleR[symmetric]
  3142     then show "collinear {0, x, y}"
  3251   apply (simp add: field_simps)
  3143       unfolding norm_cauchy_schwarz_abs_eq collinear_lemma 
  3252   apply (rule exI[where x="(1/norm x) * - norm y"])
  3144       by (meson eq_vector_fraction_iff nnz)
  3253   apply clarify
  3145   next
  3254   apply (drule sym)
  3146     assume "collinear {0, x, y}"
  3255   unfolding scaleR_scaleR[symmetric]
  3147     with False show "\<bar>x \<bullet> y\<bar> = norm x * norm y"
  3256   apply (simp add: field_simps)
  3148       unfolding norm_cauchy_schwarz_abs_eq collinear_lemma  by (auto simp: abs_if)
  3257   apply (erule exE)
  3149   qed
  3258   apply (erule ssubst)
  3150 qed
  3259   unfolding scaleR_scaleR
       
  3260   unfolding norm_scaleR
       
  3261   apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
       
  3262   apply (auto simp add: field_simps)
       
  3263   done
       
  3264 
  3151 
  3265 end
  3152 end