theory Lattice_int

imports "Jordan_Normal_Form.Matrix"
        "Jordan_Normal_Form.VS_Connect"
        "BenOr_Kozen_Reif.More_Matrix"

begin

text \<open>Connect the type vec to records of rings, commutative rings, fields and modules in order to
  use properties of modules such as lin_indpt (linear independence).\<close>

lemma dim_carrier: "dim_vec z = dim_col A \<Longrightarrow> A *\<^sub>v z \<in> carrier_vec (dim_row A)"
  by (metis carrier_vec_dim_vec dim_mult_mat_vec)

text \<open>Concrete type conversion int vec to real vec\<close>
definition real_of_int_vec :: "int vec \<Rightarrow> real vec"  where
  "real_of_int_vec v = map_vec real_of_int v"

definition real_to_int_vec :: "real vec \<Rightarrow> int vec"  where
  "real_to_int_vec v = map_vec floor v"

lemma real_of_int_vec_nth[simp, intro]:
  "i<dim_vec v \<Longrightarrow> (real_of_int_vec v) $ i = real_of_int (v$i)"
by (simp add: real_of_int_vec_def)

lemma real_of_int_vec_vec:
  "real_of_int_vec (vec n f) = vec n (real_of_int \<circ> f)"
by (auto simp add: real_of_int_vec_def)

text \<open>Concrete type conversion int mat to real mat\<close>
definition real_of_int_mat :: "int mat \<Rightarrow> real mat"  where
  "real_of_int_mat A = map_mat real_of_int A"

definition real_to_int_mat :: "real mat \<Rightarrow> int mat"  where
  "real_to_int_mat A = map_mat floor A"

lemma[simp]: "dim_col (real_of_int_mat A) = dim_col A"
  unfolding real_of_int_mat_def by auto

lemma[simp]: "dim_row (real_of_int_mat A) = dim_row A"
  unfolding real_of_int_mat_def by auto

lemma real_of_int_mat_nth[simp, intro]:
  "i<dim_row A \<Longrightarrow> j<dim_col A \<Longrightarrow> (real_of_int_mat A) $$ (i,j) = real_of_int (A $$ (i,j))"
by (simp add: real_of_int_mat_def)

lemma real_of_int_mat_mat:
  "real_of_int_mat (mat n m f) = mat n m (real_of_int \<circ> f)"
by (auto simp add: real_of_int_mat_def)

lemma real_of_int_mat_cols:
"cols (real_of_int_mat A) = map real_of_int_vec (cols A)"
by (simp add: list_eq_iff_nth_eq real_of_int_mat_def real_of_int_vec_def)

lemma distinct_cols_real_of_int_mat:
 "distinct (cols A) = distinct (cols (real_of_int_mat A))"
by (smt (verit, best) cols_length distinct_conv_nth index_map_mat(3) nth_map
  of_int_hom.vec_hom_inj real_of_int_mat_cols real_of_int_mat_def real_of_int_vec_def)

text \<open>Algebraic lattices are discrete additive subgroups of $\mathbb{R}^n$.
  Lattices can be represented by a basis, multiple bases can represent the same lattice.\<close>
type_synonym int_lattice = "int vec set"

text \<open>Linear independence\<close>

definition is_indep :: "real mat \<Rightarrow> bool" where
  "is_indep A \<equiv> (\<forall>z::real vec. (A *\<^sub>v z = 0\<^sub>v (dim_row A) \<and>
    dim_vec z = dim_col A) \<longrightarrow> z = 0\<^sub>v (dim_vec z))"

text \<open>properties of lattices\<close>

definition is_lattice :: "int_lattice \<Rightarrow> bool" where
  "is_lattice L \<equiv> (\<exists>B::(int mat).
    L = {B *\<^sub>v z | z::int vec. dim_vec z = dim_col B}
    \<and> is_indep (real_of_int_mat B))"

text \<open>The lattice generated by the column vectors of a matrix.
  This matrix does not need to be linearly independent.
  Make certain that the output is indeed a lattice and not the entire space.\<close>
definition gen_lattice :: "int mat \<Rightarrow> int vec set" where
  "gen_lattice A = {A *\<^sub>v z | z::int vec. dim_vec z = dim_col A}"

text \<open>Theorems\<close>
lemma finsum_vec_carrier:
assumes "f ` A \<subseteq> carrier_vec nr" "finite A"
shows "finsum_vec TYPE('a::ring) nr f A \<in> carrier_vec nr"
using assms unfolding finsum_vec_def
by (metis (no_types, lifting) Pi_I' comm_monoid.finprod_closed comm_monoid_vec
  image_subset_iff monoid_vec_simps(2))

lemma dim_vec_finsum_vec:
assumes "f ` A \<subseteq> carrier_vec nr" "finite A"
shows "dim_vec (finsum_vec TYPE('a::ring) nr f A) = nr"
using assms finsum_vec_carrier by (metis carrier_vecD)

lemma mat_mult_as_col_span:
assumes "(A :: 'a :: comm_ring mat) \<in> carrier_mat nr nc"
  and "(z :: 'a vec) \<in> carrier_vec nc"
shows "A *\<^sub>v z = finsum_vec TYPE('a) nr (\<lambda>i. z$i \<cdot>\<^sub>v col A i) {0..<nc}"
  (is "?left = ?right")
proof -
  have *: "finsum_vec TYPE('a) nr (\<lambda>i. z$i \<cdot>\<^sub>v col A i) {0..<nc} $ j = (A *\<^sub>v z) $ j"
    if "j<nr" for j
  proof -
    have "finsum_vec TYPE('a) nr (\<lambda>i. z$i \<cdot>\<^sub>v col A i) {0..<nc} $ j =
      sum (\<lambda>i. (z$i \<cdot>\<^sub>v col A i) $ j) {0..<nc}"
      by (subst index_finsum_vec, use assms that in \<open>auto\<close>)
    also have "\<dots> = sum (\<lambda>i. z$i * (col A i $ j)) {0..<nc}"
      using assms(1) that by force
    also have "\<dots> = sum (\<lambda>i. z$i * A $$ (j,i)) {0..<nc}" using assms that by auto
    also have "\<dots> = sum (\<lambda>i. A $$ (j,i) * z$i) {0..<nc}"
      by (meson mult.commute)
    also have "\<dots> = sum (\<lambda>i. row A j $ i * z $ i) {0..<nc}"
      using assms that by (auto simp add: index_row(1)[symmetric] simp del: index_row(1))
    also have "\<dots> = (A *\<^sub>v z) $ j"
      unfolding mult_mat_vec_def scalar_prod_def using assms that by auto
    finally show ?thesis by blast
  qed
  then show ?thesis
  proof (subst eq_vecI[of ?left ?right], goal_cases)
    case (1 i)
    have dim_nr: "dim_vec (A *\<^sub>v z) = nr"
      using assms(1) dim_mult_mat_vec by blast
    show ?case using assms 1 unfolding dim_nr by auto
  next
    case 2
    then show ?case using assms by (subst dim_vec_finsum_vec, auto)
  qed auto
qed

lemma mat_index:
"B = mat (dim_row B) (dim_col B) (\<lambda>(i,j). B $$ (i,j))"
by auto

lemma col_unit_vec:
assumes "i<dim_col (B:: 'a :: {monoid_mult, semiring_0, zero_neq_one} mat)"
shows "B *\<^sub>v (unit_vec (dim_col B) i) = col B i" (is "?left = ?right")
proof -
  have "B $$ (ia, i) = (\<Sum>ib = 0..<dim_col B. B $$ (ia, ib) * (if ib = i then 1 else 0))"
    if "ia < dim_row B" for ia
  proof -
    have "(\<Sum>ib = 0..<dim_col B. B $$ (ia, ib) * (if ib = i then 1 else 0)) =
      (\<Sum>ib = 0..<dim_col B. (if ib = i then B $$ (ia, ib) else 0))"
      by (smt (verit, best) mult.right_neutral mult_zero_right sum.cong)
    also have "\<dots> = B $$ (ia, i) +
       (\<Sum>ib\<in> {0..<dim_col B}-{i}. (if ib = i then B $$ (ia, ib) else 0))"
      by (simp add: assms)
    also have "\<dots> =  B $$ (ia, i)" by simp
    finally show ?thesis by auto
  qed
  then show ?thesis using assms by (subst eq_vecI[of ?left ?right])
    (auto simp add: unit_vec_def scalar_prod_def)
qed

lemma is_indep_not_null:
assumes "is_indep B" "i<dim_col B"
shows "col B i \<noteq> 0\<^sub>v (dim_row B)"
proof (rule ccontr)
  assume "\<not> (col B i \<noteq> 0\<^sub>v (dim_row B))"
  then have "col B i = 0\<^sub>v (dim_row B)" by auto
  then have "B *\<^sub>v (unit_vec (dim_col B) i) = 0\<^sub>v (dim_row B)"
  using col_unit_vec assms(2) by metis
  moreover have "dim_vec (unit_vec (dim_col B) i) = dim_col B" by auto
  moreover have "(unit_vec (dim_col B) i) \<noteq> 0\<^sub>v (dim_col B)"
    by (simp add: assms(2))
  ultimately have "\<not> (is_indep B)" unfolding is_indep_def by auto
  then show False using assms by auto
qed

lemma col_in_gen_lattice:
assumes "i<dim_col B"
shows "col B i \<in> gen_lattice B"
unfolding gen_lattice_def proof (safe)
  have "col B i = B *\<^sub>v (unit_vec (dim_col B) i)" using col_unit_vec[OF assms] by auto
  moreover have "dim_vec (unit_vec (dim_col B) i) = dim_col B" by auto
  ultimately show "\<exists>z. col B i = B *\<^sub>v z \<and> dim_vec z = dim_col B" by auto
qed

(* Lemmas for base change*)
definition span :: "('a :: semiring_0) mat \<Rightarrow> 'a vec set"  where
"span B = {B *\<^sub>v z | z:: 'a vec. dim_vec z = dim_col B}"

definition dim :: "int mat \<Rightarrow> nat" where
"dim B = (if \<exists>b. is_indep (real_of_int_mat b) \<and> span (real_of_int_mat b) = span (real_of_int_mat B)
    then dim_col (SOME b. is_indep (real_of_int_mat b) \<and>
    span (real_of_int_mat b) = span (real_of_int_mat B)) else 0)"

definition set_cols[simp]: "set_cols A = set (cols A)"

definition insert_col:
"insert_col A c = mat_of_cols (dim_row A) (c # cols A)"

definition delete_col:
"delete_col A c = mat_of_cols (dim_row A) (filter (\<lambda> x. \<not> (x = c)) (cols A))"

lemma set_cols_col:
"set_cols A = col A ` {0..<dim_col A}"
by (simp add: cols_def)

lemma set_cols_subset_col:
assumes "set_cols A \<subseteq> set_cols B"
  "i<dim_col A"
obtains j where "col A i = col B j"
proof -
  have "col A i \<in> set_cols B" using assms
    by (metis cols_length cols_nth nth_mem set_cols subsetD)
  then have "\<exists>j. col A i = col B j \<and> j<dim_col B"
    using set_cols_col by fastforce
  then show ?thesis using that by blast
qed

lemma span_mono:
assumes "set_cols (A ::'a::comm_ring mat) \<subseteq> set_cols B" "dim_row A = dim_row B"
    "distinct (cols A)"
shows "span A \<subseteq> span B"
using assms proof (induction "card (set_cols B - set_cols A)" arbitrary: A B rule: less_induct)
  case less
  then show ?case unfolding span_def
  proof (safe, goal_cases)
    case (1 _ z)
    define nr where "nr = dim_row B"
    define nc where "nc = dim_col B"
    have 2: "B \<in> carrier_mat nr nc" unfolding nr_def nc_def by auto
    have 3: "set (cols A) \<subseteq> set (cols B)" using less.prems(1) by auto
    have 4: "z \<in> carrier_vec (length (cols A))" using 1(5)
    by (metis carrier_vec_dim_vec cols_length)
    have 5: "mat_of_cols nr (cols A) = A"
    by (metis less.prems(2) mat_of_cols_cols nr_def)
    obtain zb where "A *\<^sub>v z = B *\<^sub>v zb" "dim_vec zb = dim_col B"
      using helper3[of B nr nc "cols A" z, OF 2 less.prems(3) 3 4] unfolding nc_def 5 by auto
    then show ?case by auto
  qed
qed

