src/HOL/Analysis/Determinants.thy
author hoelzl
Mon Aug 08 14:13:14 2016 +0200 (2016-08-08)
changeset 63627 6ddb43c6b711
parent 63469 src/HOL/Multivariate_Analysis/Determinants.thy@b6900858dcb9
child 63918 6bf55e6e0b75
permissions -rw-r--r--
rename HOL-Multivariate_Analysis to HOL-Analysis.
hoelzl@63627
     1
(*  Title:      HOL/Analysis/Determinants.thy
wenzelm@41959
     2
    Author:     Amine Chaieb, University of Cambridge
himmelma@33175
     3
*)
himmelma@33175
     4
wenzelm@60420
     5
section \<open>Traces, Determinant of square matrices and some properties\<close>
himmelma@33175
     6
himmelma@33175
     7
theory Determinants
huffman@44228
     8
imports
huffman@44228
     9
  Cartesian_Euclidean_Space
huffman@44228
    10
  "~~/src/HOL/Library/Permutations"
himmelma@33175
    11
begin
himmelma@33175
    12
wenzelm@60420
    13
subsection \<open>Trace\<close>
himmelma@33175
    14
wenzelm@53253
    15
definition trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a"
wenzelm@53253
    16
  where "trace A = setsum (\<lambda>i. ((A$i)$i)) (UNIV::'n set)"
himmelma@33175
    17
wenzelm@53854
    18
lemma trace_0: "trace (mat 0) = 0"
himmelma@33175
    19
  by (simp add: trace_def mat_def)
himmelma@33175
    20
wenzelm@53854
    21
lemma trace_I: "trace (mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))"
himmelma@33175
    22
  by (simp add: trace_def mat_def)
himmelma@33175
    23
hoelzl@34291
    24
lemma trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
haftmann@57418
    25
  by (simp add: trace_def setsum.distrib)
himmelma@33175
    26
hoelzl@34291
    27
lemma trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
himmelma@33175
    28
  by (simp add: trace_def setsum_subtractf)
himmelma@33175
    29
wenzelm@53854
    30
lemma trace_mul_sym: "trace ((A::'a::comm_semiring_1^'n^'m) ** B) = trace (B**A)"
himmelma@33175
    31
  apply (simp add: trace_def matrix_matrix_mult_def)
haftmann@57418
    32
  apply (subst setsum.commute)
haftmann@57512
    33
  apply (simp add: mult.commute)
wenzelm@53253
    34
  done
himmelma@33175
    35
wenzelm@60420
    36
text \<open>Definition of determinant.\<close>
himmelma@33175
    37
hoelzl@34291
    38
definition det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
wenzelm@53253
    39
  "det A =
wenzelm@53253
    40
    setsum (\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set))
