src/HOL/Analysis/Determinants.thy
author wenzelm
Mon Mar 25 17:21:26 2019 +0100 (2 months ago)
changeset 69981 3dced198b9ec
parent 69720 be6634e99e09
child 70136 f03a01a18c6e
permissions -rw-r--r--
more strict AFP properties;
     1 (*  Title:      HOL/Analysis/Determinants.thy
     2     Author:     Amine Chaieb, University of Cambridge; proofs reworked by LCP
     3 *)
     4 
     5 section \<open>Traces, Determinant of square matrices and some properties\<close>
     6 
     7 theory Determinants
     8 imports
     9   Cartesian_Space
    10   "HOL-Library.Permutations"
    11 begin
    12 
    13 subsection  \<open>Trace\<close>
    14 
    15 definition%important  trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a"
    16   where "trace A = sum (\<lambda>i. ((A$i)$i)) (UNIV::'n set)"
    17 
    18 lemma  trace_0: "trace (mat 0) = 0"
    19   by (simp add: trace_def mat_def)
    20 
    21 lemma  trace_I: "trace (mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))"
    22   by (simp add: trace_def mat_def)
    23 
    24 lemma  trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
    25   by (simp add: trace_def sum.distrib)
    26 
    27 lemma  trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
    28   by (simp add: trace_def sum_subtractf)
    29 
    30 lemma  trace_mul_sym: "trace ((A::'a::comm_semiring_1^'n^'m) ** B) = trace (B**A)"
    31   apply (simp add: trace_def matrix_matrix_mult_def)
    32   apply (subst sum.swap)
    33   apply (simp add: mult.commute)
    34   done
    35 
    36 subsubsection%important  \<open>Definition of determinant\<close>
    37 
    38 definition%important  det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
    39   "det A =
    40     sum (\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set))
    41       {p. p permutes (UNIV :: 'n set)}"
    42 
    43 text \<open>Basic determinant properties\<close>
    44 
    45 lemma  det_transpose [simp]: "det (transpose A) = det (A::'a::comm_ring_1 ^'n^'n)"
    46 proof -
    47   let ?di = "\<lambda>A i j. A$i$j"
    48   let ?U = "(UNIV :: 'n set)"
    49   have fU: "finite ?U" by simp
    50   {
    51     fix p
    52     assume p: "p \<in> {p. p permutes ?U}"
    53     from p have pU: "p permutes ?U"
    54       by blast
    55     have sth: "sign (inv p) = sign p"
    56       by (metis sign_inverse fU p mem_Collect_eq permutation_permutes)
    57     from permutes_inj[OF pU]
    58     have pi: "inj_on p ?U"
    59       by (blast intro: subset_inj_on)
    60     from permutes_image[OF pU]
    61     have "prod (\<lambda>i. ?di (transpose A) i (inv p i)) ?U =
    62       prod (\<lambda>i. ?di (transpose A) i (inv p i)) (p ` ?U)"
    63       by simp
    64     also have "\<dots> = prod ((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) ?U"
    65       unfolding prod.reindex[OF pi] ..
    66     also have "\<dots> = prod (\<lambda>i. ?di A i (p i)) ?U"
    67     proof -
    68       have "((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) i = ?di A i (p i)" if "i \<in> ?U" for i
    69         using that permutes_inv_o[OF pU] permutes_in_image[OF pU]
    70         unfolding transpose_def by (simp add: fun_eq_iff)
    71       then show "prod ((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) ?U = prod (\<lambda>i. ?di A i (p i)) ?U"
    72         by (auto intro: prod.cong)
    73     qed
    74     finally have "of_int (sign (inv p)) * (prod (\<lambda>i. ?di (transpose A) i (inv p i)) ?U) =
    75       of_int (sign p) * (prod (\<lambda>i. ?di A i (p i)) ?U)"
    76       using sth by simp
    77   }
    78   then show ?thesis
    79     unfolding det_def
    80     by (subst sum_permutations_inverse) (blast intro: sum.cong)
    81 qed
    82 
    83 lemma  det_lowerdiagonal:
    84   fixes A :: "'a::comm_ring_1^('n::{finite,wellorder})^('n::{finite,wellorder})"
    85   assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
    86   shows "det A = prod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
    87 proof -
    88   let ?U = "UNIV:: 'n set"
    89   let ?PU = "{p. p permutes ?U}"
    90   let ?pp = "\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
    91   have fU: "finite ?U"
    92     by simp
    93   have id0: "{id} \<subseteq> ?PU"
    94     by (auto simp: permutes_id)
    95   have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
    96   proof
    97     fix p
    98     assume "p \<in> ?PU - {id}"
    99     then obtain i where i: "p i > i"
   100       by clarify (meson leI permutes_natset_le)
   101     from ld[OF i] have "\<exists>i \<in> ?U. A$i$p i = 0"
   102       by blast
   103     with prod_zero[OF fU] show "?pp p = 0"
   104       by force
   105   qed
   106   from sum.mono_neutral_cong_left[OF finite_permutations[OF fU] id0 p0] show ?thesis
   107     unfolding det_def by (simp add: sign_id)
   108 qed
   109 
   110 lemma  det_upperdiagonal:
   111   fixes A :: "'a::comm_ring_1^'n::{finite,wellorder}^'n::{finite,wellorder}"
   112   assumes ld: "\<And>i j. i > j \<Longrightarrow> A$i$j = 0"
   113   shows "det A = prod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
   114 proof -
   115   let ?U = "UNIV:: 'n set"
   116   let ?PU = "{p. p permutes ?U}"
   117   let ?pp = "(\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
   118   have fU: "finite ?U"
   119     by simp
   120   have id0: "{id} \<subseteq> ?PU"
   121     by (auto simp: permutes_id)
   122   have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0"
   123   proof
   124     fix p
   125     assume p: "p \<in> ?PU - {id}"
   126     then obtain i where i: "p i < i"
   127       by clarify (meson leI permutes_natset_ge)
   128     from ld[OF i] have "\<exists>i \<in> ?U. A$i$p i = 0"
   129       by blast
   130     with prod_zero[OF fU]  show "?pp p = 0"
   131       by force
   132   qed
   133   from sum.mono_neutral_cong_left[OF finite_permutations[OF fU] id0 p0] show ?thesis
   134     unfolding det_def by (simp add: sign_id)
   135 qed
   136 
   137 proposition  det_diagonal:
   138   fixes A :: "'a::comm_ring_1^'n^'n"
   139   assumes ld: "\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0"
   140   shows "det A = prod (\<lambda>i. A$i$i) (UNIV::'n set)"
   141 proof -
   142   let ?U = "UNIV:: 'n set"
   143   let ?PU = "{p. p permutes ?U}"
   144   let ?pp = "\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
   145   have fU: "finite ?U" by simp
   146   from finite_permutations[OF fU] have fPU: "finite ?PU" .
   147   have id0: "{id} \<subseteq> ?PU"
   148     by (auto simp: permutes_id)
   149   have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
   150   proof
   151     fix p
   152     assume p: "p \<in> ?PU - {id}"
   153     then obtain i where i: "p i \<noteq> i"
   154       by fastforce
   155     with ld have "\<exists>i \<in> ?U. A$i$p i = 0"
   156       by (metis UNIV_I)
   157     with prod_zero [OF fU] show "?pp p = 0"
   158       by force
   159   qed
   160   from sum.mono_neutral_cong_left[OF fPU id0 p0] show ?thesis
   161     unfolding det_def by (simp add: sign_id)
   162 qed
   163 
   164 lemma  det_I [simp]: "det (mat 1 :: 'a::comm_ring_1^'n^'n) = 1"
   165   by (simp add: det_diagonal mat_def)
   166 
   167 lemma  det_0 [simp]: "det (mat 0 :: 'a::comm_ring_1^'n^'n) = 0"
   168   by (simp add: det_def prod_zero power_0_left)
   169 
   170 lemma  det_permute_rows:
   171   fixes A :: "'a::comm_ring_1^'n^'n"
   172   assumes p: "p permutes (UNIV :: 'n::finite set)"
   173   shows "det (\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
   174 proof -
   175   let ?U = "UNIV :: 'n set"
   176   let ?PU = "{p. p permutes ?U}"
   177   have *: "(\<Sum>q\<in>?PU. of_int (sign (q \<circ> p)) * (\<Prod>i\<in>?U. A $ p i $ (q \<circ> p) i)) =
   178            (\<Sum>n\<in>?PU. of_int (sign p) * of_int (sign n) * (\<Prod>i\<in>?U. A $ i $ n i))"
   179   proof (rule sum.cong)
   180     fix q
   181     assume qPU: "q \<in> ?PU"
   182     have fU: "finite ?U"
   183       by simp
   184     from qPU have q: "q permutes ?U"
   185       by blast
   186     have "prod (\<lambda>i. A$p i$ (q \<circ> p) i) ?U = prod ((\<lambda>i. A$p i$(q \<circ> p) i) \<circ> inv p) ?U"
   187       by (simp only: prod.permute[OF permutes_inv[OF p], symmetric])
   188     also have "\<dots> = prod (\<lambda>i. A $ (p \<circ> inv p) i $ (q \<circ> (p \<circ> inv p)) i) ?U"
   189       by (simp only: o_def)
   190     also have "\<dots> = prod (\<lambda>i. A$i$q i) ?U"
   191       by (simp only: o_def permutes_inverses[OF p])
   192     finally have thp: "prod (\<lambda>i. A$p i$ (q \<circ> p) i) ?U = prod (\<lambda>i. A$i$q i) ?U"
   193       by blast
   194     from p q have pp: "permutation p" and qp: "permutation q"
   195       by (metis fU permutation_permutes)+
   196     show "of_int (sign (q \<circ> p)) * prod (\<lambda>i. A$ p i$ (q \<circ> p) i) ?U =
   197           of_int (sign p) * of_int (sign q) * prod (\<lambda>i. A$i$q i) ?U"
   198       by (simp only: thp sign_compose[OF qp pp] mult.commute of_int_mult)
   199   qed auto
   200   show ?thesis
   201     apply (simp add: det_def sum_distrib_left mult.assoc[symmetric])
   202     apply (subst sum_permutations_compose_right[OF p])
   203     apply (rule *)
   204     done
   205 qed
   206 
   207 lemma  det_permute_columns:
   208   fixes A :: "'a::comm_ring_1^'n^'n"
   209   assumes p: "p permutes (UNIV :: 'n set)"
   210   shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
   211 proof -
   212   let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
   213   let ?At = "transpose A"
   214   have "of_int (sign p) * det A = det (transpose (\<chi> i. transpose A $ p i))"
   215     unfolding det_permute_rows[OF p, of ?At] det_transpose ..
   216   moreover
   217   have "?Ap = transpose (\<chi> i. transpose A $ p i)"
   218     by (simp add: transpose_def vec_eq_iff)
   219   ultimately show ?thesis
   220     by simp
   221 qed
   222 
   223 lemma  det_identical_columns:
   224   fixes A :: "'a::comm_ring_1^'n^'n"
   225   assumes jk: "j \<noteq> k"
   226     and r: "column j A = column k A"
   227   shows "det A = 0"
   228 proof -
   229   let ?U="UNIV::'n set"
   230   let ?t_jk="Fun.swap j k id"
   231   let ?PU="{p. p permutes ?U}"
   232   let ?S1="{p. p\<in>?PU \<and> evenperm p}"
   233   let ?S2="{(?t_jk \<circ> p) |p. p \<in>?S1}"
   234   let ?f="\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i)"
   235   let ?g="\<lambda>p. ?t_jk \<circ> p"
   236   have g_S1: "?S2 = ?g` ?S1" by auto
   237   have inj_g: "inj_on ?g ?S1"
   238   proof (unfold inj_on_def, auto)
   239     fix x y assume x: "x permutes ?U" and even_x: "evenperm x"
   240       and y: "y permutes ?U" and even_y: "evenperm y" and eq: "?t_jk \<circ> x = ?t_jk \<circ> y"
   241     show "x = y" by (metis (hide_lams, no_types) comp_assoc eq id_comp swap_id_idempotent)
   242   qed
   243   have tjk_permutes: "?t_jk permutes ?U" unfolding permutes_def swap_id_eq by (auto,metis)
   244   have tjk_eq: "\<forall>i l. A $ i $ ?t_jk l  =  A $ i $ l"
   245     using r jk
   246     unfolding column_def vec_eq_iff swap_id_eq by fastforce
   247   have sign_tjk: "sign ?t_jk = -1" using sign_swap_id[of j k] jk by auto
   248   {fix x
   249     assume x: "x\<in> ?S1"
   250     have "sign (?t_jk \<circ> x) = sign (?t_jk) * sign x"
   251       by (metis (lifting) finite_class.finite_UNIV mem_Collect_eq
   252           permutation_permutes permutation_swap_id sign_compose x)
   253     also have "\<dots> = - sign x" using sign_tjk by simp
   254     also have "\<dots> \<noteq> sign x" unfolding sign_def by simp
   255     finally have "sign (?t_jk \<circ> x) \<noteq> sign x" and "(?t_jk \<circ> x) \<in> ?S2"
   256       using x by force+
   257   }
   258   hence disjoint: "?S1 \<inter> ?S2 = {}"
   259     by (force simp: sign_def)
   260   have PU_decomposition: "?PU = ?S1 \<union> ?S2"
   261   proof (auto)
   262     fix x
   263     assume x: "x permutes ?U" and "\<forall>p. p permutes ?U \<longrightarrow> x = Fun.swap j k id \<circ> p \<longrightarrow> \<not> evenperm p"
   264     then obtain p where p: "p permutes UNIV" and x_eq: "x = Fun.swap j k id \<circ> p"
   265       and odd_p: "\<not> evenperm p"
   266       by (metis (mono_tags) id_o o_assoc permutes_compose swap_id_idempotent tjk_permutes)
   267     thus "evenperm x"
   268       by (meson evenperm_comp evenperm_swap finite_class.finite_UNIV
   269           jk permutation_permutes permutation_swap_id)
   270   next
   271     fix p assume p: "p permutes ?U"
   272     show "Fun.swap j k id \<circ> p permutes UNIV" by (metis p permutes_compose tjk_permutes)
   273   qed
   274   have "sum ?f ?S2 = sum ((\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))
   275   \<circ> (\<circ>) (Fun.swap j k id)) {p \<in> {p. p permutes UNIV}. evenperm p}"
   276     unfolding g_S1 by (rule sum.reindex[OF inj_g])
   277   also have "\<dots> = sum (\<lambda>p. of_int (sign (?t_jk \<circ> p)) * (\<Prod>i\<in>UNIV. A $ i $ p i)) ?S1"
   278     unfolding o_def by (rule sum.cong, auto simp: tjk_eq)
   279   also have "\<dots> = sum (\<lambda>p. - ?f p) ?S1"
   280   proof (rule sum.cong, auto)
   281     fix x assume x: "x permutes ?U"
   282       and even_x: "evenperm x"
   283     hence perm_x: "permutation x" and perm_tjk: "permutation ?t_jk"
   284       using permutation_permutes[of x] permutation_permutes[of ?t_jk] permutation_swap_id
   285       by (metis finite_code)+
   286     have "(sign (?t_jk \<circ> x)) = - (sign x)"
   287       unfolding sign_compose[OF perm_tjk perm_x] sign_tjk by auto
   288     thus "of_int (sign (?t_jk \<circ> x)) * (\<Prod>i\<in>UNIV. A $ i $ x i)
   289       = - (of_int (sign x) * (\<Prod>i\<in>UNIV. A $ i $ x i))"
   290       by auto
   291   qed
   292   also have "\<dots>= - sum ?f ?S1" unfolding sum_negf ..
   293   finally have *: "sum ?f ?S2 = - sum ?f ?S1" .
   294   have "det A = (\<Sum>p | p permutes UNIV. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))"
   295     unfolding det_def ..
   296   also have "\<dots>= sum ?f ?S1 + sum ?f ?S2"
   297     by (subst PU_decomposition, rule sum.union_disjoint[OF _ _ disjoint], auto)
   298   also have "\<dots>= sum ?f ?S1 - sum ?f ?S1 " unfolding * by auto
   299   also have "\<dots>= 0" by simp
   300   finally show "det A = 0" by simp
   301 qed
   302 
   303 lemma  det_identical_rows:
   304   fixes A :: "'a::comm_ring_1^'n^'n"
   305   assumes ij: "i \<noteq> j" and r: "row i A = row j A"
   306   shows "det A = 0"
   307   by (metis column_transpose det_identical_columns det_transpose ij r)
   308 
   309 lemma  det_zero_row:
   310   fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
   311   shows "row i A = 0 \<Longrightarrow> det A = 0" and "row j F = 0 \<Longrightarrow> det F = 0"
   312   by (force simp: row_def det_def vec_eq_iff sign_nz intro!: sum.neutral)+
   313 
   314 lemma  det_zero_column:
   315   fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
   316   shows "column i A = 0 \<Longrightarrow> det A = 0" and "column j F = 0 \<Longrightarrow> det F = 0"
   317   unfolding atomize_conj atomize_imp
   318   by (metis det_transpose det_zero_row row_transpose)
   319 
   320 lemma  det_row_add:
   321   fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
   322   shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
   323     det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
   324     det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
   325   unfolding det_def vec_lambda_beta sum.distrib[symmetric]
   326 proof (rule sum.cong)
   327   let ?U = "UNIV :: 'n set"
   328   let ?pU = "{p. p permutes ?U}"
   329   let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   330   let ?g = "(\<lambda> i. if i = k then a i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   331   let ?h = "(\<lambda> i. if i = k then b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   332   fix p
   333   assume p: "p \<in> ?pU"
   334   let ?Uk = "?U - {k}"
   335   from p have pU: "p permutes ?U"
   336     by blast
   337   have kU: "?U = insert k ?Uk"
   338     by blast
   339   have eq: "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?g i $ p i) ?Uk"
   340            "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?h i $ p i) ?Uk"
   341     by auto
   342   have Uk: "finite ?Uk" "k \<notin> ?Uk"
   343     by auto
   344   have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
   345     unfolding kU[symmetric] ..
   346   also have "\<dots> = ?f k $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk"
   347     by (rule prod.insert) auto
   348   also have "\<dots> = (a k $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk) + (b k$ p k * prod (\<lambda>i. ?f i $ p i) ?Uk)"
   349     by (simp add: field_simps)
   350   also have "\<dots> = (a k $ p k * prod (\<lambda>i. ?g i $ p i) ?Uk) + (b k$ p k * prod (\<lambda>i. ?h i $ p i) ?Uk)"
   351     by (metis eq)
   352   also have "\<dots> = prod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + prod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
   353     unfolding  prod.insert[OF Uk] by simp
   354   finally have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?g i $ p i) ?U + prod (\<lambda>i. ?h i $ p i) ?U"
   355     unfolding kU[symmetric] .
   356   then show "of_int (sign p) * prod (\<lambda>i. ?f i $ p i) ?U =
   357     of_int (sign p) * prod (\<lambda>i. ?g i $ p i) ?U + of_int (sign p) * prod (\<lambda>i. ?h i $ p i) ?U"
   358     by (simp add: field_simps)
   359 qed auto
   360 
   361 lemma  det_row_mul:
   362   fixes a b :: "'n::finite \<Rightarrow> _ ^ 'n"
   363   shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
   364     c * det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
   365   unfolding det_def vec_lambda_beta sum_distrib_left
   366 proof (rule sum.cong)
   367   let ?U = "UNIV :: 'n set"
   368   let ?pU = "{p. p permutes ?U}"
   369   let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   370   let ?g = "(\<lambda> i. if i = k then a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
   371   fix p
   372   assume p: "p \<in> ?pU"
   373   let ?Uk = "?U - {k}"
   374   from p have pU: "p permutes ?U"
   375     by blast
   376   have kU: "?U = insert k ?Uk"
   377     by blast
   378   have eq: "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?g i $ p i) ?Uk"
   379     by auto
   380   have Uk: "finite ?Uk" "k \<notin> ?Uk"
   381     by auto
   382   have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
   383     unfolding kU[symmetric] ..
   384   also have "\<dots> = ?f k $ p k  * prod (\<lambda>i. ?f i $ p i) ?Uk"
   385     by (rule prod.insert) auto
   386   also have "\<dots> = (c*s a k) $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk"
   387     by (simp add: field_simps)
   388   also have "\<dots> = c* (a k $ p k * prod (\<lambda>i. ?g i $ p i) ?Uk)"
   389     unfolding eq by (simp add: ac_simps)
   390   also have "\<dots> = c* (prod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
   391     unfolding prod.insert[OF Uk] by simp
   392   finally have "prod (\<lambda>i. ?f i $ p i) ?U = c* (prod (\<lambda>i. ?g i $ p i) ?U)"
   393     unfolding kU[symmetric] .
   394   then show "of_int (sign p) * prod (\<lambda>i. ?f i $ p i) ?U = c * (of_int (sign p) * prod (\<lambda>i. ?g i $ p i) ?U)"
   395     by (simp add: field_simps)
   396 qed auto
   397 
   398 lemma  det_row_0:
   399   fixes b :: "'n::finite \<Rightarrow> _ ^ 'n"
   400   shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
   401   using det_row_mul[of k 0 "\<lambda>i. 1" b]
   402   apply simp
   403   apply (simp only: vector_smult_lzero)
   404   done
   405 
   406 lemma  det_row_operation:
   407   fixes A :: "'a::{comm_ring_1}^'n^'n"
   408   assumes ij: "i \<noteq> j"
   409   shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
   410 proof -
   411   let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
   412   have th: "row i ?Z = row j ?Z" by (vector row_def)
   413   have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
   414     by (vector row_def)
   415   show ?thesis
   416     unfolding det_row_add [of i] det_row_mul[of i] det_identical_rows[OF ij th] th2
   417     by simp
   418 qed
   419 
   420 lemma  det_row_span:
   421   fixes A :: "'a::{field}^'n^'n"
   422   assumes x: "x \<in> vec.span {row j A |j. j \<noteq> i}"
   423   shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
   424   using x
   425 proof (induction rule: vec.span_induct_alt)
   426   case base
   427   have "(if k = i then row i A + 0 else row k A) = row k A" for k
   428     by simp
   429   then show ?case
   430     by (simp add: row_def)
   431 next
   432   case (step c z y)
   433   then obtain j where j: "z = row j A" "i \<noteq> j"
   434     by blast
   435   let ?w = "row i A + y"
   436   have th0: "row i A + (c*s z + y) = ?w + c*s z"
   437     by vector
   438   let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
   439   have thz: "?d z = 0"
   440     apply (rule det_identical_rows[OF j(2)])
   441     using j
   442     apply (vector row_def)
   443     done
   444   have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)"
   445     unfolding th0 ..
   446   then have "?d (row i A + (c*s z + y)) = det A"
   447     unfolding thz step.IH det_row_mul[of i] det_row_add[of i] by simp
   448   then show ?case
   449     unfolding scalar_mult_eq_scaleR .
   450 qed
   451 
   452 lemma  matrix_id [simp]: "det (matrix id) = 1"
   453   by (simp add: matrix_id_mat_1)
   454 
   455 proposition  det_matrix_scaleR [simp]: "det (matrix (((*\<^sub>R) r)) :: real^'n^'n) = r ^ CARD('n::finite)"
   456   apply (subst det_diagonal)
   457    apply (auto simp: matrix_def mat_def)
   458   apply (simp add: cart_eq_inner_axis inner_axis_axis)
   459   done
   460 
   461 text \<open>
   462   May as well do this, though it's a bit unsatisfactory since it ignores
   463   exact duplicates by considering the rows/columns as a set.
   464 \<close>
   465 
   466 lemma  det_dependent_rows:
   467   fixes A:: "'a::{field}^'n^'n"
   468   assumes d: "vec.dependent (rows A)"
   469   shows "det A = 0"
   470 proof -
   471   let ?U = "UNIV :: 'n set"
   472   from d obtain i where i: "row i A \<in> vec.span (rows A - {row i A})"
   473     unfolding vec.dependent_def rows_def by blast
   474   show ?thesis
   475   proof (cases "\<forall>i j. i \<noteq> j \<longrightarrow> row i A \<noteq> row j A")
   476     case True
   477     with i have "vec.span (rows A - {row i A}) \<subseteq> vec.span {row j A |j. j \<noteq> i}"
   478       by (auto simp: rows_def intro!: vec.span_mono)
   479     then have "- row i A \<in> vec.span {row j A|j. j \<noteq> i}"
   480       by (meson i subsetCE vec.span_neg)
   481     from det_row_span[OF this]
   482     have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
   483       unfolding right_minus vector_smult_lzero ..
   484     with det_row_mul[of i 0 "\<lambda>i. 1"]
   485     show ?thesis by simp
   486   next
   487     case False
   488     then obtain j k where jk: "j \<noteq> k" "row j A = row k A"
   489       by auto
   490     from det_identical_rows[OF jk] show ?thesis .
   491   qed
   492 qed
   493 
   494 lemma  det_dependent_columns:
   495   assumes d: "vec.dependent (columns (A::real^'n^'n))"
   496   shows "det A = 0"
   497   by (metis d det_dependent_rows rows_transpose det_transpose)
   498 
   499 text \<open>Multilinearity and the multiplication formula\<close>
   500 
   501 lemma  Cart_lambda_cong: "(\<And>x. f x = g x) \<Longrightarrow> (vec_lambda f::'a^'n) = (vec_lambda g :: 'a^'n)"
   502   by auto
   503 
   504 lemma  det_linear_row_sum:
   505   assumes fS: "finite S"
   506   shows "det ((\<chi> i. if i = k then sum (a i) S else c i)::'a::comm_ring_1^'n^'n) =
   507     sum (\<lambda>j. det ((\<chi> i. if i = k then a  i j else c i)::'a^'n^'n)) S"
   508   using fS  by (induct rule: finite_induct; simp add: det_row_0 det_row_add cong: if_cong)
   509 
   510 lemma  finite_bounded_functions:
   511   assumes fS: "finite S"
   512   shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
   513 proof (induct k)
   514   case 0
   515   have *: "{f. \<forall>i. f i = i} = {id}"
   516     by auto
   517   show ?case
   518     by (auto simp: *)
   519 next
   520   case (Suc k)
   521   let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
   522   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)})"
   523   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)}"
   524     apply (auto simp: image_iff)
   525     apply (rename_tac f)
   526     apply (rule_tac x="f (Suc k)" in bexI)
   527     apply (rule_tac x = "\<lambda>i. if i = Suc k then i else f i" in exI, auto)
   528     done
   529   with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
   530   show ?case
   531     by metis
   532 qed
   533 
   534 
   535 lemma  det_linear_rows_sum_lemma:
   536   assumes fS: "finite S"
   537     and fT: "finite T"
   538   shows "det ((\<chi> i. if i \<in> T then sum (a i) S else c i):: 'a::comm_ring_1^'n^'n) =
   539     sum (\<lambda>f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n))
   540       {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
   541   using fT
   542 proof (induct T arbitrary: a c set: finite)
   543   case empty
   544   have th0: "\<And>x y. (\<chi> i. if i \<in> {} then x i else y i) = (\<chi> i. y i)"
   545     by vector
   546   from empty.prems show ?case
   547     unfolding th0 by (simp add: eq_id_iff)
   548 next
   549   case (insert z T a c)
   550   let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
   551   let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
   552   let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
   553   let ?s = "\<lambda> k a c f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n)"
   554   let ?c = "\<lambda>j i. if i = z then a i j else c i"
   555   have thif: "\<And>a b c d. (if a \<or> b then c else d) = (if a then c else if b then c else d)"
   556     by simp
   557   have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
   558      (if c then (if a then b else d) else (if a then b else e))"
   559     by simp
   560   from \<open>z \<notin> T\<close> have nz: "\<And>i. i \<in> T \<Longrightarrow> i \<noteq> z"
   561     by auto
   562   have "det (\<chi> i. if i \<in> insert z T then sum (a i) S else c i) =
   563     det (\<chi> i. if i = z then sum (a i) S else if i \<in> T then sum (a i) S else c i)"
   564     unfolding insert_iff thif ..
   565   also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<in> T then sum (a i) S else if i = z then a i j else c i))"
   566     unfolding det_linear_row_sum[OF fS]
   567     by (subst thif2) (simp add: nz cong: if_cong)
   568   finally have tha:
   569     "det (\<chi> i. if i \<in> insert z T then sum (a i) S else c i) =
   570      (\<Sum>(j, f)\<in>S \<times> ?F T. det (\<chi> i. if i \<in> T then a i (f i)
   571                                 else if i = z then a i j
   572                                 else c i))"
   573     unfolding insert.hyps unfolding sum.cartesian_product by blast
   574   show ?case unfolding tha
   575     using \<open>z \<notin> T\<close>
   576     by (intro sum.reindex_bij_witness[where i="?k" and j="?h"])
   577        (auto intro!: cong[OF refl[of det]] simp: vec_eq_iff)
   578 qed
   579 
   580 lemma  det_linear_rows_sum:
   581   fixes S :: "'n::finite set"
   582   assumes fS: "finite S"
   583   shows "det (\<chi> i. sum (a i) S) =
   584     sum (\<lambda>f. det (\<chi> i. a i (f i) :: 'a::comm_ring_1 ^ 'n^'n)) {f. \<forall>i. f i \<in> S}"
   585 proof -
   586   have th0: "\<And>x y. ((\<chi> i. if i \<in> (UNIV:: 'n set) then x i else y i) :: 'a^'n^'n) = (\<chi> i. x i)"
   587     by vector
   588   from det_linear_rows_sum_lemma[OF fS, of "UNIV :: 'n set" a, unfolded th0, OF finite]
   589   show ?thesis by simp
   590 qed
   591 
   592 lemma  matrix_mul_sum_alt:
   593   fixes A B :: "'a::comm_ring_1^'n^'n"
   594   shows "A ** B = (\<chi> i. sum (\<lambda>k. A$i$k *s B $ k) (UNIV :: 'n set))"
   595   by (vector matrix_matrix_mult_def sum_component)
   596 
   597 lemma  det_rows_mul:
   598   "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n) =
   599     prod (\<lambda>i. c i) (UNIV:: 'n set) * det((\<chi> i. a i)::'a^'n^'n)"
   600 proof (simp add: det_def sum_distrib_left cong add: prod.cong, rule sum.cong)
   601   let ?U = "UNIV :: 'n set"
   602   let ?PU = "{p. p permutes ?U}"
   603   fix p
   604   assume pU: "p \<in> ?PU"
   605   let ?s = "of_int (sign p)"
   606   from pU have p: "p permutes ?U"
   607     by blast
   608   have "prod (\<lambda>i. c i * a i $ p i) ?U = prod c ?U * prod (\<lambda>i. a i $ p i) ?U"
   609     unfolding prod.distrib ..
   610   then show "?s * (\<Prod>xa\<in>?U. c xa * a xa $ p xa) =
   611     prod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))"
   612     by (simp add: field_simps)
   613 qed rule
   614 
   615 proposition  det_mul:
   616   fixes A B :: "'a::comm_ring_1^'n^'n"
   617   shows "det (A ** B) = det A * det B"
   618 proof -
   619   let ?U = "UNIV :: 'n set"
   620   let ?F = "{f. (\<forall>i \<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
   621   let ?PU = "{p. p permutes ?U}"
   622   have "p \<in> ?F" if "p permutes ?U" for p
   623     by simp
   624   then have PUF: "?PU \<subseteq> ?F" by blast
   625   {
   626     fix f
   627     assume fPU: "f \<in> ?F - ?PU"
   628     have fUU: "f ` ?U \<subseteq> ?U"
   629       using fPU by auto
   630     from fPU have f: "\<forall>i \<in> ?U. f i \<in> ?U" "\<forall>i. i \<notin> ?U \<longrightarrow> f i = i" "\<not>(\<forall>y. \<exists>!x. f x = y)"
   631       unfolding permutes_def by auto
   632 
   633     let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
   634     let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
   635     {
   636       assume fni: "\<not> inj_on f ?U"
   637       then obtain i j where ij: "f i = f j" "i \<noteq> j"
   638         unfolding inj_on_def by blast
   639       then have "row i ?B = row j ?B"
   640         by (vector row_def)
   641       with det_identical_rows[OF ij(2)]
   642       have "det (\<chi> i. A$i$f i *s B$f i) = 0"
   643         unfolding det_rows_mul by force
   644     }
   645     moreover
   646     {
   647       assume fi: "inj_on f ?U"
   648       from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
   649         unfolding inj_on_def by metis
   650       note fs = fi[unfolded surjective_iff_injective_gen[OF finite finite refl fUU, symmetric]]
   651       have "\<exists>!x. f x = y" for y
   652         using fith fs by blast
   653       with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0"
   654         by blast
   655     }
   656     ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0"
   657       by blast
   658   }
   659   then have zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0"
   660     by simp
   661   {
   662     fix p
   663     assume pU: "p \<in> ?PU"
   664     from pU have p: "p permutes ?U"
   665       by blast
   666     let ?s = "\<lambda>p. of_int (sign p)"
   667     let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) * (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
   668     have "(sum (\<lambda>q. ?s q *
   669         (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
   670       (sum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) * (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
   671       unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
   672     proof (rule sum.cong)
   673       fix q
   674       assume qU: "q \<in> ?PU"
   675       then have q: "q permutes ?U"
   676         by blast
   677       from p q have pp: "permutation p" and pq: "permutation q"
   678         unfolding permutation_permutes by auto
   679       have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
   680         "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
   681         unfolding mult.assoc[symmetric]
   682         unfolding of_int_mult[symmetric]
   683         by (simp_all add: sign_idempotent)
   684       have ths: "?s q = ?s p * ?s (q \<circ> inv p)"
   685         using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
   686         by (simp add: th00 ac_simps sign_idempotent sign_compose)
   687       have th001: "prod (\<lambda>i. B$i$ q (inv p i)) ?U = prod ((\<lambda>i. B$i$ q (inv p i)) \<circ> p) ?U"
   688         by (rule prod.permute[OF p])
   689       have thp: "prod (\<lambda>i. (\<chi> i. A$i$p i *s B$p i :: 'a^'n^'n) $i $ q i) ?U =
   690         prod (\<lambda>i. A$i$p i) ?U * prod (\<lambda>i. B$i$ q (inv p i)) ?U"
   691         unfolding th001 prod.distrib[symmetric] o_def permutes_inverses[OF p]
   692         apply (rule prod.cong[OF refl])
   693         using permutes_in_image[OF q]
   694         apply vector
   695         done
   696       show "?s q * prod (\<lambda>i. (((\<chi> i. A$i$p i *s B$p i) :: 'a^'n^'n)$i$q i)) ?U =
   697         ?s p * (prod (\<lambda>i. A$i$p i) ?U) * (?s (q \<circ> inv p) * prod (\<lambda>i. B$i$(q \<circ> inv p) i) ?U)"
   698         using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
   699         by (simp add: sign_nz th00 field_simps sign_idempotent sign_compose)
   700     qed rule
   701   }
   702   then have th2: "sum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
   703     unfolding det_def sum_product
   704     by (rule sum.cong [OF refl])
   705   have "det (A**B) = sum (\<lambda>f.  det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
   706     unfolding matrix_mul_sum_alt det_linear_rows_sum[OF finite]
   707     by simp
   708   also have "\<dots> = sum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
   709     using sum.mono_neutral_cong_left[OF finite PUF zth, symmetric]
   710     unfolding det_rows_mul by auto
   711   finally show ?thesis unfolding th2 .
   712 qed
   713 
   714 
   715 subsection \<open>Relation to invertibility\<close>
   716 
   717 proposition  invertible_det_nz:
   718   fixes A::"'a::{field}^'n^'n"
   719   shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
   720 proof (cases "invertible A")
   721   case True
   722   then obtain B :: "'a^'n^'n" where B: "A ** B = mat 1"
   723     unfolding invertible_right_inverse by blast
   724   then have "det (A ** B) = det (mat 1 :: 'a^'n^'n)"
   725     by simp
   726   then show ?thesis
   727     by (metis True det_I det_mul mult_zero_left one_neq_zero)
   728 next
   729   case False
   730   let ?U = "UNIV :: 'n set"
   731   have fU: "finite ?U"
   732     by simp
   733   from False obtain c i where c: "sum (\<lambda>i. c i *s row i A) ?U = 0" and iU: "i \<in> ?U" and ci: "c i \<noteq> 0"
   734     unfolding invertible_right_inverse matrix_right_invertible_independent_rows
   735     by blast
   736   have thr0: "- row i A = sum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
   737     unfolding sum_cmul  using c ci
   738     by (auto simp: sum.remove[OF fU iU] eq_vector_fraction_iff add_eq_0_iff)
   739   have thr: "- row i A \<in> vec.span {row j A| j. j \<noteq> i}"
   740     unfolding thr0 by (auto intro: vec.span_base vec.span_scale vec.span_sum)
   741   let ?B = "(\<chi> k. if k = i then 0 else row k A) :: 'a^'n^'n"
   742   have thrb: "row i ?B = 0" using iU by (vector row_def)
   743   have "det A = 0"
   744     unfolding det_row_span[OF thr, symmetric] right_minus
   745     unfolding det_zero_row(2)[OF thrb] ..
   746   then show ?thesis
   747     by (simp add: False)
   748 qed
   749 
   750 
   751 lemma  det_nz_iff_inj_gen:
   752   fixes f :: "'a::field^'n \<Rightarrow> 'a::field^'n"
   753   assumes "Vector_Spaces.linear (*s) (*s) f"
   754   shows "det (matrix f) \<noteq> 0 \<longleftrightarrow> inj f"
   755 proof
   756   assume "det (matrix f) \<noteq> 0"
   757   then show "inj f"
   758     using assms invertible_det_nz inj_matrix_vector_mult by force
   759 next
   760   assume "inj f"
   761   show "det (matrix f) \<noteq> 0"
   762     using vec.linear_injective_left_inverse [OF assms \<open>inj f\<close>]
   763     by (metis assms invertible_det_nz invertible_left_inverse matrix_compose_gen matrix_id_mat_1)
   764 qed
   765 
   766 lemma  det_nz_iff_inj:
   767   fixes f :: "real^'n \<Rightarrow> real^'n"
   768   assumes "linear f"
   769   shows "det (matrix f) \<noteq> 0 \<longleftrightarrow> inj f"
   770   using det_nz_iff_inj_gen[of f] assms
   771   unfolding linear_matrix_vector_mul_eq .
   772 
   773 lemma  det_eq_0_rank:
   774   fixes A :: "real^'n^'n"
   775   shows "det A = 0 \<longleftrightarrow> rank A < CARD('n)"
   776   using invertible_det_nz [of A]
   777   by (auto simp: matrix_left_invertible_injective invertible_left_inverse less_rank_noninjective)
   778 
   779 subsubsection%important  \<open>Invertibility of matrices and corresponding linear functions\<close>
   780 
   781 lemma  matrix_left_invertible_gen:
   782   fixes f :: "'a::field^'m \<Rightarrow> 'a::field^'n"
   783   assumes "Vector_Spaces.linear (*s) (*s) f"
   784   shows "((\<exists>B. B ** matrix f = mat 1) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> g \<circ> f = id))"
   785 proof safe
   786   fix B
   787   assume 1: "B ** matrix f = mat 1"
   788   show "\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> g \<circ> f = id"
   789   proof (intro exI conjI)
   790     show "Vector_Spaces.linear (*s) (*s) (\<lambda>y. B *v y)"
   791       by simp
   792     show "((*v) B) \<circ> f = id"
   793       unfolding o_def
   794       by (metis assms 1 eq_id_iff matrix_vector_mul(1) matrix_vector_mul_assoc matrix_vector_mul_lid)
   795   qed
   796 next
   797   fix g
   798   assume "Vector_Spaces.linear (*s) (*s) g" "g \<circ> f = id"
   799   then have "matrix g ** matrix f = mat 1"
   800     by (metis assms matrix_compose_gen matrix_id_mat_1)
   801   then show "\<exists>B. B ** matrix f = mat 1" ..
   802 qed
   803 
   804 lemma  matrix_left_invertible:
   805   "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"
   806   using matrix_left_invertible_gen[of f]
   807   by (auto simp: linear_matrix_vector_mul_eq)
   808 
   809 lemma  matrix_right_invertible_gen:
   810   fixes f :: "'a::field^'m \<Rightarrow> 'a^'n"
   811   assumes "Vector_Spaces.linear (*s) (*s) f"
   812   shows "((\<exists>B. matrix f ** B = mat 1) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id))"
   813 proof safe
   814   fix B
   815   assume 1: "matrix f ** B = mat 1"
   816   show "\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id"
   817   proof (intro exI conjI)
   818     show "Vector_Spaces.linear (*s) (*s) ((*v) B)"
   819       by simp
   820     show "f \<circ> (*v) B = id"
   821       using 1 assms comp_apply eq_id_iff vec.linear_id matrix_id_mat_1 matrix_vector_mul_assoc matrix_works
   822       by (metis (no_types, hide_lams))
   823   qed
   824 next
   825   fix g
   826   assume "Vector_Spaces.linear (*s) (*s) g" and "f \<circ> g = id"
   827   then have "matrix f ** matrix g = mat 1"
   828     by (metis assms matrix_compose_gen matrix_id_mat_1)
   829   then show "\<exists>B. matrix f ** B = mat 1" ..
   830 qed
   831 
   832 lemma  matrix_right_invertible:
   833   "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"
   834   using matrix_right_invertible_gen[of f]
   835   by (auto simp: linear_matrix_vector_mul_eq)
   836 
   837 lemma  matrix_invertible_gen:
   838   fixes f :: "'a::field^'m \<Rightarrow> 'a::field^'n"
   839   assumes "Vector_Spaces.linear (*s) (*s) f"
   840   shows  "invertible (matrix f) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
   841     (is "?lhs = ?rhs")
   842 proof
   843   assume ?lhs then show ?rhs
   844     by (metis assms invertible_def left_right_inverse_eq matrix_left_invertible_gen matrix_right_invertible_gen)
   845 next
   846   assume ?rhs then show ?lhs
   847     by (metis assms invertible_def matrix_compose_gen matrix_id_mat_1)
   848 qed
   849 
   850 lemma  matrix_invertible:
   851   "linear f \<Longrightarrow> invertible (matrix f) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
   852   for f::"real^'m \<Rightarrow> real^'n"
   853   using matrix_invertible_gen[of f]
   854   by (auto simp: linear_matrix_vector_mul_eq)
   855 
   856 lemma  invertible_eq_bij:
   857   fixes m :: "'a::field^'m^'n"
   858   shows "invertible m \<longleftrightarrow> bij ((*v) m)"
   859   using matrix_invertible_gen[OF matrix_vector_mul_linear_gen, of m, simplified matrix_of_matrix_vector_mul]
   860   by (metis bij_betw_def left_right_inverse_eq matrix_vector_mul_linear_gen o_bij
   861       vec.linear_injective_left_inverse vec.linear_surjective_right_inverse)
   862 
   863 
   864 subsection \<open>Cramer's rule\<close>
   865 
   866 lemma  cramer_lemma_transpose:
   867   fixes A:: "'a::{field}^'n^'n"
   868     and x :: "'a::{field}^'n"
   869   shows "det ((\<chi> i. if i = k then sum (\<lambda>i. x$i *s row i A) (UNIV::'n set)
   870                              else row i A)::'a::{field}^'n^'n) = x$k * det A"
   871   (is "?lhs = ?rhs")
   872 proof -
   873   let ?U = "UNIV :: 'n set"
   874   let ?Uk = "?U - {k}"
   875   have U: "?U = insert k ?Uk"
   876     by blast
   877   have kUk: "k \<notin> ?Uk"
   878     by simp
   879   have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
   880     by (vector field_simps)
   881   have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f"
   882     by auto
   883   have "(\<chi> i. row i A) = A" by (vector row_def)
   884   then have thd1: "det (\<chi> i. row i A) = det A"
   885     by simp
   886   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"
   887     by (force intro: det_row_span vec.span_sum vec.span_scale vec.span_base)
   888   show "?lhs = x$k * det A"
   889     apply (subst U)
   890     unfolding sum.insert[OF finite kUk]
   891     apply (subst th00)
   892     unfolding add.assoc
   893     apply (subst det_row_add)
   894     unfolding thd0
   895     unfolding det_row_mul
   896     unfolding th001[of k "\<lambda>i. row i A"]
   897     unfolding thd1
   898     apply (simp add: field_simps)
   899     done
   900 qed
   901 
   902 proposition  cramer_lemma:
   903   fixes A :: "'a::{field}^'n^'n"
   904   shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: 'a::{field}^'n^'n) = x$k * det A"
   905 proof -
   906   let ?U = "UNIV :: 'n set"
   907   have *: "\<And>c. sum (\<lambda>i. c i *s row i (transpose A)) ?U = sum (\<lambda>i. c i *s column i A) ?U"
   908     by (auto intro: sum.cong)
   909   show ?thesis
   910     unfolding matrix_mult_sum
   911     unfolding cramer_lemma_transpose[of k x "transpose A", unfolded det_transpose, symmetric]
   912     unfolding *[of "\<lambda>i. x$i"]
   913     apply (subst det_transpose[symmetric])
   914     apply (rule cong[OF refl[of det]])
   915     apply (vector transpose_def column_def row_def)
   916     done
   917 qed
   918 
   919 proposition  cramer:
   920   fixes A ::"'a::{field}^'n^'n"
   921   assumes d0: "det A \<noteq> 0"
   922   shows "A *v x = b \<longleftrightarrow> x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j) / det A)"
   923 proof -
   924   from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
   925     unfolding invertible_det_nz[symmetric] invertible_def
   926     by blast
   927   have "(A ** B) *v b = b"
   928     by (simp add: B)
   929   then have "A *v (B *v b) = b"
   930     by (simp add: matrix_vector_mul_assoc)
   931   then have xe: "\<exists>x. A *v x = b"
   932     by blast
   933   {
   934     fix x
   935     assume x: "A *v x = b"
   936     have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j) / det A)"
   937       unfolding x[symmetric]
   938       using d0 by (simp add: vec_eq_iff cramer_lemma field_simps)
   939   }
   940   with xe show ?thesis
   941     by auto
   942 qed
   943 
   944 lemma  det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
   945   by (simp add: det_def sign_id)
   946 
   947 lemma  det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
   948 proof -
   949   have f12: "finite {2::2}" "1 \<notin> {2::2}" by auto
   950   show ?thesis
   951     unfolding det_def UNIV_2
   952     unfolding sum_over_permutations_insert[OF f12]
   953     unfolding permutes_sing
   954     by (simp add: sign_swap_id sign_id swap_id_eq)
   955 qed
   956 
   957 lemma  det_3:
   958   "det (A::'a::comm_ring_1^3^3) =
   959     A$1$1 * A$2$2 * A$3$3 +
   960     A$1$2 * A$2$3 * A$3$1 +
   961     A$1$3 * A$2$1 * A$3$2 -
   962     A$1$1 * A$2$3 * A$3$2 -
   963     A$1$2 * A$2$1 * A$3$3 -
   964     A$1$3 * A$2$2 * A$3$1"
   965 proof -
   966   have f123: "finite {2::3, 3}" "1 \<notin> {2::3, 3}"
   967     by auto
   968   have f23: "finite {3::3}" "2 \<notin> {3::3}"
   969     by auto
   970 
   971   show ?thesis
   972     unfolding det_def UNIV_3
   973     unfolding sum_over_permutations_insert[OF f123]
   974     unfolding sum_over_permutations_insert[OF f23]
   975     unfolding permutes_sing
   976     by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
   977 qed
   978 
   979 proposition  det_orthogonal_matrix:
   980   fixes Q:: "'a::linordered_idom^'n^'n"
   981   assumes oQ: "orthogonal_matrix Q"
   982   shows "det Q = 1 \<or> det Q = - 1"
   983 proof -
   984   have "Q ** transpose Q = mat 1"
   985     by (metis oQ orthogonal_matrix_def)
   986   then have "det (Q ** transpose Q) = det (mat 1:: 'a^'n^'n)"
   987     by simp
   988   then have "det Q * det Q = 1"
   989     by (simp add: det_mul)
   990   then show ?thesis
   991     by (simp add: square_eq_1_iff)
   992 qed
   993 
   994 proposition  orthogonal_transformation_det [simp]:
   995   fixes f :: "real^'n \<Rightarrow> real^'n"
   996   shows "orthogonal_transformation f \<Longrightarrow> \<bar>det (matrix f)\<bar> = 1"
   997   using%unimportant det_orthogonal_matrix orthogonal_transformation_matrix by fastforce
   998 
   999 subsection  \<open>Rotation, reflection, rotoinversion\<close>
  1000 
  1001 definition%important  "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
  1002 definition%important  "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"
  1003 
  1004 lemma  orthogonal_rotation_or_rotoinversion:
  1005   fixes Q :: "'a::linordered_idom^'n^'n"
  1006   shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
  1007   by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)
  1008 
  1009 text\<open> Slightly stronger results giving rotation, but only in two or more dimensions\<close>
  1010 
  1011 lemma  rotation_matrix_exists_basis:
  1012   fixes a :: "real^'n"
  1013   assumes 2: "2 \<le> CARD('n)" and "norm a = 1"
  1014   obtains A where "rotation_matrix A" "A *v (axis k 1) = a"
  1015 proof -
  1016   obtain A where "orthogonal_matrix A" and A: "A *v (axis k 1) = a"
  1017     using orthogonal_matrix_exists_basis assms by metis
  1018   with orthogonal_rotation_or_rotoinversion
  1019   consider "rotation_matrix A" | "rotoinversion_matrix A"
  1020     by metis
  1021   then show thesis
  1022   proof cases
  1023     assume "rotation_matrix A"
  1024     then show ?thesis
  1025       using \<open>A *v axis k 1 = a\<close> that by auto
  1026   next
  1027     from ex_card[OF 2] obtain h i::'n where "h \<noteq> i"
  1028       by (auto simp add: eval_nat_numeral card_Suc_eq)
  1029     then obtain j where "j \<noteq> k"
  1030       by (metis (full_types))
  1031     let ?TA = "transpose A"
  1032     let ?A = "\<chi> i. if i = j then - 1 *\<^sub>R (?TA $ i) else ?TA $i"
  1033     assume "rotoinversion_matrix A"
  1034     then have [simp]: "det A = -1"
  1035       by (simp add: rotoinversion_matrix_def)
  1036     show ?thesis
  1037     proof
  1038       have [simp]: "row i (\<chi> i. if i = j then - 1 *\<^sub>R ?TA $ i else ?TA $ i) = (if i = j then - row i ?TA else row i ?TA)" for i
  1039         by (auto simp: row_def)
  1040       have "orthogonal_matrix ?A"
  1041         unfolding orthogonal_matrix_orthonormal_rows
  1042         using \<open>orthogonal_matrix A\<close> by (auto simp: orthogonal_matrix_orthonormal_columns orthogonal_clauses)
  1043       then show "rotation_matrix (transpose ?A)"
  1044         unfolding rotation_matrix_def
  1045         by (simp add: det_row_mul[of j _ "\<lambda>i. ?TA $ i", unfolded scalar_mult_eq_scaleR])
  1046       show "transpose ?A *v axis k 1 = a"
  1047         using \<open>j \<noteq> k\<close> A by (simp add: matrix_vector_column axis_def scalar_mult_eq_scaleR if_distrib [of "\<lambda>z. z *\<^sub>R c" for c] cong: if_cong)
  1048     qed
  1049   qed
  1050 qed
  1051 
  1052 lemma  rotation_exists_1:
  1053   fixes a :: "real^'n"
  1054   assumes "2 \<le> CARD('n)" "norm a = 1" "norm b = 1"
  1055   obtains f where "orthogonal_transformation f" "det(matrix f) = 1" "f a = b"
  1056 proof -
  1057   obtain k::'n where True
  1058     by simp
  1059   obtain A B where AB: "rotation_matrix A" "rotation_matrix B"
  1060                and eq: "A *v (axis k 1) = a" "B *v (axis k 1) = b"
  1061     using rotation_matrix_exists_basis assms by metis
  1062   let ?f = "\<lambda>x. (B ** transpose A) *v x"
  1063   show thesis
  1064   proof
  1065     show "orthogonal_transformation ?f"
  1066       using AB orthogonal_matrix_mul orthogonal_transformation_matrix rotation_matrix_def matrix_vector_mul_linear by force
  1067     show "det (matrix ?f) = 1"
  1068       using AB by (auto simp: det_mul rotation_matrix_def)
  1069     show "?f a = b"
  1070       using AB unfolding orthogonal_matrix_def rotation_matrix_def
  1071       by (metis eq matrix_mul_rid matrix_vector_mul_assoc)
  1072   qed
  1073 qed
  1074 
  1075 lemma  rotation_exists:
  1076   fixes a :: "real^'n"
  1077   assumes 2: "2 \<le> CARD('n)" and eq: "norm a = norm b"
  1078   obtains f where "orthogonal_transformation f" "det(matrix f) = 1" "f a = b"
  1079 proof (cases "a = 0 \<or> b = 0")
  1080   case True
  1081   with assms have "a = 0" "b = 0"
  1082     by auto
  1083   then show ?thesis
  1084     by (metis eq_id_iff matrix_id orthogonal_transformation_id that)
  1085 next
  1086   case False
  1087   then obtain f where f: "orthogonal_transformation f" "det (matrix f) = 1"
  1088     and f': "f (a /\<^sub>R norm a) = b /\<^sub>R norm b"
  1089     using rotation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b", OF 2] by auto
  1090   then interpret linear f by (simp add: orthogonal_transformation)
  1091   have "f a = b"
  1092     using f' False
  1093     by (simp add: eq scale)
  1094   with f show thesis ..
  1095 qed
  1096 
  1097 lemma  rotation_rightward_line:
  1098   fixes a :: "real^'n"
  1099   obtains f where "orthogonal_transformation f" "2 \<le> CARD('n) \<Longrightarrow> det(matrix f) = 1"
  1100                   "f(norm a *\<^sub>R axis k 1) = a"
  1101 proof (cases "CARD('n) = 1")
  1102   case True
  1103   obtain f where "orthogonal_transformation f" "f (norm a *\<^sub>R axis k (1::real)) = a"
  1104   proof (rule orthogonal_transformation_exists)
  1105     show "norm (norm a *\<^sub>R axis k (1::real)) = norm a"
  1106       by simp
  1107   qed auto
  1108   then show thesis
  1109     using True that by auto
  1110 next
  1111   case False
  1112   obtain f where "orthogonal_transformation f" "det(matrix f) = 1" "f (norm a *\<^sub>R axis k 1) = a"
  1113   proof (rule rotation_exists)
  1114     show "2 \<le> CARD('n)"
  1115       using False one_le_card_finite [where 'a='n] by linarith
  1116     show "norm (norm a *\<^sub>R axis k (1::real)) = norm a"
  1117       by simp
  1118   qed auto
  1119   then show thesis
  1120     using that by blast
  1121 qed
  1122 
  1123 end