theory hensels_lemma
imports "~~/src/HOL/Algebra/UnivPoly" padic_int_topology domain_poly padic_fields
begin

context padic_int_poly
begin

lemma(in cring) plus_pairs:
  assumes "a1 \<in> carrier R"
  assumes "a2 \<in> carrier R"
  assumes "a3 \<in> carrier R"
  assumes "b1 \<in> carrier R"
  assumes "b2 \<in> carrier R"
  assumes "b3 \<in> carrier R"
  shows "(a1 \<oplus> a2 \<oplus> a3) \<oplus> (b1 \<oplus> b2 \<oplus> b3) = (a1 \<oplus> b1) \<oplus> (a2 \<oplus> b2) \<oplus> (a3 \<oplus> b3)"
  by (simp add: add.m_assoc add.m_lcomm assms(1) assms(2) assms(3) assms(4) assms(5) assms(6))

lemma(in cring) minus_pairs:
  assumes "a1 \<in> carrier R"
  assumes "a2 \<in> carrier R"
  assumes "a3 \<in> carrier R"
  assumes "b1 \<in> carrier R"
  assumes "b2 \<in> carrier R"
  assumes "b3 \<in> carrier R"
  shows "(a1 \<oplus> a2 \<oplus> a3) \<ominus> (b1 \<oplus> b2 \<oplus> b3) = (a1 \<ominus> b1) \<oplus> (a2 \<ominus> b2) \<oplus> (a3 \<ominus> b3)"
proof-
  have " \<ominus> (b1 \<oplus> b2 \<oplus> b3) = \<ominus>b1 \<oplus>(\<ominus>b2) \<oplus>(\<ominus>b3)"
    using assms inv_add minus_eq
    by auto
  then show ?thesis
  unfolding a_minus_def
  using plus_pairs[of a1 a2 a3 "\<ominus>b1" "\<ominus>b2" "\<ominus>b3"]
        a_inv_closed[of "b1"]
        a_inv_closed[of "b2"]
        a_inv_closed[of "b3"]
        assms
  by auto
qed

lemma(in cring) minus_pairs_cancel_1:
  assumes "a1 \<in> carrier R"
  assumes "a2 \<in> carrier R"
  assumes "a3 \<in> carrier R"
  assumes "b2 \<in> carrier R"
  assumes "b3 \<in> carrier R"
  shows "(a1 \<oplus> a2 \<oplus> a3) \<ominus> (a1 \<oplus> b2 \<oplus> b3) = (a2 \<ominus> b2) \<oplus> (a3 \<ominus> b3)"
  using assms  minus_pairs[of a1 a2 a3 a1 b2 b3]
  by simp

lemma(in cring) minus_pair_factor:
  assumes "a1 \<in> carrier R"
  assumes "b1 \<in> carrier R"
  assumes "c \<in> carrier R"
  assumes "d \<in> carrier R"
  shows "(c \<otimes> a1 \<ominus> c \<otimes> b1) = c \<otimes>(a1 \<ominus> b1)"
proof-
  have "(c \<otimes> a1 \<oplus> c \<otimes> (\<ominus>b1)) = c \<otimes>(a1 \<ominus> b1)"
    using assms
    by (simp add: minus_eq r_distr)
  then show ?thesis
    by (simp add: assms cring.cring_simprules(29) is_cring minus_eq)
qed

lemma(in cring) minus_pairs_factor:
  assumes "a1 \<in> carrier R"
  assumes "a2 \<in> carrier R"
  assumes "b1 \<in> carrier R"
  assumes "b2 \<in> carrier R"
  assumes "c \<in> carrier R"
  assumes "d \<in> carrier R"
  shows "(c \<otimes> a1 \<ominus> c \<otimes> b1) \<oplus> (d \<otimes> a2 \<ominus> c \<otimes> b2) = c \<otimes>(a1 \<ominus> b1)\<oplus> (d \<otimes> a2 \<ominus> c \<otimes> b2)"
  using minus_pair_factor assms(1) assms(3) assms(5)
  by auto

lemma(in cring) minus_pairs_cancel_2:
  assumes "a1 \<in> carrier R"
  assumes "a2 \<in> carrier R"
  assumes "a \<in> carrier R"
  shows "(a1 \<ominus> a \<ominus> (a2 \<ominus> a)) =a1 \<ominus>a2"
  by (smt a_minus_def abelian_group.a_inv_closed abelian_group.minus_closed
      abelian_group.right_inv_add assms(1) assms(2) assms(3) cring.cring_simprules(17)
      is_abelian_group is_cring local.ring_axioms ring.ring_simprules(15) ring.ring_simprules(22))

type_synonym padic_int_poly = "nat \<Rightarrow> padic_int"

lemma monom_term_car:
  assumes "c \<in> carrier Z\<^sub>p"
  assumes "x \<in> carrier Z\<^sub>p"
  shows "c \<otimes> x[^](n::nat) \<in> carrier Z\<^sub>p"
  using assms Zp_is_cring monoid.nat_pow_closed
  by (simp add: monoid.nat_pow_closed cring.cring_simprules(5) cring_def ring_def)

(*Univariate polynomial ring over Z\<^sub>p*)

abbreviation Z\<^sub>p_x where
"Z\<^sub>p_x \<equiv> UP Z\<^sub>p"

lemma Z\<^sub>p_x_is_UP_ring[simp]:
"UP_ring Z\<^sub>p"
  by (metis UP_ring.intro Zp_is_cring cring_def)

lemma Z\<^sub>p_x_is_UP_cring[simp]:
"UP_cring Z\<^sub>p"
  by (simp add: UP_cring_def)

lemma Z\<^sub>p_x_is_UP_domain[simp]:
"UP_domain Z\<^sub>p"
  by (simp add: UP_domain_def)

lemma Z\<^sub>p_x_ring[simp]:
"ring Z\<^sub>p_x "
  by (simp add: UP_ring.UP_ring)

lemma Z\<^sub>p_x_cring[simp]:
"cring Z\<^sub>p_x "
  by (simp add: UP_cring.UP_cring)

lemma Z\<^sub>p_x_domain[simp]:
"domain Z\<^sub>p_x "
  by (simp add: UP_domain.UP_domain)

(*Basic simp rules to streaminline computation*)
lemma pow_closedP[simp]:
  assumes "f \<in> carrier Z\<^sub>p_x"
  shows "f[^]\<^bsub>Z\<^sub>p_x\<^esub>(n::nat) \<in> carrier Z\<^sub>p_x "
  by (meson Z\<^sub>p_x_ring assms monoid.nat_pow_closed ring_def)

lemma pow_closed[simp]:
  assumes "a \<in> carrier Z\<^sub>p"
  shows "a[^](n::nat) \<in> carrier Z\<^sub>p"
  by (meson Zp_is_domain domain_def cring_def assms monoid.nat_pow_closed ring_def)

lemma(in ring) pow_zero[simp]:
  assumes "(n::nat)>0"
  shows "\<zero>[^] n = \<zero>"
  by (simp add: assms nat_pow_zero)

lemma pow_zero[simp]:
  assumes "(n::nat)>0"
  shows "\<zero>[^] n = \<zero>"
  using Zp_is_cring
  unfolding cring_def
  using ring.pow_zero
        assms
  by blast

lemma pow_zeroP[simp]:
  assumes "n >0"
  shows "\<zero>\<^bsub>Z\<^sub>p_x\<^esub>[^]\<^bsub>Z\<^sub>p_x\<^esub>(n::nat) = \<zero>\<^bsub>Z\<^sub>p_x\<^esub>"
  using assms ring.pow_zero[of Z\<^sub>p_x] by simp

lemma sum_closedP[simp]:
  assumes "f \<in> carrier Z\<^sub>p_x"
  assumes "g \<in> carrier Z\<^sub>p_x"
  shows "f \<oplus>\<^bsub>Z\<^sub>p_x\<^esub>g \<in>  carrier Z\<^sub>p_x"
  by (simp add: assms(1) assms(2) cring.cring_simprules(1))

lemma sum_closed[simp]:
  assumes "f \<in> carrier Z\<^sub>p"
  assumes "g \<in> carrier Z\<^sub>p"
  shows "f \<oplus> g \<in>  carrier Z\<^sub>p"
  by (simp add: assms(1) assms(2) cring.cring_simprules(1))

lemma mult_zero[simp]:
  assumes "f \<in> carrier Z\<^sub>p"
  shows "f \<otimes> \<zero> = \<zero>"
        "\<zero> \<otimes> f = \<zero>"
   apply (simp add: assms cring.cring_simprules(27))
   apply (simp add: assms cring.cring_simprules(26))
  done

lemma mult_zeroP[simp]:
  assumes "f \<in> carrier Z\<^sub>p_x"
  shows "f \<otimes>\<^bsub>Z\<^sub>p_x\<^esub> \<zero>\<^bsub>Z\<^sub>p_x\<^esub> = \<zero>\<^bsub>Z\<^sub>p_x\<^esub>"
        "\<zero>\<^bsub>Z\<^sub>p_x\<^esub> \<otimes>\<^bsub>Z\<^sub>p_x\<^esub> f = \<zero>\<^bsub>Z\<^sub>p_x\<^esub>"
  apply (simp add: assms cring.cring_simprules(27))
  apply (simp add: assms cring.cring_simprules(26))
  done

lemma add_zero[simp]:
  assumes "f \<in> carrier Z\<^sub>p"
  shows "f \<oplus> \<zero> = f"
        "\<zero> \<oplus> f = f"
   apply (simp add: assms cring.cring_simprules)
   apply (simp add: assms cring.cring_simprules)
   done

lemma add_zeroP[simp]:
  assumes "f \<in> carrier Z\<^sub>p_x "
  shows "f \<oplus>\<^bsub>Z\<^sub>p_x\<^esub> \<zero>\<^bsub>Z\<^sub>p_x\<^esub> = f"
        "\<zero>\<^bsub>Z\<^sub>p_x\<^esub> \<oplus>\<^bsub>Z\<^sub>p_x\<^esub> f = f"
   apply (simp add: assms cring.cring_simprules)
   apply (simp add: assms cring.cring_simprules)
   done

(*Degree function*)
abbreviation degree:: "padic_int_poly \<Rightarrow> nat" where
"degree f \<equiv>  deg Z\<^sub>p f"

(*Coefficient function*)
abbreviation cf :: "padic_int_poly \<Rightarrow> nat \<Rightarrow> padic_int" where
"cf  \<equiv> coeff (UP Z\<^sub>p)"

(*Leading term function*)
abbreviation lt  where
"lt \<equiv> leading_term Z\<^sub>p"

(*Leading coefficient function*)
abbreviation lc where
"lc \<equiv> leading_coefficient Z\<^sub>p"

(*Truncation function, which sends a polynomial f \<Longrightarrow> (f - leading_term (f)), which has strictly
smaller degree in the case where degree f > 0*)
abbreviation trunc where
"trunc \<equiv> truncate Z\<^sub>p"

(*Turning a padic polynomial into a function on Z\<^sub>p*)
abbreviation fun_of :: "_ \<Rightarrow> padic_int_fun" (infixl "\<^emph>" 70) where
"fun_of f a \<equiv> function_of Z\<^sub>p f a"

(*predicate for monomial polynomials*)
abbreviation is_monom where
"is_monom \<equiv> is_monom_poly Z\<^sub>p"

(*technical lemmas for reasoning about fun_of*)
lemma id_is_hom:
"ring_hom_cring Z\<^sub>p Z\<^sub>p (\<lambda>x. x)"
proof(rule ring_hom_cringI)
  show "cring Z\<^sub>p"
    using Zp_is_cring by auto
  show "cring Z\<^sub>p"
    using Zp_is_cring by auto
  show "(\<lambda>x. x) \<in> ring_hom Z\<^sub>p Z\<^sub>p"
    unfolding ring_hom_def
    apply(auto)
    done
qed

lemma UP_pre_univ_prop_fact:
"UP_pre_univ_prop Z\<^sub>p Z\<^sub>p (\<lambda>x. x)"
  unfolding UP_pre_univ_prop_def
  by (simp add: UP_cring_def  id_is_hom)

(*Z\<^sub>p_x addition commutes with evaluation addition*)
lemma fun_of_fun_sum:
  assumes "f \<in> carrier Z\<^sub>p_x"
  assumes "g \<in> carrier Z\<^sub>p_x"
  assumes "h = f \<oplus>\<^bsub>Z\<^sub>p_x\<^esub> g"
  shows "fun_sum (fun_of f) (fun_of g) \<doteq> fun_of h"
  unfolding eq_on_Zp_def
  apply(auto)
proof-
  fix x
  assume A: "x \<in> carrier Z\<^sub>p"
  show "fun_sum (fun_of f) (fun_of g) x = fun_of h x "
    unfolding fun_sum_def
    unfolding function_of_def
  proof-
    have "(eval Z\<^sub>p Z\<^sub>p (\<lambda>x. x)) x \<in> (ring_hom Z\<^sub>p_x Z\<^sub>p)"
      using UP_pre_univ_prop_fact A UP_pre_univ_prop.eval_ring_hom[of Z\<^sub>p Z\<^sub>p "(\<lambda>x. x)" x]    by auto
    then show "eval Z\<^sub>p Z\<^sub>p (\<lambda>x. x) x f \<oplus> eval Z\<^sub>p Z\<^sub>p (\<lambda>x. x) x g = eval Z\<^sub>p Z\<^sub>p (\<lambda>x. x) x h "
      using assms ring_hom_add   by (simp add: \<open>f \<in> carrier Z\<^sub>p_x\<close> ring_hom_def)
  qed
qed

(*monomial functions are monomials*)
lemma fun_of_monom_is_monom0:
  assumes "c \<in> carrier Z\<^sub>p"
  assumes "c \<noteq>\<zero>"
  assumes "f = monom Z\<^sub>p_x c n"
  assumes "x \<in> carrier Z\<^sub>p"
  shows "f\<^emph>x = mon c n x"
proof-
  have 1: "f\<^emph>x = c \<otimes> x [^] n"
    using UP_domain.fun_of_monom assms Z\<^sub>p_x_is_UP_domain
    by (simp add: UP_domain.fun_of_monom)
  show ?thesis
    unfolding mon_def scalar_mult_def X_pow_Zp_def
    apply auto
     apply (metis "1" Zp_is_cring cring.axioms(1) monoid.nat_pow_0 ring_def)
    using 1  by simp
qed

lemma fun_of_monom_is_monom:
  assumes "c \<in> carrier Z\<^sub>p"
  assumes "f = monom Z\<^sub>p_x c n"
  shows "fun_of f \<doteq> mon c n"