wenzelm@53253
    41
      {p. p permutes (UNIV :: 'n set)}"
himmelma@33175
    42
wenzelm@60420
    43
text \<open>A few general lemmas we need below.\<close>
himmelma@33175
    44
himmelma@33175
    45
lemma setprod_permute:
himmelma@33175
    46
  assumes p: "p permutes S"
wenzelm@53854
    47
  shows "setprod f S = setprod (f \<circ> p) S"
haftmann@51489
    48
  using assms by (fact setprod.permute)
himmelma@33175
    49
wenzelm@53253
    50
lemma setproduct_permute_nat_interval:
wenzelm@53854
    51
  fixes m n :: nat
wenzelm@53854
    52
  shows "p permutes {m..n} \<Longrightarrow> setprod f {m..n} = setprod (f \<circ> p) {m..n}"
himmelma@33175
    53
  by (blast intro!: setprod_permute)
himmelma@33175
    54
wenzelm@60420
    55
text \<open>Basic determinant properties.\<close>
himmelma@33175
    56
hoelzl@35150
    57
lemma det_transpose: "det (transpose A) = det (A::'a::comm_ring_1 ^'n^'n)"
wenzelm@53253
    58
proof -
himmelma@33175
    59
  let ?di = "\<lambda>A i j. A$i$j"
himmelma@33175
    60
  let ?U = "(UNIV :: 'n set)"
himmelma@33175
    61
  have fU: "finite ?U" by simp
wenzelm@53253
    62
  {
wenzelm@53253
    63
    fix p
wenzelm@53253
    64
    assume p: "p \<in> {p. p permutes ?U}"
wenzelm@53854
    65
    from p have pU: "p permutes ?U"
wenzelm@53854
    66
      by blast
himmelma@33175
    67
    have sth: "sign (inv p) = sign p"
huffman@44260
    68
      by (metis sign_inverse fU p mem_Collect_eq permutation_permutes)
himmelma@33175
    69
    from permutes_inj[OF pU]
wenzelm@53854
    70
    have pi: "inj_on p ?U"
wenzelm@53854
    71
      by (blast intro: subset_inj_on)
himmelma@33175
    72
    from permutes_image[OF pU]
wenzelm@53253
    73
    have "setprod (\<lambda>i. ?di (transpose A) i (inv p i)) ?U =
wenzelm@53854
    74
      setprod (\<lambda>i. ?di (transpose A) i (inv p i)) (p ` ?U)"
wenzelm@53854
    75
      by simp
wenzelm@53854
    76
    also have "\<dots> = setprod ((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) ?U"
haftmann@57418
    77
      unfolding setprod.reindex[OF pi] ..
himmelma@33175
    78
    also have "\<dots> = setprod (\<lambda>i. ?di A i (p i)) ?U"
wenzelm@53253
    79
    proof -
wenzelm@53253
    80
      {
wenzelm@53253
    81
        fix i
wenzelm@53253
    82
        assume i: "i \<in> ?U"
himmelma@33175
    83
        from i permutes_inv_o[OF pU] permutes_in_image[OF pU]
wenzelm@53854
    84
        have "((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) i = ?di A i (p i)"
wenzelm@53253
    85
          unfolding transpose_def by (simp add: fun_eq_iff)
wenzelm@53253
    86
      }
wenzelm@53854
    87
      then show "setprod ((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) ?U =
wenzelm@53854
    88
        setprod (\<lambda>i. ?di A i (p i)) ?U"
haftmann@57418
    89
        by (auto intro: setprod.cong)
himmelma@33175
    90
    qed
wenzelm@53253
    91
    finally have "of_int (sign (inv p)) * (setprod (\<lambda>i. ?di (transpose A) i (inv p i)) ?U) =
wenzelm@53854
    92
      of_int (sign p) * (setprod (\<lambda>i. ?di A i (p i)) ?U)"
wenzelm@53854
    93
      using sth by simp
wenzelm@53253
    94
  }
wenzelm@53253
    95
  then show ?thesis
wenzelm@53253
    96
    unfolding det_def
wenzelm@53253
    97
    apply (subst setsum_permutations_inverse)
haftmann@57418
    98
    apply (rule setsum.cong)
haftmann@57418
    99
    apply (rule refl)
wenzelm@53253
   100
    apply blast
wenzelm@53253
   101
    done
himmelma@33175
   102
qed
himmelma@33175
   103
himmelma@33175
   104
lemma det_lowerdiagonal:
hoelzl@34291
   105
  fixes A :: "'a::comm_ring_1^('n::{finite,wellorder})^('n::{finite,wellorder})"
himmelma@33175
   106
  assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
himmelma@33175
   107
  shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
wenzelm@53253
   108
proof -
himmelma@33175
   109
  let ?U = "UNIV:: 'n set"
himmelma@33175
   110
  let ?PU = "{p. p permutes ?U}"
himmelma@33175
   111
  let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
wenzelm@53854
   112
  have fU: "finite ?U"
wenzelm@53854
   113
    by simp
himmelma@33175
   114
  from finite_permutations[OF fU] have fPU: "finite ?PU" .
wenzelm@53854
   115
  have id0: "{id} \<subseteq> ?PU"
wenzelm@53854
   116
    by (auto simp add: permutes_id)
wenzelm@53253
   117
  {
wenzelm@53253
   118
    fix p
wenzelm@53854
   119
    assume p: "p \<in> ?PU - {id}"
wenzelm@53253
   120
    from p have pU: "p permutes ?U" and pid: "p \<noteq> id"
wenzelm@53253
   121
      by blast+
wenzelm@53253
   122
    from permutes_natset_le[OF pU] pid obtain i where i: "p i > i"
wenzelm@53253
   123
      by (metis not_le)
wenzelm@53253
   124
    from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0"
wenzelm@53253
   125
      by blast
wenzelm@53253
   126
    from setprod_zero[OF fU ex] have "?pp p = 0"
wenzelm@53253
   127
      by simp
wenzelm@53253
   128
  }
wenzelm@53854
   129
  then have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
wenzelm@53253
   130
    by blast
haftmann@57418
   131
  from setsum.mono_neutral_cong_left[OF fPU id0 p0] show ?thesis
himmelma@33175
   132
    unfolding det_def by (simp add: sign_id)
himmelma@33175
   133
qed
himmelma@33175
   134
himmelma@33175
   135
lemma det_upperdiagonal:
hoelzl@34291
   136
  fixes A :: "'a::comm_ring_1^'n::{finite,wellorder}^'n::{finite,wellorder}"
himmelma@33175
   137
  assumes ld: "\<And>i j. i > j \<Longrightarrow> A$i$j = 0"
himmelma@33175
   138
  shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
wenzelm@53253
   139
proof -
himmelma@33175
   140
  let ?U = "UNIV:: 'n set"
himmelma@33175
   141
  let ?PU = "{p. p permutes ?U}"
himmelma@33175
   142
  let ?pp = "(\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
wenzelm@53854
   143
  have fU: "finite ?U"
wenzelm@53854
   144
    by simp
himmelma@33175
   145
  from finite_permutations[OF fU] have fPU: "finite ?PU" .
wenzelm@53854
   146
  have id0: "{id} \<subseteq> ?PU"
wenzelm@53854
   147
    by (auto simp add: permutes_id)
wenzelm@53253
   148
  {
wenzelm@53253
   149
    fix p
wenzelm@53854
   150
    assume p: "p \<in> ?PU - {id}"
wenzelm@53253
   151
    from p have pU: "p permutes ?U" and pid: "p \<noteq> id"
wenzelm@53253
   152
      by blast+
wenzelm@53253
   153
    from permutes_natset_ge[OF pU] pid obtain i where i: "p i < i"
wenzelm@53253
   154
      by (metis not_le)
wenzelm@53854
   155
    from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0"
wenzelm@53854
   156
      by blast
wenzelm@53854
   157
    from setprod_zero[OF fU ex] have "?pp p = 0"
wenzelm@53854
   158
      by simp
wenzelm@53253
   159
  }
wenzelm@53253
   160
  then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0"
wenzelm@53253
   161
    by blast
haftmann@57418
   162
  from setsum.mono_neutral_cong_left[OF fPU id0 p0] show ?thesis
himmelma@33175
   163
    unfolding det_def by (simp add: sign_id)
himmelma@33175
   164
qed
himmelma@33175
   165
himmelma@33175
   166
lemma det_diagonal:
hoelzl@34291
   167
  fixes A :: "'a::comm_ring_1^'n^'n"
himmelma@33175
   168
  assumes ld: "\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0"
himmelma@33175
   169
  shows "det A = setprod (\<lambda>i. A$i$i) (UNIV::'n set)"
wenzelm@53253
   170
proof -
himmelma@33175
   171
  let ?U = "UNIV:: 'n set"
himmelma@33175
   172
  let ?PU = "{p. p permutes ?U}"
himmelma@33175
   173
  let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
himmelma@33175
   174
  have fU: "finite ?U" by simp
himmelma@33175
   175
  from finite_permutations[OF fU] have fPU: "finite ?PU" .
wenzelm@53854
   176
  have id0: "{id} \<subseteq> ?PU"
wenzelm@53854
   177
    by (auto simp add: permutes_id)
wenzelm@53253
   178
  {
wenzelm@53253
   179
    fix p
wenzelm@53253
   180
    assume p: "p \<in> ?PU - {id}"
wenzelm@53854
   181
    then have "p \<noteq> id"
wenzelm@53854
   182
      by simp
wenzelm@53854
   183
    then obtain i where i: "p i \<noteq> i"
wenzelm@53854
   184
      unfolding fun_eq_iff by auto
wenzelm@53854
   185
    from ld [OF i [symmetric]] have ex:"\<exists>i \<in> ?U. A$i$p i = 0"
wenzelm@53854
   186
      by blast
wenzelm@53854
   187
    from setprod_zero [OF fU ex] have "?pp p = 0"
wenzelm@53854
   188
      by simp
wenzelm@53854
   189
  }
wenzelm@53854
   190
  then have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
wenzelm@53854
   191
    by blast
haftmann@57418
   192
  from setsum.mono_neutral_cong_left[OF fPU id0 p0] show ?thesis
himmelma@33175
   193
    unfolding det_def by (simp add: sign_id)
himmelma@33175
   194
qed
himmelma@33175
   195
hoelzl@34291
   196
lemma det_I: "det (mat 1 :: 'a::comm_ring_1^'n^'n) = 1"
wenzelm@53253
   197
proof -
himmelma@33175
   198
  let ?A = "mat 1 :: 'a::comm_ring_1^'n^'n"
himmelma@33175
   199
  let ?U = "UNIV :: 'n set"
himmelma@33175
   200
  let ?f = "\<lambda>i j. ?A$i$j"
wenzelm@53253
   201
  {
wenzelm@53253
   202
    fix i
wenzelm@53253
   203
    assume i: "i \<in> ?U"
wenzelm@53854
   204
    have "?f i i = 1"
wenzelm@53854
   205
      using i by (vector mat_def)
wenzelm@53253
   206
  }
wenzelm@53253
   207
  then have th: "setprod (\<lambda>i. ?f i i) ?U = setprod (\<lambda>x. 1) ?U"
haftmann@57418
   208
    by (auto intro: setprod.cong)
wenzelm@53253
   209
  {
wenzelm@53253
   210
    fix i j
wenzelm@53253
   211
    assume i: "i \<in> ?U" and j: "j \<in> ?U" and ij: "i \<noteq> j"
wenzelm@53854
   212
    have "?f i j = 0" using i j ij
wenzelm@53854
   213
      by (vector mat_def)
wenzelm@53253
   214
  }
wenzelm@53854
   215
  then have "det ?A = setprod (\<lambda>i. ?f i i) ?U"
wenzelm@53854
   216
    using det_diagonal by blast
wenzelm@53854
   217
  also have "\<dots> = 1"
haftmann@57418
   218
    unfolding th setprod.neutral_const ..
himmelma@33175
   219
  finally show ?thesis .
himmelma@33175
   220
qed
himmelma@33175
   221
hoelzl@34291
   222
lemma det_0: "det (mat 0 :: 'a::comm_ring_1^'n^'n) = 0"
himmelma@33175
   223
  by (simp add: det_def setprod_zero)
himmelma@33175
   224
himmelma@33175
   225
lemma det_permute_rows:
hoelzl@34291
   226
  fixes A :: "'a::comm_ring_1^'n^'n"
himmelma@33175
   227
  assumes p: "p permutes (UNIV :: 'n::finite set)"
wenzelm@53854
   228
  shows "det (\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
haftmann@57512
   229
  apply (simp add: det_def setsum_right_distrib mult.assoc[symmetric])
himmelma@33175
   230
  apply (subst sum_permutations_compose_right[OF p])
haftmann@57418
   231
proof (rule setsum.cong)
himmelma@33175
   232
  let ?U = "UNIV :: 'n set"
himmelma@33175
   233
  let ?PU = "{p. p permutes ?U}"
wenzelm@53253
   234
  fix q
wenzelm@53253
   235
  assume qPU: "q \<in> ?PU"
wenzelm@53854
   236
  have fU: "finite ?U"
wenzelm@53854
   237
    by simp
wenzelm@53253
   238
  from qPU have q: "q permutes ?U"
wenzelm@53253
   239
    by blast
himmelma@33175
   240
  from p q have pp: "permutation p" and qp: "permutation q"
himmelma@33175
   241
    by (metis fU permutation_permutes)+
himmelma@33175
   242
  from permutes_inv[OF p] have ip: "inv p permutes ?U" .
wenzelm@53854
   243
  have "setprod (\<lambda>i. A$p i$ (q \<circ> p) i) ?U = setprod ((\<lambda>i. A$p i$(q \<circ> p) i) \<circ> inv p) ?U"
wenzelm@53253
   244
    by (simp only: setprod_permute[OF ip, symmetric])
wenzelm@53854
   245
  also have "\<dots> = setprod (\<lambda>i. A $ (p \<circ> inv p) i $ (q \<circ> (p \<circ> inv p)) i) ?U"
wenzelm@53253
   246
    by (simp only: o_def)
wenzelm@53253
   247
  also have "\<dots> = setprod (\<lambda>i. A$i$q i) ?U"
wenzelm@53253
   248
    by (simp only: o_def permutes_inverses[OF p])
wenzelm@53854
   249
  finally have thp: "setprod (\<lambda>i. A$p i$ (q \<circ> p) i) ?U = setprod (\<lambda>i. A$i$q i) ?U"
wenzelm@53253
   250
    by blast
wenzelm@53854
   251
  show "of_int (sign (q \<circ> p)) * setprod (\<lambda>i. A$ p i$ (q \<circ> p) i) ?U =
wenzelm@53253
   252
    of_int (sign p) * of_int (sign q) * setprod (\<lambda>i. A$i$q i) ?U"
haftmann@57512
   253
    by (simp only: thp sign_compose[OF qp pp] mult.commute of_int_mult)
haftmann@57418
   254
qed rule
himmelma@33175
   255
himmelma@33175
   256
lemma det_permute_columns:
hoelzl@34291
   257
  fixes A :: "'a::comm_ring_1^'n^'n"
himmelma@33175
   258
  assumes p: "p permutes (UNIV :: 'n set)"
himmelma@33175
   259
  shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
wenzelm@53253
   260
proof -
himmelma@33175
   261
  let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
hoelzl@35150
   262
  let ?At = "transpose A"
hoelzl@35150
   263
  have "of_int (sign p) * det A = det (transpose (\<chi> i. transpose A $ p i))"
hoelzl@35150
   264
    unfolding det_permute_rows[OF p, of ?At] det_transpose ..
himmelma@33175
   265
  moreover
hoelzl@35150
   266
  have "?Ap = transpose (\<chi> i. transpose A $ p i)"
huffman@44228
   267
    by (simp add: transpose_def vec_eq_iff)
wenzelm@53854
   268
  ultimately show ?thesis
wenzelm@53854
   269
    by simp
himmelma@33175
   270
qed
himmelma@33175
   271
himmelma@33175
   272
lemma det_identical_rows:
haftmann@35028
   273
  fixes A :: "'a::linordered_idom^'n^'n"
himmelma@33175
   274
  assumes ij: "i \<noteq> j"
wenzelm@53253
   275
    and r: "row i A = row j A"
himmelma@33175
   276
  shows "det A = 0"
himmelma@33175
   277
proof-
wenzelm@53253
   278
  have tha: "\<And>(a::'a) b. a = b \<Longrightarrow> b = - a \<Longrightarrow> a = 0"
himmelma@33175
   279
    by simp
huffman@47108
   280
  have th1: "of_int (-1) = - 1" by simp
himmelma@33175
   281
  let ?p = "Fun.swap i j id"
himmelma@33175
   282
  let ?A = "\<chi> i. A $ ?p i"
haftmann@56545
   283
  from r have "A = ?A" by (simp add: vec_eq_iff row_def Fun.swap_def)
wenzelm@53253
   284
  then have "det A = det ?A" by simp
himmelma@33175
   285
  moreover have "det A = - det ?A"
himmelma@33175
   286
    by (simp add: det_permute_rows[OF permutes_swap_id] sign_swap_id ij th1)
himmelma@33175
   287
  ultimately show "det A = 0" by (metis tha)
himmelma@33175
   288
qed
himmelma@33175
   289
himmelma@33175
   290
lemma det_identical_columns:
haftmann@35028
   291
  fixes A :: "'a::linordered_idom^'n^'n"
himmelma@33175
   292
  assumes ij: "i \<noteq> j"
wenzelm@53253
   293
    and r: "column i A = column j A"
himmelma@33175
   294
  shows "det A = 0"
wenzelm@53253
   295
  apply (subst det_transpose[symmetric])
wenzelm@53253
   296
  apply (rule det_identical_rows[OF ij])
wenzelm@53253
   297
  apply (metis row_transpose r)
wenzelm@53253
   298
  done
himmelma@33175
   299
himmelma@33175
   300
lemma det_zero_row:
hoelzl@34291
   301
  fixes A :: "'a::{idom, ring_char_0}^'n^'n"
himmelma@33175
   302
  assumes r: "row i A = 0"
himmelma@33175
   303
  shows "det A = 0"
wenzelm@53253
   304
  using r
wenzelm@53253
   305
  apply (simp add: row_def det_def vec_eq_iff)
haftmann@57418
   306
  apply (rule setsum.neutral)
wenzelm@53253
   307
  apply (auto simp: sign_nz)
wenzelm@53253
   308
  done
himmelma@33175
   309
himmelma@33175
   310
lemma det_zero_column:
hoelzl@34291
   311
  fixes A :: "'a::{idom,ring_char_0}^'n^'n"
himmelma@33175
   312
  assumes r: "column i A = 0"
himmelma@33175
   313
  shows "det A = 0"
hoelzl@35150
   314
  apply (subst det_transpose[symmetric])
himmelma@33175
   315
  apply (rule det_zero_row [of i])
wenzelm@53253
   316
  apply (metis row_transpose r)
wenzelm@53253
   317
  done
himmelma@33175
   318
himmelma@33175
   319
lemma det_row_add:
himmelma@33175
   320
  fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
himmelma@33175
   321
  shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
wenzelm@53253
   322
    det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
wenzelm@53253
   323
    det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
haftmann@57418
   324
  unfolding det_def vec_lambda_beta setsum.distrib[symmetric]
haftmann@57418
   325
proof (rule setsum.cong)
himmelma@33175
   326
  let ?U = "UNIV :: 'n set"
himmelma@33175
   327
  let ?pU = "{p. p permutes ?U}"
himmelma@33175
   328
  let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
himmelma@33175
   329
  let ?g = "(\<lambda> i. if i = k then a i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
himmelma@33175
   330
  let ?h = "(\<lambda> i. if i = k then b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
wenzelm@53253
   331
  fix p
wenzelm@53253
   332
  assume p: "p \<in> ?pU"
himmelma@33175
   333
  let ?Uk = "?U - {k}"
wenzelm@53854
   334
  from p have pU: "p permutes ?U"
wenzelm@53854
   335
    by blast
wenzelm@53854
   336
  have kU: "?U = insert k ?Uk"
wenzelm@53854
   337
    by blast
wenzelm@53253
   338
  {
wenzelm@53253
   339
    fix j
wenzelm@53253
   340
    assume j: "j \<in> ?Uk"
himmelma@33175
   341
    from j have "?f j $ p j = ?g j $ p j" and "?f j $ p j= ?h j $ p j"
wenzelm@53253
   342
      by simp_all
wenzelm@53253
   343
  }
himmelma@33175
   344
  then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
himmelma@33175
   345
    and th2: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?h i $ p i) ?Uk"
himmelma@33175
   346
    apply -
haftmann@57418
   347
    apply (rule setprod.cong, simp_all)+
himmelma@33175
   348
    done
wenzelm@53854
   349
  have th3: "finite ?Uk" "k \<notin> ?Uk"
wenzelm@53854
   350
    by auto
himmelma@33175
   351
  have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
himmelma@33175
   352
    unfolding kU[symmetric] ..
wenzelm@53854
   353
  also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
haftmann@57418
   354
    apply (rule setprod.insert)
himmelma@33175
   355
    apply simp
wenzelm@53253
   356
    apply blast
wenzelm@53253
   357
    done
wenzelm@53253
   358
  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)"
wenzelm@53253
   359
    by (simp add: field_simps)
wenzelm@53253
   360
  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)"
wenzelm@53253
   361
    by (metis th1 th2)
himmelma@33175
   362
  also have "\<dots> = setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + setprod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
haftmann@57418
   363
    unfolding  setprod.insert[OF th3] by simp
wenzelm@53854
   364
  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"
wenzelm@53854
   365
    unfolding kU[symmetric] .
wenzelm@53253
   366
  then show "of_int (sign p) * setprod (\<lambda>i. ?f i $ p i) ?U =
wenzelm@53253
   367
    of_int (sign p) * setprod (\<lambda>i. ?g i $ p i) ?U + of_int (sign p) * setprod (\<lambda>i. ?h i $ p i) ?U"
haftmann@36350
   368
    by (simp add: field_simps)
haftmann@57418
   369
qed rule
himmelma@33175
   370
himmelma@33175
   371
lemma det_row_mul:
himmelma@33175
   372
  fixes a b :: "'n::finite \<Rightarrow> _ ^ 'n"
himmelma@33175
   373
  shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
wenzelm@53253
   374
    c * det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
wenzelm@53253
   375
  unfolding det_def vec_lambda_beta setsum_right_distrib
haftmann@57418
   376
proof (rule setsum.cong)
himmelma@33175
   377
  let ?U = "UNIV :: 'n set"
himmelma@33175
   378
  let ?pU = "{p. p permutes ?U}"
himmelma@33175
   379
  let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
himmelma@33175
   380
  let ?g = "(\<lambda> i. if i = k then a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
wenzelm@53253
   381
  fix p
wenzelm@53253
   382
  assume p: "p \<in> ?pU"
himmelma@33175
   383
  let ?Uk = "?U - {k}"
wenzelm@53854
   384
  from p have pU: "p permutes ?U"
wenzelm@53854
   385
    by blast
wenzelm@53854
   386
  have kU: "?U = insert k ?Uk"
wenzelm@53854
   387
    by blast
wenzelm@53253
   388
  {
wenzelm@53253
   389
    fix j
wenzelm@53253
   390
    assume j: "j \<in> ?Uk"
wenzelm@53854
   391
    from j have "?f j $ p j = ?g j $ p j"
wenzelm@53854
   392
      by simp
wenzelm@53253
   393
  }
himmelma@33175
   394
  then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
himmelma@33175
   395
    apply -
haftmann@57418
   396
    apply (rule setprod.cong)
wenzelm@53253
   397
    apply simp_all
himmelma@33175
   398
    done
wenzelm@53854
   399
  have th3: "finite ?Uk" "k \<notin> ?Uk"
wenzelm@53854
   400
    by auto
himmelma@33175
   401
  have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
himmelma@33175
   402
    unfolding kU[symmetric] ..
himmelma@33175
   403
  also have "\<dots> = ?f k $ p k  * setprod (\<lambda>i. ?f i $ p i) ?Uk"
haftmann@57418
   404
    apply (rule setprod.insert)
himmelma@33175
   405
    apply simp
wenzelm@53253
   406
    apply blast
wenzelm@53253
   407
    done
wenzelm@53253
   408
  also have "\<dots> = (c*s a k) $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
wenzelm@53253
   409
    by (simp add: field_simps)
himmelma@33175
   410
  also have "\<dots> = c* (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk)"
haftmann@57514
   411
    unfolding th1 by (simp add: ac_simps)
himmelma@33175
   412
  also have "\<dots> = c* (setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
haftmann@57418
   413
    unfolding setprod.insert[OF th3] by simp
wenzelm@53253
   414
  finally have "setprod (\<lambda>i. ?f i $ p i) ?U = c* (setprod (\<lambda>i. ?g i $ p i) ?U)"
wenzelm@53253
   415
    unfolding kU[symmetric] .
wenzelm@53253
   416
  then show "of_int (sign p) * setprod (\<lambda>i. ?f i $ p i) ?U =
wenzelm@53253
   417
    c * (of_int (sign p) * setprod (\<lambda>i. ?g i $ p i) ?U)"
haftmann@36350
   418
    by (simp add: field_simps)
haftmann@57418
   419
qed rule
himmelma@33175
   420
himmelma@33175
   421
lemma det_row_0:
himmelma@33175
   422
  fixes b :: "'n::finite \<Rightarrow> _ ^ 'n"
himmelma@33175
   423
  shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
wenzelm@53253
   424
  using det_row_mul[of k 0 "\<lambda>i. 1" b]
wenzelm@53253
   425
  apply simp
wenzelm@53253
   426
  apply (simp only: vector_smult_lzero)
wenzelm@53253
   427
  done
himmelma@33175
   428
himmelma@33175
   429
lemma det_row_operation:
haftmann@35028
   430
  fixes A :: "'a::linordered_idom^'n^'n"
himmelma@33175
   431
  assumes ij: "i \<noteq> j"
himmelma@33175
   432
  shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
wenzelm@53253
   433
proof -
himmelma@33175
   434
  let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
himmelma@33175
   435
  have th: "row i ?Z = row j ?Z" by (vector row_def)
himmelma@33175
   436
  have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
himmelma@33175
   437
    by (vector row_def)
himmelma@33175
   438
  show ?thesis
himmelma@33175
   439
    unfolding det_row_add [of i] det_row_mul[of i] det_identical_rows[OF ij th] th2
himmelma@33175
   440
    by simp
himmelma@33175
   441
qed
himmelma@33175
   442
himmelma@33175
   443
lemma det_row_span:
huffman@36593
   444
  fixes A :: "real^'n^'n"
himmelma@33175
   445
  assumes x: "x \<in> span {row j A |j. j \<noteq> i}"
himmelma@33175
   446
  shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
wenzelm@53253
   447
proof -
himmelma@33175
   448
  let ?U = "UNIV :: 'n set"
himmelma@33175
   449
  let ?S = "{row j A |j. j \<noteq> i}"
himmelma@33175
   450
  let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
himmelma@33175
   451
  let ?P = "\<lambda>x. ?d (row i A + x) = det A"
wenzelm@53253
   452
  {
wenzelm@53253
   453
    fix k
wenzelm@53854
   454
    have "(if k = i then row i A + 0 else row k A) = row k A"
wenzelm@53854
   455
      by simp
wenzelm@53253
   456
  }
himmelma@33175
   457
  then have P0: "?P 0"
himmelma@33175
   458
    apply -
himmelma@33175
   459
    apply (rule cong[of det, OF refl])
wenzelm@53253
   460
    apply (vector row_def)
wenzelm@53253
   461
    done
himmelma@33175
   462
  moreover
wenzelm@53253
   463
  {
wenzelm@53253
   464
    fix c z y
wenzelm@53253
   465
    assume zS: "z \<in> ?S" and Py: "?P y"
wenzelm@53854
   466
    from zS obtain j where j: "z = row j A" "i \<noteq> j"
wenzelm@53854
   467
      by blast
himmelma@33175
   468
    let ?w = "row i A + y"
wenzelm@53854
   469
    have th0: "row i A + (c*s z + y) = ?w + c*s z"
wenzelm@53854
   470
      by vector
himmelma@33175
   471
    have thz: "?d z = 0"
himmelma@33175
   472
      apply (rule det_identical_rows[OF j(2)])
wenzelm@53253
   473
      using j
wenzelm@53253
   474
      apply (vector row_def)
wenzelm@53253
   475
      done
wenzelm@53253
   476
    have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)"
wenzelm@53253
   477
      unfolding th0 ..
wenzelm@53253
   478
    then have "?P (c*s z + y)"
wenzelm@53253
   479
      unfolding thz Py det_row_mul[of i] det_row_add[of i]
wenzelm@53253
   480
      by simp
wenzelm@53253
   481
  }
himmelma@33175
   482
  ultimately show ?thesis
himmelma@33175
   483
    apply -
hoelzl@50526
   484
    apply (rule span_induct_alt[of ?P ?S, OF P0, folded scalar_mult_eq_scaleR])
himmelma@33175
   485
    apply blast
himmelma@33175
   486
    apply (rule x)
himmelma@33175
   487
    done
himmelma@33175
   488
qed
himmelma@33175
   489
wenzelm@60420
   490
text \<open>
wenzelm@53854
   491
  May as well do this, though it's a bit unsatisfactory since it ignores
wenzelm@53854
   492
  exact duplicates by considering the rows/columns as a set.
wenzelm@60420
   493
\<close>
himmelma@33175
   494
himmelma@33175
   495
lemma det_dependent_rows:
huffman@36593
   496
  fixes A:: "real^'n^'n"
himmelma@33175
   497
  assumes d: "dependent (rows A)"
himmelma@33175
   498
  shows "det A = 0"
wenzelm@53253
   499
proof -
himmelma@33175
   500
  let ?U = "UNIV :: 'n set"
himmelma@33175
   501
  from d obtain i where i: "row i A \<in> span (rows A - {row i A})"
himmelma@33175
   502
    unfolding dependent_def rows_def by blast
wenzelm@53253
   503
  {
wenzelm@53253
   504
    fix j k
wenzelm@53253
   505
    assume jk: "j \<noteq> k" and c: "row j A = row k A"
wenzelm@53253
   506
    from det_identical_rows[OF jk c] have ?thesis .
wenzelm@53253
   507
  }
himmelma@33175
   508
  moreover
wenzelm@53253
   509
  {
wenzelm@53253
   510
    assume H: "\<And> i j. i \<noteq> j \<Longrightarrow> row i A \<noteq> row j A"
himmelma@33175
   511
    have th0: "- row i A \<in> span {row j A|j. j \<noteq> i}"
himmelma@33175
   512
      apply (rule span_neg)
himmelma@33175
   513
      apply (rule set_rev_mp)
himmelma@33175
   514
      apply (rule i)
himmelma@33175
   515
      apply (rule span_mono)
wenzelm@53253
   516
      using H i
wenzelm@53253
   517
      apply (auto simp add: rows_def)
wenzelm@53253
   518
      done
himmelma@33175
   519
    from det_row_span[OF th0]
himmelma@33175
   520
    have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
himmelma@33175
   521
      unfolding right_minus vector_smult_lzero ..
huffman@36593
   522
    with det_row_mul[of i "0::real" "\<lambda>i. 1"]
wenzelm@53253
   523
    have "det A = 0" by simp
wenzelm@53253
   524
  }
himmelma@33175
   525
  ultimately show ?thesis by blast
himmelma@33175
   526
qed
himmelma@33175
   527
wenzelm@53253
   528
lemma det_dependent_columns:
wenzelm@53253
   529
  assumes d: "dependent (columns (A::real^'n^'n))"
wenzelm@53253
   530
  shows "det A = 0"
wenzelm@53253
   531
  by (metis d det_dependent_rows rows_transpose det_transpose)
himmelma@33175
   532
wenzelm@60420
   533
text \<open>Multilinearity and the multiplication formula.\<close>
himmelma@33175
   534
huffman@44228
   535
lemma Cart_lambda_cong: "(\<And>x. f x = g x) \<Longrightarrow> (vec_lambda f::'a^'n) = (vec_lambda g :: 'a^'n)"
wenzelm@53253
   536
  by (rule iffD1[OF vec_lambda_unique]) vector
himmelma@33175
   537
himmelma@33175
   538
lemma det_linear_row_setsum:
himmelma@33175
   539
  assumes fS: "finite S"
wenzelm@53253
   540
  shows "det ((\<chi> i. if i = k then setsum (a i) S else c i)::'a::comm_ring_1^'n^'n) =
wenzelm@53253
   541
    setsum (\<lambda>j. det ((\<chi> i. if i = k then a  i j else c i)::'a^'n^'n)) S"
wenzelm@53253
   542
proof (induct rule: finite_induct[OF fS])
wenzelm@53253
   543
  case 1
wenzelm@53253
   544
  then show ?case
wenzelm@53253
   545
    apply simp
haftmann@57418
   546
    unfolding setsum.empty det_row_0[of k]
wenzelm@53253
   547
    apply rule
wenzelm@53253
   548
    done
himmelma@33175
   549
next
himmelma@33175
   550
  case (2 x F)
wenzelm@53253
   551
  then show ?case
wenzelm@53253
   552
    by (simp add: det_row_add cong del: if_weak_cong)
himmelma@33175
   553
qed
himmelma@33175
   554
himmelma@33175
   555
lemma finite_bounded_functions:
himmelma@33175
   556
  assumes fS: "finite S"
himmelma@33175
   557
  shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
wenzelm@53253
   558
proof (induct k)
himmelma@33175
   559
  case 0
wenzelm@53854
   560
  have th: "{f. \<forall>i. f i = i} = {id}"
wenzelm@53854
   561
    by auto
wenzelm@53854
   562
  show ?case
wenzelm@53854
   563
    by (auto simp add: th)
himmelma@33175
   564
next
himmelma@33175
   565
  case (Suc k)
himmelma@33175
   566
  let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
himmelma@33175
   567
  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)})"
himmelma@33175
   568
  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)}"
himmelma@33175
   569
    apply (auto simp add: image_iff)
himmelma@33175
   570
    apply (rule_tac x="x (Suc k)" in bexI)
himmelma@33175
   571
    apply (rule_tac x = "\<lambda>i. if i = Suc k then i else x i" in exI)
huffman@44457
   572
    apply auto
himmelma@33175
   573
    done
himmelma@33175
   574
  with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
wenzelm@53854
   575
  show ?case
wenzelm@53854
   576
    by metis
himmelma@33175
   577
qed
himmelma@33175
   578
himmelma@33175
   579
himmelma@33175
   580
lemma det_linear_rows_setsum_lemma:
wenzelm@53854
   581
  assumes fS: "finite S"
wenzelm@53854
   582
    and fT: "finite T"
wenzelm@53854
   583
  shows "det ((\<chi> i. if i \<in> T then setsum (a i) S else c i):: 'a::comm_ring_1^'n^'n) =
wenzelm@53253
   584
    setsum (\<lambda>f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n))
wenzelm@53253
   585
      {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
wenzelm@53253
   586
  using fT
wenzelm@53253
   587
proof (induct T arbitrary: a c set: finite)
himmelma@33175
   588
  case empty
wenzelm@53253
   589
  have th0: "\<And>x y. (\<chi> i. if i \<in> {} then x i else y i) = (\<chi> i. y i)"
wenzelm@53253
   590
    by vector
wenzelm@53854
   591
  from empty.prems show ?case
lp15@62408
   592
    unfolding th0 by (simp add: eq_id_iff)
himmelma@33175
   593
next
himmelma@33175
   594
  case (insert z T a c)
himmelma@33175
   595
  let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
himmelma@33175
   596
  let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
himmelma@33175
   597
  let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
himmelma@33175
   598
  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)"
hoelzl@57129
   599
  let ?c = "\<lambda>j i. if i = z then a i j else c i"
wenzelm@53253
   600
  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)"
wenzelm@53253
   601
    by simp
himmelma@33175
   602
  have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
wenzelm@53253
   603
     (if c then (if a then b else d) else (if a then b else e))"
wenzelm@53253
   604
    by simp
wenzelm@60420
   605
  from \<open>z \<notin> T\<close> have nz: "\<And>i. i \<in> T \<Longrightarrow> i = z \<longleftrightarrow> False"
wenzelm@53253
   606
    by auto
himmelma@33175
   607
  have "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
wenzelm@53253
   608
    det (\<chi> i. if i = z then setsum (a i) S else if i \<in> T then setsum (a i) S else c i)"
himmelma@33175
   609
    unfolding insert_iff thif ..
wenzelm@53253
   610
  also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<in> T then setsum (a i) S else if i = z then a i j else c i))"
himmelma@33175
   611
    unfolding det_linear_row_setsum[OF fS]
himmelma@33175
   612
    apply (subst thif2)
wenzelm@53253
   613
    using nz
wenzelm@53253
   614
    apply (simp cong del: if_weak_cong cong add: if_cong)
wenzelm@53253
   615
    done
himmelma@33175
   616
  finally have tha:
himmelma@33175
   617
    "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
himmelma@33175
   618
     (\<Sum>(j, f)\<in>S \<times> ?F T. det (\<chi> i. if i \<in> T then a i (f i)
himmelma@33175
   619
                                else if i = z then a i j
himmelma@33175
   620
                                else c i))"
haftmann@57418
   621
    unfolding insert.hyps unfolding setsum.cartesian_product by blast
himmelma@33175
   622
  show ?case unfolding tha
wenzelm@60420
   623
    using \<open>z \<notin> T\<close>
hoelzl@57129
   624
    by (intro setsum.reindex_bij_witness[where i="?k" and j="?h"])
hoelzl@57129
   625
       (auto intro!: cong[OF refl[of det]] simp: vec_eq_iff)
himmelma@33175
   626
qed
himmelma@33175
   627
himmelma@33175
   628
lemma det_linear_rows_setsum:
wenzelm@53854
   629
  fixes S :: "'n::finite set"
wenzelm@53854
   630
  assumes fS: "finite S"
wenzelm@53253
   631
  shows "det (\<chi> i. setsum (a i) S) =
wenzelm@53253
   632
    setsum (\<lambda>f. det (\<chi> i. a i (f i) :: 'a::comm_ring_1 ^ 'n^'n)) {f. \<forall>i. f i \<in> S}"
wenzelm@53253
   633
proof -
wenzelm@53253
   634
  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)"
wenzelm@53253
   635
    by vector
wenzelm@53253
   636
  from det_linear_rows_setsum_lemma[OF fS, of "UNIV :: 'n set" a, unfolded th0, OF finite]
wenzelm@53253
   637
  show ?thesis by simp
himmelma@33175
   638
qed
himmelma@33175
   639
himmelma@33175
   640
lemma matrix_mul_setsum_alt:
hoelzl@34291
   641
  fixes A B :: "'a::comm_ring_1^'n^'n"
himmelma@33175
   642
  shows "A ** B = (\<chi> i. setsum (\<lambda>k. A$i$k *s B $ k) (UNIV :: 'n set))"
himmelma@33175
   643
  by (vector matrix_matrix_mult_def setsum_component)
himmelma@33175
   644
himmelma@33175
   645
lemma det_rows_mul:
hoelzl@34291
   646
  "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n) =
wenzelm@53253
   647
    setprod (\<lambda>i. c i) (UNIV:: 'n set) * det((\<chi> i. a i)::'a^'n^'n)"
haftmann@57418
   648
proof (simp add: det_def setsum_right_distrib cong add: setprod.cong, rule setsum.cong)
himmelma@33175
   649
  let ?U = "UNIV :: 'n set"
himmelma@33175
   650
  let ?PU = "{p. p permutes ?U}"
wenzelm@53253
   651
  fix p
wenzelm@53253
   652
  assume pU: "p \<in> ?PU"
himmelma@33175
   653
  let ?s = "of_int (sign p)"
wenzelm@53253
   654
  from pU have p: "p permutes ?U"
wenzelm@53253
   655
    by blast
himmelma@33175
   656
  have "setprod (\<lambda>i. c i * a i $ p i) ?U = setprod c ?U * setprod (\<lambda>i. a i $ p i) ?U"
haftmann@57418
   657
    unfolding setprod.distrib ..
himmelma@33175
   658
  then show "?s * (\<Prod>xa\<in>?U. c xa * a xa $ p xa) =
wenzelm@53854
   659
    setprod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))"
wenzelm@53854
   660
    by (simp add: field_simps)
haftmann@57418
   661
qed rule
himmelma@33175
   662
himmelma@33175
   663
lemma det_mul:
haftmann@35028
   664
  fixes A B :: "'a::linordered_idom^'n^'n"
himmelma@33175
   665
  shows "det (A ** B) = det A * det B"
wenzelm@53253
   666
proof -
himmelma@33175
   667
  let ?U = "UNIV :: 'n set"
himmelma@33175
   668
  let ?F = "{f. (\<forall>i\<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
himmelma@33175
   669
  let ?PU = "{p. p permutes ?U}"
wenzelm@53854
   670
  have fU: "finite ?U"
wenzelm@53854
   671
    by simp
wenzelm@53854
   672
  have fF: "finite ?F"
wenzelm@53854
   673
    by (rule finite)
wenzelm@53253
   674
  {
wenzelm@53253
   675
    fix p
wenzelm@53253
   676
    assume p: "p permutes ?U"
himmelma@33175
   677
    have "p \<in> ?F" unfolding mem_Collect_eq permutes_in_image[OF p]
wenzelm@53253
   678
      using p[unfolded permutes_def] by simp
wenzelm@53253
   679
  }
wenzelm@53854
   680
  then have PUF: "?PU \<subseteq> ?F" by blast
wenzelm@53253
   681
  {
wenzelm@53253
   682
    fix f
wenzelm@53253
   683
    assume fPU: "f \<in> ?F - ?PU"
wenzelm@53854
   684
    have fUU: "f ` ?U \<subseteq> ?U"
wenzelm@53854
   685
      using fPU by auto
wenzelm@53253
   686
    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)"
wenzelm@53253
   687
      unfolding permutes_def by auto
himmelma@33175
   688
himmelma@33175
   689
    let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
himmelma@33175
   690
    let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
wenzelm@53253
   691
    {
wenzelm@53253
   692
      assume fni: "\<not> inj_on f ?U"
himmelma@33175
   693
      then obtain i j where ij: "f i = f j" "i \<noteq> j"
himmelma@33175
   694
        unfolding inj_on_def by blast
himmelma@33175
   695
      from ij
wenzelm@53854
   696
      have rth: "row i ?B = row j ?B"
wenzelm@53854
   697
        by (vector row_def)
himmelma@33175
   698
      from det_identical_rows[OF ij(2) rth]
himmelma@33175
   699
      have "det (\<chi> i. A$i$f i *s B$f i) = 0"
wenzelm@53253
   700
        unfolding det_rows_mul by simp
wenzelm@53253
   701
    }
himmelma@33175
   702
    moreover
wenzelm@53253
   703
    {
wenzelm@53253
   704
      assume fi: "inj_on f ?U"
himmelma@33175
   705
      from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
himmelma@33175
   706
        unfolding inj_on_def by metis
himmelma@33175
   707
      note fs = fi[unfolded surjective_iff_injective_gen[OF fU fU refl fUU, symmetric]]
wenzelm@53253
   708
      {
wenzelm@53253
   709
        fix y
wenzelm@53854
   710
        from fs f have "\<exists>x. f x = y"
wenzelm@53854
   711
          by blast
wenzelm@53854
   712
        then obtain x where x: "f x = y"
wenzelm@53854
   713
          by blast
wenzelm@53253
   714
        {
wenzelm@53253
   715
          fix z
wenzelm@53253
   716
          assume z: "f z = y"
wenzelm@53854
   717
          from fith x z have "z = x"
wenzelm@53854
   718
            by metis
wenzelm@53253
   719
        }
wenzelm@53854
   720
        with x have "\<exists>!x. f x = y"
wenzelm@53854
   721
          by blast
wenzelm@53253
   722
      }
wenzelm@53854
   723
      with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0"
wenzelm@53854
   724
        by blast
wenzelm@53253
   725
    }
wenzelm@53854
   726
    ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0"
wenzelm@53854
   727
      by blast
wenzelm@53253
   728
  }
wenzelm@53854
   729
  then have zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0"
wenzelm@53253
   730
    by simp
wenzelm@53253
   731
  {
wenzelm@53253
   732
    fix p
wenzelm@53253
   733
    assume pU: "p \<in> ?PU"
wenzelm@53854
   734
    from pU have p: "p permutes ?U"
wenzelm@53854
   735
      by blast
himmelma@33175
   736
    let ?s = "\<lambda>p. of_int (sign p)"
wenzelm@53253
   737
    let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) * (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
himmelma@33175
   738
    have "(setsum (\<lambda>q. ?s q *
wenzelm@53253
   739
        (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
wenzelm@53253
   740
      (setsum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) * (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
himmelma@33175
   741
      unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
haftmann@57418
   742
    proof (rule setsum.cong)
wenzelm@53253
   743
      fix q
wenzelm@53253
   744
      assume qU: "q \<in> ?PU"
wenzelm@53854
   745
      then have q: "q permutes ?U"
wenzelm@53854
   746
        by blast
himmelma@33175
   747
      from p q have pp: "permutation p" and pq: "permutation q"
himmelma@33175
   748
        unfolding permutation_permutes by auto
himmelma@33175
   749
      have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
himmelma@33175
   750
        "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
haftmann@57512
   751
        unfolding mult.assoc[symmetric]
wenzelm@53854
   752
        unfolding of_int_mult[symmetric]
himmelma@33175
   753
        by (simp_all add: sign_idempotent)
wenzelm@53854
   754
      have ths: "?s q = ?s p * ?s (q \<circ> inv p)"
himmelma@33175
   755
        using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
haftmann@57514
   756
        by (simp add:  th00 ac_simps sign_idempotent sign_compose)
wenzelm@53854
   757
      have th001: "setprod (\<lambda>i. B$i$ q (inv p i)) ?U = setprod ((\<lambda>i. B$i$ q (inv p i)) \<circ> p) ?U"
himmelma@33175
   758
        by (rule setprod_permute[OF p])
wenzelm@53253
   759
      have thp: "setprod (\<lambda>i. (\<chi> i. A$i$p i *s B$p i :: 'a^'n^'n) $i $ q i) ?U =
wenzelm@53253
   760
        setprod (\<lambda>i. A$i$p i) ?U * setprod (\<lambda>i. B$i$ q (inv p i)) ?U"
haftmann@57418
   761
        unfolding th001 setprod.distrib[symmetric] o_def permutes_inverses[OF p]
haftmann@57418
   762
        apply (rule setprod.cong[OF refl])
wenzelm@53253
   763
        using permutes_in_image[OF q]
wenzelm@53253
   764
        apply vector
wenzelm@53253
   765
        done
wenzelm@53253
   766
      show "?s q * setprod (\<lambda>i. (((\<chi> i. A$i$p i *s B$p i) :: 'a^'n^'n)$i$q i)) ?U =
wenzelm@53854
   767
        ?s p * (setprod (\<lambda>i. A$i$p i) ?U) * (?s (q \<circ> inv p) * setprod (\<lambda>i. B$i$(q \<circ> inv p) i) ?U)"
himmelma@33175
   768
        using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
haftmann@36350
   769
        by (simp add: sign_nz th00 field_simps sign_idempotent sign_compose)
haftmann@57418
   770
    qed rule
himmelma@33175
   771
  }
himmelma@33175
   772
  then have th2: "setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
himmelma@33175
   773
    unfolding det_def setsum_product
haftmann@57418
   774
    by (rule setsum.cong [OF refl])
himmelma@33175
   775
  have "det (A**B) = setsum (\<lambda>f.  det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
wenzelm@53854
   776
    unfolding matrix_mul_setsum_alt det_linear_rows_setsum[OF fU]
wenzelm@53854
   777
    by simp
himmelma@33175
   778
  also have "\<dots> = setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
haftmann@57418
   779
    using setsum.mono_neutral_cong_left[OF fF PUF zth, symmetric]
himmelma@33175
   780
    unfolding det_rows_mul by auto
himmelma@33175
   781
  finally show ?thesis unfolding th2 .
himmelma@33175
   782
qed
himmelma@33175
   783
wenzelm@60420
   784
text \<open>Relation to invertibility.\<close>
himmelma@33175
   785
himmelma@33175
   786
lemma invertible_left_inverse:
hoelzl@34291
   787
  fixes A :: "real^'n^'n"
himmelma@33175
   788
  shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). B** A = mat 1)"
himmelma@33175
   789
  by (metis invertible_def matrix_left_right_inverse)
himmelma@33175
   790
himmelma@33175
   791
lemma invertible_righ_inverse:
hoelzl@34291
   792
  fixes A :: "real^'n^'n"
himmelma@33175
   793
  shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). A** B = mat 1)"
