(*<*)
theory Filtermap
  imports Trivia
begin
(*>*)

section \<open>Preliminaries\<close>

function filtermap ::
"('trans \<Rightarrow> bool) \<Rightarrow> ('trans \<Rightarrow> 'a) \<Rightarrow> 'trans list \<Rightarrow> 'a list"
where
"filtermap pred func [] = []"
|
"\<not> pred trn \<Longrightarrow> filtermap pred func (trn # tr) = filtermap pred func tr"
|
"pred trn \<Longrightarrow> filtermap pred func (trn # tr) = func trn # filtermap pred func tr"
by auto (metis list.exhaust)
termination by lexicographic_order

lemma filtermap_map_filter: "filtermap pred func xs = map func (filter pred xs)"
by (induction xs) auto

lemma filtermap_append: "filtermap pred func (tr @ tr1) = filtermap pred func tr @ filtermap pred func tr1"
proof(induction tr arbitrary: tr1)
  case (Cons trn tr)
  thus ?case by (cases "pred trn") auto
qed auto

lemma filtermap_Nil_list_ex: "filtermap pred func tr = [] \<longleftrightarrow> \<not> list_ex pred tr"
proof(induction tr)
  case (Cons trn tr)
  thus ?case by (cases "pred trn") auto
qed auto

lemma filtermap_Nil_never: "filtermap pred func tr = [] \<longleftrightarrow> never pred tr"
proof(induction tr)
  case (Cons trn tr)
  thus ?case by (cases "pred trn") auto
qed auto

lemma length_filtermap: "length (filtermap pred func tr) \<le> length tr"
proof(induction tr)
  case (Cons trn tr)
  thus ?case by (cases "pred trn") auto
qed auto

lemma filtermap_list_all[simp]: "filtermap pred func tr = map func tr \<longleftrightarrow> list_all pred tr"
proof(induction tr)
  case (Cons trn tr)
  thus ?case apply (cases "pred trn")
  by (simp_all) (metis impossible_Cons length_filtermap length_map)
qed auto

lemma filtermap_eq_Cons:
assumes "filtermap pred func tr = a # al1"
shows "\<exists> trn tr2 tr1.
   tr = tr2 @ [trn] @ tr1 \<and> never pred tr2 \<and> pred trn \<and> func trn = a \<and> filtermap pred func tr1 = al1"
using assms proof(induction tr arbitrary: a al1)
  case (Cons trn tr a al1)
  show ?case
  proof(cases "pred trn")
    case False
    hence "filtermap pred func tr = a # al1" using Cons by simp
    from Cons(1)[OF this] obtain trnn tr2 tr1 where
    1: "tr = tr2 @ [trnn] @ tr1 \<and> never pred tr2 \<and> pred trnn \<and> func trnn = a \<and>
     filtermap pred func tr1 = al1" by blast
    show ?thesis apply(rule exI[of _ trnn], rule exI[of _ "trn # tr2"], rule exI[of _ tr1])
    using Cons(2) 1 False by simp
  next
    case True
    hence "filtermap pred func tr = al1" using Cons by simp
    show ?thesis apply(rule exI[of _ trn], rule exI[of _ "[]"], rule exI[of _ tr])
    using Cons(2) True by simp
  qed
qed auto

lemma filtermap_eq_append:
assumes "filtermap pred func tr = al1 @ al2"
shows "\<exists> tr1 tr2. tr = tr1 @ tr2 \<and> filtermap pred func tr1 = al1 \<and> filtermap pred func tr2 = al2"
using assms proof(induction al1 arbitrary: tr)
  case Nil show ?case
  apply (rule exI[of _ "[]"], rule exI[of _ tr]) using Nil by auto
next
  case (Cons a al1 tr)
  hence "filtermap pred func tr = a # (al1 @ al2)" by simp
  from filtermap_eq_Cons[OF this] obtain trn tr2 tr1
  where tr: "tr = tr2 @ [trn] @ tr1" and n: "never pred tr2 \<and> pred trn \<and> func trn = a"
  and f: "filtermap pred func tr1 = al1 @ al2" by blast
  from Cons(1)[OF f] obtain tr11 tr22 where tr1: "tr1 = tr11 @ tr22"
  and f1: "filtermap pred func tr11 = al1" and f2: "filtermap pred func tr22 = al2" by blast
  show ?case apply (rule exI[of _ "tr2 @ [trn] @ tr11"], rule exI[of _ tr22])
  using n filtermap_Nil_never f1 f2 unfolding tr tr1 filtermap_append by auto
qed

lemma holds_filtermap_RCons[simp]:
"pred trn \<Longrightarrow> filtermap pred func (tr ## trn) = filtermap pred func tr ## func trn"
proof(induction tr)
  case (Cons trn1 tr)
  thus ?case by (cases "pred trn1") auto
qed auto

lemma not_holds_filtermap_RCons[simp]:
"\<not> pred trn \<Longrightarrow> filtermap pred func (tr ## trn) = filtermap pred func tr"
proof(induction tr)
  case (Cons trn1 tr)
  thus ?case by (cases "pred trn1") auto
qed auto

lemma filtermap_eq_RCons:
assumes "filtermap pred func tr = al1 ## a"
shows "\<exists> trn tr1 tr2.
   tr = tr1 @ [trn] @ tr2 \<and> never pred tr2 \<and> pred trn \<and> func trn = a \<and> filtermap pred func tr1 = al1"
using assms proof(induction tr arbitrary: a al1 rule: rev_induct)
  case (snoc trn tr a al1)
  show ?case
  proof(cases "pred trn")
    case False
    hence "filtermap pred func tr = al1 ## a" using snoc by simp
    from snoc(1)[OF this] obtain trnn tr2 tr1 where
    1: "tr = tr1 @ [trnn] @ tr2 \<and> never pred tr2 \<and> pred trnn \<and> func trnn = a \<and>
     filtermap pred func tr1 = al1" by blast
    show ?thesis apply(rule exI[of _ trnn], rule exI[of _ tr1], rule exI[of _ "tr2 ## trn"])
    using snoc(2) 1 False by simp
  next
    case True
    hence "filtermap pred func tr = al1" using snoc by simp
    show ?thesis apply(rule exI[of _ trn], rule exI[of _ tr], rule exI[of _ "[]"])
    using snoc(2) True by simp
  qed
qed auto

lemma filtermap_eq_Cons_RCons:
assumes "filtermap pred func tr = a # al1 ## b"
shows "\<exists> tra trna tr1 trnb trb.
   tr = tra @ [trna] @ tr1 @ [trnb] @ trb \<and>
   never pred tra \<and>
   pred trna \<and> func trna = a \<and>
   filtermap pred func tr1 = al1 \<and>
   pred trnb \<and> func trnb = b \<and>
   never pred trb"
proof-
  from filtermap_eq_Cons[OF assms] obtain trna tra tr2
  where 0: "tr = tra @ [trna] @ tr2 \<and> never pred tra \<and> pred trna \<and> func trna = a"
  and 1: "filtermap pred func tr2 = al1 ## b" by auto
  from filtermap_eq_RCons[OF 1] obtain trnb tr1 trb where
  2: "tr2 = tr1 @ [trnb] @ trb \<and> never pred trb \<and>
  pred trnb \<and> func trnb = b \<and> filtermap pred func tr1 = al1" by blast
  show ?thesis apply(rule exI[of _ tra], rule exI[of _ trna], rule exI[of _ tr1],
    rule exI[of _ trnb], rule exI[of _ trb])
  using 2 0 by auto
qed

lemma filter_Nil_never: "[] = filter pred xs \<Longrightarrow> never pred xs"
by (induction xs) (auto split: if_splits)

lemma never_Nil_filter: "never pred xs \<longleftrightarrow> [] = filter pred xs"
by (induction xs) (auto split: if_splits)

lemma snoc_eq_filterD:
  assumes "xs ## x = filter Q ys"
  obtains us vs where "ys = us @ x # vs" and "never Q vs" and "Q x" and "xs = filter Q us"
using assms proof (induction ys rule: rev_induct)
  case Nil then show ?case by auto
next
  case (snoc y ys)
    show ?case
    proof (cases)
      assume "Q y"
      moreover then have "x = y" using snoc.prems by auto
      ultimately show thesis using snoc(3) snoc(2) by auto
    next
      assume "\<not>Q y"
      show thesis
      proof (rule snoc.IH)
        show "xs ## x = filter Q ys" using \<open>\<not>Q y\<close> snoc(3) by auto
      next
        fix us vs
        assume "ys = us @ x # vs" and "never Q vs" and "Q x" and "xs = filter Q us"
        then show thesis using \<open>\<not>Q y\<close> snoc(2) by auto
      qed
    qed
qed

