theory ATC
imports "../FSM/FSM"
begin

section \<open> Adaptive test cases \<close>

text \<open>
Adaptive test cases (ATCs) are tree-like structures that label nodes with inputs and edges with
outputs such that applying an ATC to some FSM is performed by applying the label of its root node
and then applying the ATC connected to the root node by an edge labeled with the observed output of
the FSM. The result of such an application is here called an ATC-reaction.

ATCs are here modelled to have edges for every possible output from each non-leaf node. This is not
a restriction on the definition of ATCs by Hierons @{cite "hierons"} as a missing edge can be
expressed by an edge to a leaf.
\<close>

datatype ('in, 'out) ATC = Leaf | Node 'in "'out \<Rightarrow> ('in, 'out) ATC"

inductive atc_reaction :: "('in, 'out, 'state) FSM \<Rightarrow> 'state \<Rightarrow> ('in, 'out) ATC
                            \<Rightarrow> ('in \<times> 'out) list \<Rightarrow> bool"
  where
  leaf[intro!]: "atc_reaction M q1 Leaf []" |
  node[intro!]: "q2 \<in> succ M (x,y) q1
                  \<Longrightarrow> atc_reaction M q2 (f y) io
                  \<Longrightarrow> atc_reaction M q1 (Node x f) ((x,y)#io)"

inductive_cases leaf_elim[elim!] : "atc_reaction M q1 Leaf []"
inductive_cases node_elim[elim!] : "atc_reaction M q1 (Node x f) ((x,y)#io)"

subsection \<open> Properties of ATC-reactions \<close>

lemma atc_reaction_empty[simp] :
  assumes "atc_reaction M q t []"
  shows "t = Leaf"
using assms atc_reaction.simps by force

lemma atc_reaction_nonempty_no_leaf :
  assumes "atc_reaction M q t (Cons a io)"
  shows "t \<noteq> Leaf"
using assms
proof -
  have "\<And>f c a ps. \<not> atc_reaction f (c::'c) (a::('a, 'b) ATC) ps \<or> a \<noteq> Leaf \<or> a \<noteq> Leaf \<or> ps = []"
    using atc_reaction.simps by fastforce
  then show ?thesis
    using assms by blast
qed

lemma atc_reaction_nonempty[elim] :
  assumes "atc_reaction M q1 t (Cons (x,y) io)"
  obtains q2 f
  where "t = Node x f" "q2 \<in> succ M (x,y) q1"  "atc_reaction M q2 (f y) io"
proof -
  obtain x2 f where "t = Node x2 f"
    using assms by (metis ATC.exhaust atc_reaction_nonempty_no_leaf)
  moreover have "x = x2"
    using assms calculation atc_reaction.cases by fastforce
  ultimately show ?thesis
    using assms using that by blast
qed

lemma atc_reaction_path_ex :
  assumes "atc_reaction M q1 t io"
  shows "\<exists> tr . path M (io || tr) q1 \<and> length io = length tr"
using assms proof (induction io arbitrary: q1 t rule: list.induct)
  case Nil
  then show ?case by (simp add: FSM.nil)
next
  case (Cons io_hd io_tl)
  then obtain x y where io_hd_def : "io_hd = (x,y)"
    by (meson surj_pair)
  then obtain f where f_def : "t = (Node x f)"
    using Cons atc_reaction_nonempty by metis
  then obtain q2 where q2_def : "q2 \<in> succ M (x,y) q1" "atc_reaction M q2 (f y) io_tl"
    using Cons io_hd_def atc_reaction_nonempty by auto
  then obtain tr_tl where tr_tl_def :  "path M (io_tl || tr_tl) q2" "length io_tl = length tr_tl"
    using Cons.IH[of q2 "f y"] by blast
  then have "path M (io_hd # io_tl || q2 # tr_tl) q1"
    using Cons q2_def by (simp add: FSM.path.intros(2) io_hd_def)
  then show ?case using tr_tl_def by fastforce
qed

lemma atc_reaction_path[elim] :
  assumes "atc_reaction M q1 t io"
obtains tr
  where "path M (io || tr) q1" "length io = length tr"
by (meson assms atc_reaction_path_ex)

subsection \<open> Applicability \<close>

text \<open>
An ATC can be applied to an FSM if each node-label is contained in the input alphabet of the FSM.
\<close>

inductive subtest :: "('in, 'out) ATC \<Rightarrow> ('in, 'out) ATC \<Rightarrow> bool" where
  "t \<in> range f \<Longrightarrow> subtest t (Node x f)"

lemma accp_subtest : "Wellfounded.accp subtest t"
proof (induction t)
  case Leaf
  then show ?case by (meson ATC.distinct(1) accp.simps subtest.cases)
next
  case (Node x f)
  have IH: "Wellfounded.accp subtest t" if "t \<in> range f" for "t"
    using Node[of t] and that by (auto simp: eq_commute)
  show ?case by (rule accpI) (auto intro: IH elim!: subtest.cases)
qed

definition subtest_rel where "subtest_rel = {(t, Node x f) |f x t. t \<in> range f}"

lemma subtest_rel_altdef: "subtest_rel = {(s, t) |s t. subtest s t}"
  by (auto simp: subtest_rel_def subtest.simps)

lemma subtest_relI [intro]: "t \<in> range f \<Longrightarrow> (t, Node x f) \<in> subtest_rel"
  by (simp add: subtest_rel_def)

lemma subtest_relI' [intro]: "t = f y \<Longrightarrow> (t, Node x f) \<in> subtest_rel"
  by (auto simp: subtest_rel_def ran_def)

lemma wf_subtest_rel [simp, intro]: "wf subtest_rel"
  using accp_subtest unfolding subtest_rel_altdef accp_eq_acc wf_acc_iff
  by auto

function inputs_atc :: "('a,'b) ATC \<Rightarrow> 'a set" where
  "inputs_atc Leaf = {}" |
  "inputs_atc (Node x f) = insert x (\<Union> (image inputs_atc (range f)))"
by pat_completeness auto
termination by (relation subtest_rel) auto

fun applicable :: "('in, 'out, 'state) FSM \<Rightarrow> ('in, 'out) ATC \<Rightarrow> bool" where
  "applicable M t = (inputs_atc t \<subseteq> inputs M)"

fun applicable_set :: "('in, 'out, 'state) FSM \<Rightarrow> ('in, 'out) ATC set \<Rightarrow> bool" where
  "applicable_set M \<Omega> = (\<forall> t \<in> \<Omega> . applicable M t)"

lemma applicable_subtest :
  assumes "applicable M (Node x f)"
shows "applicable M (f y)"
using assms inputs_atc.simps
  by (simp add: Sup_le_iff)

subsection \<open> Application function IO \<close>

text \<open>
Function @{verbatim IO} collects all ATC-reactions of some FSM to some ATC.
\<close>

fun IO :: "('in, 'out, 'state) FSM \<Rightarrow> 'state \<Rightarrow> ('in, 'out) ATC \<Rightarrow> ('in \<times> 'out) list set" where
  "IO M q t = { tr . atc_reaction M q t tr }"

fun IO_set :: "('in, 'out, 'state) FSM \<Rightarrow> 'state \<Rightarrow> ('in, 'out) ATC set \<Rightarrow> ('in \<times> 'out) list set"
  where
  "IO_set M q \<Omega> = \<Union> {IO M q t | t . t \<in> \<Omega>}"

lemma IO_language : "IO M q t \<subseteq> language_state M q"
  by (metis atc_reaction_path IO.elims language_state mem_Collect_eq subsetI)

lemma IO_leaf[simp] : "IO M q Leaf = {[]}"
proof
  show "IO M q Leaf \<subseteq> {[]}"
  proof (rule ccontr)
    assume assm : "\<not> IO M q Leaf \<subseteq> {[]}"
    then obtain io_hd io_tl where elem_ex : "Cons io_hd io_tl \<in> IO M q Leaf"
      by (metis (no_types, hide_lams) insertI1 neq_Nil_conv subset_eq)
    then show "False"
      using atc_reaction_nonempty_no_leaf assm by (metis IO.simps mem_Collect_eq)
  qed
next
  show "{[]} \<subseteq> IO M q Leaf" by auto
qed

lemma IO_applicable_nonempty :
  assumes "applicable M t"
  and     "completely_specified M"
  and     "q1 \<in> nodes M"
  shows "IO M q1 t \<noteq> {}"
using assms proof (induction t arbitrary: q1)
  case Leaf
  then show ?case by auto
next
  case (Node x f)
  then have "x \<in> inputs M" by auto
  then obtain y q2  where x_appl : "q2 \<in> succ M (x, y) q1"
    using Node unfolding completely_specified.simps by blast
  then have "applicable M (f y)"
    using applicable_subtest Node by metis
  moreover have "q2 \<in> nodes M"
    using Node(4) \<open>q2 \<in> succ M (x, y) q1\<close> FSM.nodes.intros(2)[of q1 M "((x,y),q2)"] by auto
  ultimately have "IO M q2 (f y) \<noteq> {}"
    using Node by auto
  then show ?case unfolding IO.simps
    using x_appl by blast
qed

lemma IO_in_language :
  "IO M q t \<subseteq> LS M q"
  unfolding IO.simps by blast

lemma IO_set_in_language :
  "IO_set M q \<Omega> \<subseteq> LS M q"
  using IO_in_language[of M q] unfolding IO_set.simps by blast

subsection \<open> R-distinguishability \<close>

text \<open>
A non-empty ATC r-distinguishes two states of some FSM if there exists no shared ATC-reaction.
\<close>

fun r_dist :: "('in, 'out, 'state) FSM \<Rightarrow> ('in, 'out) ATC \<Rightarrow> 'state \<Rightarrow> 'state \<Rightarrow> bool" where
"r_dist M t s1 s2 = (t \<noteq> Leaf \<and> IO M s1 t \<inter> IO M s2 t = {})"

fun r_dist_set :: "('in, 'out, 'state) FSM \<Rightarrow> ('in, 'out) ATC set \<Rightarrow> 'state \<Rightarrow> 'state \<Rightarrow> bool" where
"r_dist_set M T s1 s2 = (\<exists> t \<in> T . r_dist M t s1 s2)"

lemma r_dist_dist :
  assumes "applicable M t"
  and     "completely_specified M"
  and     "r_dist M t q1 q2"
  and     "q1 \<in> nodes M"
shows   "q1 \<noteq> q2"
proof (rule ccontr)
  assume "\<not>(q1 \<noteq> q2)"
  then have "q1 = q2"
    by simp
  then have "IO M q1 t = {}"
    using assms by simp
  moreover have "IO M q1 t \<noteq> {}"
    using assms IO_applicable_nonempty by auto
  ultimately show "False"
    by simp
qed

lemma r_dist_set_dist :
  assumes "applicable_set M \<Omega>"
  and     "completely_specified M"
  and     "r_dist_set M \<Omega> q1 q2"
  and     "q1 \<in> nodes M"
shows   "q1 \<noteq> q2"
using assms r_dist_dist by (metis applicable_set.elims(2) r_dist_set.elims(2))

lemma r_dist_set_dist_disjoint :
  assumes "applicable_set M \<Omega>"
  and     "completely_specified M"
  and     "\<forall> t1 \<in> T1 . \<forall> t2 \<in> T2 . r_dist_set M \<Omega> t1 t2"
  and     "T1 \<subseteq> nodes M"
shows "T1 \<inter> T2 = {}"
  by (metis assms disjoint_iff_not_equal r_dist_set_dist subsetCE)

subsection \<open> Response sets \<close>

text \<open>
The following functions calculate the sets of all ATC-reactions observed by applying some set of
ATCs on every state reached in some FSM using a given set of IO-sequences.
\<close>

fun B :: "('in, 'out, 'state) FSM \<Rightarrow> ('in * 'out) list \<Rightarrow> ('in, 'out) ATC set
          \<Rightarrow> ('in * 'out) list set" where
  "B M io \<Omega> = \<Union> (image (\<lambda> s . IO_set M s \<Omega>) (io_targets M (initial M) io))"

fun D :: "('in, 'out, 'state) FSM \<Rightarrow> 'in list set \<Rightarrow> ('in, 'out) ATC set
          \<Rightarrow> ('in * 'out) list set set" where
  "D M ISeqs \<Omega> = image (\<lambda> io . B M io \<Omega>) (LS\<^sub>i\<^sub>n M (initial M) ISeqs)"

fun append_io_B :: "('in, 'out, 'state) FSM \<Rightarrow> ('in * 'out) list \<Rightarrow> ('in, 'out) ATC set
                    \<Rightarrow> ('in * 'out) list set" where
  "append_io_B M io \<Omega> = { io@res | res . res \<in> B M io \<Omega> }"

lemma B_dist' :
  assumes df: "B M io1 \<Omega> \<noteq> B M io2 \<Omega>"
  shows   "(io_targets M (initial M) io1) \<noteq> (io_targets M (initial M) io2)"
  using assms by force

lemma B_dist :
  assumes "io_targets M (initial M) io1 = {q1}"
  and     "io_targets M (initial M) io2 = {q2}"
  and     "B M io1 \<Omega> \<noteq> B M io2 \<Omega>"
shows   "q1 \<noteq> q2"
  using assms by force

lemma D_bound :
  assumes wf: "well_formed M"
  and     ob: "observable M"
  and     fi: "finite ISeqs"
  shows "finite (D M ISeqs \<Omega>)" "card (D M ISeqs \<Omega>) \<le> card (nodes M)"
proof -
  have "D M ISeqs \<Omega> \<subseteq> image (\<lambda> s . IO_set M s \<Omega>) (nodes M)"
  proof
    fix RS assume RS_def : "RS \<in> D M ISeqs \<Omega>"
    then obtain xs ys where RS_tr : "RS = B M (xs || ys) \<Omega>"
                                    "(xs \<in> ISeqs \<and> length xs = length ys
                                        \<and> (xs || ys) \<in> language_state M (initial M))"
      by auto
    then obtain qx where qx_def : "io_targets M (initial M) (xs || ys) = { qx }"
      by (meson io_targets_observable_singleton_ex ob)
    then have "RS = IO_set M qx \<Omega>"
      using RS_tr by auto
    moreover have "qx \<in> nodes M"
      by (metis FSM.nodes.initial io_targets_nodes qx_def singletonI)
    ultimately show "RS \<in> image (\<lambda> s . IO_set M s \<Omega>) (nodes M)"
      by auto
  qed
  moreover have "finite (nodes M)"
    using assms by auto
  ultimately show "finite (D M ISeqs \<Omega>)" "card (D M ISeqs \<Omega>) \<le> card (nodes M)"
    by (meson  finite_imageI infinite_super surj_card_le)+