himmelma@33175
   794
  by (metis invertible_def matrix_left_right_inverse)
himmelma@33175
   795
himmelma@33175
   796
lemma invertible_det_nz:
hoelzl@34291
   797
  fixes A::"real ^'n^'n"
himmelma@33175
   798
  shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
wenzelm@53253
   799
proof -
wenzelm@53253
   800
  {
wenzelm@53253
   801
    assume "invertible A"
himmelma@33175
   802
    then obtain B :: "real ^'n^'n" where B: "A ** B = mat 1"
himmelma@33175
   803
      unfolding invertible_righ_inverse by blast
wenzelm@53854
   804
    then have "det (A ** B) = det (mat 1 :: real ^'n^'n)"
wenzelm@53854
   805
      by simp
wenzelm@53854
   806
    then have "det A \<noteq> 0"
wenzelm@53854
   807
      by (simp add: det_mul det_I) algebra
wenzelm@53253
   808
  }
himmelma@33175
   809
  moreover
wenzelm@53253
   810
  {
wenzelm@53253
   811
    assume H: "\<not> invertible A"
himmelma@33175
   812
    let ?U = "UNIV :: 'n set"
wenzelm@53854
   813
    have fU: "finite ?U"
wenzelm@53854
   814
      by simp
himmelma@33175
   815
    from H obtain c i where c: "setsum (\<lambda>i. c i *s row i A) ?U = 0"
wenzelm@53854
   816
      and iU: "i \<in> ?U"
wenzelm@53854
   817
      and ci: "c i \<noteq> 0"
himmelma@33175
   818
      unfolding invertible_righ_inverse
wenzelm@53854
   819
      unfolding matrix_right_invertible_independent_rows
wenzelm@53854
   820
      by blast
wenzelm@53253
   821
    have *: "\<And>(a::real^'n) b. a + b = 0 \<Longrightarrow> -a = b"
himmelma@33175
   822
      apply (drule_tac f="op + (- a)" in cong[OF refl])
haftmann@57512
   823
      apply (simp only: ab_left_minus add.assoc[symmetric])
himmelma@33175
   824
      apply simp
himmelma@33175
   825
      done
himmelma@33175
   826
    from c ci
himmelma@33175
   827
    have thr0: "- row i A = setsum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
haftmann@57418
   828
      unfolding setsum.remove[OF fU iU] setsum_cmul
himmelma@33175
   829
      apply -
himmelma@33175
   830
      apply (rule vector_mul_lcancel_imp[OF ci])
huffman@44457
   831
      apply (auto simp add: field_simps)
wenzelm@53854
   832
      unfolding *
wenzelm@53854
   833
      apply rule
wenzelm@53854
   834
      done
himmelma@33175
   835
    have thr: "- row i A \<in> span {row j A| j. j \<noteq> i}"
himmelma@33175
   836
      unfolding thr0
himmelma@33175
   837
      apply (rule span_setsum)
himmelma@33175
   838
      apply simp
hoelzl@50526
   839
      apply (rule span_mul [where 'a="real^'n", folded scalar_mult_eq_scaleR])+
himmelma@33175
   840
      apply (rule span_superset)
himmelma@33175
   841
      apply auto
himmelma@33175
   842
      done
himmelma@33175
   843
    let ?B = "(\<chi> k. if k = i then 0 else row k A) :: real ^'n^'n"
himmelma@33175
   844
    have thrb: "row i ?B = 0" using iU by (vector row_def)
himmelma@33175
   845
    have "det A = 0"
himmelma@33175
   846
      unfolding det_row_span[OF thr, symmetric] right_minus
wenzelm@53253
   847
      unfolding det_zero_row[OF thrb] ..
wenzelm@53253
   848
  }
wenzelm@53854
   849
  ultimately show ?thesis
wenzelm@53854
   850
    by blast
himmelma@33175
   851
qed
himmelma@33175
   852
wenzelm@60420
   853
text \<open>Cramer's rule.\<close>
himmelma@33175
   854
hoelzl@35150
   855
lemma cramer_lemma_transpose:
wenzelm@53854
   856
  fixes A:: "real^'n^'n"
wenzelm@53854
   857
    and x :: "real^'n"
himmelma@33175
   858
  shows "det ((\<chi> i. if i = k then setsum (\<lambda>i. x$i *s row i A) (UNIV::'n set)
wenzelm@53854
   859
                             else row i A)::real^'n^'n) = x$k * det A"
