(* Author: Alexander Maletzky *)

section \<open>Syzygies of Multivariate Polynomials\<close>

theory Syzygy
  imports Groebner_Bases More_MPoly_Type_Class
begin

text \<open>In this theory we first introduce the general concept of @{emph \<open>syzygies\<close>} in modules, and
  then provide a method for computing Gr\"obner bases of syzygy modules of lists of multivariate
  vector-polynomials. Since syzygies in this context are themselves represented by vector-polynomials,
  this method can be applied repeatedly to compute bases of syzygy modules of syzygies, and so on.\<close>

instance nat :: comm_powerprod ..

subsection \<open>Syzygy Modules Generated by Sets\<close>

context module
begin

definition rep :: "('b \<Rightarrow>\<^sub>0 'a) \<Rightarrow> 'b"
  where "rep r = (\<Sum>v\<in>keys r. lookup r v *s v)"

definition represents :: "'b set \<Rightarrow> ('b \<Rightarrow>\<^sub>0 'a) \<Rightarrow> 'b \<Rightarrow> bool"
  where "represents B r x \<longleftrightarrow> (keys r \<subseteq> B \<and> local.rep r = x)"

definition syzygy_module :: "'b set \<Rightarrow> ('b \<Rightarrow>\<^sub>0 'a) set"
  where "syzygy_module B = {s. local.represents B s 0}"

end

hide_const (open) real_vector.rep real_vector.represents real_vector.syzygy_module

context module
begin

lemma rep_monomial [simp]: "rep (monomial c x) = c *s x"
proof -
  have sub: "keys (monomial c x) \<subseteq> {x}" by simp
  have "rep (monomial c x) = (\<Sum>v\<in>{x}. lookup (monomial c x) v *s v)" unfolding rep_def
    by (rule sum.mono_neutral_left, simp, fact sub, simp)
  also have "... = c *s x" by simp
  finally show ?thesis .
qed

lemma rep_zero [simp]: "rep 0 = 0"
  by (simp add: rep_def)

lemma rep_uminus [simp]: "rep (- r) = - rep r"
  by (simp add: keys_uminus sum_negf rep_def)

lemma rep_plus: "rep (r + s) = rep r + rep s"
proof -
  from finite_keys finite_keys have fin: "finite (keys r \<union> keys s)" by (rule finite_UnI)
  from fin have eq1: "(\<Sum>v\<in>keys r \<union> keys s. lookup r v *s v) = (\<Sum>v\<in>keys r. lookup r v *s v)"
  proof (rule sum.mono_neutral_right)
    show "\<forall>v\<in>keys r \<union> keys s - keys r. lookup r v *s v = 0" by (simp add: in_keys_iff)
  qed simp
  from fin have eq2: "(\<Sum>v\<in>keys r \<union> keys s. lookup s v *s v) = (\<Sum>v\<in>keys s. lookup s v *s v)"
  proof (rule sum.mono_neutral_right)
    show "\<forall>v\<in>keys r \<union> keys s - keys s. lookup s v *s v = 0" by (simp add: in_keys_iff)
  qed simp
  have "rep (r + s) = (\<Sum>v\<in>keys (r + s). lookup (r + s) v *s v)" by (simp only: rep_def)
  also have "... = (\<Sum>v\<in>keys r \<union> keys s. lookup (r + s) v *s v)"
  proof (rule sum.mono_neutral_left)
    show "\<forall>i\<in>keys r \<union> keys s - keys (r + s). lookup (r + s) i *s i = 0" by (simp add: in_keys_iff)
  qed (auto simp: Poly_Mapping.keys_add)
  also have "... = (\<Sum>v\<in>keys r \<union> keys s. lookup r v *s v) + (\<Sum>v\<in>keys r \<union> keys s. lookup s v *s v)"
    by (simp add: lookup_add scale_left_distrib sum.distrib)
  also have "... = rep r + rep s" by (simp only: eq1 eq2 rep_def)
  finally show ?thesis .
qed

lemma rep_minus: "rep (r - s) = rep r - rep s"
proof -
  from finite_keys finite_keys have fin: "finite (keys r \<union> keys s)" by (rule finite_UnI)
  from fin have eq1: "(\<Sum>v\<in>keys r \<union> keys s. lookup r v *s v) = (\<Sum>v\<in>keys r. lookup r v *s v)"
  proof (rule sum.mono_neutral_right)
    show "\<forall>v\<in>keys r \<union> keys s - keys r. lookup r v *s v = 0" by (simp add: in_keys_iff)
  qed simp
  from fin have eq2: "(\<Sum>v\<in>keys r \<union> keys s. lookup s v *s v) = (\<Sum>v\<in>keys s. lookup s v *s v)"
  proof (rule sum.mono_neutral_right)
    show "\<forall>v\<in>keys r \<union> keys s - keys s. lookup s v *s v = 0" by (simp add: in_keys_iff)
  qed simp
  have "rep (r - s) = (\<Sum>v\<in>keys (r - s). lookup (r - s) v *s v)" by (simp only: rep_def)
  also from fin keys_minus have "... = (\<Sum>v\<in>keys r \<union> keys s. lookup (r - s) v *s v)"
  proof (rule sum.mono_neutral_left)
    show "\<forall>i\<in>keys r \<union> keys s - keys (r - s). lookup (r - s) i *s i = 0" by (simp add: in_keys_iff)
  qed
  also have "... = (\<Sum>v\<in>keys r \<union> keys s. lookup r v *s v) - (\<Sum>v\<in>keys r \<union> keys s. lookup s v *s v)"
    by (simp add: lookup_minus scale_left_diff_distrib sum_subtractf)
  also have "... = rep r - rep s" by (simp only: eq1 eq2 rep_def)
  finally show ?thesis .
qed

lemma rep_smult: "rep (monomial c 0 * r) = c *s rep r"
proof -
  have l: "lookup (monomial c 0 * r) v = c * (lookup r v)" for v
    unfolding mult_map_scale_conv_mult[symmetric] by (rule map_lookup, simp)
  have sub: "keys (monomial c 0 * r) \<subseteq> keys r"
    by (metis l lookup_not_eq_zero_eq_in_keys mult_zero_right subsetI)

  have "rep (monomial c 0 * r) = (\<Sum>v\<in>keys (monomial c 0 * r). lookup (monomial c 0 * r) v *s v)"
    by (simp only: rep_def)
  also from finite_keys sub have "... = (\<Sum>v\<in>keys r. lookup (monomial c 0 * r) v *s v)"
  proof (rule sum.mono_neutral_left)
    show "\<forall>v\<in>keys r - keys (monomial c 0 * r). lookup (monomial c 0 * r) v *s v = 0" by (simp add: in_keys_iff)
  qed
  also have "... = c *s (\<Sum>v\<in>keys r. lookup r v *s v)" by (simp add: l scale_sum_right)
  also have "... = c *s rep r" by (simp add: rep_def)
  finally show ?thesis .
qed

lemma rep_in_span: "rep r \<in> span (keys r)"
  unfolding rep_def by (fact sum_in_spanI)

lemma spanE_rep:
  assumes "x \<in> span B"
  obtains r where "keys r \<subseteq> B" and "x = rep r"
proof -
  from assms obtain A q where "finite A" and "A \<subseteq> B" and x: "x = (\<Sum>a\<in>A. q a *s a)" by (rule spanE)
  define r where "r = Abs_poly_mapping (\<lambda>k. q k when k \<in> A)"
  have 1: "lookup r = (\<lambda>k. q k when k \<in> A)" unfolding r_def
    by (rule Abs_poly_mapping_inverse, simp add: \<open>finite A\<close>)
  have 2: "keys r \<subseteq> A" by (auto simp: in_keys_iff 1)
  show ?thesis
  proof
    have "x = (\<Sum>a\<in>A. lookup r a *s a)" unfolding x by (rule sum.cong, simp_all add: 1)
    also from \<open>finite A\<close> 2 have "... = (\<Sum>a\<in>keys r. lookup r a *s a)"
    proof (rule sum.mono_neutral_right)
      show "\<forall>a\<in>A - keys r. lookup r a *s a = 0" by (simp add: in_keys_iff)
    qed
    finally show "x = rep r" by (simp only: rep_def)
  next
    from 2 \<open>A \<subseteq> B\<close> show "keys r \<subseteq> B" by (rule subset_trans)
  qed
qed

lemma representsI:
  assumes "keys r \<subseteq> B" and "rep r = x"
  shows "represents B r x"
  unfolding represents_def using assms by blast

lemma representsD1:
  assumes "represents B r x"
  shows "keys r \<subseteq> B"
  using assms unfolding represents_def by blast

lemma representsD2:
  assumes "represents B r x"
  shows "x = rep r"
  using assms unfolding represents_def by blast

lemma represents_mono:
  assumes "represents B r x" and "B \<subseteq> A"
  shows "represents A r x"
proof (rule representsI)
  from assms(1) have "keys r \<subseteq> B" by (rule representsD1)
  thus "keys r \<subseteq> A" using assms(2) by (rule subset_trans)
next
  from assms(1) have "x = rep r" by (rule representsD2)
  thus "rep r = x" by (rule HOL.sym)
qed

lemma represents_self: "represents {x} (monomial 1 x) x"
proof -
  have sub: "keys (monomial (1::'a) x) \<subseteq> {x}" by simp
  moreover have "rep (monomial (1::'a) x) = x" by simp
  ultimately show ?thesis by (rule representsI)
qed

lemma represents_zero: "represents B 0 0"
  by (rule representsI, simp_all)

lemma represents_plus:
  assumes "represents A r x" and "represents B s y"
  shows "represents (A \<union> B) (r + s) (x + y)"
proof -
  from assms(1) have r: "keys r \<subseteq> A" and x: "x = rep r" by (rule representsD1, rule representsD2)
  from assms(2) have s: "keys s \<subseteq> B" and y: "y = rep s" by (rule representsD1, rule representsD2)
  show ?thesis
  proof (rule representsI)
    from r s have "keys r \<union> keys s \<subseteq> A \<union> B" by blast
    thus "keys (r + s) \<subseteq> A \<union> B"
      by (meson Poly_Mapping.keys_add subset_trans)
  qed (simp add: rep_plus x y)
qed

lemma represents_uminus:
  assumes "represents B r x"
  shows "represents B (- r) (- x)"
proof -
  from assms have r: "keys r \<subseteq> B" and x: "x = rep r" by (rule representsD1, rule representsD2)
  show ?thesis
  proof (rule representsI)
    from r show "keys (- r) \<subseteq> B" by (simp only: keys_uminus)
  qed (simp add: x)
qed

lemma represents_minus:
  assumes "represents A r x" and "represents B s y"
  shows "represents (A \<union> B) (r - s) (x - y)"
proof -
  from assms(1) have r: "keys r \<subseteq> A" and x: "x = rep r" by (rule representsD1, rule representsD2)
  from assms(2) have s: "keys s \<subseteq> B" and y: "y = rep s" by (rule representsD1, rule representsD2)
  show ?thesis
  proof (rule representsI)
    from r s have "keys r \<union> keys s \<subseteq> A \<union> B" by blast
    with keys_minus show "keys (r - s) \<subseteq> A \<union> B" by (rule subset_trans)
  qed (simp only: rep_minus x y)
qed

lemma represents_scale:
  assumes "represents B r x"
  shows "represents B (monomial c 0 * r) (c *s x)"
proof -
  from assms have r: "keys r \<subseteq> B" and x: "x = rep r" by (rule representsD1, rule representsD2)
  show ?thesis
  proof (rule representsI)
    have l: "lookup (monomial c 0 * r) v = c * (lookup r v)" for v
      unfolding mult_map_scale_conv_mult[symmetric] by (rule map_lookup, simp)
    have sub: "keys (monomial c 0 * r) \<subseteq> keys r"
      by (metis l lookup_not_eq_zero_eq_in_keys mult_zero_right subsetI)
    thus "keys (monomial c 0 * r) \<subseteq> B" using r by (rule subset_trans)
  qed (simp only: rep_smult x)
qed

lemma represents_in_span:
  assumes "represents B r x"
  shows "x \<in> span B"
proof -
  from assms have r: "keys r \<subseteq> B" and x: "x = rep r" by (rule representsD1, rule representsD2)
  have "x \<in> span (keys r)" unfolding x by (fact rep_in_span)
  also from r have "... \<subseteq> span B" by (rule span_mono)
  finally show ?thesis .
qed

lemma syzygy_module_iff: "s \<in> syzygy_module B \<longleftrightarrow> represents B s 0"
  by (simp add: syzygy_module_def)

lemma syzygy_moduleI:
  assumes "represents B s 0"
  shows "s \<in> syzygy_module B"
  unfolding syzygy_module_iff using assms .

lemma syzygy_moduleD:
  assumes "s \<in> syzygy_module B"
  shows "represents B s 0"
  using assms unfolding syzygy_module_iff .

lemma zero_in_syzygy_module: "0 \<in> syzygy_module B"
  using represents_zero by (rule syzygy_moduleI)

lemma syzygy_module_closed_plus:
  assumes "s1 \<in> syzygy_module B" and "s2 \<in> syzygy_module B"
  shows "s1 + s2 \<in> syzygy_module B"
proof -
  from assms(1) have "represents B s1 0" by (rule syzygy_moduleD)
  moreover from assms(2) have "represents B s2 0" by (rule syzygy_moduleD)
  ultimately have "represents (B \<union> B) (s1 + s2) (0 + 0)" by (rule represents_plus)
  hence "represents B (s1 + s2) 0" by simp
  thus ?thesis by (rule syzygy_moduleI)
qed

lemma syzygy_module_closed_minus:
  assumes "s1 \<in> syzygy_module B" and "s2 \<in> syzygy_module B"
  shows "s1 - s2 \<in> syzygy_module B"
proof -
  from assms(1) have "represents B s1 0" by (rule syzygy_moduleD)
  moreover from assms(2) have "represents B s2 0" by (rule syzygy_moduleD)
  ultimately have "represents (B \<union> B) (s1 - s2) (0 - 0)" by (rule represents_minus)
  hence "represents B (s1 - s2) 0" by simp
  thus ?thesis by (rule syzygy_moduleI)
qed

lemma syzygy_module_closed_times_monomial:
  assumes "s \<in> syzygy_module B"
  shows "monomial c 0 * s \<in> syzygy_module B"
proof -
  from assms(1) have "represents B s 0" by (rule syzygy_moduleD)
  hence "represents B (monomial c 0 * s) (c *s 0)" by (rule represents_scale)
  hence "represents B (monomial c 0 * s) 0" by simp
  thus ?thesis by (rule syzygy_moduleI)