qed

lemma append_io_B_in_language :
  "append_io_B M io \<Omega> \<subseteq> L M"
proof
  fix x assume "x \<in> append_io_B M io \<Omega>"
  then obtain res where "x = io@res" "res \<in> B M io \<Omega>"
    unfolding append_io_B.simps by blast
  then obtain q where "q \<in> io_targets M (initial M) io"  "res \<in> IO_set M q \<Omega>"
    unfolding B.simps by blast
  then have "res \<in> LS M q"
    using IO_set_in_language[of M q \<Omega>] by blast

  obtain pIO where "path M (io || pIO) (initial M)"
                   "length pIO = length io" "target (io || pIO) (initial M) = q"
    using \<open>q \<in> io_targets M (initial M) io\<close> by auto
  moreover obtain pRes where "path M (res || pRes) q" "length pRes = length res"
    using \<open>res \<in> LS M q\<close> by auto
  ultimately have "io@res \<in> L M"
    using FSM.path_append[of M "io||pIO" "initial M" "res||pRes"]
    by (metis language_state length_append zip_append)
  then show "x \<in> L M"
    using \<open>x = io@res\<close> by blast
qed

lemma append_io_B_nonempty :
  assumes "applicable_set M \<Omega>"
  and     "completely_specified M"
  and     "io \<in> language_state M (initial M)"
  and     "\<Omega> \<noteq> {}"
shows "append_io_B M io \<Omega> \<noteq> {}"
proof -
  obtain t where "t \<in> \<Omega>"
    using assms(4) by blast
  then have "applicable M t"
    using assms(1) by simp
  moreover obtain tr where "path M (io || tr) (initial M) \<and> length tr = length io"
    using assms(3) by auto
  moreover have "target (io || tr) (initial M) \<in> nodes M"
    using calculation(2) by blast
  ultimately have "IO M (target (io || tr) (initial M)) t \<noteq> {}"
    using assms(2) IO_applicable_nonempty by simp
  then obtain io' where "io' \<in> IO M (target (io || tr) (initial M)) t"
    by blast
  then have "io' \<in> IO_set M (target (io || tr) (initial M)) \<Omega>"
    using \<open>t \<in> \<Omega>\<close> unfolding IO_set.simps by blast
  moreover have "(target (io || tr) (initial M)) \<in> io_targets M (initial M) io"
    using \<open>path M (io || tr) (initial M) \<and> length tr = length io\<close> by auto
  ultimately have "io' \<in> B M io \<Omega>"
    unfolding B.simps by blast
  then have "io@io' \<in> append_io_B M io \<Omega>"
    unfolding append_io_B.simps by blast
  then show ?thesis by blast
qed

lemma append_io_B_prefix_in_language :
  assumes "append_io_B M io \<Omega> \<noteq> {}"
  shows "io \<in> L M"
proof -
  obtain res where "io @ res \<in> append_io_B M io \<Omega> \<and> res \<in> B M io \<Omega>"
    using assms by auto
  then have "io_targets M (initial M) io \<noteq> {}"
    by auto
  then obtain q where "q \<in> io_targets M (initial M) io"
    by blast
  then obtain tr where "target (io || tr) (initial M) = q \<and> path M (io || tr) (initial M)
                          \<and> length tr = length io" by auto
  then show ?thesis by auto
qed

subsection \<open> Characterizing sets \<close>

text \<open>
A set of ATCs is a characterizing set for some FSM if for every pair of r-distinguishable states it
contains an ATC that r-distinguishes them.
\<close>

fun characterizing_atc_set :: "('in, 'out, 'state) FSM \<Rightarrow> ('in, 'out) ATC set \<Rightarrow> bool" where
"characterizing_atc_set M \<Omega> = (applicable_set M \<Omega> \<and> (\<forall> s1 \<in> (nodes M) . \<forall> s2 \<in> (nodes M) .
    (\<exists> td . r_dist M td s1 s2) \<longrightarrow> (\<exists> tt \<in> \<Omega> . r_dist M tt s1 s2)))"

subsection \<open> Reduction over ATCs \<close>

text \<open>
Some state is a an ATC-reduction of another over some set of ATCs if for every contained ATC every
ATC-reaction to it of the former state is also an ATC-reaction of the latter state.
\<close>