himmelma@33175
   860
  (is "?lhs = ?rhs")
wenzelm@53253
   861
proof -
himmelma@33175
   862
  let ?U = "UNIV :: 'n set"
himmelma@33175
   863
  let ?Uk = "?U - {k}"
wenzelm@53854
   864
  have U: "?U = insert k ?Uk"
wenzelm@53854
   865
    by blast
wenzelm@53854
   866
  have fUk: "finite ?Uk"
wenzelm@53854
   867
    by simp
wenzelm@53854
   868
  have kUk: "k \<notin> ?Uk"
wenzelm@53854
   869
    by simp
himmelma@33175
   870
  have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
haftmann@36350
   871
    by (vector field_simps)
wenzelm@53854
   872
  have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f"
wenzelm@53854
   873
    by auto
himmelma@33175
   874
  have "(\<chi> i. row i A) = A" by (vector row_def)
wenzelm@53253
   875
  then have thd1: "det (\<chi> i. row i A) = det A"
wenzelm@53253
   876
    by simp
himmelma@33175
   877
  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"
himmelma@33175
   878
    apply (rule det_row_span)
huffman@56196
   879
    apply (rule span_setsum)
hoelzl@50526
   880
    apply (rule span_mul [where 'a="real^'n", folded scalar_mult_eq_scaleR])+
himmelma@33175
   881
    apply (rule span_superset)
himmelma@33175
   882
    apply auto
himmelma@33175
   883
    done
himmelma@33175
   884
  show "?lhs = x$k * det A"
himmelma@33175
   885
    apply (subst U)
haftmann@57418
   886
    unfolding setsum.insert[OF fUk kUk]
himmelma@33175
   887
    apply (subst th00)
haftmann@57512
   888
    unfolding add.assoc
himmelma@33175
   889
    apply (subst det_row_add)
himmelma@33175
   890
    unfolding thd0
himmelma@33175
   891
    unfolding det_row_mul
himmelma@33175
   892
    unfolding th001[of k "\<lambda>i. row i A"]
wenzelm@53253
   893
    unfolding thd1
wenzelm@53253
   894
    apply (simp add: field_simps)
wenzelm@53253
   895
    done
himmelma@33175
   896
qed
himmelma@33175
   897
himmelma@33175
   898
lemma cramer_lemma:
huffman@36593
   899
  fixes A :: "real^'n^'n"
huffman@36593
   900
  shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: real^'n^'n) = x$k * det A"
wenzelm@53253
   901
proof -
himmelma@33175
   902
  let ?U = "UNIV :: 'n set"
wenzelm@53253
   903
  have *: "\<And>c. setsum (\<lambda>i. c i *s row i (transpose A)) ?U = setsum (\<lambda>i. c i *s column i A) ?U"
haftmann@57418
   904
    by (auto simp add: row_transpose intro: setsum.cong)
wenzelm@53854
   905
  show ?thesis
wenzelm@53854
   906
    unfolding matrix_mult_vsum
wenzelm@53253
   907
    unfolding cramer_lemma_transpose[of k x "transpose A", unfolded det_transpose, symmetric]
wenzelm@53253
   908
    unfolding *[of "\<lambda>i. x$i"]
wenzelm@53253
   909
    apply (subst det_transpose[symmetric])
wenzelm@53253
   910
    apply (rule cong[OF refl[of det]])
wenzelm@53253
   911
    apply (vector transpose_def column_def row_def)
wenzelm@53253
   912
    done
himmelma@33175
   913
qed
himmelma@33175
   914
himmelma@33175
   915
lemma cramer:
hoelzl@34291
   916
  fixes A ::"real^'n^'n"
himmelma@33175
   917
  assumes d0: "det A \<noteq> 0"
huffman@36362
   918
  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)"
