theory HOModel
imports Main
begin

declare split_if_asm [split] -- {* perform default perform case splitting on conditionals *}

section {* Heard-Of Algorithms *}

subsection {* The Consensus Problem *}

text {*
  We are interested in the verification of fault-tolerant distributed algorithms.
  The Consensus problem is paradigmatic in this area. Stated
  informally, it assumes that all processes participating in the algorithm
  initially propose some value, and that they may at some point decide some value.
  It is required that every process eventually decides, and that all processes
  must decide the same value.

  More formally, we represent runs of algorithms as @{text \<omega>}-sequences of
  configurations (vectors of process states). Hence, a run is modeled as
  a function of type @{text "nat \<Rightarrow> 'proc \<Rightarrow> 'pst"} where type variables
  @{text "'proc"} and @{text "'pst"} represent types of processes and process
  states, respectively. The Consensus property is expressed with respect
  to a collection @{text "vals"} of initially proposed values (one per process)
  and an observer function @{text "dec::'pst \<Rightarrow> val option"} that retrieves the decision
  (if any) from a process state. The Consensus problem is stated as the conjunction
  of the following properties:
  \begin{description}
  \item[Integrity.] Processes can only decide initially proposed values.
  \item[Agreement.] Whenever processes @{text p} and @{text q} decide,
    their decision values must be the same. (In particular, process @{text p}
    may never change the value it decides, which is referred to as Irrevocability.)
  \item[Termination.] Every process decides eventually.
  \end{description}

  The above properties are sometimes only required of non-faulty processes, since
  nothing can be required of a faulty process.
  The Heard-Of model does not attribute faults to processes, and therefore the
  above formulation is appropriate in this framework.
*}

type_synonym
  ('proc,'pst) run = "nat \<Rightarrow> 'proc \<Rightarrow> 'pst"

definition
  consensus :: "('proc \<Rightarrow> 'val) \<Rightarrow> ('pst \<Rightarrow> 'val option) \<Rightarrow> ('proc,'pst) run \<Rightarrow> bool"
where
  "consensus vals dec rho \<equiv>
     (\<forall>n p v. dec (rho n p) = Some v \<longrightarrow> v \<in> range vals)
   \<and> (\<forall>m n p q v w. dec (rho m p) = Some v \<and> dec (rho n q) = Some w
         \<longrightarrow> v = w)
   \<and> (\<forall>p. \<exists>n. dec (rho n p) \<noteq> None)"

text {*
  A variant of the Consensus problem replaces the Integrity requirement by
  \begin{description}
  \item[Validity.] If all processes initially propose the same value @{text "v"}
    then every process may only decide @{text "v"}.
  \end{description}
*}

definition weak_consensus where
  "weak_consensus vals dec rho \<equiv>
     (\<forall>v. (\<forall>p. vals p = v) \<longrightarrow> (\<forall>n p w. dec (rho n p) = Some w \<longrightarrow> w = v))
   \<and> (\<forall>m n p q v w. dec (rho m p) = Some v \<and> dec (rho n q) = Some w
         \<longrightarrow> v = w)
   \<and> (\<forall>p. \<exists>n. dec (rho n p) \<noteq> None)"

text {*
  Clearly, @{text "consensus"} implies @{text "weak_consensus"}.
*}

lemma consensus_then_weak_consensus:
  assumes "consensus vals dec rho"
  shows "weak_consensus vals dec rho"
  using assms by (auto simp: consensus_def weak_consensus_def image_def)

text {*
  Over Boolean values (``binary Consensus''), @{text weak_consensus}
  implies @{text consensus}, hence the two problems are equivalent.
  In fact, this theorem holds more generally whenever at most two
  different values are proposed initially (i.e., @{text "card (range vals) \<le> 2"}).
*}

lemma binary_weak_consensus_then_consensus:
  assumes bc: "weak_consensus (vals::'proc \<Rightarrow> bool) dec rho"
  shows "consensus vals dec rho"
proof -
  { -- {* Show the Integrity property, the other conjuncts are the same. *}
    fix n p v
    assume dec: "dec (rho n p) = Some v"
    have "v \<in> range vals"
    proof (cases "\<exists>w. \<forall>p. vals p = w")
      case True
      then obtain w where w: "\<forall>p. vals p = w" ..
      with bc have "dec (rho n p) \<in> {Some w, None}" by (auto simp: weak_consensus_def)
      with dec w show ?thesis by (auto simp: image_def)
    next
      case False
      -- {* In this case both possible values occur in @{text "vals"}, and the result is trivial. *}
      thus ?thesis by (auto simp: image_def)
    qed
  } note integrity = this
  from bc show ?thesis
    unfolding consensus_def weak_consensus_def by (auto elim!: integrity)
qed

text {*
  The algorithms that we are going to verify solve the Consensus or weak Consensus
  problem, under different hypotheses about the kinds and number of faults.
*}

subsection {* A Generic Representation of Heard-Of Algorithms *}

