(*  Title:      HOL/Analysis/Determinants.thy
    Author:     Amine Chaieb, University of Cambridge; proofs reworked by LCP
*)

section \<open>Traces and Determinants of Square Matrices\<close>

theory Determinants
imports
  Cartesian_Space
  "HOL-Library.Permutations"
begin

subsection  \<open>Trace\<close>

definition\<^marker>\<open>tag important\<close>  trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a"
  where "trace A = sum (\<lambda>i. ((A$i)$i)) (UNIV::'n set)"

lemma  trace_0: "trace (mat 0) = 0"
  by (simp add: trace_def mat_def)

lemma  trace_I: "trace (mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))"
  by (simp add: trace_def mat_def)

lemma  trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
  by (simp add: trace_def sum.distrib)

lemma  trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
  by (simp add: trace_def sum_subtractf)

lemma  trace_mul_sym: "trace ((A::'a::comm_semiring_1^'n^'m) ** B) = trace (B**A)"
  apply (simp add: trace_def matrix_matrix_mult_def)
  apply (subst sum.swap)
  apply (simp add: mult.commute)
  done

subsubsection\<^marker>\<open>tag important\<close>  \<open>Definition of determinant\<close>

definition\<^marker>\<open>tag important\<close>  det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
  "det A =
    sum (\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set))
      {p. p permutes (UNIV :: 'n set)}"

text \<open>Basic determinant properties\<close>

lemma  det_transpose [simp]: "det (transpose A) = det (A::'a::comm_ring_1 ^'n^'n)"
proof -
  let ?di = "\<lambda>A i j. A$i$j"
  let ?U = "(UNIV :: 'n set)"
  have fU: "finite ?U" by simp
  {
    fix p
    assume p: "p \<in> {p. p permutes ?U}"
    from p have pU: "p permutes ?U"
      by blast
    have sth: "sign (inv p) = sign p"
      by (metis sign_inverse fU p mem_Collect_eq permutation_permutes)
    from permutes_inj[OF pU]
    have pi: "inj_on p ?U"
      by (blast intro: subset_inj_on)
    from permutes_image[OF pU]
    have "prod (\<lambda>i. ?di (transpose A) i (inv p i)) ?U =
      prod (\<lambda>i. ?di (transpose A) i (inv p i)) (p ` ?U)"
      by simp
    also have "\<dots> = prod ((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) ?U"
      unfolding prod.reindex[OF pi] ..
    also have "\<dots> = prod (\<lambda>i. ?di A i (p i)) ?U"
    proof -
      have "((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) i = ?di A i (p i)" if "i \<in> ?U" for i
        using that permutes_inv_o[OF pU] permutes_in_image[OF pU]
        unfolding transpose_def by (simp add: fun_eq_iff)
      then show "prod ((\<lambda>i. ?di (transpose A) i (inv p i)) \<circ> p) ?U = prod (\<lambda>i. ?di A i (p i)) ?U"
        by (auto intro: prod.cong)
    qed
    finally have "of_int (sign (inv p)) * (prod (\<lambda>i. ?di (transpose A) i (inv p i)) ?U) =
      of_int (sign p) * (prod (\<lambda>i. ?di A i (p i)) ?U)"
      using sth by simp
  }
  then show ?thesis
    unfolding det_def
    by (subst sum_permutations_inverse) (blast intro: sum.cong)
qed

lemma  det_lowerdiagonal:
  fixes A :: "'a::comm_ring_1^('n::{finite,wellorder})^('n::{finite,wellorder})"
  assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
  shows "det A = prod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
proof -
  let ?U = "UNIV:: 'n set"
  let ?PU = "{p. p permutes ?U}"
  let ?pp = "\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
  have fU: "finite ?U"
    by simp
  have id0: "{id} \<subseteq> ?PU"
    by (auto simp: permutes_id)
  have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
  proof
    fix p
    assume "p \<in> ?PU - {id}"
    then obtain i where i: "p i > i"
      by clarify (meson leI permutes_natset_le)
    from ld[OF i] have "\<exists>i \<in> ?U. A$i$p i = 0"
      by blast
    with prod_zero[OF fU] show "?pp p = 0"
      by force
  qed
  from sum.mono_neutral_cong_left[OF finite_permutations[OF fU] id0 p0] show ?thesis
    unfolding det_def by (simp add: sign_id)
qed

lemma  det_upperdiagonal:
  fixes A :: "'a::comm_ring_1^'n::{finite,wellorder}^'n::{finite,wellorder}"
  assumes ld: "\<And>i j. i > j \<Longrightarrow> A$i$j = 0"
  shows "det A = prod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
proof -
  let ?U = "UNIV:: 'n set"
  let ?PU = "{p. p permutes ?U}"
  let ?pp = "(\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
  have fU: "finite ?U"
    by simp
  have id0: "{id} \<subseteq> ?PU"
    by (auto simp: permutes_id)
  have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0"
  proof
    fix p
    assume p: "p \<in> ?PU - {id}"
    then obtain i where i: "p i < i"
      by clarify (meson leI permutes_natset_ge)
    from ld[OF i] have "\<exists>i \<in> ?U. A$i$p i = 0"
      by blast
    with prod_zero[OF fU]  show "?pp p = 0"
      by force
  qed
  from sum.mono_neutral_cong_left[OF finite_permutations[OF fU] id0 p0] show ?thesis
    unfolding det_def by (simp add: sign_id)
qed

proposition  det_diagonal:
  fixes A :: "'a::comm_ring_1^'n^'n"
  assumes ld: "\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0"
  shows "det A = prod (\<lambda>i. A$i$i) (UNIV::'n set)"
proof -
  let ?U = "UNIV:: 'n set"
  let ?PU = "{p. p permutes ?U}"
  let ?pp = "\<lambda>p. of_int (sign p) * prod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
  have fU: "finite ?U" by simp
  from finite_permutations[OF fU] have fPU: "finite ?PU" .
  have id0: "{id} \<subseteq> ?PU"
    by (auto simp: permutes_id)
  have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0"
  proof
    fix p
    assume p: "p \<in> ?PU - {id}"
    then obtain i where i: "p i \<noteq> i"
      by fastforce
    with ld have "\<exists>i \<in> ?U. A$i$p i = 0"
      by (metis UNIV_I)
    with prod_zero [OF fU] show "?pp p = 0"
      by force
  qed
  from sum.mono_neutral_cong_left[OF fPU id0 p0] show ?thesis
    unfolding det_def by (simp add: sign_id)
qed

lemma  det_I [simp]: "det (mat 1 :: 'a::comm_ring_1^'n^'n) = 1"
  by (simp add: det_diagonal mat_def)

lemma  det_0 [simp]: "det (mat 0 :: 'a::comm_ring_1^'n^'n) = 0"
  by (simp add: det_def prod_zero power_0_left)

lemma  det_permute_rows:
  fixes A :: "'a::comm_ring_1^'n^'n"
  assumes p: "p permutes (UNIV :: 'n::finite set)"
  shows "det (\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
proof -
  let ?U = "UNIV :: 'n set"
  let ?PU = "{p. p permutes ?U}"
  have *: "(\<Sum>q\<in>?PU. of_int (sign (q \<circ> p)) * (\<Prod>i\<in>?U. A $ p i $ (q \<circ> p) i)) =
           (\<Sum>n\<in>?PU. of_int (sign p) * of_int (sign n) * (\<Prod>i\<in>?U. A $ i $ n i))"
  proof (rule sum.cong)
    fix q
    assume qPU: "q \<in> ?PU"
    have fU: "finite ?U"
      by simp
    from qPU have q: "q permutes ?U"
      by blast
    have "prod (\<lambda>i. A$p i$ (q \<circ> p) i) ?U = prod ((\<lambda>i. A$p i$(q \<circ> p) i) \<circ> inv p) ?U"
      by (simp only: prod.permute[OF permutes_inv[OF p], symmetric])
    also have "\<dots> = prod (\<lambda>i. A $ (p \<circ> inv p) i $ (q \<circ> (p \<circ> inv p)) i) ?U"
      by (simp only: o_def)
    also have "\<dots> = prod (\<lambda>i. A$i$q i) ?U"
      by (simp only: o_def permutes_inverses[OF p])
    finally have thp: "prod (\<lambda>i. A$p i$ (q \<circ> p) i) ?U = prod (\<lambda>i. A$i$q i) ?U"
      by blast
    from p q have pp: "permutation p" and qp: "permutation q"
      by (metis fU permutation_permutes)+
    show "of_int (sign (q \<circ> p)) * prod (\<lambda>i. A$ p i$ (q \<circ> p) i) ?U =
          of_int (sign p) * of_int (sign q) * prod (\<lambda>i. A$i$q i) ?U"
      by (simp only: thp sign_compose[OF qp pp] mult.commute of_int_mult)
  qed auto
  show ?thesis
    apply (simp add: det_def sum_distrib_left mult.assoc[symmetric])
    apply (subst sum_permutations_compose_right[OF p])
    apply (rule *)
    done
qed

lemma  det_permute_columns:
  fixes A :: "'a::comm_ring_1^'n^'n"
  assumes p: "p permutes (UNIV :: 'n set)"
  shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
proof -
  let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
  let ?At = "transpose A"
  have "of_int (sign p) * det A = det (transpose (\<chi> i. transpose A $ p i))"
    unfolding det_permute_rows[OF p, of ?At] det_transpose ..
  moreover
  have "?Ap = transpose (\<chi> i. transpose A $ p i)"
    by (simp add: transpose_def vec_eq_iff)
  ultimately show ?thesis
    by simp
qed

lemma  det_identical_columns:
  fixes A :: "'a::comm_ring_1^'n^'n"
  assumes jk: "j \<noteq> k"
    and r: "column j A = column k A"
  shows "det A = 0"
proof -
  let ?U="UNIV::'n set"
  let ?t_jk="Fun.swap j k id"
  let ?PU="{p. p permutes ?U}"
  let ?S1="{p. p\<in>?PU \<and> evenperm p}"
  let ?S2="{(?t_jk \<circ> p) |p. p \<in>?S1}"
  let ?f="\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i)"
  let ?g="\<lambda>p. ?t_jk \<circ> p"
  have g_S1: "?S2 = ?g` ?S1" by auto
  have inj_g: "inj_on ?g ?S1"
  proof (unfold inj_on_def, auto)
    fix x y assume x: "x permutes ?U" and even_x: "evenperm x"
      and y: "y permutes ?U" and even_y: "evenperm y" and eq: "?t_jk \<circ> x = ?t_jk \<circ> y"
    show "x = y" by (metis (hide_lams, no_types) comp_assoc eq id_comp swap_id_idempotent)
  qed
  have tjk_permutes: "?t_jk permutes ?U" unfolding permutes_def swap_id_eq by (auto,metis)
  have tjk_eq: "\<forall>i l. A $ i $ ?t_jk l  =  A $ i $ l"
    using r jk
    unfolding column_def vec_eq_iff swap_id_eq by fastforce
  have sign_tjk: "sign ?t_jk = -1" using sign_swap_id[of j k] jk by auto
  {fix x
    assume x: "x\<in> ?S1"
    have "sign (?t_jk \<circ> x) = sign (?t_jk) * sign x"
      by (metis (lifting) finite_class.finite_UNIV mem_Collect_eq
          permutation_permutes permutation_swap_id sign_compose x)
    also have "\<dots> = - sign x" using sign_tjk by simp
    also have "\<dots> \<noteq> sign x" unfolding sign_def by simp
    finally have "sign (?t_jk \<circ> x) \<noteq> sign x" and "(?t_jk \<circ> x) \<in> ?S2"
      using x by force+
  }
  hence disjoint: "?S1 \<inter> ?S2 = {}"
    by (force simp: sign_def)
  have PU_decomposition: "?PU = ?S1 \<union> ?S2"
  proof (auto)
    fix x
    assume x: "x permutes ?U" and "\<forall>p. p permutes ?U \<longrightarrow> x = Fun.swap j k id \<circ> p \<longrightarrow> \<not> evenperm p"
    then obtain p where p: "p permutes UNIV" and x_eq: "x = Fun.swap j k id \<circ> p"
      and odd_p: "\<not> evenperm p"
      by (metis (mono_tags) id_o o_assoc permutes_compose swap_id_idempotent tjk_permutes)
    thus "evenperm x"
      by (meson evenperm_comp evenperm_swap finite_class.finite_UNIV
          jk permutation_permutes permutation_swap_id)
  next
    fix p assume p: "p permutes ?U"
    show "Fun.swap j k id \<circ> p permutes UNIV" by (metis p permutes_compose tjk_permutes)
  qed
  have "sum ?f ?S2 = sum ((\<lambda>p. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))
  \<circ> (\<circ>) (Fun.swap j k id)) {p \<in> {p. p permutes UNIV}. evenperm p}"
    unfolding g_S1 by (rule sum.reindex[OF inj_g])
  also have "\<dots> = sum (\<lambda>p. of_int (sign (?t_jk \<circ> p)) * (\<Prod>i\<in>UNIV. A $ i $ p i)) ?S1"
    unfolding o_def by (rule sum.cong, auto simp: tjk_eq)
  also have "\<dots> = sum (\<lambda>p. - ?f p) ?S1"
  proof (rule sum.cong, auto)
    fix x assume x: "x permutes ?U"
      and even_x: "evenperm x"
    hence perm_x: "permutation x" and perm_tjk: "permutation ?t_jk"
      using permutation_permutes[of x] permutation_permutes[of ?t_jk] permutation_swap_id
      by (metis finite_code)+
    have "(sign (?t_jk \<circ> x)) = - (sign x)"
      unfolding sign_compose[OF perm_tjk perm_x] sign_tjk by auto
    thus "of_int (sign (?t_jk \<circ> x)) * (\<Prod>i\<in>UNIV. A $ i $ x i)
      = - (of_int (sign x) * (\<Prod>i\<in>UNIV. A $ i $ x i))"
      by auto
  qed
  also have "\<dots>= - sum ?f ?S1" unfolding sum_negf ..
  finally have *: "sum ?f ?S2 = - sum ?f ?S1" .
  have "det A = (\<Sum>p | p permutes UNIV. of_int (sign p) * (\<Prod>i\<in>UNIV. A $ i $ p i))"
    unfolding det_def ..
  also have "\<dots>= sum ?f ?S1 + sum ?f ?S2"
    by (subst PU_decomposition, rule sum.union_disjoint[OF _ _ disjoint], auto)
  also have "\<dots>= sum ?f ?S1 - sum ?f ?S1 " unfolding * by auto
  also have "\<dots>= 0" by simp
  finally show "det A = 0" by simp
qed

lemma  det_identical_rows:
  fixes A :: "'a::comm_ring_1^'n^'n"
  assumes ij: "i \<noteq> j" and r: "row i A = row j A"
  shows "det A = 0"
  by (metis column_transpose det_identical_columns det_transpose ij r)

lemma  det_zero_row:
  fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
  shows "row i A = 0 \<Longrightarrow> det A = 0" and "row j F = 0 \<Longrightarrow> det F = 0"
  by (force simp: row_def det_def vec_eq_iff sign_nz intro!: sum.neutral)+

lemma  det_zero_column:
  fixes A :: "'a::{idom, ring_char_0}^'n^'n" and F :: "'b::{field}^'m^'m"
  shows "column i A = 0 \<Longrightarrow> det A = 0" and "column j F = 0 \<Longrightarrow> det F = 0"
  unfolding atomize_conj atomize_imp
  by (metis det_transpose det_zero_row row_transpose)

lemma  det_row_add:
  fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
  shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
    det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
    det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
  unfolding det_def vec_lambda_beta sum.distrib[symmetric]
proof (rule sum.cong)
  let ?U = "UNIV :: 'n set"
  let ?pU = "{p. p permutes ?U}"
  let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
  let ?g = "(\<lambda> i. if i = k then a i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
  let ?h = "(\<lambda> i. if i = k then b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
  fix p
  assume p: "p \<in> ?pU"
  let ?Uk = "?U - {k}"
  from p have pU: "p permutes ?U"
    by blast
  have kU: "?U = insert k ?Uk"
    by blast
  have eq: "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?g i $ p i) ?Uk"
           "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?h i $ p i) ?Uk"
    by auto
  have Uk: "finite ?Uk" "k \<notin> ?Uk"
    by auto
  have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
    unfolding kU[symmetric] ..
  also have "\<dots> = ?f k $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk"
    by (rule prod.insert) auto
  also have "\<dots> = (a k $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk) + (b k$ p k * prod (\<lambda>i. ?f i $ p i) ?Uk)"
    by (simp add: field_simps)
  also have "\<dots> = (a k $ p k * prod (\<lambda>i. ?g i $ p i) ?Uk) + (b k$ p k * prod (\<lambda>i. ?h i $ p i) ?Uk)"
    by (metis eq)
  also have "\<dots> = prod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + prod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
    unfolding  prod.insert[OF Uk] by simp
  finally have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?g i $ p i) ?U + prod (\<lambda>i. ?h i $ p i) ?U"
    unfolding kU[symmetric] .
  then show "of_int (sign p) * prod (\<lambda>i. ?f i $ p i) ?U =
    of_int (sign p) * prod (\<lambda>i. ?g i $ p i) ?U + of_int (sign p) * prod (\<lambda>i. ?h i $ p i) ?U"
    by (simp add: field_simps)
qed auto

lemma  det_row_mul:
  fixes a b :: "'n::finite \<Rightarrow> _ ^ 'n"
  shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
    c * det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
  unfolding det_def vec_lambda_beta sum_distrib_left
proof (rule sum.cong)
  let ?U = "UNIV :: 'n set"
  let ?pU = "{p. p permutes ?U}"
  let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
  let ?g = "(\<lambda> i. if i = k then a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
  fix p
  assume p: "p \<in> ?pU"
  let ?Uk = "?U - {k}"
  from p have pU: "p permutes ?U"
    by blast
  have kU: "?U = insert k ?Uk"
    by blast
  have eq: "prod (\<lambda>i. ?f i $ p i) ?Uk = prod (\<lambda>i. ?g i $ p i) ?Uk"
    by auto
  have Uk: "finite ?Uk" "k \<notin> ?Uk"
    by auto
  have "prod (\<lambda>i. ?f i $ p i) ?U = prod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
    unfolding kU[symmetric] ..
  also have "\<dots> = ?f k $ p k  * prod (\<lambda>i. ?f i $ p i) ?Uk"
    by (rule prod.insert) auto
  also have "\<dots> = (c*s a k) $ p k * prod (\<lambda>i. ?f i $ p i) ?Uk"
    by (simp add: field_simps)
  also have "\<dots> = c* (a k $ p k * prod (\<lambda>i. ?g i $ p i) ?Uk)"
    unfolding eq by (simp add: ac_simps)
  also have "\<dots> = c* (prod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
    unfolding prod.insert[OF Uk] by simp
  finally have "prod (\<lambda>i. ?f i $ p i) ?U = c* (prod (\<lambda>i. ?g i $ p i) ?U)"
    unfolding kU[symmetric] .
  then show "of_int (sign p) * prod (\<lambda>i. ?f i $ p i) ?U = c * (of_int (sign p) * prod (\<lambda>i. ?g i $ p i) ?U)"
    by (simp add: field_simps)
qed auto

lemma  det_row_0:
  fixes b :: "'n::finite \<Rightarrow> _ ^ 'n"
  shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
  using det_row_mul[of k 0 "\<lambda>i. 1" b]
  apply simp
  apply (simp only: vector_smult_lzero)
  done

lemma  det_row_operation:
  fixes A :: "'a::{comm_ring_1}^'n^'n"
  assumes ij: "i \<noteq> j"
  shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
proof -
  let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
  have th: "row i ?Z = row j ?Z" by (vector row_def)
  have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
    by (vector row_def)
  show ?thesis
    unfolding det_row_add [of i] det_row_mul[of i] det_identical_rows[OF ij th] th2
    by simp
qed

lemma  det_row_span:
  fixes A :: "'a::{field}^'n^'n"
  assumes x: "x \<in> vec.span {row j A |j. j \<noteq> i}"
  shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
  using x
proof (induction rule: vec.span_induct_alt)
  case base
  have "(if k = i then row i A + 0 else row k A) = row k A" for k
    by simp
  then show ?case
    by (simp add: row_def)
next
  case (step c z y)
  then obtain j where j: "z = row j A" "i \<noteq> j"
    by blast
  let ?w = "row i A + y"
  have th0: "row i A + (c*s z + y) = ?w + c*s z"
    by vector
  let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
  have thz: "?d z = 0"
    apply (rule det_identical_rows[OF j(2)])
    using j
    apply (vector row_def)
    done
  have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)"
    unfolding th0 ..
  then have "?d (row i A + (c*s z + y)) = det A"
    unfolding thz step.IH det_row_mul[of i] det_row_add[of i] by simp
  then show ?case
    unfolding scalar_mult_eq_scaleR .
qed

lemma  matrix_id [simp]: "det (matrix id) = 1"
  by (simp add: matrix_id_mat_1)

proposition  det_matrix_scaleR [simp]: "det (matrix (((*\<^sub>R) r)) :: real^'n^'n) = r ^ CARD('n::finite)"
  apply (subst det_diagonal)
   apply (auto simp: matrix_def mat_def)
  apply (simp add: cart_eq_inner_axis inner_axis_axis)
  done

text \<open>
  May as well do this, though it's a bit unsatisfactory since it ignores
  exact duplicates by considering the rows/columns as a set.
\<close>

lemma  det_dependent_rows:
  fixes A:: "'a::{field}^'n^'n"
  assumes d: "vec.dependent (rows A)"
  shows "det A = 0"
proof -
  let ?U = "UNIV :: 'n set"
  from d obtain i where i: "row i A \<in> vec.span (rows A - {row i A})"
    unfolding vec.dependent_def rows_def by blast
  show ?thesis
  proof (cases "\<forall>i j. i \<noteq> j \<longrightarrow> row i A \<noteq> row j A")
    case True
    with i have "vec.span (rows A - {row i A}) \<subseteq> vec.span {row j A |j. j \<noteq> i}"
      by (auto simp: rows_def intro!: vec.span_mono)
    then have "- row i A \<in> vec.span {row j A|j. j \<noteq> i}"
      by (meson i subsetCE vec.span_neg)
    from det_row_span[OF this]
    have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
      unfolding right_minus vector_smult_lzero ..
    with det_row_mul[of i 0 "\<lambda>i. 1"]
    show ?thesis by simp
  next
    case False
    then obtain j k where jk: "j \<noteq> k" "row j A = row k A"
      by auto
    from det_identical_rows[OF jk] show ?thesis .
  qed
qed

lemma  det_dependent_columns:
  assumes d: "vec.dependent (columns (A::real^'n^'n))"
  shows "det A = 0"
  by (metis d det_dependent_rows rows_transpose det_transpose)

text \<open>Multilinearity and the multiplication formula\<close>

lemma  Cart_lambda_cong: "(\<And>x. f x = g x) \<Longrightarrow> (vec_lambda f::'a^'n) = (vec_lambda g :: 'a^'n)"
  by auto

lemma  det_linear_row_sum:
  assumes fS: "finite S"
  shows "det ((\<chi> i. if i = k then sum (a i) S else c i)::'a::comm_ring_1^'n^'n) =
    sum (\<lambda>j. det ((\<chi> i. if i = k then a  i j else c i)::'a^'n^'n)) S"
  using fS  by (induct rule: finite_induct; simp add: det_row_0 det_row_add cong: if_cong)

lemma  finite_bounded_functions:
  assumes fS: "finite S"
  shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
proof (induct k)
  case 0
  have *: "{f. \<forall>i. f i = i} = {id}"
    by auto
  show ?case
    by (auto simp: *)
next
  case (Suc k)
  let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
  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)})"
  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)}"
    apply (auto simp: image_iff)
    apply (rename_tac f)
    apply (rule_tac x="f (Suc k)" in bexI)
    apply (rule_tac x = "\<lambda>i. if i = Suc k then i else f i" in exI, auto)
    done
  with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
  show ?case
    by metis