wenzelm@53253
   919
proof -
himmelma@33175
   920
  from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
wenzelm@53854
   921
    unfolding invertible_det_nz[symmetric] invertible_def
wenzelm@53854
   922
    by blast
wenzelm@53854
   923
  have "(A ** B) *v b = b"
wenzelm@53854
   924
    by (simp add: B matrix_vector_mul_lid)
wenzelm@53854
   925
  then have "A *v (B *v b) = b"
wenzelm@53854
   926
    by (simp add: matrix_vector_mul_assoc)
wenzelm@53854
   927
  then have xe: "\<exists>x. A *v x = b"
wenzelm@53854
   928
    by blast
wenzelm@53253
   929
  {
wenzelm@53253
   930
    fix x
wenzelm@53253
   931
    assume x: "A *v x = b"
wenzelm@53253
   932
    have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j) / det A)"
wenzelm@53253
   933
      unfolding x[symmetric]
wenzelm@53253
   934
      using d0 by (simp add: vec_eq_iff cramer_lemma field_simps)
wenzelm@53253
   935
  }
wenzelm@53854
   936
  with xe show ?thesis
wenzelm@53854
   937
    by auto
himmelma@33175
   938
qed
himmelma@33175
   939
wenzelm@60420
   940
text \<open>Orthogonality of a transformation and matrix.\<close>
himmelma@33175
   941