fun atc_reduction :: "('in, 'out, 'state) FSM \<Rightarrow> 'state \<Rightarrow> ('in, 'out, 'state) FSM \<Rightarrow> 'state
                      \<Rightarrow> ('in, 'out) ATC set \<Rightarrow> bool" where
  "atc_reduction M2 s2 M1 s1 \<Omega> = (\<forall> t \<in> \<Omega> . IO M2 s2 t \<subseteq> IO M1 s1 t)"

\<comment> \<open>r-distinguishability holds for atc-reductions\<close>
lemma atc_rdist_dist[intro] :
  assumes wf2   : "well_formed M2"
  and     cs2   : "completely_specified M2"
  and     ap2   : "applicable_set M2 \<Omega>"
  and     el_t1 : "t1 \<in> nodes M2"
  and     red1  : "atc_reduction M2 t1 M1 s1 \<Omega>"
  and     red2  : "atc_reduction M2 t2 M1 s2 \<Omega>"
  and     rdist : "r_dist_set M1 \<Omega> s1 s2"
  and             "t1 \<in> nodes M2"
shows "r_dist_set M2 \<Omega> t1 t2"
proof -
  obtain td where td_def : "td \<in> \<Omega> \<and> r_dist M1 td s1 s2"
    using rdist by auto
  then have "IO M1 s1 td \<inter> IO M1 s2 td = {}"
    using td_def by simp
  moreover have "IO M2 t1 td \<subseteq> IO M1 s1 td"
    using red1 td_def by auto
  moreover have "IO M2 t2 td \<subseteq> IO M1 s2 td"
    using red2 td_def by auto
  ultimately have no_inter : "IO M2 t1 td \<inter> IO M2 t2 td = {}"
    by blast

  then have "td \<noteq> Leaf"
    by auto
  then have "IO M2 t1 td \<noteq> {}"
    by (meson ap2 IO_applicable_nonempty applicable_set.elims(2) cs2 td_def assms(8))
  then have "IO M2 t1 td \<noteq> IO M2 t2 td"
    using no_inter by auto
  then show ?thesis
    using no_inter td_def by auto
qed

subsection \<open> Reduction over ATCs applied after input sequences \<close>

text \<open>
The following functions check whether some FSM is a reduction of another over a given set of input
sequences while furthermore the response sets obtained by applying a set of ATCs after every input
sequence to the first FSM are subsets of the analogously constructed response sets of the second
FSM.
\<close>

fun atc_io_reduction_on :: "('in, 'out, 'state1) FSM \<Rightarrow> ('in, 'out, 'state2) FSM \<Rightarrow> 'in list
                            \<Rightarrow> ('in, 'out) ATC set \<Rightarrow> bool" where
  "atc_io_reduction_on M1 M2 iseq \<Omega> = (L\<^sub>i\<^sub>n M1 {iseq} \<subseteq> L\<^sub>i\<^sub>n M2 {iseq}
    \<and> (\<forall> io \<in> L\<^sub>i\<^sub>n M1 {iseq} . B M1 io \<Omega> \<subseteq> B M2 io \<Omega>))"

fun atc_io_reduction_on_sets :: "('in, 'out, 'state1) FSM \<Rightarrow> 'in list set \<Rightarrow> ('in, 'out) ATC set
                                  \<Rightarrow> ('in, 'out, 'state2) FSM \<Rightarrow> bool" where
  "atc_io_reduction_on_sets M1 TS \<Omega> M2 = (\<forall> iseq \<in> TS . atc_io_reduction_on M1 M2 iseq \<Omega>)"

notation
  atc_io_reduction_on_sets ("(_ \<preceq>\<lbrakk>_._\<rbrakk> _)" [1000,1000,1000,1000])

lemma io_reduction_from_atc_io_reduction :
  assumes "atc_io_reduction_on_sets M1 T \<Omega> M2"
  and     "finite T"
  shows "io_reduction_on M1 T M2"
using assms(2,1) proof (induction T)
  case empty
  then show ?case by auto
next
  case (insert t T)
  then have "atc_io_reduction_on M1 M2 t \<Omega>"
    by auto
  then have "L\<^sub>i\<^sub>n M1 {t} \<subseteq> L\<^sub>i\<^sub>n M2 {t}"
    using atc_io_reduction_on.simps by blast

  have "L\<^sub>i\<^sub>n M1 T \<subseteq> L\<^sub>i\<^sub>n M2 T"
    using insert.IH
  proof -
    have "atc_io_reduction_on_sets M1 T \<Omega> M2"
      by (meson contra_subsetD insert.prems atc_io_reduction_on_sets.simps subset_insertI)
    then show ?thesis
      using insert.IH by blast
  qed
  then have "L\<^sub>i\<^sub>n M1 T \<subseteq> L\<^sub>i\<^sub>n M2 (insert t T)"
    by (meson insert_iff language_state_for_inputs_in_language_state
        language_state_for_inputs_map_fst language_state_for_inputs_map_fst_contained
        subsetCE subsetI)
  moreover have "L\<^sub>i\<^sub>n M1 {t} \<subseteq> L\<^sub>i\<^sub>n M2 (insert t T)"
  proof -
    obtain pps :: "('a \<times> 'b) list set \<Rightarrow> ('a \<times> 'b) list set \<Rightarrow> ('a \<times> 'b) list" where
      "\<forall>x0 x1. (\<exists>v2. v2 \<in> x1 \<and> v2 \<notin> x0) = (pps x0 x1 \<in> x1 \<and> pps x0 x1 \<notin> x0)"
      by moura
    then have "\<forall>P Pa. pps Pa P \<in> P \<and> pps Pa P \<notin> Pa \<or> P \<subseteq> Pa"
      by blast
    moreover
    { assume "map fst (pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 {t})) \<notin> insert t T"
      then have "pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 {t}) \<notin> L\<^sub>i\<^sub>n M1 {t}
                      \<or> pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 {t}) \<in> L\<^sub>i\<^sub>n M2 (insert t T)"
        by (metis (no_types) insertI1 language_state_for_inputs_map_fst_contained singletonD) }
    ultimately show ?thesis
      by (meson \<open>L\<^sub>i\<^sub>n M1 {t} \<subseteq> L\<^sub>i\<^sub>n M2 {t}\<close> language_state_for_inputs_in_language_state
          language_state_for_inputs_map_fst set_rev_mp)
  qed

  ultimately show ?case
  proof -
    have f1: "\<forall>ps P Pa. (ps::('a \<times> 'b) list) \<notin> P \<or> \<not> P \<subseteq> Pa \<or> ps \<in> Pa"
      by blast
    obtain pps :: "('a \<times> 'b) list set \<Rightarrow> ('a \<times> 'b) list set \<Rightarrow> ('a \<times> 'b) list" where
      "\<forall>x0 x1. (\<exists>v2. v2 \<in> x1 \<and> v2 \<notin> x0) = (pps x0 x1 \<in> x1 \<and> pps x0 x1 \<notin> x0)"
      by moura
    moreover
    { assume "pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 (insert t T))
              \<notin> L\<^sub>i\<^sub>n M1 {t}"
      moreover
      { assume "map fst (pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 (insert t T)))
                \<notin> {t}"
        then have "map fst (pps (L\<^sub>i\<^sub>n M2 (insert t T))
                      (L\<^sub>i\<^sub>n M1 (insert t T))) \<noteq> t"
          by blast
        then have "pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 (insert t T))
                        \<notin> L\<^sub>i\<^sub>n M1 (insert t T)
                    \<or> pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 (insert t T))
                          \<in> L\<^sub>i\<^sub>n M2 (insert t T)"
          using f1 by (meson \<open>L\<^sub>i\<^sub>n M1 T \<subseteq> L\<^sub>i\<^sub>n M2 (insert t T)\<close>
                       insertE language_state_for_inputs_in_language_state
                       language_state_for_inputs_map_fst
                       language_state_for_inputs_map_fst_contained) }
      ultimately have "io_reduction_on M1 (insert t T) M2
                        \<or> pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 (insert t T))
                            \<notin> L\<^sub>i\<^sub>n M1 (insert t T)
                        \<or> pps (L\<^sub>i\<^sub>n M2 (insert t T)) (L\<^sub>i\<^sub>n M1 (insert t T))
                            \<in> L\<^sub>i\<^sub>n M2 (insert t T)"
        using f1 by (meson language_state_for_inputs_in_language_state
                     language_state_for_inputs_map_fst) }
      ultimately show ?thesis
        using f1 by (meson \<open>L\<^sub>i\<^sub>n M1 {t} \<subseteq> L\<^sub>i\<^sub>n M2 (insert t T)\<close> subsetI)
  qed
qed

lemma atc_io_reduction_on_subset :
  assumes "atc_io_reduction_on_sets M1 T \<Omega> M2"
  and     "T' \<subseteq> T"
shows "atc_io_reduction_on_sets M1 T' \<Omega> M2"
  using assms unfolding atc_io_reduction_on_sets.simps by blast

lemma atc_reaction_reduction[intro] :
  assumes ls : "language_state M1 q1 \<subseteq> language_state M2 q2"
  and     el1 : "q1 \<in> nodes M1"
  and     el2 : "q2 \<in> nodes M2"
  and     rct : "atc_reaction M1 q1 t io"
  and     ob2 : "observable M2"
  and     ob1 : "observable M1"
shows "atc_reaction M2 q2 t io"
using assms proof (induction t arbitrary: io q1 q2)
  case Leaf
  then have "io = []"
    by (metis atc_reaction_nonempty_no_leaf list.exhaust)
  then show ?case
    by (simp add: leaf)