lemma filtermap_Cons2_eq:
     "filtermap pred func [x, x'] = filtermap pred func [y, y']
  \<Longrightarrow> filtermap pred func (x # x' # zs) = filtermap pred func (y # y' # zs)"
unfolding filtermap_append[of pred func "[x, x']" "zs", simplified]
          filtermap_append[of pred func "[y, y']" "zs", simplified]
by simp

lemma filtermap_Cons_cong:
   "filtermap pred func xs = filtermap pred func ys
\<Longrightarrow> filtermap pred func (x # xs) = filtermap pred func (x # ys)"
by (cases "pred x") auto

lemma set_filtermap:
"set (filtermap pred func xs) \<subseteq> {func x | x . x \<in>\<in> xs \<and> pred x}"
by (induct xs, simp) (case_tac "pred a", auto)

(*<*)
end
(*>*)


theory Zp_poly
imports "~~/src/HOL/Algebra/UnivPoly" padic_sequences cring_poly
begin

context padic_integers
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))

(*
\<oplus> (d \<otimes> a2 \<ominus> d \<otimes> a)  \<oplus> d \<otimes>(a2 \<ominus> b2)
*)
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 P_Zp where
"P_Zp \<equiv> UP Z\<^sub>p"

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

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

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

lemma P_Zp_ring[simp]:
"ring P_Zp "
  by (simp add: UP_ring.UP_ring)

lemma P_Zp_cring[simp]:
"cring P_Zp "
  by (simp add: UP_cring.UP_cring)

lemma P_Zp_domain[simp]:
"domain P_Zp "
  by (simp add: UP_domain.UP_domain)

(*Basic simp rules to streaminline computation*)

lemma pow_closedP[simp]:
  assumes "f \<in> carrier P_Zp"
  shows "f[^]\<^bsub>P_Zp\<^esub>(n::nat) \<in> carrier P_Zp "
  by (meson P_Zp_ring assms monoid.nat_pow_closed ring_def)

lemma pow_closed[simp]:
  assumes "f \<in> carrier Z\<^sub>p"
  shows "f[^](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>P_Zp\<^esub>[^]\<^bsub>P_Zp\<^esub>(n::nat) = \<zero>\<^bsub>P_Zp\<^esub>"
  using assms ring.pow_zero[of P_Zp] by simp

lemma sum_closedP[simp]:
  assumes "f \<in> carrier P_Zp"
  assumes "g \<in> carrier P_Zp"
  shows "f \<oplus>\<^bsub>P_Zp\<^esub>g \<in>  carrier P_Zp"
  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 P_Zp"
  shows "f \<otimes>\<^bsub>P_Zp\<^esub> \<zero>\<^bsub>P_Zp\<^esub> = \<zero>\<^bsub>P_Zp\<^esub>"
        "\<zero>\<^bsub>P_Zp\<^esub> \<otimes>\<^bsub>P_Zp\<^esub> f = \<zero>\<^bsub>P_Zp\<^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: Zp_is_cring assms cring.cring_simprules)
   apply (simp add: Zp_is_cring assms cring.cring_simprules)
   done

lemma add_zeroP[simp]:
  assumes "f \<in> carrier P_Zp "
  shows "f \<oplus>\<^bsub>P_Zp\<^esub> \<zero>\<^bsub>P_Zp\<^esub> = f"
        "\<zero>\<^bsub>P_Zp\<^esub> \<oplus>\<^bsub>P_Zp\<^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*)
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 "\<star>" 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)

(*P_Zp addition commutes with evaluation addition*)
lemma fun_of_fun_sum:
  assumes "f \<in> carrier P_Zp"
  assumes "g \<in> carrier P_Zp"
  assumes "h = f \<oplus>\<^bsub>P_Zp\<^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 P_Zp 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 P_Zp\<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 P_Zp c n"
  assumes "x \<in> carrier Z\<^sub>p"
  shows "fun_of f x = mon c n x"
proof-
  have 1: "fun_of f x = c \<otimes> x [^] n"
    using UP_domain.fun_of_monom assms P_Zp_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 P_Zp 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:P_Zp_is_UP_ring 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: "fun_of f 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 P_Zp"
        apply(auto simp: assms(2))
        using assms(1) P_Zp_is_UP_ring UP_ring.monom_closed[of Z\<^sub>p c n] apply simp
        done
      have C3: "fun_of f x = (\<Oplus>i \<in> {..degree f}. (cf f i) \<otimes> x [^] i)"
        using  A  C2 P_Zp_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 "fun_of f 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 P_Zp_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 P_Zp 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 P_Zp_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_imp_constant1:
  assumes "f \<in> carrier P_Zp"
  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 P_Zp_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 = fun_of f x "
    proof-
      have LHS: "g x = c"
        using g_def using to_const_fun_def by simp
      have RHS: "fun_of f 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_imp_continuous:
  assumes "f \<in> carrier P_Zp"
  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_imp_constant1 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_continuous0:
  fixes n::nat
  shows "\<And>f. f \<in> carrier P_Zp \<Longrightarrow> degree f \<le> n \<Longrightarrow> is_continuous (fun_of f)"
proof(induction n)
case 0
  then show ?case
    using degree_0_imp_continuous by blast
next
  case (Suc n)
  fix n
  assume IH: "\<And>f. f \<in> carrier P_Zp \<Longrightarrow> (degree f \<le> n \<Longrightarrow> is_continuous (fun_of f))"
  show "\<And>f. f \<in> carrier P_Zp \<Longrightarrow> degree f \<le> Suc n \<Longrightarrow> is_continuous (fun_of f) "
  proof-
    fix f
    assume A0:"f \<in> carrier P_Zp"
    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 P_Zp \<and> (f = g \<oplus>\<^bsub>P_Zp\<^esub> (lt f)) \<and> degree g < degree f"
        using E0 A0 P_Zp_is_UP_domain UP_domain.lt_decomp[of Z\<^sub>p f] by auto
      have g0: "g \<in> carrier P_Zp"
        using g_def by auto
      have g1: "f = g \<oplus>\<^bsub>P_Zp\<^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
            P_Zp_is_UP_ring UP_domain.coeff_simp1 P_Zp_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) P_Zp_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 P_Zp"
  shows "is_continuous (fun_of f)"
proof-
  obtain n where n_def: "n = degree f"
    by simp
  then show ?thesis
    using assms polynomial_is_continuous0 by auto
qed

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

(*The inclusion of Z\<^sub>p into P_Zp*)
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 P_Zp"
  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"

(*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 shift function*)

abbreviation poly_shift where
"poly_shift \<equiv> polynomial_shift Z\<^sub>p"

(*The iterated shift function*)

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 "(fun_of (X[^]\<^bsub>P_Zp\<^esub>(n::nat)) a) k = (fun_of (X[^]\<^bsub>P_Zp\<^esub>n) b) k"
proof(induction n)
  case 0
  then show ?case
    by (smt P_Zp_is_UP_domain P_Zp_is_UP_ring P_Zp_ring UP_domain.X_is_poly UP_ring.deg_monom
        UP_ring.monom_one Zp_one_car Zp_one_notzero assms(1) assms(2) degree_0_imp_constant1
        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>P_Zp\<^esub> n \<star> a) k = (X [^]\<^bsub>P_Zp\<^esub> n \<star> b) k"
  show "(X [^]\<^bsub>P_Zp\<^esub> Suc n \<star> a) k = (X [^]\<^bsub>P_Zp\<^esub> Suc n \<star> b) k"
  proof-
    have LHS0: "(X [^]\<^bsub>P_Zp\<^esub> Suc n \<star> a) k = ((X [^]\<^bsub>P_Zp\<^esub> n \<star> a) \<otimes> (X \<star> a)) k"
      by (metis (no_types, lifting) P_Zp_is_UP_domain P_Zp_ring UP_domain.X_is_poly
          UP_domain.fun_of_mult assms(1) monoid.nat_pow_Suc pow_closedP ring_def)
    have LHS1: "(X [^]\<^bsub>P_Zp\<^esub> Suc n \<star> a) k = (X [^]\<^bsub>P_Zp\<^esub> n \<star> a) k \<otimes>\<^bsub>R k\<^esub> (X \<star> a) k"
      using LHS0
      by (simp add: Res_def Z\<^sub>p_def padic_mult_simp)
    then show ?thesis using assms IH
      by (smt P_Zp_is_UP_domain P_Zp_ring UP_domain.X_is_poly
          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 P_Zp"
  assumes "a k = b k"
  shows "(fun_of (lt f) a) k = (fun_of (lt f) b) k"
proof-
  have "lt f = (lc f)\<odot>\<^bsub>P_Zp\<^esub>(X[^]\<^bsub>P_Zp\<^esub>(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[^]\<^bsub>P_Zp\<^esub>(degree f)) a)"
    by (simp add: UP_domain.X_is_poly UP_domain.fun_of_smult UP_domain.lc_closed \<open>lt f = lc f \<odot>\<^bsub>P_Zp\<^esub> X [^]\<^bsub>P_Zp\<^esub> degree f\<close> assms(1) assms(3))
  have RHS0: "(fun_of (lt f) b) = (lc f) \<otimes> (fun_of (X[^]\<^bsub>P_Zp\<^esub>(degree f)) b)"
    by (simp add: UP_domain.X_is_poly UP_domain.fun_of_smult UP_domain.lc_closed \<open>lt f = lc f \<odot>\<^bsub>P_Zp\<^esub> X [^]\<^bsub>P_Zp\<^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[^]\<^bsub>P_Zp\<^esub>(degree f)) a) k"
    using LHS0 assms
    by (simp add: Res_def 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[^]\<^bsub>P_Zp\<^esub>(degree f)) b) k"
    using RHS0 assms
    by (simp add: Res_def Z\<^sub>p_def padic_simps(3))
  then show ?thesis
    using LHS1 RHS1 assms
    by (metis fun_of_res_X_pow)