himmelma@33175
   942
definition "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
himmelma@33175
   943
wenzelm@53253
   944
lemma orthogonal_transformation:
wenzelm@53253
   945
  "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>(v::real ^_). norm (f v) = norm v)"
himmelma@33175
   946
  unfolding orthogonal_transformation_def
himmelma@33175
   947
  apply auto
himmelma@33175
   948
  apply (erule_tac x=v in allE)+
himmelma@35542
   949
  apply (simp add: norm_eq_sqrt_inner)
wenzelm@53253
   950
  apply (simp add: dot_norm  linear_add[symmetric])
wenzelm@53253
   951
  done
himmelma@33175
   952
wenzelm@53253
   953
definition "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \<longleftrightarrow>
wenzelm@53253
   954
  transpose Q ** Q = mat 1 \<and> Q ** transpose Q = mat 1"
himmelma@33175
   955
wenzelm@53253
   956
lemma orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n) \<longleftrightarrow> transpose Q ** Q = mat 1"
himmelma@33175
   957
  by (metis matrix_left_right_inverse orthogonal_matrix_def)
himmelma@33175
   958
hoelzl@34291
   959
lemma orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n)"
hoelzl@35150
   960
  by (simp add: orthogonal_matrix_def transpose_mat matrix_mul_lid)
