header {* Matrices of Polynomials\label{sec.mat.poly} *}

theory Polynomial_matrix
imports
  Main
  Polynomial_extension
  Determinants_extension
  Matrices
begin

(* ------------------------------------------------------------------------- *)
subsection {* Basics *}
(* ------------------------------------------------------------------------- *)

definition coeffM_zero :: "'a poly^'n^'n \<Rightarrow> 'a\<Colon>zero^'n^'n" where
  "coeffM_zero A = (\<chi> i j. (coeff (A $ i $ j) 0))"

definition coeffM :: "'a poly^'n^'n \<Rightarrow> nat \<Rightarrow> 'a\<Colon>zero^'n^'n" where
  "coeffM A n = (\<chi> i j. coeff (A $ i $ j) n)"

lemma coeffM_simps:
  "coeffM (A - B) n = coeffM A n - coeffM B n"
  "coeffM (A + B) n = coeffM A n + coeffM B n"
  "coeffM (- A) n = - coeffM A n"
  "coeffM 0 n = 0"
  by (simp_all add: coeffM_def vec_eq_iff)

lemma expand_poly_eqM:
  "A = B \<longleftrightarrow> (\<forall> n. coeffM A n = coeffM B n)"
  by(auto simp add: coeffM_def vec_eq_iff poly_eq_iff)

lemma coeffM_monom_mult:
  fixes A :: "'a\<Colon>comm_ring_1 poly^'n\<Colon>finite^'n"
  shows "coeffM (monom 1 j *ss A) n = (if j \<le> n then coeffM A (n - j) else 0)"
  by (simp add: coeffM_def vec_eq_iff scalar_matrix_mult_def coeff_mult
     if_distrib[where f="\<lambda>x. x * y" for y] setsum.If_cases)

lemma coeffM_mat:
  fixes p :: "'a\<Colon>comm_ring_1 poly"
  shows "coeffM (mat p) i = coeff p i *ss mat 1"
  by (simp add: mat_def coeffM_def scalar_matrix_mult_def vec_eq_iff)

lemma coeffM_setsum: "coeffM (\<Sum>i\<in>A. f i) num = (\<Sum>i\<in>A. coeffM (f i) num)"
  by(simp add: coeff_setsum coeffM_def vec_eq_iff)

definition maxdegM :: "'a\<Colon>zero poly^'n^'n \<Rightarrow> nat"
  where "maxdegM A = Max {degree (A $ i $ j) | i j. True }"

lemma maxdegM_eq_range: "maxdegM A = Max (range (\<lambda>(i, j). degree (A $ i $ j)))"
  by (auto simp add: maxdegM_def intro!: arg_cong[where f=Max])

lemma all_degree_smaller:
  "degree (A $ i $ j) \<le> (maxdegM A)"
  using full_SetCompr_eq[of "\<lambda> (i, j) \<Rightarrow> degree (A $ i $ j)"]
  by(auto simp add: maxdegM_def intro!: Max_ge)

lemma all_degree_smaller_implies_smaller:
  "(\<forall> i j. degree (A $ i $ j) < n) \<Longrightarrow> maxdegM A < n"
  using full_SetCompr_eq[of "\<lambda> (i, j) \<Rightarrow> degree (A $ i $ j)"]
  by(auto simp add: maxdegM_def)

lemma deg_if_monom_minus:
  fixes A :: "'a::comm_ring_1^'n^'n"
  shows "degree ((if i = p i then monom 1 (Suc 0) else 0) - [:A $ i $ p i:])
         = (if i = p i then 1 else 0)"
  using monom_poly_degree_one by auto

definition mat2matofpoly :: "'a\<Colon>zero^'n^'n \<Rightarrow> ('a poly)^'n^'n" where
  "mat2matofpoly A = (\<chi> i j. [: A $ i $ j :])"

lemma mat2matofpoly_simps:
  "mat2matofpoly (A - B) = mat2matofpoly A - mat2matofpoly B"
  "mat2matofpoly (A + B) = mat2matofpoly A + mat2matofpoly B"
  "mat2matofpoly (- A) = - (mat2matofpoly A)"
  "mat2matofpoly 0 = 0"
  by(simp_all add: mat2matofpoly_def vec_eq_iff)

lemma coeffM_mat2matofpoly: "coeffM (mat2matofpoly A) i = (if i = 0 then A else 0)"
  by (auto simp add: coeffM_def mat2matofpoly_def vec_eq_iff gr0_conv_Suc)

lemma mat2matofpoly_mult:
  fixes A B :: "('a\<Colon>comm_ring_1)^'n^'n"
  shows "(mat2matofpoly A) ** (mat2matofpoly B) = mat2matofpoly (A ** B)"
  unfolding mat2matofpoly_def matrix_matrix_mult_def vec_eq_iff
  using finite[of UNIV]
  by(induct rule: finite_induct)
    (auto)

(* ------------------------------------------------------------------------- *)
subsection {* Euclidean division *}
(* ------------------------------------------------------------------------- *)

lemma matofpoly_euclidean_division:
  fixes A :: "('a::comm_ring_1 poly)^'n\<Colon>finite^'n\<Colon>finite"
  assumes *: "maxdegM A >0"
  shows "\<exists> B :: ('a^'n^'n). \<exists> A'\<in>{ x . maxdegM x < maxdegM A}.
         A = ( (monom 1 (maxdegM A)) *ss (mat2matofpoly B) ) + A'"