qed

lemma fun_of_res:
  assumes "f \<in> carrier P_Zp"
  assumes "a \<in> carrier Z\<^sub>p"
  assumes "b \<in> carrier Z\<^sub>p"
  assumes "a k = b k"
  shows "(fun_of f a) k = (fun_of f 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 P_Zp" using assms by simp
  show "\<And>p. p \<in> carrier P_Zp \<Longrightarrow> degree p = 0 \<Longrightarrow> (p \<star> a) k = (p \<star> b) k"
    by (metis P_Zp_is_UP_domain UP_domain.degree_0_imp_constant0 assms(2) assms(3))
  show "\<And>p. 0 < degree p \<Longrightarrow> p \<in> carrier P_Zp \<Longrightarrow> (trunc p \<star> a) k = (trunc p \<star> b) k
                \<Longrightarrow> (p \<star> a) k = (p \<star> b) k"
  proof-
    fix p
    assume A: "0 < degree p" "p \<in> carrier P_Zp"
    assume IH: " (trunc p \<star> a) k = (trunc p \<star> b) k "
    show "(p \<star> a) k = (p \<star> b) k"
    proof-
      have "(p \<star> a) k = (((trunc p)\<star> a) \<oplus> ((lt p) \<star> a)) k "
        by (metis A(2) P_Zp_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 \<star> a) k = (((trunc p)\<star> b) k) \<oplus>\<^bsub>R k\<^esub> ((lt p) \<star> a) k "
        using IH
        by (simp add: Res_def Z\<^sub>p_def padic_add_def)
      have "((lt p) \<star> a) k = ((lt p) \<star> b) k"
        by (simp add: A(2) assms(2) assms(3) assms(4) fun_of_res_lt)
      then have 1: "(p \<star> a) k = (((trunc p)\<star> b) k) \<oplus>\<^bsub>R k\<^esub> ((lt p) \<star> b) k "
        using 0 by auto
      then have 2: "(p \<star> a) k = (((trunc p)\<star> b) \<oplus> ((lt p) \<star> b)) k "
        using IH Z\<^sub>p_def \<open>(lt p \<star> a) k = (lt p \<star> b) k\<close> \<open>(p \<star> a) k = (trunc p \<star> a \<oplus> lt p \<star> a) k\<close>
          padic_add_def by auto
      then have 2: "(p \<star> a) k = (((trunc p) \<oplus>\<^bsub>P_Zp\<^esub>(lt p)) \<star> 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) P_Zp_is_UP_domain UP_domain.trunc_simps(1))
    qed
  qed
qed

lemma deriv_res:
  assumes "f \<in> carrier P_Zp"
  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 P_Zp"
    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 P_Zp \<and> a \<in> carrier Z\<^sub>p \<and> ((f \<star> a) 1) = 0 \<and> (deriv f a 1) \<noteq> 0)"

lemma pre_hensel:
  assumes "hensel f a"
  shows "\<exists> b \<in> carrier Z\<^sub>p. (f \<star> b) (Suc n) = 0 \<and> b 1 = a 1"
proof(induction n)
  case 0
  then show ?case
    using assms by auto
next
  case (Suc n)
  fix n
  assume IH: "\<exists> b \<in> carrier Z\<^sub>p. (f \<star> b) (Suc n) = 0 \<and> b 1 = a 1"
  show "\<exists> b \<in> carrier Z\<^sub>p. (f \<star> b) (Suc (Suc n)) = 0 \<and> b 1 = a 1"
  proof-
    obtain b where b_def: "b \<in> carrier Z\<^sub>p \<and> (f \<star> b) (Suc n) = 0 \<and> b 1 = a 1"
      using IH by blast
    have  "val_Zp (\<p>[^](Suc n)) \<preceq>\<^bsub>G\<^esub> val_Zp (f \<star> b)"
    proof(cases "f \<star> b = \<zero>")
      case True
      then show ?thesis
        by (simp add: G_ord(1) val_Zp_def)
    next
      case False
      then have "f \<star> b \<in>nonzero Z\<^sub>p"
        by (meson assms b_def continuous_is_closed is_closed_fun_simp
            not_nonzero_Zp order_refl polynomial_is_continuous0)
      then have "ord_Zp (f \<star> b) \<ge> Suc n"
        using b_def  False Zp_nonzero_def(1) ord_Zp_geq by force
      then have "ord_Zp (\<p>[^](Suc n)) \<le> ord_Zp (f \<star> b)"
        using b_def  by (simp add: ord_Zp_p_pow)
      then show ?thesis
        using False G_ord(3) \<open>int (Suc n) \<le> ord_Zp (f \<star> b)\<close> ord_Zp_def val_Zp_def val_Zp_p_pow by auto
    qed
    then have 1:"divide (f \<star> b) (\<p>[^](Suc n)) \<otimes> (\<p>[^](Suc n)) = f \<star> b"
      using assms b_def continuous_is_closed divide_id'(2)  is_closed_fun_simp
        p_pow_nonzero polynomial_is_continuous by auto
    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 "(f' a)"] by simp
    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 Res_def Z\<^sub>p_def by (metis padic_set_simp0 partial_object.select_convs(1))
      have "\<zero>\<^bsub>R 1\<^esub> = 0"
        by (simp add: Res_def 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 Res_def P0 P1 m_inv_def field.field_inv[of "R 1" "(deriv f a) 1"] k_def
        by auto
      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 \<star> 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 \<star> (b \<oplus> ((\<p>[^](Suc n)) \<otimes> t))) (Suc (Suc n)) = 0"
    proof-
      obtain fb where fb_def[simp]: "fb = f \<star> 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)) \<star> ((\<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 P_Zp_is_UP_domain Taylor_closed_UP_domain
              poly_shift_closed_UP_domain pnt_car c_def
        by (simp add: assms b_def)
      have A0: " f \<star> (\<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 P_Zp"
          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
                P_Zp_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 auto
        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)"
            by (simp add: ord_Zp_p_pow)
          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 auto
          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] P_Zp_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 \<star> (\<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 auto
      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] P_Zp_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: Res_def 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 \<star> b) (\<p>[^](Suc n))) 1) \<otimes>\<^bsub>R 1\<^esub> k))"
              using C10 m_def C0
              by (smt R_residues Res_def 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 \<star> b) (\<p>[^](Suc n))) 1))))"
            proof-
              have C120:"((divide (f \<star> b) (\<p>[^](Suc n))) 1) \<in> carrier (R 1)"
                by (metis A7 Res_def Z\<^sub>p_def \<open>val_Zp (f \<star> 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 \<star> b) (\<p>[^](Suc n))) 1) \<otimes>\<^bsub>R 1\<^esub> k))
                              =(\<ominus>\<^bsub>R 1\<^esub> (k \<otimes>\<^bsub>R 1\<^esub> ((divide (f \<star> b) (\<p>[^](Suc n))) 1)))"
                using C120 C121   Res_1_field
                by (metis R_residues Res_def 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" Res_def 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" Res_def 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 \<star> b) (\<p>[^](Suc n))) 1))) \<in> carrier (R 1)"
            proof-
              have "(divide (f \<star> b) (\<p>[^](Suc n))) \<in> carrier Z\<^sub>p"
                using A7 \<open>val_Zp (f \<star> 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 \<star> b) (\<p>[^](Suc n))) 1 \<in> carrier (R 1)"
                by (metis Res_def Z\<^sub>p_def padic_set_simp0 partial_object.select_convs(1))
              then show ?thesis using Res_1_field C13
                by simp
            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 \<star> b) (\<p>[^](Suc n))) 1))))"
              using C12 C13 C14 C15 Res_1_field R_cring[of 1] R_residues[of 1]
              unfolding Res_def
              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 \<star> b) (\<p>[^](Suc n))) 1)))"
              using C12 C13 C14 C15 Res_1_field R_cring[of 1] R_residues[of 1]
              unfolding Res_def
              by (metis (no_types, lifting) A7 Z\<^sub>p_def \<open>val_Zp (f \<star> 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 \<star> 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]
              unfolding Res_def
              by (smt A7 Res_def 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 \<star> 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
          using A7 Res_def Z\<^sub>p_def \<open>val_Zp (f \<star> b) \<succeq>\<^bsub>G\<^esub> val_Zp (\<p> [^] Suc n)\<close>
            divide_id'(1) p_pow_nonzero padic_inv prime by auto
        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 \<star> 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 \<star> 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 \<star> 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 \<star> 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 \<star> 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 simp
            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] P_Zp_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: Res_def Z\<^sub>p_def padic_add_def)
          then show ?thesis
            using A834
            unfolding Res_def
            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 \<star> 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: Res_def 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
          unfolding Res_def
          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
    show ?thesis using b10 b11 b12 by blast
  qed