next
  case (Node x f)
  then obtain io_hd io_tl where io_split : "io = io_hd # io_tl"
    by (metis ATC.distinct(1) atc_reaction_empty list.exhaust)
  moreover obtain y where y_def : "io_hd = (x,y)"
    using Node calculation by (metis ATC.inject atc_reaction_nonempty surj_pair)
  ultimately  obtain q1x where q1x_def : "q1x \<in> succ M1 (x,y) q1" "atc_reaction M1 q1x (f y) io_tl"
    using Node.prems(4) by blast

  then have pt1 : "path M1 ([(x,y)] || [q1x]) q1"
    by auto
  then have ls1 : "[(x,y)] \<in> language_state M1 q1"
    unfolding language_state_def path_def using list.simps(9) by force
  moreover have "q1x \<in> io_targets M1 q1 [(x,y)]"
    unfolding io_targets.simps
  proof -
    have f1: "length [(x, y)] = length [q1x]"
      by simp
    have "q1x = target ([(x, y)] || [q1x]) q1"
      by simp
    then show "q1x \<in> {target ([(x, y)] || cs) q1 |cs. path M1 ([(x, y)] || cs) q1
                                                      \<and> length [(x, y)] = length cs}"
      using f1 pt1 by blast
  qed
  ultimately have tgt1 : "io_targets M1 q1 [(x,y)] = {q1x}"
    using Node.prems io_targets_observable_singleton_ex q1x_def
    by (metis (no_types, lifting) singletonD)

  then have ls2 : "[(x,y)] \<in> language_state M2 q2"
    using Node.prems(1) ls1 by auto
  then obtain q2x where q2x_def : "q2x \<in> succ M2 (x,y) q2"
    unfolding language_state_def path_def
    using transition_system.path.cases by fastforce
  then have pt2 : "path M2 ([(x,y)] || [q2x]) q2"
    by auto
  then have "q2x \<in> io_targets M2 q2 [(x,y)]"
    using ls2 unfolding io_targets.simps
  proof -
    have f1: "length [(x, y)] = length [q2x]"
      by simp
    have "q2x = target ([(x, y)] || [q2x]) q2"
      by simp
    then show "q2x \<in> {target ([(x, y)] || cs) q2 |cs. path M2 ([(x, y)] || cs) q2
                                                        \<and> length [(x, y)] = length cs}"
      using f1 pt2 by blast
  qed

  then have tgt2 : "io_targets M2 q2 [(x,y)] = {q2x}"
    using Node.prems io_targets_observable_singleton_ex ls2 q2x_def
    by (metis (no_types, lifting) singletonD)

  then have "language_state M1 q1x \<subseteq> language_state M2 q2x"
    using language_state_inclusion_of_state_reached_by_same_sequence
          [of M1 q1 M2 q2 "[(x,y)]" q1x q2x]
          tgt1 tgt2 Node.prems by auto
  moreover have "q1x \<in> nodes M1"
    using q1x_def(1) Node.prems(2) by (metis insertI1 io_targets_nodes tgt1)
  moreover have "q2x \<in> nodes M2"
    using q2x_def(1) Node.prems(3) by (metis insertI1 io_targets_nodes tgt2)
  ultimately have "q2x \<in> succ M2 (x,y) q2 \<and> atc_reaction M2 q2x (f y) io_tl"
    using Node.IH[of "f y" q1x q2x io_tl] ob1 ob2 q1x_def(2) q2x_def by blast

  then show "atc_reaction M2 q2 (Node x f) io" using io_split y_def by blast
qed

lemma IO_reduction :
  assumes ls : "language_state M1 q1 \<subseteq> language_state M2 q2"
  and     el1 : "q1 \<in> nodes M1"
  and     el2 : "q2 \<in> nodes M2"
  and     ob1 : "observable M1"
  and     ob2 : "observable M2"
shows "IO M1 q1 t \<subseteq> IO M2 q2 t"
  using assms atc_reaction_reduction unfolding IO.simps by auto

lemma IO_set_reduction :
  assumes ls : "language_state M1 q1 \<subseteq> language_state M2 q2"
  and     el1 : "q1 \<in> nodes M1"
  and     el2 : "q2 \<in> nodes M2"
  and     ob1 : "observable M1"
  and     ob2 : "observable M2"
shows "IO_set M1 q1 \<Omega> \<subseteq> IO_set M2 q2 \<Omega>"
proof -
  have "\<forall> t \<in> \<Omega> . IO M1 q1 t \<subseteq> IO M2 q2 t"
    using assms IO_reduction by metis
  then show ?thesis
    unfolding IO_set.simps by blast
qed

lemma B_reduction :
  assumes red : "M1 \<preceq> M2"
  and     ob1 : "observable M1"
  and     ob2 : "observable M2"
shows "B M1 io \<Omega> \<subseteq> B M2 io \<Omega>"
proof
  fix xy assume xy_assm : "xy \<in> B M1 io \<Omega>"
  then obtain q1x where q1x_def : "q1x \<in> (io_targets M1 (initial M1) io) \<and> xy \<in> IO_set M1 q1x \<Omega>"
    unfolding B.simps by auto
  then obtain tr1 where tr1_def : "path M1 (io || tr1) (initial M1) \<and> length io = length tr1"
    by auto

  then have q1x_ob : "io_targets M1 (initial M1) io = {q1x}"
    using assms
    by (metis io_targets_observable_singleton_ex language_state q1x_def singleton_iff)

  then have ls1 : "io \<in> language_state M1 (initial M1)"
    by auto
  then have ls2 : "io \<in> language_state M2 (initial M2)"
    using red by auto

  then obtain tr2 where tr2_def : "path M2 (io || tr2) (initial M2) \<and> length io = length tr2"
    by auto
  then obtain q2x where q2x_def : "q2x \<in> (io_targets M2 (initial M2) io)"
    by auto

  then have q2x_ob : "io_targets M2 (initial M2) io = {q2x}"
    using tr2_def assms
    by (metis io_targets_observable_singleton_ex language_state singleton_iff)

  then have "language_state M1 q1x \<subseteq> language_state M2 q2x"
    using q1x_ob assms unfolding io_reduction.simps
    by (simp add: language_state_inclusion_of_state_reached_by_same_sequence)
  then have "IO_set M1 q1x \<Omega> \<subseteq> IO_set M2 q2x \<Omega>"
    using assms IO_set_reduction by (metis FSM.nodes.initial io_targets_nodes q1x_def q2x_def)
  moreover have "B M1 io \<Omega> = IO_set M1 q1x \<Omega>"
    using q1x_ob by auto
  moreover have "B M2 io \<Omega> = IO_set M2 q2x \<Omega>"
    using q2x_ob by auto
  ultimately have "B M1 io \<Omega> \<subseteq> B M2 io \<Omega>"
    by simp
  then show "xy \<in> B M2 io \<Omega>" using xy_assm
    by blast
qed

lemma append_io_B_reduction :
  assumes red : "M1 \<preceq> M2"
  and     ob1 : "observable M1"
  and     ob2 : "observable M2"
shows "append_io_B M1 io \<Omega> \<subseteq> append_io_B M2 io \<Omega>"
proof
  fix ioR assume ioR_assm : "ioR \<in> append_io_B M1 io \<Omega>"
  then obtain res where res_def : "ioR = io @ res" "res \<in> B M1 io \<Omega>"
    by auto
  then have "res \<in> B M2 io \<Omega>"
    using assms B_reduction by (metis (no_types, hide_lams) subset_iff)
  then show "ioR \<in> append_io_B M2 io \<Omega>"
    using ioR_assm res_def by auto
qed

lemma atc_io_reduction_on_reduction[intro] :
  assumes red : "M1 \<preceq> M2"
  and     ob1 : "observable M1"
  and     ob2 : "observable M2"
shows "atc_io_reduction_on M1 M2 iseq \<Omega>"
unfolding atc_io_reduction_on.simps proof
  show "L\<^sub>i\<^sub>n M1 {iseq} \<subseteq> L\<^sub>i\<^sub>n M2 {iseq}"
    using red by auto
next
  show "\<forall>io\<in>L\<^sub>i\<^sub>n M1 {iseq}. B M1 io \<Omega> \<subseteq> B M2 io \<Omega>"
    using  B_reduction assms by blast
qed

lemma atc_io_reduction_on_sets_reduction[intro] :
  assumes red : "M1 \<preceq> M2"
  and     ob1 : "observable M1"
  and     ob2 : "observable M2"
shows "atc_io_reduction_on_sets M1 TS \<Omega> M2"
  using assms atc_io_reduction_on_reduction by (metis atc_io_reduction_on_sets.elims(3))

lemma atc_io_reduction_on_sets_via_LS\<^sub>i\<^sub>n :
  assumes "atc_io_reduction_on_sets M1 TS \<Omega> M2"
  shows "(L\<^sub>i\<^sub>n M1 TS \<union> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 TS. B M1 io \<Omega>))
          \<subseteq> (L\<^sub>i\<^sub>n M2 TS \<union> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 TS. B M2 io \<Omega>))"
