section \<open>The Fundamental Theorem of Linear Inequalities\<close>

text \<open>The theorem states that for a given set of vectors A and vector b, either
  b is in the cone of a linear independent subset of A, or
  there is a hyperplane that contains span(A,b)-1 linearly independent vectors of A
  that separates A from b. We prove this theorem and derive some consequences, e.g.,
  Caratheodory's theorem that b is the cone of A iff b is in the cone of a linear
  independent subset of A.\<close>

theory Fundamental_Theorem_Linear_Inequalities
  imports
    Cone
    Normal_Vector
    Dim_Span
begin

context gram_schmidt
begin

text \<open>The mentions equivances A-D are:
 \<^item> A: b is in the cone of vectors A,
 \<^item> B: b is in the cone of a subset of linear independent of vectors A,
 \<^item> C: there is no separating hyperplane of b and the vectors A,
      which contains dim many linear independent vectors of A
 \<^item> D: there is no separating hyperplane of b and the vectors A\<close>

lemma fundamental_theorem_of_linear_inequalities_A_imp_D:
  assumes A: "A \<subseteq> carrier_vec n"
    and fin: "finite A"
    and b: "b \<in> cone A"
  shows "\<nexists> c. c \<in> carrier_vec n \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0"
proof
  assume "\<exists> c. c \<in> carrier_vec n \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0"
  then obtain c where c: "c \<in> carrier_vec n"
    and ai: "\<And> ai. ai \<in> A \<Longrightarrow> c \<bullet> ai \<ge> 0"
    and cb: "c \<bullet> b < 0" by auto
  from b[unfolded cone_def nonneg_lincomb_def finite_cone_def]
  obtain l AA where bc: "b = lincomb l AA" and l: "l ` AA \<subseteq> {x. x \<ge> 0}" and AA: "AA \<subseteq> A" by auto
  from cone_carrier[OF A] b have b: "b \<in> carrier_vec n" by auto
  have "0 \<le> (\<Sum>ai\<in>AA. l ai * (c \<bullet> ai))"
    by (intro sum_nonneg mult_nonneg_nonneg, insert l ai AA, auto)
  also have "\<dots> = (\<Sum>ai\<in>AA. l ai * (ai \<bullet> c))"
    by (rule sum.cong, insert c A AA comm_scalar_prod, force+)
  also have "\<dots> = (\<Sum>ai\<in>AA. ((l ai \<cdot>\<^sub>v ai) \<bullet> c))"
    by (rule sum.cong, insert smult_scalar_prod_distrib c A AA, auto)
  also have "\<dots> = b \<bullet> c" unfolding bc lincomb_def
    by (subst finsum_scalar_prod_sum[symmetric], insert c A AA, auto)
  also have "\<dots> = c \<bullet> b" using comm_scalar_prod b c by auto
  also have "\<dots> < 0" by fact
  finally show False by simp
qed

text \<open>The difficult direction is that C implies B. To this end we follow the
  proof that at least one of B and the negation of C is satisfied.\<close>
context
  fixes a :: "nat \<Rightarrow> 'a vec"
    and b :: "'a vec"
    and m :: nat
  assumes a: "a ` {0 ..< m} \<subseteq> carrier_vec n"
    and inj_a: "inj_on a {0 ..< m}"
    and b: "b \<in> carrier_vec n"
    and full_span: "span (a ` {0 ..< m}) = carrier_vec n"
begin

private definition "goal = ((\<exists> I. I \<subseteq> {0 ..< m} \<and> card (a ` I) = n \<and> lin_indpt (a ` I) \<and> b \<in> finite_cone (a ` I))
  \<or> (\<exists> c I. I \<subseteq> {0 ..< m} \<and> c \<in> {normal_vector (a ` I), - normal_vector (a ` I)} \<and> Suc (card (a ` I)) = n
      \<and> lin_indpt (a ` I) \<and> (\<forall> i < m. c \<bullet> a i \<ge> 0) \<and> c \<bullet> b < 0))"

private lemma card_a_I[simp]: "I \<subseteq> {0 ..< m} \<Longrightarrow> card (a ` I) = card I"
  by (smt inj_a card_image inj_on_image_eq_iff subset_image_inj subset_refl subset_trans)

private lemma in_a_I[simp]: "I \<subseteq> {0 ..< m} \<Longrightarrow> i < m \<Longrightarrow> (a i \<in> a ` I) = (i \<in> I)"
  using inj_a
  by (meson atLeastLessThan_iff image_eqI inj_on_image_mem_iff_alt zero_le)

private definition "valid_I = { I. card I = n \<and> lin_indpt (a ` I) \<and> I \<subseteq> {0 ..< m}}"