proof(cases "c = \<zero>")
  case True
  have H: "f = (\<lambda> i. \<zero>)"
    apply(auto simp: assms(2))
    apply(auto simp:True)
  proof-
    have A: "\<zero> \<in> carrier Z\<^sub>p"
      using True assms(1) by auto
    then have "monom  (UP Z\<^sub>p) = (\<lambda>a\<in>carrier Z\<^sub>p. (\<lambda>n i. if i = n then a else \<zero>)) "
      by(simp add: UP_def)
    then have "monom (UP Z\<^sub>p) \<zero>  = (\<lambda>n i. if i = n then \<zero> else \<zero>)"
      using A by simp
    then have "monom (UP Z\<^sub>p) \<zero> n  =  (\<lambda>i. if i = n then \<zero> else \<zero>)"
      by simp
    then show "monom (UP Z\<^sub>p) \<zero> n = (\<lambda>i. \<zero>)"
      by simp
  qed
  have H1: "cf f= f"
    by (simp add:UP_domain.coeff_simp1 UP_ring.monom_closed assms(1) assms(2))
  show ?thesis
    unfolding eq_on_Zp_def
    apply(auto )
    unfolding mon_def scalar_mult_def X_pow_Zp_def
  proof-
    fix x
    assume A: "x \<in> carrier Z\<^sub>p"
    have P0: "f\<^emph>x = \<zero>"
    proof-
      have C0: "abelian_monoid Z\<^sub>p"
        using Zp_is_cring abelian_group_def cring_def ring_def by blast
      have C1: "\<And> i::nat. \<zero> \<otimes> x [^]i = \<zero>"
      proof-
        fix i::nat
        show "\<zero> \<otimes> x [^] i = \<zero>"
          using Zp_is_cring A monoid.nat_pow_closed
          by (simp add: monoid.nat_pow_closed cring.cring_simprules(26) cring_def ring_def)
      qed
      have C2: "f \<in> carrier Z\<^sub>p_x"
        apply(auto simp: assms(2))
        using assms(1) Z\<^sub>p_x_is_UP_ring UP_ring.monom_closed[of Z\<^sub>p c n] apply simp
        done
      have C3: "f\<^emph>x = (\<Oplus>i \<in> {..degree f}. (cf f i) \<otimes> x [^] i)"
        using  A  C2 Z\<^sub>p_x_is_UP_domain UP_domain.fun_of_formula[of Z\<^sub>p f x]
        by blast
      show ?thesis
        apply(auto simp: C3 H1 )
        apply(auto simp: H)
        apply(auto simp: C1)
        apply(auto simp: C0 abelian_monoid.finsum_zero)
        done
    qed
    show "f\<^emph>x = c \<otimes> (if n = 0 then \<one> else x [^] n) "
      apply(auto simp: P0)
       apply (simp add: True Zp_one_car cring.cring_simprules(26))
      using A assms(1) monom_term_car[of c x]
      by (metis True Zp_is_cring cring.cring_simprules(26) cring_def monoid.nat_pow_closed ring_def)
  qed
next
  case False
  then show ?thesis
    unfolding eq_on_Zp_def
    apply(auto)
    by (simp add: assms(1) assms(2) fun_of_monom_is_monom0)
qed

lemma fun_of_monom_is_monom':
  assumes "is_monom f"
  shows "fun_of f \<doteq> mon (lc f) (degree f)"
  using Z\<^sub>p_x_is_UP_domain assms
    UP_domain.is_monom_id[of Z\<^sub>p f]
    fun_of_monom_is_monom[of "lc f" f "degree f"]
    UP_domain.lc_closed[of Z\<^sub>p f]
  unfolding   is_monom_poly_def
  by auto

(*monomials are continuous*)

lemma monom_poly_is_continuous:
  assumes "c \<in> carrier Z\<^sub>p"
  assumes "f = monom Z\<^sub>p_x c n"
  shows "is_continuous (fun_of f)"
proof-
  have 0: "is_continuous (mon c n)"
    unfolding mon_def using assms(1)
    by (simp add: X_pow_Zp_is_continuous scalar_mult_is_continuous)
  have 1: "fun_of f \<doteq> mon c n"
    by (simp add: assms(1) assms(2) fun_of_monom_is_monom)
  show ?thesis using 0 1 is_continuous_eq eq_on_Zp_def by auto
qed

lemma monom_poly_is_continuous':
  assumes "is_monom f"
  shows "is_continuous (fun_of f)"
  using Z\<^sub>p_x_is_UP_domain UP_domain.is_monom_id[of Z\<^sub>p f]
        monom_poly_is_continuous[of "lc f" f "degree f"]
        assms UP_domain.lc_closed[of Z\<^sub>p f]
  unfolding is_monom_poly_def
  by (simp add:  )

lemma degree_0_is_constant:
  assumes "f \<in> carrier Z\<^sub>p_x"
  assumes "degree f = 0"
  obtains g where "is_constant_fun g" and "g \<doteq> fun_of f"
proof-
  obtain c where c0: "c \<in> carrier Z\<^sub>p" and  c1: "\<And>x.  x \<in> carrier Z\<^sub>p \<Longrightarrow> (fun_of f) x = c"
    using Z\<^sub>p_x_is_UP_domain UP_domain.degree_0_imp_constant0  assms(1) assms(2) by blast
  obtain g where g_def: "g = to_const_fun c"
    by simp
  have 0: "is_constant_fun g"
    by (simp add: \<open>g = to_const_fun c\<close> c0 to_const_fun_is_const)
  have 1: "g \<doteq> fun_of f"
    unfolding eq_on_Zp_def
    apply(auto)
  proof-
    fix x
    assume A: "x \<in> carrier Z\<^sub>p"
    show "g x = f\<^emph>x "
    proof-
      have LHS: "g x = c"
        using g_def using to_const_fun_def by simp
      have RHS: "f\<^emph>x = c"
        apply(auto simp: A c1)
        done
      then show ?thesis
        using RHS LHS by auto
    qed
  qed
  show ?thesis
    using 0 1  that by auto
qed

(*degree 0 polynomials induce continuous functions*)
lemma degree_0_is_continuous:
  assumes "f \<in> carrier Z\<^sub>p_x"
  assumes "degree f = 0"
  shows "is_continuous (fun_of f)"
proof-
  obtain g where 0: "is_constant_fun g" and 1: "g \<doteq> fun_of f"
    using assms degree_0_is_constant by auto
  have "is_continuous g"
    using 0 by (simp add: constant_is_continuous)
  then show ?thesis
    using 1 is_continuous_eq by blast
qed

(*all polynomials induce continuous functions*)
lemma polynomial_is_continuous_induct:
  fixes n::nat
  shows "\<And>f. f \<in> carrier Z\<^sub>p_x \<Longrightarrow> degree f \<le> n \<Longrightarrow> is_continuous (fun_of f)"
proof(induction n)
case 0
  then show ?case
    using degree_0_is_continuous by blast
next
  case (Suc n)
  fix n
  assume IH: "\<And>f. f \<in> carrier Z\<^sub>p_x \<Longrightarrow> (degree f \<le> n \<Longrightarrow> is_continuous (fun_of f))"
  show "\<And>f. f \<in> carrier Z\<^sub>p_x \<Longrightarrow> degree f \<le> Suc n \<Longrightarrow> is_continuous (fun_of f) "
  proof-
    fix f
    assume A0:"f \<in> carrier Z\<^sub>p_x"
    assume D: "degree f \<le> Suc n"
    show "is_continuous (fun_of f)"
    proof(cases "degree f < Suc n")
      case True
      then show ?thesis
        using IH A0 by simp
    next
      case False
      then have E: "degree f = Suc n"
        using D by auto
      then have E0: "degree f > (0::nat)"
        by auto
      obtain g where g_def: "g \<in> carrier Z\<^sub>p_x \<and> (f = g \<oplus>\<^bsub>Z\<^sub>p_x\<^esub> (lt f)) \<and> degree g < degree f"
        using E0 A0 Z\<^sub>p_x_is_UP_domain UP_domain.lt_decomp[of Z\<^sub>p f] by auto
      have g0: "g \<in> carrier Z\<^sub>p_x"
        using g_def by auto
      have g1: "f = g \<oplus>\<^bsub>Z\<^sub>p_x\<^esub> (lt f)"
        using g_def by auto
      have g2: "degree g < degree f"
        using g_def by auto
      have LS: "is_continuous (fun_of g)"
        using E g0 g1 g2 IH by auto
      have RS: "is_continuous (fun_of (lt f))"
        using monom_poly_is_continuous leading_term_def A0  UP_ring.lcoeff_closed
            Z\<^sub>p_x_is_UP_ring UP_domain.coeff_simp1 Z\<^sub>p_x_is_UP_domain   by metis
      have "fun_of f \<doteq>  fun_sum (fun_of g) (fun_of (lt f))"
        using  fun_of_fun_sum g0 A0 g1  eq_on_Zp_def UP_domain.lt_closed
        by (metis (mono_tags, lifting) Z\<^sub>p_x_is_UP_domain)
      then show ?thesis
        using LS RS sum_of_cont_is_cont
        by (metis eq_on_Zp_def is_continuous_eq)
    qed
  qed
qed

lemma polynomial_is_continuous:
  assumes "f \<in> carrier Z\<^sub>p_x"
  shows "is_continuous (fun_of f)"
proof-
  obtain n where n_def: "n = degree f"
    by simp
  then show ?thesis
    using assms polynomial_is_continuous_induct by auto
qed

(**************************************************************************************************)
(**************************************************************************************************)
(**********************************    Polynomial Substitution   **********************************)
(**************************************************************************************************)
(**************************************************************************************************)

(*The inclusion of Z\<^sub>p into Z\<^sub>p_x*)

abbreviation to_poly :: "padic_int \<Rightarrow> padic_int_poly" where
"to_poly \<equiv> to_polynomial Z\<^sub>p"

lemma to_poly_is_ring_hom:
"to_poly \<in> ring_hom Z\<^sub>p Z\<^sub>p_x"
  by (simp add: UP_domain.to_poly_is_ring_hom)

abbreviation sub :: "padic_int_poly \<Rightarrow> padic_int_poly \<Rightarrow> padic_int_poly" (infixl "of" 70)where
"sub \<equiv> compose Z\<^sub>p"

abbreviation rev_sub :: "padic_int_poly \<Rightarrow> padic_int_poly \<Rightarrow> padic_int_poly" where
"rev_sub \<equiv> rev_compose Z\<^sub>p"

lemma sub_rev_sub:
"sub f g = rev_sub g f"
  by (simp add:  UP_domain.sub_rev_sub)

(*The polynomial X*)
abbreviation X where
"X \<equiv> X_poly Z\<^sub>p"

(*Translates of X*)
abbreviation X_plus where
"X_plus \<equiv> X_poly_plus  Z\<^sub>p"

abbreviation X_minus where
"X_minus \<equiv> X_poly_minus  Z\<^sub>p"

(*Powers of X*)
abbreviation X_pow where
"X_pow n \<equiv> X[^]\<^bsub>Z\<^sub>p_x\<^esub>n"

(*The Taylor expansion*)

abbreviation Taylor ("T\<^bsub>_\<^esub>") where
"Taylor \<equiv> taylor_expansion Z\<^sub>p"

(*Derivative function*)

abbreviation deriv   where
"deriv \<equiv> derivative Z\<^sub>p"

(*Zero coefficient function*)
abbreviation cf0 where
"cf0 \<equiv> zero_coefficient"

(*The horner shift function. Satisfies the equation:       f = a0 + X(poly_shift f)      *)
abbreviation poly_shift where
"poly_shift \<equiv> polynomial_shift Z\<^sub>p"

(*The iterated shift function. Satisfies   f = a0 + a1*X + ...+ (an-1)*X^(n-1) + X^n(shift n f) *)
abbreviation shift where
"shift \<equiv> poly_shift_iter Z\<^sub>p"

(*The "first n+1 terms" function*)
abbreviation deg_leq where
"deg_leq \<equiv> degree_n_or_less_terms Z\<^sub>p"

(*The linear part function*)
abbreviation lin_part where
"lin_part \<equiv> linear_part Z\<^sub>p"

(*the derivative operator*)

abbreviation pderiv where
"pderiv \<equiv> poly_deriv Z\<^sub>p"

(*Evaluating polynomials in the residue rings*)

lemma fun_of_res_X_pow:
  assumes "a \<in> carrier Z\<^sub>p"
  assumes "b \<in> carrier Z\<^sub>p"
  assumes "a k = b k"
  shows "(X_pow(n::nat)\<^emph> a) k = (X_pow n\<^emph>b) k"
proof(induction n)
  case 0
  then show ?case
    by (smt Z\<^sub>p_x_is_UP_domain Z\<^sub>p_x_is_UP_ring Z\<^sub>p_x_ring UP_domain.X_closed UP_ring.deg_monom
        UP_ring.monom_one Zp_one_car Zp_one_notzero assms(1) assms(2) degree_0_is_constant
        eq_on_Zp_def is_constant_fun_def monoid.nat_pow_0 pow_closedP ring_def)
next
  case (Suc n)
  fix n::nat
  assume IH: "(X [^]\<^bsub>Z\<^sub>p_x\<^esub> n \<^emph> a) k = (X [^]\<^bsub>Z\<^sub>p_x\<^esub> n \<^emph> b) k"
  show "(X [^]\<^bsub>Z\<^sub>p_x\<^esub> Suc n \<^emph> a) k = (X [^]\<^bsub>Z\<^sub>p_x\<^esub> Suc n \<^emph> b) k"
  proof-
    have LHS0: "(X [^]\<^bsub>Z\<^sub>p_x\<^esub> Suc n \<^emph> a) k = ((X [^]\<^bsub>Z\<^sub>p_x\<^esub> n \<^emph> a) \<otimes> (X \<^emph> a)) k"
      by (metis (no_types, lifting) Z\<^sub>p_x_is_UP_domain Z\<^sub>p_x_ring UP_domain.X_closed
          UP_domain.fun_of_mult assms(1) monoid.nat_pow_Suc pow_closedP ring_def)
    have LHS1: "(X [^]\<^bsub>Z\<^sub>p_x\<^esub> Suc n \<^emph> a) k = (X [^]\<^bsub>Z\<^sub>p_x\<^esub> n \<^emph> a) k \<otimes>\<^bsub>R k\<^esub> (X \<^emph> a) k"
      using LHS0
      by (simp add:  Z\<^sub>p_def padic_mult_simp)
    then show ?thesis using assms IH
      by (smt Z\<^sub>p_x_is_UP_domain Z\<^sub>p_x_ring UP_domain.X_closed
          UP_domain.fun_of_X UP_domain.fun_of_mult Z\<^sub>p_def monoid.nat_pow_Suc
          monoid.simps(1) padic_simps(3) pow_closedP ring_def)
  qed
qed

lemma fun_of_res_lt:
  assumes "a \<in> carrier Z\<^sub>p"
  assumes "b \<in> carrier Z\<^sub>p"
  assumes "f \<in> carrier Z\<^sub>p_x"
  assumes "a k = b k"
  shows "((lt f)\<^emph>a) k = ((lt f)\<^emph>b) k"