proof -
  have "\<forall> iseq \<in> TS . (L\<^sub>i\<^sub>n M1 {iseq} \<subseteq> L\<^sub>i\<^sub>n M2 {iseq}
                        \<and> (\<forall> io \<in> L\<^sub>i\<^sub>n M1 {iseq} . B M1 io \<Omega> \<subseteq> B M2 io \<Omega>))"
    using assms by auto
  then have "\<forall> iseq \<in> TS . (\<Union>io\<in>L\<^sub>i\<^sub>n M1 {iseq}. B M1 io \<Omega>)
                            \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 {iseq}. B M2 io \<Omega>)"
    by blast
  moreover have "\<forall> iseq \<in> TS . (\<Union>io\<in>L\<^sub>i\<^sub>n M2 {iseq}. B M2 io \<Omega>)
                                \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 TS. B M2 io \<Omega>)"
    unfolding language_state_for_inputs.simps by blast
  ultimately have elem_subset : "\<forall> iseq \<in> TS .
                                  (\<Union>io\<in>L\<^sub>i\<^sub>n M1 {iseq}. B M1 io \<Omega>)
                                    \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 TS. B M2 io \<Omega>)"
    by blast

  show ?thesis
  proof
    fix x assume "x \<in> L\<^sub>i\<^sub>n M1 TS \<union> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 TS. B M1 io \<Omega>)"
    then show "x \<in> L\<^sub>i\<^sub>n M2 TS \<union> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 TS. B M2 io \<Omega>)"
    proof (cases "x \<in> L\<^sub>i\<^sub>n M1 TS")
      case True
      then obtain iseq where "iseq \<in> TS" "x\<in> L\<^sub>i\<^sub>n M1 {iseq}"
        unfolding language_state_for_inputs.simps by blast
      then have "atc_io_reduction_on M1 M2 iseq \<Omega>"
        using assms by auto
      then have "L\<^sub>i\<^sub>n M1 {iseq} \<subseteq> L\<^sub>i\<^sub>n M2 {iseq}"
        by auto
      then have "x \<in> L\<^sub>i\<^sub>n M2 TS"
        by (metis (no_types, lifting) UN_I
            \<open>\<And>thesis. (\<And>iseq. \<lbrakk>iseq \<in> TS; x \<in> L\<^sub>i\<^sub>n M1 {iseq}\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
            \<open>\<forall>iseq\<in>TS. L\<^sub>i\<^sub>n M1 {iseq} \<subseteq> L\<^sub>i\<^sub>n M2 {iseq} \<and> (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {iseq}. B M1 io \<Omega> \<subseteq> B M2 io \<Omega>)\<close>
            language_state_for_input_alt_def language_state_for_inputs_alt_def set_rev_mp)
      then show ?thesis
        by blast
    next
      case False
      then have "x \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 TS. B M1 io \<Omega>)"
        using \<open>x \<in> L\<^sub>i\<^sub>n M1 TS \<union> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 TS. B M1 io \<Omega>)\<close> by blast
      then obtain io where "io \<in> L\<^sub>i\<^sub>n M1 TS" "x \<in> B M1 io \<Omega>"
        by blast
      then obtain iseq where "iseq \<in> TS" "io\<in>L\<^sub>i\<^sub>n M1 {iseq}"
        unfolding language_state_for_inputs.simps by blast
      have "x \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 {iseq}. B M1 io \<Omega>)"
        using \<open>io \<in> L\<^sub>i\<^sub>n M1 {iseq}\<close> \<open>x \<in> B M1 io \<Omega>\<close> by blast
      then have "x \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 TS. B M2 io \<Omega>)"
        using \<open>iseq \<in> TS\<close> elem_subset by blast
      then show ?thesis
        by blast
    qed
  qed
qed

end


theory Zp_Compact
imports Padic_Int_Topology
begin

context padic_integers
begin

lemma res_ring_car:
"carrier (Zp_res_ring k) = {0..p ^ k - 1}"
  unfolding residue_ring_def by simp

text\<open>The refinement of a sequence by a function $nat \Rightarrow nat$\<close>
definition take_subseq :: "(nat \<Rightarrow> 'a) \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow> 'a)" where
"take_subseq s f = (\<lambda>k. s (f k))"

text\<open>Predicate for increasing function on the natural numbers\<close>
definition is_increasing :: "(nat \<Rightarrow> nat) \<Rightarrow> bool" where
"is_increasing f = (\<forall> n m::nat. n>m \<longrightarrow> (f n) > (f m))"

text\<open>Elimination and introduction lemma for increasing functions\<close>
lemma is_increasingI:
  assumes "\<And> n m::nat. n>m \<Longrightarrow> (f n) > (f m)"
  shows "is_increasing f"
  unfolding is_increasing_def
  using assms
  by blast

lemma is_increasingE:
  assumes "is_increasing f"
  assumes " n> m"
  shows "f n > f m"
  using assms
  unfolding is_increasing_def
  by blast

text\<open>The subsequence predicate\<close>
definition is_subseq_of :: "(nat \<Rightarrow> 'a) \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> bool" where
"is_subseq_of s s' = (\<exists>(f::nat \<Rightarrow> nat). is_increasing f \<and> s' = take_subseq s f)"

text\<open>Subsequence introduction lemma\<close>
lemma is_subseqI:
  assumes "is_increasing f"
  assumes "s' = take_subseq s f"
  shows "is_subseq_of s s'"
  using assms
  unfolding is_subseq_of_def
  by auto

lemma is_subseq_ind:
  assumes "is_subseq_of s s'"
  shows "\<exists> l. s' k = s l"
  using assms
  unfolding is_subseq_of_def  take_subseq_def by blast

lemma is_subseq_closed:
  assumes "s \<in> closed_seqs Zp"
  assumes "is_subseq_of s s'"
  shows "s' \<in> closed_seqs Zp"
  apply(rule closed_seqs_memI)
  using is_subseq_ind assms closed_seqs_memE
  by metis

text\<open>Given a sequence and a predicate, returns the function from nat to nat which represents
the increasing sequences of indices n on which P (s n) holds.\<close>

primrec seq_filter :: "(nat \<Rightarrow>'a) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat" where
"seq_filter s P (0::nat) = (LEAST k::nat. P (s k))"|
"seq_filter s P (Suc n) = (LEAST k:: nat. (P (s k)) \<and> k > (seq_filter s P n))"

lemma seq_filter_pre_increasing:
  assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
  shows "seq_filter s P n < seq_filter s P (Suc n)"
  apply(auto)
proof(induction n)
  case 0
  have "\<exists>k. P (s k)" using assms(1) by blast
  then have "\<exists>k::nat. (LEAST k::nat. (P (s k))) \<ge> 0"
    by blast
  obtain k where "(LEAST k::nat. (P (s k))) = k" by simp
  have "\<exists>l. l = (LEAST l::nat. (P (s l) \<and> l > k))"
    by simp
  thus ?case
    by (metis (no_types, lifting) LeastI assms)
next
  case (Suc n)
  then show ?case
    by (metis (no_types, lifting) LeastI assms)
qed

lemma seq_filter_increasing:
  assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
  shows "is_increasing (seq_filter s P)"
  by (metis assms seq_filter_pre_increasing is_increasingI lift_Suc_mono_less)

definition filtered_seq :: "(nat \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> 'a)" where
"filtered_seq s P = take_subseq s (seq_filter s P)"

lemma filter_exist:
  assumes "s \<in> closed_seqs Zp"
  assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
  shows "\<And>m. n\<le>m \<Longrightarrow> P (s (seq_filter s P n))"
proof(induct n)
  case 0
  then show ?case
    using LeastI assms(2) by force
next
  case (Suc n)
  then show ?case
    by (smt LeastI assms(2) seq_filter.simps(2))
qed

text\<open>In a filtered sequence, every element satisfies the filtering predicate \<close>

lemma fil_seq_pred:
  assumes "s \<in> closed_seqs Zp"
  assumes "s' = filtered_seq s P"
  assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
  shows "\<And>m::nat. P (s' m)"
proof-
  have "\<exists>k. P (s k)" using assms(3)
    by blast
  fix m
  obtain k where kdef: "k = seq_filter s P m" by auto
  have "\<exists>k. P (s k)"
    using assms(3) by auto
  then have "P (s k)"
    by (metis (full_types) assms(1) assms(3) kdef le_refl less_imp_triv not_less_eq filter_exist )
  then have "s' m = s k"
    by (simp add: assms(2) filtered_seq_def kdef take_subseq_def)
  hence "P (s' m)"
    by (simp add: \<open>P (s k)\<close>)
  thus "\<And>m. P (s' m)" using  assms(2) assms(3) dual_order.strict_trans filter_exist filtered_seq_def
      lessI less_Suc_eq_le take_subseq_def
    by (metis (mono_tags, opaque_lifting) assms(1))
qed

definition kth_res_equals :: "nat \<Rightarrow> int \<Rightarrow> (padic_int  \<Rightarrow> bool)"  where
"kth_res_equals k n a = (a k = n)"

(*The characteristic function of the underlying set of a sequence*)
definition indicator:: "(nat \<Rightarrow> 'a) \<Rightarrow> ('a  \<Rightarrow> bool)" where
"indicator s a = (\<exists>n::nat. s n = a)"

text\<open>Choice function for a subsequence with constant kth residue. Could be made constructive by
choosing the LEAST n if we wanted.\<close>