himmelma@33175
   961
himmelma@33175
   962
lemma orthogonal_matrix_mul:
hoelzl@34291
   963
  fixes A :: "real ^'n^'n"
himmelma@33175
   964
  assumes oA : "orthogonal_matrix A"
wenzelm@53253
   965
    and oB: "orthogonal_matrix B"
himmelma@33175
   966
  shows "orthogonal_matrix(A ** B)"
himmelma@33175
   967
  using oA oB
hoelzl@35150
   968
  unfolding orthogonal_matrix matrix_transpose_mul
himmelma@33175
   969
  apply (subst matrix_mul_assoc)
himmelma@33175
   970
  apply (subst matrix_mul_assoc[symmetric])
wenzelm@53253
   971
  apply (simp add: matrix_mul_rid)
wenzelm@53253
   972
  done
himmelma@33175
   973
himmelma@33175
   974
lemma orthogonal_transformation_matrix:
hoelzl@34291
   975
  fixes f:: "real^'n \<Rightarrow> real^'n"
himmelma@33175
   976
  shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
himmelma@33175
   977
  (is "?lhs \<longleftrightarrow> ?rhs")
wenzelm@53253
   978
proof -
himmelma@33175
   979
  let ?mf = "matrix f"
himmelma@33175
   980
  let ?ot = "orthogonal_transformation f"
himmelma@33175
   981
  let ?U = "UNIV :: 'n set"
himmelma@33175
   982
  have fU: "finite ?U" by simp
himmelma@33175
   983
  let ?m1 = "mat 1 :: real ^'n^'n"
wenzelm@53253
   984
  {
wenzelm@53253
   985
    assume ot: ?ot
himmelma@33175
   986
    from ot have lf: "linear f" and fd: "\<forall>v w. f v \<bullet> f w = v \<bullet> w"
himmelma@33175
   987
      unfolding  orthogonal_transformation_def orthogonal_matrix by blast+
wenzelm@53253
   988
    {
wenzelm@53253
   989
      fix i j
hoelzl@35150
   990
      let ?A = "transpose ?mf ** ?mf"
himmelma@33175
   991
      have th0: "\<And>b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)"
himmelma@33175
   992
        "\<And>b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)"
himmelma@33175
   993
        by simp_all
wenzelm@63170
   994
      from fd[rule_format, of "axis i 1" "axis j 1",
wenzelm@63170
   995
        simplified matrix_works[OF lf, symmetric] dot_matrix_vector_mul]
himmelma@33175
   996
      have "?A$i$j = ?m1 $ i $ j"
hoelzl@50526
   997
        by (simp add: inner_vec_def matrix_matrix_mult_def columnvector_def rowvector_def
haftmann@57418
   998
            th0 setsum.delta[OF fU] mat_def axis_def)
wenzelm@53253
   999
    }
wenzelm@53854
  1000
    then have "orthogonal_matrix ?mf"
wenzelm@53854
  1001
      unfolding orthogonal_matrix
wenzelm@53253
  1002
      by vector
wenzelm@53854
  1003
    with lf have ?rhs
wenzelm@53854
  1004
      by blast
wenzelm@53253
  1005
  }
himmelma@33175
  1006
  moreover
wenzelm@53253
  1007
  {
wenzelm@53253
  1008
    assume lf: "linear f" and om: "orthogonal_matrix ?mf"
himmelma@33175
  1009
    from lf om have ?lhs
wenzelm@63170
  1010
      apply (simp only: orthogonal_matrix_def norm_eq orthogonal_transformation)
wenzelm@63170
  1011
      apply (simp only: matrix_works[OF lf, symmetric])
himmelma@33175
  1012
      apply (subst dot_matrix_vector_mul)
wenzelm@53253
  1013
      apply (simp add: dot_matrix_product matrix_mul_lid)
wenzelm@53253
  1014
      done
wenzelm@53253
  1015
  }
wenzelm@53854
  1016
  ultimately show ?thesis
wenzelm@53854
  1017
    by blast
himmelma@33175
  1018
qed
himmelma@33175
  1019
himmelma@33175
  1020
lemma det_orthogonal_matrix:
haftmann@35028
  1021
  fixes Q:: "'a::linordered_idom^'n^'n"
himmelma@33175
  1022
  assumes oQ: "orthogonal_matrix Q"
himmelma@33175
  1023
  shows "det Q = 1 \<or> det Q = - 1"
wenzelm@53253
  1024
proof -
himmelma@33175
  1025
  have th: "\<And>x::'a. x = 1 \<or> x = - 1 \<longleftrightarrow> x*x = 1" (is "\<And>x::'a. ?ths x")
wenzelm@53253
  1026
  proof -
himmelma@33175
  1027
    fix x:: 'a
wenzelm@53854
  1028
    have th0: "x * x - 1 = (x - 1) * (x + 1)"
wenzelm@53253
  1029
      by (simp add: field_simps)
himmelma@33175
  1030
    have th1: "\<And>(x::'a) y. x = - y \<longleftrightarrow> x + y = 0"
wenzelm@53253
  1031
      apply (subst eq_iff_diff_eq_0)
wenzelm@53253
  1032
      apply simp
wenzelm@53253
  1033
      done
wenzelm@53854
  1034
    have "x * x = 1 \<longleftrightarrow> x * x - 1 = 0"
wenzelm@53854
  1035
      by simp
wenzelm@53854
  1036
    also have "\<dots> \<longleftrightarrow> x = 1 \<or> x = - 1"
wenzelm@53854
  1037
      unfolding th0 th1 by simp
himmelma@33175
  1038
    finally show "?ths x" ..
himmelma@33175
  1039
  qed
wenzelm@53253
  1040
  from oQ have "Q ** transpose Q = mat 1"
wenzelm@53253
  1041
    by (metis orthogonal_matrix_def)
wenzelm@53253
  1042
  then have "det (Q ** transpose Q) = det (mat 1:: 'a^'n^'n)"
wenzelm@53253
  1043
    by simp
wenzelm@53253
  1044
  then have "det Q * det Q = 1"
wenzelm@53253
  1045
    by (simp add: det_mul det_I det_transpose)
himmelma@33175
  1046
  then show ?thesis unfolding th .
himmelma@33175
  1047
qed
himmelma@33175
  1048
wenzelm@60420
  1049
text \<open>Linearity of scaling, and hence isometry, that preserves origin.\<close>
wenzelm@53854
  1050
himmelma@33175
  1051
lemma scaling_linear:
hoelzl@34291
  1052
  fixes f :: "real ^'n \<Rightarrow> real ^'n"
wenzelm@53253
  1053
  assumes f0: "f 0 = 0"
wenzelm@53253
  1054
    and fd: "\<forall>x y. dist (f x) (f y) = c * dist x y"
himmelma@33175
  1055
  shows "linear f"
wenzelm@53253
  1056
proof -
wenzelm@53253
  1057
  {
wenzelm@53253
  1058
    fix v w
wenzelm@53253
  1059
    {
wenzelm@53253
  1060
      fix x
wenzelm@53253
  1061
      note fd[rule_format, of x 0, unfolded dist_norm f0 diff_0_right]
wenzelm@53253
  1062
    }
himmelma@33175
  1063
    note th0 = this
wenzelm@53077
  1064
    have "f v \<bullet> f w = c\<^sup>2 * (v \<bullet> w)"
himmelma@33175
  1065
      unfolding dot_norm_neg dist_norm[symmetric]
himmelma@33175
  1066
      unfolding th0 fd[rule_format] by (simp add: power2_eq_square field_simps)}
himmelma@33175
  1067
  note fc = this
hoelzl@50526
  1068
  show ?thesis