qed

definition hensel_sequence where
"hensel_sequence f a = (\<lambda>n::nat. (SOME b. b \<in> carrier Z\<^sub>p \<and> (f \<star> b) (Suc n) = 0 \<and> b 1 = a 1))"

lemma hensel_sequence_id:
  assumes "hensel f a"
  assumes " b = (hensel_sequence f a)"
  assumes "n > m"
  shows "(b n) m = (b m) m"
proof-
  obtain bn where bn_def[simp]: "bn = b n"
    by simp
  obtain bm where bm_def[simp]: "bm = b m"
    by simp

  have bn: "bn \<in> carrier Z\<^sub>p \<and> (f \<star> (bn)) (Suc n) = 0 \<and> (bn) 1 = a 1"
    using pre_hensel[of f a] assms bn_def
    unfolding hensel_sequence_def
    by (smt someI_ex)
  have bm: "bm \<in> carrier Z\<^sub>p \<and> (f \<star> (bm)) (Suc m) = 0 \<and> (bm) 1 = a 1"
    using pre_hensel[of f a] assms bm_def
    unfolding hensel_sequence_def
    by (smt someI_ex)

  obtain fbn where fbn_def[simp]: "fbn = fun_of f (bn)"
    by simp
  obtain fbm where fbm_def[simp]: "fbm = fun_of f (bm)"
    by simp

  have fbn_car[simp]: "fbn \<in> carrier Z\<^sub>p"
    using assms(1) bn continuous_is_closed fbn_def
        is_closed_fun_simp polynomial_is_continuous by blast
  have fbm_car[simp]: "fbm \<in> carrier Z\<^sub>p"
    using assms(1) bm continuous_is_closed fbm_def
         is_closed_fun_simp polynomial_is_continuous
    by blast

  obtain f'a where f'a_def[simp]:"f'a = deriv f a"
    by simp
  have f'a_car[simp]: "f'a \<in> carrier Z\<^sub>p"
    using assms f'a_def P_Zp_is_UP_domain
    by (simp add: UP_domain.derivative_closed)

  obtain fa where fa_def: "fa = fun_of f a"
    by simp
  have fa_car: "fa \<in> carrier Z\<^sub>p"
    using fa_def P_Zp_is_UP_domain
    by (simp add: assms(1))

  obtain cn where cn_def: "cn = fun_of (shift (2::nat) (T\<^bsub>a\<^esub> f)) (bn \<ominus> a)"
    by simp
  have cn_car[simp]: "cn \<in> carrier Z\<^sub>p"
    using cn_def P_Zp_is_UP_domain
    by (metis UP_domain.Taylor_closed Zp_is_cring a_minus_def assms(1)
        bn cring.cring_simprules(3) fun_of_closed_UP_domain shift_closed_UP_domain sum_closed)

  obtain cm where cm_def: "cm = fun_of (shift (2::nat) (T\<^bsub>a\<^esub> f)) (bm \<ominus> a)"
    by simp
  have cm_car[simp]: "cm \<in> carrier Z\<^sub>p"
    using cm_def P_Zp_is_UP_domain

    by (metis UP_domain.Taylor_closed Zp_is_cring a_minus_def assms(1)
        bm cring.cring_simprules(3) fun_of_closed_UP_domain shift_closed_UP_domain sum_closed)

  have fbn0: "fbn =  fa \<oplus> f'a \<otimes> (bn \<ominus> a) \<oplus> (cn \<otimes> (bn \<ominus> a)[^](2::nat))"
    using UP_domain.Taylor_deg_1_expansion[of Z\<^sub>p f a bn cn fa f'a] P_Zp_is_UP_domain
          assms(1) bn cn_def f'a_def fa_def fbn_def
    by blast
  have fbm0: "fbm =  fa \<oplus> f'a \<otimes> (bm \<ominus> a) \<oplus> (cm \<otimes> (bm \<ominus> a)[^](2::nat))"
    using UP_domain.Taylor_deg_1_expansion[of Z\<^sub>p f a bm cm fa f'a] P_Zp_is_UP_domain
          assms(1) bm cm_def f'a_def fa_def fbm_def
    by blast
-

  have fb_diff: "fbn \<ominus> fbm = f'a \<otimes>(bn \<ominus> bm) \<oplus>  (cn \<otimes> (bn \<ominus> a) [^] (2::nat) \<ominus> cm \<otimes> (bm \<ominus> a) [^] (2::nat))"
  proof-
    have fb_d0:"fbn \<ominus> fbm = fa \<oplus> f'a \<otimes> (bn \<ominus> a) \<oplus> (cn \<otimes> (bn \<ominus> a)[^](2::nat))
                    \<ominus>(fa \<oplus> f'a \<otimes> (bm \<ominus> a) \<oplus> (cm \<otimes> (bm \<ominus> a)[^](2::nat)))"
      using fbn0 fbm0 by auto
    have fb_d1:"fbn \<ominus> fbm =  f'a \<otimes> (bn \<ominus> a) \<ominus> f'a \<otimes> (bm \<ominus> a) \<oplus> (cn \<otimes> (bn \<ominus> a) [^] (2::nat) \<ominus> cm \<otimes> (bm \<ominus> a) [^] (2::nat))"
    proof-
      have fb_d10[simp]:"f'a \<otimes> (bn \<ominus> a) \<in> carrier Z\<^sub>p" "f'a \<otimes> (bm \<ominus> a) \<in> carrier Z\<^sub>p"
        using Zp_is_cring cring_def[of Z\<^sub>p]
              fbn_car bn cn_car f'a_car fa_car  assms
              cring.cring_simprules(1-5)[of Z\<^sub>p]
              ring.ring_simprules(1-6)[of Z\<^sub>p]
        apply meson
        using Zp_is_cring cring.cring_simprules(4)[of Z\<^sub>p]  cring.cring_simprules(5)[of Z\<^sub>p]
              assms(1) bm f'a_car
        apply blast done
      have fb_d11[simp]:"cn \<otimes> (bn \<ominus> a) [^] (2::nat) \<in> carrier Z\<^sub>p" "cm \<otimes> (bm \<ominus> a) [^] (2::nat) \<in> carrier Z\<^sub>p"
       apply (meson Zp_is_cring assms(1) bn cn_car cring.cring_simprules(4) monom_term_car)
       by (meson Zp_is_cring assms(1) bm cm_car cring.cring_simprules(4) monom_term_car)
     show ?thesis
       using fb_d0 fb_d10 fb_d11 cring_def fa_car
              cring.minus_pairs_cancel_1[of Z\<^sub>p fa "f'a \<otimes> (bn \<ominus> a)" "(cn \<otimes> (bn \<ominus> a)[^](2::nat))"
                                                  "f'a \<otimes> (bm \<ominus> a)" "(cm \<otimes> (bm \<ominus> a)[^](2::nat))"]
       by force
    qed
    have fb_d2:"fbn \<ominus> fbm = f'a \<otimes> (bn \<ominus> a \<ominus> (bm \<ominus> a)) \<oplus>  (cn \<otimes> (bn \<ominus> a) [^] (2::nat) \<ominus> cm \<otimes> (bm \<ominus> a) [^] (2::nat))"
      using Zp_is_cring cring.minus_pair_factor[of Z\<^sub>p "(bn \<ominus> a)" "(bm \<ominus> a)" f'a ]
      by (metis assms(1) bm bn cring.cring_simprules(4) f'a_car fb_d1)
    have fb_d3: "(bn \<ominus> a \<ominus> (bm \<ominus> a)) = bn \<ominus> bm"
      using  cring.minus_pairs_cancel_2[of Z\<^sub>p bn bm a]
             Zp_is_cring assms(1) bm bn
      by blast
    show ?thesis using fb_d2 fb_d3
      by auto
  qed

lemma hensels_lemma0:
assumes "hensel f a"
shows "\<exists> \<alpha> \<in> carrier Z\<^sub>p. f\<star>\<alpha> = \<zero> \<and> \<alpha> 1 = a 1"

end
end


\<^marker>\<open>creator Bilel Ghorbel, Florian Kessler\<close>

section "Small step semantics of IMP-- "

subsection "IMP-- Small step semantics definition"
theory IMP_Minus_Minus_Small_StepT  imports Main IMP_Minus_Minus_Com "IMP_Minus.Rel_Pow" begin

paragraph "Summary"
text\<open>We give small step semantics with time for IMP--.
Based on the small step semantics definition time for IMP-. In contrast to IMP-, we use partial
maps to represent states. That has the simple reason the we designed this with translation to
SAS++ in mind, which also uses partial states. \<close>

type_synonym state = "vname \<rightharpoonup> bit"

inductive
  small_step :: "com * state  \<Rightarrow> com * state \<Rightarrow> bool"  ("_ \<rightarrow> _" 55)
  where
Assign:  "(x ::= v, s) \<rightarrow> (SKIP, s(x \<mapsto> v))" |

Seq1:    "(SKIP;;c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |
Seq2:    "(c\<^sub>1,s) \<rightarrow> (c\<^sub>1',s') \<Longrightarrow> (c\<^sub>1;;c\<^sub>2,s) \<rightarrow> (c\<^sub>1';;c\<^sub>2,s')" |

IfTrue:  "\<exists>b \<in> set bs. s b \<noteq> Some Zero \<Longrightarrow> (IF bs \<noteq>0 THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>1,s)" |
IfFalse: "\<forall>b \<in> set bs. s b = Some Zero \<Longrightarrow> (IF bs \<noteq>0  THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |

WhileTrue:   "(\<exists>b \<in> set bs. s b \<noteq> Some Zero) \<Longrightarrow> (WHILE bs \<noteq>0 DO c,s) \<rightarrow>
            (c ;; (WHILE bs \<noteq>0 DO c), s)" |
WhileFalse:   "(\<forall>b \<in> set bs. s b = Some Zero) \<Longrightarrow> (WHILE bs \<noteq>0 DO c,s) \<rightarrow>
            (SKIP,s)"

subsection "Transitive Closure"
abbreviation
  small_step_pow :: "com * state \<Rightarrow> nat \<Rightarrow> com * state \<Rightarrow> bool" ("_ \<rightarrow>\<^bsup>_\<^esup> _" 55)
  where "x \<rightarrow>\<^bsup>t\<^esup> y == (rel_pow small_step t) x y"

bundle small_step_syntax
begin
notation small_step (infix "\<rightarrow>" 55) and
         small_step_pow ("_ \<rightarrow>\<^bsup>_\<^esup> _" 55)
end

bundle no_small_step_syntax
begin
no_notation small_step (infix "\<rightarrow>" 55) and
            small_step_pow ("_ \<rightarrow>\<^bsup>_\<^esup> _" 55)
end

subsection\<open>Executability\<close>

code_pred small_step .

subsection\<open>Proof infrastructure\<close>

subsubsection\<open>Induction rules\<close>

text\<open>The default induction rule @{thm[source] small_step.induct} only works
for lemmas of the form \<open>a \<rightarrow> b \<Longrightarrow> \<dots>\<close> where \<open>a\<close> and \<open>b\<close> are
not already pairs \<open>(DUMMY,DUMMY)\<close>. We can generate a suitable variant
of @{thm[source] small_step.induct} for pairs by ``splitting'' the arguments
\<open>\<rightarrow>\<close> into pairs:\<close>
lemmas small_step_induct = small_step.induct[split_format(complete)]

subsubsection\<open>Proof automation\<close>

declare small_step.intros[simp,intro]

text\<open>Rule inversion:\<close>

inductive_cases SkipE[elim!]: "(SKIP,s) \<rightarrow> ct"
inductive_cases Assign[elim!]: "(x ::= v,s) \<rightarrow> ct"
inductive_cases SeqE[elim]: "(c1;;c2,s) \<rightarrow> ct"
inductive_cases IfE[elim!]: "(IF b\<noteq>0 THEN c1 ELSE c2,s) \<rightarrow> ct"
inductive_cases WhileE[elim]: "(WHILE b\<noteq>0 DO c, s) \<rightarrow> ct"

subsection "Sequence properties"
declare rel_pow_intros[simp,intro]

text\<open>A simple property:\<close>
lemma deterministic:
  "cs \<rightarrow> cs' \<Longrightarrow> cs \<rightarrow> cs'' \<Longrightarrow> cs'' = cs'"
apply(induction arbitrary: cs'' rule: small_step.induct)
  by blast+

text "sequence property"
lemma star_seq2: "(c1,s) \<rightarrow>\<^bsup>t\<^esup> (c1',s') \<Longrightarrow> (c1;;c2,s) \<rightarrow>\<^bsup> t \<^esup> (c1';;c2,s')"
proof(induction t arbitrary: c1 c1' s s')
  case (Suc t)
  then obtain c1'' s'' where "(c1,s) \<rightarrow> (c1'', s'')"
                         and "(c1'', s'')  \<rightarrow>\<^bsup> t \<^esup>  (c1', s')" by auto
  moreover then have "(c1'';;c2, s'') \<rightarrow>\<^bsup> t \<^esup> (c1';;c2, s')" using Suc by simp
  ultimately show ?case by auto
qed auto

lemma if_trueI[intro]:
  "is1 v = Some One \<Longrightarrow> v \<in> set x1 \<Longrightarrow> (IF x1\<noteq>0 THEN c11 ELSE c12, is1) \<rightarrow> (c11, is1)"
  by force

lemma if_falseI[intro]:
  "map_of (map (\<lambda>v. (v, Zero)) (remdups x1)) \<subseteq>\<^sub>m is1
    \<Longrightarrow> (IF x1\<noteq>0 THEN c11 ELSE c12, is1) \<rightarrow> (c12, is1)"
proof -
  assume "map_of (map (\<lambda>v. (v, Zero)) (remdups x1)) \<subseteq>\<^sub>m is1"
  have "v \<in> set (remdups x1) \<Longrightarrow> map_of (map (\<lambda>v. (v, Zero)) (remdups x1)) v = Some Zero" for v
    by(induction x1) (auto split: if_splits)
  hence "\<forall>v \<in> set x1. is1 v = Some Zero"
    apply(auto simp: map_le_def dom_map_of_conv_image_fst)
    by (metis (mono_tags, lifting) \<open>map_of (map (\<lambda>v. (v, Zero)) (remdups x1)) \<subseteq>\<^sub>m is1\<close> domI map_le_def)
  thus ?thesis by simp
qed

lemma while_trueI[intro]:
  "is1 v = Some One \<Longrightarrow> v \<in> set x1 \<Longrightarrow> (WHILE x1\<noteq>0 DO c1, is1) \<rightarrow> (c1 ;; WHILE x1\<noteq>0 DO c1, is1)"
  by force

lemma while_falseI[intro]:
  "map_of (map (\<lambda>v. (v, Zero)) (remdups x1)) \<subseteq>\<^sub>m is1
    \<Longrightarrow> (WHILE x1\<noteq>0 DO c1, is1) \<rightarrow> (SKIP, is1)"
proof -
  assume "map_of (map (\<lambda>v. (v, Zero)) (remdups x1)) \<subseteq>\<^sub>m is1"
  have "v \<in> set (remdups x1) \<Longrightarrow> map_of (map (\<lambda>v. (v, Zero)) (remdups x1)) v = Some Zero" for v
    by(induction x1) (auto split: if_splits)
  hence "\<forall>v \<in> set x1. is1 v = Some Zero"
    apply(auto simp: map_le_def dom_map_of_conv_image_fst)
    by (metis (mono_tags, lifting) \<open>map_of (map (\<lambda>v. (v, Zero)) (remdups x1)) \<subseteq>\<^sub>m is1\<close> domI map_le_def)
  thus ?thesis by simp
qed

subsection \<open>Functional definition\<close>

text \<open>We also give a definition of small step semantics as a function rather than as a relation.
    We show the equivalence between the two definitions. We also give some useful Lemmas to show
    that IMP-- terminates in some state. \<close>

fun small_step_fun:: "com * state \<Rightarrow> com * state" where
"small_step_fun (SKIP, s) = (SKIP, s)" |
"small_step_fun (x ::= v, s) = (SKIP, s(x \<mapsto> v))" |
"small_step_fun (c\<^sub>1;;c\<^sub>2,s) = (if c\<^sub>1 = SKIP then (c\<^sub>2,s)
  else  (fst (small_step_fun (c\<^sub>1, s)) ;;c\<^sub>2, snd (small_step_fun (c\<^sub>1, s))))" |
"small_step_fun (IF bs \<noteq>0 THEN c\<^sub>1 ELSE c\<^sub>2,s) = (if \<exists>b \<in> set bs. s b \<noteq> Some Zero then (c\<^sub>1,s) else (c\<^sub>2,s))" |
"small_step_fun (WHILE bs \<noteq>0 DO c,s) = (if  \<exists>b \<in> set bs. s b \<noteq> Some Zero
  then (c ;; (WHILE bs \<noteq>0 DO c), s) else (SKIP,s))"

fun t_small_step_fun:: "nat \<Rightarrow> com * state \<Rightarrow> com * state" where
"t_small_step_fun 0 = id" |
"t_small_step_fun (Suc t) = (t_small_step_fun t) \<circ> small_step_fun"

lemma t_small_step_fun_ge_0: "t > 0
  \<Longrightarrow> t_small_step_fun t (c, s) = t_small_step_fun (t - 1) (small_step_fun (c, s))"
proof-
  assume "t > 0"
  then obtain t' where "t = Suc t'" using lessE by blast
  thus ?thesis by simp
qed

lemma t_small_step_fun_small_step_fun: "t_small_step_fun t (small_step_fun cs)
  = t_small_step_fun (t + 1) cs"
  by simp

lemma small_step_fun_t_small_step_fun: "small_step_fun (t_small_step_fun t (c, s))
  = t_small_step_fun (t + 1) (c, s)"
proof(induction t arbitrary: c s)
  case (Suc t)
  let ?c' = "fst (small_step_fun (c, s))"
  let ?s' = "snd (small_step_fun (c, s))"
  have "small_step_fun (t_small_step_fun t (?c', ?s')) = t_small_step_fun t (small_step_fun (?c', ?s'))"
    using Suc t_small_step_fun_small_step_fun by presburger
  thus ?case by auto
qed auto

lemma t_small_step_fun_SKIP[simp]: "t_small_step_fun t (SKIP, s) = (SKIP, s)"
  apply(induction t)
  by auto

lemma t_small_step_fun_terminate_iff: "t_small_step_fun t (c1, s1) = (SKIP, s2) \<longleftrightarrow>
  ((c1 = SKIP \<and> s1 = s2) \<or> (t > 0 \<and> t_small_step_fun (t - 1) (small_step_fun (c1, s1))
    = (SKIP, s2)))"
  apply(auto simp: t_small_step_fun_ge_0)
   apply (metis One_nat_def id_apply less_Suc_eq_0_disj prod.inject t_small_step_fun.elims t_small_step_fun_ge_0)
  by (metis One_nat_def Pair_inject id_apply less_Suc_eq_0_disj t_small_step_fun.elims t_small_step_fun_ge_0)

lemma t_small_step_fun_decomposition: "t_small_step_fun (a + b) cs
  = t_small_step_fun a (t_small_step_fun b cs)"
  apply(induction a arbitrary: cs)
  by(auto simp: small_step_fun_t_small_step_fun)

lemma t_small_step_fun_increase_time: "t \<le> t' \<Longrightarrow> t_small_step_fun t (c1, s1) = (SKIP, s2)
  \<Longrightarrow> t_small_step_fun t' (c1, s1) = (SKIP, s2)"
  using t_small_step_fun_decomposition[where ?a="t' - t" and ?b="t"] by simp

lemma exists_terminating_iff: "(\<exists>t < Suc t'.
  t_small_step_fun t (c, s) = (SKIP, s'))
  \<longleftrightarrow>  t_small_step_fun t' (c, s) = (SKIP, s')"
  using t_small_step_fun_increase_time by (auto simp: less_Suc_eq_le)

lemma terminates_then_can_reach_SKIP_in_seq: "t_small_step_fun t (c1, s1) = (SKIP, s2)
  \<Longrightarrow> (\<exists>t' \<le> t. t_small_step_fun t' (c1 ;; c2, s1) = (SKIP ;; c2, s2))"
proof(induction t arbitrary: c1 s1)
  case (Suc t)
  have "c1 = SKIP \<or> c1 \<noteq> SKIP" by auto
  thus ?case using Suc
  proof (elim disjE)
    assume *: "c1 \<noteq> SKIP"
    let ?c1' = "fst (small_step_fun (c1, s1))"
    let ?s1' = "snd (small_step_fun (c1, s1))"
    have "t_small_step_fun t (?c1', ?s1') = (SKIP, s2)" using *
      by (metis Suc.prems Suc_eq_plus1 prod.collapse t_small_step_fun_small_step_fun)
    then obtain t' where "t' \<le> t \<and> t_small_step_fun t' (?c1' ;; c2, ?s1') = (SKIP ;; c2, s2)"
      using Suc by blast
    thus ?case using * by auto
  qed auto
qed auto

lemma seq_terminates_iff: "t_small_step_fun t (a ;; b, s1) = (SKIP, s2) \<longleftrightarrow>
  (\<exists>t' s3. t' < t \<and> t_small_step_fun t' (a, s1) = (SKIP, s3)
  \<and> t_small_step_fun (t - (t' + 1)) (b, s3) = (SKIP, s2))"
proof(induction t arbitrary: a s1)
  case (Suc t)
  show ?case
  proof
    assume *: "t_small_step_fun (Suc t) (a;; b, s1) = (SKIP, s2)"
    have "a = SKIP \<or> a \<noteq> SKIP" by auto
    thus "\<exists>t' s3. t' < Suc t \<and> t_small_step_fun t' (a, s1) = (SKIP, s3)
        \<and> t_small_step_fun (Suc t - (t' + 1)) (b, s3) = (SKIP, s2)"
    using * proof (elim disjE)
      assume **: "a \<noteq> SKIP"
      let ?a' = "fst (small_step_fun (a, s1))"
      let ?s1' = "snd (small_step_fun (a, s1))"
      have "t_small_step_fun t (?a' ;; b, ?s1') = (SKIP, s2)" using * **
        by (auto simp: t_small_step_fun_terminate_iff)
      then obtain t' s3 where "t' < t \<and> t_small_step_fun t' (?a', ?s1') = (SKIP, s3)
        \<and> t_small_step_fun (t - (t' + 1)) (b, s3) = (SKIP, s2)" using Suc by auto
      hence "t' + 1 < t + 1 \<and> t_small_step_fun (t' + 1) (a, s1) = (SKIP, s3)
        \<and> t_small_step_fun (t - (t' + 1)) (b, s3) = (SKIP, s2)" by(auto)
      thus ?thesis by auto
    qed auto
  next
    assume "\<exists>t' s3. t' < Suc t \<and> t_small_step_fun t' (a, s1) = (SKIP, s3)
      \<and> t_small_step_fun (Suc t - (t' + 1)) (b, s3) = (SKIP, s2)"
    then obtain t' s3 where t'_def: "t' < Suc t \<and> t_small_step_fun t' (a, s1) = (SKIP, s3)
      \<and> t_small_step_fun (Suc t - (t' + 1)) (b, s3) = (SKIP, s2)" by blast
    then obtain t'' where t''_def: "t'' \<le> t' \<and> t_small_step_fun t'' (a ;; b, s1) = (SKIP ;; b, s3)"
      using terminates_then_can_reach_SKIP_in_seq by blast
    hence "t_small_step_fun (t'' + ((Suc t - (t' + 1)) + 1)) (a ;; b, s1)
      = t_small_step_fun (Suc t - (t' + 1) + 1) (SKIP ;; b, s3)"
      using t_small_step_fun_decomposition[where ?b="t''"] t'_def by (metis add.commute)
    also have "... = t_small_step_fun (Suc t  - (t' + 1)) (b, s3)" using t'_def
      by(auto simp: t_small_step_fun_ge_0)
    also have "... = (SKIP, s2)" using t'_def by simp
    ultimately show "t_small_step_fun (Suc t) (a ;; b, s1) = (SKIP, s2)"
      apply -
      apply(rule t_small_step_fun_increase_time[where ?t="t'' + ((Suc t - (t' + 1)) + 1)"])
      using t'_def t''_def by(auto)
  qed
qed auto

lemma seq_terminates_when: "t1 + t2 < t \<Longrightarrow> t_small_step_fun t1 (a, s1) = (SKIP, s3)
  \<Longrightarrow> t_small_step_fun t2 (b, s3) = (SKIP, s2)
  \<Longrightarrow> t_small_step_fun t (a ;; b, s1) = (SKIP, s2)"
  apply(auto simp: seq_terminates_iff)
  by (metis Nat.add_diff_assoc2 add_lessD1 diff_Suc_Suc diff_add_inverse le_add_same_cancel1
      less_natE t_small_step_fun_increase_time zero_le)

lemma seq_terminates_when': "t_small_step_fun t1 (a, s1) = (SKIP, s3)
  \<Longrightarrow> t_small_step_fun t2 (b, s3) = (SKIP, s2)
  \<Longrightarrow> t1 + t2 < t
  \<Longrightarrow> t_small_step_fun t (a ;; b, s1) = (SKIP, s2)"
  apply(auto simp: seq_terminates_iff)
  by (metis Nat.add_diff_assoc2 add_lessD1 diff_Suc_Suc diff_add_inverse le_add_same_cancel1
      less_natE t_small_step_fun_increase_time zero_le)

lemma small_step_fun_small_step: "c1 \<noteq> SKIP \<Longrightarrow> small_step_fun (c1, s1) = (c2, s2)
  \<longleftrightarrow> (c1, s1) \<rightarrow> (c2, s2)"
  apply(induction c1 arbitrary: s1 c2 s2)
    apply auto
  apply fastforce
  by (metis SeqE fstI eq_snd_iff)+

lemma small_step_fun_small_step': "c1 \<noteq> SKIP \<Longrightarrow>
   (c1, s1) \<rightarrow> small_step_fun (c1, s1)"
  apply(induction c1 arbitrary: s1)
  by auto

lemma t_small_step_fun_t_small_step_equivalence: "(t_small_step_fun t (c1, s1) = (SKIP, s2))
  \<longleftrightarrow> (\<exists>t' \<le> t. (c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (SKIP, s2))"
proof(induction t arbitrary: c1 s1 rule: nat_less_induct)
  case (1 n)
  hence IH: "t'' < n
     \<Longrightarrow> (t_small_step_fun t'' (c1, s1) = (SKIP, s2)) \<longleftrightarrow> (\<exists>t'\<le>t''. (c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (SKIP, s2))"
    for t'' c1 s1 by simp
  show ?case
  proof(cases n)
    case (Suc t)
    have "c1 = SKIP \<or> c1 \<noteq> SKIP" by auto
    thus ?thesis
    proof(elim disjE)
      assume "c1 \<noteq> SKIP"
      show ?thesis
      proof
        assume "t_small_step_fun n (c1, s1) = (SKIP, s2)"
        hence "(c1, s1) \<rightarrow> small_step_fun (c1, s1)
          \<and> (\<exists>t' \<le> t. small_step_fun (c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (SKIP, s2))"
          using IH[where ?c1.0="fst (small_step_fun (c1, s1))"
              and ?s1.0="snd (small_step_fun (c1, s1))" and ?t''=t]
          \<open>c1 \<noteq> SKIP\<close> small_step_fun_small_step' Suc by auto
        thus "\<exists>t' \<le> n. (c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (SKIP, s2)" using Suc by auto
      next
        assume "\<exists>t' \<le> n. (c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (SKIP, s2)"
        then obtain t' where t'_def: "t' \<le> n \<and> (c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (SKIP, s2)" by blast
        then obtain t'' where t''_def: "t' = Suc t''" using \<open>c1 \<noteq> SKIP\<close> by (metis prod.inject rel_pow.cases)
        then obtain c3 s3 where "(c1, s1) \<rightarrow> (c3, s3) \<and> (c3, s3) \<rightarrow>\<^bsup>t''\<^esup> (SKIP, s2)"
          using t'_def by auto
        hence "small_step_fun (c1, s1) = (c3, s3) \<and> t_small_step_fun t'' (c3, s3) = (SKIP, s2)"
          using IH[where ?c1.0=c3 and ?s1.0=s3 and ?t''=t''] small_step_fun_small_step \<open>c1 \<noteq> SKIP\<close>
            t'_def t''_def by auto
        hence "t_small_step_fun (Suc t'') (c1, s1) = (SKIP, s2)" by simp
        thus "t_small_step_fun n (c1, s1) = (SKIP, s2)" using t'_def t''_def
           t_small_step_fun_increase_time by blast
      qed
    next
      assume "c1 = SKIP"
      thus ?thesis using rel_pow.cases by fastforce
    qed
  qed auto
qed

end


section \<open> Relational Operational Semantics \<close>

theory utp_rel_opsem
  imports
    utp_rel_laws
    utp_hoare
begin

text \<open> This theory uses the laws of relational calculus to create a basic operational semantics.
  It is based on Chapter 10 of the UTP book~\cite{Hoare&98}. \<close>

fun trel :: "'\<alpha> usubst \<times> '\<alpha> hrel \<Rightarrow> '\<alpha> usubst \<times> '\<alpha> hrel \<Rightarrow> bool" (infix "\<rightarrow>\<^sub>u" 85) where
"(\<sigma>, P) \<rightarrow>\<^sub>u (\<rho>, Q) \<longleftrightarrow> (\<langle>\<sigma>\<rangle>\<^sub>a ;; P) \<sqsubseteq> (\<langle>\<rho>\<rangle>\<^sub>a ;; Q)"

lemma trans_trel:
  "\<lbrakk> (\<sigma>, P) \<rightarrow>\<^sub>u (\<rho>, Q); (\<rho>, Q) \<rightarrow>\<^sub>u (\<phi>, R) \<rbrakk> \<Longrightarrow> (\<sigma>, P) \<rightarrow>\<^sub>u (\<phi>, R)"
  by auto

lemma skip_trel: "(\<sigma>, II) \<rightarrow>\<^sub>u (\<sigma>, II)"
  by simp

lemma assigns_trel: "(\<sigma>, \<langle>\<rho>\<rangle>\<^sub>a) \<rightarrow>\<^sub>u (\<rho> \<circ>\<^sub>s \<sigma>, II)"
  by (simp add: assigns_comp)

lemma assign_trel:
  "(\<sigma>, x := v) \<rightarrow>\<^sub>u (\<sigma>(&x \<mapsto>\<^sub>s \<sigma> \<dagger> v), II)"
  by (simp add: assigns_comp usubst)

lemma seq_trel:
  assumes "(\<sigma>, P) \<rightarrow>\<^sub>u (\<rho>, Q)"
  shows "(\<sigma>, P ;; R) \<rightarrow>\<^sub>u (\<rho>, Q ;; R)"
  by (metis (no_types, lifting) assms order_refl seqr_assoc seqr_mono trel.simps)

lemma seq_skip_trel:
  "(\<sigma>, II ;; P) \<rightarrow>\<^sub>u (\<sigma>, P)"
  by simp

lemma nondet_left_trel:
  "(\<sigma>, P \<sqinter> Q) \<rightarrow>\<^sub>u (\<sigma>, P)"
  by (metis (no_types, opaque_lifting) disj_comm disj_upred_def semilattice_sup_class.sup.absorb_iff1 semilattice_sup_class.sup.left_idem seqr_or_distr trel.simps)

lemma nondet_right_trel:
  "(\<sigma>, P \<sqinter> Q) \<rightarrow>\<^sub>u (\<sigma>, Q)"
  by (simp add: seqr_mono)

lemma rcond_true_trel:
  assumes "\<sigma> \<dagger> b = true"
  shows "(\<sigma>, P \<triangleleft> b \<triangleright>\<^sub>r Q) \<rightarrow>\<^sub>u (\<sigma>, P)"
  using assms
  by (simp add: assigns_r_comp usubst alpha)

lemma rcond_false_trel:
  assumes "\<sigma> \<dagger> b = false"
  shows "(\<sigma>, P \<triangleleft> b \<triangleright>\<^sub>r Q) \<rightarrow>\<^sub>u (\<sigma>, Q)"
  using assms
  by (simp add: assigns_r_comp usubst alpha)

lemma while_true_trel:
  assumes "\<sigma> \<dagger> b = true"
  shows "(\<sigma>, while b do P od) \<rightarrow>\<^sub>u (\<sigma>, P ;; while b do P od)"
  by (metis assms rcond_true_trel while_unfold)

lemma while_false_trel:
  assumes "\<sigma> \<dagger> b = false"
  shows "(\<sigma>, while b do P od) \<rightarrow>\<^sub>u (\<sigma>, II)"
  by (metis assms rcond_false_trel while_unfold)

text \<open> Theorem linking Hoare calculus and operational semantics. If we start $Q$ in a state $\sigma_0$
  satisfying $p$, and $Q$ reaches final state $\sigma_1$ then $r$ holds in this final state. \<close>

theorem hoare_opsem_link:
  "\<lbrace>p\<rbrace>Q\<lbrace>r\<rbrace>\<^sub>u = (\<forall> \<sigma>\<^sub>0 \<sigma>\<^sub>1. `\<sigma>\<^sub>0 \<dagger> p` \<and> (\<sigma>\<^sub>0, Q) \<rightarrow>\<^sub>u (\<sigma>\<^sub>1, II) \<longrightarrow> `\<sigma>\<^sub>1 \<dagger> r`)"
  apply (rel_auto)
  apply (rename_tac a b)
  apply (metis (full_types) lit.rep_eq)
  done

declare trel.simps [simp del]

end


(*  Title:       Some extra results about linear algebra
    Author:      Tim Makarios <tjm1983 at gmail.com>, 2012
    Maintainer:  Tim Makarios <tjm1983 at gmail.com>
*)

(* Some of these theorems previously here have been moved to the Isabelle repository *)

section "Linear algebra"

theory Linear_Algebra2
imports Miscellany
begin

lemma exhaust_4:
  fixes x :: 4
  shows "x = 1 \<or> x = 2 \<or> x = 3 \<or> x = 4"
proof (induct x)
  case (of_int z)
  hence "0 \<le> z" and "z < 4" by simp_all
  hence "z = 0 \<or> z = 1 \<or> z = 2 \<or> z = 3" by arith
  thus ?case by auto
qed

lemma forall_4: "(\<forall> i::4. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3 \<and> P 4"
  by (metis exhaust_4)

lemma UNIV_4: "(UNIV::(4 set)) = {1, 2, 3, 4}"
  using exhaust_4
  by auto

lemma vector_4:
  fixes w :: "'a::zero"
  shows "(vector [w, x, y, z] :: 'a^4)$1 = w"
  and  "(vector [w, x, y, z] :: 'a^4)$2 = x"
  and  "(vector [w, x, y, z] :: 'a^4)$3 = y"
  and  "(vector [w, x, y, z] :: 'a^4)$4 = z"
  unfolding vector_def
  by simp_all

definition
  is_basis :: "(real^'n) set \<Rightarrow> bool" where
  "is_basis S \<equiv> independent S \<and> span S = UNIV"

lemma card_finite:
  assumes "card S = CARD('n::finite)"
  shows "finite S"
proof -
  from \<open>card S = CARD('n)\<close> have "card S \<noteq> 0" by simp
  with card_eq_0_iff [of S] show "finite S" by simp
qed

lemma independent_is_basis:
  fixes B :: "(real^'n) set"
  shows "independent B \<and> card B = CARD('n) \<longleftrightarrow> is_basis B"
proof
  assume L: "independent B \<and> card B = CARD('n)"
  then have "card (Basis::(real^'n) set) = card B"
    by simp
  with L show "is_basis B"
    by (metis (no_types) card_eq_dim dim_UNIV independent_bound is_basis_def subset_antisym top_greatest)
next
  assume "is_basis B"
  then  show "independent B \<and> card B = CARD('n)"
    by (metis DIM_cart DIM_real basis_card_eq_dim dim_UNIV is_basis_def mult.right_neutral top.extremum)
qed

lemma basis_expand:
  assumes "is_basis B"
  shows "\<exists>c. v = (\<Sum>w\<in>B. (c w) *\<^sub>R w)"
proof -
  from \<open>is_basis B\<close> have "v \<in> span B" unfolding is_basis_def by simp
  from basis_finite [of B] and \<open>is_basis B\<close> have "finite B" by simp
  with span_finite [of B] and \<open>v \<in> span B\<close>
  show "\<exists>c. v = (\<Sum>w\<in>B. (c w) *\<^sub>R w)" by (simp add: scalar_equiv) auto
qed

lemma not_span_independent_insert:
  fixes v :: "('a::real_vector)^'n"
  assumes "independent S" and "v \<notin> span S"
  shows "independent (insert v S)"
  by (simp add: assms independent_insert)

lemma orthogonal_sum:
  fixes v :: "real^'n"
  assumes "\<And>w. w\<in>S \<Longrightarrow> orthogonal v w"
  shows "orthogonal v (\<Sum>w\<in>S. c w *s w)"
  by (metis (no_types, lifting) assms orthogonal_clauses(1,2) orthogonal_rvsum scalar_equiv sum.infinite)

lemma orthogonal_self_eq_0:
  fixes v :: "('a::real_inner)^'n"
  assumes "orthogonal v v"
  shows "v = 0"
  using inner_eq_zero_iff [of v] and assms
  unfolding orthogonal_def
  by simp

lemma orthogonal_in_span_eq_0:
  fixes v :: "real^'n"
  assumes "v \<in> span S" and "\<And>w. w\<in>S \<Longrightarrow> orthogonal v w"
  shows "v = 0"
  using assms orthogonal_self orthogonal_to_span by blast

lemma orthogonal_independent:
  fixes v :: "real^'n"
  assumes "independent S" and "v \<noteq> 0" and "\<And>w. w\<in>S \<Longrightarrow> orthogonal v w"
  shows "independent (insert v S)"
  using assms not_span_independent_insert orthogonal_in_span_eq_0 by blast

lemma dot_scaleR_mult:
  shows "(k *\<^sub>R a) \<bullet> b = k * (a \<bullet> b)" and "a \<bullet> (k *\<^sub>R b) = k * (a \<bullet> b)"
  by auto

lemma dependent_explicit_finite:
  fixes S :: "(('a::{real_vector,field})^'n) set"
  assumes "finite S"
  shows "dependent S \<longleftrightarrow> (\<exists> u. (\<exists> v\<in>S. u v \<noteq> 0) \<and> (\<Sum> v\<in>S. u v *\<^sub>R v) = 0)"
  by (simp add: assms dependent_finite)

lemma dependent_explicit_2:
  fixes v w :: "('a::{field,real_vector})^'n"
  assumes "v \<noteq> w"
  shows "dependent {v, w} \<longleftrightarrow> (\<exists> i j. (i \<noteq> 0 \<or> j \<noteq> 0) \<and> i *\<^sub>R v + j *\<^sub>R w = 0)"
proof
  let ?S = "{v, w}"
  have "finite ?S" by simp

  { assume "dependent ?S"
    with dependent_explicit_finite [of ?S] and \<open>finite ?S\<close> and \<open>v \<noteq> w\<close>
    show "\<exists> i j. (i \<noteq> 0 \<or> j \<noteq> 0) \<and> i *\<^sub>R v + j *\<^sub>R w = 0" by auto }

  { assume "\<exists> i j. (i \<noteq> 0 \<or> j \<noteq> 0) \<and> i *\<^sub>R v + j *\<^sub>R w = 0"
    then obtain i and j where "i \<noteq> 0 \<or> j \<noteq> 0" and "i *\<^sub>R v + j *\<^sub>R w = 0" by auto
    let ?u = "\<lambda> x. if x = v then i else j"
    from \<open>i \<noteq> 0 \<or> j \<noteq> 0\<close> and \<open>v \<noteq> w\<close> have "\<exists> x\<in>?S. ?u x \<noteq> 0" by simp
    from \<open>i *\<^sub>R v + j *\<^sub>R w = 0\<close> and \<open>v \<noteq> w\<close>
    have "(\<Sum> x\<in>?S. ?u x *\<^sub>R x) = 0" by simp
    with dependent_explicit_finite [of ?S]
      and \<open>finite ?S\<close> and \<open>\<exists> x\<in>?S. ?u x \<noteq> 0\<close>
    show "dependent ?S" by best }
qed

subsection "Matrices"

lemma zero_not_invertible:
  "\<not> (invertible (0::real^'n^'n))"
  using invertible_times_eq_zero matrix_vector_mult_0 by blast

text \<open>Based on matrix-vector-column in
  HOL/Multivariate\_Analysis/Euclidean\_Space.thy in Isabelle 2009-1:\<close>
lemma vector_matrix_row:
  fixes x :: "('a::comm_semiring_1)^'m" and A :: "('a^'n^'m)"
  shows "x v* A = (\<Sum> i\<in>UNIV. (x$i) *s (A$i))"
  unfolding vector_matrix_mult_def
  by (simp add: vec_eq_iff mult.commute)

lemma matrix_inv:
  assumes "invertible M"
  shows "matrix_inv M ** M = mat 1"
  and "M ** matrix_inv M = mat 1"
  using \<open>invertible M\<close> and someI_ex [of "\<lambda> N. M ** N = mat 1 \<and> N ** M = mat 1"]
  unfolding invertible_def and matrix_inv_def
  by simp_all

lemma matrix_inv_invertible:
  assumes "invertible M"
  shows "invertible (matrix_inv M)"
  using \<open>invertible M\<close> and matrix_inv
  unfolding invertible_def [of "matrix_inv M"]
  by auto

lemma invertible_times_non_zero:
  fixes M :: "real^'n^'n"
  assumes "invertible M" and "v \<noteq> 0"
  shows "M *v v \<noteq> 0"
  using \<open>invertible M\<close> and \<open>v \<noteq> 0\<close> and invertible_times_eq_zero [of M v]
  by auto

lemma matrix_right_invertible_ker:
  fixes M :: "real^('m::finite)^'n"
  shows "(\<exists> M'. M ** M' = mat 1) \<longleftrightarrow> (\<forall> x. x v* M = 0 \<longrightarrow> x = 0)"
  using left_invertible_transpose matrix_left_invertible_ker by force

lemma left_invertible_iff_invertible:
  fixes M :: "real^'n^'n"
  shows "(\<exists> N. N ** M = mat 1) \<longleftrightarrow> invertible M"
  by (simp add: invertible_def matrix_left_right_inverse)

lemma right_invertible_iff_invertible:
  fixes M :: "real^'n^'n"
  shows "(\<exists> N. M ** N = mat 1) \<longleftrightarrow> invertible M"
  by (simp add: invertible_def matrix_left_right_inverse)

definition symmatrix :: "'a^'n^'n \<Rightarrow> bool" where
  "symmatrix M \<equiv> transpose M = M"

lemma symmatrix_preserve:
  fixes M N :: "('a::comm_semiring_1)^'n^'n"
  assumes "symmatrix M"
  shows "symmatrix (N ** M ** transpose N)"
proof -
  have "transpose (N ** M ** transpose N) = N ** (M ** transpose N)"
    by (metis (no_types) transpose_transpose assms matrix_transpose_mul symmatrix_def)
  then show ?thesis
    by (simp add: matrix_mul_assoc symmatrix_def)
qed

end