definition const_res_subseq :: "nat \<Rightarrow> padic_int_seq \<Rightarrow> padic_int_seq"  where
"const_res_subseq k s = (SOME s'::(padic_int_seq). (\<exists> n. is_subseq_of s s' \<and> s'
  = (filtered_seq s (kth_res_equals k n)) \<and> (\<forall>m. s' m k = n)))"

text\<open>The constant kth residue value for the sequence obtained by the previous function\<close>

definition const_res :: "nat \<Rightarrow> padic_int_seq \<Rightarrow> int"  where
"const_res k s = (THE n. (\<forall> m. (const_res_subseq k s) m k = n))"

definition maps_to_n:: "int \<Rightarrow> (nat \<Rightarrow> int) \<Rightarrow> bool" where
"maps_to_n n f = (\<forall>(k::nat). f k \<in> {0..n})"

definition drop_res :: "int \<Rightarrow> (nat \<Rightarrow> int) \<Rightarrow> (nat \<Rightarrow> int)" where
"drop_res k f n = (if (f n) = k then 0 else f n)"

lemma maps_to_nE:
  assumes "maps_to_n n f"
  shows "(f k) \<in> {0..n}"
  using assms
  unfolding maps_to_n_def
  by blast

lemma maps_to_nI:
  assumes "\<And>n. f n \<in>{0 .. k}"
  shows "maps_to_n k f"
  using assms maps_to_n_def by auto

lemma maps_to_n_drop_res:
  assumes "maps_to_n (Suc n) f"
  shows "maps_to_n n (drop_res (Suc n) f)"
proof-
  fix k
  have "drop_res (Suc n) f k \<in> {0..n}"
  proof(cases "f k = Suc n")
    case True
    then have "drop_res (Suc n) f k = 0"
      unfolding drop_res_def by auto
    then show ?thesis
      using assms local.drop_res_def maps_to_n_def by auto
  next
    case False
    then show ?thesis
      using assms atLeast0_atMost_Suc maps_to_n_def drop_res_def
      by auto
  qed
  then have "\<And>k. drop_res (Suc n) f k \<in> {0..n}"
    using assms local.drop_res_def maps_to_n_def by auto
    then show "maps_to_n n (drop_res (Suc n) f)" using maps_to_nI
      using maps_to_n_def by blast
qed

lemma drop_res_eq_f:
  assumes "maps_to_n (Suc n) f"
  assumes "\<not> (\<forall>m. \<exists>n. n>m \<and> (f n = (Suc k)))"
  shows "\<exists>N. \<forall>n. n>N \<longrightarrow> f n = drop_res (Suc k) f n"
proof-
  have "\<exists>m. \<forall>n. n \<le> m \<or> (f n) \<noteq> (Suc k)"
    using assms
    by (meson Suc_le_eq nat_le_linear)
  then have "\<exists>m. \<forall>n. n \<le> m \<or> (f n)  = drop_res (Suc k) f n"
    using drop_res_def by auto
  then show ?thesis
    by (meson less_Suc_eq_le order.asym)
qed

lemma maps_to_n_infinite_seq:
  shows "\<And>f. maps_to_n (k::nat) f \<Longrightarrow> \<exists>l::int. \<forall>m. \<exists>n. n>m \<and> (f n = l)"
proof(induction k)
  case 0
  then have "\<And>n. f n \<in> {0}"
    using maps_to_nE[of 0 f] by auto
  then show " \<exists>l. \<forall>m. \<exists>n. m < n \<and> f n = l"
    by blast
next
  case (Suc k)
  assume IH: "\<And>f. maps_to_n k f \<Longrightarrow> \<exists>l. \<forall>m. \<exists>n. m < n \<and> f n = l"
  fix f
  assume A: "maps_to_n (Suc k) f"
  show "\<exists>l. \<forall>m. \<exists>n. n>m \<and> (f n = l)"
  proof(cases " \<forall>m. \<exists>n. n>m \<and> (f n = (Suc k))")
    case True
    then show ?thesis by blast
  next
    case False
    then obtain N where N_def: "\<forall>n. n>N \<longrightarrow> f n = drop_res (Suc k) f n"
      using drop_res_eq_f drop_res_def
      by fastforce
    have " maps_to_n k (drop_res (Suc k) f) "
      using A maps_to_n_drop_res by blast
    then have " \<exists>l. \<forall>m. \<exists>n. m < n \<and> (drop_res (Suc k) f) n = l"
      using IH by blast
    then obtain l where l_def: "\<forall>m. \<exists>n. m < n \<and> (drop_res (Suc k) f) n = l"
      by blast
    have "\<forall>m. \<exists>n. n>m \<and> (f n = l)"
      apply auto
    proof-
      fix m
      show "\<exists>n>m. f n = l"
      proof-
        obtain n where N'_def: "(max m N) < n \<and> (drop_res (Suc k) f) n = l"
          using l_def by blast
        have "f n =  (drop_res (Suc k) f) n"
          using N'_def N_def
          by simp
        then show ?thesis
          using N'_def by auto
      qed
    qed
    then show ?thesis
      by blast
  qed
qed

lemma int_nat_p_pow_minus:
"int (nat (p ^ k - 1)) = p ^ k - 1"
  by (simp add: prime prime_gt_0_int)

lemma maps_to_n_infinite_seq_res_ring:
"\<And>f. f \<in> (UNIV::nat set) \<rightarrow> carrier (Zp_res_ring k) \<Longrightarrow> \<exists>l. \<forall>m. \<exists>n. n>m \<and> (f n = l)"
apply(rule maps_to_n_infinite_seq[of "nat (p^k - 1)"])
  unfolding maps_to_n_def res_ring_car int_nat_p_pow_minus by blast

definition index_to_residue :: "padic_int_seq \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> int" where
"index_to_residue s k m = ((s m) k)"

lemma seq_maps_to_n:
  assumes "s \<in> closed_seqs Zp"
  shows "(index_to_residue s k) \<in> UNIV \<rightarrow> carrier (Zp_res_ring k)"
proof-
  have A1: "\<And>m. (s m) \<in> carrier Zp"
    using assms closed_seqs_memE by auto
  have A2: "\<And>m. (s m k) \<in> carrier (Zp_res_ring k)"
    using assms by (simp add: A1)
  have "\<And>m. index_to_residue s k m = s m k"
    using index_to_residue_def
    by auto
  thus "index_to_residue s k \<in> UNIV \<rightarrow> carrier (residue_ring (p ^ k))"
    using A2 by simp
qed

lemma seq_pr_inc:
  assumes "s \<in> closed_seqs Zp"
  shows "\<exists>l. \<forall>m. \<exists>n > m. (kth_res_equals k l) (s n)"
proof-
  fix k l m
  have 0: "(kth_res_equals k l) (s m) \<Longrightarrow> (s m) k = l"
    by (simp add: kth_res_equals_def)
  have 1: "\<And>k m. s m k = index_to_residue s k m"
    by (simp add: index_to_residue_def)
  have 2: "(index_to_residue s k) \<in> UNIV \<rightarrow> carrier (Zp_res_ring k)"
    using seq_maps_to_n assms by blast
  have 3: "\<And>m. s m k \<in> carrier (Zp_res_ring k)"
  proof-
    fix m have 30: "s m k = index_to_residue s k m"
      using 1 by blast
    show " s m k \<in> carrier (Zp_res_ring k)"
      unfolding 30 using 2 by blast
  qed
  obtain j where j_def: "j = nat (p^k - 1)"
    by blast
  have j_to_int: "int j = p^k - 1"
    using j_def
    by (simp add: prime prime_gt_0_int)
  have "\<exists>l. \<forall>m. \<exists>n. n > m \<and>  (index_to_residue s k n = l)"
    by(rule maps_to_n_infinite_seq_res_ring[of _ k], rule seq_maps_to_n, rule assms)
  hence "\<exists>l. \<forall>m. \<exists>n. n > m \<and>  (s n k = l)"
    by (simp add: index_to_residue_def)
  thus "\<exists>l. \<forall>m. \<exists>n > m. (kth_res_equals k l) (s n)"
    using kth_res_equals_def by auto
qed

lemma kth_res_equals_subseq:
  assumes "s \<in> closed_seqs Zp"
  shows "\<exists>n. is_subseq_of s (filtered_seq s (kth_res_equals k n)) \<and> (\<forall>m. (filtered_seq s (kth_res_equals k n)) m k = n)"
proof-
  obtain l where l_def: " \<forall> m. \<exists>n > m. (kth_res_equals k l) (s n)"
    using assms seq_pr_inc by blast
  have 0: "is_subseq_of s (filtered_seq s (kth_res_equals k l))"
    unfolding filtered_seq_def
    apply(rule is_subseqI[of "seq_filter s (kth_res_equals k l)"])
     apply(rule seq_filter_increasing, rule l_def)
    by blast
  have 1: " (\<forall>m. (filtered_seq s (kth_res_equals k l)) m k = l)"
   using l_def
   by (meson assms kth_res_equals_def fil_seq_pred padic_integers_axioms)
  show ?thesis using 0 1 by blast
qed

lemma const_res_subseq_prop_0:
  assumes "s \<in> closed_seqs Zp"
  shows "\<exists>l. (((const_res_subseq k s) = filtered_seq s (kth_res_equals k l)) \<and> (is_subseq_of s (const_res_subseq k s)) \<and> (\<forall>m.(const_res_subseq k s) m k = l))"
proof-
  have " \<exists>n. (is_subseq_of s (filtered_seq s (kth_res_equals k n)) \<and> (\<forall>m. (filtered_seq s (kth_res_equals k n)) m k = n))"
    by (simp add: kth_res_equals_subseq assms)
  then have "\<exists>s'. (\<exists>n. (is_subseq_of s s') \<and> (s' = filtered_seq s (kth_res_equals k n)) \<and> (\<forall>m. s' m k = n))"
    by blast
  then show ?thesis
  using const_res_subseq_def[of k s] const_res_subseq_def someI_ex
      by (smt const_res_subseq_def someI_ex)
qed

lemma const_res_subseq_prop_1:
  assumes "s \<in> closed_seqs Zp"
  shows "(\<forall>m.(const_res_subseq k s) m k = (const_res k s) )"
  using const_res_subseq_prop_0[of s] const_res_def[of k s]
  by (smt assms const_res_subseq_def const_res_def the_equality)

lemma const_res_subseq:
  assumes "s \<in> closed_seqs Zp"
  shows "is_subseq_of s (const_res_subseq k s)"
  using assms const_res_subseq_prop_0[of s k] by blast

lemma const_res_range:
  assumes "s \<in> closed_seqs Zp"
  assumes "k > 0"
  shows "const_res k s \<in> carrier (Zp_res_ring k)"
proof-
  have 0: "(const_res_subseq k s) 0 \<in> carrier Zp"
    using const_res_subseq[of s k] is_subseq_closed[of s "const_res_subseq k s"]
          assms(1) closed_seqs_memE by blast
  have 1: "(const_res_subseq k s) 0 k \<in>  carrier (Zp_res_ring k)"
    using 0 by simp
  then show  ?thesis
    using assms const_res_subseq_prop_1[of s k]
    by (simp add: \<open>s \<in> closed_seqs Zp\<close>)
qed

fun res_seq ::"padic_int_seq \<Rightarrow> nat \<Rightarrow>  padic_int_seq" where
"res_seq s 0 = s"|
"res_seq s (Suc k) = const_res_subseq (Suc k) (res_seq s k)"

lemma res_seq_res:
  assumes "s \<in> closed_seqs Zp"
  shows "(res_seq s k) \<in> closed_seqs Zp"
  apply(induction k)
  apply (simp add: assms)
  by (simp add: const_res_subseq is_subseq_closed)

lemma res_seq_res':
  assumes "s \<in> closed_seqs Zp"
  shows "\<And>n. res_seq s (Suc k) n (Suc k) = const_res (Suc k) (res_seq s k)"
  using assms res_seq_res[of s k] const_res_subseq_prop_1[of "(res_seq s k)" "Suc k" ]
  by simp

lemma res_seq_subseq:
  assumes "s \<in> closed_seqs Zp"
  shows "is_subseq_of (res_seq s k) (res_seq s (Suc k))"
  by (metis assms  const_res_subseq_prop_0 res_seq_res
      res_seq.simps(2))

lemma is_increasing_id:
"is_increasing (\<lambda> n. n)"
  by (simp add: is_increasingI)

lemma is_increasing_comp:
  assumes "is_increasing f"
  assumes "is_increasing g"
  shows "is_increasing (f \<circ> g)"
  using assms(1) assms(2) is_increasing_def
  by auto

lemma is_increasing_imp_geq_id[simp]:
  assumes  "is_increasing f"
  shows "f n \<ge>n"
  apply(induction n)
  apply simp
  by (metis (mono_tags, lifting) assms is_increasing_def
      leD lessI not_less_eq_eq order_less_le_subst2)

lemma is_subseq_ofE:
  assumes "s \<in> closed_seqs Zp"
  assumes "is_subseq_of s s'"
  shows "\<exists>k. k \<ge> n \<and> s' n = s k"
proof-
  obtain f where "is_increasing f \<and> s' = take_subseq s f"
    using assms(2) is_subseq_of_def by blast
  then have  " f n \<ge> n \<and> s' n = s (f n)"
    unfolding take_subseq_def
    by simp
  then show ?thesis by blast
qed

lemma is_subseq_of_id:
  assumes "s \<in> closed_seqs Zp"
  shows "is_subseq_of s s"
proof-
  have "s = take_subseq s (\<lambda>n. n)"
    unfolding take_subseq_def
    by auto
  then show ?thesis using is_increasing_id
    using is_subseqI
    by blast
qed

lemma is_subseq_of_trans:
  assumes "s \<in> closed_seqs Zp"
  assumes "is_subseq_of s s'"
  assumes "is_subseq_of s' s''"
  shows "is_subseq_of s s''"
proof-
  obtain f where f_def: "is_increasing f \<and> s' = take_subseq s f"
    using assms(2) is_subseq_of_def
    by blast
  obtain g where g_def: "is_increasing g \<and> s'' = take_subseq s' g"
    using assms(3) is_subseq_of_def
    by blast
  have "s'' = take_subseq s (f \<circ> g)"
  proof
    fix x
    show "s'' x = take_subseq s (f \<circ> g) x"
      using f_def g_def unfolding take_subseq_def
      by auto
  qed
  then show ?thesis
    using f_def g_def is_increasing_comp is_subseq_of_def
    by blast
qed

lemma res_seq_subseq':
  assumes "s \<in> closed_seqs Zp"
  shows "is_subseq_of s (res_seq s k)"
proof(induction k)
  case 0
  then show ?case using is_subseq_of_id
    by (simp add: assms)
next
  case (Suc k)
  fix k
  assume "is_subseq_of s (res_seq s k)"
  then show "is_subseq_of s (res_seq s (Suc k)) "
    using assms is_subseq_of_trans res_seq_subseq
    by blast
qed

lemma res_seq_subseq'':
  assumes "s \<in> closed_seqs Zp"
  shows "is_subseq_of (res_seq s n) (res_seq s (n + k))"
  apply(induction k)
  apply (simp add: assms is_subseq_of_id res_seq_res)
  using add_Suc_right assms is_subseq_of_trans res_seq_res res_seq_subseq by presburger
(**)

definition acc_point :: "padic_int_seq \<Rightarrow> padic_int" where
"acc_point s k = (if (k = 0) then (0::int) else ((res_seq s k) 0 k))"

lemma res_seq_res_1:
  assumes "s \<in> closed_seqs Zp"
  shows "res_seq s (Suc k) 0 k = res_seq s k 0 k"
proof-
  obtain n where  n_def: "res_seq s (Suc k) 0 = res_seq s k n"
    by (metis assms is_subseq_of_def res_seq_subseq take_subseq_def)
  have "res_seq s (Suc k) 0 k = res_seq s k n k"
    using n_def by auto
  thus ?thesis
    using  assms padic_integers.p_res_ring_0'
        padic_integers_axioms res_seq.elims  residues_closed
  proof -
    have "\<forall>n. s n \<in> carrier Zp"
      by (simp add: assms closed_seqs_memE)
    then show ?thesis
      by (metis \<open>res_seq s (Suc k) 0 k = res_seq s k n k\<close> assms padic_integers.p_res_ring_0' padic_integers_axioms res_seq.elims res_seq_res' residues_closed)
  qed
qed

lemma acc_point_cres:
  assumes "s \<in> closed_seqs Zp"
  shows "(acc_point s (Suc k)) = (const_res (Suc k) (res_seq s k))"
proof-
  have "Suc k > 0" by simp
  have "(res_seq s (Suc k)) = const_res_subseq (Suc k) (res_seq s k)"
    by simp
  then have "(const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k) = const_res (Suc k)  (res_seq s k)"
    using assms res_seq_res' padic_integers_axioms by auto
  have "acc_point s (Suc k) = res_seq s (Suc k) 0 (Suc k)" using acc_point_def by simp
  then have "acc_point s (Suc k) = (const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k)"
    by simp
  thus ?thesis
    by (simp add: \<open>(const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k) = const_res (Suc k) (res_seq s k)\<close>)
qed

lemma acc_point_res:
  assumes "s \<in> closed_seqs Zp"
  shows "residue (p ^ k) (acc_point s (Suc k)) = acc_point s k"
proof(cases "k = 0")
  case True
  then show ?thesis
    by (simp add: acc_point_def residue_1_zero)
next
  case False
  assume "k \<noteq> 0"  show "residue (p ^ k) (acc_point s (Suc k)) = acc_point s k"
    using False acc_point_def assms lessI less_imp_le nat.distinct(1) res_seq_res_1 res_seq_res
          Zp_defs(3) closed_seqs_memE prime by (metis padic_set_res_coherent)
qed

lemma acc_point_closed:
  assumes "s \<in> closed_seqs Zp"
  shows "acc_point s \<in>  carrier Zp"
proof-
  have "acc_point s \<in> padic_set p"
  proof(rule padic_set_memI)
    show "\<And>m. acc_point s m \<in> carrier (residue_ring (p ^ m))"
    proof-
      fix m
      show "acc_point s m \<in> carrier (residue_ring (p ^ m))"
      proof(cases "m = 0")
        case True
        then show ?thesis
          by (simp add: acc_point_def residue_ring_def)
      next
        case False
        assume "m \<noteq> 0"
        then have "acc_point s m = res_seq s m 0 m" (*"res_seq s (Suc k) = const_res_subseq (Suc k) (res_seq s k)"*)
          by (simp add: acc_point_def)
        then show ?thesis  using const_res_range[of "(const_res_subseq (m-1) s)" m] acc_point_def[of s m]
          by (metis False Suc_pred acc_point_cres assms const_res_range neq0_conv res_seq_res)
      qed
    qed
    show "\<And>m n. m < n \<Longrightarrow> residue (p ^ m) (acc_point s n) = acc_point s m"
    proof-
      fix m n::nat
      assume A: "m < n"
      show "residue (p ^ m) (acc_point s n) = acc_point s m"
      proof-
        obtain l where l_def: "l = n - m - 1"
          by simp
        have "residue (p ^ m) (acc_point s (Suc (m + l))) = acc_point s m"
        proof(induction l)
          case 0
          then show ?case
            by (simp add: acc_point_res assms)
        next
          case (Suc l)
          then show ?case
            using Zp_defs(3) acc_point_def add_Suc_right assms  le_add1 closed_seqs_memE nat.distinct(1)
                padic_integers.prime padic_integers_axioms res_seq_res res_seq_res_1
            by (metis padic_set_res_coherent)
        qed
        then show ?thesis
          by (metis A Suc_diff_Suc Suc_eq_plus1 add_Suc_right add_diff_inverse_nat diff_diff_left
              l_def le_less_trans less_not_refl order_less_imp_le)
      qed
    qed
  qed
  then show ?thesis
    by (simp add: Zp_defs(3))
qed

text\<open>Choice function for a subsequence of s which converges to a, if it exists\<close>
fun convergent_subseq_fun :: "padic_int_seq \<Rightarrow> padic_int \<Rightarrow> (nat \<Rightarrow> nat)" where
"convergent_subseq_fun s a 0 = 0"|
"convergent_subseq_fun s a (Suc n) = (SOME k. k > (convergent_subseq_fun s a n)
                                                \<and> (s k (Suc n)) = a (Suc n))"