qed

lemma  det_linear_rows_sum_lemma:
  assumes fS: "finite S"
    and fT: "finite T"
  shows "det ((\<chi> i. if i \<in> T then sum (a i) S else c i):: 'a::comm_ring_1^'n^'n) =
    sum (\<lambda>f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n))
      {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
  using fT
proof (induct T arbitrary: a c set: finite)
  case empty
  have th0: "\<And>x y. (\<chi> i. if i \<in> {} then x i else y i) = (\<chi> i. y i)"
    by vector
  from empty.prems show ?case
    unfolding th0 by (simp add: eq_id_iff)
next
  case (insert z T a c)
  let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
  let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
  let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
  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)"
  let ?c = "\<lambda>j i. if i = z then a i j else c i"
  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)"
    by simp
  have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
     (if c then (if a then b else d) else (if a then b else e))"
    by simp
  from \<open>z \<notin> T\<close> have nz: "\<And>i. i \<in> T \<Longrightarrow> i \<noteq> z"
    by auto
  have "det (\<chi> i. if i \<in> insert z T then sum (a i) S else c i) =
    det (\<chi> i. if i = z then sum (a i) S else if i \<in> T then sum (a i) S else c i)"
    unfolding insert_iff thif ..
  also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<in> T then sum (a i) S else if i = z then a i j else c i))"
    unfolding det_linear_row_sum[OF fS]
    by (subst thif2) (simp add: nz cong: if_cong)
  finally have tha:
    "det (\<chi> i. if i \<in> insert z T then sum (a i) S else c i) =
     (\<Sum>(j, f)\<in>S \<times> ?F T. det (\<chi> i. if i \<in> T then a i (f i)
                                else if i = z then a i j
                                else c i))"
    unfolding insert.hyps unfolding sum.cartesian_product by blast
  show ?case unfolding tha
    using \<open>z \<notin> T\<close>
    by (intro sum.reindex_bij_witness[where i="?k" and j="?h"])
       (auto intro!: cong[OF refl[of det]] simp: vec_eq_iff)
qed

lemma  det_linear_rows_sum:
  fixes S :: "'n::finite set"
  assumes fS: "finite S"
  shows "det (\<chi> i. sum (a i) S) =
    sum (\<lambda>f. det (\<chi> i. a i (f i) :: 'a::comm_ring_1 ^ 'n^'n)) {f. \<forall>i. f i \<in> S}"
proof -
  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)"
    by vector
  from det_linear_rows_sum_lemma[OF fS, of "UNIV :: 'n set" a, unfolded th0, OF finite]
  show ?thesis by simp
qed

lemma  matrix_mul_sum_alt:
  fixes A B :: "'a::comm_ring_1^'n^'n"
  shows "A ** B = (\<chi> i. sum (\<lambda>k. A$i$k *s B $ k) (UNIV :: 'n set))"
  by (vector matrix_matrix_mult_def sum_component)

lemma  det_rows_mul:
  "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n) =
    prod (\<lambda>i. c i) (UNIV:: 'n set) * det((\<chi> i. a i)::'a^'n^'n)"
proof (simp add: det_def sum_distrib_left cong add: prod.cong, rule sum.cong)
  let ?U = "UNIV :: 'n set"
  let ?PU = "{p. p permutes ?U}"
  fix p
  assume pU: "p \<in> ?PU"
  let ?s = "of_int (sign p)"
  from pU have p: "p permutes ?U"
    by blast
  have "prod (\<lambda>i. c i * a i $ p i) ?U = prod c ?U * prod (\<lambda>i. a i $ p i) ?U"
    unfolding prod.distrib ..
  then show "?s * (\<Prod>xa\<in>?U. c xa * a xa $ p xa) =
    prod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))"
    by (simp add: field_simps)
qed rule

proposition  det_mul:
  fixes A B :: "'a::comm_ring_1^'n^'n"
  shows "det (A ** B) = det A * det B"