proof-
  have "\<And> i j . \<exists> b a'. degree (A $ i $ j) = maxdegM A \<longrightarrow>
  (degree a' < (degree (A $ i $ j))) \<and>
  (A $ i $ j) = monom b (degree (A $ i $ j)) + a'"
    by (metis assms mem_Collect_eq poly_euclidean_division)

  then obtain a' and b where Pred:
  "\<And> i j. degree (A $ i $ j) = maxdegM A \<Longrightarrow> (degree (a' i j) < maxdegM A) \<and>
  (A $ i $ j) = monom (b i j) (degree (A $ i $ j)) + a' i j"
    by metis

  def A'_mat \<equiv> "(\<chi> i j. if (degree (A $ i $ j) = maxdegM A) then a' i j else (A $ i $ j))"
  def B_mat \<equiv> "(\<chi> i j. if( degree (A $ i $ j) = maxdegM A) then b i j else 0)"

  have "\<And>i j. B_mat $ i $ j \<noteq> 0 \<longrightarrow> b i j \<noteq> 0"
       "\<And>i j. degree (A'_mat $ i $ j) < maxdegM A"
       "\<And>i j. A $ i $ j = monom (B_mat $ i $ j) (degree (A $ i $ j)) + A'_mat $ i $ j"
    using Pred
    by(simp_all add: all_degree_smaller le_neq_implies_less A'_mat_def B_mat_def )

  then obtain A' B where Pred2: "\<And> i j . ((B $ i $ j) \<noteq> 0 \<longrightarrow> (B_mat $ i $ j)\<noteq> 0) \<and>
  (degree (A' $ i $ j) < maxdegM A) \<and>
  (A $ i $ j) = monom (B $ i $ j) (degree (A $ i $ j)) + A' $ i $ j"
    by blast

  show ?thesis unfolding vec_eq_iff
    using B_mat_def Pred2
    by(simp add: scalar_matrix_mult_def mat2matofpoly_def)
      (metis (erased, hide_lams) all_degree_smaller_implies_smaller[of A' "maxdegM A"]
       monom_eq_0 smult_monom monoid_mult_class.mult.right_neutral)
qed

(* ------------------------------------------------------------------------- *)
subsection {* The characteristic polynomial *}
(* ------------------------------------------------------------------------- *)

text{* The characteristic polynomial of a square matrix is defined as follows: *}
definition "charpoly A = det (mat (monom 1 (Suc 0)) - mat2matofpoly A)"

text{* First we prove an auxiliary lemma that will later be used for analysing
   the degree of the characteristic polynomial via the Leibniz formula
   for the determinant. The lemma describes the degree and highest coefficient
   of a polynomial obtained as determinant of a matrix of polynomials (via the
   Leibniz formula). *}

lemma det_coeff_poly_mat:
  fixes A :: "'a\<Colon>comm_ring_1 poly^'n\<Colon>finite^'n"
  defines
     Sn: "Sn \<equiv> {p . p permutes (UNIV\<Colon>'n\<Colon>finite set)}"
  and m: "m \<equiv> Max { (\<Sum>i\<in>(UNIV\<Colon>'n\<Colon>finite set). degree (A $ i $ p i))| p. p permutes (UNIV\<Colon>'n set)}"
  shows
  "p\<in>Sn \<Longrightarrow> ((\<forall>p0\<in>Sn. degree (\<Prod>i\<in>(UNIV\<Colon>'n\<Colon>finite set). A $ i $ p0 i) = m \<longrightarrow> p0 = p)
                    \<and> degree (\<Prod>i\<in>(UNIV\<Colon>'n set). A $ i $ p i) = m) \<Longrightarrow> degree (det A) = m"

  "p\<in>Sn \<Longrightarrow> ((\<forall>p0\<in>Sn. degree (\<Prod>i\<in>(UNIV\<Colon>'n\<Colon>finite set). A $ i $ p0 i) = m \<longrightarrow> p0 = p)
             \<and> degree (\<Prod>i\<in>(UNIV\<Colon>'n set). A $ i $ p i) = m) \<Longrightarrow> coeff (det A) (degree (det A)) =
            of_int (sign p) * (\<Prod>i\<in>(UNIV\<Colon>'n set). coeff (A $ i $ p i) (degree (A $ i $ p i)))"

  "degree(det A) \<le> m"
proof-
  let ?U = "UNIV\<Colon>'n\<Colon>finite set"
  let ?Sn = "{p. p permutes ?U}"

  let ?m = "Max { \<Sum>i\<in>?U. degree (A $ i $ p i) | p. p permutes ?U}"
  let ?f = "\<lambda>p. \<Prod>i\<in>?U. A $ i $ p i"

  have p: "Sup ((\<lambda>p. degree(?f p)) ` ?Sn) \<le> Sup ((\<lambda>p. (\<Sum>i\<in>?U. degree (A $ i $ p i))) ` ?Sn)"
    unfolding Sup_image_eq
    by(intro cSUP_subset_mono)
      (simp_all add: exI[of _ id] permutes_id degree_setprod_le)

  then show "degree(det A) \<le> m"
    using degree_setsum_le_max[of "\<lambda>p. of_int (sign p) * (\<Prod>i\<in>?U. A $ i $ p i)" ?Sn]
    by(simp add: m sign_permut det_def Sup_nat_def image_Collect)

  { fix p0 :: "'n::finite \<Rightarrow> 'n"
    assume a: "p0 permutes ?U"
              "\<forall>pp0 \<in> ?Sn. degree (\<Prod>i\<in>?U. A $ i $ pp0 i) = ?m \<longrightarrow> pp0 = p0"
              "degree (\<Prod>i\<in>?U. A $ i $ p0 i) = ?m"

    let ?f = "\<lambda>p. (\<Prod>i\<in>?U. A $ i $ p i)"
    let ?ff = "\<lambda>p. of_int (sign p) * ?f p"
    let ?Sn_p = "?Sn - {p0}"

    let ?p = "of_int (sign p0) * ?f p0"
    let ?q = "(\<Sum>p\<in>?Sn - {p0}. of_int (sign p) * ?f p)"

    have th6b: "(\<Sum>p\<in>?Sn. ?ff p) = (\<Sum>p\<in>{p0}. ?ff p) + (\<Sum>p\<in>(?Sn - {p0}). ?ff p)"
      by (subst setsum.union_disjoint[symmetric])
         (auto intro!: setsum.cong a)

    { assume a2: "?Sn_p \<noteq> {}"
      let ?S = "{degree (?f p) | p. p\<in>?Sn_p}"

      have "Max ?S \<le> Max{ degree (?f p) | p. p permutes ?U}"
        using a2 by (auto intro!: Max_mono)

      also have "Max ?S \<noteq> ?m"
        using Max_in[of ?S] a(2) a2
        by force

      ultimately have "degree ?q < ?m"
        using p degree_setsum_le_max[of ?ff ?Sn_p]
        by(simp add: Sup_nat_def image_Collect sign_permut)
    } note deg_q_smaller_m = this

    have coeffs: "coeff ?p (degree(?p + ?q)) + coeff ?q (degree(?p + ?q)) = coeff ?p (degree ?p)"
      by (cases "?Sn_p = {}")
         (auto simp add: a(3) coeff_eq_0 degree_add_eq_left deg_q_smaller_m sign_permut
               simp del: Diff_eq_empty_iff)

    let ?fp0 = "\<lambda>i. (A $ i $ p0 i)"

    have "(\<Sum>i\<in>?U. degree (?fp0 i)) = degree (\<Prod>i\<in>?U. ?fp0 i)"
      by(intro dual_order.antisym degree_setprod_le)
        (auto simp add: a(1) a(3) intro!: Max_ge)

    then have "coeff ?p (degree ?p) = of_int (sign p0) * (\<Prod>i\<in>?U. coeff (?fp0 i) (degree (?fp0 i)))"
    by(simp add: coeff_mult_setprod_setsum[of ?fp0 ?U, symmetric] sign_def)

    then have 1: "coeff (det A) (degree (det A)) =
                  of_int (sign p0) * (\<Prod>i\<in>?U. coeff (?fp0 i) (degree (?fp0 i)))"
         and 2: "degree (det A) = ?m"
      apply(simp_all add: coeffs det_def th6b)
      apply(cases "?Sn_p = {}")
      apply(simp_all add:sign_permut a(3) degree_add_eq_left deg_q_smaller_m del: Diff_eq_empty_iff)
      done
    note 1 2
  }
  thus "p\<in>Sn \<Longrightarrow> ((\<forall>p0 \<in> Sn. degree (\<Prod>i\<in>?U. A $ i $ p0 i) = m \<longrightarrow> p0 = p)
        \<and> degree (\<Prod>i\<in>?U. A $ i $ p i) = m) \<Longrightarrow> degree(det A) = m"

       "p\<in>Sn \<Longrightarrow> ((\<forall>p0 \<in> Sn. degree (\<Prod>i\<in>?U. A $ i $ p0 i) = m \<longrightarrow> p0 = p)
        \<and> degree (\<Prod>i\<in>?U. A $ i $ p i) = m) \<Longrightarrow>
        coeff (det A) (degree (det A)) =
          of_int (sign p) * (\<Prod>i\<in>?U. coeff (A $ i $ p i) (degree (A $ i $ p i)))"
    using Sn m by fast+
qed

lemma p_not_id:
  assumes a1: "p\<noteq>id"
  shows "\<exists>i\<in>(UNIV :: 'n::finite set). i \<noteq> p i" "card {i. i = p i} < CARD('n)"
proof-
  show "\<exists>i\<in>(UNIV :: 'n::finite set). i \<noteq> p i"
    using a1 by auto
  then show "card {i. i = p i} < CARD('n)"
    by (metis (full_types) UNIV_I finite mem_Collect_eq psubset_card_mono top.not_eq_extremum)
qed

lemma coeff_charpoly_xn_is_one:
fixes A :: "'a::comm_ring_1^'n\<Colon>finite^'n"
shows "coeff (charpoly A) (card (UNIV\<Colon>'n set)) = 1"
      "degree (charpoly A) = card (UNIV\<Colon>'n set)"
proof-
  txt{* charpoly *}
  let ?B = "mat (monom 1 (Suc 0)) - mat2matofpoly A"
  let ?U = "UNIV :: 'n::finite set"

  let ?f = "\<lambda>p. \<Sum>i\<in>?U. degree (?B $ i $ p i)"
  let ?m = "Max {\<Sum>i\<in>?U. degree (?B $ i $ p i) | p. p permutes ?U}"
  let ?mon_A = "\<lambda>i. monom 1 (Suc 0) - [:A $ i $ i:]"

  have deg_prod_B_card: "degree (\<Prod>i\<in>?U. ?B $i $ i) = card ?U"
    using coeff_mult_setprod_setsum[of ?mon_A ?U]
    degree_setprod_le[of ?mon_A ?U] le_degree[of "\<Prod>i\<in>?U. ?mon_A i" "card ?U"]
    by(simp add: monom_poly_degree_one mat_def mat2matofpoly_def)

  have max_is_id: "Max {?f p | p. p permutes ?U} = ?f id"
    by (intro Max_eqI)
       (auto simp add: mat_def mat2matofpoly_def deg_if_monom_minus monom_poly_degree_one
             setsum.If_cases intro!: exI[of _ id] card_mono permutes_id cong del: if_cong)

  { fix p0
    have "degree (\<Prod>i\<in>?U. ?B $ i $ p0 i) = ?m \<Longrightarrow> p0 = id"
      unfolding max_is_id
      using degree_setprod_le[of "\<lambda>i.(if i=p0 i then monom 1 (Suc 0) else 0)- [:A $ i $ p0 i:]" ?U]
      p_not_id(2)[of p0]
      by(auto simp add: mat_def mat2matofpoly_def deg_if_monom_minus setsum.If_cases
         monom_poly_degree_one)
  } note x = this

  then show "degree (charpoly A) = card ?U"
    using max_is_id det_coeff_poly_mat(1)[of id ?B]
    by(simp add: charpoly_def deg_prod_B_card permutes_id del: vector_minus_component)
      (simp add: mat2matofpoly_def mat_def monom_poly_degree_one)

  then show "coeff (charpoly A) (card ?U) = 1"
    using x det_coeff_poly_mat(2)[of id ?B]
    by (simp add: charpoly_def max_is_id deg_prod_B_card permutes_id del: vector_minus_component)
       (simp add: mat2matofpoly_def mat_def sign_id monom_poly_degree_one)
qed

(* ------------------------------------------------------------------------- *)
subsection {* The basis lemma *}
(* ------------------------------------------------------------------------- *)

lemma poly_basis:
  fixes A :: "'a::comm_ring_1 poly^'n\<Colon>finite^'n"
  shows "\<exists> B. A = (\<Sum> i\<le>maxdegM A. monom 1 i *ss mat2matofpoly (B i))"
proof-
  { fix d
    have "\<forall>A. maxdegM A \<le> d \<longrightarrow> ( \<exists> B\<Colon>nat \<Rightarrow> 'a^'n^'n. A =
         (\<Sum>i\<le>maxdegM A. monom 1 i *ss mat2matofpoly (B i)))"
    proof (induct d)
      case 0
      { fix A :: "('a poly)^'n^'n"
        assume caseass: "maxdegM A = 0"

        have "A = mat2matofpoly (coeffM A 0)"
          by(simp add: coeffM_def mat2matofpoly_def vec_eq_iff )
            (metis (erased, hide_lams) caseass all_degree_smaller coeff_pCons_0 degree_pCons_eq_if
                                       le0 le_antisym nat.distinct(1) pCons_cases)

        hence "\<exists> B\<Colon>(nat \<Rightarrow> 'a^'n^'n). A = (\<Sum>i\<le>maxdegM A. monom 1 i *ss mat2matofpoly (B i))"
          by(auto simp add: caseass scalar_matrix_mult_monom intro!: exI[of _ "\<lambda>x. coeffM A 0"])
      }
      thus ?case by auto
    next
      case ( Suc n ) note IH = this
      { fix A :: "'a poly^'n\<Colon>finite^'n"
        assume caseass: "maxdegM A = Suc n"

        from matofpoly_euclidean_division[of A]
        obtain A' B where Pred: "A = monom 1 (maxdegM A) *ss mat2matofpoly B + A'"
                                "maxdegM A' < maxdegM A"
          using caseass by auto

        obtain B' where Pred2: "A' = (\<Sum>i\<le> maxdegM A'. monom 1 i *ss mat2matofpoly (B' i))"
          using IH caseass Pred by fastforce

        txt{* aB: combine B and B' *}
        def aB \<equiv> "\<lambda>i. if i \<le> maxdegM A' then B' i else (if i = maxdegM A then B else 0)"
        let ?MB = "\<lambda>i. monom 1 i *ss mat2matofpoly (aB i)"

        have "A = ?MB (maxdegM A) + (\<Sum>i\<le>maxdegM A'. ?MB i)"
          using Pred Pred Pred2
          by (simp add: aB_def cong del: if_cong)

        also have "\<And>i.(i > maxdegM A') \<and> (i < (maxdegM A)) \<Longrightarrow> ?MB i = 0"
          by(simp add: aB_def mat2matofpoly_def scalar_matrix_mult_def zero_vec_def)

        ultimately have "A = ?MB (maxdegM A) + (\<Sum>i=maxdegM A'+1 ..< maxdegM A. ?MB i) +
        (\<Sum>i \<le> maxdegM A'. ?MB i)"
          by simp
        also have "... = (\<Sum>i\<in>{maxdegM A} \<union> {maxdegM A'+1 ..< maxdegM A} \<union> {.. maxdegM A'}. ?MB i)"
          using Pred by (subst setsum.union_disjoint) auto
        also have "{maxdegM A} \<union> {maxdegM A'+1 ..< maxdegM A} \<union> {.. maxdegM A'} = {.. maxdegM A}"
          using Pred by auto
        finally have "A = (\<Sum>i \<le> maxdegM A. ?MB i)" .

        hence "\<exists> B. A = (\<Sum>i\<le> maxdegM A. monom 1 i *ss mat2matofpoly (B i))"
          by auto
      }
      then show ?case
        by(simp add: le_Suc_eq IH)
    qed
  }
  thus ?thesis by auto
qed

end


theory TopoS_ENF
imports Main TopoS_Interface "Lib/TopoS_Util" TopoS_withOffendingFlows
begin

section{*Special Structures of Security Invariants*}

text {* Security Invariants may have a common structure:
  If the function @{term "sinvar"} is predicate which starts with @{text "\<forall> (v\<^sub>1, v\<^sub>2) \<in> edges G. \<dots>"},
  we call this the all edges normal form (ENF).
  We found that this form has some nice properties.
  Also, locale instantiation is easier in ENF with the help of the following lemmata.*}

subsection {* Simple Edges Normal Form (ENF) *}

context SecurityInvariant_withOffendingFlows
begin

  definition sinvar_all_edges_normal_form :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool" where
  "sinvar_all_edges_normal_form P \<equiv> \<forall> G nP. sinvar G nP = (\<forall> (e1, e2)\<in> edges G. P (nP e1) (nP e2))"

  text{* reflexivity is needed for convenience. If a security invariant is not reflexive, that means that all nodes with the default
    parameter @{text "\<bottom>"} are not allowed to communicate with each other. Non-reflexivity is possible, but requires more work. *}
  definition ENF_refl :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool" where
  "ENF_refl P \<equiv> sinvar_all_edges_normal_form P \<and> (\<forall> p1. P p1 p1)"

  lemma monotonicity_sinvar_mono: "sinvar_all_edges_normal_form P \<Longrightarrow> sinvar_mono"
  unfolding sinvar_all_edges_normal_form_def sinvar_mono_def
  by auto

end

subsubsection {* Offending Flows*}

context SecurityInvariant_withOffendingFlows
begin

  text{*The insight: for all edges in the members of the offending flows, @{term "\<not> P"} holds.*}
  lemma ENF_offending_imp_not_P:
    assumes "sinvar_all_edges_normal_form P" "F \<in> set_offending_flows G nP" "(e1, e2) \<in> F"
    shows "\<not> P (nP e1) (nP e2)"
  using assms
  unfolding sinvar_all_edges_normal_form_def set_offending_flows_def is_offending_flows_min_set_def is_offending_flows_def
  by (fastforce simp: graph_ops)

  text{*Hence, the members of @{const set_offending_flows} must look as follows. *}
  lemma ENF_offending_set_P_representation:
    assumes "sinvar_all_edges_normal_form P" "F \<in> set_offending_flows G nP"
    shows "F = {(e1,e2). (e1, e2) \<in> edges G \<and> \<not> P (nP e1) (nP e2)}" (is "F = ?E")
  proof -
    { fix a b
      assume "(a, b) \<in> F"
      hence "(a, b) \<in> ?E"
        using assms
        by (auto simp: set_offending_flows_def ENF_offending_imp_not_P)
    }
    moreover
    { fix x
      assume "x \<in> ?E"
      hence "x \<in> F"
        using assms
        unfolding sinvar_all_edges_normal_form_def set_offending_flows_def is_offending_flows_min_set_def
        by (fastforce simp: is_offending_flows_def graph_ops)
    }
    ultimately show ?thesis
      by blast
  qed

  text{* We can show left to right of the desired representation of @{const set_offending_flows}*}
  lemma ENF_offending_subseteq_lhs:
    assumes "sinvar_all_edges_normal_form P"
    shows "set_offending_flows G nP \<subseteq> { {(e1,e2). (e1, e2) \<in> edges G \<and> \<not> P (nP e1) (nP e2)} }"
  using assms
  by (force simp: ENF_offending_set_P_representation)

  text{* if @{const set_offending_flows} is not empty, we have the other direction. *}
  lemma ENF_offending_not_empty_imp_ENF_offending_subseteq_rhs:
    assumes "sinvar_all_edges_normal_form P" "set_offending_flows G nP \<noteq> {}"
    shows "{ {(e1,e2) \<in> edges G. \<not> P (nP e1) (nP e2)} } \<subseteq> set_offending_flows G nP"
  using assms ENF_offending_set_P_representation
  by blast

  lemma ENF_notevalmodel_imp_offending_not_empty:
  "sinvar_all_edges_normal_form P \<Longrightarrow> \<not> sinvar G nP \<Longrightarrow> set_offending_flows G nP \<noteq> {}"
    (*TODO get easier from monotonicity? but would require valid graph assumption ...*)
    proof -
      assume enf: "sinvar_all_edges_normal_form P"
      and ns: "\<not> sinvar G nP"

      {
        let ?F'="{(e1,e2) \<in> (edges G). \<not>P (nP e1) (nP e2)}"
        -- {* select @{term "?F'"} as the list of all edges which violate @{term "P"} *}

        from enf have ENF_notevalmodel_offending_imp_ex_offending_min:
            "\<And>F. is_offending_flows F G nP \<Longrightarrow> F \<subseteq> edges G \<Longrightarrow>
             \<exists>F'. F' \<subseteq> edges G \<and> is_offending_flows_min_set F' G nP"
          unfolding sinvar_all_edges_normal_form_def is_offending_flows_min_set_def is_offending_flows_def
          by (-) (rule exI[where x="?F'"], fastforce simp: graph_ops)

        from enf ns have "\<exists>F. F \<subseteq> (edges G) \<and> is_offending_flows F G nP"
          unfolding sinvar_all_edges_normal_form_def is_offending_flows_def
          by (-) (rule exI[where x="?F'"], fastforce simp: graph_ops)

        from enf ns this ENF_notevalmodel_offending_imp_ex_offending_min have ENF_notevalmodel_imp_ex_offending_min:
          "\<exists>F. F \<subseteq> edges G \<and> is_offending_flows_min_set F G nP" by blast
        } note ENF_notevalmodel_imp_ex_offending_min=this

      from ENF_notevalmodel_imp_ex_offending_min show "set_offending_flows G nP \<noteq> {}" using set_offending_flows_def by simp
    qed

  lemma ENF_offending_case1:
    "\<lbrakk> sinvar_all_edges_normal_form P;  \<not> sinvar G nP \<rbrakk> \<Longrightarrow>
    { {(e1,e2). (e1, e2) \<in> (edges G) \<and> \<not> P (nP e1) (nP e2)} } = set_offending_flows G nP"
    apply(rule)
     apply(frule ENF_notevalmodel_imp_offending_not_empty, simp)
     apply(rule ENF_offending_not_empty_imp_ENF_offending_subseteq_rhs, simp)
     apply simp
    apply(rule ENF_offending_subseteq_lhs)
    apply simp
  done

  lemma ENF_offending_case2:
    "\<lbrakk> sinvar_all_edges_normal_form P; sinvar G nP \<rbrakk> \<Longrightarrow>
    {} = set_offending_flows G nP"
    apply(drule sinvar_no_offending[of G nP])
    apply simp
  done

  theorem ENF_offending_set:
    "\<lbrakk> sinvar_all_edges_normal_form P \<rbrakk> \<Longrightarrow>
    set_offending_flows G nP = (if sinvar G nP then
      {}
     else
      { {(e1,e2). (e1, e2) \<in> edges G \<and> \<not> P (nP e1) (nP e2)} })"
  by(simp add: ENF_offending_case1 ENF_offending_case2)
end

subsubsection {* Lemmata *}

  lemma (in SecurityInvariant_withOffendingFlows)  ENF_offending_members:
    "\<lbrakk> \<not> sinvar G nP; sinvar_all_edges_normal_form P; f \<in> set_offending_flows G nP\<rbrakk> \<Longrightarrow>
    f \<subseteq> (edges G) \<and> (\<forall> (e1, e2)\<in> f. \<not> P (nP e1) (nP e2))"
  by(auto simp add: ENF_offending_set)

subsubsection {* Instance Helper *}

  lemma (in SecurityInvariant_withOffendingFlows) ENF_refl_not_offedning:
        "\<lbrakk> \<not> sinvar G nP; f \<in> set_offending_flows G nP;
          ENF_refl P\<rbrakk> \<Longrightarrow>
          \<forall>(e1,e2) \<in> f. e1 \<noteq> e2"
  proof -
  assume a_not_eval: "\<not> sinvar G nP"
    and   a_enf_refl: "ENF_refl P"
    and   a_offedning: "f \<in> set_offending_flows G nP"

    from a_enf_refl have a_enf: "sinvar_all_edges_normal_form P" using ENF_refl_def by simp
    hence a_ENF: "\<And> G nP. sinvar G nP  = (\<forall> (e1, e2) \<in> edges G. P (nP e1) (nP e2))" using sinvar_all_edges_normal_form_def by simp

    from a_enf_refl ENF_refl_def have a_refl: "\<forall> (e1,e1) \<in> f. P (nP e1) (nP e1)" by simp
    from ENF_offending_members[OF a_not_eval a_enf a_offedning] have "\<forall> (e1, e2) \<in> f. \<not> P (nP e1) (nP e2)" by fast
    from this a_refl show "\<forall>(e1,e2) \<in> f. e1 \<noteq> e2" by fast
  qed

  lemma (in SecurityInvariant_withOffendingFlows) ENF_default_update_fst:
  fixes "default_node_properties" :: "'a" ("\<bottom>")
  assumes modelInv: "\<not> sinvar G nP"
    and   ENFdef: "sinvar_all_edges_normal_form P"
    and   secdef: "\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> (P (nP e1) (nP e2)) \<longrightarrow> \<not> (P \<bottom> (nP e2))"
  shows
    "\<not> (\<forall> (e1, e2) \<in> edges G. P ((nP(i := \<bottom>)) e1) (nP e2))"
  proof -
    from ENFdef have ENF: "\<And> G nP. sinvar G nP  = (\<forall> (e1, e2)\<in> edges G. P (nP e1) (nP e2))"
      using sinvar_all_edges_normal_form_def by simp
    from modelInv ENF have modelInv': "\<not> (\<forall> (e1, e2)\<in> edges G. P (nP e1) (nP e2))" by simp
    from this secdef have modelInv'': "\<not> (\<forall> (e1, e2)\<in> edges G. P \<bottom> (nP e2))" by blast
      have simpUpdateI: "\<And> e1 e2. \<not> P (nP e1) (nP e2) \<Longrightarrow> \<not> P \<bottom> (nP e2) \<Longrightarrow> \<not> P ((nP(i := \<bottom>)) e1) (nP e2)" by simp
      hence "\<And> X. \<exists>(e1,e2) \<in> X. \<not> P (nP e1) (nP e2) \<Longrightarrow> \<exists>(e1,e2) \<in> X.\<not> P \<bottom> (nP e2) \<Longrightarrow> \<exists>(e1,e2) \<in> X.\<not> P ((nP(i := \<bottom>)) e1) (nP e2)"
        using secdef by blast
    from this modelInv' modelInv'' show "\<not> (\<forall> (e1, e2) \<in> edges G. P ((nP(i := \<bottom>)) e1) (nP e2))" by blast
  qed

  lemma (in SecurityInvariant_withOffendingFlows)
    fixes "default_node_properties" :: "'a" ("\<bottom>")
    shows "\<not> sinvar G nP \<Longrightarrow> sinvar_all_edges_normal_form P \<Longrightarrow>
    (\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> (P (nP e1) (nP e2)) \<longrightarrow>  \<not> (P \<bottom> (nP e2))) \<Longrightarrow>
    (\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> (P (nP e1) (nP e2)) \<longrightarrow> \<not> (P (nP e1) \<bottom>)) \<Longrightarrow>
    (\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> P \<bottom> \<bottom>)
    \<Longrightarrow> \<not> sinvar G (nP(i := \<bottom>))"
  proof -
    assume a1: "\<not> sinvar G nP"
    and   a2d: "sinvar_all_edges_normal_form P"
    and    a3: "\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> (P (nP e1) (nP e2)) \<longrightarrow> \<not> (P \<bottom> (nP e2))"
    and    a4: "\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> (P (nP e1) (nP e2)) \<longrightarrow> \<not> (P (nP e1) \<bottom>)"
    and    a5: "\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> P \<bottom> \<bottom>"

    from a2d have a2: "\<And> G nP. sinvar G nP  = (\<forall> (e1, e2) \<in> edges G. P (nP e1) (nP e2))"
      using sinvar_all_edges_normal_form_def by simp

    from ENF_default_update_fst[OF a1 a2d] a3 have subgoal1: "\<not> (\<forall> (e1, e2) \<in> edges G. P ((nP(i := \<bottom>)) e1) (nP e2))" by blast

    let ?nP' = "(nP(i := \<bottom>))"

    from subgoal1 have "\<exists> (e1, e2) \<in> edges G. \<not> P (?nP' e1) (nP e2)" by blast
    from this obtain e11 e21 where s1cond: "(e11, e21) \<in> edges G \<and> \<not> P (?nP' e11) (nP e21)" by blast

    from s1cond have "i \<noteq> e11 \<Longrightarrow> \<not> P (nP e11) (nP e21)" by simp
    from s1cond have "e11 \<noteq> e21 \<Longrightarrow> \<not> P (?nP' e11) (?nP' e21)"
      apply simp
      apply(rule conjI)
       apply blast
      apply(insert a4)
      by force
    from s1cond a4 fun_upd_apply have ex1: "e11 \<noteq> e21 \<Longrightarrow> \<not> P (?nP' e11) (?nP' e21)" by metis
    from s1cond a5 have ex2: "e11 = e21 \<Longrightarrow> \<not> P (?nP' e11) (?nP' e21)" by auto

    from ex1 ex2 s1cond have "\<exists> (e1, e2) \<in> edges G. \<not> P (?nP' e1) (?nP' e2)" by blast
    hence "\<not> (\<forall> (e1, e2) \<in> edges G. P ((nP(i := \<bottom>)) e1) ((nP(i := \<bottom>)) e2))" by fast
    from this a2 show "\<not> sinvar G (nP(i := \<bottom>))" by presburger
  qed

  (* fsts version *)
  lemma (in SecurityInvariant_withOffendingFlows)  ENF_fsts_refl_instance:
    fixes "default_node_properties" :: "'a" ("\<bottom>")
    assumes a_enf_refl: "ENF_refl P"
    and   a3: "\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> (P (nP e1) (nP e2)) \<longrightarrow> \<not> (P \<bottom> (nP e2))" (*changed \<And> to \<forall>*)
    and   a_offending: "f \<in> set_offending_flows G nP"
    and   a_i_fsts: "i \<in> fst ` f"
    shows
          "\<not> sinvar G (nP(i := \<bottom>))"
  proof -
    from a_offending have a_not_eval: "\<not> sinvar G nP" by (metis equals0D sinvar_no_offending)
    from valid_without_offending_flows[OF a_offending] have a_offending_rm: "sinvar (delete_edges G f) nP" .

    from a_enf_refl have a_enf: "sinvar_all_edges_normal_form P" using ENF_refl_def by simp
    hence a2: "\<And> G nP. sinvar G nP  = (\<forall> (e1, e2) \<in> edges G. P (nP e1) (nP e2))" using sinvar_all_edges_normal_form_def by simp

    from ENF_offending_members[OF a_not_eval a_enf a_offending] have a_f_3_in_f: "\<And> e1 e2. (e1, e2) \<in> f \<Longrightarrow> \<not> P (nP e1) (nP e2)" by fast

    let ?nP' = "(nP(i := \<bottom>))"

    (* obain from f *)
    from offending_not_empty[OF a_offending] ENF_offending_members[OF a_not_eval a_enf a_offending] a_i_fsts hd_in_set
      obtain e1 e2 where e1e2cond: "(e1, e2) \<in> f \<and> e1 = i" by force

    from conjunct1[OF e1e2cond] a_f_3_in_f have e1e2notP: "\<not> P (nP e1) (nP e2)" by simp
    from this a3 have "\<not> P \<bottom> (nP e2)" by simp
    from this e1e2notP have e1e2subgoal1: "\<not> P (?nP' e1) (nP e2)" by simp

    from ENF_refl_not_offedning[OF a_not_eval a_offending a_enf_refl] conjunct1[OF e1e2cond] have ENF_refl: "e1 \<noteq> e2" by fast

    from e1e2subgoal1 have "e1 \<noteq> e2 \<Longrightarrow> \<not> P (?nP' e1) (?nP' e2)"
      apply simp
      apply(rule conjI)
       apply blast
      apply(insert conjunct2[OF e1e2cond])
      by simp

    from this ENF_refl ENF_offending_members[OF a_not_eval a_enf a_offending]  conjunct1[OF e1e2cond] have
      "\<exists> (e1, e2) \<in> edges G. \<not> P (?nP' e1) (?nP' e2)" by blast
    hence "\<not> (\<forall> (e1, e2) \<in> edges G. P ((nP(i := \<bottom>)) e1) ((nP(i := \<bottom>)) e2))" by fast
    from this a2 show "\<not> sinvar G (nP(i := \<bottom>))" by presburger
  qed

  (* snds version *)
  lemma (in SecurityInvariant_withOffendingFlows)  ENF_snds_refl_instance:
    fixes "default_node_properties" :: "'a" ("\<bottom>")
    assumes a_enf_refl: "ENF_refl P"
    and   a3: "\<forall> (nP::'v \<Rightarrow> 'a) e1 e2. \<not> (P (nP e1) (nP e2)) \<longrightarrow> \<not> (P (nP e1) \<bottom>)"
    and   a_offending: "f \<in> set_offending_flows G nP"
    and   a_i_snds: "i \<in> snd ` f"
    shows
          "\<not> sinvar G (nP(i := \<bottom>))"
  proof -
    from a_offending have a_not_eval: "\<not> sinvar G nP" by (metis equals0D sinvar_no_offending)
    from valid_without_offending_flows[OF a_offending] have a_offending_rm: "sinvar (delete_edges G f) nP" .
    from a_enf_refl have a_enf: "sinvar_all_edges_normal_form P" using ENF_refl_def by simp
    hence a2: "\<And> G nP. sinvar G nP  = (\<forall> (e1, e2) \<in> edges G. P (nP e1) (nP e2))" using sinvar_all_edges_normal_form_def by simp

    from ENF_offending_members[OF a_not_eval a_enf a_offending] have a_f_3_in_f: "\<And> e1 e2. (e1, e2) \<in> f \<Longrightarrow> \<not> P (nP e1) (nP e2)" by fast

    let ?nP' = "(nP(i := \<bottom>))"

    (* obain from f *)
    from offending_not_empty[OF a_offending] ENF_offending_members[OF a_not_eval a_enf a_offending] a_i_snds hd_in_set
      obtain e1 e2 where e1e2cond: "(e1, e2) \<in> f \<and> e2 = i" by force

    from conjunct1[OF e1e2cond] a_f_3_in_f have e1e2notP: "\<not> P (nP e1) (nP e2)" by simp
    from this a3 have "\<not> P (nP e1) \<bottom>" by auto
    from this e1e2notP have e1e2subgoal1: "\<not> P (nP e1) (?nP' e2)" by simp

    from ENF_refl_not_offedning[OF a_not_eval a_offending a_enf_refl] e1e2cond have ENF_refl: "e1 \<noteq> e2" by fast

    from e1e2subgoal1 have "e1 \<noteq> e2 \<Longrightarrow> \<not> P (?nP' e1) (?nP' e2)"
      apply simp
      apply(rule conjI)
       apply(insert conjunct2[OF e1e2cond])
       by simp_all

    from this ENF_refl e1e2cond ENF_offending_members[OF a_not_eval a_enf a_offending]  conjunct1[OF e1e2cond] have
      "\<exists> (e1, e2) \<in> edges G. \<not> P (?nP' e1) (?nP' e2)" by blast
    hence "\<not> (\<forall> (e1, e2) \<in> edges G. P ((nP(i := \<bottom>)) e1) ((nP(i := \<bottom>)) e2))" by fast
    from this a2 show "\<not> sinvar G (nP(i := \<bottom>))" by presburger
  qed

(*ENF_sr*)

subsection {* edges normal form ENF with sender and receiver names *}
  definition (in SecurityInvariant_withOffendingFlows) sinvar_all_edges_normal_form_sr :: "('a \<Rightarrow> 'v \<Rightarrow> 'a \<Rightarrow> 'v \<Rightarrow> bool) \<Rightarrow> bool" where
    "sinvar_all_edges_normal_form_sr P \<equiv> \<forall> G nP. sinvar G nP = (\<forall> (s, r)\<in> edges G. P (nP s) s (nP r) r)"

  lemma (in SecurityInvariant_withOffendingFlows) ENFsr_monotonicity_sinvar_mono: "\<lbrakk> sinvar_all_edges_normal_form_sr P \<rbrakk> \<Longrightarrow>
    sinvar_mono"
    apply(simp add: sinvar_all_edges_normal_form_sr_def sinvar_mono_def)
    by blast

subsubsection {*Offending Flows:*}

  theorem (in SecurityInvariant_withOffendingFlows) ENFsr_offending_set:
    assumes ENFsr: "sinvar_all_edges_normal_form_sr P"
    shows "set_offending_flows G nP = (if sinvar G nP then
      {}
     else
      { {(s,r). (s, r) \<in> edges G \<and> \<not> P (nP s) s (nP r) r} })" (is "?A = ?B")
  proof(cases "sinvar G nP")
  case True thus "?A = ?B"
    by(simp add: set_offending_flows_def is_offending_flows_min_set_def is_offending_flows_def)
  next
  case False
   from ENFsr have ENFsr_offending_imp_not_P: "\<And> F s r. F \<in> set_offending_flows G nP \<Longrightarrow> (s, r) \<in> F  \<Longrightarrow> \<not> P (nP s) s (nP r) r"
     unfolding sinvar_all_edges_normal_form_sr_def
     apply(simp add: set_offending_flows_def is_offending_flows_def is_offending_flows_min_set_def graph_ops)
     apply clarify
     by fastforce
   from ENFsr have  ENFsr_offending_set_P_representation:
    "\<And> F. F \<in> set_offending_flows G nP  \<Longrightarrow> F = {(s,r). (s, r) \<in> edges G \<and> \<not> P (nP s) s (nP r) r}"
      apply -
      apply rule
       apply rule
       apply clarify
       apply(rename_tac a b)
       apply rule
        apply(auto simp add:set_offending_flows_def)[1]
       apply(simp add: ENFsr_offending_imp_not_P)
      unfolding sinvar_all_edges_normal_form_sr_def
      apply(simp add:set_offending_flows_def is_offending_flows_def is_offending_flows_min_set_def graph_ops)
      apply clarify
      apply(rename_tac a b a1 b1)
      apply(blast)
    done

    from ENFsr False have ENFsr_offending_flows_exist: "set_offending_flows G nP \<noteq> {}"
      apply(simp add: set_offending_flows_def is_offending_flows_min_set_def is_offending_flows_def sinvar_all_edges_normal_form_sr_def
            delete_edges_def add_edge_def)
      apply(clarify)
      apply(rename_tac s r)
      apply(rule_tac x="{(s,r). (s,r) \<in> (edges G) \<and> \<not>P (nP s) s (nP r) r}" in exI)
      apply(simp)
      by blast

    from ENFsr have ENFsr_offenindg_not_empty_imp_ENF_offending_subseteq_rhs:
      "set_offending_flows G nP \<noteq> {}  \<Longrightarrow>
      { {(s,r). (s, r) \<in> edges G \<and> \<not> P (nP s) s (nP r) r} } \<subseteq> set_offending_flows G nP"
      apply -
      apply rule
      using ENFsr_offending_set_P_representation
      by blast

    from ENFsr have ENFsr_offending_subseteq_lhs:
      "(set_offending_flows G nP) \<subseteq> { {(s,r). (s, r) \<in> edges G \<and> \<not> P (nP s) s (nP r) r} }"
      apply -
      apply rule
      by(simp add: ENFsr_offending_set_P_representation)

    from False ENFsr_offenindg_not_empty_imp_ENF_offending_subseteq_rhs[OF ENFsr_offending_flows_exist] ENFsr_offending_subseteq_lhs show "?A = ?B"
      by force
  qed

(*ENFnrSR*)

subsection {* edges normal form not refl ENFnrSR *}
  definition (in SecurityInvariant_withOffendingFlows) sinvar_all_edges_normal_form_not_refl_SR :: "('a \<Rightarrow> 'v \<Rightarrow> 'a \<Rightarrow> 'v \<Rightarrow> bool) \<Rightarrow> bool" where
    "sinvar_all_edges_normal_form_not_refl_SR P \<equiv>
    \<forall> G nP. sinvar G nP = (\<forall> (s, r) \<in> edges G. s \<noteq> r \<longrightarrow> P (nP s) s (nP r) r)"

  text{* we derive everything from the ENFnrSR form *}
  lemma (in SecurityInvariant_withOffendingFlows) ENFnrSR_to_ENFsr:
    "sinvar_all_edges_normal_form_not_refl_SR P \<Longrightarrow> sinvar_all_edges_normal_form_sr (\<lambda> p1 v1 p2 v2. v1 \<noteq> v2 \<longrightarrow> P p1 v1 p2 v2)"
    by(simp add: sinvar_all_edges_normal_form_sr_def sinvar_all_edges_normal_form_not_refl_SR_def)

subsubsection {*Offending Flows*}

subsubsection {* Instance helper*}

  (* fsts version *)
  lemma (in SecurityInvariant_withOffendingFlows)  ENFnrSR_fsts_weakrefl_instance:
    fixes "default_node_properties" :: "'a" ("\<bottom>")
    assumes a_enf: "sinvar_all_edges_normal_form_not_refl_SR P"
    and   a_weakrefl: "\<forall> s r. P \<bottom> s \<bottom> r"
    and   a_botdefault: "\<forall> s r. (nP r) \<noteq> \<bottom> \<longrightarrow> \<not> P (nP s) s (nP r) r \<longrightarrow> \<not> P \<bottom> s (nP r) r"
    and   a_alltobot: "\<forall> s r. P (nP s) s \<bottom> r"
    and   a_offending: "f \<in> set_offending_flows G nP"
    and   a_i_fsts: "i \<in> fst` f"
    shows
          "\<not> sinvar G (nP(i := \<bottom>))"
  proof -
    from a_offending have a_not_eval: "\<not> sinvar G nP" by (metis ex_in_conv sinvar_no_offending)
    from valid_without_offending_flows[OF a_offending] have a_offending_rm: "sinvar (delete_edges G f) nP" .
    from a_enf have a_enf': "\<And> G nP. sinvar G nP  = (\<forall> (e1, e2)\<in> (edges G). e1 \<noteq> e2 \<longrightarrow> P (nP e1) e1 (nP e2) e2)"
      using sinvar_all_edges_normal_form_not_refl_SR_def by simp

    from ENFnrSR_offending_set[OF a_enf] a_not_eval a_offending have a_f_3_in_f: "\<And> e1 e2. (e1, e2)\<in>f \<Longrightarrow> \<not> P (nP e1) e1 (nP e2) e2" by(simp)
    from ENFnrSR_offending_set[OF a_enf] a_not_eval a_offending have a_f_3_neq: "\<And> e1 e2. (e1, e2)\<in>f \<Longrightarrow> e1 \<noteq> e2" by simp

    let ?nP' = "(nP(i := \<bottom>))"

    from ENFnrSR_offending_set[OF a_enf] a_not_eval a_offending a_i_fsts
      obtain e1 e2 where e1e2cond: "(e1, e2) \<in> f \<and> e1 = i" by fastforce

    from conjunct1[OF e1e2cond] a_offending have "(e1, e2) \<in> edges G"
      by (metis (lifting, no_types) SecurityInvariant_withOffendingFlows.set_offending_flows_def mem_Collect_eq set_rev_mp)

    from conjunct1[OF e1e2cond] a_f_3_in_f have e1e2notP: "\<not> P (nP e1) e1 (nP e2) e2" by simp
    from e1e2notP a_weakrefl have e1ore2neqbot: "(nP e1) \<noteq> \<bottom> \<or> (nP e2) \<noteq> \<bottom>" by fastforce
    from e1e2notP a_alltobot have "(nP e2) \<noteq> \<bottom>" by fastforce
    from this e1e2notP a_botdefault have "\<not> P \<bottom> e1 (nP e2) e2" by simp
    from this e1e2notP have e1e2subgoal1: "\<not> P (?nP' e1) e1 (nP e2) e2" by auto

    from a_f_3_neq e1e2cond have "e2 \<noteq> e1" by blast

    from e1e2subgoal1 have "e1 \<noteq> e2 \<Longrightarrow> \<not> P (?nP' e1) e1 (?nP' e2) e2"
      apply simp
      apply(rule conjI)
       apply blast
      apply(insert e1e2cond)
      by simp
    from this `e2 \<noteq> e1` have "\<not> P (?nP' e1) e1 (?nP' e2) e2" by simp

    from this `e2 \<noteq> e1` ENFnrSR_offending_set[OF a_enf] a_offending `(e1, e2) \<in> edges G` have
      "\<exists> (e1, e2)\<in>(edges G). e2 \<noteq> e1 \<and> \<not> P (?nP' e1) e1 (?nP' e2) e2" by blast
    hence "\<not> (\<forall> (e1, e2)\<in>(edges G). e2 \<noteq> e1 \<longrightarrow> P ((nP(i := \<bottom>)) e1) e1 ((nP(i := \<bottom>)) e2) e2)" by fast
    from this a_enf' show "\<not> sinvar G (nP(i := \<bottom>))" by fast
  qed

  (* snds version *)
  lemma (in SecurityInvariant_withOffendingFlows)  ENFnrSR_snds_weakrefl_instance:
    fixes "default_node_properties" :: "'a" ("\<bottom>")
    assumes a_enf: "sinvar_all_edges_normal_form_not_refl_SR P"
    and   a_weakrefl: "\<forall> s r. P \<bottom> s \<bottom> r"
    and   a_botdefault: "\<forall> s r. (nP s) \<noteq> \<bottom> \<longrightarrow> \<not> P (nP s) s (nP r) r \<longrightarrow> \<not> P (nP s) s \<bottom> r"
    and   a_bottoall: "\<forall> s r. P \<bottom> s (nP r) r"
    and   a_offending: "f \<in> set_offending_flows G nP"
    and   a_i_snds: "i \<in> snd` f"
    shows
          "\<not> sinvar G (nP(i := \<bottom>))"
  proof -
    from a_offending have a_not_eval: "\<not> sinvar G nP" by (metis equals0D sinvar_no_offending)
    from valid_without_offending_flows[OF a_offending] have a_offending_rm: "sinvar (delete_edges G f) nP" .
    from a_enf have a_enf': "\<And> G nP. sinvar G nP  = (\<forall> (e1, e2)\<in>(edges G). e1 \<noteq> e2 \<longrightarrow> P (nP e1) e1 (nP e2) e2)"
      using sinvar_all_edges_normal_form_not_refl_SR_def by simp

    from ENFnrSR_offending_set[OF a_enf] a_not_eval a_offending have a_f_3_in_f: "\<And> s r. (s, r)\<in>f \<Longrightarrow> \<not> P (nP s) s (nP r) r" by simp
    from ENFnrSR_offending_set[OF a_enf] a_not_eval a_offending have a_f_3_neq: "\<And> s r. (s, r)\<in>f \<Longrightarrow> s \<noteq> r" by simp

    let ?nP' = "(nP(i := \<bottom>))"

    from ENFnrSR_offending_set[OF a_enf] a_not_eval a_offending a_i_snds
      obtain e1 e2 where e1e2cond: "(e1, e2)\<in>f \<and> e2 = i" by fastforce

    from conjunct1[OF e1e2cond] a_offending have "(e1, e2) \<in> edges G"
      by (metis (lifting, no_types) SecurityInvariant_withOffendingFlows.set_offending_flows_def mem_Collect_eq set_rev_mp)

    from conjunct1[OF e1e2cond] a_f_3_in_f have e1e2notP: "\<not> P (nP e1) e1 (nP e2) e2" by simp
    from e1e2notP a_weakrefl have e1ore2neqbot: "(nP e1) \<noteq> \<bottom> \<or> (nP e2) \<noteq> \<bottom>" by fastforce
    from e1e2notP a_bottoall have x1: "(nP e1) \<noteq> \<bottom>" by fastforce
    from this e1e2notP a_botdefault have x2: "\<not> P (nP e1) e1 \<bottom> e2" by fast
    from this e1e2notP have e1e2subgoal1: "\<not> P (nP e1) e1 (?nP' e2) e2" by auto

    from a_f_3_neq e1e2cond have "e2 \<noteq> e1" by blast

    from e1e2subgoal1 have "e1 \<noteq> e2 \<Longrightarrow> \<not> P (?nP' e1) e1 (?nP' e2) e2" by(simp add: e1e2cond)

    from this `e2 \<noteq> e1` ENFnrSR_offending_set[OF a_enf] a_offending `(e1, e2) \<in> edges G` have
      "\<exists> (e1, e2)\<in>(edges G). e2 \<noteq> e1 \<and> \<not> P (?nP' e1) e1 (?nP' e2) e2" by fastforce
    hence "\<not> (\<forall> (e1, e2)\<in>(edges G). e2 \<noteq> e1 \<longrightarrow> P ((nP(i := \<bottom>)) e1) e1 ((nP(i := \<bottom>)) e2) e2)" by fast
    from this a_enf' show "\<not> sinvar G (nP(i := \<bottom>))" by fast
  qed

(*ENFnr*)

subsection {* edges normal form not refl ENFnr *}
  definition (in SecurityInvariant_withOffendingFlows) sinvar_all_edges_normal_form_not_refl :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool" where
    "sinvar_all_edges_normal_form_not_refl P \<equiv> \<forall> G nP. sinvar G nP = (\<forall> (e1, e2) \<in> edges G. e1 \<noteq> e2 \<longrightarrow> P (nP e1) (nP e2))"

  text{* we derive everything from the ENFnrSR form *}
  lemma (in SecurityInvariant_withOffendingFlows) ENFnr_to_ENFnrSR:
    "sinvar_all_edges_normal_form_not_refl P \<Longrightarrow> sinvar_all_edges_normal_form_not_refl_SR (\<lambda> v1 _ v2 _. P v1 v2)"
    by(simp add: sinvar_all_edges_normal_form_not_refl_def sinvar_all_edges_normal_form_not_refl_SR_def)

  (*most of results are now implied from previous lemma*)

subsubsection {*Offending Flows*}
   theorem (in SecurityInvariant_withOffendingFlows) ENFnr_offending_set:
    "\<lbrakk> sinvar_all_edges_normal_form_not_refl P \<rbrakk> \<Longrightarrow>
    set_offending_flows G nP = (if sinvar G nP then
      {}
     else
      { {(e1,e2). (e1, e2) \<in> edges G \<and> e1 \<noteq> e2 \<and> \<not> P (nP e1) (nP e2)} })"
    apply(drule ENFnr_to_ENFnrSR)
    by(drule(1) ENFnrSR_offending_set)

subsubsection {* Instance helper*}
  (* fsts version *)
  lemma (in SecurityInvariant_withOffendingFlows)  ENFnr_fsts_weakrefl_instance:
    fixes "default_node_properties" :: "'a" ("\<bottom>")
    assumes a_enf: "sinvar_all_edges_normal_form_not_refl P"
    and   a_botdefault: "\<forall> e1 e2. e2 \<noteq> \<bottom> \<longrightarrow> \<not> P e1 e2 \<longrightarrow> \<not> P \<bottom> e2"
    and   a_alltobot: "\<forall> e1. P e1 \<bottom>"
    and   a_offending: "f \<in> set_offending_flows G nP"
    and   a_i_fsts: "i \<in> fst` f"
    shows
          "\<not> sinvar G (nP(i := \<bottom>))"
  proof -
    from assms show ?thesis
    apply -
    apply(drule ENFnr_to_ENFnrSR)
    apply(drule ENFnrSR_fsts_weakrefl_instance)
         by auto
  qed

  (* snds version *)
  lemma (in SecurityInvariant_withOffendingFlows)  ENFnr_snds_weakrefl_instance:
    fixes "default_node_properties" :: "'a" ("\<bottom>")
    assumes a_enf: "sinvar_all_edges_normal_form_not_refl P"
    and   a_botdefault: "\<forall> e1 e2. \<not> P e1 e2 \<longrightarrow> \<not> P e1 \<bottom>"
    and   a_bottoall: "\<forall> e2. P \<bottom> e2"
    and   a_offending: "f \<in> set_offending_flows G nP"
    and   a_i_snds: "i \<in> snd` f"
    shows
          "\<not> sinvar G (nP(i := \<bottom>))"
  proof -
    from assms show ?thesis
    apply -
    apply(drule ENFnr_to_ENFnrSR)
    apply(drule ENFnrSR_snds_weakrefl_instance)
         by auto
  qed

  (* snds version DRAFT*)
  lemma (in SecurityInvariant_withOffendingFlows)  ENF_weakrefl_instance_FALSE:
    fixes "default_node_properties" :: "'a" ("\<bottom>")
    assumes a_wfG: "wf_graph G"
    and   a_not_eval: "\<not> sinvar G nP"
    and   a_enf: "sinvar_all_edges_normal_form P"
    and   a_weakrefl: "P \<bottom> \<bottom>"
    and   a_botisolated: "\<And> e2. e2 \<noteq> \<bottom> \<Longrightarrow> \<not> P \<bottom> e2"
    and   a_botdefault: "\<And> e1 e2. e1 \<noteq> \<bottom> \<Longrightarrow> \<not> P e1 e2 \<Longrightarrow> \<not> P e1 \<bottom>"
    and   a_offending: "f \<in> set_offending_flows G nP"
    and   a_offending_rm: "sinvar (delete_edges G f) nP"
    and   a_i_fsts: "i \<in> snd` f"
    and   a_not_eval_upd: "\<not> sinvar G (nP(i := \<bottom>))"
    shows "False"
oops

end


section \<open>Isomorphism between Finite Fields\label{sec:uniqueness}\<close>

theory Finite_Fields_Isomorphic
  imports
    Card_Irreducible_Polynomials
begin

lemma (in finite_field) eval_on_root_is_iso:
  defines "p \<equiv> char R"
  assumes "f \<in> carrier (poly_ring (ZFact p))"
  assumes "pirreducible\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f"
  assumes "order R = p^degree f"
  assumes "x \<in> carrier R"
  assumes "eval (map (char_iso R) f) x = \<zero>"
  shows "ring_hom_ring (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R
    (\<lambda>g. the_elem ((\<lambda>g'. eval (map (char_iso R) g') x) ` g))"
proof -
  let ?P = "poly_ring (ZFact p)"

  have char_pos: "char R > 0"
    using finite_carr_imp_char_ge_0[OF finite_carrier] by simp

  have p_prime: "Factorial_Ring.prime p"
    unfolding p_def
    using characteristic_is_prime[OF char_pos] by simp

  interpret zf: finite_field "ZFact p"
    using zfact_prime_is_finite_field p_prime by simp
  interpret pzf: principal_domain "poly_ring (ZFact p)"
    using zf.univ_poly_is_principal[OF zf.carrier_is_subfield] by simp

  interpret i: ideal "(PIdl\<^bsub>?P\<^esub> f)" "?P"
    by (intro pzf.cgenideal_ideal assms(2))
  have rupt_carr: "y \<subseteq> carrier (poly_ring (ZFact p))"
    if "y \<in> carrier (Rupt\<^bsub>ZFact p\<^esub> (carrier (ZFact p)) f)" for y
    using that pzf.quot_carr i.ideal_axioms by (simp add:rupture_def)

  have rupt_is_ring: "ring (Rupt\<^bsub>ZFact p\<^esub> (carrier (ZFact p)) f)"
    unfolding rupture_def by (intro i.quotient_is_ring)

  have "map (char_iso R) \<in>
    ring_iso ?P (poly_ring (R\<lparr>carrier := char_subring R\<rparr>))"
    using lift_iso_to_poly_ring[OF char_iso] zf.domain_axioms
    using char_ring_is_subdomain subdomain_is_domain
    by (simp add:p_def)
  moreover have "(char_subring R)[X] =
    poly_ring (R \<lparr>carrier := char_subring R\<rparr>)"
    using univ_poly_consistent[OF char_ring_is_subring] by simp
  ultimately have
    "map (char_iso R) \<in> ring_hom ?P ((char_subring R)[X])"
    by (simp add:ring_iso_def)
  moreover have "(\<lambda>p. eval p x) \<in> ring_hom ((char_subring R)[X]) R"
    using eval_is_hom char_ring_is_subring assms(5) by simp
  ultimately have
    "(\<lambda>p. eval p x) \<circ> map (char_iso R) \<in> ring_hom ?P R"
    using ring_hom_trans by blast
  hence a:"(\<lambda>p. eval (map (char_iso R) p) x) \<in> ring_hom ?P R"
    by (simp add:comp_def)
  interpret h:ring_hom_ring "?P" "R" "(\<lambda>p. eval (map (char_iso R) p) x)"
    by (intro ring_hom_ringI2 pzf.ring_axioms a ring_axioms)

  let ?h = "(\<lambda>p. eval (map (char_iso R) p) x)"
  let ?J = "a_kernel (poly_ring (ZFact (int p))) R ?h"

  have "?h ` a_kernel (poly_ring (ZFact (int p))) R ?h \<subseteq> {\<zero>}"
    by auto
  moreover have
    "\<zero>\<^bsub>?P\<^esub> \<in> a_kernel (poly_ring (ZFact (int p))) R ?h"
    "?h \<zero>\<^bsub>?P\<^esub> = \<zero>"
    unfolding a_kernel_def' by simp_all
  hence "{\<zero>} \<subseteq> ?h ` a_kernel (poly_ring (ZFact (int p))) R ?h"
    by simp
  ultimately have c:
    "?h ` a_kernel (poly_ring (ZFact (int p))) R ?h = {\<zero>}"
    by auto

  have d: "PIdl\<^bsub>?P\<^esub> f \<subseteq> a_kernel ?P R ?h"
  proof (rule subsetI)
    fix y assume "y \<in> PIdl\<^bsub>?P\<^esub> f"
    then obtain y' where y'_def: "y' \<in> carrier ?P" "y = y' \<otimes>\<^bsub>?P\<^esub> f"
      unfolding cgenideal_def by auto
    have "?h y = ?h (y' \<otimes>\<^bsub>?P\<^esub> f)" by (simp add:y'_def)
    also have "... = ?h y' \<otimes> ?h f"
      using y'_def assms(2) by simp
    also have "... = ?h y' \<otimes> \<zero>"
      using assms(6) by simp
    also have "... = \<zero>"
      using y'_def by simp
    finally have "?h y = \<zero>" by simp
    moreover have "y \<in> carrier ?P" using y'_def assms(2) by simp
    ultimately show "y \<in> a_kernel ?P R ?h"
      unfolding a_kernel_def kernel_def by simp
  qed

  have "(\<lambda>y. the_elem ((\<lambda>p. eval (map (char_iso R) p) x) ` y))
    \<in> ring_hom (?P Quot ?J) R"
    using h.the_elem_hom by simp
  moreover have "(\<lambda>y. ?J <+>\<^bsub>?P\<^esub> y)
    \<in> ring_hom (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) (?P Quot ?J)"
    unfolding rupture_def using h.kernel_is_ideal d assms(2)
    by (intro pzf.quot_quot_hom pzf.cgenideal_ideal) auto
  ultimately have "(\<lambda>y. the_elem (?h ` y)) \<circ> (\<lambda>y. ?J <+>\<^bsub>?P\<^esub> y)
    \<in> ring_hom (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R"
    using ring_hom_trans by blast
  hence b: "(\<lambda>y. the_elem (?h ` (?J <+>\<^bsub>?P\<^esub> y))) \<in>
    ring_hom (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R"
    by (simp add:comp_def)
  have "?h ` y = ?h ` (?J <+>\<^bsub>?P\<^esub> y)"
    if "y \<in> carrier (Rupt\<^bsub>ZFact p\<^esub> (carrier (ZFact p)) f)"
    for y
  proof -
    have y_range: "y \<subseteq> carrier ?P"
      using rupt_carr that by simp
    have "?h ` y = {\<zero>} <+>\<^bsub>R\<^esub> ?h ` y"
      using y_range h.hom_closed by (subst set_add_zero, auto)
    also have "... = ?h ` ?J <+>\<^bsub>R\<^esub> ?h ` y"
      by (subst c, simp)
    also have "... = ?h ` (?J <+>\<^bsub>?P\<^esub> y)"
      by (subst set_add_hom[OF a _ y_range], subst a_kernel_def') auto
    finally show ?thesis by simp
  qed
  hence "(\<lambda>y. the_elem (?h ` y)) \<in>
    ring_hom (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R"
    by (intro ring_hom_cong[OF _ rupt_is_ring b]) simp
  thus ?thesis
    by (intro ring_hom_ringI2 rupt_is_ring ring_axioms, simp)
qed

lemma (in domain) pdivides_consistent:
  assumes "subfield K R" "f \<in> carrier (K[X])" "g \<in> carrier (K[X])"
  shows "f pdivides g \<longleftrightarrow> f pdivides\<^bsub>R \<lparr> carrier := K \<rparr>\<^esub> g"
proof -
  have a:"subring K R"
    using assms(1) subfieldE(1) by auto
  let ?S = "R \<lparr> carrier := K \<rparr>"
  have "f pdivides g \<longleftrightarrow> f divides\<^bsub>K[X]\<^esub> g"
    using pdivides_iff_shell[OF assms] by simp
  also have "... \<longleftrightarrow> (\<exists>x \<in> carrier (K[X]). f \<otimes>\<^bsub>K[X]\<^esub> x = g)"
    unfolding pdivides_def factor_def by auto
  also have "... \<longleftrightarrow>
    (\<exists>x \<in> carrier (poly_ring ?S). f \<otimes>\<^bsub>poly_ring ?S\<^esub> x = g)"
    using univ_poly_consistent[OF a] by simp
  also have "... \<longleftrightarrow> f divides\<^bsub>poly_ring ?S\<^esub> g"
    unfolding pdivides_def factor_def by auto
  also have "... \<longleftrightarrow> f pdivides\<^bsub>?S\<^esub> g"
    unfolding pdivides_def by simp
  finally show ?thesis by simp
qed

lemma (in finite_field) find_root:
  assumes "subfield K R"
  assumes "monic_irreducible_poly (R \<lparr> carrier := K \<rparr>) f"
  assumes "order R = card K^degree f"
  obtains x where "eval f x = \<zero>" "x \<in> carrier R"
proof -
  define \<tau> :: "'a list \<Rightarrow> 'a list" where "\<tau> = id"
  let ?K = "R \<lparr> carrier := K \<rparr>"
  have "finite K"
    using assms(1) by (intro finite_subset[OF _ finite_carrier], simp)
  hence fin_K: "finite (carrier (?K))"
    by simp
  interpret f: finite_field "?K"
    using assms(1) subfield_iff fin_K finite_fieldI by blast
  have b:"subring K R"
    using assms(1) subfieldE(1) by blast
  interpret e: ring_hom_ring "(K[X])" "(poly_ring R)" "\<tau>"
    using embed_hom[OF b] by (simp add:\<tau>_def)

  have a: "card K^degree f > 1"
    using assms(3) finite_field_min_order by simp
  have "f \<in> carrier (poly_ring ?K)"
    using f.monic_poly_carr assms(2)
    unfolding monic_irreducible_poly_def by simp
  hence f_carr_2: "f \<in> carrier (K[X])"
    using univ_poly_consistent[OF b] by simp
  have f_carr: "f \<in> carrier (poly_ring R)"
    using e.hom_closed[OF f_carr_2] unfolding \<tau>_def by simp

  have gp_carr: "gauss_poly ?K (order ?K^degree f) \<in> carrier (K[X])"
    using f.gauss_poly_carr univ_poly_consistent[OF b] by simp

  have "gauss_poly ?K (order ?K^degree f) =
    gauss_poly ?K (card K^degree f)"
    by (simp add:Coset.order_def)
  also have "... =
    X\<^bsub>?K\<^esub> [^]\<^bsub>poly_ring ?K\<^esub> card K ^ degree f \<ominus>\<^bsub>poly_ring ?K\<^esub> X\<^bsub>?K\<^esub>"
    unfolding gauss_poly_def by simp
  also have "... = X\<^bsub>R\<^esub> [^]\<^bsub>K[X]\<^esub> card K ^ degree f  \<ominus>\<^bsub>K[X]\<^esub> X\<^bsub>R\<^esub>"
    unfolding var_def using univ_poly_consistent[OF b] by simp
  also have "... = \<tau> (X\<^bsub>R\<^esub> [^]\<^bsub>K[X]\<^esub> card K ^ degree f  \<ominus>\<^bsub>K[X]\<^esub> X\<^bsub>R\<^esub>)"
    unfolding \<tau>_def by simp
  also have "... = gauss_poly R (card K^degree f)"
    unfolding gauss_poly_def a_minus_def using var_closed[OF b]
    by (simp add:e.hom_nat_pow, simp add:\<tau>_def)
  finally have gp_consistent: "gauss_poly ?K (order ?K^degree f) =
    gauss_poly R (card K^degree f)"
    by simp

  have deg_f: "degree f > 0"
    using f.monic_poly_min_degree[OF assms(2)] by simp

  have "splitted f"
  proof (cases "degree f > 1")
    case True

    have "f pdivides\<^bsub>?K\<^esub> gauss_poly ?K (order ?K^degree f)"
      using f.div_gauss_poly_iff[OF deg_f assms(2)] by simp
    hence "f pdivides gauss_poly ?K (order ?K^degree f)"
      using pdivides_consistent[OF assms(1)] f_carr_2 gp_carr by simp
    hence "f pdivides gauss_poly R (card K^degree f)"
      using gp_consistent by simp
    moreover have "splitted (gauss_poly R (card K^degree f))"
      unfolding assms(3)[symmetric] using gauss_poly_splitted by simp
    moreover have "gauss_poly R (card K^degree f) \<noteq> []"
      using gauss_poly_not_zero a by (simp add: univ_poly_zero)
    ultimately show "splitted f"
      using pdivides_imp_splitted f_carr gauss_poly_carr by auto
  next
    case False
    hence "degree f = 1" using deg_f by simp
    thus ?thesis using f_carr degree_one_imp_splitted by auto
  qed
  hence "size (roots f) > 0"
    using deg_f unfolding splitted_def by simp
  then obtain x where x_def: "x \<in> carrier R" "is_root f x"
    using roots_mem_iff_is_root[OF f_carr]
    by (metis f_carr nonempty_has_size not_empty_rootsE)
  have "eval f x = \<zero>"
    using x_def is_root_def by blast
  thus ?thesis using x_def using that by simp
qed

lemma (in finite_field) find_iso_from_zfact:
  defines "p \<equiv> int (char R)"
  assumes "monic_irreducible_poly (ZFact p) f"
  assumes "order R = char R^degree f"
  shows "\<exists>\<phi>. \<phi> \<in> ring_iso (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R"
proof -
  have char_pos: "char R > 0"
    using finite_carr_imp_char_ge_0[OF finite_carrier] by simp

  interpret zf: finite_field "ZFact p"
    unfolding p_def using zfact_prime_is_finite_field
    using characteristic_is_prime[OF char_pos] by simp

  interpret zfp: polynomial_ring "ZFact p" "carrier (ZFact p)"
    unfolding polynomial_ring_def polynomial_ring_axioms_def
    using zf.field_axioms zf.carrier_is_subfield by simp

  let ?f' = "map (char_iso R) f"
  let ?F = "Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f"

  have "domain (R\<lparr>carrier := char_subring R\<rparr>)"
    using char_ring_is_subdomain subdomain_is_domain by simp

  hence "monic_irreducible_poly (R \<lparr> carrier := char_subring R \<rparr>) ?f'"
    using char_iso p_def zf.domain_axioms
    by (intro monic_irreducible_poly_hom[OF assms(2)]) auto
  moreover have "order R = card (char_subring R)^degree ?f'"
    using assms(3) unfolding char_def by simp
  ultimately obtain x where x_def: "eval ?f' x = \<zero>" "x \<in> carrier R"
    using find_root[OF char_ring_is_subfield[OF char_pos]] by blast
  let ?\<phi> = "(\<lambda>g. the_elem ((\<lambda>g'. eval (map (char_iso R) g') x) ` g))"
  interpret r: ring_hom_ring "?F" "R" "?\<phi>"
    using assms(2,3)
    unfolding monic_irreducible_poly_def monic_poly_def p_def
    by (intro eval_on_root_is_iso x_def, auto)
  have a:"?\<phi> \<in> ring_hom ?F R"
    using r.homh by auto

  have "field (Rupt\<^bsub>ZFact p\<^esub> (carrier (ZFact p)) f)"
    using assms(2)
    unfolding monic_irreducible_poly_def monic_poly_def
    by (subst zfp.rupture_is_field_iff_pirreducible, simp_all)
  hence b:"inj_on ?\<phi> (carrier ?F)"
    using non_trivial_field_hom_is_inj[OF a _ field_axioms] by simp

  have "card (?\<phi> ` carrier ?F) = order ?F"
    using card_image[OF b] unfolding Coset.order_def by simp
  also have "... =  card (carrier (ZFact p))^degree f"
    using assms(2) zf.monic_poly_min_degree[OF assms(2)]
    unfolding monic_irreducible_poly_def monic_poly_def
    by (intro zf.rupture_order[OF zf.carrier_is_subfield]) auto
  also have "... = char R ^degree f"
    unfolding p_def by (subst card_zfact_carr[OF char_pos], simp)
  also have "... = card (carrier R)"
    using assms(3) unfolding Coset.order_def by simp
  finally have "card (?\<phi> ` carrier ?F) = card (carrier R)" by simp
  moreover have "?\<phi> ` carrier ?F \<subseteq> carrier R"
    by (intro image_subsetI, simp)
  ultimately have "?\<phi> ` carrier ?F = carrier R"
    by (intro card_seteq finite_carrier, auto)
  hence "bij_betw ?\<phi> (carrier ?F) (carrier R)"
    using b bij_betw_imageI by auto

  thus ?thesis
    unfolding ring_iso_def using a b by auto
qed

theorem uniqueness:
  assumes "finite_field F\<^sub>1"
  assumes "finite_field F\<^sub>2"
  assumes "order F\<^sub>1 = order F\<^sub>2"
  shows "F\<^sub>1 \<simeq> F\<^sub>2"
proof -
  obtain n where o1: "order F\<^sub>1 = char F\<^sub>1^n" "n > 0"
    using finite_field.finite_field_order[OF assms(1)] by auto
  obtain m where o2: "order F\<^sub>2 = char F\<^sub>2^m" "m > 0"
    using finite_field.finite_field_order[OF assms(2)] by auto

  interpret f1: "finite_field" F\<^sub>1 using assms(1) by simp
  interpret f2: "finite_field" F\<^sub>2 using assms(2) by simp

  have char_pos: "char F\<^sub>1 > 0" "char F\<^sub>2 > 0"
    using f1.finite_carrier f1.finite_carr_imp_char_ge_0
    using f2.finite_carrier f2.finite_carr_imp_char_ge_0 by auto
  hence char_prime:
    "Factorial_Ring.prime (char F\<^sub>1)"
    "Factorial_Ring.prime (char F\<^sub>2)"
    using f1.characteristic_is_prime f2.characteristic_is_prime
    by auto

  have "char F\<^sub>1^n = char F\<^sub>2^m"
    using o1 o2 assms(3) by simp
  hence eq: "n = m" "char F\<^sub>1 = char F\<^sub>2"
    using char_prime char_pos o1(2) o2(2) prime_power_inj' by auto

  obtain p where p_def: "p = char F\<^sub>1" "p = char F\<^sub>2"
    using eq by simp

  have p_prime: "Factorial_Ring.prime p"
    unfolding p_def(1)
    using f1.characteristic_is_prime char_pos by simp

  interpret zf: finite_field "ZFact (int p)"
    using zfact_prime_is_finite_field p_prime o1(2)
    using prime_nat_int_transfer by blast

  interpret zfp: polynomial_ring "ZFact p" "carrier (ZFact p)"
    unfolding polynomial_ring_def polynomial_ring_axioms_def
    using zf.field_axioms zf.carrier_is_subfield by simp

  obtain f where f_def:
    "monic_irreducible_poly (ZFact (int p)) f" "degree f = n"
    using zf.exist_irred o1(2) by auto

  let ?F\<^sub>0  = "Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f"

  obtain \<phi>\<^sub>1 where \<phi>\<^sub>1_def: "\<phi>\<^sub>1 \<in> ring_iso ?F\<^sub>0 F\<^sub>1"
    using f1.find_iso_from_zfact f_def o1
    unfolding p_def by auto

  obtain \<phi>\<^sub>2 where \<phi>\<^sub>2_def: "\<phi>\<^sub>2 \<in> ring_iso ?F\<^sub>0 F\<^sub>2"
    using f2.find_iso_from_zfact f_def o2
    unfolding p_def(2) eq(1) by auto

  have "?F\<^sub>0 \<simeq> F\<^sub>1" using \<phi>\<^sub>1_def is_ring_iso_def by auto
  moreover have "?F\<^sub>0 \<simeq> F\<^sub>2" using \<phi>\<^sub>2_def is_ring_iso_def by auto
  moreover have "field ?F\<^sub>0"
    using f_def(1) zf.monic_poly_carr monic_irreducible_poly_def
    by (subst zfp.rupture_is_field_iff_pirreducible) auto
  hence "ring ?F\<^sub>0" using field.is_ring by auto
  ultimately show ?thesis
    using ring_iso_trans ring_iso_sym by blast
qed

end


theory Lambda_Example
imports "~~/src/HOL/Library/Code_Prolog"
begin

subsection {* Lambda *}

datatype type =
    Atom nat
  | Fun type type    (infixr "\<Rightarrow>" 200)

datatype dB =
    Var nat
  | App dB dB (infixl "\<degree>" 200)
  | Abs type dB

primrec
  nth_el :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option" ("_\<langle>_\<rangle>" [90, 0] 91)
where
  "[]\<langle>i\<rangle> = None"
| "(x # xs)\<langle>i\<rangle> = (case i of 0 \<Rightarrow> Some x | Suc j \<Rightarrow> xs \<langle>j\<rangle>)"

inductive nth_el1 :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> bool"
where
  "nth_el1 (x # xs) 0 x"
| "nth_el1 xs i y \<Longrightarrow> nth_el1 (x # xs) (Suc i) y"

inductive typing :: "type list \<Rightarrow> dB \<Rightarrow> type \<Rightarrow> bool"  ("_ \<turnstile> _ : _" [50, 50, 50] 50)
  where
    Var [intro!]: "nth_el1 env x T \<Longrightarrow> env \<turnstile> Var x : T"
  | Abs [intro!]: "T # env \<turnstile> t : U \<Longrightarrow> env \<turnstile> Abs T t : (T \<Rightarrow> U)"
  | App [intro!]: "env \<turnstile> s : U \<Rightarrow> T \<Longrightarrow> env \<turnstile> t : T \<Longrightarrow> env \<turnstile> (s \<degree> t) : U"

primrec
  lift :: "[dB, nat] => dB"
where
    "lift (Var i) k = (if i < k then Var i else Var (i + 1))"
  | "lift (s \<degree> t) k = lift s k \<degree> lift t k"
  | "lift (Abs T s) k = Abs T (lift s (k + 1))"

primrec pred :: "nat => nat"
where
  "pred (Suc i) = i"

primrec
  subst :: "[dB, dB, nat] => dB"  ("_[_'/_]" [300, 0, 0] 300)
where
    subst_Var: "(Var i)[s/k] =
      (if k < i then Var (pred i) else if i = k then s else Var i)"
  | subst_App: "(t \<degree> u)[s/k] = t[s/k] \<degree> u[s/k]"
  | subst_Abs: "(Abs T t)[s/k] = Abs T (t[lift s 0 / k+1])"

inductive beta :: "[dB, dB] => bool"  (infixl "\<rightarrow>\<^sub>\<beta>" 50)
  where
    beta [simp, intro!]: "Abs T s \<degree> t \<rightarrow>\<^sub>\<beta> s[t/0]"
  | appL [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> s \<degree> u \<rightarrow>\<^sub>\<beta> t \<degree> u"
  | appR [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> u \<degree> s \<rightarrow>\<^sub>\<beta> u \<degree> t"
  | abs [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> Abs T s \<rightarrow>\<^sub>\<beta> Abs T t"

subsection {* Inductive definitions for ordering on naturals *}

inductive less_nat
where
  "less_nat 0 (Suc y)"
| "less_nat x y ==> less_nat (Suc x) (Suc y)"

lemma less_nat[code_pred_inline]:
  "x < y = less_nat x y"
apply (rule iffI)
apply (induct x arbitrary: y)
apply (case_tac y) apply (auto intro: less_nat.intros)
apply (case_tac y)
apply (auto intro: less_nat.intros)
apply (induct rule: less_nat.induct)
apply auto
done

lemma [code_pred_inline]: "(x::nat) + 1 = Suc x"
by simp

section {* Manual setup to find counterexample *}

setup {*
  Context.theory_map
    (Quickcheck.add_tester ("prolog", (Code_Prolog.active, Code_Prolog.test_goals)))
*}

setup {* Code_Prolog.map_code_options (K
  { ensure_groundness = true,
    limit_globally = NONE,
    limited_types = [(@{typ nat}, 1), (@{typ "type"}, 1), (@{typ dB}, 1), (@{typ "type list"}, 1)],
    limited_predicates = [(["typing"], 2), (["nthel1"], 2)],
    replacing = [(("typing", "limited_typing"), "quickcheck"),
                 (("nthel1", "limited_nthel1"), "lim_typing")],
    manual_reorder = []}) *}

lemma
  "\<Gamma> \<turnstile> t : U \<Longrightarrow> t \<rightarrow>\<^sub>\<beta> t' \<Longrightarrow> \<Gamma> \<turnstile> t' : U"
quickcheck[tester = prolog, iterations = 1, expect = counterexample]
oops

text {* Verifying that the found counterexample really is one by means of a proof *}

lemma
assumes
  "t' = Var 0"
  "U = Atom 0"
  "\<Gamma> = [Atom 1]"
  "t = App (Abs (Atom 0) (Var 1)) (Var 0)"
shows
  "\<Gamma> \<turnstile> t : U"
  "t \<rightarrow>\<^sub>\<beta> t'"
  "\<not> \<Gamma> \<turnstile> t' : U"
proof -
  from assms show "\<Gamma> \<turnstile> t : U"
    by (auto intro!: typing.intros nth_el1.intros)
next
  from assms have "t \<rightarrow>\<^sub>\<beta> (Var 1)[Var 0/0]"
    by (auto simp only: intro: beta.intros)
  moreover
  from assms have "(Var 1)[Var 0/0] = t'" by simp
  ultimately show "t \<rightarrow>\<^sub>\<beta> t'" by simp
next
  from assms show "\<not> \<Gamma> \<turnstile> t' : U"
    by (auto elim: typing.cases nth_el1.cases)
qed

end


theory ALC
  imports Main
begin
typedecl i (* type for individuals *)
type_synonym \<sigma> = "i\<Rightarrow>bool" (* type for concepts *)
type_synonym r = "i\<times>i\<Rightarrow>bool" (* type for relations*)

abbreviation dlconj :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<sqinter>"51)
  where "C\<sqinter>D \<equiv> \<lambda>x. C(x)\<and>D(x)"
abbreviation dldisj :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<squnion>"50)
  where "C\<squnion>D \<equiv> \<lambda>x. C(x)\<or>D(x)"
abbreviation dlnot :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<not>_")
  where "\<^bold>\<not>C \<equiv> \<lambda>x. \<not>C(x)"
abbreviation dlexists :: "r\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<exists>_._"[8]9)
  where "\<^bold>\<exists>R. C\<equiv> \<lambda>x. \<exists>y. R(x,y) \<and> C(y)"
abbreviation dlforall :: "r\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<forall>_._"[8]9)
  where "\<^bold>\<forall>R. C\<equiv> \<lambda>x. \<forall>y. R(x,y)\<longrightarrow>C(y)"
abbreviation subsums :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" (infixr"\<sqsubseteq>"48)
  where "C\<sqsubseteq>D \<equiv> \<forall>x. C(x)\<longrightarrow>D(x)"
abbreviation equi :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" (infixr"\<^bold>\<equiv>"48)
  where "C\<^bold>\<equiv>D \<equiv> C\<sqsubseteq>D \<and> D \<sqsubseteq> C"

abbreviation dltop :: "\<sigma>" ("\<top>")
  where "\<top> \<equiv> \<lambda>x. True"
abbreviation dlbot :: "\<sigma>" ("\<bottom>")
  where "\<bottom> \<equiv> \<lambda>x. False"

consts Woman :: \<sigma>
consts Man   :: \<sigma>
consts Person:: \<sigma>
consts Female:: \<sigma>

axiomatization where
A1: "Woman \<^bold>\<equiv> Person \<sqinter> Female"  and
A2: "Man   \<^bold>\<equiv> Person \<sqinter> \<^bold>\<not>Female"

theorem "Man \<squnion> Woman \<^bold>\<equiv> Person"
  using A1 A2 by blast

theorem "\<bottom> \<^bold>\<equiv> Man \<sqinter> Female"
  using A1 A2 by blast
end


(*
    Title:      Rref.thy
    Author:     Jose Divasón <jose.divasonm at unirioja.es>
    Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
*)

section\<open>Reduced row echelon form\<close>

theory Rref
imports
  Rank_Nullity_Theorem.Mod_Type
  Rank_Nullity_Theorem.Miscellaneous
begin

subsection\<open>Defining the concept of Reduced Row Echelon Form\<close>

subsubsection\<open>Previous definitions and properties\<close>
text\<open>This function returns True if each position lesser than k in a column contains a zero.\<close>
definition is_zero_row_upt_k :: "'rows => nat =>'a::{zero}^'columns::{mod_type}^'rows => bool"
  where "is_zero_row_upt_k i k A = (\<forall>j::'columns. (to_nat j) < k \<longrightarrow> A $ i $ j = 0)"

definition is_zero_row :: "'rows =>'a::{zero}^'columns::{mod_type}^'rows => bool"
  where "is_zero_row i A = is_zero_row_upt_k i (ncols A) A"

lemma is_zero_row_upt_ncols:
  fixes A::"'a::{zero}^'columns::{mod_type}^'rows"
  shows "is_zero_row_upt_k i (ncols A) A = (\<forall>j::'columns. A $ i $ j = 0)" unfolding is_zero_row_def is_zero_row_upt_k_def ncols_def by auto

corollary is_zero_row_def':
  fixes A::"'a::{zero}^'columns::{mod_type}^'rows"
  shows "is_zero_row i A = (\<forall>j::'columns. A $ i $ j = 0)" using is_zero_row_upt_ncols unfolding is_zero_row_def ncols_def .

lemma is_zero_row_eq_row_zero: "is_zero_row a A = (row a A = 0)"
  unfolding is_zero_row_def' row_def
  unfolding vec_nth_inverse
  unfolding vec_eq_iff zero_index ..

lemma not_is_zero_row_upt_suc:
  assumes "\<not> is_zero_row_upt_k i (Suc k) A"
  and "\<forall>i. A $ i $ (from_nat k) = 0"
  shows "\<not> is_zero_row_upt_k i k A"
  using assms from_nat_to_nat_id
  using is_zero_row_upt_k_def less_SucE
  by metis

lemma is_zero_row_upt_k_suc:
  assumes "is_zero_row_upt_k i k A"
  and "A $ i $ (from_nat k) = 0"
  shows "is_zero_row_upt_k i (Suc k) A"
  using assms unfolding is_zero_row_upt_k_def using less_SucE to_nat_from_nat by metis

lemma is_zero_row_utp_0:
  shows "is_zero_row_upt_k m 0 A" unfolding is_zero_row_upt_k_def by fast

lemma is_zero_row_upt_k_le:
  assumes "is_zero_row_upt_k i (Suc k) A"
  shows "is_zero_row_upt_k i k A"
  using assms unfolding is_zero_row_upt_k_def by simp

lemma is_zero_row_imp_is_zero_row_upt:
assumes "is_zero_row i A"
shows "is_zero_row_upt_k i k A"
using assms unfolding  is_zero_row_def is_zero_row_upt_k_def ncols_def by simp

subsubsection\<open>Definition of reduced row echelon form up to a column\<close>

text\<open>This definition returns True if a matrix is in reduced row echelon form up to the column k (not included), otherwise False.\<close>

(*In the third condition, i<i+1 is assumed to avoid that row i can be the last row (in that case, i+1 would be the first row):*)

definition reduced_row_echelon_form_upt_k :: "'a::{zero, one}^'m::{mod_type}^'n::{finite, ord, plus, one} => nat => bool"
  where "reduced_row_echelon_form_upt_k A k =
  (
    (\<forall>i. is_zero_row_upt_k i k A \<longrightarrow> \<not> (\<exists>j. j>i \<and> \<not> is_zero_row_upt_k j k A)) \<and>
    (\<forall>i. \<not> (is_zero_row_upt_k i k A) \<longrightarrow> A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1) \<and>
    (\<forall>i. i<i+1 \<and> \<not> (is_zero_row_upt_k i k A) \<and> \<not> (is_zero_row_upt_k (i+1) k A) \<longrightarrow> ((LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ (i+1) $ n \<noteq> 0))) \<and>
    (\<forall>i. \<not> (is_zero_row_upt_k i k A) \<longrightarrow> (\<forall>j. i \<noteq> j \<longrightarrow> A $ j $ (LEAST n. A $ i $ n \<noteq> 0) = 0))
  )"

lemma rref_upt_0: "reduced_row_echelon_form_upt_k A 0"
  unfolding reduced_row_echelon_form_upt_k_def is_zero_row_upt_k_def by auto

lemma rref_upt_condition1:
  assumes r: "reduced_row_echelon_form_upt_k A k"
  shows "(\<forall>i. is_zero_row_upt_k i k A \<longrightarrow> \<not> (\<exists>j. j>i \<and> \<not> is_zero_row_upt_k j k A))"
  using r unfolding reduced_row_echelon_form_upt_k_def by simp

lemma rref_upt_condition2:
  assumes r: "reduced_row_echelon_form_upt_k A k"
  shows "(\<forall>i. \<not> (is_zero_row_upt_k i k A) \<longrightarrow> A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1)"
  using r unfolding reduced_row_echelon_form_upt_k_def by simp

lemma rref_upt_condition3:
  assumes r: "reduced_row_echelon_form_upt_k A k"
  shows "(\<forall>i. i<i+1 \<and> \<not> (is_zero_row_upt_k i k A) \<and> \<not> (is_zero_row_upt_k (i+1) k A) \<longrightarrow> ((LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ (i+1) $ n \<noteq> 0)))"
  using r unfolding reduced_row_echelon_form_upt_k_def by simp

lemma rref_upt_condition4:
  assumes r: "reduced_row_echelon_form_upt_k A k"
  shows " (\<forall>i. \<not> (is_zero_row_upt_k i k A) \<longrightarrow> (\<forall>j. i \<noteq> j \<longrightarrow> A $ j $ (LEAST n. A $ i $ n \<noteq> 0) = 0))"
  using r unfolding reduced_row_echelon_form_upt_k_def by simp

text\<open>Explicit lemmas for each condition\<close>

lemma rref_upt_condition1_explicit:
assumes "reduced_row_echelon_form_upt_k A k"
and "is_zero_row_upt_k i k A"
and "j>i"
shows "is_zero_row_upt_k j k A"
using assms rref_upt_condition1 by blast

lemma rref_upt_condition2_explicit:
assumes rref_A: "reduced_row_echelon_form_upt_k A k"
and "\<not> is_zero_row_upt_k i k A"
shows "A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1"
using rref_upt_condition2 assms by blast

lemma rref_upt_condition3_explicit:
assumes "reduced_row_echelon_form_upt_k A k"
and "i < i + 1"
and "\<not> is_zero_row_upt_k i k A"
and "\<not> is_zero_row_upt_k (i + 1) k A "
shows "(LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ (i + 1) $ n \<noteq> 0)"
using assms rref_upt_condition3 by blast

lemma rref_upt_condition4_explicit:
assumes "reduced_row_echelon_form_upt_k A k"
and "\<not> is_zero_row_upt_k i k A"
and "i \<noteq> j"
shows "A $ j $ (LEAST n. A $ i $ n \<noteq> 0) = 0"
using assms rref_upt_condition4 by auto

text\<open>Intro lemma and general properties\<close>

lemma reduced_row_echelon_form_upt_k_intro:
  assumes "(\<forall>i. is_zero_row_upt_k i k A \<longrightarrow> \<not> (\<exists>j. j>i \<and> \<not> is_zero_row_upt_k j k A))"
  and "(\<forall>i. \<not> (is_zero_row_upt_k i k A) \<longrightarrow> A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1)"
  and "(\<forall>i. i<i+1 \<and> \<not> (is_zero_row_upt_k i k A) \<and> \<not> (is_zero_row_upt_k (i+1) k A) \<longrightarrow> ((LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ (i+1) $ n \<noteq> 0)))"
  and "(\<forall>i. \<not> (is_zero_row_upt_k i k A) \<longrightarrow> (\<forall>j. i \<noteq> j \<longrightarrow> A $ j $ (LEAST n. A $ i $ n \<noteq> 0) = 0))"
  shows "reduced_row_echelon_form_upt_k A k"
  unfolding reduced_row_echelon_form_upt_k_def using assms by fast

lemma rref_suc_imp_rref:
  fixes A::"'a::{semiring_1}^'n::{mod_type}^'m::{mod_type}"
  assumes r: "reduced_row_echelon_form_upt_k A (Suc k)"
  and k_le_card: "Suc k < ncols A"
  shows "reduced_row_echelon_form_upt_k A k"
proof (rule reduced_row_echelon_form_upt_k_intro)
  show "\<forall>i. \<not> is_zero_row_upt_k i k A \<longrightarrow> A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1"
    using rref_upt_condition2[OF r] less_SucI unfolding is_zero_row_upt_k_def by blast
  show "\<forall>i. i < i + 1 \<and> \<not> is_zero_row_upt_k i k A \<and> \<not> is_zero_row_upt_k (i + 1) k A \<longrightarrow> (LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ (i + 1) $ n \<noteq> 0)"
    using rref_upt_condition3[OF r] less_SucI unfolding is_zero_row_upt_k_def by blast
  show "\<forall>i. \<not> is_zero_row_upt_k i k A \<longrightarrow> (\<forall>j. i \<noteq> j \<longrightarrow> A $ j $ (LEAST n. A $ i $ n \<noteq> 0) = 0)"
    using rref_upt_condition4[OF r] less_SucI unfolding is_zero_row_upt_k_def by blast
  show "\<forall>i. is_zero_row_upt_k i k A \<longrightarrow> \<not> (\<exists>j>i. \<not> is_zero_row_upt_k j k A)"
  proof (clarify, rule ccontr)
    fix i j
    assume zero_i: "is_zero_row_upt_k i k A"
      and i_less_j: "i < j"
      and not_zero_j: "\<not> is_zero_row_upt_k j k A"
    have not_zero_j_suc: "\<not> is_zero_row_upt_k j (Suc k) A"
      using not_zero_j unfolding is_zero_row_upt_k_def by fastforce
    hence not_zero_i_suc: "\<not> is_zero_row_upt_k i (Suc k) A"
      using rref_upt_condition1[OF r] i_less_j by fast
    have not_zero_i_plus_suc: "\<not> is_zero_row_upt_k (i+1) (Suc k) A"
    proof (cases "j=i+1")
      case True thus ?thesis using not_zero_j_suc by simp
    next
      case False
      have "i+1<j" by (rule Suc_less[OF i_less_j False[symmetric]])
      thus ?thesis  using rref_upt_condition1[OF r] not_zero_j_suc by blast
    qed
    from this obtain n where a: "A $ (i+1) $ n \<noteq> 0" and n_less_suc: "to_nat n < Suc k"
      unfolding is_zero_row_upt_k_def by blast
    have "(LEAST n. A $ (i+1) $ n \<noteq> 0) \<le> n" by (rule Least_le, simp add: a)
    also have "... \<le> from_nat k" by (metis Suc_lessD from_nat_mono' from_nat_to_nat_id k_le_card less_Suc_eq_le n_less_suc ncols_def)
    finally have least_le: "(LEAST n. A $ (i + 1) $ n \<noteq> 0) \<le> from_nat k" .
    have least_eq_k: "(LEAST n. A $ i $ n \<noteq> 0) = from_nat k"
    proof (rule Least_equality)
      show "A $ i $ from_nat k \<noteq> 0" using not_zero_i_suc zero_i unfolding is_zero_row_upt_k_def by (metis from_nat_to_nat_id less_SucE)
      show "\<And>y. A $ i $ y \<noteq> 0 \<Longrightarrow> from_nat k \<le> y" by (metis is_zero_row_upt_k_def not_le_imp_less to_nat_le zero_i)
    qed
    have i_less: "i<i+1"
    proof (rule Suc_le', rule ccontr)
      assume "\<not> i + 1 \<noteq> 0" hence "i+1=0" by simp
      hence "i=-1" using diff_0 diff_add_cancel diff_minus_eq_add by metis
      hence "j <= i" using Greatest_is_minus_1 by blast
      thus False using i_less_j by fastforce
    qed
    have "from_nat k < (LEAST n. A $ (i+1) $ n \<noteq> 0)"
      using rref_upt_condition3[OF r] i_less not_zero_i_suc not_zero_i_plus_suc least_eq_k by fastforce
    thus False using least_le by simp
  qed
qed

lemma reduced_row_echelon_if_all_zero:
  assumes all_zero: "\<forall>n. is_zero_row_upt_k n k A"
  shows "reduced_row_echelon_form_upt_k A k"
  using assms unfolding reduced_row_echelon_form_upt_k_def is_zero_row_upt_k_def by auto

subsubsection\<open>The definition of reduced row echelon form\<close>

text\<open>Definition of reduced row echelon form, based on \<open>reduced_row_echelon_form_upt_k_def\<close>\<close>
definition reduced_row_echelon_form :: "'a::{zero, one}^'m::{mod_type}^'n::{finite, ord, plus, one} => bool"
  where "reduced_row_echelon_form A = reduced_row_echelon_form_upt_k A (ncols A)"

text\<open>Equivalence between our definition of reduced row echelon form and the one presented
in Steven Roman's book: Advanced Linear Algebra.\<close>

lemma reduced_row_echelon_form_def':
"reduced_row_echelon_form A =
  (
    (\<forall>i. is_zero_row i A \<longrightarrow> \<not> (\<exists>j. j>i \<and> \<not> is_zero_row j A)) \<and>
    (\<forall>i. \<not> (is_zero_row i A) \<longrightarrow> A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1) \<and>
    (\<forall>i. i<i+1 \<and> \<not> (is_zero_row i A) \<and> \<not> (is_zero_row (i+1) A) \<longrightarrow> ((LEAST k. A $ i $ k \<noteq> 0) < (LEAST k. A $ (i+1) $ k \<noteq> 0))) \<and>
    (\<forall>i. \<not> (is_zero_row i A) \<longrightarrow> (\<forall>j. i \<noteq> j \<longrightarrow> A $ j $ (LEAST k. A $ i $ k \<noteq> 0) = 0))
  )" unfolding reduced_row_echelon_form_def reduced_row_echelon_form_upt_k_def is_zero_row_def ..

subsection\<open>Properties of the reduced row echelon form of a matrix\<close>

lemma rref_condition1:
  assumes r: "reduced_row_echelon_form A"
  shows "(\<forall>i. is_zero_row i A \<longrightarrow> \<not> (\<exists>j. j>i \<and> \<not> is_zero_row j A))" using r unfolding reduced_row_echelon_form_def' by simp

lemma rref_condition2:
  assumes r: "reduced_row_echelon_form A"
  shows " (\<forall>i. \<not> (is_zero_row i A) \<longrightarrow> A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1)" using r unfolding reduced_row_echelon_form_def' by simp

lemma rref_condition3:
  assumes r: "reduced_row_echelon_form A"
  shows "(\<forall>i. i<i+1 \<and> \<not> (is_zero_row i A) \<and> \<not> (is_zero_row (i+1) A) \<longrightarrow> ((LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ (i+1) $ n \<noteq> 0)))"
  using r unfolding reduced_row_echelon_form_def' by simp

text\<open>Explicit lemmas for each condition\<close>

lemma rref_condition1_explicit:
assumes rref_A: "reduced_row_echelon_form A"
and "is_zero_row i A"
shows "\<forall>j>i. is_zero_row j A"
using rref_condition1 assms by blast

lemma rref_condition2_explicit:
assumes rref_A: "reduced_row_echelon_form A"
and "\<not> is_zero_row i A"
shows "A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1"
using rref_condition2 assms by blast

lemma rref_condition3_explicit:
assumes rref_A: "reduced_row_echelon_form A"
and i_le: "i < i + 1"
and "\<not> is_zero_row i A" and "\<not> is_zero_row (i + 1) A"
shows "(LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ (i + 1) $ n \<noteq> 0)"
using rref_condition3 assms by blast

lemma rref_condition4_explicit:
assumes rref_A: "reduced_row_echelon_form A"
and "\<not> is_zero_row i A"
and "i \<noteq> j"
shows "A $ j $ (LEAST n. A $ i $ n \<noteq> 0) = 0"
using rref_condition4 assms by blast

text\<open>Other properties and equivalences\<close>

lemma rref_condition3_equiv1:
fixes A::"'a::{one, zero}^'cols::{mod_type}^'rows::{mod_type}"
assumes rref: "reduced_row_echelon_form A"
and i_less_j: "i<j"
and j_less_nrows: "j<nrows A"
and not_zero_i: "\<not> is_zero_row (from_nat i) A"
and not_zero_j: "\<not> is_zero_row (from_nat j) A"
shows "(LEAST n. A $ (from_nat i) $ n \<noteq> 0) < (LEAST n. A $ (from_nat j) $ n \<noteq> 0)"
using i_less_j not_zero_j j_less_nrows
proof (induct j)
case 0
show ?case using "0.prems"(1) by simp
next
fix j
assume hyp: "i < j \<Longrightarrow> \<not> is_zero_row (from_nat j) A \<Longrightarrow> j < nrows A \<Longrightarrow> (LEAST n. A $ from_nat i $ n \<noteq> 0) < (LEAST n. A $ from_nat j $ n \<noteq> 0)"
and i_less_suc_j: "i < Suc j"
and not_zero_suc_j: "\<not> is_zero_row (from_nat (Suc j)) A"
and Suc_j_less_nrows: "Suc j < nrows A"
have j_less: "(from_nat j::'rows) < from_nat (j+1)" by (rule from_nat_mono, auto simp add: Suc_j_less_nrows[unfolded nrows_def])
hence not_zero_j: "\<not> is_zero_row (from_nat j) A" using rref_condition1[OF rref] not_zero_suc_j unfolding Suc_eq_plus1 by blast
show "(LEAST n. A $ from_nat i $ n \<noteq> 0) < (LEAST n. A $ from_nat (Suc j) $ n \<noteq> 0)"
proof (cases "i=j")
case True
show ?thesis
 proof (unfold True Suc_eq_plus1 from_nat_suc, rule rref_condition3_explicit)
     show "reduced_row_echelon_form A" using rref .
     show "(from_nat j::'rows) < from_nat j + 1" using j_less unfolding from_nat_suc .
     show "\<not> is_zero_row (from_nat j) A" using not_zero_j .
     show "\<not> is_zero_row (from_nat j + 1) A" using not_zero_suc_j unfolding Suc_eq_plus1 from_nat_suc .
  qed
next
case False
have "(LEAST n. A $ from_nat i $ n \<noteq> 0) < (LEAST n. A $ from_nat j $ n \<noteq> 0)"
  proof (rule hyp)
     show "i < j" using False i_less_suc_j by simp
     show "\<not> is_zero_row (from_nat j) A" using not_zero_j .
     show "j < nrows A" using Suc_j_less_nrows by simp
  qed
also have "... < (LEAST n. A $ from_nat (j+1) $ n \<noteq> 0)"
  proof (unfold from_nat_suc, rule rref_condition3_explicit)
     show "reduced_row_echelon_form A" using rref .
     show "(from_nat j::'rows) < from_nat j + 1" using j_less unfolding from_nat_suc .
     show "\<not> is_zero_row (from_nat j) A" using not_zero_j .
     show "\<not> is_zero_row (from_nat j + 1) A" using not_zero_suc_j unfolding Suc_eq_plus1 from_nat_suc .
  qed
finally show "(LEAST n. A $ from_nat i $ n \<noteq> 0) < (LEAST n. A $ from_nat (Suc j) $ n \<noteq> 0)" unfolding Suc_eq_plus1 .
qed
qed

corollary rref_condition3_equiv:
fixes A::"'a::{one, zero}^'cols::{mod_type}^'rows::{mod_type}"
assumes rref: "reduced_row_echelon_form A"
and i_less_j: "i<j"
and i: "\<not> is_zero_row i A"
and j: "\<not> is_zero_row j A"
shows "(LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ j $ n \<noteq> 0)"
proof (rule rref_condition3_equiv1[of A "to_nat i" "to_nat j", unfolded from_nat_to_nat_id])
 show "reduced_row_echelon_form A" using rref .
 show "to_nat i < to_nat j" by (rule to_nat_mono[OF i_less_j])
 show "to_nat j < nrows A" using to_nat_less_card unfolding nrows_def .
 show "\<not> is_zero_row i A" using i .
 show "\<not> is_zero_row j A" using j .
qed

lemma rref_implies_rref_upt:
fixes A::"'a::{one,zero}^'cols::{mod_type}^'rows::{mod_type}"
assumes rref: "reduced_row_echelon_form A"
shows "reduced_row_echelon_form_upt_k A k"
proof (rule reduced_row_echelon_form_upt_k_intro)
  show "\<forall>i. \<not> is_zero_row_upt_k i k A \<longrightarrow> A $ i $ (LEAST k. A $ i $ k \<noteq> 0) = 1"
    using rref_condition2[OF rref] is_zero_row_imp_is_zero_row_upt by blast
  show "\<forall>i. i < i + 1 \<and> \<not> is_zero_row_upt_k i k A \<and> \<not> is_zero_row_upt_k (i + 1) k A \<longrightarrow> (LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ (i + 1) $ n \<noteq> 0)"
    using rref_condition3[OF rref] is_zero_row_imp_is_zero_row_upt by blast
  show "\<forall>i. \<not> is_zero_row_upt_k i k A \<longrightarrow> (\<forall>j. i \<noteq> j \<longrightarrow> A $ j $ (LEAST n. A $ i $ n \<noteq> 0) = 0)"
    using rref_condition4[OF rref] is_zero_row_imp_is_zero_row_upt by blast
show "\<forall>i. is_zero_row_upt_k i k A \<longrightarrow> \<not> (\<exists>j>i. \<not> is_zero_row_upt_k j k A)"
proof (auto, rule ccontr)
fix i j assume zero_i_k: "is_zero_row_upt_k i k A" and i_less_j: "i < j"
and not_zero_j_k:"\<not> is_zero_row_upt_k j k A"
have not_zero_j: "\<not> is_zero_row j A" using is_zero_row_imp_is_zero_row_upt not_zero_j_k by blast
hence not_zero_i: "\<not> is_zero_row i A" using rref_condition1[OF rref] i_less_j by blast
have Least_less: "(LEAST n. A $ i $ n \<noteq> 0) < (LEAST n. A $ j $ n \<noteq> 0)" by (rule rref_condition3_equiv[OF rref i_less_j not_zero_i not_zero_j])
moreover have "(LEAST n. A $ j $ n \<noteq> 0) < (LEAST n. A $ i $ n \<noteq> 0)"
  proof (rule LeastI2_ex)
     show "\<exists>a. A $ i $ a \<noteq> 0" using not_zero_i unfolding is_zero_row_def is_zero_row_upt_k_def by fast
     fix x assume Aix_not_0: "A $ i $ x \<noteq> 0"
     have k_less_x: "k \<le> to_nat x"  using zero_i_k Aix_not_0 unfolding is_zero_row_upt_k_def by force
     hence k_less_ncols: "k < ncols A" unfolding ncols_def using to_nat_less_card[of x] by simp
     obtain s where Ajs_not_zero: "A $ j $ s \<noteq> 0" and s_less_k: "to_nat s < k" using not_zero_j_k unfolding is_zero_row_upt_k_def by blast
     have "(LEAST n. A $ j $ n \<noteq> 0) \<le> s" using Ajs_not_zero Least_le by fast
     also have "... = from_nat (to_nat s)" unfolding from_nat_to_nat_id ..
     also have "... < from_nat k" by (rule from_nat_mono[OF s_less_k k_less_ncols[unfolded ncols_def]])
     also have "... \<le> x" using k_less_x leD not_le_imp_less to_nat_le by fast
     finally show "(LEAST n. A $ j $ n \<noteq> 0) < x" .
  qed
ultimately show False by fastforce
qed
qed

lemma rref_first_position_zero_imp_column_0:
fixes A::"'a::{one,zero}^'cols::{mod_type}^'rows::{mod_type}"
assumes rref: "reduced_row_echelon_form A"
and A_00: "A $ 0 $ 0 = 0"
shows "column 0 A = 0"
proof (unfold column_def, vector, clarify)
fix i
have "is_zero_row_upt_k 0 1 A" unfolding is_zero_row_upt_k_def using A_00 by (metis One_nat_def less_Suc0 to_nat_eq_0)
hence "is_zero_row_upt_k i 1 A" using rref_upt_condition1[OF rref_implies_rref_upt[OF rref]] using least_mod_type less_le by metis
thus "A $ i $ 0 = 0" unfolding is_zero_row_upt_k_def using to_nat_eq_0 by blast
qed

lemma rref_first_element:
fixes A::"'a::{one,zero}^'cols::{mod_type}^'rows::{mod_type}"
assumes rref: "reduced_row_echelon_form A"
and column_not_0: "column 0 A \<noteq> 0"
shows "A $ 0 $ 0 = 1"
proof (rule ccontr)
have A_00_not_0: "A $ 0 $ 0 \<noteq> 0"
  proof (rule ccontr, simp)
    assume A_00: "A $ 0 $ 0 = 0"
    from this obtain i where Ai0: "A $ i $ 0 \<noteq> 0" and i: "i>0" using column_not_0 unfolding column_def by (metis column_def rref rref_first_position_zero_imp_column_0)
    have "is_zero_row_upt_k 0 1 A" unfolding is_zero_row_upt_k_def using A_00 by (metis One_nat_def less_Suc0 to_nat_eq_0)
    moreover have "\<not> is_zero_row_upt_k i 1 A" using Ai0 by (metis is_zero_row_upt_k_def to_nat_0 zero_less_one)
    ultimately have "\<not> reduced_row_echelon_form A" by (metis A_00 column_not_0 rref_first_position_zero_imp_column_0)
    thus False using rref by contradiction
qed
assume A_00_not_1: "A $ 0 $ 0 \<noteq> 1"
have Least_eq_0: "(LEAST n. A $ 0 $ n \<noteq> 0) = 0"
  proof (rule Least_equality)
     show "A $ 0 $ 0 \<noteq> 0" by (rule A_00_not_0)
     show "\<And>y. A $ 0 $ y \<noteq> 0 \<Longrightarrow> 0 \<le> y" using least_mod_type .
  qed
moreover have "\<not> is_zero_row 0 A" unfolding is_zero_row_def is_zero_row_upt_k_def ncols_def using A_00_not_0 by auto
ultimately have "A $ 0 $ (LEAST n. A $ 0 $ n \<noteq> 0) = 1" using rref_condition2[OF rref] by fast
thus False unfolding Least_eq_0 using A_00_not_1 by contradiction
qed

end