private definition cond where "cond I I' l c h k \<equiv>
  b = lincomb l (a ` I) \<and>
  h \<in> I \<and> l (a h) < 0 \<and> (\<forall> h'. h' \<in> I \<longrightarrow> h' < h \<longrightarrow> l (a h') \<ge> 0) \<and>
  c \<in> carrier_vec n \<and> span (a ` (I - {h})) = { x. x \<in> carrier_vec n \<and> c \<bullet> x = 0} \<and> c \<bullet> b < 0 \<and>
  k < m \<and> c \<bullet> a k < 0 \<and> (\<forall> k'. k' < k \<longrightarrow> c \<bullet> a k' \<ge> 0) \<and>
  I' = insert k (I - {h})"

private definition "step_rel = Restr { (I'', I). \<exists> l c h k. cond I I'' l c h k } valid_I"

private lemma finite_step_rel: "finite step_rel"
proof (rule finite_subset)
  show "step_rel \<subseteq> (Pow {0 ..< m} \<times> Pow {0 ..< m})" unfolding step_rel_def valid_I_def by auto
qed auto

private lemma acyclic_imp_goal: "acyclic step_rel \<Longrightarrow> goal"
proof (rule ccontr)
  assume ngoal: "\<not> goal" (* then the algorithm will not terminate *)
  {
    fix I
    assume I: "I \<in> valid_I"
    hence Im: "I \<subseteq> {0..<m}" and
      lin: "lin_indpt (a ` I)" and
      cardI: "card I = n"
      by (auto simp: valid_I_def)
    let ?D = "(a ` I)"
    have finD: "finite ?D" using Im infinite_super by blast
    have carrD: "?D \<subseteq> carrier_vec n" using a Im by auto
    have cardD: "card ?D = n" using cardI Im by simp
    have spanD: "span ?D = carrier_vec n"
      by (intro span_carrier_lin_indpt_card_n lin cardD carrD)
    obtain lamb where b_is_lincomb: "b = lincomb lamb (a ` I)"
      using finite_in_span[OF fin carrD, of b] using spanD b carrD fin_dim lin by auto
    define h where "h = (LEAST h. h \<in> I \<and> lamb (a h) < 0)"
    have "\<exists> I'. (I', I) \<in> step_rel"
    proof (cases "\<forall>i\<in> I . lamb (a i) \<ge> 0")
      case cond1_T: True
      have goal unfolding goal_def
        by (intro disjI1 exI[of _ I] conjI lin cardI
            lincomb_in_finite_cone[OF b_is_lincomb finD _ carrD], insert cardI Im cond1_T, auto)
      with ngoal show ?thesis by auto
    next
      case cond1_F: False
      hence "\<exists> h. h \<in> I \<and> lamb (a h) < 0" by fastforce
      from LeastI_ex[OF this, folded h_def] have h: "h \<in> I" "lamb (a h) < 0" by auto
      from not_less_Least[of _ "\<lambda> h. h \<in> I \<and> lamb (a h) < 0", folded h_def]
      have h_least: "\<forall> k. k \<in> I \<longrightarrow> k < h \<longrightarrow> lamb (a k) \<ge> 0" by fastforce
      obtain I' where I'_def: "I' = I - {h}" by auto
      obtain c where c_def: "c = pos_norm_vec (a ` I') (a h)" by auto
      let ?D' = "a ` I'"
      have I'm: "I' \<subseteq> {0..<m}" using Im I'_def by auto
      have carrD': " ?D' \<subseteq> carrier_vec n" using a Im I'_def by auto
      have finD': "finite (?D')" using Im I'_def subset_eq_atLeast0_lessThan_finite by auto
      have D'subs: "?D' \<subseteq> ?D" using I'_def by auto
      have linD': "lin_indpt (?D')" using lin I'_def Im D'subs subset_li_is_li by auto
      have D'strictsubs: "?D = ?D' \<union> {a h}" using h I'_def by auto
      have h_nin_I: "h \<notin> I'" using h I'_def by auto
      have ah_nin_D': "a h \<notin> ?D'" using h inj_a Im h_nin_I by (subst in_a_I, auto simp: I'_def)
      have cardD': "Suc (card (?D')) = n " using cardD ah_nin_D' D'strictsubs finD' by simp
      have ah_carr: "a h \<in> carrier_vec n" using h a Im by auto
      note pnv = pos_norm_vec[OF carrD' finD' linD' cardD' c_def]
      have ah_nin_span: "a h \<notin> span ?D'"
        using D'strictsubs lin_dep_iff_in_span[OF carrD' linD' ah_carr ah_nin_D'] lin by auto
      have cah_ge_zero:"c \<bullet> a h > 0" and "c \<in> carrier_vec n"
        and cnorm: "span ?D' = {x \<in> carrier_vec n. x \<bullet> c = 0}"
        using ah_carr ah_nin_span pnv by auto
      have ccarr: "c \<in> carrier_vec n" by fact
      have "b \<bullet> c = lincomb lamb (a ` I) \<bullet> c" using b_is_lincomb by auto
      also have "\<dots> = (\<Sum>w\<in> ?D. lamb w * (w \<bullet> c))"
        using lincomb_scalar_prod_left[OF carrD, of c lamb] pos_norm_vec ccarr by blast
      also have "\<dots> = lamb (a h) * (a h \<bullet> c) + (\<Sum>w\<in> ?D'. lamb w * (w \<bullet> c))"
        using sum.insert[OF finD' ah_nin_D', of lamb] D'strictsubs ah_nin_D' finD' by auto
      also have "(\<Sum>w\<in> ?D'. lamb w * (w \<bullet> c)) = 0"
        apply (rule sum.neutral)
        using span_mem[OF carrD', unfolded cnorm] by simp
      also have "lamb (a h) * (a h \<bullet> c) + 0 < 0"
        using cah_ge_zero h(2) comm_scalar_prod[OF ah_carr ccarr]
        by (auto intro: mult_neg_pos)
      finally have cb_le_zero: "c \<bullet> b < 0" using comm_scalar_prod[OF b ccarr] by auto

      show ?thesis
      proof (cases "\<forall>i < m . c \<bullet> a i \<ge> 0")
        case cond2_T: True
        have goal
          unfolding goal_def
          by (intro disjI2 exI[of _ c] exI[of _ I'] conjI cb_le_zero linD' cond2_T cardD' I'm pnv(4))
        with ngoal show ?thesis by auto
      next
        case cond2_F: False
        define k where "k = (LEAST k. k < m \<and> c \<bullet> a k < 0)"
        let ?I'' = "insert k I'"
        show ?thesis unfolding step_rel_def
        proof (intro exI[of _ ?I''], standard, unfold mem_Collect_eq split, intro exI)
          from LeastI_ex[OF ]
          have "\<exists>k. k < m \<and> c \<bullet> a k < 0" using cond2_F by fastforce
          from LeastI_ex[OF this, folded k_def] have k: "k < m" "c \<bullet> a k < 0" by auto
          show "cond I ?I'' lamb c h k" unfolding cond_def I'_def[symmetric] cnorm
          proof(intro conjI cb_le_zero b_is_lincomb h ccarr h_least refl k)
            show "{x \<in> carrier_vec n. x \<bullet> c = 0} = {x \<in> carrier_vec n. c \<bullet> x = 0}"
              using comm_scalar_prod[OF ccarr] by auto
            from not_less_Least[of _ "\<lambda> k. k < m \<and> c \<bullet> a k < 0", folded k_def]
            have "\<forall>k' < k . k' > m \<or> c \<bullet> a k' \<ge> 0" using k(1) less_trans not_less by blast
            then show "\<forall>k' < k . c \<bullet> a k' \<ge> 0" using k(1) by auto
          qed

          have "?I'' \<in> valid_I" unfolding valid_I_def
          proof(standard, intro conjI)
            from k a have ak_carr: "a k \<in> carrier_vec n" by auto
            have ak_nin_span: "a k \<notin> span ?D'" using k(2) cnorm comm_scalar_prod[OF ak_carr ccarr] by auto
            hence ak_nin_D': "a k \<notin> ?D'" using span_mem[OF carrD'] by auto
            from lin_dep_iff_in_span[OF carrD' linD' ak_carr ak_nin_D']
            show "lin_indpt (a ` ?I'')" using ak_nin_span by auto
            show "?I'' \<subseteq> {0..<m}" using I'm k by auto
            show "card (insert k I') = n" using cardD' ak_nin_D' finD'
              by (metis \<open>insert k I' \<subseteq> {0..<m}\<close> card_a_I card_insert_disjoint image_insert)
          qed
          then show "(?I'', I) \<in> valid_I \<times> valid_I"  using I by auto

        qed
      qed
    qed
  } note step = this
  { (* create some valid initial set I *)
    from exists_lin_indpt_subset[OF a, unfolded full_span]
    obtain A where lin: "lin_indpt A" and span: "span A = carrier_vec n" and Am: "A \<subseteq> a ` {0 ..<m}" by auto
    from Am a have A: "A \<subseteq> carrier_vec n" by auto
    from lin span A have card: "card A = n"
      using basis_def dim_basis dim_is_n fin_dim_li_fin by auto
    from A Am obtain I where  A: "A = a ` I" and I: "I \<subseteq> {0 ..< m}" by (metis subset_imageE)
    have "I \<in> valid_I" using I card lin unfolding valid_I_def A by auto
    hence "\<exists> I. I \<in> valid_I" ..
  }
  note init = this
  have step_valid: "(I',I) \<in> step_rel \<Longrightarrow> I' \<in> valid_I" for I I' unfolding step_rel_def by auto
  have "\<not> (wf step_rel)"
  proof
    from init obtain I where I: "I \<in> valid_I" by auto
    assume "wf step_rel"
    from this[unfolded wf_eq_minimal, rule_format, OF I] step step_valid show False by blast
  qed
  with wf_iff_acyclic_if_finite[OF finite_step_rel]
  have "\<not> acyclic step_rel" by auto
  thus "acyclic step_rel \<Longrightarrow> False" by auto
qed

private lemma acyclic_step_rel: "acyclic step_rel"
proof (rule ccontr)
  assume "\<not> ?thesis"
  hence "\<not> acyclic (step_rel\<inverse>)" by auto

(* obtain cycle *)
  then obtain I where "(I, I) \<in> (step_rel^-1)^+" unfolding acyclic_def by blast
  from this[unfolded trancl_power]
  obtain len where "(I, I) \<in> (step_rel^-1) ^^ len" and len0: "len > 0" by blast
      (* obtain all intermediate I's *)
  from this[unfolded relpow_fun_conv] obtain Is where
    stepsIs: "\<And> i. i < len \<Longrightarrow> (Is (Suc i), Is i) \<in> step_rel"
    and IsI: "Is 0 = I" "Is len = I" by auto
  {
    fix i
    assume "i \<le> len" hence "i - 1 < len" using len0 by auto
    from stepsIs[unfolded step_rel_def, OF this]
    have "Is i \<in> valid_I" by (cases i, auto)
  } note Is_valid = this
  from stepsIs[unfolded step_rel_def]
  have "\<forall> i. \<exists> l c h k. i < len \<longrightarrow> cond (Is i) (Is (Suc i)) l c h k" by auto
      (* obtain all intermediate c's h's, l's, k's *)
  from choice[OF this] obtain ls where "\<forall> i. \<exists> c h k. i < len \<longrightarrow> cond (Is i) (Is (Suc i)) (ls i) c h k" by auto
  from choice[OF this] obtain cs where "\<forall> i. \<exists> h k. i < len \<longrightarrow> cond (Is i) (Is (Suc i)) (ls i) (cs i) h k" by auto
  from choice[OF this] obtain hs where "\<forall> i. \<exists> k. i < len \<longrightarrow> cond (Is i) (Is (Suc i)) (ls i) (cs i) (hs i) k" by auto
  from choice[OF this] obtain ks where
    cond: "\<And> i. i < len \<Longrightarrow> cond (Is i) (Is (Suc i)) (ls i) (cs i) (hs i) (ks i)" by auto
      (* finally derive contradiction *)
  let ?R = "{hs i | i. i < len}"
  define r where "r = Max ?R"
  from cond[OF len0] have "hs 0 \<in> I" using IsI unfolding cond_def by auto
  hence R0: "hs 0 \<in> ?R" using len0 by auto
  have finR: "finite ?R" by auto
  from Max_in[OF finR] R0
  have rR: "r \<in> ?R" unfolding r_def[symmetric] by auto
  then obtain p where rp: "r = hs p" and p: "p < len" by auto
  from Max_ge[OF finR, folded r_def]
  have rLarge: "i < len \<Longrightarrow> hs i \<le> r" for i by auto
  have exq: "\<exists>q. ks q = r \<and> q < len"
  proof (rule ccontr)
    assume neg: "\<not>?thesis"
    show False
    proof(cases "r \<in> I")
      case True
      have 1: "j\<in>{Suc p..len} \<Longrightarrow> r \<notin> Is j" for j
      proof(induction j rule: less_induct)
        case (less j)
        from less(2) have j_bounds: "j = Suc p \<or> j > Suc p" by auto
        from less(2) have j_len: "j \<le> len" by auto
        have pj_cond: "j = Suc p \<Longrightarrow> cond (Is p) (Is j) (ls p) (cs p) (hs p) (ks p)" using cond p by blast
        have r_neq_ksp: "r \<noteq> ks p" using p neg by auto
        have "j = Suc p \<Longrightarrow> Is j = insert (ks p) (Is p - {r})"
          using rp cond pj_cond cond_def[of "Is p" "Is j" _ _ r] by blast
        hence c1: "j = Suc p \<Longrightarrow> r \<notin> Is j" using r_neq_ksp by simp
        have IH: "\<And>t. t < j \<Longrightarrow> t \<in> {Suc p..len} \<Longrightarrow> r \<notin> Is t" by fact
        have r_neq_kspj: "j > Suc p \<and> j \<le> len \<Longrightarrow> r \<noteq> ks (j-1)" using j_len neg IH by auto
        have jsucj_cond: "j > Suc p \<and> j \<le> len \<Longrightarrow> Is j = insert (ks (j-1)) (Is (j-1) - {hs (j-1)})"
          using cond_def[of "Is (j-1)" "Is j"] cond
          by (metis (no_types, lifting) Suc_less_eq2 diff_Suc_1 le_simps(3))
        hence "j > Suc p \<and> j \<le> len \<Longrightarrow> r \<notin> insert (ks (j-1)) (Is (j-1))"
          using IH r_neq_kspj by auto
        hence "j > Suc p \<and> j \<le> len \<Longrightarrow> r \<notin> Is j" using jsucj_cond by simp
        then show ?case using j_bounds j_len c1 by blast
      qed
      then show ?thesis using neg IsI(2) True p by auto
    next
      case False
      have 2: "j\<in>{0..p} \<Longrightarrow> r \<notin> Is j" for j
      proof(induction j rule: less_induct)
        case(less j)
        from less(2) have j_bound: "j \<le> p" by auto
        have r_nin_Is0: "r \<notin> Is 0" using IsI(1) False by simp
        have IH: "\<And>t. t < j \<and> t \<in> {0..p} \<Longrightarrow> r \<notin> Is t" using less.IH by blast
        have j_neq_ksjpred: "j > 0 \<Longrightarrow> r \<noteq> ks (j -1)" using neg j_bound p by auto
        have Is_jpredj: "j > 0 \<Longrightarrow> Is j = insert (ks (j-1)) (Is (j-1) - {hs (j-1)})"
          using cond_def[of "Is (j-1)" "Is j" _ _ "hs (j-1)" "ks (j-1)"] cond
          by (metis (full_types) One_nat_def Suc_pred diff_le_self j_bound le_less_trans p)
        have "j > 0 \<Longrightarrow> r \<notin> insert (ks (j-1)) (Is (j-1))"
          using j_neq_ksjpred IH j_bound by fastforce
        hence "j > 0 \<Longrightarrow> r \<notin> Is j" using Is_jpredj by blast
        then show ?case using j_bound r_nin_Is0 by blast
      qed
      have 3: "r \<in> Is p" using rp cond cond_def p by blast
      then show ?thesis using 2 3 by auto
    qed
  qed
  then obtain q where q1: "ks q = r" and q_len: "q < len" by blast

  {
    fix t i1 i2
    assume "i1 < len" "i2 < len" "t < m"
    assume "t\<in> Is i1" "t\<notin> Is i2"
    have "\<exists>j < len. t = hs j"
    proof (rule ccontr)
      assume "\<not> ?thesis"
      hence hst: "\<And> j. j < len \<Longrightarrow> hs j \<noteq> t" by auto
      have main: "t \<notin> Is (i + k) \<Longrightarrow> i + k \<le> len \<Longrightarrow> t \<notin> Is k" for i k
      proof (induct i)
        case (Suc i)
        hence i: "i + k < len" by auto
        from cond[OF this, unfolded cond_def]
        have "Is (Suc i + k) = insert (ks (i + k)) (Is (i + k) - {hs (i + k)})" by auto
        from Suc(2)[unfolded this] hst[OF i] have "t \<notin> Is (i + k)" by auto
        from Suc(1)[OF this] i show ?case by auto
      qed auto
      from main[of i2 0] \<open>i2 < len\<close> \<open>t \<notin> Is i2\<close> have "t \<notin> Is 0" by auto
      with IsI have "t \<notin> Is len" by auto
      with main[of "len - i1" i1] \<open>i1 < len\<close> have "t \<notin> Is i1" by auto
      with \<open>t \<in> Is i1\<close> show False by blast
    qed
  } note innotin = this

  {
    fix i
    assume i: "i \<in> {Suc r..<m}"
    {
      assume i_in_Isp: "i \<in> Is p"
      have "i \<in> Is q"
      proof (rule ccontr)
        have i_range: "i < m" using i by simp
        assume "\<not> ?thesis"
        then have ex: "\<exists>j < len. i = hs j"
          using innotin[OF p q_len i_range i_in_Isp] by simp
        then obtain j where j_hs: "i = hs j" by blast
        have "i>r" using i by simp
        then show False using j_hs p rLarge ex by force
      qed
    }
    hence "(i \<in> Is p) \<Longrightarrow> (i \<in> Is q)" by blast
  } note bla = this
  have blin: "b = lincomb (ls p) (a ` (Is p))" using cond_def p cond by blast
  have carrDp: "(a ` (Is p)) \<subseteq> carrier_vec n " using Is_valid valid_I_def a p
    by (smt image_subset_iff less_imp_le_nat mem_Collect_eq subsetD)
  have carrcq: "cs q \<in> carrier_vec n" using cond cond_def q_len by simp
  have ineq1: "(cs q) \<bullet> b < 0" using cond_def q_len cond by blast
  let ?Isp_lt_r = "{x \<in> Is p . x < r}"
  let ?Isp_gt_r = "{x \<in> Is p . x > r}"
  have Is_disj: "?Isp_lt_r \<inter> ?Isp_gt_r = {}" using Is_valid by auto
  have "?Isp_lt_r \<subseteq> Is p" by simp
  hence Isp_lt_0m: "?Isp_lt_r \<subseteq> {0..<m}" using valid_I_def Is_valid p less_imp_le_nat by blast
  have "?Isp_gt_r \<subseteq> Is p" by simp
  hence Isp_gt_0m: "?Isp_gt_r \<subseteq> {0..<m}" using valid_I_def Is_valid p less_imp_le_nat by blast
  let ?Dp_lt = "a ` ?Isp_lt_r"
  let ?Dp_ge = "a ` ?Isp_gt_r"
  {
    fix A B
    assume Asub: "A \<subseteq> {0..<m} \<union> {0..<Suc r}"
    assume Bsub: "B \<subseteq> {0..<m} \<union> {0..<Suc r}"
    assume ABinters: "A \<inter> B = {}"
    have "r \<in> Is p" using rp p cond unfolding cond_def by simp
    hence r_lt_m: "r < m" using p Is_valid[of p] unfolding valid_I_def by auto
    hence 1: "A \<subseteq> {0..<m}" using Asub by auto
    have 2: "B \<subseteq> {0..<m}" using r_lt_m Bsub by auto
    have "a ` A \<inter> a ` B = {}"
      using inj_on_image_Int[OF inj_a 1 2] ABinters by auto
  } note inja = this

  have "(Is p \<inter> {0..<r}) \<inter> (Is p \<inter> {r}) = {}" by auto
  hence "a ` (Is p \<inter> {0..<r} \<union> Is p \<inter> {r}) = a ` (Is p \<inter> {0..<r}) \<union> a ` (Is p \<inter> {r})"
    using inj_a by auto
  moreover have "Is p \<inter> {0..<r} \<union> Is p \<inter> {r} \<subseteq> {0..<m} \<union> {0..<Suc r}" by auto
  moreover have "Is p \<inter> {Suc r..<m} \<subseteq> {0..<m} \<union> {0..<Suc r}" by auto
  moreover have "(Is p \<inter> {0..<r} \<union> Is p \<inter> {r}) \<inter> (Is p \<inter> {Suc r..<m}) = {}" by auto
  ultimately have one: "(a ` (Is p \<inter> {0..<r}) \<union> a ` (Is p \<inter> {r})) \<inter> a ` (Is p \<inter> {Suc r..<m}) = {}"
    using inja[of "Is p \<inter> {0..<r} \<union> Is p \<inter> {r}" "Is p \<inter> {Suc r..<m}"] by auto
  have split: "Is p = Is p \<inter> {0..<r} \<union> Is p \<inter> {r} \<union> Is p \<inter> {Suc r ..< m}"
    using rp p Is_valid[of p] unfolding valid_I_def by auto
  have gtr: "(\<Sum>w \<in> (a ` (Is p \<inter> {Suc r ..< m})). ((ls p) w) * (cs q \<bullet> w)) = 0"
  proof (rule sum.neutral, clarify)
    fix w
    assume w1: "w \<in> Is p" and w2: "w\<in>{Suc r..<m}"
    have w_in_q:  "w \<in> Is q" using bla[OF w2] w1 by blast
    moreover have "hs q \<le> r" using rR rLarge using q_len by blast
    ultimately have "w \<noteq> hs q" using w2 by simp
    hence "w \<in> Is q -{hs q}" using w1 w_in_q by auto
    moreover have "Is q - {hs q} \<subseteq> {0..<m}"
      using q_len Is_valid[of q] unfolding valid_I_def by auto
    ultimately have "a w \<in> span ( a ` (Is q - {hs q}))" using a by (intro span_mem, auto)
    moreover have "cs q \<in> carrier_vec n \<and> span (a ` (Is q - {hs q})) =
      { x. x \<in> carrier_vec n \<and> cs q \<bullet> x = 0}"
      using cond[of q] q_len unfolding cond_def by auto
    ultimately have "(cs q) \<bullet> (a w) = 0" using a w2 by simp
    then show "ls p (a w) * (cs q \<bullet> a w) = 0" by simp
  qed
  note pp = cond[OF p, unfolded cond_def rp[symmetric]]
  note qq = cond[OF q_len, unfolded cond_def q1]
  have "(cs q) \<bullet> b = (cs q) \<bullet> lincomb (ls p) (a ` (Is p))" using blin by auto
  also have "\<dots> = (\<Sum>w \<in> (a ` (Is p)). ((ls p) w) * (cs q \<bullet> w))"
    by (subst lincomb_scalar_prod_right[OF carrDp carrcq], simp)
  also have "\<dots> = (\<Sum>w \<in> (a ` (Is p \<inter> {0..<r}) \<union> a ` (Is p \<inter> {r}) \<union> a ` (Is p \<inter> {Suc r..<m})).
     ((ls p) w) * (cs q \<bullet> w))"
    by (subst (1) split, rule sum.cong, auto)
  also have "\<dots> = (\<Sum>w \<in> (a ` (Is p \<inter> {0..<r})). ((ls p) w) * (cs q \<bullet> w))
       + (\<Sum>w \<in> (a ` (Is p \<inter> {r})). ((ls p) w) * (cs q \<bullet> w))
      + (\<Sum>w \<in> (a ` (Is p \<inter> {Suc r ..< m})). ((ls p) w) * (cs q \<bullet> w))"
    apply (subst sum.union_disjoint[OF _ _ one])
      apply (force+)[2]
    apply (subst sum.union_disjoint)
       apply (force+)[2]
     apply (rule inja)
    by auto
  also have "\<dots> = (\<Sum>w \<in> (a ` (Is p \<inter> {0..<r})). ((ls p) w) * (cs q \<bullet> w))
       + (\<Sum>w \<in> (a ` (Is p \<inter> {r})). ((ls p) w) * (cs q \<bullet> w))"
    using sum.neutral gtr by simp
  also have "\<dots> > 0 + 0"
  proof (intro add_le_less_mono sum_nonneg mult_nonneg_nonneg)
    {
      fix x
      assume x: "x \<in> a ` (Is p \<inter> {0..<r})"
      show "0 \<le> ls p x" using pp x by auto
      show "0 \<le> cs q \<bullet> x" using qq x by auto
    }
    have "r \<in> Is p" using pp by blast
    hence "a ` (Is p \<inter> {r}) = {a r}" by auto
    hence id: "(\<Sum>w\<in>a ` (Is p \<inter> {r}). ls p w * (cs q \<bullet> w)) = ls p (a r) * (cs q \<bullet> a r)"
      by simp
    show "0 < (\<Sum>w\<in>a ` (Is p \<inter> {r}). ls p w * (cs q \<bullet> w))"
      unfolding id
    proof (rule mult_neg_neg)
      show "ls p (a r) < 0" using pp by auto
      show "cs q \<bullet> a r < 0" using qq by auto
    qed
  qed
  finally have "cs q \<bullet> b > 0" by simp
  moreover have "cs q \<bullet> b < 0" using qq by blast
  ultimately show False by auto
qed

lemma fundamental_theorem_neg_C_or_B_in_context:
  assumes W: "W = a ` {0 ..< m}"
  shows "(\<exists> U. U \<subseteq> W \<and> card U = n \<and> lin_indpt U \<and> b \<in> finite_cone U) \<or>
    (\<exists>c U. U \<subseteq> W \<and>
           c \<in> {normal_vector U, - normal_vector U} \<and>
           Suc (card U) = n \<and> lin_indpt U \<and> (\<forall>w \<in> W. 0 \<le> c \<bullet> w) \<and> c \<bullet> b < 0)"
  using acyclic_imp_goal[unfolded goal_def, OF acyclic_step_rel]
proof
  assume "\<exists>I. I\<subseteq>{0..<m} \<and> card (a ` I) = n \<and> lin_indpt (a ` I) \<and> b \<in> finite_cone (a ` I)"
  thus ?thesis unfolding W by (intro disjI1, blast)
next
  assume "\<exists>c I. I \<subseteq> {0..<m} \<and>
          c \<in> {normal_vector (a ` I), - normal_vector (a ` I)} \<and>
          Suc (card (a ` I)) = n \<and> lin_indpt (a ` I) \<and> (\<forall>i<m. 0 \<le> c \<bullet> a i) \<and> c \<bullet> b < 0"
  then obtain c I where "I \<subseteq> {0..<m} \<and>
          c \<in> {normal_vector (a ` I), - normal_vector (a ` I)} \<and>
          Suc (card (a ` I)) = n \<and> lin_indpt (a ` I) \<and> (\<forall>i<m. 0 \<le> c \<bullet> a i) \<and> c \<bullet> b < 0" by auto
  thus ?thesis unfolding W
    by (intro disjI2 exI[of _ c] exI[of _ "a ` I"], auto)
qed

end

lemma fundamental_theorem_of_linear_inequalities_C_imp_B_full_dim:
  assumes A: "A \<subseteq> carrier_vec n"
    and fin: "finite A"
    and span: "span A = carrier_vec n" (* this condition was a wlog in the proof *)
    and b: "b \<in> carrier_vec n"
    and C: "\<nexists> c B. B \<subseteq> A \<and> c \<in> {normal_vector B, - normal_vector B} \<and> Suc (card B) = n
      \<and> lin_indpt B \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0"
  shows "\<exists> B \<subseteq> A. lin_indpt B \<and> card B = n \<and> b \<in> finite_cone B"
proof -
  from finite_distinct_list[OF fin] obtain as where Aas: "A = set as" and dist: "distinct as" by auto
  define m where "m = length as"
  define a where "a = (\<lambda> i. as ! i)"
  have inj: "inj_on a {0..< (m :: nat)}"
    and id: "A = a ` {0..<m}"
    unfolding m_def a_def Aas using inj_on_nth[OF dist] unfolding set_conv_nth
    by auto
  from fundamental_theorem_neg_C_or_B_in_context[OF _ inj b, folded id, OF A span refl] C
  show ?thesis by blast
qed

lemma fundamental_theorem_of_linear_inequalities_full_dim: fixes A :: "'a vec set"
  defines "HyperN \<equiv> {b. b \<in> carrier_vec n \<and> (\<nexists> B c. B \<subseteq> A \<and> c \<in> {normal_vector B, - normal_vector B}
      \<and> Suc (card B) = n \<and> lin_indpt B \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0)}"
  defines "HyperA \<equiv> {b. b \<in> carrier_vec n \<and> (\<nexists> c. c \<in> carrier_vec n \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0)}"
  defines "lin_indpt_cone \<equiv> \<Union> { finite_cone B | B. B \<subseteq> A \<and> card B = n \<and> lin_indpt B}"
  assumes A: "A \<subseteq> carrier_vec n"
    and fin: "finite A"
    and span: "span A = carrier_vec n"
  shows
    "cone A = lin_indpt_cone"
    "cone A = HyperN"
    "cone A = HyperA"
proof -
  have "lin_indpt_cone \<subseteq> cone A" unfolding lin_indpt_cone_def cone_def using fin finite_cone_mono A
    by auto
  moreover have "cone A \<subseteq> HyperA"
  proof
    fix c
    assume cA: "c \<in> cone A"
    from fundamental_theorem_of_linear_inequalities_A_imp_D[OF A fin this] cone_carrier[OF A] cA
    show "c \<in> HyperA" unfolding HyperA_def by auto
  qed
  moreover have "HyperA \<subseteq> HyperN"
  proof
    fix c
    assume "c \<in> HyperA"
    hence False: "\<And> v. v \<in> carrier_vec n \<Longrightarrow> (\<forall>a\<^sub>i\<in>A. 0 \<le> v \<bullet> a\<^sub>i) \<Longrightarrow> v \<bullet> c < 0 \<Longrightarrow> False"
      and c: "c \<in> carrier_vec n" unfolding HyperA_def by auto
    show "c \<in> HyperN"
      unfolding HyperN_def
    proof (standard, intro conjI c notI, clarify, goal_cases)
      case (1 W nv)
      with A fin have fin: "finite W" and W: "W \<subseteq> carrier_vec n" by (auto intro: finite_subset)
      show ?case using False[of nv] 1 normal_vector[OF fin _ _ W] by auto
    qed
  qed
  moreover have "HyperN \<subseteq> lin_indpt_cone"
  proof
    fix b
    assume "b \<in> HyperN"
    from this[unfolded HyperN_def]
      fundamental_theorem_of_linear_inequalities_C_imp_B_full_dim[OF A fin span, of b]
    show "b \<in> lin_indpt_cone" unfolding lin_indpt_cone_def by auto
  qed
  ultimately show
    "cone A = lin_indpt_cone"
    "cone A = HyperN"
    "cone A = HyperA"
    by auto
qed

lemma fundamental_theorem_of_linear_inequalities_C_imp_B:
  assumes A: "A \<subseteq> carrier_vec n"
    and fin: "finite A"
    and b: "b \<in> carrier_vec n"
    and C: "\<nexists> c A'. c \<in> carrier_vec n
      \<and> A' \<subseteq> A \<and> Suc (card A') = dim_span (insert b A)
      \<and> (\<forall> a \<in> A'. c \<bullet> a = 0)
      \<and> lin_indpt A' \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0"
  shows "\<exists> B \<subseteq> A. lin_indpt B \<and> card B = dim_span A \<and> b \<in> finite_cone B"
proof -
  from exists_lin_indpt_sublist[OF A] obtain A' where
    lin: "lin_indpt_list A'" and span: "span (set A') = span A" and A'A: "set A' \<subseteq> A" by auto
  hence linA': "lin_indpt (set A')" unfolding lin_indpt_list_def by auto
  from A'A A have A': "set A' \<subseteq> carrier_vec n" by auto
  have dim_spanA: "dim_span A = card (set A')"
    by (rule sym, rule same_span_imp_card_eq_dim_span[OF A' A span linA'])
  show ?thesis
  proof (cases "b \<in> span A")
    case False
    with span have "b \<notin> span (set A')" by auto
    with lin have linAb: "lin_indpt_list (A' @ [b])" unfolding lin_indpt_list_def
      using lin_dep_iff_in_span[OF A' _ b] span_mem[OF A', of b] b by auto
    interpret gso: gram_schmidt_fs_lin_indpt n "A' @ [b]"
      by (standard, insert linAb[unfolded lin_indpt_list_def], auto)
    let ?m = "length A'"
    define c where "c = - gso.gso ?m"
    have c: "c \<in> carrier_vec n" using gso.gso_carrier[of ?m] unfolding c_def by auto
    from gso.gso_times_self_is_norm[of ?m]
    have "b \<bullet> gso.gso ?m = sq_norm (gso.gso ?m)" unfolding c_def using b c by auto
    also have "\<dots> > 0" using gso.sq_norm_pos[of ?m] by auto
    finally have cb: "c \<bullet> b < 0" using b c comm_scalar_prod[OF b c] unfolding c_def by auto
    {
      fix a
      assume "a \<in> A"
      hence "a \<in> span (set A')" unfolding span using span_mem[OF A] by auto
      from finite_in_span[OF _ A' this]
      obtain l where "a = lincomb l (set A')" by auto
      hence "c \<bullet> a = c \<bullet> lincomb l (set A')" by simp
      also have "\<dots> = 0"
        by (subst lincomb_scalar_prod_right[OF A' c], rule sum.neutral, insert A', unfold set_conv_nth,
            insert gso.gso_scalar_zero[of ?m] c, auto simp: c_def nth_append )
      finally have "c \<bullet> a = 0" .
    } note cA = this
    have "\<exists> c A'. c \<in> carrier_vec n \<and> A' \<subseteq> A \<and> Suc (card A') = dim_span (insert b A)
      \<and> (\<forall> a \<in> A'. c \<bullet> a = 0) \<and> lin_indpt A' \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0"
    proof (intro exI[of _ c] exI[of _ "set A'"] conjI A'A linA' cb c)
      show "\<forall>a\<in>set A'. c \<bullet> a = 0" "\<forall>a\<^sub>i\<in>A. 0 \<le> c \<bullet> a\<^sub>i" using cA A'A by auto
      have "dim_span (insert b A) = Suc (dim_span A)"
        by (rule dim_span_insert[OF A b False])
      also have "\<dots> = Suc (card (set A'))" unfolding dim_spanA ..
      finally show "Suc (card (set A')) = dim_span (insert b A)" ..
    qed
    with C have False by blast
    thus ?thesis ..
  next
    case bspan: True
    define N where "N = normal_vectors A'"
    from normal_vectors[OF lin, folded N_def]
    have N: "set N \<subseteq> carrier_vec n" and
      orthA'N: "\<And> w nv. w \<in> set A' \<Longrightarrow> nv \<in> set N \<Longrightarrow> nv \<bullet> w = 0" and
      linAN: "lin_indpt_list (A' @ N)"  and
      lenAN: "length (A' @ N) = n" and
      disj: "set A' \<inter> set N = {}" by auto
    from linAN lenAN have full_span': "span (set (A' @ N)) = carrier_vec n"
      using lin_indpt_list_length_eq_n by blast
    hence full_span'': "span (set A' \<union> set N) = carrier_vec n" by auto
    from A N A' have AN: "A \<union> set N \<subseteq> carrier_vec n" and A'N: "set (A' @ N) \<subseteq> carrier_vec n" by auto
    hence "span (A \<union> set N) \<subseteq> carrier_vec n" by (simp add: span_is_subset2)
    with A'A span_is_monotone[of "set (A' @ N)" "A \<union> set N", unfolded full_span']
    have full_span: "span (A \<union> set N) = carrier_vec n" unfolding set_append by fast
    from fin have finAN: "finite (A \<union> set N)" by auto
    note fundamental = fundamental_theorem_of_linear_inequalities_full_dim[OF AN finAN full_span]
    show ?thesis
    proof (cases "b \<in> cone (A \<union> set N)")
      case True
      from this[unfolded fundamental(1)] obtain C where CAN: "C \<subseteq> A \<union> set N" and cardC: "card C = n"
        and linC: "lin_indpt C"
        and bC: "b \<in> finite_cone C" by auto
      have finC: "finite C" using finite_subset[OF CAN] fin by auto
      from CAN A N have C: "C \<subseteq> carrier_vec n" by auto
      from bC[unfolded finite_cone_def nonneg_lincomb_def] finC obtain c
        where bC: "b = lincomb c C" and nonneg: "\<And> b. b \<in> C \<Longrightarrow> c b \<ge> 0" by auto
      let ?C = "C - set N"
      show ?thesis
      proof (intro exI[of _ ?C] conjI)
        from subset_li_is_li[OF linC] show "lin_indpt ?C" by auto
        show CA: "?C \<subseteq> A" using CAN by auto
        have bc: "b = lincomb c (?C \<union> (C \<inter> set N))" unfolding bC
          by (rule arg_cong[of _ _ "lincomb _"], auto)
        have "b = lincomb c (?C - C \<inter> set N)"
        proof (rule orthogonal_cone(2)[OF A N fin full_span'' orthA'N refl span
              A'A linAN lenAN _ CA _ bc])
          show "\<forall>w\<in>set N. w \<bullet> b = 0"
            using ortho_span'[OF A' N _ bspan[folded span]] orthA'N by auto
        qed auto
        also have "?C - C \<inter> set N = ?C" by auto
        finally have "b = lincomb c ?C" .
        with nonneg have "nonneg_lincomb c ?C b" unfolding nonneg_lincomb_def by auto
        thus "b \<in> finite_cone ?C" unfolding finite_cone_def using finite_subset[OF CA fin] by auto
        have Cid: "C \<inter> set N \<union> ?C = C" by auto
        have "length A' + length N = n" by fact
        also have "\<dots> = card (C \<inter> set N \<union> ?C) " using Cid cardC by auto
        also have "\<dots> = card (C \<inter> set N) + card ?C"
          by (subst card_Un_disjoint, insert finC, auto)
        also have "\<dots> \<le> length N + card ?C"
          by (rule add_right_mono, rule order.trans, rule card_mono[OF finite_set[of N]],
              auto intro: card_length)
        also have "length A' = card (set A')" using lin[unfolded lin_indpt_list_def]
            distinct_card[of A'] by auto
        finally have le: "dim_span A \<le> card ?C" using dim_spanA by auto
        have CA: "?C \<subseteq> span A" using CA C in_own_span[OF A] by auto
        have linC: "lin_indpt ?C" using subset_li_is_li[OF linC] by auto
        show "card ?C = dim_span A"
          using card_le_dim_span[OF _ CA linC] le C by force
      qed
    next
      case False
      from False[unfolded fundamental(2)] b
      obtain C c where
        CAN: "C \<subseteq> A \<union> set N"  and
        cardC: "Suc (card C) = n"  and
        linC: "lin_indpt C" and
        contains: "(\<forall>a\<^sub>i\<in>A \<union> set N. 0 \<le> c \<bullet> a\<^sub>i)" and
        cb: "c \<bullet> b < 0" and
        nv: "c \<in> {normal_vector C, - normal_vector C}"
        by auto
      from CAN A N have C: "C \<subseteq> carrier_vec n" by auto
      from cardC have cardCn: "card C < n" by auto
      from finite_subset[OF CAN] fin have finC: "finite C" by auto
      let ?C = "C - set N"
      note nv' = normal_vector(1-4)[OF finC cardC linC C]
      from nv' nv have c: "c \<in> carrier_vec n" by auto
      have "\<exists> c A'. c \<in> carrier_vec n \<and> A' \<subseteq> A \<and> Suc (card A') = dim_span (insert b A)
          \<and> (\<forall> a \<in> A'. c \<bullet> a = 0) \<and> lin_indpt A' \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0"
      proof (intro exI[of _ c] exI[of _ ?C] conjI cb c)
        show CA: "?C \<subseteq> A" using CAN by auto
        show "\<forall>a\<^sub>i\<in>A. 0 \<le> c \<bullet> a\<^sub>i" using contains by auto
        show lin': "lin_indpt ?C" using subset_li_is_li[OF linC] by auto
        show sC0: "\<forall>a\<in> ?C. c \<bullet> a = 0" using nv' nv C by auto
        have Cid: "C \<inter> set N \<union> ?C = C" by auto
        have "dim_span (set A') = card (set A')"
          by (rule sym, rule same_span_imp_card_eq_dim_span[OF A' A' refl linA'])
        also have "\<dots> = length A'"
          using lin[unfolded lin_indpt_list_def] distinct_card[of A'] by auto
        finally have dimA': "dim_span (set A') = length A'" .
        from bspan have "span (insert b A) = span A" using b A using already_in_span by auto
        from dim_span_cong[OF this[folded span]] dimA'
        have dimbA: "dim_span (insert b A) = length A'" by simp
        also have "\<dots> = Suc (card ?C)"
        proof (rule ccontr)
          assume neq: "length A' \<noteq> Suc (card ?C)"
          have "length A' + length N = n" by fact
          also have "\<dots> = Suc (card (C \<inter> set N \<union> ?C))" using Cid cardC by auto
          also have "\<dots> = Suc (card (C \<inter> set N) + card ?C)"
            by (subst card_Un_disjoint, insert finC, auto)
          finally have id: "length A' + length N = Suc (card (C \<inter> set N) + card ?C)" .
          have le1: "card (C \<inter> set N) \<le> length N"
            by (metis Int_lower2 List.finite_set card_length card_mono inf.absorb_iff2 le_inf_iff)
          from CA C A have CsA: "?C \<subseteq> span (set A')" unfolding span by (meson in_own_span order.trans)
          from card_le_dim_span[OF _ this lin'] C
          have le2: "card ?C \<le> length A'" unfolding dimA' by auto
          from id le1 le2 neq
          have id2: "card ?C = length A'" by linarith+
          from card_eq_dim_span_imp_same_span[OF A' CsA lin' id2[folded dimA']]
          have "span ?C = span A" unfolding span by auto
          with bspan have "b \<in> span ?C" by auto
          from orthocompl_span[OF _ _ c this] C sC0
          have "c \<bullet> b = 0" by auto
          with cb show False by simp
        qed
        finally show "Suc (card ?C) = dim_span (insert b A)" by simp
      qed
      with assms(4) have False by blast
      thus ?thesis ..
    qed
  qed
qed

lemma fundamental_theorem_of_linear_inequalities: fixes A :: "'a vec set"
  defines "HyperN \<equiv> {b. b \<in> carrier_vec n \<and> (\<nexists> c B. c \<in> carrier_vec n \<and> B \<subseteq> A
      \<and> Suc (card B) = dim_span (insert b A) \<and> lin_indpt B
      \<and> (\<forall> a \<in> B. c \<bullet> a = 0)
      \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0)}"
  defines "HyperA \<equiv> {b. b \<in> carrier_vec n \<and> (\<nexists> c. c \<in> carrier_vec n \<and> (\<forall> a\<^sub>i \<in> A. c \<bullet> a\<^sub>i \<ge> 0) \<and> c \<bullet> b < 0)}"
  defines "lin_indpt_cone \<equiv> \<Union> { finite_cone B | B. B \<subseteq> A \<and> card B = dim_span A \<and> lin_indpt B}"
  assumes A: "A \<subseteq> carrier_vec n"
    and fin: "finite A"
  shows
    "cone A = lin_indpt_cone"
    "cone A = HyperN"
    "cone A = HyperA"
proof -
  have "lin_indpt_cone \<subseteq> cone A"
    unfolding lin_indpt_cone_def cone_def using fin finite_cone_mono A by auto
  moreover have "cone A \<subseteq> HyperA"
    using fundamental_theorem_of_linear_inequalities_A_imp_D[OF A fin] cone_carrier[OF A]
    unfolding HyperA_def by blast
  moreover have "HyperA \<subseteq> HyperN" unfolding HyperA_def HyperN_def by blast
  moreover have "HyperN \<subseteq> lin_indpt_cone"
  proof
    fix b
    assume "b \<in> HyperN"
    from this[unfolded HyperN_def]
      fundamental_theorem_of_linear_inequalities_C_imp_B[OF A fin, of b]
    show "b \<in> lin_indpt_cone" unfolding lin_indpt_cone_def by blast
  qed
  ultimately show
    "cone A = lin_indpt_cone"
    "cone A = HyperN"
    "cone A = HyperA"
    by auto
qed

corollary Caratheodory_theorem: assumes A: "A \<subseteq> carrier_vec n"
  shows "cone A = \<Union> {finite_cone B |B. B \<subseteq> A \<and> lin_indpt B}"
proof
  show "\<Union> {finite_cone B |B. B \<subseteq> A \<and> lin_indpt B} \<subseteq> cone A" unfolding cone_def
    using fin[OF fin_dim _ subset_trans[OF _ A]] by auto
  {
    fix a
    assume "a \<in> cone A"
    from this[unfolded cone_def] obtain B where
      finB: "finite B" and BA: "B \<subseteq> A" and a: "a \<in> finite_cone B" by auto
    from BA A have B: "B \<subseteq> carrier_vec n" by auto
    hence "a \<in> cone B" using finB a by (simp add: cone_iff_finite_cone)
    with fundamental_theorem_of_linear_inequalities(1)[OF B finB]
    obtain C where CB: "C \<subseteq> B" and a: "a \<in> finite_cone C" and "lin_indpt C" by auto
    with BA have "a \<in> \<Union> {finite_cone B |B. B \<subseteq> A \<and> lin_indpt B}" by auto
  }
  thus "\<Union> {finite_cone B |B. B \<subseteq> A \<and> lin_indpt B} \<supseteq> cone A" by blast
qed
end
end


section \<open>Reduced Gr\"obner Bases\<close>

theory Reduced_GB
  imports Groebner_Bases Auto_Reduction
begin

lemma (in gd_term) GB_image_monic: "is_Groebner_basis (monic ` G) \<longleftrightarrow> is_Groebner_basis G"
  by (simp add: GB_alt_1)

subsection \<open>Definition and Uniqueness of Reduced Gr\"obner Bases\<close>

context ordered_term
begin

definition is_reduced_GB :: "('t \<Rightarrow>\<^sub>0 'b::field) set \<Rightarrow> bool" where
  "is_reduced_GB B \<equiv> is_Groebner_basis B \<and> is_auto_reduced B \<and> is_monic_set B \<and> 0 \<notin> B"

lemma reduced_GB_D1:
  assumes "is_reduced_GB G"
  shows "is_Groebner_basis G"
  using assms unfolding is_reduced_GB_def by simp

lemma reduced_GB_D2:
  assumes "is_reduced_GB G"
  shows "is_auto_reduced G"
  using assms unfolding is_reduced_GB_def by simp

 lemma reduced_GB_D3:
  assumes "is_reduced_GB G"
  shows "is_monic_set G"
  using assms unfolding is_reduced_GB_def by simp

lemma reduced_GB_D4:
  assumes "is_reduced_GB G" and "g \<in> G"
  shows "g \<noteq> 0"
  using assms unfolding is_reduced_GB_def by auto

lemma reduced_GB_lc:
  assumes major: "is_reduced_GB G" and "g \<in> G"
  shows "lc g = 1"
  by (rule is_monic_setD, rule reduced_GB_D3, fact major, fact \<open>g \<in> G\<close>, rule reduced_GB_D4, fact major, fact \<open>g \<in> G\<close>)

end (* ordered_term *)

context gd_term
begin

lemma is_reduced_GB_subsetI:
  assumes Ared: "is_reduced_GB A" and BGB: "is_Groebner_basis B" and Bmon: "is_monic_set B"
    and *: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> B \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> a - b \<noteq> 0 \<Longrightarrow> lt (a - b) \<in> keys b \<Longrightarrow> lt (a - b) \<prec>\<^sub>t lt b \<Longrightarrow> False"
    and id_eq: "pmdl A = pmdl B"
  shows "A \<subseteq> B"
proof
  fix a
  assume "a \<in> A"

  have "a \<noteq> 0" by (rule reduced_GB_D4, fact Ared, fact \<open>a \<in> A\<close>)
  have lca: "lc a = 1" by (rule reduced_GB_lc, fact Ared, fact \<open>a \<in> A\<close>)
  have AGB: "is_Groebner_basis A" by (rule reduced_GB_D1, fact Ared)

  from \<open>a \<in> A\<close> have "a \<in> pmdl A" by (rule pmdl.span_base)
  also have "... = pmdl B" using id_eq by simp
  finally have "a \<in> pmdl B" .

  from BGB this \<open>a \<noteq> 0\<close> obtain b where "b \<in> B" and "b \<noteq> 0" and baddsa: "lt b adds\<^sub>t lt a"
    by (rule GB_adds_lt)
  from Bmon this(1) this(2) have lcb: "lc b = 1" by (rule is_monic_setD)
  from \<open>b \<in> B\<close> have "b \<in> pmdl B" by (rule pmdl.span_base)
  also have "... = pmdl A" using id_eq by simp
  finally have "b \<in> pmdl A" .

  have lt_eq: "lt b = lt a"
  proof (rule ccontr)
    assume "lt b \<noteq> lt a"
    from AGB \<open>b \<in> pmdl A\<close> \<open>b \<noteq> 0\<close> obtain a'
      where "a' \<in> A" and "a' \<noteq> 0" and a'addsb: "lt a' adds\<^sub>t lt b" by (rule GB_adds_lt)
    have a'addsa: "lt a' adds\<^sub>t lt a" by (rule adds_term_trans, fact a'addsb, fact baddsa)
    have "lt a' \<noteq> lt a"
    proof
      assume "lt a' = lt a"
      hence aaddsa': "lt a adds\<^sub>t lt a'" by (simp add: adds_term_refl)
      have "lt a adds\<^sub>t lt b" by (rule adds_term_trans, fact aaddsa', fact a'addsb)
      have "lt a = lt b" by (rule adds_term_antisym, fact+)
      with \<open>lt b \<noteq> lt a\<close> show False by simp
    qed
    hence "a' \<noteq> a" by auto
    with \<open>a' \<in> A\<close> have "a' \<in> A - {a}" by blast
    have is_red: "is_red (A - {a}) a" by (intro is_red_addsI, fact, fact, rule lt_in_keys, fact+)
    have "\<not> is_red (A - {a}) a" by (rule is_auto_reducedD, rule reduced_GB_D2, fact Ared, fact+)
    from this is_red show False ..
  qed

  have "a - b = 0"
  proof (rule ccontr)
    let ?c = "a - b"
    assume "?c \<noteq> 0"
    have "?c \<in> pmdl A" by (rule pmdl.span_diff, fact+)
    also have "... = pmdl B" using id_eq by simp
    finally have "?c \<in> pmdl B" .

    from \<open>b \<noteq> 0\<close> have "- b \<noteq> 0" by simp
    have "lt (-b) = lt a" unfolding lt_uminus by fact
    have "lc (-b) = - lc a" unfolding lc_uminus lca lcb ..
    from \<open>?c \<noteq> 0\<close> have "a + (-b) \<noteq> 0" by simp

    have "lt ?c \<in> keys ?c" by (rule lt_in_keys, fact)
    have "keys ?c \<subseteq> (keys a \<union> keys b)" by (fact keys_minus)
    with \<open>lt ?c \<in> keys ?c\<close> have "lt ?c \<in> keys a \<or> lt ?c \<in> keys b" by auto
    thus False
    proof
      assume "lt ?c \<in> keys a"

      from AGB \<open>?c \<in> pmdl A\<close> \<open>?c \<noteq> 0\<close> obtain a'
        where "a' \<in> A" and "a' \<noteq> 0" and a'addsc: "lt a' adds\<^sub>t lt ?c" by (rule GB_adds_lt)

      from a'addsc have "lt a' \<preceq>\<^sub>t lt ?c" by (rule ord_adds_term)
      also have "... = lt (a + (- b))" by simp
      also have "... \<prec>\<^sub>t lt a" by (rule lt_plus_lessI, fact+)
      finally have "lt a' \<prec>\<^sub>t lt a" .
      hence "lt a' \<noteq> lt a" by simp
      hence "a' \<noteq> a" by auto
      with \<open>a' \<in> A\<close> have "a' \<in> A - {a}" by blast

      have is_red: "is_red (A - {a}) a" by (intro is_red_addsI, fact, fact, fact+)
      have "\<not> is_red (A - {a}) a" by (rule is_auto_reducedD, rule reduced_GB_D2, fact Ared, fact+)
      from this is_red show False ..
    next
      assume "lt ?c \<in> keys b"

      with \<open>a \<in> A\<close> \<open>b \<in> B\<close> \<open>a \<noteq> 0\<close> \<open>b \<noteq> 0\<close> \<open>?c \<noteq> 0\<close> show False
      proof (rule *)
        have "lt ?c = lt ((- b) + a)" by simp
        also have "... \<prec>\<^sub>t lt (-b)"
        proof (rule lt_plus_lessI)
          from \<open>?c \<noteq> 0\<close> show "-b + a \<noteq> 0" by simp
        next
          from \<open>lt (-b) = lt a\<close> show "lt a = lt (-b)" by simp
        next
          from \<open>lc (-b) = - lc a\<close> show "lc a = - lc (-b)" by simp
        qed
        finally show "lt ?c \<prec>\<^sub>t lt b" unfolding lt_uminus .
      qed
    qed
  qed

  hence "a = b" by simp
  with \<open>b \<in> B\<close> show "a \<in> B" by simp
qed

lemma is_reduced_GB_unique':
  assumes Ared: "is_reduced_GB A" and Bred: "is_reduced_GB B" and id_eq: "pmdl A = pmdl B"
  shows "A \<subseteq> B"
proof -
  from Bred have BGB: "is_Groebner_basis B" by (rule reduced_GB_D1)
  with assms(1) show ?thesis
  proof (rule is_reduced_GB_subsetI)
    from Bred show "is_monic_set B" by (rule reduced_GB_D3)
  next
    fix a b :: "'t \<Rightarrow>\<^sub>0 'b"
    let ?c = "a - b"
    assume "a \<in> A" and "b \<in> B" and "a \<noteq> 0" and "b \<noteq> 0" and "?c \<noteq> 0" and "lt ?c \<in> keys b" and "lt ?c \<prec>\<^sub>t lt b"

    from \<open>a \<in> A\<close> have "a \<in> pmdl B" by (simp only: id_eq[symmetric], rule pmdl.span_base)
    moreover from \<open>b \<in> B\<close> have "b \<in> pmdl B" by (rule pmdl.span_base)
    ultimately have "?c \<in> pmdl B" by (rule pmdl.span_diff)
    from BGB this \<open>?c \<noteq> 0\<close> obtain b'
      where "b' \<in> B" and "b' \<noteq> 0" and b'addsc: "lt b' adds\<^sub>t lt ?c" by (rule GB_adds_lt)

    from b'addsc have "lt b' \<preceq>\<^sub>t lt ?c" by (rule ord_adds_term)
    also have "... \<prec>\<^sub>t lt b" by fact
    finally have "lt b' \<prec>\<^sub>t lt b" unfolding lt_uminus .
    hence "lt b' \<noteq> lt b" by simp
    hence "b' \<noteq> b" by auto
    with \<open>b' \<in> B\<close> have "b' \<in> B - {b}" by blast

    have is_red: "is_red (B - {b}) b" by (intro is_red_addsI, fact, fact, fact+)
    have "\<not> is_red (B - {b}) b" by (rule is_auto_reducedD, rule reduced_GB_D2, fact Bred, fact+)
    from this is_red show False ..
  qed fact
qed

theorem is_reduced_GB_unique:
  assumes Ared: "is_reduced_GB A" and Bred: "is_reduced_GB B" and id_eq: "pmdl A = pmdl B"
  shows "A = B"
proof
  from assms show "A \<subseteq> B" by (rule is_reduced_GB_unique')
next
  from Bred Ared id_eq[symmetric] show "B \<subseteq> A" by (rule is_reduced_GB_unique')
qed

subsection \<open>Computing Reduced Gr\"obner Bases by Auto-Reduction\<close>

subsubsection \<open>Minimal Bases\<close>

lemma minimal_basis_is_reduced_GB:
  assumes "is_minimal_basis B" and "is_monic_set B" and "is_reduced_GB G" and "G \<subseteq> B"
    and "pmdl B = pmdl G"
  shows "B = G"
  using _ assms(3) assms(5)
proof (rule is_reduced_GB_unique)
  from assms(3) have "is_Groebner_basis G" by (rule reduced_GB_D1)
  show "is_reduced_GB B" unfolding is_reduced_GB_def
  proof (intro conjI)
    show "0 \<notin> B"
    proof
      assume "0 \<in> B"
      with assms(1) have "0 \<noteq> (0::'t \<Rightarrow>\<^sub>0 'b)" by (rule is_minimal_basisD1)
      thus False by simp
    qed
  next
    from \<open>is_Groebner_basis G\<close> assms(4) assms(5) show "is_Groebner_basis B" by (rule GB_subset)
  next
    show "is_auto_reduced B" unfolding is_auto_reduced_def
    proof (intro ballI notI)
      fix b
      assume "b \<in> B"
      with assms(1) have "b \<noteq> 0" by (rule is_minimal_basisD1)
      assume "is_red (B - {b}) b"
      then obtain f where "f \<in> B - {b}" and "is_red {f} b" by (rule is_red_singletonI)
      from this(1) have "f \<in> B" and "f \<noteq> b" by simp_all

      from assms(1) \<open>f \<in> B\<close> have "f \<noteq> 0" by (rule is_minimal_basisD1)
      from \<open>f \<in> B\<close> have "f \<in> pmdl B" by (rule pmdl.span_base)
      hence "f \<in> pmdl G" by (simp only: assms(5))
      from \<open>is_Groebner_basis G\<close> this \<open>f \<noteq> 0\<close> obtain g where "g \<in> G" and "g \<noteq> 0" and "lt g adds\<^sub>t lt f"
        by (rule GB_adds_lt)
      from \<open>g \<in> G\<close> \<open>G \<subseteq> B\<close> have "g \<in> B" ..
      have "g = f"
      proof (rule ccontr)
        assume "g \<noteq> f"
        with assms(1) \<open>g \<in> B\<close> \<open>f \<in> B\<close> have "\<not> lt g adds\<^sub>t lt f" by (rule is_minimal_basisD2)
        from this \<open>lt g adds\<^sub>t lt f\<close> show False ..
      qed
      with \<open>g \<in> G\<close> have "f \<in> G" by simp
      with \<open>f \<in> B - {b}\<close> \<open>is_red {f} b\<close> have red: "is_red (G - {b}) b"
        by (meson Diff_iff is_red_singletonD)

      from \<open>b \<in> B\<close> have "b \<in> pmdl B" by (rule pmdl.span_base)
      hence "b \<in> pmdl G" by (simp only: assms(5))
      from \<open>is_Groebner_basis G\<close> this \<open>b \<noteq> 0\<close> obtain g' where "g' \<in> G" and "g' \<noteq> 0" and "lt g' adds\<^sub>t lt b"
        by (rule GB_adds_lt)
      from \<open>g' \<in> G\<close> \<open>G \<subseteq> B\<close> have "g' \<in> B" ..
      have "g' = b"
      proof (rule ccontr)
        assume "g' \<noteq> b"
        with assms(1) \<open>g' \<in> B\<close> \<open>b \<in> B\<close> have "\<not> lt g' adds\<^sub>t lt b" by (rule is_minimal_basisD2)
        from this \<open>lt g' adds\<^sub>t lt b\<close> show False ..
      qed
      with \<open>g' \<in> G\<close> have "b \<in> G" by simp

      from assms(3) have "is_auto_reduced G" by (rule reduced_GB_D2)
      from this \<open>b \<in> G\<close> have "\<not> is_red (G - {b}) b" by (rule is_auto_reducedD)
      from this red show False ..
    qed
  qed fact
qed

subsubsection \<open>Computing Minimal Bases\<close>

lemma comp_min_basis_pmdl:
  assumes "is_Groebner_basis (set xs)"
  shows "pmdl (set (comp_min_basis xs)) = pmdl (set xs)" (is "pmdl (set ?ys) = _")
  using finite_set
proof (rule pmdl_eqI_adds_lt_finite)
  from comp_min_basis_subset show *: "pmdl (set ?ys) \<subseteq> pmdl (set xs)" by (rule pmdl.span_mono)
next
  fix f
  assume "f \<in> pmdl (set xs)" and "f \<noteq> 0"
  with assms obtain g where "g \<in> set xs" and "g \<noteq> 0" and 1: "lt g adds\<^sub>t lt f" by (rule GB_adds_lt)
  from this(1, 2) obtain g' where "g' \<in> set ?ys" and 2: "lt g' adds\<^sub>t lt g"
    by (rule comp_min_basis_adds)
  note this(1)
  moreover from this have "g' \<noteq> 0" by (rule comp_min_basis_nonzero)
  moreover from 2 1 have "lt g' adds\<^sub>t lt f" by (rule adds_term_trans)
  ultimately show "\<exists>g\<in>set ?ys. g \<noteq> 0 \<and> lt g adds\<^sub>t lt f" by blast
qed

lemma comp_min_basis_GB:
  assumes "is_Groebner_basis (set xs)"
  shows "is_Groebner_basis (set (comp_min_basis xs))" (is "is_Groebner_basis (set ?ys)")
  unfolding GB_alt_2_finite[OF finite_set]
proof (intro ballI impI)
  fix f
  assume "f \<in> pmdl (set ?ys)"
  also from assms have "\<dots> = pmdl (set xs)" by (rule comp_min_basis_pmdl)
  finally have "f \<in> pmdl (set xs)" .
  moreover assume "f \<noteq> 0"
  ultimately have "is_red (set xs) f" using assms unfolding GB_alt_2_finite[OF finite_set] by blast
  thus "is_red (set ?ys) f" by (rule comp_min_basis_is_red)
qed

subsubsection \<open>Computing Reduced Bases\<close>

lemma comp_red_basis_pmdl:
  assumes "is_Groebner_basis (set xs)"
  shows "pmdl (set (comp_red_basis xs)) = pmdl (set xs)"
proof (rule, fact pmdl_comp_red_basis_subset, rule)
  fix f
  assume "f \<in> pmdl (set xs)"
  show "f \<in> pmdl (set (comp_red_basis xs))"
  proof (cases "f = 0")
    case True
    show ?thesis unfolding True by (rule pmdl.span_zero)
  next
    case False
    let ?xs = "comp_red_basis xs"
    have "(red (set ?xs))\<^sup>*\<^sup>* f 0"
    proof (rule is_red_implies_0_red_finite, fact finite_set, fact pmdl_comp_red_basis_subset)
      fix q
      assume "q \<noteq> 0" and "q \<in> pmdl (set xs)"
      with assms have "is_red (set xs) q" by (rule GB_imp_reducibility)
      thus "is_red (set (comp_red_basis xs)) q" unfolding comp_red_basis_is_red .
    qed fact
    thus ?thesis by (rule red_rtranclp_0_in_pmdl)
  qed
qed

lemma comp_red_basis_GB:
  assumes "is_Groebner_basis (set xs)"
  shows "is_Groebner_basis (set (comp_red_basis xs))"
  unfolding GB_alt_2_finite[OF finite_set]
proof (intro ballI impI)
  fix f
  assume fin: "f \<in> pmdl (set (comp_red_basis xs))"
  hence "f \<in> pmdl (set xs)" unfolding comp_red_basis_pmdl[OF assms] .
  assume "f \<noteq> 0"
  from assms \<open>f \<noteq> 0\<close> \<open>f \<in> pmdl (set xs)\<close> show "is_red (set (comp_red_basis xs)) f"
    by (simp add: comp_red_basis_is_red GB_alt_2_finite)
qed

subsubsection \<open>Computing Reduced Gr\"obner Bases\<close>

lemma comp_red_monic_basis_pmdl:
  assumes "is_Groebner_basis (set xs)"
  shows "pmdl (set (comp_red_monic_basis xs)) = pmdl (set xs)"
  unfolding set_comp_red_monic_basis pmdl_image_monic comp_red_basis_pmdl[OF assms] ..

lemma comp_red_monic_basis_GB:
  assumes "is_Groebner_basis (set xs)"
  shows "is_Groebner_basis (set (comp_red_monic_basis xs))"
  unfolding set_comp_red_monic_basis GB_image_monic using assms by (rule comp_red_basis_GB)

lemma comp_red_monic_basis_is_reduced_GB:
  assumes "is_Groebner_basis (set xs)"
  shows "is_reduced_GB (set (comp_red_monic_basis xs))"
  unfolding is_reduced_GB_def
proof (intro conjI, rule comp_red_monic_basis_GB, fact assms,
       rule comp_red_monic_basis_is_auto_reduced, rule comp_red_monic_basis_is_monic_set, intro notI)
  assume "0 \<in> set (comp_red_monic_basis xs)"
  hence "0 \<noteq> (0::'t \<Rightarrow>\<^sub>0 'b)" by (rule comp_red_monic_basis_nonzero)
  thus False by simp
qed

lemma ex_finite_reduced_GB_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  obtains G where "G \<subseteq> dgrad_p_set d m" and "finite G" and "is_reduced_GB G" and "pmdl G = pmdl F"
proof -
  from assms obtain G0 where G0_sub: "G0 \<subseteq> dgrad_p_set d m" and fin: "finite G0"
    and gb: "is_Groebner_basis G0" and pid: "pmdl G0 = pmdl F"
    by (rule ex_finite_GB_dgrad_p_set)
  from fin obtain xs where set: "G0 = set xs" using finite_list by blast
  let ?G = "set (comp_red_monic_basis xs)"
  show ?thesis
  proof
    from assms(1) have "dgrad_p_set_le d (set (comp_red_monic_basis xs)) G0" unfolding set
      by (rule comp_red_monic_basis_dgrad_p_set_le)
    from this G0_sub show "set (comp_red_monic_basis xs) \<subseteq> dgrad_p_set d m"
      by (rule dgrad_p_set_le_dgrad_p_set)
  next
    from gb show rgb: "is_reduced_GB ?G" unfolding set
      by (rule comp_red_monic_basis_is_reduced_GB)
  next
    from gb show "pmdl ?G = pmdl F" unfolding set pid[symmetric]
      by (rule comp_red_monic_basis_pmdl)
  qed (fact finite_set)
qed

theorem ex_unique_reduced_GB_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "\<exists>!G. G \<subseteq> dgrad_p_set d m \<and> finite G \<and> is_reduced_GB G \<and> pmdl G = pmdl F"
proof -
  from assms obtain G where "G \<subseteq> dgrad_p_set d m" and "finite G"
    and "is_reduced_GB G" and G: "pmdl G = pmdl F" by (rule ex_finite_reduced_GB_dgrad_p_set)
  hence "G \<subseteq> dgrad_p_set d m \<and> finite G \<and> is_reduced_GB G \<and> pmdl G = pmdl F" by simp
  thus ?thesis
  proof (rule ex1I)
    fix G'
    assume "G' \<subseteq> dgrad_p_set d m \<and> finite G' \<and> is_reduced_GB G' \<and> pmdl G' = pmdl F"
    hence "is_reduced_GB G'" and G': "pmdl G' = pmdl F" by simp_all
    note this(1) \<open>is_reduced_GB G\<close>
    moreover have "pmdl G' = pmdl G" by (simp only: G G')
    ultimately show "G' = G" by (rule is_reduced_GB_unique)
  qed
qed

corollary ex_unique_reduced_GB_dgrad_p_set':
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "\<exists>!G. finite G \<and> is_reduced_GB G \<and> pmdl G = pmdl F"
proof -
  from assms obtain G where "G \<subseteq> dgrad_p_set d m" and "finite G"
    and "is_reduced_GB G" and G: "pmdl G = pmdl F" by (rule ex_finite_reduced_GB_dgrad_p_set)
  hence "finite G \<and> is_reduced_GB G \<and> pmdl G = pmdl F" by simp
  thus ?thesis
  proof (rule ex1I)
    fix G'
    assume "finite G' \<and> is_reduced_GB G' \<and> pmdl G' = pmdl F"
    hence "is_reduced_GB G'" and G': "pmdl G' = pmdl F" by simp_all
    note this(1) \<open>is_reduced_GB G\<close>
    moreover have "pmdl G' = pmdl G" by (simp only: G G')
    ultimately show "G' = G" by (rule is_reduced_GB_unique)
  qed
qed

definition reduced_GB :: "('t \<Rightarrow>\<^sub>0 'b) set \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b::field) set"
  where "reduced_GB B = (THE G. finite G \<and> is_reduced_GB G \<and> pmdl G = pmdl B)"

text \<open>@{const reduced_GB} returns the unique reduced Gr\"obner basis of the given set, provided its
  Dickson grading is bounded. Combining @{const comp_red_monic_basis} with any function for computing
  Gr\"obner bases, e.\,g. \<open>gb\<close> from theory "Buchberger", makes @{const reduced_GB} computable.\<close>

lemma finite_reduced_GB_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "finite (reduced_GB F)"
  unfolding reduced_GB_def
  by (rule the1I2, rule ex_unique_reduced_GB_dgrad_p_set', fact, fact, fact, elim conjE)

lemma reduced_GB_is_GB_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "is_Groebner_basis (reduced_GB F)"
proof -
  from assms have "is_reduced_GB (reduced_GB F)" by (rule reduced_GB_is_reduced_GB_dgrad_p_set)
  thus ?thesis unfolding is_reduced_GB_def ..
qed

lemma reduced_GB_is_auto_reduced_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "is_auto_reduced (reduced_GB F)"
proof -
  from assms have "is_reduced_GB (reduced_GB F)" by (rule reduced_GB_is_reduced_GB_dgrad_p_set)
  thus ?thesis unfolding is_reduced_GB_def by simp
qed

lemma reduced_GB_is_monic_set_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "is_monic_set (reduced_GB F)"
proof -
  from assms have "is_reduced_GB (reduced_GB F)" by (rule reduced_GB_is_reduced_GB_dgrad_p_set)
  thus ?thesis unfolding is_reduced_GB_def by simp
qed

lemma reduced_GB_nonzero_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "0 \<notin> reduced_GB F"
proof -
  from assms have "is_reduced_GB (reduced_GB F)" by (rule reduced_GB_is_reduced_GB_dgrad_p_set)
  thus ?thesis unfolding is_reduced_GB_def by simp
qed

lemma reduced_GB_pmdl_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "pmdl (reduced_GB F) = pmdl F"
  unfolding reduced_GB_def
  by (rule the1I2, rule ex_unique_reduced_GB_dgrad_p_set', fact, fact, fact, elim conjE)

lemma reduced_GB_unique_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
    and "is_reduced_GB G" and "pmdl G = pmdl F"
  shows "reduced_GB F = G"
  by (rule is_reduced_GB_unique, rule reduced_GB_is_reduced_GB_dgrad_p_set, fact+,
      simp only: reduced_GB_pmdl_dgrad_p_set[OF assms(1, 2, 3)] assms(5))

lemma reduced_GB_dgrad_p_set:
  assumes "dickson_grading d" and "finite (component_of_term ` Keys F)" and "F \<subseteq> dgrad_p_set d m"
  shows "reduced_GB F \<subseteq> dgrad_p_set d m"
proof -
  from assms obtain G where G: "G \<subseteq> dgrad_p_set d m" and "is_reduced_GB G" and "pmdl G = pmdl F"
    by (rule ex_finite_reduced_GB_dgrad_p_set)
  from assms this(2, 3) have "reduced_GB F = G" by (rule reduced_GB_unique_dgrad_p_set)
  with G show ?thesis by simp
qed

lemma reduced_GB_unique:
  assumes "finite G" and "is_reduced_GB G" and "pmdl G = pmdl F"
  shows "reduced_GB F = G"
proof -
  from assms have "finite G \<and> is_reduced_GB G \<and> pmdl G = pmdl F" by simp
  thus ?thesis unfolding reduced_GB_def
  proof (rule the_equality)
    fix G'
    assume "finite G' \<and> is_reduced_GB G' \<and> pmdl G' = pmdl F"
    hence "is_reduced_GB G'" and eq: "pmdl G' = pmdl F" by simp_all
    note this(1)
    moreover note assms(2)
    moreover have "pmdl G' = pmdl G" by (simp only: assms(3) eq)
    ultimately show "G' = G" by (rule is_reduced_GB_unique)
  qed
qed

lemma is_reduced_GB_empty: "is_reduced_GB {}"
  by (simp add: is_reduced_GB_def is_Groebner_basis_empty is_monic_set_def is_auto_reduced_def)

lemma is_reduced_GB_singleton: "is_reduced_GB {f} \<longleftrightarrow> lc f = 1"
proof
  assume "is_reduced_GB {f}"
  hence "is_monic_set {f}" and "f \<noteq> 0" by (rule reduced_GB_D3, rule reduced_GB_D4) simp
  from this(1) _ this(2) show "lc f = 1" by (rule is_monic_setD) simp
next
  assume "lc f = 1"
  moreover from this have "f \<noteq> 0" by auto
  ultimately show "is_reduced_GB {f}"
    by (simp add: is_reduced_GB_def is_Groebner_basis_singleton is_monic_set_def is_auto_reduced_def
        not_is_red_empty)
qed

lemma reduced_GB_empty: "reduced_GB {} = {}"
  using finite.emptyI is_reduced_GB_empty refl by (rule reduced_GB_unique)

lemma reduced_GB_singleton: "reduced_GB {f} = (if f = 0 then {} else {monic f})"
proof (cases "f = 0")
  case True
  from finite.emptyI is_reduced_GB_empty have "reduced_GB {f} = {}"
    by (rule reduced_GB_unique) (simp add: True flip: pmdl.span_Diff_zero[of "{0}"])
  with True show ?thesis by simp
next
  case False
  have "reduced_GB {f} = {monic f}"
  proof (rule reduced_GB_unique)
    from False have "lc f \<noteq> 0" by (rule lc_not_0)
    thus "is_reduced_GB {monic f}" by (simp add: is_reduced_GB_singleton monic_def)
  next
    have "pmdl {monic f} = pmdl (monic ` {f})" by simp
    also have "\<dots> = pmdl {f}" by (fact pmdl_image_monic)
    finally show "pmdl {monic f} = pmdl {f}" .
  qed simp
  with False show ?thesis by simp
qed

lemma ex_unique_reduced_GB_finite: "finite F \<Longrightarrow> (\<exists>!G. finite G \<and> is_reduced_GB G \<and> pmdl G = pmdl F)"
  by (rule ex_unique_reduced_GB_dgrad_p_set', rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

lemma finite_reduced_GB_finite: "finite F \<Longrightarrow> finite (reduced_GB F)"
  by (rule finite_reduced_GB_dgrad_p_set, rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

lemma reduced_GB_is_reduced_GB_finite: "finite F \<Longrightarrow> is_reduced_GB (reduced_GB F)"
  by (rule reduced_GB_is_reduced_GB_dgrad_p_set, rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

lemma reduced_GB_is_GB_finite: "finite F \<Longrightarrow> is_Groebner_basis (reduced_GB F)"
  by (rule reduced_GB_is_GB_dgrad_p_set, rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

lemma reduced_GB_is_auto_reduced_finite: "finite F \<Longrightarrow> is_auto_reduced (reduced_GB F)"
  by (rule reduced_GB_is_auto_reduced_dgrad_p_set, rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

lemma reduced_GB_is_monic_set_finite: "finite F \<Longrightarrow> is_monic_set (reduced_GB F)"
  by (rule reduced_GB_is_monic_set_dgrad_p_set, rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

lemma reduced_GB_nonzero_finite: "finite F \<Longrightarrow> 0 \<notin> reduced_GB F"
  by (rule reduced_GB_nonzero_dgrad_p_set, rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

lemma reduced_GB_pmdl_finite: "finite F \<Longrightarrow> pmdl (reduced_GB F) = pmdl F"
  by (rule reduced_GB_pmdl_dgrad_p_set, rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

lemma reduced_GB_unique_finite: "finite F \<Longrightarrow> is_reduced_GB G \<Longrightarrow> pmdl G = pmdl F \<Longrightarrow> reduced_GB F = G"
  by (rule reduced_GB_unique_dgrad_p_set, rule dickson_grading_dgrad_dummy,
      erule finite_imp_finite_component_Keys, erule dgrad_p_set_exhaust_expl)

end (* gd_term *)

subsubsection \<open>Properties of the Reduced Gr\"obner Basis of an Ideal\<close>

context gd_powerprod
begin

lemma ideal_eq_UNIV_iff_reduced_GB_eq_one_dgrad_p_set:
  assumes "dickson_grading d" and "F \<subseteq> punit.dgrad_p_set d m"
  shows "ideal F = UNIV \<longleftrightarrow> punit.reduced_GB F = {1}"
proof -
  have fin: "finite (local.punit.component_of_term ` Keys F)" by simp
  show ?thesis
  proof
    assume "ideal F = UNIV"
    from assms(1) fin assms(2) show "punit.reduced_GB F = {1}"
    proof (rule punit.reduced_GB_unique_dgrad_p_set)
      show "punit.is_reduced_GB {1}" unfolding punit.is_reduced_GB_def
      proof (intro conjI, fact punit.is_Groebner_basis_singleton)
        show "punit.is_auto_reduced {1}" unfolding punit.is_auto_reduced_def
          by (rule ballI, simp add: remove_def punit.not_is_red_empty)
      next
        show "punit.is_monic_set {1}"
          by (rule punit.is_monic_setI, simp del: single_one add: single_one[symmetric])
      qed simp
    next
      have "punit.pmdl {1} = ideal {1}" by simp
      also have "... = ideal F"
      proof (simp only: \<open>ideal F = UNIV\<close> ideal_eq_UNIV_iff_contains_one)
        have "1 \<in> {1}" ..
        with module_times show "1 \<in> ideal {1}" by (rule module.span_base)
      qed
      also have "... = punit.pmdl F" by simp
      finally show "punit.pmdl {1} = punit.pmdl F" .
    qed
  next
    assume "punit.reduced_GB F = {1}"
    hence "1 \<in> punit.reduced_GB F" by simp
    hence "1 \<in> punit.pmdl (punit.reduced_GB F)" by (rule punit.pmdl.span_base)
    also from assms(1) fin assms(2) have "... = punit.pmdl F" by (rule punit.reduced_GB_pmdl_dgrad_p_set)
    finally show "ideal F = UNIV" by (simp add: ideal_eq_UNIV_iff_contains_one)
  qed
qed

lemmas ideal_eq_UNIV_iff_reduced_GB_eq_one_finite =
  ideal_eq_UNIV_iff_reduced_GB_eq_one_dgrad_p_set[OF dickson_grading_dgrad_dummy punit.dgrad_p_set_exhaust_expl]

end (* gd_powerprod *)

subsubsection \<open>Context @{locale od_term}\<close>

context od_term
begin

lemmas ex_unique_reduced_GB =
  ex_unique_reduced_GB_dgrad_p_set'[OF dickson_grading_zero _ subset_dgrad_p_set_zero]
lemmas finite_reduced_GB =
  finite_reduced_GB_dgrad_p_set[OF dickson_grading_zero _ subset_dgrad_p_set_zero]
lemmas reduced_GB_is_reduced_GB =
  reduced_GB_is_reduced_GB_dgrad_p_set[OF dickson_grading_zero _ subset_dgrad_p_set_zero]
lemmas reduced_GB_is_GB =
  reduced_GB_is_GB_dgrad_p_set[OF dickson_grading_zero _ subset_dgrad_p_set_zero]
lemmas reduced_GB_is_auto_reduced =
  reduced_GB_is_auto_reduced_dgrad_p_set[OF dickson_grading_zero _ subset_dgrad_p_set_zero]
lemmas reduced_GB_is_monic_set =
  reduced_GB_is_monic_set_dgrad_p_set[OF dickson_grading_zero _ subset_dgrad_p_set_zero]
lemmas reduced_GB_nonzero =
  reduced_GB_nonzero_dgrad_p_set[OF dickson_grading_zero _ subset_dgrad_p_set_zero]
lemmas reduced_GB_pmdl =
  reduced_GB_pmdl_dgrad_p_set[OF dickson_grading_zero _ subset_dgrad_p_set_zero]
lemmas reduced_GB_unique =
  reduced_GB_unique_dgrad_p_set[OF dickson_grading_zero _ subset_dgrad_p_set_zero]

end (* od_term *)

end (* theory *)


(*
   File:     Laws_of_Large_Numbers.thy
   Author:   Manuel Eberl, TU München
*)
section \<open>The Laws of Large Numbers\<close>
theory Laws_of_Large_Numbers
  imports Ergodic_Theory.Shift_Operator
begin

text \<open>
  We prove the strong law of large numbers in the following form: Let $(X_i)_{i\in\mathbb{N}}$
  be a sequence of i.i.d. random variables over a probability space \<open>M\<close>. Further assume that
  the expected value $E[X_0]$ of $X_0$ exists. Then the sequence of random variables
  \[\overline{X}_n = \frac{1}{n} \sum_{i=0}^n X_i\]
  of running averages almost surely converges to $E[X_0]$.
  This means that
  \[\mathcal{P}[\overline{X}_n \longrightarrow E[X_0]] = 1\ .\]

  We start with the strong law.
\<close>

subsection \<open>The strong law\<close>

text \<open>
  The proof uses Birkhoff's Theorem from Gouëzel's formalisation of ergodic theory~\<^cite>\<open>"gouezel"\<close>
  and the fact that the shift operator $T(x_1, x_2, x_3, \ldots) = (x_2, x_3, \ldots)$ is ergodic.
  This proof can be found in various textbooks on probability theory/ergodic
  theory, e.g. the ones by Krengel~\<^cite>\<open>\<open>p.~24\<close> in "krengel"\<close> and
  Simmonet~\<^cite>\<open>\<open>Chapter 15, pp.~311--325\<close> in "Simonnet1996"\<close>.
\<close>
theorem (in prob_space) strong_law_of_large_numbers_iid:
  fixes X :: "nat \<Rightarrow> 'a \<Rightarrow> real"
  assumes indep: "indep_vars (\<lambda>_. borel) X UNIV"
  assumes distr: "\<And>i. distr M borel (X i) = distr M borel (X 0)"
  assumes L1:    "integrable M (X 0)"
  shows "AE x in M. (\<lambda>n. (\<Sum>i<n. X i x) / n) \<longlonglongrightarrow> expectation (X 0)"
proof -
  text \<open>
    We adopt a more explicit view of \<^term>\<open>M\<close> as a countably infinite product of i.i.d.
    random variables, indexed by the natural numbers:
  \<close>
  define M' :: "(nat \<Rightarrow> real) measure" where "M' = Pi\<^sub>M UNIV (\<lambda>i. distr M borel (X i))"
  have [measurable]: "random_variable borel (X i)" for i
    using indep by (auto simp: indep_vars_def)
  have M'_eq: "M' = distr M (Pi\<^sub>M UNIV (\<lambda>i. borel)) (\<lambda>x. \<lambda>i\<in>UNIV. X i x)"
    using indep unfolding M'_def by (subst (asm) indep_vars_iff_distr_eq_PiM) auto
  have space_M': "space M' = UNIV"
    by (simp add: M'_def space_PiM)
  have sets_M' [measurable_cong]: "sets M' = sets (Pi\<^sub>M UNIV (\<lambda>i. borel))"
    by (simp add: M'_eq)
  interpret M': prob_space M'
    unfolding M'_eq by (intro prob_space_distr) auto

  text \<open>We introduce a shift operator that forgets the first variable in the sequence.\<close>
  define T :: "(nat \<Rightarrow> real) \<Rightarrow> (nat \<Rightarrow> real)" where
    "T = (\<lambda>f. f \<circ> Suc)"
  have funpow_T: "(T ^^ i) = (\<lambda>f. f \<circ> (\<lambda>n. n + i))" for i
    by (induction i) (auto simp: T_def)

  interpret T: shift_operator_ergodic "distr M borel (X 0)" T M'
  proof -
    interpret X0: prob_space "distr M borel (X 0)"
      by (rule prob_space_distr) auto
    show "shift_operator_ergodic (distr M borel (X 0))"
      by unfold_locales
    show "M' \<equiv> Pi\<^sub>M UNIV (\<lambda>_. distr M borel (X 0)) "
      unfolding M'_def by (subst distr)
  qed (simp_all add: T_def)

  have [intro]: "integrable M' (\<lambda>f. f 0)"
    unfolding M'_eq by (subst integrable_distr_eq) (use L1 in auto)
  have "AE f in M'. (\<lambda>n. T.birkhoff_sum (\<lambda>f. f 0) n f / real n)
            \<longlonglongrightarrow> real_cond_exp M' T.Invariants (\<lambda>f. f 0) f"
    by (rule T.birkhoff_theorem_AE_nonergodic) auto
  moreover have "AE x in M'. real_cond_exp M' T.Invariants (\<lambda>f. f 0) x =
                    M'.expectation (\<lambda>f. f 0) / M'.prob (space M')"
    by (intro T.Invariants_cond_exp_is_integral_fmpt) auto
  ultimately have "AE f in M'. (\<lambda>n. T.birkhoff_sum (\<lambda>f. f 0) n f / real n)
                     \<longlonglongrightarrow> M'.expectation (\<lambda>f. f 0)"
    by eventually_elim (simp_all add: M'.prob_space)
  also have "M'.expectation (\<lambda>f. f 0) = expectation (X 0)"
    unfolding M'_eq by (subst integral_distr) simp_all
  also have "T.birkhoff_sum (\<lambda>f. f 0) = (\<lambda>n f. sum f {..<n})"
    by (intro ext) (simp_all add:T.birkhoff_sum_def funpow_T)
  finally show ?thesis
    unfolding M'_eq by (subst (asm) AE_distr_iff) simp_all
qed

subsection \<open>The weak law\<close>

text \<open>
  To go from the strong law to the weak one, we need the fact that almost sure convergence
  implies convergence in probability. We prove this for sequences of random variables here.
\<close>
lemma (in prob_space) AE_convergence_imp_convergence_in_prob:
  assumes [measurable]: "\<And>i. random_variable borel (X i)" "random_variable borel Y"
  assumes AE: "AE x in M. (\<lambda>i. X i x) \<longlonglongrightarrow> Y x"
  assumes "\<epsilon> > (0 :: real)"
  shows   "(\<lambda>i. prob {x\<in>space M. \<bar>X i x - Y x\<bar> > \<epsilon>}) \<longlonglongrightarrow> 0"
proof -
  define A where "A = (\<lambda>i. {x\<in>space M. \<bar>X i x - Y x\<bar> > \<epsilon>})"
  define B where "B = (\<lambda>n. (\<Union>i\<in>{n..}. A i))"
  have [measurable]: "A i \<in> sets M"  "B i \<in> sets M" for i
    unfolding A_def B_def by measurable

  have "AE x in M. x \<notin> (\<Inter>i. B i)"
    using AE unfolding B_def A_def
    by eventually_elim
       (use \<open>\<epsilon> > 0\<close> in \<open>fastforce simp: tendsto_iff dist_norm eventually_at_top_linorder\<close>)
  hence "(\<Inter>i. B i) \<in> null_sets M"
    by (subst AE_iff_null_sets) auto

  show "(\<lambda>i. prob (A i)) \<longlonglongrightarrow> 0"
  proof (rule Lim_null_comparison)
    have "(\<lambda>i. prob (B i)) \<longlonglongrightarrow> prob (\<Inter>i. B i)"
    proof (rule finite_Lim_measure_decseq)
      show "decseq B"
        by (rule decseq_SucI) (force simp: B_def)
    qed auto
    also have "prob (\<Inter>i. B i) = 0"
      using \<open>(\<Inter>i. B i) \<in> null_sets M\<close> by (simp add: measure_eq_0_null_sets)
    finally show "(\<lambda>i. prob (B i)) \<longlonglongrightarrow> 0" .
  next
    have "prob (A n) \<le> prob (B n)" for n
      unfolding B_def by (intro finite_measure_mono) auto
    thus "\<forall>\<^sub>F n in at_top. norm (prob (A n)) \<le> prob (B n)"
      by (intro always_eventually) auto
  qed
qed

text \<open>
  The weak law is now a simple corollary: we again have the same setting as before. The weak
  law now states that $\overline{X}_n$ converges to $E[X_0]$ in probability. This means that
  for any \<open>\<epsilon> > 0\<close>, the probability that $|\overline{X}_n - X_0| > \varepsilon$ vanishes as
  \<open>n \<rightarrow> \<infinity>\<close>.
\<close>
corollary (in prob_space) weak_law_of_large_numbers_iid:
  fixes X :: "nat \<Rightarrow> 'a \<Rightarrow> real" and \<epsilon> :: real
  assumes indep: "indep_vars (\<lambda>_. borel) X UNIV"
  assumes distr: "\<And>i. distr M borel (X i) = distr M borel (X 0)"
  assumes L1:    "integrable M (X 0)"
  assumes "\<epsilon> > 0"
  shows   "(\<lambda>n. prob {x\<in>space M. \<bar>(\<Sum>i<n. X i x) / n - expectation (X 0)\<bar> > \<epsilon>}) \<longlonglongrightarrow> 0"
proof (rule AE_convergence_imp_convergence_in_prob)
  show "AE x in M. (\<lambda>n. (\<Sum>i<n. X i x) / n) \<longlonglongrightarrow> expectation (X 0)"
    by (rule strong_law_of_large_numbers_iid) fact+
next
  have [measurable]: "random_variable borel (X i)" for i
    using indep by (auto simp: indep_vars_def)
  show "random_variable borel (\<lambda>x. (\<Sum>i<n. X i x) / real n)" for n
    by measurable
qed (use \<open>\<epsilon> > 0\<close> in simp_all)

end


(*
    Author:      René Thiemann
                 Akihisa Yamada
    License:     BSD
*)
section \<open>Divmod-Int\<close>

text \<open>We provide the divmod-operation on type int for efficiency reasons.\<close>

theory Divmod_Int
imports Main
begin

definition divmod_int :: "int \<Rightarrow> int \<Rightarrow> int \<times> int" where
  "divmod_int n m = (n div m, n mod m)"

text \<open>We implement @{const divmod_int} via @{const divmod_integer}
  instead of invoking both division and modulo separately.\<close>

context
includes integer.lifting
begin

lemma divmod_int_code[code]: "divmod_int m n = map_prod int_of_integer int_of_integer
  (divmod_integer (integer_of_int m) (integer_of_int n))"
  unfolding divmod_int_def divmod_integer_def map_prod_def split prod.simps
proof
  show "m div n = int_of_integer
     (integer_of_int m div integer_of_int n)"
    by (transfer, simp)
  show "m mod n = int_of_integer
     (integer_of_int m mod integer_of_int n)"
    by (transfer, simp)
qed
end

end