text {*
  Charron-Bost and Schiper~\cite{charron:heardof} introduce
  the Heard-Of (HO) model for representing fault-tolerant
  distributed algorithms. In this model, algorithms execute in communication-closed
  rounds: at any round~$r$, processes only receive messages that were sent for
  that round. For every process~$p$ and round~$r$, the ``heard-of set'' $HO(p,r)$
  denotes the set of processes from which~$p$ receives a message in round~$r$.
  Since every process is assumed to send a message to all processes in each round,
  the complement of $HO(p,r)$ represents the set of faults that may affect~$p$ in
  round~$r$ (messages that were not received, e.g. because the sender crashed,
  because of a network problem etc.).

  The HO model expresses hypotheses on the faults tolerated by an algorithm
  through ``communication predicates'' that constrain the sets $HO(p,r)$
  that may occur during an execution. Charron-Bost and Schiper show that
  standard fault models can be represented in this form.

  The original HO model is sufficient for representing algorithms
  tolerating benign failures such as process crashes or message loss. A later
  extension for algorithms tolerating Byzantine (or value) failures~\cite{biely:tolerating}
  adds a second collection of sets $SHO(p,r) \subseteq HO(p,r)$ that contain those
  processes $q$ from which process $p$ receives the message that $q$ was indeed
  supposed to send for round $r$ according to the algorithm. In other words,
  messages from processes in $HO(p,r) \setminus SHO(p,r)$ were corrupted, be it
  due to errors during message transmission or because of the sender was faulty or
  lied deliberately. For both benign and Byzantine errors, the HO model registers
  the fault but does not try to identify the faulty component (i.e., designate the
  sending or receiving process, or the communication channel as the ``culprit'').

  Executions of HO algorithms are defined with respect to collections
  $HO(p,r)$ and $SHO(p,r)$. However, the code of a process does not have
  access to these sets. In particular, process $p$ has no way of determining
  if a message it received from another process $q$ corresponds to what $q$
  should have sent or if it has been corrupted.

  Certain algorithms rely on the assignment of ``coordinator'' processes for
  each round. Just as the collections $HO(p,r)$, the definitions assume an
  external coordinator assignment such that $coord(p,r)$ denotes the coordinator
  of process $p$ and round $r$. Again, the correctness of algorithms may depend
  on hypotheses about coordinator assignments -- e.g., it may be assumed that
  processes agree sufficiently often on who the current coordinator is.

  The following definitions provide a generic representation of HO and SHO algorithms
  in Isabelle/HOL. A (coordinated) HO algorithm is described by the following parameters:
  \begin{itemize}
  \item a finite type @{text 'proc} of processes,
  \item a type @{text 'pst} of local process states,
  \item a type @{text 'msg} of messages sent in the course of the algorithm,
  \item a predicate @{text CinitState} such that @{text "CinitState p st crd"} is
    true precisely of the initial states @{text st} of process @{text p}, assuming
    that @{text crd} is the initial coordinator of @{text p},
  \item a function @{text sendMsg} where @{text "sendMsg r p q st"} yields
    the message that process @{text p} sends to process @{text q} at round
    @{text r}, given its local state @{text st}, and
  \item a predicate @{text CnextState} where @{text "CnextState r p st msgs crd st'"}
    characterizes the successor states @{text st'} of process @{text p} at round
    @{text r}, given current state @{text st}, the vector
    @{text "msgs :: 'proc \<Rightarrow> 'msg option"} of messages that @{text p} received at
    round @{text r} (@{text "msgs q = None"} indicates that no message has been
    received from process @{text q}),
    and process @{text crd} as the coordinator for the following round.
  \end{itemize}
  Note that every process can store the coordinator for the current round in its
  local state, and it is therefore not necessary to make the coordinator a parameter
  of the message sending function @{text sendMsg}.

  We represent an algorithm by a record as follows.
*}

record ('proc, 'pst, 'msg) CHOAlgorithm =
  CinitState ::  "'proc \<Rightarrow> 'pst \<Rightarrow> 'proc \<Rightarrow> bool"
  sendMsg ::   "nat \<Rightarrow> 'proc \<Rightarrow> 'proc \<Rightarrow> 'pst \<Rightarrow> 'msg"
  CnextState :: "nat \<Rightarrow> 'proc \<Rightarrow> 'pst \<Rightarrow> ('proc \<Rightarrow> 'msg option) \<Rightarrow> 'proc \<Rightarrow> 'pst \<Rightarrow> bool"

text {*
  For non-coordinated HO algorithms, the coordinator argument of functions
  @{text CinitState} and @{text CnextState} is irrelevant, and we
  define utility functions that omit that argument.
*}

definition isNCAlgorithm where
  "isNCAlgorithm alg \<equiv>
      (\<forall>p st crd crd'. CinitState alg p st crd = CinitState alg p st crd')
   \<and> (\<forall>r p st msgs crd crd' st'. CnextState alg r p st msgs crd st'
                               = CnextState alg r p st msgs crd' st')"

definition initState where
  "initState alg p st \<equiv> CinitState alg p st undefined"

definition nextState where
  "nextState alg r p st msgs st' \<equiv> CnextState alg r p st msgs undefined st'"

text {*
  A \emph{heard-of assignment} associates a set of processes with each
  process. The following type is used to represent the collections $HO(p,r)$
  and $SHO(p,r)$ for fixed round $r$.
%
  Similarly, a \emph{coordinator assignment} associates a process (its coordinator)
  to each process.
*}

type_synonym
  'proc HO = "'proc \<Rightarrow> 'proc set"

type_synonym
  'proc coord = "'proc \<Rightarrow> 'proc"

text {*
  An execution of an HO algorithm is defined with respect to HO and SHO
  assignments that indicate, for every round @{text r} and every process @{text p},
  from which sender processes @{text p} receives messages (resp., uncorrupted
  messages) at round @{text r}.

%% That's the intention, but we don't enforce this in the definitions.
%  Obviously, SHO sets are always included in HO sets, for the same process and round.

  The following definitions formalize this idea. We define ``coarse-grained''
  executions whose unit of atomicity is the round of execution. At each round,
  the entire collection of processes performs a transition according to the
  @{text CnextState} function of the algorithm. Consequently, a system state is
  simply described by a configuration, i.e. a function assigning a process state
  to every process. This definition of executions may appear surprising for an
  asynchronous distributed system, but it simplifies system verification,
  compared to a ``fine-grained'' execution model that records individual events
  such as message sending and reception or local transitions. We will justify
  later why the ``coarse-grained'' model is sufficient for verifying interesting
  correctness properties of HO algorithms.

  The predicate @{text CSHOinitConfig} describes the possible initial configurations
  for algorithm @{text A} (remember that a configuration is a function that assigns
  local states to every process).
*}

definition CHOinitConfig where
  "CHOinitConfig A cfg (coord::'proc coord) \<equiv> \<forall>p. CinitState A p (cfg p) (coord p)"

text {*
  Given the current configuration @{text cfg} and the HO and SHO sets @{text HOp}
  and @{text SHOp} for process @{text p} at round @{text r}, the function
  @{text SHOmsgVectors} computes the set of possible vectors of messages that
  process @{text p} may receive. For processes @{text "q \<notin> HOp"}, @{text p}
  receives no message (represented as value @{text None}). For processes
  @{text "q \<in> SHOp"}, @{text p} receives the message that @{text q} computed
  according to the @{text sendMsg} function of the algorithm. For the remaining
  processes @{text "q \<in> HOp - SHOp"}, @{text p} may receive some arbitrary value.
*}

definition SHOmsgVectors where
  "SHOmsgVectors A r p cfg HOp SHOp \<equiv>
   {\<mu>. (\<forall>q. q \<in> HOp \<longleftrightarrow> \<mu> q \<noteq> None)
     \<and> (\<forall>q. q \<in> SHOp \<inter> HOp \<longrightarrow> \<mu> q = Some (sendMsg A r q p (cfg q)))}"

text {*
  Predicate @{text CSHOnextConfig} uses the preceding function and the algorithm's
  @{text CnextState} function to characterize the possible successor configurations
  in a coarse-grained step, and predicate @{text CSHORun} defines (coarse-grained)
  executions @{text rho} of an HO algorithm.
*}

definition CSHOnextConfig where
  "CSHOnextConfig A r cfg HO SHO coord cfg' \<equiv>
   \<forall>p. \<exists>\<mu> \<in> SHOmsgVectors A r p cfg (HO p) (SHO p).
          CnextState A r p (cfg p) \<mu> (coord p) (cfg' p)"

definition CSHORun where
  "CSHORun A rho HOs SHOs coords \<equiv>
     CHOinitConfig A (rho 0) (coords 0)
   \<and> (\<forall>r. CSHOnextConfig A r (rho r) (HOs r) (SHOs r) (coords (Suc r))
                             (rho (Suc r)))"

text {*
  For non-coordinated algorithms. the @{text coord} arguments of the above functions
  are irrelevant. We define similar functions that omit that argument, and relate
  them to the above utility functions for these algorithms.
*}

definition HOinitConfig where
  "HOinitConfig A cfg \<equiv> CHOinitConfig A cfg (\<lambda>q. undefined)"

definition SHOnextConfig where
  "SHOnextConfig A r cfg HO SHO cfg' \<equiv>
   CSHOnextConfig A r cfg HO SHO (\<lambda>q. undefined) cfg'"

lemma SHOnextConfig_eq:
  "SHOnextConfig A r cfg HO SHO cfg' =
   (\<forall>p. \<exists>\<mu> \<in> SHOmsgVectors A r p cfg (HO p) (SHO p).
             nextState A r p (cfg p) \<mu> (cfg' p))"
  by (auto simp: SHOnextConfig_def CSHOnextConfig_def SHOmsgVectors_def nextState_def)

definition SHORun where
  "SHORun A rho HOs SHOs \<equiv>
   CSHORun A rho HOs SHOs (\<lambda>r q. undefined)"

lemma SHORun_eq:
  "SHORun A rho HOs SHOs =
     (HOinitConfig A (rho 0)
   \<and> (\<forall>r. SHOnextConfig A r (rho r) (HOs r) (SHOs r) (rho (Suc r))))"
  by (auto simp: SHORun_def CSHORun_def HOinitConfig_def SHOnextConfig_def)

text {*
  Algorithms designed to tolerate benign failures are not subject to
  message corruption, and therefore the SHO sets are irrelevant (more formally,
  each SHO set equals the corresponding HO set). We define corresponding
  special cases of the definitions of successor configurations and of runs,
  and prove that these are equivalent to simpler definitions that will be more
  useful in proofs. In particular, the vector of messages received by a process
  in a benign execution is uniquely determined from the current configuration
  and the HO sets.
*}

definition HOrcvdMsgs where
  "HOrcvdMsgs A r p HO cfg \<equiv>
   \<lambda>q. if q \<in> HO then Some (sendMsg A r q p (cfg q)) else None"

lemma SHOmsgVectors_HO:
  "SHOmsgVectors A r p cfg HO HO = {HOrcvdMsgs A r p HO cfg}"
  unfolding SHOmsgVectors_def HOrcvdMsgs_def by auto

text {* With coordinators *}

definition CHOnextConfig where
  "CHOnextConfig A r cfg HO coord cfg' \<equiv>
   CSHOnextConfig A r cfg HO HO coord cfg'"

lemma CHOnextConfig_eq:
  "CHOnextConfig A r cfg HO coord cfg' =
   (\<forall>p. CnextState A r p (cfg p) (HOrcvdMsgs A r p (HO p) cfg)
                   (coord p) (cfg' p))"
  by (auto simp: CHOnextConfig_def CSHOnextConfig_def SHOmsgVectors_HO)

definition CHORun where
  "CHORun A rho HOs coords \<equiv> CSHORun A rho HOs HOs coords"

lemma CHORun_eq:
  "CHORun A rho HOs coords =
     (CHOinitConfig A (rho 0) (coords 0)
      \<and> (\<forall>r. CHOnextConfig A r (rho r) (HOs r) (coords (Suc r)) (rho (Suc r))))"
  by (auto simp: CHORun_def CSHORun_def CHOinitConfig_def CHOnextConfig_def)

text {* Without coordinators *}
definition HOnextConfig where
  "HOnextConfig A r cfg HO cfg' \<equiv> SHOnextConfig A r cfg HO HO cfg'"

lemma HOnextConfig_eq:
  "HOnextConfig A r cfg HO cfg' =
   (\<forall>p. nextState A r p (cfg p) (HOrcvdMsgs A r p (HO p) cfg) (cfg' p))"
  by (auto simp: HOnextConfig_def SHOnextConfig_eq SHOmsgVectors_HO)

definition HORun where
  "HORun A rho HOs \<equiv> SHORun A rho HOs HOs"

lemma HORun_eq:
  "HORun A rho HOs =
   (  HOinitConfig A (rho 0)
    \<and> (\<forall>r. HOnextConfig A r (rho r) (HOs r) (rho (Suc r))))"
  by (auto simp: HORun_def SHORun_eq HOnextConfig_def)

text {*
  The following derived proof rules are immediate consequences of
  the definition of @{text CHORun}; they simplify automatic reasoning.
*}

lemma CHORun_0:
  assumes "CHORun A rho HOs coords"
      and "\<And>cfg. CHOinitConfig A cfg (coords 0) \<Longrightarrow> P cfg"
  shows "P (rho 0)"
using assms unfolding CHORun_eq by blast

lemma CHORun_Suc:
  assumes "CHORun A rho HOs coords"
  and "\<And>r. CHOnextConfig A r (rho r) (HOs r) (coords (Suc r)) (rho (Suc r))
            \<Longrightarrow> P r"
  shows "P n"
using assms unfolding CHORun_eq by blast

lemma CHORun_induct:
  assumes run: "CHORun A rho HOs coords"
  and init: "CHOinitConfig A (rho 0) (coords 0) \<Longrightarrow> P 0"
  and step: "\<And>r. \<lbrakk> P r; CHOnextConfig A r (rho r) (HOs r) (coords (Suc r))
                                      (rho (Suc r)) \<rbrakk> \<Longrightarrow> P (Suc r)"
  shows "P n"
using run unfolding CHORun_eq by (induct n, auto elim: init step)

text {*
  Because algorithms will not operate for arbitrary HO, SHO, and coordinator
  assignments, these are constrained by a \emph{communication predicate}.
  For convenience, we split this predicate into a \emph{per Round} part that
  is expected to hold at every round and a \emph{global} part that must hold
  of the sequence of (S)HO assignments and may thus express liveness assumptions.

  In the parlance of~\cite{charron:heardof}, a \emph{HO machine} is an HO algorithm
  augmented with a communication predicate. We therefore define (C)(S)HO machines as
  the corresponding extensions of the record defining an HO algorithm.
*}

record ('proc, 'pst, 'msg) HOMachine = "('proc, 'pst, 'msg) CHOAlgorithm" +
  HOcommPerRd::"'proc HO \<Rightarrow> bool"
  HOcommGlobal::"(nat \<Rightarrow> 'proc HO) \<Rightarrow> bool"

record ('proc, 'pst, 'msg) CHOMachine = "('proc, 'pst, 'msg) CHOAlgorithm" +
  CHOcommPerRd::"nat \<Rightarrow> 'proc HO \<Rightarrow> 'proc coord \<Rightarrow> bool"
  CHOcommGlobal::"(nat \<Rightarrow> 'proc HO) \<Rightarrow> (nat \<Rightarrow> 'proc coord) \<Rightarrow> bool"

record ('proc, 'pst, 'msg) SHOMachine = "('proc, 'pst, 'msg) CHOAlgorithm" +
  SHOcommPerRd::"('proc HO) \<Rightarrow> ('proc HO) \<Rightarrow> bool"
  SHOcommGlobal::"(nat \<Rightarrow> 'proc HO) \<Rightarrow> (nat \<Rightarrow> 'proc HO) \<Rightarrow> bool"

record ('proc, 'pst, 'msg) CSHOMachine = "('proc, 'pst, 'msg) CHOAlgorithm" +
  CSHOcommPerRd::"('proc HO) \<Rightarrow> ('proc HO) \<Rightarrow> 'proc coord \<Rightarrow> bool"
  CSHOcommGlobal::"(nat \<Rightarrow> 'proc HO) \<Rightarrow> (nat \<Rightarrow> 'proc HO)
                                     \<Rightarrow> (nat \<Rightarrow> 'proc coord) \<Rightarrow> bool"

end -- {* theory HOModel *}


(*  Title:      HOL/ex/Induction_Schema.thy
    Author:     Alexander Krauss, TU Muenchen
*)

section {* Examples of automatically derived induction rules *}

theory Induction_Schema
imports Main
begin

subsection {* Some simple induction principles on nat *}

lemma nat_standard_induct: (* cf. Nat.thy *)
  "\<lbrakk>P 0; \<And>n. P n \<Longrightarrow> P (Suc n)\<rbrakk> \<Longrightarrow> P x"
by induction_schema (pat_completeness, lexicographic_order)

lemma nat_induct2:
  "\<lbrakk> P 0; P (Suc 0); \<And>k. P k ==> P (Suc k) ==> P (Suc (Suc k)) \<rbrakk>
  \<Longrightarrow> P n"
by induction_schema (pat_completeness, lexicographic_order)

lemma minus_one_induct:
  "\<lbrakk>\<And>n::nat. (n \<noteq> 0 \<Longrightarrow> P (n - 1)) \<Longrightarrow> P n\<rbrakk> \<Longrightarrow> P x"
by induction_schema (pat_completeness, lexicographic_order)

theorem diff_induct: (* cf. Nat.thy *)
  "(!!x. P x 0) ==> (!!y. P 0 (Suc y)) ==>
    (!!x y. P x y ==> P (Suc x) (Suc y)) ==> P m n"
by induction_schema (pat_completeness, lexicographic_order)

lemma list_induct2': (* cf. List.thy *)
  "\<lbrakk> P [] [];
  \<And>x xs. P (x#xs) [];
  \<And>y ys. P [] (y#ys);
   \<And>x xs y ys. P xs ys  \<Longrightarrow> P (x#xs) (y#ys) \<rbrakk>
 \<Longrightarrow> P xs ys"
by induction_schema (pat_completeness, lexicographic_order)

theorem even_odd_induct:
  assumes "R 0"
  assumes "Q 0"
  assumes "\<And>n. Q n \<Longrightarrow> R (Suc n)"
  assumes "\<And>n. R n \<Longrightarrow> Q (Suc n)"
  shows "R n" "Q n"
  using assms
by induction_schema (pat_completeness+, lexicographic_order)

end


(*  Author: Lukas Bulwahn <lukas.bulwahn-at-gmail.com> *)

section \<open>Injections from A to B up to a Permutation of A\<close>

theory Twelvefold_Way_Entry5
imports
  Equiv_Relations_on_Functions
begin

subsection \<open>Definition of Bijections\<close>

definition subset_of :: "'a set \<Rightarrow> ('a  \<Rightarrow> 'b) set \<Rightarrow> 'b set"
where
  "subset_of A F = univ (\<lambda>f. f ` A) F"

definition functions_of :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> 'b) set"
where
  "functions_of A B = {f \<in> A \<rightarrow>\<^sub>E B. f ` A = B}"

subsection \<open>Properties for Bijections\<close>

lemma functions_of_eq:
  assumes "finite A"
  assumes "f \<in> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A}"
  shows "functions_of A (f ` A) = domain_permutation A B `` {f}"
proof
  have bij: "bij_betw f A (f ` A)"
    using assms by (simp add: bij_betw_imageI)
  show "functions_of A (f ` A) \<subseteq> domain_permutation A B `` {f}"
  proof
    fix f'
    assume "f' \<in> functions_of A (f ` A)"
    from this have "f' \<in> A \<rightarrow>\<^sub>E f ` A" and "f' ` A = f ` A"
      unfolding functions_of_def by auto
    from this assms have "f' \<in> A \<rightarrow>\<^sub>E B" and "inj_on f A"
      using PiE_mem by fastforce+
    moreover have "\<exists>p. p permutes A \<and> (\<forall>x\<in>A. f x = f' (p x))"
    proof
      let ?p = "\<lambda>x. if x \<in> A then inv_into A f' (f x) else x"
      show "?p permutes A \<and> (\<forall>x\<in>A. f x = f' (?p x))"
      proof
        show "?p permutes A"
        proof (rule bij_imp_permutes)
          show "bij_betw ?p A A"
          proof (rule bij_betw_imageI)
            show "inj_on ?p A"
            proof (rule inj_onI)
              fix a a'
              assume "a \<in> A" "a' \<in> A" "?p a = ?p a'"
              from this have "inv_into A f' (f a) = inv_into A f' (f a')" by auto
              from this \<open>a \<in> A\<close> \<open>a' \<in> A\<close> \<open>f' ` A = f ` A\<close> have "f a = f a'"
                using inv_into_injective by fastforce
              from this \<open>a \<in> A\<close> \<open>a' \<in> A\<close> show "a = a'"
                by (metis bij bij_betw_inv_into_left)
            qed
          next
            show "?p ` A = A"
            proof
              show "?p ` A \<subseteq> A"
                using \<open>f' ` A = f ` A\<close> by (simp add: image_subsetI inv_into_into)
            next
              show "A \<subseteq> ?p ` A"
              proof
                fix a
                assume "a \<in> A"
                have "inj_on f' A"
                  using \<open>finite A\<close> \<open>f' ` A = f ` A\<close> \<open>inj_on f A\<close>
                  by (simp add: card_image eq_card_imp_inj_on)
                from \<open>a \<in> A\<close> \<open>f' ` A = f ` A\<close> have "inv_into A f (f' a) \<in> A"
                  by (metis image_eqI inv_into_into)
                moreover have "a = inv_into A f' (f (inv_into A f (f' a)))"
                  using \<open>a \<in> A\<close> \<open>f' ` A = f ` A\<close> \<open>inj_on f' A\<close>
                  by (metis f_inv_into_f image_eqI inv_into_f_f)
                ultimately show "a \<in> ?p ` A" by auto
              qed
            qed
          qed
        next
          fix x
          assume "x \<notin> A"
          from this show "?p x = x" by simp
        qed
      next
        from \<open>f' ` A = f ` A\<close> show "\<forall>x\<in>A. f x = f' (?p x)"
          by (simp add: f_inv_into_f)
      qed
    qed
    moreover have "f \<in> A \<rightarrow>\<^sub>E B" using assms by auto
    ultimately show "f' \<in> domain_permutation A B `` {f}"
      unfolding domain_permutation_def by auto
  qed
next
  show "domain_permutation A B `` {f} \<subseteq> functions_of A (f ` A)"
  proof
    fix f'
    assume "f' \<in> domain_permutation A B `` {f}"
    from this obtain p where p: "p permutes A" "\<forall>x\<in>A. f x = f' (p x)"
      and "f \<in> A \<rightarrow>\<^sub>E B" "f' \<in> A \<rightarrow>\<^sub>E B"
      unfolding domain_permutation_def by auto
    have "f' ` A = f ` A"
    proof
      show "f' ` A \<subseteq> f ` A"
      proof
        fix x
        assume "x \<in> f' ` A"
        from this obtain x' where "x = f' x'" and "x' \<in> A" ..
        from this have "x = f (inv p x')"
          using p by (metis (mono_tags, lifting) permutes_in_image permutes_inverses(1))
        moreover have "inv p x' \<in> A"
          using p \<open>x' \<in> A\<close> by (simp add: permutes_in_image permutes_inv)
        ultimately show "x \<in> f ` A" ..
      qed
    next
      show "f ` A \<subseteq> f' ` A"
        using p permutes_in_image by fastforce
    qed
    moreover from this \<open>f' \<in> A \<rightarrow>\<^sub>E B\<close> have "f' \<in> A \<rightarrow>\<^sub>E f ` A" by auto
    ultimately show "f' \<in> functions_of A (f ` A)"
      unfolding functions_of_def by auto
  qed
qed

lemma subset_of:
  assumes "F \<in> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B"
  shows "subset_of A F \<subseteq> B" and "card (subset_of A F) = card A"
proof -
  from assms obtain f where F_eq: "F = (domain_permutation A B) `` {f}"
    and f: "f \<in> A \<rightarrow>\<^sub>E B" "inj_on f A"
    using mem_Collect_eq quotientE by force
  from this have "subset_of A (domain_permutation A B `` {f}) = f ` A"
    using equiv_domain_permutation image_respects_domain_permutation
    unfolding subset_of_def by (intro univ_commute') auto
  from this f F_eq show "subset_of A F \<subseteq> B" and "card (subset_of A F) = card A"
    by (auto simp add: card_image)
qed

lemma functions_of:
  assumes "finite A" "finite B" "X \<subseteq> B" "card X = card A"
  shows "functions_of A X \<in> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B"
proof -
  from assms obtain f where f: "f \<in> A \<rightarrow>\<^sub>E X \<and> bij_betw f A X"
    using \<open>finite A\<close> \<open>finite B\<close> by (metis finite_same_card_bij_on_ext_funcset finite_subset)
  from this have "X = f ` A" by (simp add: bij_betw_def)
  from f \<open>X \<subseteq> B\<close> have "f \<in> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A}"
    by (auto simp add: bij_betw_imp_inj_on)
  have "functions_of A X = domain_permutation A B `` {f}"
    using \<open>finite A\<close> \<open>X = f ` A\<close> \<open>f \<in> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A}\<close>
    by (simp add: functions_of_eq)
  from this show "functions_of A X \<in> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B"
    using \<open>f \<in> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A}\<close> by (auto intro: quotientI)
qed

lemma subset_of_functions_of:
  assumes "finite A" "finite X" "card A = card X"
  shows "subset_of A (functions_of A X) = X"
proof -
  from assms obtain f where "f \<in> A \<rightarrow>\<^sub>E X" and "bij_betw f A X"
    using finite_same_card_bij_on_ext_funcset by blast
  from this have subset_of: "subset_of A (domain_permutation A X `` {f}) = f ` A"
    using equiv_domain_permutation image_respects_domain_permutation
    unfolding subset_of_def by (intro univ_commute') auto
  from \<open>bij_betw f A X\<close> have "inj_on f A" and "f ` A = X"
    by (auto simp add: bij_betw_def)
  have "subset_of A (functions_of A X) = subset_of A (functions_of A (f ` A))"
    using \<open>f ` A = X\<close> by simp
  also have "\<dots> = subset_of A (domain_permutation A X `` {f})"
    using \<open>finite A\<close> \<open>inj_on f A\<close> \<open>f \<in> A \<rightarrow>\<^sub>E X\<close> by (auto simp add: functions_of_eq)
  also have "\<dots> = f ` A"
    using \<open>inj_on f A\<close> \<open>f \<in> A \<rightarrow>\<^sub>E X\<close> by (simp add: subset_of)
  also have "\<dots> = X"
    using \<open>f ` A = X\<close> by simp
  finally show ?thesis .
qed

subsection \<open>Bijections\<close>

lemma bij_betw_subset_of:
  assumes "finite A" "finite B"
  shows "bij_betw (subset_of A) ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B) {X. X \<subseteq> B \<and> card X = card A}"
proof (rule bij_betw_byWitness[where f'="functions_of A"])
  show "\<forall>F\<in>{f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B. functions_of A (subset_of A F) = F"
    using \<open>finite A\<close> functions_of_subset_of by auto
  show "\<forall>X\<in>{X. X \<subseteq> B \<and> card X = card A}. subset_of A (functions_of A X) = X"
    using subset_of_functions_of \<open>finite A\<close> \<open>finite B\<close>
    by (metis (mono_tags) finite_subset mem_Collect_eq)
  show "subset_of A ` ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B) \<subseteq> {X. X \<subseteq> B \<and> card X = card A}"
    using subset_of by fastforce
  show "functions_of A ` {X. X \<subseteq> B \<and> card X = card A} \<subseteq> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B"
    using \<open>finite A\<close> \<open>finite B\<close> functions_of by auto
qed

lemma bij_betw_functions_of:
  assumes "finite A" "finite B"
  shows "bij_betw (functions_of A) {X. X \<subseteq> B \<and> card X = card A} ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B)"
proof (rule bij_betw_byWitness[where f'="subset_of A"])
  show "\<forall>F\<in>{f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B. functions_of A (subset_of A F) = F"
    using \<open>finite A\<close> functions_of_subset_of by auto
  show "\<forall>X\<in>{X. X \<subseteq> B \<and> card X = card A}. subset_of A (functions_of A X) = X"
    using subset_of_functions_of \<open>finite A\<close> \<open>finite B\<close>
    by (metis (mono_tags) finite_subset mem_Collect_eq)
  show "subset_of A ` ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B) \<subseteq> {X. X \<subseteq> B \<and> card X = card A}"
    using subset_of by fastforce
  show "functions_of A ` {X. X \<subseteq> B \<and> card X = card A} \<subseteq> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B"
    using \<open>finite A\<close> \<open>finite B\<close> functions_of by auto
qed

lemma bij_betw_mset_set:
  shows "bij_betw mset_set {A. finite A} {M. \<forall>x. count M x \<le> 1}"
proof (rule bij_betw_byWitness[where f'="set_mset"])
  show "\<forall>A\<in>{A. finite A}. set_mset (mset_set A) = A" by auto
  show "\<forall>M\<in>{M. \<forall>x. count M x \<le> 1}. mset_set (set_mset M) = M"
    by (auto simp add: mset_set_set_mset')
  show "mset_set ` {A. finite A} \<subseteq> {M. \<forall>x. count M x \<le> 1}"
    using nat_le_linear by fastforce
  show "set_mset ` {M. \<forall>x. count M x \<le> 1} \<subseteq> {A. finite A}" by auto
qed

lemma bij_betw_mset_set_card:
  assumes "finite A"
  shows "bij_betw mset_set {X. X \<subseteq> A \<and> card X = k} {M. M \<subseteq># mset_set A \<and> size M = k}"
proof (rule bij_betw_byWitness[where f'="set_mset"])
  show "\<forall>X\<in>{X. X \<subseteq> A \<and> card X = k}. set_mset (mset_set X) = X"
    using \<open>finite A\<close> rev_finite_subset[of A] by auto
  show "\<forall>M\<in>{M. M \<subseteq># mset_set A \<and> size M = k}. mset_set (set_mset M) = M"
    by (auto simp add: mset_set_set_mset)
  show "mset_set ` {X. X \<subseteq> A \<and> card X = k} \<subseteq> {M. M \<subseteq># mset_set A \<and> size M = k}"
    using \<open>finite A\<close> rev_finite_subset[of A]
    by (auto simp add: mset_set_subseteq_mset_set)
  show "set_mset ` {M. M \<subseteq># mset_set A \<and> size M = k} \<subseteq> {X. X \<subseteq> A \<and> card X = k}"
    using assms mset_subset_eqD card_set_mset by fastforce
qed

lemma bij_betw_mset_set_card':
  assumes "finite A"
  shows "bij_betw mset_set {X. X \<subseteq> A \<and> card X = k} {M. set_mset M \<subseteq> A \<and> size M = k \<and> (\<forall>x. count M x \<le> 1)}"
proof (rule bij_betw_byWitness[where f'="set_mset"])
  show "\<forall>X\<in>{X. X \<subseteq> A \<and> card X = k}. set_mset (mset_set X) = X"
    using \<open>finite A\<close> rev_finite_subset[of A] by auto
  show "\<forall>M\<in>{M. set_mset M \<subseteq> A \<and> size M = k \<and> (\<forall>x. count M x \<le> 1)}. mset_set (set_mset M) = M"
    by (auto simp add: mset_set_set_mset')
  show "mset_set ` {X. X \<subseteq> A \<and> card X = k} \<subseteq> {M. set_mset M \<subseteq> A \<and> size M = k \<and> (\<forall>x. count M x \<le> 1)}"
    using \<open>finite A\<close> rev_finite_subset[of A] by (auto simp add: count_mset_set_leq')
  show "set_mset ` {M. set_mset M \<subseteq> A \<and> size M = k \<and> (\<forall>x. count M x \<le> 1)} \<subseteq> {X. X \<subseteq> A \<and> card X = k}"
    by (auto simp add: card_set_mset')
qed

subsection \<open>Cardinality\<close>

lemma card_injective_functions_domain_permutation:
  assumes "finite A" "finite B"
  shows "card ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B) = card B choose card A"
proof -
  have "bij_betw (subset_of A) ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B) {X. X \<subseteq> B \<and> card X = card A}"
    using \<open>finite A\<close> \<open>finite B\<close> by (rule bij_betw_subset_of)
  from this have "card ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // domain_permutation A B) = card {X. X \<subseteq> B \<and> card X = card A}"
    by (rule bij_betw_same_card)
  also have "card {X. X \<subseteq> B \<and> card X = card A} = card B choose card A"
    using \<open>finite B\<close> by (rule n_subsets)
  finally show ?thesis .
qed

lemma card_multiset_only_sets:
  assumes "finite A"
  shows "card {M. M \<subseteq># mset_set A \<and> size M = k} = card A choose k"
proof -
  have "bij_betw mset_set {X. X \<subseteq> A \<and> card X = k} {M. M \<subseteq># mset_set A \<and> size M = k}"
    using \<open>finite A\<close> by (rule bij_betw_mset_set_card)
  from this have "card {M. M \<subseteq># mset_set A \<and> size M = k} = card {X. X \<subseteq> A \<and> card X = k}"
    by (simp add: bij_betw_same_card)
  also have " card {X. X \<subseteq> A \<and> card X = k} = card A choose k"
    using \<open>finite A\<close> by (rule n_subsets)
  finally show ?thesis .
qed

lemma card_multiset_only_sets':
  assumes "finite A"
  shows "card {M. set_mset M \<subseteq> A \<and> size M = k \<and> (\<forall>x. count M x \<le> 1)} = card A choose k"
proof -
  from \<open>finite A\<close> have "{M. set_mset M \<subseteq> A \<and> size M = k \<and> (\<forall>x. count M x \<le> 1)} =
    {M. M \<subseteq># mset_set A \<and> size M = k}"
    using msubset_mset_set_iff by auto
  from this \<open>finite A\<close> card_multiset_only_sets show ?thesis by simp
qed

end


theory Zp_compact
imports padic_int_topology
begin

(**************************************************************************************************)
(**************************************************************************************************)
(*******************************   SEQUENTIAL COMPACTNESS  ****************************************)
(*******************************          OF ZP            ****************************************)
(**************************************************************************************************)
(**************************************************************************************************)

context padic_int_poly
begin

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

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

(*Elimination and introduction lemma for increasing functions*)
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

(*The subsequence predicate*)
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)"

(*Subsequence introduction lemma*)
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

(*Given a sequence and a predicate, returns the function nat\<Rightarrow>nat which represents the increasing
sequences of indices n on which P (s n) holds.*)

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

lemma filtering_func_pre_increasing:
  assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
  shows "filtering_function s P n < filtering_function 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 filtering_func_increasing:
  assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
  shows "is_increasing (filtering_function s P)"
  by (metis assms filtering_func_pre_increasing is_increasingI lift_Suc_mono_less)

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

lemma filter_exist:
  assumes "is_closed_seq s"
  assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
  shows "\<And>m. n\<le>m \<Longrightarrow> P (s (filtering_function 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) filtering_function.simps(2))
qed
(* In a filtered sequence, every element satisfies the given predicate *)

lemma fil_seq_pred:
  assumes "is_closed_seq s"
  assumes "s' = filtered_sequence s P"
  assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
  shows "\<And>m::nat. P (s' m)" sorry
(*proof-
  have "\<exists>k. P (s k)" using assms(3)
    by blast
  fix m
  obtain k where kdef: "k = filtering_function s P m" by auto
  have "\<exists>k. P (s k)"
    using assms(3) by auto
  then have "P (s k)"
    sledgehammer
  then have "s' m = s k"
    by (simp add: assms(2) filtered_sequence_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_sequence_def
      lessI less_Suc_eq_le take_subseq_def sledgehammer

qed*)

definition kth_res_equals :: "nat \<Rightarrow> int \<Rightarrow> (padic_int  \<Rightarrow> bool)" ("Pr _  _") 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)"

(*Every filtering function is the indicator of the sequence that it filters
lemma filtering_function_is_indicator:
  assumes "s' = filtered_sequence s P"
  assumes "is_subseq s s'"
  shows "P = indicator s'"
  sorry*)

(*choice function for a subsequence with constant kth residue. Could be made constructive by
choosing the LEAST n if we wanted.*)
definition equal_res_choice :: "nat \<Rightarrow> padic_int_seq \<Rightarrow> padic_int_seq" ("Cseq _ _") where
"equal_res_choice k s = (SOME s'::(padic_int_seq). (\<exists> n. is_subseq_of s s' \<and> s'
  = (filtered_sequence s (Pr k n)) \<and> (\<forall>m. s' m k = n)))"

(*The constant kth residue value for the sequence obtained by the previous function*)
definition equal_res_choice_res :: "nat \<Rightarrow> padic_int_seq \<Rightarrow> int" ("Cres") where
"equal_res_choice_res k s = (THE n. (\<forall> m. (Cseq k s) m k = n))"

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

definition drop :: "nat \<Rightarrow> (nat \<Rightarrow> int) \<Rightarrow> (nat \<Rightarrow> int)" where
"drop 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:
  assumes "maps_to_n (Suc n) f"
  shows "maps_to_n n (drop (Suc n) f)"
(*proof(rule maps_to_nI)*)
proof-
  fix k
  have "drop (Suc n) f k \<in> {0..n}"
  proof(cases "f k = Suc n")
    case True
    then have "drop (Suc n) f k = 0"
      unfolding drop_def by auto
    then show ?thesis
      using assms local.drop_def maps_to_n_def by auto
  next
    case False
    then show ?thesis
      using assms atLeast0_atMost_Suc maps_to_n_def drop_def
      by auto
  qed
  then have "\<And>k. drop (Suc n) f k \<in> {0..n}"
    using assms local.drop_def maps_to_n_def by auto
    then show "maps_to_n n (drop (Suc n) f)" using maps_to_nI
      using maps_to_n_def by blast
  qed

lemma drop_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 (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 (Suc k) f n"
    using drop_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 f \<Longrightarrow> \<exists>l. \<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 (Suc k) f n"
      using drop_eq_f drop_def
      by fastforce
    have " maps_to_n k (drop (Suc k) f) "
      by (simp add: A maps_to_n_drop)
    then have " \<exists>l. \<forall>m. \<exists>n. m < n \<and> (drop (Suc k) f) n = l"
      using IH by blast
    then obtain l where l_def: "\<forall>m. \<exists>n. m < n \<and> (drop (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 (Suc k) f) n = l"
          using l_def by blast
        have "f n =  (drop (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

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 "is_closed_seq s"
  shows "\<And>m. maps_to_n ((p^k)-1) (index_to_residue s k)"
proof-
  have A1: "\<And>m. (s m) \<in> carrier Z\<^sub>p"
    using assms is_closed_seq_def by auto
  have "\<And>m. (s m k) \<in> {0..(p^k -1)}"
    by (metis A1 le_refl r_Zp r_range)
  have "\<And>m. index_to_residue s k m = s m k" using index_to_residue_def
    using \<open>\<And>m. s m k \<in> {0..int (p ^ k - 1)}\<close> by auto
  thus "\<And>m. maps_to_n ((p^k)-1) (index_to_residue s k)"
    by (metis \<open>\<And>m. s m k \<in> {0..int (p ^ k - 1)}\<close> atLeastAtMost_iff
        maps_to_n_def)
qed

lemma seq_pr_inc:
  assumes "is_closed_seq s"
  shows "\<exists>l. \<forall>m. \<exists>n > m. (Pr k l) (s n)"
proof-
  fix k l m
  have "(Pr k l) (s m) \<Longrightarrow> (s m) k = l"
    by (simp add: kth_res_equals_def)
  have "\<And>k. s m k = index_to_residue s k m"
    by (simp add: index_to_residue_def)
  have A1: "maps_to_n (p^k - 1) (index_to_residue s k)" using seq_maps_to_n assms by blast
  then have "\<And>m. s m k \<in> {0..(p^k - 1)}"
    by (metis index_to_residue_def maps_to_nE)
  have "maps_to_n (p^k - 1) (index_to_residue s k) \<Longrightarrow>  \<exists>l. \<forall>m. \<exists>n. n>m \<and> (index_to_residue s k n = l)"
    by (simp add: maps_to_n_infinite_seq)
  hence "\<exists>l. \<forall>m. \<exists>n. n > m \<and>  (index_to_residue s k n = l)" using A1 by simp
  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. (Pr k l) (s n)"
    using kth_res_equals_def by auto
qed

lemma Pr_subseq:
  assumes "is_closed_seq s"
  shows "\<exists>n. is_subseq_of s (filtered_sequence s (Pr k n)) \<and> (\<forall>m. (filtered_sequence s (Pr k n)) m k = n)"
proof-
  obtain l where l_def: " \<forall> m. \<exists>n > m. (Pr k l) (s n)"
    using assms seq_pr_inc by blast
  have 0: "is_subseq_of s (filtered_sequence s (Pr k l))"
    unfolding filtered_sequence_def
  proof(rule is_subseqI)
    let ?f = "(filtering_function s Pr k  l)"
    show "is_increasing ?f"
      using l_def
      by (simp add: filtering_func_increasing)
    show "take_subseq s (filtering_function s Pr k  l) = take_subseq s (filtering_function s Pr k  l)"
      by auto
  qed
  have 1: " (\<forall>m. (filtered_sequence s (Pr 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 Cseq_prop_0:
  assumes "is_closed_seq s"
  shows "\<exists>l. (((Cseq k s) = filtered_sequence s (Pr k l)) \<and> (is_subseq_of s (Cseq k s)) \<and> (\<forall>m.(Cseq k s) m k = l))"
proof-
  have " \<exists>n. (is_subseq_of s (filtered_sequence s Pr k  n) \<and> (\<forall>m. (filtered_sequence s Pr k  n) m k = n))"
    by (simp add: Pr_subseq assms)
  then have "\<exists>s'. (\<exists>n. (is_subseq_of s s') \<and> (s' = filtered_sequence s Pr k  n) \<and> (\<forall>m. s' m k = n))"
    by blast
  then show ?thesis
  using equal_res_choice_def[of k s]
      by (smt equal_res_choice_def someI_ex)
qed

lemma Cseq_prop_1:
  assumes "is_closed_seq s"
  shows "(\<forall>m.(Cseq k s) m k = (Cres k s) )"
  using Cseq_prop_0[of s] equal_res_choice_res_def[of k s]
  by (smt assms equal_res_choice_def equal_res_choice_res_def the_equality)

lemma Cres_range:
  assumes "is_closed_seq s"
  assumes "k > 0"
  shows "Cres k s \<in> carrier R k"
proof-
  have 0: "is_closed_seq (Cseq k s)"
    by (metis (no_types, hide_lams) Cseq_prop_0 assms(1)
        filtered_sequence_def is_closedI is_closed_simp take_subseq_def)
  have 1: "(Cseq k s) 0 k \<in>  carrier R k"
    using 0  is_closed_seq_def padic_integers_axioms padic_set_simp0
    using padic_int_poly.is_closed_simp padic_int_poly_axioms by auto

  then show  ?thesis
  using assms Cseq_prop_1[of s k]
  by (simp add: \<open>is_closed_seq s\<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) = Cseq (Suc k) (res_seq s k)"

lemma res_seq_res:
  assumes "is_closed_seq s"
  shows "is_closed_seq (res_seq s k)"
  apply(induction k)
  apply (simp add: assms)
  by (smt is_subseq_of_def Cseq_prop_0 is_closed_seq_def
      padic_integers_axioms res_seq.simps(2) take_subseq_def)

lemma res_seq_res':
  assumes "is_closed_seq s"
  shows "\<And>n. res_seq s (Suc k) n (Suc k) = Cres (Suc k) (res_seq s k)"
  using assms res_seq_res[of s k] Cseq_prop_1[of "(res_seq s k)" "Suc k" ]
  by simp

lemma res_seq_subseq:
  assumes "is_closed_seq s"
  shows "is_subseq_of (res_seq s k) (res_seq s (Suc k))"
  by (metis assms  Cseq_prop_0 res_seq_res
      res_seq.simps(2))

(**)
lemma is_increasing_id[simp]:
"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 "is_closed_seq s"
  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 "is_closed_seq s"
  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 "is_closed_seq s"
  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 "is_closed_seq s"
  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 "is_closed_seq s"
  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 "is_closed_seq s"
  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
    by (metis (no_types, hide_lams)  Cseq_prop_1 Zp_is_cring  assms cring_def  is_closed_simp
        monoid.nat_pow_0 monoid.r_one n_def of_nat_0 of_nat_le_0_iff p_pow_factor res_seq.elims
        res_seq_res ring_def)
qed

lemma acc_point_cres:
  assumes "is_closed_seq s"
  shows "(acc_point s (Suc k)) = (Cres (Suc k) (res_seq s k))"
proof-
  have "Suc k > 0" by simp
  have "(res_seq s (Suc k)) = Cseq (Suc k) (res_seq s k)" (*(Cseq k s) m k = (Cres k s) )"*)
    by simp
  then have "(Cseq (Suc k) (res_seq s k)) 0 (Suc k) = Cres (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) = (Cseq (Suc k) (res_seq s k)) 0 (Suc k)"
    by simp
  thus ?thesis
    by (simp add: \<open>(Cseq (Suc k) (res_seq s k)) 0 (Suc k) = Cres (Suc k) (res_seq s k)\<close>)
qed

lemma acc_point_res:
  assumes "is_closed_seq s"
  shows "res (int p ^ k) (acc_point s (Suc k)) = acc_point s k"
proof(cases "k = 0")
  case True
  then show ?thesis
    by (metis Res_0' acc_point_def of_nat_power r_range')
next
  case False
  assume "k \<noteq> 0"  show "res (int p ^ k) (acc_point s (Suc k)) = acc_point s k"
    by (metis False acc_point_def assms is_closed_simp lessI less_imp_le nat.distinct(1)
        of_nat_power res_seq_res_1  r_Zp res_seq_res)
qed

lemma acc_point_closed:
  assumes "is_closed_seq s"
  shows "acc_point s \<in>  carrier Z\<^sub>p"
proof-
  have "acc_point s \<in> padic_set p"
  proof(rule padic_set_mem)
    show "\<And>m. acc_point s m \<in> carrier (residue_ring (int p ^ m))"
    proof-
      fix m
      show "acc_point s m \<in> carrier (residue_ring (int 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) = Cseq (Suc k) (res_seq s k)"*)
          by (simp add: acc_point_def)
        (*then have "res_seq s m 0 m = Cres 0 (Cseq m (res_seq s (m-1)))" sledgehammer*)
        then show ?thesis  using Cres_range[of "(Cseq (m-1) s)" m] acc_point_def[of s m]
          by (metis acc_point_res assms of_nat_power r_range')
      qed
    qed
    show "\<And>m n. m < n \<Longrightarrow> res (int p ^ m) (acc_point s n) = acc_point s m"
    proof-
      fix m n::nat
      assume A: "m < n"
      show "res (int p ^ m) (acc_point s n) = acc_point s m"
      proof-
        obtain l where l_def: "l = n - m - 1"
          by simp
        have "res (int 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
            by (metis acc_point_def add_Suc_right assms is_closed_simp le_add1 nat.distinct(1)
                of_nat_power res_seq_res_1  r_Zp res_seq_res)
        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: Z\<^sub>p_def)
qed

(*Choice function for a subsequence of s which converges to a, if it exists*)
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 "is_closed_seq s"
  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 "is_closed_seq s"
  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 "is_closed_seq s"
  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 "is_closed_seq s"
  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 "is_closed_seq s"
  shows "is_closed_seq (convergent_subseq s)"
  by (simp add: assms convergent_subseq_def take_subseq_def)

lemma convergent_sequence_res:
  assumes "is_closed_seq s"
  assumes "a = acc_point s"
  shows "convergent_subseq s l l = res (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
        by (metis acc_point_def assms(1) assms(2) is_closed_simp of_nat_0 ord_pos zero_below_ord zero_vals)
    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_diff_1)

      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) r_Zp by auto
qed

lemma convergent_subsequence_is_convergent:
  assumes "is_closed_seq s"
  assumes "a = acc_point s"
  shows "converges_to (convergent_subseq s) (acc_point s)" (*\<And>n. \<exists>N. \<forall>k > N. s k n = a n"*)
proof(rule converges_toI)
  show "acc_point s \<in> carrier Z\<^sub>p"
    using acc_point_closed assms  by blast
  show "is_closed_seq (convergent_subseq s)" 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  by (metis (mono_tags, hide_lams) acc_point_def assms convergent_subseq_def is_closed_seq_def of_nat_0 ord_pos take_subseq_def zero_below_ord zero_vals)
    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)"
        by (metis Suc_leI \<open>is_closed_seq (convergent_subseq s)\<close> acc_point_closed assms(1) assms(2) convergent_sequence_res is_closed_simp le_refl r_Zp)
      then show ?case
        using assms(2) by blast
    qed
  qed
qed

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

end
end


theory Subseq
  imports Main Seq2less
begin

(* Here we play with sub-sequences of 2-less sequences. *)

(* Removal of one element from a sequence. *)

(* lt_all: removal of one element (first,last,middle) preserves lt_all. *)

lemma subseq_lt_all_remove_first:
  "lt_all x (h#t) \<longrightarrow> lt_all x t"
  by simp

lemma subseq_lt_all_remove_last:
  "lt_all x (s@[l]) \<longrightarrow> lt_all x s"
  apply (induction s)
  by auto

lemma subseq_lt_all_remove_middle:
  "lt_all x (s@h#t) \<longrightarrow> lt_all x (s@t)"
  apply (induction s)
  by auto

(* lt_2less: removal of one element (first,last,middle) preserves is_2less. *)

lemma subseq_remove_first:
  "is_2less (h#t) \<longrightarrow> is_2less t"
  by auto

lemma subseq_remove_last:
  "is_2less (s@[x]) \<longrightarrow> is_2less s"
  apply (induction s arbitrary: x)
  apply simp
  using subseq_lt_all_remove_last
  by auto

lemma subseq_remove_middle:
  "is_2less (s@x#t) \<longrightarrow> is_2less (s@t)"
  apply (induction s arbitrary: t x)
  using subseq_remove_last
  apply simp
  using subseq_lt_all_remove_middle
  by (metis append_Cons is_2less.simps(2))

(* Removal of a subsequence from a sequence. *)

(* lt_all: removal of subsequence preserves lt_all *)

lemma subseq_lt_all_prefix:
  "lt_all a (s@t) \<longrightarrow> lt_all a s"
  apply (induction s)
  by auto

lemma subseq_lt_all_postfix:
  "lt_all a (s@t) \<longrightarrow> lt_all a t"
  apply (induction s)
  by auto

lemma subseq_lt_all:
  "lt_all a (s@t) \<longrightarrow> lt_all a s \<and> lt_all a t"
  using subseq_lt_all_prefix subseq_lt_all_postfix
  by blast

(* is_2less: removal of subsequence preserves is_2less *)

lemma subseq_postfix:
  "is_2less (s@t) \<longrightarrow> is_2less t"
  apply (induction s arbitrary: t)
  apply simp
  using subseq_remove_first
  by (metis append_Cons)

lemma subseq_prefix:
  "is_2less (s@t) \<longrightarrow> is_2less s"
  apply (induction t arbitrary: s)
  apply simp
  using subseq_remove_last subseq_lt_all_remove_last
  by (metis (no_types, hide_lams) Cons_eq_appendI append_eq_appendI self_append_conv2)

corollary subseq_split_2:
  "is_2less (s@t) \<longrightarrow> is_2less s \<and> is_2less t"
  using subseq_prefix subseq_postfix
  by blast

corollary subseq_split_3:
  "is_2less (p@s@t) \<longrightarrow> is_2less p \<and> is_2less s \<and> is_2less t"
  using subseq_prefix subseq_postfix
  by blast

lemma subseq_infix:
  "is_2less (p@s@t) \<longrightarrow> is_2less (p@t)"
  apply (induction s)
  apply simp
  using subseq_remove_middle
  by auto

end