src/HOL/Analysis/Determinants.thy
changeset 68138 c738f40e88d4
parent 68134 cfe796bf59da
child 68143 58c9231c2937
equal deleted inserted replaced
68137:afcdc4c0ef0d 68138:c738f40e88d4
    75       of_int (sign p) * (prod (\<lambda>i. ?di A i (p i)) ?U)"
    75       of_int (sign p) * (prod (\<lambda>i. ?di A i (p i)) ?U)"
    76       using sth by simp
    76       using sth by simp
    77   }
    77   }
    78   then show ?thesis
    78   then show ?thesis
    79     unfolding det_def
    79     unfolding det_def
    80     by (subst sum_permutations_inverse) (blast intro: sum.cong elim: )
    80     by (subst sum_permutations_inverse) (blast intro: sum.cong)
    81 qed
    81 qed
    82 
    82 
    83 lemma det_lowerdiagonal:
    83 lemma det_lowerdiagonal:
    84   fixes A :: "'a::comm_ring_1^('n::{finite,wellorder})^('n::{finite,wellorder})"
    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"
    85   assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
    89   let ?PU = "{p. p permutes ?U}"
    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)"
    90   let ?pp = "\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
    91   have fU: "finite ?U"
    91   have fU: "finite ?U"
    92     by simp
    92     by simp
    93   have id0: "{id} \<subseteq> ?PU"
    93   have id0: "{id} \<subseteq> ?PU"
    94     by (auto simp add: permutes_id)
    94     by (auto simp: permutes_id)
    95   have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
    95   have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
    96   proof
    96   proof
    97     fix p
    97     fix p
    98     assume "p \<in> ?PU - {id}"
    98     assume "p \<in> ?PU - {id}"
    99     then obtain i where i: "p i > i"
    99     then obtain i where i: "p i > i"
   116   let ?PU = "{p. p permutes ?U}"
   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))"
   117   let ?pp = "(\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
   118   have fU: "finite ?U"
   118   have fU: "finite ?U"
   119     by simp
   119     by simp
   120   have id0: "{id} \<subseteq> ?PU"
   120   have id0: "{id} \<subseteq> ?PU"
   121     by (auto simp add: permutes_id)
   121     by (auto simp: permutes_id)
   122   have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0"
   122   have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0"
   123   proof
   123   proof
   124     fix p
   124     fix p
   125     assume p: "p \<in> ?PU - {id}"
   125     assume p: "p \<in> ?PU - {id}"
   126     then obtain i where i: "p i < i"
   126     then obtain i where i: "p i < i"
   143   let ?PU = "{p. p permutes ?U}"
   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)"
   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
   145   have fU: "finite ?U" by simp
   146   from finite_permutations[OF fU] have fPU: "finite ?PU" .
   146   from finite_permutations[OF fU] have fPU: "finite ?PU" .
   147   have id0: "{id} \<subseteq> ?PU"
   147   have id0: "{id} \<subseteq> ?PU"
   148     by (auto simp add: permutes_id)
   148     by (auto simp: permutes_id)
   149   have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
   149   have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
   150   proof
   150   proof
   151     fix p
   151     fix p
   152     assume p: "p \<in> ?PU - {id}"
   152     assume p: "p \<in> ?PU - {id}"
   153     then obtain i where i: "p i \<noteq> i"
   153     then obtain i where i: "p i \<noteq> i"
   248   {fix x
   248   {fix x
   249     assume x: "x\<in> ?S1"
   249     assume x: "x\<in> ?S1"
   250     have "sign (?t_jk \<circ> x) = sign (?t_jk) * sign x"
   250     have "sign (?t_jk \<circ> x) = sign (?t_jk) * sign x"
   251       by (metis (lifting) finite_class.finite_UNIV mem_Collect_eq
   251       by (metis (lifting) finite_class.finite_UNIV mem_Collect_eq
   252           permutation_permutes permutation_swap_id sign_compose x)
   252           permutation_permutes permutation_swap_id sign_compose x)
   253     also have "... = - sign x" using sign_tjk by simp
   253     also have "\<dots> = - sign x" using sign_tjk by simp
   254     also have "... \<noteq> sign x" unfolding sign_def 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"
   255     finally have "sign (?t_jk \<circ> x) \<noteq> sign x" and "(?t_jk \<circ> x) \<in> ?S2"
   256       using x by force+
   256       using x by force+
   257   }
   257   }
   258   hence disjoint: "?S1 \<inter> ?S2 = {}"
   258   hence disjoint: "?S1 \<inter> ?S2 = {}"
   259     by (force simp: sign_def)
   259     by (force simp: sign_def)
   272     show "Fun.swap j k id \<circ> p permutes UNIV" by (metis p permutes_compose tjk_permutes)
   272     show "Fun.swap j k id \<circ> p permutes UNIV" by (metis p permutes_compose tjk_permutes)
   273   qed
   273   qed
   274   have "sum ?f ?S2 = sum ((\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))
   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}"
   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])
   276     unfolding g_S1 by (rule sum.reindex[OF inj_g])
   277   also have "... = sum (\<lambda>p. of_int (sign (?t_jk \<circ> p)) * (\<Prod>i\<in>UNIV. A $ i $ p i)) ?S1"
   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 add: tjk_eq)
   278     unfolding o_def by (rule sum.cong, auto simp: tjk_eq)
   279   also have "... = sum (\<lambda>p. - ?f p) ?S1"
   279   also have "\<dots> = sum (\<lambda>p. - ?f p) ?S1"
   280   proof (rule sum.cong, auto)
   280   proof (rule sum.cong, auto)
   281     fix x assume x: "x permutes ?U"
   281     fix x assume x: "x permutes ?U"
   282       and even_x: "evenperm x"
   282       and even_x: "evenperm x"
   283     hence perm_x: "permutation x" and perm_tjk: "permutation ?t_jk"
   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
   284       using permutation_permutes[of x] permutation_permutes[of ?t_jk] permutation_swap_id
   287       unfolding sign_compose[OF perm_tjk perm_x] sign_tjk by auto
   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)
   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))"
   289       = - (of_int (sign x) * (\<Prod>i\<in>UNIV. A $ i $ x i))"
   290       by auto
   290       by auto
   291   qed
   291   qed
   292   also have "...= - sum ?f ?S1" unfolding sum_negf ..
   292   also have "\<dots>= - sum ?f ?S1" unfolding sum_negf ..
   293   finally have *: "sum ?f ?S2 = - sum ?f ?S1" .
   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))"
   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 ..
   295     unfolding det_def ..
   296   also have "...= sum ?f ?S1 + sum ?f ?S2"
   296   also have "\<dots>= sum ?f ?S1 + sum ?f ?S2"
   297     by (subst PU_decomposition, rule sum.union_disjoint[OF _ _ disjoint], auto)
   297     by (subst PU_decomposition, rule sum.union_disjoint[OF _ _ disjoint], auto)
   298   also have "...= sum ?f ?S1 - sum ?f ?S1 " unfolding * by auto
   298   also have "\<dots>= sum ?f ?S1 - sum ?f ?S1 " unfolding * by auto
   299   also have "...= 0" by simp
   299   also have "\<dots>= 0" by simp
   300   finally show "det A = 0" by simp
   300   finally show "det A = 0" by simp
   301 qed
   301 qed
   302 
   302 
   303 lemma det_identical_rows:
   303 lemma det_identical_rows:
   304   fixes A :: "'a::comm_ring_1^'n^'n"
   304   fixes A :: "'a::comm_ring_1^'n^'n"
   307   by (metis column_transpose det_identical_columns det_transpose ij r)
   307   by (metis column_transpose det_identical_columns det_transpose ij r)
   308 
   308 
   309 lemma det_zero_row:
   309 lemma det_zero_row:
   310   fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
   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"
   311   shows "row i A = 0 \<Longrightarrow> det A = 0" and "row j F = 0 \<Longrightarrow> det F = 0"
   312   by (force simp add: row_def det_def vec_eq_iff sign_nz intro!: sum.neutral)+
   312   by (force simp: row_def det_def vec_eq_iff sign_nz intro!: sum.neutral)+
   313 
   313 
   314 lemma det_zero_column:
   314 lemma det_zero_column:
   315   fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
   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"
   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
   317   unfolding atomize_conj atomize_imp
   374   from p have pU: "p permutes ?U"
   374   from p have pU: "p permutes ?U"
   375     by blast
   375     by blast
   376   have kU: "?U = insert k ?Uk"
   376   have kU: "?U = insert k ?Uk"
   377     by blast
   377     by blast
   378   have eq: "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?g i $ p i) ?Uk"
   378   have eq: "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?g i $ p i) ?Uk"
   379     by (auto simp: )
   379     by auto
   380   have Uk: "finite ?Uk" "k \<notin> ?Uk"
   380   have Uk: "finite ?Uk" "k \<notin> ?Uk"
   381     by auto
   381     by auto
   382   have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
   382   have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
   383     unfolding kU[symmetric] ..
   383     unfolding kU[symmetric] ..
   384   also have "\<dots> = ?f k $ p k  * prod (\<lambda>i. ?f i $ p i) ?Uk"
   384   also have "\<dots> = ?f k $ p k  * prod (\<lambda>i. ?f i $ p i) ?Uk"
   473     unfolding vec.dependent_def rows_def by blast
   473     unfolding vec.dependent_def rows_def by blast
   474   show ?thesis
   474   show ?thesis
   475   proof (cases "\<forall>i j. i \<noteq> j \<longrightarrow> row i A \<noteq> row j A")
   475   proof (cases "\<forall>i j. i \<noteq> j \<longrightarrow> row i A \<noteq> row j A")
   476     case True
   476     case True
   477     with i have "vec.span (rows A - {row i A}) \<subseteq> vec.span {row j A |j. j \<noteq> i}"
   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 add: rows_def intro!: vec.span_mono)
   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}"
   479     then have "- row i A \<in> vec.span {row j A|j. j \<noteq> i}"
   480       by (meson i subsetCE vec.span_neg)
   480       by (meson i subsetCE vec.span_neg)
   481     from det_row_span[OF this]
   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)"
   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 ..
   483       unfolding right_minus vector_smult_lzero ..
   513 proof (induct k)
   513 proof (induct k)
   514   case 0
   514   case 0
   515   have *: "{f. \<forall>i. f i = i} = {id}"
   515   have *: "{f. \<forall>i. f i = i} = {id}"
   516     by auto
   516     by auto
   517   show ?case
   517   show ?case
   518     by (auto simp add: *)
   518     by (auto simp: *)
   519 next
   519 next
   520   case (Suc k)
   520   case (Suc k)
   521   let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
   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)})"
   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)}"
   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 add: image_iff)
   524     apply (auto simp: image_iff)
   525     apply (rename_tac f)
   525     apply (rename_tac f)
   526     apply (rule_tac x="f (Suc k)" in bexI)
   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)
   527     apply (rule_tac x = "\<lambda>i. if i = Suc k then i else f i" in exI, auto)
   528     apply auto
       
   529     done
   528     done
   530   with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
   529   with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
   531   show ?case
   530   show ?case
   532     by metis
   531     by metis
   533 qed
   532 qed
   734   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"
   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"
   735     unfolding invertible_right_inverse matrix_right_invertible_independent_rows
   734     unfolding invertible_right_inverse matrix_right_invertible_independent_rows
   736     by blast
   735     by blast
   737   have thr0: "- row i A = sum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
   736   have thr0: "- row i A = sum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
   738     unfolding sum_cmul  using c ci   
   737     unfolding sum_cmul  using c ci   
   739     by (auto simp add: sum.remove[OF fU iU] eq_vector_fraction_iff add_eq_0_iff)
   738     by (auto simp: sum.remove[OF fU iU] eq_vector_fraction_iff add_eq_0_iff)
   740   have thr: "- row i A \<in> vec.span {row j A| j. j \<noteq> i}"
   739   have thr: "- row i A \<in> vec.span {row j A| j. j \<noteq> i}"
   741     unfolding thr0 by (auto intro: vec.span_base vec.span_scale vec.span_sum)
   740     unfolding thr0 by (auto intro: vec.span_base vec.span_scale vec.span_sum)
   742   let ?B = "(\<chi> k. if k = i then 0 else row k A) :: 'a^'n^'n"
   741   let ?B = "(\<chi> k. if k = i then 0 else row k A) :: 'a^'n^'n"
   743   have thrb: "row i ?B = 0" using iU by (vector row_def)
   742   have thrb: "row i ?B = 0" using iU by (vector row_def)
   744   have "det A = 0"
   743   have "det A = 0"
   787   fix B
   786   fix B
   788   assume 1: "B ** matrix f = mat 1"
   787   assume 1: "B ** matrix f = mat 1"
   789   show "\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> g \<circ> f = id"
   788   show "\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> g \<circ> f = id"
   790   proof (intro exI conjI)
   789   proof (intro exI conjI)
   791     show "Vector_Spaces.linear ( *s) ( *s) (\<lambda>y. B *v y)"
   790     show "Vector_Spaces.linear ( *s) ( *s) (\<lambda>y. B *v y)"
   792       by (simp add:)
   791       by simp
   793     show "(( *v) B) \<circ> f = id"
   792     show "(( *v) B) \<circ> f = id"
   794       unfolding o_def
   793       unfolding o_def
   795       by (metis assms 1 eq_id_iff matrix_vector_mul(1) matrix_vector_mul_assoc matrix_vector_mul_lid)
   794       by (metis assms 1 eq_id_iff matrix_vector_mul(1) matrix_vector_mul_assoc matrix_vector_mul_lid)
   796   qed
   795   qed
   797 next
   796 next
   815   fix B
   814   fix B
   816   assume 1: "matrix f ** B = mat 1"
   815   assume 1: "matrix f ** B = mat 1"
   817   show "\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> f \<circ> g = id"
   816   show "\<exists>g. Vector_Spaces.linear ( *s) ( *s) g \<and> f \<circ> g = id"
   818   proof (intro exI conjI)
   817   proof (intro exI conjI)
   819     show "Vector_Spaces.linear ( *s) ( *s) (( *v) B)"
   818     show "Vector_Spaces.linear ( *s) ( *s) (( *v) B)"
   820       by (simp add: )
   819       by simp
   821     show "f \<circ> ( *v) B = id"
   820     show "f \<circ> ( *v) B = id"
   822       using 1 assms comp_apply eq_id_iff vec.linear_id matrix_id_mat_1 matrix_vector_mul_assoc matrix_works
   821       using 1 assms comp_apply eq_id_iff vec.linear_id matrix_id_mat_1 matrix_vector_mul_assoc matrix_works
   823       by (metis (no_types, hide_lams))
   822       by (metis (no_types, hide_lams))
   824   qed
   823   qed
   825 next
   824 next
   965     "orthogonal_transformation f \<Longrightarrow> orthogonal (f x) (f y) \<longleftrightarrow> orthogonal x y"
   964     "orthogonal_transformation f \<Longrightarrow> orthogonal (f x) (f y) \<longleftrightarrow> orthogonal x y"
   966   by (simp add: orthogonal_def orthogonal_transformation_def)
   965   by (simp add: orthogonal_def orthogonal_transformation_def)
   967 
   966 
   968 lemma orthogonal_transformation_compose:
   967 lemma orthogonal_transformation_compose:
   969    "\<lbrakk>orthogonal_transformation f; orthogonal_transformation g\<rbrakk> \<Longrightarrow> orthogonal_transformation(f \<circ> g)"
   968    "\<lbrakk>orthogonal_transformation f; orthogonal_transformation g\<rbrakk> \<Longrightarrow> orthogonal_transformation(f \<circ> g)"
   970   by (auto simp add: orthogonal_transformation_def linear_compose)
   969   by (auto simp: orthogonal_transformation_def linear_compose)
   971 
   970 
   972 lemma orthogonal_transformation_neg:
   971 lemma orthogonal_transformation_neg:
   973   "orthogonal_transformation(\<lambda>x. -(f x)) \<longleftrightarrow> orthogonal_transformation f"
   972   "orthogonal_transformation(\<lambda>x. -(f x)) \<longleftrightarrow> orthogonal_transformation f"
   974   by (auto simp: orthogonal_transformation_def dest: linear_compose_neg)
   973   by (auto simp: orthogonal_transformation_def dest: linear_compose_neg)
   975 
   974 
  1016     and oB: "orthogonal_matrix B"
  1015     and oB: "orthogonal_matrix B"
  1017   shows "orthogonal_matrix(A ** B)"
  1016   shows "orthogonal_matrix(A ** B)"
  1018   using oA oB
  1017   using oA oB
  1019   unfolding orthogonal_matrix matrix_transpose_mul
  1018   unfolding orthogonal_matrix matrix_transpose_mul
  1020   apply (subst matrix_mul_assoc)
  1019   apply (subst matrix_mul_assoc)
  1021   apply (subst matrix_mul_assoc[symmetric])
  1020   apply (subst matrix_mul_assoc[symmetric], simp)
  1022   apply (simp add: )
       
  1023   done
  1021   done
  1024 
  1022 
  1025 lemma orthogonal_transformation_matrix:
  1023 lemma orthogonal_transformation_matrix:
  1026   fixes f:: "real^'n \<Rightarrow> real^'n"
  1024   fixes f:: "real^'n \<Rightarrow> real^'n"
  1027   shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
  1025   shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
  1079   proof -
  1077   proof -
  1080     fix x:: 'a
  1078     fix x:: 'a
  1081     have th0: "x * x - 1 = (x - 1) * (x + 1)"
  1079     have th0: "x * x - 1 = (x - 1) * (x + 1)"
  1082       by (simp add: field_simps)
  1080       by (simp add: field_simps)
  1083     have th1: "\<And>(x::'a) y. x = - y \<longleftrightarrow> x + y = 0"
  1081     have th1: "\<And>(x::'a) y. x = - y \<longleftrightarrow> x + y = 0"
  1084       apply (subst eq_iff_diff_eq_0)
  1082       apply (subst eq_iff_diff_eq_0, simp)
  1085       apply simp
       
  1086       done
  1083       done
  1087     have "x * x = 1 \<longleftrightarrow> x * x - 1 = 0"
  1084     have "x * x = 1 \<longleftrightarrow> x * x - 1 = 0"
  1088       by simp
  1085       by simp
  1089     also have "\<dots> \<longleftrightarrow> x = 1 \<or> x = - 1"
  1086     also have "\<dots> \<longleftrightarrow> x = 1 \<or> x = - 1"
  1090       unfolding th0 th1 by simp
  1087       unfolding th0 th1 by simp
  1197   assumes "norm a = 1"
  1194   assumes "norm a = 1"
  1198   obtains A where "orthogonal_matrix A" "A *v (axis k 1) = a"
  1195   obtains A where "orthogonal_matrix A" "A *v (axis k 1) = a"
  1199 proof -
  1196 proof -
  1200   obtain S where "a \<in> S" "pairwise orthogonal S" and noS: "\<And>x. x \<in> S \<Longrightarrow> norm x = 1"
  1197   obtain S where "a \<in> S" "pairwise orthogonal S" and noS: "\<And>x. x \<in> S \<Longrightarrow> norm x = 1"
  1201    and "independent S" "card S = CARD('n)" "span S = UNIV"
  1198    and "independent S" "card S = CARD('n)" "span S = UNIV"
  1202     using vector_in_orthonormal_basis assms by (force simp: )
  1199     using vector_in_orthonormal_basis assms by force
  1203   then obtain f0 where "bij_betw f0 (UNIV::'n set) S"
  1200   then obtain f0 where "bij_betw f0 (UNIV::'n set) S"
  1204     by (metis finite_class.finite_UNIV finite_same_card_bij finiteI_independent)
  1201     by (metis finite_class.finite_UNIV finite_same_card_bij finiteI_independent)
  1205   then obtain f where f: "bij_betw f (UNIV::'n set) S" and a: "a = f k"
  1202   then obtain f where f: "bij_betw f (UNIV::'n set) S" and a: "a = f k"
  1206     using bij_swap_iff [of k "inv f0 a" f0]
  1203     using bij_swap_iff [of k "inv f0 a" f0]
  1207     by (metis UNIV_I \<open>a \<in> S\<close> bij_betw_inv_into_right bij_betw_swap_iff swap_apply1)
  1204     by (metis UNIV_I \<open>a \<in> S\<close> bij_betw_inv_into_right bij_betw_swap_iff swap_apply1)
  1347         "norm (inverse (norm y) *\<^sub>R y) = 1"
  1344         "norm (inverse (norm y) *\<^sub>R y) = 1"
  1348         "norm (f (inverse (norm y) *\<^sub>R y)) = 1"
  1345         "norm (f (inverse (norm y) *\<^sub>R y)) = 1"
  1349         "norm (f (inverse (norm x) *\<^sub>R x) - f (inverse (norm y) *\<^sub>R y)) =
  1346         "norm (f (inverse (norm x) *\<^sub>R x) - f (inverse (norm y) *\<^sub>R y)) =
  1350           norm (inverse (norm x) *\<^sub>R x - inverse (norm y) *\<^sub>R y)"
  1347           norm (inverse (norm x) *\<^sub>R x - inverse (norm y) *\<^sub>R y)"
  1351         using z
  1348         using z
  1352         by (auto simp add: field_simps intro: f1[rule_format] fd1[rule_format, unfolded dist_norm])
  1349         by (auto simp: field_simps intro: f1[rule_format] fd1[rule_format, unfolded dist_norm])
  1353       from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
  1350       from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
  1354         by (simp add: dist_norm)
  1351         by (simp add: dist_norm)
  1355     }
  1352     }
  1356     ultimately have "dist (?g x) (?g y) = dist x y"
  1353     ultimately have "dist (?g x) (?g y) = dist x y"
  1357       by blast
  1354       by blast