added Johannes' generalizations Modules.thy and Vector_Spaces.thy; adapted HOL and HOL-Analysis accordingly
--- a/CONTRIBUTORS Wed Apr 18 21:12:50 2018 +0100
+++ b/CONTRIBUTORS Wed May 02 13:49:38 2018 +0200
@@ -6,6 +6,12 @@
Contributions to this Isabelle version
--------------------------------------
+* April 2018: Jose Divasón (Universidad de la Rioja),
+ Jesús Aransay (Universidad de la Rioja), Johannes Hölzl (VU Amsterdam),
+ Fabian Immler (TUM)
+ Generalizations in the formalization of linear algebra.
+
+
* March 2018: Florian Haftmann
Abstract bit operations push_bit, push_take, push_drop, alongside
with an algebraic foundation for bit strings and word types in
--- a/NEWS Wed Apr 18 21:12:50 2018 +0100
+++ b/NEWS Wed May 02 13:49:38 2018 +0200
@@ -257,6 +257,15 @@
* The relator rel_filter on filters has been strengthened to its
canonical categorical definition with better properties. INCOMPATIBILITY.
+* Generalized linear algebra involving linear, span, dependent, dim
+from type class real_vector to locales module and vector_space.
+Renamed:
+ - span_inc ~> span_superset
+ - span_superset ~> span_base
+ - span_eq ~> span_eq_iff
+INCOMPATIBILITY.
+
+
* HOL-Algebra: renamed (^) to [^]
* Session HOL-Analysis: Moebius functions, the Riemann mapping
--- a/src/HOL/Algebra/Congruence.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Algebra/Congruence.thy Wed May 02 13:49:38 2018 +0200
@@ -4,9 +4,8 @@
*)
theory Congruence
-imports
- Main
- "HOL-Library.FuncSet"
+ imports
+ Main HOL.FuncSet
begin
section \<open>Objects\<close>
--- a/src/HOL/Algebra/Group.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Algebra/Group.thy Wed May 02 13:49:38 2018 +0200
@@ -5,7 +5,7 @@
*)
theory Group
-imports Complete_Lattice "HOL-Library.FuncSet"
+imports Complete_Lattice HOL.FuncSet
begin
section \<open>Monoids and Groups\<close>
--- a/src/HOL/Algebra/Order.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Algebra/Order.thy Wed May 02 13:49:38 2018 +0200
@@ -7,9 +7,8 @@
*)
theory Order
-imports
- "HOL-Library.FuncSet"
- Congruence
+ imports
+ Congruence
begin
section \<open>Orders\<close>
--- a/src/HOL/Analysis/Bochner_Integration.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Bochner_Integration.thy Wed May 02 13:49:38 2018 +0200
@@ -394,17 +394,19 @@
by (simp add: sum.distrib[symmetric] scaleR_add_right)
qed
-lemma (in linear) simple_bochner_integral_linear:
+lemma simple_bochner_integral_linear:
+ assumes "linear f"
assumes g: "simple_bochner_integrable M g"
shows "simple_bochner_integral M (\<lambda>x. f (g x)) = f (simple_bochner_integral M g)"
proof -
+ interpret linear f by fact
from g have "simple_bochner_integral M (\<lambda>x. f (g x)) =
(\<Sum>y\<in>g ` space M. measure M {x \<in> space M. g x = y} *\<^sub>R f y)"
by (intro simple_bochner_integral_partition)
(auto simp: simple_bochner_integrable_compose2[where p="\<lambda>x y. f x"] zero
elim: simple_bochner_integrable.cases)
also have "\<dots> = f (simple_bochner_integral M g)"
- by (simp add: simple_bochner_integral_def sum scaleR)
+ by (simp add: simple_bochner_integral_def sum scale)
finally show ?thesis .
qed
@@ -412,8 +414,7 @@
assumes f: "simple_bochner_integrable M f"
shows "simple_bochner_integral M (\<lambda>x. - f x) = - simple_bochner_integral M f"
proof -
- interpret linear uminus by unfold_locales auto
- from f show ?thesis
+ from linear_uminus f show ?thesis
by (rule simple_bochner_integral_linear)
qed
@@ -646,7 +647,7 @@
assume "(\<lambda>i. simple_bochner_integral M (s i)) \<longlonglongrightarrow> x"
with s show "(\<lambda>i. simple_bochner_integral M (\<lambda>x. T (s i x))) \<longlonglongrightarrow> T x"
- by (auto intro!: T.tendsto simp: T.simple_bochner_integral_linear)
+ by (auto intro!: T.tendsto simp: simple_bochner_integral_linear T.linear_axioms)
qed
lemma has_bochner_integral_zero[intro]: "has_bochner_integral M (\<lambda>x. 0) 0"
--- a/src/HOL/Analysis/Bounded_Linear_Function.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Bounded_Linear_Function.thy Wed May 02 13:49:38 2018 +0200
@@ -529,7 +529,7 @@
lemma Blinfun_eq_matrix: "bounded_linear f \<Longrightarrow> Blinfun f = blinfun_of_matrix (\<lambda>i j. f j \<bullet> i)"
by (intro blinfun_euclidean_eqI)
(auto simp: blinfun_of_matrix_apply bounded_linear_Blinfun_apply inner_Basis if_distrib
- cond_application_beta sum.delta' euclidean_representation
+ if_distribR sum.delta' euclidean_representation
cong: if_cong)
text \<open>TODO: generalize (via \<open>compact_cball\<close>)?\<close>
--- a/src/HOL/Analysis/Cartesian_Euclidean_Space.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Cartesian_Euclidean_Space.thy Wed May 02 13:49:38 2018 +0200
@@ -1,19 +1,9 @@
section \<open>Instantiates the finite Cartesian product of Euclidean spaces as a Euclidean space\<close>
theory Cartesian_Euclidean_Space
-imports Finite_Cartesian_Product Derivative
+imports Cartesian_Space Derivative
begin
-lemma norm_le_componentwise:
- "(\<And>b. b \<in> Basis \<Longrightarrow> abs(x \<bullet> b) \<le> abs(y \<bullet> b)) \<Longrightarrow> norm x \<le> norm y"
- by (auto simp: norm_le euclidean_inner [of x x] euclidean_inner [of y y] abs_le_square_iff power2_eq_square intro!: sum_mono)
-
-lemma norm_le_componentwise_cart:
- fixes x :: "real^'n"
- shows "(\<And>i. abs(x$i) \<le> abs(y$i)) \<Longrightarrow> norm x \<le> norm y"
- unfolding cart_eq_inner_axis
- by (rule norm_le_componentwise) (metis axis_index)
-
lemma subspace_special_hyperplane: "subspace {x. x $ k = 0}"
by (simp add: subspace_def)
@@ -31,254 +21,9 @@
qed simp
qed simp
-subsection\<open>Basic componentwise operations on vectors\<close>
-
-instantiation vec :: (times, finite) times
-begin
-
-definition "( * ) \<equiv> (\<lambda> x y. (\<chi> i. (x$i) * (y$i)))"
-instance ..
-
-end
-
-instantiation vec :: (one, finite) one
-begin
-
-definition "1 \<equiv> (\<chi> i. 1)"
-instance ..
-
-end
-
-instantiation vec :: (ord, finite) ord
-begin
-
-definition "x \<le> y \<longleftrightarrow> (\<forall>i. x$i \<le> y$i)"
-definition "x < (y::'a^'b) \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
-instance ..
-
-end
-
-text\<open>The ordering on one-dimensional vectors is linear.\<close>
-
-class cart_one =
- assumes UNIV_one: "card (UNIV :: 'a set) = Suc 0"
-begin
-
-subclass finite
-proof
- from UNIV_one show "finite (UNIV :: 'a set)"
- by (auto intro!: card_ge_0_finite)
-qed
-
-end
-
-instance vec:: (order, finite) order
- by standard (auto simp: less_eq_vec_def less_vec_def vec_eq_iff
- intro: order.trans order.antisym order.strict_implies_order)
-
-instance vec :: (linorder, cart_one) linorder
-proof
- obtain a :: 'b where all: "\<And>P. (\<forall>i. P i) \<longleftrightarrow> P a"
- proof -
- have "card (UNIV :: 'b set) = Suc 0" by (rule UNIV_one)
- then obtain b :: 'b where "UNIV = {b}" by (auto iff: card_Suc_eq)
- then have "\<And>P. (\<forall>i\<in>UNIV. P i) \<longleftrightarrow> P b" by auto
- then show thesis by (auto intro: that)
- qed
- fix x y :: "'a^'b::cart_one"
- note [simp] = less_eq_vec_def less_vec_def all vec_eq_iff field_simps
- show "x \<le> y \<or> y \<le> x" by auto
-qed
-
-text\<open>Constant Vectors\<close>
-
-definition "vec x = (\<chi> i. x)"
-
lemma interval_cbox_cart: "{a::real^'n..b} = cbox a b"
by (auto simp add: less_eq_vec_def mem_box Basis_vec_def inner_axis)
-text\<open>Also the scalar-vector multiplication.\<close>
-
-definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70)
- where "c *s x = (\<chi> i. c * (x$i))"
-
-
-subsection \<open>A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space\<close>
-
-lemma sum_cong_aux:
- "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> sum f A = sum g A"
- by (auto intro: sum.cong)
-
-hide_fact (open) sum_cong_aux
-
-method_setup vector = \<open>
-let
- val ss1 =
- simpset_of (put_simpset HOL_basic_ss @{context}
- addsimps [@{thm sum.distrib} RS sym,
- @{thm sum_subtractf} RS sym, @{thm sum_distrib_left},
- @{thm sum_distrib_right}, @{thm sum_negf} RS sym])
- val ss2 =
- simpset_of (@{context} addsimps
- [@{thm plus_vec_def}, @{thm times_vec_def},
- @{thm minus_vec_def}, @{thm uminus_vec_def},
- @{thm one_vec_def}, @{thm zero_vec_def}, @{thm vec_def},
- @{thm scaleR_vec_def},
- @{thm vec_lambda_beta}, @{thm vector_scalar_mult_def}])
- fun vector_arith_tac ctxt ths =
- simp_tac (put_simpset ss1 ctxt)
- THEN' (fn i => resolve_tac ctxt @{thms Cartesian_Euclidean_Space.sum_cong_aux} i
- ORELSE resolve_tac ctxt @{thms sum.neutral} i
- ORELSE simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm vec_eq_iff}]) i)
- (* THEN' TRY o clarify_tac HOL_cs THEN' (TRY o rtac @{thm iffI}) *)
- THEN' asm_full_simp_tac (put_simpset ss2 ctxt addsimps ths)
-in
- Attrib.thms >> (fn ths => fn ctxt => SIMPLE_METHOD' (vector_arith_tac ctxt ths))
-end
-\<close> "lift trivial vector statements to real arith statements"
-
-lemma vec_0[simp]: "vec 0 = 0" by vector
-lemma vec_1[simp]: "vec 1 = 1" by vector
-
-lemma vec_inj[simp]: "vec x = vec y \<longleftrightarrow> x = y" by vector
-
-lemma vec_in_image_vec: "vec x \<in> (vec ` S) \<longleftrightarrow> x \<in> S" by auto
-
-lemma vec_add: "vec(x + y) = vec x + vec y" by vector
-lemma vec_sub: "vec(x - y) = vec x - vec y" by vector
-lemma vec_cmul: "vec(c * x) = c *s vec x " by vector
-lemma vec_neg: "vec(- x) = - vec x " by vector
-
-lemma vec_scaleR: "vec(c * x) = c *\<^sub>R vec x"
- by vector
-
-lemma vec_sum:
- assumes "finite S"
- shows "vec(sum f S) = sum (vec \<circ> f) S"
- using assms
-proof induct
- case empty
- then show ?case by simp
-next
- case insert
- then show ?case by (auto simp add: vec_add)
-qed
-
-text\<open>Obvious "component-pushing".\<close>
-
-lemma vec_component [simp]: "vec x $ i = x"
- by vector
-
-lemma vector_mult_component [simp]: "(x * y)$i = x$i * y$i"
- by vector
-
-lemma vector_smult_component [simp]: "(c *s y)$i = c * (y$i)"
- by vector
-
-lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
-
-lemmas vector_component =
- vec_component vector_add_component vector_mult_component
- vector_smult_component vector_minus_component vector_uminus_component
- vector_scaleR_component cond_component
-
-
-subsection \<open>Some frequently useful arithmetic lemmas over vectors\<close>
-
-instance vec :: (semigroup_mult, finite) semigroup_mult
- by standard (vector mult.assoc)
-
-instance vec :: (monoid_mult, finite) monoid_mult
- by standard vector+
-
-instance vec :: (ab_semigroup_mult, finite) ab_semigroup_mult
- by standard (vector mult.commute)
-
-instance vec :: (comm_monoid_mult, finite) comm_monoid_mult
- by standard vector
-
-instance vec :: (semiring, finite) semiring
- by standard (vector field_simps)+
-
-instance vec :: (semiring_0, finite) semiring_0
- by standard (vector field_simps)+
-instance vec :: (semiring_1, finite) semiring_1
- by standard vector
-instance vec :: (comm_semiring, finite) comm_semiring
- by standard (vector field_simps)+
-
-instance vec :: (comm_semiring_0, finite) comm_semiring_0 ..
-instance vec :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add ..
-instance vec :: (semiring_0_cancel, finite) semiring_0_cancel ..
-instance vec :: (comm_semiring_0_cancel, finite) comm_semiring_0_cancel ..
-instance vec :: (ring, finite) ring ..
-instance vec :: (semiring_1_cancel, finite) semiring_1_cancel ..
-instance vec :: (comm_semiring_1, finite) comm_semiring_1 ..
-
-instance vec :: (ring_1, finite) ring_1 ..
-
-instance vec :: (real_algebra, finite) real_algebra
- by standard (simp_all add: vec_eq_iff)
-
-instance vec :: (real_algebra_1, finite) real_algebra_1 ..
-
-lemma of_nat_index: "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
-proof (induct n)
- case 0
- then show ?case by vector
-next
- case Suc
- then show ?case by vector
-qed
-
-lemma one_index [simp]: "(1 :: 'a :: one ^ 'n) $ i = 1"
- by vector
-
-lemma neg_one_index [simp]: "(- 1 :: 'a :: {one, uminus} ^ 'n) $ i = - 1"
- by vector
-
-instance vec :: (semiring_char_0, finite) semiring_char_0
-proof
- fix m n :: nat
- show "inj (of_nat :: nat \<Rightarrow> 'a ^ 'b)"
- by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
-qed
-
-instance vec :: (numeral, finite) numeral ..
-instance vec :: (semiring_numeral, finite) semiring_numeral ..
-
-lemma numeral_index [simp]: "numeral w $ i = numeral w"
- by (induct w) (simp_all only: numeral.simps vector_add_component one_index)
-
-lemma neg_numeral_index [simp]: "- numeral w $ i = - numeral w"
- by (simp only: vector_uminus_component numeral_index)
-
-instance vec :: (comm_ring_1, finite) comm_ring_1 ..
-instance vec :: (ring_char_0, finite) ring_char_0 ..
-
-lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
- by (vector mult.assoc)
-lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x"
- by (vector field_simps)
-lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y"
- by (vector field_simps)
-lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector
-lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector
-lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y"
- by (vector field_simps)
-lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
-lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
-lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
-lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
-lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
- by (vector field_simps)
-
-lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)"
- by (simp add: vec_eq_iff)
-
-lemma linear_vec [simp]: "linear vec"
- by (simp add: linearI vec_add vec_eq_iff)
-
lemma differentiable_vec:
fixes S :: "'a::euclidean_space set"
shows "vec differentiable_on S"
@@ -296,73 +41,6 @@
"box (vec a) (vec b) = {} \<longleftrightarrow> box a b = {}"
by (auto simp: Basis_vec_def mem_box box_eq_empty inner_axis)
-lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_zero)
-
-lemma norm_axis_1 [simp]: "norm (axis m (1::real)) = 1"
- by (simp add: inner_axis' norm_eq_1)
-
-lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
- by vector
-
-lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y"
- by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib)
-
-lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::real) = b \<or> x = 0"
- by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib)
-
-lemma vector_mul_lcancel_imp: "a \<noteq> (0::real) ==> a *s x = a *s y ==> (x = y)"
- by (metis vector_mul_lcancel)
-
-lemma vector_mul_rcancel_imp: "x \<noteq> 0 \<Longrightarrow> (a::real) *s x = b *s x ==> a = b"
- by (metis vector_mul_rcancel)
-
-lemma component_le_norm_cart: "\<bar>x$i\<bar> \<le> norm x"
- apply (simp add: norm_vec_def)
- apply (rule member_le_L2_set, simp_all)
- done
-
-lemma norm_bound_component_le_cart: "norm x \<le> e ==> \<bar>x$i\<bar> \<le> e"
- by (metis component_le_norm_cart order_trans)
-
-lemma norm_bound_component_lt_cart: "norm x < e ==> \<bar>x$i\<bar> < e"
- by (metis component_le_norm_cart le_less_trans)
-
-lemma norm_le_l1_cart: "norm x \<le> sum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
- by (simp add: norm_vec_def L2_set_le_sum)
-
-lemma scalar_mult_eq_scaleR [simp]: "c *s x = c *\<^sub>R x"
- unfolding scaleR_vec_def vector_scalar_mult_def by simp
-
-lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y"
- unfolding dist_norm scalar_mult_eq_scaleR
- unfolding scaleR_right_diff_distrib[symmetric] by simp
-
-lemma sum_component [simp]:
- fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n"
- shows "(sum f S)$i = sum (\<lambda>x. (f x)$i) S"
-proof (cases "finite S")
- case True
- then show ?thesis by induct simp_all
-next
- case False
- then show ?thesis by simp
-qed
-
-lemma sum_eq: "sum f S = (\<chi> i. sum (\<lambda>x. (f x)$i ) S)"
- by (simp add: vec_eq_iff)
-
-lemma sum_cmul:
- fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n"
- shows "sum (\<lambda>x. c *s f x) S = c *s sum f S"
- by (simp add: vec_eq_iff sum_distrib_left)
-
-lemma sum_norm_allsubsets_bound_cart:
- fixes f:: "'a \<Rightarrow> real ^'n"
- assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (sum f Q) \<le> e"
- shows "sum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) * e"
- using sum_norm_allsubsets_bound[OF assms]
- by simp
-
subsection\<open>Closures and interiors of halfspaces\<close>
lemma interior_halfspace_le [simp]:
@@ -497,270 +175,50 @@
by force
qed
-subsection \<open>Matrix operations\<close>
-
-text\<open>Matrix notation. NB: an MxN matrix is of type @{typ "'a^'n^'m"}, not @{typ "'a^'m^'n"}\<close>
-
-definition map_matrix::"('a \<Rightarrow> 'b) \<Rightarrow> (('a, 'i::finite)vec, 'j::finite) vec \<Rightarrow> (('b, 'i)vec, 'j) vec" where
- "map_matrix f x = (\<chi> i j. f (x $ i $ j))"
-
-lemma nth_map_matrix[simp]: "map_matrix f x $ i $ j = f (x $ i $ j)"
- by (simp add: map_matrix_def)
-
-definition matrix_matrix_mult :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m"
- (infixl "**" 70)
- where "m ** m' == (\<chi> i j. sum (\<lambda>k. ((m$i)$k) * ((m'$k)$j)) (UNIV :: 'n set)) ::'a ^ 'p ^'m"
-
-definition matrix_vector_mult :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm"
- (infixl "*v" 70)
- where "m *v x \<equiv> (\<chi> i. sum (\<lambda>j. ((m$i)$j) * (x$j)) (UNIV ::'n set)) :: 'a^'m"
-
-definition vector_matrix_mult :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n "
- (infixl "v*" 70)
- where "v v* m == (\<chi> j. sum (\<lambda>i. ((m$i)$j) * (v$i)) (UNIV :: 'm set)) :: 'a^'n"
-
-definition "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)"
-definition transpose where
- "(transpose::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))"
-definition "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))"
-definition "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))"
-definition "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}"
-definition "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}"
-
-lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def)
-lemma matrix_add_ldistrib: "(A ** (B + C)) = (A ** B) + (A ** C)"
- by (vector matrix_matrix_mult_def sum.distrib[symmetric] field_simps)
-
-lemma matrix_mul_lid [simp]:
- fixes A :: "'a::semiring_1 ^ 'm ^ 'n"
- shows "mat 1 ** A = A"
- apply (simp add: matrix_matrix_mult_def mat_def)
- apply vector
- apply (auto simp only: if_distrib cond_application_beta sum.delta'[OF finite]
- mult_1_left mult_zero_left if_True UNIV_I)
- done
-
-lemma matrix_mul_rid [simp]:
- fixes A :: "'a::semiring_1 ^ 'm ^ 'n"
- shows "A ** mat 1 = A"
- apply (simp add: matrix_matrix_mult_def mat_def)
- apply vector
- apply (auto simp only: if_distrib cond_application_beta sum.delta[OF finite]
- mult_1_right mult_zero_right if_True UNIV_I cong: if_cong)
- done
-
-lemma matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C"
- apply (vector matrix_matrix_mult_def sum_distrib_left sum_distrib_right mult.assoc)
- apply (subst sum.swap)
- apply simp
- done
-
-lemma matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x"
- apply (vector matrix_matrix_mult_def matrix_vector_mult_def
- sum_distrib_left sum_distrib_right mult.assoc)
- apply (subst sum.swap)
- apply simp
- done
-
-lemma matrix_vector_mul_lid [simp]: "mat 1 *v x = (x::'a::semiring_1 ^ 'n)"
- apply (vector matrix_vector_mult_def mat_def)
- apply (simp add: if_distrib cond_application_beta sum.delta' cong del: if_weak_cong)
- done
-
-lemma matrix_transpose_mul:
- "transpose(A ** B) = transpose B ** transpose (A::'a::comm_semiring_1^_^_)"
- by (simp add: matrix_matrix_mult_def transpose_def vec_eq_iff mult.commute)
-
-lemma matrix_eq:
- fixes A B :: "'a::semiring_1 ^ 'n ^ 'm"
- shows "A = B \<longleftrightarrow> (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs")
- apply auto
- apply (subst vec_eq_iff)
- apply clarify
- apply (clarsimp simp add: matrix_vector_mult_def if_distrib cond_application_beta vec_eq_iff cong del: if_weak_cong)
- apply (erule_tac x="axis ia 1" in allE)
- apply (erule_tac x="i" in allE)
- apply (auto simp add: if_distrib cond_application_beta axis_def
- sum.delta[OF finite] cong del: if_weak_cong)
- done
-
-lemma matrix_vector_mul_component: "((A::real^_^_) *v x)$k = (A$k) \<bullet> x"
- by (simp add: matrix_vector_mult_def inner_vec_def)
-
-lemma dot_lmul_matrix: "((x::real ^_) v* A) \<bullet> y = x \<bullet> (A *v y)"
- apply (simp add: inner_vec_def matrix_vector_mult_def vector_matrix_mult_def sum_distrib_right sum_distrib_left ac_simps)
- apply (subst sum.swap)
- apply simp
- done
-
-lemma transpose_mat [simp]: "transpose (mat n) = mat n"
- by (vector transpose_def mat_def)
-
-lemma transpose_transpose [simp]: "transpose(transpose A) = A"
- by (vector transpose_def)
-
-lemma row_transpose [simp]:
- fixes A:: "'a::semiring_1^_^_"
- shows "row i (transpose A) = column i A"
- by (simp add: row_def column_def transpose_def vec_eq_iff)
-
-lemma column_transpose [simp]:
- fixes A:: "'a::semiring_1^_^_"
- shows "column i (transpose A) = row i A"
- by (simp add: row_def column_def transpose_def vec_eq_iff)
-
-lemma rows_transpose [simp]: "rows(transpose (A::'a::semiring_1^_^_)) = columns A"
- by (auto simp add: rows_def columns_def row_transpose intro: set_eqI)
-
-lemma columns_transpose [simp]: "columns(transpose (A::'a::semiring_1^_^_)) = rows A"
- by (metis transpose_transpose rows_transpose)
-
lemma matrix_mult_transpose_dot_column:
fixes A :: "real^'n^'n"
- shows "transpose A ** A = (\<chi> i j. (column i A) \<bullet> (column j A))"
+ shows "transpose A ** A = (\<chi> i j. inner (column i A) (column j A))"
by (simp add: matrix_matrix_mult_def vec_eq_iff transpose_def column_def inner_vec_def)
lemma matrix_mult_transpose_dot_row:
fixes A :: "real^'n^'n"
- shows "A ** transpose A = (\<chi> i j. (row i A) \<bullet> (row j A))"
+ shows "A ** transpose A = (\<chi> i j. inner (row i A) (row j A))"
by (simp add: matrix_matrix_mult_def vec_eq_iff transpose_def row_def inner_vec_def)
text\<open>Two sometimes fruitful ways of looking at matrix-vector multiplication.\<close>
-lemma matrix_mult_dot: "A *v x = (\<chi> i. A$i \<bullet> x)"
+lemma matrix_mult_dot: "A *v x = (\<chi> i. inner (A$i) x)"
by (simp add: matrix_vector_mult_def inner_vec_def)
-lemma matrix_mult_sum:
- "(A::'a::comm_semiring_1^'n^'m) *v x = sum (\<lambda>i. (x$i) *s column i A) (UNIV:: 'n set)"
- by (simp add: matrix_vector_mult_def vec_eq_iff column_def mult.commute)
-
-lemma vector_componentwise:
- "(x::'a::ring_1^'n) = (\<chi> j. \<Sum>i\<in>UNIV. (x$i) * (axis i 1 :: 'a^'n) $ j)"
- by (simp add: axis_def if_distrib sum.If_cases vec_eq_iff)
-
-lemma basis_expansion: "sum (\<lambda>i. (x$i) *s axis i 1) UNIV = (x::('a::ring_1) ^'n)"
- by (auto simp add: axis_def vec_eq_iff if_distrib sum.If_cases cong del: if_weak_cong)
-
-lemma linear_componentwise_expansion:
- fixes f:: "real ^'m \<Rightarrow> real ^ _"
- assumes lf: "linear f"
- shows "(f x)$j = sum (\<lambda>i. (x$i) * (f (axis i 1)$j)) (UNIV :: 'm set)" (is "?lhs = ?rhs")
-proof -
- let ?M = "(UNIV :: 'm set)"
- let ?N = "(UNIV :: 'n set)"
- have "?rhs = (sum (\<lambda>i.(x$i) *\<^sub>R f (axis i 1) ) ?M)$j"
- unfolding sum_component by simp
- then show ?thesis
- unfolding linear_sum_mul[OF lf, symmetric]
- unfolding scalar_mult_eq_scaleR[symmetric]
- unfolding basis_expansion
- by simp
-qed
-
-subsection\<open>Inverse matrices (not necessarily square)\<close>
-
-definition
- "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
-
-definition
- "matrix_inv(A:: 'a::semiring_1^'n^'m) =
- (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
-
-text\<open>Correspondence between matrices and linear operators.\<close>
-
-definition matrix :: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n"
- where "matrix f = (\<chi> i j. (f(axis j 1))$i)"
-
-lemma matrix_id_mat_1: "matrix id = mat 1"
- by (simp add: mat_def matrix_def axis_def)
-
-lemma matrix_scaleR: "(matrix (( *\<^sub>R) r)) = mat r"
- by (simp add: mat_def matrix_def axis_def if_distrib cong: if_cong)
-
-lemma matrix_vector_mul_linear: "linear(\<lambda>x. A *v (x::real ^ _))"
- by (simp add: linear_iff matrix_vector_mult_def vec_eq_iff
- field_simps sum_distrib_left sum.distrib)
-
-lemma
- fixes A :: "real^'n^'m"
- shows matrix_vector_mult_linear_continuous_at [continuous_intros]: "isCont (( *v) A) z"
- and matrix_vector_mult_linear_continuous_on [continuous_intros]: "continuous_on S (( *v) A)"
- by (simp_all add: linear_linear linear_continuous_at linear_continuous_on matrix_vector_mul_linear)
-
-lemma matrix_vector_mult_add_distrib [algebra_simps]:
- "A *v (x + y) = A *v x + A *v y"
- by (vector matrix_vector_mult_def sum.distrib distrib_left)
-
-lemma matrix_vector_mult_diff_distrib [algebra_simps]:
- fixes A :: "'a::ring_1^'n^'m"
- shows "A *v (x - y) = A *v x - A *v y"
- by (vector matrix_vector_mult_def sum_subtractf right_diff_distrib)
-
-lemma matrix_vector_mult_scaleR[algebra_simps]:
- fixes A :: "real^'n^'m"
- shows "A *v (c *\<^sub>R x) = c *\<^sub>R (A *v x)"
- using linear_iff matrix_vector_mul_linear by blast
-
-lemma matrix_vector_mult_0_right [simp]: "A *v 0 = 0"
- by (simp add: matrix_vector_mult_def vec_eq_iff)
-
-lemma matrix_vector_mult_0 [simp]: "0 *v w = 0"
- by (simp add: matrix_vector_mult_def vec_eq_iff)
-
-lemma matrix_vector_mult_add_rdistrib [algebra_simps]:
- "(A + B) *v x = (A *v x) + (B *v x)"
- by (vector matrix_vector_mult_def sum.distrib distrib_right)
-
-lemma matrix_vector_mult_diff_rdistrib [algebra_simps]:
- fixes A :: "'a :: ring_1^'n^'m"
- shows "(A - B) *v x = (A *v x) - (B *v x)"
- by (vector matrix_vector_mult_def sum_subtractf left_diff_distrib)
-
-lemma matrix_works:
- assumes lf: "linear f"
- shows "matrix f *v x = f (x::real ^ 'n)"
- apply (simp add: matrix_def matrix_vector_mult_def vec_eq_iff mult.commute)
- by (simp add: linear_componentwise_expansion lf)
-
-lemma matrix_vector_mul: "linear f ==> f = (\<lambda>x. matrix f *v (x::real ^ 'n))"
- by (simp add: ext matrix_works)
-
-declare matrix_vector_mul [symmetric, simp]
-
-lemma matrix_of_matrix_vector_mul [simp]: "matrix(\<lambda>x. A *v (x :: real ^ 'n)) = A"
- by (simp add: matrix_eq matrix_vector_mul_linear matrix_works)
-
-lemma matrix_compose:
- assumes lf: "linear (f::real^'n \<Rightarrow> real^'m)"
- and lg: "linear (g::real^'m \<Rightarrow> real^_)"
- shows "matrix (g \<circ> f) = matrix g ** matrix f"
- using lf lg linear_compose[OF lf lg] matrix_works[OF linear_compose[OF lf lg]]
- by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def)
-
-lemma matrix_vector_column:
- "(A::'a::comm_semiring_1^'n^_) *v x = sum (\<lambda>i. (x$i) *s ((transpose A)$i)) (UNIV:: 'n set)"
- by (simp add: matrix_vector_mult_def transpose_def vec_eq_iff mult.commute)
-
lemma adjoint_matrix: "adjoint(\<lambda>x. (A::real^'n^'m) *v x) = (\<lambda>x. transpose A *v x)"
apply (rule adjoint_unique)
apply (simp add: transpose_def inner_vec_def matrix_vector_mult_def
sum_distrib_right sum_distrib_left)
apply (subst sum.swap)
- apply (auto simp add: ac_simps)
+ apply (simp add: ac_simps)
done
lemma matrix_adjoint: assumes lf: "linear (f :: real^'n \<Rightarrow> real ^'m)"
shows "matrix(adjoint f) = transpose(matrix f)"
- apply (subst matrix_vector_mul[OF lf])
- unfolding adjoint_matrix matrix_of_matrix_vector_mul
- apply rule
- done
+proof -
+ have "matrix(adjoint f) = matrix(adjoint (( *v) (matrix f)))"
+ by (simp add: lf)
+ also have "\<dots> = transpose(matrix f)"
+ unfolding adjoint_matrix matrix_of_matrix_vector_mul
+ apply rule
+ done
+ finally show ?thesis .
+qed
-lemma inj_matrix_vector_mult:
- fixes A::"'a::field^'n^'m"
- assumes "invertible A"
- shows "inj (( *v) A)"
- by (metis assms inj_on_inverseI invertible_def matrix_vector_mul_assoc matrix_vector_mul_lid)
+lemma matrix_vector_mul_bounded_linear[intro, simp]: "bounded_linear (( *v) A)" for A :: "real^'n^'m"
+ using matrix_vector_mul_linear[of A]
+ by (simp add: linear_conv_bounded_linear linear_matrix_vector_mul_eq)
+
+lemma
+ fixes A :: "real^'n^'m"
+ shows matrix_vector_mult_linear_continuous_at [continuous_intros]: "isCont (( *v) A) z"
+ and matrix_vector_mult_linear_continuous_on [continuous_intros]: "continuous_on S (( *v) A)"
+ by (simp_all add: linear_continuous_at linear_continuous_on)
subsection\<open>Some bounds on components etc. relative to operator norm\<close>
@@ -769,12 +227,10 @@
fixes A :: "real^'n^'m"
shows "norm(column i A) \<le> onorm(( *v) A)"
proof -
- have bl: "bounded_linear (( *v) A)"
- by (simp add: linear_linear matrix_vector_mul_linear)
have "norm (\<chi> j. A $ j $ i) \<le> norm (A *v axis i 1)"
by (simp add: matrix_mult_dot cart_eq_inner_axis)
also have "\<dots> \<le> onorm (( *v) A)"
- using onorm [OF bl, of "axis i 1"] by auto
+ using onorm [OF matrix_vector_mul_bounded_linear, of A "axis i 1"] by auto
finally have "norm (\<chi> j. A $ j $ i) \<le> onorm (( *v) A)" .
then show ?thesis
unfolding column_def .
@@ -794,7 +250,7 @@
lemma component_le_onorm:
fixes f :: "real^'m \<Rightarrow> real^'n"
shows "linear f \<Longrightarrow> \<bar>matrix f $ i $ j\<bar> \<le> onorm f"
- by (metis matrix_component_le_onorm matrix_vector_mul)
+ by (metis linear_matrix_vector_mul_eq matrix_component_le_onorm matrix_vector_mul)
lemma onorm_le_matrix_component_sum:
fixes A :: "real^'n^'m"
@@ -892,16 +348,8 @@
lemma vector_sub_project_orthogonal_cart: "(b::real^'n) \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *s b) = 0"
unfolding inner_simps scalar_mult_eq_scaleR by auto
-lemma left_invertible_transpose:
- "(\<exists>(B). B ** transpose (A) = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B). A ** B = mat 1)"
- by (metis matrix_transpose_mul transpose_mat transpose_transpose)
-
-lemma right_invertible_transpose:
- "(\<exists>(B). transpose (A) ** B = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B). B ** A = mat 1)"
- by (metis matrix_transpose_mul transpose_mat transpose_transpose)
-
lemma matrix_left_invertible_injective:
- fixes A :: "real^'n^'m"
+ fixes A :: "'a::field^'n^'m"
shows "(\<exists>B. B ** A = mat 1) \<longleftrightarrow> inj (( *v) A)"
proof safe
fix B
@@ -911,34 +359,29 @@
by (metis B matrix_vector_mul_assoc matrix_vector_mul_lid)
next
assume "inj (( *v) A)"
- with linear_injective_left_inverse[OF matrix_vector_mul_linear]
- obtain g where "linear g" and g: "g \<circ> ( *v) A = id"
+ from vec.linear_injective_left_inverse[OF matrix_vector_mul_linear_gen this]
+ obtain g where "Vector_Spaces.linear ( *s) ( *s) g" and g: "g \<circ> ( *v) A = id"
by blast
have "matrix g ** A = mat 1"
- by (metis \<open>linear g\<close> g matrix_compose matrix_id_mat_1 matrix_of_matrix_vector_mul matrix_vector_mul_linear)
+ by (metis matrix_vector_mul_linear_gen \<open>Vector_Spaces.linear ( *s) ( *s) g\<close> g matrix_compose_gen
+ matrix_eq matrix_id_mat_1 matrix_vector_mul(1))
then show "\<exists>B. B ** A = mat 1"
by metis
qed
-lemma matrix_left_invertible_ker:
- "(\<exists>B. (B::real ^'m^'n) ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> (\<forall>x. A *v x = 0 \<longrightarrow> x = 0)"
- unfolding matrix_left_invertible_injective
- using linear_injective_0[OF matrix_vector_mul_linear, of A]
- by (simp add: inj_on_def)
-
lemma matrix_right_invertible_surjective:
- "(\<exists>B. (A::real^'n^'m) ** (B::real^'m^'n) = mat 1) \<longleftrightarrow> surj (\<lambda>x. A *v x)"
+ "(\<exists>B. (A::'a::field^'n^'m) ** (B::'a::field^'m^'n) = mat 1) \<longleftrightarrow> surj (\<lambda>x. A *v x)"
proof -
- { fix B :: "real ^'m^'n"
+ { fix B :: "'a ^'m^'n"
assume AB: "A ** B = mat 1"
- { fix x :: "real ^ 'm"
+ { fix x :: "'a ^ 'm"
have "A *v (B *v x) = x"
- by (simp add: matrix_vector_mul_lid matrix_vector_mul_assoc AB) }
+ by (simp add: matrix_vector_mul_assoc AB) }
hence "surj (( *v) A)" unfolding surj_def by metis }
moreover
{ assume sf: "surj (( *v) A)"
- from linear_surjective_right_inverse[OF matrix_vector_mul_linear sf]
- obtain g:: "real ^'m \<Rightarrow> real ^'n" where g: "linear g" "( *v) A \<circ> g = id"
+ from vec.linear_surjective_right_inverse[OF _ this]
+ obtain g:: "'a ^'m \<Rightarrow> 'a ^'n" where g: "Vector_Spaces.linear ( *s) ( *s) g" "( *v) A \<circ> g = id"
by blast
have "A ** (matrix g) = mat 1"
@@ -946,69 +389,32 @@
matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
using g(2) unfolding o_def fun_eq_iff id_def
.
- hence "\<exists>B. A ** (B::real^'m^'n) = mat 1" by blast
+ hence "\<exists>B. A ** (B::'a^'m^'n) = mat 1" by blast
}
ultimately show ?thesis unfolding surj_def by blast
qed
-lemma matrix_left_invertible_independent_columns:
- fixes A :: "real^'n^'m"
- shows "(\<exists>(B::real ^'m^'n). B ** A = mat 1) \<longleftrightarrow>
- (\<forall>c. sum (\<lambda>i. c i *s column i A) (UNIV :: 'n set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof -
- let ?U = "UNIV :: 'n set"
- { assume k: "\<forall>x. A *v x = 0 \<longrightarrow> x = 0"
- { fix c i
- assume c: "sum (\<lambda>i. c i *s column i A) ?U = 0" and i: "i \<in> ?U"
- let ?x = "\<chi> i. c i"
- have th0:"A *v ?x = 0"
- using c
- unfolding matrix_mult_sum vec_eq_iff
- by auto
- from k[rule_format, OF th0] i
- have "c i = 0" by (vector vec_eq_iff)}
- hence ?rhs by blast }
- moreover
- { assume H: ?rhs
- { fix x assume x: "A *v x = 0"
- let ?c = "\<lambda>i. ((x$i ):: real)"
- from H[rule_format, of ?c, unfolded matrix_mult_sum[symmetric], OF x]
- have "x = 0" by vector }
- }
- ultimately show ?thesis unfolding matrix_left_invertible_ker by blast
-qed
-
-lemma matrix_right_invertible_independent_rows:
- fixes A :: "real^'n^'m"
- shows "(\<exists>(B::real^'m^'n). A ** B = mat 1) \<longleftrightarrow>
- (\<forall>c. sum (\<lambda>i. c i *s row i A) (UNIV :: 'm set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
- unfolding left_invertible_transpose[symmetric]
- matrix_left_invertible_independent_columns
- by (simp add: column_transpose)
-
lemma matrix_right_invertible_span_columns:
- "(\<exists>(B::real ^'n^'m). (A::real ^'m^'n) ** B = mat 1) \<longleftrightarrow>
- span (columns A) = UNIV" (is "?lhs = ?rhs")
+ "(\<exists>(B::'a::field ^'n^'m). (A::'a ^'m^'n) ** B = mat 1) \<longleftrightarrow>
+ vec.span (columns A) = UNIV" (is "?lhs = ?rhs")
proof -
let ?U = "UNIV :: 'm set"
have fU: "finite ?U" by simp
- have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::real^'m). sum (\<lambda>i. (x$i) *s column i A) ?U = y)"
+ have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::'a^'m). sum (\<lambda>i. (x$i) *s column i A) ?U = y)"
unfolding matrix_right_invertible_surjective matrix_mult_sum surj_def
apply (subst eq_commute)
apply rule
done
- have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> span (columns A))" by blast
+ have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> vec.span (columns A))" by blast
{ assume h: ?lhs
- { fix x:: "real ^'n"
- from h[unfolded lhseq, rule_format, of x] obtain y :: "real ^'m"
+ { fix x:: "'a ^'n"
+ from h[unfolded lhseq, rule_format, of x] obtain y :: "'a ^'m"
where y: "sum (\<lambda>i. (y$i) *s column i A) ?U = x" by blast
- have "x \<in> span (columns A)"
+ have "x \<in> vec.span (columns A)"
unfolding y[symmetric]
- apply (rule span_sum)
- unfolding scalar_mult_eq_scaleR
- apply (rule span_mul)
- apply (rule span_superset)
+ apply (rule vec.span_sum)
+ apply (rule vec.span_scale)
+ apply (rule vec.span_base)
unfolding columns_def
apply blast
done
@@ -1016,22 +422,24 @@
then have ?rhs unfolding rhseq by blast }
moreover
{ assume h:?rhs
- let ?P = "\<lambda>(y::real ^'n). \<exists>(x::real^'m). sum (\<lambda>i. (x$i) *s column i A) ?U = y"
+ let ?P = "\<lambda>(y::'a ^'n). \<exists>(x::'a^'m). sum (\<lambda>i. (x$i) *s column i A) ?U = y"
{ fix y
- have "?P y"
- proof (rule span_induct_alt[of ?P "columns A", folded scalar_mult_eq_scaleR])
- show "\<exists>x::real ^ 'm. sum (\<lambda>i. (x$i) *s column i A) ?U = 0"
+ have "y \<in> vec.span (columns A)"
+ unfolding h by blast
+ then have "?P y"
+ proof (induction rule: vec.span_induct_alt)
+ show "\<exists>x::'a ^ 'm. sum (\<lambda>i. (x$i) *s column i A) ?U = 0"
by (rule exI[where x=0], simp)
next
fix c y1 y2
assume y1: "y1 \<in> columns A" and y2: "?P y2"
from y1 obtain i where i: "i \<in> ?U" "y1 = column i A"
unfolding columns_def by blast
- from y2 obtain x:: "real ^'m" where
+ from y2 obtain x:: "'a ^'m" where
x: "sum (\<lambda>i. (x$i) *s column i A) ?U = y2" by blast
- let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::real^'m"
+ let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::'a^'m"
show "?P (c*s y1 + y2)"
- proof (rule exI[where x= "?x"], vector, auto simp add: i x[symmetric] if_distrib distrib_left cond_application_beta cong del: if_weak_cong)
+ proof (rule exI[where x= "?x"], vector, auto simp add: i x[symmetric] if_distrib distrib_left if_distribR cong del: if_weak_cong)
fix j
have th: "\<forall>xa \<in> ?U. (if xa = i then (c + (x$i)) * ((column xa A)$j)
else (x$xa) * ((column xa A$j))) = (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))"
@@ -1049,9 +457,6 @@
finally show "sum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
else (x$xa) * ((column xa A$j))) ?U = c * ((column i A)$j) + sum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" .
qed
- next
- show "y \<in> span (columns A)"
- unfolding h by blast
qed
}
then have ?lhs unfolding lhseq ..
@@ -1059,41 +464,20 @@
ultimately show ?thesis by blast
qed
-lemma matrix_left_invertible_span_rows:
- "(\<exists>(B::real^'m^'n). B ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> span (rows A) = UNIV"
+lemma matrix_left_invertible_span_rows_gen:
+ "(\<exists>(B::'a^'m^'n). B ** (A::'a::field^'n^'m) = mat 1) \<longleftrightarrow> vec.span (rows A) = UNIV"
unfolding right_invertible_transpose[symmetric]
unfolding columns_transpose[symmetric]
unfolding matrix_right_invertible_span_columns
..
+lemma matrix_left_invertible_span_rows:
+ "(\<exists>(B::real^'m^'n). B ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> span (rows A) = UNIV"
+ using matrix_left_invertible_span_rows_gen[of A] by (simp add: span_vec_eq)
+
+
text \<open>The same result in terms of square matrices.\<close>
-lemma matrix_left_right_inverse:
- fixes A A' :: "real ^'n^'n"
- shows "A ** A' = mat 1 \<longleftrightarrow> A' ** A = mat 1"
-proof -
- { fix A A' :: "real ^'n^'n"
- assume AA': "A ** A' = mat 1"
- have sA: "surj (( *v) A)"
- unfolding surj_def
- apply clarify
- apply (rule_tac x="(A' *v y)" in exI)
- apply (simp add: matrix_vector_mul_assoc AA' matrix_vector_mul_lid)
- done
- from linear_surjective_isomorphism[OF matrix_vector_mul_linear sA]
- obtain f' :: "real ^'n \<Rightarrow> real ^'n"
- where f': "linear f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast
- have th: "matrix f' ** A = mat 1"
- by (simp add: matrix_eq matrix_works[OF f'(1)]
- matrix_vector_mul_assoc[symmetric] matrix_vector_mul_lid f'(2)[rule_format])
- hence "(matrix f' ** A) ** A' = mat 1 ** A'" by simp
- hence "matrix f' = A'"
- by (simp add: matrix_mul_assoc[symmetric] AA' matrix_mul_rid matrix_mul_lid)
- hence "matrix f' ** A = A' ** A" by simp
- hence "A' ** A = mat 1" by (simp add: th)
- }
- then show ?thesis by blast
-qed
text \<open>Considering an n-element vector as an n-by-1 or 1-by-n matrix.\<close>
@@ -1338,8 +722,8 @@
using connected_ivt_hyperplane[of s x y "axis k 1" a]
by (auto simp add: inner_axis inner_commute)
-lemma subspace_substandard_cart: "subspace {x::real^_. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
- unfolding subspace_def by auto
+lemma subspace_substandard_cart: "vec.subspace {x. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
+ unfolding vec.subspace_def by auto
lemma closed_substandard_cart:
"closed {x::'a::real_normed_vector ^ 'n. \<forall>i. P i \<longrightarrow> x$i = 0}"
@@ -1351,32 +735,49 @@
unfolding Collect_all_eq by (simp add: closed_INT)
qed
-lemma dim_substandard_cart: "dim {x::real^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d"
- (is "dim ?A = _")
-proof -
- let ?a = "\<lambda>x. axis x 1 :: real^'n"
- have *: "{x. \<forall>i\<in>Basis. i \<notin> ?a ` d \<longrightarrow> x \<bullet> i = 0} = ?A"
- by (auto simp: image_iff Basis_vec_def axis_eq_axis inner_axis)
- have "?a ` d \<subseteq> Basis"
- by (auto simp: Basis_vec_def)
- thus ?thesis
- using dim_substandard[of "?a ` d"] card_image[of ?a d]
- by (auto simp: axis_eq_axis inj_on_def *)
-qed
+lemma dim_substandard_cart: "vec.dim {x::'a::field^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d"
+ (is "vec.dim ?A = _")
+proof (rule vec.dim_unique)
+ let ?B = "((\<lambda>x. axis x 1) ` d)"
+ have subset_basis: "?B \<subseteq> cart_basis"
+ by (auto simp: cart_basis_def)
+ show "?B \<subseteq> ?A"
+ by (auto simp: axis_def)
+ show "vec.independent ((\<lambda>x. axis x 1) ` d)"
+ using subset_basis
+ by (rule vec.independent_mono[OF vec.independent_Basis])
+ have "x \<in> vec.span ?B" if "\<forall>i. i \<notin> d \<longrightarrow> x $ i = 0" for x::"'a^'n"
+ proof -
+ have "finite ?B"
+ using subset_basis finite_cart_basis
+ by (rule finite_subset)
+ have "x = (\<Sum>i\<in>UNIV. x $ i *s axis i 1)"
+ by (rule basis_expansion[symmetric])
+ also have "\<dots> = (\<Sum>i\<in>d. (x $ i) *s axis i 1)"
+ by (rule sum.mono_neutral_cong_right) (auto simp: that)
+ also have "\<dots> \<in> vec.span ?B"
+ by (simp add: vec.span_sum vec.span_clauses)
+ finally show "x \<in> vec.span ?B" .
+ qed
+ then show "?A \<subseteq> vec.span ?B" by auto
+qed (simp add: card_image inj_on_def axis_eq_axis)
+
+lemma dim_subset_UNIV_cart_gen:
+ fixes S :: "('a::field^'n) set"
+ shows "vec.dim S \<le> CARD('n)"
+ by (metis vec.dim_eq_full vec.dim_subset_UNIV vec.span_UNIV vec_dim_card)
lemma dim_subset_UNIV_cart:
fixes S :: "(real^'n) set"
shows "dim S \<le> CARD('n)"
- by (metis dim_subset_UNIV DIM_cart DIM_real mult.right_neutral)
+ using dim_subset_UNIV_cart_gen[of S] by (simp add: dim_vec_eq)
lemma affinity_inverses:
assumes m0: "m \<noteq> (0::'a::field)"
shows "(\<lambda>x. m *s x + c) \<circ> (\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) = id"
"(\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) \<circ> (\<lambda>x. m *s x + c) = id"
using m0
- apply (auto simp add: fun_eq_iff vector_add_ldistrib diff_conv_add_uminus simp del: add_uminus_conv_diff)
- apply (simp_all add: vector_smult_lneg[symmetric] vector_smult_assoc vector_sneg_minus1 [symmetric])
- done
+ by (auto simp add: fun_eq_iff vector_add_ldistrib diff_conv_add_uminus simp del: add_uminus_conv_diff)
lemma vector_affinity_eq:
assumes m0: "(m::'a::field) \<noteq> 0"
@@ -1580,13 +981,18 @@
text\<open>Equivalence of row and column rank is taken from George Mackiw's paper, Mathematics Magazine 1995, p. 285.\<close>
+lemma matrix_vector_mult_in_columnspace_gen:
+ fixes A :: "'a::field^'n^'m"
+ shows "(A *v x) \<in> vec.span(columns A)"
+ apply (simp add: matrix_vector_column columns_def transpose_def column_def)
+ apply (intro vec.span_sum vec.span_scale)
+ apply (force intro: vec.span_base)
+ done
+
lemma matrix_vector_mult_in_columnspace:
fixes A :: "real^'n^'m"
shows "(A *v x) \<in> span(columns A)"
- apply (simp add: matrix_vector_column columns_def transpose_def column_def)
- apply (intro span_sum span_mul)
- apply (force intro: span_superset)
- done
+ using matrix_vector_mult_in_columnspace_gen[of A x] by (simp add: span_vec_eq)
lemma orthogonal_nullspace_rowspace:
fixes A :: "real^'n^'m"
@@ -1608,16 +1014,20 @@
lemma nullspace_inter_rowspace:
fixes A :: "real^'n^'m"
shows "A *v x = 0 \<and> x \<in> span(rows A) \<longleftrightarrow> x = 0"
- using orthogonal_nullspace_rowspace orthogonal_self by auto
+ using orthogonal_nullspace_rowspace orthogonal_self span_zero matrix_vector_mult_0_right
+ by blast
lemma matrix_vector_mul_injective_on_rowspace:
fixes A :: "real^'n^'m"
shows "\<lbrakk>A *v x = A *v y; x \<in> span(rows A); y \<in> span(rows A)\<rbrakk> \<Longrightarrow> x = y"
using nullspace_inter_rowspace [of A "x-y"]
- by (metis eq_iff_diff_eq_0 matrix_vector_mult_diff_distrib span_diff)
+ by (metis diff_eq_diff_eq diff_self matrix_vector_mult_diff_distrib span_diff)
-definition rank :: "real^'n^'m=>nat"
- where "rank A \<equiv> dim(columns A)"
+definition rank :: "'a::field^'n^'m=>nat"
+ where row_rank_def_gen: "rank A \<equiv> vec.dim(rows A)"
+
+lemma row_rank_def: "rank A = dim (rows A)" for A::"real^'n^'m"
+ by (auto simp: row_rank_def_gen dim_vec_eq)
lemma dim_rows_le_dim_columns:
fixes A :: "real^'n^'m"
@@ -1628,31 +1038,35 @@
obtain B where "independent B" "span(rows A) \<subseteq> span B"
and B: "B \<subseteq> span(rows A)""card B = dim (span(rows A))"
using basis_exists [of "span(rows A)"] by blast
- with span_subspace have eq: "span B = span(rows A)"
- by auto
+ then have eq: "span B = span(rows A)"
+ using span_subspace subspace_span by blast
then have inj: "inj_on (( *v) A) (span B)"
- using inj_on_def matrix_vector_mul_injective_on_rowspace by blast
+ by (simp add: inj_on_def matrix_vector_mul_injective_on_rowspace)
then have ind: "independent (( *v) A ` B)"
- by (rule independent_inj_on_image [OF \<open>independent B\<close> matrix_vector_mul_linear])
- then have "finite (( *v) A ` B) \<and> card (( *v) A ` B) \<le> dim (( *v) A ` B)"
- by (rule independent_bound_general)
- then show ?thesis
- by (metis (no_types, lifting) B ind inj eq card_image image_subset_iff independent_card_le_dim inj_on_subset matrix_vector_mult_in_columnspace)
+ by (rule linear_independent_injective_image [OF Finite_Cartesian_Product.matrix_vector_mul_linear \<open>independent B\<close>])
+ have "dim (span (rows A)) \<le> card (( *v) A ` B)"
+ unfolding B(2)[symmetric]
+ using inj
+ by (auto simp: card_image inj_on_subset span_superset)
+ also have "\<dots> \<le> dim (span (columns A))"
+ using _ ind
+ by (rule independent_card_le_dim) (auto intro!: matrix_vector_mult_in_columnspace)
+ finally show ?thesis .
qed
then show ?thesis
- by simp
+ by (simp add: dim_span)
qed
-lemma rank_row:
+lemma column_rank_def:
fixes A :: "real^'n^'m"
- shows "rank A = dim(rows A)"
- unfolding rank_def
- by (metis dim_rows_le_dim_columns columns_transpose dual_order.antisym rows_transpose)
+ shows "rank A = dim(columns A)"
+ unfolding row_rank_def
+ by (metis columns_transpose dim_rows_le_dim_columns le_antisym rows_transpose)
lemma rank_transpose:
fixes A :: "real^'n^'m"
shows "rank(transpose A) = rank A"
- by (metis rank_def rank_row rows_transpose)
+ by (metis column_rank_def row_rank_def rows_transpose)
lemma matrix_vector_mult_basis:
fixes A :: "real^'n^'m"
@@ -1667,22 +1081,26 @@
lemma rank_dim_range:
fixes A :: "real^'n^'m"
shows "rank A = dim(range (\<lambda>x. A *v x))"
- unfolding rank_def
+ unfolding column_rank_def
proof (rule span_eq_dim)
- show "span (columns A) = span (range (( *v) A))"
- apply (auto simp: columns_image_basis span_linear_image matrix_vector_mul_linear)
- by (metis columns_image_basis matrix_vector_mul_linear matrix_vector_mult_in_columnspace span_linear_image)
+ have "span (columns A) \<subseteq> span (range (( *v) A))" (is "?l \<subseteq> ?r")
+ by (simp add: columns_image_basis image_subsetI span_mono)
+ then show "?l = ?r"
+ by (metis (no_types, lifting) image_subset_iff matrix_vector_mult_in_columnspace
+ span_eq span_span)
qed
lemma rank_bound:
fixes A :: "real^'n^'m"
shows "rank A \<le> min CARD('m) (CARD('n))"
- by (metis (mono_tags, hide_lams) min.bounded_iff DIM_cart DIM_real dim_subset_UNIV mult.right_neutral rank_def rank_transpose)
+ by (metis (mono_tags, lifting) dim_subset_UNIV_cart min.bounded_iff
+ column_rank_def row_rank_def)
lemma full_rank_injective:
fixes A :: "real^'n^'m"
shows "rank A = CARD('n) \<longleftrightarrow> inj (( *v) A)"
- by (simp add: matrix_left_invertible_injective [symmetric] matrix_left_invertible_span_rows rank_row dim_eq_full [symmetric])
+ by (simp add: matrix_left_invertible_injective [symmetric] matrix_left_invertible_span_rows row_rank_def
+ dim_eq_full [symmetric] card_cart_basis vec.dimension_def)
lemma full_rank_surjective:
fixes A :: "real^'n^'m"
@@ -1703,10 +1121,10 @@
shows "(\<exists>x. (x \<noteq> 0) \<and> A *v x = 0) \<longleftrightarrow> ~(rank A = CARD('n))"
by (meson matrix_left_invertible_injective full_rank_injective matrix_left_invertible_ker)
-lemma rank_eq_0: "rank A = 0 \<longleftrightarrow> A = 0" and rank_0 [simp]: "rank 0 = 0"
+lemma rank_eq_0: "rank A = 0 \<longleftrightarrow> A = 0" and rank_0 [simp]: "rank (0::real^'n^'m) = 0"
+ for A :: "real^'n^'m"
by (auto simp: rank_dim_range matrix_eq)
-
lemma rank_mul_le_right:
fixes A :: "real^'n^'m" and B :: "real^'p^'n"
shows "rank(A ** B) \<le> rank B"
@@ -1714,7 +1132,7 @@
have "rank(A ** B) \<le> dim (( *v) A ` range (( *v) B))"
by (auto simp: rank_dim_range image_comp o_def matrix_vector_mul_assoc)
also have "\<dots> \<le> rank B"
- by (simp add: rank_dim_range matrix_vector_mul_linear dim_image_le)
+ by (simp add: rank_dim_range dim_image_le)
finally show ?thesis .
qed
@@ -1845,4 +1263,4 @@
bounded_linear.uniform_limit[OF bounded_linear_vec_nth]
bounded_linear.uniform_limit[OF bounded_linear_component_cart]
-end
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Analysis/Cartesian_Space.thy Wed May 02 13:49:38 2018 +0200
@@ -0,0 +1,312 @@
+(* Title: Cartesian_Space.thy
+ Author: Amine Chaieb, University of Cambridge
+ Author: Jose Divasón <jose.divasonm at unirioja.es>
+ Author: Jesús Aransay <jesus-maria.aransay at unirioja.es>
+ Author: Johannes Hölzl, VU Amsterdam
+ Author: Fabian Immler, TUM
+*)
+theory Cartesian_Space
+ imports
+ Finite_Cartesian_Product Linear_Algebra
+begin
+
+definition "cart_basis = {axis i 1 | i. i\<in>UNIV}"
+
+lemma finite_cart_basis: "finite (cart_basis)" unfolding cart_basis_def
+ using finite_Atleast_Atmost_nat by fastforce
+
+lemma card_cart_basis: "card (cart_basis::('a::zero_neq_one^'i) set) = CARD('i)"
+ unfolding cart_basis_def Setcompr_eq_image
+ by (rule card_image) (auto simp: inj_on_def axis_eq_axis)
+
+interpretation vec: vector_space "( *s) "
+ by unfold_locales (vector algebra_simps)+
+
+lemma independent_cart_basis:
+ "vec.independent (cart_basis)"
+proof (rule vec.independent_if_scalars_zero)
+ show "finite (cart_basis)" using finite_cart_basis .
+ fix f::"('a, 'b) vec \<Rightarrow> 'a" and x::"('a, 'b) vec"
+ assume eq_0: "(\<Sum>x\<in>cart_basis. f x *s x) = 0" and x_in: "x \<in> cart_basis"
+ obtain i where x: "x = axis i 1" using x_in unfolding cart_basis_def by auto
+ have sum_eq_0: "(\<Sum>x\<in>(cart_basis) - {x}. f x * (x $ i)) = 0"
+ proof (rule sum.neutral, rule ballI)
+ fix xa assume xa: "xa \<in> cart_basis - {x}"
+ obtain a where a: "xa = axis a 1" and a_not_i: "a \<noteq> i"
+ using xa x unfolding cart_basis_def by auto
+ have "xa $ i = 0" unfolding a axis_def using a_not_i by auto
+ thus "f xa * xa $ i = 0" by simp
+ qed
+ have "0 = (\<Sum>x\<in>cart_basis. f x *s x) $ i" using eq_0 by simp
+ also have "... = (\<Sum>x\<in>cart_basis. (f x *s x) $ i)" unfolding sum_component ..
+ also have "... = (\<Sum>x\<in>cart_basis. f x * (x $ i))" unfolding vector_smult_component ..
+ also have "... = f x * (x $ i) + (\<Sum>x\<in>(cart_basis) - {x}. f x * (x $ i))"
+ by (rule sum.remove[OF finite_cart_basis x_in])
+ also have "... = f x * (x $ i)" unfolding sum_eq_0 by simp
+ also have "... = f x" unfolding x axis_def by auto
+ finally show "f x = 0" ..
+qed
+
+lemma span_cart_basis:
+ "vec.span (cart_basis) = UNIV"
+proof (auto)
+ fix x::"('a, 'b) vec"
+ let ?f="\<lambda>v. x $ (THE i. v = axis i 1)"
+ show "x \<in> vec.span (cart_basis)"
+ apply (unfold vec.span_finite[OF finite_cart_basis])
+ apply (rule image_eqI[of _ _ ?f])
+ apply (subst vec_eq_iff)
+ apply clarify
+ proof -
+ fix i::'b
+ let ?w = "axis i (1::'a)"
+ have the_eq_i: "(THE a. ?w = axis a 1) = i"
+ by (rule the_equality, auto simp: axis_eq_axis)
+ have sum_eq_0: "(\<Sum>v\<in>(cart_basis) - {?w}. x $ (THE i. v = axis i 1) * v $ i) = 0"
+ proof (rule sum.neutral, rule ballI)
+ fix xa::"('a, 'b) vec"
+ assume xa: "xa \<in> cart_basis - {?w}"
+ obtain j where j: "xa = axis j 1" and i_not_j: "i \<noteq> j" using xa unfolding cart_basis_def by auto
+ have the_eq_j: "(THE i. xa = axis i 1) = j"
+ proof (rule the_equality)
+ show "xa = axis j 1" using j .
+ show "\<And>i. xa = axis i 1 \<Longrightarrow> i = j" by (metis axis_eq_axis j zero_neq_one)
+ qed
+ show "x $ (THE i. xa = axis i 1) * xa $ i = 0"
+ apply (subst (2) j)
+ unfolding the_eq_j unfolding axis_def using i_not_j by simp
+ qed
+ have "(\<Sum>v\<in>cart_basis. x $ (THE i. v = axis i 1) *s v) $ i =
+ (\<Sum>v\<in>cart_basis. (x $ (THE i. v = axis i 1) *s v) $ i)" unfolding sum_component ..
+ also have "... = (\<Sum>v\<in>cart_basis. x $ (THE i. v = axis i 1) * v $ i)"
+ unfolding vector_smult_component ..
+ also have "... = x $ (THE a. ?w = axis a 1) * ?w $ i + (\<Sum>v\<in>(cart_basis) - {?w}. x $ (THE i. v = axis i 1) * v $ i)"
+ by (rule sum.remove[OF finite_cart_basis], auto simp add: cart_basis_def)
+ also have "... = x $ (THE a. ?w = axis a 1) * ?w $ i" unfolding sum_eq_0 by simp
+ also have "... = x $ i" unfolding the_eq_i unfolding axis_def by auto
+ finally show "x $ i = (\<Sum>v\<in>cart_basis. x $ (THE i. v = axis i 1) *s v) $ i" by simp
+ qed simp
+qed
+
+(*Some interpretations:*)
+interpretation vec: finite_dimensional_vector_space "( *s)" "cart_basis"
+ by (unfold_locales, auto simp add: finite_cart_basis independent_cart_basis span_cart_basis)
+
+lemma matrix_vector_mul_linear_gen[intro, simp]:
+ "Vector_Spaces.linear ( *s) ( *s) (( *v) A)"
+ by unfold_locales
+ (vector matrix_vector_mult_def sum.distrib algebra_simps)+
+
+lemma linear_componentwise:
+ fixes f:: "'a::field ^'m \<Rightarrow> 'a ^ 'n"
+ assumes lf: "Vector_Spaces.linear ( *s) ( *s) f"
+ shows "(f x)$j = sum (\<lambda>i. (x$i) * (f (axis i 1)$j)) (UNIV :: 'm set)" (is "?lhs = ?rhs")
+proof -
+ interpret lf: Vector_Spaces.linear "( *s)" "( *s)" f
+ using lf .
+ let ?M = "(UNIV :: 'm set)"
+ let ?N = "(UNIV :: 'n set)"
+ have fM: "finite ?M" by simp
+ have "?rhs = (sum (\<lambda>i. (x$i) *s (f (axis i 1))) ?M)$j"
+ unfolding sum_component by simp
+ then show ?thesis
+ unfolding lf.sum[symmetric] lf.scale[symmetric]
+ unfolding basis_expansion by auto
+qed
+
+interpretation vec: Vector_Spaces.linear "( *s)" "( *s)" "( *v) A"
+ using matrix_vector_mul_linear_gen.
+
+interpretation vec: finite_dimensional_vector_space_pair "( *s)" cart_basis "( *s)" cart_basis ..
+
+lemma matrix_works:
+ assumes lf: "Vector_Spaces.linear ( *s) ( *s) f"
+ shows "matrix f *v x = f (x::'a::field ^ 'n)"
+ apply (simp add: matrix_def matrix_vector_mult_def vec_eq_iff mult.commute)
+ apply clarify
+ apply (rule linear_componentwise[OF lf, symmetric])
+ done
+
+lemma matrix_of_matrix_vector_mul[simp]: "matrix(\<lambda>x. A *v (x :: 'a::field ^ 'n)) = A"
+ by (simp add: matrix_eq matrix_works)
+
+lemma matrix_compose_gen:
+ assumes lf: "Vector_Spaces.linear ( *s) ( *s) (f::'a::{field}^'n \<Rightarrow> 'a^'m)"
+ and lg: "Vector_Spaces.linear ( *s) ( *s) (g::'a^'m \<Rightarrow> 'a^_)"
+ shows "matrix (g o f) = matrix g ** matrix f"
+ using lf lg Vector_Spaces.linear_compose[OF lf lg] matrix_works[OF Vector_Spaces.linear_compose[OF lf lg]]
+ by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def)
+
+lemma matrix_compose:
+ assumes "linear (f::real^'n \<Rightarrow> real^'m)" "linear (g::real^'m \<Rightarrow> real^_)"
+ shows "matrix (g o f) = matrix g ** matrix f"
+ using matrix_compose_gen[of f g] assms
+ by (simp add: linear_def scalar_mult_eq_scaleR)
+
+lemma matrix_left_invertible_injective:
+ "(\<exists>B. (B::'a::field^'m^'n) ** (A::'a::field^'n^'m) = mat 1)
+ \<longleftrightarrow> (\<forall>x y. A *v x = A *v y \<longrightarrow> x = y)"
+proof -
+ { fix B:: "'a^'m^'n" and x y assume B: "B ** A = mat 1" and xy: "A *v x = A*v y"
+ from xy have "B*v (A *v x) = B *v (A*v y)" by simp
+ hence "x = y"
+ unfolding matrix_vector_mul_assoc B matrix_vector_mul_lid . }
+ moreover
+ { assume A: "\<forall>x y. A *v x = A *v y \<longrightarrow> x = y"
+ hence i: "inj (( *v) A)" unfolding inj_on_def by auto
+ from vec.linear_exists_left_inverse_on[OF matrix_vector_mul_linear_gen vec.subspace_UNIV i]
+ obtain g where g: "Vector_Spaces.linear ( *s) ( *s) g" "g o (( *v) A) = id" by (auto simp: id_def module_hom_iff_linear o_def)
+ have "matrix g ** A = mat 1"
+ unfolding matrix_eq matrix_vector_mul_lid matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
+ using g(2) by (metis comp_apply id_apply)
+ then have "\<exists>B. (B::'a::{field}^'m^'n) ** A = mat 1" by blast }
+ ultimately show ?thesis by blast
+qed
+
+lemma matrix_left_invertible_ker:
+ "(\<exists>B. (B::'a::{field} ^'m^'n) ** (A::'a::{field}^'n^'m) = mat 1) \<longleftrightarrow> (\<forall>x. A *v x = 0 \<longrightarrow> x = 0)"
+ unfolding matrix_left_invertible_injective
+ using vec.inj_on_iff_eq_0[OF vec.subspace_UNIV, of A]
+ by (simp add: inj_on_def)
+
+lemma matrix_left_invertible_independent_columns:
+ fixes A :: "'a::{field}^'n^'m"
+ shows "(\<exists>(B::'a ^'m^'n). B ** A = mat 1) \<longleftrightarrow>
+ (\<forall>c. sum (\<lambda>i. c i *s column i A) (UNIV :: 'n set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
+ (is "?lhs \<longleftrightarrow> ?rhs")
+proof -
+ let ?U = "UNIV :: 'n set"
+ { assume k: "\<forall>x. A *v x = 0 \<longrightarrow> x = 0"
+ { fix c i
+ assume c: "sum (\<lambda>i. c i *s column i A) ?U = 0" and i: "i \<in> ?U"
+ let ?x = "\<chi> i. c i"
+ have th0:"A *v ?x = 0"
+ using c
+ by (vector matrix_mult_sum)
+ from k[rule_format, OF th0] i
+ have "c i = 0" by (vector vec_eq_iff)}
+ hence ?rhs by blast }
+ moreover
+ { assume H: ?rhs
+ { fix x assume x: "A *v x = 0"
+ let ?c = "\<lambda>i. ((x$i ):: 'a)"
+ from H[rule_format, of ?c, unfolded matrix_mult_sum[symmetric], OF x]
+ have "x = 0" by vector }
+ }
+ ultimately show ?thesis unfolding matrix_left_invertible_ker by auto
+qed
+
+lemma left_invertible_transpose:
+ "(\<exists>(B). B ** transpose (A) = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B). A ** B = mat 1)"
+ by (metis matrix_transpose_mul transpose_mat transpose_transpose)
+
+lemma right_invertible_transpose:
+ "(\<exists>(B). transpose (A) ** B = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B). B ** A = mat 1)"
+ by (metis matrix_transpose_mul transpose_mat transpose_transpose)
+
+lemma matrix_right_invertible_independent_rows:
+ fixes A :: "'a::{field}^'n^'m"
+ shows "(\<exists>(B::'a^'m^'n). A ** B = mat 1) \<longleftrightarrow>
+ (\<forall>c. sum (\<lambda>i. c i *s row i A) (UNIV :: 'm set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
+ unfolding left_invertible_transpose[symmetric]
+ matrix_left_invertible_independent_columns
+ by (simp add:)
+
+lemma matrix_left_right_inverse:
+ fixes A A' :: "'a::{field}^'n^'n"
+ shows "A ** A' = mat 1 \<longleftrightarrow> A' ** A = mat 1"
+proof -
+ { fix A A' :: "'a ^'n^'n"
+ assume AA': "A ** A' = mat 1"
+ have sA: "surj (( *v) A)"
+ unfolding surj_def
+ apply clarify
+ apply (rule_tac x="(A' *v y)" in exI)
+ apply (simp add: matrix_vector_mul_assoc AA')
+ done
+ from vec.linear_surjective_isomorphism[OF matrix_vector_mul_linear_gen sA]
+ obtain f' :: "'a ^'n \<Rightarrow> 'a ^'n"
+ where f': "Vector_Spaces.linear ( *s) ( *s) f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast
+ have th: "matrix f' ** A = mat 1"
+ by (simp add: matrix_eq matrix_works[OF f'(1)]
+ matrix_vector_mul_assoc[symmetric] f'(2)[rule_format])
+ hence "(matrix f' ** A) ** A' = mat 1 ** A'" by simp
+ hence "matrix f' = A'"
+ by (simp add: matrix_mul_assoc[symmetric] AA')
+ hence "matrix f' ** A = A' ** A" by simp
+ hence "A' ** A = mat 1" by (simp add: th)
+ }
+ then show ?thesis by blast
+qed
+
+lemma invertible_left_inverse:
+ fixes A :: "'a::{field}^'n^'n"
+ shows "invertible A \<longleftrightarrow> (\<exists>(B::'a^'n^'n). B ** A = mat 1)"
+ by (metis invertible_def matrix_left_right_inverse)
+
+ lemma invertible_right_inverse:
+ fixes A :: "'a::{field}^'n^'n"
+ shows "invertible A \<longleftrightarrow> (\<exists>(B::'a^'n^'n). A** B = mat 1)"
+ by (metis invertible_def matrix_left_right_inverse)
+
+(*Finally, some interesting theorems and interpretations that don't appear in any file of the
+ library.*)
+
+locale linear_first_finite_dimensional_vector_space =
+ l?: Vector_Spaces.linear scaleB scaleC f +
+ B?: finite_dimensional_vector_space scaleB BasisB
+ for scaleB :: "('a::field => 'b::ab_group_add => 'b)" (infixr "*b" 75)
+ and scaleC :: "('a => 'c::ab_group_add => 'c)" (infixr "*c" 75)
+ and BasisB :: "('b set)"
+ and f :: "('b=>'c)"
+
+lemma vec_dim_card: "vec.dim (UNIV::('a::{field}^'n) set) = CARD ('n)"
+proof -
+ let ?f="\<lambda>i::'n. axis i (1::'a)"
+ have "vec.dim (UNIV::('a::{field}^'n) set) = card (cart_basis::('a^'n) set)"
+ unfolding vec.dim_UNIV ..
+ also have "... = card ({i. i\<in> UNIV}::('n) set)"
+ proof (rule bij_betw_same_card[of ?f, symmetric], unfold bij_betw_def, auto)
+ show "inj (\<lambda>i::'n. axis i (1::'a))" by (simp add: inj_on_def axis_eq_axis)
+ fix i::'n
+ show "axis i 1 \<in> cart_basis" unfolding cart_basis_def by auto
+ fix x::"'a^'n"
+ assume "x \<in> cart_basis"
+ thus "x \<in> range (\<lambda>i. axis i 1)" unfolding cart_basis_def by auto
+ qed
+ also have "... = CARD('n)" by auto
+ finally show ?thesis .
+qed
+
+interpretation vector_space_over_itself: vector_space "( *) :: 'a::field => 'a => 'a"
+ by unfold_locales (simp_all add: algebra_simps)
+
+lemmas [simp del] = vector_space_over_itself.scale_scale
+
+interpretation vector_space_over_itself: finite_dimensional_vector_space
+ "( *) :: 'a::field => 'a => 'a" "{1}"
+ by unfold_locales (auto simp: vector_space_over_itself.span_singleton)
+
+lemma dimension_eq_1[code_unfold]: "vector_space_over_itself.dimension TYPE('a::field)= 1"
+ unfolding vector_space_over_itself.dimension_def by simp
+
+lemma linear_matrix_vector_mul_eq:
+ "Vector_Spaces.linear ( *s) ( *s) f \<longleftrightarrow> linear (f :: real^'n \<Rightarrow> real ^'m)"
+ by (simp add: scalar_mult_eq_scaleR linear_def)
+
+lemma matrix_vector_mul[simp]:
+ "Vector_Spaces.linear ( *s) ( *s) g \<Longrightarrow> (\<lambda>y. matrix g *v y) = g"
+ "linear f \<Longrightarrow> (\<lambda>x. matrix f *v x) = f"
+ "bounded_linear f \<Longrightarrow> (\<lambda>x. matrix f *v x) = f"
+ for f :: "real^'n \<Rightarrow> real ^'m"
+ by (simp_all add: ext matrix_works linear_matrix_vector_mul_eq linear_linear)
+
+lemma span_vec_eq: "vec.span X = span X"
+ and dim_vec_eq: "vec.dim X = dim X"
+ and dependent_vec_eq: "vec.dependent X = dependent X"
+ and subspace_vec_eq: "vec.subspace X = subspace X"
+ for X::"(real^'n) set"
+ unfolding span_raw_def dim_raw_def dependent_raw_def subspace_raw_def
+ by (auto simp: scalar_mult_eq_scaleR)
+
+end
\ No newline at end of file
--- a/src/HOL/Analysis/Change_Of_Vars.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Change_Of_Vars.thy Wed May 02 13:49:38 2018 +0200
@@ -179,6 +179,10 @@
by (rule induct_matrix_elementary) (auto intro: assms *)
qed
+lemma matrix_vector_mult_matrix_matrix_mult_compose:
+ "( *v) (A ** B) = ( *v) A \<circ> ( *v) B"
+ by (auto simp: matrix_vector_mul_assoc)
+
lemma induct_linear_elementary:
fixes f :: "real^'n \<Rightarrow> real^'n"
assumes "linear f"
@@ -194,12 +198,15 @@
fix A B
assume "P (( *v) A)" and "P (( *v) B)"
then show "P (( *v) (A ** B))"
- by (metis (no_types, lifting) comp linear_compose matrix_compose matrix_eq matrix_vector_mul matrix_vector_mul_linear)
+ by (auto simp add: matrix_vector_mult_matrix_matrix_mult_compose matrix_vector_mul_linear
+ intro!: comp)
next
fix A :: "real^'n^'n" and i
assume "row i A = 0"
- then show "P (( *v) A)"
- by (metis inner_zero_left matrix_vector_mul_component matrix_vector_mul_linear row_def vec_eq_iff vec_lambda_beta zeroes)
+ show "P (( *v) A)"
+ using matrix_vector_mul_linear
+ by (rule zeroes[where i=i])
+ (metis \<open>row i A = 0\<close> inner_zero_left matrix_vector_mul_component row_def vec_lambda_eta)
next
fix A :: "real^'n^'n"
assume 0: "\<And>i j. i \<noteq> j \<Longrightarrow> A $ i $ j = 0"
@@ -246,7 +253,7 @@
= measure lebesgue (cbox a b)" (is "?Q")
proof -
have lin: "linear ?f"
- by (force simp: plus_vec_def scaleR_vec_def algebra_simps intro: linearI)
+ by (rule linearI) (auto simp: plus_vec_def scaleR_vec_def algebra_simps)
show fab: "?f ` cbox a b \<in> lmeasurable"
by (simp add: lin measurable_linear_image_interval)
let ?c = "\<chi> i. if i = m then b$m + b$n else b$i"
@@ -474,7 +481,7 @@
then have "\<not> inj f"
by (metis (full_types) linear_injective_imp_surjective one_neq_zero surjE vec_component)
have detf: "det (matrix f) = 0"
- by (metis "0" \<open>linear f\<close> invertible_det_nz invertible_right_inverse matrix_right_invertible_surjective matrix_vector_mul surjE vec_component)
+ using \<open>\<not> inj f\<close> det_nz_iff_inj[OF \<open>linear f\<close>] by blast
show "f ` S \<in> lmeasurable \<and> ?Q f S"
proof
show "f ` S \<in> lmeasurable"
@@ -500,7 +507,7 @@
assume "m \<noteq> n" and "S \<in> lmeasurable"
let ?h = "\<lambda>v::(real, 'n) vec. \<chi> i. v $ Fun.swap m n id i"
have lin: "linear ?h"
- by (simp add: plus_vec_def scaleR_vec_def linearI)
+ by (rule linearI) (simp_all add: plus_vec_def scaleR_vec_def)
have meq: "measure lebesgue ((\<lambda>v::(real, 'n) vec. \<chi> i. v $ Fun.swap m n id i) ` cbox a b)
= measure lebesgue (cbox a b)" for a b
proof (cases "cbox a b = {}")
@@ -532,7 +539,7 @@
assume "m \<noteq> n" and "S \<in> lmeasurable"
let ?h = "\<lambda>v::(real, 'n) vec. \<chi> i. if i = m then v $ m + v $ n else v $ i"
have lin: "linear ?h"
- by (auto simp: algebra_simps plus_vec_def scaleR_vec_def vec_eq_iff intro: linearI)
+ by (rule linearI) (auto simp: algebra_simps plus_vec_def scaleR_vec_def vec_eq_iff)
consider "m < n" | " n < m"
using \<open>m \<noteq> n\<close> less_linear by blast
then have 1: "det(matrix ?h) = 1"
@@ -997,11 +1004,11 @@
then show ?thesis
proof (rule_tac x="(y - x) /\<^sub>R r" in bexI)
have "f' x ((y - x) /\<^sub>R r) = f' x (y - x) /\<^sub>R r"
- by (simp add: lin linear_cmul)
+ by (simp add: lin linear_scale)
then have "dist (f' x ((y - x) /\<^sub>R r)) ((f y - f x) /\<^sub>R r) = norm (f' x (y - x) /\<^sub>R r - (f y - f x) /\<^sub>R r)"
by (simp add: dist_norm)
also have "\<dots> = norm (f' x (y - x) - (f y - f x)) / r"
- using \<open>r > 0\<close> by (simp add: real_vector.scale_right_diff_distrib [symmetric] divide_simps)
+ using \<open>r > 0\<close> by (simp add: scale_right_diff_distrib [symmetric] divide_simps)
also have "\<dots> \<le> norm (f y - (f x + f' x (y - x))) / norm (y - x)"
using that \<open>r > 0\<close> False by (simp add: algebra_simps divide_simps dist_norm norm_minus_commute mult_right_mono)
also have "\<dots> < k"
@@ -1610,8 +1617,9 @@
and lb: "\<And>v. v \<noteq> 0 \<Longrightarrow> (\<exists>k>0. \<forall>e>0. \<exists>x. x \<in> S - {0} \<and> norm x < e \<and> k * norm x \<le> \<bar>v \<bullet> x\<bar>)"
shows "f x = 0"
proof -
+ interpret linear f by fact
have "dim {x. f x = 0} \<le> DIM('a)"
- using dim_subset_UNIV by blast
+ by (rule dim_subset_UNIV)
moreover have False if less: "dim {x. f x = 0} < DIM('a)"
proof -
obtain d where "d \<noteq> 0" and d: "\<And>y. f y = 0 \<Longrightarrow> d \<bullet> y = 0"
@@ -1662,7 +1670,7 @@
with lim0 \<alpha> have "((\<lambda>x. f x /\<^sub>R norm x) \<circ> (\<alpha> \<circ> \<rho>)) \<longlonglongrightarrow> 0"
by (force simp: tendsto_at_iff_sequentially)
then show "(f \<circ> (\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)) \<circ> \<rho>) \<longlonglongrightarrow> 0"
- by (simp add: o_def linear_cmul \<open>linear f\<close>)
+ by (simp add: o_def scale)
qed
qed
ultimately show False
@@ -1671,7 +1679,9 @@
ultimately have dim: "dim {x. f x = 0} = DIM('a)"
by force
then show ?thesis
- by (metis (mono_tags, lifting) UNIV_I assms(1) dim_eq_full linear_eq_0_span mem_Collect_eq)
+ using dim_eq_full
+ by (metis (mono_tags, lifting) eq_0_on_span eucl.span_Basis linear_axioms linear_eq_stdbasis
+ mem_Collect_eq module_hom_zero span_base span_raw_def)
qed
lemma lemma_partial_derivatives:
@@ -1950,11 +1960,12 @@
unfolding subspace_def convergent_eq_Cauchy [symmetric]
by (force simp: algebra_simps intro: tendsto_intros)
then have CA_eq: "?CA = span ?CA"
- by (metis span_eq)
+ by (metis span_eq_iff)
also have "\<dots> = UNIV"
proof -
have "dim ?CA \<le> CARD('m)"
- by (rule dim_subset_UNIV_cart)
+ using dim_subset_UNIV[of ?CA]
+ by auto
moreover have "False" if less: "dim ?CA < CARD('m)"
proof -
obtain d where "d \<noteq> 0" and d: "\<And>y. y \<in> span ?CA \<Longrightarrow> orthogonal d y"
@@ -2102,7 +2113,9 @@
have lin_df: "linear (f' x)"
and lim_df: "((\<lambda>y. (1 / norm (y - x)) *\<^sub>R (f y - (f x + f' x (y - x)))) \<longlongrightarrow> 0) (at x within S)"
using \<open>x \<in> S\<close> assms by (auto simp: has_derivative_within linear_linear)
- moreover have "(matrix (f' x) - B) *v w = 0" for w
+ moreover
+ interpret linear "f' x" by fact
+ have "(matrix (f' x) - B) *v w = 0" for w
proof (rule lemma_partial_derivatives [of "( *v) (matrix (f' x) - B)"])
show "linear (( *v) (matrix (f' x) - B))"
by (rule matrix_vector_mul_linear)
@@ -2124,7 +2137,8 @@
fix k :: "nat"
assume "0 \<le> k"
have "0 \<le> onorm (( *v) (A k - B))"
- by (simp add: linear_linear onorm_pos_le matrix_vector_mul_linear)
+ using matrix_vector_mul_bounded_linear
+ by (rule onorm_pos_le)
then show "norm (onorm (( *v) (A k - B))) \<le> (\<Sum>i\<in>UNIV. \<Sum>j\<in>UNIV. \<bar>(A k - B) $ i $ j\<bar>)"
by (simp add: onorm_le_matrix_component_sum del: vector_minus_component)
qed
@@ -2174,11 +2188,11 @@
then show "((\<lambda>y. (matrix (f' x) - B) *v (y - x) /\<^sub>R
norm (y - x) - (f x + f' x (y - x) - f y) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0)
(at x within S)"
- by (simp add: algebra_simps lin_df linear_diff matrix_vector_mul_linear)
+ by (simp add: algebra_simps diff lin_df matrix_vector_mul_linear scalar_mult_eq_scaleR)
qed
qed (use x in \<open>simp; auto simp: not_less\<close>)
ultimately have "f' x = ( *v) B"
- by (force simp: algebra_simps)
+ by (force simp: algebra_simps scalar_mult_eq_scaleR)
show "matrix (f' x) $ m $ n \<le> b"
proof (rule tendsto_upperbound [of "\<lambda>i. (A i $ m $ n)" _ sequentially])
show "(\<lambda>i. A i $ m $ n) \<longlonglongrightarrow> matrix (f' x) $ m $ n"
@@ -2228,11 +2242,11 @@
have "linear (f' x)"
using True f has_derivative_linear by blast
then have "norm (f' x (y - x) - B *v (y - x)) = norm ((matrix (f' x) - B) *v (y - x))"
- by (metis matrix_vector_mul matrix_vector_mult_diff_rdistrib)
+ by (simp add: matrix_vector_mult_diff_rdistrib)
also have "\<dots> \<le> (e * norm (y - x)) / 2"
proof (rule split246)
have "norm ((?A - B) *v (y - x)) / norm (y - x) \<le> onorm(\<lambda>x. (?A - B) *v x)"
- by (simp add: le_onorm linear_linear matrix_vector_mul_linear)
+ by (rule le_onorm) auto
also have "\<dots> < e/6"
by (rule Bo_e6)
finally have "norm ((?A - B) *v (y - x)) / norm (y - x) < e / 6" .
@@ -2445,7 +2459,8 @@
moreover have "\<exists>t\<in>T -` P. norm (inv T x - t) \<le> e"
proof
have "T (inv T x - inv T t) = x - t"
- using T linear_diff orthogonal_transformation_def by fastforce
+ using T linear_diff orthogonal_transformation_def
+ by (metis (no_types, hide_lams) Tinv)
then have "norm (inv T x - inv T t) = norm (x - t)"
by (metis T orthogonal_transformation_norm)
then show "norm (inv T x - inv T t) \<le> e"
@@ -2473,7 +2488,7 @@
and "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
proof -
obtain a where "a \<noteq> 0" "P \<subseteq> {x. a \<bullet> x = 0}"
- using lowdim_subset_hyperplane [of P] P span_inc by auto
+ using lowdim_subset_hyperplane [of P] P span_base by auto
then obtain S where S: "S \<in> lmeasurable"
and subS: "{z. norm z \<le> m \<and> (\<exists>t \<in> P. norm(z - t) \<le> e)} \<subseteq> S"
and mS: "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
@@ -2566,7 +2581,8 @@
obtain x where x: "x \<in> S \<inter> cbox u v" "cbox u v \<subseteq> ball x (r x)"
using \<open>K \<in> \<D>\<close> covered uv by blast
then have "dim (range (f' x)) < ?n"
- using rank_dim_range [of "matrix (f' x)"] lin_f' rank by fastforce
+ using rank_dim_range [of "matrix (f' x)"] x rank[of x]
+ by (auto simp: matrix_works scalar_mult_eq_scaleR lin_f')
then obtain T where T: "T \<in> lmeasurable"
and subT: "{z. norm(z - f x) \<le> (2 * B) * norm(v - u) \<and> (\<exists>t \<in> range (f' x). norm(z - f x - t) \<le> d * norm(v - u))} \<subseteq> T"
and measT: "?\<mu> T \<le> (2 * (d * norm(v - u))) * (2 * ((2 * B) * norm(v - u))) ^ (?n - 1)"
@@ -2586,8 +2602,8 @@
using r [of x y] x \<open>y \<in> S\<close> by blast
have yx_le: "norm (y - x) \<le> norm (v - u)"
proof (rule norm_le_componentwise_cart)
- show "\<bar>(y - x) $ i\<bar> \<le> \<bar>(v - u) $ i\<bar>" for i
- using x y by (force simp: mem_box_cart dest!: spec [where x=i])
+ show "norm ((y - x) $ i) \<le> norm ((v - u) $ i)" for i
+ using x y by (force simp: mem_box_cart dest!: spec [where x=i])
qed
have *: "\<lbrakk>norm(y - x - z) \<le> d; norm z \<le> B; d \<le> B\<rbrakk> \<Longrightarrow> norm(y - x) \<le> 2 * B"
for x y z :: "real^'n::_" and d B
@@ -3177,8 +3193,8 @@
if "x \<in> T" for x
proof -
have "matrix (h' x) ** matrix (g' (h x)) = mat 1"
- using that id matrix_compose
- by (metis der_g gh has_derivative_linear left_inverse_linear matrix_id_mat_1)
+ using that id[OF that] der_g[of "h x"] gh[OF that] left_inverse_linear has_derivative_linear
+ by (subst matrix_compose[symmetric]) (force simp: matrix_id_mat_1 has_derivative_linear)+
then have "\<bar>det (matrix (h' x))\<bar> * \<bar>det (matrix (g' (h x)))\<bar> = 1"
by (metis abs_1 abs_mult det_I det_mul)
then show ?thesis
--- a/src/HOL/Analysis/Connected.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Connected.thy Wed May 02 13:49:38 2018 +0200
@@ -4141,13 +4141,13 @@
lemma closed_span [iff]: "closed (span s)"
for s :: "'a::euclidean_space set"
- by (simp add: closed_subspace)
+ by (simp add: closed_subspace subspace_span)
lemma dim_closure [simp]: "dim (closure s) = dim s" (is "?dc = ?d")
for s :: "'a::euclidean_space set"
proof -
have "?dc \<le> ?d"
- using closure_minimal[OF span_inc, of s]
+ using closure_minimal[OF span_superset, of s]
using closed_subspace[OF subspace_span, of s]
using dim_subset[of "closure s" "span s"]
by simp
--- a/src/HOL/Analysis/Convex_Euclidean_Space.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy Wed May 02 13:49:38 2018 +0200
@@ -28,50 +28,6 @@
done
qed
-lemma dim_image_eq:
- fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
- assumes lf: "linear f"
- and fi: "inj_on f (span S)"
- shows "dim (f ` S) = dim (S::'n::euclidean_space set)"
-proof -
- obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
- using basis_exists[of S] by auto
- then have "span S = span B"
- using span_mono[of B S] span_mono[of S "span B"] span_span[of B] by auto
- then have "independent (f ` B)"
- using independent_inj_on_image[of B f] B assms by auto
- moreover have "card (f ` B) = card B"
- using assms card_image[of f B] subset_inj_on[of f "span S" B] B span_inc by auto
- moreover have "(f ` B) \<subseteq> (f ` S)"
- using B by auto
- ultimately have "dim (f ` S) \<ge> dim S"
- using independent_card_le_dim[of "f ` B" "f ` S"] B by auto
- then show ?thesis
- using dim_image_le[of f S] assms by auto
-qed
-
-lemma linear_injective_on_subspace_0:
- assumes lf: "linear f"
- and "subspace S"
- shows "inj_on f S \<longleftrightarrow> (\<forall>x \<in> S. f x = 0 \<longrightarrow> x = 0)"
-proof -
- have "inj_on f S \<longleftrightarrow> (\<forall>x \<in> S. \<forall>y \<in> S. f x = f y \<longrightarrow> x = y)"
- by (simp add: inj_on_def)
- also have "\<dots> \<longleftrightarrow> (\<forall>x \<in> S. \<forall>y \<in> S. f x - f y = 0 \<longrightarrow> x - y = 0)"
- by simp
- also have "\<dots> \<longleftrightarrow> (\<forall>x \<in> S. \<forall>y \<in> S. f (x - y) = 0 \<longrightarrow> x - y = 0)"
- by (simp add: linear_diff[OF lf])
- also have "\<dots> \<longleftrightarrow> (\<forall>x \<in> S. f x = 0 \<longrightarrow> x = 0)"
- using \<open>subspace S\<close> subspace_def[of S] subspace_diff[of S] by auto
- finally show ?thesis .
-qed
-
-lemma subspace_Inter: "\<forall>s \<in> f. subspace s \<Longrightarrow> subspace (\<Inter>f)"
- unfolding subspace_def by auto
-
-lemma span_eq[simp]: "span s = s \<longleftrightarrow> subspace s"
- unfolding span_def by (rule hull_eq) (rule subspace_Inter)
-
lemma substdbasis_expansion_unique:
assumes d: "d \<subseteq> Basis"
shows "(\<Sum>i\<in>d. f i *\<^sub>R i) = (x::'a::euclidean_space) \<longleftrightarrow>
@@ -105,20 +61,16 @@
moreover from * have "x = (norm x/e) *\<^sub>R y"
by auto
ultimately have "x \<in> span (cball 0 e)"
- using span_mul[of y "cball 0 e" "norm x/e"] span_inc[of "cball 0 e"]
- by (simp add: span_superset)
+ using span_scale[of y "cball 0 e" "norm x/e"]
+ span_superset[of "cball 0 e"]
+ by (simp add: span_base)
}
then have "span (cball 0 e) = (UNIV :: 'n::euclidean_space set)"
by auto
then show ?thesis
- using dim_span[of "cball (0 :: 'n::euclidean_space) e"] by (auto simp add: dim_UNIV)
-qed
-
-lemma indep_card_eq_dim_span:
- fixes B :: "'n::euclidean_space set"
- assumes "independent B"
- shows "finite B \<and> card B = dim (span B)"
- using assms basis_card_eq_dim[of B "span B"] span_inc by auto
+ using dim_span[of "cball (0 :: 'n::euclidean_space) e"]
+ by auto
+qed
lemma sum_not_0: "sum f A \<noteq> 0 \<Longrightarrow> \<exists>a \<in> A. f a \<noteq> 0"
by (rule ccontr) auto
@@ -1218,57 +1170,6 @@
shows "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> convex (f ` s) \<longleftrightarrow> convex s"
by (metis (no_types) convex_linear_image convex_linear_vimage inj_vimage_image_eq)
-lemma basis_to_basis_subspace_isomorphism:
- assumes s: "subspace (S:: ('n::euclidean_space) set)"
- and t: "subspace (T :: ('m::euclidean_space) set)"
- and d: "dim S = dim T"
- and B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
- and C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "card C = dim T"
- shows "\<exists>f. linear f \<and> f ` B = C \<and> f ` S = T \<and> inj_on f S"
-proof -
- from B independent_bound have fB: "finite B"
- by blast
- from C independent_bound have fC: "finite C"
- by blast
- from B(4) C(4) card_le_inj[of B C] d obtain f where
- f: "f ` B \<subseteq> C" "inj_on f B" using \<open>finite B\<close> \<open>finite C\<close> by auto
- from linear_independent_extend[OF B(2)] obtain g where
- g: "linear g" "\<forall>x \<in> B. g x = f x" by blast
- from inj_on_iff_eq_card[OF fB, of f] f(2)
- have "card (f ` B) = card B" by simp
- with B(4) C(4) have ceq: "card (f ` B) = card C" using d
- by simp
- have "g ` B = f ` B" using g(2)
- by (auto simp add: image_iff)
- also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
- finally have gBC: "g ` B = C" .
- have gi: "inj_on g B" using f(2) g(2)
- by (auto simp add: inj_on_def)
- note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
- {
- fix x y
- assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
- from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B"
- by blast+
- from gxy have th0: "g (x - y) = 0"
- by (simp add: linear_diff[OF g(1)])
- have th1: "x - y \<in> span B" using x' y'
- by (metis span_diff)
- have "x = y" using g0[OF th1 th0] by simp
- }
- then have giS: "inj_on g S" unfolding inj_on_def by blast
- from span_subspace[OF B(1,3) s]
- have "g ` S = span (g ` B)"
- by (simp add: span_linear_image[OF g(1)])
- also have "\<dots> = span C"
- unfolding gBC ..
- also have "\<dots> = T"
- using span_subspace[OF C(1,3) t] .
- finally have gS: "g ` S = T" .
- from g(1) gS giS gBC show ?thesis
- by blast
-qed
-
lemma closure_bounded_linear_image_subset:
assumes f: "bounded_linear f"
shows "f ` closure S \<subseteq> closure (f ` S)"
@@ -1820,19 +1721,13 @@
assume as: "finite t" "t \<noteq> {}" "t \<subseteq> insert a s" "sum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
have "(\<lambda>x. x - a) ` (t - {a}) \<subseteq> {x - a |x. x \<in> s}"
using as(3) by auto
- then show "\<exists>v. x = a + v \<and> (\<exists>S u. finite S \<and> S \<subseteq> {x - a |x. x \<in> s} \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = v)"
+ then show "\<exists>v. x = a + v \<and> (\<exists>S u. v = (\<Sum>v\<in>S. u v *\<^sub>R v) \<and> finite S \<and> S \<subseteq> {x - a |x. x \<in> s} )"
apply (rule_tac x="x - a" in exI)
apply (rule conjI, simp)
apply (rule_tac x="(\<lambda>x. x - a) ` (t - {a})" in exI)
apply (rule_tac x="\<lambda>x. u (x + a)" in exI)
- apply (rule conjI) using as(1) apply simp
- apply (erule conjI)
- using as(1)
- apply (simp add: sum.reindex[unfolded inj_on_def] scaleR_right_diff_distrib
- sum_subtractf scaleR_left.sum[symmetric] sum_diff1 scaleR_left_diff_distrib)
- unfolding as
- apply simp
- done
+ by (simp_all add: as sum.reindex[unfolded inj_on_def] scaleR_right_diff_distrib
+ sum_subtractf scaleR_left.sum[symmetric] sum_diff1 scaleR_left_diff_distrib)
qed
lemma affine_hull_insert_span:
@@ -2113,7 +2008,7 @@
unfolding cone_def by auto
lemma subspace_imp_cone: "subspace S \<Longrightarrow> cone S"
- by (simp add: cone_def subspace_mul)
+ by (simp add: cone_def subspace_scale)
subsubsection \<open>Conic hull\<close>
@@ -3153,10 +3048,10 @@
using subspace_imp_affine affine_imp_convex by auto
lemma affine_hull_subset_span: "(affine hull s) \<subseteq> (span s)"
- by (metis hull_minimal span_inc subspace_imp_affine subspace_span)
+ by (metis hull_minimal span_superset subspace_imp_affine subspace_span)
lemma convex_hull_subset_span: "(convex hull s) \<subseteq> (span s)"
- by (metis hull_minimal span_inc subspace_imp_convex subspace_span)
+ by (metis hull_minimal span_superset subspace_imp_convex subspace_span)
lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
by (metis affine_affine_hull affine_imp_convex hull_minimal hull_subset)
@@ -3289,7 +3184,7 @@
apply (rule subset_le_dim)
unfolding subset_eq
using \<open>a\<in>s\<close>
- apply (auto simp add:span_superset span_diff)
+ apply (auto simp add:span_base span_diff)
done
also have "\<dots> < dim s + 1" by auto
also have "\<dots> \<le> card (s - {a})"
@@ -3660,45 +3555,7 @@
then show ?thesis by auto
qed
-lemma independent_finite:
- fixes B :: "'n::euclidean_space set"
- assumes "independent B"
- shows "finite B"
- using affine_dependent_imp_dependent[of B] aff_independent_finite[of B] assms
- by auto
-
-lemma subspace_dim_equal:
- assumes "subspace (S :: ('n::euclidean_space) set)"
- and "subspace T"
- and "S \<subseteq> T"
- and "dim S \<ge> dim T"
- shows "S = T"
-proof -
- obtain B where B: "B \<le> S" "independent B \<and> S \<subseteq> span B" "card B = dim S"
- using basis_exists[of S] by auto
- then have "span B \<subseteq> S"
- using span_mono[of B S] span_eq[of S] assms by metis
- then have "span B = S"
- using B by auto
- have "dim S = dim T"
- using assms dim_subset[of S T] by auto
- then have "T \<subseteq> span B"
- using card_eq_dim[of B T] B independent_finite assms by auto
- then show ?thesis
- using assms \<open>span B = S\<close> by auto
-qed
-
-corollary dim_eq_span:
- fixes S :: "'a::euclidean_space set"
- shows "\<lbrakk>S \<subseteq> T; dim T \<le> dim S\<rbrakk> \<Longrightarrow> span S = span T"
-by (simp add: span_mono subspace_dim_equal subspace_span)
-
-lemma dim_eq_full:
- fixes S :: "'a :: euclidean_space set"
- shows "dim S = DIM('a) \<longleftrightarrow> span S = UNIV"
-apply (rule iffI)
- apply (metis dim_eq_span dim_subset_UNIV span_Basis span_span subset_UNIV)
-by (metis dim_UNIV dim_span)
+lemmas independent_finite = independent_imp_finite
lemma span_substd_basis:
assumes d: "d \<subseteq> Basis"
@@ -3710,9 +3567,10 @@
moreover have s: "subspace ?B"
using subspace_substandard[of "\<lambda>i. i \<notin> d"] .
ultimately have "span d \<subseteq> ?B"
- using span_mono[of d "?B"] span_eq[of "?B"] by blast
+ using span_mono[of d "?B"] span_eq_iff[of "?B"] by blast
moreover have *: "card d \<le> dim (span d)"
- using independent_card_le_dim[of d "span d"] independent_substdbasis[OF assms] span_inc[of d]
+ using independent_card_le_dim[of d "span d"] independent_substdbasis[OF assms]
+ span_superset[of d]
by auto
moreover from * have "dim ?B \<le> dim (span d)"
using dim_substandard[OF assms] by auto
@@ -3727,7 +3585,7 @@
f ` span B = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0} \<and> inj_on f (span B) \<and> d \<subseteq> Basis"
proof -
have B: "card B = dim B"
- using dim_unique[of B B "card B"] assms span_inc[of B] by auto
+ using dim_unique[of B B "card B"] assms span_superset[of B] by auto
have "dim B \<le> card (Basis :: 'a set)"
using dim_subset_UNIV[of B] by simp
from ex_card[OF this] obtain d :: "'a set" where d: "d \<subseteq> Basis" and t: "card d = dim B"
@@ -3738,13 +3596,13 @@
apply (rule subspace_span)
apply (rule subspace_substandard)
defer
- apply (rule span_inc)
+ apply (rule span_superset)
apply (rule assms)
defer
unfolding dim_span[of B]
apply(rule B)
unfolding span_substd_basis[OF d, symmetric]
- apply (rule span_inc)
+ apply (rule span_superset)
apply (rule independent_substdbasis[OF d])
apply rule
apply assumption
@@ -4032,7 +3890,7 @@
have "a \<bullet> w = a \<bullet> c" if "span ((+) (- c) ` S) \<subseteq> {x. a \<bullet> x = 0}" "w \<in> S" for w
proof -
have "w-c \<in> span ((+) (- c) ` S)"
- by (simp add: span_superset \<open>w \<in> S\<close>)
+ by (simp add: span_base \<open>w \<in> S\<close>)
with that have "w-c \<in> {x. a \<bullet> x = 0}"
by blast
then show ?thesis
@@ -4052,10 +3910,10 @@
have 1: "{b - a|b. b \<in> (S - {a})} \<subseteq> {x - a|x. x \<in> S}" by auto
have 2: "x - a \<in> span {b - a |b. b \<in> S - {a}}" if "x \<in> S" for x
proof (cases "x = a")
- case True then show ?thesis by simp
+ case True then show ?thesis by (simp add: span_clauses)
next
case False then show ?thesis
- using assms by (blast intro: span_superset that)
+ using assms by (blast intro: span_base that)
qed
have "\<not> affine_dependent (insert a S)"
by (simp add: assms insert_absorb)
@@ -5072,7 +4930,7 @@
then have "y \<in> S"
using assms y hull_subset[of S] affine_hull_subset_span
inj_on_image_mem_iff [OF \<open>inj_on f (span S)\<close>]
- by (metis Int_iff span_inc subsetCE)
+ by (metis Int_iff span_superset subsetCE)
}
then have "z \<in> f ` (rel_interior S)"
using mem_rel_interior_cball[of x S] \<open>e > 0\<close> x by auto
@@ -5107,7 +4965,7 @@
using assms linear_diff[of f x xy] linear_conv_bounded_linear[of f] by auto
moreover have *: "x - xy \<in> span S"
using subspace_diff[of "span S" x xy] subspace_span \<open>x \<in> S\<close> xy
- affine_hull_subset_span[of S] span_inc
+ affine_hull_subset_span[of S] span_superset
by auto
moreover from * have "e1 * norm (x - xy) \<le> norm (f (x - xy))"
using e1 by auto
@@ -6070,7 +5928,7 @@
proof -
from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
obtain a where "a \<noteq> 0" "\<forall>x\<in>{x - y |x y. x \<in> t \<and> y \<in> s}. 0 \<le> inner a x"
- using assms(3-5) by fastforce
+ using assms(3-5) by force
then have *: "\<And>x y. x \<in> t \<Longrightarrow> y \<in> s \<Longrightarrow> inner a y \<le> inner a x"
by (force simp add: inner_diff)
then have bdd: "bdd_above (((\<bullet>) a)`s)"
@@ -6152,7 +6010,7 @@
lemma convex_hull_scaling:
"convex hull ((\<lambda>x. c *\<^sub>R x) ` s) = (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
- using linear_scaleR by (rule convex_hull_linear_image [symmetric])
+ by (simp add: convex_hull_linear_image)
lemma convex_hull_affinity:
"convex hull ((\<lambda>x. a + c *\<^sub>R x) ` s) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull s)"
@@ -6730,8 +6588,10 @@
shows "connected s \<longleftrightarrow> convex s"
proof -
obtain f:: "'a \<Rightarrow> real" where linf: "linear f" and "inj f"
- using subspace_isomorphism [where 'a = 'a and 'b = real]
- by (metis DIM_real dim_UNIV subspace_UNIV assms)
+ using subspace_isomorphism[OF subspace_UNIV subspace_UNIV,
+ where 'a='a and 'b=real]
+ unfolding Euclidean_Space.dim_UNIV
+ by (auto simp: assms)
then have "f -` (f ` s) = s"
by (simp add: inj_vimage_image_eq)
then show ?thesis
@@ -6739,7 +6599,7 @@
qed
lemma is_interval_cball_1[intro, simp]: "is_interval (cball a b)" for a b::real
- by (auto simp: is_interval_convex_1 convex_cball)
+ by (simp add: is_interval_convex_1)
subsection%unimportant \<open>Another intermediate value theorem formulation\<close>
@@ -6909,7 +6769,7 @@
also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` (convex hull {0, 1}))"
by (simp only: convex_hull_eq_real_cbox zero_le_one)
also have "\<dots> = (\<Sum>i\<in>Basis. convex hull ((\<lambda>x. x *\<^sub>R i) ` {0, 1}))"
- by (simp only: convex_hull_linear_image linear_scaleR_left)
+ by (simp add: convex_hull_linear_image)
also have "\<dots> = convex hull (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` {0, 1})"
by (simp only: convex_hull_set_sum)
also have "\<dots> = convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}}"
--- a/src/HOL/Analysis/Derivative.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Derivative.thy Wed May 02 13:49:38 2018 +0200
@@ -400,7 +400,7 @@
apply (rule linear_eq_stdbasis)
unfolding linear_conv_bounded_linear
apply (rule as(1,2)[THEN conjunct1])+
- proof (rule, rule ccontr)
+ proof (rule ccontr)
fix i :: 'a
assume i: "i \<in> Basis"
define e where "e = norm (f' i - f'' i)"
@@ -1605,28 +1605,6 @@
We could put \<open>f' \<circ> g = I\<close> but this happens to fit with the minimal linear
algebra theory I've set up so far.\<close>
-(* move before left_inverse_linear in Euclidean_Space*)
-
-lemma right_inverse_linear:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
- assumes lf: "linear f"
- and gf: "f \<circ> g = id"
- shows "linear g"
-proof -
- from gf have fi: "surj f"
- by (auto simp add: surj_def o_def id_def) metis
- from linear_surjective_isomorphism[OF lf fi]
- obtain h:: "'a \<Rightarrow> 'a" where h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
- by blast
- have "h = g"
- apply (rule ext)
- using gf h(2,3)
- apply (simp add: o_def id_def fun_eq_iff)
- apply metis
- done
- with h(1) show ?thesis by blast
-qed
-
lemma has_derivative_inverse_strong:
fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
assumes "open s"
@@ -2778,7 +2756,7 @@
"\<forall>\<^sub>F n in sequentially. ((\<lambda>x. \<Sum>i<n. ?e i x) \<longlongrightarrow> A) ?F"
by eventually_elim
(auto intro!: tendsto_eq_intros
- simp: power_0_left if_distrib cond_application_beta sum.delta
+ simp: power_0_left if_distrib if_distribR sum.delta
cong: if_cong)
ultimately
have [tendsto_intros]: "((\<lambda>x. \<Sum>i. ?e i x) \<longlongrightarrow> A) ?F"
--- a/src/HOL/Analysis/Determinants.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Determinants.thy Wed May 02 13:49:38 2018 +0200
@@ -246,52 +246,106 @@
by simp
qed
-lemma det_identical_rows:
- fixes A :: "'a::linordered_idom^'n^'n"
- assumes ij: "i \<noteq> j"
- and r: "row i A = row j A"
+lemma det_identical_columns:
+ fixes A :: "'a::comm_ring_1^'n^'n"
+ assumes jk: "j \<noteq> k"
+ and r: "column j A = column k A"
shows "det A = 0"
-proof-
- have tha: "\<And>(a::'a) b. a = b \<Longrightarrow> b = - a \<Longrightarrow> a = 0"
- by simp
- have th1: "of_int (-1) = - 1" by simp
- let ?p = "Fun.swap i j id"
- let ?A = "\<chi> i. A $ ?p i"
- from r have "A = ?A" by (simp add: vec_eq_iff row_def Fun.swap_def)
- then have "det A = det ?A" by simp
- moreover have "det A = - det ?A"
- by (simp add: det_permute_rows[OF permutes_swap_id] sign_swap_id ij th1)
- ultimately show "det A = 0" by (metis tha)
+proof -
+ let ?U="UNIV::'n set"
+ let ?t_jk="Fun.swap j k id"
+ let ?PU="{p. p permutes ?U}"
+ let ?S1="{p. p\<in>?PU \<and> evenperm p}"
+ let ?S2="{(?t_jk \<circ> p) |p. p \<in>?S1}"
+ let ?f="\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i)"
+ let ?g="\<lambda>p. ?t_jk \<circ> p"
+ have g_S1: "?S2 = ?g` ?S1" by auto
+ have inj_g: "inj_on ?g ?S1"
+ proof (unfold inj_on_def, auto)
+ fix x y assume x: "x permutes ?U" and even_x: "evenperm x"
+ and y: "y permutes ?U" and even_y: "evenperm y" and eq: "?t_jk \<circ> x = ?t_jk \<circ> y"
+ show "x = y" by (metis (hide_lams, no_types) comp_assoc eq id_comp swap_id_idempotent)
+ qed
+ have tjk_permutes: "?t_jk permutes ?U" unfolding permutes_def swap_id_eq by (auto,metis)
+ have tjk_eq: "\<forall>i l. A $ i $ ?t_jk l = A $ i $ l"
+ using r jk
+ unfolding column_def vec_eq_iff swap_id_eq by fastforce
+ have sign_tjk: "sign ?t_jk = -1" using sign_swap_id[of j k] jk by auto
+ {fix x
+ assume x: "x\<in> ?S1"
+ have "sign (?t_jk \<circ> x) = sign (?t_jk) * sign x"
+ by (metis (lifting) finite_class.finite_UNIV mem_Collect_eq
+ permutation_permutes permutation_swap_id sign_compose x)
+ also have "... = - sign x" using sign_tjk by simp
+ also have "... \<noteq> sign x" unfolding sign_def by simp
+ finally have "sign (?t_jk \<circ> x) \<noteq> sign x" and "(?t_jk \<circ> x) \<in> ?S2"
+ by (auto, metis (lifting, full_types) mem_Collect_eq x)
+ }
+ hence disjoint: "?S1 \<inter> ?S2 = {}" by (auto, metis sign_def)
+ have PU_decomposition: "?PU = ?S1 \<union> ?S2"
+ proof (auto)
+ fix x
+ assume x: "x permutes ?U" and "\<forall>p. p permutes ?U \<longrightarrow> x = Fun.swap j k id \<circ> p \<longrightarrow> \<not> evenperm p"
+ from this obtain p where p: "p permutes UNIV" and x_eq: "x = Fun.swap j k id \<circ> p"
+ and odd_p: "\<not> evenperm p"
+ by (metis (no_types) comp_assoc id_comp inv_swap_id permutes_compose
+ permutes_inv_o(1) tjk_permutes)
+ thus "evenperm x"
+ by (metis evenperm_comp evenperm_swap finite_class.finite_UNIV
+ jk permutation_permutes permutation_swap_id)
+ next
+ fix p assume p: "p permutes ?U"
+ show "Fun.swap j k id \<circ> p permutes UNIV" by (metis p permutes_compose tjk_permutes)
+ qed
+ have "sum ?f ?S2 = sum ((\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))
+ \<circ> (\<circ>) (Fun.swap j k id)) {p \<in> {p. p permutes UNIV}. evenperm p}"
+ unfolding g_S1 by (rule sum.reindex[OF inj_g])
+ also have "... = sum (\<lambda>p. of_int (sign (?t_jk \<circ> p)) * (\<Prod>i\<in>UNIV. A $ i $ p i)) ?S1"
+ unfolding o_def by (rule sum.cong, auto simp add: tjk_eq)
+ also have "... = sum (\<lambda>p. - ?f p) ?S1"
+ proof (rule sum.cong, auto)
+ fix x assume x: "x permutes ?U"
+ and even_x: "evenperm x"
+ hence perm_x: "permutation x" and perm_tjk: "permutation ?t_jk"
+ using permutation_permutes[of x] permutation_permutes[of ?t_jk] permutation_swap_id
+ by (metis finite_code)+
+ have "(sign (?t_jk \<circ> x)) = - (sign x)"
+ unfolding sign_compose[OF perm_tjk perm_x] sign_tjk by auto
+ thus "of_int (sign (?t_jk \<circ> x)) * (\<Prod>i\<in>UNIV. A $ i $ x i)
+ = - (of_int (sign x) * (\<Prod>i\<in>UNIV. A $ i $ x i))"
+ by auto
+ qed
+ also have "...= - sum ?f ?S1" unfolding sum_negf ..
+ finally have *: "sum ?f ?S2 = - sum ?f ?S1" .
+ have "det A = (\<Sum>p | p permutes UNIV. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))"
+ unfolding det_def ..
+ also have "...= sum ?f ?S1 + sum ?f ?S2"
+ by (subst PU_decomposition, rule sum.union_disjoint[OF _ _ disjoint], auto)
+ also have "...= sum ?f ?S1 - sum ?f ?S1 " unfolding * by auto
+ also have "...= 0" by simp
+ finally show "det A = 0" by simp
qed
-lemma det_identical_columns:
- fixes A :: "'a::linordered_idom^'n^'n"
+lemma det_identical_rows:
+ fixes A :: "'a::comm_ring_1^'n^'n"
assumes ij: "i \<noteq> j"
- and r: "column i A = column j A"
+ and r: "row i A = row j A"
shows "det A = 0"
apply (subst det_transpose[symmetric])
- apply (rule det_identical_rows[OF ij])
- apply (metis row_transpose r)
+ apply (rule det_identical_columns[OF ij])
+ apply (metis column_transpose r)
done
lemma det_zero_row:
- fixes A :: "'a::{idom, ring_char_0}^'n^'n"
- assumes r: "row i A = 0"
- shows "det A = 0"
- using r
- apply (simp add: row_def det_def vec_eq_iff)
- apply (rule sum.neutral)
- apply (auto simp: sign_nz)
- done
+ fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
+ shows "row i A = 0 \<Longrightarrow> det A = 0" and "row j F = 0 \<Longrightarrow> det F = 0"
+ by (force simp add: row_def det_def vec_eq_iff sign_nz intro!: sum.neutral)+
lemma det_zero_column:
- fixes A :: "'a::{idom,ring_char_0}^'n^'n"
- assumes r: "column i A = 0"
- shows "det A = 0"
- apply (subst det_transpose[symmetric])
- apply (rule det_zero_row [of i])
- apply (metis row_transpose r)
- done
+ fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
+ shows "column i A = 0 \<Longrightarrow> det A = 0" and "column j F = 0 \<Longrightarrow> det F = 0"
+ unfolding atomize_conj atomize_imp
+ by (metis det_transpose det_zero_row row_transpose)
lemma det_row_add:
fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
@@ -404,7 +458,7 @@
done
lemma det_row_operation:
- fixes A :: "'a::linordered_idom^'n^'n"
+ fixes A :: "'a::{comm_ring_1}^'n^'n"
assumes ij: "i \<noteq> j"
shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
proof -
@@ -418,50 +472,35 @@
qed
lemma det_row_span:
- fixes A :: "real^'n^'n"
- assumes x: "x \<in> span {row j A |j. j \<noteq> i}"
+ fixes A :: "'a::{field}^'n^'n"
+ assumes x: "x \<in> vec.span {row j A |j. j \<noteq> i}"
shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
-proof -
- let ?U = "UNIV :: 'n set"
- let ?S = "{row j A |j. j \<noteq> i}"
+ using x
+proof (induction rule: vec.span_induct_alt)
+ case 1
+ then show ?case
+ by (rule cong[of det, OF refl]) (vector row_def)
+next
+ case (2 c z y)
+ note zS = 2(1)
+ and Py = 2(2)
let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
let ?P = "\<lambda>x. ?d (row i A + x) = det A"
- {
- fix k
- have "(if k = i then row i A + 0 else row k A) = row k A"
- by simp
- }
- then have P0: "?P 0"
- apply -
- apply (rule cong[of det, OF refl])
+ from zS obtain j where j: "z = row j A" "i \<noteq> j"
+ by blast
+ let ?w = "row i A + y"
+ have th0: "row i A + (c*s z + y) = ?w + c*s z"
+ by vector
+ have thz: "?d z = 0"
+ apply (rule det_identical_rows[OF j(2)])
+ using j
apply (vector row_def)
done
- moreover
- {
- fix c z y
- assume zS: "z \<in> ?S" and Py: "?P y"
- from zS obtain j where j: "z = row j A" "i \<noteq> j"
- by blast
- let ?w = "row i A + y"
- have th0: "row i A + (c*s z + y) = ?w + c*s z"
- by vector
- have thz: "?d z = 0"
- apply (rule det_identical_rows[OF j(2)])
- using j
- apply (vector row_def)
- done
- have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)"
- unfolding th0 ..
- then have "?P (c*s z + y)"
- unfolding thz Py det_row_mul[of i] det_row_add[of i]
- by simp
- }
- ultimately show ?thesis
- apply -
- apply (rule span_induct_alt[of ?P ?S, OF P0, folded scalar_mult_eq_scaleR])
- apply blast
- apply (rule x)
- done
+ have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)"
+ unfolding th0 ..
+ then show ?case
+ unfolding thz Py det_row_mul[of i] det_row_add[of i]
+ by simp
qed
lemma matrix_id [simp]: "det (matrix id) = 1"
@@ -469,7 +508,7 @@
lemma det_matrix_scaleR [simp]: "det (matrix ((( *\<^sub>R) r)) :: real^'n^'n) = r ^ CARD('n::finite)"
apply (subst det_diagonal)
- apply (auto simp: matrix_def mat_def prod_constant)
+ apply (auto simp: matrix_def mat_def)
apply (simp add: cart_eq_inner_axis inner_axis_axis)
done
@@ -479,13 +518,13 @@
\<close>
lemma det_dependent_rows:
- fixes A:: "real^'n^'n"
- assumes d: "dependent (rows A)"
+ fixes A:: "'a::{field}^'n^'n"
+ assumes d: "vec.dependent (rows A)"
shows "det A = 0"
proof -
let ?U = "UNIV :: 'n set"
- from d obtain i where i: "row i A \<in> span (rows A - {row i A})"
- unfolding dependent_def rows_def by blast
+ from d obtain i where i: "row i A \<in> vec.span (rows A - {row i A})"
+ unfolding vec.dependent_def rows_def by blast
{
fix j k
assume jk: "j \<noteq> k" and c: "row j A = row k A"
@@ -494,25 +533,25 @@
moreover
{
assume H: "\<And> i j. i \<noteq> j \<Longrightarrow> row i A \<noteq> row j A"
- have th0: "- row i A \<in> span {row j A|j. j \<noteq> i}"
- apply (rule span_neg)
+ have th0: "- row i A \<in> vec.span {row j A|j. j \<noteq> i}"
+ apply (rule vec.span_neg)
apply (rule set_rev_mp)
apply (rule i)
- apply (rule span_mono)
+ apply (rule vec.span_mono)
using H i
apply (auto simp add: rows_def)
done
from det_row_span[OF th0]
have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
unfolding right_minus vector_smult_lzero ..
- with det_row_mul[of i "0::real" "\<lambda>i. 1"]
+ with det_row_mul[of i "0::'a" "\<lambda>i. 1"]
have "det A = 0" by simp
}
ultimately show ?thesis by blast
qed
lemma det_dependent_columns:
- assumes d: "dependent (columns (A::real^'n^'n))"
+ assumes d: "vec.dependent (columns (A::real^'n^'n))"
shows "det A = 0"
by (metis d det_dependent_rows rows_transpose det_transpose)
@@ -647,7 +686,7 @@
qed rule
lemma det_mul:
- fixes A B :: "'a::linordered_idom^'n^'n"
+ fixes A B :: "'a::comm_ring_1^'n^'n"
shows "det (A ** B) = det A * det B"
proof -
let ?U = "UNIV :: 'n set"
@@ -767,30 +806,21 @@
finally show ?thesis unfolding th2 .
qed
+
subsection \<open>Relation to invertibility.\<close>
-lemma invertible_left_inverse:
- fixes A :: "real^'n^'n"
- shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). B** A = mat 1)"
- by (metis invertible_def matrix_left_right_inverse)
-
-lemma invertible_right_inverse:
- fixes A :: "real^'n^'n"
- shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). A** B = mat 1)"
- by (metis invertible_def matrix_left_right_inverse)
-
lemma invertible_det_nz:
- fixes A::"real ^'n^'n"
+ fixes A::"'a::{field}^'n^'n"
shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
proof -
{
assume "invertible A"
- then obtain B :: "real ^'n^'n" where B: "A ** B = mat 1"
+ then obtain B :: "'a^'n^'n" where B: "A ** B = mat 1"
unfolding invertible_right_inverse by blast
- then have "det (A ** B) = det (mat 1 :: real ^'n^'n)"
+ then have "det (A ** B) = det (mat 1 :: 'a^'n^'n)"
by simp
then have "det A \<noteq> 0"
- by (simp add: det_mul det_I) algebra
+ by (simp add: det_mul) algebra
}
moreover
{
@@ -804,37 +834,41 @@
unfolding invertible_right_inverse
unfolding matrix_right_invertible_independent_rows
by blast
- have *: "\<And>(a::real^'n) b. a + b = 0 \<Longrightarrow> -a = b"
+ have *: "\<And>(a::'a^'n) b. a + b = 0 \<Longrightarrow> -a = b"
apply (drule_tac f="(+) (- a)" in cong[OF refl])
apply (simp only: ab_left_minus add.assoc[symmetric])
apply simp
done
+ from c ci
have thr0: "- row i A = sum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
+ unfolding sum.remove[OF fU iU] sum_cmul
+ apply -
apply (rule vector_mul_lcancel_imp[OF ci])
- using c ci unfolding sum.remove[OF fU iU] sum_cmul
- apply (auto simp add: field_simps *)
+ apply (auto simp add: field_simps)
+ unfolding *
+ apply rule
done
- have thr: "- row i A \<in> span {row j A| j. j \<noteq> i}"
+ have thr: "- row i A \<in> vec.span {row j A| j. j \<noteq> i}"
unfolding thr0
- apply (rule span_sum)
+ apply (rule vec.span_sum)
apply simp
- apply (rule span_mul [where 'a="real^'n"])
- apply (rule span_superset)
+ apply (rule vec.span_scale[folded scalar_mult_eq_scaleR])+
+ apply (rule vec.span_base)
apply auto
done
- let ?B = "(\<chi> k. if k = i then 0 else row k A) :: real ^'n^'n"
+ let ?B = "(\<chi> k. if k = i then 0 else row k A) :: 'a^'n^'n"
have thrb: "row i ?B = 0" using iU by (vector row_def)
have "det A = 0"
unfolding det_row_span[OF thr, symmetric] right_minus
- unfolding det_zero_row[OF thrb] ..
+ unfolding det_zero_row(2)[OF thrb] ..
}
ultimately show ?thesis
by blast
qed
-lemma det_nz_iff_inj:
- fixes f :: "real^'n \<Rightarrow> real^'n"
- assumes "linear f"
+lemma det_nz_iff_inj_gen:
+ fixes f :: "'a::field^'n \<Rightarrow> 'a::field^'n"
+ assumes "Vector_Spaces.linear ( *s) ( *s) f"
shows "det (matrix f) \<noteq> 0 \<longleftrightarrow> inj f"
proof
assume "det (matrix f) \<noteq> 0"
@@ -843,10 +877,17 @@
next
assume "inj f"
show "det (matrix f) \<noteq> 0"
- using linear_injective_left_inverse [OF assms \<open>inj f\<close>]
- by (metis assms invertible_det_nz invertible_left_inverse matrix_compose matrix_id_mat_1)
+ using vec.linear_injective_left_inverse [OF assms \<open>inj f\<close>]
+ by (metis assms invertible_det_nz invertible_left_inverse matrix_compose_gen matrix_id_mat_1)
qed
+lemma det_nz_iff_inj:
+ fixes f :: "real^'n \<Rightarrow> real^'n"
+ assumes "linear f"
+ shows "det (matrix f) \<noteq> 0 \<longleftrightarrow> inj f"
+ using det_nz_iff_inj_gen[of f] assms
+ unfolding linear_matrix_vector_mul_eq .
+
lemma det_eq_0_rank:
fixes A :: "real^'n^'n"
shows "det A = 0 \<longleftrightarrow> rank A < CARD('n)"
@@ -855,71 +896,88 @@
subsubsection\<open>Invertibility of matrices and corresponding linear functions\<close>
-lemma matrix_left_invertible:
- fixes f :: "real^'m \<Rightarrow> real^'n"
- assumes "linear f"
- shows "((\<exists>B. B ** matrix f = mat 1) \<longleftrightarrow> (\<exists>g. linear g \<and> g \<circ> f = id))"
+lemma matrix_left_invertible_gen:
+ fixes f :: "'a::field^'m \<Rightarrow> 'a::field^'n"
+ assumes "Vector_Spaces.linear ( *s) ( *s) f"
+ shows "((\<exists>B. B ** matrix f = mat 1) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> g \<circ> f = id))"
proof safe
fix B
assume 1: "B ** matrix f = mat 1"
- show "\<exists>g. linear g \<and> g \<circ> f = id"
+ show "\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> g \<circ> f = id"
proof (intro exI conjI)
- show "linear (\<lambda>y. B *v y)"
- by (simp add: matrix_vector_mul_linear)
+ show "Vector_Spaces.linear ( *s) ( *s) (\<lambda>y. B *v y)"
+ by (simp add:)
show "(( *v) B) \<circ> f = id"
unfolding o_def
- by (metis assms 1 eq_id_iff matrix_vector_mul matrix_vector_mul_assoc matrix_vector_mul_lid)
+ by (metis assms 1 eq_id_iff matrix_vector_mul(1) matrix_vector_mul_assoc matrix_vector_mul_lid)
qed
next
fix g
- assume "linear g" "g \<circ> f = id"
+ assume "Vector_Spaces.linear ( *s) ( *s) g" "g \<circ> f = id"
then have "matrix g ** matrix f = mat 1"
- by (metis assms matrix_compose matrix_id_mat_1)
+ by (metis assms matrix_compose_gen matrix_id_mat_1)
then show "\<exists>B. B ** matrix f = mat 1" ..
qed
-lemma matrix_right_invertible:
- fixes f :: "real^'m \<Rightarrow> real^'n"
- assumes "linear f"
- shows "((\<exists>B. matrix f ** B = mat 1) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id))"
+lemma matrix_left_invertible:
+ "linear f \<Longrightarrow> ((\<exists>B. B ** matrix f = mat 1) \<longleftrightarrow> (\<exists>g. linear g \<and> g \<circ> f = id))" for f::"real^'m \<Rightarrow> real^'n"
+ using matrix_left_invertible_gen[of f]
+ by (auto simp: linear_matrix_vector_mul_eq)
+
+lemma matrix_right_invertible_gen:
+ fixes f :: "'a::field^'m \<Rightarrow> 'a^'n"
+ assumes "Vector_Spaces.linear ( *s) ( *s) f"
+ shows "((\<exists>B. matrix f ** B = mat 1) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> f \<circ> g = id))"
proof safe
fix B
assume 1: "matrix f ** B = mat 1"
- show "\<exists>g. linear g \<and> f \<circ> g = id"
+ show "\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> f \<circ> g = id"
proof (intro exI conjI)
- show "linear (( *v) B)"
- by (simp add: matrix_vector_mul_linear)
+ show "Vector_Spaces.linear ( *s) ( *s) (( *v) B)"
+ by (simp add: )
show "f \<circ> ( *v) B = id"
- by (metis 1 assms comp_apply eq_id_iff linear_id matrix_id_mat_1 matrix_vector_mul_assoc matrix_works)
+ using 1 assms comp_apply eq_id_iff vec.linear_id matrix_id_mat_1 matrix_vector_mul_assoc matrix_works
+ by (metis (no_types, hide_lams))
qed
next
fix g
- assume "linear g" and "f \<circ> g = id"
+ assume "Vector_Spaces.linear ( *s) ( *s) g" and "f \<circ> g = id"
then have "matrix f ** matrix g = mat 1"
- by (metis assms matrix_compose matrix_id_mat_1)
+ by (metis assms matrix_compose_gen matrix_id_mat_1)
then show "\<exists>B. matrix f ** B = mat 1" ..
qed
+lemma matrix_right_invertible:
+ "linear f \<Longrightarrow> ((\<exists>B. matrix f ** B = mat 1) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id))" for f::"real^'m \<Rightarrow> real^'n"
+ using matrix_right_invertible_gen[of f]
+ by (auto simp: linear_matrix_vector_mul_eq)
+
+lemma matrix_invertible_gen:
+ fixes f :: "'a::field^'m \<Rightarrow> 'a::field^'n"
+ assumes "Vector_Spaces.linear ( *s) ( *s) f"
+ shows "invertible (matrix f) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
+ (is "?lhs = ?rhs")
+proof
+ assume ?lhs then show ?rhs
+ by (metis assms invertible_def left_right_inverse_eq matrix_left_invertible_gen matrix_right_invertible_gen)
+next
+ assume ?rhs then show ?lhs
+ by (metis assms invertible_def matrix_compose_gen matrix_id_mat_1)
+qed
+
lemma matrix_invertible:
- fixes f :: "real^'m \<Rightarrow> real^'n"
- assumes "linear f"
- shows "invertible (matrix f) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
- (is "?lhs = ?rhs")
-proof
- assume ?lhs then show ?rhs
- by (metis assms invertible_def left_right_inverse_eq matrix_left_invertible matrix_right_invertible)
-next
- assume ?rhs then show ?lhs
- by (metis assms invertible_def matrix_compose matrix_id_mat_1)
-qed
+ "linear f \<Longrightarrow> invertible (matrix f) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
+ for f::"real^'m \<Rightarrow> real^'n"
+ using matrix_invertible_gen[of f]
+ by (auto simp: linear_matrix_vector_mul_eq)
lemma invertible_eq_bij:
- fixes m :: "real^'m^'n"
+ fixes m :: "'a::field^'m^'n"
shows "invertible m \<longleftrightarrow> bij (( *v) m)"
- using matrix_invertible [OF matrix_vector_mul_linear] o_bij
- apply (auto simp: bij_betw_def)
- by (metis left_right_inverse_eq linear_injective_left_inverse [OF matrix_vector_mul_linear]
- linear_surjective_right_inverse[OF matrix_vector_mul_linear])
+ using matrix_invertible_gen[OF matrix_vector_mul_linear_gen, of m, simplified matrix_of_matrix_vector_mul]
+ by (metis bij_betw_def left_right_inverse_eq matrix_vector_mul_linear_gen o_bij
+ vec.linear_injective_left_inverse vec.linear_surjective_right_inverse)
+
subsection \<open>Cramer's rule.\<close>
@@ -947,9 +1005,9 @@
by simp
have thd0: "det (\<chi> i. if i = k then row k A + (\<Sum>i \<in> ?Uk. x $ i *s row i A) else row i A) = det A"
apply (rule det_row_span)
- apply (rule span_sum)
- apply (rule span_mul [where 'a="real^'n", folded scalar_mult_eq_scaleR])
- apply (rule span_superset)
+ apply (rule vec.span_sum)
+ apply (rule vec.span_scale)
+ apply (rule vec.span_base)
apply auto
done
show "?lhs = x$k * det A"
@@ -972,7 +1030,7 @@
proof -
let ?U = "UNIV :: 'n set"
have *: "\<And>c. sum (\<lambda>i. c i *s row i (transpose A)) ?U = sum (\<lambda>i. c i *s column i A) ?U"
- by (auto simp add: row_transpose intro: sum.cong)
+ by (auto intro: sum.cong)
show ?thesis
unfolding matrix_mult_sum
unfolding cramer_lemma_transpose[of k x "transpose A", unfolded det_transpose, symmetric]
@@ -992,7 +1050,7 @@
unfolding invertible_det_nz[symmetric] invertible_def
by blast
have "(A ** B) *v b = b"
- by (simp add: B matrix_vector_mul_lid)
+ by (simp add: B)
then have "A *v (B *v b) = b"
by (simp add: matrix_vector_mul_assoc)
then have xe: "\<exists>x. A *v x = b"
@@ -1021,7 +1079,7 @@
apply auto
apply (erule_tac x=v in allE)+
apply (simp add: norm_eq_sqrt_inner)
- apply (simp add: dot_norm linear_add[symmetric])
+ apply (simp add: dot_norm linear_add[symmetric])
done
lemma orthogonal_transformation_id [simp]: "orthogonal_transformation (\<lambda>x. x)"
@@ -1033,7 +1091,7 @@
lemma orthogonal_transformation_compose:
"\<lbrakk>orthogonal_transformation f; orthogonal_transformation g\<rbrakk> \<Longrightarrow> orthogonal_transformation(f \<circ> g)"
- by (simp add: orthogonal_transformation_def linear_compose)
+ by (auto simp add: orthogonal_transformation_def linear_compose)
lemma orthogonal_transformation_neg:
"orthogonal_transformation(\<lambda>x. -(f x)) \<longleftrightarrow> orthogonal_transformation f"
@@ -1074,7 +1132,7 @@
by (metis matrix_left_right_inverse orthogonal_matrix_def)
lemma orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n)"
- by (simp add: orthogonal_matrix_def transpose_mat matrix_mul_lid)
+ by (simp add: orthogonal_matrix_def)
lemma orthogonal_matrix_mul:
fixes A :: "real ^'n^'n"
@@ -1085,7 +1143,7 @@
unfolding orthogonal_matrix matrix_transpose_mul
apply (subst matrix_mul_assoc)
apply (subst matrix_mul_assoc[symmetric])
- apply (simp add: matrix_mul_rid)
+ apply (simp add: )
done
lemma orthogonal_transformation_matrix:
@@ -1100,8 +1158,9 @@
let ?m1 = "mat 1 :: real ^'n^'n"
{
assume ot: ?ot
- from ot have lf: "linear f" and fd: "\<forall>v w. f v \<bullet> f w = v \<bullet> w"
- unfolding orthogonal_transformation_def orthogonal_matrix by blast+
+ from ot have lf: "Vector_Spaces.linear ( *s) ( *s) f" and fd: "\<forall>v w. f v \<bullet> f w = v \<bullet> w"
+ unfolding orthogonal_transformation_def orthogonal_matrix linear_def scalar_mult_eq_scaleR
+ by blast+
{
fix i j
let ?A = "transpose ?mf ** ?mf"
@@ -1118,20 +1177,21 @@
unfolding orthogonal_matrix
by vector
with lf have ?rhs
+ unfolding linear_def scalar_mult_eq_scaleR
by blast
}
moreover
{
- assume lf: "linear f" and om: "orthogonal_matrix ?mf"
+ assume lf: "Vector_Spaces.linear ( *s) ( *s) f" and om: "orthogonal_matrix ?mf"
from lf om have ?lhs
apply (simp only: orthogonal_matrix_def norm_eq orthogonal_transformation)
apply (simp only: matrix_works[OF lf, symmetric])
apply (subst dot_matrix_vector_mul)
- apply (simp add: dot_matrix_product matrix_mul_lid)
+ apply (simp add: dot_matrix_product linear_def scalar_mult_eq_scaleR)
done
}
ultimately show ?thesis
- by blast
+ by (auto simp: linear_def scalar_mult_eq_scaleR)
qed
lemma det_orthogonal_matrix:
@@ -1159,7 +1219,7 @@
then have "det (Q ** transpose Q) = det (mat 1:: 'a^'n^'n)"
by simp
then have "det Q * det Q = 1"
- by (simp add: det_mul det_I det_transpose)
+ by (simp add: det_mul)
then show ?thesis unfolding th .
qed
@@ -1266,9 +1326,9 @@
proof -
obtain S where "a \<in> S" "pairwise orthogonal S" and noS: "\<And>x. x \<in> S \<Longrightarrow> norm x = 1"
and "independent S" "card S = CARD('n)" "span S = UNIV"
- using vector_in_orthonormal_basis assms by force
- with independent_imp_finite obtain f0 where "bij_betw f0 (UNIV::'n set) S"
- by (metis finite_class.finite_UNIV finite_same_card_bij)
+ using vector_in_orthonormal_basis assms by (force simp: )
+ then obtain f0 where "bij_betw f0 (UNIV::'n set) S"
+ by (metis finite_class.finite_UNIV finite_same_card_bij finiteI_independent)
then obtain f where f: "bij_betw f (UNIV::'n set) S" and a: "a = f k"
using bij_swap_iff [of k "inv f0 a" f0]
by (metis UNIV_I \<open>a \<in> S\<close> bij_betw_inv_into_right bij_betw_swap_iff swap_apply1)
@@ -1299,7 +1359,8 @@
show thesis
proof
show "orthogonal_transformation ?f"
- by (simp add: AB orthogonal_matrix_mul matrix_vector_mul_linear orthogonal_transformation_matrix)
+ by (subst orthogonal_transformation_matrix)
+ (auto simp: AB orthogonal_matrix_mul)
next
show "?f a = b"
using \<open>orthogonal_matrix A\<close> unfolding orthogonal_matrix_def
@@ -1321,10 +1382,10 @@
by (auto intro: orthogonal_transformation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b"])
show ?thesis
proof
- have "linear f"
+ interpret linear f
using f by (simp add: orthogonal_transformation_linear)
- then have "f a /\<^sub>R norm a = f (a /\<^sub>R norm a)"
- by (simp add: linear_cmul [of f])
+ have "f a /\<^sub>R norm a = f (a /\<^sub>R norm a)"
+ by (simp add: scale)
also have "\<dots> = b /\<^sub>R norm a"
by (simp add: eq assms [symmetric])
finally show "f a = b"
@@ -1453,7 +1514,7 @@
by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute)
lemma det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
- by (simp add: det_def of_nat_Suc sign_id)
+ by (simp add: det_def sign_id)
lemma det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
proof -
@@ -1563,9 +1624,14 @@
by (metis eq_id_iff matrix_id orthogonal_transformation_id that)
next
case False
- with that show thesis
- by (auto simp: eq linear_cmul orthogonal_transformation_def
- intro: rotation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b", OF 2])
+ then obtain f where f: "orthogonal_transformation f" "det (matrix f) = 1"
+ and f': "f (a /\<^sub>R norm a) = b /\<^sub>R norm b"
+ using rotation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b", OF 2] by auto
+ then interpret linear f by (simp add: orthogonal_transformation)
+ have "f a = b"
+ using f' False
+ by (simp add: eq scale)
+ with f show thesis ..
qed
lemma rotation_rightward_line:
--- a/src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy Wed May 02 13:49:38 2018 +0200
@@ -1226,7 +1226,7 @@
have "negligible (span S)"
using \<open>a \<noteq> 0\<close> a negligible_hyperplane by (blast intro: negligible_subset)
then show ?thesis
- using span_inc by (blast intro: negligible_subset)
+ using span_base by (blast intro: negligible_subset)
qed
proposition negligible_convex_frontier:
@@ -1240,7 +1240,7 @@
and spanB: "S \<subseteq> span B" and cardB: "card B = dim S"
by (metis basis_exists)
consider "dim S < DIM('N)" | "dim S = DIM('N)"
- using dim_subset_UNIV le_eq_less_or_eq by blast
+ using dim_subset_UNIV le_eq_less_or_eq by auto
then show ?thesis
proof cases
case 1
@@ -2848,8 +2848,12 @@
show "negligible (frontier (g ` K \<inter> g ` L))"
by (simp add: negligible_convex_frontier convex_Int conv convex_linear_image that)
next
- show "negligible (interior (g ` K \<inter> g ` L))"
- by (metis (mono_tags, lifting) True finite.emptyI image_Int image_empty interior_Int interior_injective_linear_image intint negligible_finite pairwiseD that)
+ have "\<forall>p N. pairwise p N = (\<forall>Na. (Na::'n set) \<in> N \<longrightarrow> (\<forall>Nb. Nb \<in> N \<and> Na \<noteq> Nb \<longrightarrow> p Na Nb))"
+ by (metis pairwise_def)
+ then have "interior K \<inter> interior L = {}"
+ using intint that(2) that(3) that(4) by presburger
+ then show "negligible (interior (g ` K \<inter> g ` L))"
+ by (metis True empty_imp_negligible image_Int image_empty interior_Int interior_injective_linear_image that(1))
qed
moreover have "g ` K \<inter> g ` L \<subseteq> frontier (g ` K \<inter> g ` L) \<union> interior (g ` K \<inter> g ` L)"
apply (auto simp: frontier_def)
@@ -3176,7 +3180,7 @@
assumes "f absolutely_integrable_on S"
shows "(norm o f) absolutely_integrable_on S"
using assms by (simp add: absolutely_integrable_on_def o_def)
-
+
lemma absolutely_integrable_abs:
fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
assumes "f absolutely_integrable_on S"
--- a/src/HOL/Analysis/Euclidean_Space.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Euclidean_Space.thy Wed May 02 13:49:38 2018 +0200
@@ -152,6 +152,53 @@
using False by (auto simp: inner_sum_left)
qed
+lemma norm_le_componentwise:
+ "(\<And>b. b \<in> Basis \<Longrightarrow> abs(inner x b) \<le> abs(inner y b)) \<Longrightarrow> norm x \<le> norm y"
+ by (auto simp: norm_le euclidean_inner [of x x] euclidean_inner [of y y] abs_le_square_iff power2_eq_square intro!: sum_mono)
+
+lemma Basis_le_norm: "b \<in> Basis \<Longrightarrow> \<bar>inner x b\<bar> \<le> norm x"
+ by (rule order_trans [OF Cauchy_Schwarz_ineq2]) simp
+
+lemma norm_bound_Basis_le: "b \<in> Basis \<Longrightarrow> norm x \<le> e \<Longrightarrow> \<bar>inner x b\<bar> \<le> e"
+ by (metis Basis_le_norm order_trans)
+
+lemma norm_bound_Basis_lt: "b \<in> Basis \<Longrightarrow> norm x < e \<Longrightarrow> \<bar>inner x b\<bar> < e"
+ by (metis Basis_le_norm le_less_trans)
+
+lemma norm_le_l1: "norm x \<le> (\<Sum>b\<in>Basis. \<bar>inner x b\<bar>)"
+ apply (subst euclidean_representation[of x, symmetric])
+ apply (rule order_trans[OF norm_sum])
+ apply (auto intro!: sum_mono)
+ done
+
+lemma sum_norm_allsubsets_bound:
+ fixes f :: "'a \<Rightarrow> 'n::euclidean_space"
+ assumes fP: "finite P"
+ and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (sum f Q) \<le> e"
+ shows "(\<Sum>x\<in>P. norm (f x)) \<le> 2 * real DIM('n) * e"
+proof -
+ have "(\<Sum>x\<in>P. norm (f x)) \<le> (\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>inner (f x) b\<bar>)"
+ by (rule sum_mono) (rule norm_le_l1)
+ also have "(\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>inner (f x) b\<bar>) = (\<Sum>b\<in>Basis. \<Sum>x\<in>P. \<bar>inner (f x) b\<bar>)"
+ by (rule sum.swap)
+ also have "\<dots> \<le> of_nat (card (Basis :: 'n set)) * (2 * e)"
+ proof (rule sum_bounded_above)
+ fix i :: 'n
+ assume i: "i \<in> Basis"
+ have "norm (\<Sum>x\<in>P. \<bar>inner (f x) i\<bar>) \<le>
+ norm (inner (\<Sum>x\<in>P \<inter> - {x. inner (f x) i < 0}. f x) i) + norm (inner (\<Sum>x\<in>P \<inter> {x. inner (f x) i < 0}. f x) i)"
+ by (simp add: abs_real_def sum.If_cases[OF fP] sum_negf norm_triangle_ineq4 inner_sum_left
+ del: real_norm_def)
+ also have "\<dots> \<le> e + e"
+ unfolding real_norm_def
+ by (intro add_mono norm_bound_Basis_le i fPs) auto
+ finally show "(\<Sum>x\<in>P. \<bar>inner (f x) i\<bar>) \<le> 2*e" by simp
+ qed
+ also have "\<dots> = 2 * real DIM('n) * e" by simp
+ finally show ?thesis .
+qed
+
+
subsection%unimportant \<open>Subclass relationships\<close>
instance euclidean_space \<subseteq> perfect_space
@@ -250,4 +297,56 @@
end
+
+subsection \<open>Locale instances\<close>
+
+lemma finite_dimensional_vector_space_euclidean:
+ "finite_dimensional_vector_space ( *\<^sub>R) Basis"
+proof unfold_locales
+ show "finite (Basis::'a set)" by (metis finite_Basis)
+ show "real_vector.independent (Basis::'a set)"
+ unfolding dependent_def dependent_raw_def[symmetric]
+ apply (subst span_finite)
+ apply simp
+ apply clarify
+ apply (drule_tac f="inner a" in arg_cong)
+ apply (simp add: inner_Basis inner_sum_right eq_commute)
+ done
+ show "module.span ( *\<^sub>R) Basis = UNIV"
+ unfolding span_finite [OF finite_Basis] span_raw_def[symmetric]
+ by (auto intro!: euclidean_representation[symmetric])
+qed
+
+interpretation eucl?: finite_dimensional_vector_space "scaleR :: real => 'a => 'a::euclidean_space" "Basis"
+ rewrites "module.dependent ( *\<^sub>R) = dependent"
+ and "module.representation ( *\<^sub>R) = representation"
+ and "module.subspace ( *\<^sub>R) = subspace"
+ and "module.span ( *\<^sub>R) = span"
+ and "vector_space.extend_basis ( *\<^sub>R) = extend_basis"
+ and "vector_space.dim ( *\<^sub>R) = dim"
+ and "Vector_Spaces.linear ( *\<^sub>R) ( *\<^sub>R) = linear"
+ and "Vector_Spaces.linear ( * ) ( *\<^sub>R) = linear"
+ and "finite_dimensional_vector_space.dimension Basis = DIM('a)"
+ and "dimension = DIM('a)"
+ by (auto simp add: dependent_raw_def representation_raw_def
+ subspace_raw_def span_raw_def extend_basis_raw_def dim_raw_def linear_def
+ real_scaleR_def[abs_def]
+ finite_dimensional_vector_space.dimension_def
+ intro!: finite_dimensional_vector_space.dimension_def
+ finite_dimensional_vector_space_euclidean)
+
+interpretation eucl?: finite_dimensional_vector_space_prod scaleR scaleR Basis Basis
+ rewrites "Basis_pair = Basis"
+ and "module_prod.scale ( *\<^sub>R) ( *\<^sub>R) = (scaleR::_\<Rightarrow>_\<Rightarrow>('a \<times> 'b))"
+proof -
+ show "finite_dimensional_vector_space_prod ( *\<^sub>R) ( *\<^sub>R) Basis Basis"
+ by unfold_locales
+ interpret finite_dimensional_vector_space_prod "( *\<^sub>R)" "( *\<^sub>R)" "Basis::'a set" "Basis::'b set"
+ by fact
+ show "Basis_pair = Basis"
+ unfolding Basis_pair_def Basis_prod_def by auto
+ show "module_prod.scale ( *\<^sub>R) ( *\<^sub>R) = scaleR"
+ by (fact module_prod_scale_eq_scaleR)
+qed
+
end
--- a/src/HOL/Analysis/Finite_Cartesian_Product.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Finite_Cartesian_Product.thy Wed May 02 13:49:38 2018 +0200
@@ -10,7 +10,6 @@
L2_Norm
"HOL-Library.Numeral_Type"
"HOL-Library.Countable_Set"
- "HOL-Library.FuncSet"
begin
subsection \<open>Finite Cartesian products, with indexing and lambdas\<close>
@@ -230,6 +229,80 @@
by standard (simp_all add: vec_eq_iff)
+subsection\<open>Basic componentwise operations on vectors\<close>
+
+instantiation vec :: (times, finite) times
+begin
+
+definition "( * ) \<equiv> (\<lambda> x y. (\<chi> i. (x$i) * (y$i)))"
+instance ..
+
+end
+
+instantiation vec :: (one, finite) one
+begin
+
+definition "1 \<equiv> (\<chi> i. 1)"
+instance ..
+
+end
+
+instantiation vec :: (ord, finite) ord
+begin
+
+definition "x \<le> y \<longleftrightarrow> (\<forall>i. x$i \<le> y$i)"
+definition "x < (y::'a^'b) \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
+instance ..
+
+end
+
+text\<open>The ordering on one-dimensional vectors is linear.\<close>
+
+class cart_one =
+ assumes UNIV_one: "card (UNIV :: 'a set) = Suc 0"
+begin
+
+subclass finite
+proof
+ from UNIV_one show "finite (UNIV :: 'a set)"
+ by (auto intro!: card_ge_0_finite)
+qed
+
+end
+
+instance vec:: (order, finite) order
+ by standard (auto simp: less_eq_vec_def less_vec_def vec_eq_iff
+ intro: order.trans order.antisym order.strict_implies_order)
+
+instance vec :: (linorder, cart_one) linorder
+proof
+ obtain a :: 'b where all: "\<And>P. (\<forall>i. P i) \<longleftrightarrow> P a"
+ proof -
+ have "card (UNIV :: 'b set) = Suc 0" by (rule UNIV_one)
+ then obtain b :: 'b where "UNIV = {b}" by (auto iff: card_Suc_eq)
+ then have "\<And>P. (\<forall>i\<in>UNIV. P i) \<longleftrightarrow> P b" by auto
+ then show thesis by (auto intro: that)
+ qed
+ fix x y :: "'a^'b::cart_one"
+ note [simp] = less_eq_vec_def less_vec_def all vec_eq_iff field_simps
+ show "x \<le> y \<or> y \<le> x" by auto
+qed
+
+text\<open>Constant Vectors\<close>
+
+definition "vec x = (\<chi> i. x)"
+
+text\<open>Also the scalar-vector multiplication.\<close>
+
+definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70)
+ where "c *s x = (\<chi> i. c * (x$i))"
+
+text \<open>scalar product\<close>
+
+definition scalar_product :: "'a :: semiring_1 ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a" where
+ "scalar_product v w = (\<Sum> i \<in> UNIV. v $ i * w $ i)"
+
+
subsection \<open>Real vector space\<close>
instantiation vec :: (real_vector, finite) real_vector
@@ -543,6 +616,29 @@
unfolding norm_vec_def
by (rule member_le_L2_set) simp_all
+lemma norm_le_componentwise_cart:
+ fixes x :: "'a::real_normed_vector^'n"
+ assumes "\<And>i. norm(x$i) \<le> norm(y$i)"
+ shows "norm x \<le> norm y"
+ unfolding norm_vec_def
+ by (rule L2_set_mono) (auto simp: assms)
+
+lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_zero)
+
+lemma component_le_norm_cart: "\<bar>x$i\<bar> \<le> norm x"
+ apply (simp add: norm_vec_def)
+ apply (rule member_le_L2_set, simp_all)
+ done
+
+lemma norm_bound_component_le_cart: "norm x \<le> e ==> \<bar>x$i\<bar> \<le> e"
+ by (metis component_le_norm_cart order_trans)
+
+lemma norm_bound_component_lt_cart: "norm x < e ==> \<bar>x$i\<bar> < e"
+ by (metis component_le_norm_cart le_less_trans)
+
+lemma norm_le_l1_cart: "norm x \<le> sum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
+ by (simp add: norm_vec_def L2_set_le_sum)
+
lemma bounded_linear_vec_nth: "bounded_linear (\<lambda>x. x $ i)"
apply standard
apply (rule vector_add_component)
@@ -649,6 +745,16 @@
end
+lemma norm_axis_1 [simp]: "norm (axis m (1::real)) = 1"
+ by (simp add: inner_axis' norm_eq_1)
+
+lemma sum_norm_allsubsets_bound_cart:
+ fixes f:: "'a \<Rightarrow> real ^'n"
+ assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (sum f Q) \<le> e"
+ shows "sum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) * e"
+ using sum_norm_allsubsets_bound[OF assms]
+ by simp
+
lemma cart_eq_inner_axis: "a $ i = inner a (axis i 1)"
by (simp add: inner_axis)
@@ -684,4 +790,414 @@
shows "(axis_index (axis u 1 :: real^'n)) = (u::'n)"
by (simp add: axis_eq_axis axis_index_def)
+subsection \<open>A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space\<close>
+
+lemma sum_cong_aux:
+ "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> sum f A = sum g A"
+ by (auto intro: sum.cong)
+
+hide_fact (open) sum_cong_aux
+
+method_setup vector = \<open>
+let
+ val ss1 =
+ simpset_of (put_simpset HOL_basic_ss @{context}
+ addsimps [@{thm sum.distrib} RS sym,
+ @{thm sum_subtractf} RS sym, @{thm sum_distrib_left},
+ @{thm sum_distrib_right}, @{thm sum_negf} RS sym])
+ val ss2 =
+ simpset_of (@{context} addsimps
+ [@{thm plus_vec_def}, @{thm times_vec_def},
+ @{thm minus_vec_def}, @{thm uminus_vec_def},
+ @{thm one_vec_def}, @{thm zero_vec_def}, @{thm vec_def},
+ @{thm scaleR_vec_def},
+ @{thm vec_lambda_beta}, @{thm vector_scalar_mult_def}])
+ fun vector_arith_tac ctxt ths =
+ simp_tac (put_simpset ss1 ctxt)
+ THEN' (fn i => resolve_tac ctxt @{thms Finite_Cartesian_Product.sum_cong_aux} i
+ ORELSE resolve_tac ctxt @{thms sum.neutral} i
+ ORELSE simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm vec_eq_iff}]) i)
+ (* THEN' TRY o clarify_tac HOL_cs THEN' (TRY o rtac @{thm iffI}) *)
+ THEN' asm_full_simp_tac (put_simpset ss2 ctxt addsimps ths)
+in
+ Attrib.thms >> (fn ths => fn ctxt => SIMPLE_METHOD' (vector_arith_tac ctxt ths))
end
+\<close> "lift trivial vector statements to real arith statements"
+
+lemma vec_0[simp]: "vec 0 = 0" by vector
+lemma vec_1[simp]: "vec 1 = 1" by vector
+
+lemma vec_inj[simp]: "vec x = vec y \<longleftrightarrow> x = y" by vector
+
+lemma vec_in_image_vec: "vec x \<in> (vec ` S) \<longleftrightarrow> x \<in> S" by auto
+
+lemma vec_add: "vec(x + y) = vec x + vec y" by vector
+lemma vec_sub: "vec(x - y) = vec x - vec y" by vector
+lemma vec_cmul: "vec(c * x) = c *s vec x " by vector
+lemma vec_neg: "vec(- x) = - vec x " by vector
+
+lemma vec_scaleR: "vec(c * x) = c *\<^sub>R vec x"
+ by vector
+
+lemma vec_sum:
+ assumes "finite S"
+ shows "vec(sum f S) = sum (vec \<circ> f) S"
+ using assms
+proof induct
+ case empty
+ then show ?case by simp
+next
+ case insert
+ then show ?case by (auto simp add: vec_add)
+qed
+
+text\<open>Obvious "component-pushing".\<close>
+
+lemma vec_component [simp]: "vec x $ i = x"
+ by vector
+
+lemma vector_mult_component [simp]: "(x * y)$i = x$i * y$i"
+ by vector
+
+lemma vector_smult_component [simp]: "(c *s y)$i = c * (y$i)"
+ by vector
+
+lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
+
+lemmas vector_component =
+ vec_component vector_add_component vector_mult_component
+ vector_smult_component vector_minus_component vector_uminus_component
+ vector_scaleR_component cond_component
+
+
+subsection \<open>Some frequently useful arithmetic lemmas over vectors\<close>
+
+instance vec :: (semigroup_mult, finite) semigroup_mult
+ by standard (vector mult.assoc)
+
+instance vec :: (monoid_mult, finite) monoid_mult
+ by standard vector+
+
+instance vec :: (ab_semigroup_mult, finite) ab_semigroup_mult
+ by standard (vector mult.commute)
+
+instance vec :: (comm_monoid_mult, finite) comm_monoid_mult
+ by standard vector
+
+instance vec :: (semiring, finite) semiring
+ by standard (vector field_simps)+
+
+instance vec :: (semiring_0, finite) semiring_0
+ by standard (vector field_simps)+
+instance vec :: (semiring_1, finite) semiring_1
+ by standard vector
+instance vec :: (comm_semiring, finite) comm_semiring
+ by standard (vector field_simps)+
+
+instance vec :: (comm_semiring_0, finite) comm_semiring_0 ..
+instance vec :: (semiring_0_cancel, finite) semiring_0_cancel ..
+instance vec :: (comm_semiring_0_cancel, finite) comm_semiring_0_cancel ..
+instance vec :: (ring, finite) ring ..
+instance vec :: (semiring_1_cancel, finite) semiring_1_cancel ..
+instance vec :: (comm_semiring_1, finite) comm_semiring_1 ..
+
+instance vec :: (ring_1, finite) ring_1 ..
+
+instance vec :: (real_algebra, finite) real_algebra
+ by standard (simp_all add: vec_eq_iff)
+
+instance vec :: (real_algebra_1, finite) real_algebra_1 ..
+
+lemma of_nat_index: "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
+proof (induct n)
+ case 0
+ then show ?case by vector
+next
+ case Suc
+ then show ?case by vector
+qed
+
+lemma one_index [simp]: "(1 :: 'a :: one ^ 'n) $ i = 1"
+ by vector
+
+lemma neg_one_index [simp]: "(- 1 :: 'a :: {one, uminus} ^ 'n) $ i = - 1"
+ by vector
+
+instance vec :: (semiring_char_0, finite) semiring_char_0
+proof
+ fix m n :: nat
+ show "inj (of_nat :: nat \<Rightarrow> 'a ^ 'b)"
+ by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
+qed
+
+instance vec :: (numeral, finite) numeral ..
+instance vec :: (semiring_numeral, finite) semiring_numeral ..
+
+lemma numeral_index [simp]: "numeral w $ i = numeral w"
+ by (induct w) (simp_all only: numeral.simps vector_add_component one_index)
+
+lemma neg_numeral_index [simp]: "- numeral w $ i = - numeral w"
+ by (simp only: vector_uminus_component numeral_index)
+
+instance vec :: (comm_ring_1, finite) comm_ring_1 ..
+instance vec :: (ring_char_0, finite) ring_char_0 ..
+
+lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
+ by (vector mult.assoc)
+lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x"
+ by (vector field_simps)
+lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y"
+ by (vector field_simps)
+lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector
+lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector
+lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y"
+ by (vector field_simps)
+lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
+lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
+lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
+lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
+lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
+ by (vector field_simps)
+
+lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)"
+ by (simp add: vec_eq_iff)
+
+lemma Vector_Spaces_linear_vec [simp]: "Vector_Spaces.linear ( * ) vector_scalar_mult vec"
+ by unfold_locales (vector algebra_simps)+
+
+lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
+ by vector
+
+lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::'a::field) \<or> x = y"
+ by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib)
+
+lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::'a::field) = b \<or> x = 0"
+ by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib)
+
+lemma vector_mul_lcancel_imp: "a \<noteq> (0::'a::field) ==> a *s x = a *s y ==> (x = y)"
+ by (metis vector_mul_lcancel)
+
+lemma vector_mul_rcancel_imp: "x \<noteq> 0 \<Longrightarrow> (a::'a::field) *s x = b *s x ==> a = b"
+ by (metis vector_mul_rcancel)
+
+lemma scalar_mult_eq_scaleR [abs_def]: "c *s x = c *\<^sub>R x"
+ unfolding scaleR_vec_def vector_scalar_mult_def by simp
+
+lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y"
+ unfolding dist_norm scalar_mult_eq_scaleR
+ unfolding scaleR_right_diff_distrib[symmetric] by simp
+
+lemma sum_component [simp]:
+ fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n"
+ shows "(sum f S)$i = sum (\<lambda>x. (f x)$i) S"
+proof (cases "finite S")
+ case True
+ then show ?thesis by induct simp_all
+next
+ case False
+ then show ?thesis by simp
+qed
+
+lemma sum_eq: "sum f S = (\<chi> i. sum (\<lambda>x. (f x)$i ) S)"
+ by (simp add: vec_eq_iff)
+
+lemma sum_cmul:
+ fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n"
+ shows "sum (\<lambda>x. c *s f x) S = c *s sum f S"
+ by (simp add: vec_eq_iff sum_distrib_left)
+
+lemma linear_vec [simp]: "linear vec"
+ using Vector_Spaces_linear_vec
+ apply (auto )
+ by unfold_locales (vector algebra_simps)+
+
+subsection \<open>Matrix operations\<close>
+
+text\<open>Matrix notation. NB: an MxN matrix is of type @{typ "'a^'n^'m"}, not @{typ "'a^'m^'n"}\<close>
+
+definition map_matrix::"('a \<Rightarrow> 'b) \<Rightarrow> (('a, 'i::finite)vec, 'j::finite) vec \<Rightarrow> (('b, 'i)vec, 'j) vec" where
+ "map_matrix f x = (\<chi> i j. f (x $ i $ j))"
+
+lemma nth_map_matrix[simp]: "map_matrix f x $ i $ j = f (x $ i $ j)"
+ by (simp add: map_matrix_def)
+
+definition matrix_matrix_mult :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m"
+ (infixl "**" 70)
+ where "m ** m' == (\<chi> i j. sum (\<lambda>k. ((m$i)$k) * ((m'$k)$j)) (UNIV :: 'n set)) ::'a ^ 'p ^'m"
+
+definition matrix_vector_mult :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm"
+ (infixl "*v" 70)
+ where "m *v x \<equiv> (\<chi> i. sum (\<lambda>j. ((m$i)$j) * (x$j)) (UNIV ::'n set)) :: 'a^'m"
+
+definition vector_matrix_mult :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n "
+ (infixl "v*" 70)
+ where "v v* m == (\<chi> j. sum (\<lambda>i. ((m$i)$j) * (v$i)) (UNIV :: 'm set)) :: 'a^'n"
+
+definition "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)"
+definition transpose where
+ "(transpose::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))"
+definition "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))"
+definition "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))"
+definition "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}"
+definition "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}"
+
+lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def)
+lemma matrix_add_ldistrib: "(A ** (B + C)) = (A ** B) + (A ** C)"
+ by (vector matrix_matrix_mult_def sum.distrib[symmetric] field_simps)
+
+lemma matrix_mul_lid [simp]:
+ fixes A :: "'a::semiring_1 ^ 'm ^ 'n"
+ shows "mat 1 ** A = A"
+ apply (simp add: matrix_matrix_mult_def mat_def)
+ apply vector
+ apply (auto simp only: if_distrib if_distribR sum.delta'[OF finite]
+ mult_1_left mult_zero_left if_True UNIV_I)
+ done
+
+lemma matrix_mul_rid [simp]:
+ fixes A :: "'a::semiring_1 ^ 'm ^ 'n"
+ shows "A ** mat 1 = A"
+ apply (simp add: matrix_matrix_mult_def mat_def)
+ apply vector
+ apply (auto simp only: if_distrib if_distribR sum.delta[OF finite]
+ mult_1_right mult_zero_right if_True UNIV_I cong: if_cong)
+ done
+
+lemma matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C"
+ apply (vector matrix_matrix_mult_def sum_distrib_left sum_distrib_right mult.assoc)
+ apply (subst sum.swap)
+ apply simp
+ done
+
+lemma matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x"
+ apply (vector matrix_matrix_mult_def matrix_vector_mult_def
+ sum_distrib_left sum_distrib_right mult.assoc)
+ apply (subst sum.swap)
+ apply simp
+ done
+
+lemma matrix_vector_mul_lid [simp]: "mat 1 *v x = (x::'a::semiring_1 ^ 'n)"
+ apply (vector matrix_vector_mult_def mat_def)
+ apply (simp add: if_distrib if_distribR sum.delta' cong del: if_weak_cong)
+ done
+
+lemma matrix_transpose_mul:
+ "transpose(A ** B) = transpose B ** transpose (A::'a::comm_semiring_1^_^_)"
+ by (simp add: matrix_matrix_mult_def transpose_def vec_eq_iff mult.commute)
+
+lemma matrix_eq:
+ fixes A B :: "'a::semiring_1 ^ 'n ^ 'm"
+ shows "A = B \<longleftrightarrow> (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs")
+ apply auto
+ apply (subst vec_eq_iff)
+ apply clarify
+ apply (clarsimp simp add: matrix_vector_mult_def if_distrib if_distribR vec_eq_iff cong del: if_weak_cong)
+ apply (erule_tac x="axis ia 1" in allE)
+ apply (erule_tac x="i" in allE)
+ apply (auto simp add: if_distrib if_distribR axis_def
+ sum.delta[OF finite] cong del: if_weak_cong)
+ done
+
+lemma matrix_vector_mul_component: "((A::real^_^_) *v x)$k = inner (A$k) x"
+ by (simp add: matrix_vector_mult_def inner_vec_def)
+
+lemma dot_lmul_matrix: "inner ((x::real ^_) v* A) y = inner x (A *v y)"
+ apply (simp add: inner_vec_def matrix_vector_mult_def vector_matrix_mult_def sum_distrib_right sum_distrib_left ac_simps)
+ apply (subst sum.swap)
+ apply simp
+ done
+
+lemma transpose_mat [simp]: "transpose (mat n) = mat n"
+ by (vector transpose_def mat_def)
+
+lemma transpose_transpose [simp]: "transpose(transpose A) = A"
+ by (vector transpose_def)
+
+lemma row_transpose [simp]: "row i (transpose A) = column i A"
+ by (simp add: row_def column_def transpose_def vec_eq_iff)
+
+lemma column_transpose [simp]: "column i (transpose A) = row i A"
+ by (simp add: row_def column_def transpose_def vec_eq_iff)
+
+lemma rows_transpose [simp]: "rows(transpose A) = columns A"
+ by (auto simp add: rows_def columns_def intro: set_eqI)
+
+lemma columns_transpose [simp]: "columns(transpose A) = rows A"
+ by (metis transpose_transpose rows_transpose)
+
+lemma matrix_mult_sum:
+ "(A::'a::comm_semiring_1^'n^'m) *v x = sum (\<lambda>i. (x$i) *s column i A) (UNIV:: 'n set)"
+ by (simp add: matrix_vector_mult_def vec_eq_iff column_def mult.commute)
+
+lemma vector_componentwise:
+ "(x::'a::ring_1^'n) = (\<chi> j. \<Sum>i\<in>UNIV. (x$i) * (axis i 1 :: 'a^'n) $ j)"
+ by (simp add: axis_def if_distrib sum.If_cases vec_eq_iff)
+
+lemma basis_expansion: "sum (\<lambda>i. (x$i) *s axis i 1) UNIV = (x::('a::ring_1) ^'n)"
+ by (auto simp add: axis_def vec_eq_iff if_distrib sum.If_cases cong del: if_weak_cong)
+
+
+text\<open>Correspondence between matrices and linear operators.\<close>
+
+definition matrix :: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n"
+ where "matrix f = (\<chi> i j. (f(axis j 1))$i)"
+
+lemma matrix_id_mat_1: "matrix id = mat 1"
+ by (simp add: mat_def matrix_def axis_def)
+
+lemma matrix_scaleR: "(matrix (( *\<^sub>R) r)) = mat r"
+ by (simp add: mat_def matrix_def axis_def if_distrib cong: if_cong)
+
+lemma matrix_vector_mul_linear[intro, simp]: "linear (\<lambda>x. A *v (x::real ^ _))"
+ by (simp add: linear_iff matrix_vector_mult_def vec_eq_iff
+ field_simps sum_distrib_left sum.distrib)
+
+lemma matrix_vector_mult_add_distrib [algebra_simps]:
+ "A *v (x + y) = A *v x + A *v y"
+ by (vector matrix_vector_mult_def sum.distrib distrib_left)
+
+lemma matrix_vector_mult_diff_distrib [algebra_simps]:
+ fixes A :: "'a::ring_1^'n^'m"
+ shows "A *v (x - y) = A *v x - A *v y"
+ by (vector matrix_vector_mult_def sum_subtractf right_diff_distrib)
+
+lemma matrix_vector_mult_scaleR[algebra_simps]:
+ fixes A :: "real^'n^'m"
+ shows "A *v (c *\<^sub>R x) = c *\<^sub>R (A *v x)"
+ using linear_iff matrix_vector_mul_linear by blast
+
+lemma matrix_vector_mult_0_right [simp]: "A *v 0 = 0"
+ by (simp add: matrix_vector_mult_def vec_eq_iff)
+
+lemma matrix_vector_mult_0 [simp]: "0 *v w = 0"
+ by (simp add: matrix_vector_mult_def vec_eq_iff)
+
+lemma matrix_vector_mult_add_rdistrib [algebra_simps]:
+ "(A + B) *v x = (A *v x) + (B *v x)"
+ by (vector matrix_vector_mult_def sum.distrib distrib_right)
+
+lemma matrix_vector_mult_diff_rdistrib [algebra_simps]:
+ fixes A :: "'a :: ring_1^'n^'m"
+ shows "(A - B) *v x = (A *v x) - (B *v x)"
+ by (vector matrix_vector_mult_def sum_subtractf left_diff_distrib)
+
+lemma matrix_vector_column:
+ "(A::'a::comm_semiring_1^'n^_) *v x = sum (\<lambda>i. (x$i) *s ((transpose A)$i)) (UNIV:: 'n set)"
+ by (simp add: matrix_vector_mult_def transpose_def vec_eq_iff mult.commute)
+
+subsection\<open>Inverse matrices (not necessarily square)\<close>
+
+definition
+ "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
+
+definition
+ "matrix_inv(A:: 'a::semiring_1^'n^'m) =
+ (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
+
+lemma inj_matrix_vector_mult:
+ fixes A::"'a::field^'n^'m"
+ assumes "invertible A"
+ shows "inj (( *v) A)"
+ by (metis assms inj_on_inverseI invertible_def matrix_vector_mul_assoc matrix_vector_mul_lid)
+
+end
--- a/src/HOL/Analysis/Further_Topology.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Further_Topology.thy Wed May 02 13:49:38 2018 +0200
@@ -68,7 +68,7 @@
by (simp add: subspace_orthogonal_to_vectors T'_def)
have dim_eq: "dim T' + dim T = DIM('a)"
using dim_subspace_orthogonal_to_vectors [of T UNIV] \<open>subspace T\<close>
- by (simp add: dim_UNIV T'_def)
+ by (simp add: T'_def)
have "\<exists>v1 v2. v1 \<in> span T \<and> (\<forall>w \<in> span T. orthogonal v2 w) \<and> x = v1 + v2" for x
by (force intro: orthogonal_subspace_decomp_exists [of T x])
then obtain p1 p2 where p1span: "p1 x \<in> span T"
@@ -76,25 +76,35 @@
and eq: "p1 x + p2 x = x" for x
by metis
then have p1: "\<And>z. p1 z \<in> T" and ortho: "\<And>w. w \<in> T \<Longrightarrow> orthogonal (p2 x) w" for x
- using span_eq \<open>subspace T\<close> by blast+
+ using span_eq_iff \<open>subspace T\<close> by blast+
then have p2: "\<And>z. p2 z \<in> T'"
by (simp add: T'_def orthogonal_commute)
have p12_eq: "\<And>x y. \<lbrakk>x \<in> T; y \<in> T'\<rbrakk> \<Longrightarrow> p1(x + y) = x \<and> p2(x + y) = y"
proof (rule orthogonal_subspace_decomp_unique [OF eq p1span, where T=T'])
show "\<And>x y. \<lbrakk>x \<in> T; y \<in> T'\<rbrakk> \<Longrightarrow> p2 (x + y) \<in> span T'"
- using span_eq p2 \<open>subspace T'\<close> by blast
+ using span_eq_iff p2 \<open>subspace T'\<close> by blast
show "\<And>a b. \<lbrakk>a \<in> T; b \<in> T'\<rbrakk> \<Longrightarrow> orthogonal a b"
using T'_def by blast
- qed (auto simp: span_superset)
+ qed (auto simp: span_base)
then have "\<And>c x. p1 (c *\<^sub>R x) = c *\<^sub>R p1 x \<and> p2 (c *\<^sub>R x) = c *\<^sub>R p2 x"
- by (metis eq \<open>subspace T\<close> \<open>subspace T'\<close> p1 p2 scaleR_add_right subspace_mul)
+ proof -
+ fix c :: real and x :: 'a
+ have f1: "c *\<^sub>R x = c *\<^sub>R p1 x + c *\<^sub>R p2 x"
+ by (metis eq pth_6)
+ have f2: "c *\<^sub>R p2 x \<in> T'"
+ by (simp add: \<open>subspace T'\<close> p2 subspace_scale)
+ have "c *\<^sub>R p1 x \<in> T"
+ by (metis (full_types) assms(2) p1span span_eq_iff subspace_scale)
+ then show "p1 (c *\<^sub>R x) = c *\<^sub>R p1 x \<and> p2 (c *\<^sub>R x) = c *\<^sub>R p2 x"
+ using f2 f1 p12_eq by presburger
+ qed
moreover have lin_add: "\<And>x y. p1 (x + y) = p1 x + p1 y \<and> p2 (x + y) = p2 x + p2 y"
proof (rule orthogonal_subspace_decomp_unique [OF _ p1span, where T=T'])
show "\<And>x y. p1 (x + y) + p2 (x + y) = p1 x + p1 y + (p2 x + p2 y)"
by (simp add: add.assoc add.left_commute eq)
show "\<And>a b. \<lbrakk>a \<in> T; b \<in> T'\<rbrakk> \<Longrightarrow> orthogonal a b"
using T'_def by blast
- qed (auto simp: p1span p2 span_superset subspace_add)
+ qed (auto simp: p1span p2 span_base span_add)
ultimately have "linear p1" "linear p2"
by unfold_locales auto
have "(\<lambda>z. g (p1 z)) differentiable_on {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
@@ -263,7 +273,7 @@
show ?thesis
proof (rule that [OF \<open>subspace T\<close>])
show "T \<subseteq> U"
- using span_eq \<open>subspace U\<close> \<open>T \<subseteq> span U\<close> by blast
+ using span_eq_iff \<open>subspace U\<close> \<open>T \<subseteq> span U\<close> by blast
show "aff_dim T = aff_dim S"
using dimT \<open>subspace T\<close> affS aff_dim_subspace by fastforce
show "rel_frontier S homeomorphic sphere 0 1 \<inter> T"
@@ -314,7 +324,7 @@
where "subspace T'" and affT': "aff_dim T' = aff_dim T"
and homT: "rel_frontier T homeomorphic sphere 0 1 \<inter> T'"
apply (rule spheremap_lemma3 [OF \<open>bounded T\<close> \<open>convex T\<close> subspace_UNIV, where 'b='a])
- apply (simp add: dim_UNIV aff_dim_le_DIM)
+ apply (simp add: aff_dim_le_DIM)
using \<open>T \<noteq> {}\<close> by blast
with homeomorphic_imp_homotopy_eqv
have relT: "sphere 0 1 \<inter> T' homotopy_eqv rel_frontier T"
@@ -2003,7 +2013,7 @@
have "U \<subseteq> S"
using ope openin_imp_subset by blast
have "(UNIV::'b set) homeomorphic S"
- by (simp add: \<open>subspace S\<close> dimS dim_UNIV homeomorphic_subspaces)
+ by (simp add: \<open>subspace S\<close> dimS homeomorphic_subspaces)
then obtain h k where homhk: "homeomorphism (UNIV::'b set) S h k"
using homeomorphic_def by blast
have homkh: "homeomorphism S (k ` S) k h"
@@ -2090,7 +2100,7 @@
proof -
obtain V' where "subspace V'" "V' \<subseteq> U" "dim V' = dim V"
using choose_subspace_of_subspace [OF VU]
- by (metis span_eq \<open>subspace U\<close>)
+ by (metis span_eq_iff \<open>subspace U\<close>)
then have "V homeomorphic V'"
by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
then obtain h k where homhk: "homeomorphism V V' h k"
@@ -2136,7 +2146,7 @@
proof -
obtain T where "subspace T" "T \<subseteq> U" "dim T = dim V"
using choose_subspace_of_subspace [of "dim V" U]
- by (metis span_eq \<open>subspace U\<close> \<open>dim V < dim U\<close> linear not_le)
+ by (metis \<open>dim V < dim U\<close> assms(2) order.strict_implies_order span_eq_iff)
then have "V homeomorphic T"
by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
then obtain h k where homhk: "homeomorphism V T h k"
--- a/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy Wed May 02 13:49:38 2018 +0200
@@ -2866,7 +2866,7 @@
then have "?sum b = f b"
using Suc_pred'[OF \<open>p > 0\<close>]
by (simp add: diff_eq_eq Dg_def power_0_left le_Suc_eq if_distrib
- cond_application_beta sum.If_cases f0)
+ if_distribR sum.If_cases f0)
also
have "{..<p} = (\<lambda>x. p - x - 1) ` {..<p}"
proof safe
--- a/src/HOL/Analysis/Homeomorphism.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Homeomorphism.thy Wed May 02 13:49:38 2018 +0200
@@ -941,7 +941,7 @@
apply (rule choose_subspace_of_subspace [of "dim ((+) (- a) ` S)" "{x::'n. i \<bullet> x = 0}"])
apply (simp add: dim_hyperplane [OF \<open>i \<noteq> 0\<close>])
apply (metis DIM_positive Suc_pred dd not_le not_less_eq_eq)
- apply (metis span_eq subspace_hyperplane)
+ apply (metis span_eq_iff subspace_hyperplane)
done
have "subspace (span ((+) (- a) ` S))"
using subspace_span by blast
@@ -956,7 +956,7 @@
have hcont: "continuous_on A h" and kcont: "continuous_on B k" for A B
using \<open>linear h\<close> \<open>linear k\<close> linear_continuous_on linear_conv_bounded_linear by blast+
have ihhhh[simp]: "\<And>x. x \<in> S \<Longrightarrow> i \<bullet> h (x - a) = 0"
- using Tsub [THEN subsetD] heq span_inc by fastforce
+ using Tsub [THEN subsetD] heq span_superset by fastforce
have "sphere 0 1 - {i} homeomorphic {x. i \<bullet> x = 0}"
apply (rule homeomorphic_punctured_sphere_affine)
using i
--- a/src/HOL/Analysis/Inner_Product.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Inner_Product.thy Wed May 02 13:49:38 2018 +0200
@@ -161,6 +161,44 @@
end
+lemma square_bound_lemma:
+ fixes x :: real
+ shows "x < (1 + x) * (1 + x)"
+proof -
+ have "(x + 1/2)\<^sup>2 + 3/4 > 0"
+ using zero_le_power2[of "x+1/2"] by arith
+ then show ?thesis
+ by (simp add: field_simps power2_eq_square)
+qed
+
+lemma square_continuous:
+ fixes e :: real
+ shows "e > 0 \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>y. \<bar>y - x\<bar> < d \<longrightarrow> \<bar>y * y - x * x\<bar> < e)"
+ using isCont_power[OF continuous_ident, of x, unfolded isCont_def LIM_eq, rule_format, of e 2]
+ by (force simp add: power2_eq_square)
+
+lemma norm_eq_0_dot: "norm x = 0 \<longleftrightarrow> inner x x = (0::real)"
+ by simp (* TODO: delete *)
+
+lemma norm_triangle_sub:
+ fixes x y :: "'a::real_normed_vector"
+ shows "norm x \<le> norm y + norm (x - y)"
+ using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps)
+
+lemma norm_le: "norm x \<le> norm y \<longleftrightarrow> inner x x \<le> inner y y"
+ by (simp add: norm_eq_sqrt_inner)
+
+lemma norm_lt: "norm x < norm y \<longleftrightarrow> inner x x < inner y y"
+ by (simp add: norm_eq_sqrt_inner)
+
+lemma norm_eq: "norm x = norm y \<longleftrightarrow> inner x x = inner y y"
+ apply (subst order_eq_iff)
+ apply (auto simp: norm_le)
+ done
+
+lemma norm_eq_1: "norm x = 1 \<longleftrightarrow> inner x x = 1"
+ by (simp add: norm_eq_sqrt_inner)
+
lemma inner_divide_left:
fixes a :: "'a :: {real_inner,real_div_algebra}"
shows "inner (a / of_real m) b = (inner a b) / m"
--- a/src/HOL/Analysis/Linear_Algebra.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Linear_Algebra.thy Wed May 02 13:49:38 2018 +0200
@@ -23,8 +23,8 @@
show "f (a + b) = f a + f b" by (rule f.add)
show "f (a - b) = f a - f b" by (rule f.diff)
show "f 0 = 0" by (rule f.zero)
- show "f (- a) = - f a" by (rule f.minus)
- show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scaleR)
+ show "f (- a) = - f a" by (rule f.neg)
+ show "f (s *\<^sub>R v) = s *\<^sub>R (f v)" by (rule f.scale)
qed
lemma bounded_linearI:
@@ -34,1312 +34,6 @@
shows "bounded_linear f"
using assms by (rule bounded_linear_intro) (* FIXME: duplicate *)
-subsection \<open>A generic notion of "hull" (convex, affine, conic hull and closure).\<close>
-
-definition%important hull :: "('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "hull" 75)
- where "S hull s = \<Inter>{t. S t \<and> s \<subseteq> t}"
-
-lemma hull_same: "S s \<Longrightarrow> S hull s = s"
- unfolding hull_def by auto
-
-lemma hull_in: "(\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)) \<Longrightarrow> S (S hull s)"
- unfolding hull_def Ball_def by auto
-
-lemma hull_eq: "(\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)) \<Longrightarrow> (S hull s) = s \<longleftrightarrow> S s"
- using hull_same[of S s] hull_in[of S s] by metis
-
-lemma hull_hull [simp]: "S hull (S hull s) = S hull s"
- unfolding hull_def by blast
-
-lemma hull_subset[intro]: "s \<subseteq> (S hull s)"
- unfolding hull_def by blast
-
-lemma hull_mono: "s \<subseteq> t \<Longrightarrow> (S hull s) \<subseteq> (S hull t)"
- unfolding hull_def by blast
-
-lemma hull_antimono: "\<forall>x. S x \<longrightarrow> T x \<Longrightarrow> (T hull s) \<subseteq> (S hull s)"
- unfolding hull_def by blast
-
-lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> S t \<Longrightarrow> (S hull s) \<subseteq> t"
- unfolding hull_def by blast
-
-lemma subset_hull: "S t \<Longrightarrow> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
- unfolding hull_def by blast
-
-lemma hull_UNIV [simp]: "S hull UNIV = UNIV"
- unfolding hull_def by auto
-
-lemma hull_unique: "s \<subseteq> t \<Longrightarrow> S t \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> S t' \<Longrightarrow> t \<subseteq> t') \<Longrightarrow> (S hull s = t)"
- unfolding hull_def by auto
-
-lemma hull_induct: "(\<And>x. x\<in> S \<Longrightarrow> P x) \<Longrightarrow> Q {x. P x} \<Longrightarrow> \<forall>x\<in> Q hull S. P x"
- using hull_minimal[of S "{x. P x}" Q]
- by (auto simp add: subset_eq)
-
-lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S"
- by (metis hull_subset subset_eq)
-
-lemma hull_Un_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))"
- unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2)
-
-lemma hull_Un:
- assumes T: "\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)"
- shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)"
- apply (rule equalityI)
- apply (meson hull_mono hull_subset sup.mono)
- by (metis hull_Un_subset hull_hull hull_mono)
-
-lemma hull_Un_left: "P hull (S \<union> T) = P hull (P hull S \<union> T)"
- apply (rule equalityI)
- apply (simp add: Un_commute hull_mono hull_subset sup.coboundedI2)
- by (metis Un_subset_iff hull_hull hull_mono hull_subset)
-
-lemma hull_Un_right: "P hull (S \<union> T) = P hull (S \<union> P hull T)"
- by (metis hull_Un_left sup.commute)
-
-lemma hull_insert:
- "P hull (insert a S) = P hull (insert a (P hull S))"
- by (metis hull_Un_right insert_is_Un)
-
-lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> S hull (insert a s) = S hull s"
- unfolding hull_def by blast
-
-lemma hull_redundant: "a \<in> (S hull s) \<Longrightarrow> S hull (insert a s) = S hull s"
- by (metis hull_redundant_eq)
-
-subsection \<open>Linear functions.\<close>
-
-lemma%important linear_iff:
- "linear f \<longleftrightarrow> (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (c *\<^sub>R x) = c *\<^sub>R f x)"
- (is "linear f \<longleftrightarrow> ?rhs")
-proof%unimportant
- assume "linear f"
- then interpret f: linear f .
- show "?rhs" by (simp add: f.add f.scaleR)
-next
- assume "?rhs"
- then show "linear f" by unfold_locales simp_all
-qed
-
-lemma linear_compose_cmul: "linear f \<Longrightarrow> linear (\<lambda>x. c *\<^sub>R f x)"
- by (simp add: linear_iff algebra_simps)
-
-lemma linear_compose_scaleR: "linear f \<Longrightarrow> linear (\<lambda>x. f x *\<^sub>R c)"
- by (simp add: linear_iff scaleR_add_left)
-
-lemma linear_compose_neg: "linear f \<Longrightarrow> linear (\<lambda>x. - f x)"
- by (simp add: linear_iff)
-
-lemma linear_compose_add: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (\<lambda>x. f x + g x)"
- by (simp add: linear_iff algebra_simps)
-
-lemma linear_compose_sub: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (\<lambda>x. f x - g x)"
- by (simp add: linear_iff algebra_simps)
-
-lemma linear_compose: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (g \<circ> f)"
- by (simp add: linear_iff)
-
-lemma linear_id: "linear id"
- by (simp add: linear_iff id_def)
-
-lemma linear_zero: "linear (\<lambda>x. 0)"
- by (simp add: linear_iff)
-
-lemma linear_uminus: "linear uminus"
-by (simp add: linear_iff)
-
-lemma linear_compose_sum:
- assumes lS: "\<forall>a \<in> S. linear (f a)"
- shows "linear (\<lambda>x. sum (\<lambda>a. f a x) S)"
-proof (cases "finite S")
- case True
- then show ?thesis
- using lS by induct (simp_all add: linear_zero linear_compose_add)
-next
- case False
- then show ?thesis
- by (simp add: linear_zero)
-qed
-
-lemma linear_0: "linear f \<Longrightarrow> f 0 = 0"
- unfolding linear_iff
- apply clarsimp
- apply (erule allE[where x="0::'a"])
- apply simp
- done
-
-lemma linear_cmul: "linear f \<Longrightarrow> f (c *\<^sub>R x) = c *\<^sub>R f x"
- by (rule linear.scaleR)
-
-lemma linear_neg: "linear f \<Longrightarrow> f (- x) = - f x"
- using linear_cmul [where c="-1"] by simp
-
-lemma linear_add: "linear f \<Longrightarrow> f (x + y) = f x + f y"
- by (metis linear_iff)
-
-lemma linear_diff: "linear f \<Longrightarrow> f (x - y) = f x - f y"
- using linear_add [of f x "- y"] by (simp add: linear_neg)
-
-lemma linear_sum:
- assumes f: "linear f"
- shows "f (sum g S) = sum (f \<circ> g) S"
-proof (cases "finite S")
- case True
- then show ?thesis
- by induct (simp_all add: linear_0 [OF f] linear_add [OF f])
-next
- case False
- then show ?thesis
- by (simp add: linear_0 [OF f])
-qed
-
-lemma linear_sum_mul:
- assumes lin: "linear f"
- shows "f (sum (\<lambda>i. c i *\<^sub>R v i) S) = sum (\<lambda>i. c i *\<^sub>R f (v i)) S"
- using linear_sum[OF lin, of "\<lambda>i. c i *\<^sub>R v i" , unfolded o_def] linear_cmul[OF lin]
- by simp
-
-lemma linear_injective_0:
- assumes lin: "linear f"
- shows "inj f \<longleftrightarrow> (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
-proof -
- have "inj f \<longleftrightarrow> (\<forall> x y. f x = f y \<longrightarrow> x = y)"
- by (simp add: inj_on_def)
- also have "\<dots> \<longleftrightarrow> (\<forall> x y. f x - f y = 0 \<longrightarrow> x - y = 0)"
- by simp
- also have "\<dots> \<longleftrightarrow> (\<forall> x y. f (x - y) = 0 \<longrightarrow> x - y = 0)"
- by (simp add: linear_diff[OF lin])
- also have "\<dots> \<longleftrightarrow> (\<forall> x. f x = 0 \<longrightarrow> x = 0)"
- by auto
- finally show ?thesis .
-qed
-
-lemma linear_scaleR [simp]: "linear (\<lambda>x. scaleR c x)"
- by (simp add: linear_iff scaleR_add_right)
-
-lemma linear_scaleR_left [simp]: "linear (\<lambda>r. scaleR r x)"
- by (simp add: linear_iff scaleR_add_left)
-
-lemma injective_scaleR: "c \<noteq> 0 \<Longrightarrow> inj (\<lambda>x::'a::real_vector. scaleR c x)"
- by (simp add: inj_on_def)
-
-lemma linear_add_cmul:
- assumes "linear f"
- shows "f (a *\<^sub>R x + b *\<^sub>R y) = a *\<^sub>R f x + b *\<^sub>R f y"
- using linear_add[of f] linear_cmul[of f] assms by simp
-
-subsection \<open>Subspaces of vector spaces\<close>
-
-definition%important (in real_vector) subspace :: "'a set \<Rightarrow> bool"
- where "subspace S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>x \<in> S. \<forall>y \<in> S. x + y \<in> S) \<and> (\<forall>c. \<forall>x \<in> S. c *\<^sub>R x \<in> S)"
-
-definition%important (in real_vector) "span S = (subspace hull S)"
-definition%important (in real_vector) "dependent S \<longleftrightarrow> (\<exists>a \<in> S. a \<in> span (S - {a}))"
-abbreviation (in real_vector) "independent s \<equiv> \<not> dependent s"
-
-text \<open>Closure properties of subspaces.\<close>
-
-lemma subspace_UNIV[simp]: "subspace UNIV"
- by (simp add: subspace_def)
-
-lemma (in real_vector) subspace_0: "subspace S \<Longrightarrow> 0 \<in> S"
- by (metis subspace_def)
-
-lemma (in real_vector) subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x + y \<in> S"
- by (metis subspace_def)
-
-lemma (in real_vector) subspace_mul: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *\<^sub>R x \<in> S"
- by (metis subspace_def)
-
-lemma subspace_neg: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> - x \<in> S"
- by (metis scaleR_minus1_left subspace_mul)
-
-lemma subspace_diff: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
- using subspace_add [of S x "- y"] by (simp add: subspace_neg)
-
-lemma (in real_vector) subspace_sum:
- assumes sA: "subspace A"
- and f: "\<And>x. x \<in> B \<Longrightarrow> f x \<in> A"
- shows "sum f B \<in> A"
-proof (cases "finite B")
- case True
- then show ?thesis
- using f by induct (simp_all add: subspace_0 [OF sA] subspace_add [OF sA])
-qed (simp add: subspace_0 [OF sA])
-
-lemma subspace_trivial [iff]: "subspace {0}"
- by (simp add: subspace_def)
-
-lemma (in real_vector) subspace_inter: "subspace A \<Longrightarrow> subspace B \<Longrightarrow> subspace (A \<inter> B)"
- by (simp add: subspace_def)
-
-lemma subspace_Times: "subspace A \<Longrightarrow> subspace B \<Longrightarrow> subspace (A \<times> B)"
- unfolding subspace_def zero_prod_def by simp
-
-lemma subspace_sums: "\<lbrakk>subspace S; subspace T\<rbrakk> \<Longrightarrow> subspace {x + y|x y. x \<in> S \<and> y \<in> T}"
-apply (simp add: subspace_def)
-apply (intro conjI impI allI)
- using add.right_neutral apply blast
- apply clarify
- apply (metis add.assoc add.left_commute)
-using scaleR_add_right by blast
-
-subsection%unimportant \<open>Properties of span\<close>
-
-lemma (in real_vector) span_mono: "A \<subseteq> B \<Longrightarrow> span A \<subseteq> span B"
- by (metis span_def hull_mono)
-
-lemma (in real_vector) subspace_span [iff]: "subspace (span S)"
- unfolding span_def
- apply (rule hull_in)
- apply (simp only: subspace_def Inter_iff Int_iff subset_eq)
- apply auto
- done
-
-lemma (in real_vector) span_clauses:
- "a \<in> S \<Longrightarrow> a \<in> span S"
- "0 \<in> span S"
- "x\<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x + y \<in> span S"
- "x \<in> span S \<Longrightarrow> c *\<^sub>R x \<in> span S"
- by (metis span_def hull_subset subset_eq) (metis subspace_span subspace_def)+
-
-lemma span_unique:
- "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> (\<And>T'. S \<subseteq> T' \<Longrightarrow> subspace T' \<Longrightarrow> T \<subseteq> T') \<Longrightarrow> span S = T"
- unfolding span_def by (rule hull_unique)
-
-lemma span_minimal: "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> span S \<subseteq> T"
- unfolding span_def by (rule hull_minimal)
-
-lemma span_UNIV [simp]: "span UNIV = UNIV"
- by (intro span_unique) auto
-
-lemma (in real_vector) span_induct:
- assumes x: "x \<in> span S"
- and P: "subspace (Collect P)"
- and SP: "\<And>x. x \<in> S \<Longrightarrow> P x"
- shows "P x"
-proof -
- from SP have SP': "S \<subseteq> Collect P"
- by (simp add: subset_eq)
- from x hull_minimal[where S=subspace, OF SP' P, unfolded span_def[symmetric]]
- show ?thesis
- using subset_eq by force
-qed
-
-lemma span_empty[simp]: "span {} = {0}"
- apply (simp add: span_def)
- apply (rule hull_unique)
- apply (auto simp add: subspace_def)
- done
-
-lemma (in real_vector) independent_empty [iff]: "independent {}"
- by (simp add: dependent_def)
-
-lemma dependent_single[simp]: "dependent {x} \<longleftrightarrow> x = 0"
- unfolding dependent_def by auto
-
-lemma (in real_vector) independent_mono: "independent A \<Longrightarrow> B \<subseteq> A \<Longrightarrow> independent B"
- apply (clarsimp simp add: dependent_def span_mono)
- apply (subgoal_tac "span (B - {a}) \<le> span (A - {a})")
- apply force
- apply (rule span_mono)
- apply auto
- done
-
-lemma (in real_vector) span_subspace: "A \<subseteq> B \<Longrightarrow> B \<le> span A \<Longrightarrow> subspace B \<Longrightarrow> span A = B"
- by (metis order_antisym span_def hull_minimal)
-
-lemma (in real_vector) span_induct':
- "\<forall>x \<in> S. P x \<Longrightarrow> subspace {x. P x} \<Longrightarrow> \<forall>x \<in> span S. P x"
- unfolding span_def by (rule hull_induct) auto
-
-inductive_set (in real_vector) span_induct_alt_help for S :: "'a set"
-where
- span_induct_alt_help_0: "0 \<in> span_induct_alt_help S"
-| span_induct_alt_help_S:
- "x \<in> S \<Longrightarrow> z \<in> span_induct_alt_help S \<Longrightarrow>
- (c *\<^sub>R x + z) \<in> span_induct_alt_help S"
-
-lemma span_induct_alt':
- assumes h0: "h 0"
- and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c *\<^sub>R x + y)"
- shows "\<forall>x \<in> span S. h x"
-proof -
- {
- fix x :: 'a
- assume x: "x \<in> span_induct_alt_help S"
- have "h x"
- apply (rule span_induct_alt_help.induct[OF x])
- apply (rule h0)
- apply (rule hS)
- apply assumption
- apply assumption
- done
- }
- note th0 = this
- {
- fix x
- assume x: "x \<in> span S"
- have "x \<in> span_induct_alt_help S"
- proof (rule span_induct[where x=x and S=S])
- show "x \<in> span S" by (rule x)
- next
- fix x
- assume xS: "x \<in> S"
- from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1]
- show "x \<in> span_induct_alt_help S"
- by simp
- next
- have "0 \<in> span_induct_alt_help S" by (rule span_induct_alt_help_0)
- moreover
- {
- fix x y
- assume h: "x \<in> span_induct_alt_help S" "y \<in> span_induct_alt_help S"
- from h have "(x + y) \<in> span_induct_alt_help S"
- apply (induct rule: span_induct_alt_help.induct)
- apply simp
- unfolding add.assoc
- apply (rule span_induct_alt_help_S)
- apply assumption
- apply simp
- done
- }
- moreover
- {
- fix c x
- assume xt: "x \<in> span_induct_alt_help S"
- then have "(c *\<^sub>R x) \<in> span_induct_alt_help S"
- apply (induct rule: span_induct_alt_help.induct)
- apply (simp add: span_induct_alt_help_0)
- apply (simp add: scaleR_right_distrib)
- apply (rule span_induct_alt_help_S)
- apply assumption
- apply simp
- done }
- ultimately show "subspace {a. a \<in> span_induct_alt_help S}"
- unfolding subspace_def Ball_def by blast
- qed
- }
- with th0 show ?thesis by blast
-qed
-
-lemma span_induct_alt:
- assumes h0: "h 0"
- and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c *\<^sub>R x + y)"
- and x: "x \<in> span S"
- shows "h x"
- using span_induct_alt'[of h S] h0 hS x by blast
-
-text \<open>Individual closure properties.\<close>
-
-lemma span_span: "span (span A) = span A"
- unfolding span_def hull_hull ..
-
-lemma (in real_vector) span_superset: "x \<in> S \<Longrightarrow> x \<in> span S"
- by (metis span_clauses(1))
-
-lemma (in real_vector) span_0 [simp]: "0 \<in> span S"
- by (metis subspace_span subspace_0)
-
-lemma span_inc: "S \<subseteq> span S"
- by (metis subset_eq span_superset)
-
-lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
- using span_inc[unfolded subset_eq] using span_mono[of T "span S"] span_mono[of S "span T"]
- by (auto simp add: span_span)
-
-lemma (in real_vector) dependent_0:
- assumes "0 \<in> A"
- shows "dependent A"
- unfolding dependent_def
- using assms span_0
- by blast
-
-lemma (in real_vector) span_add: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x + y \<in> span S"
- by (metis subspace_add subspace_span)
-
-lemma (in real_vector) span_mul: "x \<in> span S \<Longrightarrow> c *\<^sub>R x \<in> span S"
- by (metis subspace_span subspace_mul)
-
-lemma span_neg: "x \<in> span S \<Longrightarrow> - x \<in> span S"
- by (metis subspace_neg subspace_span)
-
-lemma span_diff: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x - y \<in> span S"
- by (metis subspace_span subspace_diff)
-
-lemma (in real_vector) span_sum: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> span S) \<Longrightarrow> sum f A \<in> span S"
- by (rule subspace_sum [OF subspace_span])
-
-lemma span_add_eq: "x \<in> span S \<Longrightarrow> x + y \<in> span S \<longleftrightarrow> y \<in> span S"
- by (metis add_minus_cancel scaleR_minus1_left subspace_def subspace_span)
-
-text \<open>The key breakdown property.\<close>
-
-lemma span_singleton: "span {x} = range (\<lambda>k. k *\<^sub>R x)"
-proof (rule span_unique)
- show "{x} \<subseteq> range (\<lambda>k. k *\<^sub>R x)"
- by (fast intro: scaleR_one [symmetric])
- show "subspace (range (\<lambda>k. k *\<^sub>R x))"
- unfolding subspace_def
- by (auto intro: scaleR_add_left [symmetric])
-next
- fix T
- assume "{x} \<subseteq> T" and "subspace T"
- then show "range (\<lambda>k. k *\<^sub>R x) \<subseteq> T"
- unfolding subspace_def by auto
-qed
-
-text \<open>Mapping under linear image.\<close>
-
-lemma subspace_linear_image:
- assumes lf: "linear f"
- and sS: "subspace S"
- shows "subspace (f ` S)"
- using lf sS linear_0[OF lf]
- unfolding linear_iff subspace_def
- apply (auto simp add: image_iff)
- apply (rule_tac x="x + y" in bexI)
- apply auto
- apply (rule_tac x="c *\<^sub>R x" in bexI)
- apply auto
- done
-
-lemma subspace_linear_vimage: "linear f \<Longrightarrow> subspace S \<Longrightarrow> subspace (f -` S)"
- by (auto simp add: subspace_def linear_iff linear_0[of f])
-
-lemma subspace_linear_preimage: "linear f \<Longrightarrow> subspace S \<Longrightarrow> subspace {x. f x \<in> S}"
- by (auto simp add: subspace_def linear_iff linear_0[of f])
-
-lemma span_linear_image:
- assumes lf: "linear f"
- shows "span (f ` S) = f ` span S"
-proof (rule span_unique)
- show "f ` S \<subseteq> f ` span S"
- by (intro image_mono span_inc)
- show "subspace (f ` span S)"
- using lf subspace_span by (rule subspace_linear_image)
-next
- fix T
- assume "f ` S \<subseteq> T" and "subspace T"
- then show "f ` span S \<subseteq> T"
- unfolding image_subset_iff_subset_vimage
- by (intro span_minimal subspace_linear_vimage lf)
-qed
-
-lemma spans_image:
- assumes lf: "linear f"
- and VB: "V \<subseteq> span B"
- shows "f ` V \<subseteq> span (f ` B)"
- unfolding span_linear_image[OF lf] by (metis VB image_mono)
-
-lemma span_Un: "span (A \<union> B) = (\<lambda>(a, b). a + b) ` (span A \<times> span B)"
-proof (rule span_unique)
- show "A \<union> B \<subseteq> (\<lambda>(a, b). a + b) ` (span A \<times> span B)"
- by safe (force intro: span_clauses)+
-next
- have "linear (\<lambda>(a, b). a + b)"
- by (simp add: linear_iff scaleR_add_right)
- moreover have "subspace (span A \<times> span B)"
- by (intro subspace_Times subspace_span)
- ultimately show "subspace ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
- by (rule subspace_linear_image)
-next
- fix T
- assume "A \<union> B \<subseteq> T" and "subspace T"
- then show "(\<lambda>(a, b). a + b) ` (span A \<times> span B) \<subseteq> T"
- by (auto intro!: subspace_add elim: span_induct)
-qed
-
-lemma span_insert: "span (insert a S) = {x. \<exists>k. (x - k *\<^sub>R a) \<in> span S}"
-proof -
- have "span ({a} \<union> S) = {x. \<exists>k. (x - k *\<^sub>R a) \<in> span S}"
- unfolding span_Un span_singleton
- apply safe
- apply (rule_tac x=k in exI, simp)
- apply (erule rev_image_eqI [OF SigmaI [OF rangeI]])
- apply auto
- done
- then show ?thesis by simp
-qed
-
-lemma span_breakdown:
- assumes bS: "b \<in> S"
- and aS: "a \<in> span S"
- shows "\<exists>k. a - k *\<^sub>R b \<in> span (S - {b})"
- using assms span_insert [of b "S - {b}"]
- by (simp add: insert_absorb)
-
-lemma span_breakdown_eq: "x \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. x - k *\<^sub>R a \<in> span S)"
- by (simp add: span_insert)
-
-text \<open>Hence some "reversal" results.\<close>
-
-lemma in_span_insert:
- assumes a: "a \<in> span (insert b S)"
- and na: "a \<notin> span S"
- shows "b \<in> span (insert a S)"
-proof -
- from a obtain k where k: "a - k *\<^sub>R b \<in> span S"
- unfolding span_insert by fast
- show ?thesis
- proof (cases "k = 0")
- case True
- with k have "a \<in> span S" by simp
- with na show ?thesis by simp
- next
- case False
- from k have "(- inverse k) *\<^sub>R (a - k *\<^sub>R b) \<in> span S"
- by (rule span_mul)
- then have "b - inverse k *\<^sub>R a \<in> span S"
- using \<open>k \<noteq> 0\<close> by (simp add: scaleR_diff_right)
- then show ?thesis
- unfolding span_insert by fast
- qed
-qed
-
-lemma in_span_delete:
- assumes a: "a \<in> span S"
- and na: "a \<notin> span (S - {b})"
- shows "b \<in> span (insert a (S - {b}))"
- apply (rule in_span_insert)
- apply (rule set_rev_mp)
- apply (rule a)
- apply (rule span_mono)
- apply blast
- apply (rule na)
- done
-
-text \<open>Transitivity property.\<close>
-
-lemma span_redundant: "x \<in> span S \<Longrightarrow> span (insert x S) = span S"
- unfolding span_def by (rule hull_redundant)
-
-lemma span_trans:
- assumes x: "x \<in> span S"
- and y: "y \<in> span (insert x S)"
- shows "y \<in> span S"
- using assms by (simp only: span_redundant)
-
-lemma span_insert_0[simp]: "span (insert 0 S) = span S"
- by (simp only: span_redundant span_0)
-
-text \<open>An explicit expansion is sometimes needed.\<close>
-
-lemma span_explicit:
- "span P = {y. \<exists>S u. finite S \<and> S \<subseteq> P \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
- (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \<exists>S u. ?Q S u y}")
-proof -
- {
- fix x
- assume "?h x"
- then obtain S u where "finite S" and "S \<subseteq> P" and "sum (\<lambda>v. u v *\<^sub>R v) S = x"
- by blast
- then have "x \<in> span P"
- by (auto intro: span_sum span_mul span_superset)
- }
- moreover
- have "\<forall>x \<in> span P. ?h x"
- proof (rule span_induct_alt')
- show "?h 0"
- by (rule exI[where x="{}"], simp)
- next
- fix c x y
- assume x: "x \<in> P"
- assume hy: "?h y"
- from hy obtain S u where fS: "finite S" and SP: "S\<subseteq>P"
- and u: "sum (\<lambda>v. u v *\<^sub>R v) S = y" by blast
- let ?S = "insert x S"
- let ?u = "\<lambda>y. if y = x then (if x \<in> S then u y + c else c) else u y"
- from fS SP x have th0: "finite (insert x S)" "insert x S \<subseteq> P"
- by blast+
- have "?Q ?S ?u (c*\<^sub>R x + y)"
- proof cases
- assume xS: "x \<in> S"
- have "sum (\<lambda>v. ?u v *\<^sub>R v) ?S = (\<Sum>v\<in>S - {x}. u v *\<^sub>R v) + (u x + c) *\<^sub>R x"
- using xS by (simp add: sum.remove [OF fS xS] insert_absorb)
- also have "\<dots> = (\<Sum>v\<in>S. u v *\<^sub>R v) + c *\<^sub>R x"
- by (simp add: sum.remove [OF fS xS] algebra_simps)
- also have "\<dots> = c*\<^sub>R x + y"
- by (simp add: add.commute u)
- finally have "sum (\<lambda>v. ?u v *\<^sub>R v) ?S = c*\<^sub>R x + y" .
- then show ?thesis using th0 by blast
- next
- assume xS: "x \<notin> S"
- have th00: "(\<Sum>v\<in>S. (if v = x then c else u v) *\<^sub>R v) = y"
- unfolding u[symmetric]
- apply (rule sum.cong)
- using xS
- apply auto
- done
- show ?thesis using fS xS th0
- by (simp add: th00 add.commute cong del: if_weak_cong)
- qed
- then show "?h (c*\<^sub>R x + y)"
- by fast
- qed
- ultimately show ?thesis by blast
-qed
-
-lemma dependent_explicit:
- "dependent P \<longleftrightarrow> (\<exists>S u. finite S \<and> S \<subseteq> P \<and> (\<exists>v\<in>S. u v \<noteq> 0 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0))"
- (is "?lhs = ?rhs")
-proof -
- {
- assume dP: "dependent P"
- then obtain a S u where aP: "a \<in> P" and fS: "finite S"
- and SP: "S \<subseteq> P - {a}" and ua: "sum (\<lambda>v. u v *\<^sub>R v) S = a"
- unfolding dependent_def span_explicit by blast
- let ?S = "insert a S"
- let ?u = "\<lambda>y. if y = a then - 1 else u y"
- let ?v = a
- from aP SP have aS: "a \<notin> S"
- by blast
- from fS SP aP have th0: "finite ?S" "?S \<subseteq> P" "?v \<in> ?S" "?u ?v \<noteq> 0"
- by auto
- have s0: "sum (\<lambda>v. ?u v *\<^sub>R v) ?S = 0"
- using fS aS
- apply simp
- apply (subst (2) ua[symmetric])
- apply (rule sum.cong)
- apply auto
- done
- with th0 have ?rhs by fast
- }
- moreover
- {
- fix S u v
- assume fS: "finite S"
- and SP: "S \<subseteq> P"
- and vS: "v \<in> S"
- and uv: "u v \<noteq> 0"
- and u: "sum (\<lambda>v. u v *\<^sub>R v) S = 0"
- let ?a = v
- let ?S = "S - {v}"
- let ?u = "\<lambda>i. (- u i) / u v"
- have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P"
- using fS SP vS by auto
- have "sum (\<lambda>v. ?u v *\<^sub>R v) ?S =
- sum (\<lambda>v. (- (inverse (u ?a))) *\<^sub>R (u v *\<^sub>R v)) S - ?u v *\<^sub>R v"
- using fS vS uv by (simp add: sum_diff1 field_simps)
- also have "\<dots> = ?a"
- unfolding scaleR_right.sum [symmetric] u using uv by simp
- finally have "sum (\<lambda>v. ?u v *\<^sub>R v) ?S = ?a" .
- with th0 have ?lhs
- unfolding dependent_def span_explicit
- apply -
- apply (rule bexI[where x= "?a"])
- apply (simp_all del: scaleR_minus_left)
- apply (rule exI[where x= "?S"])
- apply (auto simp del: scaleR_minus_left)
- done
- }
- ultimately show ?thesis by blast
-qed
-
-lemma dependent_finite:
- assumes "finite S"
- shows "dependent S \<longleftrightarrow> (\<exists>u. (\<exists>v \<in> S. u v \<noteq> 0) \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = 0)"
- (is "?lhs = ?rhs")
-proof
- assume ?lhs
- then obtain T u v
- where "finite T" "T \<subseteq> S" "v\<in>T" "u v \<noteq> 0" "(\<Sum>v\<in>T. u v *\<^sub>R v) = 0"
- by (force simp: dependent_explicit)
- with assms show ?rhs
- apply (rule_tac x="\<lambda>v. if v \<in> T then u v else 0" in exI)
- apply (auto simp: sum.mono_neutral_right)
- done
-next
- assume ?rhs with assms show ?lhs
- by (fastforce simp add: dependent_explicit)
-qed
-
-lemma span_alt:
- "span B = {(\<Sum>x | f x \<noteq> 0. f x *\<^sub>R x) | f. {x. f x \<noteq> 0} \<subseteq> B \<and> finite {x. f x \<noteq> 0}}"
- unfolding span_explicit
- apply safe
- subgoal for x S u
- by (intro exI[of _ "\<lambda>x. if x \<in> S then u x else 0"])
- (auto intro!: sum.mono_neutral_cong_right)
- apply auto
- done
-
-lemma dependent_alt:
- "dependent B \<longleftrightarrow>
- (\<exists>X. finite {x. X x \<noteq> 0} \<and> {x. X x \<noteq> 0} \<subseteq> B \<and> (\<Sum>x|X x \<noteq> 0. X x *\<^sub>R x) = 0 \<and> (\<exists>x. X x \<noteq> 0))"
- unfolding dependent_explicit
- apply safe
- subgoal for S u v
- apply (intro exI[of _ "\<lambda>x. if x \<in> S then u x else 0"])
- apply (subst sum.mono_neutral_cong_left[where T=S])
- apply (auto intro!: sum.mono_neutral_cong_right cong: rev_conj_cong)
- done
- apply auto
- done
-
-lemma independent_alt:
- "independent B \<longleftrightarrow>
- (\<forall>X. finite {x. X x \<noteq> 0} \<longrightarrow> {x. X x \<noteq> 0} \<subseteq> B \<longrightarrow> (\<Sum>x|X x \<noteq> 0. X x *\<^sub>R x) = 0 \<longrightarrow> (\<forall>x. X x = 0))"
- unfolding dependent_alt by auto
-
-lemma independentD_alt:
- "independent B \<Longrightarrow> finite {x. X x \<noteq> 0} \<Longrightarrow> {x. X x \<noteq> 0} \<subseteq> B \<Longrightarrow> (\<Sum>x|X x \<noteq> 0. X x *\<^sub>R x) = 0 \<Longrightarrow> X x = 0"
- unfolding independent_alt by blast
-
-lemma independentD_unique:
- assumes B: "independent B"
- and X: "finite {x. X x \<noteq> 0}" "{x. X x \<noteq> 0} \<subseteq> B"
- and Y: "finite {x. Y x \<noteq> 0}" "{x. Y x \<noteq> 0} \<subseteq> B"
- and "(\<Sum>x | X x \<noteq> 0. X x *\<^sub>R x) = (\<Sum>x| Y x \<noteq> 0. Y x *\<^sub>R x)"
- shows "X = Y"
-proof -
- have "X x - Y x = 0" for x
- using B
- proof (rule independentD_alt)
- have "{x. X x - Y x \<noteq> 0} \<subseteq> {x. X x \<noteq> 0} \<union> {x. Y x \<noteq> 0}"
- by auto
- then show "finite {x. X x - Y x \<noteq> 0}" "{x. X x - Y x \<noteq> 0} \<subseteq> B"
- using X Y by (auto dest: finite_subset)
- then have "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *\<^sub>R x) = (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. (X v - Y v) *\<^sub>R v)"
- using X Y by (intro sum.mono_neutral_cong_left) auto
- also have "\<dots> = (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. X v *\<^sub>R v) - (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. Y v *\<^sub>R v)"
- by (simp add: scaleR_diff_left sum_subtractf assms)
- also have "(\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. X v *\<^sub>R v) = (\<Sum>v\<in>{S. X S \<noteq> 0}. X v *\<^sub>R v)"
- using X Y by (intro sum.mono_neutral_cong_right) auto
- also have "(\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. Y v *\<^sub>R v) = (\<Sum>v\<in>{S. Y S \<noteq> 0}. Y v *\<^sub>R v)"
- using X Y by (intro sum.mono_neutral_cong_right) auto
- finally show "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *\<^sub>R x) = 0"
- using assms by simp
- qed
- then show ?thesis
- by auto
-qed
-
-text \<open>This is useful for building a basis step-by-step.\<close>
-
-lemma independent_insert:
- "independent (insert a S) \<longleftrightarrow>
- (if a \<in> S then independent S else independent S \<and> a \<notin> span S)"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof (cases "a \<in> S")
- case True
- then show ?thesis
- using insert_absorb[OF True] by simp
-next
- case False
- show ?thesis
- proof
- assume i: ?lhs
- then show ?rhs
- using False
- apply simp
- apply (rule conjI)
- apply (rule independent_mono)
- apply assumption
- apply blast
- apply (simp add: dependent_def)
- done
- next
- assume i: ?rhs
- show ?lhs
- using i False
- apply (auto simp add: dependent_def)
- by (metis in_span_insert insert_Diff_if insert_Diff_single insert_absorb)
- qed
-qed
-
-lemma independent_Union_directed:
- assumes directed: "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
- assumes indep: "\<And>c. c \<in> C \<Longrightarrow> independent c"
- shows "independent (\<Union>C)"
-proof
- assume "dependent (\<Union>C)"
- then obtain u v S where S: "finite S" "S \<subseteq> \<Union>C" "v \<in> S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
- by (auto simp: dependent_explicit)
-
- have "S \<noteq> {}"
- using \<open>v \<in> S\<close> by auto
- have "\<exists>c\<in>C. S \<subseteq> c"
- using \<open>finite S\<close> \<open>S \<noteq> {}\<close> \<open>S \<subseteq> \<Union>C\<close>
- proof (induction rule: finite_ne_induct)
- case (insert i I)
- then obtain c d where cd: "c \<in> C" "d \<in> C" and iI: "I \<subseteq> c" "i \<in> d"
- by blast
- from directed[OF cd] cd have "c \<union> d \<in> C"
- by (auto simp: sup.absorb1 sup.absorb2)
- with iI show ?case
- by (intro bexI[of _ "c \<union> d"]) auto
- qed auto
- then obtain c where "c \<in> C" "S \<subseteq> c"
- by auto
- have "dependent c"
- unfolding dependent_explicit
- by (intro exI[of _ S] exI[of _ u] bexI[of _ v] conjI) fact+
- with indep[OF \<open>c \<in> C\<close>] show False
- by auto
-qed
-
-text \<open>Hence we can create a maximal independent subset.\<close>
-
-lemma maximal_independent_subset_extend:
- assumes "S \<subseteq> V" "independent S"
- shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
-proof -
- let ?C = "{B. S \<subseteq> B \<and> independent B \<and> B \<subseteq> V}"
- have "\<exists>M\<in>?C. \<forall>X\<in>?C. M \<subseteq> X \<longrightarrow> X = M"
- proof (rule subset_Zorn)
- fix C :: "'a set set" assume "subset.chain ?C C"
- then have C: "\<And>c. c \<in> C \<Longrightarrow> c \<subseteq> V" "\<And>c. c \<in> C \<Longrightarrow> S \<subseteq> c" "\<And>c. c \<in> C \<Longrightarrow> independent c"
- "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
- unfolding subset.chain_def by blast+
-
- show "\<exists>U\<in>?C. \<forall>X\<in>C. X \<subseteq> U"
- proof cases
- assume "C = {}" with assms show ?thesis
- by (auto intro!: exI[of _ S])
- next
- assume "C \<noteq> {}"
- with C(2) have "S \<subseteq> \<Union>C"
- by auto
- moreover have "independent (\<Union>C)"
- by (intro independent_Union_directed C)
- moreover have "\<Union>C \<subseteq> V"
- using C by auto
- ultimately show ?thesis
- by auto
- qed
- qed
- then obtain B where B: "independent B" "B \<subseteq> V" "S \<subseteq> B"
- and max: "\<And>S. independent S \<Longrightarrow> S \<subseteq> V \<Longrightarrow> B \<subseteq> S \<Longrightarrow> S = B"
- by auto
- moreover
- { assume "\<not> V \<subseteq> span B"
- then obtain v where "v \<in> V" "v \<notin> span B"
- by auto
- with B have "independent (insert v B)"
- unfolding independent_insert by auto
- from max[OF this] \<open>v \<in> V\<close> \<open>B \<subseteq> V\<close>
- have "v \<in> B"
- by auto
- with \<open>v \<notin> span B\<close> have False
- by (auto intro: span_superset) }
- ultimately show ?thesis
- by (auto intro!: exI[of _ B])
-qed
-
-
-lemma maximal_independent_subset:
- "\<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
- by (metis maximal_independent_subset_extend[of "{}"] empty_subsetI independent_empty)
-
-lemma span_finite:
- assumes fS: "finite S"
- shows "span S = {y. \<exists>u. sum (\<lambda>v. u v *\<^sub>R v) S = y}"
- (is "_ = ?rhs")
-proof -
- {
- fix y
- assume y: "y \<in> span S"
- from y obtain S' u where fS': "finite S'"
- and SS': "S' \<subseteq> S"
- and u: "sum (\<lambda>v. u v *\<^sub>R v) S' = y"
- unfolding span_explicit by blast
- let ?u = "\<lambda>x. if x \<in> S' then u x else 0"
- have "sum (\<lambda>v. ?u v *\<^sub>R v) S = sum (\<lambda>v. u v *\<^sub>R v) S'"
- using SS' fS by (auto intro!: sum.mono_neutral_cong_right)
- then have "sum (\<lambda>v. ?u v *\<^sub>R v) S = y" by (metis u)
- then have "y \<in> ?rhs" by auto
- }
- moreover
- {
- fix y u
- assume u: "sum (\<lambda>v. u v *\<^sub>R v) S = y"
- then have "y \<in> span S" using fS unfolding span_explicit by auto
- }
- ultimately show ?thesis by blast
-qed
-
-lemma linear_independent_extend_subspace:
- assumes "independent B"
- shows "\<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x) \<and> range g = span (f`B)"
-proof -
- from maximal_independent_subset_extend[OF _ \<open>independent B\<close>, of UNIV]
- obtain B' where "B \<subseteq> B'" "independent B'" "span B' = UNIV"
- by (auto simp: top_unique)
- have "\<forall>y. \<exists>X. {x. X x \<noteq> 0} \<subseteq> B' \<and> finite {x. X x \<noteq> 0} \<and> y = (\<Sum>x|X x \<noteq> 0. X x *\<^sub>R x)"
- using \<open>span B' = UNIV\<close> unfolding span_alt by auto
- then obtain X where X: "\<And>y. {x. X y x \<noteq> 0} \<subseteq> B'" "\<And>y. finite {x. X y x \<noteq> 0}"
- "\<And>y. y = (\<Sum>x|X y x \<noteq> 0. X y x *\<^sub>R x)"
- unfolding choice_iff by auto
-
- have X_add: "X (x + y) = (\<lambda>z. X x z + X y z)" for x y
- using \<open>independent B'\<close>
- proof (rule independentD_unique)
- have "(\<Sum>z | X x z + X y z \<noteq> 0. (X x z + X y z) *\<^sub>R z)
- = (\<Sum>z\<in>{z. X x z \<noteq> 0} \<union> {z. X y z \<noteq> 0}. (X x z + X y z) *\<^sub>R z)"
- by (intro sum.mono_neutral_cong_left) (auto intro: X)
- also have "\<dots> = (\<Sum>z\<in>{z. X x z \<noteq> 0}. X x z *\<^sub>R z) + (\<Sum>z\<in>{z. X y z \<noteq> 0}. X y z *\<^sub>R z)"
- by (auto simp add: scaleR_add_left sum.distrib
- intro!: arg_cong2[where f="(+)"] sum.mono_neutral_cong_right X)
- also have "\<dots> = x + y"
- by (simp add: X(3)[symmetric])
- also have "\<dots> = (\<Sum>z | X (x + y) z \<noteq> 0. X (x + y) z *\<^sub>R z)"
- by (rule X(3))
- finally show "(\<Sum>z | X (x + y) z \<noteq> 0. X (x + y) z *\<^sub>R z) = (\<Sum>z | X x z + X y z \<noteq> 0. (X x z + X y z) *\<^sub>R z)"
- ..
- have "{z. X x z + X y z \<noteq> 0} \<subseteq> {z. X x z \<noteq> 0} \<union> {z. X y z \<noteq> 0}"
- by auto
- then show "finite {z. X x z + X y z \<noteq> 0}" "{xa. X x xa + X y xa \<noteq> 0} \<subseteq> B'"
- "finite {xa. X (x + y) xa \<noteq> 0}" "{xa. X (x + y) xa \<noteq> 0} \<subseteq> B'"
- using X(1) by (auto dest: finite_subset intro: X)
- qed
-
- have X_cmult: "X (c *\<^sub>R x) = (\<lambda>z. c * X x z)" for x c
- using \<open>independent B'\<close>
- proof (rule independentD_unique)
- show "finite {z. X (c *\<^sub>R x) z \<noteq> 0}" "{z. X (c *\<^sub>R x) z \<noteq> 0} \<subseteq> B'"
- "finite {z. c * X x z \<noteq> 0}" "{z. c * X x z \<noteq> 0} \<subseteq> B' "
- using X(1,2) by auto
- show "(\<Sum>z | X (c *\<^sub>R x) z \<noteq> 0. X (c *\<^sub>R x) z *\<^sub>R z) = (\<Sum>z | c * X x z \<noteq> 0. (c * X x z) *\<^sub>R z)"
- unfolding scaleR_scaleR[symmetric] scaleR_sum_right[symmetric]
- by (cases "c = 0") (auto simp: X(3)[symmetric])
- qed
-
- have X_B': "x \<in> B' \<Longrightarrow> X x = (\<lambda>z. if z = x then 1 else 0)" for x
- using \<open>independent B'\<close>
- by (rule independentD_unique[OF _ X(2) X(1)]) (auto intro: X simp: X(3)[symmetric])
-
- define f' where "f' y = (if y \<in> B then f y else 0)" for y
- define g where "g y = (\<Sum>x|X y x \<noteq> 0. X y x *\<^sub>R f' x)" for y
-
- have g_f': "x \<in> B' \<Longrightarrow> g x = f' x" for x
- by (auto simp: g_def X_B')
-
- have "linear g"
- proof
- fix x y
- have *: "(\<Sum>z | X x z + X y z \<noteq> 0. (X x z + X y z) *\<^sub>R f' z)
- = (\<Sum>z\<in>{z. X x z \<noteq> 0} \<union> {z. X y z \<noteq> 0}. (X x z + X y z) *\<^sub>R f' z)"
- by (intro sum.mono_neutral_cong_left) (auto intro: X)
- show "g (x + y) = g x + g y"
- unfolding g_def X_add *
- by (auto simp add: scaleR_add_left sum.distrib
- intro!: arg_cong2[where f="(+)"] sum.mono_neutral_cong_right X)
- next
- show "g (r *\<^sub>R x) = r *\<^sub>R g x" for r x
- by (auto simp add: g_def X_cmult scaleR_sum_right intro!: sum.mono_neutral_cong_left X)
- qed
- moreover have "\<forall>x\<in>B. g x = f x"
- using \<open>B \<subseteq> B'\<close> by (auto simp: g_f' f'_def)
- moreover have "range g = span (f`B)"
- unfolding \<open>span B' = UNIV\<close>[symmetric] span_linear_image[OF \<open>linear g\<close>, symmetric]
- proof (rule span_subspace)
- have "g ` B' \<subseteq> f`B \<union> {0}"
- by (auto simp: g_f' f'_def)
- also have "\<dots> \<subseteq> span (f`B)"
- by (auto intro: span_superset span_0)
- finally show "g ` B' \<subseteq> span (f`B)"
- by auto
- have "x \<in> B \<Longrightarrow> f x = g x" for x
- using \<open>B \<subseteq> B'\<close> by (auto simp add: g_f' f'_def)
- then show "span (f ` B) \<subseteq> span (g ` B')"
- using \<open>B \<subseteq> B'\<close> by (intro span_mono) auto
- qed (rule subspace_span)
- ultimately show ?thesis
- by auto
-qed
-
-lemma linear_independent_extend:
- "independent B \<Longrightarrow> \<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x)"
- using linear_independent_extend_subspace[of B f] by auto
-
-text \<open>Linear functions are equal on a subspace if they are on a spanning set.\<close>
-
-lemma subspace_kernel:
- assumes lf: "linear f"
- shows "subspace {x. f x = 0}"
- apply (simp add: subspace_def)
- apply (simp add: linear_add[OF lf] linear_cmul[OF lf] linear_0[OF lf])
- done
-
-lemma linear_eq_0_span:
- assumes lf: "linear f" and f0: "\<forall>x\<in>B. f x = 0"
- shows "\<forall>x \<in> span B. f x = 0"
- using f0 subspace_kernel[OF lf]
- by (rule span_induct')
-
-lemma linear_eq_0: "linear f \<Longrightarrow> S \<subseteq> span B \<Longrightarrow> \<forall>x\<in>B. f x = 0 \<Longrightarrow> \<forall>x\<in>S. f x = 0"
- using linear_eq_0_span[of f B] by auto
-
-lemma linear_eq_span: "linear f \<Longrightarrow> linear g \<Longrightarrow> \<forall>x\<in>B. f x = g x \<Longrightarrow> \<forall>x \<in> span B. f x = g x"
- using linear_eq_0_span[of "\<lambda>x. f x - g x" B] by (auto simp: linear_compose_sub)
-
-lemma linear_eq: "linear f \<Longrightarrow> linear g \<Longrightarrow> S \<subseteq> span B \<Longrightarrow> \<forall>x\<in>B. f x = g x \<Longrightarrow> \<forall>x\<in>S. f x = g x"
- using linear_eq_span[of f g B] by auto
-
-text \<open>The degenerate case of the Exchange Lemma.\<close>
-
-lemma spanning_subset_independent:
- assumes BA: "B \<subseteq> A"
- and iA: "independent A"
- and AsB: "A \<subseteq> span B"
- shows "A = B"
-proof
- show "B \<subseteq> A" by (rule BA)
-
- from span_mono[OF BA] span_mono[OF AsB]
- have sAB: "span A = span B" unfolding span_span by blast
-
- {
- fix x
- assume x: "x \<in> A"
- from iA have th0: "x \<notin> span (A - {x})"
- unfolding dependent_def using x by blast
- from x have xsA: "x \<in> span A"
- by (blast intro: span_superset)
- have "A - {x} \<subseteq> A" by blast
- then have th1: "span (A - {x}) \<subseteq> span A"
- by (metis span_mono)
- {
- assume xB: "x \<notin> B"
- from xB BA have "B \<subseteq> A - {x}"
- by blast
- then have "span B \<subseteq> span (A - {x})"
- by (metis span_mono)
- with th1 th0 sAB have "x \<notin> span A"
- by blast
- with x have False
- by (metis span_superset)
- }
- then have "x \<in> B" by blast
- }
- then show "A \<subseteq> B" by blast
-qed
-
-text \<open>Relation between bases and injectivity/surjectivity of map.\<close>
-
-lemma spanning_surjective_image:
- assumes us: "UNIV \<subseteq> span S"
- and lf: "linear f"
- and sf: "surj f"
- shows "UNIV \<subseteq> span (f ` S)"
-proof -
- have "UNIV \<subseteq> f ` UNIV"
- using sf by (auto simp add: surj_def)
- also have " \<dots> \<subseteq> span (f ` S)"
- using spans_image[OF lf us] .
- finally show ?thesis .
-qed
-
-lemma independent_inj_on_image:
- assumes iS: "independent S"
- and lf: "linear f"
- and fi: "inj_on f (span S)"
- shows "independent (f ` S)"
-proof -
- {
- fix a
- assume a: "a \<in> S" "f a \<in> span (f ` S - {f a})"
- have eq: "f ` S - {f a} = f ` (S - {a})"
- using fi \<open>a\<in>S\<close> by (auto simp add: inj_on_def span_superset)
- from a have "f a \<in> f ` span (S - {a})"
- unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast
- then have "a \<in> span (S - {a})"
- by (rule inj_on_image_mem_iff_alt[OF fi, rotated])
- (insert span_mono[of "S - {a}" S], auto intro: span_superset \<open>a\<in>S\<close>)
- with a(1) iS have False
- by (simp add: dependent_def)
- }
- then show ?thesis
- unfolding dependent_def by blast
-qed
-
-lemma independent_injective_image:
- "independent S \<Longrightarrow> linear f \<Longrightarrow> inj f \<Longrightarrow> independent (f ` S)"
- using independent_inj_on_image[of S f] by (auto simp: subset_inj_on)
-
-text \<open>Detailed theorems about left and right invertibility in general case.\<close>
-
-lemma linear_inj_on_left_inverse:
- assumes lf: "linear f" and fi: "inj_on f (span S)"
- shows "\<exists>g. range g \<subseteq> span S \<and> linear g \<and> (\<forall>x\<in>span S. g (f x) = x)"
-proof -
- obtain B where "independent B" "B \<subseteq> S" "S \<subseteq> span B"
- using maximal_independent_subset[of S] by auto
- then have "span S = span B"
- unfolding span_eq by (auto simp: span_superset)
- with linear_independent_extend_subspace[OF independent_inj_on_image, OF \<open>independent B\<close> lf] fi
- obtain g where g: "linear g" "\<forall>x\<in>f ` B. g x = inv_into B f x" "range g = span (inv_into B f ` f ` B)"
- by fastforce
- have fB: "inj_on f B"
- using fi by (auto simp: \<open>span S = span B\<close> intro: subset_inj_on span_superset)
-
- have "\<forall>x\<in>span B. g (f x) = x"
- proof (intro linear_eq_span)
- show "linear (\<lambda>x. x)" "linear (\<lambda>x. g (f x))"
- using linear_id linear_compose[OF \<open>linear f\<close> \<open>linear g\<close>] by (auto simp: id_def comp_def)
- show "\<forall>x \<in> B. g (f x) = x"
- using g fi \<open>span S = span B\<close> by (auto simp: fB)
- qed
- moreover
- have "inv_into B f ` f ` B \<subseteq> B"
- by (auto simp: fB)
- then have "range g \<subseteq> span S"
- unfolding g \<open>span S = span B\<close> by (intro span_mono)
- ultimately show ?thesis
- using \<open>span S = span B\<close> \<open>linear g\<close> by auto
-qed
-
-lemma linear_injective_left_inverse: "linear f \<Longrightarrow> inj f \<Longrightarrow> \<exists>g. linear g \<and> g \<circ> f = id"
- using linear_inj_on_left_inverse[of f UNIV] by (auto simp: fun_eq_iff span_UNIV)
-
-lemma linear_surj_right_inverse:
- assumes lf: "linear f" and sf: "span T \<subseteq> f`span S"
- shows "\<exists>g. range g \<subseteq> span S \<and> linear g \<and> (\<forall>x\<in>span T. f (g x) = x)"
-proof -
- obtain B where "independent B" "B \<subseteq> T" "T \<subseteq> span B"
- using maximal_independent_subset[of T] by auto
- then have "span T = span B"
- unfolding span_eq by (auto simp: span_superset)
-
- from linear_independent_extend_subspace[OF \<open>independent B\<close>, of "inv_into (span S) f"]
- obtain g where g: "linear g" "\<forall>x\<in>B. g x = inv_into (span S) f x" "range g = span (inv_into (span S) f`B)"
- by auto
- moreover have "x \<in> B \<Longrightarrow> f (inv_into (span S) f x) = x" for x
- using \<open>B \<subseteq> T\<close> \<open>span T \<subseteq> f`span S\<close> by (intro f_inv_into_f) (auto intro: span_superset)
- ultimately have "\<forall>x\<in>B. f (g x) = x"
- by auto
- then have "\<forall>x\<in>span B. f (g x) = x"
- using linear_id linear_compose[OF \<open>linear g\<close> \<open>linear f\<close>]
- by (intro linear_eq_span) (auto simp: id_def comp_def)
- moreover have "inv_into (span S) f ` B \<subseteq> span S"
- using \<open>B \<subseteq> T\<close> \<open>span T \<subseteq> f`span S\<close> by (auto intro: inv_into_into span_superset)
- then have "range g \<subseteq> span S"
- unfolding g by (intro span_minimal subspace_span) auto
- ultimately show ?thesis
- using \<open>linear g\<close> \<open>span T = span B\<close> by auto
-qed
-
-lemma linear_surjective_right_inverse: "linear f \<Longrightarrow> surj f \<Longrightarrow> \<exists>g. linear g \<and> f \<circ> g = id"
- using linear_surj_right_inverse[of f UNIV UNIV]
- by (auto simp: span_UNIV fun_eq_iff)
-
-text \<open>The general case of the Exchange Lemma, the key to what follows.\<close>
-
-lemma exchange_lemma:
- assumes f:"finite t"
- and i: "independent s"
- and sp: "s \<subseteq> span t"
- shows "\<exists>t'. card t' = card t \<and> finite t' \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
- using f i sp
-proof (induct "card (t - s)" arbitrary: s t rule: less_induct)
- case less
- note ft = \<open>finite t\<close> and s = \<open>independent s\<close> and sp = \<open>s \<subseteq> span t\<close>
- let ?P = "\<lambda>t'. card t' = card t \<and> finite t' \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
- let ?ths = "\<exists>t'. ?P t'"
- {
- assume "s \<subseteq> t"
- then have ?ths
- by (metis ft Un_commute sp sup_ge1)
- }
- moreover
- {
- assume st: "t \<subseteq> s"
- from spanning_subset_independent[OF st s sp] st ft span_mono[OF st]
- have ?ths
- by (metis Un_absorb sp)
- }
- moreover
- {
- assume st: "\<not> s \<subseteq> t" "\<not> t \<subseteq> s"
- from st(2) obtain b where b: "b \<in> t" "b \<notin> s"
- by blast
- from b have "t - {b} - s \<subset> t - s"
- by blast
- then have cardlt: "card (t - {b} - s) < card (t - s)"
- using ft by (auto intro: psubset_card_mono)
- from b ft have ct0: "card t \<noteq> 0"
- by auto
- have ?ths
- proof cases
- assume stb: "s \<subseteq> span (t - {b})"
- from ft have ftb: "finite (t - {b})"
- by auto
- from less(1)[OF cardlt ftb s stb]
- obtain u where u: "card u = card (t - {b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u"
- and fu: "finite u" by blast
- let ?w = "insert b u"
- have th0: "s \<subseteq> insert b u"
- using u by blast
- from u(3) b have "u \<subseteq> s \<union> t"
- by blast
- then have th1: "insert b u \<subseteq> s \<union> t"
- using u b by blast
- have bu: "b \<notin> u"
- using b u by blast
- from u(1) ft b have "card u = (card t - 1)"
- by auto
- then have th2: "card (insert b u) = card t"
- using card_insert_disjoint[OF fu bu] ct0 by auto
- from u(4) have "s \<subseteq> span u" .
- also have "\<dots> \<subseteq> span (insert b u)"
- by (rule span_mono) blast
- finally have th3: "s \<subseteq> span (insert b u)" .
- from th0 th1 th2 th3 fu have th: "?P ?w"
- by blast
- from th show ?thesis by blast
- next
- assume stb: "\<not> s \<subseteq> span (t - {b})"
- from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})"
- by blast
- have ab: "a \<noteq> b"
- using a b by blast
- have at: "a \<notin> t"
- using a ab span_superset[of a "t- {b}"] by auto
- have mlt: "card ((insert a (t - {b})) - s) < card (t - s)"
- using cardlt ft a b by auto
- have ft': "finite (insert a (t - {b}))"
- using ft by auto
- {
- fix x
- assume xs: "x \<in> s"
- have t: "t \<subseteq> insert b (insert a (t - {b}))"
- using b by auto
- from b(1) have "b \<in> span t"
- by (simp add: span_superset)
- have bs: "b \<in> span (insert a (t - {b}))"
- apply (rule in_span_delete)
- using a sp unfolding subset_eq
- apply auto
- done
- from xs sp have "x \<in> span t"
- by blast
- with span_mono[OF t] have x: "x \<in> span (insert b (insert a (t - {b})))" ..
- from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .
- }
- then have sp': "s \<subseteq> span (insert a (t - {b}))"
- by blast
- from less(1)[OF mlt ft' s sp'] obtain u where u:
- "card u = card (insert a (t - {b}))"
- "finite u" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t - {b})"
- "s \<subseteq> span u" by blast
- from u a b ft at ct0 have "?P u"
- by auto
- then show ?thesis by blast
- qed
- }
- ultimately show ?ths by blast
-qed
-
-text \<open>This implies corresponding size bounds.\<close>
-
-lemma independent_span_bound:
- assumes f: "finite t"
- and i: "independent s"
- and sp: "s \<subseteq> span t"
- shows "finite s \<and> card s \<le> card t"
- by (metis exchange_lemma[OF f i sp] finite_subset card_mono)
-
lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\<in> (UNIV::'a::finite set)}"
proof -
have eq: "{f x |x. x\<in> UNIV} = f ` UNIV"
@@ -1353,51 +47,8 @@
subsection%unimportant \<open>More interesting properties of the norm.\<close>
-lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)"
- by auto
-
notation inner (infix "\<bullet>" 70)
-lemma square_bound_lemma:
- fixes x :: real
- shows "x < (1 + x) * (1 + x)"
-proof -
- have "(x + 1/2)\<^sup>2 + 3/4 > 0"
- using zero_le_power2[of "x+1/2"] by arith
- then show ?thesis
- by (simp add: field_simps power2_eq_square)
-qed
-
-lemma square_continuous:
- fixes e :: real
- shows "e > 0 \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>y. \<bar>y - x\<bar> < d \<longrightarrow> \<bar>y * y - x * x\<bar> < e)"
- using isCont_power[OF continuous_ident, of x, unfolded isCont_def LIM_eq, rule_format, of e 2]
- by (force simp add: power2_eq_square)
-
-
-lemma norm_eq_0_dot: "norm x = 0 \<longleftrightarrow> x \<bullet> x = (0::real)"
- by simp (* TODO: delete *)
-
-lemma norm_triangle_sub:
- fixes x y :: "'a::real_normed_vector"
- shows "norm x \<le> norm y + norm (x - y)"
- using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps)
-
-lemma norm_le: "norm x \<le> norm y \<longleftrightarrow> x \<bullet> x \<le> y \<bullet> y"
- by (simp add: norm_eq_sqrt_inner)
-
-lemma norm_lt: "norm x < norm y \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
- by (simp add: norm_eq_sqrt_inner)
-
-lemma norm_eq: "norm x = norm y \<longleftrightarrow> x \<bullet> x = y \<bullet> y"
- apply (subst order_eq_iff)
- apply (auto simp: norm_le)
- done
-
-lemma norm_eq_1: "norm x = 1 \<longleftrightarrow> x \<bullet> x = 1"
- by (simp add: norm_eq_sqrt_inner)
-
-
text\<open>Equality of vectors in terms of @{term "(\<bullet>)"} products.\<close>
lemma linear_componentwise:
@@ -1405,11 +56,11 @@
assumes lf: "linear f"
shows "(f x) \<bullet> j = (\<Sum>i\<in>Basis. (x\<bullet>i) * (f i\<bullet>j))" (is "?lhs = ?rhs")
proof -
+ interpret linear f by fact
have "?rhs = (\<Sum>i\<in>Basis. (x\<bullet>i) *\<^sub>R (f i))\<bullet>j"
by (simp add: inner_sum_left)
then show ?thesis
- unfolding linear_sum_mul[OF lf, symmetric]
- unfolding euclidean_representation ..
+ by (simp add: euclidean_representation sum[symmetric] scale[symmetric])
qed
lemma vector_eq: "x = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y \<and> y \<bullet> y = x \<bullet> x"
@@ -1607,22 +258,15 @@
using bilinear_radd [of h _ x "- y"] by (simp add: bilinear_rneg)
lemma bilinear_sum:
- assumes bh: "bilinear h"
- and fS: "finite S"
- and fT: "finite T"
+ assumes "bilinear h"
shows "h (sum f S) (sum g T) = sum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
proof -
+ interpret l: linear "\<lambda>x. h x y" for y using assms by (simp add: bilinear_def)
+ interpret r: linear "\<lambda>y. h x y" for x using assms by (simp add: bilinear_def)
have "h (sum f S) (sum g T) = sum (\<lambda>x. h (f x) (sum g T)) S"
- apply (rule linear_sum[unfolded o_def])
- using bh fS
- apply (auto simp add: bilinear_def)
- done
+ by (simp add: l.sum)
also have "\<dots> = sum (\<lambda>x. sum (\<lambda>y. h (f x) (g y)) T) S"
- apply (rule sum.cong, simp)
- apply (rule linear_sum[unfolded o_def])
- using bh fT
- apply (auto simp add: bilinear_def)
- done
+ by (rule sum.cong) (simp_all add: r.sum)
finally show ?thesis
unfolding sum.cartesian_product .
qed
@@ -1663,6 +307,7 @@
assumes lf: "linear f"
shows "x \<bullet> adjoint f y = f x \<bullet> y"
proof -
+ interpret linear f by fact
have "\<forall>y. \<exists>w. \<forall>x. f x \<bullet> y = x \<bullet> w"
proof (intro allI exI)
fix y :: "'m" and x
@@ -1670,8 +315,7 @@
have "f x \<bullet> y = f (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i) \<bullet> y"
by (simp add: euclidean_representation)
also have "\<dots> = (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) \<bullet> y"
- unfolding linear_sum[OF lf]
- by (simp add: linear_cmul[OF lf])
+ by (simp add: sum scale)
finally show "f x \<bullet> y = x \<bullet> ?w"
by (simp add: inner_sum_left inner_sum_right mult.commute)
qed
@@ -1847,63 +491,14 @@
subsection%unimportant \<open>Euclidean Spaces as Typeclass\<close>
lemma independent_Basis: "independent Basis"
- unfolding dependent_def
- apply (subst span_finite)
- apply simp
- apply clarify
- apply (drule_tac f="inner a" in arg_cong)
- apply (simp add: inner_Basis inner_sum_right eq_commute)
- done
+ by (rule independent_Basis)
lemma span_Basis [simp]: "span Basis = UNIV"
- unfolding span_finite [OF finite_Basis]
- by (fast intro: euclidean_representation)
+ by (rule span_Basis)
lemma in_span_Basis: "x \<in> span Basis"
unfolding span_Basis ..
-lemma Basis_le_norm: "b \<in> Basis \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> norm x"
- by (rule order_trans [OF Cauchy_Schwarz_ineq2]) simp
-
-lemma norm_bound_Basis_le: "b \<in> Basis \<Longrightarrow> norm x \<le> e \<Longrightarrow> \<bar>x \<bullet> b\<bar> \<le> e"
- by (metis Basis_le_norm order_trans)
-
-lemma norm_bound_Basis_lt: "b \<in> Basis \<Longrightarrow> norm x < e \<Longrightarrow> \<bar>x \<bullet> b\<bar> < e"
- by (metis Basis_le_norm le_less_trans)
-
-lemma norm_le_l1: "norm x \<le> (\<Sum>b\<in>Basis. \<bar>x \<bullet> b\<bar>)"
- apply (subst euclidean_representation[of x, symmetric])
- apply (rule order_trans[OF norm_sum])
- apply (auto intro!: sum_mono)
- done
-
-lemma sum_norm_allsubsets_bound:
- fixes f :: "'a \<Rightarrow> 'n::euclidean_space"
- assumes fP: "finite P"
- and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (sum f Q) \<le> e"
- shows "(\<Sum>x\<in>P. norm (f x)) \<le> 2 * real DIM('n) * e"
-proof -
- have "(\<Sum>x\<in>P. norm (f x)) \<le> (\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>f x \<bullet> b\<bar>)"
- by (rule sum_mono) (rule norm_le_l1)
- also have "(\<Sum>x\<in>P. \<Sum>b\<in>Basis. \<bar>f x \<bullet> b\<bar>) = (\<Sum>b\<in>Basis. \<Sum>x\<in>P. \<bar>f x \<bullet> b\<bar>)"
- by (rule sum.swap)
- also have "\<dots> \<le> of_nat (card (Basis :: 'n set)) * (2 * e)"
- proof (rule sum_bounded_above)
- fix i :: 'n
- assume i: "i \<in> Basis"
- have "norm (\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le>
- norm ((\<Sum>x\<in>P \<inter> - {x. f x \<bullet> i < 0}. f x) \<bullet> i) + norm ((\<Sum>x\<in>P \<inter> {x. f x \<bullet> i < 0}. f x) \<bullet> i)"
- by (simp add: abs_real_def sum.If_cases[OF fP] sum_negf norm_triangle_ineq4 inner_sum_left
- del: real_norm_def)
- also have "\<dots> \<le> e + e"
- unfolding real_norm_def
- by (intro add_mono norm_bound_Basis_le i fPs) auto
- finally show "(\<Sum>x\<in>P. \<bar>f x \<bullet> i\<bar>) \<le> 2*e" by simp
- qed
- also have "\<dots> = 2 * real DIM('n) * e" by simp
- finally show ?thesis .
-qed
-
subsection%unimportant \<open>Linearity and Bilinearity continued\<close>
@@ -1912,6 +507,7 @@
assumes lf: "linear f"
shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
proof
+ interpret linear f by fact
let ?B = "\<Sum>b\<in>Basis. norm (f b)"
show "\<forall>x. norm (f x) \<le> ?B * norm x"
proof
@@ -1920,7 +516,7 @@
have "norm (f x) = norm (f (\<Sum>b\<in>Basis. (x \<bullet> b) *\<^sub>R b))"
unfolding euclidean_representation ..
also have "\<dots> = norm (sum ?g Basis)"
- by (simp add: linear_sum [OF lf] linear_cmul [OF lf])
+ by (simp add: sum scale)
finally have th0: "norm (f x) = norm (sum ?g Basis)" .
have th: "norm (?g i) \<le> norm (f i) * norm x" if "i \<in> Basis" for i
proof -
@@ -1997,15 +593,15 @@
fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
assumes "linear f" "inj f"
obtains B where "B > 0" "\<And>x. B * norm x \<le> norm(f x)"
- using linear_injective_left_inverse [OF assms] linear_invertible_bounded_below_pos assms by blast
+ using linear_injective_left_inverse [OF assms]
+ linear_invertible_bounded_below_pos assms by blast
lemma bounded_linearI':
fixes f ::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
assumes "\<And>x y. f (x + y) = f x + f y"
and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
shows "bounded_linear f"
- unfolding linear_conv_bounded_linear[symmetric]
- by (rule linearI[OF assms])
+ using assms linearI linear_conv_bounded_linear by blast
lemma bilinear_bounded:
fixes h :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space \<Rightarrow> 'k::real_normed_vector"
@@ -2020,7 +616,7 @@
apply rule
done
also have "\<dots> = norm (sum (\<lambda> (i,j). h ((x \<bullet> i) *\<^sub>R i) ((y \<bullet> j) *\<^sub>R j)) (Basis \<times> Basis))"
- unfolding bilinear_sum[OF bh finite_Basis finite_Basis] ..
+ unfolding bilinear_sum[OF bh] ..
finally have th: "norm (h x y) = \<dots>" .
show "norm (h x y) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. norm (h i j)) * norm x * norm y"
apply (auto simp add: sum_distrib_right th sum.cartesian_product)
@@ -2084,14 +680,14 @@
by (simp only: ac_simps)
qed
-lemma bounded_linear_imp_has_derivative:
- "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
- by (simp add: has_derivative_def bounded_linear.linear linear_diff)
+lemma bounded_linear_imp_has_derivative: "bounded_linear f \<Longrightarrow> (f has_derivative f) net"
+ by (auto simp add: has_derivative_def linear_diff linear_linear linear_def
+ dest: bounded_linear.linear)
lemma linear_imp_has_derivative:
fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
shows "linear f \<Longrightarrow> (f has_derivative f) net"
-by (simp add: has_derivative_def linear_conv_bounded_linear linear_diff)
+ by (simp add: bounded_linear_imp_has_derivative linear_conv_bounded_linear)
lemma bounded_linear_imp_differentiable: "bounded_linear f \<Longrightarrow> f differentiable net"
using bounded_linear_imp_has_derivative differentiable_def by blast
@@ -2099,7 +695,7 @@
lemma linear_imp_differentiable:
fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
shows "linear f \<Longrightarrow> f differentiable net"
-by (metis linear_imp_has_derivative differentiable_def)
+ by (metis linear_imp_has_derivative differentiable_def)
subsection%unimportant \<open>We continue.\<close>
@@ -2107,221 +703,21 @@
lemma independent_bound:
fixes S :: "'a::euclidean_space set"
shows "independent S \<Longrightarrow> finite S \<and> card S \<le> DIM('a)"
- using independent_span_bound[OF finite_Basis, of S] by auto
+ by (metis dim_subset_UNIV finiteI_independent dim_span_eq_card_independent)
+
+lemmas independent_imp_finite = finiteI_independent
corollary
fixes S :: "'a::euclidean_space set"
assumes "independent S"
- shows independent_imp_finite: "finite S" and independent_card_le:"card S \<le> DIM('a)"
-using assms independent_bound by auto
-
-lemma independent_explicit:
- fixes B :: "'a::euclidean_space set"
- shows "independent B \<longleftrightarrow>
- finite B \<and> (\<forall>c. (\<Sum>v\<in>B. c v *\<^sub>R v) = 0 \<longrightarrow> (\<forall>v \<in> B. c v = 0))"
-apply (cases "finite B")
- apply (force simp: dependent_finite)
-using independent_bound
-apply auto
-done
+ shows independent_card_le:"card S \<le> DIM('a)"
+ using assms independent_bound by auto
lemma dependent_biggerset:
fixes S :: "'a::euclidean_space set"
shows "(finite S \<Longrightarrow> card S > DIM('a)) \<Longrightarrow> dependent S"
by (metis independent_bound not_less)
-text \<open>Notion of dimension.\<close>
-
-definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> card B = n)"
-
-lemma basis_exists:
- "\<exists>B. (B :: ('a::euclidean_space) set) \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (card B = dim V)"
- unfolding dim_def some_eq_ex[of "\<lambda>n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (card B = n)"]
- using maximal_independent_subset[of V] independent_bound
- by auto
-
-corollary dim_le_card:
- fixes s :: "'a::euclidean_space set"
- shows "finite s \<Longrightarrow> dim s \<le> card s"
-by (metis basis_exists card_mono)
-
-text \<open>Consequences of independence or spanning for cardinality.\<close>
-
-lemma independent_card_le_dim:
- fixes B :: "'a::euclidean_space set"
- assumes "B \<subseteq> V"
- and "independent B"
- shows "card B \<le> dim V"
-proof -
- from basis_exists[of V] \<open>B \<subseteq> V\<close>
- obtain B' where "independent B'"
- and "B \<subseteq> span B'"
- and "card B' = dim V"
- by blast
- with independent_span_bound[OF _ \<open>independent B\<close> \<open>B \<subseteq> span B'\<close>] independent_bound[of B']
- show ?thesis by auto
-qed
-
-lemma span_card_ge_dim:
- fixes B :: "'a::euclidean_space set"
- shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B"
- by (metis basis_exists[of V] independent_span_bound subset_trans)
-
-lemma basis_card_eq_dim:
- fixes V :: "'a::euclidean_space set"
- shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
- by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_bound)
-
-lemma dim_unique:
- fixes B :: "'a::euclidean_space set"
- shows "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> card B = n \<Longrightarrow> dim V = n"
- by (metis basis_card_eq_dim)
-
-text \<open>More lemmas about dimension.\<close>
-
-lemma dim_UNIV [simp]: "dim (UNIV :: 'a::euclidean_space set) = DIM('a)"
- using independent_Basis
- by (intro dim_unique[of Basis]) auto
-
-lemma dim_subset:
- fixes S :: "'a::euclidean_space set"
- shows "S \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
- using basis_exists[of T] basis_exists[of S]
- by (metis independent_card_le_dim subset_trans)
-
-lemma dim_subset_UNIV:
- fixes S :: "'a::euclidean_space set"
- shows "dim S \<le> DIM('a)"
- by (metis dim_subset subset_UNIV dim_UNIV)
-
-text \<open>Converses to those.\<close>
-
-lemma card_ge_dim_independent:
- fixes B :: "'a::euclidean_space set"
- assumes BV: "B \<subseteq> V"
- and iB: "independent B"
- and dVB: "dim V \<le> card B"
- shows "V \<subseteq> span B"
-proof
- fix a
- assume aV: "a \<in> V"
- {
- assume aB: "a \<notin> span B"
- then have iaB: "independent (insert a B)"
- using iB aV BV by (simp add: independent_insert)
- from aV BV have th0: "insert a B \<subseteq> V"
- by blast
- from aB have "a \<notin>B"
- by (auto simp add: span_superset)
- with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB]
- have False by auto
- }
- then show "a \<in> span B" by blast
-qed
-
-lemma card_le_dim_spanning:
- assumes BV: "(B:: ('a::euclidean_space) set) \<subseteq> V"
- and VB: "V \<subseteq> span B"
- and fB: "finite B"
- and dVB: "dim V \<ge> card B"
- shows "independent B"
-proof -
- {
- fix a
- assume a: "a \<in> B" "a \<in> span (B - {a})"
- from a fB have c0: "card B \<noteq> 0"
- by auto
- from a fB have cb: "card (B - {a}) = card B - 1"
- by auto
- from BV a have th0: "B - {a} \<subseteq> V"
- by blast
- {
- fix x
- assume x: "x \<in> V"
- from a have eq: "insert a (B - {a}) = B"
- by blast
- from x VB have x': "x \<in> span B"
- by blast
- from span_trans[OF a(2), unfolded eq, OF x']
- have "x \<in> span (B - {a})" .
- }
- then have th1: "V \<subseteq> span (B - {a})"
- by blast
- have th2: "finite (B - {a})"
- using fB by auto
- from span_card_ge_dim[OF th0 th1 th2]
- have c: "dim V \<le> card (B - {a})" .
- from c c0 dVB cb have False by simp
- }
- then show ?thesis
- unfolding dependent_def by blast
-qed
-
-lemma card_eq_dim:
- fixes B :: "'a::euclidean_space set"
- shows "B \<subseteq> V \<Longrightarrow> card B = dim V \<Longrightarrow> finite B \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
- by (metis order_eq_iff card_le_dim_spanning card_ge_dim_independent)
-
-text \<open>More general size bound lemmas.\<close>
-
-lemma independent_bound_general:
- fixes S :: "'a::euclidean_space set"
- shows "independent S \<Longrightarrow> finite S \<and> card S \<le> dim S"
- by (metis independent_card_le_dim independent_bound subset_refl)
-
-lemma dependent_biggerset_general:
- fixes S :: "'a::euclidean_space set"
- shows "(finite S \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
- using independent_bound_general[of S] by (metis linorder_not_le)
-
-lemma dim_span [simp]:
- fixes S :: "'a::euclidean_space set"
- shows "dim (span S) = dim S"
-proof -
- have th0: "dim S \<le> dim (span S)"
- by (auto simp add: subset_eq intro: dim_subset span_superset)
- from basis_exists[of S]
- obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S"
- by blast
- from B have fB: "finite B" "card B = dim S"
- using independent_bound by blast+
- have bSS: "B \<subseteq> span S"
- using B(1) by (metis subset_eq span_inc)
- have sssB: "span S \<subseteq> span B"
- using span_mono[OF B(3)] by (simp add: span_span)
- from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
- using fB(2) by arith
-qed
-
-lemma subset_le_dim:
- fixes S :: "'a::euclidean_space set"
- shows "S \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
- by (metis dim_span dim_subset)
-
-lemma span_eq_dim:
- fixes S :: "'a::euclidean_space set"
- shows "span S = span T \<Longrightarrow> dim S = dim T"
- by (metis dim_span)
-
-lemma dim_image_le:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
- assumes lf: "linear f"
- shows "dim (f ` S) \<le> dim (S)"
-proof -
- from basis_exists[of S] obtain B where
- B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" by blast
- from B have fB: "finite B" "card B = dim S"
- using independent_bound by blast+
- have "dim (f ` S) \<le> card (f ` B)"
- apply (rule span_card_ge_dim)
- using lf B fB
- apply (auto simp add: span_linear_image spans_image subset_image_iff)
- done
- also have "\<dots> \<le> dim S"
- using card_image_le[OF fB(1)] fB by simp
- finally show ?thesis .
-qed
-
text \<open>Picking an orthogonal replacement for a spanning set.\<close>
lemma vector_sub_project_orthogonal:
@@ -2367,10 +763,10 @@
have "x - k *\<^sub>R (a - (\<Sum>x\<in>C. (x \<bullet> a / (x \<bullet> x)) *\<^sub>R x)) \<in> span C \<longleftrightarrow> x - k *\<^sub>R a \<in> span C"
apply (simp only: scaleR_right_diff_distrib th0)
apply (rule span_add_eq)
- apply (rule span_mul)
+ apply (rule span_scale)
apply (rule span_sum)
- apply (rule span_mul)
- apply (rule span_superset)
+ apply (rule span_scale)
+ apply (rule span_base)
apply assumption
done
}
@@ -2402,7 +798,8 @@
lemma orthogonal_basis_exists:
fixes V :: "('a::euclidean_space) set"
- shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (card B = dim V) \<and> pairwise orthogonal B"
+ shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and>
+ (card B = dim V) \<and> pairwise orthogonal B"
proof -
from basis_exists[of V] obtain B where
B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "card B = dim V"
@@ -2413,7 +810,7 @@
C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C"
by blast
from C B have CSV: "C \<subseteq> span V"
- by (metis span_inc span_mono subset_trans)
+ by (metis span_superset span_mono subset_trans)
from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C"
by (simp add: span_span)
from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
@@ -2423,7 +820,7 @@
by simp
moreover have "dim V \<le> card C"
using span_card_ge_dim[OF CSV SVC C(1)]
- by (simp add: dim_span)
+ by simp
ultimately have CdV: "card C = dim V"
using C(1) by simp
from C B CSV CdV iC show ?thesis
@@ -2440,7 +837,8 @@
from sU obtain a where a: "a \<notin> span S"
by blast
from orthogonal_basis_exists obtain B where
- B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "card B = dim S" "pairwise orthogonal B"
+ B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B"
+ "card B = dim S" "pairwise orthogonal B"
by blast
from B have fB: "finite B" "card B = dim S"
using independent_bound by auto
@@ -2451,8 +849,8 @@
have "sum (\<lambda>b. (a \<bullet> b / (b \<bullet> b)) *\<^sub>R b) B \<in> span S"
unfolding sSB
apply (rule span_sum)
- apply (rule span_mul)
- apply (rule span_superset)
+ apply (rule span_scale)
+ apply (rule span_base)
apply assumption
done
with a have a0:"?a \<noteq> 0"
@@ -2504,7 +902,7 @@
then have "dim (span S) = dim (UNIV :: ('a) set)"
by simp
then have "dim S = DIM('a)"
- by (simp add: dim_span dim_UNIV)
+ by (metis Euclidean_Space.dim_UNIV dim_span)
with d have False by arith
}
then have th: "span S \<noteq> UNIV"
@@ -2512,132 +910,15 @@
from span_not_univ_subset_hyperplane[OF th] show ?thesis .
qed
-text \<open>We can extend a linear basis-basis injection to the whole set.\<close>
-
-lemma linear_indep_image_lemma:
- assumes lf: "linear f"
- and fB: "finite B"
- and ifB: "independent (f ` B)"
- and fi: "inj_on f B"
- and xsB: "x \<in> span B"
- and fx: "f x = 0"
- shows "x = 0"
- using fB ifB fi xsB fx
-proof (induct arbitrary: x rule: finite_induct[OF fB])
- case 1
- then show ?case by auto
-next
- case (2 a b x)
- have fb: "finite b" using "2.prems" by simp
- have th0: "f ` b \<subseteq> f ` (insert a b)"
- apply (rule image_mono)
- apply blast
- done
- from independent_mono[ OF "2.prems"(2) th0]
- have ifb: "independent (f ` b)" .
- have fib: "inj_on f b"
- apply (rule subset_inj_on [OF "2.prems"(3)])
- apply blast
- done
- from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
- obtain k where k: "x - k*\<^sub>R a \<in> span (b - {a})"
- by blast
- have "f (x - k*\<^sub>R a) \<in> span (f ` b)"
- unfolding span_linear_image[OF lf]
- apply (rule imageI)
- using k span_mono[of "b - {a}" b]
- apply blast
- done
- then have "f x - k*\<^sub>R f a \<in> span (f ` b)"
- by (simp add: linear_diff[OF lf] linear_cmul[OF lf])
- then have th: "-k *\<^sub>R f a \<in> span (f ` b)"
- using "2.prems"(5) by simp
- have xsb: "x \<in> span b"
- proof (cases "k = 0")
- case True
- with k have "x \<in> span (b - {a})" by simp
- then show ?thesis using span_mono[of "b - {a}" b]
- by blast
- next
- case False
- with span_mul[OF th, of "- 1/ k"]
- have th1: "f a \<in> span (f ` b)"
- by auto
- from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
- have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
- from "2.prems"(2) [unfolded dependent_def bex_simps(8), rule_format, of "f a"]
- have "f a \<notin> span (f ` b)" using tha
- using "2.hyps"(2)
- "2.prems"(3) by auto
- with th1 have False by blast
- then show ?thesis by blast
- qed
- from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" .
-qed
-
-text \<open>Can construct an isomorphism between spaces of same dimension.\<close>
-
-lemma subspace_isomorphism:
- fixes S :: "'a::euclidean_space set"
- and T :: "'b::euclidean_space set"
- assumes s: "subspace S"
- and t: "subspace T"
- and d: "dim S = dim T"
- shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
-proof -
- from basis_exists[of S] independent_bound
- obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "card B = dim S" and fB: "finite B"
- by blast
- from basis_exists[of T] independent_bound
- obtain C where C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "card C = dim T" and fC: "finite C"
- by blast
- from B(4) C(4) card_le_inj[of B C] d
- obtain f where f: "f ` B \<subseteq> C" "inj_on f B" using \<open>finite B\<close> \<open>finite C\<close>
- by auto
- from linear_independent_extend[OF B(2)]
- obtain g where g: "linear g" "\<forall>x\<in> B. g x = f x"
- by blast
- from inj_on_iff_eq_card[OF fB, of f] f(2) have "card (f ` B) = card B"
- by simp
- with B(4) C(4) have ceq: "card (f ` B) = card C"
- using d by simp
- have "g ` B = f ` B"
- using g(2) by (auto simp add: image_iff)
- also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
- finally have gBC: "g ` B = C" .
- have gi: "inj_on g B"
- using f(2) g(2) by (auto simp add: inj_on_def)
- note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
- {
- fix x y
- assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
- from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B"
- by blast+
- from gxy have th0: "g (x - y) = 0"
- by (simp add: linear_diff[OF g(1)])
- have th1: "x - y \<in> span B"
- using x' y' by (metis span_diff)
- have "x = y"
- using g0[OF th1 th0] by simp
- }
- then have giS: "inj_on g S"
- unfolding inj_on_def by blast
- from span_subspace[OF B(1,3) s] have "g ` S = span (g ` B)"
- by (simp add: span_linear_image[OF g(1)])
- also have "\<dots> = span C" unfolding gBC ..
- also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
- finally have gS: "g ` S = T" .
- from g(1) gS giS show ?thesis
- by blast
-qed
-
lemma linear_eq_stdbasis:
fixes f :: "'a::euclidean_space \<Rightarrow> _"
assumes lf: "linear f"
and lg: "linear g"
- and fg: "\<forall>b\<in>Basis. f b = g b"
+ and fg: "\<And>b. b \<in> Basis \<Longrightarrow> f b = g b"
shows "f = g"
- using linear_eq[OF lf lg, of _ Basis] fg by auto
+ using linear_eq_on_span[OF lf lg, of Basis] fg
+ by auto
+
text \<open>Similar results for bilinear functions.\<close>
@@ -2652,7 +933,8 @@
let ?P = "{x. \<forall>y\<in> span C. f x y = g x y}"
from bf bg have sp: "subspace ?P"
unfolding bilinear_def linear_iff subspace_def bf bg
- by (auto simp add: span_0 bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def
+ by (auto simp add: span_zero bilinear_lzero[OF bf] bilinear_lzero[OF bg]
+ span_add Ball_def
intro: bilinear_ladd[OF bf])
have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
@@ -2662,7 +944,8 @@
apply (simp add: fg)
apply (auto simp add: subspace_def)
using bf bg unfolding bilinear_def linear_iff
- apply (auto simp add: span_0 bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def
+ apply (auto simp add: span_zero bilinear_rzero[OF bf] bilinear_rzero[OF bg]
+ span_add Ball_def
intro: bilinear_ladd[OF bf])
done
then show ?thesis
@@ -2677,234 +960,6 @@
shows "f = g"
using bilinear_eq[OF bf bg equalityD2[OF span_Basis] equalityD2[OF span_Basis] fg] by blast
-text \<open>An injective map @{typ "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"} is also surjective.\<close>
-
-lemma linear_injective_imp_surjective:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
- assumes lf: "linear f"
- and fi: "inj f"
- shows "surj f"
-proof -
- let ?U = "UNIV :: 'a set"
- from basis_exists[of ?U] obtain B
- where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "card B = dim ?U"
- by blast
- from B(4) have d: "dim ?U = card B"
- by simp
- have th: "?U \<subseteq> span (f ` B)"
- apply (rule card_ge_dim_independent)
- apply blast
- apply (rule independent_injective_image[OF B(2) lf fi])
- apply (rule order_eq_refl)
- apply (rule sym)
- unfolding d
- apply (rule card_image)
- apply (rule subset_inj_on[OF fi])
- apply blast
- done
- from th show ?thesis
- unfolding span_linear_image[OF lf] surj_def
- using B(3) by blast
-qed
-
-text \<open>And vice versa.\<close>
-
-lemma surjective_iff_injective_gen:
- assumes fS: "finite S"
- and fT: "finite T"
- and c: "card S = card T"
- and ST: "f ` S \<subseteq> T"
- shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof
- assume h: "?lhs"
- {
- fix x y
- assume x: "x \<in> S"
- assume y: "y \<in> S"
- assume f: "f x = f y"
- from x fS have S0: "card S \<noteq> 0"
- by auto
- have "x = y"
- proof (rule ccontr)
- assume xy: "\<not> ?thesis"
- have th: "card S \<le> card (f ` (S - {y}))"
- unfolding c
- apply (rule card_mono)
- apply (rule finite_imageI)
- using fS apply simp
- using h xy x y f unfolding subset_eq image_iff
- apply auto
- apply (case_tac "xa = f x")
- apply (rule bexI[where x=x])
- apply auto
- done
- also have " \<dots> \<le> card (S - {y})"
- apply (rule card_image_le)
- using fS by simp
- also have "\<dots> \<le> card S - 1" using y fS by simp
- finally show False using S0 by arith
- qed
- }
- then show ?rhs
- unfolding inj_on_def by blast
-next
- assume h: ?rhs
- have "f ` S = T"
- apply (rule card_subset_eq[OF fT ST])
- unfolding card_image[OF h]
- apply (rule c)
- done
- then show ?lhs by blast
-qed
-
-lemma linear_surjective_imp_injective:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
- assumes lf: "linear f"
- and sf: "surj f"
- shows "inj f"
-proof -
- let ?U = "UNIV :: 'a set"
- from basis_exists[of ?U] obtain B
- where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" and d: "card B = dim ?U"
- by blast
- {
- fix x
- assume x: "x \<in> span B"
- assume fx: "f x = 0"
- from B(2) have fB: "finite B"
- using independent_bound by auto
- have fBi: "independent (f ` B)"
- apply (rule card_le_dim_spanning[of "f ` B" ?U])
- apply blast
- using sf B(3)
- unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
- apply blast
- using fB apply blast
- unfolding d[symmetric]
- apply (rule card_image_le)
- apply (rule fB)
- done
- have th0: "dim ?U \<le> card (f ` B)"
- apply (rule span_card_ge_dim)
- apply blast
- unfolding span_linear_image[OF lf]
- apply (rule subset_trans[where B = "f ` UNIV"])
- using sf unfolding surj_def
- apply blast
- apply (rule image_mono)
- apply (rule B(3))
- apply (metis finite_imageI fB)
- done
- moreover have "card (f ` B) \<le> card B"
- by (rule card_image_le, rule fB)
- ultimately have th1: "card B = card (f ` B)"
- unfolding d by arith
- have fiB: "inj_on f B"
- unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric]
- by blast
- from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
- have "x = 0" by blast
- }
- then show ?thesis
- unfolding linear_injective_0[OF lf]
- using B(3)
- by blast
-qed
-
-text \<open>Hence either is enough for isomorphism.\<close>
-
-lemma left_right_inverse_eq:
- assumes fg: "f \<circ> g = id"
- and gh: "g \<circ> h = id"
- shows "f = h"
-proof -
- have "f = f \<circ> (g \<circ> h)"
- unfolding gh by simp
- also have "\<dots> = (f \<circ> g) \<circ> h"
- by (simp add: o_assoc)
- finally show "f = h"
- unfolding fg by simp
-qed
-
-lemma isomorphism_expand:
- "f \<circ> g = id \<and> g \<circ> f = id \<longleftrightarrow> (\<forall>x. f (g x) = x) \<and> (\<forall>x. g (f x) = x)"
- by (simp add: fun_eq_iff o_def id_def)
-
-lemma linear_injective_isomorphism:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
- assumes lf: "linear f"
- and fi: "inj f"
- shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
- unfolding isomorphism_expand[symmetric]
- using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]]
- linear_injective_left_inverse[OF lf fi]
- by (metis left_right_inverse_eq)
-
-lemma linear_surjective_isomorphism:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
- assumes lf: "linear f"
- and sf: "surj f"
- shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
- unfolding isomorphism_expand[symmetric]
- using linear_surjective_right_inverse[OF lf sf]
- linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
- by (metis left_right_inverse_eq)
-
-text \<open>Left and right inverses are the same for
- @{typ "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"}.\<close>
-
-lemma linear_inverse_left:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
- assumes lf: "linear f"
- and lf': "linear f'"
- shows "f \<circ> f' = id \<longleftrightarrow> f' \<circ> f = id"
-proof -
- {
- fix f f':: "'a \<Rightarrow> 'a"
- assume lf: "linear f" "linear f'"
- assume f: "f \<circ> f' = id"
- from f have sf: "surj f"
- apply (auto simp add: o_def id_def surj_def)
- apply metis
- done
- from linear_surjective_isomorphism[OF lf(1) sf] lf f
- have "f' \<circ> f = id"
- unfolding fun_eq_iff o_def id_def by metis
- }
- then show ?thesis
- using lf lf' by metis
-qed
-
-text \<open>Moreover, a one-sided inverse is automatically linear.\<close>
-
-lemma left_inverse_linear:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
- assumes lf: "linear f"
- and gf: "g \<circ> f = id"
- shows "linear g"
-proof -
- from gf have fi: "inj f"
- apply (auto simp add: inj_on_def o_def id_def fun_eq_iff)
- apply metis
- done
- from linear_injective_isomorphism[OF lf fi]
- obtain h :: "'a \<Rightarrow> 'a" where h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
- by blast
- have "h = g"
- apply (rule ext) using gf h(2,3)
- apply (simp add: o_def id_def fun_eq_iff)
- apply metis
- done
- with h(1) show ?thesis by blast
-qed
-
-lemma inj_linear_imp_inv_linear:
- fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
- assumes "linear f" "inj f" shows "linear (inv f)"
-using assms inj_iff left_inverse_linear by blast
-
-
subsection \<open>Infinity norm\<close>
definition%important "infnorm (x::'a::euclidean_space) = Sup {\<bar>x \<bullet> b\<bar> |b. b \<in> Basis}"
@@ -3181,7 +1236,7 @@
qed
then show ?thesis
apply (clarsimp simp: collinear_def)
- by (metis real_vector.scale_zero_right vector_fraction_eq_iff)
+ by (metis scaleR_zero_right vector_fraction_eq_iff)
qed
lemma collinear_subset: "\<lbrakk>collinear T; S \<subseteq> T\<rbrakk> \<Longrightarrow> collinear S"
--- a/src/HOL/Analysis/Path_Connected.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Path_Connected.thy Wed May 02 13:49:38 2018 +0200
@@ -6354,21 +6354,18 @@
by (meson subsetD image_eqI inj_on_def)
obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
using linear_independent_extend \<open>independent B\<close> by fastforce
- have "f ` S \<subseteq> T"
- by (metis ffb \<open>fb ` B \<subseteq> C\<close> \<open>linear f\<close> \<open>span B = S\<close> \<open>span C = T\<close> image_cong span_linear_image span_mono)
+ have "span (f ` B) \<subseteq> span C"
+ by (metis \<open>fb ` B \<subseteq> C\<close> ffb image_cong span_mono)
+ then have "f ` S \<subseteq> T"
+ unfolding \<open>span B = S\<close> \<open>span C = T\<close> span_linear_image[OF \<open>linear f\<close>] .
have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
using B1 C1 \<open>fb ` B \<subseteq> C\<close> by auto
have "norm (f x) = norm x" if "x \<in> S" for x
proof -
+ interpret linear f by fact
obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
- have "f x = (\<Sum>v \<in> B. f (a v *\<^sub>R v))"
- using linear_sum [OF \<open>linear f\<close>] x by auto
- also have "... = (\<Sum>v \<in> B. a v *\<^sub>R f v)"
- using \<open>linear f\<close> by (simp add: linear_sum linear.scaleR)
- also have "... = (\<Sum>v \<in> B. a v *\<^sub>R fb v)"
- by (simp add: ffb cong: sum.cong)
- finally have "norm (f x)^2 = norm (\<Sum>v\<in>B. a v *\<^sub>R fb v)^2" by simp
+ have "norm (f x)^2 = norm (\<Sum>v\<in>B. a v *\<^sub>R fb v)^2" by (simp add: sum scale ffb x)
also have "... = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
apply (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
apply (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
@@ -6410,6 +6407,7 @@
by (meson subsetD image_eqI inj_on_def)
obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
using linear_independent_extend \<open>independent B\<close> by fastforce
+ interpret f: linear f by fact
define gb where "gb \<equiv> inv_into B fb"
then have pairwise_orth_gb: "pairwise (\<lambda>v j. orthogonal (gb v) (gb j)) C"
using Borth
@@ -6417,8 +6415,12 @@
by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on bij_betw_inv_into_right inv_into_into)
obtain g where "linear g" and ggb: "\<And>x. x \<in> C \<Longrightarrow> g x = gb x"
using linear_independent_extend \<open>independent C\<close> by fastforce
- have "f ` S \<subseteq> T"
- by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on eq_iff ffb \<open>linear f\<close> \<open>span B = S\<close> \<open>span C = T\<close> image_cong span_linear_image)
+ interpret g: linear g by fact
+ have "span (f ` B) \<subseteq> span C"
+ by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on eq_iff ffb image_cong)
+ then have "f ` S \<subseteq> T"
+ unfolding \<open>span B = S\<close> \<open>span C = T\<close>
+ span_linear_image[OF \<open>linear f\<close>] .
have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
using B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on by fastforce
have f [simp]: "norm (f x) = norm x" "g (f x) = x" if "x \<in> S" for x
@@ -6428,7 +6430,7 @@
have "f x = (\<Sum>v \<in> B. f (a v *\<^sub>R v))"
using linear_sum [OF \<open>linear f\<close>] x by auto
also have "... = (\<Sum>v \<in> B. a v *\<^sub>R f v)"
- using \<open>linear f\<close> by (simp add: linear_sum linear.scaleR)
+ by (simp add: f.sum f.scale)
also have "... = (\<Sum>v \<in> B. a v *\<^sub>R fb v)"
by (simp add: ffb cong: sum.cong)
finally have *: "f x = (\<Sum>v\<in>B. a v *\<^sub>R fb v)" .
@@ -6443,9 +6445,9 @@
by (simp add: norm_eq_sqrt_inner)
have "g (f x) = g (\<Sum>v\<in>B. a v *\<^sub>R fb v)" by (simp add: *)
also have "... = (\<Sum>v\<in>B. g (a v *\<^sub>R fb v))"
- using \<open>linear g\<close> by (simp add: linear_sum linear.scaleR)
+ by (simp add: g.sum g.scale)
also have "... = (\<Sum>v\<in>B. a v *\<^sub>R g (fb v))"
- by (simp add: \<open>linear g\<close> linear.scaleR)
+ by (simp add: g.scale)
also have "... = (\<Sum>v\<in>B. a v *\<^sub>R v)"
apply (rule sum.cong [OF refl])
using \<open>bij_betw fb B C\<close> gb_def bij_betwE bij_betw_inv_into_left gb_def ggb by fastforce
@@ -6460,16 +6462,16 @@
obtain a where x: "x = (\<Sum>v \<in> C. a v *\<^sub>R v)"
using \<open>finite C\<close> \<open>span C = T\<close> \<open>x \<in> T\<close> span_finite by fastforce
have "g x = (\<Sum>v \<in> C. g (a v *\<^sub>R v))"
- using linear_sum [OF \<open>linear g\<close>] x by auto
+ by (simp add: x g.sum)
also have "... = (\<Sum>v \<in> C. a v *\<^sub>R g v)"
- using \<open>linear g\<close> by (simp add: linear_sum linear.scaleR)
+ by (simp add: g.scale)
also have "... = (\<Sum>v \<in> C. a v *\<^sub>R gb v)"
by (simp add: ggb cong: sum.cong)
finally have "f (g x) = f (\<Sum>v\<in>C. a v *\<^sub>R gb v)" by simp
also have "... = (\<Sum>v\<in>C. f (a v *\<^sub>R gb v))"
- using \<open>linear f\<close> by (simp add: linear_sum linear.scaleR)
+ by (simp add: f.scale f.sum)
also have "... = (\<Sum>v\<in>C. a v *\<^sub>R f (gb v))"
- by (simp add: \<open>linear f\<close> linear.scaleR)
+ by (simp add: f.scale f.sum)
also have "... = (\<Sum>v\<in>C. a v *\<^sub>R v)"
using \<open>bij_betw fb B C\<close>
by (simp add: bij_betw_def gb_def bij_betw_inv_into_right ffb inv_into_into)
@@ -6478,7 +6480,8 @@
finally show "f (g x) = x" .
qed
have gim: "g ` T = S"
- by (metis (no_types, lifting) \<open>f ` S \<subseteq> T\<close> \<open>linear g\<close> \<open>span B = S\<close> \<open>span C = T\<close> d dim_eq_span dim_image_le f(2) image_subset_iff span_linear_image span_span subsetI)
+ by (metis (full_types) S T \<open>f ` S \<subseteq> T\<close> d dim_eq_span dim_image_le f(2) g.linear_axioms
+ image_iff linear_subspace_image span_eq_iff subset_iff)
have fim: "f ` S = T"
using \<open>g ` T = S\<close> image_iff by fastforce
have [simp]: "norm (g x) = norm x" if "x \<in> T" for x
@@ -6504,8 +6507,8 @@
obtains f::"'M::euclidean_space \<Rightarrow>'N::euclidean_space" and g
where "linear f" "linear g"
"\<And>x. norm(f x) = norm x" "\<And>y. norm(g y) = norm y"
- "\<And>x. g(f x) = x" "\<And>y. f(g y) = y"
- using assms by (auto simp: dim_UNIV intro: isometries_subspaces [of "UNIV::'M set" "UNIV::'N set"])
+ "\<And>x. g (f x) = x" "\<And>y. f(g y) = y"
+ using assms by (auto simp: intro: isometries_subspaces [of "UNIV::'M set" "UNIV::'N set"])
lemma homeomorphic_subspaces:
fixes S :: "'a::euclidean_space set"
@@ -7079,7 +7082,7 @@
shows "uncountable (ball a r)"
proof -
have "uncountable (open_segment a (a + r *\<^sub>R (SOME i. i \<in> Basis)))"
- by (metis Basis_zero SOME_Basis add_cancel_right_right assms less_le real_vector.scale_eq_0_iff uncountable_open_segment)
+ by (metis Basis_zero SOME_Basis add_cancel_right_right assms less_le scale_eq_0_iff uncountable_open_segment)
moreover have "open_segment a (a + r *\<^sub>R (SOME i. i \<in> Basis)) \<subseteq> ball a r"
using assms by (auto simp: in_segment algebra_simps dist_norm SOME_Basis)
ultimately show ?thesis
--- a/src/HOL/Analysis/Polytope.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Polytope.thy Wed May 02 13:49:38 2018 +0200
@@ -197,8 +197,7 @@
by (simp add: algebra_simps d_def) (simp add: divide_simps)
have [simp]: "((e - e * e / (e + norm (b - c))) / norm (b - c)) = (e / (e + norm (b - c)))"
using False nbc
- apply (simp add: algebra_simps divide_simps)
- by (metis mult_eq_0_iff norm_eq_zero norm_imp_pos_and_ge norm_pths(2) real_scaleR_def scaleR_left.add zero_less_norm_iff)
+ by (simp add: divide_simps) (simp add: algebra_simps)
have "b \<in> open_segment d c"
apply (simp add: open_segment_image_interval)
apply (simp add: d_def algebra_simps image_def)
@@ -2673,7 +2672,8 @@
lemma polyhedron_negations:
fixes S :: "'a :: euclidean_space set"
shows "polyhedron S \<Longrightarrow> polyhedron(image uminus S)"
-by (auto simp: polyhedron_linear_image_eq linear_uminus bij_uminus)
+ by (subst polyhedron_linear_image_eq)
+ (auto simp: bij_uminus intro!: linear_uminus)
subsection\<open>Relation between polytopes and polyhedra\<close>
--- a/src/HOL/Analysis/Product_Vector.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Product_Vector.thy Wed May 02 13:49:38 2018 +0200
@@ -10,6 +10,52 @@
"HOL-Library.Product_Plus"
begin
+lemma Times_eq_image_sum:
+ fixes S :: "'a :: comm_monoid_add set" and T :: "'b :: comm_monoid_add set"
+ shows "S \<times> T = {u + v |u v. u \<in> (\<lambda>x. (x, 0)) ` S \<and> v \<in> Pair 0 ` T}"
+ by force
+
+
+subsection \<open>Product is a module\<close>
+
+locale module_prod = module_pair begin
+
+definition scale :: "'a \<Rightarrow> 'b \<times> 'c \<Rightarrow> 'b \<times> 'c"
+ where "scale a v = (s1 a (fst v), s2 a (snd v))"
+
+lemma scale_prod: "scale x (a, b) = (s1 x a, s2 x b)"
+ by (auto simp: scale_def)
+
+sublocale p: module scale
+proof qed (simp_all add: scale_def
+ m1.scale_left_distrib m1.scale_right_distrib m2.scale_left_distrib m2.scale_right_distrib)
+
+lemma subspace_Times: "m1.subspace A \<Longrightarrow> m2.subspace B \<Longrightarrow> p.subspace (A \<times> B)"
+ unfolding m1.subspace_def m2.subspace_def p.subspace_def
+ by (auto simp: zero_prod_def scale_def)
+
+lemma module_hom_fst: "module_hom scale s1 fst"
+ by unfold_locales (auto simp: scale_def)
+
+lemma module_hom_snd: "module_hom scale s2 snd"
+ by unfold_locales (auto simp: scale_def)
+
+end
+
+locale vector_space_prod = vector_space_pair begin
+
+sublocale module_prod s1 s2
+ rewrites "module_hom = Vector_Spaces.linear"
+ by unfold_locales (fact module_hom_eq_linear)
+
+sublocale p: vector_space scale by unfold_locales (auto simp: algebra_simps)
+
+lemmas linear_fst = module_hom_fst
+ and linear_snd = module_hom_snd
+
+end
+
+
subsection \<open>Product is a real vector space\<close>
instantiation%important prod :: (real_vector, real_vector) real_vector
@@ -42,6 +88,27 @@
end
+lemma module_prod_scale_eq_scaleR: "module_prod.scale ( *\<^sub>R) ( *\<^sub>R) = scaleR"
+ apply (rule ext) apply (rule ext)
+ apply (subst module_prod.scale_def)
+ subgoal by unfold_locales
+ by (simp add: scaleR_prod_def)
+
+interpretation real_vector?: vector_space_prod "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
+ rewrites "scale = (( *\<^sub>R)::_\<Rightarrow>_\<Rightarrow>('a \<times> 'b))"
+ and "module.dependent ( *\<^sub>R) = dependent"
+ and "module.representation ( *\<^sub>R) = representation"
+ and "module.subspace ( *\<^sub>R) = subspace"
+ and "module.span ( *\<^sub>R) = span"
+ and "vector_space.extend_basis ( *\<^sub>R) = extend_basis"
+ and "vector_space.dim ( *\<^sub>R) = dim"
+ and "Vector_Spaces.linear ( *\<^sub>R) ( *\<^sub>R) = linear"
+ subgoal by unfold_locales
+ subgoal by (fact module_prod_scale_eq_scaleR)
+ unfolding dependent_raw_def representation_raw_def subspace_raw_def span_raw_def
+ extend_basis_raw_def dim_raw_def linear_def
+ by (rule refl)+
+
subsection \<open>Product is a metric space\<close>
(* TODO: Product of uniform spaces and compatibility with metric_spaces! *)
@@ -270,7 +337,7 @@
show "(f (x + y), g (x + y)) = (f x, g x) + (f y, g y)"
by (simp add: f.add g.add)
show "(f (r *\<^sub>R x), g (r *\<^sub>R x)) = r *\<^sub>R (f x, g x)"
- by (simp add: f.scaleR g.scaleR)
+ by (simp add: f.scale g.scale)
obtain Kf where "0 < Kf" and norm_f: "\<And>x. norm (f x) \<le> norm x * Kf"
using f.pos_bounded by fast
obtain Kg where "0 < Kg" and norm_g: "\<And>x. norm (g x) \<le> norm x * Kg"
@@ -389,4 +456,112 @@
unfolding norm_Pair
by (metis norm_ge_zero sqrt_sum_squares_le_sum)
+lemma (in vector_space_prod) span_Times_sing1: "p.span ({0} \<times> B) = {0} \<times> vs2.span B"
+ apply (rule p.span_unique)
+ subgoal by (auto intro!: vs1.span_base vs2.span_base)
+ subgoal using vs1.subspace_single_0 vs2.subspace_span by (rule subspace_Times)
+ subgoal for T
+ proof safe
+ fix b
+ assume subset_T: "{0} \<times> B \<subseteq> T" and subspace: "p.subspace T" and b_span: "b \<in> vs2.span B"
+ then obtain t r where b: "b = (\<Sum>a\<in>t. r a *b a)" and t: "finite t" "t \<subseteq> B"
+ by (auto simp: vs2.span_explicit)
+ have "(0, b) = (\<Sum>b\<in>t. scale (r b) (0, b))"
+ unfolding b scale_prod sum_prod
+ by simp
+ also have "\<dots> \<in> T"
+ using \<open>t \<subseteq> B\<close> subset_T
+ by (auto intro!: p.subspace_sum p.subspace_scale subspace)
+ finally show "(0, b) \<in> T" .
+ qed
+ done
+
+lemma (in vector_space_prod) span_Times_sing2: "p.span (A \<times> {0}) = vs1.span A \<times> {0}"
+ apply (rule p.span_unique)
+ subgoal by (auto intro!: vs1.span_base vs2.span_base)
+ subgoal using vs1.subspace_span vs2.subspace_single_0 by (rule subspace_Times)
+ subgoal for T
+ proof safe
+ fix a
+ assume subset_T: "A \<times> {0} \<subseteq> T" and subspace: "p.subspace T" and a_span: "a \<in> vs1.span A"
+ then obtain t r where a: "a = (\<Sum>a\<in>t. r a *a a)" and t: "finite t" "t \<subseteq> A"
+ by (auto simp: vs1.span_explicit)
+ have "(a, 0) = (\<Sum>a\<in>t. scale (r a) (a, 0))"
+ unfolding a scale_prod sum_prod
+ by simp
+ also have "\<dots> \<in> T"
+ using \<open>t \<subseteq> A\<close> subset_T
+ by (auto intro!: p.subspace_sum p.subspace_scale subspace)
+ finally show "(a, 0) \<in> T" .
+ qed
+ done
+
+lemma (in finite_dimensional_vector_space) zero_not_in_Basis[simp]: "0 \<notin> Basis"
+ using dependent_zero local.independent_Basis by blast
+
+locale finite_dimensional_vector_space_prod = vector_space_prod + finite_dimensional_vector_space_pair begin
+
+definition "Basis_pair = B1 \<times> {0} \<union> {0} \<times> B2"
+
+sublocale p: finite_dimensional_vector_space scale Basis_pair
+proof unfold_locales
+ show "finite Basis_pair"
+ by (auto intro!: finite_cartesian_product vs1.finite_Basis vs2.finite_Basis simp: Basis_pair_def)
+ show "p.independent Basis_pair"
+ unfolding p.dependent_def Basis_pair_def
+ proof safe
+ fix a
+ assume a: "a \<in> B1"
+ assume "(a, 0) \<in> p.span (B1 \<times> {0} \<union> {0} \<times> B2 - {(a, 0)})"
+ also have "B1 \<times> {0} \<union> {0} \<times> B2 - {(a, 0)} = (B1 - {a}) \<times> {0} \<union> {0} \<times> B2"
+ by auto
+ finally show False
+ using a vs1.dependent_def vs1.independent_Basis
+ by (auto simp: p.span_Un span_Times_sing1 span_Times_sing2)
+ next
+ fix b
+ assume b: "b \<in> B2"
+ assume "(0, b) \<in> p.span (B1 \<times> {0} \<union> {0} \<times> B2 - {(0, b)})"
+ also have "(B1 \<times> {0} \<union> {0} \<times> B2 - {(0, b)}) = B1 \<times> {0} \<union> {0} \<times> (B2 - {b})"
+ by auto
+ finally show False
+ using b vs2.dependent_def vs2.independent_Basis
+ by (auto simp: p.span_Un span_Times_sing1 span_Times_sing2)
+ qed
+ show "p.span Basis_pair = UNIV"
+ by (auto simp: p.span_Un span_Times_sing2 span_Times_sing1 vs1.span_Basis vs2.span_Basis
+ Basis_pair_def)
+qed
+
+lemma dim_Times:
+ assumes "vs1.subspace S" "vs2.subspace T"
+ shows "p.dim(S \<times> T) = vs1.dim S + vs2.dim T"
+proof -
+ interpret p1: Vector_Spaces.linear s1 scale "(\<lambda>x. (x, 0))"
+ by unfold_locales (auto simp: scale_def)
+ interpret pair1: finite_dimensional_vector_space_pair "( *a)" B1 scale Basis_pair
+ by unfold_locales
+ interpret p2: Vector_Spaces.linear s2 scale "(\<lambda>x. (0, x))"
+ by unfold_locales (auto simp: scale_def)
+ interpret pair2: finite_dimensional_vector_space_pair "( *b)" B2 scale Basis_pair
+ by unfold_locales
+ have ss: "p.subspace ((\<lambda>x. (x, 0)) ` S)" "p.subspace (Pair 0 ` T)"
+ by (rule p1.subspace_image p2.subspace_image assms)+
+ have "p.dim(S \<times> T) = p.dim({u + v |u v. u \<in> (\<lambda>x. (x, 0)) ` S \<and> v \<in> Pair 0 ` T})"
+ by (simp add: Times_eq_image_sum)
+ moreover have "p.dim ((\<lambda>x. (x, 0::'c)) ` S) = vs1.dim S" "p.dim (Pair (0::'b) ` T) = vs2.dim T"
+ by (simp_all add: inj_on_def p1.linear_axioms pair1.dim_image_eq p2.linear_axioms pair2.dim_image_eq)
+ moreover have "p.dim ((\<lambda>x. (x, 0)) ` S \<inter> Pair 0 ` T) = 0"
+ by (subst p.dim_eq_0) auto
+ ultimately show ?thesis
+ using p.dim_sums_Int [OF ss] by linarith
+qed
+
+lemma dimension_pair: "p.dimension = vs1.dimension + vs2.dimension"
+ using dim_Times[OF vs1.subspace_UNIV vs2.subspace_UNIV]
+ by (auto simp: p.dim_UNIV vs1.dim_UNIV vs2.dim_UNIV
+ p.dimension_def vs1.dimension_def vs2.dimension_def)
+
end
+
+end
--- a/src/HOL/Analysis/Sigma_Algebra.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Sigma_Algebra.thy Wed May 02 13:49:38 2018 +0200
@@ -11,7 +11,6 @@
imports
Complex_Main
"HOL-Library.Countable_Set"
- "HOL-Library.FuncSet"
"HOL-Library.Indicator_Function"
"HOL-Library.Extended_Nonnegative_Real"
"HOL-Library.Disjoint_Sets"
--- a/src/HOL/Analysis/Starlike.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Starlike.thy Wed May 02 13:49:38 2018 +0200
@@ -10,7 +10,6 @@
theory Starlike
imports Convex_Euclidean_Space
-
begin
subsection \<open>Midpoint\<close>
@@ -108,8 +107,12 @@
using less_eq_real_def by (auto simp: segment algebra_simps)
lemma closed_segment_linear_image:
- "linear f \<Longrightarrow> closed_segment (f a) (f b) = f ` (closed_segment a b)"
- by (force simp add: in_segment linear_add_cmul)
+ "closed_segment (f a) (f b) = f ` (closed_segment a b)" if "linear f"
+proof -
+ interpret linear f by fact
+ show ?thesis
+ by (force simp add: in_segment add scale)
+qed
lemma open_segment_linear_image:
"\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> open_segment (f a) (f b) = f ` (open_segment a b)"
@@ -1680,9 +1683,9 @@
fix x :: "'a::euclidean_space"
assume "x \<in> d"
then have "x \<in> span d"
- using span_superset[of _ "d"] by auto
+ using span_base[of _ "d"] by auto
then have "x /\<^sub>R (2 * real (card d)) \<in> span d"
- using span_mul[of x "d" "(inverse (real (card d)) / 2)"] by auto
+ using span_scale[of x "d" "(inverse (real (card d)) / 2)"] by auto
}
then show "\<And>x. x\<in>d \<Longrightarrow> x /\<^sub>R (2 * real (card d)) \<in> span d"
by auto
@@ -1705,22 +1708,26 @@
then show ?thesis using rel_interior_sing by auto
next
case False
- obtain B where B: "independent B \<and> B \<le> S \<and> S \<le> span B \<and> card B = dim S"
+ obtain B where B: "independent B \<and> B \<le> S \<and> S \<le> span B \<and>
+ card B = dim S"
using basis_exists[of S] by auto
then have "B \<noteq> {}"
using B assms \<open>S \<noteq> {0}\<close> span_empty by auto
have "insert 0 B \<le> span B"
- using subspace_span[of B] subspace_0[of "span B"] span_inc by auto
+ using subspace_span[of B] subspace_0[of "span B"]
+ span_superset by auto
then have "span (insert 0 B) \<le> span B"
using span_span[of B] span_mono[of "insert 0 B" "span B"] by blast
then have "convex hull insert 0 B \<le> span B"
using convex_hull_subset_span[of "insert 0 B"] by auto
then have "span (convex hull insert 0 B) \<le> span B"
- using span_span[of B] span_mono[of "convex hull insert 0 B" "span B"] by blast
+ using span_span[of B]
+ span_mono[of "convex hull insert 0 B" "span B"] by blast
then have *: "span (convex hull insert 0 B) = span B"
using span_mono[of B "convex hull insert 0 B"] hull_subset[of "insert 0 B"] by auto
then have "span (convex hull insert 0 B) = span S"
- using B span_mono[of B S] span_mono[of S "span B"] span_span[of B] by auto
+ using B span_mono[of B S] span_mono[of S "span B"]
+ span_span[of B] by auto
moreover have "0 \<in> affine hull (convex hull insert 0 B)"
using hull_subset[of "convex hull insert 0 B"] hull_subset[of "insert 0 B"] by auto
ultimately have **: "affine hull (convex hull insert 0 B) = affine hull S"
@@ -1787,8 +1794,8 @@
obtains a where "a \<in> interior (convex hull (insert 0 S))"
proof -
have "affine hull (insert 0 S) = UNIV"
- apply (simp add: hull_inc affine_hull_span_0)
- using assms dim_eq_full indep_card_eq_dim_span by fastforce
+ by (simp add: hull_inc affine_hull_span_0 dim_eq_full[symmetric]
+ assms(1) assms(3) dim_eq_card_independent)
moreover have "rel_interior (convex hull insert 0 S) \<noteq> {}"
using rel_interior_eq_empty [of "convex hull (insert 0 S)"] by auto
ultimately have "interior (convex hull insert 0 S) \<noteq> {}"
@@ -2815,6 +2822,7 @@
using assms rel_interior_empty rel_interior_eq_empty by auto
next
case False
+ interpret linear f by fact
have *: "f ` (rel_interior S) \<subseteq> f ` S"
unfolding image_mono using rel_interior_subset by auto
have "f ` S \<subseteq> f ` (closure S)"
@@ -2847,15 +2855,15 @@
then obtain e where e: "e > 1" "(1 - e) *\<^sub>R x1 + e *\<^sub>R z1 \<in> S"
using convex_rel_interior_iff[of S z1] \<open>convex S\<close> x1 z1 by auto
moreover have "f ((1 - e) *\<^sub>R x1 + e *\<^sub>R z1) = (1 - e) *\<^sub>R x + e *\<^sub>R z"
- using x1 z1 \<open>linear f\<close> by (simp add: linear_add_cmul)
+ using x1 z1 by (simp add: linear_add linear_scale \<open>linear f\<close>)
ultimately have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f ` S"
using imageI[of "(1 - e) *\<^sub>R x1 + e *\<^sub>R z1" S f] by auto
then have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f ` S"
using e by auto
}
then have "z \<in> rel_interior (f ` S)"
- using convex_rel_interior_iff[of "f ` S" z] \<open>convex S\<close>
- \<open>linear f\<close> \<open>S \<noteq> {}\<close> convex_linear_image[of f S] linear_conv_bounded_linear[of f]
+ using convex_rel_interior_iff[of "f ` S" z] \<open>convex S\<close> \<open>linear f\<close>
+ \<open>S \<noteq> {}\<close> convex_linear_image[of f S] linear_conv_bounded_linear[of f]
by auto
}
ultimately show ?thesis by auto
@@ -2868,6 +2876,7 @@
and "f -` (rel_interior S) \<noteq> {}"
shows "rel_interior (f -` S) = f -` (rel_interior S)"
proof -
+ interpret linear f by fact
have "S \<noteq> {}"
using assms rel_interior_empty by auto
have nonemp: "f -` S \<noteq> {}"
@@ -2877,7 +2886,7 @@
have conv: "convex (f -` S)"
using convex_linear_vimage assms by auto
then have "convex (S \<inter> range f)"
- by (metis assms(1) assms(2) convex_Int subspace_UNIV subspace_imp_convex subspace_linear_image)
+ by (simp add: assms(2) convex_Int convex_linear_image linear_axioms)
{
fix z
assume "z \<in> f -` (rel_interior S)"
@@ -2917,7 +2926,7 @@
convex_rel_interior_iff[of "S \<inter> (range f)" "f z"]
by auto
moreover have "affine (range f)"
- by (metis assms(1) subspace_UNIV subspace_imp_affine subspace_linear_image)
+ by (simp add: linear_axioms linear_subspace_image subspace_imp_affine)
ultimately have "f z \<in> rel_interior S"
using convex_affine_rel_interior_Int[of S "range f"] assms by auto
then have "z \<in> f -` (rel_interior S)"
@@ -3888,9 +3897,7 @@
apply (induct s rule: finite_induct)
apply (simp_all add: affine_dependent_iff_dependent affine_hull_insert_span_gen interior_translation)
apply (rule empty_interior_lowdim)
- apply (simp add: affine_dependent_iff_dependent affine_hull_insert_span_gen)
- apply (metis Suc_le_lessD not_less order_trans card_image_le finite_imageI dim_le_card)
- done
+ by (auto simp: Suc_le_lessD card_image_le dual_order.trans intro!: dim_le_card'[THEN le_less_trans])
lemma empty_interior_convex_hull:
fixes s :: "'a::euclidean_space set"
@@ -5641,7 +5648,7 @@
by (simp add: algebra_simps)
have "inverse k *\<^sub>R k *\<^sub>R (x-a) \<in> span ((\<lambda>x. x - a) ` (S \<inter> T))"
apply (rule span_mul)
- apply (rule span_superset)
+ apply (rule span_base)
apply (rule image_eqI [where x = "a + k *\<^sub>R (x - a)"])
apply (auto simp: S T)
done
@@ -5799,7 +5806,7 @@
by (auto simp: sum.remove [of _ k] inner_commute assms that)
finally have "x = (\<Sum>b\<in>Basis - {k}. (x \<bullet> b) *\<^sub>R b)" .
then show ?thesis
- by (simp add: Linear_Algebra.span_finite) metis
+ by (simp add: span_finite)
qed
show ?thesis
apply (rule span_subspace [symmetric])
@@ -5811,11 +5818,11 @@
lemma dim_special_hyperplane:
fixes k :: "'n::euclidean_space"
shows "k \<in> Basis \<Longrightarrow> dim {x. k \<bullet> x = 0} = DIM('n) - 1"
-apply (simp add: special_hyperplane_span)
-apply (rule Linear_Algebra.dim_unique [OF subset_refl])
-apply (auto simp: Diff_subset independent_substdbasis)
-apply (metis member_remove remove_def span_clauses(1))
-done
+ apply (simp add: special_hyperplane_span)
+ apply (rule dim_unique [OF order_refl])
+ apply (auto simp: Diff_subset independent_substdbasis)
+ apply (metis member_remove remove_def span_clauses(1))
+ done
proposition dim_hyperplane:
fixes a :: "'a::euclidean_space"
@@ -5831,7 +5838,7 @@
and ortho: "pairwise orthogonal B"
using orthogonal_basis_exists by metis
with assms have "a \<notin> span B"
- by (metis (mono_tags, lifting) span_eq inner_eq_zero_iff mem_Collect_eq span0 span_subspace)
+ by (metis (mono_tags, lifting) span_eq inner_eq_zero_iff mem_Collect_eq span0)
then have ind: "independent (insert a B)"
by (simp add: \<open>independent B\<close> independent_insert)
have "finite B"
@@ -5843,13 +5850,15 @@
using assms
by (auto simp: algebra_simps)
show "y \<in> span (insert a B)"
- by (metis (mono_tags, lifting) z Bsub Convex_Euclidean_Space.span_eq
+ by (metis (mono_tags, lifting) z Bsub span_eq_iff
add_diff_cancel_left' mem_Collect_eq span0 span_breakdown_eq span_subspace subspB)
qed
then have dima: "DIM('a) = dim(insert a B)"
- by (metis antisym dim_UNIV dim_subset_UNIV subset_le_dim)
+ by (metis independent_Basis span_Basis dim_eq_card top.extremum_uniqueI)
then show ?thesis
- by (metis (mono_tags, lifting) Bsub Diff_insert_absorb \<open>a \<notin> span B\<close> ind card0 card_Diff_singleton dim_span indep_card_eq_dim_span insertI1 subsetCE subspB)
+ by (metis (mono_tags, lifting) Bsub Diff_insert_absorb \<open>a \<notin> span B\<close> ind card0
+ card_Diff_singleton dim_span indep_card_eq_dim_span insertI1 subsetCE
+ subspB)
qed
lemma lowdim_eq_hyperplane:
@@ -5857,13 +5866,15 @@
assumes "dim S = DIM('a) - 1"
obtains a where "a \<noteq> 0" and "span S = {x. a \<bullet> x = 0}"
proof -
- have [simp]: "dim S < DIM('a)"
- by (simp add: DIM_positive assms)
+ have dimS: "dim S < DIM('a)"
+ by (simp add: assms)
then obtain b where b: "b \<noteq> 0" "span S \<subseteq> {a. b \<bullet> a = 0}"
using lowdim_subset_hyperplane [of S] by fastforce
show ?thesis
- using b that real_vector_class.subspace_span [of S]
- by (simp add: assms dim_hyperplane subspace_dim_equal subspace_hyperplane)
+ apply (rule that[OF b(1)])
+ apply (rule subspace_dim_equal)
+ by (auto simp: assms b dim_hyperplane dim_span subspace_hyperplane
+ subspace_span)
qed
lemma dim_eq_hyperplane:
@@ -5927,47 +5938,6 @@
subsection%unimportant\<open>Some stepping theorems\<close>
-lemma dim_empty [simp]: "dim ({} :: 'a::euclidean_space set) = 0"
- by (force intro!: dim_unique)
-
-lemma dim_insert:
- fixes x :: "'a::euclidean_space"
- shows "dim (insert x S) = (if x \<in> span S then dim S else dim S + 1)"
-proof -
- show ?thesis
- proof (cases "x \<in> span S")
- case True then show ?thesis
- by (metis dim_span span_redundant)
- next
- case False
- obtain B where B: "B \<subseteq> span S" "independent B" "span S \<subseteq> span B" "card B = dim (span S)"
- using basis_exists [of "span S"] by blast
- have 1: "insert x B \<subseteq> span (insert x S)"
- by (meson \<open>B \<subseteq> span S\<close> dual_order.trans insertI1 insert_subsetI span_mono span_superset subset_insertI)
- have 2: "span (insert x S) \<subseteq> span (insert x B)"
- by (metis \<open>B \<subseteq> span S\<close> \<open>span S \<subseteq> span B\<close> span_breakdown_eq span_subspace subsetI subspace_span)
- have 3: "independent (insert x B)"
- by (metis B independent_insert span_subspace subspace_span False)
- have "dim (span (insert x S)) = Suc (dim S)"
- apply (rule dim_unique [OF 1 2 3])
- by (metis B False card_insert_disjoint dim_span independent_imp_finite subsetCE)
- then show ?thesis
- by (simp add: False)
- qed
-qed
-
-lemma dim_singleton [simp]:
- fixes x :: "'a::euclidean_space"
- shows "dim{x} = (if x = 0 then 0 else 1)"
-by (simp add: dim_insert)
-
-lemma dim_eq_0 [simp]:
- fixes S :: "'a::euclidean_space set"
- shows "dim S = 0 \<longleftrightarrow> S \<subseteq> {0}"
-apply safe
-apply (metis DIM_positive DIM_real card_ge_dim_independent contra_subsetD dim_empty dim_insert dim_singleton empty_subsetI independent_empty less_not_refl zero_le)
-by (metis dim_singleton dim_subset le_0_eq)
-
lemma aff_dim_insert:
fixes a :: "'a::euclidean_space"
shows "aff_dim (insert a S) = (if a \<in> affine hull S then aff_dim S else aff_dim S + 1)"
@@ -5981,9 +5951,7 @@
show ?thesis using S
apply (simp add: hull_redundant cong: aff_dim_affine_hull2)
apply (simp add: affine_hull_insert_span_gen hull_inc)
- apply (simp add: insert_commute [of a] hull_inc aff_dim_eq_dim [of x] dim_insert)
- apply (metis (no_types, lifting) add_minus_cancel image_iff uminus_add_conv_diff)
- done
+ by (force simp add:span_zero insert_commute [of a] hull_inc aff_dim_eq_dim [of x] dim_insert)
qed
lemma affine_dependent_choose:
@@ -6147,7 +6115,7 @@
then have "norm (a /\<^sub>R (norm a)) = 1"
by simp
moreover have "a /\<^sub>R (norm a) \<in> span S"
- by (simp add: \<open>a \<in> S\<close> span_mul span_superset)
+ by (simp add: \<open>a \<in> S\<close> span_scale span_base)
ultimately have ass: "a /\<^sub>R (norm a) \<in> span S \<inter> sphere 0 1"
by simp
show ?thesis
@@ -6171,7 +6139,7 @@
moreover have "norm (a /\<^sub>R (norm a)) = 1"
using \<open>a \<noteq> 0\<close> by simp
moreover have "a /\<^sub>R (norm a) \<in> span S"
- by (simp add: \<open>a \<in> S\<close> span_mul span_superset)
+ by (simp add: \<open>a \<in> S\<close> span_scale span_base)
ultimately have ass: "a /\<^sub>R (norm a) \<in> span S \<inter> sphere 0 1"
by simp
have aa: "a /\<^sub>R (norm a) \<in> (\<Inter>c\<in>C. {x. 0 \<le> c \<bullet> x})"
@@ -6636,41 +6604,6 @@
qed
qed
-subsection%unimportant\<open>Misc results about span\<close>
-
-lemma eq_span_insert_eq:
- assumes "(x - y) \<in> span S"
- shows "span(insert x S) = span(insert y S)"
-proof -
- have *: "span(insert x S) \<subseteq> span(insert y S)" if "(x - y) \<in> span S" for x y
- proof -
- have 1: "(r *\<^sub>R x - r *\<^sub>R y) \<in> span S" for r
- by (metis real_vector.scale_right_diff_distrib span_mul that)
- have 2: "(z - k *\<^sub>R y) - k *\<^sub>R (x - y) = z - k *\<^sub>R x" for z k
- by (simp add: real_vector.scale_right_diff_distrib)
- show ?thesis
- apply (clarsimp simp add: span_breakdown_eq)
- by (metis 1 2 diff_add_cancel real_vector.scale_right_diff_distrib span_add_eq)
- qed
- show ?thesis
- apply (intro subset_antisym * assms)
- using assms subspace_neg subspace_span minus_diff_eq by force
-qed
-
-lemma dim_psubset:
- fixes S :: "'a :: euclidean_space set"
- shows "span S \<subset> span T \<Longrightarrow> dim S < dim T"
-by (metis (no_types, hide_lams) dim_span less_le not_le subspace_dim_equal subspace_span)
-
-
-lemma basis_subspace_exists:
- fixes S :: "'a::euclidean_space set"
- shows
- "subspace S
- \<Longrightarrow> \<exists>b. finite b \<and> b \<subseteq> S \<and>
- independent b \<and> span b = S \<and> card b = dim S"
-by (metis span_subspace basis_exists independent_imp_finite)
-
lemma affine_hyperplane_sums_eq_UNIV_0:
fixes S :: "'a :: euclidean_space set"
assumes "affine S"
@@ -6687,7 +6620,7 @@
using \<open>a \<bullet> w \<noteq> 0\<close> span_induct subspace_hyperplane by auto
moreover have "w \<in> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
using \<open>w \<in> S\<close>
- by (metis (mono_tags, lifting) inner_zero_right mem_Collect_eq pth_d span_superset)
+ by (metis (mono_tags, lifting) inner_zero_right mem_Collect_eq pth_d span_base)
ultimately have span2: "span {y. a \<bullet> y = 0} \<noteq> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
by blast
have "a \<noteq> 0" using assms inner_zero_left by blast
@@ -6704,7 +6637,7 @@
using DIM_lt apply simp
done
ultimately show ?thesis
- by (simp add: subs) (metis (lifting) span_eq subs)
+ by (simp add: subs) (metis (lifting) span_eq_iff subs)
qed
proposition affine_hyperplane_sums_eq_UNIV:
@@ -6751,108 +6684,6 @@
finally show ?thesis .
qed
-proposition dim_sums_Int:
- fixes S :: "'a :: euclidean_space set"
- assumes "subspace S" "subspace T"
- shows "dim {x + y |x y. x \<in> S \<and> y \<in> T} + dim(S \<inter> T) = dim S + dim T"
-proof -
- obtain B where B: "B \<subseteq> S \<inter> T" "S \<inter> T \<subseteq> span B"
- and indB: "independent B"
- and cardB: "card B = dim (S \<inter> T)"
- using basis_exists by blast
- then obtain C D where "B \<subseteq> C" "C \<subseteq> S" "independent C" "S \<subseteq> span C"
- and "B \<subseteq> D" "D \<subseteq> T" "independent D" "T \<subseteq> span D"
- using maximal_independent_subset_extend
- by (metis Int_subset_iff \<open>B \<subseteq> S \<inter> T\<close> indB)
- then have "finite B" "finite C" "finite D"
- by (simp_all add: independent_imp_finite indB independent_bound)
- have Beq: "B = C \<inter> D"
- apply (rule sym)
- apply (rule spanning_subset_independent)
- using \<open>B \<subseteq> C\<close> \<open>B \<subseteq> D\<close> apply blast
- apply (meson \<open>independent C\<close> independent_mono inf.cobounded1)
- using B \<open>C \<subseteq> S\<close> \<open>D \<subseteq> T\<close> apply auto
- done
- then have Deq: "D = B \<union> (D - C)"
- by blast
- have CUD: "C \<union> D \<subseteq> {x + y |x y. x \<in> S \<and> y \<in> T}"
- apply safe
- apply (metis add.right_neutral subsetCE \<open>C \<subseteq> S\<close> \<open>subspace T\<close> set_eq_subset span_0 span_minimal)
- apply (metis add.left_neutral subsetCE \<open>D \<subseteq> T\<close> \<open>subspace S\<close> set_eq_subset span_0 span_minimal)
- done
- have "a v = 0" if 0: "(\<Sum>v\<in>C. a v *\<^sub>R v) + (\<Sum>v\<in>D - C. a v *\<^sub>R v) = 0"
- and v: "v \<in> C \<union> (D-C)" for a v
- proof -
- have eq: "(\<Sum>v\<in>D - C. a v *\<^sub>R v) = - (\<Sum>v\<in>C. a v *\<^sub>R v)"
- using that add_eq_0_iff by blast
- have "(\<Sum>v\<in>D - C. a v *\<^sub>R v) \<in> S"
- apply (subst eq)
- apply (rule subspace_neg [OF \<open>subspace S\<close>])
- apply (rule subspace_sum [OF \<open>subspace S\<close>])
- by (meson subsetCE subspace_mul \<open>C \<subseteq> S\<close> \<open>subspace S\<close>)
- moreover have "(\<Sum>v\<in>D - C. a v *\<^sub>R v) \<in> T"
- apply (rule subspace_sum [OF \<open>subspace T\<close>])
- by (meson DiffD1 \<open>D \<subseteq> T\<close> \<open>subspace T\<close> subset_eq subspace_def)
- ultimately have "(\<Sum>v \<in> D-C. a v *\<^sub>R v) \<in> span B"
- using B by blast
- then obtain e where e: "(\<Sum>v\<in>B. e v *\<^sub>R v) = (\<Sum>v \<in> D-C. a v *\<^sub>R v)"
- using span_finite [OF \<open>finite B\<close>] by blast
- have "\<And>c v. \<lbrakk>(\<Sum>v\<in>C. c v *\<^sub>R v) = 0; v \<in> C\<rbrakk> \<Longrightarrow> c v = 0"
- using independent_explicit \<open>independent C\<close> by blast
- define cc where "cc x = (if x \<in> B then a x + e x else a x)" for x
- have [simp]: "C \<inter> B = B" "D \<inter> B = B" "C \<inter> - B = C-D" "B \<inter> (D - C) = {}"
- using \<open>B \<subseteq> C\<close> \<open>B \<subseteq> D\<close> Beq by blast+
- have f2: "(\<Sum>v\<in>C \<inter> D. e v *\<^sub>R v) = (\<Sum>v\<in>D - C. a v *\<^sub>R v)"
- using Beq e by presburger
- have f3: "(\<Sum>v\<in>C \<union> D. a v *\<^sub>R v) = (\<Sum>v\<in>C - D. a v *\<^sub>R v) + (\<Sum>v\<in>D - C. a v *\<^sub>R v) + (\<Sum>v\<in>C \<inter> D. a v *\<^sub>R v)"
- using \<open>finite C\<close> \<open>finite D\<close> sum.union_diff2 by blast
- have f4: "(\<Sum>v\<in>C \<union> (D - C). a v *\<^sub>R v) = (\<Sum>v\<in>C. a v *\<^sub>R v) + (\<Sum>v\<in>D - C. a v *\<^sub>R v)"
- by (meson Diff_disjoint \<open>finite C\<close> \<open>finite D\<close> finite_Diff sum.union_disjoint)
- have "(\<Sum>v\<in>C. cc v *\<^sub>R v) = 0"
- using 0 f2 f3 f4
- apply (simp add: cc_def Beq if_smult \<open>finite C\<close> sum.If_cases algebra_simps sum.distrib)
- apply (simp add: add.commute add.left_commute diff_eq)
- done
- then have "\<And>v. v \<in> C \<Longrightarrow> cc v = 0"
- using independent_explicit \<open>independent C\<close> by blast
- then have C0: "\<And>v. v \<in> C - B \<Longrightarrow> a v = 0"
- by (simp add: cc_def Beq) meson
- then have [simp]: "(\<Sum>x\<in>C - B. a x *\<^sub>R x) = 0"
- by simp
- have "(\<Sum>x\<in>C. a x *\<^sub>R x) = (\<Sum>x\<in>B. a x *\<^sub>R x)"
- proof -
- have "C - D = C - B"
- using Beq by blast
- then show ?thesis
- using Beq \<open>(\<Sum>x\<in>C - B. a x *\<^sub>R x) = 0\<close> f3 f4 by auto
- qed
- with 0 have Dcc0: "(\<Sum>v\<in>D. a v *\<^sub>R v) = 0"
- apply (subst Deq)
- by (simp add: \<open>finite B\<close> \<open>finite D\<close> sum_Un)
- then have D0: "\<And>v. v \<in> D \<Longrightarrow> a v = 0"
- using independent_explicit \<open>independent D\<close> by blast
- show ?thesis
- using v C0 D0 Beq by blast
- qed
- then have "independent (C \<union> (D - C))"
- by (simp add: independent_explicit \<open>finite C\<close> \<open>finite D\<close> sum_Un del: Un_Diff_cancel)
- then have indCUD: "independent (C \<union> D)" by simp
- have "dim (S \<inter> T) = card B"
- by (rule dim_unique [OF B indB refl])
- moreover have "dim S = card C"
- by (metis \<open>C \<subseteq> S\<close> \<open>independent C\<close> \<open>S \<subseteq> span C\<close> basis_card_eq_dim)
- moreover have "dim T = card D"
- by (metis \<open>D \<subseteq> T\<close> \<open>independent D\<close> \<open>T \<subseteq> span D\<close> basis_card_eq_dim)
- moreover have "dim {x + y |x y. x \<in> S \<and> y \<in> T} = card(C \<union> D)"
- apply (rule dim_unique [OF CUD _ indCUD refl], clarify)
- apply (meson \<open>S \<subseteq> span C\<close> \<open>T \<subseteq> span D\<close> span_add span_inc span_minimal subsetCE subspace_span sup.bounded_iff)
- done
- ultimately show ?thesis
- using \<open>B = C \<inter> D\<close> [symmetric]
- by (simp add: \<open>independent C\<close> \<open>independent D\<close> card_Un_Int independent_finite)
-qed
-
-
lemma aff_dim_sums_Int_0:
assumes "affine S"
and "affine T"
@@ -6921,62 +6752,8 @@
by (metis (no_types) aff_dim_affine_hull aff_dim_le_DIM aff_dim_UNIV affine_hull_UNIV less_le)
-lemma dim_Times:
- fixes S :: "'a :: euclidean_space set" and T :: "'a set"
- assumes "subspace S" "subspace T"
- shows "dim(S \<times> T) = dim S + dim T"
-proof -
- have ss: "subspace ((\<lambda>x. (x, 0)) ` S)" "subspace (Pair 0 ` T)"
- by (rule subspace_linear_image, unfold_locales, auto simp: assms)+
- have "dim(S \<times> T) = dim({u + v |u v. u \<in> (\<lambda>x. (x, 0)) ` S \<and> v \<in> Pair 0 ` T})"
- by (simp add: Times_eq_image_sum)
- moreover have "dim ((\<lambda>x. (x, 0::'a)) ` S) = dim S" "dim (Pair (0::'a) ` T) = dim T"
- by (auto simp: additive.intro linear.intro linear_axioms.intro inj_on_def intro: dim_image_eq)
- moreover have "dim ((\<lambda>x. (x, 0)) ` S \<inter> Pair 0 ` T) = 0"
- by (subst dim_eq_0) (force simp: zero_prod_def)
- ultimately show ?thesis
- using dim_sums_Int [OF ss] by linarith
-qed
-
subsection\<open> Orthogonal bases, Gram-Schmidt process, and related theorems\<close>
-lemma span_delete_0 [simp]: "span(S - {0}) = span S"
-proof
- show "span (S - {0}) \<subseteq> span S"
- by (blast intro!: span_mono)
-next
- have "span S \<subseteq> span(insert 0 (S - {0}))"
- by (blast intro!: span_mono)
- also have "... \<subseteq> span(S - {0})"
- using span_insert_0 by blast
- finally show "span S \<subseteq> span (S - {0})" .
-qed
-
-lemma span_image_scale:
- assumes "finite S" and nz: "\<And>x. x \<in> S \<Longrightarrow> c x \<noteq> 0"
- shows "span ((\<lambda>x. c x *\<^sub>R x) ` S) = span S"
-using assms
-proof (induction S arbitrary: c)
- case (empty c) show ?case by simp
-next
- case (insert x F c)
- show ?case
- proof (intro set_eqI iffI)
- fix y
- assume "y \<in> span ((\<lambda>x. c x *\<^sub>R x) ` insert x F)"
- then show "y \<in> span (insert x F)"
- using insert by (force simp: span_breakdown_eq)
- next
- fix y
- assume "y \<in> span (insert x F)"
- then show "y \<in> span ((\<lambda>x. c x *\<^sub>R x) ` insert x F)"
- using insert
- apply (clarsimp simp: span_breakdown_eq)
- apply (rule_tac x="k / c x" in exI)
- by simp
- qed
-qed
-
lemma pairwise_orthogonal_independent:
assumes "pairwise orthogonal S" and "0 \<notin> S"
shows "independent S"
@@ -7022,9 +6799,8 @@
lemma orthogonal_to_span:
assumes a: "a \<in> span S" and x: "\<And>y. y \<in> S \<Longrightarrow> orthogonal x y"
shows "orthogonal x a"
-apply (rule span_induct [OF a subspace_orthogonal_to_vector])
-apply (simp add: x)
-done
+ by (metis a orthogonal_clauses(1,2,4)
+ span_induct_alt x)
proposition%important Gram_Schmidt_step:
fixes S :: "'a::euclidean_space set"
@@ -7064,19 +6840,20 @@
define a' where "a' = a - (\<Sum>b\<in>S. (b \<bullet> a / (b \<bullet> b)) *\<^sub>R b)"
obtain U where orthU: "pairwise orthogonal (S \<union> insert a' U)"
and spanU: "span (insert a' S \<union> U) = span (insert a' S \<union> T)"
- apply (rule exE [OF insert.IH [of "insert a' S"]])
- apply (auto simp: Gram_Schmidt_step a'_def insert.prems orthogonal_commute pairwise_orthogonal_insert span_clauses)
- done
+ by (rule exE [OF insert.IH [of "insert a' S"]])
+ (auto simp: Gram_Schmidt_step a'_def insert.prems orthogonal_commute
+ pairwise_orthogonal_insert span_clauses)
have orthS: "\<And>x. x \<in> S \<Longrightarrow> a' \<bullet> x = 0"
apply (simp add: a'_def)
using Gram_Schmidt_step [OF \<open>pairwise orthogonal S\<close>]
- apply (force simp: orthogonal_def inner_commute span_inc [THEN subsetD])
+ apply (force simp: orthogonal_def inner_commute span_superset [THEN subsetD])
done
have "span (S \<union> insert a' U) = span (insert a' (S \<union> T))"
using spanU by simp
also have "... = span (insert a (S \<union> T))"
apply (rule eq_span_insert_eq)
- apply (simp add: a'_def span_neg span_sum span_clauses(1) span_mul)
+ apply (simp add: a'_def span_neg span_sum span_clauses(1)
+ span_scale)
done
also have "... = span (S \<union> insert a T)"
by simp
@@ -7097,17 +6874,15 @@
with orthogonal_extension_aux [of B S]
obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> B)"
using assms pairwise_orthogonal_imp_finite by auto
- show ?thesis
- apply (rule_tac U=U in that)
- apply (simp add: \<open>pairwise orthogonal (S \<union> U)\<close>)
- by (metis \<open>span (S \<union> U) = span (S \<union> B)\<close> \<open>span B = span T\<close> span_Un)
+ with \<open>span B = span T\<close> show ?thesis
+ by (rule_tac U=U in that) (auto simp: span_Un)
qed
corollary orthogonal_extension_strong:
fixes S :: "'a::euclidean_space set"
assumes S: "pairwise orthogonal S"
obtains U where "U \<inter> (insert 0 S) = {}" "pairwise orthogonal (S \<union> U)"
- "span (S \<union> U) = span (S \<union> T)"
+ "span (S \<union> U) = span (S \<union> T)"
proof -
obtain U where "pairwise orthogonal (S \<union> U)" "span (S \<union> U) = span (S \<union> T)"
using orthogonal_extension assms by blast
@@ -7115,8 +6890,8 @@
apply (rule_tac U = "U - (insert 0 S)" in that)
apply blast
apply (force simp: pairwise_def)
- apply (metis (no_types, lifting) Un_Diff_cancel span_insert_0 span_Un)
- done
+ apply (metis Un_Diff_cancel Un_insert_left span_redundant span_zero)
+ done
qed
subsection\<open>Decomposing a vector into parts in orthogonal subspaces\<close>
@@ -7132,7 +6907,7 @@
using basis_exists by blast
with orthogonal_extension [of "{}" B]
show ?thesis
- by (metis Un_empty_left assms pairwise_empty span_inc span_subspace that)
+ by (metis Un_empty_left assms pairwise_empty span_superset span_subspace that)
qed
lemma orthogonal_basis_subspace:
@@ -7161,7 +6936,7 @@
and "independent B" "card B = dim S" "span B = S"
by (blast intro: orthogonal_basis_subspace [OF assms])
have 1: "(\<lambda>x. x /\<^sub>R norm x) ` B \<subseteq> S"
- using \<open>span B = S\<close> span_clauses(1) span_mul by fastforce
+ using \<open>span B = S\<close> span_clauses(1) span_scale by fastforce
have 2: "pairwise orthogonal ((\<lambda>x. x /\<^sub>R norm x) ` B)"
using orth by (force simp: pairwise_def orthogonal_clauses)
have 3: "\<And>x. x \<in> (\<lambda>x. x /\<^sub>R norm x) ` B \<Longrightarrow> norm x = 1"
@@ -7194,7 +6969,8 @@
obtain B where "B \<subseteq> span S" and orthB: "pairwise orthogonal B"
and "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
and "independent B" "card B = dim S" "span B = span S"
- by (rule orthonormal_basis_subspace [of "span S"]) auto
+ by (rule orthonormal_basis_subspace [of "span S", OF subspace_span])
+ (auto simp: dim_span)
with assms obtain u where spanBT: "span B \<subseteq> span T" and "u \<notin> span B" "u \<in> span T"
by auto
obtain C where orthBC: "pairwise orthogonal (B \<union> C)" and spanBC: "span (B \<union> C) = span (B \<union> {u})"
@@ -7203,18 +6979,21 @@
proof (cases "C \<subseteq> insert 0 B")
case True
then have "C \<subseteq> span B"
- using Linear_Algebra.span_eq
+ using span_eq
by (metis span_insert_0 subset_trans)
moreover have "u \<in> span (B \<union> C)"
- using \<open>span (B \<union> C) = span (B \<union> {u})\<close> span_inc by force
+ using \<open>span (B \<union> C) = span (B \<union> {u})\<close> span_superset by force
ultimately show ?thesis
- by (metis \<open>u \<notin> span B\<close> span_Un span_span sup.orderE)
+ using True \<open>u \<notin> span B\<close>
+ by (metis Un_insert_left span_insert_0 sup.orderE)
next
case False
then obtain x where "x \<in> C" "x \<noteq> 0" "x \<notin> B"
by blast
then have "x \<in> span T"
- by (metis (no_types, lifting) Un_insert_right Un_upper2 \<open>u \<in> span T\<close> spanBT spanBC \<open>u \<in> span T\<close> insert_subset span_inc span_mono span_span subsetCE subset_trans sup_bot.comm_neutral)
+ by (metis (no_types, lifting) Un_insert_right Un_upper2 \<open>u \<in> span T\<close> spanBT spanBC
+ \<open>u \<in> span T\<close> insert_subset span_superset span_mono
+ span_span subsetCE subset_trans sup_bot.comm_neutral)
moreover have "orthogonal x y" if "y \<in> span B" for y
using that
proof (rule span_induct)
@@ -7234,8 +7013,10 @@
obtains x where "x \<noteq> 0" "\<And>y. y \<in> span S \<Longrightarrow> orthogonal x y"
proof -
have "span S \<subset> UNIV"
- by (metis assms dim_eq_full less_irrefl top.not_eq_extremum)
- with orthogonal_to_subspace_exists_gen [of S UNIV] that show ?thesis by auto
+ by (metis (mono_tags) UNIV_I assms inner_eq_zero_iff less_le lowdim_subset_hyperplane
+ mem_Collect_eq top.extremum_strict top.not_eq_extremum)
+ with orthogonal_to_subspace_exists_gen [of S UNIV] that show ?thesis
+ by (auto simp: span_UNIV)
qed
corollary orthogonal_to_vector_exists:
@@ -7253,14 +7034,16 @@
fixes S :: "'a :: euclidean_space set"
obtains y z where "y \<in> span S" "\<And>w. w \<in> span S \<Longrightarrow> orthogonal z w" "x = y + z"
proof%unimportant -
- obtain T where "0 \<notin> T" "T \<subseteq> span S" "pairwise orthogonal T" "independent T" "card T = dim (span S)" "span T = span S"
+ obtain T where "0 \<notin> T" "T \<subseteq> span S" "pairwise orthogonal T" "independent T"
+ "card T = dim (span S)" "span T = span S"
using orthogonal_basis_subspace subspace_span by blast
let ?a = "\<Sum>b\<in>T. (b \<bullet> x / (b \<bullet> b)) *\<^sub>R b"
have orth: "orthogonal (x - ?a) w" if "w \<in> span S" for w
- by (simp add: Gram_Schmidt_step \<open>pairwise orthogonal T\<close> \<open>span T = span S\<close> orthogonal_commute that)
+ by (simp add: Gram_Schmidt_step \<open>pairwise orthogonal T\<close> \<open>span T = span S\<close>
+ orthogonal_commute that)
show ?thesis
apply (rule_tac y = "?a" and z = "x - ?a" in that)
- apply (meson \<open>T \<subseteq> span S\<close> span_mul span_sum subsetCE)
+ apply (meson \<open>T \<subseteq> span S\<close> span_scale span_sum subsetCE)
apply (fact orth, simp)
done
qed
@@ -7284,7 +7067,8 @@
lemma vector_in_orthogonal_spanningset:
fixes a :: "'a::euclidean_space"
obtains S where "a \<in> S" "pairwise orthogonal S" "span S = UNIV"
- by (metis UNIV_I Un_iff empty_iff insert_subset orthogonal_extension pairwise_def pairwise_orthogonal_insert span_UNIV subsetI subset_antisym)
+ by (metis UNIV_I Un_iff empty_iff insert_subset orthogonal_extension pairwise_def
+ pairwise_orthogonal_insert span_UNIV subsetI subset_antisym)
lemma vector_in_orthogonal_basis:
fixes a :: "'a::euclidean_space"
@@ -7304,7 +7088,7 @@
using \<open>independent (S - {0})\<close> independent_finite by blast
show "card (S - {0}) = DIM('a)"
using span_delete_0 [of S] S
- by (simp add: \<open>independent (S - {0})\<close> indep_card_eq_dim_span)
+ by (simp add: \<open>independent (S - {0})\<close> indep_card_eq_dim_span dim_UNIV)
qed (use S \<open>a \<noteq> 0\<close> in auto)
qed
@@ -7337,7 +7121,9 @@
then show "card ?S = DIM('a)"
by (simp add: card_image S)
show "span ?S = UNIV"
- by (metis (no_types) \<open>0 \<notin> S\<close> \<open>finite S\<close> \<open>span S = UNIV\<close> field_class.field_inverse_zero inverse_inverse_eq less_irrefl span_image_scale zero_less_norm_iff)
+ by (metis (no_types) \<open>0 \<notin> S\<close> \<open>finite S\<close> \<open>span S = UNIV\<close>
+ field_class.field_inverse_zero inverse_inverse_eq less_irrefl span_image_scale
+ zero_less_norm_iff)
qed
qed
@@ -7354,17 +7140,17 @@
then have 0: "\<And>x y. \<lbrakk>x \<in> span A; y \<in> span B\<rbrakk> \<Longrightarrow> x \<bullet> y = 0"
by simp
have "dim(A \<union> B) = dim (span (A \<union> B))"
- by simp
- also have "... = dim ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
- by (simp add: span_Un)
- also have "... = dim {x + y |x y. x \<in> span A \<and> y \<in> span B}"
+ by (simp add: dim_span)
+ also have "span (A \<union> B) = ((\<lambda>(a, b). a + b) ` (span A \<times> span B))"
+ by (auto simp add: span_Un image_def)
+ also have "dim \<dots> = dim {x + y |x y. x \<in> span A \<and> y \<in> span B}"
by (auto intro!: arg_cong [where f=dim])
also have "... = dim {x + y |x y. x \<in> span A \<and> y \<in> span B} + dim(span A \<inter> span B)"
by (auto simp: dest: 0)
also have "... = dim (span A) + dim (span B)"
- by (rule dim_sums_Int) auto
+ by (rule dim_sums_Int) (auto simp: subspace_span)
also have "... = dim A + dim B"
- by simp
+ by (simp add: dim_span)
finally show ?thesis .
qed
@@ -7384,22 +7170,24 @@
obtain y z where "x = y + z" "y \<in> span A" and orth: "\<And>w. w \<in> span A \<Longrightarrow> orthogonal z w"
using orthogonal_subspace_decomp_exists [of A x] that by auto
have "y \<in> span B"
- by (metis span_eq \<open>y \<in> span A\<close> assms subset_iff)
+ using \<open>y \<in> span A\<close> assms(3) span_mono by blast
then have "z \<in> {a \<in> B. \<forall>x. x \<in> A \<longrightarrow> orthogonal x a}"
- by simp (metis (no_types) span_eq \<open>x = y + z\<close> \<open>subspace A\<close> \<open>subspace B\<close> orth orthogonal_commute span_add_eq that)
+ apply simp
+ using \<open>x = y + z\<close> assms(1) assms(2) orth orthogonal_commute span_add_eq
+ span_eq_iff that by blast
then have z: "z \<in> span {y \<in> B. \<forall>x\<in>A. orthogonal x y}"
- by (meson span_inc subset_iff)
+ by (meson span_superset subset_iff)
then show ?thesis
- apply (simp add: span_Un image_def)
- apply (rule bexI [OF _ z])
- apply (simp add: \<open>x = y + z\<close> \<open>y \<in> span A\<close>)
- done
+ apply (auto simp: span_Un image_def \<open>x = y + z\<close> \<open>y \<in> span A\<close>)
+ using \<open>y \<in> span A\<close> add.commute by blast
qed
show "span B \<subseteq> span ({y \<in> B. \<forall>x\<in>A. orthogonal x y} \<union> A)"
- by (rule span_minimal) (auto intro: * span_minimal elim: )
+ by (rule span_minimal)
+ (auto intro: * span_minimal simp: subspace_span)
qed
then show ?thesis
- by (metis (no_types, lifting) dim_orthogonal_sum dim_span mem_Collect_eq orthogonal_commute orthogonal_def)
+ by (metis (no_types, lifting) dim_orthogonal_sum dim_span mem_Collect_eq
+ orthogonal_commute orthogonal_def)
qed
lemma aff_dim_openin:
@@ -7444,9 +7232,9 @@
then show "(\<lambda>x. e *\<^sub>R x) ` B \<subseteq> (\<lambda>x. x - a) ` S"
using e' by blast
show "independent ((\<lambda>x. e *\<^sub>R x) ` B)"
- using \<open>independent B\<close>
- apply (rule independent_injective_image, simp)
- by (metis \<open>0 < e\<close> injective_scaleR less_irrefl)
+ using linear_scale_self \<open>independent B\<close>
+ apply (rule linear_independent_injective_image)
+ using \<open>0 < e\<close> inj_on_def by fastforce
qed
also have "... = aff_dim S"
using \<open>a \<in> S\<close> aff_dim_eq_dim hull_inc by force
@@ -7466,7 +7254,8 @@
using aff_dim_openin
by (metis aff_dim_subspace \<open>subspace T\<close> \<open>S \<noteq> {}\<close> ope subspace_affine)
also have "... \<le> dim S"
- by (metis aff_dim_subset aff_dim_subspace dim_span span_inc subspace_span)
+ by (metis aff_dim_subset aff_dim_subspace dim_span span_superset
+ subspace_span)
finally show "dim T \<le> dim S" by simp
qed
@@ -7502,13 +7291,13 @@
using \<open>0 < e\<close> by (simp add: dist_norm)
next
have "?y \<in> S"
- by (metis span_eq \<open>a \<in> span S\<close> \<open>x \<in> S\<close> \<open>subspace S\<close> subspace_add subspace_mul)
+ by (metis \<open>a \<in> span S\<close> \<open>x \<in> S\<close> assms(2) span_eq_iff subspace_add subspace_scale)
moreover have "?y \<notin> U"
proof -
have "e/2 / norm a \<noteq> 0"
using \<open>0 < e\<close> \<open>a \<noteq> 0\<close> by auto
then show ?thesis
- by (metis True \<open>a \<noteq> 0\<close> a orthogonal_scaleR orthogonal_self real_vector.scale_eq_0_iff span_add_eq span_clauses(1))
+ by (metis True \<open>a \<noteq> 0\<close> a orthogonal_scaleR orthogonal_self scale_eq_0_iff span_add_eq span_clauses(1))
qed
ultimately show "?y \<in> S - U" by blast
qed
@@ -7628,7 +7417,7 @@
then have ba'': "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> w = b - a' \<bullet> z"
by (simp add: inner_diff_left z)
have "\<And>w. w \<in> (+) (- z) ` S \<Longrightarrow> (w + a') \<in> (+) (- z) ` S"
- by (metis subspace_add a' span_eq sub)
+ by (metis subspace_add a' span_eq_iff sub)
then have Sclo: "\<And>w. w \<in> S \<Longrightarrow> (w + a') \<in> S"
by fastforce
show ?thesis
@@ -7685,7 +7474,7 @@
also have "... = dim {x - c |x. x \<in> B}"
by (simp add: affine_independent_card_dim_diffs [OF ind \<open>c \<in> B\<close>])
also have "... = dim {x - c | x. x \<in> affine hull B}"
- by (simp add: diffs_affine_hull_span \<open>c \<in> B\<close>)
+ by (simp add: diffs_affine_hull_span \<open>c \<in> B\<close> dim_span)
also have "... = dim {x - a |x. x \<in> S}"
by (simp add: affS aff *)
finally show ?thesis .
@@ -7730,7 +7519,7 @@
by (simp add: aff_dim_linear_image_le assms(1))
next
obtain g where "linear g" "g \<circ> f = id"
- using linear_injective_left_inverse assms by blast
+ using assms(1) assms(2) linear_injective_left_inverse by blast
then have "aff_dim S \<le> aff_dim(g ` f ` S)"
by (simp add: image_comp)
also have "... \<le> aff_dim (f ` S)"
@@ -7739,43 +7528,6 @@
qed
-text\<open>Choosing a subspace of a given dimension\<close>
-proposition choose_subspace_of_subspace:
- fixes S :: "'n::euclidean_space set"
- assumes "n \<le> dim S"
- obtains T where "subspace T" "T \<subseteq> span S" "dim T = n"
-proof -
- have "\<exists>T. subspace T \<and> T \<subseteq> span S \<and> dim T = n"
- using assms
- proof (induction n)
- case 0 then show ?case by force
- next
- case (Suc n)
- then obtain T where "subspace T" "T \<subseteq> span S" "dim T = n"
- by force
- then show ?case
- proof (cases "span S \<subseteq> span T")
- case True
- have "dim S = dim T"
- apply (rule span_eq_dim [OF subset_antisym [OF True]])
- by (simp add: \<open>T \<subseteq> span S\<close> span_minimal subspace_span)
- then show ?thesis
- using Suc.prems \<open>dim T = n\<close> by linarith
- next
- case False
- then obtain y where y: "y \<in> S" "y \<notin> T"
- by (meson span_mono subsetI)
- then have "span (insert y T) \<subseteq> span S"
- by (metis (no_types) \<open>T \<subseteq> span S\<close> subsetD insert_subset span_inc span_mono span_span)
- with \<open>dim T = n\<close> \<open>subspace T\<close> y show ?thesis
- apply (rule_tac x="span(insert y T)" in exI)
- apply (auto simp: dim_insert)
- using span_eq by blast
- qed
- qed
- with that show ?thesis by blast
-qed
-
lemma choose_affine_subset:
assumes "affine S" "-1 \<le> d" and dle: "d \<le> aff_dim S"
obtains T where "affine T" "T \<subseteq> S" "aff_dim T = d"
@@ -7799,7 +7551,7 @@
moreover have "(+) a ` T \<subseteq> S"
proof -
have "T \<subseteq> (+) (- a) ` S"
- by (metis (no_types) span_eq Tsb ss)
+ by (metis (no_types) span_eq_iff Tsb ss)
then show "(+) a ` T \<subseteq> S"
using add_ac by auto
qed
@@ -8077,7 +7829,7 @@
also have "... = (\<Sum>x \<in> S - {b}. v x *\<^sub>R x)"
using b False by (auto intro!: sum.cong split: if_split_asm)
also have "... = (\<Sum>x\<in>S. v x *\<^sub>R x)"
- by (metis (no_types, lifting) b(2) diff_zero fin finite.emptyI finite_Diff2 finite_insert real_vector.scale_eq_0_iff sum_diff1)
+ by (metis (no_types, lifting) b(2) diff_zero fin finite.emptyI finite_Diff2 finite_insert scale_eq_0_iff sum_diff1)
finally show "(\<Sum>x\<in>insert a (S - {b}). (if x = a then 0 else v x) *\<^sub>R x) = x"
by (simp add: vx)
qed
@@ -8123,7 +7875,7 @@
apply (rule sum.cong, auto)
done
also have "... = (v b / u b) *\<^sub>R a + (\<Sum>x \<in> S - {b}. v x *\<^sub>R x) - (v b / u b) *\<^sub>R (\<Sum>x \<in> S - {b}. u x *\<^sub>R x)"
- by (simp add: Groups_Big.sum_subtractf scaleR_left_diff_distrib sum_distrib_left real_vector.scale_sum_right)
+ by (simp add: Groups_Big.sum_subtractf scaleR_left_diff_distrib sum_distrib_left scale_sum_right)
also have "... = (\<Sum>x\<in>S. v x *\<^sub>R x)"
using \<open>0 < u b\<close> True by (simp add: ua vx Groups_Big.sum_diff1 algebra_simps)
finally
@@ -8361,7 +8113,8 @@
have "v = ?u + (v - ?u)"
by simp
moreover have "?u \<in> U"
- by (metis (no_types, lifting) \<open>span B = U\<close> assms real_vector_class.subspace_sum span_clauses(1) span_mul)
+ by (metis (no_types, lifting) \<open>span B = U\<close> assms subspace_sum
+ span_clauses(1) span_scale)
moreover have "(v - ?u) \<in> U\<^sup>\<bottom>"
proof (clarsimp simp: orthogonal_comp_def orthogonal_def)
fix y
@@ -8381,33 +8134,6 @@
by auto
qed
-lemma add_subspaces:
- assumes "subspace S" "subspace T"
- shows "subspace (S + T)"
- unfolding subspace_def
-proof (intro conjI ballI allI)
- show "0 \<in> S + T"
- by (meson assms set_zero_plus2 subsetCE subspace_0)
-next
- fix x y
- assume "x \<in> S + T" and "y \<in> S + T"
- then obtain xs xt ys yt where "xs \<in> S" "xt \<in> T" "ys \<in> S" "yt \<in> T" and eq: "x = xs+xt" "y = ys+yt"
- by (meson set_plus_elim)
- then have "xs+ys \<in> S" "xt+yt \<in> T"
- using assms subspace_def by blast+
- then have "(xs + ys) + (xt + yt) \<in> S + T"
- by blast
- then show "x + y \<in> S + T"
- by (simp add: eq add.assoc add.left_commute)
-next
- fix c x
- assume "x \<in> S + T"
- then obtain xs xt where "xs \<in> S" "xt \<in> T" "x = xs+xt"
- by (meson set_plus_elim)
- then show "c *\<^sub>R x \<in> S + T"
- by (metis assms scaleR_add_right set_plus_intro subspace_def)
-qed
-
lemma orthogonal_Int_0:
assumes "subspace U"
shows "U \<inter> U\<^sup>\<bottom> = {0}"
@@ -8480,7 +8206,9 @@
ultimately have "range (adjoint f)\<^sup>\<bottom>\<^sup>\<bottom> = UNIV"
by (metis orthogonal_comp_null)
then show "surj (adjoint f)"
- by (simp add: adjoint_linear \<open>linear f\<close> subspace_linear_image orthogonal_comp_self)
+ using adjoint_linear \<open>linear f\<close>
+ by (subst (asm) orthogonal_comp_self)
+ (simp add: adjoint_linear linear_subspace_image)
qed
lemma inj_adjoint_iff_surj [simp]:
@@ -8513,7 +8241,8 @@
assume "\<not>inj f"
then show ?rhs
using all_zero_iff
- by (metis (no_types, hide_lams) adjoint_clauses(2) adjoint_linear assms linear_injective_0 linear_injective_imp_surjective linear_surj_adj_imp_inj)
+ by (metis (no_types, hide_lams) adjoint_clauses(2) adjoint_linear assms
+ linear_injective_0 linear_injective_imp_surjective linear_surj_adj_imp_inj)
next
assume ?rhs
then show "\<not>inj f"
@@ -8527,4 +8256,3 @@
using assms by (fastforce simp add: linear_singular_into_hyperplane)
end
-
--- a/src/HOL/Analysis/Topology_Euclidean_Space.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Topology_Euclidean_Space.thy Wed May 02 13:49:38 2018 +0200
@@ -10,18 +10,12 @@
imports
"HOL-Library.Indicator_Function"
"HOL-Library.Countable_Set"
- "HOL-Library.FuncSet"
Linear_Algebra
Norm_Arith
begin
(* FIXME: move elsewhere *)
-lemma Times_eq_image_sum:
- fixes S :: "'a :: comm_monoid_add set" and T :: "'b :: comm_monoid_add set"
- shows "S \<times> T = {u + v |u v. u \<in> (\<lambda>x. (x, 0)) ` S \<and> v \<in> Pair 0 ` T}"
- by force
-
lemma halfspace_Int_eq:
"{x. a \<bullet> x \<le> b} \<inter> {x. b \<le> a \<bullet> x} = {x. a \<bullet> x = b}"
"{x. b \<le> a \<bullet> x} \<inter> {x. a \<bullet> x \<le> b} = {x. a \<bullet> x = b}"
--- a/src/HOL/Analysis/Weierstrass_Theorems.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Analysis/Weierstrass_Theorems.thy Wed May 02 13:49:38 2018 +0200
@@ -1376,7 +1376,7 @@
using \<open>polynomial_function g\<close> by auto
show "(\<lambda>x. \<Sum>i\<in>B. (g x \<bullet> i) *\<^sub>R i) ` S \<subseteq> T"
using \<open>B \<subseteq> T\<close>
- by (blast intro: real_vector_class.subspace_sum subspace_mul \<open>subspace T\<close>)
+ by (blast intro: subspace_sum subspace_mul \<open>subspace T\<close>)
show "norm (f x - (\<Sum>i\<in>B. (g x \<bullet> i) *\<^sub>R i)) < e" if "x \<in> S" for x
proof -
have orth': "pairwise (\<lambda>i j. orthogonal ((f x \<bullet> i) *\<^sub>R i - (g x \<bullet> i) *\<^sub>R i)
--- a/src/HOL/Computational_Algebra/Formal_Power_Series.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Computational_Algebra/Formal_Power_Series.thy Wed May 02 13:49:38 2018 +0200
@@ -105,9 +105,6 @@
lemma cond_value_iff: "f (if b then x else y) = (if b then f x else f y)"
by auto
-lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)"
- by auto
-
subsection \<open>Formal power series form a commutative ring with unity, if the range of sequences
they represent is a commutative ring with unity\<close>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/FuncSet.thy Wed May 02 13:49:38 2018 +0200
@@ -0,0 +1,568 @@
+(* Title: HOL/FuncSet.thy
+ Author: Florian Kammueller and Lawrence C Paulson, Lukas Bulwahn
+*)
+
+section \<open>Pi and Function Sets\<close>
+
+theory FuncSet
+ imports Main
+ abbrevs PiE = "Pi\<^sub>E"
+ and PIE = "\<Pi>\<^sub>E"
+begin
+
+definition Pi :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> ('a \<Rightarrow> 'b) set"
+ where "Pi A B = {f. \<forall>x. x \<in> A \<longrightarrow> f x \<in> B x}"
+
+definition extensional :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b) set"
+ where "extensional A = {f. \<forall>x. x \<notin> A \<longrightarrow> f x = undefined}"
+
+definition "restrict" :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> 'b"
+ where "restrict f A = (\<lambda>x. if x \<in> A then f x else undefined)"
+
+abbreviation funcset :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set" (infixr "\<rightarrow>" 60)
+ where "A \<rightarrow> B \<equiv> Pi A (\<lambda>_. B)"
+
+syntax
+ "_Pi" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set" ("(3\<Pi> _\<in>_./ _)" 10)
+ "_lam" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)" ("(3\<lambda>_\<in>_./ _)" [0,0,3] 3)
+translations
+ "\<Pi> x\<in>A. B" \<rightleftharpoons> "CONST Pi A (\<lambda>x. B)"
+ "\<lambda>x\<in>A. f" \<rightleftharpoons> "CONST restrict (\<lambda>x. f) A"
+
+definition "compose" :: "'a set \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'c)"
+ where "compose A g f = (\<lambda>x\<in>A. g (f x))"
+
+
+subsection \<open>Basic Properties of @{term Pi}\<close>
+
+lemma Pi_I[intro!]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B x) \<Longrightarrow> f \<in> Pi A B"
+ by (simp add: Pi_def)
+
+lemma Pi_I'[simp]: "(\<And>x. x \<in> A \<longrightarrow> f x \<in> B x) \<Longrightarrow> f \<in> Pi A B"
+ by (simp add:Pi_def)
+
+lemma funcsetI: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B) \<Longrightarrow> f \<in> A \<rightarrow> B"
+ by (simp add: Pi_def)
+
+lemma Pi_mem: "f \<in> Pi A B \<Longrightarrow> x \<in> A \<Longrightarrow> f x \<in> B x"
+ by (simp add: Pi_def)
+
+lemma Pi_iff: "f \<in> Pi I X \<longleftrightarrow> (\<forall>i\<in>I. f i \<in> X i)"
+ unfolding Pi_def by auto
+
+lemma PiE [elim]: "f \<in> Pi A B \<Longrightarrow> (f x \<in> B x \<Longrightarrow> Q) \<Longrightarrow> (x \<notin> A \<Longrightarrow> Q) \<Longrightarrow> Q"
+ by (auto simp: Pi_def)
+
+lemma Pi_cong: "(\<And>w. w \<in> A \<Longrightarrow> f w = g w) \<Longrightarrow> f \<in> Pi A B \<longleftrightarrow> g \<in> Pi A B"
+ by (auto simp: Pi_def)
+
+lemma funcset_id [simp]: "(\<lambda>x. x) \<in> A \<rightarrow> A"
+ by auto
+
+lemma funcset_mem: "f \<in> A \<rightarrow> B \<Longrightarrow> x \<in> A \<Longrightarrow> f x \<in> B"
+ by (simp add: Pi_def)
+
+lemma funcset_image: "f \<in> A \<rightarrow> B \<Longrightarrow> f ` A \<subseteq> B"
+ by auto
+
+lemma image_subset_iff_funcset: "F ` A \<subseteq> B \<longleftrightarrow> F \<in> A \<rightarrow> B"
+ by auto
+
+lemma Pi_eq_empty[simp]: "(\<Pi> x \<in> A. B x) = {} \<longleftrightarrow> (\<exists>x\<in>A. B x = {})"
+ apply (simp add: Pi_def)
+ apply auto
+ txt \<open>Converse direction requires Axiom of Choice to exhibit a function
+ picking an element from each non-empty @{term "B x"}\<close>
+ apply (drule_tac x = "\<lambda>u. SOME y. y \<in> B u" in spec)
+ apply auto
+ apply (cut_tac P = "\<lambda>y. y \<in> B x" in some_eq_ex)
+ apply auto
+ done
+
+lemma Pi_empty [simp]: "Pi {} B = UNIV"
+ by (simp add: Pi_def)
+
+lemma Pi_Int: "Pi I E \<inter> Pi I F = (\<Pi> i\<in>I. E i \<inter> F i)"
+ by auto
+
+lemma Pi_UN:
+ fixes A :: "nat \<Rightarrow> 'i \<Rightarrow> 'a set"
+ assumes "finite I"
+ and mono: "\<And>i n m. i \<in> I \<Longrightarrow> n \<le> m \<Longrightarrow> A n i \<subseteq> A m i"
+ shows "(\<Union>n. Pi I (A n)) = (\<Pi> i\<in>I. \<Union>n. A n i)"
+proof (intro set_eqI iffI)
+ fix f
+ assume "f \<in> (\<Pi> i\<in>I. \<Union>n. A n i)"
+ then have "\<forall>i\<in>I. \<exists>n. f i \<in> A n i"
+ by auto
+ from bchoice[OF this] obtain n where n: "f i \<in> A (n i) i" if "i \<in> I" for i
+ by auto
+ obtain k where k: "n i \<le> k" if "i \<in> I" for i
+ using \<open>finite I\<close> finite_nat_set_iff_bounded_le[of "n`I"] by auto
+ have "f \<in> Pi I (A k)"
+ proof (intro Pi_I)
+ fix i
+ assume "i \<in> I"
+ from mono[OF this, of "n i" k] k[OF this] n[OF this]
+ show "f i \<in> A k i" by auto
+ qed
+ then show "f \<in> (\<Union>n. Pi I (A n))"
+ by auto
+qed auto
+
+lemma Pi_UNIV [simp]: "A \<rightarrow> UNIV = UNIV"
+ by (simp add: Pi_def)
+
+text \<open>Covariance of Pi-sets in their second argument\<close>
+lemma Pi_mono: "(\<And>x. x \<in> A \<Longrightarrow> B x \<subseteq> C x) \<Longrightarrow> Pi A B \<subseteq> Pi A C"
+ by auto
+
+text \<open>Contravariance of Pi-sets in their first argument\<close>
+lemma Pi_anti_mono: "A' \<subseteq> A \<Longrightarrow> Pi A B \<subseteq> Pi A' B"
+ by auto
+
+lemma prod_final:
+ assumes 1: "fst \<circ> f \<in> Pi A B"
+ and 2: "snd \<circ> f \<in> Pi A C"
+ shows "f \<in> (\<Pi> z \<in> A. B z \<times> C z)"
+proof (rule Pi_I)
+ fix z
+ assume z: "z \<in> A"
+ have "f z = (fst (f z), snd (f z))"
+ by simp
+ also have "\<dots> \<in> B z \<times> C z"
+ by (metis SigmaI PiE o_apply 1 2 z)
+ finally show "f z \<in> B z \<times> C z" .
+qed
+
+lemma Pi_split_domain[simp]: "x \<in> Pi (I \<union> J) X \<longleftrightarrow> x \<in> Pi I X \<and> x \<in> Pi J X"
+ by (auto simp: Pi_def)
+
+lemma Pi_split_insert_domain[simp]: "x \<in> Pi (insert i I) X \<longleftrightarrow> x \<in> Pi I X \<and> x i \<in> X i"
+ by (auto simp: Pi_def)
+
+lemma Pi_cancel_fupd_range[simp]: "i \<notin> I \<Longrightarrow> x \<in> Pi I (B(i := b)) \<longleftrightarrow> x \<in> Pi I B"
+ by (auto simp: Pi_def)
+
+lemma Pi_cancel_fupd[simp]: "i \<notin> I \<Longrightarrow> x(i := a) \<in> Pi I B \<longleftrightarrow> x \<in> Pi I B"
+ by (auto simp: Pi_def)
+
+lemma Pi_fupd_iff: "i \<in> I \<Longrightarrow> f \<in> Pi I (B(i := A)) \<longleftrightarrow> f \<in> Pi (I - {i}) B \<and> f i \<in> A"
+ apply auto
+ apply (drule_tac x=x in Pi_mem)
+ apply (simp_all split: if_split_asm)
+ apply (drule_tac x=i in Pi_mem)
+ apply (auto dest!: Pi_mem)
+ done
+
+
+subsection \<open>Composition With a Restricted Domain: @{term compose}\<close>
+
+lemma funcset_compose: "f \<in> A \<rightarrow> B \<Longrightarrow> g \<in> B \<rightarrow> C \<Longrightarrow> compose A g f \<in> A \<rightarrow> C"
+ by (simp add: Pi_def compose_def restrict_def)
+
+lemma compose_assoc:
+ assumes "f \<in> A \<rightarrow> B"
+ and "g \<in> B \<rightarrow> C"
+ and "h \<in> C \<rightarrow> D"
+ shows "compose A h (compose A g f) = compose A (compose B h g) f"
+ using assms by (simp add: fun_eq_iff Pi_def compose_def restrict_def)
+
+lemma compose_eq: "x \<in> A \<Longrightarrow> compose A g f x = g (f x)"
+ by (simp add: compose_def restrict_def)
+
+lemma surj_compose: "f ` A = B \<Longrightarrow> g ` B = C \<Longrightarrow> compose A g f ` A = C"
+ by (auto simp add: image_def compose_eq)
+
+
+subsection \<open>Bounded Abstraction: @{term restrict}\<close>
+
+lemma restrict_cong: "I = J \<Longrightarrow> (\<And>i. i \<in> J =simp=> f i = g i) \<Longrightarrow> restrict f I = restrict g J"
+ by (auto simp: restrict_def fun_eq_iff simp_implies_def)
+
+lemma restrict_in_funcset: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B) \<Longrightarrow> (\<lambda>x\<in>A. f x) \<in> A \<rightarrow> B"
+ by (simp add: Pi_def restrict_def)
+
+lemma restrictI[intro!]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B x) \<Longrightarrow> (\<lambda>x\<in>A. f x) \<in> Pi A B"
+ by (simp add: Pi_def restrict_def)
+
+lemma restrict_apply[simp]: "(\<lambda>y\<in>A. f y) x = (if x \<in> A then f x else undefined)"
+ by (simp add: restrict_def)
+
+lemma restrict_apply': "x \<in> A \<Longrightarrow> (\<lambda>y\<in>A. f y) x = f x"
+ by simp
+
+lemma restrict_ext: "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> (\<lambda>x\<in>A. f x) = (\<lambda>x\<in>A. g x)"
+ by (simp add: fun_eq_iff Pi_def restrict_def)
+
+lemma restrict_UNIV: "restrict f UNIV = f"
+ by (simp add: restrict_def)
+
+lemma inj_on_restrict_eq [simp]: "inj_on (restrict f A) A = inj_on f A"
+ by (simp add: inj_on_def restrict_def)
+
+lemma Id_compose: "f \<in> A \<rightarrow> B \<Longrightarrow> f \<in> extensional A \<Longrightarrow> compose A (\<lambda>y\<in>B. y) f = f"
+ by (auto simp add: fun_eq_iff compose_def extensional_def Pi_def)
+
+lemma compose_Id: "g \<in> A \<rightarrow> B \<Longrightarrow> g \<in> extensional A \<Longrightarrow> compose A g (\<lambda>x\<in>A. x) = g"
+ by (auto simp add: fun_eq_iff compose_def extensional_def Pi_def)
+
+lemma image_restrict_eq [simp]: "(restrict f A) ` A = f ` A"
+ by (auto simp add: restrict_def)
+
+lemma restrict_restrict[simp]: "restrict (restrict f A) B = restrict f (A \<inter> B)"
+ unfolding restrict_def by (simp add: fun_eq_iff)
+
+lemma restrict_fupd[simp]: "i \<notin> I \<Longrightarrow> restrict (f (i := x)) I = restrict f I"
+ by (auto simp: restrict_def)
+
+lemma restrict_upd[simp]: "i \<notin> I \<Longrightarrow> (restrict f I)(i := y) = restrict (f(i := y)) (insert i I)"
+ by (auto simp: fun_eq_iff)
+
+lemma restrict_Pi_cancel: "restrict x I \<in> Pi I A \<longleftrightarrow> x \<in> Pi I A"
+ by (auto simp: restrict_def Pi_def)
+
+
+subsection \<open>Bijections Between Sets\<close>
+
+text \<open>The definition of @{const bij_betw} is in \<open>Fun.thy\<close>, but most of
+the theorems belong here, or need at least @{term Hilbert_Choice}.\<close>
+
+lemma bij_betwI:
+ assumes "f \<in> A \<rightarrow> B"
+ and "g \<in> B \<rightarrow> A"
+ and g_f: "\<And>x. x\<in>A \<Longrightarrow> g (f x) = x"
+ and f_g: "\<And>y. y\<in>B \<Longrightarrow> f (g y) = y"
+ shows "bij_betw f A B"
+ unfolding bij_betw_def
+proof
+ show "inj_on f A"
+ by (metis g_f inj_on_def)
+ have "f ` A \<subseteq> B"
+ using \<open>f \<in> A \<rightarrow> B\<close> by auto
+ moreover
+ have "B \<subseteq> f ` A"
+ by auto (metis Pi_mem \<open>g \<in> B \<rightarrow> A\<close> f_g image_iff)
+ ultimately show "f ` A = B"
+ by blast
+qed
+
+lemma bij_betw_imp_funcset: "bij_betw f A B \<Longrightarrow> f \<in> A \<rightarrow> B"
+ by (auto simp add: bij_betw_def)
+
+lemma inj_on_compose: "bij_betw f A B \<Longrightarrow> inj_on g B \<Longrightarrow> inj_on (compose A g f) A"
+ by (auto simp add: bij_betw_def inj_on_def compose_eq)
+
+lemma bij_betw_compose: "bij_betw f A B \<Longrightarrow> bij_betw g B C \<Longrightarrow> bij_betw (compose A g f) A C"
+ apply (simp add: bij_betw_def compose_eq inj_on_compose)
+ apply (auto simp add: compose_def image_def)
+ done
+
+lemma bij_betw_restrict_eq [simp]: "bij_betw (restrict f A) A B = bij_betw f A B"
+ by (simp add: bij_betw_def)
+
+
+subsection \<open>Extensionality\<close>
+
+lemma extensional_empty[simp]: "extensional {} = {\<lambda>x. undefined}"
+ unfolding extensional_def by auto
+
+lemma extensional_arb: "f \<in> extensional A \<Longrightarrow> x \<notin> A \<Longrightarrow> f x = undefined"
+ by (simp add: extensional_def)
+
+lemma restrict_extensional [simp]: "restrict f A \<in> extensional A"
+ by (simp add: restrict_def extensional_def)
+
+lemma compose_extensional [simp]: "compose A f g \<in> extensional A"
+ by (simp add: compose_def)
+
+lemma extensionalityI:
+ assumes "f \<in> extensional A"
+ and "g \<in> extensional A"
+ and "\<And>x. x \<in> A \<Longrightarrow> f x = g x"
+ shows "f = g"
+ using assms by (force simp add: fun_eq_iff extensional_def)
+
+lemma extensional_restrict: "f \<in> extensional A \<Longrightarrow> restrict f A = f"
+ by (rule extensionalityI[OF restrict_extensional]) auto
+
+lemma extensional_subset: "f \<in> extensional A \<Longrightarrow> A \<subseteq> B \<Longrightarrow> f \<in> extensional B"
+ unfolding extensional_def by auto
+
+lemma inv_into_funcset: "f ` A = B \<Longrightarrow> (\<lambda>x\<in>B. inv_into A f x) \<in> B \<rightarrow> A"
+ by (unfold inv_into_def) (fast intro: someI2)
+
+lemma compose_inv_into_id: "bij_betw f A B \<Longrightarrow> compose A (\<lambda>y\<in>B. inv_into A f y) f = (\<lambda>x\<in>A. x)"
+ apply (simp add: bij_betw_def compose_def)
+ apply (rule restrict_ext, auto)
+ done
+
+lemma compose_id_inv_into: "f ` A = B \<Longrightarrow> compose B f (\<lambda>y\<in>B. inv_into A f y) = (\<lambda>x\<in>B. x)"
+ apply (simp add: compose_def)
+ apply (rule restrict_ext)
+ apply (simp add: f_inv_into_f)
+ done
+
+lemma extensional_insert[intro, simp]:
+ assumes "a \<in> extensional (insert i I)"
+ shows "a(i := b) \<in> extensional (insert i I)"
+ using assms unfolding extensional_def by auto
+
+lemma extensional_Int[simp]: "extensional I \<inter> extensional I' = extensional (I \<inter> I')"
+ unfolding extensional_def by auto
+
+lemma extensional_UNIV[simp]: "extensional UNIV = UNIV"
+ by (auto simp: extensional_def)
+
+lemma restrict_extensional_sub[intro]: "A \<subseteq> B \<Longrightarrow> restrict f A \<in> extensional B"
+ unfolding restrict_def extensional_def by auto
+
+lemma extensional_insert_undefined[intro, simp]:
+ "a \<in> extensional (insert i I) \<Longrightarrow> a(i := undefined) \<in> extensional I"
+ unfolding extensional_def by auto
+
+lemma extensional_insert_cancel[intro, simp]:
+ "a \<in> extensional I \<Longrightarrow> a \<in> extensional (insert i I)"
+ unfolding extensional_def by auto
+
+
+subsection \<open>Cardinality\<close>
+
+lemma card_inj: "f \<in> A \<rightarrow> B \<Longrightarrow> inj_on f A \<Longrightarrow> finite B \<Longrightarrow> card A \<le> card B"
+ by (rule card_inj_on_le) auto
+
+lemma card_bij:
+ assumes "f \<in> A \<rightarrow> B" "inj_on f A"
+ and "g \<in> B \<rightarrow> A" "inj_on g B"
+ and "finite A" "finite B"
+ shows "card A = card B"
+ using assms by (blast intro: card_inj order_antisym)
+
+
+subsection \<open>Extensional Function Spaces\<close>
+
+definition PiE :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> ('a \<Rightarrow> 'b) set"
+ where "PiE S T = Pi S T \<inter> extensional S"
+
+abbreviation "Pi\<^sub>E A B \<equiv> PiE A B"
+
+syntax
+ "_PiE" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set" ("(3\<Pi>\<^sub>E _\<in>_./ _)" 10)
+translations
+ "\<Pi>\<^sub>E x\<in>A. B" \<rightleftharpoons> "CONST Pi\<^sub>E A (\<lambda>x. B)"
+
+abbreviation extensional_funcset :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set" (infixr "\<rightarrow>\<^sub>E" 60)
+ where "A \<rightarrow>\<^sub>E B \<equiv> (\<Pi>\<^sub>E i\<in>A. B)"
+
+lemma extensional_funcset_def: "extensional_funcset S T = (S \<rightarrow> T) \<inter> extensional S"
+ by (simp add: PiE_def)
+
+lemma PiE_empty_domain[simp]: "Pi\<^sub>E {} T = {\<lambda>x. undefined}"
+ unfolding PiE_def by simp
+
+lemma PiE_UNIV_domain: "Pi\<^sub>E UNIV T = Pi UNIV T"
+ unfolding PiE_def by simp
+
+lemma PiE_empty_range[simp]: "i \<in> I \<Longrightarrow> F i = {} \<Longrightarrow> (\<Pi>\<^sub>E i\<in>I. F i) = {}"
+ unfolding PiE_def by auto
+
+lemma PiE_eq_empty_iff: "Pi\<^sub>E I F = {} \<longleftrightarrow> (\<exists>i\<in>I. F i = {})"
+proof
+ assume "Pi\<^sub>E I F = {}"
+ show "\<exists>i\<in>I. F i = {}"
+ proof (rule ccontr)
+ assume "\<not> ?thesis"
+ then have "\<forall>i. \<exists>y. (i \<in> I \<longrightarrow> y \<in> F i) \<and> (i \<notin> I \<longrightarrow> y = undefined)"
+ by auto
+ from choice[OF this]
+ obtain f where " \<forall>x. (x \<in> I \<longrightarrow> f x \<in> F x) \<and> (x \<notin> I \<longrightarrow> f x = undefined)" ..
+ then have "f \<in> Pi\<^sub>E I F"
+ by (auto simp: extensional_def PiE_def)
+ with \<open>Pi\<^sub>E I F = {}\<close> show False
+ by auto
+ qed
+qed (auto simp: PiE_def)
+
+lemma PiE_arb: "f \<in> Pi\<^sub>E S T \<Longrightarrow> x \<notin> S \<Longrightarrow> f x = undefined"
+ unfolding PiE_def by auto (auto dest!: extensional_arb)
+
+lemma PiE_mem: "f \<in> Pi\<^sub>E S T \<Longrightarrow> x \<in> S \<Longrightarrow> f x \<in> T x"
+ unfolding PiE_def by auto
+
+lemma PiE_fun_upd: "y \<in> T x \<Longrightarrow> f \<in> Pi\<^sub>E S T \<Longrightarrow> f(x := y) \<in> Pi\<^sub>E (insert x S) T"
+ unfolding PiE_def extensional_def by auto
+
+lemma fun_upd_in_PiE: "x \<notin> S \<Longrightarrow> f \<in> Pi\<^sub>E (insert x S) T \<Longrightarrow> f(x := undefined) \<in> Pi\<^sub>E S T"
+ unfolding PiE_def extensional_def by auto
+
+lemma PiE_insert_eq: "Pi\<^sub>E (insert x S) T = (\<lambda>(y, g). g(x := y)) ` (T x \<times> Pi\<^sub>E S T)"
+proof -
+ {
+ fix f assume "f \<in> Pi\<^sub>E (insert x S) T" "x \<notin> S"
+ then have "f \<in> (\<lambda>(y, g). g(x := y)) ` (T x \<times> Pi\<^sub>E S T)"
+ by (auto intro!: image_eqI[where x="(f x, f(x := undefined))"] intro: fun_upd_in_PiE PiE_mem)
+ }
+ moreover
+ {
+ fix f assume "f \<in> Pi\<^sub>E (insert x S) T" "x \<in> S"
+ then have "f \<in> (\<lambda>(y, g). g(x := y)) ` (T x \<times> Pi\<^sub>E S T)"
+ by (auto intro!: image_eqI[where x="(f x, f)"] intro: fun_upd_in_PiE PiE_mem simp: insert_absorb)
+ }
+ ultimately show ?thesis
+ by (auto intro: PiE_fun_upd)
+qed
+
+lemma PiE_Int: "Pi\<^sub>E I A \<inter> Pi\<^sub>E I B = Pi\<^sub>E I (\<lambda>x. A x \<inter> B x)"
+ by (auto simp: PiE_def)
+
+lemma PiE_cong: "(\<And>i. i\<in>I \<Longrightarrow> A i = B i) \<Longrightarrow> Pi\<^sub>E I A = Pi\<^sub>E I B"
+ unfolding PiE_def by (auto simp: Pi_cong)
+
+lemma PiE_E [elim]:
+ assumes "f \<in> Pi\<^sub>E A B"
+ obtains "x \<in> A" and "f x \<in> B x"
+ | "x \<notin> A" and "f x = undefined"
+ using assms by (auto simp: Pi_def PiE_def extensional_def)
+
+lemma PiE_I[intro!]:
+ "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B x) \<Longrightarrow> (\<And>x. x \<notin> A \<Longrightarrow> f x = undefined) \<Longrightarrow> f \<in> Pi\<^sub>E A B"
+ by (simp add: PiE_def extensional_def)
+
+lemma PiE_mono: "(\<And>x. x \<in> A \<Longrightarrow> B x \<subseteq> C x) \<Longrightarrow> Pi\<^sub>E A B \<subseteq> Pi\<^sub>E A C"
+ by auto
+
+lemma PiE_iff: "f \<in> Pi\<^sub>E I X \<longleftrightarrow> (\<forall>i\<in>I. f i \<in> X i) \<and> f \<in> extensional I"
+ by (simp add: PiE_def Pi_iff)
+
+lemma PiE_restrict[simp]: "f \<in> Pi\<^sub>E A B \<Longrightarrow> restrict f A = f"
+ by (simp add: extensional_restrict PiE_def)
+
+lemma restrict_PiE[simp]: "restrict f I \<in> Pi\<^sub>E I S \<longleftrightarrow> f \<in> Pi I S"
+ by (auto simp: PiE_iff)
+
+lemma PiE_eq_subset:
+ assumes ne: "\<And>i. i \<in> I \<Longrightarrow> F i \<noteq> {}" "\<And>i. i \<in> I \<Longrightarrow> F' i \<noteq> {}"
+ and eq: "Pi\<^sub>E I F = Pi\<^sub>E I F'"
+ and "i \<in> I"
+ shows "F i \<subseteq> F' i"
+proof
+ fix x
+ assume "x \<in> F i"
+ with ne have "\<forall>j. \<exists>y. (j \<in> I \<longrightarrow> y \<in> F j \<and> (i = j \<longrightarrow> x = y)) \<and> (j \<notin> I \<longrightarrow> y = undefined)"
+ by auto
+ from choice[OF this] obtain f
+ where f: " \<forall>j. (j \<in> I \<longrightarrow> f j \<in> F j \<and> (i = j \<longrightarrow> x = f j)) \<and> (j \<notin> I \<longrightarrow> f j = undefined)" ..
+ then have "f \<in> Pi\<^sub>E I F"
+ by (auto simp: extensional_def PiE_def)
+ then have "f \<in> Pi\<^sub>E I F'"
+ using assms by simp
+ then show "x \<in> F' i"
+ using f \<open>i \<in> I\<close> by (auto simp: PiE_def)
+qed
+
+lemma PiE_eq_iff_not_empty:
+ assumes ne: "\<And>i. i \<in> I \<Longrightarrow> F i \<noteq> {}" "\<And>i. i \<in> I \<Longrightarrow> F' i \<noteq> {}"
+ shows "Pi\<^sub>E I F = Pi\<^sub>E I F' \<longleftrightarrow> (\<forall>i\<in>I. F i = F' i)"
+proof (intro iffI ballI)
+ fix i
+ assume eq: "Pi\<^sub>E I F = Pi\<^sub>E I F'"
+ assume i: "i \<in> I"
+ show "F i = F' i"
+ using PiE_eq_subset[of I F F', OF ne eq i]
+ using PiE_eq_subset[of I F' F, OF ne(2,1) eq[symmetric] i]
+ by auto
+qed (auto simp: PiE_def)
+
+lemma PiE_eq_iff:
+ "Pi\<^sub>E I F = Pi\<^sub>E I F' \<longleftrightarrow> (\<forall>i\<in>I. F i = F' i) \<or> ((\<exists>i\<in>I. F i = {}) \<and> (\<exists>i\<in>I. F' i = {}))"
+proof (intro iffI disjCI)
+ assume eq[simp]: "Pi\<^sub>E I F = Pi\<^sub>E I F'"
+ assume "\<not> ((\<exists>i\<in>I. F i = {}) \<and> (\<exists>i\<in>I. F' i = {}))"
+ then have "(\<forall>i\<in>I. F i \<noteq> {}) \<and> (\<forall>i\<in>I. F' i \<noteq> {})"
+ using PiE_eq_empty_iff[of I F] PiE_eq_empty_iff[of I F'] by auto
+ with PiE_eq_iff_not_empty[of I F F'] show "\<forall>i\<in>I. F i = F' i"
+ by auto
+next
+ assume "(\<forall>i\<in>I. F i = F' i) \<or> (\<exists>i\<in>I. F i = {}) \<and> (\<exists>i\<in>I. F' i = {})"
+ then show "Pi\<^sub>E I F = Pi\<^sub>E I F'"
+ using PiE_eq_empty_iff[of I F] PiE_eq_empty_iff[of I F'] by (auto simp: PiE_def)
+qed
+
+lemma extensional_funcset_fun_upd_restricts_rangeI:
+ "\<forall>y \<in> S. f x \<noteq> f y \<Longrightarrow> f \<in> (insert x S) \<rightarrow>\<^sub>E T \<Longrightarrow> f(x := undefined) \<in> S \<rightarrow>\<^sub>E (T - {f x})"
+ unfolding extensional_funcset_def extensional_def
+ apply auto
+ apply (case_tac "x = xa")
+ apply auto
+ done
+
+lemma extensional_funcset_fun_upd_extends_rangeI:
+ assumes "a \<in> T" "f \<in> S \<rightarrow>\<^sub>E (T - {a})"
+ shows "f(x := a) \<in> insert x S \<rightarrow>\<^sub>E T"
+ using assms unfolding extensional_funcset_def extensional_def by auto
+
+
+subsubsection \<open>Injective Extensional Function Spaces\<close>
+
+lemma extensional_funcset_fun_upd_inj_onI:
+ assumes "f \<in> S \<rightarrow>\<^sub>E (T - {a})"
+ and "inj_on f S"
+ shows "inj_on (f(x := a)) S"
+ using assms
+ unfolding extensional_funcset_def by (auto intro!: inj_on_fun_updI)
+
+lemma extensional_funcset_extend_domain_inj_on_eq:
+ assumes "x \<notin> S"
+ shows "{f. f \<in> (insert x S) \<rightarrow>\<^sub>E T \<and> inj_on f (insert x S)} =
+ (\<lambda>(y, g). g(x:=y)) ` {(y, g). y \<in> T \<and> g \<in> S \<rightarrow>\<^sub>E (T - {y}) \<and> inj_on g S}"
+ using assms
+ apply (auto del: PiE_I PiE_E)
+ apply (auto intro: extensional_funcset_fun_upd_inj_onI
+ extensional_funcset_fun_upd_extends_rangeI del: PiE_I PiE_E)
+ apply (auto simp add: image_iff inj_on_def)
+ apply (rule_tac x="xa x" in exI)
+ apply (auto intro: PiE_mem del: PiE_I PiE_E)
+ apply (rule_tac x="xa(x := undefined)" in exI)
+ apply (auto intro!: extensional_funcset_fun_upd_restricts_rangeI)
+ apply (auto dest!: PiE_mem split: if_split_asm)
+ done
+
+lemma extensional_funcset_extend_domain_inj_onI:
+ assumes "x \<notin> S"
+ shows "inj_on (\<lambda>(y, g). g(x := y)) {(y, g). y \<in> T \<and> g \<in> S \<rightarrow>\<^sub>E (T - {y}) \<and> inj_on g S}"
+ using assms
+ apply (auto intro!: inj_onI)
+ apply (metis fun_upd_same)
+ apply (metis assms PiE_arb fun_upd_triv fun_upd_upd)
+ done
+
+
+subsubsection \<open>Cardinality\<close>
+
+lemma finite_PiE: "finite S \<Longrightarrow> (\<And>i. i \<in> S \<Longrightarrow> finite (T i)) \<Longrightarrow> finite (\<Pi>\<^sub>E i \<in> S. T i)"
+ by (induct S arbitrary: T rule: finite_induct) (simp_all add: PiE_insert_eq)
+
+lemma inj_combinator: "x \<notin> S \<Longrightarrow> inj_on (\<lambda>(y, g). g(x := y)) (T x \<times> Pi\<^sub>E S T)"
+proof (safe intro!: inj_onI ext)
+ fix f y g z
+ assume "x \<notin> S"
+ assume fg: "f \<in> Pi\<^sub>E S T" "g \<in> Pi\<^sub>E S T"
+ assume "f(x := y) = g(x := z)"
+ then have *: "\<And>i. (f(x := y)) i = (g(x := z)) i"
+ unfolding fun_eq_iff by auto
+ from this[of x] show "y = z" by simp
+ fix i from *[of i] \<open>x \<notin> S\<close> fg show "f i = g i"
+ by (auto split: if_split_asm simp: PiE_def extensional_def)
+qed
+
+lemma card_PiE: "finite S \<Longrightarrow> card (\<Pi>\<^sub>E i \<in> S. T i) = (\<Prod> i\<in>S. card (T i))"
+proof (induct rule: finite_induct)
+ case empty
+ then show ?case by auto
+next
+ case (insert x S)
+ then show ?case
+ by (simp add: PiE_insert_eq inj_combinator card_image card_cartesian_product)
+qed
+
+end
--- a/src/HOL/HOL.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/HOL.thy Wed May 02 13:49:38 2018 +0200
@@ -1398,6 +1398,9 @@
lemma if_distrib: "f (if c then x else y) = (if c then f x else f y)"
by simp
+lemma if_distribR: "(if b then f else g) x = (if b then f x else g x)"
+ by simp
+
lemma all_if_distrib: "(\<forall>x. if x = a then P x else Q x) \<longleftrightarrow> P a \<and> (\<forall>x. x\<noteq>a \<longrightarrow> Q x)"
by auto
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Hull.thy Wed May 02 13:49:38 2018 +0200
@@ -0,0 +1,85 @@
+(* Title: Hull.thy
+ Author: Amine Chaieb, University of Cambridge
+ Author: Jose Divasón <jose.divasonm at unirioja.es>
+ Author: Jesús Aransay <jesus-maria.aransay at unirioja.es>
+ Author: Johannes Hölzl, VU Amsterdam
+*)
+
+theory Hull
+ imports Main
+begin
+
+subsection \<open>A generic notion of the convex, affine, conic hull, or closed "hull".\<close>
+
+definition hull :: "('a set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "hull" 75)
+ where "S hull s = \<Inter>{t. S t \<and> s \<subseteq> t}"
+
+lemma hull_same: "S s \<Longrightarrow> S hull s = s"
+ unfolding hull_def by auto
+
+lemma hull_in: "(\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)) \<Longrightarrow> S (S hull s)"
+ unfolding hull_def Ball_def by auto
+
+lemma hull_eq: "(\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)) \<Longrightarrow> (S hull s) = s \<longleftrightarrow> S s"
+ using hull_same[of S s] hull_in[of S s] by metis
+
+lemma hull_hull [simp]: "S hull (S hull s) = S hull s"
+ unfolding hull_def by blast
+
+lemma hull_subset[intro]: "s \<subseteq> (S hull s)"
+ unfolding hull_def by blast
+
+lemma hull_mono: "s \<subseteq> t \<Longrightarrow> (S hull s) \<subseteq> (S hull t)"
+ unfolding hull_def by blast
+
+lemma hull_antimono: "\<forall>x. S x \<longrightarrow> T x \<Longrightarrow> (T hull s) \<subseteq> (S hull s)"
+ unfolding hull_def by blast
+
+lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> S t \<Longrightarrow> (S hull s) \<subseteq> t"
+ unfolding hull_def by blast
+
+lemma subset_hull: "S t \<Longrightarrow> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
+ unfolding hull_def by blast
+
+lemma hull_UNIV [simp]: "S hull UNIV = UNIV"
+ unfolding hull_def by auto
+
+lemma hull_unique: "s \<subseteq> t \<Longrightarrow> S t \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> S t' \<Longrightarrow> t \<subseteq> t') \<Longrightarrow> (S hull s = t)"
+ unfolding hull_def by auto
+
+lemma hull_induct: "(\<And>x. x\<in> S \<Longrightarrow> P x) \<Longrightarrow> Q {x. P x} \<Longrightarrow> \<forall>x\<in> Q hull S. P x"
+ using hull_minimal[of S "{x. P x}" Q]
+ by (auto simp add: subset_eq)
+
+lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S"
+ by (metis hull_subset subset_eq)
+
+lemma hull_Un_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))"
+ unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2)
+
+lemma hull_Un:
+ assumes T: "\<And>T. Ball T S \<Longrightarrow> S (\<Inter>T)"
+ shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)"
+ apply (rule equalityI)
+ apply (meson hull_mono hull_subset sup.mono)
+ by (metis hull_Un_subset hull_hull hull_mono)
+
+lemma hull_Un_left: "P hull (S \<union> T) = P hull (P hull S \<union> T)"
+ apply (rule equalityI)
+ apply (simp add: Un_commute hull_mono hull_subset sup.coboundedI2)
+ by (metis Un_subset_iff hull_hull hull_mono hull_subset)
+
+lemma hull_Un_right: "P hull (S \<union> T) = P hull (S \<union> P hull T)"
+ by (metis hull_Un_left sup.commute)
+
+lemma hull_insert:
+ "P hull (insert a S) = P hull (insert a (P hull S))"
+ by (metis hull_Un_right insert_is_Un)
+
+lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> S hull (insert a s) = S hull s"
+ unfolding hull_def by blast
+
+lemma hull_redundant: "a \<in> (S hull s) \<Longrightarrow> S hull (insert a s) = S hull s"
+ by (metis hull_redundant_eq)
+
+end
\ No newline at end of file
--- a/src/HOL/Library/FuncSet.thy Wed Apr 18 21:12:50 2018 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,568 +0,0 @@
-(* Title: HOL/Library/FuncSet.thy
- Author: Florian Kammueller and Lawrence C Paulson, Lukas Bulwahn
-*)
-
-section \<open>Pi and Function Sets\<close>
-
-theory FuncSet
- imports Main
- abbrevs PiE = "Pi\<^sub>E"
- and PIE = "\<Pi>\<^sub>E"
-begin
-
-definition Pi :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> ('a \<Rightarrow> 'b) set"
- where "Pi A B = {f. \<forall>x. x \<in> A \<longrightarrow> f x \<in> B x}"
-
-definition extensional :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b) set"
- where "extensional A = {f. \<forall>x. x \<notin> A \<longrightarrow> f x = undefined}"
-
-definition "restrict" :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> 'b"
- where "restrict f A = (\<lambda>x. if x \<in> A then f x else undefined)"
-
-abbreviation funcset :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set" (infixr "\<rightarrow>" 60)
- where "A \<rightarrow> B \<equiv> Pi A (\<lambda>_. B)"
-
-syntax
- "_Pi" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set" ("(3\<Pi> _\<in>_./ _)" 10)
- "_lam" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)" ("(3\<lambda>_\<in>_./ _)" [0,0,3] 3)
-translations
- "\<Pi> x\<in>A. B" \<rightleftharpoons> "CONST Pi A (\<lambda>x. B)"
- "\<lambda>x\<in>A. f" \<rightleftharpoons> "CONST restrict (\<lambda>x. f) A"
-
-definition "compose" :: "'a set \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'c)"
- where "compose A g f = (\<lambda>x\<in>A. g (f x))"
-
-
-subsection \<open>Basic Properties of @{term Pi}\<close>
-
-lemma Pi_I[intro!]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B x) \<Longrightarrow> f \<in> Pi A B"
- by (simp add: Pi_def)
-
-lemma Pi_I'[simp]: "(\<And>x. x \<in> A \<longrightarrow> f x \<in> B x) \<Longrightarrow> f \<in> Pi A B"
- by (simp add:Pi_def)
-
-lemma funcsetI: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B) \<Longrightarrow> f \<in> A \<rightarrow> B"
- by (simp add: Pi_def)
-
-lemma Pi_mem: "f \<in> Pi A B \<Longrightarrow> x \<in> A \<Longrightarrow> f x \<in> B x"
- by (simp add: Pi_def)
-
-lemma Pi_iff: "f \<in> Pi I X \<longleftrightarrow> (\<forall>i\<in>I. f i \<in> X i)"
- unfolding Pi_def by auto
-
-lemma PiE [elim]: "f \<in> Pi A B \<Longrightarrow> (f x \<in> B x \<Longrightarrow> Q) \<Longrightarrow> (x \<notin> A \<Longrightarrow> Q) \<Longrightarrow> Q"
- by (auto simp: Pi_def)
-
-lemma Pi_cong: "(\<And>w. w \<in> A \<Longrightarrow> f w = g w) \<Longrightarrow> f \<in> Pi A B \<longleftrightarrow> g \<in> Pi A B"
- by (auto simp: Pi_def)
-
-lemma funcset_id [simp]: "(\<lambda>x. x) \<in> A \<rightarrow> A"
- by auto
-
-lemma funcset_mem: "f \<in> A \<rightarrow> B \<Longrightarrow> x \<in> A \<Longrightarrow> f x \<in> B"
- by (simp add: Pi_def)
-
-lemma funcset_image: "f \<in> A \<rightarrow> B \<Longrightarrow> f ` A \<subseteq> B"
- by auto
-
-lemma image_subset_iff_funcset: "F ` A \<subseteq> B \<longleftrightarrow> F \<in> A \<rightarrow> B"
- by auto
-
-lemma Pi_eq_empty[simp]: "(\<Pi> x \<in> A. B x) = {} \<longleftrightarrow> (\<exists>x\<in>A. B x = {})"
- apply (simp add: Pi_def)
- apply auto
- txt \<open>Converse direction requires Axiom of Choice to exhibit a function
- picking an element from each non-empty @{term "B x"}\<close>
- apply (drule_tac x = "\<lambda>u. SOME y. y \<in> B u" in spec)
- apply auto
- apply (cut_tac P = "\<lambda>y. y \<in> B x" in some_eq_ex)
- apply auto
- done
-
-lemma Pi_empty [simp]: "Pi {} B = UNIV"
- by (simp add: Pi_def)
-
-lemma Pi_Int: "Pi I E \<inter> Pi I F = (\<Pi> i\<in>I. E i \<inter> F i)"
- by auto
-
-lemma Pi_UN:
- fixes A :: "nat \<Rightarrow> 'i \<Rightarrow> 'a set"
- assumes "finite I"
- and mono: "\<And>i n m. i \<in> I \<Longrightarrow> n \<le> m \<Longrightarrow> A n i \<subseteq> A m i"
- shows "(\<Union>n. Pi I (A n)) = (\<Pi> i\<in>I. \<Union>n. A n i)"
-proof (intro set_eqI iffI)
- fix f
- assume "f \<in> (\<Pi> i\<in>I. \<Union>n. A n i)"
- then have "\<forall>i\<in>I. \<exists>n. f i \<in> A n i"
- by auto
- from bchoice[OF this] obtain n where n: "f i \<in> A (n i) i" if "i \<in> I" for i
- by auto
- obtain k where k: "n i \<le> k" if "i \<in> I" for i
- using \<open>finite I\<close> finite_nat_set_iff_bounded_le[of "n`I"] by auto
- have "f \<in> Pi I (A k)"
- proof (intro Pi_I)
- fix i
- assume "i \<in> I"
- from mono[OF this, of "n i" k] k[OF this] n[OF this]
- show "f i \<in> A k i" by auto
- qed
- then show "f \<in> (\<Union>n. Pi I (A n))"
- by auto
-qed auto
-
-lemma Pi_UNIV [simp]: "A \<rightarrow> UNIV = UNIV"
- by (simp add: Pi_def)
-
-text \<open>Covariance of Pi-sets in their second argument\<close>
-lemma Pi_mono: "(\<And>x. x \<in> A \<Longrightarrow> B x \<subseteq> C x) \<Longrightarrow> Pi A B \<subseteq> Pi A C"
- by auto
-
-text \<open>Contravariance of Pi-sets in their first argument\<close>
-lemma Pi_anti_mono: "A' \<subseteq> A \<Longrightarrow> Pi A B \<subseteq> Pi A' B"
- by auto
-
-lemma prod_final:
- assumes 1: "fst \<circ> f \<in> Pi A B"
- and 2: "snd \<circ> f \<in> Pi A C"
- shows "f \<in> (\<Pi> z \<in> A. B z \<times> C z)"
-proof (rule Pi_I)
- fix z
- assume z: "z \<in> A"
- have "f z = (fst (f z), snd (f z))"
- by simp
- also have "\<dots> \<in> B z \<times> C z"
- by (metis SigmaI PiE o_apply 1 2 z)
- finally show "f z \<in> B z \<times> C z" .
-qed
-
-lemma Pi_split_domain[simp]: "x \<in> Pi (I \<union> J) X \<longleftrightarrow> x \<in> Pi I X \<and> x \<in> Pi J X"
- by (auto simp: Pi_def)
-
-lemma Pi_split_insert_domain[simp]: "x \<in> Pi (insert i I) X \<longleftrightarrow> x \<in> Pi I X \<and> x i \<in> X i"
- by (auto simp: Pi_def)
-
-lemma Pi_cancel_fupd_range[simp]: "i \<notin> I \<Longrightarrow> x \<in> Pi I (B(i := b)) \<longleftrightarrow> x \<in> Pi I B"
- by (auto simp: Pi_def)
-
-lemma Pi_cancel_fupd[simp]: "i \<notin> I \<Longrightarrow> x(i := a) \<in> Pi I B \<longleftrightarrow> x \<in> Pi I B"
- by (auto simp: Pi_def)
-
-lemma Pi_fupd_iff: "i \<in> I \<Longrightarrow> f \<in> Pi I (B(i := A)) \<longleftrightarrow> f \<in> Pi (I - {i}) B \<and> f i \<in> A"
- apply auto
- apply (drule_tac x=x in Pi_mem)
- apply (simp_all split: if_split_asm)
- apply (drule_tac x=i in Pi_mem)
- apply (auto dest!: Pi_mem)
- done
-
-
-subsection \<open>Composition With a Restricted Domain: @{term compose}\<close>
-
-lemma funcset_compose: "f \<in> A \<rightarrow> B \<Longrightarrow> g \<in> B \<rightarrow> C \<Longrightarrow> compose A g f \<in> A \<rightarrow> C"
- by (simp add: Pi_def compose_def restrict_def)
-
-lemma compose_assoc:
- assumes "f \<in> A \<rightarrow> B"
- and "g \<in> B \<rightarrow> C"
- and "h \<in> C \<rightarrow> D"
- shows "compose A h (compose A g f) = compose A (compose B h g) f"
- using assms by (simp add: fun_eq_iff Pi_def compose_def restrict_def)
-
-lemma compose_eq: "x \<in> A \<Longrightarrow> compose A g f x = g (f x)"
- by (simp add: compose_def restrict_def)
-
-lemma surj_compose: "f ` A = B \<Longrightarrow> g ` B = C \<Longrightarrow> compose A g f ` A = C"
- by (auto simp add: image_def compose_eq)
-
-
-subsection \<open>Bounded Abstraction: @{term restrict}\<close>
-
-lemma restrict_cong: "I = J \<Longrightarrow> (\<And>i. i \<in> J =simp=> f i = g i) \<Longrightarrow> restrict f I = restrict g J"
- by (auto simp: restrict_def fun_eq_iff simp_implies_def)
-
-lemma restrict_in_funcset: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B) \<Longrightarrow> (\<lambda>x\<in>A. f x) \<in> A \<rightarrow> B"
- by (simp add: Pi_def restrict_def)
-
-lemma restrictI[intro!]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B x) \<Longrightarrow> (\<lambda>x\<in>A. f x) \<in> Pi A B"
- by (simp add: Pi_def restrict_def)
-
-lemma restrict_apply[simp]: "(\<lambda>y\<in>A. f y) x = (if x \<in> A then f x else undefined)"
- by (simp add: restrict_def)
-
-lemma restrict_apply': "x \<in> A \<Longrightarrow> (\<lambda>y\<in>A. f y) x = f x"
- by simp
-
-lemma restrict_ext: "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> (\<lambda>x\<in>A. f x) = (\<lambda>x\<in>A. g x)"
- by (simp add: fun_eq_iff Pi_def restrict_def)
-
-lemma restrict_UNIV: "restrict f UNIV = f"
- by (simp add: restrict_def)
-
-lemma inj_on_restrict_eq [simp]: "inj_on (restrict f A) A = inj_on f A"
- by (simp add: inj_on_def restrict_def)
-
-lemma Id_compose: "f \<in> A \<rightarrow> B \<Longrightarrow> f \<in> extensional A \<Longrightarrow> compose A (\<lambda>y\<in>B. y) f = f"
- by (auto simp add: fun_eq_iff compose_def extensional_def Pi_def)
-
-lemma compose_Id: "g \<in> A \<rightarrow> B \<Longrightarrow> g \<in> extensional A \<Longrightarrow> compose A g (\<lambda>x\<in>A. x) = g"
- by (auto simp add: fun_eq_iff compose_def extensional_def Pi_def)
-
-lemma image_restrict_eq [simp]: "(restrict f A) ` A = f ` A"
- by (auto simp add: restrict_def)
-
-lemma restrict_restrict[simp]: "restrict (restrict f A) B = restrict f (A \<inter> B)"
- unfolding restrict_def by (simp add: fun_eq_iff)
-
-lemma restrict_fupd[simp]: "i \<notin> I \<Longrightarrow> restrict (f (i := x)) I = restrict f I"
- by (auto simp: restrict_def)
-
-lemma restrict_upd[simp]: "i \<notin> I \<Longrightarrow> (restrict f I)(i := y) = restrict (f(i := y)) (insert i I)"
- by (auto simp: fun_eq_iff)
-
-lemma restrict_Pi_cancel: "restrict x I \<in> Pi I A \<longleftrightarrow> x \<in> Pi I A"
- by (auto simp: restrict_def Pi_def)
-
-
-subsection \<open>Bijections Between Sets\<close>
-
-text \<open>The definition of @{const bij_betw} is in \<open>Fun.thy\<close>, but most of
-the theorems belong here, or need at least @{term Hilbert_Choice}.\<close>
-
-lemma bij_betwI:
- assumes "f \<in> A \<rightarrow> B"
- and "g \<in> B \<rightarrow> A"
- and g_f: "\<And>x. x\<in>A \<Longrightarrow> g (f x) = x"
- and f_g: "\<And>y. y\<in>B \<Longrightarrow> f (g y) = y"
- shows "bij_betw f A B"
- unfolding bij_betw_def
-proof
- show "inj_on f A"
- by (metis g_f inj_on_def)
- have "f ` A \<subseteq> B"
- using \<open>f \<in> A \<rightarrow> B\<close> by auto
- moreover
- have "B \<subseteq> f ` A"
- by auto (metis Pi_mem \<open>g \<in> B \<rightarrow> A\<close> f_g image_iff)
- ultimately show "f ` A = B"
- by blast
-qed
-
-lemma bij_betw_imp_funcset: "bij_betw f A B \<Longrightarrow> f \<in> A \<rightarrow> B"
- by (auto simp add: bij_betw_def)
-
-lemma inj_on_compose: "bij_betw f A B \<Longrightarrow> inj_on g B \<Longrightarrow> inj_on (compose A g f) A"
- by (auto simp add: bij_betw_def inj_on_def compose_eq)
-
-lemma bij_betw_compose: "bij_betw f A B \<Longrightarrow> bij_betw g B C \<Longrightarrow> bij_betw (compose A g f) A C"
- apply (simp add: bij_betw_def compose_eq inj_on_compose)
- apply (auto simp add: compose_def image_def)
- done
-
-lemma bij_betw_restrict_eq [simp]: "bij_betw (restrict f A) A B = bij_betw f A B"
- by (simp add: bij_betw_def)
-
-
-subsection \<open>Extensionality\<close>
-
-lemma extensional_empty[simp]: "extensional {} = {\<lambda>x. undefined}"
- unfolding extensional_def by auto
-
-lemma extensional_arb: "f \<in> extensional A \<Longrightarrow> x \<notin> A \<Longrightarrow> f x = undefined"
- by (simp add: extensional_def)
-
-lemma restrict_extensional [simp]: "restrict f A \<in> extensional A"
- by (simp add: restrict_def extensional_def)
-
-lemma compose_extensional [simp]: "compose A f g \<in> extensional A"
- by (simp add: compose_def)
-
-lemma extensionalityI:
- assumes "f \<in> extensional A"
- and "g \<in> extensional A"
- and "\<And>x. x \<in> A \<Longrightarrow> f x = g x"
- shows "f = g"
- using assms by (force simp add: fun_eq_iff extensional_def)
-
-lemma extensional_restrict: "f \<in> extensional A \<Longrightarrow> restrict f A = f"
- by (rule extensionalityI[OF restrict_extensional]) auto
-
-lemma extensional_subset: "f \<in> extensional A \<Longrightarrow> A \<subseteq> B \<Longrightarrow> f \<in> extensional B"
- unfolding extensional_def by auto
-
-lemma inv_into_funcset: "f ` A = B \<Longrightarrow> (\<lambda>x\<in>B. inv_into A f x) \<in> B \<rightarrow> A"
- by (unfold inv_into_def) (fast intro: someI2)
-
-lemma compose_inv_into_id: "bij_betw f A B \<Longrightarrow> compose A (\<lambda>y\<in>B. inv_into A f y) f = (\<lambda>x\<in>A. x)"
- apply (simp add: bij_betw_def compose_def)
- apply (rule restrict_ext, auto)
- done
-
-lemma compose_id_inv_into: "f ` A = B \<Longrightarrow> compose B f (\<lambda>y\<in>B. inv_into A f y) = (\<lambda>x\<in>B. x)"
- apply (simp add: compose_def)
- apply (rule restrict_ext)
- apply (simp add: f_inv_into_f)
- done
-
-lemma extensional_insert[intro, simp]:
- assumes "a \<in> extensional (insert i I)"
- shows "a(i := b) \<in> extensional (insert i I)"
- using assms unfolding extensional_def by auto
-
-lemma extensional_Int[simp]: "extensional I \<inter> extensional I' = extensional (I \<inter> I')"
- unfolding extensional_def by auto
-
-lemma extensional_UNIV[simp]: "extensional UNIV = UNIV"
- by (auto simp: extensional_def)
-
-lemma restrict_extensional_sub[intro]: "A \<subseteq> B \<Longrightarrow> restrict f A \<in> extensional B"
- unfolding restrict_def extensional_def by auto
-
-lemma extensional_insert_undefined[intro, simp]:
- "a \<in> extensional (insert i I) \<Longrightarrow> a(i := undefined) \<in> extensional I"
- unfolding extensional_def by auto
-
-lemma extensional_insert_cancel[intro, simp]:
- "a \<in> extensional I \<Longrightarrow> a \<in> extensional (insert i I)"
- unfolding extensional_def by auto
-
-
-subsection \<open>Cardinality\<close>
-
-lemma card_inj: "f \<in> A \<rightarrow> B \<Longrightarrow> inj_on f A \<Longrightarrow> finite B \<Longrightarrow> card A \<le> card B"
- by (rule card_inj_on_le) auto
-
-lemma card_bij:
- assumes "f \<in> A \<rightarrow> B" "inj_on f A"
- and "g \<in> B \<rightarrow> A" "inj_on g B"
- and "finite A" "finite B"
- shows "card A = card B"
- using assms by (blast intro: card_inj order_antisym)
-
-
-subsection \<open>Extensional Function Spaces\<close>
-
-definition PiE :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> ('a \<Rightarrow> 'b) set"
- where "PiE S T = Pi S T \<inter> extensional S"
-
-abbreviation "Pi\<^sub>E A B \<equiv> PiE A B"
-
-syntax
- "_PiE" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set" ("(3\<Pi>\<^sub>E _\<in>_./ _)" 10)
-translations
- "\<Pi>\<^sub>E x\<in>A. B" \<rightleftharpoons> "CONST Pi\<^sub>E A (\<lambda>x. B)"
-
-abbreviation extensional_funcset :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set" (infixr "\<rightarrow>\<^sub>E" 60)
- where "A \<rightarrow>\<^sub>E B \<equiv> (\<Pi>\<^sub>E i\<in>A. B)"
-
-lemma extensional_funcset_def: "extensional_funcset S T = (S \<rightarrow> T) \<inter> extensional S"
- by (simp add: PiE_def)
-
-lemma PiE_empty_domain[simp]: "Pi\<^sub>E {} T = {\<lambda>x. undefined}"
- unfolding PiE_def by simp
-
-lemma PiE_UNIV_domain: "Pi\<^sub>E UNIV T = Pi UNIV T"
- unfolding PiE_def by simp
-
-lemma PiE_empty_range[simp]: "i \<in> I \<Longrightarrow> F i = {} \<Longrightarrow> (\<Pi>\<^sub>E i\<in>I. F i) = {}"
- unfolding PiE_def by auto
-
-lemma PiE_eq_empty_iff: "Pi\<^sub>E I F = {} \<longleftrightarrow> (\<exists>i\<in>I. F i = {})"
-proof
- assume "Pi\<^sub>E I F = {}"
- show "\<exists>i\<in>I. F i = {}"
- proof (rule ccontr)
- assume "\<not> ?thesis"
- then have "\<forall>i. \<exists>y. (i \<in> I \<longrightarrow> y \<in> F i) \<and> (i \<notin> I \<longrightarrow> y = undefined)"
- by auto
- from choice[OF this]
- obtain f where " \<forall>x. (x \<in> I \<longrightarrow> f x \<in> F x) \<and> (x \<notin> I \<longrightarrow> f x = undefined)" ..
- then have "f \<in> Pi\<^sub>E I F"
- by (auto simp: extensional_def PiE_def)
- with \<open>Pi\<^sub>E I F = {}\<close> show False
- by auto
- qed
-qed (auto simp: PiE_def)
-
-lemma PiE_arb: "f \<in> Pi\<^sub>E S T \<Longrightarrow> x \<notin> S \<Longrightarrow> f x = undefined"
- unfolding PiE_def by auto (auto dest!: extensional_arb)
-
-lemma PiE_mem: "f \<in> Pi\<^sub>E S T \<Longrightarrow> x \<in> S \<Longrightarrow> f x \<in> T x"
- unfolding PiE_def by auto
-
-lemma PiE_fun_upd: "y \<in> T x \<Longrightarrow> f \<in> Pi\<^sub>E S T \<Longrightarrow> f(x := y) \<in> Pi\<^sub>E (insert x S) T"
- unfolding PiE_def extensional_def by auto
-
-lemma fun_upd_in_PiE: "x \<notin> S \<Longrightarrow> f \<in> Pi\<^sub>E (insert x S) T \<Longrightarrow> f(x := undefined) \<in> Pi\<^sub>E S T"
- unfolding PiE_def extensional_def by auto
-
-lemma PiE_insert_eq: "Pi\<^sub>E (insert x S) T = (\<lambda>(y, g). g(x := y)) ` (T x \<times> Pi\<^sub>E S T)"
-proof -
- {
- fix f assume "f \<in> Pi\<^sub>E (insert x S) T" "x \<notin> S"
- then have "f \<in> (\<lambda>(y, g). g(x := y)) ` (T x \<times> Pi\<^sub>E S T)"
- by (auto intro!: image_eqI[where x="(f x, f(x := undefined))"] intro: fun_upd_in_PiE PiE_mem)
- }
- moreover
- {
- fix f assume "f \<in> Pi\<^sub>E (insert x S) T" "x \<in> S"
- then have "f \<in> (\<lambda>(y, g). g(x := y)) ` (T x \<times> Pi\<^sub>E S T)"
- by (auto intro!: image_eqI[where x="(f x, f)"] intro: fun_upd_in_PiE PiE_mem simp: insert_absorb)
- }
- ultimately show ?thesis
- by (auto intro: PiE_fun_upd)
-qed
-
-lemma PiE_Int: "Pi\<^sub>E I A \<inter> Pi\<^sub>E I B = Pi\<^sub>E I (\<lambda>x. A x \<inter> B x)"
- by (auto simp: PiE_def)
-
-lemma PiE_cong: "(\<And>i. i\<in>I \<Longrightarrow> A i = B i) \<Longrightarrow> Pi\<^sub>E I A = Pi\<^sub>E I B"
- unfolding PiE_def by (auto simp: Pi_cong)
-
-lemma PiE_E [elim]:
- assumes "f \<in> Pi\<^sub>E A B"
- obtains "x \<in> A" and "f x \<in> B x"
- | "x \<notin> A" and "f x = undefined"
- using assms by (auto simp: Pi_def PiE_def extensional_def)
-
-lemma PiE_I[intro!]:
- "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B x) \<Longrightarrow> (\<And>x. x \<notin> A \<Longrightarrow> f x = undefined) \<Longrightarrow> f \<in> Pi\<^sub>E A B"
- by (simp add: PiE_def extensional_def)
-
-lemma PiE_mono: "(\<And>x. x \<in> A \<Longrightarrow> B x \<subseteq> C x) \<Longrightarrow> Pi\<^sub>E A B \<subseteq> Pi\<^sub>E A C"
- by auto
-
-lemma PiE_iff: "f \<in> Pi\<^sub>E I X \<longleftrightarrow> (\<forall>i\<in>I. f i \<in> X i) \<and> f \<in> extensional I"
- by (simp add: PiE_def Pi_iff)
-
-lemma PiE_restrict[simp]: "f \<in> Pi\<^sub>E A B \<Longrightarrow> restrict f A = f"
- by (simp add: extensional_restrict PiE_def)
-
-lemma restrict_PiE[simp]: "restrict f I \<in> Pi\<^sub>E I S \<longleftrightarrow> f \<in> Pi I S"
- by (auto simp: PiE_iff)
-
-lemma PiE_eq_subset:
- assumes ne: "\<And>i. i \<in> I \<Longrightarrow> F i \<noteq> {}" "\<And>i. i \<in> I \<Longrightarrow> F' i \<noteq> {}"
- and eq: "Pi\<^sub>E I F = Pi\<^sub>E I F'"
- and "i \<in> I"
- shows "F i \<subseteq> F' i"
-proof
- fix x
- assume "x \<in> F i"
- with ne have "\<forall>j. \<exists>y. (j \<in> I \<longrightarrow> y \<in> F j \<and> (i = j \<longrightarrow> x = y)) \<and> (j \<notin> I \<longrightarrow> y = undefined)"
- by auto
- from choice[OF this] obtain f
- where f: " \<forall>j. (j \<in> I \<longrightarrow> f j \<in> F j \<and> (i = j \<longrightarrow> x = f j)) \<and> (j \<notin> I \<longrightarrow> f j = undefined)" ..
- then have "f \<in> Pi\<^sub>E I F"
- by (auto simp: extensional_def PiE_def)
- then have "f \<in> Pi\<^sub>E I F'"
- using assms by simp
- then show "x \<in> F' i"
- using f \<open>i \<in> I\<close> by (auto simp: PiE_def)
-qed
-
-lemma PiE_eq_iff_not_empty:
- assumes ne: "\<And>i. i \<in> I \<Longrightarrow> F i \<noteq> {}" "\<And>i. i \<in> I \<Longrightarrow> F' i \<noteq> {}"
- shows "Pi\<^sub>E I F = Pi\<^sub>E I F' \<longleftrightarrow> (\<forall>i\<in>I. F i = F' i)"
-proof (intro iffI ballI)
- fix i
- assume eq: "Pi\<^sub>E I F = Pi\<^sub>E I F'"
- assume i: "i \<in> I"
- show "F i = F' i"
- using PiE_eq_subset[of I F F', OF ne eq i]
- using PiE_eq_subset[of I F' F, OF ne(2,1) eq[symmetric] i]
- by auto
-qed (auto simp: PiE_def)
-
-lemma PiE_eq_iff:
- "Pi\<^sub>E I F = Pi\<^sub>E I F' \<longleftrightarrow> (\<forall>i\<in>I. F i = F' i) \<or> ((\<exists>i\<in>I. F i = {}) \<and> (\<exists>i\<in>I. F' i = {}))"
-proof (intro iffI disjCI)
- assume eq[simp]: "Pi\<^sub>E I F = Pi\<^sub>E I F'"
- assume "\<not> ((\<exists>i\<in>I. F i = {}) \<and> (\<exists>i\<in>I. F' i = {}))"
- then have "(\<forall>i\<in>I. F i \<noteq> {}) \<and> (\<forall>i\<in>I. F' i \<noteq> {})"
- using PiE_eq_empty_iff[of I F] PiE_eq_empty_iff[of I F'] by auto
- with PiE_eq_iff_not_empty[of I F F'] show "\<forall>i\<in>I. F i = F' i"
- by auto
-next
- assume "(\<forall>i\<in>I. F i = F' i) \<or> (\<exists>i\<in>I. F i = {}) \<and> (\<exists>i\<in>I. F' i = {})"
- then show "Pi\<^sub>E I F = Pi\<^sub>E I F'"
- using PiE_eq_empty_iff[of I F] PiE_eq_empty_iff[of I F'] by (auto simp: PiE_def)
-qed
-
-lemma extensional_funcset_fun_upd_restricts_rangeI:
- "\<forall>y \<in> S. f x \<noteq> f y \<Longrightarrow> f \<in> (insert x S) \<rightarrow>\<^sub>E T \<Longrightarrow> f(x := undefined) \<in> S \<rightarrow>\<^sub>E (T - {f x})"
- unfolding extensional_funcset_def extensional_def
- apply auto
- apply (case_tac "x = xa")
- apply auto
- done
-
-lemma extensional_funcset_fun_upd_extends_rangeI:
- assumes "a \<in> T" "f \<in> S \<rightarrow>\<^sub>E (T - {a})"
- shows "f(x := a) \<in> insert x S \<rightarrow>\<^sub>E T"
- using assms unfolding extensional_funcset_def extensional_def by auto
-
-
-subsubsection \<open>Injective Extensional Function Spaces\<close>
-
-lemma extensional_funcset_fun_upd_inj_onI:
- assumes "f \<in> S \<rightarrow>\<^sub>E (T - {a})"
- and "inj_on f S"
- shows "inj_on (f(x := a)) S"
- using assms
- unfolding extensional_funcset_def by (auto intro!: inj_on_fun_updI)
-
-lemma extensional_funcset_extend_domain_inj_on_eq:
- assumes "x \<notin> S"
- shows "{f. f \<in> (insert x S) \<rightarrow>\<^sub>E T \<and> inj_on f (insert x S)} =
- (\<lambda>(y, g). g(x:=y)) ` {(y, g). y \<in> T \<and> g \<in> S \<rightarrow>\<^sub>E (T - {y}) \<and> inj_on g S}"
- using assms
- apply (auto del: PiE_I PiE_E)
- apply (auto intro: extensional_funcset_fun_upd_inj_onI
- extensional_funcset_fun_upd_extends_rangeI del: PiE_I PiE_E)
- apply (auto simp add: image_iff inj_on_def)
- apply (rule_tac x="xa x" in exI)
- apply (auto intro: PiE_mem del: PiE_I PiE_E)
- apply (rule_tac x="xa(x := undefined)" in exI)
- apply (auto intro!: extensional_funcset_fun_upd_restricts_rangeI)
- apply (auto dest!: PiE_mem split: if_split_asm)
- done
-
-lemma extensional_funcset_extend_domain_inj_onI:
- assumes "x \<notin> S"
- shows "inj_on (\<lambda>(y, g). g(x := y)) {(y, g). y \<in> T \<and> g \<in> S \<rightarrow>\<^sub>E (T - {y}) \<and> inj_on g S}"
- using assms
- apply (auto intro!: inj_onI)
- apply (metis fun_upd_same)
- apply (metis assms PiE_arb fun_upd_triv fun_upd_upd)
- done
-
-
-subsubsection \<open>Cardinality\<close>
-
-lemma finite_PiE: "finite S \<Longrightarrow> (\<And>i. i \<in> S \<Longrightarrow> finite (T i)) \<Longrightarrow> finite (\<Pi>\<^sub>E i \<in> S. T i)"
- by (induct S arbitrary: T rule: finite_induct) (simp_all add: PiE_insert_eq)
-
-lemma inj_combinator: "x \<notin> S \<Longrightarrow> inj_on (\<lambda>(y, g). g(x := y)) (T x \<times> Pi\<^sub>E S T)"
-proof (safe intro!: inj_onI ext)
- fix f y g z
- assume "x \<notin> S"
- assume fg: "f \<in> Pi\<^sub>E S T" "g \<in> Pi\<^sub>E S T"
- assume "f(x := y) = g(x := z)"
- then have *: "\<And>i. (f(x := y)) i = (g(x := z)) i"
- unfolding fun_eq_iff by auto
- from this[of x] show "y = z" by simp
- fix i from *[of i] \<open>x \<notin> S\<close> fg show "f i = g i"
- by (auto split: if_split_asm simp: PiE_def extensional_def)
-qed
-
-lemma card_PiE: "finite S \<Longrightarrow> card (\<Pi>\<^sub>E i \<in> S. T i) = (\<Prod> i\<in>S. card (T i))"
-proof (induct rule: finite_induct)
- case empty
- then show ?case by auto
-next
- case (insert x S)
- then show ?case
- by (simp add: PiE_insert_eq inj_combinator card_image card_cartesian_product)
-qed
-
-end
--- a/src/HOL/Library/Library.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Library/Library.thy Wed May 02 13:49:38 2018 +0200
@@ -28,7 +28,6 @@
Finite_Map
Float
FSet
- FuncSet
Function_Division
Fun_Lexorder
Going_To_Filter
--- a/src/HOL/Metis_Examples/Abstraction.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Metis_Examples/Abstraction.thy Wed May 02 13:49:38 2018 +0200
@@ -8,7 +8,7 @@
section \<open>Example Featuring Metis's Support for Lambda-Abstractions\<close>
theory Abstraction
-imports "HOL-Library.FuncSet"
+imports HOL.FuncSet
begin
(* For Christoph Benzmüller *)
--- a/src/HOL/Metis_Examples/Tarski.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Metis_Examples/Tarski.thy Wed May 02 13:49:38 2018 +0200
@@ -8,7 +8,7 @@
section \<open>Metis Example Featuring the Full Theorem of Tarski\<close>
theory Tarski
-imports Main "HOL-Library.FuncSet"
+imports Main HOL.FuncSet
begin
declare [[metis_new_skolem]]
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Modules.thy Wed May 02 13:49:38 2018 +0200
@@ -0,0 +1,937 @@
+(* Title: Modules.thy
+ Author: Amine Chaieb, University of Cambridge
+ Author: Jose Divasón <jose.divasonm at unirioja.es>
+ Author: Jesús Aransay <jesus-maria.aransay at unirioja.es>
+ Author: Johannes Hölzl, VU Amsterdam
+ Author: Fabian Immler, TUM
+*)
+
+section \<open>Modules\<close>
+
+text \<open>Bases of a linear algebra based on modules (i.e. vector spaces of rings). \<close>
+
+theory Modules
+ imports Hull
+begin
+
+subsection \<open>Locale for additive functions\<close>
+
+locale additive =
+ fixes f :: "'a::ab_group_add \<Rightarrow> 'b::ab_group_add"
+ assumes add: "f (x + y) = f x + f y"
+begin
+
+lemma zero: "f 0 = 0"
+proof -
+ have "f 0 = f (0 + 0)" by simp
+ also have "\<dots> = f 0 + f 0" by (rule add)
+ finally show "f 0 = 0" by simp
+qed
+
+lemma minus: "f (- x) = - f x"
+proof -
+ have "f (- x) + f x = f (- x + x)" by (rule add [symmetric])
+ also have "\<dots> = - f x + f x" by (simp add: zero)
+ finally show "f (- x) = - f x" by (rule add_right_imp_eq)
+qed
+
+lemma diff: "f (x - y) = f x - f y"
+ using add [of x "- y"] by (simp add: minus)
+
+lemma sum: "f (sum g A) = (\<Sum>x\<in>A. f (g x))"
+ by (induct A rule: infinite_finite_induct) (simp_all add: zero add)
+
+end
+
+
+text \<open>Modules form the central spaces in linear algebra. They are a generalization from vector
+spaces by replacing the scalar field by a scalar ring.\<close>
+locale module =
+ fixes scale :: "'a::comm_ring_1 \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b" (infixr "*s" 75)
+ assumes scale_right_distrib [algebra_simps]: "a *s (x + y) = a *s x + a *s y"
+ and scale_left_distrib [algebra_simps]: "(a + b) *s x = a *s x + b *s x"
+ and scale_scale [simp]: "a *s (b *s x) = (a * b) *s x"
+ and scale_one [simp]: "1 *s x = x"
+begin
+
+lemma scale_left_commute: "a *s (b *s x) = b *s (a *s x)"
+ by (simp add: mult.commute)
+
+lemma scale_zero_left [simp]: "0 *s x = 0"
+ and scale_minus_left [simp]: "(- a) *s x = - (a *s x)"
+ and scale_left_diff_distrib [algebra_simps]: "(a - b) *s x = a *s x - b *s x"
+ and scale_sum_left: "(sum f A) *s x = (\<Sum>a\<in>A. (f a) *s x)"
+proof -
+ interpret s: additive "\<lambda>a. a *s x"
+ by standard (rule scale_left_distrib)
+ show "0 *s x = 0" by (rule s.zero)
+ show "(- a) *s x = - (a *s x)" by (rule s.minus)
+ show "(a - b) *s x = a *s x - b *s x" by (rule s.diff)
+ show "(sum f A) *s x = (\<Sum>a\<in>A. (f a) *s x)" by (rule s.sum)
+qed
+
+lemma scale_zero_right [simp]: "a *s 0 = 0"
+ and scale_minus_right [simp]: "a *s (- x) = - (a *s x)"
+ and scale_right_diff_distrib [algebra_simps]: "a *s (x - y) = a *s x - a *s y"
+ and scale_sum_right: "a *s (sum f A) = (\<Sum>x\<in>A. a *s (f x))"
+proof -
+ interpret s: additive "\<lambda>x. a *s x"
+ by standard (rule scale_right_distrib)
+ show "a *s 0 = 0" by (rule s.zero)
+ show "a *s (- x) = - (a *s x)" by (rule s.minus)
+ show "a *s (x - y) = a *s x - a *s y" by (rule s.diff)
+ show "a *s (sum f A) = (\<Sum>x\<in>A. a *s (f x))" by (rule s.sum)
+qed
+
+lemma sum_constant_scale: "(\<Sum>x\<in>A. y) = scale (of_nat (card A)) y"
+ by (induct A rule: infinite_finite_induct) (simp_all add: algebra_simps)
+
+section \<open>Subspace\<close>
+
+definition subspace :: "'b set \<Rightarrow> bool"
+ where "subspace S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>x\<in>S. \<forall>y\<in>S. x + y \<in> S) \<and> (\<forall>c. \<forall>x\<in>S. c *s x \<in> S)"
+
+lemma subspaceI:
+ "0 \<in> S \<Longrightarrow> (\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x + y \<in> S) \<Longrightarrow> (\<And>c x. x \<in> S \<Longrightarrow> c *s x \<in> S) \<Longrightarrow> subspace S"
+ by (auto simp: subspace_def)
+
+lemma subspace_UNIV[simp]: "subspace UNIV"
+ by (simp add: subspace_def)
+
+lemma subspace_single_0[simp]: "subspace {0}"
+ by (simp add: subspace_def)
+
+lemma subspace_0: "subspace S \<Longrightarrow> 0 \<in> S"
+ by (metis subspace_def)
+
+lemma subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x + y \<in> S"
+ by (metis subspace_def)
+
+lemma subspace_scale: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *s x \<in> S"
+ by (metis subspace_def)
+
+lemma subspace_neg: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> - x \<in> S"
+ by (metis scale_minus_left scale_one subspace_scale)
+
+lemma subspace_diff: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
+ by (metis diff_conv_add_uminus subspace_add subspace_neg)
+
+lemma subspace_sum: "subspace A \<Longrightarrow> (\<And>x. x \<in> B \<Longrightarrow> f x \<in> A) \<Longrightarrow> sum f B \<in> A"
+ by (induct B rule: infinite_finite_induct) (auto simp add: subspace_add subspace_0)
+
+lemma subspace_Int: "(\<And>i. i \<in> I \<Longrightarrow> subspace (s i)) \<Longrightarrow> subspace (\<Inter>i\<in>I. s i)"
+ by (auto simp: subspace_def)
+
+lemma subspace_Inter: "\<forall>s \<in> f. subspace s \<Longrightarrow> subspace (\<Inter>f)"
+ unfolding subspace_def by auto
+
+lemma subspace_inter: "subspace A \<Longrightarrow> subspace B \<Longrightarrow> subspace (A \<inter> B)"
+ by (simp add: subspace_def)
+
+
+section \<open>Span: subspace generated by a set\<close>
+
+definition span :: "'b set \<Rightarrow> 'b set"
+ where span_explicit: "span b = {(\<Sum>a\<in>t. r a *s a) | t r. finite t \<and> t \<subseteq> b}"
+
+lemma span_explicit':
+ "span b = {(\<Sum>v | f v \<noteq> 0. f v *s v) | f. finite {v. f v \<noteq> 0} \<and> (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> b)}"
+ unfolding span_explicit
+proof safe
+ fix t r assume "finite t" "t \<subseteq> b"
+ then show "\<exists>f. (\<Sum>a\<in>t. r a *s a) = (\<Sum>v | f v \<noteq> 0. f v *s v) \<and> finite {v. f v \<noteq> 0} \<and> (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> b)"
+ by (intro exI[of _ "\<lambda>v. if v \<in> t then r v else 0"]) (auto intro!: sum.mono_neutral_cong_right)
+next
+ fix f :: "'b \<Rightarrow> 'a" assume "finite {v. f v \<noteq> 0}" "(\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> b)"
+ then show "\<exists>t r. (\<Sum>v | f v \<noteq> 0. f v *s v) = (\<Sum>a\<in>t. r a *s a) \<and> finite t \<and> t \<subseteq> b"
+ by (intro exI[of _ "{v. f v \<noteq> 0}"] exI[of _ f]) auto
+qed
+
+lemma span_alt:
+ "span B = {(\<Sum>x | f x \<noteq> 0. f x *s x) | f. {x. f x \<noteq> 0} \<subseteq> B \<and> finite {x. f x \<noteq> 0}}"
+ unfolding span_explicit' by auto
+
+lemma span_finite:
+ assumes fS: "finite S"
+ shows "span S = range (\<lambda>u. \<Sum>v\<in>S. u v *s v)"
+ unfolding span_explicit
+proof safe
+ fix t r assume "t \<subseteq> S" then show "(\<Sum>a\<in>t. r a *s a) \<in> range (\<lambda>u. \<Sum>v\<in>S. u v *s v)"
+ by (intro image_eqI[of _ _ "\<lambda>a. if a \<in> t then r a else 0"])
+ (auto simp: if_distrib[of "\<lambda>r. r *s a" for a] sum.If_cases fS Int_absorb1)
+next
+ show "\<exists>t r. (\<Sum>v\<in>S. u v *s v) = (\<Sum>a\<in>t. r a *s a) \<and> finite t \<and> t \<subseteq> S" for u
+ by (intro exI[of _ u] exI[of _ S]) (auto intro: fS)
+qed
+
+lemma span_induct_alt[consumes 1]:
+ assumes x: "x \<in> span S"
+ assumes h0: "h 0" and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c *s x + y)"
+ shows "h x"
+ using x unfolding span_explicit
+proof safe
+ fix t r assume "finite t" "t \<subseteq> S" then show "h (\<Sum>a\<in>t. r a *s a)"
+ by (induction t) (auto intro!: hS h0)
+qed
+
+lemma span_mono: "A \<subseteq> B \<Longrightarrow> span A \<subseteq> span B"
+ by (auto simp: span_explicit)
+
+lemma span_base: "a \<in> S \<Longrightarrow> a \<in> span S"
+ by (auto simp: span_explicit intro!: exI[of _ "{a}"] exI[of _ "\<lambda>_. 1"])
+
+lemma span_superset: "S \<subseteq> span S"
+ by (auto simp: span_base)
+
+lemma span_zero: "0 \<in> span S"
+ by (auto simp: span_explicit intro!: exI[of _ "{}"])
+
+lemma span_UNIV: "span UNIV = UNIV"
+ by (auto intro: span_base)
+
+lemma span_add: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x + y \<in> span S"
+ unfolding span_explicit
+proof safe
+ fix tx ty rx ry assume *: "finite tx" "finite ty" "tx \<subseteq> S" "ty \<subseteq> S"
+ have [simp]: "(tx \<union> ty) \<inter> tx = tx" "(tx \<union> ty) \<inter> ty = ty"
+ by auto
+ show "\<exists>t r. (\<Sum>a\<in>tx. rx a *s a) + (\<Sum>a\<in>ty. ry a *s a) = (\<Sum>a\<in>t. r a *s a) \<and> finite t \<and> t \<subseteq> S"
+ apply (intro exI[of _ "tx \<union> ty"])
+ apply (intro exI[of _ "\<lambda>a. (if a \<in> tx then rx a else 0) + (if a \<in> ty then ry a else 0)"])
+ apply (auto simp: * scale_left_distrib sum.distrib if_distrib[of "\<lambda>r. r *s a" for a] sum.If_cases)
+ done
+qed
+
+lemma span_scale: "x \<in> span S \<Longrightarrow> c *s x \<in> span S"
+ unfolding span_explicit
+proof safe
+ fix t r assume *: "finite t" "t \<subseteq> S"
+ show "\<exists>t' r'. c *s (\<Sum>a\<in>t. r a *s a) = (\<Sum>a\<in>t'. r' a *s a) \<and> finite t' \<and> t' \<subseteq> S"
+ by (intro exI[of _ t] exI[of _ "\<lambda>a. c * r a"]) (auto simp: * scale_sum_right)
+qed
+
+lemma subspace_span: "subspace (span S)"
+ by (auto simp: subspace_def span_zero span_add span_scale)
+
+lemma span_neg: "x \<in> span S \<Longrightarrow> - x \<in> span S"
+ by (metis subspace_neg subspace_span)
+
+lemma span_diff: "x \<in> span S \<Longrightarrow> y \<in> span S \<Longrightarrow> x - y \<in> span S"
+ by (metis subspace_span subspace_diff)
+
+lemma span_sum: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> span S) \<Longrightarrow> sum f A \<in> span S"
+ by (rule subspace_sum, rule subspace_span)
+
+lemma span_minimal: "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> span S \<subseteq> T"
+ by (auto simp: span_explicit intro!: subspace_sum subspace_scale)
+
+lemma span_def: "span S = subspace hull S"
+ by (intro hull_unique[symmetric] span_superset subspace_span span_minimal)
+
+lemma span_unique:
+ "S \<subseteq> T \<Longrightarrow> subspace T \<Longrightarrow> (\<And>T'. S \<subseteq> T' \<Longrightarrow> subspace T' \<Longrightarrow> T \<subseteq> T') \<Longrightarrow> span S = T"
+ unfolding span_def by (rule hull_unique)
+
+lemma span_subspace_induct[consumes 2]:
+ assumes x: "x \<in> span S"
+ and P: "subspace P"
+ and SP: "\<And>x. x \<in> S \<Longrightarrow> x \<in> P"
+ shows "x \<in> P"
+proof -
+ from SP have SP': "S \<subseteq> P"
+ by (simp add: subset_eq)
+ from x hull_minimal[where S=subspace, OF SP' P, unfolded span_def[symmetric]]
+ show "x \<in> P"
+ by (metis subset_eq)
+qed
+
+lemma (in module) span_induct[consumes 1]:
+ assumes x: "x \<in> span S"
+ and P: "subspace (Collect P)"
+ and SP: "\<And>x. x \<in> S \<Longrightarrow> P x"
+ shows "P x"
+ using P SP span_subspace_induct x by fastforce
+
+lemma (in module) span_induct':
+ "\<forall>x \<in> S. P x \<Longrightarrow> subspace {x. P x} \<Longrightarrow> \<forall>x \<in> span S. P x"
+ unfolding span_def by (rule hull_induct) auto
+
+lemma span_empty[simp]: "span {} = {0}"
+ by (rule span_unique) (auto simp add: subspace_def)
+
+lemma span_subspace: "A \<subseteq> B \<Longrightarrow> B \<subseteq> span A \<Longrightarrow> subspace B \<Longrightarrow> span A = B"
+ by (metis order_antisym span_def hull_minimal)
+
+lemma span_span: "span (span A) = span A"
+ unfolding span_def hull_hull ..
+
+(* TODO: proof generally for subspace: *)
+lemma span_add_eq: assumes x: "x \<in> span S" shows "x + y \<in> span S \<longleftrightarrow> y \<in> span S"
+proof
+ assume *: "x + y \<in> span S"
+ have "(x + y) - x \<in> span S" using * x by (rule span_diff)
+ then show "y \<in> span S" by simp
+qed (intro span_add x)
+
+lemma span_add_eq2: assumes y: "y \<in> span S" shows "x + y \<in> span S \<longleftrightarrow> x \<in> span S"
+ using span_add_eq[of y S x] y by (auto simp: ac_simps)
+
+lemma span_singleton: "span {x} = range (\<lambda>k. k *s x)"
+ by (auto simp: span_finite)
+
+lemma span_Un: "span (S \<union> T) = {x + y | x y. x \<in> span S \<and> y \<in> span T}"
+proof safe
+ fix x assume "x \<in> span (S \<union> T)"
+ then obtain t r where t: "finite t" "t \<subseteq> S \<union> T" and x: "x = (\<Sum>a\<in>t. r a *s a)"
+ by (auto simp: span_explicit)
+ moreover have "t \<inter> S \<union> (t - S) = t" by auto
+ ultimately show "\<exists>xa y. x = xa + y \<and> xa \<in> span S \<and> y \<in> span T"
+ unfolding x
+ apply (rule_tac exI[of _ "\<Sum>a\<in>t \<inter> S. r a *s a"])
+ apply (rule_tac exI[of _ "\<Sum>a\<in>t - S. r a *s a"])
+ apply (subst sum.union_inter_neutral[symmetric])
+ apply (auto intro!: span_sum span_scale intro: span_base)
+ done
+next
+ fix x y assume"x \<in> span S" "y \<in> span T" then show "x + y \<in> span (S \<union> T)"
+ using span_mono[of S "S \<union> T"] span_mono[of T "S \<union> T"]
+ by (auto intro!: span_add)
+qed
+
+lemma span_insert: "span (insert a S) = {x. \<exists>k. (x - k *s a) \<in> span S}"
+proof -
+ have "span ({a} \<union> S) = {x. \<exists>k. (x - k *s a) \<in> span S}"
+ unfolding span_Un span_singleton
+ apply (auto simp add: set_eq_iff)
+ subgoal for y k by (auto intro!: exI[of _ "k"])
+ subgoal for y k by (rule exI[of _ "k *s a"], rule exI[of _ "y - k *s a"]) auto
+ done
+ then show ?thesis by simp
+qed
+
+lemma span_breakdown:
+ assumes bS: "b \<in> S"
+ and aS: "a \<in> span S"
+ shows "\<exists>k. a - k *s b \<in> span (S - {b})"
+ using assms span_insert [of b "S - {b}"]
+ by (simp add: insert_absorb)
+
+lemma span_breakdown_eq: "x \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. x - k *s a \<in> span S)"
+ by (simp add: span_insert)
+
+lemmas span_clauses = span_base span_zero span_add span_scale
+
+lemma span_eq_iff[simp]: "span s = s \<longleftrightarrow> subspace s"
+ unfolding span_def by (rule hull_eq) (rule subspace_Inter)
+
+lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
+ by (metis span_minimal span_subspace span_superset subspace_span)
+
+lemma eq_span_insert_eq:
+ assumes "(x - y) \<in> span S"
+ shows "span(insert x S) = span(insert y S)"
+proof -
+ have *: "span(insert x S) \<subseteq> span(insert y S)" if "(x - y) \<in> span S" for x y
+ proof -
+ have 1: "(r *s x - r *s y) \<in> span S" for r
+ by (metis scale_right_diff_distrib span_scale that)
+ have 2: "(z - k *s y) - k *s (x - y) = z - k *s x" for z k
+ by (simp add: scale_right_diff_distrib)
+ show ?thesis
+ apply (clarsimp simp add: span_breakdown_eq)
+ by (metis 1 2 diff_add_cancel scale_right_diff_distrib span_add_eq)
+ qed
+ show ?thesis
+ apply (intro subset_antisym * assms)
+ using assms subspace_neg subspace_span minus_diff_eq by force
+qed
+
+
+section \<open>Dependent and independent sets\<close>
+
+definition dependent :: "'b set \<Rightarrow> bool"
+ where dependent_explicit: "dependent s \<longleftrightarrow> (\<exists>t u. finite t \<and> t \<subseteq> s \<and> (\<Sum>v\<in>t. u v *s v) = 0 \<and> (\<exists>v\<in>t. u v \<noteq> 0))"
+
+abbreviation "independent s \<equiv> \<not> dependent s"
+
+lemma dependent_mono: "dependent B \<Longrightarrow> B \<subseteq> A \<Longrightarrow> dependent A"
+ by (auto simp add: dependent_explicit)
+
+lemma independent_mono: "independent A \<Longrightarrow> B \<subseteq> A \<Longrightarrow> independent B"
+ by (auto intro: dependent_mono)
+
+lemma dependent_zero: "0 \<in> A \<Longrightarrow> dependent A"
+ by (auto simp: dependent_explicit intro!: exI[of _ "\<lambda>i. 1"] exI[of _ "{0}"])
+
+lemma independent_empty[intro]: "independent {}"
+ by (simp add: dependent_explicit)
+
+lemma independent_explicit_module:
+ "independent s \<longleftrightarrow> (\<forall>t u v. finite t \<longrightarrow> t \<subseteq> s \<longrightarrow> (\<Sum>v\<in>t. u v *s v) = 0 \<longrightarrow> v \<in> t \<longrightarrow> u v = 0)"
+ unfolding dependent_explicit by auto
+
+lemma independentD: "independent s \<Longrightarrow> finite t \<Longrightarrow> t \<subseteq> s \<Longrightarrow> (\<Sum>v\<in>t. u v *s v) = 0 \<Longrightarrow> v \<in> t \<Longrightarrow> u v = 0"
+ by (simp add: independent_explicit_module)
+
+lemma independent_Union_directed:
+ assumes directed: "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
+ assumes indep: "\<And>c. c \<in> C \<Longrightarrow> independent c"
+ shows "independent (\<Union>C)"
+proof
+ assume "dependent (\<Union>C)"
+ then obtain u v S where S: "finite S" "S \<subseteq> \<Union>C" "v \<in> S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *s v) = 0"
+ by (auto simp: dependent_explicit)
+
+ have "S \<noteq> {}"
+ using \<open>v \<in> S\<close> by auto
+ have "\<exists>c\<in>C. S \<subseteq> c"
+ using \<open>finite S\<close> \<open>S \<noteq> {}\<close> \<open>S \<subseteq> \<Union>C\<close>
+ proof (induction rule: finite_ne_induct)
+ case (insert i I)
+ then obtain c d where cd: "c \<in> C" "d \<in> C" and iI: "I \<subseteq> c" "i \<in> d"
+ by blast
+ from directed[OF cd] cd have "c \<union> d \<in> C"
+ by (auto simp: sup.absorb1 sup.absorb2)
+ with iI show ?case
+ by (intro bexI[of _ "c \<union> d"]) auto
+ qed auto
+ then obtain c where "c \<in> C" "S \<subseteq> c"
+ by auto
+ have "dependent c"
+ unfolding dependent_explicit
+ by (intro exI[of _ S] exI[of _ u] bexI[of _ v] conjI) fact+
+ with indep[OF \<open>c \<in> C\<close>] show False
+ by auto
+qed
+
+lemma dependent_finite:
+ assumes "finite S"
+ shows "dependent S \<longleftrightarrow> (\<exists>u. (\<exists>v \<in> S. u v \<noteq> 0) \<and> (\<Sum>v\<in>S. u v *s v) = 0)"
+ (is "?lhs = ?rhs")
+proof
+ assume ?lhs
+ then obtain T u v
+ where "finite T" "T \<subseteq> S" "v\<in>T" "u v \<noteq> 0" "(\<Sum>v\<in>T. u v *s v) = 0"
+ by (force simp: dependent_explicit)
+ with assms show ?rhs
+ apply (rule_tac x="\<lambda>v. if v \<in> T then u v else 0" in exI)
+ apply (auto simp: sum.mono_neutral_right)
+ done
+next
+ assume ?rhs with assms show ?lhs
+ by (fastforce simp add: dependent_explicit)
+qed
+
+lemma dependent_alt:
+ "dependent B \<longleftrightarrow>
+ (\<exists>X. finite {x. X x \<noteq> 0} \<and> {x. X x \<noteq> 0} \<subseteq> B \<and> (\<Sum>x|X x \<noteq> 0. X x *s x) = 0 \<and> (\<exists>x. X x \<noteq> 0))"
+ unfolding dependent_explicit
+ apply safe
+ subgoal for S u v
+ apply (intro exI[of _ "\<lambda>x. if x \<in> S then u x else 0"])
+ apply (subst sum.mono_neutral_cong_left[where T=S])
+ apply (auto intro!: sum.mono_neutral_cong_right cong: rev_conj_cong)
+ done
+ apply auto
+ done
+
+lemma independent_alt:
+ "independent B \<longleftrightarrow>
+ (\<forall>X. finite {x. X x \<noteq> 0} \<longrightarrow> {x. X x \<noteq> 0} \<subseteq> B \<longrightarrow> (\<Sum>x|X x \<noteq> 0. X x *s x) = 0 \<longrightarrow> (\<forall>x. X x = 0))"
+ unfolding dependent_alt by auto
+
+lemma independentD_alt:
+ "independent B \<Longrightarrow> finite {x. X x \<noteq> 0} \<Longrightarrow> {x. X x \<noteq> 0} \<subseteq> B \<Longrightarrow> (\<Sum>x|X x \<noteq> 0. X x *s x) = 0 \<Longrightarrow> X x = 0"
+ unfolding independent_alt by blast
+
+lemma independentD_unique:
+ assumes B: "independent B"
+ and X: "finite {x. X x \<noteq> 0}" "{x. X x \<noteq> 0} \<subseteq> B"
+ and Y: "finite {x. Y x \<noteq> 0}" "{x. Y x \<noteq> 0} \<subseteq> B"
+ and "(\<Sum>x | X x \<noteq> 0. X x *s x) = (\<Sum>x| Y x \<noteq> 0. Y x *s x)"
+ shows "X = Y"
+proof -
+ have "X x - Y x = 0" for x
+ using B
+ proof (rule independentD_alt)
+ have "{x. X x - Y x \<noteq> 0} \<subseteq> {x. X x \<noteq> 0} \<union> {x. Y x \<noteq> 0}"
+ by auto
+ then show "finite {x. X x - Y x \<noteq> 0}" "{x. X x - Y x \<noteq> 0} \<subseteq> B"
+ using X Y by (auto dest: finite_subset)
+ then have "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *s x) = (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. (X v - Y v) *s v)"
+ using X Y by (intro sum.mono_neutral_cong_left) auto
+ also have "\<dots> = (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. X v *s v) - (\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. Y v *s v)"
+ by (simp add: scale_left_diff_distrib sum_subtractf assms)
+ also have "(\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. X v *s v) = (\<Sum>v\<in>{S. X S \<noteq> 0}. X v *s v)"
+ using X Y by (intro sum.mono_neutral_cong_right) auto
+ also have "(\<Sum>v\<in>{S. X S \<noteq> 0} \<union> {S. Y S \<noteq> 0}. Y v *s v) = (\<Sum>v\<in>{S. Y S \<noteq> 0}. Y v *s v)"
+ using X Y by (intro sum.mono_neutral_cong_right) auto
+ finally show "(\<Sum>x | X x - Y x \<noteq> 0. (X x - Y x) *s x) = 0"
+ using assms by simp
+ qed
+ then show ?thesis
+ by auto
+qed
+
+
+section \<open>Representation of a vector on a specific basis\<close>
+
+definition representation :: "'b set \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'a"
+ where "representation basis v =
+ (if independent basis \<and> v \<in> span basis then
+ SOME f. (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> basis) \<and> finite {v. f v \<noteq> 0} \<and> (\<Sum>v\<in>{v. f v \<noteq> 0}. f v *s v) = v
+ else (\<lambda>b. 0))"
+
+lemma unique_representation:
+ assumes basis: "independent basis"
+ and in_basis: "\<And>v. f v \<noteq> 0 \<Longrightarrow> v \<in> basis" "\<And>v. g v \<noteq> 0 \<Longrightarrow> v \<in> basis"
+ and [simp]: "finite {v. f v \<noteq> 0}" "finite {v. g v \<noteq> 0}"
+ and eq: "(\<Sum>v\<in>{v. f v \<noteq> 0}. f v *s v) = (\<Sum>v\<in>{v. g v \<noteq> 0}. g v *s v)"
+ shows "f = g"
+proof (rule ext, rule ccontr)
+ fix v assume ne: "f v \<noteq> g v"
+ have "dependent basis"
+ unfolding dependent_explicit
+ proof (intro exI conjI)
+ have *: "{v. f v - g v \<noteq> 0} \<subseteq> {v. f v \<noteq> 0} \<union> {v. g v \<noteq> 0}"
+ by auto
+ show "finite {v. f v - g v \<noteq> 0}"
+ by (rule finite_subset[OF *]) simp
+ show "\<exists>v\<in>{v. f v - g v \<noteq> 0}. f v - g v \<noteq> 0"
+ by (rule bexI[of _ v]) (auto simp: ne)
+ have "(\<Sum>v | f v - g v \<noteq> 0. (f v - g v) *s v) =
+ (\<Sum>v\<in>{v. f v \<noteq> 0} \<union> {v. g v \<noteq> 0}. (f v - g v) *s v)"
+ by (intro sum.mono_neutral_cong_left *) auto
+ also have "... =
+ (\<Sum>v\<in>{v. f v \<noteq> 0} \<union> {v. g v \<noteq> 0}. f v *s v) - (\<Sum>v\<in>{v. f v \<noteq> 0} \<union> {v. g v \<noteq> 0}. g v *s v)"
+ by (simp add: algebra_simps sum_subtractf)
+ also have "... = (\<Sum>v | f v \<noteq> 0. f v *s v) - (\<Sum>v | g v \<noteq> 0. g v *s v)"
+ by (intro arg_cong2[where f= "(-)"] sum.mono_neutral_cong_right) auto
+ finally show "(\<Sum>v | f v - g v \<noteq> 0. (f v - g v) *s v) = 0"
+ by (simp add: eq)
+ show "{v. f v - g v \<noteq> 0} \<subseteq> basis"
+ using in_basis * by auto
+ qed
+ with basis show False by auto
+qed
+
+lemma
+ shows representation_ne_zero: "\<And>b. representation basis v b \<noteq> 0 \<Longrightarrow> b \<in> basis"
+ and finite_representation: "finite {b. representation basis v b \<noteq> 0}"
+ and sum_nonzero_representation_eq:
+ "independent basis \<Longrightarrow> v \<in> span basis \<Longrightarrow> (\<Sum>b | representation basis v b \<noteq> 0. representation basis v b *s b) = v"
+proof -
+ { assume basis: "independent basis" and v: "v \<in> span basis"
+ define p where "p f \<longleftrightarrow>
+ (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> basis) \<and> finite {v. f v \<noteq> 0} \<and> (\<Sum>v\<in>{v. f v \<noteq> 0}. f v *s v) = v" for f
+ obtain t r where *: "finite t" "t \<subseteq> basis" "(\<Sum>b\<in>t. r b *s b) = v"
+ using \<open>v \<in> span basis\<close> by (auto simp: span_explicit)
+ define f where "f b = (if b \<in> t then r b else 0)" for b
+ have "p f"
+ using * by (auto simp: p_def f_def intro!: sum.mono_neutral_cong_left)
+ have *: "representation basis v = Eps p" by (simp add: p_def[abs_def] representation_def basis v)
+ from someI[of p f, OF \<open>p f\<close>] have "p (representation basis v)"
+ unfolding * . }
+ note * = this
+
+ show "representation basis v b \<noteq> 0 \<Longrightarrow> b \<in> basis" for b
+ using * by (cases "independent basis \<and> v \<in> span basis") (auto simp: representation_def)
+
+ show "finite {b. representation basis v b \<noteq> 0}"
+ using * by (cases "independent basis \<and> v \<in> span basis") (auto simp: representation_def)
+
+ show "independent basis \<Longrightarrow> v \<in> span basis \<Longrightarrow> (\<Sum>b | representation basis v b \<noteq> 0. representation basis v b *s b) = v"
+ using * by auto
+qed
+
+lemma sum_representation_eq:
+ "(\<Sum>b\<in>B. representation basis v b *s b) = v"
+ if "independent basis" "v \<in> span basis" "finite B" "basis \<subseteq> B"
+proof -
+ have "(\<Sum>b\<in>B. representation basis v b *s b) =
+ (\<Sum>b | representation basis v b \<noteq> 0. representation basis v b *s b)"
+ apply (rule sum.mono_neutral_cong)
+ apply (rule finite_representation)
+ apply fact
+ subgoal for b
+ using that representation_ne_zero[of basis v b]
+ by auto
+ subgoal by auto
+ subgoal by simp
+ done
+ also have "\<dots> = v"
+ by (rule sum_nonzero_representation_eq; fact)
+ finally show ?thesis .
+qed
+
+lemma representation_eqI:
+ assumes basis: "independent basis" and b: "v \<in> span basis"
+ and ne_zero: "\<And>b. f b \<noteq> 0 \<Longrightarrow> b \<in> basis"
+ and finite: "finite {b. f b \<noteq> 0}"
+ and eq: "(\<Sum>b | f b \<noteq> 0. f b *s b) = v"
+ shows "representation basis v = f"
+ by (rule unique_representation[OF basis])
+ (auto simp: representation_ne_zero finite_representation
+ sum_nonzero_representation_eq[OF basis b] ne_zero finite eq)
+
+lemma representation_basis:
+ assumes basis: "independent basis" and b: "b \<in> basis"
+ shows "representation basis b = (\<lambda>v. if v = b then 1 else 0)"
+proof (rule unique_representation[OF basis])
+ show "representation basis b v \<noteq> 0 \<Longrightarrow> v \<in> basis" for v
+ using representation_ne_zero .
+ show "finite {v. representation basis b v \<noteq> 0}"
+ using finite_representation .
+ show "(if v = b then 1 else 0) \<noteq> 0 \<Longrightarrow> v \<in> basis" for v
+ by (cases "v = b") (auto simp: b)
+ have *: "{v. (if v = b then 1 else 0 :: 'a) \<noteq> 0} = {b}"
+ by auto
+ show "finite {v. (if v = b then 1 else 0) \<noteq> 0}" unfolding * by auto
+ show "(\<Sum>v | representation basis b v \<noteq> 0. representation basis b v *s v) =
+ (\<Sum>v | (if v = b then 1 else 0::'a) \<noteq> 0. (if v = b then 1 else 0) *s v)"
+ unfolding * sum_nonzero_representation_eq[OF basis span_base[OF b]] by auto
+qed
+
+lemma representation_zero: "representation basis 0 = (\<lambda>b. 0)"
+proof cases
+ assume basis: "independent basis" show ?thesis
+ by (rule representation_eqI[OF basis span_zero]) auto
+qed (simp add: representation_def)
+
+lemma representation_diff:
+ assumes basis: "independent basis" and v: "v \<in> span basis" and u: "u \<in> span basis"
+ shows "representation basis (u - v) = (\<lambda>b. representation basis u b - representation basis v b)"
+proof (rule representation_eqI[OF basis span_diff[OF u v]])
+ let ?R = "representation basis"
+ note finite_representation[simp] u[simp] v[simp]
+ have *: "{b. ?R u b - ?R v b \<noteq> 0} \<subseteq> {b. ?R u b \<noteq> 0} \<union> {b. ?R v b \<noteq> 0}"
+ by auto
+ then show "?R u b - ?R v b \<noteq> 0 \<Longrightarrow> b \<in> basis" for b
+ by (auto dest: representation_ne_zero)
+ show "finite {b. ?R u b - ?R v b \<noteq> 0}"
+ by (intro finite_subset[OF *]) simp_all
+ have "(\<Sum>b | ?R u b - ?R v b \<noteq> 0. (?R u b - ?R v b) *s b) =
+ (\<Sum>b\<in>{b. ?R u b \<noteq> 0} \<union> {b. ?R v b \<noteq> 0}. (?R u b - ?R v b) *s b)"
+ by (intro sum.mono_neutral_cong_left *) auto
+ also have "... =
+ (\<Sum>b\<in>{b. ?R u b \<noteq> 0} \<union> {b. ?R v b \<noteq> 0}. ?R u b *s b) - (\<Sum>b\<in>{b. ?R u b \<noteq> 0} \<union> {b. ?R v b \<noteq> 0}. ?R v b *s b)"
+ by (simp add: algebra_simps sum_subtractf)
+ also have "... = (\<Sum>b | ?R u b \<noteq> 0. ?R u b *s b) - (\<Sum>b | ?R v b \<noteq> 0. ?R v b *s b)"
+ by (intro arg_cong2[where f= "(-)"] sum.mono_neutral_cong_right) auto
+ finally show "(\<Sum>b | ?R u b - ?R v b \<noteq> 0. (?R u b - ?R v b) *s b) = u - v"
+ by (simp add: sum_nonzero_representation_eq[OF basis])
+qed
+
+lemma representation_neg:
+ "independent basis \<Longrightarrow> v \<in> span basis \<Longrightarrow> representation basis (- v) = (\<lambda>b. - representation basis v b)"
+ using representation_diff[of basis v 0] by (simp add: representation_zero span_zero)
+
+lemma representation_add:
+ "independent basis \<Longrightarrow> v \<in> span basis \<Longrightarrow> u \<in> span basis \<Longrightarrow>
+ representation basis (u + v) = (\<lambda>b. representation basis u b + representation basis v b)"
+ using representation_diff[of basis "-v" u] by (simp add: representation_neg representation_diff span_neg)
+
+lemma representation_sum:
+ "independent basis \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> v i \<in> span basis) \<Longrightarrow>
+ representation basis (sum v I) = (\<lambda>b. \<Sum>i\<in>I. representation basis (v i) b)"
+ by (induction I rule: infinite_finite_induct)
+ (auto simp: representation_zero representation_add span_sum)
+
+lemma representation_scale:
+ assumes basis: "independent basis" and v: "v \<in> span basis"
+ shows "representation basis (r *s v) = (\<lambda>b. r * representation basis v b)"
+proof (rule representation_eqI[OF basis span_scale[OF v]])
+ let ?R = "representation basis"
+ note finite_representation[simp] v[simp]
+ have *: "{b. r * ?R v b \<noteq> 0} \<subseteq> {b. ?R v b \<noteq> 0}"
+ by auto
+ then show "r * representation basis v b \<noteq> 0 \<Longrightarrow> b \<in> basis" for b
+ using representation_ne_zero by auto
+ show "finite {b. r * ?R v b \<noteq> 0}"
+ by (intro finite_subset[OF *]) simp_all
+ have "(\<Sum>b | r * ?R v b \<noteq> 0. (r * ?R v b) *s b) = (\<Sum>b\<in>{b. ?R v b \<noteq> 0}. (r * ?R v b) *s b)"
+ by (intro sum.mono_neutral_cong_left *) auto
+ also have "... = r *s (\<Sum>b | ?R v b \<noteq> 0. ?R v b *s b)"
+ by (simp add: scale_scale[symmetric] scale_sum_right del: scale_scale)
+ finally show "(\<Sum>b | r * ?R v b \<noteq> 0. (r * ?R v b) *s b) = r *s v"
+ by (simp add: sum_nonzero_representation_eq[OF basis])
+qed
+
+lemma representation_extend:
+ assumes basis: "independent basis" and v: "v \<in> span basis'" and basis': "basis' \<subseteq> basis"
+ shows "representation basis v = representation basis' v"
+proof (rule representation_eqI[OF basis])
+ show v': "v \<in> span basis" using span_mono[OF basis'] v by auto
+ have *: "independent basis'" using basis' basis by (auto intro: dependent_mono)
+ show "representation basis' v b \<noteq> 0 \<Longrightarrow> b \<in> basis" for b
+ using representation_ne_zero basis' by auto
+ show "finite {b. representation basis' v b \<noteq> 0}"
+ using finite_representation .
+ show "(\<Sum>b | representation basis' v b \<noteq> 0. representation basis' v b *s b) = v"
+ using sum_nonzero_representation_eq[OF * v] .
+qed
+
+text \<open>The set \<open>B\<close> is the maximal independent set for \<open>span B\<close>, or \<open>A\<close> is the minimal spanning set\<close>
+lemma spanning_subset_independent:
+ assumes BA: "B \<subseteq> A"
+ and iA: "independent A"
+ and AsB: "A \<subseteq> span B"
+ shows "A = B"
+proof (intro antisym[OF _ BA] subsetI)
+ have iB: "independent B" using independent_mono [OF iA BA] .
+ fix v assume "v \<in> A"
+ with AsB have "v \<in> span B" by auto
+ let ?RB = "representation B v" and ?RA = "representation A v"
+ have "?RB v = 1"
+ unfolding representation_extend[OF iA \<open>v \<in> span B\<close> BA, symmetric] representation_basis[OF iA \<open>v \<in> A\<close>] by simp
+ then show "v \<in> B"
+ using representation_ne_zero[of B v v] by auto
+qed
+
+end
+
+(* We need to introduce more specific modules, where the ring structure gets more and more finer,
+ i.e. Bezout rings & domains, division rings, fields *)
+
+text \<open>A linear function is a mapping between two modules over the same ring.\<close>
+
+locale module_hom = m1: module s1 + m2: module s2
+ for s1 :: "'a::comm_ring_1 \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b" (infixr "*a" 75)
+ and s2 :: "'a::comm_ring_1 \<Rightarrow> 'c::ab_group_add \<Rightarrow> 'c" (infixr "*b" 75) +
+ fixes f :: "'b \<Rightarrow> 'c"
+ assumes add: "f (b1 + b2) = f b1 + f b2"
+ and scale: "f (r *a b) = r *b f b"
+begin
+
+lemma zero[simp]: "f 0 = 0"
+ using scale[of 0 0] by simp
+
+lemma neg: "f (- x) = - f x"
+ using scale [where r="-1"] by (metis add add_eq_0_iff zero)
+
+lemma diff: "f (x - y) = f x - f y"
+ by (metis diff_conv_add_uminus add neg)
+
+lemma sum: "f (sum g S) = (\<Sum>a\<in>S. f (g a))"
+proof (induct S rule: infinite_finite_induct)
+ case (insert x F)
+ have "f (sum g (insert x F)) = f (g x + sum g F)"
+ using insert.hyps by simp
+ also have "\<dots> = f (g x) + f (sum g F)"
+ using add by simp
+ also have "\<dots> = (\<Sum>a\<in>insert x F. f (g a))"
+ using insert.hyps by simp
+ finally show ?case .
+qed simp_all
+
+lemma inj_on_iff_eq_0:
+ assumes s: "m1.subspace s"
+ shows "inj_on f s \<longleftrightarrow> (\<forall>x\<in>s. f x = 0 \<longrightarrow> x = 0)"
+proof -
+ have "inj_on f s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. f x - f y = 0 \<longrightarrow> x - y = 0)"
+ by (simp add: inj_on_def)
+ also have "\<dots> \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. f (x - y) = 0 \<longrightarrow> x - y = 0)"
+ by (simp add: diff)
+ also have "\<dots> \<longleftrightarrow> (\<forall>x\<in>s. f x = 0 \<longrightarrow> x = 0)" (is "?l = ?r")(* TODO: sledgehammer! *)
+ proof safe
+ fix x assume ?l assume "x \<in> s" "f x = 0" with \<open>?l\<close>[rule_format, of x 0] s show "x = 0"
+ by (auto simp: m1.subspace_0)
+ next
+ fix x y assume ?r assume "x \<in> s" "y \<in> s" "f (x - y) = 0"
+ with \<open>?r\<close>[rule_format, of "x - y"] s
+ show "x - y = 0"
+ by (auto simp: m1.subspace_diff)
+ qed
+ finally show ?thesis
+ by auto
+qed
+
+lemma inj_iff_eq_0: "inj f = (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
+ by (rule inj_on_iff_eq_0[OF m1.subspace_UNIV, unfolded ball_UNIV])
+
+lemma subspace_image: assumes S: "m1.subspace S" shows "m2.subspace (f ` S)"
+ unfolding m2.subspace_def
+proof safe
+ show "0 \<in> f ` S"
+ by (rule image_eqI[of _ _ 0]) (auto simp: S m1.subspace_0)
+ show "x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f x + f y \<in> f ` S" for x y
+ by (rule image_eqI[of _ _ "x + y"]) (auto simp: S m1.subspace_add add)
+ show "x \<in> S \<Longrightarrow> r *b f x \<in> f ` S" for r x
+ by (rule image_eqI[of _ _ "r *a x"]) (auto simp: S m1.subspace_scale scale)
+qed
+
+lemma subspace_vimage: "m2.subspace S \<Longrightarrow> m1.subspace (f -` S)"
+ by (simp add: vimage_def add scale m1.subspace_def m2.subspace_0 m2.subspace_add m2.subspace_scale)
+
+lemma subspace_kernel: "m1.subspace {x. f x = 0}"
+ using subspace_vimage[OF m2.subspace_single_0] by (simp add: vimage_def)
+
+lemma span_image: "m2.span (f ` S) = f ` (m1.span S)"
+proof (rule m2.span_unique)
+ show "f ` S \<subseteq> f ` m1.span S"
+ by (rule image_mono, rule m1.span_superset)
+ show "m2.subspace (f ` m1.span S)"
+ using m1.subspace_span by (rule subspace_image)
+next
+ fix T assume "f ` S \<subseteq> T" and "m2.subspace T" then show "f ` m1.span S \<subseteq> T"
+ unfolding image_subset_iff_subset_vimage by (metis subspace_vimage m1.span_minimal)
+qed
+
+lemma dependent_inj_imageD:
+ assumes d: "m2.dependent (f ` s)" and i: "inj_on f (m1.span s)"
+ shows "m1.dependent s"
+proof -
+ have [intro]: "inj_on f s"
+ using \<open>inj_on f (m1.span s)\<close> m1.span_superset by (rule inj_on_subset)
+ from d obtain s' r v where *: "finite s'" "s' \<subseteq> s" "(\<Sum>v\<in>f ` s'. r v *b v) = 0" "v \<in> s'" "r (f v) \<noteq> 0"
+ by (auto simp: m2.dependent_explicit subset_image_iff dest!: finite_imageD intro: inj_on_subset)
+ have "f (\<Sum>v\<in>s'. r (f v) *a v) = (\<Sum>v\<in>s'. r (f v) *b f v)"
+ by (simp add: sum scale)
+ also have "... = (\<Sum>v\<in>f ` s'. r v *b v)"
+ using \<open>s' \<subseteq> s\<close> by (subst sum.reindex) (auto dest!: finite_imageD intro: inj_on_subset)
+ finally have "f (\<Sum>v\<in>s'. r (f v) *a v) = 0"
+ by (simp add: *)
+ with \<open>s' \<subseteq> s\<close> have "(\<Sum>v\<in>s'. r (f v) *a v) = 0"
+ by (intro inj_onD[OF i] m1.span_zero m1.span_sum m1.span_scale) (auto intro: m1.span_base)
+ then show "m1.dependent s"
+ using \<open>finite s'\<close> \<open>s' \<subseteq> s\<close> \<open>v \<in> s'\<close> \<open>r (f v) \<noteq> 0\<close> by (force simp add: m1.dependent_explicit)
+qed
+
+lemma eq_0_on_span:
+ assumes f0: "\<And>x. x \<in> b \<Longrightarrow> f x = 0" and x: "x \<in> m1.span b" shows "f x = 0"
+ using m1.span_induct[OF x subspace_kernel] f0 by simp
+
+lemma independent_injective_image: "m1.independent s \<Longrightarrow> inj_on f (m1.span s) \<Longrightarrow> m2.independent (f ` s)"
+ using dependent_inj_imageD[of s] by auto
+
+lemma inj_on_span_independent_image:
+ assumes ifB: "m2.independent (f ` B)" and f: "inj_on f B" shows "inj_on f (m1.span B)"
+ unfolding inj_on_iff_eq_0[OF m1.subspace_span] unfolding m1.span_explicit'
+proof safe
+ fix r assume fr: "finite {v. r v \<noteq> 0}" and r: "\<forall>v. r v \<noteq> 0 \<longrightarrow> v \<in> B"
+ and eq0: "f (\<Sum>v | r v \<noteq> 0. r v *a v) = 0"
+ have "0 = (\<Sum>v | r v \<noteq> 0. r v *b f v)"
+ using eq0 by (simp add: sum scale)
+ also have "... = (\<Sum>v\<in>f ` {v. r v \<noteq> 0}. r (the_inv_into B f v) *b v)"
+ using r by (subst sum.reindex) (auto simp: the_inv_into_f_f[OF f] intro!: inj_on_subset[OF f] sum.cong)
+ finally have "r v \<noteq> 0 \<Longrightarrow> r (the_inv_into B f (f v)) = 0" for v
+ using fr r ifB[unfolded m2.independent_explicit_module, rule_format,
+ of "f ` {v. r v \<noteq> 0}" "\<lambda>v. r (the_inv_into B f v)"]
+ by auto
+ then have "r v = 0" for v
+ using the_inv_into_f_f[OF f] r by auto
+ then show "(\<Sum>v | r v \<noteq> 0. r v *a v) = 0" by auto
+qed
+
+lemma inj_on_span_iff_independent_image: "m2.independent (f ` B) \<Longrightarrow> inj_on f (m1.span B) \<longleftrightarrow> inj_on f B"
+ using inj_on_span_independent_image[of B] inj_on_subset[OF _ m1.span_superset, of f B] by auto
+
+lemma subspace_linear_preimage: "m2.subspace S \<Longrightarrow> m1.subspace {x. f x \<in> S}"
+ by (simp add: add scale m1.subspace_def m2.subspace_def)
+
+lemma spans_image: "V \<subseteq> m1.span B \<Longrightarrow> f ` V \<subseteq> m2.span (f ` B)"
+ by (metis image_mono span_image)
+
+text \<open>Relation between bases and injectivity/surjectivity of map.\<close>
+
+lemma spanning_surjective_image:
+ assumes us: "UNIV \<subseteq> m1.span S"
+ and sf: "surj f"
+ shows "UNIV \<subseteq> m2.span (f ` S)"
+proof -
+ have "UNIV \<subseteq> f ` UNIV"
+ using sf by (auto simp add: surj_def)
+ also have " \<dots> \<subseteq> m2.span (f ` S)"
+ using spans_image[OF us] .
+ finally show ?thesis .
+qed
+
+lemmas independent_inj_on_image = independent_injective_image
+
+lemma independent_inj_image:
+ "m1.independent S \<Longrightarrow> inj f \<Longrightarrow> m2.independent (f ` S)"
+ using independent_inj_on_image[of S] by (auto simp: subset_inj_on)
+
+end
+
+lemma module_hom_iff:
+ "module_hom s1 s2 f \<longleftrightarrow>
+ module s1 \<and> module s2 \<and>
+ (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (s1 c x) = s2 c (f x))"
+ by (simp add: module_hom_def module_hom_axioms_def)
+
+locale module_pair = m1: module s1 + m2: module s2
+ for s1 :: "'a :: comm_ring_1 \<Rightarrow> 'b \<Rightarrow> 'b :: ab_group_add"
+ and s2 :: "'a :: comm_ring_1 \<Rightarrow> 'c \<Rightarrow> 'c :: ab_group_add"
+begin
+
+lemma module_hom_zero: "module_hom s1 s2 (\<lambda>x. 0)"
+ by (simp add: module_hom_iff m1.module_axioms m2.module_axioms)
+
+lemma module_hom_add: "module_hom s1 s2 f \<Longrightarrow> module_hom s1 s2 g \<Longrightarrow> module_hom s1 s2 (\<lambda>x. f x + g x)"
+ by (simp add: module_hom_iff module.scale_right_distrib)
+
+lemma module_hom_sub: "module_hom s1 s2 f \<Longrightarrow> module_hom s1 s2 g \<Longrightarrow> module_hom s1 s2 (\<lambda>x. f x - g x)"
+ by (simp add: module_hom_iff module.scale_right_diff_distrib)
+
+lemma module_hom_neg: "module_hom s1 s2 f \<Longrightarrow> module_hom s1 s2 (\<lambda>x. - f x)"
+ by (simp add: module_hom_iff module.scale_minus_right)
+
+lemma module_hom_scale: "module_hom s1 s2 f \<Longrightarrow> module_hom s1 s2 (\<lambda>x. s2 c (f x))"
+ by (simp add: module_hom_iff module.scale_scale module.scale_right_distrib ac_simps)
+
+lemma module_hom_compose_scale:
+ "module_hom s1 s2 (\<lambda>x. s2 (f x) (c))"
+ if "module_hom s1 ( *) f"
+proof -
+ interpret mh: module_hom s1 "( *)" f by fact
+ show ?thesis
+ by unfold_locales (simp_all add: mh.add mh.scale m2.scale_left_distrib)
+qed
+
+lemma bij_module_hom_imp_inv_module_hom: "module_hom scale1 scale2 f \<Longrightarrow> bij f \<Longrightarrow>
+ module_hom scale2 scale1 (inv f)"
+ by (auto simp: module_hom_iff bij_is_surj bij_is_inj surj_f_inv_f
+ intro!: Hilbert_Choice.inv_f_eq)
+
+lemma module_hom_sum: "(\<And>i. i \<in> I \<Longrightarrow> module_hom s1 s2 (f i)) \<Longrightarrow> (I = {} \<Longrightarrow> module s1 \<and> module s2) \<Longrightarrow> module_hom s1 s2 (\<lambda>x. \<Sum>i\<in>I. f i x)"
+ apply (induction I rule: infinite_finite_induct)
+ apply (auto intro!: module_hom_zero module_hom_add)
+ using m1.module_axioms m2.module_axioms by blast
+
+lemma module_hom_eq_on_span: "f x = g x"
+ if "module_hom s1 s2 f" "module_hom s1 s2 g"
+ and "(\<And>x. x \<in> B \<Longrightarrow> f x = g x)" "x \<in> m1.span B"
+proof -
+ interpret module_hom s1 s2 "\<lambda>x. f x - g x"
+ by (rule module_hom_sub that)+
+ from eq_0_on_span[OF _ that(4)] that(3) show ?thesis by auto
+qed
+
+end
+
+context module begin
+
+lemma module_hom_scale_self[simp]:
+ "module_hom scale scale (\<lambda>x. scale c x)"
+ using module_axioms module_hom_iff scale_left_commute scale_right_distrib by blast
+
+lemma module_hom_scale_left[simp]:
+ "module_hom ( *) scale (\<lambda>r. scale r x)"
+ by unfold_locales (auto simp: algebra_simps)
+
+lemma module_hom_id: "module_hom scale scale id"
+ by (simp add: module_hom_iff module_axioms)
+
+lemma module_hom_ident: "module_hom scale scale (\<lambda>x. x)"
+ by (simp add: module_hom_iff module_axioms)
+
+lemma module_hom_uminus: "module_hom scale scale uminus"
+ by (simp add: module_hom_iff module_axioms)
+
+end
+
+lemma module_hom_compose: "module_hom s1 s2 f \<Longrightarrow> module_hom s2 s3 g \<Longrightarrow> module_hom s1 s3 (g o f)"
+ by (auto simp: module_hom_iff)
+
+end
--- a/src/HOL/Number_Theory/Prime_Powers.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Number_Theory/Prime_Powers.thy Wed May 02 13:49:38 2018 +0200
@@ -6,7 +6,7 @@
*)
section \<open>Prime powers\<close>
theory Prime_Powers
- imports Complex_Main "HOL-Computational_Algebra.Primes" "HOL-Library.FuncSet"
+ imports Complex_Main "HOL-Computational_Algebra.Primes"
begin
definition aprimedivisor :: "'a :: normalization_semidom \<Rightarrow> 'a" where
--- a/src/HOL/Real_Vector_Spaces.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/Real_Vector_Spaces.thy Wed May 02 13:49:38 2018 +0200
@@ -6,123 +6,9 @@
section \<open>Vector Spaces and Algebras over the Reals\<close>
theory Real_Vector_Spaces
-imports Real Topological_Spaces
-begin
-
-subsection \<open>Locale for additive functions\<close>
-
-locale additive =
- fixes f :: "'a::ab_group_add \<Rightarrow> 'b::ab_group_add"
- assumes add: "f (x + y) = f x + f y"
-begin
-
-lemma zero: "f 0 = 0"
-proof -
- have "f 0 = f (0 + 0)" by simp
- also have "\<dots> = f 0 + f 0" by (rule add)
- finally show "f 0 = 0" by simp
-qed
-
-lemma minus: "f (- x) = - f x"
-proof -
- have "f (- x) + f x = f (- x + x)" by (rule add [symmetric])
- also have "\<dots> = - f x + f x" by (simp add: zero)
- finally show "f (- x) = - f x" by (rule add_right_imp_eq)
-qed
-
-lemma diff: "f (x - y) = f x - f y"
- using add [of x "- y"] by (simp add: minus)
-
-lemma sum: "f (sum g A) = (\<Sum>x\<in>A. f (g x))"
- by (induct A rule: infinite_finite_induct) (simp_all add: zero add)
-
-end
-
-
-subsection \<open>Vector spaces\<close>
-
-locale vector_space =
- fixes scale :: "'a::field \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b"
- assumes scale_right_distrib [algebra_simps]: "scale a (x + y) = scale a x + scale a y"
- and scale_left_distrib [algebra_simps]: "scale (a + b) x = scale a x + scale b x"
- and scale_scale [simp]: "scale a (scale b x) = scale (a * b) x"
- and scale_one [simp]: "scale 1 x = x"
+imports Real Topological_Spaces Vector_Spaces
begin
-lemma scale_left_commute: "scale a (scale b x) = scale b (scale a x)"
- by (simp add: mult.commute)
-
-lemma scale_zero_left [simp]: "scale 0 x = 0"
- and scale_minus_left [simp]: "scale (- a) x = - (scale a x)"
- and scale_left_diff_distrib [algebra_simps]: "scale (a - b) x = scale a x - scale b x"
- and scale_sum_left: "scale (sum f A) x = (\<Sum>a\<in>A. scale (f a) x)"
-proof -
- interpret s: additive "\<lambda>a. scale a x"
- by standard (rule scale_left_distrib)
- show "scale 0 x = 0" by (rule s.zero)
- show "scale (- a) x = - (scale a x)" by (rule s.minus)
- show "scale (a - b) x = scale a x - scale b x" by (rule s.diff)
- show "scale (sum f A) x = (\<Sum>a\<in>A. scale (f a) x)" by (rule s.sum)
-qed
-
-lemma scale_zero_right [simp]: "scale a 0 = 0"
- and scale_minus_right [simp]: "scale a (- x) = - (scale a x)"
- and scale_right_diff_distrib [algebra_simps]: "scale a (x - y) = scale a x - scale a y"
- and scale_sum_right: "scale a (sum f A) = (\<Sum>x\<in>A. scale a (f x))"
-proof -
- interpret s: additive "\<lambda>x. scale a x"
- by standard (rule scale_right_distrib)
- show "scale a 0 = 0" by (rule s.zero)
- show "scale a (- x) = - (scale a x)" by (rule s.minus)
- show "scale a (x - y) = scale a x - scale a y" by (rule s.diff)
- show "scale a (sum f A) = (\<Sum>x\<in>A. scale a (f x))" by (rule s.sum)
-qed
-
-lemma scale_eq_0_iff [simp]: "scale a x = 0 \<longleftrightarrow> a = 0 \<or> x = 0"
-proof (cases "a = 0")
- case True
- then show ?thesis by simp
-next
- case False
- have "x = 0" if "scale a x = 0"
- proof -
- from False that have "scale (inverse a) (scale a x) = 0" by simp
- with False show ?thesis by simp
- qed
- then show ?thesis by force
-qed
-
-lemma scale_left_imp_eq:
- assumes nonzero: "a \<noteq> 0"
- and scale: "scale a x = scale a y"
- shows "x = y"
-proof -
- from scale have "scale a (x - y) = 0"
- by (simp add: scale_right_diff_distrib)
- with nonzero have "x - y = 0" by simp
- then show "x = y" by (simp only: right_minus_eq)
-qed
-
-lemma scale_right_imp_eq:
- assumes nonzero: "x \<noteq> 0"
- and scale: "scale a x = scale b x"
- shows "a = b"
-proof -
- from scale have "scale (a - b) x = 0"
- by (simp add: scale_left_diff_distrib)
- with nonzero have "a - b = 0" by simp
- then show "a = b" by (simp only: right_minus_eq)
-qed
-
-lemma scale_cancel_left [simp]: "scale a x = scale a y \<longleftrightarrow> x = y \<or> a = 0"
- by (auto intro: scale_left_imp_eq)
-
-lemma scale_cancel_right [simp]: "scale a x = scale b x \<longleftrightarrow> a = b \<or> x = 0"
- by (auto intro: scale_right_imp_eq)
-
-end
-
-
subsection \<open>Real vector spaces\<close>
class scaleR =
@@ -140,13 +26,74 @@
and scaleR_scaleR: "scaleR a (scaleR b x) = scaleR (a * b) x"
and scaleR_one: "scaleR 1 x = x"
-interpretation real_vector: vector_space "scaleR :: real \<Rightarrow> 'a \<Rightarrow> 'a::real_vector"
+
+class real_algebra = real_vector + ring +
+ assumes mult_scaleR_left [simp]: "scaleR a x * y = scaleR a (x * y)"
+ and mult_scaleR_right [simp]: "x * scaleR a y = scaleR a (x * y)"
+
+class real_algebra_1 = real_algebra + ring_1
+
+class real_div_algebra = real_algebra_1 + division_ring
+
+class real_field = real_div_algebra + field
+
+instantiation real :: real_field
+begin
+
+definition real_scaleR_def [simp]: "scaleR a x = a * x"
+
+instance
+ by standard (simp_all add: algebra_simps)
+
+end
+
+locale linear = Vector_Spaces.linear "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
+begin
+lemmas scaleR = scale
+end
+
+global_interpretation real_vector?: vector_space "scaleR :: real \<Rightarrow> 'a \<Rightarrow> 'a::real_vector"
+ rewrites "Vector_Spaces.linear ( *\<^sub>R) ( *\<^sub>R) = linear"
+ and "Vector_Spaces.linear ( * ) ( *\<^sub>R) = linear"
+ defines dependent_raw_def: dependent = real_vector.dependent
+ and representation_raw_def: representation = real_vector.representation
+ and subspace_raw_def: subspace = real_vector.subspace
+ and span_raw_def: span = real_vector.span
+ and extend_basis_raw_def: extend_basis = real_vector.extend_basis
+ and dim_raw_def: dim = real_vector.dim
+ apply unfold_locales
+ apply (rule scaleR_add_right)
+ apply (rule scaleR_add_left)
+ apply (rule scaleR_scaleR)
+ apply (rule scaleR_one)
+ apply (force simp add: linear_def)
+ apply (force simp add: linear_def real_scaleR_def[abs_def])
+ done
+
+hide_const (open)\<comment>\<open>locale constants\<close>
+ real_vector.dependent
+ real_vector.independent
+ real_vector.representation
+ real_vector.subspace
+ real_vector.span
+ real_vector.extend_basis
+ real_vector.dim
+
+abbreviation "independent x \<equiv> \<not> dependent x"
+
+global_interpretation real_vector?: vector_space_pair "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
+ rewrites "Vector_Spaces.linear ( *\<^sub>R) ( *\<^sub>R) = linear"
+ and "Vector_Spaces.linear ( * ) ( *\<^sub>R) = linear"
+ defines construct_raw_def: construct = real_vector.construct
apply unfold_locales
- apply (rule scaleR_add_right)
- apply (rule scaleR_add_left)
- apply (rule scaleR_scaleR)
- apply (rule scaleR_one)
- done
+ unfolding linear_def real_scaleR_def
+ by (rule refl)+
+
+hide_const (open)\<comment>\<open>locale constants\<close>
+ real_vector.construct
+
+lemma linear_compose: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (g o f)"
+ unfolding linear_def by (rule Vector_Spaces.linear_compose)
text \<open>Recover original theorem names\<close>
@@ -172,6 +119,16 @@
lemmas scaleR_left_diff_distrib = scaleR_diff_left
lemmas scaleR_right_diff_distrib = scaleR_diff_right
+lemmas linear_injective_0 = linear_inj_iff_eq_0
+ and linear_injective_on_subspace_0 = linear_inj_on_iff_eq_0
+ and linear_cmul = linear_scale
+ and linear_scaleR = linear_scale_self
+ and subspace_mul = subspace_scale
+ and span_linear_image = linear_span_image
+ and span_0 = span_zero
+ and span_mul = span_scale
+ and injective_scaleR = injective_scale
+
lemma scaleR_minus1_left [simp]: "scaleR (-1) x = - x"
for x :: "'a::real_vector"
using scaleR_minus_left [of 1 x] by simp
@@ -191,26 +148,6 @@
by simp
qed
-class real_algebra = real_vector + ring +
- assumes mult_scaleR_left [simp]: "scaleR a x * y = scaleR a (x * y)"
- and mult_scaleR_right [simp]: "x * scaleR a y = scaleR a (x * y)"
-
-class real_algebra_1 = real_algebra + ring_1
-
-class real_div_algebra = real_algebra_1 + division_ring
-
-class real_field = real_div_algebra + field
-
-instantiation real :: real_field
-begin
-
-definition real_scaleR_def [simp]: "scaleR a x = a * x"
-
-instance
- by standard (simp_all add: algebra_simps)
-
-end
-
interpretation scaleR_left: additive "(\<lambda>a. scaleR a x :: 'a::real_vector)"
by standard (rule scaleR_left_distrib)
@@ -231,9 +168,7 @@
apply (erule (1) nonzero_inverse_scaleR_distrib)
done
-lemma sum_constant_scaleR: "(\<Sum>x\<in>A. y) = of_nat (card A) *\<^sub>R y"
- for y :: "'a::real_vector"
- by (induct A rule: infinite_finite_induct) (simp_all add: algebra_simps)
+lemmas sum_constant_scaleR = real_vector.sum_constant_scale\<comment>\<open>legacy name\<close>
named_theorems vector_add_divide_simps "to simplify sums of scaled vectors"
@@ -247,7 +182,7 @@
"(a / z) *\<^sub>R v - w = (if z = 0 then -w else (a *\<^sub>R v - z *\<^sub>R w) /\<^sub>R z)"
"(a / z) *\<^sub>R v - b *\<^sub>R w = (if z = 0 then -b *\<^sub>R w else (a *\<^sub>R v - (b * z) *\<^sub>R w) /\<^sub>R z)"
for v :: "'a :: real_vector"
- by (simp_all add: divide_inverse_commute scaleR_add_right real_vector.scale_right_diff_distrib)
+ by (simp_all add: divide_inverse_commute scaleR_add_right scaleR_diff_right)
lemma eq_vector_fraction_iff [vector_add_divide_simps]:
@@ -271,11 +206,11 @@
then have "inverse m *\<^sub>R (m *\<^sub>R x) = inverse m *\<^sub>R (y - c)" by simp
then show "x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)"
using m0
- by (simp add: real_vector.scale_right_diff_distrib)
+ by (simp add: scaleR_diff_right)
next
assume ?rhs
with m0 show "m *\<^sub>R x + c = y"
- by (simp add: real_vector.scale_right_diff_distrib)
+ by (simp add: scaleR_diff_right)
qed
lemma real_vector_eq_affinity: "m \<noteq> 0 \<Longrightarrow> y = m *\<^sub>R x + c \<longleftrightarrow> inverse m *\<^sub>R y - (inverse m *\<^sub>R c) = x"
@@ -1402,13 +1337,26 @@
subsection \<open>Bounded Linear and Bilinear Operators\<close>
-locale linear = additive f for f :: "'a::real_vector \<Rightarrow> 'b::real_vector" +
- assumes scaleR: "f (scaleR r x) = scaleR r (f x)"
+lemma linearI: "linear f"
+ if "\<And>b1 b2. f (b1 + b2) = f b1 + f b2"
+ "\<And>r b. f (r *\<^sub>R b) = r *\<^sub>R f b"
+ using that
+ by unfold_locales (auto simp: algebra_simps)
-lemma linear_imp_scaleR:
- assumes "linear D"
- obtains d where "D = (\<lambda>x. x *\<^sub>R d)"
- by (metis assms linear.scaleR mult.commute mult.left_neutral real_scaleR_def)
+lemma linear_iff:
+ "linear f \<longleftrightarrow> (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (c *\<^sub>R x) = c *\<^sub>R f x)"
+ (is "linear f \<longleftrightarrow> ?rhs")
+proof
+ assume "linear f"
+ then interpret f: linear f .
+ show "?rhs" by (simp add: f.add f.scale)
+next
+ assume "?rhs"
+ then show "linear f" by (intro linearI) auto
+qed
+
+lemmas linear_scaleR_left = linear_scale_left
+lemmas linear_imp_scaleR = linear_imp_scale
corollary real_linearD:
fixes f :: "real \<Rightarrow> real"
@@ -1416,14 +1364,8 @@
by (rule linear_imp_scaleR [OF assms]) (force simp: scaleR_conv_of_real)
lemma linear_times_of_real: "linear (\<lambda>x. a * of_real x)"
- apply (simp add: linear_def Real_Vector_Spaces.additive_def linear_axioms_def)
- by (metis distrib_left mult_scaleR_right scaleR_conv_of_real)
-
-lemma linearI:
- assumes "\<And>x y. f (x + y) = f x + f y"
- and "\<And>c x. f (c *\<^sub>R x) = c *\<^sub>R f x"
- shows "linear f"
- by standard (rule assms)+
+ by (auto intro!: linearI simp: distrib_left)
+ (metis mult_scaleR_right scaleR_conv_of_real)
locale bounded_linear = linear f for f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" +
assumes bounded: "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
@@ -1720,10 +1662,6 @@
by (auto intro: exI[of _ "f 1"] bounded_linear_mult_left)
qed
-lemma bij_linear_imp_inv_linear: "linear f \<Longrightarrow> bij f \<Longrightarrow> linear (inv f)"
- by (auto simp: linear_def linear_axioms_def additive_def bij_is_surj bij_is_inj surj_f_inv_f
- intro!: Hilbert_Choice.inv_f_eq)
-
instance real_normed_algebra_1 \<subseteq> perfect_space
proof
show "\<not> open {x}" for x :: 'a
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Vector_Spaces.thy Wed May 02 13:49:38 2018 +0200
@@ -0,0 +1,1759 @@
+(* Title: Vector_Spaces.thy
+ Author: Amine Chaieb, University of Cambridge
+ Author: Jose Divasón <jose.divasonm at unirioja.es>
+ Author: Jesús Aransay <jesus-maria.aransay at unirioja.es>
+ Author: Johannes Hölzl, VU Amsterdam
+ Author: Fabian Immler, TUM
+*)
+
+section \<open>Vector Spaces\<close>
+
+theory Vector_Spaces
+ imports Modules FuncSet
+begin
+
+lemma isomorphism_expand:
+ "f \<circ> g = id \<and> g \<circ> f = id \<longleftrightarrow> (\<forall>x. f (g x) = x) \<and> (\<forall>x. g (f x) = x)"
+ by (simp add: fun_eq_iff o_def id_def)
+
+lemma left_right_inverse_eq:
+ assumes fg: "f \<circ> g = id"
+ and gh: "g \<circ> h = id"
+ shows "f = h"
+proof -
+ have "f = f \<circ> (g \<circ> h)"
+ unfolding gh by simp
+ also have "\<dots> = (f \<circ> g) \<circ> h"
+ by (simp add: o_assoc)
+ finally show "f = h"
+ unfolding fg by simp
+qed
+
+lemma ordLeq3_finite_infinite:
+ assumes A: "finite A" and B: "infinite B" shows "ordLeq3 (card_of A) (card_of B)"
+proof -
+ have \<open>ordLeq3 (card_of A) (card_of B) \<or> ordLeq3 (card_of B) (card_of A)\<close>
+ by (intro ordLeq_total card_of_Well_order)
+ moreover have "\<not> ordLeq3 (card_of B) (card_of A)"
+ using B A card_of_ordLeq_finite[of B A] by auto
+ ultimately show ?thesis by auto
+qed
+
+locale vector_space =
+ fixes scale :: "'a::field \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b" (infixr "*s" 75)
+ assumes vector_space_assms:\<comment>\<open>re-stating the assumptions of \<open>module\<close> instead of extending \<open>module\<close>
+ allows us to rewrite in the sublocale.\<close>
+ "a *s (x + y) = a *s x + a *s y"
+ "(a + b) *s x = a *s x + b *s x"
+ "a *s (b *s x) = (a * b) *s x"
+ "1 *s x = x"
+
+lemma module_iff_vector_space: "module s \<longleftrightarrow> vector_space s"
+ unfolding module_def vector_space_def ..
+
+locale linear = vs1: vector_space s1 + vs2: vector_space s2 + module_hom s1 s2 f
+ for s1 :: "'a::field \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b" (infixr "*a" 75)
+ and s2 :: "'a::field \<Rightarrow> 'c::ab_group_add \<Rightarrow> 'c" (infixr "*b" 75)
+ and f :: "'b \<Rightarrow> 'c"
+
+lemma module_hom_iff_linear: "module_hom s1 s2 f \<longleftrightarrow> linear s1 s2 f"
+ unfolding module_hom_def linear_def module_iff_vector_space by auto
+lemmas module_hom_eq_linear = module_hom_iff_linear[abs_def, THEN meta_eq_to_obj_eq]
+lemmas linear_iff_module_hom = module_hom_iff_linear[symmetric]
+lemmas linear_module_homI = module_hom_iff_linear[THEN iffD1]
+ and module_hom_linearI = module_hom_iff_linear[THEN iffD2]
+
+context vector_space begin
+
+sublocale module scale rewrites "module_hom = linear"
+ by (unfold_locales) (fact vector_space_assms module_hom_eq_linear)+
+
+lemmas\<comment>\<open>from \<open>module\<close>\<close>
+ linear_id = module_hom_id
+ and linear_ident = module_hom_ident
+ and linear_scale_self = module_hom_scale_self
+ and linear_scale_left = module_hom_scale_left
+ and linear_uminus = module_hom_uminus
+
+lemma linear_imp_scale:
+ fixes D::"'a \<Rightarrow> 'b"
+ assumes "linear ( *) scale D"
+ obtains d where "D = (\<lambda>x. scale x d)"
+proof -
+ interpret linear "( *)" scale D by fact
+ show ?thesis
+ by (metis mult.commute mult.left_neutral scale that)
+qed
+
+lemma scale_eq_0_iff [simp]: "scale a x = 0 \<longleftrightarrow> a = 0 \<or> x = 0"
+ by (metis scale_left_commute right_inverse scale_one scale_scale scale_zero_left)
+
+lemma scale_left_imp_eq:
+ assumes nonzero: "a \<noteq> 0"
+ and scale: "scale a x = scale a y"
+ shows "x = y"
+proof -
+ from scale have "scale a (x - y) = 0"
+ by (simp add: scale_right_diff_distrib)
+ with nonzero have "x - y = 0" by simp
+ then show "x = y" by (simp only: right_minus_eq)
+qed
+
+lemma scale_right_imp_eq:
+ assumes nonzero: "x \<noteq> 0"
+ and scale: "scale a x = scale b x"
+ shows "a = b"
+proof -
+ from scale have "scale (a - b) x = 0"
+ by (simp add: scale_left_diff_distrib)
+ with nonzero have "a - b = 0" by simp
+ then show "a = b" by (simp only: right_minus_eq)
+qed
+
+lemma scale_cancel_left [simp]: "scale a x = scale a y \<longleftrightarrow> x = y \<or> a = 0"
+ by (auto intro: scale_left_imp_eq)
+
+lemma scale_cancel_right [simp]: "scale a x = scale b x \<longleftrightarrow> a = b \<or> x = 0"
+ by (auto intro: scale_right_imp_eq)
+
+lemma injective_scale: "c \<noteq> 0 \<Longrightarrow> inj (\<lambda>x. scale c x)"
+ by (simp add: inj_on_def)
+
+lemma dependent_def: "dependent P \<longleftrightarrow> (\<exists>a \<in> P. a \<in> span (P - {a}))"
+ unfolding dependent_explicit
+proof safe
+ fix a assume aP: "a \<in> P" and "a \<in> span (P - {a})"
+ then obtain a S u
+ where aP: "a \<in> P" and fS: "finite S" and SP: "S \<subseteq> P" "a \<notin> S" and ua: "(\<Sum>v\<in>S. u v *s v) = a"
+ unfolding span_explicit by blast
+ let ?S = "insert a S"
+ let ?u = "\<lambda>y. if y = a then - 1 else u y"
+ from fS SP have "(\<Sum>v\<in>?S. ?u v *s v) = 0"
+ by (simp add: if_distrib[of "\<lambda>r. r *s a" for a] sum.If_cases field_simps Diff_eq[symmetric] ua)
+ moreover have "finite ?S" "?S \<subseteq> P" "a \<in> ?S" "?u a \<noteq> 0"
+ using fS SP aP by auto
+ ultimately show "\<exists>t u. finite t \<and> t \<subseteq> P \<and> (\<Sum>v\<in>t. u v *s v) = 0 \<and> (\<exists>v\<in>t. u v \<noteq> 0)" by fast
+next
+ fix S u v
+ assume fS: "finite S" and SP: "S \<subseteq> P" and vS: "v \<in> S"
+ and uv: "u v \<noteq> 0" and u: "(\<Sum>v\<in>S. u v *s v) = 0"
+ let ?a = v
+ let ?S = "S - {v}"
+ let ?u = "\<lambda>i. (- u i) / u v"
+ have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P"
+ using fS SP vS by auto
+ have "(\<Sum>v\<in>?S. ?u v *s v) = (\<Sum>v\<in>S. (- (inverse (u ?a))) *s (u v *s v)) - ?u v *s v"
+ using fS vS uv by (simp add: sum_diff1 field_simps)
+ also have "\<dots> = ?a"
+ unfolding scale_sum_right[symmetric] u using uv by simp
+ finally have "(\<Sum>v\<in>?S. ?u v *s v) = ?a" .
+ with th0 show "\<exists>a \<in> P. a \<in> span (P - {a})"
+ unfolding span_explicit by (auto intro!: bexI[where x="?a"] exI[where x="?S"] exI[where x="?u"])
+qed
+
+lemma dependent_single[simp]: "dependent {x} \<longleftrightarrow> x = 0"
+ unfolding dependent_def by auto
+
+lemma in_span_insert:
+ assumes a: "a \<in> span (insert b S)"
+ and na: "a \<notin> span S"
+ shows "b \<in> span (insert a S)"
+proof -
+ from span_breakdown[of b "insert b S" a, OF insertI1 a]
+ obtain k where k: "a - k *s b \<in> span (S - {b})" by auto
+ have "k \<noteq> 0"
+ proof
+ assume "k = 0"
+ with k span_mono[of "S - {b}" S] have "a \<in> span S" by auto
+ with na show False by blast
+ qed
+ then have eq: "b = (1/k) *s a - (1/k) *s (a - k *s b)"
+ by (simp add: algebra_simps)
+
+ from k have "(1/k) *s (a - k *s b) \<in> span (S - {b})"
+ by (rule span_scale)
+ also have "... \<subseteq> span (insert a S)"
+ by (rule span_mono) auto
+ finally show ?thesis
+ using k by (subst eq) (blast intro: span_diff span_scale span_base)
+qed
+
+lemma dependent_insertD: assumes a: "a \<notin> span S" and S: "dependent (insert a S)" shows "dependent S"
+proof -
+ have "a \<notin> S" using a by (auto dest: span_base)
+ obtain b where b: "b = a \<or> b \<in> S" "b \<in> span (insert a S - {b})"
+ using S unfolding dependent_def by blast
+ have "b \<noteq> a" "b \<in> S"
+ using b \<open>a \<notin> S\<close> a by auto
+ with b have *: "b \<in> span (insert a (S - {b}))"
+ by (auto simp: insert_Diff_if)
+ show "dependent S"
+ proof cases
+ assume "b \<in> span (S - {b})" with \<open>b \<in> S\<close> show ?thesis
+ by (auto simp add: dependent_def)
+ next
+ assume "b \<notin> span (S - {b})"
+ with * have "a \<in> span (insert b (S - {b}))" by (rule in_span_insert)
+ with a show ?thesis
+ using \<open>b \<in> S\<close> by (auto simp: insert_absorb)
+ qed
+qed
+
+lemma independent_insertI: "a \<notin> span S \<Longrightarrow> independent S \<Longrightarrow> independent (insert a S)"
+ by (auto dest: dependent_insertD)
+
+lemma independent_insert:
+ "independent (insert a S) \<longleftrightarrow> (if a \<in> S then independent S else independent S \<and> a \<notin> span S)"
+proof -
+ have "a \<notin> S \<Longrightarrow> a \<in> span S \<Longrightarrow> dependent (insert a S)"
+ by (auto simp: dependent_def)
+ then show ?thesis
+ by (auto intro: dependent_mono simp: independent_insertI)
+qed
+
+lemma maximal_independent_subset_extend:
+ assumes "S \<subseteq> V" "independent S"
+ shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
+proof -
+ let ?C = "{B. S \<subseteq> B \<and> independent B \<and> B \<subseteq> V}"
+ have "\<exists>M\<in>?C. \<forall>X\<in>?C. M \<subseteq> X \<longrightarrow> X = M"
+ proof (rule subset_Zorn)
+ fix C :: "'b set set" assume "subset.chain ?C C"
+ then have C: "\<And>c. c \<in> C \<Longrightarrow> c \<subseteq> V" "\<And>c. c \<in> C \<Longrightarrow> S \<subseteq> c" "\<And>c. c \<in> C \<Longrightarrow> independent c"
+ "\<And>c d. c \<in> C \<Longrightarrow> d \<in> C \<Longrightarrow> c \<subseteq> d \<or> d \<subseteq> c"
+ unfolding subset.chain_def by blast+
+
+ show "\<exists>U\<in>?C. \<forall>X\<in>C. X \<subseteq> U"
+ proof cases
+ assume "C = {}" with assms show ?thesis
+ by (auto intro!: exI[of _ S])
+ next
+ assume "C \<noteq> {}"
+ with C(2) have "S \<subseteq> \<Union>C"
+ by auto
+ moreover have "independent (\<Union>C)"
+ by (intro independent_Union_directed C)
+ moreover have "\<Union>C \<subseteq> V"
+ using C by auto
+ ultimately show ?thesis
+ by auto
+ qed
+ qed
+ then obtain B where B: "independent B" "B \<subseteq> V" "S \<subseteq> B"
+ and max: "\<And>S. independent S \<Longrightarrow> S \<subseteq> V \<Longrightarrow> B \<subseteq> S \<Longrightarrow> S = B"
+ by auto
+ moreover
+ { assume "\<not> V \<subseteq> span B"
+ then obtain v where "v \<in> V" "v \<notin> span B"
+ by auto
+ with B have "independent (insert v B)" by (auto intro: dependent_insertD)
+ from max[OF this] \<open>v \<in> V\<close> \<open>B \<subseteq> V\<close>
+ have "v \<in> B"
+ by auto
+ with \<open>v \<notin> span B\<close> have False
+ by (auto intro: span_base) }
+ ultimately show ?thesis
+ by (auto intro!: exI[of _ B])
+qed
+
+lemma maximal_independent_subset: "\<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
+ by (metis maximal_independent_subset_extend[of "{}"] empty_subsetI independent_empty)
+
+text \<open>Extends a basis from B to a basis of the entire space.\<close>
+definition extend_basis :: "'b set \<Rightarrow> 'b set"
+ where "extend_basis B = (SOME B'. B \<subseteq> B' \<and> independent B' \<and> span B' = UNIV)"
+
+lemma
+ assumes B: "independent B"
+ shows extend_basis_superset: "B \<subseteq> extend_basis B"
+ and independent_extend_basis: "independent (extend_basis B)"
+ and span_extend_basis[simp]: "span (extend_basis B) = UNIV"
+proof -
+ define p where "p B' \<equiv> B \<subseteq> B' \<and> independent B' \<and> span B' = UNIV" for B'
+ obtain B' where "p B'"
+ using maximal_independent_subset_extend[OF subset_UNIV B] by (auto simp: p_def)
+ then have "p (extend_basis B)"
+ unfolding extend_basis_def p_def[symmetric] by (rule someI)
+ then show "B \<subseteq> extend_basis B" "independent (extend_basis B)" "span (extend_basis B) = UNIV"
+ by (auto simp: p_def)
+qed
+
+lemma in_span_delete:
+ assumes a: "a \<in> span S"
+ and na: "a \<notin> span (S - {b})"
+ shows "b \<in> span (insert a (S - {b}))"
+ apply (rule in_span_insert)
+ apply (rule set_rev_mp)
+ apply (rule a)
+ apply (rule span_mono)
+ apply blast
+ apply (rule na)
+ done
+
+lemma span_redundant: "x \<in> span S \<Longrightarrow> span (insert x S) = span S"
+ unfolding span_def by (rule hull_redundant)
+
+lemma span_trans: "x \<in> span S \<Longrightarrow> y \<in> span (insert x S) \<Longrightarrow> y \<in> span S"
+ by (simp only: span_redundant)
+
+lemma span_insert_0[simp]: "span (insert 0 S) = span S"
+ by (metis span_zero span_redundant)
+
+lemma span_delete_0 [simp]: "span(S - {0}) = span S"
+proof
+ show "span (S - {0}) \<subseteq> span S"
+ by (blast intro!: span_mono)
+next
+ have "span S \<subseteq> span(insert 0 (S - {0}))"
+ by (blast intro!: span_mono)
+ also have "... \<subseteq> span(S - {0})"
+ using span_insert_0 by blast
+ finally show "span S \<subseteq> span (S - {0})" .
+qed
+
+lemma span_image_scale:
+ assumes "finite S" and nz: "\<And>x. x \<in> S \<Longrightarrow> c x \<noteq> 0"
+ shows "span ((\<lambda>x. c x *s x) ` S) = span S"
+using assms
+proof (induction S arbitrary: c)
+ case (empty c) show ?case by simp
+next
+ case (insert x F c)
+ show ?case
+ proof (intro set_eqI iffI)
+ fix y
+ assume "y \<in> span ((\<lambda>x. c x *s x) ` insert x F)"
+ then show "y \<in> span (insert x F)"
+ using insert by (force simp: span_breakdown_eq)
+ next
+ fix y
+ assume "y \<in> span (insert x F)"
+ then show "y \<in> span ((\<lambda>x. c x *s x) ` insert x F)"
+ using insert
+ apply (clarsimp simp: span_breakdown_eq)
+ apply (rule_tac x="k / c x" in exI)
+ by simp
+ qed
+qed
+
+lemma exchange_lemma:
+ assumes f: "finite t"
+ and i: "independent s"
+ and sp: "s \<subseteq> span t"
+ shows "\<exists>t'. card t' = card t \<and> finite t' \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
+ using f i sp
+proof (induct "card (t - s)" arbitrary: s t rule: less_induct)
+ case less
+ note ft = `finite t` and s = `independent s` and sp = `s \<subseteq> span t`
+ let ?P = "\<lambda>t'. card t' = card t \<and> finite t' \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
+ let ?ths = "\<exists>t'. ?P t'"
+
+ {
+ assume st: "t \<subseteq> s"
+ from spanning_subset_independent[OF st s sp] st ft span_mono[OF st]
+ have ?ths by (auto intro: span_base)
+ }
+ moreover
+ {
+ assume st:"\<not> t \<subseteq> s"
+ from st obtain b where b: "b \<in> t" "b \<notin> s"
+ by blast
+ from b have "t - {b} - s \<subset> t - s"
+ by blast
+ then have cardlt: "card (t - {b} - s) < card (t - s)"
+ using ft by (auto intro: psubset_card_mono)
+ from b ft have ct0: "card t \<noteq> 0"
+ by auto
+ have ?ths
+ proof cases
+ assume stb: "s \<subseteq> span (t - {b})"
+ from ft have ftb: "finite (t - {b})"
+ by auto
+ from less(1)[OF cardlt ftb s stb]
+ obtain u where u: "card u = card (t - {b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u"
+ and fu: "finite u" by blast
+ let ?w = "insert b u"
+ have th0: "s \<subseteq> insert b u"
+ using u by blast
+ from u(3) b have "u \<subseteq> s \<union> t"
+ by blast
+ then have th1: "insert b u \<subseteq> s \<union> t"
+ using u b by blast
+ have bu: "b \<notin> u"
+ using b u by blast
+ from u(1) ft b have "card u = (card t - 1)"
+ by auto
+ then have th2: "card (insert b u) = card t"
+ using card_insert_disjoint[OF fu bu] ct0 by auto
+ from u(4) have "s \<subseteq> span u" .
+ also have "\<dots> \<subseteq> span (insert b u)"
+ by (rule span_mono) blast
+ finally have th3: "s \<subseteq> span (insert b u)" .
+ from th0 th1 th2 th3 fu have th: "?P ?w"
+ by blast
+ from th show ?thesis by blast
+ next
+ assume stb: "\<not> s \<subseteq> span (t - {b})"
+ from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})"
+ by blast
+ have ab: "a \<noteq> b"
+ using a b by blast
+ have at: "a \<notin> t"
+ using a ab span_base[of a "t- {b}"] by auto
+ have mlt: "card ((insert a (t - {b})) - s) < card (t - s)"
+ using cardlt ft a b by auto
+ have ft': "finite (insert a (t - {b}))"
+ using ft by auto
+ {
+ fix x
+ assume xs: "x \<in> s"
+ have t: "t \<subseteq> insert b (insert a (t - {b}))"
+ using b by auto
+ have bs: "b \<in> span (insert a (t - {b}))"
+ apply (rule in_span_delete)
+ using a sp unfolding subset_eq
+ apply auto
+ done
+ from xs sp have "x \<in> span t"
+ by blast
+ with span_mono[OF t] have x: "x \<in> span (insert b (insert a (t - {b})))" ..
+ from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .
+ }
+ then have sp': "s \<subseteq> span (insert a (t - {b}))"
+ by blast
+ from less(1)[OF mlt ft' s sp'] obtain u where u:
+ "card u = card (insert a (t - {b}))"
+ "finite u" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t - {b})"
+ "s \<subseteq> span u" by blast
+ from u a b ft at ct0 have "?P u"
+ by auto
+ then show ?thesis by blast
+ qed
+ }
+ ultimately show ?ths by blast
+qed
+
+lemma independent_span_bound:
+ assumes f: "finite t"
+ and i: "independent s"
+ and sp: "s \<subseteq> span t"
+ shows "finite s \<and> card s \<le> card t"
+ by (metis exchange_lemma[OF f i sp] finite_subset card_mono)
+
+lemma independent_explicit_finite_subsets:
+ "independent A \<longleftrightarrow> (\<forall>S \<subseteq> A. finite S \<longrightarrow> (\<forall>u. (\<Sum>v\<in>S. u v *s v) = 0 \<longrightarrow> (\<forall>v\<in>S. u v = 0)))"
+ unfolding dependent_explicit [of A] by (simp add: disj_not2)
+
+lemma independent_if_scalars_zero:
+ assumes fin_A: "finite A"
+ and sum: "\<And>f x. (\<Sum>x\<in>A. f x *s x) = 0 \<Longrightarrow> x \<in> A \<Longrightarrow> f x = 0"
+ shows "independent A"
+proof (unfold independent_explicit_finite_subsets, clarify)
+ fix S v and u :: "'b \<Rightarrow> 'a"
+ assume S: "S \<subseteq> A" and v: "v \<in> S"
+ let ?g = "\<lambda>x. if x \<in> S then u x else 0"
+ have "(\<Sum>v\<in>A. ?g v *s v) = (\<Sum>v\<in>S. u v *s v)"
+ using S fin_A by (auto intro!: sum.mono_neutral_cong_right)
+ also assume "(\<Sum>v\<in>S. u v *s v) = 0"
+ finally have "?g v = 0" using v S sum by force
+ thus "u v = 0" unfolding if_P[OF v] .
+qed
+
+lemma bij_if_span_eq_span_bases:
+ assumes B: "independent B" and C: "independent C"
+ and eq: "span B = span C"
+ shows "\<exists>f. bij_betw f B C"
+proof cases
+ assume "finite B \<or> finite C"
+ then have "finite B \<and> finite C \<and> card C = card B"
+ using independent_span_bound[of B C] independent_span_bound[of C B] assms
+ span_superset[of B] span_superset[of C]
+ by auto
+ then show ?thesis
+ by (auto intro!: finite_same_card_bij)
+next
+ assume "\<not> (finite B \<or> finite C)"
+ then have "infinite B" "infinite C" by auto
+ { fix B C assume B: "independent B" and C: "independent C" and "infinite B" "infinite C" and eq: "span B = span C"
+ let ?R = "representation B" and ?R' = "representation C" let ?U = "\<lambda>c. {v. ?R c v \<noteq> 0}"
+ have in_span_C [simp, intro]: \<open>b \<in> B \<Longrightarrow> b \<in> span C\<close> for b unfolding eq[symmetric] by (rule span_base)
+ have in_span_B [simp, intro]: \<open>c \<in> C \<Longrightarrow> c \<in> span B\<close> for c unfolding eq by (rule span_base)
+ have \<open>B \<subseteq> (\<Union>c\<in>C. ?U c)\<close>
+ proof
+ fix b assume \<open>b \<in> B\<close>
+ have \<open>b \<in> span C\<close>
+ using \<open>b \<in> B\<close> unfolding eq[symmetric] by (rule span_base)
+ have \<open>(\<Sum>v | ?R' b v \<noteq> 0. \<Sum>w | ?R v w \<noteq> 0. (?R' b v * ?R v w) *s w) =
+ (\<Sum>v | ?R' b v \<noteq> 0. ?R' b v *s (\<Sum>w | ?R v w \<noteq> 0. ?R v w *s w))\<close>
+ by (simp add: scale_sum_right)
+ also have \<open>\<dots> = (\<Sum>v | ?R' b v \<noteq> 0. ?R' b v *s v)\<close>
+ by (auto simp: sum_nonzero_representation_eq B eq span_base representation_ne_zero)
+ also have \<open>\<dots> = b\<close>
+ by (rule sum_nonzero_representation_eq[OF C \<open>b \<in> span C\<close>])
+ finally have "?R b b = ?R (\<Sum>v | ?R' b v \<noteq> 0. \<Sum>w | ?R v w \<noteq> 0. (?R' b v * ?R v w) *s w) b"
+ by simp
+ also have \<open>\<dots> = (\<Sum>v | ?R' b v \<noteq> 0. \<Sum>w | ?R v w \<noteq> 0. ?R' b v * ?R v w * ?R w b)\<close>
+ using B \<open>b \<in> B\<close>
+ apply (subst representation_sum[OF B])
+ apply (fastforce intro: span_sum span_scale span_base representation_ne_zero)
+ apply (rule sum.cong[OF refl])
+ apply (subst representation_sum[OF B])
+ apply (simp add: span_sum span_scale span_base representation_ne_zero)
+ apply (simp add: representation_scale[OF B] span_base representation_ne_zero)
+ done
+ finally have "(\<Sum>v | ?R' b v \<noteq> 0. \<Sum>w | ?R v w \<noteq> 0. ?R' b v * ?R v w * ?R w b) \<noteq> 0"
+ using representation_basis[OF B \<open>b \<in> B\<close>] by auto
+ then obtain v w where bv: "?R' b v \<noteq> 0" and vw: "?R v w \<noteq> 0" and "?R' b v * ?R v w * ?R w b \<noteq> 0"
+ by (blast elim: sum.not_neutral_contains_not_neutral)
+ with representation_basis[OF B, of w] vw[THEN representation_ne_zero]
+ have \<open>?R' b v \<noteq> 0\<close> \<open>?R v b \<noteq> 0\<close> by (auto split: if_splits)
+ then show \<open>b \<in> (\<Union>c\<in>C. ?U c)\<close>
+ by (auto dest: representation_ne_zero)
+ qed
+ then have B_eq: \<open>B = (\<Union>c\<in>C. ?U c)\<close>
+ by (auto intro: span_base representation_ne_zero eq)
+ have "ordLeq3 (card_of B) (card_of C)"
+ proof (subst B_eq, rule card_of_UNION_ordLeq_infinite[OF \<open>infinite C\<close>])
+ show "ordLeq3 (card_of C) (card_of C)"
+ by (intro ordLeq_refl card_of_Card_order)
+ show "\<forall>c\<in>C. ordLeq3 (card_of {v. representation B c v \<noteq> 0}) (card_of C)"
+ by (intro ballI ordLeq3_finite_infinite \<open>infinite C\<close> finite_representation)
+ qed }
+ from this[of B C] this[of C B] B C eq \<open>infinite C\<close> \<open>infinite B\<close>
+ show ?thesis by (auto simp add: ordIso_iff_ordLeq card_of_ordIso)
+qed
+
+definition dim :: "'b set \<Rightarrow> nat"
+ where "dim V = card (SOME b. independent b \<and> span b = span V)"
+
+lemma dim_eq_card:
+ assumes BV: "span B = span V" and B: "independent B"
+ shows "dim V = card B"
+proof -
+ define p where "p b \<equiv> independent b \<and> span b = span V" for b
+ have "p (SOME B. p B)"
+ using assms by (intro someI[of p B]) (auto simp: p_def)
+ then have "\<exists>f. bij_betw f B (SOME B. p B)"
+ by (subst (asm) p_def, intro bij_if_span_eq_span_bases[OF B]) (simp_all add: BV)
+ then have "card B = card (SOME B. p B)"
+ by (auto intro: bij_betw_same_card)
+ then show ?thesis
+ by (simp add: dim_def p_def)
+qed
+
+lemma basis_card_eq_dim: "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> card B = dim V"
+ using dim_eq_card[of B V] span_mono[of B V] span_minimal[OF _ subspace_span, of V B] by auto
+
+lemma basis_exists: "\<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> card B = dim V"
+ by (meson basis_card_eq_dim empty_subsetI independent_empty maximal_independent_subset_extend)
+
+lemma dim_eq_card_independent: "independent B \<Longrightarrow> dim B = card B"
+ by (rule dim_eq_card[OF refl])
+
+lemma dim_span[simp]: "dim (span S) = dim S"
+ by (simp add: dim_def span_span)
+
+lemma dim_span_eq_card_independent: "independent B \<Longrightarrow> dim (span B) = card B"
+ by (simp add: dim_span dim_eq_card)
+
+lemma dim_le_card: assumes "V \<subseteq> span W" "finite W" shows "dim V \<le> card W"
+proof -
+ obtain A where "independent A" "A \<subseteq> V" "V \<subseteq> span A"
+ using maximal_independent_subset[of V] by auto
+ with assms independent_span_bound[of W A] basis_card_eq_dim[of A V]
+ show ?thesis by auto
+qed
+
+lemma span_eq_dim: "span S = span T \<Longrightarrow> dim S = dim T"
+ by (metis dim_span)
+
+corollary dim_le_card':
+ "finite s \<Longrightarrow> dim s \<le> card s"
+ by (metis basis_exists card_mono)
+
+lemma span_card_ge_dim:
+ "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B"
+ by (simp add: dim_le_card)
+
+lemma dim_unique:
+ "B \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> card B = n \<Longrightarrow> dim V = n"
+ by (metis basis_card_eq_dim)
+
+lemma subspace_sums: "\<lbrakk>subspace S; subspace T\<rbrakk> \<Longrightarrow> subspace {x + y|x y. x \<in> S \<and> y \<in> T}"
+ apply (simp add: subspace_def)
+ apply (intro conjI impI allI)
+ using add.right_neutral apply blast
+ apply clarify
+ apply (metis add.assoc add.left_commute)
+ using scale_right_distrib by blast
+
+end
+
+lemma linear_iff: "linear s1 s2 f \<longleftrightarrow>
+ (vector_space s1 \<and> vector_space s2 \<and> (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (s1 c x) = s2 c (f x)))"
+ unfolding linear_def module_hom_iff vector_space_def module_def by auto
+
+context begin
+qualified lemma linear_compose: "linear s1 s2 f \<Longrightarrow> linear s2 s3 g \<Longrightarrow> linear s1 s3 (g o f)"
+ unfolding module_hom_iff_linear[symmetric]
+ by (rule module_hom_compose)
+end
+
+locale vector_space_pair = vs1: vector_space s1 + vs2: vector_space s2
+ for s1 :: "'a::field \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b" (infixr "*a" 75)
+ and s2 :: "'a::field \<Rightarrow> 'c::ab_group_add \<Rightarrow> 'c" (infixr "*b" 75)
+begin
+
+context fixes f assumes "linear s1 s2 f" begin
+interpretation linear s1 s2 f by fact
+lemmas\<comment>\<open>from locale \<open>module_hom\<close>\<close>
+ linear_0 = zero
+ and linear_add = add
+ and linear_scale = scale
+ and linear_neg = neg
+ and linear_diff = diff
+ and linear_sum = sum
+ and linear_inj_on_iff_eq_0 = inj_on_iff_eq_0
+ and linear_inj_iff_eq_0 = inj_iff_eq_0
+ and linear_subspace_image = subspace_image
+ and linear_subspace_vimage = subspace_vimage
+ and linear_subspace_kernel = subspace_kernel
+ and linear_span_image = span_image
+ and linear_dependent_inj_imageD = dependent_inj_imageD
+ and linear_eq_0_on_span = eq_0_on_span
+ and linear_independent_injective_image = independent_injective_image
+ and linear_inj_on_span_independent_image = inj_on_span_independent_image
+ and linear_inj_on_span_iff_independent_image = inj_on_span_iff_independent_image
+ and linear_subspace_linear_preimage = subspace_linear_preimage
+ and linear_spans_image = spans_image
+ and linear_spanning_surjective_image = spanning_surjective_image
+end
+
+sublocale module_pair
+ rewrites "module_hom = linear"
+ by unfold_locales (fact module_hom_eq_linear)
+
+lemmas\<comment>\<open>from locale \<open>module_pair\<close>\<close>
+ linear_eq_on_span = module_hom_eq_on_span
+ and linear_compose_scale_right = module_hom_scale
+ and linear_compose_add = module_hom_add
+ and linear_zero = module_hom_zero
+ and linear_compose_sub = module_hom_sub
+ and linear_compose_neg = module_hom_neg
+ and linear_compose_scale = module_hom_compose_scale
+
+lemma linear_indep_image_lemma:
+ assumes lf: "linear s1 s2 f"
+ and fB: "finite B"
+ and ifB: "vs2.independent (f ` B)"
+ and fi: "inj_on f B"
+ and xsB: "x \<in> vs1.span B"
+ and fx: "f x = 0"
+ shows "x = 0"
+ using fB ifB fi xsB fx
+proof (induct arbitrary: x rule: finite_induct[OF fB])
+ case 1
+ then show ?case by auto
+next
+ case (2 a b x)
+ have fb: "finite b" using "2.prems" by simp
+ have th0: "f ` b \<subseteq> f ` (insert a b)"
+ apply (rule image_mono)
+ apply blast
+ done
+ from vs2.independent_mono[ OF "2.prems"(2) th0]
+ have ifb: "vs2.independent (f ` b)" .
+ have fib: "inj_on f b"
+ apply (rule subset_inj_on [OF "2.prems"(3)])
+ apply blast
+ done
+ from vs1.span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
+ obtain k where k: "x - k *a a \<in> vs1.span (b - {a})"
+ by blast
+ have "f (x - k *a a) \<in> vs2.span (f ` b)"
+ unfolding linear_span_image[OF lf]
+ apply (rule imageI)
+ using k vs1.span_mono[of "b - {a}" b]
+ apply blast
+ done
+ then have "f x - k *b f a \<in> vs2.span (f ` b)"
+ by (simp add: linear_diff linear_scale lf)
+ then have th: "-k *b f a \<in> vs2.span (f ` b)"
+ using "2.prems"(5) by simp
+ have xsb: "x \<in> vs1.span b"
+ proof (cases "k = 0")
+ case True
+ with k have "x \<in> vs1.span (b - {a})" by simp
+ then show ?thesis using vs1.span_mono[of "b - {a}" b]
+ by blast
+ next
+ case False
+ with vs2.span_scale[OF th, of "- 1/ k"]
+ have th1: "f a \<in> vs2.span (f ` b)"
+ by auto
+ from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
+ have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
+ from "2.prems"(2) [unfolded vs2.dependent_def bex_simps(8), rule_format, of "f a"]
+ have "f a \<notin> vs2.span (f ` b)" using tha
+ using "2.hyps"(2)
+ "2.prems"(3) by auto
+ with th1 have False by blast
+ then show ?thesis by blast
+ qed
+ from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" .
+qed
+
+lemma linear_eq_on:
+ assumes l: "linear s1 s2 f" "linear s1 s2 g"
+ assumes x: "x \<in> vs1.span B" and eq: "\<And>b. b \<in> B \<Longrightarrow> f b = g b"
+ shows "f x = g x"
+proof -
+ interpret d: linear s1 s2 "\<lambda>x. f x - g x"
+ using l by (intro linear_compose_sub) (auto simp: module_hom_iff_linear)
+ have "f x - g x = 0"
+ by (rule d.eq_0_on_span[OF _ x]) (auto simp: eq)
+ then show ?thesis by auto
+qed
+
+definition construct :: "'b set \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> ('b \<Rightarrow> 'c)"
+ where "construct B g v = (\<Sum>b | vs1.representation (vs1.extend_basis B) v b \<noteq> 0.
+ vs1.representation (vs1.extend_basis B) v b *b (if b \<in> B then g b else 0))"
+
+lemma construct_cong: "(\<And>b. b \<in> B \<Longrightarrow> f b = g b) \<Longrightarrow> construct B f = construct B g"
+ unfolding construct_def by (rule ext, auto intro!: sum.cong)
+
+lemma linear_construct:
+ assumes B[simp]: "vs1.independent B"
+ shows "linear s1 s2 (construct B f)"
+ unfolding module_hom_iff_linear linear_iff
+proof safe
+ have eB[simp]: "vs1.independent (vs1.extend_basis B)"
+ using vs1.independent_extend_basis[OF B] .
+ let ?R = "vs1.representation (vs1.extend_basis B)"
+ fix c x y
+ have "construct B f (x + y) =
+ (\<Sum>b\<in>{b. ?R x b \<noteq> 0} \<union> {b. ?R y b \<noteq> 0}. ?R (x + y) b *b (if b \<in> B then f b else 0))"
+ by (auto intro!: sum.mono_neutral_cong_left simp: vs1.finite_representation vs1.representation_add construct_def)
+ also have "\<dots> = construct B f x + construct B f y"
+ by (auto simp: construct_def vs1.representation_add vs2.scale_left_distrib sum.distrib
+ intro!: arg_cong2[where f="(+)"] sum.mono_neutral_cong_right vs1.finite_representation)
+ finally show "construct B f (x + y) = construct B f x + construct B f y" .
+
+ show "construct B f (c *a x) = c *b construct B f x"
+ by (auto simp del: vs2.scale_scale intro!: sum.mono_neutral_cong_left vs1.finite_representation
+ simp add: construct_def vs2.scale_scale[symmetric] vs1.representation_scale vs2.scale_sum_right)
+qed intro_locales
+
+lemma construct_basis:
+ assumes B[simp]: "vs1.independent B" and b: "b \<in> B"
+ shows "construct B f b = f b"
+proof -
+ have *: "vs1.representation (vs1.extend_basis B) b = (\<lambda>v. if v = b then 1 else 0)"
+ using vs1.extend_basis_superset[OF B] b
+ by (intro vs1.representation_basis vs1.independent_extend_basis) auto
+ then have "{v. vs1.representation (vs1.extend_basis B) b v \<noteq> 0} = {b}"
+ by auto
+ then show ?thesis
+ unfolding construct_def by (simp add: * b)
+qed
+
+lemma construct_outside:
+ assumes B: "vs1.independent B" and v: "v \<in> vs1.span (vs1.extend_basis B - B)"
+ shows "construct B f v = 0"
+ unfolding construct_def
+proof (clarsimp intro!: sum.neutral simp del: vs2.scale_eq_0_iff)
+ fix b assume "b \<in> B"
+ then have "vs1.representation (vs1.extend_basis B - B) v b = 0"
+ using vs1.representation_ne_zero[of "vs1.extend_basis B - B" v b] by auto
+ moreover have "vs1.representation (vs1.extend_basis B) v = vs1.representation (vs1.extend_basis B - B) v"
+ using vs1.representation_extend[OF vs1.independent_extend_basis[OF B] v] by auto
+ ultimately show "vs1.representation (vs1.extend_basis B) v b *b f b = 0"
+ by simp
+qed
+
+lemma construct_add:
+ assumes B[simp]: "vs1.independent B"
+ shows "construct B (\<lambda>x. f x + g x) v = construct B f v + construct B g v"
+proof (rule linear_eq_on)
+ show "v \<in> vs1.span (vs1.extend_basis B)" by simp
+ show "b \<in> vs1.extend_basis B \<Longrightarrow> construct B (\<lambda>x. f x + g x) b = construct B f b + construct B g b" for b
+ using construct_outside[OF B vs1.span_base, of b] by (cases "b \<in> B") (auto simp: construct_basis)
+qed (intro linear_compose_add linear_construct B)+
+
+lemma construct_scale:
+ assumes B[simp]: "vs1.independent B"
+ shows "construct B (\<lambda>x. c *b f x) v = c *b construct B f v"
+proof (rule linear_eq_on)
+ show "v \<in> vs1.span (vs1.extend_basis B)" by simp
+ show "b \<in> vs1.extend_basis B \<Longrightarrow> construct B (\<lambda>x. c *b f x) b = c *b construct B f b" for b
+ using construct_outside[OF B vs1.span_base, of b] by (cases "b \<in> B") (auto simp: construct_basis)
+qed (intro linear_construct module_hom_scale B)+
+
+lemma construct_in_span:
+ assumes B[simp]: "vs1.independent B"
+ shows "construct B f v \<in> vs2.span (f ` B)"
+proof -
+ interpret c: linear s1 s2 "construct B f" by (rule linear_construct) fact
+ let ?R = "vs1.representation B"
+ have "v \<in> vs1.span ((vs1.extend_basis B - B) \<union> B)"
+ by (auto simp: Un_absorb2 vs1.extend_basis_superset)
+ then obtain x y where "v = x + y" "x \<in> vs1.span (vs1.extend_basis B - B)" "y \<in> vs1.span B"
+ unfolding vs1.span_Un by auto
+ moreover have "construct B f (\<Sum>b | ?R y b \<noteq> 0. ?R y b *a b) \<in> vs2.span (f ` B)"
+ by (auto simp add: c.sum c.scale construct_basis vs1.representation_ne_zero
+ intro!: vs2.span_sum vs2.span_scale intro: vs2.span_base )
+ ultimately show "construct B f v \<in> vs2.span (f ` B)"
+ by (auto simp add: c.add construct_outside vs1.sum_nonzero_representation_eq)
+qed
+
+lemma linear_compose_sum:
+ assumes lS: "\<forall>a \<in> S. linear s1 s2 (f a)"
+ shows "linear s1 s2 (\<lambda>x. sum (\<lambda>a. f a x) S)"
+proof (cases "finite S")
+ case True
+ then show ?thesis
+ using lS by induct (simp_all add: linear_zero linear_compose_add)
+next
+ case False
+ then show ?thesis
+ by (simp add: linear_zero)
+qed
+
+lemma in_span_in_range_construct:
+ "x \<in> range (construct B f)" if i: "vs1.independent B" and x: "x \<in> vs2.span (f ` B)"
+proof -
+ interpret linear "( *a)" "( *b)" "construct B f"
+ using i by (rule linear_construct)
+ obtain bb :: "('b \<Rightarrow> 'c) \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> 'b set \<Rightarrow> 'b" where
+ "\<forall>x0 x1 x2. (\<exists>v4. v4 \<in> x2 \<and> x1 v4 \<noteq> x0 v4) = (bb x0 x1 x2 \<in> x2 \<and> x1 (bb x0 x1 x2) \<noteq> x0 (bb x0 x1 x2))"
+ by moura
+ then have f2: "\<forall>B Ba f fa. (B \<noteq> Ba \<or> bb fa f Ba \<in> Ba \<and> f (bb fa f Ba) \<noteq> fa (bb fa f Ba)) \<or> f ` B = fa ` Ba"
+ by (meson image_cong)
+ have "vs1.span B \<subseteq> vs1.span (vs1.extend_basis B)"
+ by (simp add: vs1.extend_basis_superset[OF i] vs1.span_mono)
+ then show "x \<in> range (construct B f)"
+ using f2 x by (metis (no_types) construct_basis[OF i, of _ f]
+ vs1.span_extend_basis[OF i] set_mp span_image spans_image)
+qed
+
+lemma range_construct_eq_span:
+ "range (construct B f) = vs2.span (f ` B)"
+ if "vs1.independent B"
+ by (auto simp: that construct_in_span in_span_in_range_construct)
+
+lemma linear_independent_extend_subspace:
+ \<comment>\<open>legacy: use @{term construct} instead\<close>
+ assumes "vs1.independent B"
+ shows "\<exists>g. linear s1 s2 g \<and> (\<forall>x\<in>B. g x = f x) \<and> range g = vs2.span (f`B)"
+ by (rule exI[where x="construct B f"])
+ (auto simp: linear_construct assms construct_basis range_construct_eq_span)
+
+lemma linear_independent_extend:
+ "vs1.independent B \<Longrightarrow> \<exists>g. linear s1 s2 g \<and> (\<forall>x\<in>B. g x = f x)"
+ using linear_independent_extend_subspace[of B f] by auto
+
+lemma linear_exists_left_inverse_on:
+ assumes lf: "linear s1 s2 f"
+ assumes V: "vs1.subspace V" and f: "inj_on f V"
+ shows "\<exists>g\<in>UNIV \<rightarrow> V. linear s2 s1 g \<and> (\<forall>v\<in>V. g (f v) = v)"
+proof -
+ interpret linear s1 s2 f by fact
+ obtain B where V_eq: "V = vs1.span B" and B: "vs1.independent B"
+ using vs1.maximal_independent_subset[of V] vs1.span_minimal[OF _ \<open>vs1.subspace V\<close>] by auto
+ have f: "inj_on f (vs1.span B)"
+ using f unfolding V_eq .
+ show ?thesis
+ proof (intro bexI ballI conjI)
+ interpret p: vector_space_pair s2 s1 by unfold_locales
+ have fB: "vs2.independent (f ` B)"
+ using independent_injective_image[OF B f] .
+ let ?g = "p.construct (f ` B) (the_inv_into B f)"
+ show "linear ( *b) ( *a) ?g"
+ by (rule p.linear_construct[OF fB])
+ have "?g b \<in> vs1.span (the_inv_into B f ` f ` B)" for b
+ by (intro p.construct_in_span fB)
+ moreover have "the_inv_into B f ` f ` B = B"
+ by (auto simp: image_comp comp_def the_inv_into_f_f inj_on_subset[OF f vs1.span_superset]
+ cong: image_cong)
+ ultimately show "?g \<in> UNIV \<rightarrow> V"
+ by (auto simp: V_eq)
+ have "(?g \<circ> f) v = id v" if "v \<in> vs1.span B" for v
+ proof (rule vector_space_pair.linear_eq_on[where x=v])
+ show "vector_space_pair ( *a) ( *a)" by unfold_locales
+ show "linear ( *a) ( *a) (?g \<circ> f)"
+ apply (rule Vector_Spaces.linear_compose[of _ "( *b)"])
+ subgoal by unfold_locales
+ apply fact
+ done
+ show "linear ( *a) ( *a) id" by (rule vs1.linear_id)
+ show "v \<in> vs1.span B" by fact
+ show "b \<in> B \<Longrightarrow> (p.construct (f ` B) (the_inv_into B f) \<circ> f) b = id b" for b
+ by (simp add: p.construct_basis fB the_inv_into_f_f inj_on_subset[OF f vs1.span_superset])
+ qed
+ then show "v \<in> V \<Longrightarrow> ?g (f v) = v" for v by (auto simp: comp_def id_def V_eq)
+ qed
+qed
+
+lemma linear_exists_right_inverse_on:
+ assumes lf: "linear s1 s2 f"
+ assumes "vs1.subspace V"
+ shows "\<exists>g\<in>UNIV \<rightarrow> V. linear s2 s1 g \<and> (\<forall>v\<in>f ` V. f (g v) = v)"
+proof -
+ obtain B where V_eq: "V = vs1.span B" and B: "vs1.independent B"
+ using vs1.maximal_independent_subset[of V] vs1.span_minimal[OF _ \<open>vs1.subspace V\<close>] by auto
+ obtain C where C: "vs2.independent C" and fB_C: "f ` B \<subseteq> vs2.span C" "C \<subseteq> f ` B"
+ using vs2.maximal_independent_subset[of "f ` B"] by auto
+ then have "\<forall>v\<in>C. \<exists>b\<in>B. v = f b" by auto
+ then obtain g where g: "\<And>v. v \<in> C \<Longrightarrow> g v \<in> B" "\<And>v. v \<in> C \<Longrightarrow> f (g v) = v" by metis
+ show ?thesis
+ proof (intro bexI ballI conjI)
+ interpret p: vector_space_pair s2 s1 by unfold_locales
+ let ?g = "p.construct C g"
+ show "linear ( *b) ( *a) ?g"
+ by (rule p.linear_construct[OF C])
+ have "?g v \<in> vs1.span (g ` C)" for v
+ by (rule p.construct_in_span[OF C])
+ also have "\<dots> \<subseteq> V" unfolding V_eq using g by (intro vs1.span_mono) auto
+ finally show "?g \<in> UNIV \<rightarrow> V" by auto
+ have "(f \<circ> ?g) v = id v" if v: "v \<in> f ` V" for v
+ proof (rule vector_space_pair.linear_eq_on[where x=v])
+ show "vector_space_pair ( *b) ( *b)" by unfold_locales
+ show "linear ( *b) ( *b) (f \<circ> ?g)"
+ apply (rule Vector_Spaces.linear_compose[of _ "( *a)"])
+ apply fact
+ subgoal by fact
+ done
+ show "linear ( *b) ( *b) id" by (rule vs2.linear_id)
+ have "vs2.span (f ` B) = vs2.span C"
+ using fB_C vs2.span_mono[of C "f ` B"] vs2.span_minimal[of "f`B" "vs2.span C"] by (auto simp: vs2.subspace_span)
+ then show "v \<in> vs2.span C"
+ using v linear_span_image[OF lf, of B] by (simp add: V_eq)
+ show "(f \<circ> p.construct C g) b = id b" if b: "b \<in> C" for b
+ by (auto simp: p.construct_basis g C b)
+ qed
+ then show "v \<in> f ` V \<Longrightarrow> f (?g v) = v" for v by (auto simp: comp_def id_def)
+ qed
+qed
+
+lemma linear_inj_on_left_inverse:
+ assumes lf: "linear s1 s2 f"
+ assumes fi: "inj_on f (vs1.span S)"
+ shows "\<exists>g. range g \<subseteq> vs1.span S \<and> linear s2 s1 g \<and> (\<forall>x\<in>vs1.span S. g (f x) = x)"
+ using linear_exists_left_inverse_on[OF lf vs1.subspace_span fi]
+ by (auto simp: linear_iff_module_hom)
+
+lemma linear_injective_left_inverse: "linear s1 s2 f \<Longrightarrow> inj f \<Longrightarrow> \<exists>g. linear s2 s1 g \<and> g \<circ> f = id"
+ using linear_inj_on_left_inverse[of f UNIV] by (auto simp: fun_eq_iff vs1.span_UNIV)
+
+lemma linear_surj_right_inverse:
+ assumes lf: "linear s1 s2 f"
+ assumes sf: "vs2.span T \<subseteq> f`vs1.span S"
+ shows "\<exists>g. range g \<subseteq> vs1.span S \<and> linear s2 s1 g \<and> (\<forall>x\<in>vs2.span T. f (g x) = x)"
+ using linear_exists_right_inverse_on[OF lf vs1.subspace_span, of S] sf
+ by (auto simp: linear_iff_module_hom)
+
+lemma linear_surjective_right_inverse: "linear s1 s2 f \<Longrightarrow> surj f \<Longrightarrow> \<exists>g. linear s2 s1 g \<and> f \<circ> g = id"
+ using linear_surj_right_inverse[of f UNIV UNIV]
+ by (auto simp: vs1.span_UNIV vs2.span_UNIV fun_eq_iff)
+
+end
+
+lemma surjective_iff_injective_gen:
+ assumes fS: "finite S"
+ and fT: "finite T"
+ and c: "card S = card T"
+ and ST: "f ` S \<subseteq> T"
+ shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S"
+ (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+ assume h: "?lhs"
+ {
+ fix x y
+ assume x: "x \<in> S"
+ assume y: "y \<in> S"
+ assume f: "f x = f y"
+ from x fS have S0: "card S \<noteq> 0"
+ by auto
+ have "x = y"
+ proof (rule ccontr)
+ assume xy: "\<not> ?thesis"
+ have th: "card S \<le> card (f ` (S - {y}))"
+ unfolding c
+ apply (rule card_mono)
+ apply (rule finite_imageI)
+ using fS apply simp
+ using h xy x y f unfolding subset_eq image_iff
+ apply auto
+ apply (case_tac "xa = f x")
+ apply (rule bexI[where x=x])
+ apply auto
+ done
+ also have " \<dots> \<le> card (S - {y})"
+ apply (rule card_image_le)
+ using fS by simp
+ also have "\<dots> \<le> card S - 1" using y fS by simp
+ finally show False using S0 by arith
+ qed
+ }
+ then show ?rhs
+ unfolding inj_on_def by blast
+next
+ assume h: ?rhs
+ have "f ` S = T"
+ apply (rule card_subset_eq[OF fT ST])
+ unfolding card_image[OF h]
+ apply (rule c)
+ done
+ then show ?lhs by blast
+qed
+
+locale finite_dimensional_vector_space = vector_space +
+ fixes Basis :: "'b set"
+ assumes finite_Basis: "finite Basis"
+ and independent_Basis: "independent Basis"
+ and span_Basis: "span Basis = UNIV"
+begin
+
+definition "dimension = card Basis"
+
+lemma finiteI_independent: "independent B \<Longrightarrow> finite B"
+ using independent_span_bound[OF finite_Basis, of B] by (auto simp: span_Basis)
+
+lemma dim_empty [simp]: "dim {} = 0"
+ by (rule dim_unique[OF order_refl]) (auto simp: dependent_def)
+
+lemma dim_insert:
+ "dim (insert x S) = (if x \<in> span S then dim S else dim S + 1)"
+proof -
+ show ?thesis
+ proof (cases "x \<in> span S")
+ case True then show ?thesis
+ by (metis dim_span span_redundant)
+ next
+ case False
+ obtain B where B: "B \<subseteq> span S" "independent B" "span S \<subseteq> span B" "card B = dim (span S)"
+ using basis_exists [of "span S"] by blast
+ have 1: "insert x B \<subseteq> span (insert x S)"
+ by (meson B(1) insertI1 insert_subset order_trans span_base span_mono subset_insertI)
+ have 2: "span (insert x S) \<subseteq> span (insert x B)"
+ by (metis \<open>B \<subseteq> span S\<close> \<open>span S \<subseteq> span B\<close> span_breakdown_eq span_subspace subsetI subspace_span)
+ have 3: "independent (insert x B)"
+ by (metis B independent_insert span_subspace subspace_span False)
+ have "dim (span (insert x S)) = Suc (dim S)"
+ apply (rule dim_unique [OF 1 2 3])
+ by (metis B False card_insert_disjoint dim_span finiteI_independent span_base span_eq span_span)
+ then show ?thesis
+ by (metis False Suc_eq_plus1 dim_span)
+ qed
+qed
+
+lemma dim_singleton [simp]:
+ "dim{x} = (if x = 0 then 0 else 1)"
+ by (simp add: dim_insert)
+
+proposition choose_subspace_of_subspace:
+ assumes "n \<le> dim S"
+ obtains T where "subspace T" "T \<subseteq> span S" "dim T = n"
+proof -
+ have "\<exists>T. subspace T \<and> T \<subseteq> span S \<and> dim T = n"
+ using assms
+ proof (induction n)
+ case 0 then show ?case by (auto intro!: exI[where x="{0}"] span_zero)
+ next
+ case (Suc n)
+ then obtain T where "subspace T" "T \<subseteq> span S" "dim T = n"
+ by force
+ then show ?case
+ proof (cases "span S \<subseteq> span T")
+ case True
+ have "dim S = dim T"
+ apply (rule span_eq_dim [OF subset_antisym [OF True]])
+ by (simp add: \<open>T \<subseteq> span S\<close> span_minimal subspace_span)
+ then show ?thesis
+ using Suc.prems \<open>dim T = n\<close> by linarith
+ next
+ case False
+ then obtain y where y: "y \<in> S" "y \<notin> T"
+ by (meson span_mono subsetI)
+ then have "span (insert y T) \<subseteq> span S"
+ by (metis (no_types) \<open>T \<subseteq> span S\<close> subsetD insert_subset span_superset span_mono span_span)
+ with \<open>dim T = n\<close> \<open>subspace T\<close> y show ?thesis
+ apply (rule_tac x="span(insert y T)" in exI)
+ apply (auto simp: dim_insert dim_span subspace_span)
+ using span_eq_iff by blast
+ qed
+ qed
+ with that show ?thesis by blast
+qed
+
+lemma basis_subspace_exists:
+ "subspace S
+ \<Longrightarrow> \<exists>b. finite b \<and> b \<subseteq> S \<and>
+ independent b \<and> span b = S \<and> card b = dim S"
+ by (meson basis_exists finiteI_independent span_subspace)
+
+lemma dim_mono: assumes "V \<subseteq> span W" shows "dim V \<le> dim W"
+proof -
+ obtain B where "independent B" "B \<subseteq> W" "W \<subseteq> span B"
+ using maximal_independent_subset[of W] by auto
+ with dim_le_card[of V B] assms independent_span_bound[of Basis B] basis_card_eq_dim[of B W]
+ span_mono[of B W] span_minimal[OF _ subspace_span, of W B]
+ show ?thesis
+ by (auto simp: finite_Basis span_Basis)
+qed
+
+lemma dim_subset: "S \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
+ using dim_mono[of S T] by (auto intro: span_base)
+
+lemma dim_eq_0 [simp]:
+ "dim S = 0 \<longleftrightarrow> S \<subseteq> {0}"
+ using basis_exists finiteI_independent
+ apply safe
+ subgoal by fastforce
+ by (metis dim_singleton dim_subset le_0_eq)
+
+lemma dim_UNIV[simp]: "dim UNIV = card Basis"
+ using dim_eq_card[of Basis UNIV] by (simp add: independent_Basis span_Basis span_UNIV)
+
+lemma independent_card_le_dim: assumes "B \<subseteq> V" and "independent B" shows "card B \<le> dim V"
+ by (subst dim_eq_card[symmetric, OF refl \<open>independent B\<close>]) (rule dim_subset[OF \<open>B \<subseteq> V\<close>])
+
+lemma dim_subset_UNIV: "dim S \<le> dimension"
+ by (metis dim_subset subset_UNIV dim_UNIV dimension_def)
+
+lemma card_ge_dim_independent:
+ assumes BV: "B \<subseteq> V"
+ and iB: "independent B"
+ and dVB: "dim V \<le> card B"
+ shows "V \<subseteq> span B"
+proof
+ fix a
+ assume aV: "a \<in> V"
+ {
+ assume aB: "a \<notin> span B"
+ then have iaB: "independent (insert a B)"
+ using iB aV BV by (simp add: independent_insert)
+ from aV BV have th0: "insert a B \<subseteq> V"
+ by blast
+ from aB have "a \<notin>B"
+ by (auto simp add: span_base)
+ with independent_card_le_dim[OF th0 iaB] dVB finiteI_independent[OF iB]
+ have False by auto
+ }
+ then show "a \<in> span B" by blast
+qed
+
+lemma card_le_dim_spanning:
+ assumes BV: "B \<subseteq> V"
+ and VB: "V \<subseteq> span B"
+ and fB: "finite B"
+ and dVB: "dim V \<ge> card B"
+ shows "independent B"
+proof -
+ {
+ fix a
+ assume a: "a \<in> B" "a \<in> span (B - {a})"
+ from a fB have c0: "card B \<noteq> 0"
+ by auto
+ from a fB have cb: "card (B - {a}) = card B - 1"
+ by auto
+ {
+ fix x
+ assume x: "x \<in> V"
+ from a have eq: "insert a (B - {a}) = B"
+ by blast
+ from x VB have x': "x \<in> span B"
+ by blast
+ from span_trans[OF a(2), unfolded eq, OF x']
+ have "x \<in> span (B - {a})" .
+ }
+ then have th1: "V \<subseteq> span (B - {a})"
+ by blast
+ have th2: "finite (B - {a})"
+ using fB by auto
+ from dim_le_card[OF th1 th2]
+ have c: "dim V \<le> card (B - {a})" .
+ from c c0 dVB cb have False by simp
+ }
+ then show ?thesis
+ unfolding dependent_def by blast
+qed
+
+lemma card_eq_dim: "B \<subseteq> V \<Longrightarrow> card B = dim V \<Longrightarrow> finite B \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
+ by (metis order_eq_iff card_le_dim_spanning card_ge_dim_independent)
+
+lemma subspace_dim_equal:
+ assumes "subspace S"
+ and "subspace T"
+ and "S \<subseteq> T"
+ and "dim S \<ge> dim T"
+ shows "S = T"
+proof -
+ obtain B where B: "B \<le> S" "independent B \<and> S \<subseteq> span B" "card B = dim S"
+ using basis_exists[of S] by auto
+ then have "span B \<subseteq> S"
+ using span_mono[of B S] span_eq_iff[of S] assms by metis
+ then have "span B = S"
+ using B by auto
+ have "dim S = dim T"
+ using assms dim_subset[of S T] by auto
+ then have "T \<subseteq> span B"
+ using card_eq_dim[of B T] B finiteI_independent assms by auto
+ then show ?thesis
+ using assms \<open>span B = S\<close> by auto
+qed
+
+corollary dim_eq_span:
+ shows "\<lbrakk>S \<subseteq> T; dim T \<le> dim S\<rbrakk> \<Longrightarrow> span S = span T"
+ by (simp add: dim_span span_mono subspace_dim_equal subspace_span)
+
+lemma dim_psubset:
+ "span S \<subset> span T \<Longrightarrow> dim S < dim T"
+ by (metis (no_types, hide_lams) dim_span less_le not_le subspace_dim_equal subspace_span)
+
+lemma dim_eq_full:
+ shows "dim S = dimension \<longleftrightarrow> span S = UNIV"
+ by (metis dim_eq_span dim_subset_UNIV span_Basis span_span subset_UNIV
+ dim_UNIV dim_span dimension_def)
+
+lemma indep_card_eq_dim_span:
+ assumes "independent B"
+ shows "finite B \<and> card B = dim (span B)"
+ using dim_span_eq_card_independent[OF assms] finiteI_independent[OF assms] by auto
+
+text \<open>More general size bound lemmas.\<close>
+
+lemma independent_bound_general:
+ "independent S \<Longrightarrow> finite S \<and> card S \<le> dim S"
+ by (simp add: dim_eq_card_independent finiteI_independent)
+
+lemma independent_explicit:
+ shows "independent B \<longleftrightarrow> finite B \<and> (\<forall>c. (\<Sum>v\<in>B. c v *s v) = 0 \<longrightarrow> (\<forall>v \<in> B. c v = 0))"
+ apply (cases "finite B")
+ apply (force simp: dependent_finite)
+ using independent_bound_general
+ apply auto
+ done
+
+proposition dim_sums_Int:
+ assumes "subspace S" "subspace T"
+ shows "dim {x + y |x y. x \<in> S \<and> y \<in> T} + dim(S \<inter> T) = dim S + dim T"
+proof -
+ obtain B where B: "B \<subseteq> S \<inter> T" "S \<inter> T \<subseteq> span B"
+ and indB: "independent B"
+ and cardB: "card B = dim (S \<inter> T)"
+ using basis_exists by blast
+ then obtain C D where "B \<subseteq> C" "C \<subseteq> S" "independent C" "S \<subseteq> span C"
+ and "B \<subseteq> D" "D \<subseteq> T" "independent D" "T \<subseteq> span D"
+ using maximal_independent_subset_extend
+ by (metis Int_subset_iff \<open>B \<subseteq> S \<inter> T\<close> indB)
+ then have "finite B" "finite C" "finite D"
+ by (simp_all add: finiteI_independent indB independent_bound_general)
+ have Beq: "B = C \<inter> D"
+ apply (rule sym)
+ apply (rule spanning_subset_independent)
+ using \<open>B \<subseteq> C\<close> \<open>B \<subseteq> D\<close> apply blast
+ apply (meson \<open>independent C\<close> independent_mono inf.cobounded1)
+ using B \<open>C \<subseteq> S\<close> \<open>D \<subseteq> T\<close> apply auto
+ done
+ then have Deq: "D = B \<union> (D - C)"
+ by blast
+ have CUD: "C \<union> D \<subseteq> {x + y |x y. x \<in> S \<and> y \<in> T}"
+ apply safe
+ apply (metis add.right_neutral subsetCE \<open>C \<subseteq> S\<close> \<open>subspace T\<close> set_eq_subset span_zero span_minimal)
+ apply (metis add.left_neutral subsetCE \<open>D \<subseteq> T\<close> \<open>subspace S\<close> set_eq_subset span_zero span_minimal)
+ done
+ have "a v = 0" if 0: "(\<Sum>v\<in>C. a v *s v) + (\<Sum>v\<in>D - C. a v *s v) = 0"
+ and v: "v \<in> C \<union> (D-C)" for a v
+ proof -
+ have eq: "(\<Sum>v\<in>D - C. a v *s v) = - (\<Sum>v\<in>C. a v *s v)"
+ using that add_eq_0_iff by blast
+ have "(\<Sum>v\<in>D - C. a v *s v) \<in> S"
+ apply (subst eq)
+ apply (rule subspace_neg [OF \<open>subspace S\<close>])
+ apply (rule subspace_sum [OF \<open>subspace S\<close>])
+ by (meson subsetCE subspace_scale \<open>C \<subseteq> S\<close> \<open>subspace S\<close>)
+ moreover have "(\<Sum>v\<in>D - C. a v *s v) \<in> T"
+ apply (rule subspace_sum [OF \<open>subspace T\<close>])
+ by (meson DiffD1 \<open>D \<subseteq> T\<close> \<open>subspace T\<close> subset_eq subspace_def)
+ ultimately have "(\<Sum>v \<in> D-C. a v *s v) \<in> span B"
+ using B by blast
+ then obtain e where e: "(\<Sum>v\<in>B. e v *s v) = (\<Sum>v \<in> D-C. a v *s v)"
+ using span_finite [OF \<open>finite B\<close>] by force
+ have "\<And>c v. \<lbrakk>(\<Sum>v\<in>C. c v *s v) = 0; v \<in> C\<rbrakk> \<Longrightarrow> c v = 0"
+ using \<open>finite C\<close> \<open>independent C\<close> independentD by blast
+ define cc where "cc x = (if x \<in> B then a x + e x else a x)" for x
+ have [simp]: "C \<inter> B = B" "D \<inter> B = B" "C \<inter> - B = C-D" "B \<inter> (D - C) = {}"
+ using \<open>B \<subseteq> C\<close> \<open>B \<subseteq> D\<close> Beq by blast+
+ have f2: "(\<Sum>v\<in>C \<inter> D. e v *s v) = (\<Sum>v\<in>D - C. a v *s v)"
+ using Beq e by presburger
+ have f3: "(\<Sum>v\<in>C \<union> D. a v *s v) = (\<Sum>v\<in>C - D. a v *s v) + (\<Sum>v\<in>D - C. a v *s v) + (\<Sum>v\<in>C \<inter> D. a v *s v)"
+ using \<open>finite C\<close> \<open>finite D\<close> sum.union_diff2 by blast
+ have f4: "(\<Sum>v\<in>C \<union> (D - C). a v *s v) = (\<Sum>v\<in>C. a v *s v) + (\<Sum>v\<in>D - C. a v *s v)"
+ by (meson Diff_disjoint \<open>finite C\<close> \<open>finite D\<close> finite_Diff sum.union_disjoint)
+ have "(\<Sum>v\<in>C. cc v *s v) = 0"
+ using 0 f2 f3 f4
+ apply (simp add: cc_def Beq \<open>finite C\<close> sum.If_cases algebra_simps sum.distrib
+ if_distrib if_distribR)
+ apply (simp add: add.commute add.left_commute diff_eq)
+ done
+ then have "\<And>v. v \<in> C \<Longrightarrow> cc v = 0"
+ using independent_explicit \<open>independent C\<close> \<open>finite C\<close> by blast
+ then have C0: "\<And>v. v \<in> C - B \<Longrightarrow> a v = 0"
+ by (simp add: cc_def Beq) meson
+ then have [simp]: "(\<Sum>x\<in>C - B. a x *s x) = 0"
+ by simp
+ have "(\<Sum>x\<in>C. a x *s x) = (\<Sum>x\<in>B. a x *s x)"
+ proof -
+ have "C - D = C - B"
+ using Beq by blast
+ then show ?thesis
+ using Beq \<open>(\<Sum>x\<in>C - B. a x *s x) = 0\<close> f3 f4 by auto
+ qed
+ with 0 have Dcc0: "(\<Sum>v\<in>D. a v *s v) = 0"
+ apply (subst Deq)
+ by (simp add: \<open>finite B\<close> \<open>finite D\<close> sum_Un)
+ then have D0: "\<And>v. v \<in> D \<Longrightarrow> a v = 0"
+ using independent_explicit \<open>independent D\<close> \<open>finite D\<close> by blast
+ show ?thesis
+ using v C0 D0 Beq by blast
+ qed
+ then have "independent (C \<union> (D - C))"
+ unfolding independent_explicit
+ using independent_explicit
+ by (simp add: independent_explicit \<open>finite C\<close> \<open>finite D\<close> sum_Un del: Un_Diff_cancel)
+ then have indCUD: "independent (C \<union> D)" by simp
+ have "dim (S \<inter> T) = card B"
+ by (rule dim_unique [OF B indB refl])
+ moreover have "dim S = card C"
+ by (metis \<open>C \<subseteq> S\<close> \<open>independent C\<close> \<open>S \<subseteq> span C\<close> basis_card_eq_dim)
+ moreover have "dim T = card D"
+ by (metis \<open>D \<subseteq> T\<close> \<open>independent D\<close> \<open>T \<subseteq> span D\<close> basis_card_eq_dim)
+ moreover have "dim {x + y |x y. x \<in> S \<and> y \<in> T} = card(C \<union> D)"
+ apply (rule dim_unique [OF CUD _ indCUD refl], clarify)
+ apply (meson \<open>S \<subseteq> span C\<close> \<open>T \<subseteq> span D\<close> span_add span_superset span_minimal subsetCE subspace_span sup.bounded_iff)
+ done
+ ultimately show ?thesis
+ using \<open>B = C \<inter> D\<close> [symmetric]
+ by (simp add: \<open>independent C\<close> \<open>independent D\<close> card_Un_Int finiteI_independent)
+qed
+
+lemma dependent_biggerset_general:
+ "(finite S \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
+ using independent_bound_general[of S] by (metis linorder_not_le)
+
+lemma subset_le_dim:
+ "S \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
+ by (metis dim_span dim_subset)
+
+lemma linear_inj_imp_surj:
+ assumes lf: "linear scale scale f"
+ and fi: "inj f"
+ shows "surj f"
+proof -
+ interpret lf: linear scale scale f by fact
+ from basis_exists[of UNIV] obtain B
+ where B: "B \<subseteq> UNIV" "independent B" "UNIV \<subseteq> span B" "card B = dim UNIV"
+ by blast
+ from B(4) have d: "dim UNIV = card B"
+ by simp
+ have th: "UNIV \<subseteq> span (f ` B)"
+ apply (rule card_ge_dim_independent)
+ apply blast
+ using B(2) inj_on_subset[OF fi]
+ apply (rule lf.independent_inj_on_image)
+ apply blast
+ apply (rule order_eq_refl)
+ apply (rule sym)
+ unfolding d
+ apply (rule card_image)
+ apply (rule subset_inj_on[OF fi])
+ apply blast
+ done
+ from th show ?thesis
+ unfolding lf.span_image surj_def
+ using B(3) by blast
+qed
+
+end
+
+locale finite_dimensional_vector_space_pair =
+ vs1: finite_dimensional_vector_space s1 B1 + vs2: finite_dimensional_vector_space s2 B2
+ for s1 :: "'a::field \<Rightarrow> 'b::ab_group_add \<Rightarrow> 'b" (infixr "*a" 75)
+ and B1 :: "'b set"
+ and s2 :: "'a::field \<Rightarrow> 'c::ab_group_add \<Rightarrow> 'c" (infixr "*b" 75)
+ and B2 :: "'c set"
+begin
+
+sublocale vector_space_pair s1 s2 by unfold_locales
+
+lemma linear_surjective_imp_injective:
+ assumes lf: "linear s1 s2 f" and sf: "surj f" and eq: "vs2.dim UNIV = vs1.dim UNIV"
+ shows "inj f"
+proof -
+ interpret linear s1 s2 f by fact
+ have *: "card (f ` B1) \<le> vs2.dim UNIV"
+ using vs1.finite_Basis vs1.dim_eq_card[of B1 UNIV] sf
+ by (auto simp: vs1.span_Basis vs1.span_UNIV vs1.independent_Basis eq
+ simp del: vs2.dim_UNIV
+ intro!: card_image_le)
+ have indep_fB: "vs2.independent (f ` B1)"
+ using vs1.finite_Basis vs1.dim_eq_card[of B1 UNIV] sf *
+ by (intro vs2.card_le_dim_spanning[of "f ` B1" UNIV]) (auto simp: span_image vs1.span_Basis )
+ have "vs2.dim UNIV \<le> card (f ` B1)"
+ unfolding eq sf[symmetric] vs2.dim_span_eq_card_independent[symmetric, OF indep_fB]
+ vs2.dim_span
+ by (intro vs2.dim_mono) (auto simp: span_image vs1.span_Basis)
+ with * have "card (f ` B1) = vs2.dim UNIV" by auto
+ also have "... = card B1"
+ unfolding eq vs1.dim_UNIV ..
+ finally have "inj_on f B1"
+ by (subst inj_on_iff_eq_card[OF vs1.finite_Basis])
+ then show "inj f"
+ using inj_on_span_iff_independent_image[OF indep_fB] vs1.span_Basis by auto
+qed
+
+lemma linear_injective_imp_surjective:
+ assumes lf: "linear s1 s2 f" and sf: "inj f" and eq: "vs2.dim UNIV = vs1.dim UNIV"
+ shows "surj f"
+proof -
+ interpret linear s1 s2 f by fact
+ have *: False if b: "b \<notin> vs2.span (f ` B1)" for b
+ proof -
+ have *: "vs2.independent (f ` B1)"
+ using vs1.independent_Basis by (intro independent_injective_image inj_on_subset[OF sf]) auto
+ have **: "vs2.independent (insert b (f ` B1))"
+ using b * by (rule vs2.independent_insertI)
+
+ have "b \<notin> f ` B1" using vs2.span_base[of b "f ` B1"] b by auto
+ then have "Suc (card B1) = card (insert b (f ` B1))"
+ using sf[THEN inj_on_subset, of B1] by (subst card_insert) (auto intro: vs1.finite_Basis simp: card_image)
+ also have "\<dots> = vs2.dim (insert b (f ` B1))"
+ using vs2.dim_eq_card_independent[OF **] by simp
+ also have "vs2.dim (insert b (f ` B1)) \<le> vs2.dim B2"
+ by (rule vs2.dim_mono) (auto simp: vs2.span_Basis)
+ also have "\<dots> = card B1"
+ using vs1.dim_span[of B1] vs2.dim_span[of B2] unfolding vs1.span_Basis vs2.span_Basis eq
+ vs1.dim_eq_card_independent[OF vs1.independent_Basis] by simp
+ finally show False by simp
+ qed
+ have "f ` UNIV = f ` vs1.span B1" unfolding vs1.span_Basis ..
+ also have "\<dots> = vs2.span (f ` B1)" unfolding span_image ..
+ also have "\<dots> = UNIV" using * by blast
+ finally show ?thesis .
+qed
+
+lemma linear_injective_isomorphism:
+ assumes lf: "linear s1 s2 f"
+ and fi: "inj f"
+ and dims: "vs2.dim UNIV = vs1.dim UNIV"
+ shows "\<exists>f'. linear s2 s1 f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
+proof -
+ show ?thesis
+ unfolding isomorphism_expand[symmetric]
+ using linear_exists_right_inverse_on[OF lf vs1.subspace_UNIV]
+ linear_exists_left_inverse_on[OF lf vs1.subspace_UNIV fi]
+ apply (auto simp: module_hom_iff_linear)
+ subgoal for f' f''
+ apply (rule exI[where x=f''])
+ using linear_injective_imp_surjective[OF lf fi dims]
+ apply auto
+ by (metis comp_apply eq_id_iff surj_def)
+ done
+qed
+
+lemma linear_surjective_isomorphism:
+ assumes lf: "linear s1 s2 f"
+ and sf: "surj f"
+ and dims: "vs2.dim UNIV = vs1.dim UNIV"
+ shows "\<exists>f'. linear s2 s1 f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
+proof -
+ show ?thesis
+ unfolding isomorphism_expand[symmetric]
+ using linear_exists_right_inverse_on[OF lf vs1.subspace_UNIV]
+ linear_exists_left_inverse_on[OF lf vs1.subspace_UNIV]
+ using linear_surjective_imp_injective[OF lf sf dims] sf
+ apply (auto simp: module_hom_iff_linear)
+ subgoal for f' f''
+ apply (rule exI[where x=f''])
+ apply auto
+ by (metis isomorphism_expand)
+ done
+qed
+
+lemma dim_image_eq:
+ assumes lf: "linear s1 s2 f"
+ and fi: "inj_on f (vs1.span S)"
+ shows "vs2.dim (f ` S) = vs1.dim S"
+proof -
+ interpret lf: linear by fact
+ obtain B where B: "B \<subseteq> S" "vs1.independent B" "S \<subseteq> vs1.span B" "card B = vs1.dim S"
+ using vs1.basis_exists[of S] by auto
+ then have "vs1.span S = vs1.span B"
+ using vs1.span_mono[of B S] vs1.span_mono[of S "vs1.span B"] vs1.span_span[of B] by auto
+ moreover have "card (f ` B) = card B"
+ using assms card_image[of f B] subset_inj_on[of f "vs1.span S" B] B vs1.span_superset by auto
+ moreover have "(f ` B) \<subseteq> (f ` S)"
+ using B by auto
+ ultimately show ?thesis
+ by (metis B(2) B(4) fi lf.dependent_inj_imageD lf.span_image vs2.dim_eq_card_independent vs2.dim_span)
+qed
+
+lemma basis_to_basis_subspace_isomorphism:
+ assumes s: "vs1.subspace S"
+ and t: "vs2.subspace T"
+ and d: "vs1.dim S = vs2.dim T"
+ and B: "B \<subseteq> S" "vs1.independent B" "S \<subseteq> vs1.span B" "card B = vs1.dim S"
+ and C: "C \<subseteq> T" "vs2.independent C" "T \<subseteq> vs2.span C" "card C = vs2.dim T"
+ shows "\<exists>f. linear s1 s2 f \<and> f ` B = C \<and> f ` S = T \<and> inj_on f S"
+proof -
+ from B have fB: "finite B"
+ by (simp add: vs1.finiteI_independent)
+ from C have fC: "finite C"
+ by (simp add: vs2.finiteI_independent)
+ from B(4) C(4) card_le_inj[of B C] d obtain f where
+ f: "f ` B \<subseteq> C" "inj_on f B" using \<open>finite B\<close> \<open>finite C\<close> by auto
+ from linear_independent_extend[OF B(2)] obtain g where
+ g: "linear s1 s2 g" "\<forall>x \<in> B. g x = f x" by blast
+ interpret g: linear s1 s2 g by fact
+ from inj_on_iff_eq_card[OF fB, of f] f(2)
+ have "card (f ` B) = card B" by simp
+ with B(4) C(4) have ceq: "card (f ` B) = card C" using d
+ by simp
+ have "g ` B = f ` B" using g(2)
+ by (auto simp add: image_iff)
+ also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
+ finally have gBC: "g ` B = C" .
+ have gi: "inj_on g B" using f(2) g(2)
+ by (auto simp add: inj_on_def)
+ note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
+ {
+ fix x y
+ assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
+ from B(3) x y have x': "x \<in> vs1.span B" and y': "y \<in> vs1.span B"
+ by blast+
+ from gxy have th0: "g (x - y) = 0"
+ by (simp add: g.diff)
+ have th1: "x - y \<in> vs1.span B" using x' y'
+ by (metis vs1.span_diff)
+ have "x = y" using g0[OF th1 th0] by simp
+ }
+ then have giS: "inj_on g S" unfolding inj_on_def by blast
+ from vs1.span_subspace[OF B(1,3) s]
+ have "g ` S = vs2.span (g ` B)"
+ by (simp add: g.span_image)
+ also have "\<dots> = vs2.span C"
+ unfolding gBC ..
+ also have "\<dots> = T"
+ using vs2.span_subspace[OF C(1,3) t] .
+ finally have gS: "g ` S = T" .
+ from g(1) gS giS gBC show ?thesis
+ by blast
+qed
+
+lemma dim_image_le:
+ assumes lf: "linear s1 s2 f"
+ shows "vs2.dim (f ` S) \<le> vs1.dim (S)"
+proof -
+ from vs1.basis_exists[of S] obtain B where
+ B: "B \<subseteq> S" "vs1.independent B" "S \<subseteq> vs1.span B" "card B = vs1.dim S" by blast
+ from B have fB: "finite B" "card B = vs1.dim S"
+ using vs1.independent_bound_general by blast+
+ have "vs2.dim (f ` S) \<le> card (f ` B)"
+ apply (rule vs2.span_card_ge_dim)
+ using lf B fB
+ apply (auto simp add: module_hom.span_image module_hom.spans_image subset_image_iff
+ linear_iff_module_hom)
+ done
+ also have "\<dots> \<le> vs1.dim S"
+ using card_image_le[OF fB(1)] fB by simp
+ finally show ?thesis .
+qed
+
+end
+
+context finite_dimensional_vector_space begin
+
+lemma linear_surj_imp_inj:
+ assumes lf: "linear scale scale f"
+ and sf: "surj f"
+ shows "inj f"
+proof -
+ interpret finite_dimensional_vector_space_pair scale Basis scale Basis by unfold_locales
+ let ?U = "UNIV :: 'b set"
+ from basis_exists[of ?U] obtain B
+ where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" and d: "card B = dim ?U"
+ by blast
+ {
+ fix x
+ assume x: "x \<in> span B"
+ assume fx: "f x = 0"
+ from B(2) have fB: "finite B"
+ using finiteI_independent by auto
+ have fBi: "independent (f ` B)"
+ apply (rule card_le_dim_spanning[of "f ` B" ?U])
+ apply blast
+ using sf B(3)
+ unfolding linear_span_image[OF lf] surj_def subset_eq image_iff
+ apply blast
+ using fB apply blast
+ unfolding d[symmetric]
+ apply (rule card_image_le)
+ apply (rule fB)
+ done
+ have th0: "dim ?U \<le> card (f ` B)"
+ apply (rule span_card_ge_dim)
+ apply blast
+ unfolding linear_span_image[OF lf]
+ apply (rule subset_trans[where B = "f ` UNIV"])
+ using sf unfolding surj_def
+ apply blast
+ apply (rule image_mono)
+ apply (rule B(3))
+ apply (metis finite_imageI fB)
+ done
+ moreover have "card (f ` B) \<le> card B"
+ by (rule card_image_le, rule fB)
+ ultimately have th1: "card B = card (f ` B)"
+ unfolding d by arith
+ have fiB: "inj_on f B"
+ unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric]
+ by blast
+ from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
+ have "x = 0" by blast
+ }
+ then show ?thesis
+ unfolding linear_inj_on_iff_eq_0[OF lf subspace_UNIV]
+ using B(3)
+ by blast
+qed
+
+lemma linear_inverse_left:
+ assumes lf: "linear scale scale f"
+ and lf': "linear scale scale f'"
+ shows "f \<circ> f' = id \<longleftrightarrow> f' \<circ> f = id"
+proof -
+ {
+ fix f f':: "'b \<Rightarrow> 'b"
+ assume lf: "linear scale scale f" "linear scale scale f'"
+ assume f: "f \<circ> f' = id"
+ from f have sf: "surj f"
+ apply (auto simp add: o_def id_def surj_def)
+ apply metis
+ done
+ interpret finite_dimensional_vector_space_pair scale Basis scale Basis by unfold_locales
+ from linear_surjective_isomorphism[OF lf(1) sf] lf f
+ have "f' \<circ> f = id"
+ unfolding fun_eq_iff o_def id_def by metis
+ }
+ then show ?thesis
+ using lf lf' by metis
+qed
+
+lemma left_inverse_linear:
+ assumes lf: "linear scale scale f"
+ and gf: "g \<circ> f = id"
+ shows "linear scale scale g"
+proof -
+ from gf have fi: "inj f"
+ apply (auto simp add: inj_on_def o_def id_def fun_eq_iff)
+ apply metis
+ done
+ interpret finite_dimensional_vector_space_pair scale Basis scale Basis by unfold_locales
+ from linear_injective_isomorphism[OF lf fi]
+ obtain h :: "'b \<Rightarrow> 'b" where h: "linear scale scale h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
+ by blast
+ have "h = g"
+ apply (rule ext) using gf h(2,3)
+ apply (simp add: o_def id_def fun_eq_iff)
+ apply metis
+ done
+ with h(1) show ?thesis by blast
+qed
+
+lemma inj_linear_imp_inv_linear:
+ assumes "linear scale scale f" "inj f" shows "linear scale scale (inv f)"
+ using assms inj_iff left_inverse_linear by blast
+
+lemma right_inverse_linear:
+ assumes lf: "linear scale scale f"
+ and gf: "f \<circ> g = id"
+ shows "linear scale scale g"
+proof -
+ from gf have fi: "surj f"
+ by (auto simp add: surj_def o_def id_def) metis
+ interpret finite_dimensional_vector_space_pair scale Basis scale Basis by unfold_locales
+ from linear_surjective_isomorphism[OF lf fi]
+ obtain h:: "'b \<Rightarrow> 'b" where h: "linear scale scale h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x"
+ by blast
+ have "h = g"
+ apply (rule ext)
+ using gf h(2,3)
+ apply (simp add: o_def id_def fun_eq_iff)
+ apply metis
+ done
+ with h(1) show ?thesis by blast
+qed
+
+end
+
+context finite_dimensional_vector_space_pair begin
+
+lemma subspace_isomorphism:
+ assumes s: "vs1.subspace S"
+ and t: "vs2.subspace T"
+ and d: "vs1.dim S = vs2.dim T"
+ shows "\<exists>f. linear s1 s2 f \<and> f ` S = T \<and> inj_on f S"
+proof -
+ from vs1.basis_exists[of S] vs1.finiteI_independent
+ obtain B where B: "B \<subseteq> S" "vs1.independent B" "S \<subseteq> vs1.span B" "card B = vs1.dim S" and fB: "finite B"
+ by blast
+ from vs2.basis_exists[of T] vs2.finiteI_independent
+ obtain C where C: "C \<subseteq> T" "vs2.independent C" "T \<subseteq> vs2.span C" "card C = vs2.dim T" and fC: "finite C"
+ by blast
+ from B(4) C(4) card_le_inj[of B C] d
+ obtain f where f: "f ` B \<subseteq> C" "inj_on f B" using \<open>finite B\<close> \<open>finite C\<close>
+ by auto
+ from linear_independent_extend[OF B(2)]
+ obtain g where g: "linear s1 s2 g" "\<forall>x\<in> B. g x = f x"
+ by blast
+ interpret g: linear s1 s2 g by fact
+ from inj_on_iff_eq_card[OF fB, of f] f(2) have "card (f ` B) = card B"
+ by simp
+ with B(4) C(4) have ceq: "card (f ` B) = card C"
+ using d by simp
+ have "g ` B = f ` B"
+ using g(2) by (auto simp add: image_iff)
+ also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
+ finally have gBC: "g ` B = C" .
+ have gi: "inj_on g B"
+ using f(2) g(2) by (auto simp add: inj_on_def)
+ note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
+ {
+ fix x y
+ assume x: "x \<in> S" and y: "y \<in> S" and gxy: "g x = g y"
+ from B(3) x y have x': "x \<in> vs1.span B" and y': "y \<in> vs1.span B"
+ by blast+
+ from gxy have th0: "g (x - y) = 0"
+ by (simp add: linear_diff g)
+ have th1: "x - y \<in> vs1.span B"
+ using x' y' by (metis vs1.span_diff)
+ have "x = y"
+ using g0[OF th1 th0] by simp
+ }
+ then have giS: "inj_on g S"
+ unfolding inj_on_def by blast
+ from vs1.span_subspace[OF B(1,3) s] have "g ` S = vs2.span (g ` B)"
+ by (simp add: module_hom.span_image[OF g(1)[unfolded linear_iff_module_hom]])
+ also have "\<dots> = vs2.span C" unfolding gBC ..
+ also have "\<dots> = T" using vs2.span_subspace[OF C(1,3) t] .
+ finally have gS: "g ` S = T" .
+ from g(1) gS giS show ?thesis
+ by blast
+qed
+
+end
+
+hide_const (open) linear
+
+end
\ No newline at end of file
--- a/src/HOL/ex/Ballot.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/ex/Ballot.thy Wed May 02 13:49:38 2018 +0200
@@ -8,7 +8,6 @@
theory Ballot
imports
Complex_Main
- "HOL-Library.FuncSet"
begin
subsection \<open>Preliminaries\<close>
--- a/src/HOL/ex/Birthday_Paradox.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/ex/Birthday_Paradox.thy Wed May 02 13:49:38 2018 +0200
@@ -5,7 +5,7 @@
section \<open>A Formulation of the Birthday Paradox\<close>
theory Birthday_Paradox
-imports Main "HOL-Library.FuncSet"
+imports Main HOL.FuncSet
begin
section \<open>Cardinality\<close>
--- a/src/HOL/ex/Tarski.thy Wed Apr 18 21:12:50 2018 +0100
+++ b/src/HOL/ex/Tarski.thy Wed May 02 13:49:38 2018 +0200
@@ -5,7 +5,7 @@
section \<open>The Full Theorem of Tarski\<close>
theory Tarski
-imports Main "HOL-Library.FuncSet"
+imports Main HOL.FuncSet
begin
text \<open>