qed

end (* module *)

context term_powerprod
begin

lemma keys_rep_subset:
  assumes "u \<in> keys (pmdl.rep r)"
  obtains t v where "t \<in> Keys (Poly_Mapping.range r)" and "v \<in> Keys (keys r)" and "u = t \<oplus> v"
proof -
  note assms
  also have "keys (pmdl.rep r) \<subseteq> (\<Union>v\<in>keys r. keys (lookup r v \<odot> v))"
    by (simp add: pmdl.rep_def keys_sum_subset)
  finally obtain v0 where "v0 \<in> keys r" and "u \<in> keys (lookup r v0 \<odot> v0)" ..
  from this(2) obtain t v where "t \<in> keys (lookup r v0)" and "v \<in> keys v0" and "u = t \<oplus> v"
    by (rule in_keys_mult_scalarE)
  show ?thesis
  proof
    from \<open>v0 \<in> keys r\<close> have "lookup r v0 \<in> Poly_Mapping.range r" by (rule in_keys_lookup_in_range)
    with \<open>t \<in> keys (lookup r v0)\<close> show "t \<in> Keys (Poly_Mapping.range r)" by (rule in_KeysI)
  next
    from \<open>v \<in> keys v0\<close> \<open>v0 \<in> keys r\<close> show "v \<in> Keys (keys r)" by (rule in_KeysI)
  qed fact
qed

lemma rep_mult_scalar: "pmdl.rep (punit.monom_mult c 0 r) = c \<odot> pmdl.rep r"
  unfolding punit.mult_scalar_monomial[symmetric] punit_mult_scalar by (fact pmdl.rep_smult)

lemma represents_mult_scalar:
  assumes "pmdl.represents B r x"
  shows "pmdl.represents B (punit.monom_mult c 0 r) (c \<odot> x)"
  unfolding punit.mult_scalar_monomial[symmetric] punit_mult_scalar using assms
  by (rule pmdl.represents_scale)

lemma syzygy_module_closed_map_scale: "s \<in> pmdl.syzygy_module B \<Longrightarrow> c \<cdot> s \<in> pmdl.syzygy_module B"
  unfolding map_scale_eq_times by (rule pmdl.syzygy_module_closed_times_monomial)

lemma phull_syzygy_module: "phull (pmdl.syzygy_module B) = pmdl.syzygy_module B"
  unfolding phull.span_eq_iff
  apply (rule phull.subspaceI)
  subgoal by (fact pmdl.zero_in_syzygy_module)
  subgoal by (fact pmdl.syzygy_module_closed_plus)
  subgoal by (fact syzygy_module_closed_map_scale)
  done

end (* term_powerprod *)

subsection \<open>Polynomial Mappings on List-Indices\<close>

definition pm_of_idx_pm :: "('a list) \<Rightarrow> (nat \<Rightarrow>\<^sub>0 'b) \<Rightarrow> 'a \<Rightarrow>\<^sub>0 'b::zero"
  where "pm_of_idx_pm xs f = Abs_poly_mapping (\<lambda>x. lookup f (Min {i. i < length xs \<and> xs ! i = x}) when x \<in> set xs)"

definition idx_pm_of_pm :: "('a list) \<Rightarrow> ('a \<Rightarrow>\<^sub>0 'b) \<Rightarrow> nat \<Rightarrow>\<^sub>0 'b::zero"
  where "idx_pm_of_pm xs f = Abs_poly_mapping (\<lambda>i. lookup f (xs ! i) when i < length xs)"

lemma lookup_pm_of_idx_pm:
  "lookup (pm_of_idx_pm xs f) = (\<lambda>x. lookup f (Min {i. i < length xs \<and> xs ! i = x}) when x \<in> set xs)"
  unfolding pm_of_idx_pm_def by (rule Abs_poly_mapping_inverse, simp)

lemma lookup_pm_of_idx_pm_distinct:
  assumes "distinct xs" and "i < length xs"
  shows "lookup (pm_of_idx_pm xs f) (xs ! i) = lookup f i"
proof -
  from assms have "{j. j < length xs \<and> xs ! j = xs ! i} = {i}"
    using distinct_Ex1 nth_mem by fastforce
  moreover from assms(2) have "xs ! i \<in> set xs" by (rule nth_mem)
  ultimately show ?thesis by (simp add: lookup_pm_of_idx_pm)
qed

lemma keys_pm_of_idx_pm_subset: "keys (pm_of_idx_pm xs f) \<subseteq> set xs"
proof
  fix t
  assume "t \<in> keys (pm_of_idx_pm xs f)"
  hence "lookup (pm_of_idx_pm xs f) t \<noteq> 0" by (simp add: in_keys_iff)
  thus "t \<in> set xs" by (simp add: lookup_pm_of_idx_pm)
qed

lemma range_pm_of_idx_pm_subset: "Poly_Mapping.range (pm_of_idx_pm xs f) \<subseteq> lookup f ` {0..<length xs} - {0}"
proof
  fix c
  assume "c \<in> Poly_Mapping.range (pm_of_idx_pm xs f)"
  then obtain t where t: "t \<in> keys (pm_of_idx_pm xs f)" and c: "c = lookup (pm_of_idx_pm xs f) t"
    by (metis DiffE imageE insertCI not_in_keys_iff_lookup_eq_zero range.rep_eq)
  from t keys_pm_of_idx_pm_subset have "t \<in> set xs" ..
  hence c1: "c = lookup f (Min {i. i < length xs \<and> xs ! i = t})" by (simp add: lookup_pm_of_idx_pm c)
  show "c \<in> lookup f ` {0..<length xs} - {0}"
  proof (intro DiffI image_eqI)
    from \<open>t \<in> set xs\<close> obtain i where "i < length xs" and "t = xs ! i" by (metis in_set_conv_nth)
    have "finite {i. i < length xs \<and> xs ! i = t}" by simp
    moreover from \<open>i < length xs\<close> \<open>t = xs ! i\<close> have "{i. i < length xs \<and> xs ! i = t} \<noteq> {}" by auto
    ultimately have "Min {i. i < length xs \<and> xs ! i = t} \<in> {i. i < length xs \<and> xs ! i = t}"
      by (rule Min_in)
    thus "Min {i. i < length xs \<and> xs ! i = t} \<in> {0..<length xs}" by simp
  next
    from t show "c \<notin> {0}" by (simp add: c in_keys_iff)
  qed (fact c1)
qed

corollary range_pm_of_idx_pm_subset': "Poly_Mapping.range (pm_of_idx_pm xs f) \<subseteq> Poly_Mapping.range f"
  using range_pm_of_idx_pm_subset
proof (rule subset_trans)
  show "lookup f ` {0..<length xs} - {0} \<subseteq> Poly_Mapping.range f" by (transfer, auto)
qed

lemma pm_of_idx_pm_zero [simp]: "pm_of_idx_pm xs 0 = 0"
  by (rule poly_mapping_eqI, simp add: lookup_pm_of_idx_pm)

lemma pm_of_idx_pm_plus: "pm_of_idx_pm xs (f + g) = pm_of_idx_pm xs f + pm_of_idx_pm xs g"
  by (rule poly_mapping_eqI, simp add: lookup_pm_of_idx_pm lookup_add when_def)

lemma pm_of_idx_pm_uminus: "pm_of_idx_pm xs (- f) = - pm_of_idx_pm xs f"
  by (rule poly_mapping_eqI, simp add: lookup_pm_of_idx_pm when_def)

lemma pm_of_idx_pm_monom_mult: "pm_of_idx_pm xs (punit.monom_mult c 0 f) = punit.monom_mult c 0 (pm_of_idx_pm xs f)"
  by (rule poly_mapping_eqI, simp add: lookup_pm_of_idx_pm punit.lookup_monom_mult_zero when_def)

lemma pm_of_idx_pm_monomial:
  assumes "distinct xs"
  shows "pm_of_idx_pm xs (monomial c i) = (monomial c (xs ! i) when i < length xs)"
proof -
  from assms have *: "{i. i < length xs \<and> xs ! i = xs ! j} = {j}" if "j < length xs" for j
    using distinct_Ex1 nth_mem that by fastforce
  show ?thesis
  proof (cases "i < length xs")
    case True
    have "pm_of_idx_pm xs (monomial c i) = monomial c (xs ! i)"
    proof (rule poly_mapping_eqI)
      fix k
      show "lookup (pm_of_idx_pm xs (monomial c i)) k = lookup (monomial c (xs ! i)) k"
      proof (cases "xs ! i = k")
        case True
        with \<open>i < length xs\<close> have "k \<in> set xs" by auto
        thus ?thesis by (simp add: lookup_pm_of_idx_pm lookup_single *[OF \<open>i < length xs\<close>] True[symmetric])
      next
        case False
        have "lookup (pm_of_idx_pm xs (monomial c i)) k = 0"
        proof (cases "k \<in> set xs")
          case True
          then obtain j where "j < length xs" and "k = xs ! j" by (metis in_set_conv_nth)
          with False have "i \<noteq> Min {i. i < length xs \<and> xs ! i = k}"
            by (auto simp: \<open>k = xs ! j\<close> *[OF \<open>j < length xs\<close>])
          thus ?thesis by (simp add: lookup_pm_of_idx_pm True lookup_single)
        next
          case False
          thus ?thesis by (simp add: lookup_pm_of_idx_pm)
        qed
        with False show ?thesis by (simp add: lookup_single)
      qed
    qed
    with True show ?thesis by simp
  next
    case False
    have "pm_of_idx_pm xs (monomial c i) = 0"
    proof (rule poly_mapping_eqI, simp add: lookup_pm_of_idx_pm when_def, rule)
      fix k
      assume "k \<in> set xs"
      then obtain j where "j < length xs" and "k = xs ! j" by (metis in_set_conv_nth)
      with False have "i \<noteq> Min {i. i < length xs \<and> xs ! i = k}"
        by (auto simp: \<open>k = xs ! j\<close> *[OF \<open>j < length xs\<close>])
      thus "lookup (monomial c i) (Min {i. i < length xs \<and> xs ! i = k}) = 0"
        by (simp add: lookup_single)
    qed
    with False show ?thesis by simp
  qed
qed

lemma pm_of_idx_pm_take:
  assumes "keys f \<subseteq> {0..<j}"
  shows "pm_of_idx_pm (take j xs) f = pm_of_idx_pm xs f"
proof (rule poly_mapping_eqI)
  fix i
  let ?xs = "take j xs"
  let ?A = "{k. k < length xs \<and> xs ! k = i}"
  let ?B = "{k. k < length xs \<and> k < j \<and> xs ! k = i}"
  have A_fin: "finite ?A" and B_fin: "finite ?B" by fastforce+
  have A_ne: "i \<in> set xs \<Longrightarrow> ?A \<noteq> {}" by (simp add: in_set_conv_nth)
  have B_ne: "i \<in> set ?xs \<Longrightarrow> ?B \<noteq> {}" by (auto simp add: in_set_conv_nth)
  define m1 where "m1 = Min ?A"
  define m2 where "m2 = Min ?B"
  have m1: "m1 \<in> ?A" if "i \<in> set xs"
    unfolding m1_def by (rule Min_in, fact A_fin, rule A_ne, fact that)
  have m2: "m2 \<in> ?B" if "i \<in> set ?xs"
    unfolding m2_def by (rule Min_in, fact B_fin, rule B_ne, fact that)
  show "lookup (pm_of_idx_pm (take j xs) f) i = lookup (pm_of_idx_pm xs f) i"
  proof (cases "i \<in> set ?xs")
    case True
    hence "i \<in> set xs" using set_take_subset ..
    hence "m1 \<in> ?A" by (rule m1)
    hence "m1 < length xs" and "xs ! m1 = i" by simp_all
    from True have "m2 \<in> ?B" by (rule m2)
    hence "m2 < length xs" and "m2 < j" and "xs ! m2 = i" by simp_all
    hence "m2 \<in> ?A" by simp
    with A_fin have "m1 \<le> m2" unfolding m1_def by (rule Min_le)
    with \<open>m2 < j\<close> have "m1 < j" by simp
    with \<open>m1 < length xs\<close> \<open>xs ! m1 = i\<close> have "m1 \<in> ?B" by simp
    with B_fin have "m2 \<le> m1" unfolding m2_def by (rule Min_le)
    with \<open>m1 \<le> m2\<close> have "m1 = m2" by (rule le_antisym)
    with True \<open>i \<in> set xs\<close> show ?thesis by (simp add: lookup_pm_of_idx_pm m1_def m2_def cong: conj_cong)
  next
    case False
    thus ?thesis
    proof (simp add: lookup_pm_of_idx_pm when_def m1_def[symmetric], intro impI)
      assume "i \<in> set xs"
      hence "m1 \<in> ?A" by (rule m1)
      hence "m1 < length xs" and "xs ! m1 = i" by simp_all
      have "m1 \<notin> keys f"
      proof
        assume "m1 \<in> keys f"
        hence "m1 \<in> {0..<j}" using assms ..
        hence "m1 < j" by simp
        with \<open>m1 < length xs\<close> have "m1 < length ?xs" by simp
        hence "?xs ! m1 \<in> set ?xs" by (rule nth_mem)
        with \<open>m1 < j\<close> have "i \<in> set ?xs" by (simp add: \<open>xs ! m1 = i\<close>)
        with False show False ..
      qed
      thus "lookup f m1 = 0" by (simp add: in_keys_iff)
    qed
  qed
qed

lemma lookup_idx_pm_of_pm: "lookup (idx_pm_of_pm xs f) = (\<lambda>i. lookup f (xs ! i) when i < length xs)"
  unfolding idx_pm_of_pm_def by (rule Abs_poly_mapping_inverse, simp)

lemma keys_idx_pm_of_pm_subset: "keys (idx_pm_of_pm xs f) \<subseteq> {0..<length xs}"
proof
  fix i
  assume "i \<in> keys (idx_pm_of_pm xs f)"
  hence "lookup (idx_pm_of_pm xs f) i \<noteq> 0" by (simp add: in_keys_iff)
  thus "i \<in> {0..<length xs}" by (simp add: lookup_idx_pm_of_pm)
qed

lemma idx_pm_of_pm_zero [simp]: "idx_pm_of_pm xs 0 = 0"
  by (rule poly_mapping_eqI, simp add: lookup_idx_pm_of_pm)

lemma idx_pm_of_pm_plus: "idx_pm_of_pm xs (f + g) = idx_pm_of_pm xs f + idx_pm_of_pm xs g"
  by (rule poly_mapping_eqI, simp add: lookup_idx_pm_of_pm lookup_add when_def)

