1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/src/HOL/Library/Determinants.thy Mon Feb 09 17:21:19 2009 +0000
1.3 @@ -0,0 +1,1151 @@
1.4 +(* Title: Determinants
1.5 + ID: $Id:
1.6 + Author: Amine Chaieb, University of Cambridge
1.7 +*)
1.8 +
1.9 +header {* Traces, Determinant of square matrices and some properties *}
1.10 +
1.11 +theory Determinants
1.12 + imports Euclidean_Space Permutations
1.13 +begin
1.14 +
1.15 +subsection{* First some facts about products*}
1.16 +lemma setprod_insert_eq: "finite A \<Longrightarrow> setprod f (insert a A) = (if a \<in> A then setprod f A else f a * setprod f A)"
1.17 +apply clarsimp
1.18 +by(subgoal_tac "insert a A = A", auto)
1.19 +
1.20 +lemma setprod_add_split:
1.21 + assumes mn: "(m::nat) <= n + 1"
1.22 + shows "setprod f {m.. n+p} = setprod f {m .. n} * setprod f {n+1..n+p}"
1.23 +proof-
1.24 + let ?A = "{m .. n+p}"
1.25 + let ?B = "{m .. n}"
1.26 + let ?C = "{n+1..n+p}"
1.27 + from mn have un: "?B \<union> ?C = ?A" by auto
1.28 + from mn have dj: "?B \<inter> ?C = {}" by auto
1.29 + have f: "finite ?B" "finite ?C" by simp_all
1.30 + from setprod_Un_disjoint[OF f dj, of f, unfolded un] show ?thesis .
1.31 +qed
1.32 +
1.33 +
1.34 +lemma setprod_offset: "setprod f {(m::nat) + p .. n + p} = setprod (\<lambda>i. f (i + p)) {m..n}"
1.35 +apply (rule setprod_reindex_cong[where f="op + p"])
1.36 +apply (auto simp add: image_iff Bex_def inj_on_def)
1.37 +apply arith
1.38 +apply (rule ext)
1.39 +apply (simp add: add_commute)
1.40 +done
1.41 +
1.42 +lemma setprod_singleton: "setprod f {x} = f x" by simp
1.43 +
1.44 +lemma setprod_singleton_nat_seg: "setprod f {n..n} = f (n::'a::order)" by simp
1.45 +
1.46 +lemma setprod_numseg: "setprod f {m..0} = (if m=0 then f 0 else 1)"
1.47 + "setprod f {m .. Suc n} = (if m \<le> Suc n then f (Suc n) * setprod f {m..n}
1.48 + else setprod f {m..n})"
1.49 + by (auto simp add: atLeastAtMostSuc_conv)
1.50 +
1.51 +lemma setprod_le: assumes fS: "finite S" and fg: "\<forall>x\<in>S. f x \<ge> 0 \<and> f x \<le> (g x :: 'a::ordered_idom)"
1.52 + shows "setprod f S \<le> setprod g S"
1.53 +using fS fg
1.54 +apply(induct S)
1.55 +apply simp
1.56 +apply auto
1.57 +apply (rule mult_mono)
1.58 +apply (auto intro: setprod_nonneg)
1.59 +done
1.60 +
1.61 + (* FIXME: In Finite_Set there is a useless further assumption *)
1.62 +lemma setprod_inversef: "finite A ==> setprod (inverse \<circ> f) A = (inverse (setprod f A) :: 'a:: {division_by_zero, field})"
1.63 + apply (erule finite_induct)
1.64 + apply (simp)
1.65 + apply simp
1.66 + done
1.67 +
1.68 +lemma setprod_le_1: assumes fS: "finite S" and f: "\<forall>x\<in>S. f x \<ge> 0 \<and> f x \<le> (1::'a::ordered_idom)"
1.69 + shows "setprod f S \<le> 1"
1.70 +using setprod_le[OF fS f] unfolding setprod_1 .
1.71 +
1.72 +subsection{* Trace *}
1.73 +
1.74 +definition trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a" where
1.75 + "trace A = setsum (\<lambda>i. ((A$i)$i)) {1..dimindex(UNIV::'n set)}"
1.76 +
1.77 +lemma trace_0: "trace(mat 0) = 0"
1.78 + by (simp add: trace_def mat_def Cart_lambda_beta setsum_0)
1.79 +
1.80 +lemma trace_I: "trace(mat 1 :: 'a::semiring_1^'n^'n) = of_nat(dimindex(UNIV::'n set))"
1.81 + by (simp add: trace_def mat_def Cart_lambda_beta)
1.82 +
1.83 +lemma trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
1.84 + by (simp add: trace_def setsum_addf Cart_lambda_beta vector_component)
1.85 +
1.86 +lemma trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
1.87 + by (simp add: trace_def setsum_subtractf Cart_lambda_beta vector_component)
1.88 +
1.89 +lemma trace_mul_sym:"trace ((A::'a::comm_semiring_1^'n^'n) ** B) = trace (B**A)"
1.90 + apply (simp add: trace_def matrix_matrix_mult_def Cart_lambda_beta)
1.91 + apply (subst setsum_commute)
1.92 + by (simp add: mult_commute)
1.93 +
1.94 +(* ------------------------------------------------------------------------- *)
1.95 +(* Definition of determinant. *)
1.96 +(* ------------------------------------------------------------------------- *)
1.97 +
1.98 +definition det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
1.99 + "det A = setsum (\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) {1 .. dimindex(UNIV :: 'n set)}) {p. p permutes {1 .. dimindex(UNIV :: 'n set)}}"
1.100 +
1.101 +(* ------------------------------------------------------------------------- *)
1.102 +(* A few general lemmas we need below. *)
1.103 +(* ------------------------------------------------------------------------- *)
1.104 +
1.105 +lemma Cart_lambda_beta_perm: assumes p: "p permutes {1..dimindex(UNIV::'n set)}"
1.106 + and i: "i \<in> {1..dimindex(UNIV::'n set)}"
1.107 + shows "Cart_nth (Cart_lambda g ::'a^'n) (p i) = g(p i)"
1.108 + using permutes_in_image[OF p] i
1.109 + by (simp add: Cart_lambda_beta permutes_in_image[OF p])
1.110 +
1.111 +lemma setprod_permute:
1.112 + assumes p: "p permutes S"
1.113 + shows "setprod f S = setprod (f o p) S"
1.114 +proof-
1.115 + {assume "\<not> finite S" hence ?thesis by simp}
1.116 + moreover
1.117 + {assume fS: "finite S"
1.118 + then have ?thesis
1.119 + apply (simp add: setprod_def)
1.120 + apply (rule ab_semigroup_mult.fold_image_permute)
1.121 + apply (auto simp add: p)
1.122 + apply unfold_locales
1.123 + done}
1.124 + ultimately show ?thesis by blast
1.125 +qed
1.126 +
1.127 +lemma setproduct_permute_nat_interval: "p permutes {m::nat .. n} ==> setprod f {m..n} = setprod (f o p) {m..n}"
1.128 + by (auto intro: setprod_permute)
1.129 +
1.130 +(* ------------------------------------------------------------------------- *)
1.131 +(* Basic determinant properties. *)
1.132 +(* ------------------------------------------------------------------------- *)
1.133 +
1.134 +lemma det_transp: "det (transp A) = det (A::'a::comm_ring_1 ^'n^'n)"
1.135 +proof-
1.136 + let ?di = "\<lambda>A i j. A$i$j"
1.137 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.138 + have fU: "finite ?U" by blast
1.139 + {fix p assume p: "p \<in> {p. p permutes ?U}"
1.140 + from p have pU: "p permutes ?U" by blast
1.141 + have sth: "sign (inv p) = sign p"
1.142 + by (metis sign_inverse fU p mem_def Collect_def permutation_permutes)
1.143 + from permutes_inj[OF pU]
1.144 + have pi: "inj_on p ?U" by (blast intro: subset_inj_on)
1.145 + from permutes_image[OF pU]
1.146 + have "setprod (\<lambda>i. ?di (transp A) i (inv p i)) ?U = setprod (\<lambda>i. ?di (transp A) i (inv p i)) (p ` ?U)" by simp
1.147 + also have "\<dots> = setprod ((\<lambda>i. ?di (transp A) i (inv p i)) o p) ?U"
1.148 + unfolding setprod_reindex[OF pi] ..
1.149 + also have "\<dots> = setprod (\<lambda>i. ?di A i (p i)) ?U"
1.150 + proof-
1.151 + {fix i assume i: "i \<in> ?U"
1.152 + from i permutes_inv_o[OF pU] permutes_in_image[OF pU]
1.153 + have "((\<lambda>i. ?di (transp A) i (inv p i)) o p) i = ?di A i (p i)"
1.154 + unfolding transp_def by (simp add: Cart_lambda_beta expand_fun_eq)}
1.155 + then show "setprod ((\<lambda>i. ?di (transp A) i (inv p i)) o p) ?U = setprod (\<lambda>i. ?di A i (p i)) ?U" by (auto intro: setprod_cong)
1.156 + qed
1.157 + finally have "of_int (sign (inv p)) * (setprod (\<lambda>i. ?di (transp A) i (inv p i)) ?U) = of_int (sign p) * (setprod (\<lambda>i. ?di A i (p i)) ?U)" using sth
1.158 + by simp}
1.159 + then show ?thesis unfolding det_def apply (subst setsum_permutations_inverse)
1.160 + apply (rule setsum_cong2) by blast
1.161 +qed
1.162 +
1.163 +lemma det_lowerdiagonal:
1.164 + fixes A :: "'a::comm_ring_1^'n^'n"
1.165 + assumes ld: "\<And>i j. i \<in> {1 .. dimindex (UNIV:: 'n set)} \<Longrightarrow> j \<in> {1 .. dimindex(UNIV:: 'n set)} \<Longrightarrow> i < j \<Longrightarrow> A$i$j = 0"
1.166 + shows "det A = setprod (\<lambda>i. A$i$i) {1..dimindex(UNIV:: 'n set)}"
1.167 +proof-
1.168 + let ?U = "{1..dimindex(UNIV:: 'n set)}"
1.169 + let ?PU = "{p. p permutes ?U}"
1.170 + let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) {1 .. dimindex(UNIV :: 'n set)}"
1.171 + have fU: "finite ?U" by blast
1.172 + from finite_permutations[OF fU] have fPU: "finite ?PU" .
1.173 + have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
1.174 + {fix p assume p: "p \<in> ?PU -{id}"
1.175 + from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
1.176 + from permutes_natset_le[OF pU] pid obtain i where
1.177 + i: "i \<in> ?U" "p i > i" by (metis not_le)
1.178 + from permutes_in_image[OF pU] i(1) have piU: "p i \<in> ?U" by blast
1.179 + from ld[OF i(1) piU i(2)] i(1) have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
1.180 + from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
1.181 + then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
1.182 + from setsum_superset[OF fPU id0 p0] show ?thesis
1.183 + unfolding det_def by (simp add: sign_id)
1.184 +qed
1.185 +
1.186 +lemma det_upperdiagonal:
1.187 + fixes A :: "'a::comm_ring_1^'n^'n"
1.188 + assumes ld: "\<And>i j. i \<in> {1 .. dimindex (UNIV:: 'n set)} \<Longrightarrow> j \<in> {1 .. dimindex(UNIV:: 'n set)} \<Longrightarrow> i > j \<Longrightarrow> A$i$j = 0"
1.189 + shows "det A = setprod (\<lambda>i. A$i$i) {1..dimindex(UNIV:: 'n set)}"
1.190 +proof-
1.191 + let ?U = "{1..dimindex(UNIV:: 'n set)}"
1.192 + let ?PU = "{p. p permutes ?U}"
1.193 + let ?pp = "(\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) {1 .. dimindex(UNIV :: 'n set)})"
1.194 + have fU: "finite ?U" by blast
1.195 + from finite_permutations[OF fU] have fPU: "finite ?PU" .
1.196 + have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
1.197 + {fix p assume p: "p \<in> ?PU -{id}"
1.198 + from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
1.199 + from permutes_natset_ge[OF pU] pid obtain i where
1.200 + i: "i \<in> ?U" "p i < i" by (metis not_le)
1.201 + from permutes_in_image[OF pU] i(1) have piU: "p i \<in> ?U" by blast
1.202 + from ld[OF i(1) piU i(2)] i(1) have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
1.203 + from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
1.204 + then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
1.205 + from setsum_superset[OF fPU id0 p0] show ?thesis
1.206 + unfolding det_def by (simp add: sign_id)
1.207 +qed
1.208 +
1.209 +lemma det_I: "det (mat 1 :: 'a::comm_ring_1^'n^'n) = 1"
1.210 +proof-
1.211 + let ?A = "mat 1 :: 'a::comm_ring_1^'n^'n"
1.212 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.213 + let ?f = "\<lambda>i j. ?A$i$j"
1.214 + {fix i assume i: "i \<in> ?U"
1.215 + have "?f i i = 1" using i by (vector mat_def)}
1.216 + hence th: "setprod (\<lambda>i. ?f i i) ?U = setprod (\<lambda>x. 1) ?U"
1.217 + by (auto intro: setprod_cong)
1.218 + {fix i j assume i: "i \<in> ?U" and j: "j \<in> ?U" and ij: "i < j"
1.219 + have "?f i j = 0" using i j ij by (vector mat_def) }
1.220 + then have "det ?A = setprod (\<lambda>i. ?f i i) ?U" using det_lowerdiagonal
1.221 + by blast
1.222 + also have "\<dots> = 1" unfolding th setprod_1 ..
1.223 + finally show ?thesis .
1.224 +qed
1.225 +
1.226 +lemma det_0: "det (mat 0 :: 'a::comm_ring_1^'n^'n) = 0"
1.227 +proof-
1.228 + let ?A = "mat 0 :: 'a::comm_ring_1^'n^'n"
1.229 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.230 + let ?f = "\<lambda>i j. ?A$i$j"
1.231 + have th:"setprod (\<lambda>i. ?f i i) ?U = 0"
1.232 + apply (rule setprod_zero)
1.233 + apply simp
1.234 + apply (rule bexI[where x=1])
1.235 + using dimindex_ge_1[of "UNIV :: 'n set"]
1.236 + by (simp_all add: mat_def Cart_lambda_beta)
1.237 + {fix i j assume i: "i \<in> ?U" and j: "j \<in> ?U" and ij: "i < j"
1.238 + have "?f i j = 0" using i j ij by (vector mat_def) }
1.239 + then have "det ?A = setprod (\<lambda>i. ?f i i) ?U" using det_lowerdiagonal
1.240 + by blast
1.241 + also have "\<dots> = 0" unfolding th ..
1.242 + finally show ?thesis .
1.243 +qed
1.244 +
1.245 +lemma det_permute_rows:
1.246 + fixes A :: "'a::comm_ring_1^'n^'n"
1.247 + assumes p: "p permutes {1 .. dimindex (UNIV :: 'n set)}"
1.248 + shows "det(\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
1.249 + apply (simp add: det_def setsum_right_distrib mult_assoc[symmetric] del: One_nat_def)
1.250 + apply (subst sum_permutations_compose_right[OF p])
1.251 +proof(rule setsum_cong2)
1.252 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.253 + let ?PU = "{p. p permutes ?U}"
1.254 + let ?Ap = "(\<chi> i. A$p i :: 'a^'n^'n)"
1.255 + fix q assume qPU: "q \<in> ?PU"
1.256 + have fU: "finite ?U" by blast
1.257 + from qPU have q: "q permutes ?U" by blast
1.258 + from p q have pp: "permutation p" and qp: "permutation q"
1.259 + by (metis fU permutation_permutes)+
1.260 + from permutes_inv[OF p] have ip: "inv p permutes ?U" .
1.261 + {fix i assume i: "i \<in> ?U"
1.262 + from Cart_lambda_beta[rule_format, OF i, of "\<lambda>i. A$ p i"]
1.263 + have "?Ap$i$ (q o p) i = A $ p i $ (q o p) i " by simp}
1.264 + hence "setprod (\<lambda>i. ?Ap$i$ (q o p) i) ?U = setprod (\<lambda>i. A$p i$(q o p) i) ?U"
1.265 + by (auto intro: setprod_cong)
1.266 + also have "\<dots> = setprod ((\<lambda>i. A$p i$(q o p) i) o inv p) ?U"
1.267 + by (simp only: setprod_permute[OF ip, symmetric])
1.268 + also have "\<dots> = setprod (\<lambda>i. A $ (p o inv p) i $ (q o (p o inv p)) i) ?U"
1.269 + by (simp only: o_def)
1.270 + also have "\<dots> = setprod (\<lambda>i. A$i$q i) ?U" by (simp only: o_def permutes_inverses[OF p])
1.271 + finally have thp: "setprod (\<lambda>i. ?Ap$i$ (q o p) i) ?U = setprod (\<lambda>i. A$i$q i) ?U"
1.272 + by blast
1.273 + show "of_int (sign (q o p)) * setprod (\<lambda>i. ?Ap$i$ (q o p) i) ?U = of_int (sign p) * of_int (sign q) * setprod (\<lambda>i. A$i$q i) ?U"
1.274 + by (simp only: thp sign_compose[OF qp pp] mult_commute of_int_mult)
1.275 +qed
1.276 +
1.277 +lemma det_permute_columns:
1.278 + fixes A :: "'a::comm_ring_1^'n^'n"
1.279 + assumes p: "p permutes {1 .. dimindex (UNIV :: 'n set)}"
1.280 + shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
1.281 +proof-
1.282 + let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
1.283 + let ?At = "transp A"
1.284 + have "of_int (sign p) * det A = det (transp (\<chi> i. transp A $ p i))"
1.285 + unfolding det_permute_rows[OF p, of ?At] det_transp ..
1.286 + moreover
1.287 + have "?Ap = transp (\<chi> i. transp A $ p i)"
1.288 + by (simp add: transp_def Cart_eq Cart_lambda_beta Cart_lambda_beta_perm[OF p])
1.289 + ultimately show ?thesis by simp
1.290 +qed
1.291 +
1.292 +lemma det_identical_rows:
1.293 + fixes A :: "'a::ordered_idom^'n^'n"
1.294 + assumes i: "i\<in>{1 .. dimindex (UNIV :: 'n set)}"
1.295 + and j: "j\<in>{1 .. dimindex (UNIV :: 'n set)}"
1.296 + and ij: "i \<noteq> j"
1.297 + and r: "row i A = row j A"
1.298 + shows "det A = 0"
1.299 +proof-
1.300 + have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
1.301 + by simp
1.302 + have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
1.303 + let ?p = "Fun.swap i j id"
1.304 + let ?A = "\<chi> i. A $ ?p i"
1.305 + from r have "A = ?A" by (simp add: Cart_eq Cart_lambda_beta Cart_lambda_beta_perm[OF permutes_swap_id[OF i j]] row_def swap_def)
1.306 + hence "det A = det ?A" by simp
1.307 + moreover have "det A = - det ?A"
1.308 + by (simp add: det_permute_rows[OF permutes_swap_id[OF i j]] sign_swap_id ij th1)
1.309 + ultimately show "det A = 0" by (metis tha)
1.310 +qed
1.311 +
1.312 +lemma det_identical_columns:
1.313 + fixes A :: "'a::ordered_idom^'n^'n"
1.314 + assumes i: "i\<in>{1 .. dimindex (UNIV :: 'n set)}"
1.315 + and j: "j\<in>{1 .. dimindex (UNIV :: 'n set)}"
1.316 + and ij: "i \<noteq> j"
1.317 + and r: "column i A = column j A"
1.318 + shows "det A = 0"
1.319 +apply (subst det_transp[symmetric])
1.320 +apply (rule det_identical_rows[OF i j ij])
1.321 +by (metis row_transp i j r)
1.322 +
1.323 +lemma det_zero_row:
1.324 + fixes A :: "'a::{idom, ring_char_0}^'n^'n"
1.325 + assumes i: "i\<in>{1 .. dimindex (UNIV :: 'n set)}"
1.326 + and r: "row i A = 0"
1.327 + shows "det A = 0"
1.328 +using i r
1.329 +apply (simp add: row_def det_def Cart_lambda_beta Cart_eq vector_component del: One_nat_def)
1.330 +apply (rule setsum_0')
1.331 +apply (clarsimp simp add: sign_nz simp del: One_nat_def)
1.332 +apply (rule setprod_zero)
1.333 +apply simp
1.334 +apply (rule bexI[where x=i])
1.335 +apply (erule_tac x="a i" in ballE)
1.336 +apply (subgoal_tac "(0\<Colon>'a ^ 'n) $ a i = 0")
1.337 +apply simp
1.338 +apply (rule zero_index)
1.339 +apply (drule permutes_in_image[of _ _ i])
1.340 +apply simp
1.341 +apply (drule permutes_in_image[of _ _ i])
1.342 +apply simp
1.343 +apply simp
1.344 +done
1.345 +
1.346 +lemma det_zero_column:
1.347 + fixes A :: "'a::{idom,ring_char_0}^'n^'n"
1.348 + assumes i: "i\<in>{1 .. dimindex (UNIV :: 'n set)}"
1.349 + and r: "column i A = 0"
1.350 + shows "det A = 0"
1.351 + apply (subst det_transp[symmetric])
1.352 + apply (rule det_zero_row[OF i])
1.353 + by (metis row_transp r i)
1.354 +
1.355 +lemma setsum_lambda_beta[simp]: "setsum (\<lambda>i. ((\<chi> i. g i) :: 'a::{comm_monoid_add}^'n) $ i ) {1 .. dimindex (UNIV :: 'n set)} = setsum g {1 .. dimindex (UNIV :: 'n set)}"
1.356 + by (simp add: Cart_lambda_beta)
1.357 +
1.358 +lemma setprod_lambda_beta[simp]: "setprod (\<lambda>i. ((\<chi> i. g i) :: 'a::{comm_monoid_mult}^'n) $ i ) {1 .. dimindex (UNIV :: 'n set)} = setprod g {1 .. dimindex (UNIV :: 'n set)}"
1.359 + apply (rule setprod_cong)
1.360 + apply simp
1.361 + apply (simp add: Cart_lambda_beta')
1.362 + done
1.363 +
1.364 +lemma setprod_lambda_beta2[simp]: "setprod (\<lambda>i. ((\<chi> i. g i) :: 'a::{comm_monoid_mult}^'n^'n) $ i$ f i ) {1 .. dimindex (UNIV :: 'n set)} = setprod (\<lambda>i. g i $ f i) {1 .. dimindex (UNIV :: 'n set)}"
1.365 +proof(rule setprod_cong[OF refl])
1.366 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.367 + fix i assume i: "i \<in> ?U"
1.368 + from Cart_lambda_beta'[OF i, of g] have
1.369 + "((\<chi> i. g i) :: 'a^'n^'n) $ i = g i" .
1.370 + hence "((\<chi> i. g i) :: 'a^'n^'n) $ i $ f i = g i $ f i" by simp
1.371 + then
1.372 + show "((\<chi> i. g i):: 'a^'n^'n) $ i $ f i = g i $ f i" .
1.373 +qed
1.374 +
1.375 +lemma det_row_add:
1.376 + assumes k: "k \<in> {1 .. dimindex (UNIV :: 'n set)}"
1.377 + shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
1.378 + det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
1.379 + det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
1.380 +unfolding det_def setprod_lambda_beta2 setsum_addf[symmetric]
1.381 +proof (rule setsum_cong2)
1.382 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.383 + let ?pU = "{p. p permutes ?U}"
1.384 + let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::nat \<Rightarrow> 'a::comm_ring_1^'n"
1.385 + let ?g = "(\<lambda> i. if i = k then a i else c i)::nat \<Rightarrow> 'a::comm_ring_1^'n"
1.386 + let ?h = "(\<lambda> i. if i = k then b i else c i)::nat \<Rightarrow> 'a::comm_ring_1^'n"
1.387 + fix p assume p: "p \<in> ?pU"
1.388 + let ?Uk = "?U - {k}"
1.389 + from p have pU: "p permutes ?U" by blast
1.390 + from k have pkU: "p k \<in> ?U" by (simp only: permutes_in_image[OF pU])
1.391 + note pin[simp] = permutes_in_image[OF pU]
1.392 + have kU: "?U = insert k ?Uk" using k by blast
1.393 + {fix j assume j: "j \<in> ?Uk"
1.394 + from j have "?f j $ p j = ?g j $ p j" and "?f j $ p j= ?h j $ p j"
1.395 + by simp_all}
1.396 + then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
1.397 + and th2: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?h i $ p i) ?Uk"
1.398 + apply -
1.399 + apply (rule setprod_cong, simp_all)+
1.400 + done
1.401 + have th3: "finite ?Uk" "k \<notin> ?Uk" using k by auto
1.402 + have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
1.403 + unfolding kU[symmetric] ..
1.404 + also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
1.405 + apply (rule setprod_insert)
1.406 + apply simp
1.407 + using k by blast
1.408 + also have "\<dots> = (a k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk) + (b k$ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk)" using pkU by (simp add: ring_simps vector_component)
1.409 + also have "\<dots> = (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk) + (b k$ p k * setprod (\<lambda>i. ?h i $ p i) ?Uk)" by (metis th1 th2)
1.410 + also have "\<dots> = setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + setprod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
1.411 + unfolding setprod_insert[OF th3] by simp
1.412 + finally have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?g i $ p i) ?U + setprod (\<lambda>i. ?h i $ p i) ?U" unfolding kU[symmetric] .
1.413 + then show "of_int (sign p) * setprod (\<lambda>i. ?f i $ p i) ?U = of_int (sign p) * setprod (\<lambda>i. ?g i $ p i) ?U + of_int (sign p) * setprod (\<lambda>i. ?h i $ p i) ?U"
1.414 + by (simp add: ring_simps)
1.415 +qed
1.416 +
1.417 +lemma det_row_mul:
1.418 + assumes k: "k \<in> {1 .. dimindex (UNIV :: 'n set)}"
1.419 + shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
1.420 + c* det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
1.421 +
1.422 +unfolding det_def setprod_lambda_beta2 setsum_right_distrib
1.423 +proof (rule setsum_cong2)
1.424 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.425 + let ?pU = "{p. p permutes ?U}"
1.426 + let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::nat \<Rightarrow> 'a::comm_ring_1^'n"
1.427 + let ?g = "(\<lambda> i. if i = k then a i else b i)::nat \<Rightarrow> 'a::comm_ring_1^'n"
1.428 + fix p assume p: "p \<in> ?pU"
1.429 + let ?Uk = "?U - {k}"
1.430 + from p have pU: "p permutes ?U" by blast
1.431 + from k have pkU: "p k \<in> ?U" by (simp only: permutes_in_image[OF pU])
1.432 + note pin[simp] = permutes_in_image[OF pU]
1.433 + have kU: "?U = insert k ?Uk" using k by blast
1.434 + {fix j assume j: "j \<in> ?Uk"
1.435 + from j have "?f j $ p j = ?g j $ p j" by simp}
1.436 + then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
1.437 + apply -
1.438 + apply (rule setprod_cong, simp_all)
1.439 + done
1.440 + have th3: "finite ?Uk" "k \<notin> ?Uk" using k by auto
1.441 + have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
1.442 + unfolding kU[symmetric] ..
1.443 + also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
1.444 + apply (rule setprod_insert)
1.445 + apply simp
1.446 + using k by blast
1.447 + also have "\<dots> = (c*s a k) $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk" using pkU by (simp add: ring_simps vector_component)
1.448 + also have "\<dots> = c* (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk)"
1.449 + unfolding th1 using pkU by (simp add: vector_component mult_ac)
1.450 + also have "\<dots> = c* (setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
1.451 + unfolding setprod_insert[OF th3] by simp
1.452 + finally have "setprod (\<lambda>i. ?f i $ p i) ?U = c* (setprod (\<lambda>i. ?g i $ p i) ?U)" unfolding kU[symmetric] .
1.453 + then show "of_int (sign p) * setprod (\<lambda>i. ?f i $ p i) ?U = c * (of_int (sign p) * setprod (\<lambda>i. ?g i $ p i) ?U)"
1.454 + by (simp add: ring_simps)
1.455 +qed
1.456 +
1.457 +lemma det_row_0:
1.458 + assumes k: "k \<in> {1 .. dimindex (UNIV :: 'n set)}"
1.459 + shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
1.460 +using det_row_mul[OF k, of 0 "\<lambda>i. 1" b]
1.461 +apply (simp)
1.462 + unfolding vector_smult_lzero .
1.463 +
1.464 +lemma det_row_operation:
1.465 + fixes A :: "'a::ordered_idom^'n^'n"
1.466 + assumes i: "i \<in> {1 .. dimindex(UNIV :: 'n set)}"
1.467 + and j: "j \<in> {1 .. dimindex(UNIV :: 'n set)}"
1.468 + and ij: "i \<noteq> j"
1.469 + shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
1.470 +proof-
1.471 + let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
1.472 + have th: "row i ?Z = row j ?Z" using i j by (vector row_def)
1.473 + have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
1.474 + using i j by (vector row_def)
1.475 + show ?thesis
1.476 + unfolding det_row_add [OF i] det_row_mul[OF i] det_identical_rows[OF i j ij th] th2
1.477 + by simp
1.478 +qed
1.479 +
1.480 +lemma det_row_span:
1.481 + fixes A :: "'a:: ordered_idom^'n^'n"
1.482 + assumes i: "i \<in> {1 .. dimindex(UNIV :: 'n set)}"
1.483 + and x: "x \<in> span {row j A |j. j\<in> {1 .. dimindex(UNIV :: 'n set)} \<and> j\<noteq> i}"
1.484 + shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
1.485 +proof-
1.486 + let ?U = "{1 .. dimindex(UNIV :: 'n set)}"
1.487 + let ?S = "{row j A |j. j\<in> ?U \<and> j\<noteq> i}"
1.488 + let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
1.489 + let ?P = "\<lambda>x. ?d (row i A + x) = det A"
1.490 + {fix k
1.491 +
1.492 + have "(if k = i then row i A + 0 else row k A) = row k A" by simp}
1.493 + then have P0: "?P 0"
1.494 + apply -
1.495 + apply (rule cong[of det, OF refl])
1.496 + using i by (vector row_def)
1.497 + moreover
1.498 + {fix c z y assume zS: "z \<in> ?S" and Py: "?P y"
1.499 + from zS obtain j where j: "z = row j A" "j \<in> ?U" "i \<noteq> j" by blast
1.500 + let ?w = "row i A + y"
1.501 + have th0: "row i A + (c*s z + y) = ?w + c*s z" by vector
1.502 + have thz: "?d z = 0"
1.503 + apply (rule det_identical_rows[OF i j(2,3)])
1.504 + using i j by (vector row_def)
1.505 + have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)" unfolding th0 ..
1.506 + then have "?P (c*s z + y)" unfolding thz Py det_row_mul[OF i] det_row_add[OF i]
1.507 + by simp }
1.508 +
1.509 + ultimately show ?thesis
1.510 + apply -
1.511 + apply (rule span_induct_alt[of ?P ?S, OF P0])
1.512 + apply blast
1.513 + apply (rule x)
1.514 + done
1.515 +qed
1.516 +
1.517 +(* ------------------------------------------------------------------------- *)
1.518 +(* May as well do this, though it's a bit unsatisfactory since it ignores *)
1.519 +(* exact duplicates by considering the rows/columns as a set. *)
1.520 +(* ------------------------------------------------------------------------- *)
1.521 +
1.522 +lemma det_dependent_rows:
1.523 + fixes A:: "'a::ordered_idom^'n^'n"
1.524 + assumes d: "dependent (rows A)"
1.525 + shows "det A = 0"
1.526 +proof-
1.527 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.528 + from d obtain i where i: "i \<in> ?U" "row i A \<in> span (rows A - {row i A})"
1.529 + unfolding dependent_def rows_def by blast
1.530 + {fix j k assume j: "j \<in>?U" and k: "k \<in> ?U" and jk: "j \<noteq> k"
1.531 + and c: "row j A = row k A"
1.532 + from det_identical_rows[OF j k jk c] have ?thesis .}
1.533 + moreover
1.534 + {assume H: "\<And> i j. i\<in> ?U \<Longrightarrow> j \<in> ?U \<Longrightarrow> i \<noteq> j \<Longrightarrow> row i A \<noteq> row j A"
1.535 + have th0: "- row i A \<in> span {row j A|j. j \<in> ?U \<and> j \<noteq> i}"
1.536 + apply (rule span_neg)
1.537 + apply (rule set_rev_mp)
1.538 + apply (rule i(2))
1.539 + apply (rule span_mono)
1.540 + using H i by (auto simp add: rows_def)
1.541 + from det_row_span[OF i(1) th0]
1.542 + have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
1.543 + unfolding right_minus vector_smult_lzero ..
1.544 + with det_row_mul[OF i(1), of "0::'a" "\<lambda>i. 1"]
1.545 + have "det A = 0" by simp}
1.546 + ultimately show ?thesis by blast
1.547 +qed
1.548 +
1.549 +lemma det_dependent_columns: assumes d: "dependent(columns (A::'a::ordered_idom^'n^'n))" shows "det A = 0"
1.550 +by (metis d det_dependent_rows rows_transp det_transp)
1.551 +
1.552 +(* ------------------------------------------------------------------------- *)
1.553 +(* Multilinearity and the multiplication formula. *)
1.554 +(* ------------------------------------------------------------------------- *)
1.555 +
1.556 +lemma Cart_lambda_cong: "(\<And>x. x \<in> {1 .. dimindex (UNIV :: 'n set)} \<Longrightarrow> f x = g x) \<Longrightarrow> (Cart_lambda f::'a^'n) = (Cart_lambda g :: 'a^'n)"
1.557 + apply (rule iffD1[OF Cart_lambda_unique]) by vector
1.558 +
1.559 +lemma det_linear_row_setsum:
1.560 + assumes fS: "finite S" and k: "k \<in> {1 .. dimindex (UNIV :: 'n set)}"
1.561 + shows "det ((\<chi> i. if i = k then setsum (a i) S else c i)::'a::comm_ring_1^'n^'n) = setsum (\<lambda>j. det ((\<chi> i. if i = k then a i j else c i)::'a^'n^'n)) S"
1.562 + using k
1.563 +proof(induct rule: finite_induct[OF fS])
1.564 + case 1 thus ?case apply simp unfolding setsum_empty det_row_0[OF k] ..
1.565 +next
1.566 + case (2 x F)
1.567 + then show ?case by (simp add: det_row_add cong del: if_weak_cong)
1.568 +qed
1.569 +
1.570 +lemma finite_bounded_functions:
1.571 + assumes fS: "finite S"
1.572 + shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
1.573 +proof(induct k)
1.574 + case 0
1.575 + have th: "{f. \<forall>i. f i = i} = {id}" by (auto intro: ext)
1.576 + show ?case by (auto simp add: th)
1.577 +next
1.578 + case (Suc k)
1.579 + let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
1.580 + let ?S = "?f ` (S \<times> {f. (\<forall>i\<in>{1..k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1..k} \<longrightarrow> f i = i)})"
1.581 + have "?S = {f. (\<forall>i\<in>{1.. Suc k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1.. Suc k} \<longrightarrow> f i = i)}"
1.582 + apply (auto simp add: image_iff)
1.583 + apply (rule_tac x="x (Suc k)" in bexI)
1.584 + apply (rule_tac x = "\<lambda>i. if i = Suc k then i else x i" in exI)
1.585 + apply (auto intro: ext)
1.586 + done
1.587 + with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
1.588 + show ?case by metis
1.589 +qed
1.590 +
1.591 +
1.592 +lemma eq_id_iff[simp]: "(\<forall>x. f x = x) = (f = id)" by (auto intro: ext)
1.593 +
1.594 +lemma det_linear_rows_setsum_lemma:
1.595 + assumes fS: "finite S" and k: "k \<le> dimindex (UNIV :: 'n set)"
1.596 + shows "det((\<chi> i. if i <= k then setsum (a i) S else c i):: 'a::comm_ring_1^'n^'n) =
1.597 + setsum (\<lambda>f. det((\<chi> i. if i <= k then a i (f i) else c i)::'a^'n^'n))
1.598 + {f. (\<forall>i \<in> {1 .. k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1..k} \<longrightarrow> f i = i)}"
1.599 +using k
1.600 +proof(induct k arbitrary: a c)
1.601 + case 0
1.602 + have th0: "\<And>x y. (\<chi> i. if i <= 0 then x i else y i) = (\<chi> i. y i)" by vector
1.603 + from "0.prems" show ?case unfolding th0 by simp
1.604 +next
1.605 + case (Suc k a c)
1.606 + let ?F = "\<lambda>k. {f. (\<forall>i \<in> {1 .. k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1..k} \<longrightarrow> f i = i)}"
1.607 + let ?h = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
1.608 + let ?k = "\<lambda>h. (h(Suc k),(\<lambda>i. if i = Suc k then i else h i))"
1.609 + let ?s = "\<lambda> k a c f. det((\<chi> i. if i <= k then a i (f i) else c i)::'a^'n^'n)"
1.610 + let ?c = "\<lambda>i. if i = Suc k then a i j else c i"
1.611 + from Suc.prems have Sk: "Suc k \<in> {1 .. dimindex (UNIV :: 'n set)}" by simp
1.612 + from Suc.prems have k': "k \<le> dimindex (UNIV :: 'n set)" by arith
1.613 + have thif: "\<And>a b c d. (if b \<or> a then c else d) = (if a then c else if b then c else d)" by simp
1.614 + have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
1.615 + (if c then (if a then b else d) else (if a then b else e))" by simp
1.616 + have "det (\<chi> i. if i \<le> Suc k then setsum (a i) S else c i) =
1.617 + det (\<chi> i. if i = Suc k then setsum (a i) S
1.618 + else if i \<le> k then setsum (a i) S else c i)"
1.619 + unfolding le_Suc_eq thif ..
1.620 + also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<le> k then setsum (a i) S
1.621 + else if i = Suc k then a i j else c i))"
1.622 + unfolding det_linear_row_setsum[OF fS Sk]
1.623 + apply (subst thif2)
1.624 + by (simp cong del: if_weak_cong cong add: if_cong)
1.625 + finally have tha:
1.626 + "det (\<chi> i. if i \<le> Suc k then setsum (a i) S else c i) =
1.627 + (\<Sum>(j, f)\<in>S \<times> ?F k. det (\<chi> i. if i \<le> k then a i (f i)
1.628 + else if i = Suc k then a i j
1.629 + else c i))"
1.630 + unfolding Suc.hyps[OF k'] unfolding setsum_cartesian_product by blast
1.631 + show ?case unfolding tha
1.632 + apply(rule setsum_eq_general_reverses[where h= "?h" and k= "?k"],
1.633 + blast intro: finite_cartesian_product fS finite_bounded_functions[OF fS],
1.634 + blast intro: finite_cartesian_product fS finite_bounded_functions[OF fS], auto intro: ext)
1.635 + apply (rule cong[OF refl[of det]])
1.636 + by vector
1.637 +qed
1.638 +
1.639 +lemma det_linear_rows_setsum:
1.640 + assumes fS: "finite S"
1.641 + shows "det (\<chi> i. setsum (a i) S) = setsum (\<lambda>f. det (\<chi> i. a i (f i) :: 'a::comm_ring_1 ^ 'n^'n)) {f. (\<forall>i \<in> {1 .. dimindex (UNIV :: 'n set)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1.. dimindex (UNIV :: 'n set)} \<longrightarrow> f i = i)}"
1.642 +proof-
1.643 + have th0: "\<And>x y. ((\<chi> i. if i <= dimindex(UNIV:: 'n set) then x i else y i) :: 'a^'n^'n) = (\<chi> i. x i)" by vector
1.644 +
1.645 + from det_linear_rows_setsum_lemma[OF fS, of "dimindex (UNIV :: 'n set)" a, unfolded th0, OF order_refl] show ?thesis by blast
1.646 +qed
1.647 +
1.648 +lemma matrix_mul_setsum_alt:
1.649 + fixes A B :: "'a::comm_ring_1^'n^'n"
1.650 + shows "A ** B = (\<chi> i. setsum (\<lambda>k. A$i$k *s B $ k) {1 .. dimindex (UNIV :: 'n set)})"
1.651 + by (vector matrix_matrix_mult_def setsum_component)
1.652 +
1.653 +lemma det_rows_mul:
1.654 + "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n) =
1.655 + setprod (\<lambda>i. c i) {1..dimindex(UNIV:: 'n set)} * det((\<chi> i. a i)::'a^'n^'n)"
1.656 +proof (simp add: det_def Cart_lambda_beta' setsum_right_distrib vector_component cong add: setprod_cong del: One_nat_def, rule setsum_cong2)
1.657 + let ?U = "{1 .. dimindex(UNIV :: 'n set)}"
1.658 + let ?PU = "{p. p permutes ?U}"
1.659 + fix p assume pU: "p \<in> ?PU"
1.660 + let ?s = "of_int (sign p)"
1.661 + from pU have p: "p permutes ?U" by blast
1.662 + have "setprod (\<lambda>i. (c i *s a i) $ p i) ?U = setprod (\<lambda>i. c i * a i $ p i) ?U"
1.663 + apply (rule setprod_cong, blast)
1.664 + by (auto simp only: permutes_in_image[OF p] intro: vector_smult_component)
1.665 + also have "\<dots> = setprod c ?U * setprod (\<lambda>i. a i $ p i) ?U"
1.666 + unfolding setprod_timesf ..
1.667 + finally show "?s * (\<Prod>xa\<in>?U. (c xa *s a xa) $ p xa) =
1.668 + setprod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))" by (simp add: ring_simps)
1.669 +qed
1.670 +
1.671 +lemma det_mul:
1.672 + fixes A B :: "'a::ordered_idom^'n^'n"
1.673 + shows "det (A ** B) = det A * det B"
1.674 +proof-
1.675 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.676 + let ?F = "{f. (\<forall>i\<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
1.677 + let ?PU = "{p. p permutes ?U}"
1.678 + have fU: "finite ?U" by simp
1.679 + have fF: "finite ?F" using finite_bounded_functions[OF fU] .
1.680 + {fix p assume p: "p permutes ?U"
1.681 +
1.682 + have "p \<in> ?F" unfolding mem_Collect_eq permutes_in_image[OF p]
1.683 + using p[unfolded permutes_def] by simp}
1.684 + then have PUF: "?PU \<subseteq> ?F" by blast
1.685 + {fix f assume fPU: "f \<in> ?F - ?PU"
1.686 + have fUU: "f ` ?U \<subseteq> ?U" using fPU by auto
1.687 + from fPU have f: "\<forall>i \<in> ?U. f i \<in> ?U"
1.688 + "\<forall>i. i \<notin> ?U \<longrightarrow> f i = i" "\<not>(\<forall>y. \<exists>!x. f x = y)" unfolding permutes_def
1.689 + by auto
1.690 +
1.691 + let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
1.692 + let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
1.693 + {assume fni: "\<not> inj_on f ?U"
1.694 + then obtain i j where ij: "i \<in> ?U" "j \<in> ?U" "f i = f j" "i \<noteq> j"
1.695 + unfolding inj_on_def by blast
1.696 + from ij
1.697 + have rth: "row i ?B = row j ?B" by (vector row_def)
1.698 + from det_identical_rows[OF ij(1,2,4) rth]
1.699 + have "det (\<chi> i. A$i$f i *s B$f i) = 0"
1.700 + unfolding det_rows_mul by simp}
1.701 + moreover
1.702 + {assume fi: "inj_on f ?U"
1.703 + from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
1.704 + unfolding inj_on_def
1.705 + apply (case_tac "i \<in> ?U")
1.706 + apply (case_tac "j \<in> ?U") by metis+
1.707 + note fs = fi[unfolded surjective_iff_injective_gen[OF fU fU refl fUU, symmetric]]
1.708 +
1.709 + {fix y
1.710 + from fs f have "\<exists>x. f x = y" by (cases "y \<in> ?U") blast+
1.711 + then obtain x where x: "f x = y" by blast
1.712 + {fix z assume z: "f z = y" from fith x z have "z = x" by metis}
1.713 + with x have "\<exists>!x. f x = y" by blast}
1.714 + with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
1.715 + ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
1.716 + hence zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0" by simp
1.717 + {fix p assume pU: "p \<in> ?PU"
1.718 + from pU have p: "p permutes ?U" by blast
1.719 + let ?s = "\<lambda>p. of_int (sign p)"
1.720 + let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
1.721 + (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
1.722 + have "(setsum (\<lambda>q. ?s q *
1.723 + (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
1.724 + (setsum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
1.725 + (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
1.726 + unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
1.727 + proof(rule setsum_cong2)
1.728 + fix q assume qU: "q \<in> ?PU"
1.729 + hence q: "q permutes ?U" by blast
1.730 + from p q have pp: "permutation p" and pq: "permutation q"
1.731 + unfolding permutation_permutes by auto
1.732 + have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
1.733 + "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
1.734 + unfolding mult_assoc[symmetric] unfolding of_int_mult[symmetric]
1.735 + by (simp_all add: sign_idempotent)
1.736 + have ths: "?s q = ?s p * ?s (q o inv p)"
1.737 + using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
1.738 + by (simp add: th00 mult_ac sign_idempotent sign_compose)
1.739 + have th001: "setprod (\<lambda>i. B$i$ q (inv p i)) ?U = setprod ((\<lambda>i. B$i$ q (inv p i)) o p) ?U"
1.740 + by (rule setprod_permute[OF p])
1.741 + have thp: "setprod (\<lambda>i. (\<chi> i. A$i$p i *s B$p i :: 'a^'n^'n) $i $ q i) ?U = setprod (\<lambda>i. A$i$p i) ?U * setprod (\<lambda>i. B$i$ q (inv p i)) ?U"
1.742 + unfolding th001 setprod_timesf[symmetric] o_def permutes_inverses[OF p]
1.743 + apply (rule setprod_cong[OF refl])
1.744 + using permutes_in_image[OF q] by vector
1.745 + show "?s q * setprod (\<lambda>i. (((\<chi> i. A$i$p i *s B$p i) :: 'a^'n^'n)$i$q i)) ?U = ?s p * (setprod (\<lambda>i. A$i$p i) ?U) * (?s (q o inv p) * setprod (\<lambda>i. B$i$(q o inv p) i) ?U)"
1.746 + using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
1.747 + by (simp add: sign_nz th00 ring_simps sign_idempotent sign_compose)
1.748 + qed
1.749 + }
1.750 + then have th2: "setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
1.751 + unfolding det_def setsum_product
1.752 + by (rule setsum_cong2)
1.753 + have "det (A**B) = setsum (\<lambda>f. det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
1.754 + unfolding matrix_mul_setsum_alt det_linear_rows_setsum[OF fU] ..
1.755 + also have "\<dots> = setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
1.756 + unfolding setsum_superset[OF fF PUF zth, symmetric]
1.757 + unfolding det_rows_mul ..
1.758 + finally show ?thesis unfolding th2 .
1.759 +qed
1.760 +
1.761 +(* ------------------------------------------------------------------------- *)
1.762 +(* Relation to invertibility. *)
1.763 +(* ------------------------------------------------------------------------- *)
1.764 +
1.765 +lemma invertible_left_inverse:
1.766 + fixes A :: "real^'n^'n"
1.767 + shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). B** A = mat 1)"
1.768 + by (metis invertible_def matrix_left_right_inverse)
1.769 +
1.770 +lemma invertible_righ_inverse:
1.771 + fixes A :: "real^'n^'n"
1.772 + shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). A** B = mat 1)"
1.773 + by (metis invertible_def matrix_left_right_inverse)
1.774 +
1.775 +lemma invertible_det_nz:
1.776 + fixes A::"real ^'n^'n"
1.777 + shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
1.778 +proof-
1.779 + {assume "invertible A"
1.780 + then obtain B :: "real ^'n^'n" where B: "A ** B = mat 1"
1.781 + unfolding invertible_righ_inverse by blast
1.782 + hence "det (A ** B) = det (mat 1 :: real ^'n^'n)" by simp
1.783 + hence "det A \<noteq> 0"
1.784 + apply (simp add: det_mul det_I) by algebra }
1.785 + moreover
1.786 + {assume H: "\<not> invertible A"
1.787 + let ?U = "{1 .. dimindex(UNIV :: 'n set)}"
1.788 + have fU: "finite ?U" by simp
1.789 + from H obtain c i where c: "setsum (\<lambda>i. c i *s row i A) ?U = 0"
1.790 + and iU: "i \<in> ?U" and ci: "c i \<noteq> 0"
1.791 + unfolding invertible_righ_inverse
1.792 + unfolding matrix_right_invertible_independent_rows by blast
1.793 + have stupid: "\<And>(a::real^'n) b. a + b = 0 \<Longrightarrow> -a = b"
1.794 + apply (drule_tac f="op + (- a)" in cong[OF refl])
1.795 + apply (simp only: ab_left_minus add_assoc[symmetric])
1.796 + apply simp
1.797 + done
1.798 + from c ci
1.799 + have thr0: "- row i A = setsum (\<lambda>j. (1/ c i) *s c j *s row j A) (?U - {i})"
1.800 + unfolding setsum_diff1'[OF fU iU] setsum_cmul
1.801 + apply (simp add: field_simps)
1.802 + apply (rule vector_mul_lcancel_imp[OF ci])
1.803 + apply (auto simp add: vector_smult_assoc vector_smult_rneg field_simps)
1.804 + unfolding stupid ..
1.805 + have thr: "- row i A \<in> span {row j A| j. j\<in> ?U \<and> j \<noteq> i}"
1.806 + unfolding thr0
1.807 + apply (rule span_setsum)
1.808 + apply simp
1.809 + apply (rule ballI)
1.810 + apply (rule span_mul)+
1.811 + apply (rule span_superset)
1.812 + apply auto
1.813 + done
1.814 + let ?B = "(\<chi> k. if k = i then 0 else row k A) :: real ^'n^'n"
1.815 + have thrb: "row i ?B = 0" using iU by (vector row_def)
1.816 + have "det A = 0"
1.817 + unfolding det_row_span[OF iU thr, symmetric] right_minus
1.818 + unfolding det_zero_row[OF iU thrb] ..}
1.819 + ultimately show ?thesis by blast
1.820 +qed
1.821 +
1.822 +(* ------------------------------------------------------------------------- *)
1.823 +(* Cramer's rule. *)
1.824 +(* ------------------------------------------------------------------------- *)
1.825 +
1.826 +lemma cramer_lemma_transp:
1.827 + fixes A:: "'a::ordered_idom^'n^'n" and x :: "'a ^'n"
1.828 + assumes k: "k \<in> {1 .. dimindex(UNIV ::'n set)}"
1.829 + shows "det ((\<chi> i. if i = k then setsum (\<lambda>i. x$i *s row i A) {1 .. dimindex(UNIV::'n set)}
1.830 + else row i A)::'a^'n^'n) = x$k * det A"
1.831 + (is "?lhs = ?rhs")
1.832 +proof-
1.833 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.834 + let ?Uk = "?U - {k}"
1.835 + have U: "?U = insert k ?Uk" using k by blast
1.836 + have fUk: "finite ?Uk" by simp
1.837 + have kUk: "k \<notin> ?Uk" by simp
1.838 + have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
1.839 + by (vector ring_simps)
1.840 + have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f" by (auto intro: ext)
1.841 + have "(\<chi> i. row i A) = A" by (vector row_def)
1.842 + then have thd1: "det (\<chi> i. row i A) = det A" by simp
1.843 + 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"
1.844 + apply (rule det_row_span[OF k])
1.845 + apply (rule span_setsum[OF fUk])
1.846 + apply (rule ballI)
1.847 + apply (rule span_mul)
1.848 + apply (rule span_superset)
1.849 + apply auto
1.850 + done
1.851 + show "?lhs = x$k * det A"
1.852 + apply (subst U)
1.853 + unfolding setsum_insert[OF fUk kUk]
1.854 + apply (subst th00)
1.855 + unfolding add_assoc
1.856 + apply (subst det_row_add[OF k])
1.857 + unfolding thd0
1.858 + unfolding det_row_mul[OF k]
1.859 + unfolding th001[of k "\<lambda>i. row i A"]
1.860 + unfolding thd1 by (simp add: ring_simps)
1.861 +qed
1.862 +
1.863 +lemma cramer_lemma:
1.864 + fixes A :: "'a::ordered_idom ^'n^'n"
1.865 + assumes k: "k \<in> {1 .. dimindex (UNIV :: 'n set)}" (is " _ \<in> ?U")
1.866 + shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: 'a^'n^'n) = x$k * det A"
1.867 +proof-
1.868 + have stupid: "\<And>c. setsum (\<lambda>i. c i *s row i (transp A)) ?U = setsum (\<lambda>i. c i *s column i A) ?U"
1.869 + by (auto simp add: row_transp intro: setsum_cong2)
1.870 + show ?thesis
1.871 + unfolding matrix_mult_vsum
1.872 + unfolding cramer_lemma_transp[OF k, of x "transp A", unfolded det_transp, symmetric]
1.873 + unfolding stupid[of "\<lambda>i. x$i"]
1.874 + apply (subst det_transp[symmetric])
1.875 + apply (rule cong[OF refl[of det]]) by (vector transp_def column_def row_def)
1.876 +qed
1.877 +
1.878 +lemma cramer:
1.879 + fixes A ::"real^'n^'n"
1.880 + assumes d0: "det A \<noteq> 0"
1.881 + shows "A *v x = b \<longleftrightarrow> x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j :: real^'n^'n) / det A)"
1.882 +proof-
1.883 + from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
1.884 + unfolding invertible_det_nz[symmetric] invertible_def by blast
1.885 + have "(A ** B) *v b = b" by (simp add: B matrix_vector_mul_lid)
1.886 + hence "A *v (B *v b) = b" by (simp add: matrix_vector_mul_assoc)
1.887 + then have xe: "\<exists>x. A*v x = b" by blast
1.888 + {fix x assume x: "A *v x = b"
1.889 + have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j :: real^'n^'n) / det A)"
1.890 + unfolding x[symmetric]
1.891 + using d0 by (simp add: Cart_eq Cart_lambda_beta' cramer_lemma field_simps)}
1.892 + with xe show ?thesis by auto
1.893 +qed
1.894 +
1.895 +(* ------------------------------------------------------------------------- *)
1.896 +(* Orthogonality of a transformation and matrix. *)
1.897 +(* ------------------------------------------------------------------------- *)
1.898 +
1.899 +definition "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
1.900 +
1.901 +lemma orthogonal_transformation: "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>(v::real ^'n). norm (f v) = norm v)"
1.902 + unfolding orthogonal_transformation_def
1.903 + apply auto
1.904 + apply (erule_tac x=v in allE)+
1.905 + apply (simp add: real_vector_norm_def)
1.906 + by (simp add: dot_norm linear_add[symmetric])
1.907 +
1.908 +definition "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \<longleftrightarrow> transp Q ** Q = mat 1 \<and> Q ** transp Q = mat 1"
1.909 +
1.910 +lemma orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n) \<longleftrightarrow> transp Q ** Q = mat 1"
1.911 + by (metis matrix_left_right_inverse orthogonal_matrix_def)
1.912 +
1.913 +lemma orthogonal_matrix_id: "orthogonal_matrix (mat 1)"
1.914 + by (simp add: orthogonal_matrix_def transp_mat matrix_mul_lid)
1.915 +
1.916 +lemma orthogonal_matrix_mul:
1.917 + fixes A :: "real ^'n^'n"
1.918 + assumes oA : "orthogonal_matrix A"
1.919 + and oB: "orthogonal_matrix B"
1.920 + shows "orthogonal_matrix(A ** B)"
1.921 + using oA oB
1.922 + unfolding orthogonal_matrix matrix_transp_mul
1.923 + apply (subst matrix_mul_assoc)
1.924 + apply (subst matrix_mul_assoc[symmetric])
1.925 + by (simp add: matrix_mul_rid)
1.926 +
1.927 +lemma orthogonal_transformation_matrix:
1.928 + fixes f:: "real^'n \<Rightarrow> real^'n"
1.929 + shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
1.930 + (is "?lhs \<longleftrightarrow> ?rhs")
1.931 +proof-
1.932 + let ?mf = "matrix f"
1.933 + let ?ot = "orthogonal_transformation f"
1.934 + let ?U = "{1 .. dimindex (UNIV :: 'n set)}"
1.935 + have fU: "finite ?U" by simp
1.936 + let ?m1 = "mat 1 :: real ^'n^'n"
1.937 + {assume ot: ?ot
1.938 + from ot have lf: "linear f" and fd: "\<forall>v w. f v \<bullet> f w = v \<bullet> w"
1.939 + unfolding orthogonal_transformation_def orthogonal_matrix by blast+
1.940 + {fix i j assume i: "i \<in> ?U" and j: "j \<in> ?U"
1.941 + let ?A = "transp ?mf ** ?mf"
1.942 + have th0: "\<And>b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)"
1.943 + "\<And>b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)"
1.944 + by simp_all
1.945 + from fd[rule_format, of "basis i" "basis j", unfolded matrix_works[OF lf, symmetric] dot_matrix_vector_mul] i j
1.946 + have "?A$i$j = ?m1 $ i $ j"
1.947 + by (simp add: Cart_lambda_beta' dot_def matrix_matrix_mult_def columnvector_def rowvector_def basis_def th0 setsum_delta[OF fU] mat_def del: One_nat_def)}
1.948 + hence "orthogonal_matrix ?mf" unfolding orthogonal_matrix by vector
1.949 + with lf have ?rhs by blast}
1.950 + moreover
1.951 + {assume lf: "linear f" and om: "orthogonal_matrix ?mf"
1.952 + from lf om have ?lhs
1.953 + unfolding orthogonal_matrix_def norm_eq orthogonal_transformation
1.954 + unfolding matrix_works[OF lf, symmetric]
1.955 + apply (subst dot_matrix_vector_mul)
1.956 + by (simp add: dot_matrix_product matrix_mul_lid del: One_nat_def)}
1.957 + ultimately show ?thesis by blast
1.958 +qed
1.959 +
1.960 +lemma det_orthogonal_matrix:
1.961 + fixes Q:: "'a::ordered_idom^'n^'n"
1.962 + assumes oQ: "orthogonal_matrix Q"
1.963 + shows "det Q = 1 \<or> det Q = - 1"
1.964 +proof-
1.965 +
1.966 + have th: "\<And>x::'a. x = 1 \<or> x = - 1 \<longleftrightarrow> x*x = 1" (is "\<And>x::'a. ?ths x")
1.967 + proof-
1.968 + fix x:: 'a
1.969 + have th0: "x*x - 1 = (x - 1)*(x + 1)" by (simp add: ring_simps)
1.970 + have th1: "\<And>(x::'a) y. x = - y \<longleftrightarrow> x + y = 0"
1.971 + apply (subst eq_iff_diff_eq_0) by simp
1.972 + have "x*x = 1 \<longleftrightarrow> x*x - 1 = 0" by simp
1.973 + also have "\<dots> \<longleftrightarrow> x = 1 \<or> x = - 1" unfolding th0 th1 by simp
1.974 + finally show "?ths x" ..
1.975 + qed
1.976 + from oQ have "Q ** transp Q = mat 1" by (metis orthogonal_matrix_def)
1.977 + hence "det (Q ** transp Q) = det (mat 1:: 'a^'n^'n)" by simp
1.978 + hence "det Q * det Q = 1" by (simp add: det_mul det_I det_transp)
1.979 + then show ?thesis unfolding th .
1.980 +qed
1.981 +
1.982 +(* ------------------------------------------------------------------------- *)
1.983 +(* Linearity of scaling, and hence isometry, that preserves origin. *)
1.984 +(* ------------------------------------------------------------------------- *)
1.985 +lemma scaling_linear:
1.986 + fixes f :: "real ^'n \<Rightarrow> real ^'n"
1.987 + assumes f0: "f 0 = 0" and fd: "\<forall>x y. dist (f x) (f y) = c * dist x y"
1.988 + shows "linear f"
1.989 +proof-
1.990 + {fix v w
1.991 + {fix x note fd[rule_format, of x 0, unfolded dist_def f0 diff_0_right] }
1.992 + note th0 = this
1.993 + have "f v \<bullet> f w = c^2 * (v \<bullet> w)"
1.994 + unfolding dot_norm_neg dist_def[symmetric]
1.995 + unfolding th0 fd[rule_format] by (simp add: power2_eq_square field_simps)}
1.996 + note fc = this
1.997 + show ?thesis unfolding linear_def vector_eq
1.998 + by (simp add: dot_lmult dot_ladd dot_rmult dot_radd fc ring_simps)
1.999 +qed
1.1000 +
1.1001 +lemma isometry_linear:
1.1002 + "f (0:: real^'n) = (0:: real^'n) \<Longrightarrow> \<forall>x y. dist(f x) (f y) = dist x y
1.1003 + \<Longrightarrow> linear f"
1.1004 +by (rule scaling_linear[where c=1]) simp_all
1.1005 +
1.1006 +(* ------------------------------------------------------------------------- *)
1.1007 +(* Hence another formulation of orthogonal transformation. *)
1.1008 +(* ------------------------------------------------------------------------- *)
1.1009 +
1.1010 +lemma orthogonal_transformation_isometry:
1.1011 + "orthogonal_transformation f \<longleftrightarrow> f(0::real^'n) = (0::real^'n) \<and> (\<forall>x y. dist(f x) (f y) = dist x y)"
1.1012 + unfolding orthogonal_transformation
1.1013 + apply (rule iffI)
1.1014 + apply clarify
1.1015 + apply (clarsimp simp add: linear_0 linear_sub[symmetric] dist_def)
1.1016 + apply (rule conjI)
1.1017 + apply (rule isometry_linear)
1.1018 + apply simp
1.1019 + apply simp
1.1020 + apply clarify
1.1021 + apply (erule_tac x=v in allE)
1.1022 + apply (erule_tac x=0 in allE)
1.1023 + by (simp add: dist_def)
1.1024 +
1.1025 +(* ------------------------------------------------------------------------- *)
1.1026 +(* Can extend an isometry from unit sphere. *)
1.1027 +(* ------------------------------------------------------------------------- *)
1.1028 +
1.1029 +lemma isometry_sphere_extend:
1.1030 + fixes f:: "real ^'n \<Rightarrow> real ^'n"
1.1031 + assumes f1: "\<forall>x. norm x = 1 \<longrightarrow> norm (f x) = 1"
1.1032 + and fd1: "\<forall> x y. norm x = 1 \<longrightarrow> norm y = 1 \<longrightarrow> dist (f x) (f y) = dist x y"
1.1033 + shows "\<exists>g. orthogonal_transformation g \<and> (\<forall>x. norm x = 1 \<longrightarrow> g x = f x)"
1.1034 +proof-
1.1035 + {fix x y x' y' x0 y0 x0' y0' :: "real ^'n"
1.1036 + assume H: "x = norm x *s x0" "y = norm y *s y0"
1.1037 + "x' = norm x *s x0'" "y' = norm y *s y0'"
1.1038 + "norm x0 = 1" "norm x0' = 1" "norm y0 = 1" "norm y0' = 1"
1.1039 + "norm(x0' - y0') = norm(x0 - y0)"
1.1040 +
1.1041 + have "norm(x' - y') = norm(x - y)"
1.1042 + apply (subst H(1))
1.1043 + apply (subst H(2))
1.1044 + apply (subst H(3))
1.1045 + apply (subst H(4))
1.1046 + using H(5-9)
1.1047 + apply (simp add: norm_eq norm_eq_1)
1.1048 + apply (simp add: dot_lsub dot_rsub dot_lmult dot_rmult)
1.1049 + apply (simp add: ring_simps)
1.1050 + by (simp only: right_distrib[symmetric])}
1.1051 + note th0 = this
1.1052 + let ?g = "\<lambda>x. if x = 0 then 0 else norm x *s f (inverse (norm x) *s x)"
1.1053 + {fix x:: "real ^'n" assume nx: "norm x = 1"
1.1054 + have "?g x = f x" using nx by (simp add: norm_eq_0[symmetric])}
1.1055 + hence thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x" by blast
1.1056 + have g0: "?g 0 = 0" by simp
1.1057 + {fix x y :: "real ^'n"
1.1058 + {assume "x = 0" "y = 0"
1.1059 + then have "dist (?g x) (?g y) = dist x y" by simp }
1.1060 + moreover
1.1061 + {assume "x = 0" "y \<noteq> 0"
1.1062 + then have "dist (?g x) (?g y) = dist x y"
1.1063 + apply (simp add: dist_def norm_neg norm_mul norm_eq_0)
1.1064 + apply (rule f1[rule_format])
1.1065 + by(simp add: norm_mul norm_eq_0 field_simps)}
1.1066 + moreover
1.1067 + {assume "x \<noteq> 0" "y = 0"
1.1068 + then have "dist (?g x) (?g y) = dist x y"
1.1069 + apply (simp add: dist_def norm_neg norm_mul norm_eq_0)
1.1070 + apply (rule f1[rule_format])
1.1071 + by(simp add: norm_mul norm_eq_0 field_simps)}
1.1072 + moreover
1.1073 + {assume z: "x \<noteq> 0" "y \<noteq> 0"
1.1074 + have th00: "x = norm x *s inverse (norm x) *s x" "y = norm y *s inverse (norm y) *s y" "norm x *s f (inverse (norm x) *s x) = norm x *s f (inverse (norm x) *s x)"
1.1075 + "norm y *s f (inverse (norm y) *s y) = norm y *s f (inverse (norm y) *s y)"
1.1076 + "norm (inverse (norm x) *s x) = 1"
1.1077 + "norm (f (inverse (norm x) *s x)) = 1"
1.1078 + "norm (inverse (norm y) *s y) = 1"
1.1079 + "norm (f (inverse (norm y) *s y)) = 1"
1.1080 + "norm (f (inverse (norm x) *s x) - f (inverse (norm y) *s y)) =
1.1081 + norm (inverse (norm x) *s x - inverse (norm y) *s y)"
1.1082 + using z
1.1083 + by (auto simp add: norm_eq_0 vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_def])
1.1084 + from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
1.1085 + by (simp add: dist_def)}
1.1086 + ultimately have "dist (?g x) (?g y) = dist x y" by blast}
1.1087 + note thd = this
1.1088 + show ?thesis
1.1089 + apply (rule exI[where x= ?g])
1.1090 + unfolding orthogonal_transformation_isometry
1.1091 + using g0 thfg thd by metis
1.1092 +qed
1.1093 +
1.1094 +(* ------------------------------------------------------------------------- *)
1.1095 +(* Rotation, reflection, rotoinversion. *)
1.1096 +(* ------------------------------------------------------------------------- *)
1.1097 +
1.1098 +definition "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
1.1099 +definition "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"
1.1100 +
1.1101 +lemma orthogonal_rotation_or_rotoinversion:
1.1102 + fixes Q :: "'a::ordered_idom^'n^'n"
1.1103 + shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
1.1104 + by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)
1.1105 +(* ------------------------------------------------------------------------- *)
1.1106 +(* Explicit formulas for low dimensions. *)
1.1107 +(* ------------------------------------------------------------------------- *)
1.1108 +
1.1109 +lemma setprod_1: "setprod f {(1::nat)..1} = f 1" by simp
1.1110 +
1.1111 +lemma setprod_2: "setprod f {(1::nat)..2} = f 1 * f 2"
1.1112 + by (simp add: nat_number setprod_numseg mult_commute)
1.1113 +lemma setprod_3: "setprod f {(1::nat)..3} = f 1 * f 2 * f 3"
1.1114 + by (simp add: nat_number setprod_numseg mult_commute)
1.1115 +
1.1116 +lemma det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
1.1117 + by (simp add: det_def dimindex_def permutes_sing sign_id del: One_nat_def)
1.1118 +
1.1119 +lemma det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
1.1120 +proof-
1.1121 + have f12: "finite {2::nat}" "1 \<notin> {2::nat}" by auto
1.1122 + have th12: "{1 .. 2} = insert (1::nat) {2}" by auto
1.1123 + show ?thesis
1.1124 + apply (simp add: det_def dimindex_def th12 del: One_nat_def)
1.1125 + unfolding setsum_over_permutations_insert[OF f12]
1.1126 + unfolding permutes_sing
1.1127 + apply (simp add: sign_swap_id sign_id swap_id_eq del: One_nat_def)
1.1128 + by (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
1.1129 +qed
1.1130 +
1.1131 +lemma det_3: "det (A::'a::comm_ring_1^3^3) =
1.1132 + A$1$1 * A$2$2 * A$3$3 +
1.1133 + A$1$2 * A$2$3 * A$3$1 +
1.1134 + A$1$3 * A$2$1 * A$3$2 -
1.1135 + A$1$1 * A$2$3 * A$3$2 -
1.1136 + A$1$2 * A$2$1 * A$3$3 -
1.1137 + A$1$3 * A$2$2 * A$3$1"
1.1138 +proof-
1.1139 + have f123: "finite {(2::nat), 3}" "1 \<notin> {(2::nat), 3}" by auto
1.1140 + have f23: "finite {(3::nat)}" "2 \<notin> {(3::nat)}" by auto
1.1141 + have th12: "{1 .. 3} = insert (1::nat) (insert 2 {3})" by auto
1.1142 +
1.1143 + show ?thesis
1.1144 + apply (simp add: det_def dimindex_def th12 del: One_nat_def)
1.1145 + unfolding setsum_over_permutations_insert[OF f123]
1.1146 + unfolding setsum_over_permutations_insert[OF f23]
1.1147 +
1.1148 + unfolding permutes_sing
1.1149 + apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq del: One_nat_def)
1.1150 + apply (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31) One_nat_def)
1.1151 + by (simp add: ring_simps)
1.1152 +qed
1.1153 +
1.1154 +end
1.1155 \ No newline at end of file