huffman@53600
  1069
    unfolding linear_iff vector_eq[where 'a="real^'n"] scalar_mult_eq_scaleR
hoelzl@50526
  1070
    by (simp add: inner_add fc field_simps)
himmelma@33175
  1071
qed
himmelma@33175
  1072
himmelma@33175
  1073
lemma isometry_linear:
wenzelm@53253
  1074
  "f (0:: real^'n) = (0:: real^'n) \<Longrightarrow> \<forall>x y. dist(f x) (f y) = dist x y \<Longrightarrow> linear f"
wenzelm@53253
  1075
  by (rule scaling_linear[where c=1]) simp_all
himmelma@33175
  1076
wenzelm@60420
  1077
text \<open>Hence another formulation of orthogonal transformation.\<close>
himmelma@33175
  1078
himmelma@33175
  1079
lemma orthogonal_transformation_isometry:
hoelzl@34291
  1080
  "orthogonal_transformation f \<longleftrightarrow> f(0::real^'n) = (0::real^'n) \<and> (\<forall>x y. dist(f x) (f y) = dist x y)"
himmelma@33175
  1081
  unfolding orthogonal_transformation
himmelma@33175
  1082
  apply (rule iffI)
himmelma@33175
  1083
  apply clarify
lp15@63469
  1084
  apply (clarsimp simp add: linear_0 linear_diff[symmetric] dist_norm)
himmelma@33175
  1085
  apply (rule conjI)
himmelma@33175
  1086
  apply (rule isometry_linear)
himmelma@33175
  1087
  apply simp
himmelma@33175
  1088
  apply simp
himmelma@33175
  1089
  apply clarify
himmelma@33175
  1090
  apply (erule_tac x=v in allE)
himmelma@33175
  1091
  apply (erule_tac x=0 in allE)
wenzelm@53253
  1092
  apply (simp add: dist_norm)
wenzelm@53253
  1093
  done
himmelma@33175
  1094
wenzelm@60420
  1095
text \<open>Can extend an isometry from unit sphere.\<close>
himmelma@33175
  1096
himmelma@33175
  1097
lemma isometry_sphere_extend:
hoelzl@34291
  1098
  fixes f:: "real ^'n \<Rightarrow> real ^'n"
himmelma@33175
  1099
  assumes f1: "\<forall>x. norm x = 1 \<longrightarrow> norm (f x) = 1"
wenzelm@53253
  1100
    and fd1: "\<forall> x y. norm x = 1 \<longrightarrow> norm y = 1 \<longrightarrow> dist (f x) (f y) = dist x y"
himmelma@33175
  1101
  shows "\<exists>g. orthogonal_transformation g \<and> (\<forall>x. norm x = 1 \<longrightarrow> g x = f x)"
wenzelm@53253
  1102
proof -
wenzelm@53253
  1103
  {
wenzelm@53253
  1104
    fix x y x' y' x0 y0 x0' y0' :: "real ^'n"
wenzelm@53253
  1105
    assume H:
wenzelm@53253
  1106
      "x = norm x *\<^sub>R x0"
wenzelm@53253
  1107
      "y = norm y *\<^sub>R y0"
wenzelm@53253
  1108
      "x' = norm x *\<^sub>R x0'" "y' = norm y *\<^sub>R y0'"
wenzelm@53253
  1109
      "norm x0 = 1" "norm x0' = 1" "norm y0 = 1" "norm y0' = 1"
wenzelm@53253
  1110
      "norm(x0' - y0') = norm(x0 - y0)"
wenzelm@53854
  1111
    then have *: "x0 \<bullet> y0 = x0' \<bullet> y0' + y0' \<bullet> x0' - y0 \<bullet> x0 "
wenzelm@53253
  1112
      by (simp add: norm_eq norm_eq_1 inner_add inner_diff)
himmelma@33175
  1113
    have "norm(x' - y') = norm(x - y)"
himmelma@33175
  1114
      apply (subst H(1))
himmelma@33175
  1115
      apply (subst H(2))
himmelma@33175
  1116
      apply (subst H(3))
himmelma@33175
  1117
      apply (subst H(4))
himmelma@33175
  1118
      using H(5-9)
himmelma@33175
  1119
      apply (simp add: norm_eq norm_eq_1)
wenzelm@53854
  1120
      apply (simp add: inner_diff scalar_mult_eq_scaleR)
wenzelm@53854
  1121
      unfolding *
wenzelm@53253
  1122
      apply (simp add: field_simps)
wenzelm@53253
  1123
      done
wenzelm@53253
  1124
  }
himmelma@33175
  1125
  note th0 = this
huffman@44228
  1126
  let ?g = "\<lambda>x. if x = 0 then 0 else norm x *\<^sub>R f (inverse (norm x) *\<^sub>R x)"
wenzelm@53253
  1127
  {
wenzelm@53253
  1128
    fix x:: "real ^'n"
wenzelm@53253
  1129
    assume nx: "norm x = 1"
wenzelm@53854
  1130
    have "?g x = f x"
wenzelm@53854
  1131
      using nx by auto
wenzelm@53253
  1132
  }
wenzelm@53253
  1133
  then have thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x"
wenzelm@53253
  1134
    by blast
wenzelm@53854
  1135
  have g0: "?g 0 = 0"
wenzelm@53854
  1136
    by simp
wenzelm@53253
  1137
  {
wenzelm@53253
  1138
    fix x y :: "real ^'n"
wenzelm@53253
  1139
    {
wenzelm@53253
  1140
      assume "x = 0" "y = 0"
wenzelm@53854
  1141
      then have "dist (?g x) (?g y) = dist x y"
wenzelm@53854
  1142
        by simp
wenzelm@53253
  1143
    }
himmelma@33175
  1144
    moreover
wenzelm@53253
  1145
    {
wenzelm@53253
  1146
      assume "x = 0" "y \<noteq> 0"
himmelma@33175
  1147
      then have "dist (?g x) (?g y) = dist x y"
huffman@36362
  1148
        apply (simp add: dist_norm)
himmelma@33175
  1149
        apply (rule f1[rule_format])
wenzelm@53253
  1150
        apply (simp add: field_simps)
wenzelm@53253
  1151
        done
wenzelm@53253
  1152
    }
himmelma@33175
  1153
    moreover
wenzelm@53253
  1154
    {
wenzelm@53253
  1155
      assume "x \<noteq> 0" "y = 0"
himmelma@33175
  1156
      then have "dist (?g x) (?g y) = dist x y"
huffman@36362
  1157
        apply (simp add: dist_norm)
himmelma@33175
  1158
        apply (rule f1[rule_format])
wenzelm@53253
  1159
        apply (simp add: field_simps)
wenzelm@53253
  1160
        done
wenzelm@53253
  1161
    }
himmelma@33175
  1162
    moreover
wenzelm@53253
  1163
    {
wenzelm@53253
  1164
      assume z: "x \<noteq> 0" "y \<noteq> 0"
wenzelm@53253
  1165
      have th00:
wenzelm@53253
  1166
        "x = norm x *\<^sub>R (inverse (norm x) *\<^sub>R x)"
wenzelm@53253
  1167
        "y = norm y *\<^sub>R (inverse (norm y) *\<^sub>R y)"
wenzelm@53253
  1168
        "norm x *\<^sub>R f ((inverse (norm x) *\<^sub>R x)) = norm x *\<^sub>R f (inverse (norm x) *\<^sub>R x)"
huffman@44228
  1169
        "norm y *\<^sub>R f (inverse (norm y) *\<^sub>R y) = norm y *\<^sub>R f (inverse (norm y) *\<^sub>R y)"
huffman@44228
  1170
        "norm (inverse (norm x) *\<^sub>R x) = 1"
huffman@44228
  1171
        "norm (f (inverse (norm x) *\<^sub>R x)) = 1"
huffman@44228
  1172
        "norm (inverse (norm y) *\<^sub>R y) = 1"
huffman@44228
  1173
        "norm (f (inverse (norm y) *\<^sub>R y)) = 1"
huffman@44228
  1174
        "norm (f (inverse (norm x) *\<^sub>R x) - f (inverse (norm y) *\<^sub>R y)) =
wenzelm@53253
  1175
          norm (inverse (norm x) *\<^sub>R x - inverse (norm y) *\<^sub>R y)"
himmelma@33175
  1176
        using z
huffman@44457
  1177
        by (auto simp add: field_simps intro: f1[rule_format] fd1[rule_format, unfolded dist_norm])
himmelma@33175
  1178
      from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
wenzelm@53253
  1179
        by (simp add: dist_norm)
wenzelm@53253
  1180
    }
wenzelm@53854
  1181
    ultimately have "dist (?g x) (?g y) = dist x y"
wenzelm@53854
  1182
      by blast
wenzelm@53253
  1183
  }
himmelma@33175
  1184
  note thd = this
himmelma@33175
  1185
    show ?thesis
himmelma@33175
  1186
    apply (rule exI[where x= ?g])
himmelma@33175
  1187
    unfolding orthogonal_transformation_isometry
wenzelm@53253
  1188
    using g0 thfg thd
wenzelm@53253
  1189
    apply metis
wenzelm@53253
  1190
    done
himmelma@33175
  1191
qed
himmelma@33175
  1192
wenzelm@60420
  1193
text \<open>Rotation, reflection, rotoinversion.\<close>
himmelma@33175
  1194
himmelma@33175
  1195
definition "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
himmelma@33175
  1196
definition "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"
himmelma@33175
  1197
himmelma@33175
  1198
lemma orthogonal_rotation_or_rotoinversion:
haftmann@35028
  1199
  fixes Q :: "'a::linordered_idom^'n^'n"
himmelma@33175
  1200
  shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
himmelma@33175
  1201
  by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)
wenzelm@53253
  1202
wenzelm@60420
  1203
text \<open>Explicit formulas for low dimensions.\<close>
himmelma@33175
  1204
haftmann@57418
  1205
lemma setprod_neutral_const: "setprod f {(1::nat)..1} = f 1"
lp15@61286
  1206
  by simp
himmelma@33175
  1207
himmelma@33175
  1208
lemma setprod_2: "setprod f {(1::nat)..2} = f 1 * f 2"
lp15@61286
  1209
  by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute)
wenzelm@53253
  1210
himmelma@33175
  1211
lemma setprod_3: "setprod f {(1::nat)..3} = f 1 * f 2 * f 3"
lp15@61286
  1212
  by (simp add: eval_nat_numeral atLeastAtMostSuc_conv mult.commute)
himmelma@33175
  1213
himmelma@33175
  1214
lemma det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
lp15@61286
  1215
  by (simp add: det_def of_nat_Suc sign_id)
himmelma@33175
  1216
himmelma@33175
  1217
lemma det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
wenzelm@53253
  1218
proof -
himmelma@33175
  1219
  have f12: "finite {2::2}" "1 \<notin> {2::2}" by auto
himmelma@33175
  1220
  show ?thesis
wenzelm@53253
  1221
    unfolding det_def UNIV_2
wenzelm@53253
  1222
    unfolding setsum_over_permutations_insert[OF f12]
wenzelm@53253
  1223
    unfolding permutes_sing
wenzelm@53253
  1224
    by (simp add: sign_swap_id sign_id swap_id_eq)
himmelma@33175
  1225
qed
himmelma@33175
  1226
wenzelm@53253
  1227
lemma det_3:
wenzelm@53253
  1228
  "det (A::'a::comm_ring_1^3^3) =
wenzelm@53253
  1229
    A$1$1 * A$2$2 * A$3$3 +
wenzelm@53253
  1230
    A$1$2 * A$2$3 * A$3$1 +
wenzelm@53253
  1231
    A$1$3 * A$2$1 * A$3$2 -
wenzelm@53253
  1232
    A$1$1 * A$2$3 * A$3$2 -
wenzelm@53253
  1233
    A$1$2 * A$2$1 * A$3$3 -
wenzelm@53253
  1234
    A$1$3 * A$2$2 * A$3$1"
wenzelm@53253
  1235
proof -
wenzelm@53854
  1236
  have f123: "finite {2::3, 3}" "1 \<notin> {2::3, 3}"
wenzelm@53854
  1237
    by auto
wenzelm@53854
  1238
  have f23: "finite {3::3}" "2 \<notin> {3::3}"
wenzelm@53854
  1239
    by auto
himmelma@33175
  1240
himmelma@33175
  1241
  show ?thesis
wenzelm@53253
  1242
    unfolding det_def UNIV_3
wenzelm@53253
  1243
    unfolding setsum_over_permutations_insert[OF f123]
wenzelm@53253
  1244
    unfolding setsum_over_permutations_insert[OF f23]
wenzelm@53253
  1245
    unfolding permutes_sing
wenzelm@53253
  1246
    by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
himmelma@33175
  1247
qed
himmelma@33175
  1248
himmelma@33175
  1249
end