proof -
  let ?U = "UNIV :: 'n set"
  let ?F = "{f. (\<forall>i \<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
  let ?PU = "{p. p permutes ?U}"
  have "p \<in> ?F" if "p permutes ?U" for p
    by simp
  then have PUF: "?PU \<subseteq> ?F" by blast
  {
    fix f
    assume fPU: "f \<in> ?F - ?PU"
    have fUU: "f ` ?U \<subseteq> ?U"
      using fPU by auto
    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)"
      unfolding permutes_def by auto

    let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
    let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
    {
      assume fni: "\<not> inj_on f ?U"
      then obtain i j where ij: "f i = f j" "i \<noteq> j"
        unfolding inj_on_def by blast
      then have "row i ?B = row j ?B"
        by (vector row_def)
      with det_identical_rows[OF ij(2)]
      have "det (\<chi> i. A$i$f i *s B$f i) = 0"
        unfolding det_rows_mul by force
    }
    moreover
    {
      assume fi: "inj_on f ?U"
      from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
        unfolding inj_on_def by metis
      note fs = fi[unfolded surjective_iff_injective_gen[OF finite finite refl fUU, symmetric]]
      have "\<exists>!x. f x = y" for y
        using fith fs by blast
      with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0"
        by blast
    }
    ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0"
      by blast
  }
  then have zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0"
    by simp
  {
    fix p
    assume pU: "p \<in> ?PU"
    from pU have p: "p permutes ?U"
      by blast
    let ?s = "\<lambda>p. of_int (sign p)"
    let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) * (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
    have "(sum (\<lambda>q. ?s q *
        (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
      (sum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) * (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
      unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
    proof (rule sum.cong)
      fix q
      assume qU: "q \<in> ?PU"
      then have q: "q permutes ?U"
        by blast
      from p q have pp: "permutation p" and pq: "permutation q"
        unfolding permutation_permutes by auto
      have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
        "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
        unfolding mult.assoc[symmetric]
        unfolding of_int_mult[symmetric]
        by (simp_all add: sign_idempotent)
      have ths: "?s q = ?s p * ?s (q \<circ> inv p)"
        using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
        by (simp add: th00 ac_simps sign_idempotent sign_compose)
      have th001: "prod (\<lambda>i. B$i$ q (inv p i)) ?U = prod ((\<lambda>i. B$i$ q (inv p i)) \<circ> p) ?U"
        by (rule prod.permute[OF p])
      have thp: "prod (\<lambda>i. (\<chi> i. A$i$p i *s B$p i :: 'a^'n^'n) $i $ q i) ?U =
        prod (\<lambda>i. A$i$p i) ?U * prod (\<lambda>i. B$i$ q (inv p i)) ?U"
        unfolding th001 prod.distrib[symmetric] o_def permutes_inverses[OF p]
        apply (rule prod.cong[OF refl])
        using permutes_in_image[OF q]
        apply vector
        done
      show "?s q * prod (\<lambda>i. (((\<chi> i. A$i$p i *s B$p i) :: 'a^'n^'n)$i$q i)) ?U =
        ?s p * (prod (\<lambda>i. A$i$p i) ?U) * (?s (q \<circ> inv p) * prod (\<lambda>i. B$i$(q \<circ> inv p) i) ?U)"
        using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
        by (simp add: sign_nz th00 field_simps sign_idempotent sign_compose)
    qed rule
  }
  then have th2: "sum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
    unfolding det_def sum_product
    by (rule sum.cong [OF refl])
  have "det (A**B) = sum (\<lambda>f.  det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
    unfolding matrix_mul_sum_alt det_linear_rows_sum[OF finite]
    by simp
  also have "\<dots> = sum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
    using sum.mono_neutral_cong_left[OF finite PUF zth, symmetric]
    unfolding det_rows_mul by auto
  finally show ?thesis unfolding th2 .
qed

subsection \<open>Relation to invertibility\<close>

proposition  invertible_det_nz:
  fixes A::"'a::{field}^'n^'n"
  shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
proof (cases "invertible A")
  case True
  then obtain B :: "'a^'n^'n" where B: "A ** B = mat 1"
    unfolding invertible_right_inverse by blast
  then have "det (A ** B) = det (mat 1 :: 'a^'n^'n)"
    by simp
  then show ?thesis
    by (metis True det_I det_mul mult_zero_left one_neq_zero)
next
  case False
  let ?U = "UNIV :: 'n set"
  have fU: "finite ?U"
    by simp
  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"
    unfolding invertible_right_inverse matrix_right_invertible_independent_rows
    by blast
  have thr0: "- row i A = sum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
    unfolding sum_cmul  using c ci
    by (auto simp: sum.remove[OF fU iU] eq_vector_fraction_iff add_eq_0_iff)
  have thr: "- row i A \<in> vec.span {row j A| j. j \<noteq> i}"
    unfolding thr0 by (auto intro: vec.span_base vec.span_scale vec.span_sum)
  let ?B = "(\<chi> k. if k = i then 0 else row k A) :: 'a^'n^'n"
  have thrb: "row i ?B = 0" using iU by (vector row_def)
  have "det A = 0"
    unfolding det_row_span[OF thr, symmetric] right_minus
    unfolding det_zero_row(2)[OF thrb] ..
  then show ?thesis
    by (simp add: False)
qed

lemma  det_nz_iff_inj_gen:
  fixes f :: "'a::field^'n \<Rightarrow> 'a::field^'n"
  assumes "Vector_Spaces.linear (*s) (*s) f"
  shows "det (matrix f) \<noteq> 0 \<longleftrightarrow> inj f"
proof
  assume "det (matrix f) \<noteq> 0"
  then show "inj f"
    using assms invertible_det_nz inj_matrix_vector_mult by force
next
  assume "inj f"
  show "det (matrix f) \<noteq> 0"
    using vec.linear_injective_left_inverse [OF assms \<open>inj f\<close>]
    by (metis assms invertible_det_nz invertible_left_inverse matrix_compose_gen matrix_id_mat_1)
qed

lemma  det_nz_iff_inj:
  fixes f :: "real^'n \<Rightarrow> real^'n"
  assumes "linear f"
  shows "det (matrix f) \<noteq> 0 \<longleftrightarrow> inj f"
  using det_nz_iff_inj_gen[of f] assms
  unfolding linear_matrix_vector_mul_eq .

lemma  det_eq_0_rank:
  fixes A :: "real^'n^'n"
  shows "det A = 0 \<longleftrightarrow> rank A < CARD('n)"
  using invertible_det_nz [of A]
  by (auto simp: matrix_left_invertible_injective invertible_left_inverse less_rank_noninjective)

subsubsection\<^marker>\<open>tag important\<close>  \<open>Invertibility of matrices and corresponding linear functions\<close>

lemma  matrix_left_invertible_gen:
  fixes f :: "'a::field^'m \<Rightarrow> 'a::field^'n"
  assumes "Vector_Spaces.linear (*s) (*s) f"
  shows "((\<exists>B. B ** matrix f = mat 1) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> g \<circ> f = id))"
proof safe
  fix B
  assume 1: "B ** matrix f = mat 1"
  show "\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> g \<circ> f = id"
  proof (intro exI conjI)
    show "Vector_Spaces.linear (*s) (*s) (\<lambda>y. B *v y)"
      by simp
    show "((*v) B) \<circ> f = id"
      unfolding o_def
      by (metis assms 1 eq_id_iff matrix_vector_mul(1) matrix_vector_mul_assoc matrix_vector_mul_lid)
  qed
next
  fix g
  assume "Vector_Spaces.linear (*s) (*s) g" "g \<circ> f = id"
  then have "matrix g ** matrix f = mat 1"
    by (metis assms matrix_compose_gen matrix_id_mat_1)
  then show "\<exists>B. B ** matrix f = mat 1" ..
qed

lemma  matrix_left_invertible:
  "linear f \<Longrightarrow> ((\<exists>B. B ** matrix f = mat 1) \<longleftrightarrow> (\<exists>g. linear g \<and> g \<circ> f = id))" for f::"real^'m \<Rightarrow> real^'n"
  using matrix_left_invertible_gen[of f]
  by (auto simp: linear_matrix_vector_mul_eq)

lemma  matrix_right_invertible_gen:
  fixes f :: "'a::field^'m \<Rightarrow> 'a^'n"
  assumes "Vector_Spaces.linear (*s) (*s) f"
  shows "((\<exists>B. matrix f ** B = mat 1) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id))"
proof safe
  fix B
  assume 1: "matrix f ** B = mat 1"
  show "\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id"
  proof (intro exI conjI)
    show "Vector_Spaces.linear (*s) (*s) ((*v) B)"
      by simp
    show "f \<circ> (*v) B = id"
      using 1 assms comp_apply eq_id_iff vec.linear_id matrix_id_mat_1 matrix_vector_mul_assoc matrix_works
      by (metis (no_types, hide_lams))
  qed
next
  fix g
  assume "Vector_Spaces.linear (*s) (*s) g" and "f \<circ> g = id"
  then have "matrix f ** matrix g = mat 1"
    by (metis assms matrix_compose_gen matrix_id_mat_1)
  then show "\<exists>B. matrix f ** B = mat 1" ..
qed

lemma  matrix_right_invertible:
  "linear f \<Longrightarrow> ((\<exists>B. matrix f ** B = mat 1) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id))" for f::"real^'m \<Rightarrow> real^'n"
  using matrix_right_invertible_gen[of f]
  by (auto simp: linear_matrix_vector_mul_eq)

lemma  matrix_invertible_gen:
  fixes f :: "'a::field^'m \<Rightarrow> 'a::field^'n"
  assumes "Vector_Spaces.linear (*s) (*s) f"
  shows  "invertible (matrix f) \<longleftrightarrow> (\<exists>g. Vector_Spaces.linear (*s) (*s) g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
    (is "?lhs = ?rhs")
proof
  assume ?lhs then show ?rhs
    by (metis assms invertible_def left_right_inverse_eq matrix_left_invertible_gen matrix_right_invertible_gen)
next
  assume ?rhs then show ?lhs
    by (metis assms invertible_def matrix_compose_gen matrix_id_mat_1)
qed

lemma  matrix_invertible:
  "linear f \<Longrightarrow> invertible (matrix f) \<longleftrightarrow> (\<exists>g. linear g \<and> f \<circ> g = id \<and> g \<circ> f = id)"
  for f::"real^'m \<Rightarrow> real^'n"
  using matrix_invertible_gen[of f]
  by (auto simp: linear_matrix_vector_mul_eq)

lemma  invertible_eq_bij:
  fixes m :: "'a::field^'m^'n"
  shows "invertible m \<longleftrightarrow> bij ((*v) m)"
  using matrix_invertible_gen[OF matrix_vector_mul_linear_gen, of m, simplified matrix_of_matrix_vector_mul]
  by (metis bij_betw_def left_right_inverse_eq matrix_vector_mul_linear_gen o_bij
      vec.linear_injective_left_inverse vec.linear_surjective_right_inverse)

subsection \<open>Cramer's rule\<close>

lemma  cramer_lemma_transpose:
  fixes A:: "'a::{field}^'n^'n"
    and x :: "'a::{field}^'n"
  shows "det ((\<chi> i. if i = k then sum (\<lambda>i. x$i *s row i A) (UNIV::'n set)
                             else row i A)::'a::{field}^'n^'n) = x$k * det A"
  (is "?lhs = ?rhs")
proof -
  let ?U = "UNIV :: 'n set"
  let ?Uk = "?U - {k}"
  have U: "?U = insert k ?Uk"
    by blast
  have kUk: "k \<notin> ?Uk"
    by simp
  have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
    by (vector field_simps)
  have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f"
    by auto
  have "(\<chi> i. row i A) = A" by (vector row_def)
  then have thd1: "det (\<chi> i. row i A) = det A"
    by simp
  have thd0: "det (\<chi> i. if i = k then row k A + (\<Sum>i \<in> ?Uk. x $ i *s row i A) else row i A) = det A"
    by (force intro: det_row_span vec.span_sum vec.span_scale vec.span_base)
  show "?lhs = x$k * det A"
    apply (subst U)
    unfolding sum.insert[OF finite kUk]
    apply (subst th00)
    unfolding add.assoc
    apply (subst det_row_add)
    unfolding thd0
    unfolding det_row_mul
    unfolding th001[of k "\<lambda>i. row i A"]
    unfolding thd1
    apply (simp add: field_simps)
    done
qed

proposition  cramer_lemma:
  fixes A :: "'a::{field}^'n^'n"
  shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: 'a::{field}^'n^'n) = x$k * det A"
proof -
  let ?U = "UNIV :: 'n set"
  have *: "\<And>c. sum (\<lambda>i. c i *s row i (transpose A)) ?U = sum (\<lambda>i. c i *s column i A) ?U"
    by (auto intro: sum.cong)
  show ?thesis
    unfolding matrix_mult_sum
    unfolding cramer_lemma_transpose[of k x "transpose A", unfolded det_transpose, symmetric]
    unfolding *[of "\<lambda>i. x$i"]
    apply (subst det_transpose[symmetric])
    apply (rule cong[OF refl[of det]])
    apply (vector transpose_def column_def row_def)
    done
qed

proposition  cramer:
  fixes A ::"'a::{field}^'n^'n"
  assumes d0: "det A \<noteq> 0"
  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)"
proof -
  from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
    unfolding invertible_det_nz[symmetric] invertible_def
    by blast
  have "(A ** B) *v b = b"
    by (simp add: B)
  then have "A *v (B *v b) = b"
    by (simp add: matrix_vector_mul_assoc)
  then have xe: "\<exists>x. A *v x = b"
    by blast
  {
    fix x
    assume x: "A *v x = b"
    have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j) / det A)"
      unfolding x[symmetric]
      using d0 by (simp add: vec_eq_iff cramer_lemma field_simps)
  }
  with xe show ?thesis
    by auto
qed

lemma  det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
  by (simp add: det_def sign_id)

lemma  det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
proof -
  have f12: "finite {2::2}" "1 \<notin> {2::2}" by auto
  show ?thesis
    unfolding det_def UNIV_2
    unfolding sum_over_permutations_insert[OF f12]
    unfolding permutes_sing
    by (simp add: sign_swap_id sign_id swap_id_eq)
qed