definition convergent_subseq :: "padic_int_seq \<Rightarrow> padic_int_seq" where
"convergent_subseq s = take_subseq s (convergent_subseq_fun s (acc_point s))"

lemma increasing_conv_induction_0_pre:
  assumes "s \<in> closed_seqs Zp"
  assumes "a = acc_point s"
  shows "\<exists>k > convergent_subseq_fun s a n. (s k (Suc n)) = a (Suc n)"
proof-
  obtain l::nat where "l > 0 " by blast
  have "is_subseq_of s (res_seq s (Suc n))"
    using assms(1) res_seq_subseq' by blast
  then obtain m where "s m = res_seq s (Suc n) l \<and> m \<ge> l"
    by (metis is_increasing_imp_geq_id is_subseq_of_def take_subseq_def )
  have "a (Suc n) = res_seq s (Suc n) 0 (Suc n)"
    by (simp add: acc_point_def assms(2))
  have "s m (Suc n) = a (Suc n)"
    by (metis \<open>a (Suc n) = res_seq s (Suc n) 0 (Suc n)\<close> \<open>s m = res_seq s (Suc n) l \<and> l \<le> m\<close> assms(1) res_seq_res')
  thus ?thesis
    using \<open>0 < l\<close> \<open>s m = res_seq s (Suc n) l \<and> l \<le> m\<close> less_le_trans  \<open>s m (Suc n) = a (Suc n)\<close>
    by (metis \<open>a (Suc n) = res_seq s (Suc n) 0 (Suc n)\<close> \<open>is_subseq_of s (res_seq s (Suc n))\<close>
        assms(1) lessI is_subseq_ofE res_seq_res' )
qed

lemma increasing_conv_subseq_fun_0:
  assumes "s \<in> closed_seqs Zp"
  assumes "\<exists>s'. s' = convergent_subseq s"
  assumes "a = acc_point s"
  shows "convergent_subseq_fun s a (Suc n) > convergent_subseq_fun s a n"
  apply(auto)
proof(induction n)
  case 0
  have "convergent_subseq_fun s a 0 = 0" by simp
  then show ?case
    by (smt assms(1) assms(3) less_Suc_eq less_Suc_eq_0_disj increasing_conv_induction_0_pre padic_integers_axioms someI_ex)
next
  case (Suc k)
  then show ?case
    by (metis (mono_tags, lifting) assms(1) assms(3) increasing_conv_induction_0_pre someI_ex)
qed

lemma increasing_conv_subseq_fun:
  assumes "s \<in> closed_seqs Zp"
  assumes "a = acc_point s"
  assumes "\<exists>s'. s' = convergent_subseq s"
  shows "is_increasing (convergent_subseq_fun s a)"
    by (metis assms(1) assms(2) increasing_conv_subseq_fun_0 is_increasingI lift_Suc_mono_less)

lemma convergent_subseq_is_subseq:
  assumes "s \<in> closed_seqs Zp"
  shows "is_subseq_of s (convergent_subseq s)"
  using assms convergent_subseq_def increasing_conv_subseq_fun is_subseqI by blast

lemma is_closed_seq_conv_subseq:
  assumes "s \<in> closed_seqs Zp"
  shows "(convergent_subseq s) \<in> closed_seqs Zp"
  by (simp add: assms convergent_subseq_def closed_seqs_memI closed_seqs_memE take_subseq_def)

lemma convergent_subseq_res:
  assumes "s \<in> closed_seqs Zp"
  assumes "a = acc_point s"
  shows "convergent_subseq s l l = residue (p ^ l) (acc_point s l)"
proof-
  have "\<exists>k. convergent_subseq s l =  s k \<and> s k l = a l"
  proof-
    have "convergent_subseq s l = s (convergent_subseq_fun s a l)"
      by (simp add: assms(2) convergent_subseq_def take_subseq_def)
    obtain k where kdef: "(convergent_subseq_fun s a l) = k"
      by simp
    have "convergent_subseq s l = s k"
      by (simp add: \<open>convergent_subseq s l = s (convergent_subseq_fun s a l)\<close> kdef)
    have "s k l = a l"
    proof(cases "l = 0")
      case True
      then show ?thesis
        using acc_point_def assms(1) assms(2)
        by (metis closed_seqs_memE p_res_ring_0' residues_closed)
    next
      case False
      have "0 < l"
        using False by blast
      then have "k > convergent_subseq_fun s a (l-1)"
        by (metis One_nat_def Suc_pred assms(1) assms(2) increasing_conv_subseq_fun_0 kdef)
      then have "s k l = a l" using kdef
        assms(1) assms(2) convergent_subseq_fun.simps(2) increasing_conv_induction_0_pre
        padic_integers_axioms someI_ex One_nat_def  \<open>0 < l\<close> increasing_conv_induction_0_pre
        by (smt Suc_pred)
      then show ?thesis
        by simp
    qed
    then have "convergent_subseq s l =  s k \<and> s k l = a l"
      using \<open>convergent_subseq s l = s k\<close> by blast
    thus ?thesis
      by blast
  qed
  thus ?thesis
    using acc_point_closed assms(1) assms(2) Zp_defs(3) prime padic_set_res_coherent by force
qed

lemma convergent_subseq_res':
  assumes "s \<in> closed_seqs Zp"
  assumes "n > l"
  shows "convergent_subseq s n l = convergent_subseq s l l "
proof-
  have 0: "convergent_subseq s l l = residue (p ^ l) (acc_point s l)"
    using assms(1) convergent_subseq_res by auto
  have 1: "convergent_subseq s n n = residue (p ^ n) (acc_point s n)"
    by (simp add: assms(1) convergent_subseq_res)
  have 2: "convergent_subseq s n l = residue (p ^ l) (convergent_subseq s l l)"
    using 0 assms 1 Zp_defs(3) acc_point_closed is_closed_seq_conv_subseq
        closed_seqs_memE le_refl less_imp_le_nat prime
    by (metis padic_set_res_coherent)
  show ?thesis using 0 1 2 Zp_defs(3) assms(1) is_closed_seq_conv_subseq closed_seqs_memE le_refl prime
    by (metis padic_set_res_coherent)
qed

lemma convergent_subsequence_is_convergent:
  assumes "s \<in> closed_seqs Zp"
  assumes "a = acc_point s"
  shows "Zp_converges_to (convergent_subseq s) (acc_point s)" (*\<And>n. \<exists>N. \<forall>k > N. s k n = a n"*)
proof(rule Zp_converges_toI)
  show "acc_point s \<in> carrier Zp"
    using acc_point_closed assms  by blast
  show "convergent_subseq s \<in> carrier (Zp\<^bsup>\<omega>\<^esup>)"
    using is_closed_seq_conv_subseq assms by simp
  show "\<And>n. \<exists>N. \<forall>k>N. convergent_subseq s k n = acc_point s n"
  proof-
    fix n
    show "\<exists>N. \<forall>k>N. convergent_subseq s k n = acc_point s n"
    proof(induction n)
      case 0
      then show ?case
        using acc_point_closed[of s] assms convergent_subseq_def closed_seqs_memE of_nat_0
              ord_pos take_subseq_def zero_below_ord is_closed_seq_conv_subseq[of s]
        by (metis residue_of_zero(2))
    next
      case (Suc n)
      have "acc_point s (Suc n) = res_seq s (Suc n) 0 (Suc n)"
        by (simp add: acc_point_def)
      obtain k where kdef: "convergent_subseq_fun s a (Suc n) = k" by simp
      have "Suc n > 0" by simp
      then have "k > (convergent_subseq_fun s a n)"
        using assms(1) assms(2) increasing_conv_subseq_fun_0 kdef by blast
      then have " k > (convergent_subseq_fun s a n) \<and> (s k (Suc n)) = a (Suc n)" using kdef
        by (metis (mono_tags, lifting) assms(1) assms(2) convergent_subseq_fun.simps(2) increasing_conv_induction_0_pre someI_ex)
      have "s k (Suc n) = a (Suc n)"
        using \<open>convergent_subseq_fun s a n < k \<and> s k (Suc n) = a (Suc n)\<close> by blast
      then have "convergent_subseq s (Suc n) (Suc n) = a (Suc n)"
        by (metis assms(2) convergent_subseq_def kdef take_subseq_def)
      then have "\<forall>l > n.  convergent_subseq s l (Suc n) = a (Suc n)"
        using convergent_subseq_res'
        by (metis Suc_lessI assms(1))
      then show ?case
        using assms(2) by blast
    qed
  qed
qed

theorem Zp_is_compact:
  assumes "s \<in> closed_seqs Zp"
  shows "\<exists>s'. is_subseq_of s s' \<and> (Zp_converges_to s' (acc_point s))"
  using assms convergent_subseq_is_subseq convergent_subsequence_is_convergent
  by blast

end
end