proof-
  have "lt f = (lc f)\<odot>\<^bsub>Z\<^sub>p_x\<^esub>(X_pow (degree f))"
    by (simp add: UP_domain.lt_rep_X_pow assms(3))
  have LHS0: "(fun_of (lt f) a) = (lc f) \<otimes> (fun_of (X_pow (degree f)) a)"
    by (simp add: UP_domain.X_closed UP_domain.fun_of_smult UP_domain.lc_closed \<open>lt f = lc f \<odot>\<^bsub>Z\<^sub>p_x\<^esub> X [^]\<^bsub>Z\<^sub>p_x\<^esub> degree f\<close> assms(1) assms(3))
  have RHS0: "(fun_of (lt f) b) = (lc f) \<otimes> (fun_of (X_pow (degree f)) b)"
    by (simp add: UP_domain.X_closed UP_domain.fun_of_smult UP_domain.lc_closed \<open>lt f = lc f \<odot>\<^bsub>Z\<^sub>p_x\<^esub> X [^]\<^bsub>Z\<^sub>p_x\<^esub> degree f\<close> assms(2) assms(3))
  have LHS1: "(fun_of (lt f) a) k = ((lc f) k) \<otimes>\<^bsub>R k\<^esub> (fun_of (X_pow (degree f)) a) k"
    using LHS0 assms
    by (simp add:  Z\<^sub>p_def padic_simps(3))
  have RHS1: "(fun_of (lt f) b) k = ((lc f) k) \<otimes>\<^bsub>R k\<^esub> (fun_of (X_pow (degree f)) b) k"
    using RHS0 assms
    by (simp add:  Z\<^sub>p_def padic_simps(3))
  then show ?thesis
    using LHS1 RHS1 assms
    by (metis fun_of_res_X_pow)
qed

(*Polynomial application commutes with taking residues*)
lemma fun_of_res:
  assumes "f \<in> carrier Z\<^sub>p_x"
  assumes "a \<in> carrier Z\<^sub>p"
  assumes "b \<in> carrier Z\<^sub>p"
  assumes "a k = b k"
  shows "(f\<^emph>a) k = (f\<^emph>b) k"
proof(rule UP_domain.poly_induct2[of Z\<^sub>p f])
  show "UP_domain Z\<^sub>p"
    by simp
  show "f \<in> carrier Z\<^sub>p_x"
    using assms by simp
  show "\<And>p. p \<in> carrier Z\<^sub>p_x \<Longrightarrow> degree p = 0 \<Longrightarrow> (p \<^emph> a) k = (p \<^emph> b) k"
    by (metis Z\<^sub>p_x_is_UP_domain UP_domain.degree_0_imp_constant0 assms(2) assms(3))
  show "\<And>p. 0 < degree p \<Longrightarrow> p \<in> carrier Z\<^sub>p_x \<Longrightarrow> (trunc p \<^emph> a) k = (trunc p \<^emph> b) k
                \<Longrightarrow> (p \<^emph> a) k = (p \<^emph> b) k"
  proof-
    fix p
    assume A: "0 < degree p" "p \<in> carrier Z\<^sub>p_x"
    assume IH: " (trunc p \<^emph> a) k = (trunc p \<^emph> b) k "
    show "(p \<^emph> a) k = (p \<^emph> b) k"
    proof-
      have "(p \<^emph> a) k = (((trunc p)\<^emph> a) \<oplus> ((lt p) \<^emph> a)) k "
        by (metis A(2) Z\<^sub>p_x_is_UP_domain UP_domain.fun_of_plus
            UP_domain.lt_closed UP_domain.trunc_simps(1) UP_domain.trunc_simps(3) assms(2))
      then have 0: "(p \<^emph> a) k = (((trunc p)\<^emph> b) k) \<oplus>\<^bsub>R k\<^esub> ((lt p) \<^emph> a) k "
        using IH
        by (simp add:  Z\<^sub>p_def padic_add_def)
      have "((lt p) \<^emph> a) k = ((lt p) \<^emph> b) k"
        by (simp add: A(2) assms(2) assms(3) assms(4) fun_of_res_lt)
      then have 1: "(p \<^emph> a) k = (((trunc p)\<^emph> b) k) \<oplus>\<^bsub>R k\<^esub> ((lt p) \<^emph> b) k "
        using 0 by auto
      then have 2: "(p \<^emph> a) k = (((trunc p)\<^emph> b) \<oplus> ((lt p) \<^emph> b)) k "
        using IH Z\<^sub>p_def \<open>(lt p \<^emph> a) k = (lt p \<^emph> b) k\<close> \<open>(p \<^emph> a) k = (trunc p \<^emph> a \<oplus> lt p \<^emph> a) k\<close>
          padic_add_def by auto
      then have 2: "(p \<^emph> a) k = (((trunc p) \<oplus>\<^bsub>Z\<^sub>p_x\<^esub>(lt p)) \<^emph> b) k"
        by (simp add: A(2) UP_domain.fun_of_plus UP_domain.lt_closed
            UP_domain.trunc_simps(3) assms(3))
      then show ?thesis
        by (metis A(2) Z\<^sub>p_x_is_UP_domain UP_domain.trunc_simps(1))
    qed
  qed
qed

(*If a and b has equal kth residues, then do f'(a) and f'(b)*)
lemma deriv_res:
  assumes "f \<in> carrier Z\<^sub>p_x"
  assumes "a \<in> carrier Z\<^sub>p"
  assumes "b \<in> carrier Z\<^sub>p"
  assumes "a k = b k"
  shows "(deriv f a) k = (deriv f b) k"
proof-
  have 0: "deriv f a = fun_of (pderiv f) a"
    by (simp add: UP_domain.pderiv_eval_deriv assms(1) assms(2))
  have 1: "deriv f b = fun_of (pderiv f) b"
    by (simp add: UP_domain.pderiv_eval_deriv assms(1) assms(3))
  have 2: "pderiv f \<in> carrier Z\<^sub>p_x"
    by (simp add: UP_domain.poly_deriv_closed assms(1))
  show ?thesis
    using assms fun_of_res[of "pderiv f" a b k] 0 1 2
    by auto
qed