lemma  det_3:
  "det (A::'a::comm_ring_1^3^3) =
    A$1$1 * A$2$2 * A$3$3 +
    A$1$2 * A$2$3 * A$3$1 +
    A$1$3 * A$2$1 * A$3$2 -
    A$1$1 * A$2$3 * A$3$2 -
    A$1$2 * A$2$1 * A$3$3 -
    A$1$3 * A$2$2 * A$3$1"
proof -
  have f123: "finite {2::3, 3}" "1 \<notin> {2::3, 3}"
    by auto
  have f23: "finite {3::3}" "2 \<notin> {3::3}"
    by auto

  show ?thesis
    unfolding det_def UNIV_3
    unfolding sum_over_permutations_insert[OF f123]
    unfolding sum_over_permutations_insert[OF f23]
    unfolding permutes_sing
    by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
qed

proposition  det_orthogonal_matrix:
  fixes Q:: "'a::linordered_idom^'n^'n"
  assumes oQ: "orthogonal_matrix Q"
  shows "det Q = 1 \<or> det Q = - 1"
proof -
  have "Q ** transpose Q = mat 1"
    by (metis oQ orthogonal_matrix_def)
  then have "det (Q ** transpose Q) = det (mat 1:: 'a^'n^'n)"
    by simp
  then have "det Q * det Q = 1"
    by (simp add: det_mul)
  then show ?thesis
    by (simp add: square_eq_1_iff)
qed

proposition  orthogonal_transformation_det [simp]:
  fixes f :: "real^'n \<Rightarrow> real^'n"
  shows "orthogonal_transformation f \<Longrightarrow> \<bar>det (matrix f)\<bar> = 1"
  using det_orthogonal_matrix orthogonal_transformation_matrix by fastforce

subsection  \<open>Rotation, reflection, rotoinversion\<close>

definition\<^marker>\<open>tag important\<close>  "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
definition\<^marker>\<open>tag important\<close>  "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"

lemma  orthogonal_rotation_or_rotoinversion:
  fixes Q :: "'a::linordered_idom^'n^'n"
  shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
  by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)

text\<open> Slightly stronger results giving rotation, but only in two or more dimensions\<close>

lemma  rotation_matrix_exists_basis:
  fixes a :: "real^'n"
  assumes 2: "2 \<le> CARD('n)" and "norm a = 1"
  obtains A where "rotation_matrix A" "A *v (axis k 1) = a"
proof -
  obtain A where "orthogonal_matrix A" and A: "A *v (axis k 1) = a"
    using orthogonal_matrix_exists_basis assms by metis
  with orthogonal_rotation_or_rotoinversion
  consider "rotation_matrix A" | "rotoinversion_matrix A"
    by metis
  then show thesis
  proof cases
    assume "rotation_matrix A"
    then show ?thesis
      using \<open>A *v axis k 1 = a\<close> that by auto
  next
    from ex_card[OF 2] obtain h i::'n where "h \<noteq> i"
      by (auto simp add: eval_nat_numeral card_Suc_eq)
    then obtain j where "j \<noteq> k"
      by (metis (full_types))
    let ?TA = "transpose A"
    let ?A = "\<chi> i. if i = j then - 1 *\<^sub>R (?TA $ i) else ?TA $i"
    assume "rotoinversion_matrix A"
    then have [simp]: "det A = -1"
      by (simp add: rotoinversion_matrix_def)
    show ?thesis
    proof
      have [simp]: "row i (\<chi> i. if i = j then - 1 *\<^sub>R ?TA $ i else ?TA $ i) = (if i = j then - row i ?TA else row i ?TA)" for i
        by (auto simp: row_def)
      have "orthogonal_matrix ?A"
        unfolding orthogonal_matrix_orthonormal_rows
        using \<open>orthogonal_matrix A\<close> by (auto simp: orthogonal_matrix_orthonormal_columns orthogonal_clauses)
      then show "rotation_matrix (transpose ?A)"
        unfolding rotation_matrix_def
        by (simp add: det_row_mul[of j _ "\<lambda>i. ?TA $ i", unfolded scalar_mult_eq_scaleR])
      show "transpose ?A *v axis k 1 = a"
        using \<open>j \<noteq> k\<close> A by (simp add: matrix_vector_column axis_def scalar_mult_eq_scaleR if_distrib [of "\<lambda>z. z *\<^sub>R c" for c] cong: if_cong)
    qed
  qed
qed

lemma  rotation_exists_1:
  fixes a :: "real^'n"
  assumes "2 \<le> CARD('n)" "norm a = 1" "norm b = 1"
  obtains f where "orthogonal_transformation f" "det(matrix f) = 1" "f a = b"
proof -
  obtain k::'n where True
    by simp
  obtain A B where AB: "rotation_matrix A" "rotation_matrix B"
               and eq: "A *v (axis k 1) = a" "B *v (axis k 1) = b"
    using rotation_matrix_exists_basis assms by metis
  let ?f = "\<lambda>x. (B ** transpose A) *v x"
  show thesis
  proof
    show "orthogonal_transformation ?f"
      using AB orthogonal_matrix_mul orthogonal_transformation_matrix rotation_matrix_def matrix_vector_mul_linear by force
    show "det (matrix ?f) = 1"
      using AB by (auto simp: det_mul rotation_matrix_def)
    show "?f a = b"
      using AB unfolding orthogonal_matrix_def rotation_matrix_def
      by (metis eq matrix_mul_rid matrix_vector_mul_assoc)
  qed
qed

lemma  rotation_exists:
  fixes a :: "real^'n"
  assumes 2: "2 \<le> CARD('n)" and eq: "norm a = norm b"
  obtains f where "orthogonal_transformation f" "det(matrix f) = 1" "f a = b"
proof (cases "a = 0 \<or> b = 0")
  case True
  with assms have "a = 0" "b = 0"
    by auto
  then show ?thesis
    by (metis eq_id_iff matrix_id orthogonal_transformation_id that)
next
  case False
  then obtain f where f: "orthogonal_transformation f" "det (matrix f) = 1"
    and f': "f (a /\<^sub>R norm a) = b /\<^sub>R norm b"
    using rotation_exists_1 [of "a /\<^sub>R norm a" "b /\<^sub>R norm b", OF 2] by auto
  then interpret linear f by (simp add: orthogonal_transformation)
  have "f a = b"
    using f' False
    by (simp add: eq scale)
  with f show thesis ..
qed

lemma  rotation_rightward_line:
  fixes a :: "real^'n"
  obtains f where "orthogonal_transformation f" "2 \<le> CARD('n) \<Longrightarrow> det(matrix f) = 1"
                  "f(norm a *\<^sub>R axis k 1) = a"
proof (cases "CARD('n) = 1")
  case True
  obtain f where "orthogonal_transformation f" "f (norm a *\<^sub>R axis k (1::real)) = a"
  proof (rule orthogonal_transformation_exists)
    show "norm (norm a *\<^sub>R axis k (1::real)) = norm a"
      by simp
  qed auto
  then show thesis
    using True that by auto
next
  case False
  obtain f where "orthogonal_transformation f" "det(matrix f) = 1" "f (norm a *\<^sub>R axis k 1) = a"
  proof (rule rotation_exists)
    show "2 \<le> CARD('n)"
      using False one_le_card_finite [where 'a='n] by linarith
    show "norm (norm a *\<^sub>R axis k (1::real)) = norm a"
      by simp
  qed auto
  then show thesis
    using that by blast
qed

end


theory Turan
  imports
    "Girth_Chromatic.Ugraphs"
    "Random_Graph_Subgraph_Threshold.Ugraph_Lemmas"
begin

section \<open>Basic facts on graphs\<close>

lemma wellformed_uverts_0 :
  assumes "uwellformed G" and "uverts G = {}"
  shows "card (uedges G) = 0" using assms
  by (metis uwellformed_def card.empty ex_in_conv zero_neq_numeral)

lemma finite_verts_edges :
  assumes "uwellformed G" and "finite (uverts G)"
  shows "finite (uedges G)"
proof -
  have sub_pow: "uwellformed G \<Longrightarrow> uedges G \<subseteq> {S. S \<subseteq> uverts G}"
    by (cases G, auto simp add: uwellformed_def)
  then have "finite {S. S \<subseteq> uverts G}" using assms
    by auto
  with sub_pow assms show "finite (uedges G)"
    using finite_subset by blast
qed