lemma idx_pm_of_pm_minus: "idx_pm_of_pm xs (f - g) = idx_pm_of_pm xs f - idx_pm_of_pm xs g"
  by (rule poly_mapping_eqI, simp add: lookup_idx_pm_of_pm lookup_minus when_def)

lemma idx_pm_of_pm_of_idx_pm:
  assumes "distinct xs" and "keys f \<subseteq> {0..<length xs}"
  shows "idx_pm_of_pm xs (pm_of_idx_pm xs f) = f"
proof (rule poly_mapping_eqI)
  fix i
  show "lookup (idx_pm_of_pm xs (pm_of_idx_pm xs f)) i = lookup f i"
  proof (cases "i < length xs")
    case True
    with assms(1) show ?thesis by (simp add: lookup_idx_pm_of_pm lookup_pm_of_idx_pm_distinct)
  next
    case False
    hence "i \<notin> {0..<length xs}" by simp
    with assms(2) have "i \<notin> keys f" by blast
    with False show ?thesis by (simp add: in_keys_iff lookup_idx_pm_of_pm)
  qed
qed

subsection \<open>POT Orders\<close>

context ordered_term
begin

definition is_pot_ord :: bool
  where "is_pot_ord \<longleftrightarrow> (\<forall>u v. component_of_term u < component_of_term v \<longrightarrow> u \<prec>\<^sub>t v)"

lemma is_pot_ordI:
  assumes "\<And>u v. component_of_term u < component_of_term v \<Longrightarrow> u \<prec>\<^sub>t v"
  shows "is_pot_ord"
  unfolding is_pot_ord_def using assms by blast

lemma is_pot_ordD:
  assumes "is_pot_ord" and "component_of_term u < component_of_term v"
  shows "u \<prec>\<^sub>t v"
  using assms unfolding is_pot_ord_def by blast

lemma is_pot_ordD2:
  assumes "is_pot_ord" and "u \<preceq>\<^sub>t v"
  shows "component_of_term u \<le> component_of_term v"
proof (rule ccontr)
  assume "\<not> component_of_term u \<le> component_of_term v"
  hence "component_of_term v < component_of_term u" by simp
  with assms(1) have "v \<prec>\<^sub>t u" by (rule is_pot_ordD)
  with assms(2) show False by simp
qed

lemma is_pot_ord:
  assumes "is_pot_ord"
  shows "u \<preceq>\<^sub>t v \<longleftrightarrow> (component_of_term u < component_of_term v \<or>
                    (component_of_term u = component_of_term v \<and> pp_of_term u \<preceq> pp_of_term v))" (is "?l \<longleftrightarrow> ?r")
proof
  assume ?l
  with assms have "component_of_term u \<le> component_of_term v" by (rule is_pot_ordD2)
  hence "component_of_term u < component_of_term v \<or> component_of_term u = component_of_term v"
    by (simp add: order_class.le_less)
  thus ?r
  proof
    assume "component_of_term u < component_of_term v"
    thus ?r ..
  next
    assume 1: "component_of_term u = component_of_term v"
    moreover have "pp_of_term u \<preceq> pp_of_term v"
    proof (rule ccontr)
      assume "\<not> pp_of_term u \<preceq> pp_of_term v"
      hence 2: "pp_of_term v \<preceq> pp_of_term u" and 3: "pp_of_term u \<noteq> pp_of_term v" by simp_all
      from 1 have "component_of_term v \<le> component_of_term u" by simp
      with 2 have "v \<preceq>\<^sub>t u" by (rule ord_termI)
      with \<open>?l\<close> have "u = v" by simp
      with 3 show False by simp
    qed
    ultimately show ?r by simp
  qed
next
  assume ?r
  thus ?l
  proof
    assume "component_of_term u < component_of_term v"
    with assms have "u \<prec>\<^sub>t v" by (rule is_pot_ordD)
    thus ?l by simp
  next
    assume "component_of_term u = component_of_term v \<and> pp_of_term u \<preceq> pp_of_term v"
    hence "pp_of_term u \<preceq> pp_of_term v" and "component_of_term u \<le> component_of_term v" by simp_all
    thus ?l by (rule ord_termI)
  qed
qed

definition map_component :: "('k \<Rightarrow> 'k) \<Rightarrow> 't \<Rightarrow> 't"
  where "map_component f v = term_of_pair (pp_of_term v, f (component_of_term v))"

lemma pair_of_map_component [term_simps]:
  "pair_of_term (map_component f v) = (pp_of_term v, f (component_of_term v))"
  by (simp add: map_component_def pair_term)

lemma pp_of_map_component [term_simps]: "pp_of_term (map_component f v) = pp_of_term v"
  by (simp add: pp_of_term_def pair_of_map_component)

lemma component_of_map_component [term_simps]:
  "component_of_term (map_component f v) = f (component_of_term v)"
  by (simp add: component_of_term_def pair_of_map_component)

lemma map_component_term_of_pair [term_simps]:
  "map_component f (term_of_pair (t, k)) = term_of_pair (t, f k)"
  by (simp add: map_component_def term_simps)

lemma map_component_comp: "map_component f (map_component g x) = map_component (\<lambda>k. f (g k)) x"
  by (simp add: map_component_def term_simps)

lemma map_component_id [term_simps]: "map_component (\<lambda>k. k) x = x"
  by (simp add: map_component_def term_simps)

lemma map_component_inj:
  assumes "inj f" and "map_component f u = map_component f v"
  shows "u = v"
proof -
  from assms(2) have "term_of_pair (pp_of_term u, f (component_of_term u)) =
                      term_of_pair (pp_of_term v, f (component_of_term v))"
    by (simp only: map_component_def)
  hence "(pp_of_term u, f (component_of_term u)) = (pp_of_term v, f (component_of_term v))"
    by (rule term_of_pair_injective)
  hence 1: "pp_of_term u = pp_of_term v" and "f (component_of_term u) = f (component_of_term v)" by simp_all
  from assms(1) this(2) have "component_of_term u = component_of_term v" by (rule injD)
  with 1 show ?thesis by (metis term_of_pair_pair)
qed

end (* ordered_term *)

subsection \<open>Gr\"obner Bases of Syzygy Modules\<close>

locale gd_inf_term =
    gd_term pair_of_term term_of_pair ord ord_strict ord_term ord_term_strict
      for pair_of_term::"'t \<Rightarrow> ('a::graded_dickson_powerprod \<times> nat)"
      and term_of_pair::"('a \<times> nat) \<Rightarrow> 't"
      and ord::"'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl "\<preceq>" 50)
      and ord_strict (infixl "\<prec>" 50)
      and ord_term::"'t \<Rightarrow> 't \<Rightarrow> bool" (infixl "\<preceq>\<^sub>t" 50)
      and ord_term_strict::"'t \<Rightarrow> 't \<Rightarrow> bool" (infixl "\<prec>\<^sub>t" 50)
begin

text \<open>In order to compute a Gr\"obner basis of the syzygy module of a list \<open>bs\<close> of polynomials, one
  first needs to ``lift'' \<open>bs\<close> to a new list \<open>bs'\<close> by adding further components, compute a Gr\"obner
  basis \<open>gs\<close> of \<open>bs'\<close>, and then filter out those elements of \<open>gs\<close> whose only non-zero components are
  those that were newly added to \<open>bs\<close>.
  Function \<open>init_syzygy_list\<close> takes care of constructing \<open>bs'\<close>, and function \<open>filter_syzygy_basis\<close>
  does the filtering. Function \<open>proj_orig_basis\<close>, finally, projects the Gr\"obner basis \<open>gs\<close> of \<open>bs'\<close>
  to a Gr\"obner basis of the original list \<open>bs\<close>.\<close>

definition lift_poly_syz :: "nat \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b) \<Rightarrow> nat \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b::semiring_1)"
  where "lift_poly_syz n b i = Abs_poly_mapping
              (\<lambda>x. if pair_of_term x = (0, i) then 1
                   else if n \<le> component_of_term x then lookup b (map_component (\<lambda>k. k - n) x)
                   else 0)"

definition proj_poly_syz :: "nat \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b) \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b::semiring_1)"
  where "proj_poly_syz n b = Poly_Mapping.map_key (\<lambda>x. map_component (\<lambda>k. k + n) x) b"

definition cofactor_list_syz :: "nat \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>0 'b::semiring_1) list"
  where "cofactor_list_syz n b = map (\<lambda>i. proj_poly i b) [0..<n]"

definition init_syzygy_list :: "('t \<Rightarrow>\<^sub>0 'b) list \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b::semiring_1) list"
  where "init_syzygy_list bs = map_idx (lift_poly_syz (length bs)) bs 0"

definition proj_orig_basis :: "nat \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b) list \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b::semiring_1) list"
  where "proj_orig_basis n bs = map (proj_poly_syz n) bs"

definition filter_syzygy_basis :: "nat \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b) list \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b::semiring_1) list"
  where "filter_syzygy_basis n bs = [b\<leftarrow>bs. component_of_term ` keys b \<subseteq> {0..<n}]"

definition syzygy_module_list :: "('t \<Rightarrow>\<^sub>0 'b) list \<Rightarrow> ('t \<Rightarrow>\<^sub>0 'b::comm_ring_1) set"
  where "syzygy_module_list bs = atomize_poly ` idx_pm_of_pm bs ` pmdl.syzygy_module (set bs)"

subsubsection \<open>@{const lift_poly_syz}\<close>

lemma keys_lift_poly_syz_aux:
  "{x. (if pair_of_term x = (0, i) then 1
        else if n \<le> component_of_term x then lookup b (map_component (\<lambda>k. k - n) x)
        else 0) \<noteq> 0} \<subseteq> insert (term_of_pair (0, i)) (map_component (\<lambda>k. k + n) ` keys b)"
  (is "?l \<subseteq> ?r") for b::"'t \<Rightarrow>\<^sub>0 'b::semiring_1"
proof
  fix x::'t
  assume "x \<in> ?l"
  hence "(if pair_of_term x = (0, i) then 1 else if n \<le> component_of_term x then lookup b (map_component (\<lambda>k. k - n) x) else 0) \<noteq> 0"
    by simp
  hence "pair_of_term x = (0, i) \<or> (n \<le> component_of_term x \<and> lookup b (map_component (\<lambda>k. k - n) x) \<noteq> 0)"
    by (simp split: if_split_asm)
  thus "x \<in> ?r"
  proof
    assume "pair_of_term x = (0, i)"
    hence "(0, i) = pair_of_term x" by (rule sym)
    hence "x = term_of_pair (0, i)" by (simp add: term_pair)
    thus ?thesis by simp
  next
    assume "n \<le> component_of_term x \<and> lookup b (map_component (\<lambda>k. k - n) x) \<noteq> 0"
    hence "n \<le> component_of_term x" and 2: "map_component (\<lambda>k. k - n) x \<in> keys b"
      by (auto simp: in_keys_iff)
    from this(1) have 3: "map_component (\<lambda>k. k - n + n) x = x" by (simp add: map_component_def term_simps)
    from 2 have "map_component (\<lambda>k. k + n) (map_component (\<lambda>k. k - n) x) \<in> map_component (\<lambda>k. k + n) ` keys b"
      by (rule imageI)
    with 3 have "x \<in> map_component (\<lambda>k. k + n) ` keys b" by (simp add: map_component_comp)
    thus ?thesis by simp
  qed
qed

lemma lookup_lift_poly_syz:
  "lookup (lift_poly_syz n b i) =
    (\<lambda>x. if pair_of_term x = (0, i) then 1 else if n \<le> component_of_term x then lookup b (map_component (\<lambda>k. k - n) x) else 0)"
  unfolding lift_poly_syz_def
proof (rule Abs_poly_mapping_inverse)
  from finite_keys have "finite (map_component (\<lambda>k. k + n) ` keys b)" ..
  hence "finite (insert (term_of_pair (0, i)) (map_component (\<lambda>k. k + n) ` keys b))" by (rule finite.insertI)
  with keys_lift_poly_syz_aux
  have "finite {x. (if pair_of_term x = (0, i) then 1
                    else if n \<le> component_of_term x then lookup b (map_component (\<lambda>k. k - n) x)
                    else 0) \<noteq> 0}"
    by (rule finite_subset)
  thus "(\<lambda>x. if pair_of_term x = (0, i) then 1
              else if n \<le> component_of_term x then lookup b (map_component (\<lambda>k. k - n) x)
              else 0) \<in>
          {f. finite {x. f x \<noteq> 0}}" by simp
qed

corollary lookup_lift_poly_syz_alt:
  "lookup (lift_poly_syz n b i) (term_of_pair (t, j)) =
          (if (t, j) = (0, i) then 1 else if n \<le> j then lookup b (term_of_pair (t, j - n)) else 0)"
  by (simp only: lookup_lift_poly_syz term_simps)

lemma keys_lift_poly_syz:
  "keys (lift_poly_syz n b i) = insert (term_of_pair (0, i)) (map_component (\<lambda>k. k + n) ` keys b)"
proof
  have "keys (lift_poly_syz n b i) \<subseteq>
          {x. (if pair_of_term x = (0, i) then 1
              else if n \<le> component_of_term x then lookup b (map_component (\<lambda>k. k - n) x)
              else 0) \<noteq> 0}"
    (is "_ \<subseteq> ?A")
  proof
    fix x
    assume "x \<in> keys (lift_poly_syz n b i)"
    hence "lookup (lift_poly_syz n b i) x \<noteq> 0" by (simp add: in_keys_iff)
    thus "x \<in> ?A" by (simp add: lookup_lift_poly_syz)
  qed
  also note keys_lift_poly_syz_aux
  finally show "keys (lift_poly_syz n b i) \<subseteq> insert (term_of_pair (0, i)) (map_component (\<lambda>k. k + n) ` keys b)" .
next
  show "insert (term_of_pair (0, i)) (map_component (\<lambda>k. k + n) ` keys b) \<subseteq> keys (lift_poly_syz n b i)"
  proof (simp, rule)
    have "lookup (lift_poly_syz n b i) (term_of_pair (0, i)) \<noteq> 0" by (simp add: lookup_lift_poly_syz_alt)
    thus "term_of_pair (0, i) \<in> keys (lift_poly_syz n b i)" by (simp add: in_keys_iff)
  next
    show "map_component (\<lambda>k. k + n) ` keys b \<subseteq> keys (lift_poly_syz n b i)"
    proof (rule, elim imageE, simp)
      fix x
      assume "x \<in> keys b"
      hence "lookup (lift_poly_syz n b i) (map_component (\<lambda>k. k + n) x) \<noteq> 0"
        by (simp add: in_keys_iff lookup_lift_poly_syz_alt map_component_def term_simps)
      thus "map_component (\<lambda>k. k + n) x \<in> keys (lift_poly_syz n b i)" by (simp add: in_keys_iff)
    qed
  qed