lemma is_indep_mono:
assumes "set_cols B \<subseteq> set_cols A" "is_indep A" "distinct (cols B)" "dim_row A = dim_row B"
shows "is_indep B"
unfolding is_indep_def
proof (safe, goal_cases)
  case (1 z)
  define nr where "nr = dim_row A"
  define nc where "nc = dim_col A"
  have r: "nr = dim_row B" unfolding nr_def  using assms(4) by auto
  have A': "A \<in> carrier_mat nr nc" unfolding nr_def nc_def by auto
  define ss where "ss = cols (B)"
  have d: "distinct (cols B)" using assms(3)
  by (simp add: distinct_cols_real_of_int_mat)
  have sub: "set (cols B) \<subseteq> set (cols A)"
  using assms(1) real_of_int_mat_cols by auto
  from distinct_list_subset_nths[of "cols B" "cols A", OF d sub]
  obtain ids where ids: "distinct ids" "set ids \<subseteq> {..<length (cols A)}"
    and ss: "ss = map ((!) (cols A)) ids"
    using assms(1) set_cols ss_def by blast
  let ?ls = " map ((!) (cols A)) (filter (\<lambda>i. i \<notin> set ids) [0..<length (cols A)])"
  from subindex_permutation2[OF ids] obtain f where
    f: "f permutes {..<length (cols A)}"
    "cols A = permute_list f (?ls @ ss)" using ss by blast
  have f': "f permutes {..<nc}" using f(1) unfolding nc_def by simp
  have *: "\<And>x. x \<in> set ?ls \<Longrightarrow> dim_vec x = nr" using nr_def by auto
  let ?cs1 = "(list_of_vec (0\<^sub>v (length ?ls) @\<^sub>v z))"
  have z: "z \<in> carrier_vec (length ss)" unfolding ss_def using 1
  using carrier_dim_vec by auto
  have "0\<^sub>v nr = B *\<^sub>v z" using 1 unfolding r by auto
  also have "\<dots> = mat_of_cols nr ss *\<^sub>v z" unfolding ss_def r by simp
  also have "\<dots> = mat_of_cols nr (?ls @ ss) *\<^sub>v vec_of_list (?cs1)"
    using helper2[OF z] * by (metis vec_list)
  also have "... = mat_of_cols nr (permute_list f (?ls @ ss)) *\<^sub>v vec_of_list (permute_list f ?cs1)"
    by (auto intro!: mat_of_cols_mult_mat_vec_permute_list[symmetric])
       (metis cols_length f(1) f(2) length_append length_map length_permute_list,
        use ss_def z in \<open>force\<close>)
  also have "... =  A *\<^sub>v vec_of_list (permute_list f ?cs1)" using f(2)
    by (simp add: nr_def)
  finally have "A *\<^sub>v vec_of_list (permute_list f ?cs1) = 0\<^sub>v nr"
  by presburger
  then have zero: "vec_of_list (permute_list f ?cs1) = 0\<^sub>v nc"
  by (smt (verit, best) assms(2) carrier_vecD cols_length dim_vec_of_list f(2)
    index_append_vec(2) index_map_mat(2) index_map_mat(3) index_zero_vec(2) is_indep_def
    length_append length_list_of_vec length_permute_list nc_def nr_def real_of_int_mat_def z)
  then have *:  "permute_list f ?cs1 ! i = 0" if "i<nc" for i
    by (metis index_zero_vec(1) that vec_of_list_index)
  then have "?cs1 ! (f i) = 0" if "i<nc" for i
    by (metis cols_length dim_vec_of_list f(1) index_zero_vec(2) length_permute_list nc_def
    permute_list_nth that zero)
  then have "(\<lambda>i. ?cs1 ! (f i)) ` {..<nc} \<subseteq> {0}" by blast
  then have "(\<lambda>i. ?cs1 ! i) ` (f `{..<nc}) \<subseteq> {0}" by blast
  then have "(\<lambda>i. ?cs1 ! i) ` {..<nc} \<subseteq> {0}" using permutes_imp_bij[OF f']
  by (metis cols_length f' length_map nc_def permutes_image)
  then have *: "?cs1 ! i = 0" if "i<nc" for i using that by blast
  then have "z $ i = 0" if "i<dim_vec z" for i using *[of "length ?ls + i"]
  by (metis (no_types, lifting) add_diff_cancel_left' add_less_cancel_left dim_vec_of_list
    index_append_vec(2) index_zero_vec(2) length_list_of_vec length_permute_list
    list_of_vec_append not_add_less1 nth_append nth_list_of_vec that zero)
  then show "z = 0\<^sub>v (dim_vec z)"
  by (metis eq_vecI index_zero_vec(1) index_zero_vec(2))
qed

lemma is_indep_distinct:
assumes "is_indep A"
shows "distinct (cols A)"
proof (rule ccontr)
  define nc where "nc = dim_col A"
  define nr where "nr = dim_row A"
  assume "\<not> distinct (cols A)"
  then obtain i j where ij: "i \<noteq> j" "i<nc" "j<nc" "col A i = col A j"
    unfolding nc_def by (metis cols_length cols_nth distinct_conv_nth)
  have "A *\<^sub>v (unit_vec nc i - unit_vec nc j) = 0\<^sub>v nr"
    by (smt (verit, ccfv_threshold) ij carrier_mat_triv col_dim col_map_mat col_unit_vec
      index_map_mat(2) index_map_mat(3) minus_cancel_vec mult_minus_distrib_mat_vec nc_def
      nr_def real_of_int_mat_def unit_vec_carrier)
  moreover have "dim_vec (unit_vec nc i - unit_vec nc j) = nc" by simp
  moreover have "(unit_vec nc i - unit_vec nc j) \<noteq> 0\<^sub>v nc" using ij
  by (smt (z3) assms calculation(1) calculation(2) index_minus_vec(1) index_unit_vec(1)
    index_unit_vec(3) index_zero_vec(1) is_indep_def nc_def nr_def)
  ultimately have "\<not> is_indep A" unfolding is_indep_def using nc_def nr_def
  by (smt (verit, ccfv_threshold) carrier_matI col_dim col_unit_vec minus_cancel_vec
    mult_minus_distrib_mat_vec unit_vec_carrier)
  then show False using assms by auto
qed

lemma span_base:
assumes "(a :: 'a :: {monoid_mult,semiring_0,zero_neq_one} vec) \<in> set_cols S"
shows "a \<in> span S"
proof -
  obtain i where "i<dim_col S" "a = col S i" using assms
  by (metis atLeastLessThan_iff imageE set_cols_col)
  then have "a = S *\<^sub>v (unit_vec (dim_col S) i)"
    using col_unit_vec[OF \<open>i<dim_col S\<close>, symmetric] by auto
  then show ?thesis unfolding span_def by auto
qed

text \<open>Representing function\<close>

definition representation :: "real mat \<Rightarrow> real vec \<Rightarrow> real vec \<Rightarrow> real"
  where "representation B v =
    (if is_indep B \<and> v \<in> (span B) then
      SOME f. (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> set_cols B) \<and>
        B *\<^sub>v (vec (dim_col B) (\<lambda>i. f (col B i))) = v
    else (\<lambda>b. 0))"

lemma unique_representation:
  assumes basis: "is_indep basis"
    and in_basis: "\<And>v. f v \<noteq> 0 \<Longrightarrow> v \<in> set_cols basis" "\<And>v. g v \<noteq> 0 \<Longrightarrow> v \<in> set_cols basis"
    and eq: "basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. f (col basis i))) =
            basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. g (col basis i)))"
  shows "f = g"
proof (rule ext, rule ccontr)
  fix v assume ne: "f v \<noteq> g v"
  then have in_col: "v \<in> set_cols basis" using in_basis by metis
  have "\<not> is_indep basis"
    unfolding is_indep_def
  proof (subst not_all, subst not_imp)
    let ?x = "vec (dim_col basis) (\<lambda>i. (f (col basis i)- g (col basis i)))"
    have  "\<exists>v\<in>set_cols basis. f v - g v \<noteq> 0"
      using ne in_col right_minus_eq by blast
    then have ex: "\<exists>i<dim_col basis. f (col basis i) - g (col basis i) \<noteq> 0"
      by (metis atLeastLessThan_iff imageE set_cols_col)
    have "basis *\<^sub>v (?x) =
          basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. f (col basis i))) -
          basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. g (col basis i)))"
    proof -
      have *: "?x = vec (dim_col basis) (\<lambda>i. f (col basis i)) -
        vec (dim_col basis) (\<lambda>i. g (col basis i))" unfolding minus_vec_def by auto
      show ?thesis unfolding *
      by (meson carrier_mat_triv mult_minus_distrib_mat_vec vec_carrier)
    qed
    then have "basis *\<^sub>v (?x) = 0\<^sub>v (dim_row basis)" using eq by auto
    moreover have "dim_vec ?x = dim_col basis"
    using dim_vec by blast
    moreover have "?x \<noteq> 0\<^sub>v (dim_col basis)" using ex
    by (metis (no_types, lifting) index_vec index_zero_vec(1))
    ultimately show "\<exists>x. (basis *\<^sub>v x = 0\<^sub>v (dim_row basis) \<and>
         dim_vec x = dim_col basis) \<and> x \<noteq> 0\<^sub>v (dim_vec x)"
         using real_of_int_vec_def by auto
  qed
  with basis show False by auto
qed

lemma
  shows representation_ne_zero: "\<And>b. representation basis v b \<noteq> 0 \<Longrightarrow> b \<in> set_cols basis"
    and sum_nonzero_representation_eq:
      "is_indep basis \<Longrightarrow> v \<in> span basis \<Longrightarrow>
      basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. representation basis v (col basis i))) = v"
proof -
  { assume basis: "is_indep basis" and v: "v \<in> span basis"
    define p where "p f \<longleftrightarrow>
      (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> set_cols basis) \<and>
      basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. f (col basis i))) = v" for f
    obtain z where z: "basis *\<^sub>v z = v" "dim_vec z = dim_col basis"
      using \<open>v \<in> span basis\<close> unfolding span_def by auto
    define r where "r = (\<lambda>v. if (\<exists>i<dim_col basis. v = col basis i)
      then z$(SOME i. i<dim_col basis \<and> v = col basis i) else 0)"
    then have "r (col basis i) = z$i" if "i<dim_col basis" for i
    proof -
      have "z $ (SOME j. j<dim_col basis \<and> col basis ia = col basis j) = z $ i"
        if "i < dim_col basis"
          "distinct (cols basis)"
          "ia < dim_col basis"
          "col basis i = col basis ia"
        for ia
      proof -
        have "i = ia" using that
        by (metis cols_length cols_nth distinct_conv_nth)
        obtain j where j: "j = (SOME j. j<dim_col basis \<and> col basis i = col basis j)" by blast
        then have "j<dim_col basis" "col basis i = col basis j"
        by (smt (verit, best) \<open>i = ia\<close> someI_ex that(3))
           (metis (mono_tags, lifting) j that(1) verit_sko_ex')
        then have "i = j" using that
        by (metis cols_length cols_nth distinct_conv_nth)
        then show ?thesis unfolding j(1)
        using that(4) by auto
      qed
      then show ?thesis
      unfolding r_def using that is_indep_distinct[OF basis] by auto
    qed
    then have "z = (vec (dim_col basis) (\<lambda>i. r (col basis i)))"
       using z(2) by auto
    then have *:
      "basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. r (col basis i))) = v"
      using z by auto
    define f where "f b = (if b \<in> set_cols basis then r b else 0)" for b
    have "p f"
      using * unfolding p_def f_def
      by (smt (verit, best) cols_length cols_nth dim_vec eq_vecI index_vec nth_mem set_cols)
    have *: "representation basis v = Eps p"
      by (simp add: p_def[abs_def] representation_def basis v)
    from someI[of p f, OF \<open>p f\<close>] have "p (representation basis v)"
      unfolding * . }
  note * = this

  show "representation basis v b \<noteq> 0 \<Longrightarrow> b \<in> set_cols basis" for b
    using * by (cases "is_indep basis \<and> v \<in> span basis") (auto simp: representation_def)

  show "is_indep basis \<Longrightarrow> v \<in> span basis \<Longrightarrow>
    basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. representation basis v (col basis i))) = v"
    using * by auto
qed

lemma sum_nonzero_representation_eq':
assumes "is_indep basis" "v \<in> span basis"
    "B = mat_of_cols (dim_row basis) (filter (\<lambda>b. representation basis v b\<noteq>0) (cols basis))"
shows "B *\<^sub>v (vec (dim_col B) (\<lambda>i. representation basis v (col B i))) = v"
oops

lemma representation_eqI:
  assumes basis: "is_indep basis" and b: "v \<in> span basis"
    and ne_zero: "\<And>b. f b \<noteq> 0 \<Longrightarrow> b \<in> set_cols basis"
    and eq: "basis *\<^sub>v (vec (dim_col basis) (\<lambda>i. f (col basis i))) = v"
  shows "representation basis v = f"
  by (rule unique_representation[OF basis])
     (auto simp: representation_ne_zero
      sum_nonzero_representation_eq[OF basis b] ne_zero eq simp del: set_cols)

lemma representation_extend:
  assumes basis: "is_indep basis" and v: "v \<in> span basis'"
    and basis': "set_cols basis' \<subseteq> set_cols basis" and d: "dim_row basis = dim_row basis'"
    and dc: "distinct (cols basis')"
  shows "representation basis v = representation basis' v"