(*Predicate for a polynomial that satisfies the hypothesis of Hensel's lemma at a point a*)
abbreviation hensel where
"hensel f a \<equiv> (f \<in> carrier Z\<^sub>p_x \<and> a \<in> carrier Z\<^sub>p \<and> ((f \<^emph> a) 1) = 0 \<and> (deriv f a 1) \<noteq> 0)"

(*Proving the existence of the sequence for hensel's lemma*)
lemma pre_hensel:
assumes "hensel f a"
assumes "b \<in> carrier Z\<^sub>p \<and> (f \<^emph> b) (Suc n) = 0 \<and> b 1 = a 1"
shows "\<exists> b' \<in> carrier Z\<^sub>p. (f \<^emph> b') (Suc (Suc n)) = 0 \<and> b' 1 = a 1 \<and> b' (Suc n) = b (Suc n)"
proof-
    have b_def: "b \<in> carrier Z\<^sub>p \<and> (f \<^emph> b) (Suc n) = 0 \<and> b 1 = a 1"
      using assms by blast
    have  "val_Zp (\<p>[^](Suc n)) \<preceq>\<^bsub>G\<^esub> val_Zp (f \<^emph> b)"
    proof(cases "f \<^emph> b = \<zero>")
      case True
      then show ?thesis
        by (simp add: G_ord(1) val_Zp_def)
    next
      case False
      then have "f \<^emph> b \<in>nonzero Z\<^sub>p"
        using assms(1) b_def not_nonzero_Zp
        by (meson Z\<^sub>p_x_is_UP_domain fun_of_closed_UP_domain)
      then have "ord_Zp (f \<^emph> b) \<ge> Suc n"
        using b_def  False Zp_nonzero_def(1) ord_Zp_geq by metis
      then have "ord_Zp (\<p>[^](Suc n)) \<le> ord_Zp (f \<^emph> b)"
        using b_def  ord_Zp_p_pow
        by presburger
      then show ?thesis
        using False G_ord(2) \<open>int (Suc n) \<le> ord_Zp (f \<^emph> b)\<close>
          ord_Zp_def val_Zp_def val_Zp_p_pow[of "Suc n"]
        by (metis val_Zp_p_pow )
    qed
    then have 1:"divide (f \<^emph> b) (\<p>[^](Suc n)) \<otimes> (\<p>[^](Suc n)) = f \<^emph> b"
      using assms b_def continuous_is_closed divide_id'(2)  is_closed_fun_simp
        p_pow_nonzero polynomial_is_continuous
      by presburger
    have 2: "(deriv f a) \<in> carrier Z\<^sub>p"
      by (simp add: UP_domain.derivative_closed assms)
    have 3: "(deriv f a) 1 \<noteq> 0"
      using assms by blast
    have "ord_Zp (deriv f a) = 0"
      using 2 3 by (simp )
    then have 4: "(deriv f a) \<in> Units Z\<^sub>p"
      using 2 ord_Zp_0_imp_unit[of "(deriv f a)"]
      by blast

    obtain k where  k_def: "k =inv\<^bsub>(R 1)\<^esub> ((deriv f a) 1)"
      by simp

    have "k \<otimes>\<^bsub>R 1\<^esub>((deriv f a) 1) = \<one>\<^bsub>R 1\<^esub> \<and> k \<in> carrier (R 1)"
    proof-
      have P0:"field (R 1)"
        using Res_1_field by auto
      have P1: "(deriv f a) 1 \<in> carrier (R 1)"
        using 2  Z\<^sub>p_def by (metis padic_set_simp0 partial_object.select_convs(1))
      have "\<zero>\<^bsub>R 1\<^esub> = 0"
        by (simp add:  residue_ring_def)
      then have P: "(deriv f a) 1 \<noteq> \<zero>\<^bsub>R 1\<^esub>"
        using "3" by linarith
      then have P2: "k \<otimes>\<^bsub>R 1\<^esub>((deriv f a) 1) = \<one>\<^bsub>R 1\<^esub>"
        using residue_ring_def  P0 P1  field.field_inv[of "R 1" "(deriv f a) 1"] k_def
        by metis
      have "(deriv f a) 1 \<in> Units (R 1)"
        using "3" P1 Res_1_field \<open>\<zero>\<^bsub>R 1\<^esub> = 0\<close> field_axioms_def field_def by fastforce
      have P3: "k \<in> carrier (R 1)"
        using k_def P0 P1 P field.field_inv[of "R 1" "(deriv f a) 1"] by auto
      then show ?thesis
        using P3 P2 by auto
    qed

    obtain m::int where m_def: "m =(\<ominus>\<^bsub>R 1\<^esub> (((divide (f \<^emph> b) (\<p>[^](Suc n))) 1) \<otimes>\<^bsub>R 1\<^esub> k))"
      by simp
    obtain t where t_def: "t = [m]\<cdot>\<one>"
      by simp

    have 5: "(f \<^emph> (b \<oplus> ((\<p>[^](Suc n)) \<otimes> t))) (Suc (Suc n)) = 0"
    proof-
      obtain fb where fb_def[simp]: "fb = f \<^emph> b"
        by simp
      obtain f'b where f'b_def[simp]: "f'b = (deriv f b)"
        by simp
      obtain c where c_def: "c = (shift 2 (T\<^bsub>b\<^esub>f)) \<^emph> ((\<p>[^](Suc n)) \<otimes> t)"
        by simp
      have pnt_car: "((\<p>[^](Suc n)) \<otimes> t) \<in> carrier Z\<^sub>p"
        by (simp add: Zp_int_mult_closed Zp_one_car
            cring.cring_simprules(5) t_def)
      have c_car:"c \<in> carrier Z\<^sub>p"
        using Z\<^sub>p_x_is_UP_domain Taylor_closed_UP_domain
              poly_shift_closed_UP_domain pnt_car c_def
        by (simp add: assms)
      have A0: " f \<^emph> (\<p> [^] (Suc n) \<otimes> t \<oplus> b) = fb \<oplus> f'b \<otimes> (\<p> [^] (Suc n) \<otimes> t) \<oplus> c \<otimes> (\<p> [^](Suc n) \<otimes> t) [^] (2::nat)"
      proof-
        have P0: "\<p> [^] (Suc n) \<otimes> t \<in> carrier Z\<^sub>p"
          by (simp add: Zp_int_mult_closed Zp_one_car cring.cring_simprules(5)  t_def)
        have P1: "f \<in> carrier Z\<^sub>p_x"
          using assms by auto
        have P2: "b \<in> carrier Z\<^sub>p"
          using b_def by auto
        show ?thesis
          using P0 P1 P2   fb_def f'b_def c_def
                Z\<^sub>p_x_is_UP_domain UP_domain.Taylor_deg_1_eval[of Z\<^sub>p f b "(\<p>[^](Suc n)) \<otimes> t" c fb f'b]
        by auto
      qed
      have A1: "(c \<otimes> (\<p> [^] (Suc n) \<otimes> t) [^] (2::nat)) (Suc (Suc n)) = 0"
      proof-
        have Q0: "(\<p> [^] (Suc n) \<otimes> t) [^] (2::nat) = ((\<p> [^] (Suc n)) [^] (2::nat)) \<otimes> (t [^] (2::nat))"
          using Zp_int_mult_closed Zp_is_cring Zp_one_car
            comm_monoid.nat_pow_distr cring_def p_pow_car_nat t_def
          by (simp add: comm_monoid.nat_pow_distr cring_def)
        then have Q1:"t = \<zero> \<or> ord_Zp ((\<p> [^] (Suc n) \<otimes> t) [^] (2::nat)) \<ge> 2*(Suc n)"
        proof(cases "t = \<zero>")
          case True
          then show ?thesis by metis
        next
          case False
          then have Q1: "ord_Zp ((\<p> [^] (Suc n) \<otimes> t) [^] (2::nat)) = ord_Zp ((\<p> [^] (Suc n)) [^] (2::nat))
                                                         + ord_Zp (t [^] (2::nat))"
            using Q0 ord_Zp_mult
            by (metis Zp_int_mult_closed Zp_nat_pow_nonzero Zp_one_car not_nonzero_Zp p_pow_nonzero t_def)
          have Q2: "ord_Zp ((\<p> [^] (Suc n)) [^] (2::nat))  = 2*(Suc n)"
            using  ord_Zp_p_pow ord_Zp_pow p_pow_nonzero by presburger
          have Q3: "ord_Zp (t [^] (2::nat)) \<ge> 0"
            by (metis False Zp_int_mult_closed Zp_one_car mult_sign_intros(1)
                not_nonzero_Zp of_nat_0_le_iff ord_Zp_pow ord_pos t_def)
          show ?thesis using Q1 Q2 Q3
            by linarith
        qed
        show ?thesis
        proof(cases "t = \<zero>")
          case True
          then have "(c \<otimes> (\<p> [^] (Suc n) \<otimes> t) [^] (2::nat)) = \<zero>"
          proof-
            have "(\<p> [^] (Suc n) \<otimes> t) = \<zero>"
              using True
              by (metis Zp_int_mult_closed Zp_is_cring Zp_one_car
                  cring.cring_simprules(14) cring.cring_simprules(26) p_pow_car_nat t_def)
            then have "(\<p> [^] (Suc n) \<otimes> t) [^] (2::nat) = \<zero>"
              by simp
            then have "(c \<otimes> (\<p> [^] (Suc n) \<otimes> t) [^] (2::nat)) = \<zero>"
              using c_car by simp
            then show ?thesis
              by blast
          qed
          then show ?thesis
            by (simp add: zero_vals)
        next
          case False
          then have Q2:"ord_Zp ((\<p> [^] (Suc n) \<otimes> t) [^] (2::nat)) \<ge> 2*(Suc n)"
            using Q1 by metis
          have Q3: "2*(Suc n) \<ge> Suc (Suc n)"
            by auto
          then have Q4:"ord_Zp ((\<p> [^] (Suc n) \<otimes> t) [^] (2::nat)) \<ge> (Suc (Suc n))"
            using Q2 by linarith
          have "((\<p> [^] (Suc n)   \<otimes> t) [^] (2::nat)) \<in> carrier Z\<^sub>p"
            by (simp add: Zp_int_mult_closed Zp_one_car cring.cring_simprules(5) t_def)
          then have "((\<p> [^] (Suc n)  \<otimes> t) [^] (2::nat)) (Suc (Suc n)) = 0"
            using  Q4  int.lless_eq zero_below_ord
            by blast
          then show ?thesis
            using  c_car  \<open>(\<p> [^] Suc n \<otimes> t) [^] 2 \<in> carrier Z\<^sub>p\<close> res_mult_zero(2)
            by blast
        qed
      qed
      have A2:"fb \<oplus> f'b \<otimes> (\<p> [^] (Suc n) \<otimes> t) \<in> carrier Z\<^sub>p"
      proof-
        have A20: "f'b \<in> carrier Z\<^sub>p"
          using f'b_def  assms b_def UP_domain.derivative_closed[of Z\<^sub>p f b] Z\<^sub>p_x_is_UP_domain
          by blast
        have A21: "fb \<in> carrier Z\<^sub>p"
          using fb_def b_def assms
          by simp
        then show ?thesis
          using t_def
          using A20 cring.cring_simprules(5) pnt_car by force
      qed
      have A3: "c \<otimes> (\<p> [^](Suc n) \<otimes> t) [^] (2::nat) \<in> carrier Z\<^sub>p"
        using c_car monom_term_car pnt_car by auto
      have A4: " (f \<^emph> (\<p> [^] (Suc n) \<otimes> t \<oplus> b)) (Suc (Suc n))
                    = (fb \<oplus> f'b \<otimes> (\<p> [^] (Suc n) \<otimes> t)) (Suc (Suc n))"
        using A0 A1 A2 A3
              res_add_zero(2)[of "(Suc (Suc n))" "c \<otimes> (\<p> [^](Suc n) \<otimes> t) [^] (2::nat)"
                                          "fb \<oplus> f'b \<otimes> (\<p> [^] (Suc n) \<otimes> t)"]
        by (metis p_pow_rep0 scalar_mult_def zero_less_Suc)
      have A6: "(f'b \<otimes> (\<p> [^] (Suc n) \<otimes> t)) \<in> carrier Z\<^sub>p"
      proof-
        have A20: "f'b \<in> carrier Z\<^sub>p"
          using f'b_def  assms b_def UP_domain.derivative_closed[of Z\<^sub>p f b] Z\<^sub>p_x_is_UP_domain
          by blast
        then show ?thesis using t_def
          using Zp_is_cring cring.cring_simprules(5) pnt_car by fastforce
      qed
      have A7: "fb  \<in> carrier Z\<^sub>p"
        using fb_def b_def assms
          by simp
      have A8: "(fb \<oplus> f'b \<otimes> (\<p> [^] (Suc n) \<otimes> t)) (Suc (Suc n)) = 0"
      proof-
        obtain fa where fa_def[simp]: "fa = fun_of f a"
          by simp
        obtain f'a where f'a_def[simp]: "f'a = deriv f a"
          by simp
        have A80: "(f'a \<otimes> t) 1= \<ominus>\<^bsub>R 1\<^esub>(divide (fb) (\<p>[^](Suc n))) 1"
        proof-
          have C0: "t 1 = m mod p"
          proof-
            have 0: "t 1 = ([m]\<cdot>\<one>) 1"
              using t_def by auto
            have 1: "([m]\<cdot>\<one>) 1 = m mod p"
              using  int_inc_rep r_def by auto
            then show ?thesis using 0 1 by auto
          qed
          show C1: "(f'a \<otimes> t) 1 = \<ominus>\<^bsub>R 1\<^esub>(divide (fb) (\<p>[^](Suc n))) 1"
          proof-
            have C10:"(f'a \<otimes> t) 1  = (f'a 1) \<otimes>\<^bsub>R 1\<^esub> (t 1)"
              by (simp add:  Z\<^sub>p_def padic_mult_simp)
            have C11:"(f'a \<otimes> t) 1  = (f'a 1) \<otimes>\<^bsub>R 1\<^esub>(\<ominus>\<^bsub>R 1\<^esub> (((divide (f \<^emph> b) (\<p>[^](Suc n))) 1) \<otimes>\<^bsub>R 1\<^esub> k))"
              using C10 m_def C0
              by (smt R_residues  mod_mult_right_eq of_nat_0_less_iff
                  of_nat_le_0_iff power_one_right residues.res_mult_eq zero_neq_one)
            have C12: "(f'a \<otimes> t) 1  = ((f'a 1) )\<otimes>\<^bsub>R 1\<^esub>(\<ominus>\<^bsub>R 1\<^esub> (k \<otimes>\<^bsub>R 1\<^esub>(((divide (f \<^emph> b) (\<p>[^](Suc n))) 1))))"
            proof-
              have C120:"((divide (f \<^emph> b) (\<p>[^](Suc n))) 1) \<in> carrier (R 1)"
                by (metis A7  Z\<^sub>p_def \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close>
                    divide_id'(1) fb_def p_pow_nonzero padic_set_simp0
                    partial_object.select_convs(1))
              have C121: "k \<in> carrier R 1"
                using \<open>k \<otimes>\<^bsub>R 1\<^esub> deriv f a 1 = \<one>\<^bsub>R 1\<^esub> \<and> k \<in> carrier R 1\<close> by auto
              have C122: "(\<ominus>\<^bsub>R 1\<^esub> (((divide (f \<^emph> b) (\<p>[^](Suc n))) 1) \<otimes>\<^bsub>R 1\<^esub> k))
                              =(\<ominus>\<^bsub>R 1\<^esub> (k \<otimes>\<^bsub>R 1\<^esub> ((divide (f \<^emph> b) (\<p>[^](Suc n))) 1)))"
                using C120 C121   Res_1_field
                by (metis R_residues  mult.commute nat_less_le
                    residues.res_mult_eq zero_le_one zero_neq_one)
              have C123: "f'a 1 \<in> carrier (R 1)"
                by (metis "2"  Z\<^sub>p_def f'a_def padic_set_simp0 partial_object.select_convs(1))
              show ?thesis
                unfolding a_minus_def
                using  C11 C120 C121 C122 C123   Res_1_field
                by simp
            qed
            have C13: "k \<in> carrier R 1"
              using \<open>k \<otimes>\<^bsub>R 1\<^esub> deriv f a 1 = \<one>\<^bsub>R 1\<^esub> \<and> k \<in> carrier R 1\<close> by auto
            have C14: "f'a 1 \<in> carrier (R 1)"
              by (metis "2"  Z\<^sub>p_def f'a_def padic_set_simp0 partial_object.select_convs(1))
            have C15: "(k \<otimes>\<^bsub>R 1\<^esub>(((divide (f \<^emph> b) (\<p>[^](Suc n))) 1))) \<in> carrier (R 1)"
            proof-
              have "(divide (f \<^emph> b) (\<p>[^](Suc n))) \<in> carrier Z\<^sub>p"
                using A7 \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close> divide_id'(1) fb_def p_pow_nonzero
                by blast
              then have "(divide (f \<^emph> b) (\<p>[^](Suc n))) 1 \<in> carrier (R 1)"
                by (metis  Z\<^sub>p_def padic_set_simp0 partial_object.select_convs(1))
              then show ?thesis using Res_1_field C13
                by (metis le_eq_less_or_eq not_one_le_zero res_mult_closed zero_le_one)
            qed
            then have "(f'a \<otimes> t) 1  = (\<ominus>\<^bsub>R 1\<^esub> ((f'a 1) )\<otimes>\<^bsub>R 1\<^esub>(k \<otimes>\<^bsub>R 1\<^esub>(((divide (f \<^emph> b) (\<p>[^](Suc n))) 1))))"
              using C12 C13 C14 C15 Res_1_field R_cring[of 1] R_residues[of 1]
              by (simp add: cring.cring_simprules(28) cring.cring_simprules(29))
            then have "(f'a \<otimes> t) 1  = (\<ominus>\<^bsub>R 1\<^esub> ((f'a 1) \<otimes>\<^bsub>R 1\<^esub> k ) \<otimes>\<^bsub>R 1\<^esub>(((divide (f \<^emph> b) (\<p>[^](Suc n))) 1)))"
              using C12 C13 C14 C15 Res_1_field R_cring[of 1] R_residues[of 1]
              by (metis (no_types, lifting) A7 Z\<^sub>p_def \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close>
                  cring.cring_simprules(11) cring.cring_simprules(28) cring.cring_simprules(3)
                  divide_id'(1) fb_def p_pow_nonzero padic_set_simp0 partial_object.select_convs(1)
                  zero_less_one)
            then have  "(f'a \<otimes> t) 1  = (\<ominus>\<^bsub>R 1\<^esub> (((divide (f \<^emph> b) (\<p>[^](Suc n))) 1)))"
              using k_def 4 Res_1_field  C12 C13 C14 C15 Res_1_field R_cring[of 1] R_residues[of 1]
              by (smt A7  Z\<^sub>p_def \<open>k \<otimes>\<^bsub>R 1\<^esub> deriv f a 1 = \<one>\<^bsub>R 1\<^esub> \<and> k \<in> carrier R 1\<close>
                  \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close> cring.cring_simprules(12)
                  cring.cring_simprules(14) cring.cring_simprules(29) cring.cring_simprules(3)
                  cring.cring_simprules(5) divide_id'(1) f'a_def fb_def p_pow_nonzero
                  padic_set_simp0 partial_object.select_convs(1) zero_less_one)
            then show ?thesis
              using fb_def by auto
          qed
        qed
        then have A81: "(f'a \<otimes> t) 1= (\<ominus> (divide (fb) (\<p>[^](Suc n)))) 1"
          using res_uminus A7  Z\<^sub>p_def \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close>
            divide_id'(1) p_pow_nonzero padic_inv prime
          by (metis (no_types, lifting) fb_def)
        have A82: "(fb \<oplus> f'a \<otimes>(\<p>[^](Suc n) \<otimes> t)) (Suc (Suc n)) = 0"
        proof-
          obtain h where h_def: "h \<in> carrier Z\<^sub>p \<and> (f'a \<otimes> t)
                          = (\<ominus>(divide (fb) (\<p>[^](Suc n)))) \<oplus> h \<otimes> \<p>[^](1::nat)"
            using eq_res_mod[of "(f'a \<otimes> t)" "\<ominus>(divide (fb) (\<p>[^](Suc n)))" 1]
            by (metis (no_types, lifting) "2" A7 A81 Zp_int_inc_closed Zp_is_cring
                \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close> cring.cring_simprules(14)
                cring.cring_simprules(3) cring.cring_simprules(5) divide_id'(1) f'a_def
                fb_def p_pow_car_nat p_pow_nonzero t_def)
          have A820: "(f'a \<otimes> t) \<in> carrier Z\<^sub>p"
            by (metis A7 Zp_is_cring \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close>
                cring.cring_simprules(3) cring.cring_simprules(5) divide_id'(1)
                fb_def h_def p_pow_car_nat p_pow_nonzero sum_closed)
          have A821: "(\<ominus>(divide (fb) (\<p>[^](Suc n)))) \<in> carrier Z\<^sub>p"
            by (metis A7 Zp_is_cring \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close>
                cring.cring_simprules(3) divide_id'(1) fb_def p_pow_nonzero)
          have A822: "(h \<otimes> \<p>[^](1::nat)) \<in> carrier Z\<^sub>p"
            by (simp add: Zp_nat_inc_closed h_def monom_term_car)
          have A823:"(f'a \<otimes> t) \<oplus> (divide (fb) (\<p>[^](Suc n))) =  h \<otimes> \<p>[^](1::nat)"
            using h_def A820 A821 A822 Zp_is_cring
            by (metis A7 \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close>
                cring.cring_simprules(10) cring.cring_simprules(19)
                cring.cring_simprules(21) divide_id'(1) fb_def p_pow_nonzero)
          then have A824: "(f'a \<otimes> t)\<otimes>  (\<p>[^](Suc n)) \<oplus> (fb)  = h \<otimes> (\<p>[^](Suc (Suc n)))"
          proof-
            have "((f'a \<otimes> t) \<oplus> (divide (fb) (\<p>[^](Suc n)))) \<otimes>  (\<p>[^](Suc n)) =  h \<otimes> \<p>[^](1::nat) \<otimes>  (\<p>[^](Suc n))"
              using A823 by auto
            then have A8240: "((f'a \<otimes> t) \<otimes>  (\<p>[^](Suc n))) \<oplus> (divide (fb) (\<p>[^](Suc n))) \<otimes>  (\<p>[^](Suc n)) =  h \<otimes> (\<p>[^](1::nat) \<otimes>  (\<p>[^](Suc n)))"
              using A820 A821 A822 Zp_is_cring
              by (metis A7 \<open>val_Zp (f \<^emph> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close> cring.cring_simprules(11)
                  cring.cring_simprules(13) divide_id'(1) fb_def h_def p_pow_car_nat p_pow_nonzero)
            have "(divide (fb) (\<p>[^](Suc n))) \<otimes>  (\<p>[^](Suc n))  = fb"
              by (simp add: "1")
            then have A8241: "((f'a \<otimes> t) \<otimes>  (\<p>[^](Suc n))) \<oplus>  (fb) =  h \<otimes> (\<p>[^](1::nat) \<otimes>  (\<p>[^](Suc n)))"
              using A8240 by metis
            then show ?thesis
              by (simp add: p_natpow_prod)
          qed
          then show ?thesis
            using p_pow_factor[of h "(Suc (Suc n))" "Suc (Suc n)"]
            by (metis (mono_tags, lifting) "2" A7 A820 Zp_int_mult_closed Zp_is_cring
                Zp_nat_mult_closed Zp_one_car cring.cring_simprules(10)
                cring.cring_simprules(11) cring.cring_simprules(14)
                f'a_def h_def monom_term_car order_refl p_pow_car_nat t_def)
        qed
        have A83: "(f'a \<otimes>(\<p>[^](Suc n) \<otimes> t)) (Suc (Suc n))
                          =  (f'b \<otimes> (\<p> [^] (Suc n) \<otimes> t))(Suc (Suc n))"
        proof-
          have A830: "f'a 1 = f'b 1"
            using f'a_def f'b_def b_def assms deriv_res
            by metis
          have A831: "f'a \<in> carrier Z\<^sub>p"
            using f'a_def   "2" by blast
          have A832: "f'b \<in> carrier Z\<^sub>p"
            using f'b_def b_def assms UP_domain.derivative_closed[of Z\<^sub>p f b] Z\<^sub>p_x_is_UP_domain
            by auto
          then obtain j where j_def0: "j \<in> carrier Z\<^sub>p \<and> f'a = f'b \<oplus> (\<p>[^](1::nat) \<otimes>j)"
            using f'a_def f'b_def   eq_res_mod[of f'a f'b 1] A830 A831 A832
            by auto
          then have j_def: "j \<in> carrier Z\<^sub>p \<and> f'a = f'b \<oplus> (j \<otimes> \<p>)"
            by (simp add: Zp_nat_inc_closed cring.cring_simprules(14) p_pow_rep0)
          then have "(f'a \<otimes>(\<p>[^](Suc n) \<otimes> t)) =  (f'b \<oplus> (j \<otimes> \<p>))\<otimes>(\<p>[^](Suc n) \<otimes> t)"
            by blast
          then have "(f'a \<otimes>(\<p>[^](Suc n) \<otimes> t)) =  (f'b\<otimes>(\<p>[^](Suc n) \<otimes> t)) \<oplus> (j \<otimes> \<p>)\<otimes>(\<p>[^](Suc n) \<otimes> t)"
            by (metis A832 Zp_is_cring Zp_nat_inc_closed cring.cring_simprules(13)
                cring.cring_simprules(5) j_def0 pnt_car)
          then have "(f'a \<otimes>(\<p>[^](Suc n) \<otimes> t)) =  (f'b\<otimes>(\<p>[^](Suc n) \<otimes> t)) \<oplus> (j \<otimes> \<p>[^](Suc (Suc n)) \<otimes> t)"
            by (metis Zp_int_inc_closed Zp_is_cring Zp_nat_inc_closed cring.cring_simprules(11)
                j_def p_natpow_prod_Suc(1) p_pow_car_nat pnt_car t_def)
          then have A833: "(f'a \<otimes>(\<p>[^](Suc n) \<otimes> t)) =  (f'b\<otimes>(\<p>[^](Suc n) \<otimes> t)) \<oplus> ( \<p>[^](Suc (Suc n)) \<otimes> (j \<otimes>t))"
            by (metis (no_types, lifting) Z\<^sub>p_def Zp_is_cring Zp_one_car cring.cring_simprules(14)
                j_def p_pow_car_nat padic_integers.Zp_int_mult_closed padic_integers_axioms
                padic_mult_assoc prime t_def)
          have A834:"( \<p>[^](Suc (Suc n)) \<otimes> (j \<otimes>t)) (Suc (Suc n)) = 0"
            by (smt Z\<^sub>p_def Zp_is_cring Zp_one_car cring.cring_simprules(5) j_def ord_Zp_p_pow
                p_pow_car_nat padic_integers.Zp_int_mult_closed padic_integers.res_mult_zero(1)
                padic_integers_axioms t_def zero_below_ord zero_less_Suc)
          have "(f'a \<otimes>(\<p>[^](Suc n) \<otimes> t)) (Suc (Suc n)) =
                          (f'b\<otimes>(\<p>[^](Suc n) \<otimes> t)) (Suc (Suc n))
                        \<oplus>\<^bsub>R (Suc (Suc n))\<^esub> ( \<p>[^](Suc (Suc n)) \<otimes> (j \<otimes>t))(Suc (Suc n))"
            using A833
            by (simp add:  Z\<^sub>p_def padic_add_def)
          then show ?thesis
            using A834
            by (smt A6 Z\<^sub>p_def Zp_is_cring Zp_one_car
                \<open>f'a \<otimes> (\<p> [^] Suc n \<otimes> t) = f'b \<otimes> (\<p> [^] Suc n \<otimes> t) \<oplus> j \<otimes> \<p> [^] Suc (Suc n) \<otimes> t\<close>
                cring.cring_simprules(10) cring.cring_simprules(11) cring.cring_simprules(14)
                cring.cring_simprules(5) j_def p_pow_car_nat padic_integers.Zp_int_mult_closed
                padic_integers_axioms res_add_zero(1) t_def zero_less_Suc)
        qed
        then show "(fb \<oplus> f'b \<otimes>(\<p>[^](Suc n) \<otimes> t)) (Suc (Suc n)) = 0"
          using A83 A82
          by (simp add: Z\<^sub>p_def padic_add_def)
      qed
      show ?thesis
        using A8 A4
        by (simp add: b_def cring.cring_simprules(10) pnt_car)
    qed

    obtain b1 where b1_def: "b1 = (b \<oplus> ((\<p>[^](Suc n)) \<otimes> t))"
      by simp

    have b10: "b1 \<in> carrier Z\<^sub>p"
      by (simp add: Zp_int_mult_closed Zp_one_car b1_def b_def cring.cring_simprules(5) t_def)
    have b11: "(f \<^emph> b1) (Suc (Suc n)) = 0"
      using b1_def 5
      by auto
    have b12: "b1 1 = a 1"
    proof-
      have "b1 1 = b 1"
      proof-
        have "b1 1 = (b \<oplus> ((\<p>[^](Suc n)) \<otimes> t)) 1"
          using b1_def by auto
        then have b120: "b1 1 = (b 1) \<oplus>\<^bsub>R 1\<^esub> ((\<p>[^](Suc n)) \<otimes> t) 1"
          by (simp add:  Z\<^sub>p_def padic_add_def)
        have b121: "((\<p>[^](Suc n)) \<otimes> t) 1 = 0"
          by (metis Z\<^sub>p_def Zero_not_Suc Zp_int_mult_closed Zp_one_car nat_int of_nat_0
              ord_Zp_0_criterion ord_Zp_p_pow p_pow_car_nat padic_integers.res_mult_zero(1)
              padic_integers_axioms t_def zero_less_one)
        show ?thesis
          using b120 b121
          by (smt Z\<^sub>p_def Zp_int_inc_zero Zp_int_mult_closed Zp_one_car add_zero(1)
              b_def ord_Zp_0_criterion ord_of_nonzero(1) padic_add_def ring.simps(2))
      qed
      then show ?thesis using b_def by auto
    qed
    have b13: "b1 (Suc n) = b (Suc n)"
      using b1_def
      by (simp add: Zp_int_mult_closed Zp_one_car b_def
          cring.cring_simprules(14) cring.cring_simprules(5) t_def)
    show ?thesis
      using b10 b11 b12 b13 by blast
qed

(*The sequence which will converge to the root obtained by hensel's lemma*)
fun hensel_seq where
"hensel_seq f a 0 = a"|
"hensel_seq f a (Suc n) = (SOME b. b \<in> carrier Z\<^sub>p \<and> (f \<^emph> b) (Suc (Suc n)) = 0 \<and> b 1 = a 1 \<and> b (Suc n) = (hensel_seq f a n) (Suc n))"

(*Inductive lemma for proving the properties of the hensel sequence*)
lemma hensel_seq_id_induct:
  assumes "hensel f a"
  shows
 "\<And>b0 b1. b0  = hensel_seq f a n \<Longrightarrow>
  b1  = hensel_seq f a (Suc n) \<Longrightarrow>
  b1 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b1) (Suc (Suc n)) = 0 \<and> b1 1 = a 1 \<and> b1 (Suc n) = b0 (Suc n)"
proof(induction n)
  show "\<And>b0 b1. b0 = hensel_seq f a 0 \<Longrightarrow>
        b1 = hensel_seq f a (Suc 0) \<Longrightarrow>
        b1 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b1) (Suc (Suc 0)) = 0 \<and> b1 1 = a 1 \<and> b1 (Suc 0) = b0 (Suc 0)"
  proof-
    fix b0 b1
    assume B:  "b0 = hensel_seq f a 0"
               "b1 = hensel_seq f a (Suc 0)"
    have B0: "b0 = a"
      using B
      by simp
    have B1: "b0 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b0) (Suc 0) = 0 \<and> b0 1 = a 1"
      using assms B0
      by auto
    have B2: "\<exists> b' \<in> carrier Z\<^sub>p. (f \<^emph> b') (Suc (Suc 0)) = 0 \<and> b' 1 = a 1 \<and> b' (Suc 0) = b0 (Suc 0)"
      using pre_hensel assms B1
      by blast
    have B3: "b1= (SOME b. b \<in> carrier Z\<^sub>p \<and> (f \<^emph> b) (Suc (Suc 0)) = 0 \<and> b 1 = a 1 \<and> b (Suc 0) = b0 (Suc 0))"
      using B
      by simp
    show  "b1 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b1) (Suc (Suc 0)) = 0 \<and> b1 1 = a 1 \<and> b1 (Suc 0) = b0 (Suc 0)"
      using B3 B2
      by (metis (mono_tags, lifting) B0 One_nat_def someI_ex)
  qed
  show "\<And>n b0 b1. (\<And>b0 b1. b0 = hensel_seq f a n \<Longrightarrow> b1 = hensel_seq f a (Suc n) \<Longrightarrow>
             b1 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b1) (Suc (Suc n)) = 0 \<and> b1 1 = a 1 \<and> b1 (Suc n) = b0 (Suc n)) \<Longrightarrow>
             b0 = hensel_seq f a (Suc n) \<Longrightarrow>
             b1 = hensel_seq f a (Suc (Suc n)) \<Longrightarrow>
             b1 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b1) (Suc (Suc (Suc n))) = 0 \<and> b1 1 = a 1 \<and> b1 (Suc (Suc n)) = b0 (Suc (Suc n))"
  proof-
    fix n b0 b1
    assume IH: "(\<And> b0 b1. b0 = hensel_seq f a n \<Longrightarrow> b1 = hensel_seq f a (Suc n) \<Longrightarrow>
             b1 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b1) (Suc (Suc n)) = 0 \<and> b1 1 = a 1 \<and> b1 (Suc n) = b0 (Suc n))"
    assume A: "b0 = hensel_seq f a (Suc n)"
              "b1 = hensel_seq f a (Suc (Suc n))"
    show "b1 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b1) (Suc (Suc (Suc n))) = 0 \<and> b1 1 = a 1 \<and> b1 (Suc (Suc n)) = b0 (Suc (Suc n))"
    proof-
      have A0: " b0 \<in> carrier Z\<^sub>p \<and> (f \<^emph> b0) (Suc (Suc n)) = 0 \<and> b0 1 = a 1 \<and> b0 (Suc n) = (hensel_seq f a n) (Suc n)"
        using A IH
        by blast
      have A1: "\<exists> b' \<in> carrier Z\<^sub>p. (f \<^emph> b') (Suc (Suc (Suc n))) = 0 \<and> b' 1 = a 1 \<and> b' (Suc (Suc n)) = b0 (Suc (Suc n))"
        using pre_hensel A0 assms
        by auto
      have A2: "b1 = (SOME b. b \<in> carrier Z\<^sub>p \<and> (f \<^emph> b) (Suc (Suc (Suc n))) = 0 \<and> b 1 = a 1 \<and> b (Suc (Suc n)) = b0 (Suc (Suc n)))"
        using A
        by simp
      let ?P = "(\<lambda> b. b \<in> carrier Z\<^sub>p \<and> (f \<^emph> b) (Suc (Suc (Suc n))) = 0 \<and> b 1 = a 1 \<and> b (Suc (Suc n)) = b0 (Suc (Suc n)))"
      show ?thesis
        using A1 A2 someI_ex[of ?P]
        by blast
    qed
  qed
qed

(*Properties of the hensel sequence*)
lemma hensel_seq_id_0:
  assumes "hensel f a"
  assumes "b = hensel_seq f a n"
  shows "b \<in> carrier Z\<^sub>p \<and> (f \<^emph> b) (Suc n) = 0 \<and> b 1 = a 1"
proof(cases "n = 0")
  case True
  then have "a = b"
    using assms by simp
  then show ?thesis
    using True[simp] assms(1)
    by auto
next
  case False
  obtain k where k_def: "n = Suc k"
    using False
    by (meson lessI less_Suc_eq_0_disj)
  show ?thesis
    using assms k_def[simp] hensel_seq_id_induct[of f a "hensel_seq f a k" k b]
    by blast
qed

lemma hensel_seq_id_1:
  assumes "hensel f a"
  shows "(hensel_seq f a n) (Suc n) = (hensel_seq f a (Suc n)) (Suc n)"
  using assms hensel_seq_id_induct[of f a "(hensel_seq f a n)" n "(hensel_seq f a (Suc n))" ]
  by simp

(*Hensel sequence is closed over Z\<^sub>p*)
lemma hensel_seq_closed:
  assumes "hensel f a"
  shows "is_closed_seq (hensel_seq f a)"
  using assms hensel_seq_id_0[of f a]
  unfolding is_closed_seq_def
  by blast

(*Hensel sequence is cauchy*)
lemma hensel_seq_is_cauchy:
  assumes "hensel f a"
  shows "is_cauchy (hensel_seq f a)"
proof(rule is_cauchyI)
  show "is_closed_seq (hensel_seq f a)"
    using hensel_seq_closed assms
    by auto
  show "\<And>n. \<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> hensel_seq f a n0 n = hensel_seq f a n1 n"
  proof-
    fix n
    have A0:  "\<And>m. hensel_seq f a (m+n) n = hensel_seq f a n n"
    proof-
      fix m
      show "hensel_seq f a (m+n) n = hensel_seq f a n n"
        apply(induction m)
         apply simp
      proof-
        fix m
        assume IH: "hensel_seq f a (m + n) n = hensel_seq f a n n "
        show "hensel_seq f a (Suc m + n) n = hensel_seq f a n n"
        proof-
          have I0: "hensel_seq f a (Suc m + n) (Suc m + n) = hensel_seq f a (m+n) (Suc m + n)"
            using assms hensel_seq_id_1[of f a "m+n"]
            using add_Suc by presburger
          have I1: "hensel_seq f a (Suc m + n) \<in> carrier Z\<^sub>p"  "hensel_seq f a (m+n) \<in> carrier Z\<^sub>p"
            using hensel_seq_closed[of f a] assms
            unfolding is_closed_seq_def
            apply blast
            using hensel_seq_closed[of f a] assms
            unfolding is_closed_seq_def
            apply blast done
          have I2: "hensel_seq f a (Suc m + n) n = hensel_seq f a (m+n) n"
          proof-
            have I20: "hensel_seq f a (Suc m + n) n = (hensel_seq f a (Suc m + n) (Suc m + n)) mod (p^n)"
              using I1 r_Zp r_def
              by auto
            have I21: "hensel_seq f a (m + n) n = (hensel_seq f a (Suc m + n) (Suc m + n)) mod (p^n)"
              using I1 r_Zp r_def I0
              by auto
            show ?thesis
              using I20 I21
              by auto
          qed
          show ?thesis
            using I2 IH
            by auto
        qed
      qed
    qed
    have A1: "\<forall>n0 n1. n < n0 \<and> n < n1 \<longrightarrow> hensel_seq f a n0 n = hensel_seq f a n1 n"
      apply auto
    proof-
      fix n0 n1
      assume A00: "n < n0" "n < n1"
      show " hensel_seq f a n0 n = hensel_seq f a n1 n"
        using A0 A00
        by (metis add.commute less_imp_add_positive)
    qed
    show "\<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> hensel_seq f a n0 n = hensel_seq f a n1 n"
      using A1 by blast
  qed
qed

(*Basic version of hensel's lemma*)
lemma hensels_lemma:
assumes "hensel f a"
shows "\<exists> \<alpha> \<in> carrier Z\<^sub>p. f\<^emph>\<alpha> = \<zero> \<and> \<alpha> 1 = a 1"
proof-
  obtain s where s_def: "s = hensel_seq f a"
    by simp
  have C: "is_cauchy s"
    using assms s_def hensel_seq_is_cauchy
    by auto
  obtain \<alpha> where alpha_def: "\<alpha>= res_lim s"
    by simp
  have Con: "converges_to s \<alpha>"
    using C alpha_def
    by (simp add: C is_cauchy_imp_has_limit)
  have Cont: "is_continuous (fun_of f)"
    using assms  polynomial_is_continuous
    by blast
  have A0: "(f\<^emph>\<alpha>) = res_lim ((fun_of f)\<^sub>*s)"
    using C Cont alpha_def alt_seq_limit
          res_lim_pushforward res_lim_pushforward'
          padic_integers_axioms
    by auto
  have A1: "res_lim ((fun_of f)\<^sub>*s) = \<zero>"
  proof-
    have "converges_to ((fun_of f)\<^sub>*s) \<zero>"
    proof(rule converges_toI)
      show "is_closed_seq((fun_of f)\<^sub>*s)"
        using Con Cont continuous_is_closed converges_to_def push_forward_of_closed_is_closed by blast
      show "\<zero> \<in> carrier Z\<^sub>p"
        by (simp add: cring.cring_simprules(2))
      show "\<And>n. \<exists>N. \<forall>k>N. ((fun_of f)\<^sub>*s) k n = \<zero> n"
      proof-
        fix n
        show "\<exists>N. \<forall>k>N. ((fun_of f)\<^sub>*s) k n = \<zero> n"
        proof-
          have "\<forall>k>n. ((fun_of f)\<^sub>*s) k n = \<zero> n"
          proof
            fix k
            show "n < k \<longrightarrow> ((fun_of f)\<^sub>*s) k n = \<zero> n"
            proof
              assume "n < k"
              show "((fun_of f)\<^sub>*s) k n = \<zero> n"
              proof-
                have 0: "((fun_of f)\<^sub>*s) k n = (fun_of f) (s k) n"
                  by (simp add: push_forward_def)
                then have 1:  "((fun_of f)\<^sub>*s) k n  = (fun_of f) (hensel_seq f a k) n"
                  using s_def by blast
                have 2: "(fun_of f) (hensel_seq f a k) n = 0"
                  by (smt Cont \<open>n < k\<close> assms continuous_is_closed
                      hensel_seq_id_0 is_closed_fun_simp less_imp_of_nat_less
                      ord_Zp_geq semiring_1_class.of_nat_simps(2) zero_below_ord zero_vals)
                show ?thesis using 1 2
                  by (simp add: zero_vals)
              qed
            qed
          qed
          then show ?thesis
            by blast
        qed
      qed
    qed
    then show ?thesis
      by (metis converges_to_def unique_limit')
  qed
  have A2: "(f\<^emph>\<alpha>) = \<zero>"
    using A0 A1 by auto
  have "\<alpha> 1 = a 1"
  proof-
    obtain N where N_def: "s N 1 = \<alpha> 1"
      using C alpha_def res_lim_cauchy by blast
    then have "s N 1 = a 1"
      using assms hensel_seq_id_0 s_def by blast
    then show ?thesis
      using N_def by auto
  qed
  then show ?thesis using A2
    using Con converges_to_def by blast
qed

end
end


theory StateMonad
imports Main "HOL-Library.Monad_Syntax"
begin

section "State Monad with Exceptions"

datatype ('n, 'e) result = Normal 'n | Exception 'e

type_synonym ('a, 'e, 's) state_monad = "'s \<Rightarrow> ('a \<times> 's, 'e) result"

lemma result_cases[cases type: result]:
  fixes x :: "('a \<times> 's, 'e) result"
  obtains (n) a s where "x = Normal (a, s)"
        | (e) e where "x = Exception e"
proof (cases x)
    case (Normal n)
    then show ?thesis
      by (metis n prod.swap_def swap_swap)
  next
    case (Exception e)
    then show ?thesis ..
qed

subsection \<open>Fundamental Definitions\<close>

fun
  return :: "'a \<Rightarrow> ('a, 'e, 's) state_monad" where
  "return a s = Normal (a, s)"

fun
  throw :: "'e \<Rightarrow> ('a, 'e, 's) state_monad" where
  "throw e s = Exception e"

fun
  bind :: "('a, 'e, 's) state_monad \<Rightarrow> ('a \<Rightarrow> ('b, 'e, 's) state_monad) \<Rightarrow>
           ('b, 'e, 's) state_monad" (infixl ">>=" 60)
  where
    "bind f g s = (case f s of
                      Normal (a, s') \<Rightarrow> g a s'
                    | Exception e \<Rightarrow> Exception e)"

adhoc_overloading Monad_Syntax.bind bind

lemma throw_left[simp]: "throw x \<bind> y = throw x" by auto

subsection \<open>The Monad Laws\<close>

text \<open>@{term return} is absorbed at the left of a @{term bind},
  applying the return value directly:\<close>
lemma return_bind [simp]: "(return x \<bind> f) = f x"
  by auto

text \<open>@{term return} is absorbed on the right of a @{term bind}\<close>
lemma bind_return [simp]: "(m \<bind> return) = m"
proof -
  have "\<forall>s. bind m return s = m s"
  proof
    fix s
    show "bind m return s = m s"
    proof (cases "m s" rule: result_cases)
      case (n a s)
      then show ?thesis by auto
    next
      case (e e)
      then show ?thesis by auto
    qed
  qed
  thus ?thesis by auto
qed

text \<open>@{term bind} is associative\<close>
lemma bind_assoc:
  fixes m :: "('a,'e,'s) state_monad"
  fixes f :: "'a \<Rightarrow> ('b,'e,'s) state_monad"
  fixes g :: "'b \<Rightarrow> ('c,'e,'s) state_monad"
  shows "(m \<bind> f) \<bind> g  =  m \<bind> (\<lambda>x. f x\<bind> g)"
proof
  fix s
  show "bind (bind m f) g s = bind m (\<lambda>x. bind (f x) g) s"
    by (cases "m s" rule: result_cases, simp+)
qed

subsection \<open>Basic Conguruence Rules\<close>

(*
  This lemma is needed for termination proofs.

  Function sub1 , for example, requires it.
*)
lemma monad_cong[fundef_cong]:
  fixes m1 m2 m3 m4
  assumes "m1 s = m2 s"
      and "\<And>v s'. m2 s = Normal (v, s') \<Longrightarrow> m3 v s' = m4 v s'"
    shows "(bind m1 m3) s = (bind m2 m4) s"
  apply(insert assms, cases "m1 s")
  apply (metis StateMonad.bind.simps old.prod.case result.simps(5))
  by (metis bind.elims result.simps(6))

(*
  Lemma bind_case_nat_cong is required if a bind operand is a case analysis over nat.

  Function sub2, for example, requires it.
*)
lemma bind_case_nat_cong [fundef_cong]:
  assumes "x = x'" and "\<And>a. x = Suc a \<Longrightarrow> f a h = f' a h"
  shows "(case x of Suc a \<Rightarrow> f a | 0 \<Rightarrow> g) h = (case x' of Suc a \<Rightarrow> f' a | 0 \<Rightarrow> g) h"
  by (metis assms(1) assms(2) old.nat.exhaust old.nat.simps(4) old.nat.simps(5))

lemma if_cong[fundef_cong]:
  assumes "b = b'"
    and "b' \<Longrightarrow> m1 s = m1' s"
    and "\<not> b' \<Longrightarrow> m2 s = m2' s"
  shows "(if b then m1 else m2) s = (if b' then m1' else m2') s"
  using assms(1) assms(2) assms(3) by auto

lemma bind_case_pair_cong [fundef_cong]:
  assumes "x = x'" and "\<And>a b. x = (a,b) \<Longrightarrow> f a b s = f' a b s"
  shows "(case x of (a,b) \<Rightarrow> f a b) s = (case x' of (a,b) \<Rightarrow> f' a b) s"
  by (simp add: assms(1) assms(2) prod.case_eq_if)

lemma bind_case_let_cong [fundef_cong]:
  assumes "M = N"
      and "(\<And>x. x = N \<Longrightarrow> f x s = g x s)"
    shows "(Let M f) s = (Let N g) s"
  by (simp add: assms(1) assms(2))

lemma bind_case_some_cong [fundef_cong]:
  assumes "x = x'" and "\<And>a. x = Some a \<Longrightarrow> f a s = f' a s" and "x = None \<Longrightarrow> g s = g' s"
  shows "(case x of Some a \<Rightarrow> f a | None \<Rightarrow> g) s = (case x' of Some a \<Rightarrow> f' a | None \<Rightarrow> g') s"
  by (simp add: assms(1) assms(2) assms(3) option.case_eq_if)

subsection \<open>Other functions\<close>

text \<open>
  The basic accessor functions of the state monad. \<open>get\<close> returns
  the current state as result, does not fail, and does not change the state.
  \<open>put s\<close> returns unit, changes the current state to \<open>s\<close> and does not fail.
\<close>
fun get :: "('s, 'e, 's) state_monad" where
  "get s = Normal (s, s)"

fun put :: "'s \<Rightarrow> (unit, 'e, 's) state_monad" where
  "put s _ = Normal ((), s)"

text \<open>Apply a function to the current state and return the result
without changing the state.\<close>
fun
  applyf :: "('s \<Rightarrow> 'a) \<Rightarrow> ('a, 'e, 's) state_monad" where
 "applyf f = get \<bind> (\<lambda>s. return (f s))"

text \<open>Modify the current state using the function passed in.\<close>
fun
  modify :: "('s \<Rightarrow> 's) \<Rightarrow> (unit, 'e, 's) state_monad"
where "modify f = get \<bind> (\<lambda>s::'s. put (f s))"

text \<open>
  Perform a test on the current state, performing the left monad if
  the result is true or the right monad if the result is false.
\<close>
fun
  condition :: "('s \<Rightarrow> bool) \<Rightarrow> ('a, 'e, 's) state_monad \<Rightarrow> ('a, 'e, 's) state_monad \<Rightarrow> ('a, 'e, 's) state_monad"
where
  "condition P L R s = (if (P s) then (L s) else (R s))"

notation (output)
  condition  ("(condition (_)//  (_)//  (_))" [1000,1000,1000] 1000)

lemma condition_cong[fundef_cong]:
  assumes "b s = b' s"
    and "b' s \<Longrightarrow> m1 s = m1' s"
    and "\<And>s'. s' = s \<Longrightarrow> \<not> b' s' \<Longrightarrow> m2 s' = m2' s'"
  shows "(condition b m1 m2) s = (condition b' m1' m2') s"
  by (simp add: assms(1) assms(2) assms(3))

fun
  assert :: "'e \<Rightarrow> ('s \<Rightarrow> bool) \<Rightarrow> ('a, 'e, 's) state_monad \<Rightarrow> ('a, 'e, 's) state_monad" where
 "assert x t m = condition t (throw x) m"

notation (output)
  assert  ("(assert (_)//  (_)//  (_))" [1000,1000,1000] 1000)

lemma assert_cong[fundef_cong]:
  assumes "b s = b' s"
    and "\<not> b' s \<Longrightarrow> m s = m' s"
  shows "(assert x b m) s = (assert x b' m') s"
  by (simp add: assms(1) assms(2))

subsection \<open>Some basic examples\<close>

lemma "do {
        x \<leftarrow> return 1;
        return (2::nat);
        return x
       } =
       return 1 \<bind> (\<lambda>x. return (2::nat) \<bind> (\<lambda>_. (return x)))" ..

lemma "do {
        x \<leftarrow> return 1;
          return 2;
          return x
       } = return 1"
  by auto

fun sub1 :: "(unit, nat, nat) state_monad" where
    "sub1 0 = put 0 0"
  | "sub1 (Suc n) = (do {
                     x \<leftarrow> get;
                     put x;
                     sub1
                    }) n"

fun sub2 :: "(unit, nat, nat) state_monad" where
  "sub2 s =
     (do {
        n \<leftarrow> get;
        (case n of
          0 \<Rightarrow> put 0
        | Suc n' \<Rightarrow> (do {
                  put n';
                  sub2
                }))
     }) s"

fun sub3 :: "(unit, nat, nat) state_monad" where
  "sub3 s =
     condition (\<lambda>n. n=0)
       (return ())
       (do {
         n \<leftarrow> get;
         put (n - 1);
         sub3
        }) s"

fun sub4 :: "(unit, nat, nat) state_monad" where
  "sub4 s =
     assert (0) (\<lambda>n. n=0)
       (do {
         n \<leftarrow> get;
         put (n - 1);
         sub4
        }) s"

fun sub5 :: "(unit, nat, (nat*nat)) state_monad" where
  "sub5 s =
     assert (0) (\<lambda>n. fst n=0)
       (do {
         (n,m) \<leftarrow> get;
          put (n - 1,m);
          sub5
        }) s"
end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |                 August 2004               |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |                October 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2009-2       |
            |                October 2010  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CPO_set
imports CPO_prod
begin

(*****************************************************************

         1. Bool is CPO  for (Isabelle 2011)
         2. Sets are CPO.
         3.
         4.

 *****************************************************************)

(**********************************************************
              def: bot in bool
 **********************************************************)

declare le_bool_def [simp del] (* for Isabelle 2011 *)

(*
instance bool :: bot0
apply (intro_classes)
done
*)

instantiation "set" :: (type) bot0
begin

definition
  set_Bot_def : "Bot == {}"
  instance ..
end

(*
for Isabelle 2011

instantiation bool :: bot0
begin

definition
  bool_Bot_def : "Bot == False"
  instance ..
end
*)

(* isabelle 2009-1
defs (overloaded)
  bool_Bot_def : "Bot == False"
*)

(*
     For Isabelle 2007

instance "set" :: (type) bot0
apply (intro_classes)
done

defs (overloaded)
  set_Bot_def : "Bot == {}"
*)

(************************************************************
                   Bool bot ==> bot  (Isabelle 2011)
 ************************************************************)

(*
for Isabelle 2011

lemma bool_Bot:
  "ALL (X::(bool)). Bot <= X"
apply (simp add: bool_Bot_def)
apply (simp add: le_bool_def)
done
*)

(*
lemma set_Bot:
  "ALL (X::('a set)). Bot <= X"
apply (simp add: set_Bot_def)
done
*)

(*****************************
       bool bot => bot
 *****************************)

(*
Isabelle 2011

instance bool :: bot
apply (intro_classes)
apply (simp only: bool_Bot)
done

*)

(************************************************************
                   Set bot ==> bot

                    Isabelle 2011
 ************************************************************)

(*** set Bot ***)
(*
lemma set_Bot:
  "ALL (X::('a set)). Bot <= X"
apply (simp add: set_Bot_def)
(* apply (simp add: prod_Bot)   Isabelle 2011 *)
done
*)

(************************************************************
                      Bool : CPO  Isabelle 2011
 ************************************************************)

(*
(* modified when Isabelle 2011 => Isabelle 2012 *)

(*** bool directed decompo ***)

lemma bool_cpo_lm:
  "directed (Bs::(bool) set) ==> Bs hasLUB"
apply (simp add: hasLUB_def)
apply (rule_tac x="(EX b:Bs. b)" in exI)
apply (simp add: isLUB_def isUB_def)
apply (simp add: le_bool_def)
by (auto)

(*****************************
          Bool : CPO
 *****************************)

instance bool :: cpo
apply (intro_classes)
by (simp add: bool_cpo_lm)
*)

(************************************************************
                      Bool : CPO_BOT
 ************************************************************)

(*
Isabelle 2011

instance bool :: cpo_bot
by (intro_classes)
*)

(************************************************************
                      Set : CPO
 ************************************************************)

lemma set_cpo_lm:
  "directed (Xs::('a set) set) ==> Xs hasLUB"
apply (simp add: hasLUB_def)
apply (rule_tac x="Union Xs" in exI)
apply (simp add: isLUB_def isUB_def)
by (auto)

(*****************************
          Set : CPO
 *****************************)

instance set :: (type) cpo
apply (intro_classes)
by (simp add: set_cpo_lm)

(************************************************************
                      Set : CPO_BOT
 ************************************************************)

instance set :: (type) cpo_bot
apply (intro_classes)
apply (simp add: set_Bot_def)
done

(* ============================================================== *)
(* for isabelle 2011

lemma set_cpo:
  "directed (Xs::('a set) set) ==> Xs hasLUB"
by (simp add: complete_cpo)

(* because (bool::cpo) and ("fun" :: (type,cpo) cpo) *)

(************************************************************
                      Set : CPO_bot
 ************************************************************)

lemma set_bot:
  "Bot <= (x::'a set)"

by (simp add: bottom_bot)

(* because (bool::bot) and ("fun" :: (type,bot) bot) *)

(* -------------------------------------------------------- *)
*)

declare le_bool_def [simp] (* for Isabelle 2011 *)

end


(* I borrow the implementation by
    [Title:      Sequents/LK0.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1993  University of Cambridge]

But make a modification to adapt to our application.
*)

header {* Classical First-Order Sequent Calculus *}

theory DLK0
imports DSequents
begin

consts Trueprop :: "two_seqi"

syntax
 "_Trueprop" :: "two_seqe" ("((_)/ |- (_))" [6,6] 5)

parse_translation {* [(@{syntax_const "_Trueprop"}, two_seq_tr @{const_syntax Trueprop})] *}
print_translation {* [(@{const_syntax Trueprop}, two_seq_tr' @{syntax_const "_Trueprop"})] *}

axioms

  (*Structural rules: contraction, thinning, exchange [Soren Heilmann] *)

  contRS: "$H |- $E, $S, $S, $F ==> $H |- $E, $S, $F"
  contLS: "$H, $S, $S, $G |- $E ==> $H, $S, $G |- $E"

  thinRS: "$H |- $E, $F ==> $H |- $E, $S, $F"
  thinLS: "$H, $G |- $E ==> $H, $S, $G |- $E"

  exchRS: "$H |- $E, $R, $S, $F ==> $H |- $E, $S, $R, $F"
  exchLS: "$H, $R, $S, $G |- $E ==> $H, $S, $R, $G |- $E"

  cut:   "[| $H |- $E, P;  $H, P |- $E |] ==> $H |- $E"

 axioms
 (*Propositional rules*)

  basic: "$H, P, $G |- $E, P, $F"

  conjR: "[| $H|- $E, P, $F;  $H|- $E, Q, $F |] ==> $H|- $E, P [&] Q, $F"
  conjL: "$H, P, Q, $G |- $E ==> $H, P [&] Q, $G |- $E"

  disjR: "$H |- $E, P, Q, $F ==> $H |- $E, P [|] Q, $F"
  disjL: "[| $H, P, $G |- $E;  $H, Q, $G |- $E |] ==> $H, P [|] Q, $G |- $E"

  impR:  "$H, P |- $E, Q, $F ==> $H |- $E, P [-->] Q, $F"
  impL:  "[| $H,$G |- $E,P;  $H, Q, $G |- $E |] ==> $H, P [-->] Q, $G |- $E"

  notR:  "$H, P |- $E, $F ==> $H |- $E, [~] P, $F"
  notL:  "$H, $G |- $E, P ==> $H, [~] P, $G |- $E"

  FalseL: "$H, WFalse, $G |- $E"

  True_def: "WTrue == WFalse [-->] WFalse"
  iff_def:  "P [<->] Q == (P [-->] Q) [&] (Q [-->] P)"

 axioms
  (*Quantifiers*)

  allR:  "(!!x.$H |- $E, P(x), $F) ==> $H |- $E, WALL x P(x), $F"
  allL:  "$H, P(x), $G, WALL x P(x) |- $E ==> $H, WALL x P(x), $G |- $E"

  exR:   "$H |- $E, P(x), $F, WEX x P(x) ==> $H |- $E, WEX  x P(x), $F"
  exL:   "(!!x.$H, P(x), $G |- $E) ==> $H, WEX x P(x), $G |- $E"

 axioms
 (*Equality*)

  refl:  "$H |- $E, a [=] a, $F"
  subst: "$H(a), $G(a) |- $E(a) ==> $H(b), a [=] b, $G(b) |- $E(b)"

  (* Reflection *)

  eq_reflection:  "|- x [=] y ==> (x==y)"
  iff_reflection: "|- P [<->] Q ==> (P==Q)"

(** Structural Rules on formulas **)

(*contraction*)

lemma contR: "$H |- $E, P, P, $F ==> $H |- $E, P, $F"
  by (rule contRS)

lemma contL: "$H, P, P, $G |- $E ==> $H, P, $G |- $E"
  by (rule contLS)

(*thinning*)

lemma thinR: "$H |- $E, $F ==> $H |- $E, P, $F"
  by (rule thinRS)

lemma thinL: "$H, $G |- $E ==> $H, P, $G |- $E"
  by (rule thinLS)

(*exchange*)

lemma exchR: "$H |- $E, Q, P, $F ==> $H |- $E, P, Q, $F"
  by (rule exchRS)

lemma exchL: "$H, Q, P, $G |- $E ==> $H, P, Q, $G |- $E"
  by (rule exchLS)

ML {*
(*Cut and thin, replacing the right-side formula*)
fun cutR_tac ctxt s i =
  res_inst_tac ctxt [(("P", 0), s) ] @{thm cut} i  THEN  rtac @{thm thinR} i

(*Cut and thin, replacing the left-side formula*)
fun cutL_tac ctxt s i =
  res_inst_tac ctxt [(("P", 0), s)] @{thm cut} i  THEN  rtac @{thm thinL} (i+1)
*}

(** If-and-only-if rules **)
lemma iffR:
    "[| $H,P |- $E,Q,$F;  $H,Q |- $E,P,$F |] ==> $H |- $E, P [<->] Q, $F"
  apply (unfold iff_def)
  apply (assumption | rule conjR impR)+
  done

lemma iffL:
    "[| $H,$G |- $E,P,Q;  $H,Q,P,$G |- $E |] ==> $H, P [<->] Q, $G |- $E"
  apply (unfold iff_def)
  apply (assumption | rule conjL impL basic)+
  done

lemma iff_refl: "$H |- $E, (P [<->] P), $F"
  apply (rule iffR basic)+
  done

lemma TrueR: "$H |- $E, WTrue, $F"
  apply (unfold True_def)
  apply (rule impR)
  apply (rule basic)
  done

(*(*Descriptions*)
lemma the_equality:
  assumes p1: "$H |- $E, P(a), $F"
    and p2: "!!x. $H, P(x) |- $E, x=a, $F"
  shows "$H |- $E, (THE x. P(x)) = a, $F"
  apply (rule cut)
   apply (rule_tac [2] p2)
  apply (rule The, rule thinR, rule exchRS, rule p1)
  apply (rule thinR, rule exchRS, rule p2)
  done
*)

(** Weakened quantifier rules.  Incomplete, they let the search terminate.**)

lemma allL_thin: "$H, P(x), $G |- $E ==> $H, WALL x P(x), $G |- $E"
  apply (rule allL)
  apply (erule thinL)
  done

lemma exR_thin: "$H |- $E, P(x), $F ==> $H |- $E, WEX x P(x), $F"
  apply (rule exR)
  apply (erule thinR)
  done

(*The rules of LK*)

ML {*
val prop_pack = empty_pack add_safes
                [@{thm basic}, @{thm refl}, @{thm TrueR}, @{thm FalseL},
                 @{thm conjL}, @{thm conjR}, @{thm disjL}, @{thm disjR}, @{thm impL}, @{thm impR},
                 @{thm notL}, @{thm notR}, @{thm iffL}, @{thm iffR}];

val LK_pack = prop_pack add_safes   [@{thm allR}, @{thm exL}]
                        add_unsafes [@{thm allL_thin}, @{thm exR_thin}, @{thm the_equality}];

val LK_dup_pack = prop_pack add_safes   [@{thm allR}, @{thm exL}]
                            add_unsafes [@{thm allL}, @{thm exR}, @{thm the_equality}];

fun lemma_tac th i =
    rtac (@{thm thinR} RS @{thm cut}) i THEN REPEAT (rtac @{thm thinL} i) THEN rtac th i;
*}

method_setup fast_prop = {* Scan.succeed (K (SIMPLE_METHOD' (fast_tac prop_pack))) *}
method_setup fast = {* Scan.succeed (K (SIMPLE_METHOD' (fast_tac LK_pack))) *}
method_setup fast_dup = {* Scan.succeed (K (SIMPLE_METHOD' (fast_tac LK_dup_pack))) *}
method_setup best = {* Scan.succeed (K (SIMPLE_METHOD' (best_tac LK_pack))) *}
method_setup best_dup = {* Scan.succeed (K (SIMPLE_METHOD' (best_tac LK_dup_pack))) *}

lemma mp_R:
  assumes major: "$H |- $E, $F, P [-->] Q"
    and minor: "$H |- $E, $F, P"
  shows "$H |- $E, Q, $F"
  apply (rule thinRS [THEN cut], rule major)
  apply (tactic "step_tac LK_pack 1")
  apply (rule thinR, rule minor)
  done

lemma mp_L:
  assumes major: "$H, $G |- $E, P [-->] Q"
    and minor: "$H, $G, Q |- $E"
  shows "$H, P, $G |- $E"
  apply (rule thinL [THEN cut], rule major)
  apply (tactic "step_tac LK_pack 1")
  apply (rule thinL, rule minor)
  done

(** Two rules to generate left- and right- rules from implications **)

lemma R_of_imp:
  assumes major: "|- P [-->] Q"
    and minor: "$H |- $E, $F, P"
  shows "$H |- $E, Q, $F"
  apply (rule mp_R)
   apply (rule_tac [2] minor)
  apply (rule thinRS, rule major [THEN thinLS])
  done

lemma L_of_imp:
  assumes major: "|- P [-->] Q"
    and minor: "$H, $G, Q |- $E"
  shows "$H, P, $G |- $E"
  apply (rule mp_L)
   apply (rule_tac [2] minor)
  apply (rule thinRS, rule major [THEN thinLS])
  done

(*Can be used to create implications in a subgoal*)
lemma backwards_impR:
  assumes prem: "$H, $G |- $E, $F, P [-->] Q"
  shows "$H, P, $G |- $E, Q, $F"
  apply (rule mp_L)
   apply (rule_tac [2] basic)
  apply (rule thinR, rule prem)
  done

lemma conjunct1: "|-P [&] Q ==> |-P"
  apply (erule thinR [THEN cut])
  apply fast
  done

lemma conjunct2: "|-P [&] Q ==> |-Q"
  apply (erule thinR [THEN cut])
  apply fast
  done

lemma spec: "|- (WALL x P(x)) ==> |- P(x)"
  apply (erule thinR [THEN cut])
  apply fast
  done

(** Equality **)

lemma sym: "|- a [=] b [-->] b [=] a"
  by (tactic {* safe_tac (LK_pack add_safes [@{thm subst}]) 1 *})

lemma trans: "|- a [=] b [-->] b [=] c [-->] a [=] c"
  by (tactic {* safe_tac (LK_pack add_safes [@{thm subst}]) 1 *})

(* Symmetry of equality in hypotheses *)
lemmas symL = sym [THEN L_of_imp, standard]

(* Symmetry of equality in hypotheses *)
lemmas symR = sym [THEN R_of_imp, standard]

lemma transR: "[| $H|- $E, $F, a [=] b;  $H|- $E, $F, b [=] c |] ==> $H|- $E, a [=] c, $F"
  by (rule trans [THEN R_of_imp, THEN mp_R])

(* Two theorms for rewriting only one instance of a definition:
   the first for definitions of formulae and the second for terms *)

lemma def_imp_iff: "(A == B) ==> |- A [<->] B"
  apply unfold
  apply (rule iff_refl)
  done

lemma meta_eq_to_obj_eq: "(A == B) ==> |- A [=] B"
  apply (unfold)
  apply (rule refl)
  done

(*New added axioms for formulas of our syntax*)
(*Arith*)
axiomatization where
Trans: "formT (f::fform) ==> |- f" and
Trans1: "(formT (f1::fform) ==> formT (f::fform)) ==> f1 |- f" and
Trans2: "(formT (f1::fform) & formT (f2::fform) ==> formT (f::fform)) ==> f1, f2 |- f" and
Trans3: "(formT (f1::fform) & formT (f2::fform) & formT (f3::fform) ==> formT (f::fform)) ==> f1, f2, f3 |- f" and
Trans4: "(formT (f1::fform) & formT (f2::fform) & formT (f3::fform) & formT (f4::fform) ==> formT (f::fform)) ==> f1, f2, f3, f4 |- f"

axiomatization where
TransR: "|- f ==> formT (f::fform)" and
TransR1: "f1 |- f ==> (formT (f1::fform) --> formT (f::fform))" and
TransR2: "f1, f2 |- f ==> (formT (f1::fform) & formT (f2::fform) --> formT (f::fform))" and
TransR3: "f1, f2, f3 |- f ==> (formT (f1::fform) & formT (f2::fform) & formT (f3::fform) --> formT (f::fform))"

axiomatization where
le_square : "[|0<=a; (a::real)<=b; 0<=c; (c::real)<=d|] ==> a*c<=b*d"

lemma le_square1 : "[|0<=(a::real); a<=1|] ==> a*a<=1"
apply (cut_tac a=a and c=a and b=1 and d=1 in le_square,auto)
done

end


section \<open>Library additions\<close>

theory Library_Additions
  imports "ZFC_in_HOL.Ordinal_Exp" "HOL-Library.Ramsey" "Nash_Williams.Nash_Williams"

begin

lemma finite_enumerate_Diff_singleton:
  fixes S :: "'a::wellorder set"
  assumes "finite S" and i: "i < card S" "enumerate S i < x"
  shows "enumerate (S - {x}) i = enumerate S i"
  using i
proof (induction i)
  case 0
  have "(LEAST i. i \<in> S \<and> i\<noteq>x) = (LEAST i. i \<in> S)"
  proof (rule Least_equality)
    have "\<exists>t. t \<in> S \<and> t\<noteq>x"
      using 0 \<open>finite S\<close> finite_enumerate_in_set by blast
    then show "(LEAST i. i \<in> S) \<in> S \<and> (LEAST i. i \<in> S) \<noteq> x"
      by (metis "0.prems"(2) LeastI enumerate_0 not_less_Least)
  qed (simp add: Least_le)
  then show ?case
    by (auto simp: enumerate_0)
next
  case (Suc i)
  then have x: "enumerate S i < x"
    by (meson enumerate_step finite_enumerate_step less_trans)
  have cardSx: "Suc i < card (S - {x})" and "i < card S"
    using Suc \<open>finite S\<close> card_Diff_singleton_if finite_enumerate_Ex by fastforce+
  have "(LEAST s. s \<in> S \<and> s\<noteq>x \<and> enumerate (S - {x}) i < s) = (LEAST s. s \<in> S \<and> enumerate S i < s)"
       (is "_ = ?r")
  proof (intro Least_equality conjI)
    show "?r \<in> S"
      by (metis (lifting) LeastI Suc.prems(1) assms(1) finite_enumerate_in_set finite_enumerate_step)
    show "?r \<noteq> x"
      using Suc.prems not_less_Least [of _ "\<lambda>t. t \<in> S \<and> enumerate S i < t"]
       \<open>finite S\<close> finite_enumerate_in_set finite_enumerate_step by blast
    show "enumerate (S - {x}) i < ?r"
      by (metis (full_types) Suc.IH Suc.prems(1) \<open>i < card S\<close> enumerate_Suc'' enumerate_step finite_enumerate_Suc'' finite_enumerate_step x)
    show "\<And>y. y \<in> S \<and> y \<noteq> x \<and> enumerate (S - {x}) i < y \<Longrightarrow> ?r \<le> y"
      by (simp add: Least_le Suc.IH \<open>i < card S\<close> x)
  qed
  then show ?case
    using Suc assms by (simp add: finite_enumerate_Suc'' cardSx)
qed

lemma hd_lex: "\<lbrakk>hd ms < hd ns; length ms = length ns; ns \<noteq> []\<rbrakk> \<Longrightarrow> (ms, ns) \<in> lex less_than"
  by (metis hd_Cons_tl length_0_conv less_than_iff lexord_cons_cons lexord_lex)

lemma sorted_hd_le:
  assumes "sorted xs" "x \<in> list.set xs"
  shows "hd xs \<le> x"
  using assms by (induction xs) (auto simp: less_imp_le)

lemma sorted_le_last:
  assumes "sorted xs" "x \<in> list.set xs"
  shows "x \<le> last xs"
  using assms by (induction xs) (auto simp: less_imp_le)

lemma hd_list_of:
  assumes "finite A" "A \<noteq> {}"
  shows "hd (sorted_list_of_set A) = Min A"
proof (rule antisym)
  have "Min A \<in> A"
    by (simp add: assms)
  then show "hd (sorted_list_of_set A) \<le> Min A"
    by (simp add: sorted_hd_le \<open>finite A\<close>)
next
  show "Min A \<le> hd (sorted_list_of_set A)"
    by (metis Min_le assms hd_in_set set_sorted_list_of_set sorted_list_of_set_eq_Nil_iff)
qed

lemma sorted_hd_le_last:
  assumes "sorted xs" "xs \<noteq> []"
  shows "hd xs \<le> last xs"
  using assms by (simp add: sorted_hd_le)

lemma sorted_list_of_set_set_of [simp]: "strict_sorted l \<Longrightarrow> sorted_list_of_set (list.set l) = l"
  by (simp add: strict_sorted_equal)

lemma range_strict_mono_ext:
  fixes f::"nat \<Rightarrow> 'a::linorder"
  assumes eq: "range f = range g"
      and sm: "strict_mono f" "strict_mono g"
    shows "f = g"
proof
  fix n
  show "f n = g n"
  proof (induction n rule: less_induct)
    case (less n)
    obtain x y where xy: "f n = g y" "f x = g n"
      by (metis eq imageE rangeI)
    then have "n = y"
      by (metis (no_types) less.IH neq_iff sm strict_mono_less xy)
    then show ?case using xy by auto
  qed
qed

subsection \<open>Other material\<close>

definition strict_mono_sets :: "['a::order set, 'a::order \<Rightarrow> 'b::order set] \<Rightarrow> bool" where
  "strict_mono_sets A f \<equiv> \<forall>x\<in>A. \<forall>y\<in>A. x < y \<longrightarrow> less_sets (f x) (f y)"

lemma strict_mono_setsD:
  assumes "strict_mono_sets A f" "x < y" "x \<in> A" "y \<in> A"
  shows "less_sets (f x) (f y)"
  using assms by (auto simp: strict_mono_sets_def)

lemma strict_mono_on_o: "\<lbrakk>strict_mono_on r A; strict_mono_on s B; s ` B \<subseteq> A\<rbrakk> \<Longrightarrow> strict_mono_on (r \<circ> s) B"
  by (auto simp: image_subset_iff strict_mono_on_def)

lemma strict_mono_sets_imp_disjoint:
  fixes A :: "'a::linorder set"
  assumes "strict_mono_sets A f"
  shows "pairwise (\<lambda>x y. disjnt (f x) (f y)) A"
  using assms unfolding strict_mono_sets_def pairwise_def
  by (meson antisym_conv3 disjnt_sym less_sets_imp_disjnt)

lemma strict_mono_sets_subset:
  assumes "strict_mono_sets B f" "A \<subseteq> B"
  shows "strict_mono_sets A f"
  using assms by (auto simp: strict_mono_sets_def)

lemma strict_mono_less_sets_Min:
  assumes "strict_mono_sets I f" "finite I" "I \<noteq> {}"
  shows "less_sets (f (Min I)) (\<Union> (f ` (I - {Min I})))"
  using assms by (simp add: strict_mono_sets_def less_sets_UN2 dual_order.strict_iff_order)

lemma pair_less_iff1 [simp]: "((x,y), (x,z)) \<in> pair_less \<longleftrightarrow> y<z"
  by (simp add: pair_less_def)

lemma infinite_finite_Inter:
  assumes "finite \<A>" "\<A>\<noteq>{}" "\<And>A. A \<in> \<A> \<Longrightarrow> infinite A"
    and "\<And>A B. \<lbrakk>A \<in> \<A>; B \<in> \<A>\<rbrakk> \<Longrightarrow> A \<inter> B \<in> \<A>"
  shows "infinite (\<Inter>\<A>)"
  by (simp add: assms finite_Inf_in)

lemma atLeast_less_sets: "\<lbrakk>less_sets A {x}; B \<subseteq> {x..}\<rbrakk> \<Longrightarrow> less_sets A B"
  by (force simp: less_sets_def subset_iff)

subsection \<open>The list-of function\<close>

lemma sorted_list_of_set_insert_remove_cons:
  assumes "finite A" "less_sets {a} A"
  shows "sorted_list_of_set (insert a A) = a # sorted_list_of_set A"
proof -
  have "strict_sorted (a # sorted_list_of_set A)"
    using assms less_setsD by auto
  moreover have "list.set (a # sorted_list_of_set A) = insert a A"
    using assms by force
  moreover have "length (a # sorted_list_of_set A) = card (insert a A)"
    using assms card_insert_if less_setsD by fastforce
  ultimately show ?thesis
    by (metis \<open>finite A\<close> finite_insert sorted_list_of_set_unique)
qed

lemma sorted_list_of_set_Un:
  assumes AB: "less_sets A B" and fin: "finite A" "finite B"
  shows "sorted_list_of_set (A \<union> B) = sorted_list_of_set A @ sorted_list_of_set B"
proof -
  have "strict_sorted (sorted_list_of_set A @ sorted_list_of_set B)"
    using AB unfolding less_sets_def
    by (metis fin set_sorted_list_of_set sorted_wrt_append strict_sorted_list_of_set)
  moreover have "card A + card B = card (A \<union> B)"
    using less_sets_imp_disjnt [OF AB]
    by (simp add: assms card_Un_disjoint disjnt_def)
  ultimately show ?thesis
    by (simp add: assms strict_sorted_equal)
qed

lemma sorted_list_of_set_UN_lessThan:
  fixes k::nat
  assumes sm: "strict_mono_sets {..<k} A" and "\<And>i. i < k \<Longrightarrow> finite (A i)"
  shows "sorted_list_of_set (\<Union>i<k. A i) = concat (map (sorted_list_of_set \<circ> A) (sorted_list_of_set {..<k}))"
  using assms
proof (induction k)
  case 0
  then show ?case
    by auto
next
  case (Suc k)
  have ls: "less_sets (\<Union> (A ` {..<k})) (A k)"
    using sm Suc.prems(1) strict_mono_setsD by (force simp: less_sets_UN1)
  have "sorted_list_of_set (\<Union> (A ` {..<Suc k})) = sorted_list_of_set (\<Union> (A ` {..<k}) \<union> A k)"
    by (simp add: Un_commute lessThan_Suc)
  also have "\<dots> = sorted_list_of_set (\<Union> (A ` {..<k})) @ sorted_list_of_set (A k)"
    by (rule sorted_list_of_set_Un) (auto simp: Suc.prems ls)
  also have "\<dots> = concat (map (sorted_list_of_set \<circ> A) (sorted_list_of_set {..<k})) @ sorted_list_of_set (A k)"
    using Suc strict_mono_sets_def by fastforce
  also have "\<dots> = concat (map (sorted_list_of_set \<circ> A) (sorted_list_of_set {..<Suc k}))"
    using strict_mono_sets_def by fastforce
  finally show ?case .
qed

lemma sorted_list_of_set_UN_atMost:
  fixes k::nat
  assumes "strict_mono_sets {..k} A" and "\<And>i. i \<le> k \<Longrightarrow> finite (A i)"
  shows "sorted_list_of_set (\<Union>i\<le>k. A i) = concat (map (sorted_list_of_set \<circ> A) (sorted_list_of_set {..k}))"
  by (metis assms lessThan_Suc_atMost less_Suc_eq_le sorted_list_of_set_UN_lessThan)

subsection \<open>Monotonic enumeration of a countably infinite set\<close>

abbreviation "enum \<equiv> enumerate"

text \<open>Could be generalised to infinite countable sets of any type\<close>
lemma nat_infinite_iff:
  fixes N :: "nat set"
  shows "infinite N \<longleftrightarrow> (\<exists>f::nat\<Rightarrow>nat. N = range f \<and> strict_mono f)"
proof safe
  assume "infinite N"
  then show "\<exists>f. N = range (f::nat \<Rightarrow> nat) \<and> strict_mono f"
    by (metis bij_betw_imp_surj_on bij_enumerate enumerate_mono strict_mono_def)
next
  fix f :: "nat \<Rightarrow> nat"
  assume "strict_mono f" and "N = range f" and "finite (range f)"
  then show False
    using range_inj_infinite strict_mono_imp_inj_on by blast
qed

lemma enum_works:
  fixes N :: "nat set"
  assumes "infinite N"
  shows "N = range (enum N) \<and> strict_mono (enum N)"
  by (metis assms bij_betw_imp_surj_on bij_enumerate enumerate_mono strict_monoI)

lemma range_enum: "range (enum N) = N" and strict_mono_enum: "strict_mono (enum N)"
  if "infinite N" for N :: "nat set"
  using enum_works [OF that] by auto

lemma enum_works_finite:
  fixes N :: "nat set"
  assumes "finite N"
  shows "N = enum N ` {..<card N} \<and> strict_mono_on (enum N) {..<card N}"
  using assms
  by (metis bij_betw_imp_surj_on finite_bij_enumerate finite_enumerate_mono lessThan_iff strict_mono_onI)

lemma enum_obtain_index_finite:
  fixes N :: "nat set"
  assumes "x \<in> N" "finite N"
  obtains i where "i < card N" "x = enum N i"
  by (metis \<open>x \<in> N\<close> \<open>finite N\<close> enum_works_finite imageE lessThan_iff)

lemma enum_0_eq_Inf_finite:
  fixes N :: "nat set"
  assumes "finite N" "N \<noteq> {}"
  shows "enum N 0 = Inf N"
proof -
  have "enum N 0 \<in> N"
    by (metis Nat.neq0_conv assms empty_is_image enum_works_finite image_eqI lessThan_empty_iff lessThan_iff)
  moreover have "enum N 0 \<le> x" if "x \<in> N" for x
  proof -
    obtain i where "i < card N" "x = enum N i"
      by (metis \<open>x \<in> N\<close> \<open>finite N\<close> enum_obtain_index_finite)
    with assms show ?thesis
      by (metis Nat.neq0_conv finite_enumerate_mono less_or_eq_imp_le)
  qed
  ultimately show ?thesis
    by (metis cInf_eq_minimum)
qed

lemma greaterThan_less_enum:
  fixes N :: "nat set"
  assumes "N \<subseteq> {x<..}" "infinite N"
  shows "x < enum N i"
  using assms range_enum by fastforce

lemma atLeast_le_enum:
  fixes N :: "nat set"
  assumes "N \<subseteq> {x..}" "infinite N"
  shows "x \<le> enum N i"
  using assms range_enum by fastforce

lemma less_sets_empty1 [simp]: "less_sets {} A" and less_sets_empty2 [simp]: "less_sets A {}"
  by (simp_all add: less_sets_def)

lemma less_sets_singleton1 [simp]: "less_sets {a} A \<longleftrightarrow> (\<forall>x\<in>A. a < x)"
  and less_sets_singleton2 [simp]: "less_sets A {a} \<longleftrightarrow> (\<forall>x\<in>A. x < a)"
  by (simp_all add: less_sets_def)

lemma less_sets_atMost [simp]: "less_sets {..a} A \<longleftrightarrow> (\<forall>x\<in>A. a < x)"
  and less_sets_alLeast [simp]: "less_sets A {a..} \<longleftrightarrow> (\<forall>x\<in>A. x < a)"
  by (auto simp: less_sets_def)

lemma less_sets_imp_strict_mono_sets:
  assumes "\<And>i. less_sets (A i) (A (Suc i))" "\<And>i. i>0 \<Longrightarrow> A i \<noteq> {}"
  shows "strict_mono_sets UNIV A"
proof (clarsimp simp: strict_mono_sets_def)
  fix i j::nat
  assume "i < j"
  then show "less_sets (A i) (A j)"
  proof (induction "j-i" arbitrary: i j)
    case (Suc x)
    then show ?case
      by (metis Suc_diff_Suc Suc_inject Suc_mono assms less_Suc_eq less_sets_trans zero_less_Suc)
  qed auto
qed

lemma less_sets_Suc_Max:
  assumes "finite A"
  shows "less_sets A {Suc (Max A)..}"
proof (cases "A = {}")
  case False
  then show ?thesis
    by (simp add: assms less_Suc_eq_le)
qed auto

lemma infinite_nat_greaterThan:
  fixes m::nat
  assumes "infinite N"
  shows "infinite (N \<inter> {m<..})"
proof -
  have "N \<subseteq> -{m<..} \<union> (N \<inter> {m<..})"
    by blast
  moreover have "finite (-{m<..})"
    by simp
  ultimately show ?thesis
    using assms finite_subset by blast
qed

end