qed

subsubsection \<open>@{const proj_poly_syz}\<close>

lemma inj_map_component_plus: "inj (map_component (\<lambda>k. k + n))"
proof (rule injI)
  fix x y
  have "inj (\<lambda>k::nat. k + n)" by (simp add: inj_def)
  moreover assume "map_component (\<lambda>k. k + n) x = map_component (\<lambda>k. k + n) y"
  ultimately show "x = y" by (rule map_component_inj)
qed

lemma lookup_proj_poly_syz: "lookup (proj_poly_syz n p) x = lookup p (map_component (\<lambda>k. k + n) x)"
 by (simp add: proj_poly_syz_def map_key.rep_eq[OF inj_map_component_plus])

lemma lookup_proj_poly_syz_alt:
  "lookup (proj_poly_syz n p) (term_of_pair (t, i)) = lookup p (term_of_pair (t, i + n))"
  by (simp add: lookup_proj_poly_syz map_component_term_of_pair)

lemma keys_proj_poly_syz: "keys (proj_poly_syz n p) = map_component (\<lambda>k. k + n) -` keys p"
  by (simp add: proj_poly_syz_def keys_map_key[OF inj_map_component_plus])

lemma proj_poly_syz_zero [simp]: "proj_poly_syz n 0 = 0"
  by (rule poly_mapping_eqI, simp add: lookup_proj_poly_syz)

lemma proj_poly_syz_plus: "proj_poly_syz n (p + q) = proj_poly_syz n p + proj_poly_syz n q"
  by (simp add: proj_poly_syz_def map_key_plus[OF inj_map_component_plus])

lemma proj_poly_syz_sum: "proj_poly_syz n (sum f A) = (\<Sum>a\<in>A. proj_poly_syz n (f a))"
  by (rule fun_sum_commute, simp_all add: proj_poly_syz_plus)

lemma proj_poly_syz_sum_list: "proj_poly_syz n (sum_list xs) = sum_list (map (proj_poly_syz n) xs)"
  by (rule fun_sum_list_commute, simp_all add: proj_poly_syz_plus)

lemma proj_poly_syz_monom_mult:
  "proj_poly_syz n (monom_mult c t p) = monom_mult c t (proj_poly_syz n p)"
  by (rule poly_mapping_eqI,
      simp add: lookup_proj_poly_syz lookup_monom_mult term_simps adds_pp_def sminus_def)

lemma proj_poly_syz_mult_scalar:
  "proj_poly_syz n (mult_scalar q p) = mult_scalar q (proj_poly_syz n p)"
  by (rule fun_mult_scalar_commute, simp_all add: proj_poly_syz_plus proj_poly_syz_monom_mult)

lemma proj_poly_syz_lift_poly_syz:
  assumes "i < n"
  shows "proj_poly_syz n (lift_poly_syz n p i) = p"
proof (rule poly_mapping_eqI, simp add: lookup_proj_poly_syz lookup_lift_poly_syz term_simps map_component_comp,
      rule, elim conjE)
  fix x::'t
  assume "component_of_term x + n = i"
  hence "n \<le> i" by simp
  with assms show "lookup p x = 1" by simp
qed

lemma proj_poly_syz_eq_zero_iff: "proj_poly_syz n p = 0 \<longleftrightarrow> (component_of_term ` keys p \<subseteq> {0..<n})"
  unfolding keys_eq_empty[symmetric] keys_proj_poly_syz
proof
  assume "map_component (\<lambda>k. k + n) -` keys p = {}" (is "?A = {}")
  show "component_of_term ` keys p \<subseteq> {0..<n}"
  proof (rule, rule ccontr)
    fix i
    assume "i \<in> component_of_term ` keys p"
    then obtain x where x: "x \<in> keys p" and i: "i = component_of_term x" ..
    assume "i \<notin> {0..<n}"
    hence "i - n + n = i" by simp
    hence 1: "map_component (\<lambda>k. k - n + n) x = x" by (simp add: map_component_def i term_simps)
    have "map_component (\<lambda>k. k - n) x \<in> ?A" by (rule vimageI2, simp add: map_component_comp x 1)
    thus False by (simp add: \<open>?A = {}\<close>)
  qed
next
  assume a: "component_of_term ` keys p \<subseteq> {0..<n}"
  show "map_component (\<lambda>k. k + n) -` keys p = {}" (is "?A = {}")
  proof (rule ccontr)
    assume "?A \<noteq> {}"
    then obtain x where "x \<in> ?A" by blast
    hence "map_component (\<lambda>k. k + n) x \<in> keys p" by (rule vimageD)
    with a have "component_of_term (map_component (\<lambda>k. k + n) x) \<in> {0..<n}" by blast
    thus False by (simp add: term_simps)
  qed
qed

lemma component_of_lt_ge:
  assumes "is_pot_ord" and "proj_poly_syz n p \<noteq> 0"
  shows "n \<le> component_of_term (lt p)"
proof -
  from assms(2) have "\<not> component_of_term ` keys p \<subseteq> {0..<n}" by (simp add: proj_poly_syz_eq_zero_iff)
  then obtain i where "i \<in> component_of_term ` keys p" and "i \<notin> {0..<n}" by fastforce
  from this(1) obtain x where "x \<in> keys p" and i: "i = component_of_term x" ..
  from this(1) have "x \<preceq>\<^sub>t lt p" by (rule lt_max_keys)
  with assms(1) have "component_of_term x \<le> component_of_term (lt p)" by (rule is_pot_ordD2)
  with \<open>i \<notin> {0..<n}\<close> show ?thesis by (simp add: i)
qed

lemma lt_proj_poly_syz:
  assumes "is_pot_ord" and "proj_poly_syz n p \<noteq> 0"
  shows "lt (proj_poly_syz n p) = map_component (\<lambda>k. k - n) (lt p)" (is "_ = ?l")
proof -
  from component_of_lt_ge[OF assms]
  have "component_of_term (lt p) - n + n = component_of_term (lt p)" by simp
  hence eq: "map_component (\<lambda>k. k - n + n) (lt p) = lt p" by (simp add: map_component_def term_simps)
  show ?thesis
  proof (rule lt_eqI)
    have "lookup (proj_poly_syz n p) ?l = lc p"
      by (simp add: lc_def lookup_proj_poly_syz term_simps map_component_comp eq)
    also have "... \<noteq> 0"
    proof (rule lc_not_0, rule)
      assume "p = 0"
      hence "proj_poly_syz n p = 0" by simp
      with assms(2) show False ..
    qed
    finally show "lookup (proj_poly_syz n p) ?l \<noteq> 0" .
  next
    fix x
    assume "lookup (proj_poly_syz n p) x \<noteq> 0"
    hence "map_component (\<lambda>k. k + n) x \<in> keys p" by (simp add: in_keys_iff lookup_proj_poly_syz)
    hence "map_component (\<lambda>k. k + n) x \<preceq>\<^sub>t lt p" by (rule lt_max_keys)
    with assms(1) show "x \<preceq>\<^sub>t ?l" by (auto simp add: is_pot_ord term_simps)
  qed
qed

lemma proj_proj_poly_syz: "proj_poly k (proj_poly_syz n p) = proj_poly (k + n) p"
  by (rule poly_mapping_eqI, simp add: lookup_proj_poly lookup_proj_poly_syz_alt)

lemma poly_mapping_eqI_proj_syz:
  assumes "proj_poly_syz n p = proj_poly_syz n q"
    and "\<And>k. k < n \<Longrightarrow> proj_poly k p = proj_poly k q"
  shows "p = q"
proof (rule poly_mapping_eqI_proj)
  fix k
  show "proj_poly k p = proj_poly k q"
  proof (cases "k < n")
    case True
    thus ?thesis by (rule assms(2))
  next
    case False
    have "proj_poly (k - n + n) p = proj_poly (k - n + n) q"
      by (simp only: proj_proj_poly_syz[symmetric] assms(1))
    with False show ?thesis by simp
  qed
qed

subsubsection \<open>@{const cofactor_list_syz}\<close>

lemma length_cofactor_list_syz [simp]: "length (cofactor_list_syz n p) = n"
  by (simp add: cofactor_list_syz_def)

lemma cofactor_list_syz_nth:
  assumes "i < n"
  shows "(cofactor_list_syz n p) ! i = proj_poly i p"
  by (simp add: cofactor_list_syz_def map_idx_nth assms)

lemma cofactor_list_syz_zero [simp]: "cofactor_list_syz n 0 = replicate n 0"
  by (rule nth_equalityI, simp_all add: cofactor_list_syz_nth proj_zero)

lemma cofactor_list_syz_plus:
  "cofactor_list_syz n (p + q) = map2 (+) (cofactor_list_syz n p) (cofactor_list_syz n q)"
  by (rule nth_equalityI, simp_all add: cofactor_list_syz_nth proj_plus)

subsubsection \<open>@{const init_syzygy_list}\<close>

lemma length_init_syzygy_list [simp]: "length (init_syzygy_list bs) = length bs"
  by (simp add: init_syzygy_list_def)

lemma init_syzygy_list_nth:
  assumes "i < length bs"
  shows "(init_syzygy_list bs) ! i = lift_poly_syz (length bs) (bs ! i) i"
  by (simp add: init_syzygy_list_def map_idx_nth[OF assms])

lemma Keys_init_syzygy_list:
  "Keys (set (init_syzygy_list bs)) =
      map_component (\<lambda>k. k + length bs) ` Keys (set bs) \<union> (\<lambda>i. term_of_pair (0, i)) ` {0..<length bs}"