proof (rule representation_eqI[OF basis])
  show v': "v \<in> span basis" using span_mono[OF basis' d[symmetric] dc] v by auto
  have *: "is_indep basis'" using is_indep_mono[OF basis' basis dc d] by (auto)
  show "representation basis' v b \<noteq> 0 \<Longrightarrow> b \<in> set_cols basis" for b
    using representation_ne_zero basis' by auto
  have dim_row: "dim_row basis' = dim_row basis"
    by (metis "*" Lattice_int.sum_nonzero_representation_eq basis dim_mult_mat_vec v v')
  show "basis *\<^sub>v vec (dim_col basis) (\<lambda>i. representation basis' v (col basis i)) = v "
  proof -
    have not_in': "representation basis' v b = 0" if "b \<notin> set_cols basis'" for b
    using Lattice_int.representation_ne_zero that by blast
    let ?vec = "vec (dim_row basis) (\<lambda>i. \<Sum>ia = 0..<dim_vec
        (vec (dim_col basis) (\<lambda>i. Lattice_int.representation basis' v (col basis i))).
         row basis i $ ia * vec (dim_col basis)
            (\<lambda>i. Lattice_int.representation basis' v (col basis i)) $ ia)"
    have dim_v: "dim_vec v = dim_row basis"
    using Lattice_int.span_def dim_row v by force
    have "v= ?vec"
    proof (subst eq_vecI[of v ?vec], goal_cases)
      case (1 i)
      obtain ids where ids: "distinct ids" "set ids \<subseteq> {..<length (cols basis)}"
        and ss: "cols basis' = map ((!) (cols basis)) ids"
      using distinct_list_subset_nths[OF dc, of "cols basis"] basis' set_cols by blast
      define ls where "ls = map ((!) (cols basis))
        (filter (\<lambda>i. i \<notin> set ids) [0..<length (cols basis)])"
      from subindex_permutation2[OF ids] obtain p where
        p: "p permutes {..<length (cols basis)}"
        "cols basis = permute_list p (ls @ (cols basis'))" unfolding ls_def using ss by metis
      then have p_i: "col basis i = (ls @ (cols basis')) ! (p i)" if "i<length (cols basis)" for i
        by (metis cols_length cols_nth length_permute_list permute_list_nth that)
      have len_ls: "length ls \<le> length (cols basis)"
      by (metis length_append length_permute_list linorder_not_less not_add_less1 p(2))
      have in_ls: "col basis j = ls ! (p j)" if "j \<in> p -` {0..<length ls}" for j
        using p_i
        by (metis atLeastLessThan_upt len_ls lessThan_atLeast0 lessThan_iff lessThan_subset_iff
          nth_append p(1) permutes_in_image subset_code(1) that vimageE)
      have not_in_ls: "col basis j = (cols basis') ! (p j - length ls)"
        if "j \<in> p -` {length ls..<length (cols basis)}" for j
      proof -
        have "(ls @ (cols basis')) ! (p j) = (cols basis') ! (p j - length ls)" using that
        by (meson atLeastLessThan_iff leD nth_append vimage_eq)
        then show ?thesis using p_i[of j] that
        by (metis (mono_tags, lifting) atLeastLessThan_iff lessThan_iff p(1) permutes_def vimageE)
      qed
      have distinct: "distinct (cols basis)" using is_indep_distinct[OF basis] .

      have ls_in_basis: "set ls \<subseteq> set_cols basis" unfolding set_cols ls_def
        by (auto, metis cols_length cols_nth nth_mem)
      have ls_not_in_basis': "(set ls) \<inter> (set_cols basis') = {}"
      proof (subst disjoint_iff, intro allI, intro impI)
        fix x assume "x \<in> set ls"
        then obtain j where j: "col basis j = x" using ls_in_basis
        by (metis imageE set_cols_col subsetD)
        then have "j \<notin> set ids"using \<open>x\<in>set ls\<close> unfolding ls_def
        by (smt (verit, del_insts) atLeastLessThan_iff atLeast_upt cols_length cols_nth distinct
          distinct_conv_nth ids(2) imageE list.set_map mem_Collect_eq set_filter set_upt subsetD)
        then show "x \<notin> set_cols basis'" unfolding set_cols ss j[symmetric]
        by (smt (verit, ccfv_threshold) \<open>x \<in> set ls\<close> atLeast_upt distinct distinct_conv_nth ids(2)
          in_set_conv_nth j length_map lessThan_iff ls_def mem_Collect_eq nth_map nth_mem
          set_filter subsetD)
      qed

      have rep: "representation basis' v = (SOME f. (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> set_cols basis') \<and>
             basis' *\<^sub>v vec (dim_col basis') (\<lambda>i. f (col basis' i)) = v) "
        unfolding representation_def using \<open>is_indep basis'\<close> \<open>v\<in>span basis'\<close> by auto
      then obtain f where some_f: "f = (SOME f. (\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> set_cols basis') \<and>
         basis' *\<^sub>v vec (dim_col basis') (\<lambda>i. f (col basis' i)) = v)" by blast
      then have f: "\<forall>v. f v \<noteq> 0 \<longrightarrow> v \<in> set_cols basis'"
        "basis' *\<^sub>v vec (dim_col basis') (\<lambda>i. f (col basis' i)) = v"
        apply (metis not_in' rep)
        by (metis "*" Lattice_int.sum_nonzero_representation_eq rep some_f v)
      then have rep_f: "representation basis' v = f" using rep some_f by auto
      have not_in_f: "f b = 0" if "b \<notin> set_cols basis' " for b using not_in'
        using f(1) that by blast
      have f_ls_0: "f (ls ! j) = 0" if "j<length ls" for j
        apply (subst not_in_f) using ls_not_in_basis' nth_mem that by auto

      have "?vec $ i = vec (dim_vec v) (\<lambda>i. \<Sum>ia = 0..<dim_col basis.
             row basis i $ ia * vec (dim_col basis) (\<lambda>j. f (col basis j)) $ ia) $ i"
        using dim_v[symmetric] rep_f by auto
      also have "\<dots> = (\<Sum>ia = 0..<dim_col basis.
             row basis i $ ia * vec (dim_col basis) (\<lambda>j. f (col basis j)) $ ia)"
        using \<open>i<dim_vec v\<close> by auto
      also have "\<dots> = (\<Sum>ia = 0..<length (cols basis). basis $$ (i, ia) * (f (col basis ia)))"
        using "1" dim_v by force
      also have "\<dots> = (\<Sum>ia \<in> p -` {0..<length (cols basis)}.
        (col basis ia $ i) * (f (col basis ia)))"
        using "1" dim_v p(1) by (simp add: atLeast0LessThan permutes_vimage)
      also have "\<dots> = (\<Sum>ia \<in> p -` {0..<length ls} \<union> p -` {length ls..<length (cols basis)}.
        (col basis ia $ i) * (f (col basis ia)))"
        by (metis (no_types, lifting) bot_nat_0.extremum ivl_disj_un_two(3) len_ls vimage_Un)
      also have "\<dots> = (\<Sum>ia \<in> p -` {0..< length ls}. (col basis ia $ i) * (f (col basis ia))) +
        (\<Sum>ia \<in> p -` {length ls..<length (cols basis)}. (col basis ia $ i) * (f (col basis ia)))"
      proof (subst sum.union_disjoint, goal_cases)
        case 1 then show ?case
        by (metis (no_types, lifting) atLeast_upt len_ls lessThan_subset_iff p(1)
          permutes_vimage set_upt subset_eq_atLeast0_lessThan_finite vimage_mono)
      next
        case 2 then show ?case
        by (metis (no_types, lifting) atLeast0LessThan diff_is_0_eq' diff_le_self
          finite_nat_iff_bounded ivl_subset length_map length_upt map_nth p(1) permutes_vimage
          vimage_mono)
      qed auto
      also have "\<dots> = (\<Sum>ia \<in> {0..<length (cols basis')}.
            (col basis' (ia) $ i) * (f (col basis' (ia))))"
      proof -
        have "(\<Sum>ia \<in> p -` {0..< length ls}. (col basis ia $ i) * (f (col basis ia))) =
              (\<Sum>ia \<in> p -` {0..< length ls}. (ls ! (p ia) $ i) * (f (ls ! (p ia))))"
          using in_ls by force
        moreover have "\<dots> = (\<Sum>ia \<in> {0..< length ls}. (ls ! ia $ i) * (f (ls ! ia)))"
        proof -
          have inj: "inj_on p (p -` {0..<length ls})"
            by (metis inj_onI p(1) permutes_def)
          have "p ` p -` {0..<length ls} = {0..<length ls}"
          by (metis p(1) permutes_def surj_def surj_image_vimage_eq)
          then show ?thesis using sum.reindex[OF inj,of "(\<lambda>j. ls ! j $ i * f (ls ! j))", symmetric]
             unfolding comp_def by auto
        qed
        moreover have "\<dots> = 0"  by (simp add: f_ls_0)
        ultimately have "(\<Sum>ia \<in> p -` {0..< length ls}. (col basis ia $ i) * (f (col basis ia)))
           = 0" by auto

        moreover have "(\<Sum>ia \<in> p -` {length ls..<length (cols basis)}. (col basis ia $ i) *
            (f (col basis ia))) =
          (\<Sum>ia \<in> p -` {length ls..<length (cols basis)}. (col basis' (p ia -length ls) $ i) *
            (f (col basis' (p ia -length ls))))"
        proof -
          have "(col basis ia $ i) * (f (col basis ia)) = (col basis' (p ia -length ls) $ i) *
            (f (col basis' (p ia -length ls)))" if "ia \<in> p -` {length ls..<length (cols basis)}"
          for ia  using not_in_ls[OF that]
          by (metis add_diff_cancel_left' atLeastLessThan_iff cols_length cols_nth diff_less_mono
            length_append length_permute_list p(2) that vimageD)
          then show ?thesis by simp
        qed
        moreover have "\<dots> = (\<Sum>ia \<in> {length ls..<length (cols basis)}. (col basis' (ia -length ls) $ i) *
            (f (col basis' (ia -length ls))))"
        proof -
          have inj: "inj_on p (p -` {length ls..<length (cols basis)})"
            by (metis inj_onI p(1) permutes_def)
          have "p ` p -` {length ls..<length (cols basis)} = {length ls..<length (cols basis)}"
          by (metis p(1) permutes_def surj_def surj_image_vimage_eq)
          then show ?thesis using sum.reindex[OF inj,of "(\<lambda>j. col basis' (j - length ls) $ i *
            f (col basis' (j - length ls)))", symmetric]
             unfolding comp_def by auto
        qed
        moreover have "\<dots> = (\<Sum>ia \<in> {length ls..<length ls + length (cols basis')}.
            (col basis' (ia -length ls) $ i) * (f (col basis' (ia -length ls))))"
          by (simp add: p(2))
        moreover have "\<dots> = (\<Sum>ia \<in> {0..<length (cols basis')}.
            (col basis' (ia) $ i) * (f (col basis' (ia))))"
        proof -
          have inj: "inj_on (\<lambda>j. j-length ls) {length ls..<length ls + length (cols basis')}"
            using inj_on_diff_nat by fastforce
          have "x \<in> (\<lambda>x. x - length ls) ` {length ls..<length ls + dim_col basis'}"
            if "x < dim_col basis'" for x using that
            by (metis add_diff_cancel_left' atLeastLessThan_iff image_eqI linorder_not_less
              nat_add_left_cancel_less not_add_less1)
          then have "(\<lambda>j. j - length ls) ` {length ls..<length ls + length (cols basis')} =
            {0..<length (cols basis')}"
            by auto
          then show ?thesis using sum.reindex[OF inj,
            of "(\<lambda>ia. col basis' ia $ i * f (col basis' ia))", symmetric]
             unfolding comp_def by auto
        qed
        ultimately show ?thesis by auto
      qed

      also have "\<dots> = (\<Sum>ia \<in> {0..<length (cols basis')}.
          (basis' $$ (i, ia)) * (f (col basis' (ia))))"
          using "1" dim_row dim_v by auto
      also have "\<dots> = (\<Sum>ia \<in> {0..<length (cols basis')}.
          (row basis' i $ ia) * (f (col basis' (ia))))"
          using "1" dim_row dim_v by force
      also have "\<dots> = (\<Sum>ia \<in> {0..<length (cols basis')}.
          (row basis' i $ ia) * vec (dim_col basis') (\<lambda>j. f (col basis' j)) $ ia)" by force
      also have "\<dots> = (row basis' i) \<bullet> vec (dim_col basis') (\<lambda>j. f (col basis' j))"
      by (simp add: scalar_prod_def)
      also have "\<dots> = vec (dim_vec v) (\<lambda>i. (row basis' i) \<bullet>
        vec (dim_col basis') (\<lambda>j. f (col basis' j))) $ i" by (simp add: "1")
      also have "\<dots> = (basis' *\<^sub>v vec (dim_col basis') (\<lambda>j. f (col basis' j))) $ i"
        unfolding mult_mat_vec_def using d dim_v by presburger
      also have "\<dots> = v $ i" using f(2) by blast
      finally have "?vec $ i = v $ i" by blast
      then show ?case by auto
    next
      case (2)
      then show ?case using dim_v by auto
    qed (auto)
    then show ?thesis unfolding mult_mat_vec_def scalar_prod_def by auto
  qed
qed

lemma representation_basis:
  assumes basis: "is_indep basis" and b: "b \<in> set_cols basis"
  shows "representation basis b = (\<lambda>v. if v = b then 1 else 0)"
proof (rule unique_representation[OF basis])
  show "representation basis b v \<noteq> 0 \<Longrightarrow> v \<in> set_cols  basis" for v
    using representation_ne_zero .
  show "(if v = b then 1 else 0) \<noteq> 0 \<Longrightarrow> v \<in> set_cols basis" for v
    using b by (cases "v = b") (auto simp: b)
  have *: "{v. (if v = b then 1 else 0::int) \<noteq> 0} = {b}"
    by auto
  obtain j where j: "col basis j = b" "j<dim_col basis"
  by (metis atLeastLessThan_iff b imageE set_cols_col)
  have dis: "distinct (cols basis)" using basis is_indep_distinct by simp
  have unit: "vec (dim_col basis) (\<lambda>i. if col basis i = b then 1 else 0) =
    unit_vec (dim_col basis) j" (is "?l = ?r")
  proof (subst eq_vecI[of ?l ?r], goal_cases)
    case (1 i)
    then show ?case using dis j
    by (smt (verit, best) cols_length cols_nth dim_vec distinct_conv_nth index_unit_vec(1)
      index_vec)
  qed  auto
  show "basis *\<^sub>v vec (dim_col basis) (\<lambda>i. Lattice_int.representation basis b (col basis i)) =
    basis *\<^sub>v vec (dim_col basis) (\<lambda>i. if col basis i = b then 1 else 0)"
    using * sum_nonzero_representation_eq[OF basis span_base[OF b]] unfolding unit
    by (subst col_unit_vec, simp add: j, unfold j(1), simp)
qed

lemma mat_mult_eq_vec_eq:
assumes "A *\<^sub>v v = A *\<^sub>v w" "dim_vec v = dim_col A" "dim_vec w = dim_col A"
  "is_indep A"
shows "v = w"
oops

lemma spanning_subset_independent:
assumes BA: "set_cols B \<subseteq> set_cols A" and iA: "is_indep A"
  and AsB:"set_cols A \<subseteq> span B"
  and d: "distinct (cols B)" and dr: "dim_row A = dim_row B"
shows "set_cols A = set_cols B"
proof (intro antisym[OF _ BA] subsetI)
  have iB: "is_indep B" using is_indep_mono[OF BA iA d dr] .
  fix v assume "v \<in> set_cols A"
  with AsB have "v \<in> span B" by auto
  let ?RB = "representation B v" and ?RA = "representation A v"
  have "?RB v = 1"
    unfolding representation_extend[OF iA \<open>v \<in> span B\<close> BA dr d, symmetric]
      representation_basis[OF iA \<open>v \<in> set_cols A\<close>] by simp
  then show "v \<in> set_cols B"
    using representation_ne_zero[of B v v] by auto
qed

lemma nth_lin_combo:
assumes "i < dim_row A" "dim_col A = dim_vec b"
shows "(A *\<^sub>v b) $ i = (\<Sum>j=0..<dim_col A. A $$ (i,j) * b $ j)"
using assms unfolding mult_mat_vec_def scalar_prod_def by auto

text \<open>insert and delete with span\<close>

lemma dim_col_insert_col:
  "dim_col (insert_col S a) = dim_col S + 1"
by (simp add: insert_col)

lemma dim_col_delete_col:
assumes "a \<in> set_cols S" "distinct (cols S)" "dim_vec a = dim_row S"
shows "dim_col (delete_col S a) = dim_col S - 1"
proof -
  have *: "{x. x \<noteq> a} \<inter> set (cols S) = set (cols S) - {a}" by fastforce
  have "length (filter (\<lambda>x. x \<noteq> a) (cols S)) = length (cols S) - 1"
    unfolding distinct_length_filter[OF \<open>distinct (cols S)\<close>] *
    by (metis assms(1) assms(2) card_Diff_singleton distinct_card set_cols)
  then have "length (cols (delete_col S a)) = length (cols S) - 1"
    unfolding delete_col by auto
  then show ?thesis by (metis cols_length)
qed

lemma dim_row_delete_col:
  "dim_row (delete_col T b) = dim_row T"
by (simp add: delete_col)

lemma span_insert1:
assumes "dim_vec (a :: 'a ::comm_ring vec) = dim_row S"
shows "span (insert_col S a) = {x. \<exists>k y. x = y + k \<cdot>\<^sub>v a \<and> y \<in> span S \<and> dim_vec x = dim_row S}"
unfolding span_def proof (safe, goal_cases)
  case (1 x z)
  obtain za zs where z: "z = vCons za zs"
  by (metis "1" add_Suc_right dim_vec insert_col list.size(4) mat_of_cols_carrier(3)
    nat.simps(3) vec_cases)
  have "dim_vec z = dim_col S + 1" using 1 by (simp add: insert_col)
  then have *: "dim_vec zs = dim_col S" using z by auto
  have "mat_of_cols (dim_row S) (a # cols S) *\<^sub>v vCons za zs = S *\<^sub>v zs + za \<cdot>\<^sub>v a"
  proof (subst mat_of_cols_cons_mat_vec, goal_cases one two three)
    case one
    then show ?case using * by (metis carrier_vec_dim_vec cols_length)
  next
    case three
    then show ?case
    by (simp add: assms comm_add_vec mult_mat_vec_def smult_vec_def)
  qed (use assms in \<open>auto\<close>)
  moreover have "S *\<^sub>v zs \<in> span S" unfolding span_def using * by auto
  moreover have "dim_vec (mat_of_cols (dim_row S) (a # cols S) *\<^sub>v vCons za zs) =
        dim_row S" by auto
  ultimately show ?case unfolding z insert_col using "*" by blast
next
  case (2 x k y z)
  have "S *\<^sub>v z + k \<cdot>\<^sub>v a = mat_of_cols (dim_row S) (cols S) *\<^sub>v z + k \<cdot>\<^sub>v a" by simp
  moreover have "mat_of_cols (dim_row S) (cols S) *\<^sub>v z + k \<cdot>\<^sub>v a =
    mat_of_cols (dim_row S) (a # cols S) *\<^sub>v (vCons k z)"
  proof (subst mat_of_cols_cons_mat_vec, goal_cases one two three)
    case one
    then show ?case using 2
    by (metis carrier_vec_dim_vec cols_length)
  next
    case three
    then show ?case
    by (simp add: assms comm_add_vec mult_mat_vec_def smult_vec_def)
  qed (use assms in \<open>auto\<close>)
  moreover have "dim_vec (vCons k z) = dim_col (insert_col S a)"
    using 2 by (simp add: insert_col)
  ultimately show ?case unfolding insert_col by auto
qed

lemma span_insert2:
assumes "dim_vec a = dim_row S"
shows "span (insert_col S (a :: 'a ::comm_ring vec)) =
    {x. \<exists>k. (x - k \<cdot>\<^sub>v a) \<in> span S \<and> dim_vec x = dim_row S}"
proof -
  have "span (insert_col S a) = {x. \<exists>k y. x = y + k \<cdot>\<^sub>v a \<and> y \<in> span S \<and> dim_vec x = dim_row S}"
    using span_insert1[OF assms] by auto
  moreover have "{x. \<exists>k y. x = y + k \<cdot>\<^sub>v a \<and> y \<in> span S  \<and> dim_vec x = dim_row S} =
      {x. \<exists>k. x - k \<cdot>\<^sub>v a \<in> Lattice_int.span S \<and> dim_vec x = dim_row S}"
  proof (safe, goal_cases)
    case (1 x k y)
    then have i: "y + ((k \<cdot>\<^sub>v a) - (k \<cdot>\<^sub>v a)) \<in> Lattice_int.span S"
    by (smt (verit, ccfv_SIG) Lattice_int.span_def assms dim_carrier mem_Collect_eq
      minus_cancel_vec right_zero_vec smult_vec_def vec_carrier)
    have rew: "y + ((k \<cdot>\<^sub>v a) - (k \<cdot>\<^sub>v a)) = (y + (k \<cdot>\<^sub>v a)) - (k \<cdot>\<^sub>v a) "
      using assoc_add_vec[of y _ "k \<cdot>\<^sub>v a" "- k \<cdot>\<^sub>v a" ] by auto
    show ?case using i unfolding rew using assms by auto
  next
    case (2 x k)
    have "x = x + (k \<cdot>\<^sub>v a - k \<cdot>\<^sub>v a)" using "2"(2) assms by auto
    then have "x = (x - k \<cdot>\<^sub>v a) + k \<cdot>\<^sub>v a"
      using assoc_add_vec[of x _ "- k \<cdot>\<^sub>v a" "k \<cdot>\<^sub>v a" ]
      using "2"(2) assms by auto
    moreover have "(x - k \<cdot>\<^sub>v a) \<in> Lattice_int.span S"  using "2"(1) by blast
    ultimately show ?case using 2 by auto
  qed
  ultimately show ?thesis by auto
qed

lemma insert_delete_span:
assumes "(a :: 'a ::comm_ring vec) \<in> set_cols A" "distinct (cols A)" "dim_vec a = dim_row A"
shows "span (insert_col (delete_col A a) a) = span (A)"
unfolding span_def
proof (safe, goal_cases)
  case (1 x z)
  define nr where "nr = dim_row A"
  define nc where "nc = dim_col A"
  obtain c where c: "mat_of_cols nr (a # cols (delete_col A a)) *\<^sub>v z = A *\<^sub>v c"
          "dim_vec c = nc"
  proof (subst helper3[where A = A and nr = nr and nc = nc and ss = "a # cols (delete_col A a)"
    and v = z], goal_cases)
    case 2
    then show ?case using assms(2) unfolding delete_col
    by (metis (mono_tags, lifting) cols_dim cols_mat_of_cols distinct.simps(2) distinct_filter
    dual_order.trans filter_is_subset mem_Collect_eq set_filter)
  next
    case 3
    then show ?case using assms(1)
    by (metis (mono_tags, lifting) cols_dim cols_mat_of_cols delete_col filter_is_subset in_mono
      set_ConsD set_cols subsetI)
  next
    case 4
    then show ?case using 1
    by (metis carrier_vecI insert_col mat_of_cols_carrier(3))
  qed (auto simp add: nc_def nr_def)
  then show ?case unfolding nr_def nc_def
    by (metis delete_col insert_col mat_of_cols_carrier(2) mat_of_cols_cols nc_def nr_def)
next
  case (2 x z)
  define nr where "nr = dim_row A"
  define nc where "nc = dim_col A"
  have gr0: "dim_col A > 0" using assms(1)
  by (metis atLeastLessThan_iff bot_nat_0.not_eq_extremum cols_def imageE less_nat_zero_code
    list.set_map set_cols set_upt)
  obtain c where c: "mat_of_cols nr (cols A) *\<^sub>v z = insert_col (delete_col A a) a *\<^sub>v c"
          "dim_vec c = nc"
  proof (subst helper3[where A = "insert_col (delete_col A a) a" and nr = nr and nc = nc
    and ss = "cols A"  and v = z], goal_cases)
    case 1
    have "dim_row (insert_col (delete_col A a) a) = dim_row A"
    by (simp add: delete_col insert_col)
    moreover have "dim_col (insert_col (delete_col A a) a) = dim_col A"
      unfolding dim_col_insert_col dim_col_delete_col[OF assms] using gr0 by simp
    ultimately show ?case unfolding nr_def nc_def by auto
  next
    case 3
    show ?case using assms(1) unfolding insert_col delete_col
    proof (subst cols_mat_of_cols, goal_cases)
      case 1
      have "a \<in> set (cols A) \<Longrightarrow> a \<in> carrier_vec (dim_row A)"
        using assms(3) carrier_vecI by blast
      moreover have "x \<in> set (cols (delete_col A a)) \<Longrightarrow> x \<in> carrier_vec (dim_row A)" for x
         by (metis cols_dim delete_col mat_of_cols_carrier(2) subsetD)
      ultimately show ?case
      by (metis "1" cols_dim insert_subset list.set(2) mat_of_cols_carrier(2) nr_def set_cols)

    next
      case 2
      then show ?case
      by (smt (verit, best) cols_dim cols_mat_of_cols filter_set insert_iff list.set(2)
        member_filter subsetI subset_trans)
    qed
  next
    case 4
    then show ?case using 2 by (metis carrier_vec_dim_vec cols_length)
  qed (auto simp add: nc_def nr_def assms)
  then show ?case unfolding nr_def nc_def
  by (metis Suc_eq_plus1 Suc_pred' assms(1) assms(2) assms(3) dim_col_delete_col
    dim_col_insert_col gr0 mat_of_cols_cols)
qed

lemma span_breakdown:
  assumes bS: "(b :: 'a :: comm_ring vec) \<in> set_cols S"
    and aS: "a \<in> span S"
    and b: "dim_vec b = dim_row S"
    and d: "distinct (cols S)"
  shows "\<exists>k. a - k \<cdot>\<^sub>v b \<in> span (delete_col S b)"
proof -
  have r: "dim_vec b = dim_row (delete_col S b)"
  by (simp add: b delete_col)
  have s: "span (insert_col (delete_col S b) b) = span S"
    by (subst insert_delete_span[OF bS d b], auto)
  have "span S = {x. \<exists>k. x - k \<cdot>\<^sub>v b \<in> Lattice_int.span (delete_col S b) \<and>
            dim_vec x = dim_row (delete_col S b)}"
    using span_insert2 [of b "delete_col S b"] r unfolding s by auto
  then show ?thesis using assms by auto
qed

lemma uminus_scalar_mult:
  "(-k) \<cdot>\<^sub>v a = - (k \<cdot>\<^sub>v (a:: 'a ::comm_ring_1 vec))"
unfolding smult_vec_def
by (subst eq_vecI[of "vec (dim_vec a) (\<lambda>i. - k * a $ i)" "- vec (dim_vec a) (\<lambda>i. k * a $ i)"])
   auto

lemma span_scale: "(x :: 'a ::field vec) \<in> span S \<Longrightarrow> c \<cdot>\<^sub>v x \<in> span S"
unfolding span_def
proof safe
  fix z assume *: "dim_vec z = dim_col S" "x = S *\<^sub>v z"
  show "\<exists>za. c \<cdot>\<^sub>v (S *\<^sub>v z) = S *\<^sub>v za \<and> dim_vec za = dim_col S"
  proof (intro exI[of _ "c \<cdot>\<^sub>v z"], safe, goal_cases)
    case 1
    show ?case by (metis "*"(1) carrier_mat_triv carrier_vec_dim_vec mult_mat_vec)
  next
    case 2
    show ?case by (simp add: "*"(1))
  qed
qed

lemma span_diff:
assumes "(x :: 'a::ring vec) \<in> span S" "y \<in> span S"
    "x \<in> carrier_vec (dim_row S)" "y \<in> carrier_vec (dim_row S)"
shows "x - y \<in> span S"
using assms unfolding span_def
proof (safe, goal_cases)
  case (1 zx zy)
  then have "zx \<in> carrier_vec (dim_col S)" "zy \<in> carrier_vec (dim_col S)"
    by (metis carrier_vec_dim_vec)+
  then have "S *\<^sub>v zx - S *\<^sub>v zy = S *\<^sub>v (zx - zy)"
   by (subst mult_minus_distrib_mat_vec[where A = S and v = zx and w = zy, symmetric], auto)
  moreover have "dim_vec (zx-zy) = dim_col S" using 1 by auto
  ultimately show ?case by auto
qed

lemma in_span_insert:
  assumes a: "(a :: 'a ::field vec) \<in> span (insert_col S b)"
    and na: "a \<notin> span S"
    and br: "dim_vec b = dim_row S"
    and bnotS: "b \<notin> set_cols S"
    and d: "distinct (cols S)"
  shows "b \<in> span (insert_col S a)"
using assms
proof -
  define nr where "nr = dim_row S"
  have carrier_a: "a \<in> carrier_vec nr"
    using a br carrier_dim_vec nr_def span_insert2 by fastforce
  have carrier_b: "b \<in> carrier_vec nr"
    by (simp add: br carrier_vecI nr_def)
  have bi: "b \<in> set_cols (insert_col S b)"
    by (simp add: br carrier_dim_vec insert_col)
  have br': "dim_vec b = dim_row (insert_col S b)" using br
    by (simp add: insert_col)
  have di: "distinct (cols (insert_col S b))" using d bnotS
    by (metis br carrier_vec_dim_vec cols_dim cols_mat_of_cols distinct.simps(2) insert_col
    insert_subset list.simps(15) set_cols)
  from span_breakdown[of b "insert_col S b" a, OF bi a br' di]
  obtain k where k: "a - k \<cdot>\<^sub>v b \<in> span (delete_col S b)"
  by (smt (verit, best) assms(1) bnotS br delete_col filter_True mat_of_cols_cols
      mem_Collect_eq set_cols span_insert2)
  have "k \<noteq> 0"
  proof
    assume "k = 0"
    have s: "set_cols (delete_col S b) \<subseteq> set_cols S"
    by (metis (no_types, lifting) cols_dim cols_mat_of_cols delete_col dual_order.trans
      filter_is_subset set_cols)
    have r: "dim_row (delete_col S b) = dim_row S"  by (simp add: delete_col)
    have dc: "distinct (cols (delete_col S b))"
    by (metis cols_dim cols_mat_of_cols d delete_col distinct_filter dual_order.trans
      filter_is_subset)
    have "a = a - k \<cdot>\<^sub>v b" using \<open>k = 0\<close>
      using a br carrier_dim_vec span_insert2 by fastforce
    then have "a \<in> Lattice_int.span (delete_col S b)" using k by auto
    then have "a \<in> span S" using span_mono[of "delete_col S b" S, OF s r dc] by auto
    with na show False by blast
  qed
  then have eq: "b = (1/k) \<cdot>\<^sub>v a - (1/k) \<cdot>\<^sub>v (a - k \<cdot>\<^sub>v b)"
  proof -
    have carrier_kb: "- k \<cdot>\<^sub>v b \<in> carrier_vec nr" using carrier_b by simp
    have "1 / k \<cdot>\<^sub>v (- k \<cdot>\<^sub>v b) = -b" by (subst smult_smult_assoc, use \<open>k\<noteq>0\<close> in \<open>auto\<close>)
    then have "(1/k) \<cdot>\<^sub>v (a + (- k \<cdot>\<^sub>v b)) = ((1/k) \<cdot>\<^sub>v a - b)"
    by (subst smult_add_distrib_vec[where a = "1/k" and v = a and w = "-k\<cdot>\<^sub>v b",
      OF carrier_a carrier_kb], auto)
    then have *: "(1/k) \<cdot>\<^sub>v (a - k \<cdot>\<^sub>v b) = ((1/k) \<cdot>\<^sub>v a - b)" unfolding uminus_scalar_mult
      by (metis carrier_a carrier_b minus_add_uminus_vec smult_carrier_vec)
    have **: "(1/k) \<cdot>\<^sub>v a - (1/k) \<cdot>\<^sub>v (a - k \<cdot>\<^sub>v b) = (1/k) \<cdot>\<^sub>v a - (1/k) \<cdot>\<^sub>v a + b" unfolding *
      using carrier_a carrier_b by auto
    then show ?thesis unfolding ** using carrier_a carrier_b by auto
  qed
  from k have k2: "(1/k) \<cdot>\<^sub>v (a - k \<cdot>\<^sub>v b) \<in> span (delete_col S b)"
    by (rule span_scale)
  have sub: "span (delete_col S b) \<subseteq> span (insert_col S a)"
  proof (subst span_mono, goal_cases)
    case 1
    then show ?case
    by (smt (verit, best) carrier_a cols_dim cols_mat_of_cols delete_col dual_order.refl
    dual_order.trans filter_is_subset insert_col insert_subset list.set(2) nr_def set_cols)
  next
    case 2
    then show ?case by (simp add: delete_col insert_col)
  next
    case 3
    then show ?case by (metis cols_dim cols_mat_of_cols d delete_col distinct_filter
      dual_order.trans filter_is_subset set_cols)
  qed auto
  then have "(1/k) \<cdot>\<^sub>v (a - k \<cdot>\<^sub>v b) \<in> span (insert_col S a)" using k2 sub by blast
  moreover have "1 / k \<cdot>\<^sub>v a \<in> span (insert_col S a)"
  by (metis Lattice_int.span_base Lattice_int.span_scale carrier_a cols_dim cols_mat_of_cols
    insertCI insert_col insert_subsetI list.set(2) nr_def set_cols)
  ultimately show ?thesis by (subst eq)
    (metis Lattice_int.span_diff br carrier_a carrier_vecD carrier_vec_dim_vec
      index_minus_vec(2) index_smult_vec(2) insert_col mat_of_cols_carrier(2) nr_def)
qed

lemma delete_not_in_set_cols:
assumes "b \<notin> set_cols T"
shows "delete_col T b = T"
unfolding delete_col using assms
by (metis (mono_tags, lifting) filter_True mat_of_cols_cols set_cols)

lemma delete_col_span:
assumes "(a :: 'a ::comm_ring vec) \<in> span (delete_col T b)" "distinct (cols T)"
shows "a \<in> span T"
using assms  using span_mono[of "delete_col T b" T]
by (metis (no_types, lifting) cols_dim cols_mat_of_cols delete_col distinct_filter
  dual_order.trans filter_is_subset in_mono mat_of_cols_carrier(2) set_cols)

lemma in_span_delete_field:
assumes aT:"(a :: 'a :: field vec) \<in> span T" and aTb: "a \<notin> span (delete_col T b)"
  and dr: "dim_vec b = dim_row T" and d:"distinct (cols T)"
shows "b \<in> span (insert_col (delete_col T b) a)"
proof (subst in_span_insert[of a "delete_col T b" b], goal_cases)
  case 1
  then show ?case proof (cases "b\<in>set_cols T")
    case True
    show ?thesis using aT insert_delete_span[OF True d dr] by (simp)
  next
    case False
    then show ?thesis by (metis assms(1) assms(2) delete_not_in_set_cols)
  qed
  case 4
  then show ?case
  by (smt (verit) cols_dim cols_mat_of_cols delete_col dual_order.trans filter_is_subset
    filter_set member_filter set_cols)
next
  case 5
  then show ?case
  by (metis cols_dim cols_mat_of_cols d delete_col distinct_filter dual_order.trans
    filter_is_subset)
qed (use assms in \<open>auto simp add: dim_row_delete_col\<close>)

lemma in_span_delete_int:
assumes aT:"(a :: int vec) \<in> span T" and aTb: "a \<notin> span (delete_col T b)"
  and dr: "dim_vec b = dim_row T" and d:"distinct (cols T)"
shows "b \<in> span (insert_col (delete_col T b) a)"
proof -
  have "(real_of_int_vec b) \<in>
    span (insert_col (delete_col (real_of_int_mat T) (real_of_int_vec b)) (real_of_int_vec a))"
  using in_span_delete_field
oops

lemma mat_of_cols_mult_vCons:
assumes "dim_vec (x :: 'a ::comm_ring vec) = dim_row S" "dim_vec zs = dim_col S"
shows "mat_of_cols (dim_row S) (x # cols S) *\<^sub>v vCons z0 zs = z0 \<cdot>\<^sub>v x + S *\<^sub>v zs"
using assms carrier_vec_dim_vec[of zs]
unfolding assms(2) by (subst mat_of_cols_cons_mat_vec, auto)

lemma mult_mat_vec_ring:
  assumes m: "(A::'a::comm_ring mat) \<in> carrier_mat nr nc" and v: "v \<in> carrier_vec nc"
  shows "A *\<^sub>v (k \<cdot>\<^sub>v v) = k \<cdot>\<^sub>v (A *\<^sub>v v)" (is "?l = ?r")
proof
  have nr: "dim_vec ?l = nr" using m v by auto
  also have "... = dim_vec ?r" using m v by auto
  finally show "dim_vec ?l = dim_vec ?r".
  show "\<And>i. i < dim_vec ?r \<Longrightarrow> ?l $ i = ?r $ i"
  proof -
    fix i assume "i < dim_vec ?r"
    hence i: "i < dim_row A" using nr m by auto
    hence i2: "i < dim_vec (A *\<^sub>v v)" using m by auto
    show "?l $ i = ?r $ i"
    apply (subst (1) mult_mat_vec_def)
    apply (subst (2) smult_vec_def)
    unfolding index_vec[OF i] index_vec[OF i2]
    unfolding mult_mat_vec_def smult_vec_def
    unfolding scalar_prod_def index_vec[OF i]
    by (simp add: mult.left_commute sum_distrib_left)
  qed
qed

lemma span_redundant:
assumes "(x :: 'a ::comm_ring vec) \<in> span S"
shows "span (insert_col S x) = span S"
proof
  have "\<exists>za. insert_col S x *\<^sub>v z = S *\<^sub>v za \<and> dim_vec za = dim_col S"
    if "dim_vec z = dim_col (insert_col S x)" for z
  proof -
    have dim_z: "dim_vec z = dim_col S + 1" using that by (simp add: insert_col)
    obtain za where za_def: "z = vCons (z$0) za"
    by (metis \<open>dim_vec z = dim_col (insert_col S x)\<close> add_Suc_right dim_vec insert_col list.size(4)
      mat_of_cols_carrier(3) nat.simps(3) vec_cases vec_index_vCons_0)
    obtain zx where zx_def: "x = S *\<^sub>v zx" "dim_col S = dim_vec zx"
      using assms unfolding span_def by auto
    have "dim_vec x = dim_row S" using zx_def(1) by auto
    moreover have "dim_vec za = dim_col S"
    by (metis Suc_eq_plus1_left add.commute add_diff_cancel_left' dim_vec_vCons dim_z za_def)
    ultimately have "insert_col S x *\<^sub>v z = z$0 \<cdot>\<^sub>v x + S *\<^sub>v za"
      unfolding insert_col by (subst za_def, subst mat_of_cols_mult_vCons, auto)
    also have "\<dots> = z$0 \<cdot>\<^sub>v (S *\<^sub>v zx) + S *\<^sub>v za" unfolding zx_def by auto
    also have "\<dots> = S *\<^sub>v (z $ 0 \<cdot>\<^sub>v zx) + S *\<^sub>v za"
      by (subst mult_mat_vec_ring[symmetric]) (auto simp add: zx_def(2))
    also have "\<dots> = S *\<^sub>v (z$0 \<cdot>\<^sub>v zx + za)"
      by (metis \<open>dim_vec za = dim_col S\<close> carrier_matI carrier_vec_dim_vec index_smult_vec(2)
      mult_add_distrib_mat_vec zx_def(2))
    finally have "insert_col S x *\<^sub>v z = S *\<^sub>v (z$0 \<cdot>\<^sub>v zx + za)" by blast
    moreover have "dim_vec (z$0 \<cdot>\<^sub>v zx + za) = dim_col S"
    by (metis Suc_eq_plus1_left add.commute add_diff_cancel_left' dim_vec_vCons dim_z
      index_add_vec(2) za_def)
    ultimately show ?thesis by blast
  qed
  then show "span (insert_col S x) \<subseteq> span S" unfolding span_def by auto
next
  have "\<exists>za. S *\<^sub>v z = insert_col S x *\<^sub>v za \<and>
              dim_vec za = dim_col (insert_col S x)" if "dim_vec z = dim_col S" for z
  proof -
    define za where za_def: "za = vCons 0 z"
    have "dim_vec za = dim_col S + 1" using that za_def by force
    then have "dim_vec za = dim_col (insert_col S x)"
    by (simp add: insert_col)
    moreover have "S *\<^sub>v z = insert_col S x *\<^sub>v za"
    proof -
      have "dim_vec x = dim_row S"
      using Lattice_int.span_def assms by force
      moreover have "dim_vec z = dim_col S"
      using that by blast
      moreover have "S *\<^sub>v z = 0 \<cdot>\<^sub>v x + S *\<^sub>v z"
      using calculation(1) by auto
      ultimately show ?thesis unfolding insert_col za_def
        by (subst mat_of_cols_mult_vCons)
    qed
    ultimately show ?thesis by blast
  qed
  then show "span S \<subseteq> span (insert_col S x)" unfolding span_def by auto
qed

lemma span_trans:
assumes "(x :: 'a ::comm_ring vec) \<in> span S" "y \<in> span (insert_col S x)"
shows "y \<in> span S"
using Lattice_int.span_redundant assms by blast

lemma delet_col_not_in_set_cols:
assumes "dim_vec b = dim_row T"
shows "b \<notin> set_cols (delete_col T b)"
unfolding delete_col
by (metis (mono_tags, lifting) cols_dim cols_mat_of_cols dual_order.trans filter_is_subset
filter_set member_filter set_cols)

lemma dim_col_distinct:
assumes "distinct (cols S)"
shows "card (set_cols S) = dim_col S"
by (simp add: assms distinct_card)

lemma set_cols_mono:
assumes "set_cols S \<subseteq> set_cols T" "distinct (cols S)" "distinct (cols T)"
shows "dim_col S \<le> dim_col T"
using assms
by (metis List.finite_set card_mono dim_col_distinct set_cols)

lemma set_cols_insert_col:
assumes "dim_vec b = dim_row U"
shows "set_cols (insert_col U b) = set_cols U \<union> {b}"
by (metis (no_types, opaque_lifting) Un_commute Un_insert_right assms carrier_vec_dim_vec
  cols_dim cols_mat_of_cols insert_col insert_subset list.set(2) set_cols sup_bot.left_neutral)

lemma set_cols_real_of_int_mat:
  "set_cols (real_of_int_mat S) = real_of_int_vec ` (set_cols S)"
unfolding set_cols using real_of_int_mat_cols by auto

lemma real_of_int_mat_span:
"real_of_int_vec ` (span S) \<subseteq> span (real_of_int_mat S)"
by (smt (verit, ccfv_SIG) Lattice_int.span_def carrier_mat_triv carrier_vec_dim_vec
  image_subset_iff index_map_mat(3) index_map_vec(2) mem_Collect_eq of_int_hom.mult_mat_vec_hom
  real_of_int_mat_def real_of_int_vec_def)

lemma real_of_int_vec_ex:
assumes "x \<in> real_of_int_vec ` A"
shows "\<exists>y. x = real_of_int_vec y"
using assms by blast

lemma real_of_int_vec_obtain:
assumes "x \<in> real_of_int_vec ` A"
obtains y where "x = real_of_int_vec y"
using assms by blast

lemma real_of_int_vec_inj:
"inj real_of_int_vec"
unfolding real_of_int_vec_def
by (simp add: injI of_int_hom.vec_hom_inj)

lemma real_of_int_mat_mat_of_cols:
assumes "\<forall>i<length cs. cs ! i \<in> carrier_vec nr"
shows "real_of_int_mat (mat_of_cols nr cs) = mat_of_cols nr (map real_of_int_vec cs)"
proof-
  have "real_of_int (cs ! j $ i) = map real_of_int_vec cs ! j $ i" if "j<length cs" "i<nr"
    for i j unfolding nth_map[OF that(1)] proof (subst real_of_int_vec_nth)
      have "dim_vec (cs ! j) = nr" using assms that(1)
      using carrier_vecD by blast
      then show "i < dim_vec (cs ! j)" using that(2) by auto
    qed (auto)
  then show ?thesis  unfolding mat_of_cols_def by (subst real_of_int_mat_mat,
    unfold o_def case_prod_beta, subst cong_mat, auto)
qed

lemma real_of_int_mat_delete_col:
"delete_col (real_of_int_mat T) (real_of_int_vec b) = real_of_int_mat (delete_col T b)"
unfolding delete_col
proof (subst real_of_int_mat_mat_of_cols, goal_cases)
  case 1 show ?case by (meson cols_dim filter_is_subset nth_mem subset_iff)
next
  case 2
  have "(real_of_int_vec x \<noteq> real_of_int_vec b) = (x \<noteq> b)" for x
    by (simp add: inj_eq real_of_int_vec_inj)
  then have *:"filter (\<lambda>x. x \<noteq> real_of_int_vec b) (cols (real_of_int_mat T)) =
    map real_of_int_vec (filter (\<lambda>x. x \<noteq> b) (cols T))"
  unfolding real_of_int_mat_cols filter_map comp_def by auto
  show ?case using cong1[OF *] by auto
qed

lemma exchange_lemma:
  assumes i: "is_indep S"
    and sp: "set_cols S \<subseteq> span T"
    and d: "distinct (cols T)"
    and dr: "dim_row S = dim_row T"
  shows "\<exists>t'. dim_col t' = dim_col T \<and> set_cols S \<subseteq> set_cols t' \<and>
              set_cols t' \<subseteq> set_cols S \<union> set_cols T \<and>
              distinct (cols t')"
(*need "distinct (cols t')*)
using i sp d dr
proof (induct "card (set_cols T - set_cols S)" arbitrary: S T rule: less_induct)
  case less
  define nr where "nr = dim_row S"
  have "nr = dim_row T" using less.prems(4) nr_def by blast
  have "nr = dim_row S"  by (simp add: nr_def)
  have "nr = dim_row T"  by (simp add: \<open>nr = dim_row T\<close>)
  have sp': "set_cols (S) \<subseteq> span (T)" using less.prems(2)
    unfolding set_cols_real_of_int_mat using real_of_int_mat_span by (auto)
  have d': "distinct (cols (T))"
    using distinct_cols_real_of_int_mat less.prems(3) by blast
  have dr': "dim_row (S) = dim_row (T)" by (simp add: less.prems(4))
  have ft: "finite (set_cols T)" by auto
  note S = \<open>is_indep S\<close>
  let ?P = "\<lambda>t'. dim_col t' = dim_col T \<and> set_cols S \<subseteq> set_cols t' \<and>
              set_cols t' \<subseteq> set_cols S \<union> set_cols T \<and> distinct (cols t')"
  show ?case
  proof (cases "set_cols S \<subseteq> set_cols T  \<or> set_cols T \<subseteq> set_cols S")
    case True
    then show ?thesis
    proof
      assume "set_cols S \<subseteq> set_cols T"
      then have "set_cols S \<subseteq> set_cols T"
      using   set_cols_real_of_int_mat by auto
      then show ?thesis using d' by blast
    next
      assume s: "set_cols T \<subseteq> set_cols S"
      then show ?thesis
      using spanning_subset_independent[OF s S _ less.prems(3) less.prems(4)]
      using less.prems by (metis d' inf_sup_ord(3))
    qed
  next
    case False
    then have st: "\<not> set_cols S \<subseteq> set_cols T" "\<not> set_cols T \<subseteq> set_cols S"
      by auto
    from st(2) obtain b where b: "b \<in> set_cols T" "b \<notin> set_cols S"
      by blast
    have "nr = dim_vec b"
      by (metis \<open>nr = dim_row T\<close> b(1) carrier_vecD cols_dim set_cols subset_eq)
    from b have "set_cols T - {b} - (set_cols S) \<subset> set_cols T - set_cols S"
      by blast
    then have cardlt: "card (set_cols T - {b} - set_cols S) < card (set_cols T - set_cols S)"
      using ft by (auto intro: psubset_card_mono)
    from b ft have ct0: "card (set_cols T) \<noteq> 0"
      by auto
    let ?T_b = "delete_col T b"
    have "nr = dim_row ?T_b" by (simp add: \<open>nr = dim_row T\<close> dim_row_delete_col)
    from ft have ftb: "finite (set_cols ?T_b)"
      by auto
    have dim_col_T_gr_0: "dim_col T > 0" using b(1)
    by (metis atLeastLessThan_iff bot_nat_0.not_eq_extremum cols_def imageE list.set_map
      set_cols set_upt zero_order(3))
    have dim_col_T_b: "dim_col ?T_b = dim_col T - 1"
    proof -
      have "length (cols T) > 0" using dim_col_T_gr_0 unfolding cols_length by auto
      have "length (filter (\<lambda>x. x = b) (cols T)) = 1"
      proof -
        have "length (filter (\<lambda>x. x = b) (cols T)) =
          card {i. i < dim_col T \<and> col T i = b}"
          unfolding length_filter_conv_card using cols_nth by (metis cols_length)
        then show ?thesis using d' \<open>b \<in> set_cols T\<close>
        by (smt (verit, del_insts) Collect_cong List.finite_set One_nat_def card.empty
          card.insert distinct_card distinct_filter equals0D list.set(1) set_cols set_filter
          singleton_conv)
      qed
      then have "length (filter (\<lambda>x. x \<noteq> b) (cols T)) = length (cols T) - 1"
         using sum_length_filter_compl by (metis add_diff_cancel_left')
      then show ?thesis unfolding delete_col by auto
    qed
    have "dim_vec b = dim_row T"
      using b(1) carrier_dim_vec cols_dim set_cols by blast
    have set_cols_T_b: "set_cols ?T_b = set_cols T - {b}"
    proof -
      have "set_cols ?T_b \<subseteq> set_cols T"
      by (smt (verit) cols_dim cols_mat_of_cols delete_col filter_is_subset order_trans set_cols)
      moreover have "b \<notin> set_cols ?T_b" using \<open>dim_vec b = dim_row T\<close>
        by (subst delet_col_not_in_set_cols, auto)
      ultimately show ?thesis
      by (smt (verit, del_insts) Diff_subset cols_dim cols_mat_of_cols delete_col dual_order.trans
      set_cols set_minus_filter_out)
    qed
    show ?thesis
(*pay attention to span over reals not only int! changes may be needed*)
    proof (cases "set_cols S \<subseteq> span ?T_b")
      case True
      (* have "set_cols T- set_cols S \<subseteq> real_of_int_vec ` (set_cols T - set_cols S)"
        unfolding   set_cols_real_of_int_mat using image_diff_subset by auto
      then have *: "card (set_cols T - set_cols S) \<le> card (set_cols T - set_cols S)"
      by (simp add: surj_card_le)*)
      from cardlt have cardlt': "card (set_cols ?T_b - set_cols S) <
        card (set_cols T - set_cols S)"
        using set_cols_T_b by presburger
      have d_delete: "distinct (cols (delete_col T b))" using d
      by (metis b(1) card_Diff_singleton card_distinct cols_length d' dim_col_T_b dim_col_distinct
        set_cols set_cols_T_b)
      have dim_row_STb: "dim_row S = dim_row (delete_col T b)"
        by (simp add: dim_row_delete_col less.prems(4))
      obtain U where U: "dim_col U = dim_col ?T_b" "set_cols S \<subseteq> set_cols U"
        "set_cols U \<subseteq> set_cols S \<union> set_cols ?T_b" "distinct (cols U)"
        using less(1)[OF cardlt' S True d_delete dim_row_STb]  by auto
      have "nr = dim_row U" using U(2) unfolding \<open>nr = dim_row S\<close>
        by (smt (verit, best)  carrier_vecD cols_dim image_subset_iff set_cols
          set_cols_real_of_int_mat st(1) subsetD subsetI)
      let ?w = "insert_col U b"
      have dim_col_w: "dim_col ?w = dim_col U + 1" unfolding insert_col by simp
      have "dim_vec b = dim_row U" unfolding \<open>nr = dim_vec b\<close>[symmetric]
        using \<open>nr = dim_row U\<close> .
      then have set_cols_w: "set_cols ?w = set_cols U \<union> {b}"
        by (subst set_cols_insert_col, auto)
      have th0: "set_cols S \<subseteq> set_cols ?w"
        using U(2) set_cols_w by auto
      have th1: "set_cols ?w \<subseteq> set_cols S \<union> set_cols T"
        using U b set_cols_w set_cols_T_b by auto
      have bu: "b \<notin> set_cols U"
        using b U
        by (metis DiffD2 Un_iff insertCI set_cols_T_b sup.orderE)
      from U(1) have "dim_col U = dim_col T - 1"
      using dim_col_T_b by presburger
      then have th2: "dim_col (?w) = dim_col T" unfolding dim_col_w
      using dim_col_T_gr_0 by linarith
      have th3: "distinct (cols ?w)"
      proof -
        have "b \<notin> set_cols U" using bu by blast
        then show ?thesis
        by (metis List.finite_set Suc_pred' U(4) \<open>dim_col U = dim_col T - 1\<close> card_distinct
          card_insert_disjoint cols_length dim_col_T_gr_0 dim_col_distinct insert_union set_cols
          set_cols_w th2)
      qed
      from th0 th1 th2 th3 have th: "?P ?w" by blast
      from th show ?thesis by blast
    next
      case False
      then obtain a where a: "a \<in> set_cols S" "a \<notin> span ?T_b" by blast
      have ab: "a \<noteq> b" using a b by blast
      have at: "a \<notin> set_cols T" using a ab span_base[of a "?T_b"]
        by (metis DiffI empty_iff insert_iff set_cols_T_b)
      let ?insert_a =  "insert_col ?T_b a"
      have set_cols_insert: "set_cols ?insert_a = {a} \<union> set_cols ?T_b"
        by (smt (verit, ccfv_SIG) Lattice_int.span_def Un_commute a(1) delete_col dim_mult_mat_vec
          less.prems(2) mat_of_cols_carrier(2) mem_Collect_eq set_cols_insert_col subsetD)
      have dim_col_insert_a: "dim_col (?insert_a) = dim_col T"
        by (metis One_nat_def Suc_eq_plus1_left Suc_pred' add.commute cols_length dim_col_T_b
          dim_col_T_gr_0 insert_col list.size(4) mat_of_cols_carrier(3))
      have mlt: "card (set_cols ?insert_a - set_cols S) < card (set_cols T - set_cols S)"
        using cardlt a b by (metis insert_Diff1 insert_is_Un set_cols_T_b set_cols_insert)
      have sp': "set_cols S \<subseteq> span (?insert_a)"
      proof
        fix x
        assume xs: "x \<in> set_cols S"
        let ?insert_b =  "mat_of_cols (dim_row T) (b # cols ?insert_a)"
        have T: "set_cols T \<subseteq> set_cols ?insert_b"
          using b
          by (smt (verit, ccfv_SIG) cols_dim cols_mat_of_cols delete_col dual_order.refl
            insert_Diff insert_col insert_is_Un insert_subset list.set(2) mat_of_cols_carrier(2)
            set_cols set_cols_T_b set_cols_insert)
        have bs: "b \<in> span (?insert_a)"
          using in_span_delete_field
          by (metis \<open>dim_vec b = dim_row T\<close> a(1) a(2) d' in_mono sp')
        from xs sp have "x \<in> span T" using less.prems(2) by blast
        with span_mono[OF T] have x: "x \<in> span (?insert_b)"
        using less.prems(3) by auto
        from span_trans show "x \<in> span (?insert_a)"
        by (metis bs delete_col insert_col mat_of_cols_carrier(2) x)
      qed
      from less(1)[OF mlt S sp'] obtain U where U:
        "dim_col U = dim_col (insert_col (?T_b) a)"
        "set_cols S \<subseteq> set_cols U" "set_cols U \<subseteq> set_cols S \<union> set_cols (insert_col (?T_b) a)"
        "distinct (cols U)"
        by (metis Lattice_int.span_base \<open>dim_vec b = dim_row T\<close> a(2) b(1) card_distinct
          card_insert_disjoint cols_length delet_col_not_in_set_cols delete_col dim_col_distinct
          dim_col_insert_a ftb insert_Diff insert_col insert_is_Un less.prems(3) less.prems(4)
          mat_of_cols_carrier(2) set_cols set_cols_T_b set_cols_insert)
      from U a b ft at ct0 have "?P U"
      using dim_col_insert_a set_cols_T_b set_cols_insert by auto
      then show ?thesis by blast
    qed
  qed
qed

lemma independent_span_bound:
  assumes i: "is_indep (real_of_int_mat S)" and d: "distinct (cols T)"
    and sp: "set_cols S \<subseteq> span T"
    and dr: "dim_row S = dim_row T"
  shows "dim_col S \<le> dim_col T"
proof -
  have sp': "set_cols (real_of_int_mat S) \<subseteq> Lattice_int.span (real_of_int_mat T)"
    using sp by (metis image_mono real_of_int_mat_span set_cols_real_of_int_mat subset_trans)
  have d': "distinct (cols (real_of_int_mat T))" using d
    by (simp add: distinct_cols_real_of_int_mat)
  have dr': "dim_row (real_of_int_mat S) = dim_row (real_of_int_mat T)" using dr
    by (simp add: distinct_cols_real_of_int_mat)
  obtain t' where t: "dim_col t' = dim_col (real_of_int_mat T)"
       "set_cols (real_of_int_mat S) \<subseteq> set_cols t'"
       "set_cols t' \<subseteq> set_cols (real_of_int_mat S) \<union> set_cols (real_of_int_mat T)"
       "distinct (cols t')"
  using exchange_lemma[OF i sp' d' dr'] by blast
  have dS: "distinct (cols (real_of_int_mat S))" using is_indep_distinct[OF i]
    using distinct_cols_real_of_int_mat by blast
  have "dim_col S = dim_col (real_of_int_mat S)" by simp
  moreover have "dim_col (real_of_int_mat S) \<le> dim_col t'"
    using set_cols_mono[OF t(2) dS t(4)] by auto
  moreover have "dim_col t' = dim_col T" unfolding t(1) by simp
  ultimately show ?thesis  by auto
qed

lemma gen_lattice_in_span:
assumes "gen_lattice B = gen_lattice B'"
shows "set_cols B \<subseteq> Lattice_int.span B'"
unfolding gen_lattice_def
by (smt (verit, ccfv_SIG) Lattice_int.span_base Lattice_int.span_def assms gen_lattice_def subsetI)

(* A general change of basis theorem is missing, corollary: all bases have the same length *)
lemma basis_exchange:
  assumes gen_eq: "gen_lattice B = gen_lattice B'"
    and "is_indep (real_of_int_mat B)" and "is_indep (real_of_int_mat B')"
  shows "dim_col B = dim_col B'"
proof -
  have dr: "dim_row B = dim_row B'"
  by (smt (z3) dim_mult_mat_vec gen_eq gen_lattice_def index_zero_vec(2) mem_Collect_eq)
  have "dim_col B \<le> dim_col B'"
    using assms(2) is_indep_distinct[OF assms(3)] gen_lattice_in_span[OF assms(1)] dr
     Lattice_int.independent_span_bound distinct_cols_real_of_int_mat by presburger
  moreover have "dim_col B' \<le> dim_col B"
    using assms(3) is_indep_distinct[OF assms(2)] gen_lattice_in_span[OF assms(1)[symmetric]] dr
     Lattice_int.independent_span_bound distinct_cols_real_of_int_mat by presburger
  ultimately show ?thesis by linarith
qed

text \<open>Basis matrix of a lattice\<close>

definition basis_of :: "int vec set \<Rightarrow> int mat" where
  "basis_of L = (SOME B. L = gen_lattice B \<and> is_indep (real_of_int_mat B))"

definition dim_lattice :: "int_lattice \<Rightarrow> nat" where
  "dim_lattice L = (THE x. x = dim_col (basis_of L))"

lemma dim_lattice_gen_lattice:
  assumes "is_indep (real_of_int_mat B)"
  shows "dim_lattice (gen_lattice B) = dim_col B"
unfolding dim_lattice_def using assms basis_exchange[of "basis_of (gen_lattice B)" B]
  by (auto simp add: basis_of_def)(metis (mono_tags, lifting) assms tfl_some)

text \<open>A lattice generated by a linearly independent matrix is indeed a lattice.\<close>
lemma is_lattice_gen_lattice:
  assumes "is_indep (real_of_int_mat A)"
  shows "is_lattice (gen_lattice A)"
unfolding is_lattice_def gen_lattice_def using assms by auto

end


(*  Title:      HOL/ex/Tarski.thy
    Author:     Florian Kammüller, Cambridge University Computer Laboratory
*)

section \<open>The Full Theorem of Tarski\<close>

theory Tarski
imports MainRLT "HOL-Library.FuncSet"
begin

text \<open>
  Minimal version of lattice theory plus the full theorem of Tarski:
  The fixedpoints of a complete lattice themselves form a complete
  lattice.

  Illustrates first-class theories, using the Sigma representation of
  structures.  Tidied and converted to Isar by lcp.
\<close>

record 'a potype =
  pset  :: "'a set"
  order :: "('a \<times> 'a) set"

definition monotone :: "['a \<Rightarrow> 'a, 'a set, ('a \<times> 'a) set] \<Rightarrow> bool"
  where "monotone f A r \<longleftrightarrow> (\<forall>x\<in>A. \<forall>y\<in>A. (x, y) \<in> r \<longrightarrow> (f x, f y) \<in> r)"

definition least :: "['a \<Rightarrow> bool, 'a potype] \<Rightarrow> 'a"
  where "least P po = (SOME x. x \<in> pset po \<and> P x \<and> (\<forall>y \<in> pset po. P y \<longrightarrow> (x, y) \<in> order po))"

definition greatest :: "['a \<Rightarrow> bool, 'a potype] \<Rightarrow> 'a"
  where "greatest P po = (SOME x. x \<in> pset po \<and> P x \<and> (\<forall>y \<in> pset po. P y \<longrightarrow> (y, x) \<in> order po))"

definition lub :: "['a set, 'a potype] \<Rightarrow> 'a"
  where "lub S po = least (\<lambda>x. \<forall>y\<in>S. (y, x) \<in> order po) po"

definition glb :: "['a set, 'a potype] \<Rightarrow> 'a"
  where "glb S po = greatest (\<lambda>x. \<forall>y\<in>S. (x, y) \<in> order po) po"

definition isLub :: "['a set, 'a potype, 'a] \<Rightarrow> bool"
  where "isLub S po =
    (\<lambda>L. L \<in> pset po \<and> (\<forall>y\<in>S. (y, L) \<in> order po) \<and>
      (\<forall>z\<in>pset po. (\<forall>y\<in>S. (y, z) \<in> order po) \<longrightarrow> (L, z) \<in> order po))"

definition isGlb :: "['a set, 'a potype, 'a] \<Rightarrow> bool"
  where "isGlb S po =
    (\<lambda>G. (G \<in> pset po \<and> (\<forall>y\<in>S. (G, y) \<in> order po) \<and>
      (\<forall>z \<in> pset po. (\<forall>y\<in>S. (z, y) \<in> order po) \<longrightarrow> (z, G) \<in> order po)))"

definition "fix" :: "['a \<Rightarrow> 'a, 'a set] \<Rightarrow> 'a set"
  where "fix f A  = {x. x \<in> A \<and> f x = x}"

definition interval :: "[('a \<times> 'a) set, 'a, 'a] \<Rightarrow> 'a set"
  where "interval r a b = {x. (a, x) \<in> r \<and> (x, b) \<in> r}"

definition Bot :: "'a potype \<Rightarrow> 'a"
  where "Bot po = least (\<lambda>x. True) po"

definition Top :: "'a potype \<Rightarrow> 'a"
  where "Top po = greatest (\<lambda>x. True) po"

definition PartialOrder :: "'a potype set"
  where "PartialOrder = {P. refl_on (pset P) (order P) \<and> antisym (order P) \<and> trans (order P)}"

definition CompleteLattice :: "'a potype set"
  where "CompleteLattice =
    {cl. cl \<in> PartialOrder \<and>
      (\<forall>S. S \<subseteq> pset cl \<longrightarrow> (\<exists>L. isLub S cl L)) \<and>
      (\<forall>S. S \<subseteq> pset cl \<longrightarrow> (\<exists>G. isGlb S cl G))}"

definition CLF_set :: "('a potype \<times> ('a \<Rightarrow> 'a)) set"
  where "CLF_set =
    (SIGMA cl : CompleteLattice.
      {f. f \<in> pset cl \<rightarrow> pset cl \<and> monotone f (pset cl) (order cl)})"

definition induced :: "['a set, ('a \<times> 'a) set] \<Rightarrow> ('a \<times> 'a) set"
  where "induced A r = {(a, b). a \<in> A \<and> b \<in> A \<and> (a, b) \<in> r}"

definition sublattice :: "('a potype \<times> 'a set) set"
  where "sublattice =
    (SIGMA cl : CompleteLattice.
      {S. S \<subseteq> pset cl \<and> \<lparr>pset = S, order = induced S (order cl)\<rparr> \<in> CompleteLattice})"

abbreviation sublat :: "['a set, 'a potype] \<Rightarrow> bool"  ("_ <<= _" [51, 50] 50)
  where "S <<= cl \<equiv> S \<in> sublattice `` {cl}"

definition dual :: "'a potype \<Rightarrow> 'a potype"
  where "dual po = \<lparr>pset = pset po, order = converse (order po)\<rparr>"

locale S =
  fixes cl :: "'a potype"
    and A :: "'a set"
    and r :: "('a \<times> 'a) set"
  defines A_def: "A \<equiv> pset cl"
     and r_def: "r \<equiv> order cl"

locale PO = S +
  assumes cl_po: "cl \<in> PartialOrder"

locale CL = S +
  assumes cl_co: "cl \<in> CompleteLattice"

sublocale CL < po?: PO
  unfolding A_def r_def
  using CompleteLattice_def PO.intro cl_co by fastforce

locale CLF = S +
  fixes f :: "'a \<Rightarrow> 'a"
    and P :: "'a set"
  assumes f_cl:  "(cl, f) \<in> CLF_set"
  defines P_def: "P \<equiv> fix f A"

sublocale CLF < cl?: CL
  unfolding A_def r_def CL_def
  using CLF_set_def f_cl by blast

locale Tarski = CLF +
  fixes Y :: "'a set"
    and intY1 :: "'a set"
    and v :: "'a"
  assumes Y_ss: "Y \<subseteq> P"
  defines intY1_def: "intY1 \<equiv> interval r (lub Y cl) (Top cl)"
    and v_def: "v \<equiv>
      glb {x. ((\<lambda>x \<in> intY1. f x) x, x) \<in> induced intY1 r \<and> x \<in> intY1}
        \<lparr>pset = intY1, order = induced intY1 r\<rparr>"

subsection \<open>Partial Order\<close>

context PO
begin

lemma dual: "PO (dual cl)"
proof
  show "dual cl \<in> PartialOrder"
  using cl_po unfolding PartialOrder_def dual_def by auto
qed

lemma PO_imp_refl_on [simp]: "refl_on A r"
  using cl_po by (simp add: PartialOrder_def A_def r_def)

lemma PO_imp_sym [simp]: "antisym r"
  using cl_po by (simp add: PartialOrder_def r_def)

lemma PO_imp_trans [simp]: "trans r"
  using cl_po by (simp add: PartialOrder_def r_def)

lemma reflE: "x \<in> A \<Longrightarrow> (x, x) \<in> r"
  using cl_po by (simp add: PartialOrder_def refl_on_def A_def r_def)

lemma antisymE: "\<lbrakk>(a, b) \<in> r; (b, a) \<in> r\<rbrakk> \<Longrightarrow> a = b"
  using cl_po by (simp add: PartialOrder_def antisym_def r_def)

lemma transE: "\<lbrakk>(a, b) \<in> r; (b, c) \<in> r\<rbrakk> \<Longrightarrow> (a, c) \<in> r"
  using cl_po by (simp add: PartialOrder_def r_def) (unfold trans_def, fast)

lemma monotoneE: "\<lbrakk>monotone f A r; x \<in> A; y \<in> A; (x, y) \<in> r\<rbrakk> \<Longrightarrow> (f x, f y) \<in> r"
  by (simp add: monotone_def)

lemma po_subset_po:
  assumes "S \<subseteq> A" shows "\<lparr>pset = S, order = induced S r\<rparr> \<in> PartialOrder"
proof -
  have "refl_on S (induced S r)"
    using \<open>S \<subseteq> A\<close> by (auto simp: refl_on_def induced_def intro: reflE)
  moreover
  have "antisym (induced S r)"
    by (auto simp add: antisym_def induced_def intro: antisymE)
  moreover
  have "trans (induced S r)"
    by (auto simp add: trans_def induced_def intro: transE)
  ultimately show ?thesis
    by (simp add: PartialOrder_def)
qed

lemma indE: "\<lbrakk>(x, y) \<in> induced S r; S \<subseteq> A\<rbrakk> \<Longrightarrow> (x, y) \<in> r"
  by (simp add: induced_def)

lemma indI: "\<lbrakk>(x, y) \<in> r; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> (x, y) \<in> induced S r"
  by (simp add: induced_def)

end

lemma (in CL) CL_imp_ex_isLub: "S \<subseteq> A \<Longrightarrow> \<exists>L. isLub S cl L"
  using cl_co by (simp add: CompleteLattice_def A_def)

declare (in CL) cl_co [simp]

lemma isLub_lub: "(\<exists>L. isLub S cl L) \<longleftrightarrow> isLub S cl (lub S cl)"
  by (simp add: lub_def least_def isLub_def some_eq_ex [symmetric])

lemma isGlb_glb: "(\<exists>G. isGlb S cl G) \<longleftrightarrow> isGlb S cl (glb S cl)"
  by (simp add: glb_def greatest_def isGlb_def some_eq_ex [symmetric])

lemma isGlb_dual_isLub: "isGlb S cl = isLub S (dual cl)"
  by (simp add: isLub_def isGlb_def dual_def converse_unfold)

lemma isLub_dual_isGlb: "isLub S cl = isGlb S (dual cl)"
  by (simp add: isLub_def isGlb_def dual_def converse_unfold)

lemma (in PO) dualPO: "dual cl \<in> PartialOrder"
  using cl_po by (simp add: PartialOrder_def dual_def)

lemma Rdual:
  assumes major: "\<And>S. S \<subseteq> A \<Longrightarrow> \<exists>L. isLub S po L" and "S \<subseteq> A" and "A = pset po"
  shows "\<exists>G. isGlb S po G"
proof
  show "isGlb S po (lub {y \<in> A. \<forall>k\<in>S. (y, k) \<in> order po} po)"
    using major [of "{y. y \<in> A \<and> (\<forall>k \<in> S. (y, k) \<in> order po)}"] \<open>S \<subseteq> A\<close> \<open>A = pset po\<close>
    apply (simp add: isLub_lub isGlb_def)
    apply (auto simp add: isLub_def)
    done
qed

lemma lub_dual_glb: "lub S cl = glb S (dual cl)"
  by (simp add: lub_def glb_def least_def greatest_def dual_def converse_unfold)

lemma glb_dual_lub: "glb S cl = lub S (dual cl)"
  by (simp add: lub_def glb_def least_def greatest_def dual_def converse_unfold)

lemma CL_subset_PO: "CompleteLattice \<subseteq> PartialOrder"
  by (auto simp: PartialOrder_def CompleteLattice_def)

lemmas CL_imp_PO = CL_subset_PO [THEN subsetD]

context CL
begin

lemma CO_refl_on: "refl_on A r"
  by (rule PO_imp_refl_on)

lemma CO_antisym: "antisym r"
  by (rule PO_imp_sym)

lemma CO_trans: "trans r"
  by (rule PO_imp_trans)

end

lemma CompleteLatticeI:
  "\<lbrakk>po \<in> PartialOrder; \<forall>S. S \<subseteq> pset po \<longrightarrow> (\<exists>L. isLub S po L);
     \<forall>S. S \<subseteq> pset po \<longrightarrow> (\<exists>G. isGlb S po G)\<rbrakk>
    \<Longrightarrow> po \<in> CompleteLattice"
  unfolding CompleteLattice_def by blast

lemma (in CL) CL_dualCL: "dual cl \<in> CompleteLattice"
  using cl_co
  apply (simp add: CompleteLattice_def dual_def)
  apply (simp add: dualPO flip: dual_def isLub_dual_isGlb isGlb_dual_isLub)
  done

context PO
begin

lemma dualA_iff [simp]: "pset (dual cl) = pset cl"
  by (simp add: dual_def)

lemma dualr_iff [simp]: "(x, y) \<in> (order (dual cl)) \<longleftrightarrow> (y, x) \<in> order cl"
  by (simp add: dual_def)

lemma monotone_dual:
  "monotone f (pset cl) (order cl) \<Longrightarrow> monotone f (pset (dual cl)) (order(dual cl))"
  by (simp add: monotone_def)

lemma interval_dual: "\<lbrakk>x \<in> A; y \<in> A\<rbrakk> \<Longrightarrow> interval r x y = interval (order(dual cl)) y x"
  unfolding interval_def dualr_iff by (auto simp flip: r_def)

lemma interval_not_empty: "interval r a b \<noteq> {} \<Longrightarrow> (a, b) \<in> r"
  by (simp add: interval_def) (use transE in blast)

lemma interval_imp_mem: "x \<in> interval r a b \<Longrightarrow> (a, x) \<in> r"
  by (simp add: interval_def)

lemma left_in_interval: "\<lbrakk>a \<in> A; b \<in> A; interval r a b \<noteq> {}\<rbrakk> \<Longrightarrow> a \<in> interval r a b"
  using interval_def interval_not_empty reflE by fastforce

lemma right_in_interval: "\<lbrakk>a \<in> A; b \<in> A; interval r a b \<noteq> {}\<rbrakk> \<Longrightarrow> b \<in> interval r a b"
  by (simp add: A_def PO.dual PO.left_in_interval PO_axioms interval_dual)

end

subsection \<open>sublattice\<close>

lemma (in PO) sublattice_imp_CL:
  "S <<= cl \<Longrightarrow> \<lparr>pset = S, order = induced S r\<rparr> \<in> CompleteLattice"
  by (simp add: sublattice_def CompleteLattice_def r_def)

lemma (in CL) sublatticeI:
  "\<lbrakk>S \<subseteq> A; \<lparr>pset = S, order = induced S r\<rparr> \<in> CompleteLattice\<rbrakk> \<Longrightarrow> S <<= cl"
  by (simp add: sublattice_def A_def r_def)

lemma (in CL) dual: "CL (dual cl)"
proof
  show "dual cl \<in> CompleteLattice"
  using cl_co
  by (simp add: CompleteLattice_def dualPO flip: isGlb_dual_isLub isLub_dual_isGlb)
qed

subsection \<open>lub\<close>

context CL
begin

lemma lub_unique: "\<lbrakk>S \<subseteq> A; isLub S cl x; isLub S cl L\<rbrakk> \<Longrightarrow> x = L"
  by (rule antisymE) (auto simp add: isLub_def r_def)

lemma lub_upper:
  assumes "S \<subseteq> A" "x \<in> S" shows "(x, lub S cl) \<in> r"
proof -
  obtain L where "isLub S cl L"
    using CL_imp_ex_isLub \<open>S \<subseteq> A\<close> by auto
  then show ?thesis
    by (metis assms(2) isLub_def isLub_lub r_def)
qed

lemma lub_least:
  assumes "S \<subseteq> A" and L: "L \<in> A" "\<forall>x \<in> S. (x, L) \<in> r" shows "(lub S cl, L) \<in> r"
proof -
  obtain L' where "isLub S cl L'"
    using CL_imp_ex_isLub \<open>S \<subseteq> A\<close> by auto
  then show ?thesis
    by (metis A_def L isLub_def isLub_lub r_def)
qed

lemma lub_in_lattice:
  assumes "S \<subseteq> A" shows "lub S cl \<in> A"
proof -
  obtain L where "isLub S cl L"
    using CL_imp_ex_isLub \<open>S \<subseteq> A\<close> by auto
  then show ?thesis
    by (metis A_def isLub_def isLub_lub)
qed

lemma lubI:
  assumes A: "S \<subseteq> A" "L \<in> A" and r: "\<forall>x \<in> S. (x, L) \<in> r"
     and clo: "\<And>z. \<lbrakk>z \<in> A; (\<forall>y \<in> S. (y, z) \<in> r)\<rbrakk> \<Longrightarrow> (L, z) \<in> r"
   shows "L = lub S cl"
proof -
  obtain L where "isLub S cl L"
    using CL_imp_ex_isLub assms(1) by auto
  then show ?thesis
    by (simp add: antisymE A clo lub_in_lattice lub_least lub_upper r)
qed

lemma lubIa: "\<lbrakk>S \<subseteq> A; isLub S cl L\<rbrakk> \<Longrightarrow> L = lub S cl"
  by (meson isLub_lub lub_unique)

lemma isLub_in_lattice: "isLub S cl L \<Longrightarrow> L \<in> A"
  by (simp add: isLub_def  A_def)

lemma isLub_upper: "\<lbrakk>isLub S cl L; y \<in> S\<rbrakk> \<Longrightarrow> (y, L) \<in> r"
  by (simp add: isLub_def r_def)

lemma isLub_least: "\<lbrakk>isLub S cl L; z \<in> A; \<forall>y \<in> S. (y, z) \<in> r\<rbrakk> \<Longrightarrow> (L, z) \<in> r"
  by (simp add: isLub_def A_def r_def)

lemma isLubI:
  "\<lbrakk>L \<in> A; \<forall>y \<in> S. (y, L) \<in> r; (\<forall>z \<in> A. (\<forall>y \<in> S. (y, z)\<in>r) \<longrightarrow> (L, z) \<in> r)\<rbrakk> \<Longrightarrow> isLub S cl L"
  by (simp add: isLub_def A_def r_def)

end

subsection \<open>glb\<close>

context CL
begin

lemma glb_in_lattice: "S \<subseteq> A \<Longrightarrow> glb S cl \<in> A"
  by (metis A_def CL.lub_in_lattice dualA_iff glb_dual_lub local.dual)

lemma glb_lower: "\<lbrakk>S \<subseteq> A; x \<in> S\<rbrakk> \<Longrightarrow> (glb S cl, x) \<in> r"
  by (metis A_def CL.lub_upper dualA_iff dualr_iff glb_dual_lub local.dual r_def)

end

text \<open>
  Reduce the sublattice property by using substructural properties;
  abandoned see \<open>Tarski_4.ML\<close>.
\<close>

context CLF
begin

declare f_cl [simp]

lemma f_in_funcset: "f \<in> A \<rightarrow> A"
  by (simp add: A_def)

lemma monotone_f: "monotone f A r"
  by (simp add: A_def r_def)

lemma CLF_dual: "(dual cl, f) \<in> CLF_set"
proof -
  have "Tarski.monotone f A (order (dual cl))"
    by (metis (no_types) A_def PO.monotone_dual PO_axioms dualA_iff monotone_f r_def)
  then show ?thesis
    by (simp add: A_def CLF_set_def CL_dualCL)
qed

lemma dual: "CLF (dual cl) f"
  by (rule CLF.intro) (rule CLF_dual)

end

subsection \<open>fixed points\<close>

lemma fix_subset: "fix f A \<subseteq> A"
  by (auto simp: fix_def)

lemma fix_imp_eq: "x \<in> fix f A \<Longrightarrow> f x = x"
  by (simp add: fix_def)

lemma fixf_subset: "\<lbrakk>A \<subseteq> B; x \<in> fix (\<lambda>y \<in> A. f y) A\<rbrakk> \<Longrightarrow> x \<in> fix f B"
  by (auto simp: fix_def)

subsection \<open>lemmas for Tarski, lub\<close>

context CLF
begin

lemma lubH_le_flubH:
  assumes "H = {x \<in> A. (x, f x) \<in> r}"
  shows "(lub H cl, f (lub H cl)) \<in> r"
proof (intro lub_least ballI)
  show "H \<subseteq> A"
    using assms
    by auto
  show "f (lub H cl) \<in> A"
    using \<open>H \<subseteq> A\<close> f_in_funcset lub_in_lattice by auto
  show "(x, f (lub H cl)) \<in> r" if "x \<in> H" for x
  proof -
    have "(f x, f (lub H cl)) \<in> r"
      by (meson \<open>H \<subseteq> A\<close> in_mono lub_in_lattice lub_upper monotoneE monotone_f that)
    moreover have "(x, f x) \<in> r"
      using assms that by blast
    ultimately show ?thesis
      using po.transE by blast
  qed
qed

lemma lubH_is_fixp:
  assumes "H = {x \<in> A. (x, f x) \<in> r}"
  shows "lub H cl \<in> fix f A"
proof -
  have "(f (lub H cl), lub H cl) \<in> r"
  proof -
    have "(lub H cl, f (lub H cl)) \<in> r"
      using assms lubH_le_flubH by blast
    then have "(f (lub H cl), f (f (lub H cl))) \<in> r"
      by (meson PO_imp_refl_on monotoneE monotone_f refl_on_domain)
    then have "f (lub H cl) \<in> H"
      by (metis (no_types, lifting) PO_imp_refl_on assms mem_Collect_eq refl_on_domain)
    then show ?thesis
      by (simp add: assms lub_upper)
  qed
  with assms show ?thesis
    by (simp add: fix_def antisymE lubH_le_flubH lub_in_lattice)
qed

lemma fixf_le_lubH:
  assumes "H = {x \<in> A. (x, f x) \<in> r}" "x \<in> fix f A"
  shows "(x, lub H cl) \<in> r"
proof -
  have "x \<in> P \<Longrightarrow> x \<in> H"
    by (simp add: assms P_def fix_imp_eq [of _ f A] reflE fix_subset [of f A, THEN subsetD])
  with assms show ?thesis
    by (metis (no_types, lifting) P_def lub_upper mem_Collect_eq subset_eq)
qed

subsection \<open>Tarski fixpoint theorem 1, first part\<close>

lemma T_thm_1_lub: "lub P cl = lub {x \<in> A. (x, f x) \<in> r} cl"
proof -
  have "lub {x \<in> A. (x, f x) \<in> r} cl = lub (fix f A) cl"
  proof (rule antisymE)
    show "(lub {x \<in> A. (x, f x) \<in> r} cl, lub (fix f A) cl) \<in> r"
      by (simp add: fix_subset lubH_is_fixp lub_upper)
    have "\<And>a. a \<in> fix f A \<Longrightarrow> a \<in> A"
      by (meson fix_subset subset_iff)
    then show "(lub (fix f A) cl, lub {x \<in> A. (x, f x) \<in> r} cl) \<in> r"
      by (simp add: fix_subset fixf_le_lubH lubH_is_fixp lub_least)
  qed
  then show ?thesis
    using P_def by auto
qed

lemma glbH_is_fixp:
  assumes "H = {x \<in> A. (f x, x) \<in> r}" shows "glb H cl \<in> P"
  \<comment> \<open>Tarski for glb\<close>
proof -
  have "glb H cl \<in> fix f (pset (dual cl))"
    using assms CLF.lubH_is_fixp [OF dual] PO.dualr_iff PO_axioms
    by (fastforce simp add: A_def r_def glb_dual_lub)
  then show ?thesis
    by (simp add: A_def P_def)
qed

lemma T_thm_1_glb: "glb P cl = glb {x \<in> A. (f x, x) \<in> r} cl"
  unfolding glb_dual_lub P_def A_def r_def
  using CLF.T_thm_1_lub dualA_iff dualr_iff local.dual by force

subsection \<open>interval\<close>

lemma rel_imp_elem: "(x, y) \<in> r \<Longrightarrow> x \<in> A"
  using CO_refl_on by (auto simp: refl_on_def)

lemma interval_subset: "\<lbrakk>a \<in> A; b \<in> A\<rbrakk> \<Longrightarrow> interval r a b \<subseteq> A"
  by (simp add: interval_def) (blast intro: rel_imp_elem)

lemma intervalI: "\<lbrakk>(a, x) \<in> r; (x, b) \<in> r\<rbrakk> \<Longrightarrow> x \<in> interval r a b"
  by (simp add: interval_def)

lemma interval_lemma1: "\<lbrakk>S \<subseteq> interval r a b; x \<in> S\<rbrakk> \<Longrightarrow> (a, x) \<in> r"
  unfolding interval_def by fast

lemma interval_lemma2: "\<lbrakk>S \<subseteq> interval r a b; x \<in> S\<rbrakk> \<Longrightarrow> (x, b) \<in> r"
  unfolding interval_def by fast

lemma a_less_lub: "\<lbrakk>S \<subseteq> A; S \<noteq> {}; \<forall>x \<in> S. (a,x) \<in> r; \<forall>y \<in> S. (y, L) \<in> r\<rbrakk> \<Longrightarrow> (a, L) \<in> r"
  by (blast intro: transE)

lemma S_intv_cl: "\<lbrakk>a \<in> A; b \<in> A; S \<subseteq> interval r a b\<rbrakk> \<Longrightarrow> S \<subseteq> A"
  by (simp add: subset_trans [OF _ interval_subset])

lemma L_in_interval:
  assumes "b \<in> A" and S: "S \<subseteq> interval r a b" "isLub S cl L" "S \<noteq> {}"
  shows "L \<in> interval r a b"
proof (rule intervalI)
  show "(a, L) \<in> r"
    by (meson PO_imp_trans all_not_in_conv S interval_lemma1 isLub_upper transD)
  show "(L, b) \<in> r"
    using \<open>b \<in> A\<close> assms interval_lemma2 isLub_least by auto
qed

lemma G_in_interval:
  assumes "b \<in> A" and S: "S \<subseteq> interval r a b" "isGlb S cl G" "S \<noteq> {}"
  shows "G \<in> interval r a b"
proof -
  have "a \<in> A"
    using S(1) \<open>S \<noteq> {}\<close> interval_lemma1 rel_imp_elem by blast
  with assms show ?thesis
    by (metis (no_types) A_def CLF.L_in_interval dualA_iff interval_dual isGlb_dual_isLub local.dual)
qed

lemma intervalPO:
  "\<lbrakk>a \<in> A; b \<in> A; interval r a b \<noteq> {}\<rbrakk>
    \<Longrightarrow> \<lparr>pset = interval r a b, order = induced (interval r a b) r\<rparr> \<in> PartialOrder"
  by (rule po_subset_po) (simp add: interval_subset)

lemma intv_CL_lub:
  assumes "a \<in> A" "b \<in> A" "interval r a b \<noteq> {}" and S: "S \<subseteq> interval r a b"
  shows "\<exists>L. isLub S \<lparr>pset = interval r a b, order = induced (interval r a b) r\<rparr>  L"
proof -
  obtain L where L: "isLub S cl L"
    by (meson CL_imp_ex_isLub S_intv_cl assms(1) assms(2) assms(4))
  show ?thesis
    unfolding isLub_def potype.simps
    proof (intro exI impI conjI ballI)
    let ?L = "(if S = {} then a else L)"
    show Lin: "?L \<in> interval r a b"
      using L L_in_interval assms left_in_interval by auto
    show "(y, ?L) \<in> induced (interval r a b) r" if "y \<in> S" for y
    proof -
      have "S \<noteq> {}"
        using that by blast
      then show ?thesis
        using L Lin S indI isLub_upper that by auto
    qed
  show "(?L, z) \<in> induced (interval r a b) r"
    if "z \<in> interval r a b" and "\<forall>y\<in>S. (y, z) \<in> induced (interval r a b) r" for z
      using that L
      apply (simp add: isLub_def induced_def interval_imp_mem)
      by (metis (full_types) A_def Lin \<open>a \<in> A\<close> \<open>b \<in> A\<close> interval_subset r_def subset_eq)
  qed
qed

lemmas intv_CL_glb = intv_CL_lub [THEN Rdual]

lemma interval_is_sublattice: "\<lbrakk>a \<in> A; b \<in> A; interval r a b \<noteq> {}\<rbrakk> \<Longrightarrow> interval r a b <<= cl"
  apply (rule sublatticeI)
   apply (simp add: interval_subset)
  by (simp add: CompleteLatticeI intervalPO intv_CL_glb intv_CL_lub)

lemmas interv_is_compl_latt = interval_is_sublattice [THEN sublattice_imp_CL]

subsection \<open>Top and Bottom\<close>

lemma Top_dual_Bot: "Top cl = Bot (dual cl)"
  by (simp add: Top_def Bot_def least_def greatest_def)

lemma Bot_dual_Top: "Bot cl = Top (dual cl)"
  by (simp add: Top_def Bot_def least_def greatest_def)

lemma Bot_in_lattice: "Bot cl \<in> A"
  unfolding Bot_def least_def
  apply (rule_tac a = "glb A cl" in someI2)
  using glb_in_lattice glb_lower by (auto simp: A_def r_def)

lemma Top_in_lattice: "Top cl \<in> A"
  using A_def CLF.Bot_in_lattice Top_dual_Bot local.dual by force

lemma Top_prop: "x \<in> A \<Longrightarrow> (x, Top cl) \<in> r"
  unfolding Top_def greatest_def
  apply (rule_tac a = "lub A cl" in someI2)
  using lub_in_lattice lub_upper by (auto simp: A_def r_def)

lemma Bot_prop: "x \<in> A \<Longrightarrow> (Bot cl, x) \<in> r"
  using A_def Bot_dual_Top CLF.Top_prop dualA_iff dualr_iff local.dual r_def by fastforce

lemma Top_intv_not_empty: "x \<in> A \<Longrightarrow> interval r x (Top cl) \<noteq> {}"
  using Top_prop intervalI reflE by force

lemma Bot_intv_not_empty: "x \<in> A \<Longrightarrow> interval r (Bot cl) x \<noteq> {}"
  using Bot_dual_Top Bot_prop intervalI reflE by fastforce

text \<open>the set of fixed points form a partial order\<close>
proposition fixf_po: "\<lparr>pset = P, order = induced P r\<rparr> \<in> PartialOrder"
  by (simp add: P_def fix_subset po_subset_po)

end

context Tarski
begin

lemma Y_subset_A: "Y \<subseteq> A"
  by (rule subset_trans [OF _ fix_subset]) (rule Y_ss [simplified P_def])

lemma lubY_in_A: "lub Y cl \<in> A"
  by (rule Y_subset_A [THEN lub_in_lattice])

lemma lubY_le_flubY: "(lub Y cl, f (lub Y cl)) \<in> r"
proof (intro lub_least Y_subset_A ballI)
  show "f (lub Y cl) \<in> A"
    by (meson Tarski.monotone_def lubY_in_A monotone_f reflE rel_imp_elem)
  show "(x, f (lub Y cl)) \<in> r" if "x \<in> Y" for x
  proof
    have "\<And>A. Y \<subseteq> A \<Longrightarrow> x \<in> A"
      using that by blast
    moreover have "(x, lub Y cl) \<in> r"
      using that by (simp add: Y_subset_A lub_upper)
    ultimately show "(x, f (lub Y cl)) \<in> r"
      by (metis (no_types) Tarski.Y_ss Tarski_axioms Y_subset_A fix_imp_eq lubY_in_A monotoneE monotone_f)
  qed auto
qed

lemma intY1_subset: "intY1 \<subseteq> A"
  unfolding intY1_def using Top_in_lattice interval_subset lubY_in_A by auto

lemmas intY1_elem = intY1_subset [THEN subsetD]

lemma intY1_f_closed:
  assumes "x \<in> intY1" shows "f x \<in> intY1"
proof (simp add: intY1_def interval_def, rule conjI)
  show "(lub Y cl, f x) \<in> r"
    using assms intY1_elem interval_imp_mem lubY_in_A unfolding intY1_def
    using lubY_le_flubY monotoneE monotone_f po.transE by blast
  then show "(f x, Top cl) \<in> r"
    by (meson PO_imp_refl_on Top_prop refl_onD2)
qed

lemma intY1_mono: "monotone (\<lambda> x \<in> intY1. f x) intY1 (induced intY1 r)"
  apply (auto simp add: monotone_def induced_def intY1_f_closed)
  apply (blast intro: intY1_elem monotone_f [THEN monotoneE])
  done

lemma intY1_is_cl: "\<lparr>pset = intY1, order = induced intY1 r\<rparr> \<in> CompleteLattice"
  unfolding intY1_def
  by (simp add: Top_in_lattice Top_intv_not_empty interv_is_compl_latt lubY_in_A)

lemma v_in_P: "v \<in> P"
proof -
  have "v \<in> fix (restrict f intY1) intY1"
    unfolding v_def
    apply (rule CLF.glbH_is_fixp
        [OF CLF.intro, unfolded CLF_set_def, of "\<lparr>pset = intY1, order = induced intY1 r\<rparr>", simplified])
    using intY1_f_closed intY1_is_cl intY1_mono apply blast+
    done
  then show ?thesis
    unfolding P_def
  by (meson fixf_subset intY1_subset)
qed

lemma z_in_interval: "\<lbrakk>z \<in> P; \<forall>y\<in>Y. (y, z) \<in> induced P r\<rbrakk> \<Longrightarrow> z \<in> intY1"
  unfolding intY1_def P_def
  by (meson Top_prop Y_subset_A fix_subset in_mono indE intervalI lub_least)

lemma tarski_full_lemma: "\<exists>L. isLub Y \<lparr>pset = P, order = induced P r\<rparr> L"
proof
  have "(y, v) \<in> induced P r" if "y \<in> Y" for y
  proof -
    have "(y, lub Y cl) \<in> r"
      by (simp add: Y_subset_A lub_upper that)
    moreover have "(lub Y cl, v) \<in> r"
      by (metis (no_types, lifting) CL.glb_in_lattice CL.intro intY1_def intY1_is_cl interval_imp_mem lub_dual_glb mem_Collect_eq select_convs(1) subsetI v_def)
    ultimately have "(y, v) \<in> r"
      using po.transE by blast
    then show ?thesis
      using Y_ss indI that v_in_P by auto
  qed
  moreover have "(v, z) \<in> induced P r" if "z \<in> P" "\<forall>y\<in>Y. (y, z) \<in> induced P r" for z
  proof (rule indI)
    have "((\<lambda>x \<in> intY1. f x) z, z) \<in> induced intY1 r"
      by (metis P_def fix_imp_eq in_mono indI intY1_subset reflE restrict_apply' that z_in_interval)
    then show "(v, z) \<in> r"
      by (metis (no_types, lifting) CL.glb_lower CL_def indE intY1_is_cl intY1_subset mem_Collect_eq select_convs(1,2) subsetI that v_def z_in_interval)
  qed (auto simp: that v_in_P)
  ultimately
  show "isLub Y \<lparr>pset = P, order = induced P r\<rparr> v"
    by (simp add: isLub_def v_in_P)
qed

end

lemma CompleteLatticeI_simp:
  "\<lbrakk>po \<in> PartialOrder; \<And>S. S \<subseteq> A \<Longrightarrow> \<exists>L. isLub S po  L; A = pset po\<rbrakk> \<Longrightarrow> po \<in> CompleteLattice"
  by (metis CompleteLatticeI Rdual)

theorem (in CLF) Tarski_full: "\<lparr>pset = P, order = induced P r\<rparr> \<in> CompleteLattice"
proof (intro CompleteLatticeI_simp allI impI)
  show "\<lparr>pset = P, order = induced P r\<rparr> \<in> PartialOrder"
    by (simp add: fixf_po)
  show "\<And>S. S \<subseteq> P \<Longrightarrow> \<exists>L. isLub S \<lparr>pset = P, order = induced P r\<rparr> L"
    unfolding P_def A_def r_def
  proof (rule Tarski.tarski_full_lemma [OF Tarski.intro [OF _ Tarski_axioms.intro]])
    show "CLF cl f" ..
  qed
qed auto

end