lemma ugraph_max_edges :
  assumes "uwellformed G" and "card (uverts G) = n" and "finite (uverts G)"
  shows "card (uedges G) \<le> n * (n-1)/2"
  using assms wellformed_all_edges [OF assms(1)] card_all_edges [OF assms(3)] Binomial.choose_two [of "card(uverts G)"]
  by (smt (verit, del_insts) all_edges_finite card_mono dbl_simps(3) dbl_simps(5) div_times_less_eq_dividend le_divide_eq_numeral1(1) le_square nat_mult_1_right numerals(1) of_nat_1 of_nat_diff of_nat_mono of_nat_mult of_nat_numeral right_diff_distrib')

lemma subgraph_verts_finite : "\<lbrakk> finite (uverts G); subgraph G' G \<rbrakk> \<Longrightarrow> finite (uverts G')"
  using rev_finite_subset subgraph_def by auto

section \<open>Cliques\<close>

text \<open>In this section a straightforward definition of cliques for simple, undirected graphs is introduced.
Besides fundamental facts about cliques, also more specialized lemmata are proved in subsequent subsections.\<close>

definition uclique :: "ugraph \<Rightarrow> ugraph \<Rightarrow> nat \<Rightarrow> bool" where
  "uclique C G p \<equiv> p = card (uverts C) \<and> subgraph C G \<and> C = complete (uverts C)"

lemma clique_any_edge :
  assumes "uclique C G p" and "x \<in> uverts C" and "y \<in> uverts C" and "x \<noteq> y"
  shows "{x,y} \<in> uedges G"
  using assms
  apply (simp add: uclique_def complete_def all_edges_def subgraph_def)
  by (smt (verit, best) SigmaI fst_conv image_iff mem_Collect_eq mk_uedge.simps snd_conv subset_eq)

lemma clique_exists : "\<exists> C p. uclique C G p \<and> p \<le> card (uverts G)"
  using bex_imageD card.empty emptyE gr_implies_not0 le_neq_implies_less
  by (auto simp add: uclique_def complete_def subgraph_def all_edges_def)

lemma clique_exists1 :
  assumes "uverts G \<noteq> {}" and "finite (uverts G)"
  shows "\<exists> C p. uclique C G p \<and> 0 < p \<and>  p \<le> card (uverts G)"
proof -
  obtain x where x: "x \<in> uverts G"
    using assms
    by auto
  show ?thesis
    apply (rule exI [of _ "({x},{})"], rule exI [of _ 1])
    using x assms(2)
    by (simp add: uclique_def subgraph_def complete_def all_edges_def Suc_leI assms(1) card_gt_0_iff)
qed

lemma clique_max_size : "uclique C G p \<Longrightarrow> finite (uverts G) \<Longrightarrow>  p \<le> card (uverts G)"
  by (auto simp add: uclique_def subgraph_def Finite_Set.card_mono)

lemma clique_exists_gt0 :
  assumes "finite (uverts G)" "card (uverts G) > 0"
  shows "\<exists> C p. uclique C G p \<and> p \<le> card (uverts G) \<and> (\<forall>C q. uclique C G q \<longrightarrow> q \<le> p)"
proof -
  have 1: "finite (uverts G) \<Longrightarrow> finite {p. \<exists>C. uclique C G p}"
    using clique_max_size
    by (smt (verit, best) finite_nat_set_iff_bounded_le mem_Collect_eq)
  have 2: "\<And>A::nat set. finite A \<Longrightarrow> \<exists>x. x\<in>A \<Longrightarrow> \<exists>x\<in>A.\<forall>y\<in>A. y \<le> x"
    using Max_ge Max_in by blast
  have "\<exists>C p. uclique C G p \<and> (\<forall>C q. uclique C G q \<longrightarrow> q \<le> p)"
    using 2 [OF 1 [OF \<open>finite (uverts G)\<close>]] clique_exists [of G]
    by (smt (z3) mem_Collect_eq)
  then show ?thesis
    using \<open>finite (uverts G)\<close> clique_max_size
    by blast
qed

text \<open>If there exists a $(p+1)$-clique @{term C} in a graph @{term G}
      then we can obtain a $p$-clique in @{term G} by removing an arbitrary vertex from @{term C}\<close>

lemma clique_size_jumpfree :
  assumes "finite (uverts G)" and "uwellformed G"
    and "uclique C G (p+1)"
  shows "\<exists>C'. uclique C' G p"
proof -
  have "card(uverts G) > p"
    using assms by (simp add: uclique_def subgraph_def card_mono less_eq_Suc_le)
  obtain x where x: "x \<in> uverts C"
    using assms by (fastforce simp add: uclique_def)
  have "mk_uedge ` {uv \<in> uverts C \<times> uverts C. fst uv \<noteq> snd uv} - {A \<in> uedges C. x \<in> A} =
    mk_uedge ` {uv \<in> (uverts C - {x}) \<times> (uverts C - {x}). fst uv \<noteq> snd uv}"
  proof -
    have "\<And>y. y \<in> mk_uedge ` {uv \<in> uverts C \<times> uverts C. fst uv \<noteq> snd uv} - {A \<in> uedges C. x \<in> A} \<Longrightarrow>
          y \<in> mk_uedge ` {uv \<in> (uverts C - {x}) \<times> (uverts C - {x}). fst uv \<noteq> snd uv}"
      using assms(3)
      apply (simp add: uclique_def complete_def all_edges_def)
      by (smt (z3) DiffI SigmaE SigmaI image_iff insertCI mem_Collect_eq mk_uedge.simps singleton_iff snd_conv)
    moreover have "\<And>y. y \<in> mk_uedge ` {uv \<in> (uverts C - {x}) \<times> (uverts C - {x}). fst uv \<noteq> snd uv}
                  \<Longrightarrow> y \<in> mk_uedge ` {uv \<in> uverts C \<times> uverts C. fst uv \<noteq> snd uv} - {A \<in> uedges C. x \<in> A}"
      apply (simp add: uclique_def complete_def all_edges_def)
      by (smt (z3) DiffE SigmaE SigmaI image_iff insert_iff mem_Collect_eq mk_uedge.simps singleton_iff)
    ultimately show ?thesis
      by blast
  qed
  then have 1: "(uverts C - {x}, uedges C - {A \<in> uedges C. x \<in> A}) = Ugraph_Lemmas.complete (uverts C - {x})"
    using assms(3)
    apply (simp add: uclique_def complete_def all_edges_def)
    by (metis (no_types, lifting) snd_eqD)
  show ?thesis
    apply (rule exI [of _ "C -- x"])
    using assms x
    apply (simp add: uclique_def remove_vertex_def subgraph_def)
    apply (simp add: 1)
    by (auto simp add: complete_def all_edges_def)
qed

text \<open>The next lemma generalises the lemma @{thm [source] clique_size_jumpfree} to a proof of
 the existence of a clique of any size smaller than the size of the original clique.\<close>

lemma clique_size_decr :
  assumes "finite (uverts G)" and "uwellformed G"
    and "uclique C G p"
  shows "q \<le> p \<Longrightarrow> \<exists>C. uclique C G q" using assms
proof (induction q rule: measure_induct [of "\<lambda>x. p - x"])
  case (1 x)
  then show ?case
  proof (cases "x = p")
    case True
    then show ?thesis
      using \<open>uclique C G p\<close>
      by blast
  next
    case False
    with 1(2) have "x < p"
      by auto
    from \<open>x < p\<close> have "p - Suc x < p - x"
      by auto
    then show ?thesis
      using 1(1) assms(1,2,3) \<open>x < p\<close>
      using clique_size_jumpfree [OF \<open>finite (uverts G)\<close> \<open>uwellformed G\<close> _]
      by (metis "1.prems"(4) add.commute linorder_not_le not_less_eq plus_1_eq_Suc)
  qed
qed

text \<open>With this lemma we can easily derive by contradiction that
      if there is no $p$-clique then there cannot exist a clique of a size greater than @{term p}\<close>

corollary clique_size_neg_max :
  assumes "finite (uverts G)" and "uwellformed G"
    and "\<not>(\<exists>C. uclique C G p)"
  shows "\<forall>C q. uclique C G q \<longrightarrow> q < p"
proof (rule ccontr)
  assume 1: "\<not> (\<forall>C q. uclique C G q \<longrightarrow> q < p)"
  show False
  proof -
    obtain C q where C: "uclique C G q"
      and q: "q \<ge> p"
      using 1 linorder_not_less
      by blast
    show ?thesis
      using assms(3) q clique_size_decr [OF \<open>finite (uverts G)\<close> \<open>uwellformed G\<close> C ]
      using order_less_imp_le by blast
  qed
qed

corollary clique_complete :
  assumes "finite V" and "x \<le> card V"
  shows "\<exists>C. uclique C (complete V) x"
proof -
  have "uclique (complete V) (complete V) (card V)"
    by (simp add: uclique_def complete_def subgraph_def)
  then show ?thesis
    using clique_size_decr [OF _ complete_wellformed [of V] _ assms(2)] assms(1)
    by (simp add: complete_def)
qed

lemma subgraph_clique :
  assumes "uwellformed G" "subgraph C G" "C = complete (uverts C)"
  shows "{e \<in> uedges G. e \<subseteq> uverts C} = uedges C"
proof -
  from assms complete_wellformed [of "uverts C"] have "uedges C \<subseteq> {e \<in> uedges G. e \<subseteq> uverts C}"
    by (auto simp add: subgraph_def uwellformed_def)
  moreover from assms(1) complete_wellformed [of "uverts C"] have "{e \<in> uedges G. e \<subseteq> uverts C} \<subseteq> uedges C"
    apply (simp add: subgraph_def uwellformed_def complete_def card_2_iff all_edges_def)
    using assms(3)[unfolded complete_def all_edges_def] in_mk_uedge_img
    by (smt (verit, ccfv_threshold) SigmaI fst_conv insert_subset mem_Collect_eq snd_conv subsetI)
  ultimately show ?thesis
    by auto
qed

text \<open>Next, we prove that in a graph @{term G} with a $p$-clique @{term C} and some vertex @{term v} outside of this clique,
there exists a $(p+1)$-clique in @{term G} if @{term v} is connected to all nodes in @{term C}.
The next lemma is an abstracted version that does not explicitly mention cliques:
If a vertex @{term n} has as many edges to a set of nodes @{term N} as there are nodes in @{term N}
then @{term n} is connected to all vertices in @{term N}.\<close>

lemma card_edges_nodes_all_edges :
  fixes G :: "ugraph" and  N :: "nat set" and E :: "nat set set" and n :: nat
  assumes "uwellformed G"
    and "finite N"
    and "N \<subseteq> uverts G" and "E \<subseteq> uedges G"
    and "n \<in> uverts G" and "n \<notin> N"
    and "\<forall>e \<in> E. \<exists>x \<in> N. {n,x} = e"
    and "card E = card N"
  shows "\<forall>x \<in> N. {n,x} \<in> E"
proof (rule ccontr)
  assume "\<not>(\<forall>x \<in> N. {n,x} \<in> E)"
  show False
  proof -
    obtain x where x: "x \<in> N" and e: "{n,x} \<notin> E"
      using \<open>\<not>(\<forall>x \<in> N. {n,x} \<in> E)\<close>
      by auto
    have "E \<subseteq> (\<lambda>y. {n,y}) ` (N - {x})"
      using Set.image_diff_subset \<open>\<forall>e \<in> E. \<exists>x \<in> N. {n,x} = e\<close> x e
      by auto
    then show ?thesis
      using \<open>finite N\<close> \<open>card E = card N\<close> x
      using surj_card_le [of "N - {x}" E "(\<lambda>y. {n,y})"]
      by (simp, metis card_gt_0_iff diff_less emptyE lessI linorder_not_le)
  qed
qed

subsection \<open>Partitioning edges along a clique\<close>

text \<open>Tur\'{a}n's proof partitions the edges of a graph into three partitions for a $(p-1)$-clique @{term C}:
All edges within @{term C}, all edges outside of @{term C}, and all edges between a vertex in @{term C} and a
vertex not in @{term C}.

We prove a generalized lemma that partitions the edges along some arbitrary set of vertices
which does not necessarily need to induce a clique.
Furthermore, in Tur\'{a}n's graph theorem we only argue about the cardinality of the partitions
so that we restrict this proof to showing that
the sum of the cardinalities of the partitions is equal to number of all edges.\<close>

lemma graph_partition_edges_card :
  assumes "finite (uverts G)" and "uwellformed G" and "A \<subseteq> (uverts G)"
  shows "card (uedges G) = card {e \<in> uedges G. e \<subseteq> A} + card {e \<in> uedges G.  e \<subseteq> uverts G - A} + card {e \<in> uedges G. e \<inter> A \<noteq> {} \<and> e \<inter> (uverts G - A) \<noteq> {}}"
  using assms
proof -
  have "uedges G = {e \<in> uedges G. e \<subseteq> A} \<union> {e \<in> uedges G.  e \<subseteq> (uverts G) - A} \<union> {e \<in> uedges G. e \<inter> A \<noteq> {} \<and> e \<inter> ((uverts G) - A) \<noteq> {}}"
    using assms uwellformed_def
    by blast
  moreover have "{e \<in> uedges G. e \<subseteq> A} \<inter> {e \<in> uedges G.  e \<subseteq> uverts G - A} = {}"
    using assms uwellformed_def
    by (smt (verit, ccfv_SIG) Diff_disjoint Int_subset_iff card.empty disjoint_iff mem_Collect_eq nat.simps(3) nat_1_add_1 plus_1_eq_Suc prod.sel(2) subset_empty)
  moreover have "({e \<in> uedges G. e \<subseteq> A} \<union> {e \<in> uedges G.  e \<subseteq> uverts G - A}) \<inter> {e \<in> uedges G. e \<inter> A \<noteq> {} \<and> e \<inter> (uverts G - A) \<noteq> {}} = {}"
    by blast
  moreover have "finite {e \<in> uedges G. e \<subseteq> A}" using assms
    by (simp add: finite_subset)
  moreover have "finite {e \<in> uedges G.  e \<subseteq> uverts G - A}" using assms
    by (simp add: finite_subset)
  moreover have "finite {e \<in> uedges G. e \<inter> A \<noteq> {} \<and> e \<inter> (uverts G - A) \<noteq> {}}"
    using assms finite_verts_edges
    by auto
  ultimately show ?thesis
    using assms Finite_Set.card_Un_disjoint
    by (smt (verit, best) finite_UnI)
qed

text \<open>Now, we turn to the problem of calculating the cardinalities of these partitions
when they are induced by the biggest clique in the graph.

First, we consider the number of edges in a $p$-clique.\<close>

lemma clique_edges_inside :
  assumes G1: "uwellformed G" and G2: "finite (uverts G)"
    and p: "p \<le> card (uverts G)" and n: "n = card(uverts G)"
    and C: "uclique C G p"
  shows "card {e \<in> uedges G. e \<subseteq> uverts C} = p * (p-1) / 2"
proof -
  have "2 dvd (card (uverts C) * (p - 1))"
    using C uclique_def
    by auto
  have "2 = real 2"
    by simp
  then show ?thesis
    using C uclique_def [of C G p] complete_def [of "uverts C"]
    using subgraph_clique [OF G1, of C] subgraph_verts_finite [OF assms(2), of C]
    using Real.real_of_nat_div [OF \<open>2 dvd (card (uverts C) * (p - 1))\<close>] Binomial.choose_two [of " card (uverts G)"]
    by (smt (verit, del_insts) One_nat_def approximation_preproc_nat(5) card_all_edges diff_self_eq_0 eq_imp_le left_diff_distrib' left_diff_distrib' linorder_not_less mult_le_mono2 n_choose_2_nat not_gr0 not_less_eq_eq of_nat_1 of_nat_diff snd_eqD)
qed

text \<open>Next, we turn to the number of edges that connect a node inside of the biggest clique with
a node outside of said clique. For that we start by calculating a bound for the number of
edges from one single node outside of the clique into the clique.\<close>

lemma clique_edges_inside_to_node_outside :
  assumes "uwellformed G" and "finite (uverts G)"
  assumes "0 < p" and "p \<le> card (uverts G)"
  assumes "uclique C G p" and "(\<forall>C p'. uclique C G p' \<longrightarrow> p' \<le> p)"
  assumes y: "y \<in> uverts G - uverts C"
  shows "card {{x,y}| x. x \<in> uverts C \<and> {x,y} \<in> uedges G} \<le> p - 1"
proof (rule ccontr)
  txt \<open>For effective proof automation we use a local function definition to compute this
       set of edges into the clique from any node @{term y}:\<close>
  define S where "S \<equiv> \<lambda>y. {{x,y}| x. x \<in> uverts C \<and> {x,y} \<in> uedges G}"
  assume "\<not> card {{x, y} |x. x \<in> uverts C \<and> {x, y} \<in> uedges G} \<le> p - 1"
  then have Sy: "card (S y) > p - 1"
    using S_def y by auto
  have "uclique ({y} \<union> (uverts C),S y \<union> uedges C) G (Suc p)"
  proof -
    have "card ({y} \<union> uverts C) = Suc p"
      using assms(3,5,7) uclique_def
      by (metis DiffD2 card_gt_0_iff card_insert_disjoint insert_is_Un)
    moreover have "subgraph ({y} \<union> uverts C, (S y) \<union> uedges C) G"
      using assms(5,7)
      by (auto simp add: uclique_def subgraph_def S_def)
    moreover have "({y} \<union> (uverts C),(S y) \<union> uedges C) = complete ({y} \<union> (uverts C))"
    proof -
      have "(S y) \<union> uedges C \<subseteq> all_edges ({y} \<union> (uverts C))"
        using y assms(5) S_def all_edges_def uclique_def complete_def
        by (simp, smt (z3) SigmaE SigmaI fst_conv image_iff in_mk_uedge_img insertCI mem_Collect_eq snd_conv subsetI)
      moreover have "all_edges ({y} \<union> (uverts C)) \<subseteq> (S y) \<union> uedges C"
      proof -
        have "\<forall>x\<in>uverts C. {y, x} \<in> S y"
        proof -
          have "card (S y) = card (uverts C)"
            using Sy assms(2,3,5,7) S_def uclique_def card_gt_0_iff
            using Finite_Set.surj_card_le [of "uverts C" "S y" "\<lambda>x. {x, y}"]
            by (smt (verit, del_insts) Suc_leI Suc_pred' image_iff le_antisym mem_Collect_eq subsetI)
          then show ?thesis
            using card_edges_nodes_all_edges [OF assms(1), of "uverts C" "S y" y] assms(1,2,5,7) S_def uclique_def
            by (smt (verit, ccfv_threshold) DiffE insert_commute mem_Collect_eq subgraph_def subgraph_verts_finite subsetI)
        qed
        then show ?thesis
          using assms(5) all_edges_def S_def uclique_def complete_def mk_uedge.simps in_mk_uedge_img
          by (smt (z3) insert_commute SigmaI fst_conv mem_Collect_eq snd_conv SigmaE UnCI image_iff insert_iff insert_is_Un subsetI)
      qed
      ultimately show ?thesis
        by (auto simp add: complete_def)
    qed
    ultimately show ?thesis
      by (simp add: uclique_def complete_def)
  qed
  then show False
    using assms(6)
    by fastforce
qed

text \<open>Now, that we have this upper bound for the number of edges from a single vertex into the largest clique
      we can calculate the upper bound for all such vertices and edges:\<close>

lemma clique_edges_inside_to_outside :
  assumes G1: "uwellformed G" and G2: "finite (uverts G)"
    and p0: "0 < p" and pn: "p \<le> card (uverts G)" and "card(uverts G) = n"
    and C: "uclique C G p" and C_max: "(\<forall>C p'. uclique C G p' \<longrightarrow> p' \<le> p)"
  shows "card {e \<in> uedges G. e \<inter> uverts C \<noteq> {} \<and> e \<inter> (uverts G - uverts C) \<noteq> {}} \<le> (p - 1) * (n - p)"
proof -
  define S where "S \<equiv> \<lambda>y. {{x,y}| x. x \<in> uverts C \<and> {x,y} \<in> uedges G}"
  have "card (uverts G - uverts C) = n - p"
    using pn C \<open>card(uverts G) = n\<close> G2
    apply (simp add: uclique_def)
    by (meson card_Diff_subset subgraph_def subgraph_verts_finite)
  moreover have "{e \<in> uedges G. e \<inter> uverts C \<noteq> {} \<and> e \<inter> (uverts G - uverts C) \<noteq> {}} = {{x,y}| x y. x \<in> uverts C \<and> y \<in> (uverts G - uverts C) \<and> {x,y} \<in> uedges G}"
  proof -
    have "e \<in> {e \<in> uedges G. e \<inter> uverts C \<noteq> {} \<and> e \<inter> (uverts G - uverts C) \<noteq> {}}
          \<Longrightarrow> \<exists>x y. e = {x,y} \<and> x \<in> uverts C \<and> y \<in> uverts G - uverts C" for e
      using G1
      apply (simp add: uwellformed_def)
      by (smt (z3) DiffD2 card_2_iff disjoint_iff_not_equal insert_Diff insert_Diff_if insert_iff)
    then show ?thesis
      by auto
  qed
  moreover have "card {{x,y}| x y. x \<in> uverts C \<and> y \<in> (uverts G - uverts C) \<and> {x,y} \<in> uedges G} \<le> card (uverts G - uverts C) * (p-1)"
  proof -
    have "card {{x,y}| x y. x \<in> uverts C \<and> y \<in> (uverts G - uverts C) \<and> {x,y} \<in> uedges G}
           \<le> (\<Sum>y \<in> (uverts G - uverts C). card (S y))"
    proof -
      have "finite (uverts G - uverts C)"
        using \<open>finite (uverts G)\<close> by auto
      have "{{x,y}| x y. x \<in> uverts C \<and> y \<in> (uverts G - uverts C) \<and> {x,y} \<in> uedges G}
           = (\<Union>y \<in> (uverts G - uverts C). {{x,y}| x. x \<in> uverts C \<and> {x,y} \<in> uedges G})"
        by auto
      then show ?thesis
        using Groups_Big.card_UN_le [OF \<open>finite (uverts G - uverts C)\<close>,
            of "\<lambda>y. {{x, y} |x. x \<in> uverts C \<and> {x, y} \<in> uedges G}"]
        using S_def
        by auto
    qed
    moreover have "(\<Sum>y\<in>uverts G - uverts C. card (S y)) \<le> card (uverts G - uverts C) * (p-1)"
    proof -
      have "card (S y) \<le> p - 1" if y: "y \<in> uverts G - uverts C" for y
        using clique_edges_inside_to_node_outside [OF assms(1,2,3,4) C C_max y] S_def y
        by simp
      then show ?thesis
        by (metis id_apply of_nat_eq_id sum_bounded_above)
    qed
    ultimately show ?thesis
      using order_trans
      by blast
  qed
  ultimately show ?thesis
    by (smt (verit, ccfv_SIG) mult.commute)
qed

text \<open>Lastly, we need to argue about the number of edges which are located entirely outside of
the greatest clique. Note that this is in the inductive step case in the overarching proof
of  Tur\'{a}n's graph theorem. That is why we have access to the inductive hypothesis as an
assumption in the following lemma:\<close>

lemma clique_edges_outside :
  assumes "uwellformed G" and "finite (uverts G)"
    and p2: "2 \<le> p" and pn: "p \<le> card (uverts G)" and n: "n = card(uverts G)"
    and C: "uclique C G (p-1)" and C_max: "(\<forall>C q. uclique C G q \<longrightarrow> q \<le> p-1)"
    and IH: "\<And>G y. y < n \<Longrightarrow> finite (uverts G) \<Longrightarrow> uwellformed G \<Longrightarrow> \<forall>C p'. uclique C G p' \<longrightarrow> p' < p
              \<Longrightarrow> 2 \<le> p \<Longrightarrow> card (uverts G) = y \<Longrightarrow> real (card (uedges G)) \<le> (1 - 1 / real (p - 1)) * real (y\<^sup>2) / 2"
  shows "card {e \<in> uedges G. e \<subseteq> uverts G - uverts C} \<le> (1 - 1 / (p-1)) * (n - p + 1) ^ 2 / 2"
proof -
  have "n - card (uverts C) < n"
    using C pn p2 n
    by (metis Suc_pred' diff_less less_2_cases_iff linorder_not_less not_gr0 uclique_def)
  have GC1: "finite (uverts (uverts G - uverts C, {e \<in> uedges G. e \<subseteq> uverts G - uverts C}))"
    using assms(2)
    by simp
  have GC2: "uwellformed (uverts G - uverts C, {e \<in> uedges G. e \<subseteq> uverts G - uverts C})"
    using assms(1)
    by (auto simp add: uwellformed_def)
  have GC3: "\<forall>C' p'. uclique C' (uverts G - uverts C, {e \<in> uedges G. e \<subseteq> uverts G - uverts C}) p' \<longrightarrow> p' < p"
  proof (rule ccontr)
    assume "\<not>(\<forall>C' p'. uclique C' (uverts G - uverts C, {e \<in> uedges G. e \<subseteq> uverts G - uverts C}) p' \<longrightarrow> p' < p)"
    then obtain C' p' where C': "uclique C' (uverts G - uverts C, {e \<in> uedges G. e \<subseteq> uverts G - uverts C}) p'" and p': "p' \<ge> p"
      by auto
    then have "uclique C' G p'"
      using uclique_def subgraph_def
      by auto
    then show False
      using p' p2 C_max
      by fastforce
  qed
  have GC4: "card (uverts (uverts G - uverts C,{e \<in> uedges G. e \<subseteq> uverts G - uverts C})) = n - card (uverts C)"
    using C n assms(2) uclique_def subgraph_def
    by (simp, meson card_Diff_subset infinite_super)
  show ?thesis
    using C GC3 IH [OF \<open>n - card (uverts C) < n\<close> GC1 GC2 GC3 \<open>2 \<le> p\<close> GC4] assms(2) n uclique_def
    by (simp, smt (verit, best) C One_nat_def Suc_1 Suc_leD clique_max_size of_nat_1 of_nat_diff p2)
qed

subsection \<open>Extending the size of the biggest clique\<close> text_raw \<open>\label{sec:extend_clique}\<close>

text \<open>In this section, we want to prove that we can add edges to a graph so that we augment the biggest clique
to some greater clique with a specific number of vertices. For that, we need the following lemma:
When too many edges have been added to a graph so that there exists a $(p+1)$-clique
then we can remove at least one of the added edges while also retaining a p-clique\<close>

lemma clique_union_size_decr :
  assumes "finite (uverts G)" and "uwellformed (uverts G, uedges G \<union> E)"
    and "uclique C (uverts G, uedges G \<union> E) (p+1)"
    and "card E \<ge> 1"
  shows "\<exists>C' E'. card E' < card E \<and> uclique C' (uverts G, uedges G \<union> E') p \<and> uwellformed (uverts G, uedges G \<union> E')"
proof (cases "\<exists>x \<in> uverts C. \<exists>e \<in> E. x \<in> e")
  case True
  then obtain x where x1: "x \<in> uverts C" and x2: "\<exists>e \<in> E. x \<in> e"
    by auto
  show ?thesis
  proof (rule exI [of _ "C -- x"], rule exI [of _ "{e \<in> E. x \<notin> e}"])
    have "card {e \<in> E. x \<notin> e} < card E"
      using x2 assms(4)
      by (smt (verit) One_nat_def card.infinite diff_is_0_eq mem_Collect_eq minus_nat.diff_0 not_less_eq psubset_card_mono psubset_eq subset_eq)
    moreover have "uclique (C -- x) (uverts G, uedges G \<union> {e \<in> E. x \<notin> e}) p"
    proof -
      have "p = card (uverts (C -- x))"
        using x1 assms(3)
        by (auto simp add: uclique_def remove_vertex_def)
      moreover have "subgraph (C -- x) (uverts G, uedges G \<union> {e \<in> E. x \<notin> e})"
        using assms(3)
        by (auto simp add: uclique_def subgraph_def remove_vertex_def)
      moreover have "C -- x = Ugraph_Lemmas.complete (uverts (C -- x))"
      proof -
        have 1: "\<And>y. y \<in> mk_uedge ` {uv \<in> uverts C \<times> uverts C. fst uv \<noteq> snd uv} - {A \<in> uedges C. x \<in> A} \<Longrightarrow>
            y \<in> mk_uedge ` {uv \<in> (uverts C - {x}) \<times> (uverts C - {x}). fst uv \<noteq> snd uv}"
          by (smt (z3) DiffE DiffI SigmaE SigmaI Ugraph_Lemmas.complete_def all_edges_def assms(3) empty_iff image_iff insert_iff mem_Collect_eq mk_uedge.simps snd_conv uclique_def)
        have 2: "\<And>y. y \<in> mk_uedge ` {uv \<in> (uverts C - {x}) \<times> (uverts C - {x}). fst uv \<noteq> snd uv} \<Longrightarrow>
            y \<in> mk_uedge ` {uv \<in> uverts C \<times> uverts C. fst uv \<noteq> snd uv} - {A \<in> uedges C. x \<in> A}"
          by (smt (z3) DiffE DiffI SigmaE SigmaI image_iff insert_iff mem_Collect_eq mk_uedge.simps singleton_iff)
        show ?thesis
          using assms(3)
          apply (simp add: remove_vertex_def complete_def all_edges_def uclique_def)
          using 1 2
          by (smt (verit, ccfv_SIG) split_pairs subset_antisym subset_eq)
      qed
      ultimately show ?thesis
        by (simp add: uclique_def)
    qed
    moreover have "uwellformed (uverts G, uedges G \<union> {e \<in> E. x \<notin> e})"
      using assms(2)
      by (auto simp add: uwellformed_def)
    ultimately show "card {e \<in> E. x \<notin> e} < card E \<and>
    uclique (C -- x) (uverts G, uedges G \<union> {e \<in> E. x \<notin> e}) p \<and>
    uwellformed (uverts G, uedges G \<union> {e \<in> E. x \<notin> e})"
      by auto
  qed
next
  case False
  then have "\<And>x. x \<in> uedges C \<Longrightarrow> x \<notin> E"
    using assms(2)
    by (metis assms(3) card_2_iff' complete_wellformed uclique_def uwellformed_def)
  then have "uclique C G (p+1)"
    using assms(3)
    by (auto simp add: uclique_def subgraph_def uwellformed_def)
  show ?thesis
    using assms(2,4) clique_size_jumpfree [OF assms(1) _ \<open>uclique C G (p+1)\<close>]
    apply (simp add: uwellformed_def)
    by (metis Suc_le_eq UnCI Un_empty_right card.empty prod.exhaust_sel)
qed

text \<open>We use this preceding lemma to prove the next result. In this lemma we assume that we have
added too many edges. The goal is then to remove some of the new edges appropriately so
that it is indeed guaranteed that there is no bigger clique.

Two proofs of this lemma will be described in the following.
Both fundamentally come down to the same core idea:
In essence, both proofs apply the well-ordering principle.
In the first proof we do so immediately by obtaining the minimum of a set:\<close>

lemma clique_union_make_greatest :
  fixes p n :: nat
  assumes "finite (uverts G)" and "uwellformed G"
    and "uwellformed (uverts G, uedges G \<union> E)" and "card(uverts G) \<ge> p"
    and "uclique C (uverts G, uedges G \<union> E) p"
    and "\<forall>C' q'. uclique C' G q' \<longrightarrow> q' < p" and "1 \<le> card E"
  shows "\<exists>C' E'. uwellformed (uverts G, uedges G \<union> E')
        \<and> (uclique C' (uverts G, uedges G \<union> E') p)
        \<and> (\<forall>C'' q'. uclique C'' (uverts G, uedges G \<union> E') q' \<longrightarrow> q' \<le> p)"
  using assms
proof  (induction "card E" arbitrary: C E rule: less_induct)
  case (less E)
  then show ?case
  proof (cases "\<exists>A. uclique A (uverts G, uedges G \<union> E) (p+1)")
    case True
    then obtain A where A: "uclique A (uverts G, uedges G \<union> E) (p+1)"
      by auto
    obtain C' E' where E'1: "card E' < card E"
      and E'2: "uclique C' (uverts G, uedges G \<union> E') p"
      and E'3: "uwellformed (uverts G, uedges G \<union> E')"
      and E'4: "1 \<le> card E'"
      using less(7)
      using clique_union_size_decr [OF assms(1) \<open>uwellformed (uverts G, uedges G \<union> E)\<close> A less(8)]
      by (metis One_nat_def Suc_le_eq Un_empty_right card_gt_0_iff finite_Un finite_verts_edges fst_conv less.prems(1) less_not_refl prod.collapse snd_conv)
    show ?thesis
      using less(1) [OF E'1 assms(1,2) E'3 less(5) E'2 less(7) E'4]
      using E'1 less(8)
      by (meson less_or_eq_imp_le order_le_less_trans)
  next
    case False
    show ?thesis
      apply (rule exI [of _ C], rule exI [of _ E])
      using clique_size_neg_max [OF _ less(4) False]
      using less(2,4,6)
      by fastforce
  qed
qed

text \<open>In this second, alternative proof the well-ordering principle is used through complete induction.\<close>

lemma clique_union_make_greatest_alt :
  fixes p n :: nat
  assumes "finite (uverts G)" and "uwellformed G"
    and "uwellformed (uverts G, uedges G \<union> E)" and "card(uverts G) \<ge> p"
    and "uclique C (uverts G, uedges G \<union> E) p"
    and "\<forall>C' q'. uclique C' G q' \<longrightarrow> q' < p" and "1 \<le> card E"
  shows "\<exists>C' E'. uwellformed (uverts G, uedges G \<union> E')
        \<and> (uclique C' (uverts G, uedges G \<union> E') p)
        \<and> (\<forall>C'' q'. uclique C'' (uverts G, uedges G \<union> E') q' \<longrightarrow> q' \<le> p)"
proof -
  define P where "P \<equiv> \<lambda>E. uwellformed (uverts G, uedges G \<union> E) \<and> (\<exists>C. uclique C (uverts G, uedges G \<union> E) p)"
  have "finite {y. \<exists>E. P E \<and> card E = y}"
  proof -
    have "\<And>E. P E \<Longrightarrow> E \<subseteq> Pow (uverts G)"
      by (auto simp add: P_def uwellformed_def)
    then have "finite {E. P E}"
      using assms(1)
      by (metis Collect_mono Pow_def finite_Pow_iff rev_finite_subset)
    then show ?thesis
      by simp
  qed
  obtain F where F1: "P F"
    and F2: "card F = Min {y. \<exists>E. P E \<and> card E = y}"
    and F3: "card F > 0"
    using assms(1,3,4,5,6) Min_in \<open>finite {y. \<exists>E. P E \<and> card E = y}\<close> P_def CollectD Collect_empty_eq
    by (smt (verit, ccfv_threshold) Un_empty_right card_gt_0_iff finite_Un finite_verts_edges fst_conv le_refl linorder_not_le prod.collapse snd_conv)
  have "p > 0"
    using assms(6) clique_exists bot_nat_0.not_eq_extremum
    by blast
  then show ?thesis
  proof (cases "\<exists>C. uclique C (uverts G, uedges G \<union> F) (p + 1)")
    case True
    then obtain F' where F'1 : "P F'" and F'2: "card F' < card F"
      using F1 F2 F3 clique_union_size_decr [OF assms(1), of F _ p] P_def
      by (smt (verit) One_nat_def Suc_eq_plus1 Suc_leI add_2_eq_Suc' assms(1) clique_size_jumpfree fst_conv)
    then show ?thesis
      using F2 \<open>finite {y. \<exists>F. P F \<and> card F = y}\<close> Min_gr_iff
      by fastforce
  next
    case False
    then show ?thesis
      using clique_size_neg_max [OF _ _ False]
      using assms(1) F1 P_def
      by (smt (verit, ccfv_SIG) Suc_eq_plus1 Suc_leI fst_conv linorder_not_le)
  qed
qed

text \<open>Finally, with this lemma we can turn to this section’s main challenge of increasing the
greatest clique size of a graph by adding edges.\<close>

lemma clique_add_edges_max :
  fixes p :: nat
  assumes "finite (uverts G)"
    and "uwellformed G" and "card(uverts G) > p"
    and "\<exists>C. uclique C G p" and "(\<forall>C q'. uclique C G q' \<longrightarrow> q' \<le> p)"
    and "q \<le> card(uverts G)" and "p \<le> q"
  shows "\<exists>E. uwellformed (uverts G, uedges G \<union> E) \<and> (\<exists>C. uclique C (uverts G, uedges G \<union> E) q)
        \<and> (\<forall>C q'. uclique C (uverts G, uedges G \<union> E) q' \<longrightarrow> q' \<le> q)"
proof (cases "p < q")
  case True
  then show ?thesis
  proof -
    have "\<exists>E. uwellformed (uverts G, uedges G \<union> E) \<and> (\<exists>C. uclique C (uverts G, uedges G \<union> E) q) \<and> card E \<ge> 1"
      apply (rule exI [of _ "all_edges (uverts G)"])
      using Set.Un_absorb1 [OF wellformed_all_edges [OF assms(2)]]
      using complete_wellformed [of "uverts G"] clique_complete [OF assms(1,6)]
      using all_edges_def assms(1,5)
      apply (simp add: complete_def)
      by (metis Suc_leI True Un_empty_right all_edges_finite card_gt_0_iff linorder_not_less prod.collapse)
    then obtain E C where E1: "uwellformed (uverts G, uedges G \<union> E)"
      and E2: "uclique C (uverts G, uedges G \<union> E) q"
      and E3: "card E \<ge> 1"
      by auto
    show ?thesis
      using clique_union_make_greatest [OF assms(1,2) E1 assms(6) E2 _ E3] assms(5) True
      using order_le_less_trans
      by blast
  qed
next
  case False
  show ?thesis
    apply (rule exI [of _ "{}"])
    using False assms(2,4,5,7)
    by simp
qed

section \<open>Properties of the upper edge bound\<close>

text \<open>In this section we prove results about the upper edge bound in Tur\'{a}n's theorem.
The first lemma proves that upper bounds of the sizes of the partitions sum up exactly to the overall upper bound.\<close>

lemma turan_sum_eq :
  fixes n p :: nat
  assumes "p \<ge> 2" and "p \<le> n"
  shows "(p-1) * (p-2) / 2 + (1 - 1 / (p-1)) * (n - p + 1) ^ 2 / 2 + (p - 2) * (n - p + 1) = (1 - 1 / (p-1)) * n^2 / 2"
proof -
  have "a * (a-1) / 2 + (1 - 1 / a) * (n - a) ^ 2 / 2 + (a - 1) * (n - a)  = (1 - 1 / a) * n^2 / 2"
    if a1: "a \<ge> 1" and a2: "n \<ge> a"
    for a :: nat
  proof -
    have "a\<^sup>2 + (n - a)\<^sup>2 + a * (n - a) * 2 = n\<^sup>2"
      using a2
      apply (simp flip: Groups.ab_semigroup_mult_class.mult.commute [of 2 "a * (n - a)"])
      apply (simp add: Semiring_Normalization.comm_semiring_1_class.semiring_normalization_rules(18) [of 2 a "(n - a)"])
      by (simp flip: Power.comm_semiring_1_class.power2_sum [of a "n-a"])
    then have "((a - 1) / a) * (a ^ 2 + (n - a) ^ 2 + a * (n - a) * 2) = ((a - 1) / a) * n^2"
      by presburger
    then have "(((a - 1) / a) * a ^ 2 + ((a - 1) / a) * (n - a) ^ 2 + ((a - 1) / a) * a * (n - a) * 2) = ..."
      using Rings.semiring_class.distrib_left [of "(a - 1) / a" "a\<^sup>2 + (n - a)\<^sup>2" "a * (n - a) * 2"]
      using Rings.semiring_class.distrib_left [of "(a - 1) / a" "a\<^sup>2" "(n - a)\<^sup>2"]
      by auto
    moreover have "((a - 1) / a) * a ^ 2 = a * (a-1)"
      by (simp add: power2_eq_square)
    ultimately have "a * (a-1) + ((a - 1) / a) * (n - a) ^ 2 + (a - 1) * (n - a) * 2  = ((a - 1) / a) * n^2"
      using a1 a2
      by auto
    moreover have "1 - 1 / a = (a - 1) / a"
      by (smt (verit, del_insts) One_nat_def Suc_pred diff_divide_distrib diff_is_0_eq of_nat_1 of_nat_diff of_nat_le_0_iff of_nat_le_iff of_nat_less_iff right_inverse_eq that)
    ultimately have "a * (a-1) + (1 - 1 / a) * (n - a) ^ 2 + (a - 1) * (n - a) * 2  = (1 - 1 / a) * n^2"
      by simp
    then show ?thesis
      by simp
  qed
  moreover have "p - 1 \<ge> 1"
    using \<open>p \<ge> 2\<close> by auto
  moreover have "n \<ge> p - 1"
    using assms(2) by auto
  ultimately show ?thesis
    by (smt (verit) assms Nat.add_diff_assoc2 Nat.diff_diff_right diff_diff_left le_eq_less_or_eq less_Suc_eq_le linorder_not_less nat_1_add_1 plus_1_eq_Suc)
qed

text \<open>The next fact proves that the upper bound of edges is monotonically increasing with the size of the biggest clique.\<close>

lemma turan_mono :
  fixes n p q :: nat
  assumes "0 < q" and "q < p" and "p \<le> n"
  shows "(1 - 1 / q) * n^2 / 2 \<le> (1 - 1 / (p-1)) * n^2 / 2"
  using assms
  by (simp add: Extended_Nonnegative_Real.divide_right_mono_ennreal Real.inverse_of_nat_le)

section \<open>Tur\'{a}n's Graph Theorem\<close>

text \<open>In this section we turn to the direct adaptation of Tur\'{a}n's original proof as presented by Aigner and Ziegler \cite{Aigner2018}\<close>

theorem turan :
  fixes p n :: nat
  assumes "finite (uverts G)"
    and "uwellformed G" and "\<forall>C p'. uclique C G p' \<longrightarrow> p' < p" and "p \<ge> 2" and "card(uverts G) = n"
  shows "card (uedges G) \<le> (1 - 1 / (p-1)) * n^2 / 2" using assms
proof (induction n arbitrary: G rule: less_induct)
  case (less n)
  then show ?case
  proof (cases "n < p")
    case True
    show ?thesis
    proof (cases "n")
      case 0
      with less True show ?thesis
        by (auto simp add: wellformed_uverts_0)
    next
      case (Suc n')
      with True have "(1 - 1 / real n) \<le> (1 - 1 / real (p - 1))"
        by (metis diff_Suc_1 diff_left_mono inverse_of_nat_le less_Suc_eq_le linorder_not_less list_decode.cases not_add_less1 plus_1_eq_Suc)
      moreover have "real (card (uedges G)) \<le> (1 - 1 / real n) * real (n\<^sup>2) / 2"
        using ugraph_max_edges [OF less(3,6,2)]
        by (smt (verit, ccfv_SIG) left_diff_distrib mult.right_neutral mult_of_nat_commute nonzero_mult_div_cancel_left of_nat_1 of_nat_mult power2_eq_square times_divide_eq_left)
      ultimately show ?thesis
        using Rings.ordered_semiring_class.mult_right_mono divide_less_eq_numeral1(1) le_less_trans linorder_not_less of_nat_0_le_iff
        by (smt (verit, ccfv_threshold) divide_nonneg_nonneg times_divide_eq_right)
    qed
  next
    case False
    show ?thesis
    proof -
      obtain C q where C: "uclique C G q"
        and C_max: "(\<forall>C q'. uclique C G q' \<longrightarrow> q' \<le> q)"
        and q: "q < card (uverts G)"
        using clique_exists_gt0 [OF \<open>finite (uverts G)\<close>] False \<open>p \<ge> 2\<close> less.prems(1,3,5)
        by (metis card.empty card_gt_0_iff le_eq_less_or_eq order_less_le_trans pos2)
      obtain E C' where E: "uwellformed (uverts G, uedges G \<union> E)"
        and C': "(uclique C' (uverts G, uedges G \<union> E) (p-1))"
        and C'_max: "(\<forall>C q'. uclique C (uverts G, uedges G \<union> E) q' \<longrightarrow> q' \<le> p-1)"
        using clique_add_edges_max [OF \<open>finite (uverts G)\<close> \<open>uwellformed G\<close> q _ C_max, of "p-1"]
        using C less(4) less(5) False \<open>card (uverts G) = n\<close>
        by (smt (verit) One_nat_def Suc_leD Suc_pred less_Suc_eq_le linorder_not_less order_less_le_trans pos2)
      have "card {e \<in> uedges G \<union> E. e \<subseteq> uverts C'} = (p-1) * (p-2) / 2"
        using clique_edges_inside [OF E _ _ _ C'] False less(2) less.prems(4) C'
        by (smt (verit, del_insts) Collect_cong Suc_1 add_leD1 clique_max_size fst_conv of_nat_1 of_nat_add of_nat_diff of_nat_mult plus_1_eq_Suc snd_conv)
      moreover have "card {e \<in> uedges G \<union> E. e \<subseteq> uverts G - uverts C'} \<le> (1 - 1 / (p-1)) * (n - p + 1) ^ 2 / 2"
      proof -
        have "real(card{e \<in> uedges (uverts G, uedges G \<union> E). e \<subseteq> uverts (uverts G, uedges G \<union> E) - uverts C'})
              \<le> (1 - 1 / (real p - 1)) * (real n - real p + 1)\<^sup>2 / 2"
          using clique_edges_outside [OF E _ less(5) _ _ C' C'_max, of n] linorder_class.leI [OF False] less(1,2,6)
          by (metis (no_types, lifting) fst_conv)
        then show ?thesis
          by (simp, smt (verit, best) False One_nat_def Suc_1 Suc_leD add.commute leI less.prems(4) of_nat_1 of_nat_diff)
      qed
      moreover have "card {e \<in> uedges G \<union> E. e \<inter> uverts C' \<noteq> {} \<and> e \<inter> (uverts G - uverts C') \<noteq> {}} \<le> (p - 2) * (n - p + 1)"
        using clique_edges_inside_to_outside [OF E _ _ _ _ C' C'_max, of  n] less(2,5,6)
        by (simp, metis (no_types, lifting) C' False Nat.add_diff_assoc Nat.add_diff_assoc2 One_nat_def Suc_1 clique_max_size fst_conv leI mult_Suc_right plus_1_eq_Suc)
      ultimately have "real (card (uedges G \<union> E)) \<le> (1 - 1 / real (p - 1)) * real (n\<^sup>2) / 2"
        using graph_partition_edges_card [OF _ E, of "uverts C'"]
        using less(2) turan_sum_eq [OF \<open>2 \<le> p\<close>, of n] False C' uclique_def subgraph_def
        by (smt (verit) Collect_cong fst_eqD linorder_not_le of_nat_add of_nat_mono snd_eqD)
      then show ?thesis
        using less(2) E finite_verts_edges Finite_Set.card_mono [OF _ Set.Un_upper1 [of "uedges G" E]]
        by force
    qed
  qed
qed

section \<open>A simplified proof of Tur\'{a}n's Graph Theorem\<close>

text \<open>In this section we discuss a simplified proof of Tur\'{a}n's Graph Theorem which uses an idea put forward by the author:
Instead of increasing the size of the biggest clique it is also possible to use the fact that
the expression in Tur\'{a}n's graph theorem is monotonically increasing in the size of the biggest clique (Lemma @{thm [source] turan_mono}).
Hence, it suffices to prove the upper bound for the actual biggest clique size in the graph.
Afterwards, the monotonicity provides the desired inequality.

The simplifications in the proof are annotated accordingly.\<close>

theorem turan' :
  fixes p n :: nat
  assumes "finite (uverts G)"
    and "uwellformed G" and "\<forall>C p'. uclique C G p' \<longrightarrow> p' < p" and "p \<ge> 2" and "card(uverts G) = n"
  shows "card (uedges G) \<le> (1 - 1 / (p-1)) * n^2 / 2" using assms
proof (induction n arbitrary: p G rule: less_induct)
  txt \<open>In the simplified proof we also need to generalize over the biggest clique size @{term p}
       so that we can leverage the induction hypothesis in the proof
       for the already pre-existing biggest clique size which might be smaller than @{term "p-1"}.\<close>
  case (less n)
  then show ?case
  proof (cases "n < p")
    case True
    show ?thesis
    proof (cases "n")
      case 0
      with less True show ?thesis
        by (auto simp add: wellformed_uverts_0)
    next
      case (Suc n')
      with True have "(1 - 1 / real n) \<le> (1 - 1 / real (p - 1))"
        by (metis diff_Suc_1 diff_left_mono inverse_of_nat_le less_Suc_eq_le linorder_not_less list_decode.cases not_add_less1 plus_1_eq_Suc)
      moreover have "real (card (uedges G)) \<le> (1 - 1 / real n) * real (n\<^sup>2) / 2"
        using ugraph_max_edges [OF less(3,6,2)]
        by (smt (verit, ccfv_SIG) left_diff_distrib mult.right_neutral mult_of_nat_commute nonzero_mult_div_cancel_left of_nat_1 of_nat_mult power2_eq_square times_divide_eq_left)
      ultimately show ?thesis
        using Rings.ordered_semiring_class.mult_right_mono divide_less_eq_numeral1(1) le_less_trans linorder_not_less of_nat_0_le_iff
        by (smt (verit, ccfv_threshold) divide_nonneg_nonneg times_divide_eq_right)
    qed
  next
    case False
    show ?thesis
    proof -
      from False \<open>p \<ge> 2\<close>
      obtain C q where C: "uclique C G q"
        and C_max: "(\<forall>C q'. uclique C G q' \<longrightarrow> q' \<le> q)"
        and q1: "q < card (uverts G)" and q2: "0 < q"
        and pq: "q < p"
        using clique_exists_gt0 [OF \<open>finite (uverts G)\<close>] clique_exists1 less.prems(1,3,5)
        by (metis card.empty card_gt_0_iff le_eq_less_or_eq order_less_le_trans pos2)
      txt \<open>In the unsimplified proof we extend this existing greatest clique C to a clique of size @{term "p-1"}.
           This part is made superfluous in the simplified proof.
           In particular, also Section \ref{sec:extend_clique} is unneeded for this simplified proof.
           From here on the proof is analogous to the unsimplified proof
           with the potentially smaller clique of size @{term q} in place of the extended clique.\<close>
      have "card {e \<in> uedges G. e \<subseteq> uverts C} = q * (q-1) / 2"
        using clique_edges_inside [OF less(3,2) _ _ C] q1 less(6)
        by auto
      moreover have "card {e \<in> uedges G. e \<subseteq> uverts G - uverts C} \<le> (1 - 1 / q) * (n - q) ^ 2 / 2"
      proof -
        have "real (card {e \<in> uedges G. e \<subseteq> uverts G - uverts C})
              \<le> (1 - 1 / (real (q + 1) - 1)) * (real n - real (q + 1) + 1)\<^sup>2 / 2"
          using clique_edges_outside [OF less(3,2) _ _ , of "q+1" n C] C C_max q1 q2 linorder_class.leI [OF False] less(1,6)
          by (smt (verit, ccfv_threshold) Suc_1 Suc_eq_plus1 Suc_leI diff_add_inverse2 zero_less_diff)
        then show ?thesis
          using  less.prems(5) q1
          by (simp add: of_nat_diff)
      qed
      moreover have "card {e \<in> uedges G. e \<inter> uverts C \<noteq> {} \<and> e \<inter> (uverts G - uverts C) \<noteq> {}} \<le> (q - 1) * (n - q)"
        using clique_edges_inside_to_outside [OF less(3,2) q2 _ less(6) C C_max] q1
        by simp
      ultimately have "real (card (uedges G)) \<le> (1 - 1 / real q) * real (n\<^sup>2) / 2"
        using graph_partition_edges_card [OF less(2,3), of "uverts C"]
        using C uclique_def subgraph_def q1 q2 less.prems(5) turan_sum_eq [of "Suc q" n]
        by (smt (verit) Nat.add_diff_assoc Suc_1 Suc_le_eq Suc_le_mono add.commute add.right_neutral diff_Suc_1 diff_Suc_Suc of_nat_add of_nat_mono plus_1_eq_Suc)
      then show ?thesis
        txt \<open>The final statement can then easily be derived with the monotonicity (Lemma @{thm [source] turan_mono}).\<close>
        using turan_mono [OF q2 pq, of n] False
        by linarith
    qed
  qed
qed

end


(* Title: Examples/SML_Relativization/Foundations/SML_Relations.thy
   Author: Mihails Milehins
   Copyright 2021 (C) Mihails Milehins
*)
section\<open>Relativization of the results about relations\<close>
theory SML_Relations
  imports Main
begin

subsection\<open>Definitions and common properties\<close>

context
  notes [[inductive_internals]]
begin

inductive_set trancl_on :: "['a set, ('a \<times> 'a) set] \<Rightarrow> ('a \<times> 'a) set"
  (\<open>on _/ (_\<^sup>+)\<close> [1000, 1000] 999)
  for U :: "'a set" and r :: "('a \<times> 'a) set"
  where
    r_into_trancl[intro, Pure.intro]:
      "\<lbrakk> a \<in> U; b \<in> U; (a, b) \<in> r \<rbrakk> \<Longrightarrow> (a, b) \<in> on U r\<^sup>+"
  | trancl_into_trancl[Pure.intro]:
      "
      \<lbrakk> a \<in> U; b \<in> U; c \<in> U; (a, b) \<in> on U r\<^sup>+; (b, c) \<in> r \<rbrakk> \<Longrightarrow>
        (a, c) \<in> on U r\<^sup>+
      "

abbreviation tranclp_on (\<open>on _/ (_\<^sup>+\<^sup>+)\<close> [1000, 1000] 1000) where
  "tranclp_on \<equiv> trancl_onp"

declare trancl_on_def[nitpick_unfold del]

lemmas tranclp_on_def = trancl_onp_def

end

definition transp_on :: "['a set, ['a, 'a] \<Rightarrow> bool] \<Rightarrow> bool"
  where "transp_on U = (\<lambda>r. (\<forall>x\<in>U. \<forall>y\<in>U. \<forall>z\<in>U. r x y \<longrightarrow> r y z \<longrightarrow> r x z))"

definition acyclic_on :: "['a set, ('a \<times> 'a) set] \<Rightarrow> bool"
  where "acyclic_on U = (\<lambda>r. (\<forall>x\<in>U. (x, x) \<notin> on U r\<^sup>+))"

lemma trancl_on_eq_tranclp_on:
  "on P (\<lambda>x y. (x, y) \<in> r)\<^sup>+\<^sup>+ x y = ((x, y) \<in> on (Collect P) r\<^sup>+)"
  unfolding trancl_on_def tranclp_on_def Set.mem_Collect_eq by simp

lemma trancl_on_imp_U: "(x, y) \<in> on U r\<^sup>+  \<Longrightarrow> (x, y) \<in> U \<times> U"
  by (auto dest: trancl_on.cases)

lemmas tranclp_on_imp_P = trancl_on_imp_U[to_pred, simplified]

lemma trancl_on_imp_trancl: "(x, y) \<in> on U r\<^sup>+ \<Longrightarrow> (x, y) \<in> r\<^sup>+"
  by (induction rule: trancl_on.induct) auto

lemmas tranclp_on_imp_tranclp = trancl_on_imp_trancl[to_pred]

lemma tranclp_eq_tranclp_on: "r\<^sup>+\<^sup>+ = on (\<lambda>x. True) r\<^sup>+\<^sup>+"
  unfolding tranclp_def tranclp_on_def by simp

lemma trancl_eq_trancl_on: "r\<^sup>+ = on UNIV r\<^sup>+"
  unfolding trancl_def trancl_on_def by (simp add: tranclp_eq_tranclp_on)

lemma transp_on_empty[simp]: "transp_on {} r" unfolding transp_on_def by simp

lemma transp_eq_transp_on: "transp = transp_on UNIV"
  unfolding transp_def transp_on_def by simp

lemma acyclic_on_empty[simp]: "acyclic_on {} r" unfolding acyclic_on_def by simp

lemma acyclic_eq_acyclic_on: "acyclic = acyclic_on UNIV"
  unfolding acyclic_def acyclic_on_def
  unfolding trancl_def tranclp_def trancl_on_def tranclp_on_def
  by simp

subsection\<open>Transfer rules I: \<^const>\<open>lfp\<close> transfer\<close>

text\<open>
The following context contains code from \<^cite>\<open>"immler_re_2019"\<close>.
\<close>

context
  includes lifting_syntax
begin

lemma Inf_transfer[transfer_rule]:
  "(rel_set (A ===> (=)) ===> A ===> (=)) Inf Inf"
  unfolding Inf_fun_def by transfer_prover

lemma less_eq_pred_transfer[transfer_rule]:
  assumes [transfer_rule]: "right_total A"
  shows
    "((A ===> (=)) ===> (A ===> (=)) ===> (=))
      (\<lambda>f g. \<forall>x\<in>Collect(Domainp A). f x \<le> g x) (\<le>)"
  unfolding le_fun_def by transfer_prover

lemma lfp_transfer[transfer_rule]:
  assumes [transfer_rule]: "bi_unique A" "right_total A"
  defines "R \<equiv> (((A ===> (=)) ===> (A ===> (=))) ===> (A ===> (=)))"
  shows "R (\<lambda>f. lfp (\<lambda>u x. if Domainp A x then f u x else bot)) lfp"
proof -
  have "R (\<lambda>f. Inf {u. \<forall>x\<in>Collect (Domainp A). f u x \<le> u x}) lfp"
    unfolding R_def lfp_def by transfer_prover
  thus ?thesis by (auto simp: le_fun_def lfp_def)
qed

lemma Inf2_transfer[transfer_rule]:
  "(rel_set (T ===> T ===> (=)) ===> T ===> T ===> (=)) Inf Inf"
  unfolding Inf_fun_def by transfer_prover

lemma less_eq2_pred_transfer[transfer_rule]:
  assumes [transfer_rule]: "right_total T"
  shows
    "((T ===> T ===> (=)) ===> (T ===> T ===> (=)) ===> (=))
      (\<lambda>f g. \<forall>x\<in>Collect(Domainp T). \<forall>y\<in>Collect(Domainp T). f x y \<le> g x y) (\<le>)"
  unfolding le_fun_def by transfer_prover

lemma lfp2_transfer[transfer_rule]:
  assumes [transfer_rule]: "bi_unique A" "right_total A"
  defines
    "R \<equiv>
      (((A ===> A ===> (=)) ===> (A ===> A ===> (=))) ===> (A ===> A ===> (=)))"
  shows
    "R
      (
        \<lambda>f. lfp
          (
            \<lambda>u x y.
              if Domainp A x
              then if Domainp A y then (f u) x y else bot
              else bot
          )
      )
      lfp"
proof -
  have
    "R
      (
        \<lambda>f.
          Inf
            {
              u.
                \<forall>x\<in>Collect (Domainp A). \<forall>y\<in>Collect (Domainp A).
                  (f u) x y \<le> u x y
            }
      )
      lfp"
    unfolding R_def lfp_def by transfer_prover
  thus ?thesis by (auto simp: le_fun_def lfp_def)
qed

end

subsection\<open>Transfer rules II: application-specific rules\<close>

context
  includes lifting_syntax
begin

lemma transp_rt_transfer[transfer_rule]:
  assumes[transfer_rule]: "right_total A"
  shows
    "((A ===> A ===> (=)) ===> (=)) (transp_on (Collect (Domainp A))) transp"
  unfolding transp_def transp_on_def by transfer_prover

lemma tranclp_rt_bu_transfer[transfer_rule]:
  assumes[transfer_rule]: "bi_unique A" "right_total A"
  shows
    "((A ===> A ===> (=)) ===> (A ===> A ===> (=)))
      (tranclp_on (Domainp A)) tranclp"
  unfolding tranclp_on_def tranclp_def
  apply transfer_prover_start
  apply transfer_step+
proof
  fix r
  have
    "(
      \<lambda>p x y.
        (\<exists>a b. x = a \<and> y = b \<and> Domainp A a \<and> Domainp A b \<and> r a b) \<or>
        (
          \<exists>a b c.
            x = a \<and> y = c \<and>
            Domainp A a \<and> Domainp A b \<and> Domainp A c \<and>
            p a b \<and> r b c
        )
    ) =
      (
        \<lambda>p x y.
          if Domainp A x
          then if Domainp A y
            then
              (
                \<exists>a\<in>Collect (Domainp A). \<exists>b\<in>Collect (Domainp A).
                  x = a \<and> y = b \<and> r a b) \<or>
                  (
                    \<exists>a\<in>Collect (Domainp A).
                    \<exists>b\<in>Collect (Domainp A).
                    \<exists>c\<in>Collect (Domainp A).
                      x = a \<and> y = c \<and> p a b \<and> r b c
                  )
           else bot
         else bot
      )"
    (is "?lhs = ?rhs")
    by (intro ext) simp
  thus "lfp ?lhs = lfp ?rhs" by clarsimp
qed

lemma trancl_rt_bu_transfer[transfer_rule]:
  assumes[transfer_rule]: "bi_unique A" "right_total A"
  shows
    "(rel_set (rel_prod A A) ===> rel_set (rel_prod A A))
      (trancl_on (Collect (Domainp A))) trancl"
  unfolding trancl_on_def trancl_def
  apply transfer_prover_start
  apply transfer_step+
  by (auto simp: tranclp_on_imp_P[where U="Domainp A"])

lemma acyclic_rt_bu_transfer[transfer_rule]:
  assumes[transfer_rule]: "bi_unique A" "right_total A"
  shows
    "((rel_set (rel_prod A A)) ===> (=))
      (acyclic_on (Collect (Domainp A))) acyclic"
  unfolding acyclic_on_def acyclic_def by transfer_prover

end

text\<open>\newpage\<close>

end