proof -
  have eq1: "(\<Union>b\<in>set bs. map_component (\<lambda>k. k + length bs) ` keys b) =
              (\<Union>i\<in>{0..<length bs}. map_component (\<lambda>k. k + length bs) ` keys (bs ! i))"
    by (fact UN_upt[symmetric])
  have eq2: "(\<lambda>i. term_of_pair (0, i)) ` {0..<length bs} = (\<Union>i\<in>{0..<length bs}. {term_of_pair (0, i)})"
    by auto
  show ?thesis
    by (simp add: init_syzygy_list_def set_map_idx Keys_def keys_lift_poly_syz image_UN
        eq1 eq2 UN_Un_distrib[symmetric])
qed

lemma pp_of_Keys_init_syzygy_list_subset:
  "pp_of_term ` Keys (set (init_syzygy_list bs)) \<subseteq> insert 0 (pp_of_term ` Keys (set bs))"
  by (auto simp add: Keys_init_syzygy_list image_Un rev_image_eqI term_simps)

lemma pp_of_Keys_init_syzygy_list_superset:
  "pp_of_term ` Keys (set bs) \<subseteq> pp_of_term ` Keys (set (init_syzygy_list bs))"
  by (simp add: Keys_init_syzygy_list image_Un term_simps image_image)

lemma pp_of_Keys_init_syzygy_list:
  assumes "bs \<noteq> []"
  shows "pp_of_term ` Keys (set (init_syzygy_list bs)) = insert 0 (pp_of_term ` Keys (set bs))"
proof
  show "insert 0 (pp_of_term ` Keys (set bs)) \<subseteq> pp_of_term ` Keys (set (init_syzygy_list bs))"
  proof (simp add: pp_of_Keys_init_syzygy_list_superset)
    from assms have "{0..<length bs} \<noteq> {}" by auto
    hence "Pair 0 ` {0..<length bs} \<noteq> {}" by blast
    then obtain x::'t where x: "x \<in> (\<lambda>i. term_of_pair (0, i)) ` {0..<length bs}" by blast
    hence "pp_of_term ` (\<lambda>i. term_of_pair (0, i)) ` {0..<length bs} = {pp_of_term x}"
      using image_subset_iff by (auto simp: term_simps)
    also from x have "... = {0}" using pp_of_term_of_pair by auto
    finally show "0 \<in> pp_of_term ` Keys (set (init_syzygy_list bs))"
      by (simp add: Keys_init_syzygy_list image_Un)
  qed
qed (fact pp_of_Keys_init_syzygy_list_subset)

lemma component_of_Keys_init_syzygy_list:
  "component_of_term ` Keys (set (init_syzygy_list bs)) =
            (+) (length bs) ` component_of_term ` Keys (set bs) \<union> {0..<length bs}"
  by (simp add: Keys_init_syzygy_list image_Un image_comp o_def ac_simps term_simps)

lemma proj_lift_poly_syz:
  assumes "j < n"
  shows "proj_poly j (lift_poly_syz n p i) = (1 when j = i)"
proof (simp add: when_def, intro conjI impI)
  assume "j = i"
  with assms have "\<not> n \<le> i" by simp
  show "proj_poly i (lift_poly_syz n p i) = 1"
    by (rule poly_mapping_eqI, simp add: lookup_proj_poly lookup_lift_poly_syz_alt \<open>\<not> n \<le> i\<close> lookup_one)
next
  assume "j \<noteq> i"
  from assms have "\<not> n \<le> j" by simp
  show "proj_poly j (lift_poly_syz n p i) = 0"
    by (rule poly_mapping_eqI, simp add: lookup_proj_poly lookup_lift_poly_syz_alt \<open>\<not> n \<le> j\<close> \<open>j \<noteq> i\<close>)
qed

subsubsection \<open>@{const proj_orig_basis}\<close>

lemma length_proj_orig_basis [simp]: "length (proj_orig_basis n bs) = length bs"
  by (simp add: proj_orig_basis_def)

lemma proj_orig_basis_nth:
  assumes "i < length bs"
  shows "(proj_orig_basis n bs) ! i = proj_poly_syz n (bs ! i)"
  by (simp add: proj_orig_basis_def assms)

lemma proj_orig_basis_init_syzygy_list [simp]:
  "proj_orig_basis (length bs) (init_syzygy_list bs) = bs"
  by (rule nth_equalityI, simp_all add: init_syzygy_list_nth proj_orig_basis_nth proj_poly_syz_lift_poly_syz)

lemma set_proj_orig_basis: "set (proj_orig_basis n bs) = proj_poly_syz n ` set bs"
  by (simp add: proj_orig_basis_def)

text \<open>The following lemma could be generalized from @{const proj_poly_syz} to arbitrary module homomorphisms,
  i.\,e. functions respecting \<open>0\<close>, addition and scalar multiplication.\<close>
lemma pmdl_proj_orig_basis':
  "pmdl (set (proj_orig_basis n bs)) = proj_poly_syz n ` pmdl (set bs)" (is "?A = ?B")
proof
  show "?A \<subseteq> ?B"
  proof
    fix p
    assume "p \<in> pmdl (set (proj_orig_basis n bs))"
    thus "p \<in> proj_poly_syz n ` pmdl (set bs)"
    proof (induct rule: pmdl_induct)
      case module_0
      have "0 = proj_poly_syz n 0" by simp
      also from pmdl.span_zero have "... \<in> proj_poly_syz n ` pmdl (set bs)" by (rule imageI)
      finally show ?case .
    next
      case (module_plus p b c t)
      from module_plus(2) obtain q where "q \<in> pmdl (set bs)" and p: "p = proj_poly_syz n q" ..
      from module_plus(3) obtain a where "a \<in> set bs" and b: "b = proj_poly_syz n a"
        unfolding set_proj_orig_basis ..
      have "p + monom_mult c t b = proj_poly_syz n (q + monom_mult c t a)"
        by (simp add: p b proj_poly_syz_monom_mult proj_poly_syz_plus)
      also have "... \<in> proj_poly_syz n ` pmdl (set bs)"
      proof (rule imageI, rule pmdl.span_add)
        show "monom_mult c t a \<in> pmdl (set bs)"
          by (rule pmdl_closed_monom_mult, rule pmdl.span_base, fact)
      qed fact
      finally show ?case .
    qed
  qed
next
  show "?B \<subseteq> ?A"
  proof
    fix p
    assume "p \<in> proj_poly_syz n ` pmdl (set bs)"
    then obtain q where "q \<in> pmdl (set bs)" and p: "p = proj_poly_syz n q" ..
    from this(1) show "p \<in> pmdl (set (proj_orig_basis n bs))" unfolding p
    proof (induct rule: pmdl_induct)
      case module_0
      have "proj_poly_syz n 0 = 0" by simp
      also have "... \<in> pmdl (set (proj_orig_basis n bs))" by (fact pmdl.span_zero)
      finally show ?case .
    next
      case (module_plus q b c t)
      have "proj_poly_syz n (q + monom_mult c t b) =
            proj_poly_syz n q + monom_mult c t (proj_poly_syz n b)"
        by (simp add: proj_poly_syz_plus proj_poly_syz_monom_mult)
      also have "... \<in> pmdl (set (proj_orig_basis n bs))"
      proof (rule pmdl.span_add)
        show "monom_mult c t (proj_poly_syz n b) \<in> pmdl (set (proj_orig_basis n bs))"
        proof (rule pmdl_closed_monom_mult, rule pmdl.span_base)
          show "proj_poly_syz n b \<in> set (proj_orig_basis n bs)"
            by (simp add: set_proj_orig_basis, rule imageI, fact)
        qed
      qed fact
      finally show ?case .
    qed
  qed
qed

subsubsection \<open>@{const filter_syzygy_basis}\<close>

lemma filter_syzygy_basis_alt: "filter_syzygy_basis n bs = [b\<leftarrow>bs. proj_poly_syz n b = 0]"
  by (simp add: filter_syzygy_basis_def proj_poly_syz_eq_zero_iff)

lemma set_filter_syzygy_basis:
  "set (filter_syzygy_basis n bs) = {b\<in>set bs. proj_poly_syz n b = 0}"
  by (simp add: filter_syzygy_basis_alt)

subsubsection \<open>@{const syzygy_module_list}\<close>

lemma syzygy_module_listI:
  assumes "s' \<in> pmdl.syzygy_module (set bs)" and "s = atomize_poly (idx_pm_of_pm bs s')"
  shows "s \<in> syzygy_module_list bs"
  unfolding assms(2) syzygy_module_list_def by (intro imageI, fact assms(1))

lemma syzygy_module_listE:
  assumes "s \<in> syzygy_module_list bs"
  obtains s' where "s' \<in> pmdl.syzygy_module (set bs)" and "s = atomize_poly (idx_pm_of_pm bs s')"
  using assms unfolding syzygy_module_list_def by (elim imageE, simp)

lemma monom_mult_atomize:
  "monom_mult c t (atomize_poly p) = atomize_poly (MPoly_Type_Class.punit.monom_mult (monomial c t) 0 p)"
  by (rule poly_mapping_eqI_proj, simp add: proj_monom_mult proj_atomize_poly
      MPoly_Type_Class.punit.lookup_monom_mult times_monomial_left)

lemma punit_monom_mult_monomial_idx_pm_of_pm:
  "MPoly_Type_Class.punit.monom_mult (monomial c t) (0::nat) (idx_pm_of_pm bs s) =
    idx_pm_of_pm bs (MPoly_Type_Class.punit.monom_mult (monomial c t) (0::'t \<Rightarrow>\<^sub>0 'b::ring_1) s)"
  by (rule poly_mapping_eqI, simp add: MPoly_Type_Class.punit.lookup_monom_mult lookup_idx_pm_of_pm when_def)

lemma syzygy_module_list_closed_monom_mult:
  assumes "s \<in> syzygy_module_list bs"
  shows "monom_mult c t s \<in> syzygy_module_list bs"
proof -
  from assms obtain s' where s': "s' \<in> pmdl.syzygy_module (set bs)"
    and s: "s = atomize_poly (idx_pm_of_pm bs s')" by (rule syzygy_module_listE)
  show ?thesis unfolding s
  proof (rule syzygy_module_listI)
    from s' show "(monomial c t) \<cdot> s' \<in> pmdl.syzygy_module (set bs)"
      by (rule syzygy_module_closed_map_scale)
  next
    show "monom_mult c t (atomize_poly (idx_pm_of_pm bs s')) =
          atomize_poly (idx_pm_of_pm bs ((monomial c t) \<cdot> s'))"
      by (simp add: monom_mult_atomize punit_monom_mult_monomial_idx_pm_of_pm
            MPoly_Type_Class.punit.map_scale_eq_monom_mult)
  qed
qed

lemma pmdl_syzygy_module_list [simp]: "pmdl (syzygy_module_list bs) = syzygy_module_list bs"
proof (rule pmdl_idI)
  show "0 \<in> syzygy_module_list bs"
    by (rule syzygy_module_listI, fact pmdl.zero_in_syzygy_module, simp add: atomize_zero)
next
  fix s1 s2
  assume "s1 \<in> syzygy_module_list bs"
  then obtain s1' where s1': "s1' \<in> pmdl.syzygy_module (set bs)"
    and s1: "s1 = atomize_poly (idx_pm_of_pm bs s1')" by (rule syzygy_module_listE)
  assume "s2 \<in> syzygy_module_list bs"
  then obtain s2' where s2': "s2' \<in> pmdl.syzygy_module (set bs)"
    and s2: "s2 = atomize_poly (idx_pm_of_pm bs s2')" by (rule syzygy_module_listE)
  show "s1 + s2 \<in> syzygy_module_list bs"
  proof (rule syzygy_module_listI)
    from s1' s2' show "s1' + s2' \<in> pmdl.syzygy_module (set bs)"
      by (rule pmdl.syzygy_module_closed_plus)
  next
    show "s1 + s2 = atomize_poly (idx_pm_of_pm bs (s1' + s2'))"
      by (simp add: idx_pm_of_pm_plus atomize_plus s1 s2)
  qed
qed (fact syzygy_module_list_closed_monom_mult)

text \<open>The following lemma also holds without the distinctness constraint on \<open>bs\<close>, but then the
  proof becomes more difficult.\<close>
lemma syzygy_module_listI':
  assumes "distinct bs" and "sum_list (map2 mult_scalar (cofactor_list_syz (length bs) s) bs) = 0"
    and "component_of_term ` keys s \<subseteq> {0..<length bs}"
  shows "s \<in> syzygy_module_list bs"
proof (rule syzygy_module_listI)
  show "pm_of_idx_pm bs (vectorize_poly s) \<in> pmdl.syzygy_module (set bs)"
  proof (rule pmdl.syzygy_moduleI, rule pmdl.representsI)
    have "(\<Sum>v\<in>keys (pm_of_idx_pm bs (vectorize_poly s)).
              mult_scalar (lookup (pm_of_idx_pm bs (vectorize_poly s)) v) v) =
          (\<Sum>b\<in>set bs. mult_scalar (lookup (pm_of_idx_pm bs (vectorize_poly s)) b) b)"
      by (rule sum.mono_neutral_left, fact finite_set, fact keys_pm_of_idx_pm_subset, simp add: in_keys_iff)
    also have "... = sum_list (map (\<lambda>b. mult_scalar (lookup (pm_of_idx_pm bs (vectorize_poly s)) b) b) bs)"
      by (simp only: sum_code distinct_remdups_id[OF assms(1)])
    also have "... = sum_list (map2 mult_scalar (cofactor_list_syz (length bs) s) bs)"
    proof (rule arg_cong[of _ _ sum_list], rule nth_equalityI, simp_all)
      fix i
      assume "i < length bs"
      with assms(1) have "lookup (pm_of_idx_pm bs (vectorize_poly s)) (bs ! i) =
                          cofactor_list_syz (length bs) s ! i"
        by (simp add: lookup_pm_of_idx_pm_distinct[OF assms(1)] cofactor_list_syz_nth lookup_vectorize_poly)
      thus "mult_scalar (lookup (pm_of_idx_pm bs (vectorize_poly s)) (bs ! i)) (bs ! i) =
            mult_scalar (cofactor_list_syz (length bs) s ! i) (bs ! i)" by (simp only:)
    qed
    also have "... = 0" by (fact assms(2))
    finally show "pmdl.rep (pm_of_idx_pm bs (vectorize_poly s)) = 0" by (simp only: pmdl.rep_def)
  qed (fact keys_pm_of_idx_pm_subset)
next
  from assms(3) have "keys (vectorize_poly s) \<subseteq> {0..<length bs}" by (simp add: keys_vectorize_poly)
  with assms(1) have "idx_pm_of_pm bs (pm_of_idx_pm bs (vectorize_poly s)) = vectorize_poly s"
    by (rule idx_pm_of_pm_of_idx_pm)
  thus "s = atomize_poly (idx_pm_of_pm bs (pm_of_idx_pm bs (vectorize_poly s)))"
    by (simp add: atomize_vectorize_poly)
qed

lemma component_of_syzygy_module_list:
  assumes "s \<in> syzygy_module_list bs"
  shows "component_of_term ` keys s \<subseteq> {0..<length bs}"
proof -
  from assms obtain s' where s: "s = atomize_poly (idx_pm_of_pm bs s')"
    by (rule syzygy_module_listE)
  have "component_of_term ` keys s \<subseteq> (\<Union>x\<in>{0..<length bs}. {x})"
    by (simp only: s keys_atomize_poly image_UN, rule UN_mono, fact keys_idx_pm_of_pm_subset, auto simp: term_simps)
  also have "... = {0..<length bs}" by simp
  finally show ?thesis .
qed

lemma map2_mult_scalar_proj_poly_syz:
  "map2 mult_scalar xs (map (proj_poly_syz n) ys) =
    map (proj_poly_syz n \<circ> (\<lambda>(x, y). mult_scalar x y)) (zip xs ys)"
  by (rule nth_equalityI, simp_all add: proj_poly_syz_mult_scalar)

lemma map2_times_proj:
  "map2 (*) xs (map (proj_poly k) ys) = map (proj_poly k \<circ> (\<lambda>(x, y). x \<odot> y)) (zip xs ys)"
  by (rule nth_equalityI, simp_all add: proj_mult_scalar)

text \<open>Probably the following lemma also holds without the distinctness constraint on \<open>bs\<close>.\<close>
lemma syzygy_module_list_subset:
  assumes "distinct bs"
  shows "syzygy_module_list bs \<subseteq> pmdl (set (init_syzygy_list bs))"
proof
  let ?as = "init_syzygy_list bs"
  fix s
  assume "s \<in> syzygy_module_list bs"
  then obtain s' where s': "s' \<in> pmdl.syzygy_module (set bs)"
    and s: "s = atomize_poly (idx_pm_of_pm bs s')" by (rule syzygy_module_listE)
  from s' have "pmdl.represents (set bs) s' 0" by (rule pmdl.syzygy_moduleD)
  hence "keys s' \<subseteq> set bs" and 1: "0 = pmdl.rep s'"
    by (rule pmdl.representsD1, rule pmdl.representsD2)
  have "s = sum_list (map2 mult_scalar (cofactor_list_syz (length bs) s) (init_syzygy_list bs))"
    (is "_ = ?r")
  proof (rule poly_mapping_eqI_proj_syz)
    have "proj_poly_syz (length bs) ?r =
            sum_list (map2 mult_scalar (cofactor_list_syz (length bs) s)
                                            (map (proj_poly_syz (length bs)) (init_syzygy_list bs)))"
      by (simp add: proj_poly_syz_sum_list map2_mult_scalar_proj_poly_syz)
    also have "... = sum_list (map2 mult_scalar (cofactor_list_syz (length bs) s) bs)"
      by (simp add: proj_orig_basis_def[symmetric])
    also have "... = sum_list (map (\<lambda>b. mult_scalar (lookup s' b) b) bs)"
    proof (rule arg_cong[of _ _ sum_list], rule nth_equalityI, simp_all)
      fix i
      assume "i < length bs"
      with assms(1) have "lookup s' (bs ! i) = cofactor_list_syz (length bs) s ! i"
        by (simp add: s cofactor_list_syz_nth lookup_idx_pm_of_pm proj_atomize_poly)
      thus "mult_scalar (cofactor_list_syz (length bs) s ! i) (bs ! i) =
            mult_scalar (lookup s' (bs ! i)) (bs ! i)" by (simp only:)
    qed
    also have "... = (\<Sum>b\<in>set bs. mult_scalar (lookup s' b) b)"
      by (simp only: sum_code distinct_remdups_id[OF assms])
    also have "... = (\<Sum>v\<in>keys s'. mult_scalar (lookup s' v) v)"
      by (rule sum.mono_neutral_right, fact finite_set, fact, simp add: in_keys_iff)
    also have "... = 0" by (simp add: 1 pmdl.rep_def)
    finally have eq: "proj_poly_syz (length bs) ?r = 0" .
    show "proj_poly_syz (length bs) s = proj_poly_syz (length bs) ?r"
      by (simp add: eq \<open>s \<in> syzygy_module_list bs\<close> proj_poly_syz_eq_zero_iff component_of_syzygy_module_list)
  next
    fix k
    assume "k < length bs"
    have "proj_poly k s = map2 (*) (cofactor_list_syz (length bs) s) (map (proj_poly k)
                                            (init_syzygy_list bs)) ! k"
      by (simp add: \<open>k < length bs\<close> init_syzygy_list_nth proj_lift_poly_syz cofactor_list_syz_nth)
    also have "... = sum_list (map2 (*) (cofactor_list_syz (length bs) s)
                                            (map (proj_poly k) (init_syzygy_list bs)))"
      by (rule sum_list_eq_nthI[symmetric],
          simp_all add: \<open>k < length bs\<close> init_syzygy_list_nth proj_lift_poly_syz)
    also have "... = proj_poly k ?r"
      by (simp add: proj_sum_list map2_times_proj)
    finally show "proj_poly k s = proj_poly k ?r" .
  qed
  also have "\<dots> \<in> pmdl (set (init_syzygy_list bs))" by (fact pmdl.span_listI)
  finally show "s \<in> pmdl (set (init_syzygy_list bs))" .
qed

subsubsection \<open>Cofactors\<close>

lemma map2_mult_scalar_plus:
  "map2 (\<odot>) (map2 (+) xs ys) zs = map2 (+) (map2 (\<odot>) xs zs) (map2 (\<odot>) ys zs)"
  by (rule nth_equalityI, simp_all add: mult_scalar_distrib_right)

lemma syz_cofactors:
  assumes "p \<in> pmdl (set (init_syzygy_list bs))"
  shows "proj_poly_syz (length bs) p = sum_list (map2 mult_scalar (cofactor_list_syz (length bs) p) bs)"
  using assms
proof (induct rule: pmdl_induct)
  case module_0
  show ?case by (simp, rule sum_list_zeroI', simp)
next
  case (module_plus p b c t)
  from this(3) obtain i where i: "i < length bs" and b: "b = (init_syzygy_list bs) ! i"
    unfolding length_init_syzygy_list[symmetric, of bs] by (metis in_set_conv_nth)
  have "proj_poly_syz (length bs) (p + monom_mult c t b) =
        proj_poly_syz (length bs) p + monom_mult c t (bs ! i)"
    by (simp only: proj_poly_syz_plus proj_poly_syz_monom_mult b init_syzygy_list_nth[OF i]
        proj_poly_syz_lift_poly_syz[OF i])
  also have "... = sum_list (map2 mult_scalar (cofactor_list_syz (length bs) p) bs) +
                    monom_mult c t (bs ! i)" by (simp only: module_plus(2))
  also have "... = sum_list (map2 mult_scalar (cofactor_list_syz (length bs) (p + monom_mult c t b)) bs)"
  proof (simp add: cofactor_list_syz_plus map2_mult_scalar_plus sum_list_map2_plus)
    have proj_b: "j < length bs \<Longrightarrow> proj_poly j b = (1 when j = i)" for j
      by (simp add: b init_syzygy_list_nth i proj_lift_poly_syz)
    have eq: "j < length bs \<Longrightarrow> (map2 mult_scalar (cofactor_list_syz (length bs) (monom_mult c t b)) bs) ! j =
              (monom_mult c t (bs ! i) when j = i)" for j
      by (simp add: cofactor_list_syz_nth proj_monom_mult proj_b mult_scalar_monom_mult when_def)
    have "sum_list (map2 mult_scalar (cofactor_list_syz (length bs) (monom_mult c t b)) bs) =
          (map2 mult_scalar (cofactor_list_syz (length bs) (monom_mult c t b)) bs) ! i"
      by (rule sum_list_eq_nthI, simp add: i, simp add: eq del: nth_zip nth_map)
    also have "... = mult_scalar (punit.monom_mult c t (proj_poly i b)) (bs ! i)"
      by (simp add: i cofactor_list_syz_nth proj_monom_mult)
    also have "... = monom_mult c t (bs ! i)"
      by (simp add: proj_b i mult_scalar_monomial times_monomial_left[symmetric])
    finally show "monom_mult c t (bs ! i) =
          sum_list (map2 mult_scalar (cofactor_list_syz (length bs) (monom_mult c t b)) bs)"
      by (simp only:)
  qed
  finally show ?case .
qed

subsubsection \<open>Modules\<close>

lemma pmdl_proj_orig_basis:
  assumes "pmdl (set gs) = pmdl (set (init_syzygy_list bs))"
  shows "pmdl (set (proj_orig_basis (length bs) gs)) = pmdl (set bs)"
  by (simp add: pmdl_proj_orig_basis' assms,
      simp only: pmdl_proj_orig_basis'[symmetric] proj_orig_basis_init_syzygy_list)

lemma pmdl_filter_syzygy_basis_subset:
  assumes "distinct bs" and "pmdl (set gs) = pmdl (set (init_syzygy_list bs))"
  shows "pmdl (set (filter_syzygy_basis (length bs) gs)) \<subseteq> pmdl (syzygy_module_list bs)"
proof (rule pmdl.span_mono, rule)
  fix s
  assume "s \<in> set (filter_syzygy_basis (length bs) gs)"
  hence "s \<in> set gs" and eq: "proj_poly_syz (length bs) s = 0"
    by (simp_all add: set_filter_syzygy_basis)
  from this(1) have "s \<in> pmdl (set gs)" by (rule pmdl.span_base)
  hence "s \<in> pmdl (set (init_syzygy_list bs))" by (simp only: assms)
  hence "proj_poly_syz (length bs) s =
          sum_list (map2 mult_scalar (cofactor_list_syz (length bs) s) bs)"
    by (rule syz_cofactors)
  hence "distinct bs" and "sum_list (map2 mult_scalar (cofactor_list_syz (length bs) s) bs) = 0"
    by (simp_all only: eq assms(1))
  moreover from eq have "component_of_term ` keys s \<subseteq> {0..<length bs}" by (simp only: proj_poly_syz_eq_zero_iff)
  ultimately show "s \<in> syzygy_module_list bs" by (rule syzygy_module_listI')
qed

lemma ex_filter_syzygy_basis_adds_lt:
  assumes "is_pot_ord" and "distinct bs" and "is_Groebner_basis (set gs)"
    and "pmdl (set gs) = pmdl (set (init_syzygy_list bs))"
    and "f \<in> pmdl (syzygy_module_list bs)" and "f \<noteq> 0"
  shows "\<exists>g\<in>set (filter_syzygy_basis (length bs) gs). g \<noteq> 0 \<and> lt g adds\<^sub>t lt f"
proof -
  from assms(5) have "f \<in> syzygy_module_list bs" by simp
  also from assms(2) have "... \<subseteq> pmdl (set (init_syzygy_list bs))"
    by (rule syzygy_module_list_subset)
  also have "... = pmdl (set gs)" by (simp only: assms(4))
  finally have "f \<in> pmdl (set gs)" .
  with assms(3, 6) obtain g where "g \<in> set gs" and "g \<noteq> 0"
    and adds: "lt g adds\<^sub>t lt f" unfolding GB_alt_3_finite[OF finite_set] by blast
  show ?thesis
  proof (intro bexI conjI)
    show "g \<in> set (filter_syzygy_basis (length bs) gs)"
    proof (simp add: set_filter_syzygy_basis, rule)
      show "proj_poly_syz (length bs) g = 0"
      proof (rule ccontr)
        assume "proj_poly_syz (length bs) g \<noteq> 0"
        with assms(1) have "length bs \<le> component_of_term (lt g)" by (rule component_of_lt_ge)
        also from adds have "... = component_of_term (lt f)" by (simp add: adds_term_def)
        also have "... < length bs"
        proof -
          from \<open>f \<noteq> 0\<close> have "lt f \<in> keys f" by (rule lt_in_keys)
          hence "component_of_term (lt f) \<in> component_of_term ` keys f" by (rule imageI)
          also from \<open>f \<in> syzygy_module_list bs\<close> have "... \<subseteq> {0..<length bs}"
            by (rule component_of_syzygy_module_list)
          finally show "component_of_term (lt f) < length bs" by simp
        qed
        finally show False ..
      qed
    qed fact
  qed fact+
qed

lemma pmdl_filter_syzygy_basis:
  fixes bs::"('t \<Rightarrow>\<^sub>0 'b::field) list"
  assumes "is_pot_ord" and "distinct bs" and "is_Groebner_basis (set gs)" and
    "pmdl (set gs) = pmdl (set (init_syzygy_list bs))"
  shows "pmdl (set (filter_syzygy_basis (length bs) gs)) = syzygy_module_list bs"
proof -
  from finite_set
  have "pmdl (set (filter_syzygy_basis (length bs) gs)) = pmdl (syzygy_module_list bs)"
  proof (rule pmdl_eqI_adds_lt_finite)
    from assms(2, 4)
    show "pmdl (set (filter_syzygy_basis (length bs) gs)) \<subseteq> pmdl (syzygy_module_list bs)"
      by (rule pmdl_filter_syzygy_basis_subset)
  next
    fix f
    assume "f \<in> pmdl (syzygy_module_list bs)" and "f \<noteq> 0"
    with assms show "\<exists>g\<in>set (filter_syzygy_basis (length bs) gs). g \<noteq> 0 \<and> lt g adds\<^sub>t lt f"
      by (rule ex_filter_syzygy_basis_adds_lt)
  qed
  thus ?thesis by simp
qed

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

lemma proj_orig_basis_isGB:
  assumes "is_pot_ord" and "is_Groebner_basis (set gs)" and "pmdl (set gs) = pmdl (set (init_syzygy_list bs))"
  shows "is_Groebner_basis (set (proj_orig_basis (length bs) gs))"
  unfolding GB_alt_3_finite[OF finite_set]
proof (intro ballI impI)
  fix f
  assume "f \<in> pmdl (set (proj_orig_basis (length bs) gs))"
  also have "... = proj_poly_syz (length bs) ` pmdl (set gs)" by (fact pmdl_proj_orig_basis')
  finally obtain h where "h \<in> pmdl (set gs)" and f: "f = proj_poly_syz (length bs) h" ..
  assume "f \<noteq> 0"
  with assms(1) have ltf: "lt f = map_component (\<lambda>k. k - length bs) (lt h)" unfolding f
    by (rule lt_proj_poly_syz)
  from \<open>f \<noteq> 0\<close> have "h \<noteq> 0" by (auto simp add: f)
  with assms(2) \<open>h \<in> pmdl (set gs)\<close> obtain g where "g \<in> set gs" and "g \<noteq> 0"
    and "lt g adds\<^sub>t lt h" unfolding GB_alt_3_finite[OF finite_set] by blast
  from this(3) have 1: "component_of_term (lt g) = component_of_term (lt h)"
    and 2: "pp_of_term (lt g) adds pp_of_term (lt h)" by (simp_all add: adds_term_def)
  let ?g = "proj_poly_syz (length bs) g"
  have "?g \<noteq> 0"
  proof (simp add: proj_poly_syz_eq_zero_iff, rule)
    assume "component_of_term ` keys g \<subseteq> {0..<length bs}"
    from assms(1) \<open>f \<noteq> 0\<close> have "length bs \<le> component_of_term (lt h)"
      unfolding f by (rule component_of_lt_ge)
    hence "component_of_term (lt g) \<notin> {0..<length bs}" by (simp add: 1)
    moreover from \<open>g \<noteq> 0\<close> have "lt g \<in> keys g" by (rule lt_in_keys)
    ultimately show False using \<open>component_of_term ` keys g \<subseteq> {0..<length bs}\<close> by blast
  qed
  with assms(1) have ltg: "lt ?g = map_component (\<lambda>k. k - length bs) (lt g)" by (rule lt_proj_poly_syz)
  show "\<exists>g\<in>set (proj_orig_basis (length bs) gs). g \<noteq> 0 \<and> lt g adds\<^sub>t lt f"
  proof (intro bexI conjI)
    show "lt ?g adds\<^sub>t lt f" by (simp add: ltf ltg adds_term_def 1 2 term_simps)
  next
    show "?g \<in> set (proj_orig_basis (length bs) gs)"
      unfolding set_proj_orig_basis using \<open>g \<in> set gs\<close> by (rule imageI)
  qed fact
qed

lemma filter_syzygy_basis_isGB:
  assumes "is_pot_ord" and "distinct bs" and "is_Groebner_basis (set gs)"
    and "pmdl (set gs) = pmdl (set (init_syzygy_list bs))"
  shows "is_Groebner_basis (set (filter_syzygy_basis (length bs) gs))"
  unfolding GB_alt_3_finite[OF finite_set]
proof (intro ballI impI)
  fix f::"'t \<Rightarrow>\<^sub>0 'b"
  assume "f \<noteq> 0"
  assume "f \<in> pmdl (set (filter_syzygy_basis (length bs) gs))"
  also from assms have "... = syzygy_module_list bs" by (rule pmdl_filter_syzygy_basis)
  finally have "f \<in> pmdl (syzygy_module_list bs)" by simp
  from assms this \<open>f \<noteq> 0\<close>
  show "\<exists>g\<in>set (filter_syzygy_basis (length bs) gs). g \<noteq> 0 \<and> lt g adds\<^sub>t lt f"
    by (rule ex_filter_syzygy_basis_adds_lt)
qed

end (* gd_inf_term *)

end (* theory *)


(*<*)
theory Documents imports Main begin
(*>*)

section {* Concrete Syntax \label{sec:concrete-syntax} *}

text {*
  The core concept of Isabelle's framework for concrete syntax is that
  of \bfindex{mixfix annotations}.  Associated with any kind of
  constant declaration, mixfixes affect both the grammar productions
  for the parser and output templates for the pretty printer.

  In full generality, parser and pretty printer configuration is a
  subtle affair~@{cite "isabelle-isar-ref"}.  Your syntax specifications need
  to interact properly with the existing setup of Isabelle/Pure and
  Isabelle/HOL\@.  To avoid creating ambiguities with existing
  elements, it is particularly important to give new syntactic
  constructs the right precedence.

  Below we introduce a few simple syntax declaration
  forms that already cover many common situations fairly well.
*}

subsection {* Infix Annotations *}

text {*
  Syntax annotations may be included wherever constants are declared,
  such as \isacommand{definition} and \isacommand{primrec} --- and also
  \isacommand{datatype}, which declares constructor operations.
  Type-constructors may be annotated as well, although this is less
  frequently encountered in practice (the infix type @{text "\<times>"} comes
  to mind).

  Infix declarations\index{infix annotations} provide a useful special
  case of mixfixes.  The following example of the exclusive-or
  operation on boolean values illustrates typical infix declarations.
*}

definition xor :: "bool \<Rightarrow> bool \<Rightarrow> bool"    (infixl "[+]" 60)
where "A [+] B \<equiv> (A \<and> \<not> B) \<or> (\<not> A \<and> B)"

text {*
  \noindent Now @{text "xor A B"} and @{text "A [+] B"} refer to the
  same expression internally.  Any curried function with at least two
  arguments may be given infix syntax.  For partial applications with
  fewer than two operands, there is a notation using the prefix~@{text
  op}.  For instance, @{text xor} without arguments is represented as
  @{text "op [+]"}; together with ordinary function application, this
  turns @{text "xor A"} into @{text "op [+] A"}.

  The keyword \isakeyword{infixl} seen above specifies an
  infix operator that is nested to the \emph{left}: in iterated
  applications the more complex expression appears on the left-hand
  side, and @{term "A [+] B [+] C"} stands for @{text "(A [+] B) [+]
  C"}.  Similarly, \isakeyword{infixr} means nesting to the
  \emph{right}, reading @{term "A [+] B [+] C"} as @{text "A [+] (B
  [+] C)"}.  A \emph{non-oriented} declaration via \isakeyword{infix}
  would render @{term "A [+] B [+] C"} illegal, but demand explicit
  parentheses to indicate the intended grouping.

  The string @{text [source] "[+]"} in our annotation refers to the
  concrete syntax to represent the operator (a literal token), while
  the number @{text 60} determines the precedence of the construct:
  the syntactic priorities of the arguments and result.  Isabelle/HOL
  already uses up many popular combinations of ASCII symbols for its
  own use, including both @{text "+"} and @{text "++"}.  Longer
  character combinations are more likely to be still available for
  user extensions, such as our~@{text "[+]"}.

  Operator precedences have a range of 0--1000.  Very low or high
  priorities are reserved for the meta-logic.  HOL syntax mainly uses
  the range of 10--100: the equality infix @{text "="} is centered at
  50; logical connectives (like @{text "\<or>"} and @{text "\<and>"}) are
  below 50; algebraic ones (like @{text "+"} and @{text "*"}) are
  above 50.  User syntax should strive to coexist with common HOL
  forms, or use the mostly unused range 100--900.
*}

subsection {* Mathematical Symbols \label{sec:syntax-symbols} *}

text {*
  Concrete syntax based on ASCII characters has inherent limitations.
  Mathematical notation demands a larger repertoire of glyphs.
  Several standards of extended character sets have been proposed over
  decades, but none has become universally available so far.  Isabelle
  has its own notion of \bfindex{symbols} as the smallest entities of
  source text, without referring to internal encodings.  There are
  three kinds of such ``generalized characters'':

  \begin{enumerate}

  \item 7-bit ASCII characters

  \item named symbols: \verb,\,\verb,<,$ident$\verb,>,

  \item named control symbols: \verb,\,\verb,<^,$ident$\verb,>,

  \end{enumerate}

  Here $ident$ is any sequence of letters.
  This results in an infinite store of symbols, whose
  interpretation is left to further front-end tools.  For example, the
  Isabelle document processor (see \S\ref{sec:document-preparation})
  display the \verb,\,\verb,<forall>, symbol as~@{text \<forall>}.

  A list of standard Isabelle symbols is given in
  @{cite "isabelle-isar-ref"}.  You may introduce your own
  interpretation of further symbols by configuring the appropriate
  front-end tool accordingly, e.g.\ by defining certain {\LaTeX}
  macros (see also \S\ref{sec:doc-prep-symbols}).  There are also a
  few predefined control symbols, such as \verb,\,\verb,<^sub>, and
  \verb,\,\verb,<^sup>, for sub- and superscript of the subsequent
  printable symbol, respectively.  For example, \<^verbatim>\<open>A\<^sup>\<star>\<close>, is
  output as @{text "A\<^sup>\<star>"}.

  A number of symbols are considered letters by the Isabelle lexer and
  can be used as part of identifiers. These are the greek letters
  @{text "\<alpha>"} (\verb+\+\verb+<alpha>+), @{text "\<beta>"}
  (\verb+\+\verb+<beta>+), etc. (excluding @{text "\<lambda>"}),
  special letters like @{text "\<A>"} (\verb+\+\verb+<A>+) and @{text
  "\<AA>"} (\verb+\+\verb+<AA>+).  Moreover the control symbol
  \verb+\+\verb+<^sub>+ may be used to subscript a single letter or digit
  in the trailing part of an identifier. This means that the input

  \medskip
  {\small\noindent \<^verbatim>\<open>\<forall>\<alpha>\<^sub>1. \<alpha>\<^sub>1 = \<Pi>\<^sub>\<A>\<close>}

  \medskip
  \noindent is recognized as the term @{term "\<forall>\<alpha>\<^sub>1. \<alpha>\<^sub>1 = \<Pi>\<^sub>\<A>"}
  by Isabelle.

  Replacing our previous definition of @{text xor} by the
  following specifies an Isabelle symbol for the new operator:
*}

(*<*)
hide_const xor
setup {* Sign.add_path "version1" *}
(*>*)
definition xor :: "bool \<Rightarrow> bool \<Rightarrow> bool"    (infixl "\<oplus>" 60)
where "A \<oplus> B \<equiv> (A \<and> \<not> B) \<or> (\<not> A \<and> B)"
(*<*)
setup {* Sign.local_path *}
(*>*)

text {*
  It is possible to provide alternative syntax forms
  through the \bfindex{print mode} concept~@{cite "isabelle-isar-ref"}.  By
  convention, the mode of ``$xsymbols$'' is enabled whenever
  Proof~General's X-Symbol mode or {\LaTeX} output is active.  Now
  consider the following hybrid declaration of @{text xor}:
*}

(*<*)
hide_const xor
setup {* Sign.add_path "version2" *}
(*>*)
definition xor :: "bool \<Rightarrow> bool \<Rightarrow> bool"    (infixl "[+]\<ignore>" 60)
where "A [+]\<ignore> B \<equiv> (A \<and> \<not> B) \<or> (\<not> A \<and> B)"

notation (xsymbols) xor (infixl "\<oplus>\<ignore>" 60)
(*<*)
setup {* Sign.local_path *}
(*>*)

text {*\noindent
The \commdx{notation} command associates a mixfix
annotation with a known constant.  The print mode specification,
here @{text "(xsymbols)"}, is optional.

We may now write @{text "A [+] B"} or @{text "A \<oplus> B"} in input, while
output uses the nicer syntax of $xsymbols$ whenever that print mode is
active.  Such an arrangement is particularly useful for interactive
development, where users may type ASCII text and see mathematical
symbols displayed during proofs.  *}

subsection {* Prefix Annotations *}

text {*
  Prefix syntax annotations\index{prefix annotation} are another form
  of mixfixes @{cite "isabelle-isar-ref"}, without any template arguments or
  priorities --- just some literal syntax.  The following example
  associates common symbols with the constructors of a datatype.
*}

datatype currency =
    Euro nat    ("\<euro>")
  | Pounds nat  ("\<pounds>")
  | Yen nat     ("\<yen>")
  | Dollar nat  ("$")

text {*
  \noindent Here the mixfix annotations on the rightmost column happen
  to consist of a single Isabelle symbol each: \verb,\,\verb,<euro>,,
  \verb,\,\verb,<pounds>,, \verb,\,\verb,<yen>,, and \verb,$,.  Recall
  that a constructor like @{text Euro} actually is a function @{typ
  "nat \<Rightarrow> currency"}.  The expression @{text "Euro 10"} will be
  printed as @{term "\<euro> 10"}; only the head of the application is
  subject to our concrete syntax.  This rather simple form already
  achieves conformance with notational standards of the European
  Commission.

  Prefix syntax works the same way for other commands that introduce new constants, e.g. \isakeyword{primrec}.
*}

subsection {* Abbreviations \label{sec:abbreviations} *}

text{* Mixfix syntax annotations merely decorate particular constant
application forms with concrete syntax, for instance replacing
@{text "xor A B"} by @{text "A \<oplus> B"}.  Occasionally, the relationship
between some piece of notation and its internal form is more
complicated.  Here we need \emph{abbreviations}.

Command \commdx{abbreviation} introduces an uninterpreted notational
constant as an abbreviation for a complex term. Abbreviations are
unfolded upon parsing and re-introduced upon printing. This provides a
simple mechanism for syntactic macros.

A typical use of abbreviations is to introduce relational notation for
membership in a set of pairs, replacing @{text "(x, y) \<in> sim"} by
@{text "x \<approx> y"}. We assume that a constant @{text sim } of type
@{typ"('a \<times> 'a) set"} has been introduced at this point. *}
(*<*)consts sim :: "('a \<times> 'a) set"(*>*)
abbreviation sim2 :: "'a \<Rightarrow> 'a \<Rightarrow> bool"   (infix "\<approx>" 50)
where "x \<approx> y  \<equiv>  (x, y) \<in> sim"

text {* \noindent The given meta-equality is used as a rewrite rule
after parsing (replacing \mbox{@{prop"x \<approx> y"}} by @{text"(x,y) \<in>
sim"}) and before printing (turning @{text"(x,y) \<in> sim"} back into
\mbox{@{prop"x \<approx> y"}}). The name of the dummy constant @{text "sim2"}
does not matter, as long as it is unique.

Another common application of abbreviations is to
provide variant versions of fundamental relational expressions, such
as @{text \<noteq>} for negated equalities.  The following declaration
stems from Isabelle/HOL itself:
*}

abbreviation not_equal :: "'a \<Rightarrow> 'a \<Rightarrow> bool"    (infixl "~=\<ignore>" 50)
where "x ~=\<ignore> y  \<equiv>  \<not> (x = y)"

notation (xsymbols) not_equal (infix "\<noteq>\<ignore>" 50)

text {* \noindent The notation @{text \<noteq>} is introduced separately to restrict it
to the \emph{xsymbols} mode.

Abbreviations are appropriate when the defined concept is a
simple variation on an existing one.  But because of the automatic
folding and unfolding of abbreviations, they do not scale up well to
large hierarchies of concepts. Abbreviations do not replace
definitions.

Abbreviations are a simplified form of the general concept of
\emph{syntax translations}; even heavier transformations may be
written in ML @{cite "isabelle-isar-ref"}.
*}

section {* Document Preparation \label{sec:document-preparation} *}

text {*
  Isabelle/Isar is centered around the concept of \bfindex{formal
  proof documents}\index{documents|bold}.  The outcome of a formal
  development effort is meant to be a human-readable record, presented
  as browsable PDF file or printed on paper.  The overall document
  structure follows traditional mathematical articles, with sections,
  intermediate explanations, definitions, theorems and proofs.

  \medskip The Isabelle document preparation system essentially acts
  as a front-end to {\LaTeX}.  After checking specifications and
  proofs formally, the theory sources are turned into typesetting
  instructions in a schematic manner.  This lets you write authentic
  reports on theory developments with little effort: many technical
  consistency checks are handled by the system.

  Here is an example to illustrate the idea of Isabelle document
  preparation.
*}

text_raw {* \begin{quotation} *}

text {*
  The following datatype definition of @{text "'a bintree"} models
  binary trees with nodes being decorated by elements of type @{typ
  'a}.
*}

datatype 'a bintree =
     Leaf | Branch 'a  "'a bintree"  "'a bintree"

text {*
  \noindent The datatype induction rule generated here is of the form
  @{thm [indent = 1, display] bintree.induct [no_vars]}
*}

text_raw {* \end{quotation} *}

text {*
  \noindent The above document output has been produced as follows:

  \begin{ttbox}
  text {\ttlbrace}*
    The following datatype definition of {\at}{\ttlbrace}text "'a bintree"{\ttrbrace}
    models binary trees with nodes being decorated by elements
    of type {\at}{\ttlbrace}typ 'a{\ttrbrace}.
  *{\ttrbrace}

  datatype 'a bintree =
    Leaf | Branch 'a  "'a bintree"  "'a bintree"
  \end{ttbox}
  \begin{ttbox}
  text {\ttlbrace}*
    {\ttback}noindent The datatype induction rule generated here is
    of the form {\at}{\ttlbrace}thm [display] bintree.induct [no_vars]{\ttrbrace}
  *{\ttrbrace}
  \end{ttbox}\vspace{-\medskipamount}

  \noindent Here we have augmented the theory by formal comments
  (using \isakeyword{text} blocks), the informal parts may again refer
  to formal entities by means of ``antiquotations'' (such as
  \texttt{\at}\verb,{text "'a bintree"}, or
  \texttt{\at}\verb,{typ 'a},), see also \S\ref{sec:doc-prep-text}.
*}

subsection {* Isabelle Sessions *}

text {*
  In contrast to the highly interactive mode of Isabelle/Isar theory
  development, the document preparation stage essentially works in
  batch-mode.  An Isabelle \bfindex{session} consists of a collection
  of source files that may contribute to an output document.  Each
  session is derived from a single parent, usually an object-logic
  image like \texttt{HOL}.  This results in an overall tree structure,
  which is reflected by the output location in the file system
  (the root directory is determined by the Isabelle settings variable
  \verb,ISABELLE_BROWSER_INFO,).

  \medskip The easiest way to manage Isabelle sessions is via
  \texttt{isabelle mkroot} (to generate an initial session source
  setup) and \texttt{isabelle build} (to run sessions as specified in
  the corresponding \texttt{ROOT} file).  These Isabelle tools are
  described in further detail in the \emph{Isabelle System Manual}
  @{cite "isabelle-system"}.

  For example, a new session \texttt{MySession} (with document
  preparation) may be produced as follows:

\begin{verbatim}
  isabelle mkroot -d MySession
  isabelle build -D MySession
\end{verbatim}

  The \texttt{isabelle build} job also informs about the file-system
  location of the ultimate results.  The above dry run should be able
  to produce some \texttt{document.pdf} (with dummy title, empty table
  of contents etc.).  Any failure at this stage usually indicates
  technical problems of the {\LaTeX} installation.

  \medskip The detailed arrangement of the session sources is as
  follows.

  \begin{itemize}

  \item Directory \texttt{MySession} holds the required theory files
  $T@1$\texttt{.thy}, \dots, $T@n$\texttt{.thy}.

  \item File \texttt{MySession/ROOT} specifies the session options and
  content, with declarations for all wanted theories; it is sufficient
  to specify the terminal nodes of the theory dependency graph.

  \item Directory \texttt{MySession/document} contains everything
  required for the {\LaTeX} stage; only \texttt{root.tex} needs to be
  provided initially.

  The latter file holds appropriate {\LaTeX} code to commence a
  document (\verb,\documentclass, etc.), and to include the generated
  files $T@i$\texttt{.tex} for each theory.  Isabelle will generate a
  file \texttt{session.tex} holding {\LaTeX} commands to include all
  generated theory output files in topologically sorted order, so
  \verb,\input{session}, in the body of \texttt{root.tex} does the job
  in most situations.

  \end{itemize}

  One may now start to populate the directory \texttt{MySession} and
  its \texttt{ROOT} file accordingly.  The file
  \texttt{MySession/document/root.tex} should also be adapted at some
  point; the default version is mostly self-explanatory.  Note that
  \verb,\isabellestyle, enables fine-tuning of the general appearance
  of characters and mathematical symbols (see also
  \S\ref{sec:doc-prep-symbols}).

  Especially observe the included {\LaTeX} packages \texttt{isabelle}
  (mandatory), \texttt{isabellesym} (required for mathematical
  symbols), and the final \texttt{pdfsetup} (provides sane defaults
  for \texttt{hyperref}, including URL markup).  All three are
  distributed with Isabelle. Further packages may be required in
  particular applications, say for unusual mathematical symbols.

  \medskip Any additional files for the {\LaTeX} stage go into the
  \texttt{MySession/document} directory as well.  In particular,
  adding a file named \texttt{root.bib} causes an automatic run of
  \texttt{bibtex} to process a bibliographic database; see also
  \texttt{isabelle document} @{cite "isabelle-system"}.

  \medskip Any failure of the document preparation phase in an
  Isabelle batch session leaves the generated sources in their target
  location, identified by the accompanying error message.  This lets
  you trace {\LaTeX} problems with the generated files at hand.
*}

subsection {* Structure Markup *}

text {*
  The large-scale structure of Isabelle documents follows existing
  {\LaTeX} conventions, with chapters, sections, subsubsections etc.
  The Isar language includes separate \bfindex{markup commands}, which
  do not affect the formal meaning of a theory (or proof), but result
  in corresponding {\LaTeX} elements.

  From the Isabelle perspective, each markup command takes a single
  $text$ argument (delimited by \verb,",~@{text \<dots>}~\verb,", or
  \verb,{,\verb,*,~@{text \<dots>}~\verb,*,\verb,},).  After stripping any
  surrounding white space, the argument is passed to a {\LaTeX} macro
  \verb,\isamarkupXYZ, for command \isakeyword{XYZ}.  These macros are
  defined in \verb,isabelle.sty, according to the meaning given in the
  rightmost column above.

  \medskip The following source fragment illustrates structure markup
  of a theory.  Note that {\LaTeX} labels may be included inside of
  section headings as well.

  \begin{ttbox}
  section {\ttlbrace}* Some properties of Foo Bar elements *{\ttrbrace}

  theory Foo_Bar
  imports Main
  begin

  subsection {\ttlbrace}* Basic definitions *{\ttrbrace}

  definition foo :: \dots

  definition bar :: \dots

  subsection {\ttlbrace}* Derived rules *{\ttrbrace}

  lemma fooI: \dots
  lemma fooE: \dots

  subsection {\ttlbrace}* Main theorem {\ttback}label{\ttlbrace}sec:main-theorem{\ttrbrace} *{\ttrbrace}

  theorem main: \dots

  end
  \end{ttbox}
*}

subsection {* Formal Comments and Antiquotations \label{sec:doc-prep-text} *}

text {*
  Isabelle \bfindex{source comments}, which are of the form
  \verb,(,\verb,*,~@{text \<dots>}~\verb,*,\verb,),, essentially act like
  white space and do not really contribute to the content.  They
  mainly serve technical purposes to mark certain oddities in the raw
  input text.  In contrast, \bfindex{formal comments} are portions of
  text that are associated with formal Isabelle/Isar commands
  (\bfindex{marginal comments}), or as standalone paragraphs within a
  theory or proof context (\bfindex{text blocks}).

  \medskip Marginal comments are part of each command's concrete
  syntax @{cite "isabelle-isar-ref"}; the common form is ``\verb,--,~$text$''
  where $text$ is delimited by \verb,",@{text \<dots>}\verb,", or
  \verb,{,\verb,*,~@{text \<dots>}~\verb,*,\verb,}, as before.  Multiple
  marginal comments may be given at the same time.  Here is a simple
  example:
*}

lemma "A --> A"
  -- "a triviality of propositional logic"
  -- "(should not really bother)"
  by (rule impI) -- "implicit assumption step involved here"

text {*
  \noindent The above output has been produced as follows:

\begin{verbatim}
  lemma "A --> A"
    -- "a triviality of propositional logic"
    -- "(should not really bother)"
    by (rule impI) -- "implicit assumption step involved here"
\end{verbatim}

  From the {\LaTeX} viewpoint, ``\verb,--,'' acts like a markup
  command, associated with the macro \verb,\isamarkupcmt, (taking a
  single argument).

  \medskip Text blocks are introduced by the commands \bfindex{text}
  and \bfindex{txt}. Each takes again a single $text$ argument,
  which is interpreted as a free-form paragraph in {\LaTeX}
  (surrounded by some additional vertical space).  The typesetting
  may be changed by redefining the {\LaTeX} environments of
  \verb,isamarkuptext, or \verb,isamarkuptxt,, respectively
  (via \verb,\renewenvironment,).

  \medskip The $text$ part of Isabelle markup commands essentially
  inserts \emph{quoted material} into a formal text, mainly for
  instruction of the reader.  An \bfindex{antiquotation} is again a
  formal object embedded into such an informal portion.  The
  interpretation of antiquotations is limited to some well-formedness
  checks, with the result being pretty printed to the resulting
  document.  Quoted text blocks together with antiquotations provide
  an attractive means of referring to formal entities, with good
  confidence in getting the technical details right (especially syntax
  and types).

  The general syntax of antiquotations is as follows:
  \texttt{{\at}{\ttlbrace}$name$ $arguments${\ttrbrace}}, or
  \texttt{{\at}{\ttlbrace}$name$ [$options$] $arguments${\ttrbrace}}
  for a comma-separated list of options consisting of a $name$ or
  \texttt{$name$=$value$} each.  The syntax of $arguments$ depends on
  the kind of antiquotation, it generally follows the same conventions
  for types, terms, or theorems as in the formal part of a theory.

  \medskip This sentence demonstrates quotations and antiquotations:
  @{term "%x y. x"} is a well-typed term.

  \medskip\noindent The output above was produced as follows:
  \begin{ttbox}
text {\ttlbrace}*
  This sentence demonstrates quotations and antiquotations:
  {\at}{\ttlbrace}term "%x y. x"{\ttrbrace} is a well-typed term.
*{\ttrbrace}
  \end{ttbox}\vspace{-\medskipamount}

  The notational change from the ASCII character~\verb,%, to the
  symbol~@{text \<lambda>} reveals that Isabelle printed this term, after
  parsing and type-checking.  Document preparation enables symbolic
  output by default.

  \medskip The next example includes an option to show the type of all
  variables.  The antiquotation
  \texttt{{\at}}\verb,{term [show_types] "%x y. x"}, produces the
  output @{term [show_types] "%x y. x"}.  Type inference has figured
  out the most general typings in the present theory context.  Terms
  may acquire different typings due to constraints imposed by their
  environment; within a proof, for example, variables are given the
  same types as they have in the main goal statement.

  \medskip Several further kinds of antiquotations and options are
  available @{cite "isabelle-isar-ref"}.  Here are a few commonly used
  combinations:

  \medskip

  \begin{tabular}{ll}
  \texttt{\at}\verb,{typ,~$\tau$\verb,}, & print type $\tau$ \\
  \texttt{\at}\verb,{const,~$c$\verb,}, & check existence of $c$ and print it \\
  \texttt{\at}\verb,{term,~$t$\verb,}, & print term $t$ \\
  \texttt{\at}\verb,{prop,~$\phi$\verb,}, & print proposition $\phi$ \\
  \texttt{\at}\verb,{prop [display],~$\phi$\verb,}, & print large proposition $\phi$ (with linebreaks) \\
  \texttt{\at}\verb,{prop [source],~$\phi$\verb,}, & check proposition $\phi$, print its input \\
  \texttt{\at}\verb,{thm,~$a$\verb,}, & print fact $a$ \\
  \texttt{\at}\verb,{thm,~$a$~\verb,[no_vars]}, & print fact $a$, fixing schematic variables \\
  \texttt{\at}\verb,{thm [source],~$a$\verb,}, & check availability of fact $a$, print its name \\
  \texttt{\at}\verb,{text,~$s$\verb,}, & print uninterpreted text $s$ \\
  \end{tabular}

  \medskip

  Note that \attrdx{no_vars} given above is \emph{not} an
  antiquotation option, but an attribute of the theorem argument given
  here.  This might be useful with a diagnostic command like
  \isakeyword{thm}, too.

  \medskip The \texttt{\at}\verb,{text, $s$\verb,}, antiquotation is
  particularly interesting.  Embedding uninterpreted text within an
  informal body might appear useless at first sight.  Here the key
  virtue is that the string $s$ is processed as Isabelle output,
  interpreting Isabelle symbols appropriately.

  For example, \texttt{\at}\verb,{text "\<forall>\<exists>"}, produces @{text
  "\<forall>\<exists>"}, according to the standard interpretation of these symbol
  (cf.\ \S\ref{sec:doc-prep-symbols}).  Thus we achieve consistent
  mathematical notation in both the formal and informal parts of the
  document very easily, independently of the term language of
  Isabelle.  Manual {\LaTeX} code would leave more control over the
  typesetting, but is also slightly more tedious.
*}

subsection {* Interpretation of Symbols \label{sec:doc-prep-symbols} *}

text {*
  As has been pointed out before (\S\ref{sec:syntax-symbols}),
  Isabelle symbols are the smallest syntactic entities --- a
  straightforward generalization of ASCII characters.  While Isabelle
  does not impose any interpretation of the infinite collection of
  named symbols, {\LaTeX} documents use canonical glyphs for certain
  standard symbols @{cite "isabelle-isar-ref"}.

  The {\LaTeX} code produced from Isabelle text follows a simple
  scheme.  You can tune the final appearance by redefining certain
  macros, say in \texttt{root.tex} of the document.

  \begin{enumerate}

  \item 7-bit ASCII characters: letters \texttt{A\dots Z} and
  \texttt{a\dots z} are output directly, digits are passed as an
  argument to the \verb,\isadigit, macro, other characters are
  replaced by specifically named macros of the form
  \verb,\isacharXYZ,.

  \item Named symbols: \verb,\,\verb,<XYZ>, is turned into
  \verb,{\isasymXYZ},; note the additional braces.

  \item Named control symbols: \verb,\,\verb,<^XYZ>, is turned into
  \verb,\isactrlXYZ,; subsequent symbols may act as arguments if the
  control macro is defined accordingly.

  \end{enumerate}

  You may occasionally wish to give new {\LaTeX} interpretations of
  named symbols.  This merely requires an appropriate definition of
  \verb,\isasymXYZ,, for \verb,\,\verb,<XYZ>, (see
  \texttt{isabelle.sty} for working examples).  Control symbols are
  slightly more difficult to get right, though.

  \medskip The \verb,\isabellestyle, macro provides a high-level
  interface to tune the general appearance of individual symbols.  For
  example, \verb,\isabellestyle{it}, uses the italics text style to
  mimic the general appearance of the {\LaTeX} math mode; double
  quotes are not printed at all.  The resulting quality of typesetting
  is quite good, so this should be the default style for work that
  gets distributed to a broader audience.
*}

subsection {* Suppressing Output \label{sec:doc-prep-suppress} *}

text {*
  By default, Isabelle's document system generates a {\LaTeX} file for
  each theory that gets loaded while running the session.  The
  generated \texttt{session.tex} will include all of these in order of
  appearance, which in turn gets included by the standard
  \texttt{root.tex}.  Certainly one may change the order or suppress
  unwanted theories by ignoring \texttt{session.tex} and load
  individual files directly in \texttt{root.tex}.  On the other hand,
  such an arrangement requires additional maintenance whenever the
  collection of theories changes.

  Alternatively, one may tune the theory loading process in
  \texttt{ROOT} itself: some sequential order of \textbf{theories}
  sections may enforce a certain traversal of the dependency graph,
  although this could degrade parallel processing.  The nodes of each
  sub-graph that is specified here are presented in some topological
  order of their formal dependencies.

  Moreover, the system build option \verb,document=false, allows to
  disable document generation for some theories.  Its usage in the
  session \texttt{ROOT} is like this:

\begin{verbatim}
  theories [document = false] T
\end{verbatim}

  \medskip Theory output may be suppressed more selectively, either
  via \bfindex{tagged command regions} or \bfindex{ignored material}.

  Tagged command regions works by annotating commands with named tags,
  which correspond to certain {\LaTeX} markup that tells how to treat
  particular parts of a document when doing the actual type-setting.
  By default, certain Isabelle/Isar commands are implicitly marked up
  using the predefined tags ``\emph{theory}'' (for theory begin and
  end), ``\emph{proof}'' (for proof commands), and ``\emph{ML}'' (for
  commands involving ML code).  Users may add their own tags using the
  \verb,%,\emph{tag} notation right after a command name.  In the
  subsequent example we hide a particularly irrelevant proof:
*}

lemma "x = x" by %invisible (simp)

text {*
  The original source has been ``\verb,lemma "x = x" by %invisible (simp),''.
  Tags observe the structure of proofs; adjacent commands with the
  same tag are joined into a single region.  The Isabelle document
  preparation system allows the user to specify how to interpret a
  tagged region, in order to keep, drop, or fold the corresponding
  parts of the document.  See the \emph{Isabelle System Manual}
  @{cite "isabelle-system"} for further details, especially on
  \texttt{isabelle build} and \texttt{isabelle document}.

  Ignored material is specified by delimiting the original formal
  source with special source comments
  \verb,(,\verb,*,\verb,<,\verb,*,\verb,), and
  \verb,(,\verb,*,\verb,>,\verb,*,\verb,),.  These parts are stripped
  before the type-setting phase, without affecting the formal checking
  of the theory, of course.  For example, we may hide parts of a proof
  that seem unfit for general public inspection.  The following
  ``fully automatic'' proof is actually a fake:
*}

lemma "x \<noteq> (0::int) \<Longrightarrow> 0 < x * x"
  by (auto(*<*)simp add: zero_less_mult_iff(*>*))

text {*
  \noindent The real source of the proof has been as follows:

\begin{verbatim}
  by (auto(*<*)simp add: zero_less_mult_iff(*>*))
\end{verbatim}
%(*

  \medskip Suppressing portions of printed text demands care.  You
  should not misrepresent the underlying theory development.  It is
  easy to invalidate the visible text by hiding references to
  questionable axioms, for example.
*}

(*<*)
end
(*>*)