(*<*)(*:maxLineLen=68:*)
section \<open>Lazy Streams\<close>

theory Stream
imports inc.LNat inc.SetPcpo
begin

section \<open>The Datatype of Lazy Streams\<close>

default_sort countable

(* deletes the Rule "1 = Suc 0" *)
 declare One_nat_def[simp del]

(* declare [[show_types]] *)
text \<open>\<open>discr u\<close> lifts an arbitrary type \<open>'a\<close> to the
  discrete \<open>pcpo\<close> and the usual rest operator \<open>rt\<close> on streams.\<close>
(*>*)
section\<open>Streams\<close> text\<open>\label{sec:stream}\<close>

text\<open>The verification framework focus is based on the streams of
messages and stream processing functions. This section will shortly
introduce the implementation of streams in Isabelle and mention and
explain a few important functions and their properties. Some of
these will play a major role in the definition of \glspl{sb} and
others will be used to ease the verification process of components.
For an in depth explanation I refer to \cite{Stu16}.\<close>

text\<open>The stream domain in Isabelle is defined with the \<open>domain\<close>
command provided by the \<open>HOLCF\<close> package. This automatically
instantiates our type as a \gls{pcpo}.\<close>

domain
  'a stream = lscons (lshd::"'a discr u") (lazy srt::"'a stream")
                                        (infixr "&&" 65)

text\<open>The message type is lifted to a discrete \gls{cpo} to generate
the same prefix order from FOCUS streams.\<close>

subsection\<open>Function over streams\<close> text\<open>\label{subsec:sfun}\<close>

text\<open> The following table gives an overview about the main functions
defined for @{type stream}s. Some of them are introduced in detail
for their later usage in the Isabelle framework.\<close>

(*<*)

(* ----------------------------------------------------------------------- *)
section \<open>Signatures of Stream Processing Functions\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Continuous function from stream to stream and shortcut
for input and output of the same type:\<close>
type_synonym ('in, 'out) spf = "('in stream \<rightarrow> 'out stream)"
type_synonym 'm spfo      = "('m, 'm) spf"

text \<open>Same for general SPFs which are not continuous by definition:\<close>
type_synonym ('in, 'out) gspf = "('in stream \<Rightarrow> 'out stream)"
type_synonym 'm gspfo      = "('m, 'm) gspf"

text \<open>Again for list processing functions:\<close>
type_synonym ('in, 'out) lpf = "('in list \<Rightarrow> 'out list)"
type_synonym 'm lpfo      = "('m, 'm) lpf"

(* ----------------------------------------------------------------------- *)
subsection \<open>Some abbreviations\<close>
(* ----------------------------------------------------------------------- *)

text \<open>The empty stream is denoted as \<open>\<epsilon>\<close>.\<close>
abbreviation
  sbot ::  "'a stream"  ("\<epsilon>")
    where "sbot \<equiv> \<bottom>"

text \<open>@{term stake}: This operator is generated by the \<open>domain\<close>
  command. It retrieves the first \<open>n\<close> elements of a stream
  (or less, if the stream is shorter).\<close>
abbreviation
  stake :: "nat \<Rightarrow> 'a spfo"
    where "stake \<equiv> stream_take"

(* ----------------------------------------------------------------------- *)
section \<open>Common functions on streams\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Conversion of function with lifted values to a partial function:\<close>
definition fup2map :: "('a \<Rightarrow> 'b::cpo u) \<Rightarrow> ('a \<rightharpoonup> 'b)" where
"fup2map f a \<equiv> if (f a = \<bottom>) then None else Some (SOME x. up\<cdot>x = f a)"

text \<open>@{term sup'}: Construct a stream by a single element.\<close>
definition sup'       :: "'a \<Rightarrow> 'a stream" ("\<up>_" [1000] 999) where
"sup' a \<equiv> updis a && \<epsilon>"

text \<open>@{term sconc}: Concatenate two streams over the same type.
  For infinite streams, arbitrary other streams can be appended
  without changing the stream.\<close>
definition sconc      :: "'a stream \<Rightarrow> 'a spfo" where
"sconc \<equiv> fix\<cdot>(\<Lambda> h. (\<lambda> s1. \<Lambda> s2.
                      if s1 = \<epsilon> then s2 else  (lshd\<cdot>s1) && (h (srt\<cdot>s1)\<cdot>s2)))"

abbreviation sconc_abbr :: "'a stream \<Rightarrow> 'a stream \<Rightarrow> 'a stream" ("(_ \<bullet> _)" [66,65] 65)
where "s1 \<bullet> s2 \<equiv> sconc s1\<cdot>s2"

text \<open>@{term shd}: Retrieve the first element of a stream.
  For \<open>\<epsilon>\<close>, the result is not defined.\<close>
definition shd        :: "'a stream \<Rightarrow> 'a" where
"shd s \<equiv> THE a. lshd\<cdot>s = updis a"

text \<open>@{term slookahd}: Apply function to head of stream.
  If the stream is empty, \<open>\<bottom>\<close> is returned.
  This function is especially useful for defining own stream-processing
  functions.\<close>
definition slookahd   :: "'a stream \<rightarrow> ('a \<Rightarrow> 'b) \<rightarrow> ('b::pcpo)" where
"slookahd \<equiv> \<Lambda> s f. if s = \<epsilon> then \<bottom> else f (shd s)"

(* ----------------------------------------------------------------------- *)
subsection \<open>Conversion of lists to streams and induced order on lists\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Lists can be converted to streams by the function @{term list2s}:\<close>

primrec list2s :: "'a list \<Rightarrow> 'a stream"
where
  list2s_0:   "list2s [] = \<epsilon>" |
  list2s_Suc: "list2s (a#as) = updis a && (list2s as)"

abbreviation stream_abbrev :: "'a list \<Rightarrow> 'a stream" ("<_>" [1000] 999)
where "<l> == list2s l"

text \<open>The data type \<open>list\<close> is a partial order with the operator
  \<open>\<sqsubseteq>\<close> derived from streams:\<close>
instantiation list :: (countable) po
begin

  definition sq_le_list:
    "s \<sqsubseteq> t \<equiv> (list2s s \<sqsubseteq> list2s t)"

  (* list2s is a bijection *)
  lemma list2s_inj[simp]: "(list2s l = list2s l') = (l = l')"
  apply (rule iffI)
  apply (simp add: atomize_imp)
  apply (rule_tac x="l'" in spec)
  apply (induct l, simp)
  apply (rule allI)
  apply (induct_tac x, simp+)
  apply (rule allI)
  by (induct_tac x, simp+)

instance
apply (intro_classes)
apply (simp add: sq_le_list)+
apply (rule_tac y="list2s y" in below_trans,assumption+)
apply (simp add: sq_le_list)
apply (rule list2s_inj [THEN iffD1])
by (rule po_eq_conv [THEN iffD2],rule conjI,assumption+)

end

(* ----------------------------------------------------------------------- *)
text \<open>Typical functions known from lists:\<close>
(* ----------------------------------------------------------------------- *)
(*>*)

subsubsection\<open>Length of Streams\<close>

text \<open>@{term slen}: Retrieve the length of a stream. It is defined
as the number of its elements or \<open>\<infinity>\<close> for infinite streams.\<close>

definition slen:: "'a stream \<rightarrow> lnat" where
"slen \<equiv> fix\<cdot>(\<Lambda> h. strictify\<cdot>(\<Lambda> s. lnsuc\<cdot>(h\<cdot>(srt\<cdot>s))))"

text\<open>Resulting from the prefix order, a few key properties can be
formulated using the length. One of these is an equality property:
If two streams are in an order and have the same length, there are
equal. Abbreviation \<open>#\<close> is used for obtaining the length of a
stream.\<close>

abbreviation slen_abbr :: "'a stream \<Rightarrow> lnat" ("#_" [1000] 999)
where "#s == slen\<cdot>s"

(*<*)

text \<open>@{term sdrop}: Remove the first \<open>n\<close> elements
  of the stream.\<close>
definition sdrop      :: "nat \<Rightarrow> 'a spfo" where
"sdrop n \<equiv> Fix.iterate n\<cdot>srt"

(*>*)
subsubsection\<open>Stream elements\<close>

text\<open>The element of a stream at position \<open>n\<close> can be accessed by
dropping the first \<open>n\<close> elements of the stream. We start counting
positions at 0.\<close>

definition snth :: "nat \<Rightarrow> 'a stream \<Rightarrow> 'a" where
"snth k s \<equiv> shd (sdrop k\<cdot>s)"

text\<open>Obtaining the elements of a stream with @{const snth} is often
used in the verification process of components behaviour.\<close>

(*<*)
text\<open>@{term sfoot}: Get the last element of a not empty, finite stream\<close>
definition sfoot      :: "'a stream \<Rightarrow> 'a" where
"sfoot s = snth (THE a. lnsuc\<cdot>(Fin a) = #s) s"
(*>*)

subsubsection\<open>A Streams Values\<close>

text \<open>The values of a stream are a set of messages of type \<open>'a\<close> that
occur at any position in the stream.\<close>

definition sValues :: "'a stream \<rightarrow> 'a set" where
"sValues \<equiv> \<Lambda> s. {snth n s | n. Fin n < #s}"

text\<open>The definition of @{const sValues} is straight forward with the
usage of @{const snth}.\<close>

(*<*)
text \<open>@{term sntimes}: Repeat the given stream \<open>n\<close> times.\<close>
text \<open>(Only listed as a constant below for reference;
  Use \<open>sntimes\<close> with same signature instead).\<close>
(* consts sntimes_    :: "nat \<Rightarrow> 'a stream \<Rightarrow> 'a stream" *)

text \<open>@{term sinftimes}: Concatenate a stream infinitely often to itself.\<close>
definition sinftimes  :: "'a stream \<Rightarrow> 'a stream" ("_\<^sup>\<infinity>") where
 "sinftimes \<equiv> fix\<cdot>(\<Lambda> h. (\<lambda>s.
                        if s = \<epsilon> then \<epsilon> else (s \<bullet> (h s))))"
(*>*)
subsubsection\<open>Applying functions element wise\<close>

text \<open>Similar to @{const map} on lists we can define a mapping that
applies a function to each element of a stream. The \<open>n\<close>th element of
the output stream is equal to applying the mapping function to the
\<open>n\<close>th element of the input stream.\<close>

definition smap:: "('a \<Rightarrow> 'b) \<Rightarrow> 'a stream \<rightarrow> 'b stream" where
"smap f \<equiv> fix\<cdot>(\<Lambda> h s. slookahd\<cdot>s\<cdot>(\<lambda> a.
                       \<up>(f a) \<bullet> (h\<cdot>(srt\<cdot>s))))"

text\<open>An automatons semantic can sometimes be represented by a
@{const smap} mapping.\<close>

(*<*)
text \<open>@{term sfilter}: Remove all elements from the stream which are
  not included in the given set.\<close>
definition sfilter    :: "'a set \<Rightarrow> 'a spfo" where
"sfilter M \<equiv> fix\<cdot>(\<Lambda> h s. slookahd\<cdot>s\<cdot>(\<lambda> a.
                          (if (a \<in> M) then \<up>a \<bullet> (h\<cdot>(srt\<cdot>s)) else h\<cdot>(srt\<cdot>s))))"

text \<open>@{term stakewhile}: Take the first elements of a stream as
  long as the given function evaluates to \<open>true\<close>.\<close>
definition stakewhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a spfo" where
"stakewhile f \<equiv> fix\<cdot>(\<Lambda> h s. slookahd\<cdot>s\<cdot>(\<lambda> a. if (f a) then \<up>a \<bullet> h\<cdot>(srt\<cdot>s) else \<epsilon>))"

text \<open>@{term sdropwhile}: Drop the first elements of a stream as
  long as the given function evaluates to \<open>true\<close>.\<close>
definition sdropwhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a spfo" where
"sdropwhile f \<equiv> fix\<cdot>(\<Lambda> h s. slookahd\<cdot>s\<cdot>(\<lambda> a.
                          if (f a) then h\<cdot>(srt\<cdot>s) else s))"

text \<open>Two streams can be combined into one stream by using tuples as elements.\<close>

text \<open>@{term szip}: Zip two streams into one stream.\<close>
definition szip       :: "'a stream \<rightarrow> 'b stream \<rightarrow> ('a \<times> 'b) stream" where
 "szip \<equiv> fix\<cdot>(\<Lambda> h s1 s2. slookahd\<cdot>s1\<cdot>(\<lambda> a. slookahd\<cdot>s2\<cdot>(\<lambda> b.
                     \<up>(a,b) \<bullet> (h\<cdot>(srt\<cdot>s1)\<cdot>(srt\<cdot>s2)))))"

text\<open>Takes a function and 2 streams, merges the 2 streams according to the function\<close>
definition merge:: "('a  \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a stream \<rightarrow> 'b stream \<rightarrow> 'c stream" where
"merge f \<equiv> \<Lambda> s1 s2 . smap (\<lambda> s3. f (fst s3) (snd s3))\<cdot>(szip\<cdot>s1\<cdot>s2)"

text \<open>@{term sprojfst}: Access the first stream of two zipped streams.\<close>
definition sprojfst   :: "(('a \<times> 'b),'a) spf" where
"sprojfst \<equiv> \<Lambda> x. smap fst\<cdot>x"

text \<open>@{term sprojsnd}: Access the second stream of two zipped streams.\<close>
definition sprojsnd   :: "(('a \<times> 'b),'b) spf" where
"sprojsnd \<equiv> \<Lambda> x. smap snd\<cdot>x"

text \<open>The following two functions are "delayed" variants
  of @{term stakewhile} and @{term sdropwhile}.\<close>

text \<open>@{term stwbl}: Take while predicate holds but also keep
  first element violating condition.\<close>
definition stwbl      :: "('a \<Rightarrow> bool) \<Rightarrow> 'a spfo" where
"stwbl f \<equiv> fix\<cdot>(\<Lambda> h s. slookahd\<cdot>s\<cdot>(\<lambda> a.
                          if (f a) then \<up>a \<bullet>  h\<cdot>(srt\<cdot>s) else \<up>a))"

text \<open>@{term srtdw}: Rest (\<open>srt\<close>) of stream after dropwhile.\<close>
definition srtdw      :: "('a \<Rightarrow> bool) \<Rightarrow> 'a spfo" where
"srtdw f \<equiv> \<Lambda> x. srt\<cdot>(sdropwhile f\<cdot>x)"

text \<open>@{term srcdups}: Remove successive duplicate values from stream.\<close>
definition srcdups    :: "'a spfo" where
"srcdups \<equiv> fix\<cdot>(\<Lambda> h s. slookahd\<cdot>s\<cdot>(\<lambda> a.
                        \<up>a \<bullet>  h\<cdot>(sdropwhile (\<lambda> z. z = a)\<cdot>(srt\<cdot>s))))"

(* Takes a nat indicating the number of elements to scan, a reducing
 function, an initial initial element, and an input stream. Returns
a stream consisting of the partial reductions of the input stream.*)
primrec SSCANL::
"nat \<Rightarrow> ('o \<Rightarrow> 'i \<Rightarrow> 'o) \<Rightarrow> 'o \<Rightarrow> 'i stream \<Rightarrow> 'o stream" where
  SSCANL_zero_def: "SSCANL 0 f q s = \<epsilon>" |
  "SSCANL (Suc n) f q s = (if s=\<epsilon> then \<epsilon>
                           else \<up>(f q (shd s)) \<bullet>
                                (SSCANL n f (f q (shd s)) (srt\<cdot>s)))"

text \<open>@{term sscanl}: Apply a function elementwise to the input
stream. Behaves like \<open>map\<close>, but also takes the previously generated
output element as additional input to the function. For the first
computation, an initial value is provided.\<close>
definition sscanl :: "('o \<Rightarrow> 'i \<Rightarrow> 'o) \<Rightarrow> 'o \<Rightarrow> ('i, 'o) spf" where
"sscanl f q \<equiv> \<Lambda> s. \<Squnion>i. SSCANL i f q s"
(*>*)

(*<*)
(* scanline Advanced :D  *)
(* or stateful ... *)
(* The user has more control. Instead of the last output ('b) a
state ('s) is used as next input *)
definition sscanlA ::
 "('s \<Rightarrow>'a \<Rightarrow> ('b \<times>'s)) \<Rightarrow> 's  \<Rightarrow> 'a stream \<rightarrow> 'b stream" where
"sscanlA f s0 \<equiv> \<Lambda> s. sprojfst\<cdot>(sscanl (\<lambda>(_,b). f b) (undefined, s0)\<cdot>s)"
(*>*)
subsubsection\<open>Applying state-based functions element wise\<close>

text\<open>One can also apply a state dependent function, like the
transition function of a deterministic automaton, to process the
streams elements. The \<open>n+1\<close>th output element then depends on the
\<open>n\<close>th ouput state, because the state based function may act
differently depending on its state. Hence, we also need an initial
state to start computing the output.\<close>

definition sscanlAg ::
"('s \<Rightarrow>'a \<Rightarrow> ('s \<times>'b)) \<Rightarrow> 's \<Rightarrow> 'a stream \<rightarrow> ('s\<times>'b) stream" where
"sscanlAg f s0 \<equiv> \<Lambda> s. (sscanl (\<lambda>(b,_). f b) (s0, undefined)\<cdot>s)"

text\<open>We first defined the general state-based @{const sscanlAg}.
The definition calls @{const sscanl} internally, @{const sscanl}
computes the output of each element depending on the input and the
output of the last element. Likewise, it needs an initial output
element it starts with. The general state-based function however
only needs the previous output state, not the whole output.\<close>

text\<open>Since the semantic of an deterministic automaton does not
return its states in each step but behaves similar in other cases,
we define another state-based function, that calls @{const sscanlAg}
but reduces its output to the message output stream. Hence, the
state stream is omitted.\<close>

definition %invisible sscanlAfst ::
"('s \<Rightarrow>'a \<Rightarrow> ('s\<times>'b)) \<Rightarrow> 's \<Rightarrow> 'a stream \<rightarrow> 's stream" where
"sscanlAfst f s0 \<equiv> \<Lambda> s. sprojfst\<cdot>(sscanlAg f s0\<cdot>s)"

definition sscanlAsnd ::
"('s \<Rightarrow>'a \<Rightarrow> ('s \<times>'b)) \<Rightarrow> 's  \<Rightarrow> 'a stream \<rightarrow> 'b stream" where
"sscanlAsnd f s0 \<equiv> \<Lambda> s. sprojsnd\<cdot>(sscanlAg f s0\<cdot>s)"

text\<open>A deterministic automatons semantic can then be represented by
a @{const sscanlAsnd} mapping.\<close>
(*<*)
(*
definition sscanlAg :: "('s \<Rightarrow>'a::countable \<Rightarrow> ('s::countable \<times>'b::countable)) \<Rightarrow>'s   \<Rightarrow> 'a stream \<rightarrow> ('s\<times>'b) stream" where
"sscanlAg f s0 \<equiv> \<Lambda> s. (sscanl (\<lambda>(b,_). f b) (s0, undefined)\<cdot>s)"

definition sscanlAsnd :: "('s \<Rightarrow>'a::countable \<Rightarrow> ('s::countable \<times>'b::countable)) \<Rightarrow> 's  \<Rightarrow> 'a stream \<rightarrow> 'b stream" where
"sscanlAsnd f s0 \<equiv> \<Lambda> s. sprojsnd\<cdot>(sscanlAg f s0\<cdot>s)"

definition sscanlAfst :: "('s \<Rightarrow>'a::countable \<Rightarrow> ('s::countable \<times>'b::countable)) \<Rightarrow>'s  \<Rightarrow> 'a stream \<rightarrow> 's stream" where
"sscanlAfst f s0 \<equiv> \<Lambda> s. sprojfst\<cdot>(sscanlAg f s0\<cdot>s)"
*)
text \<open>@{term siterate}: Create a stream by repeated application of
  a function to an element. The generated stream starts with \<open>a\<close>,
  \<open>f(a)\<close>, \<open>f(f(a))\<close>, and so on.\<close>
definition siterate   :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a stream" where
"siterate f (a::'a) \<equiv> \<up>a \<bullet> sscanl (\<lambda>a (b::'a). f a) a\<cdot>(SOME x. #x = \<infinity>)"

text \<open>Alternative definition similar to @{term siterate},
it is more general than @{term siterate}\<close>
definition siterateBlock:: "('a stream \<Rightarrow> 'a stream) \<Rightarrow> 'a stream \<Rightarrow> 'a stream" where
"siterateBlock f \<equiv> fix \<cdot> (\<Lambda> h. (\<lambda>s. s \<bullet> (h (f s))))"

(* ----------------------------------------------------------------------- *)
text \<open>Conversion between lists and streams and the processing functions:\<close>
(* ----------------------------------------------------------------------- *)

text \<open>@{term list2s}: Convert a list to a (finite) stream.\<close>
text \<open>(Only listed as a constant below for reference;
  Use \<open>list2s\<close> with same signature instead).\<close>
(* consts list2s_   :: "'a list \<Rightarrow> 'a stream" *)

text \<open>@{term s2list}: Convert a stream to a list. Result for
  infinite streams is undefined.\<close>
definition s2list     :: "'a stream \<Rightarrow> 'a list" where
"s2list s \<equiv> if #s \<noteq> \<infinity> then SOME l. list2s l = s else undefined"

text \<open>@{term slpf2spf}: Convert a list-processing function to a
  stream-processing function.\<close>
definition slpf2spf   ::"('in,'out) lpf \<Rightarrow> ('in,'out) spf" where
"slpf2spf f \<equiv>
    if monofun f
      then \<Lambda> s. (\<Squnion>k. list2s (f (s2list (stake k\<cdot>s))))
      else undefined"

text \<open>@{term sislivespf}: Liveness predicate for SPFs. A SPF
  is considered live if all finite inputs are mapped to finite outputs.\<close>
definition sislivespf ::"('in,'out) spf \<Rightarrow> bool" where
"sislivespf f \<equiv> (\<forall>x. #(f\<cdot>x) = \<infinity> \<longrightarrow> #x = \<infinity>)"

text \<open>@{term sspf2lpf}: Convert a stream-processing function
  to a list-processing function.\<close>
definition sspf2lpf   ::"('in,'out) spf \<Rightarrow> ('in,'out) lpf" where
"sspf2lpf f \<equiv>  if sislivespf f then (\<lambda>x. s2list (f\<cdot>(list2s x))) else undefined"

(* ----------------------------------------------------------------------- *)
subsection \<open>Syntactic sugar and helpers\<close>
(* ----------------------------------------------------------------------- *)

text \<open>The following abbreviations define infix and prefix operators
  for a more intuitive usage.\<close>

abbreviation sfilter_abbr :: "'a set \<Rightarrow> 'a stream \<Rightarrow> 'a stream" ("(_ \<ominus> _)" [66,65] 65)
where "F \<ominus> s \<equiv> sfilter F\<cdot>s"

(* ----------------------------------------------------------------------- *)
subsection \<open>Definition of stream manipulating functions\<close>
(* ----------------------------------------------------------------------- *)

text \<open>In this section, the definitions for the previously
  declared functions are given.\<close>

text \<open>A typical procedure is to define a primary recursive function
  first and then define the stream-processing via the least upper
  bound of the function values for the prefixes of a stream.\<close>

(* concatenates a stream to itself n times *)
primrec sntimes :: "nat \<Rightarrow> 'a stream \<Rightarrow> 'a stream" where
  "sntimes 0 s = \<epsilon>" |
  "sntimes (Suc n) s = (sconc s)\<cdot>(sntimes n s)"

(* Abbreviation for sntimes *)
abbreviation sntimes_abbr :: "nat \<Rightarrow> 'a stream \<Rightarrow> 'a stream" ("_\<star>_" [60,80] 90)
where "(n \<star> s)  == (sntimes n s)"

text \<open>In most cases, stream-processing functions or operators
  on streams are defined using the continuous fixed point operator.\<close>

(* ----------------------------------------------------------------------- *)
section \<open>Stream - basics\<close>
(* --------------------------------------\<Squnion>--------------------------------- *)

text \<open>In the following, lemmas on streams and their operators
  are proven. In most cases, the stated lemma is shortly summarized
  in natural language. Where this is not the case, the lemma
  itself is mostly self-explanatory.\<close>

(* ----------------------------------------------------------------------- *)
subsection \<open>Fundamental properties of @{term stake}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Some aliases of auto-generated lemmas are introduced:\<close>
lemmas scases' = stream.exhaust
lemmas sinjects' = stream.injects
lemmas sinverts' = stream.inverts

text \<open>Each stream is the least upper bound of its prefixes.
  As we we are in a CPO, upper bounds of chains always exist.\<close>
lemma reach_stream: "(\<Squnion>i. stake i\<cdot>s) = s"
apply (rule stream.take_lemma [OF spec [where x=s]])
apply (induct_tac n, simp, rule allI)
apply (rule_tac y=x in scases', simp)
apply (subst lub_range_shift [where j="Suc 0", THEN sym],simp+)
by (subst contlub_cfun_arg [THEN sym], auto)

(* if two streams xs and ys are identical for any prefix that is a multiple of y long, then the two
   streams are identical for any prefix *)
lemma gstake2stake: assumes "\<forall>i. stake (i*y)\<cdot>xs = stake (i*y)\<cdot>ys" and "y\<noteq>0"
  shows "\<forall>i. stake i\<cdot>xs = stake i\<cdot>ys"
proof
  fix i
  obtain k where "\<exists>l. k = y*l" and "k\<ge>i" by (metis One_nat_def Suc_le_eq assms(2) gr0I mult.commute mult_le_mono2 nat_mult_1_right)
  thus "stake i\<cdot>xs = stake i\<cdot>ys" by (metis assms(1) min_def mult.commute stream.take_take)
qed

(* stake is monotone *)
lemma stake_mono: assumes "i\<le>j"
  shows "stake i\<cdot>s \<sqsubseteq> stake j\<cdot>s"
by (metis assms min_def stream.take_below stream.take_take)

(* ----------------------------------------------------------------------- *)
subsection \<open>Construction by concatenation and more\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Basic properties of \<open>\<up>_\<close> constructor\<close>

(* shd composed with \<up> is the identity. *)

lemma [simp]: "<[a]> = \<up>a"
  by(simp add: sup'_def)

(* the singleton stream is never equal to the empty stream *)
lemma [simp]: "\<up>a \<noteq> \<epsilon>"
by (simp add: sup'_def)

(* the rest of the singleton stream is empty *)
lemma [simp]: "srt\<cdot>(\<up>a) = \<epsilon>"
by (simp add: sup'_def)

text \<open> Basic properties of concatenation \<close>
lemma reduce_seq: (*never simp*)
  assumes "s1 = s2"
  shows "s \<bullet> s1 = s \<bullet> s2"
  by (simp add: assms)

(* the empty stream is the identity element with respect to concatenation *)
lemma sconc_fst_empty[simp]:"\<epsilon> \<bullet> s = s"
apply (subst sconc_def [THEN fix_eq2])
by (simp add: cont2cont_LAM)

(* the lazy stream constructor and concatenation are associative *)
lemma sconc_scons': "(updis a && as) \<bullet> s = updis a && (as \<bullet> s)"
apply (subst sconc_def [THEN fix_eq2])
by (simp add: cont2cont_LAM)

(* the lazy stream constructor is equivalent to concatenation with a singleton stream *)
lemma lscons_conv: "updis a && s = \<up>a \<bullet> s"
apply (subst sconc_def [THEN fix_eq2])
apply (simp add:  sup'_def)
by (simp add: cont2cont_LAM)

(* concatenation with respect to singleton streams is associative *)
lemma sconc_scons[simp]: "(\<up>a \<bullet> as) \<bullet> s = \<up>a \<bullet> (as \<bullet> s)"
apply (subst sconc_def [THEN fix_eq2])
by (simp add: sconc_scons' sup'_def cont2cont_LAM)

text \<open>If a predicate P holds for empty and non-empty streams, it holds for all streams\<close>
lemma scases [case_names bottom scons]: "\<And>x P. \<lbrakk>x = \<epsilon> \<Longrightarrow> P; \<And>a s. x = \<up>a \<bullet> s \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
apply (rule_tac y=x in scases', simp+)
apply (rule_tac p=u in upE, simp+)
apply (case_tac "xa")
by (auto simp add: sup'_def sconc_scons')

(* Single element streams commute with the stake operation. *)
lemma stake_Suc[simp]: "stake (Suc n)\<cdot>(\<up>a \<bullet> as) = \<up>a \<bullet> stake n\<cdot>as"
by (simp add: sconc_scons' sup'_def)

(* see also sconc_fst_empty *)
lemma sconc_snd_empty[simp]: "s \<bullet> \<epsilon> = s"
apply (rule stream.take_lemma [OF spec [where x = "s"]])
apply (induct_tac n, simp)
apply (rule allI, simp)
by (rule_tac x=x in scases, simp+)

(* shd is the inverse of prepending a singleton *)
lemma shd1[simp]: "shd (\<up>a \<bullet> s) = a"
by (simp add: sconc_scons' shd_def sup'_def)

(* prepending an element a to a stream and extracting it with lshd is equivalent to imposing the
   discrete order on a *)
lemma lshd_updis [simp]: "lshd\<cdot>(\<up>a \<bullet> s) = updis a"
by (metis lscons_conv stream.sel_rews(4))

(* srt is the inverse of appending to a singleton *)
lemma [simp]: "srt\<cdot>(\<up>a\<bullet>as) = as"
by (simp add: sconc_scons' sup'_def)

(* appending to a singleton is monotone *)
lemma [simp]: "\<up>a \<sqsubseteq> \<up>a \<bullet> s"
apply (subst sconc_snd_empty [of "\<up>a", THEN sym])
by (rule monofun_cfun_arg, simp)

text \<open>Properties of discrete partial orders\<close>

(* updis is a bijection *)
lemma updis_eq: "(updis a = updis b) = (a = b)"
by simp

(* the discrete order only considers equal elements to be ordered *)
lemma updis_eq2: "(updis a \<sqsubseteq> updis b) = (a = b)"
by simp

text \<open>Mapping a stream to head and rest is injective\<close>
lemma inject_scons: "\<up>a \<bullet> s1 = \<up>b \<bullet> s2 \<Longrightarrow> a = b \<and> s1 = s2"
apply (subst updis_eq [THEN sym])
apply (rule sinjects' [THEN iffD1], simp)
by (simp add: sconc_scons' sup'_def)

text \<open>\<open>\<sqsubseteq>\<close> applied to head and rest\<close>
lemma less_all_sconsD: "\<up>a \<bullet> as \<sqsubseteq> \<up>b \<bullet> bs \<Longrightarrow> a = b \<and> as \<sqsubseteq> bs"
apply (subst updis_eq2 [THEN sym])
apply (rule sinverts' [THEN iffD1], simp)
by (simp add: sconc_scons' sup'_def)

(* appending to a singleton stream can never yield the empty stream *)
lemma [simp]: "\<epsilon> \<noteq> \<up>a \<bullet> as"
apply (rule ccontr, simp)
apply (drule po_eq_conv [THEN iffD1])
apply (erule conjE)
by (simp add: sconc_scons' sup'_def)

(* appending to a singleton stream can never yield the empty stream *)
lemma [simp]: "\<up>a \<bullet> as \<noteq> \<epsilon>"
by (rule notI, drule sym, simp)

text \<open>Characterizations of equality with \<open>\<sqsubseteq>\<close>, head and rest\<close>

(* singleton streams are only in an ordered relation if the two elements are equal *)
lemma [simp]: "(\<up>a \<sqsubseteq> \<up>b) = (a = b)"
apply (rule iffI)
by (insert less_all_sconsD [of a \<epsilon> b \<epsilon>], simp+)

(* length of a stream is smaller than length of this stream concatenated with another stream  *)
lemma [simp]: "#as \<sqsubseteq> #(as \<bullet> ys)"
  by (metis minimal monofun_cfun_arg sconc_snd_empty)

(* uparrow is a bijection *)
lemma [simp]: "(\<up>a = \<up>b) = (a = b)"
apply (rule iffI)
by (insert inject_scons [of a \<epsilon> b \<epsilon>], simp+)

(* appending a stream x to a singleton stream and producing another singleton stream implies that
   the two singleton streams are equal and x was empty *)
lemma [simp]: "(\<up>a \<bullet> x = \<up>c) = (a = c \<and> x = \<epsilon>)"
by (rule iffI, insert inject_scons [of a x c \<epsilon>], simp+)

(* of course we can also swap the expressions to the left and right of the equality sign *)
lemma [simp]: "(\<up>c = \<up>a \<bullet> x) = (a = c \<and> x = \<epsilon>)"
by (rule iffI, insert inject_scons [of c \<epsilon> a x], simp+)

(* if an appended stream x to a singleton stream is in relation with another singleton stream, this implies that
   a and b are equal and x was empty *)
lemma [simp]: "(\<up>a \<bullet> x \<sqsubseteq> \<up>b) = (a = b \<and> x = \<epsilon>)"
by (rule iffI, insert less_all_sconsD [of a x b \<epsilon>], simp+)

(* if a singleton stream is the prefix of another stream then the heads of the two streams must match *)
lemma [simp]: "(\<up>a \<sqsubseteq> \<up>b \<bullet> x) = (a = b)"
by (rule iffI, insert less_all_sconsD [of a \<epsilon> b x], simp+)

(* if x isn't empty then concatenating head and rest leaves the stream unchanged *)
lemma surj_scons: "x\<noteq>\<epsilon> \<Longrightarrow> \<up>(shd x) \<bullet> (srt\<cdot>x) = x"
by (rule_tac x=x in scases, simp+)

(* the head of ordered streams are equal *)
lemma below_shd: "x \<sqsubseteq> y \<and> x \<noteq> \<epsilon> \<Longrightarrow> shd x = shd y"
  by (metis below_bottom_iff less_all_sconsD surj_scons)

(* the head of ordered streams are equal *)
lemma below_shd_alt: "x \<sqsubseteq> y \<and> x \<noteq> \<epsilon> \<Longrightarrow> shd y = shd x"
  using below_shd by fastforce

text \<open>Characterizations of \<open>\<sqsubseteq>\<close> with head and rest\<close>

(* any nonempty prefix of a stream y is still a prefix when ignoring the first element *)
lemma less_fst_sconsD: "\<up>a \<bullet> as \<sqsubseteq> y \<Longrightarrow> \<exists>ry. y = \<up>a \<bullet> ry \<and> as \<sqsubseteq> ry"
apply (rule_tac x=y in scases, simp+)
apply (rule_tac x="s" in exI)
by (drule less_all_sconsD, simp)

(* the prefix of any non-empty stream is either empty or shares the same first element *)
lemma less_snd_sconsD:
  "x \<sqsubseteq> \<up>a\<bullet>as \<Longrightarrow> (x = \<epsilon>) \<or> (\<exists>rx. x = \<up>a\<bullet>rx \<and> rx \<sqsubseteq> as)"
apply (rule_tac x=x in scases, simp+)
apply (rule_tac x="s" in exI)
by (drule less_all_sconsD, simp)

(* semantically equivalent to less_fst_sconsD *)
lemma lessD:
  "x \<sqsubseteq> y \<Longrightarrow> (x = \<epsilon>) \<or> (\<exists>a q w. x = \<up>a\<bullet>q \<and> y = \<up>a\<bullet>w \<and> q \<sqsubseteq> w)"
apply (rule_tac x=x in scases, simp+)
apply (rule_tac x="a" in exI)
apply (rule_tac x="s" in exI, simp)
by (drule less_fst_sconsD, simp)

(* if ts is a prefix of xs and ts is not bottom, then lshd\<cdot>ts is equal to lshd\<cdot>xs *)
lemma lshd_eq: "ts\<sqsubseteq>xs \<Longrightarrow> ts\<noteq>\<bottom> \<Longrightarrow> lshd\<cdot>ts = lshd\<cdot>xs"
  using lessD by fastforce

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term slen}\<close>
(* ----------------------------------------------------------------------- *)

(* the length of the empty stream is zero *)
lemma strict_slen[simp]:"#\<epsilon> = 0"
by (subst slen_def [THEN fix_eq2], simp add: lnzero_def)

(* prepending a singleton stream increases the length by 1 *)
lemma slen_scons[simp]: "#(\<up>a\<bullet>as) = lnsuc\<cdot>(#as)"
by (subst slen_def [THEN fix_eq2], simp add: lnle_def)

(* the singleton stream has length 1 *)
lemma [simp]: "#(\<up>a) = Fin (Suc 0)"
apply (subst sconc_snd_empty [of "\<up>a", THEN sym])
by (subst slen_scons, simp+)

text \<open>The rest of infinite streams is infinite as well\<close>
lemma inf_scase:"#s = \<infinity> \<Longrightarrow> \<exists>a as. s = \<up>a \<bullet> as \<and> #as = \<infinity>"
by (rule_tac x=s in scases, auto)

(* only the empty stream has length 0 *)
lemma slen_empty_eq[simp]: "(#x = 0) = (x = \<epsilon>)"
by (rule_tac x=x in scases, auto)

text \<open>Appending to an inifite stream does not change its \<open>n\<close>th element\<close>
lemma sconc_fst_inf_lemma: "\<forall>x. #x=\<infinity> \<longrightarrow> stake n\<cdot>(x\<bullet>y) = stake n\<cdot>x"
apply (induct_tac n, auto)
by (rule_tac x=x in scases, auto)

text \<open>Appending to an infinite stream does not change the stream\<close>
lemma sconc_fst_inf[simp]: "#x=\<infinity> \<Longrightarrow> x\<bullet>y = x"
apply (rule stream.take_lemma)
by (rule sconc_fst_inf_lemma [rule_format])

text \<open>For finite streams, their lengths are added on concatenation\<close>
lemma slen_sconc_all_finite:
  "\<forall>x y n. #x = Fin k \<and> #y = Fin n \<longrightarrow> #(x\<bullet>y) = Fin (k+n)"
apply (induct_tac k, auto)
by (rule_tac x=x in scases, auto)

text \<open>Streams with infinite prefixes are infinite\<close>
lemma mono_fst_infD: "\<lbrakk>#x = \<infinity>; x \<sqsubseteq> y\<rbrakk> \<Longrightarrow> #y = \<infinity> "
apply (drule monofun_cfun_arg [of _ _ slen])
by (rule lnat_po_eq_conv [THEN iffD1], simp)

text \<open>For @{term "s \<sqsubseteq> t"} with @{term s} and @{term t} of
  equal length, all finite prefixes are identical\<close>
lemma stake_eq_slen_eq_and_less:
  "\<forall>s t. #s = #t \<and> s \<sqsubseteq> t \<longrightarrow> stake n\<cdot>s = stake n\<cdot>t"
apply (induct_tac n, auto)
apply (rule_tac x=s in scases, auto)
apply (rule_tac x=t in scases, auto)
by (drule less_all_sconsD, auto)

text \<open>For @{term "s \<sqsubseteq> t"} with @{term s} and @{term t} of
  equal length, @{term s} and @{term t} are identical\<close>
lemma eq_slen_eq_and_less: "\<lbrakk>#s = #t; s \<sqsubseteq> t\<rbrakk> \<Longrightarrow> s = t"
apply (rule stream.take_lemma)
by (rule stake_eq_slen_eq_and_less [rule_format], rule conjI)

text \<open>Infinite prefixes are equal to the original stream\<close>
lemma eq_less_and_fst_inf: "\<lbrakk>s1 \<sqsubseteq> s2; #s1 = \<infinity>\<rbrakk> \<Longrightarrow> s1 = s2"
apply (rule eq_slen_eq_and_less, simp)
apply (rule sym)
by (rule mono_fst_infD [of "s1" "s2"])

(*
lemma s1: "chain S \<Longrightarrow> \<not> finite_chain S \<Longrightarrow> \<forall>i. \<exists>j\<ge>i. S i \<sqsubseteq> S j"
by auto

lemma "chain S \<Longrightarrow> \<not> finite_chain S \<Longrightarrow> \<exists>k. #(S k) = \<infinity>"
apply (simp add: finite_chain_def max_in_chain_def )
apply (subgoal_tac "chain S \<Longrightarrow> \<not> finite_chain S \<Longrightarrow> \<forall>i. \<exists>j\<ge>i. S i \<sqsubseteq> S j")
prefer 2
apply (simp add: s1, simp)
*)

(* if Fin n is smaller than the length of as, then Fin n is also smaller than lnsuc\<cdot>(#as) *)
lemma [simp]: "Fin n < #as \<Longrightarrow> Fin n < lnsuc\<cdot>(#as)"
  by (smt below_antisym below_trans less_lnsuc lnle_def lnless_def)

text \<open>For infinite streams, \<open>stake n\<close> returns \<open>n\<close> elements\<close>
lemma slen_stake_fst_inf[rule_format]:
  "\<forall>x. #x = \<infinity> \<longrightarrow> #(stake n\<cdot>x) = Fin n"
apply (induct_tac n, auto)
by (rule_tac x=x in scases, auto)

(* mapping a stream to its length is a monotone function *)
lemma mono_slen: "x \<sqsubseteq> y \<Longrightarrow> #x \<le> #y"
by (drule_tac x = x and y = y and f = slen
  in monofun_cfun_arg, simp)

text \<open>A stream is shorter than \<open>n+1\<close> iff its rest is shorter than \<open>n\<close>\<close>
lemma slen_rt_ile_eq: "(#x \<le> Fin (Suc n)) = (#(srt\<cdot>x) \<le> Fin n)"
by (rule_tac x=x in scases, auto)

text \<open>If \<open>#x < #y\<close>, this also applies to the streams' rests (for nonempty, finite x)\<close>
lemma smono_slen_rt_lemma:
  "#x = Fin k \<and> x \<noteq> \<epsilon> \<and> #x < #y \<longrightarrow> #(srt\<cdot>x) < #(srt\<cdot>y)"
apply (induct_tac k, auto)
apply (rule_tac x=x in scases, auto)
by (rule_tac x=y in scases, auto)

text \<open>If \<open>#x < #y\<close>, this also applies to the streams' rests (for finite x)\<close>
lemma smono_slen_rt: "\<lbrakk>x \<noteq> \<epsilon>; #x < #y\<rbrakk> \<Longrightarrow> #(srt\<cdot>x) < #(srt\<cdot>y)"
apply (rule_tac x="#x" in lncases, auto)
by (rule smono_slen_rt_lemma [rule_format], simp)

text \<open>Infinite elements of a stream chain are equal to the LUB\<close>
lemma inf2max: "\<lbrakk>chain Y; #(Y k) = \<infinity>\<rbrakk> \<Longrightarrow> Y k = (\<Squnion>i. Y i)"
apply (subgoal_tac "Y k \<sqsubseteq> (\<Squnion>i. Y i)")
apply (drule eq_less_and_fst_inf, assumption+)
by (rule is_ub_thelub)

text \<open>\<open>stake n\<close> returns at most \<open>n\<close> elements\<close>
lemma ub_slen_stake[simp]: "#(stake n\<cdot>x) \<le> Fin n"
apply (rule spec [where x = x])
apply (induct_tac n, auto)
by (rule_tac x=x in scases, auto)

text \<open>\<open>stake\<close> always returns finite streams\<close>
lemma [simp]: "#(stake n\<cdot>x) \<noteq> \<infinity>"
proof (rule notI)
  assume inf: "#(stake n\<cdot>x) = \<infinity>"
  have "#(stake n\<cdot>x) \<le> Fin n" by (rule ub_slen_stake)
  thus False using inf by simp
qed

text \<open>\<open>stake\<close>ing at least \<open>#x\<close> elements returns \<open>x\<close> again\<close>
lemma fin2stake_lemma: "\<forall>x k. #x = Fin k \<and> k\<le>i \<longrightarrow> stake i\<cdot>x = x"
apply (induct_tac i, auto)
apply (rule_tac x=x in scases, auto)
by (case_tac "k", auto)

text \<open>\<open>stake\<close>ing \<open>#x\<close> elements returns \<open>x\<close> again\<close>
lemma fin2stake:"#x = Fin n \<Longrightarrow> stake n\<cdot>x = x"
  by (rule fin2stake_lemma [rule_format, of "x" "n" "n"], simp)

text \<open>\<open>stake\<close>ing only on element from an empty stream is the same as the stream consisting of
      \<open>shd\<close> of the stream\<close>
lemma stake2shd:"s\<noteq>\<epsilon> \<Longrightarrow> stake (Suc 0)\<cdot>s = \<up>(shd s)"
  by(rule scases[of s],simp_all add: Nat.One_nat_def)

lemma stake2shd2:"s\<noteq>\<epsilon> \<Longrightarrow> stake 1\<cdot>s = \<up>(shd s)"
  by(simp add: Nat.One_nat_def stake2shd)

(* if the stream is not empty, it holds that its length is lnsuc\<cdot>(#(srt\<cdot>s)) *)
lemma srt_decrements_length : "s \<noteq> \<epsilon> \<Longrightarrow> #s = lnsuc\<cdot>(#(srt\<cdot>s))" by (metis slen_scons surj_scons)

(* the empty stream is the shortest *)
lemma empty_is_shortest : "Fin n < #s \<Longrightarrow> s \<noteq> \<epsilon>" by (metis Fin_0 less_le lnle_Fin_0 strict_slen)

(* if Fin (Suc n) is smaller than length of s, then also Fin n is smaller than length of s *)
lemma convert_inductive_asm : "Fin (Suc n) < #s \<Longrightarrow> Fin n < #s" by (metis Fin_leq_Suc_leq less_le not_le)

(* only the empty stream has length zero *)
lemma only_empty_has_length_0 : "#s \<noteq> 0 \<Longrightarrow> s \<noteq> \<epsilon>" by simp

(* ----------------------------------------------------------------------- *)
section \<open>Basic induction rules\<close>
(* ----------------------------------------------------------------------- *)

text \<open>induction for all prefixes\<close>
lemma stakeind:
  "\<forall>x. (P \<epsilon> \<and> (\<forall>a s. P s \<longrightarrow> P (\<up>a \<bullet> s))) \<longrightarrow> P (stake n\<cdot>x)"
by (induct_tac n, auto, rule_tac x=x in scases, auto)

text \<open>induction for finite streams\<close>
lemma finind:
  "\<lbrakk>#x = Fin n; P \<epsilon>; \<And>a s. P s \<Longrightarrow> P (\<up>a \<bullet> s)\<rbrakk> \<Longrightarrow> P x"
apply (drule fin2stake)
apply (drule sym, erule ssubst)
apply (rule stakeind [rule_format])
apply (rule conjI, assumption)
apply (rule allI)+
by (rule impI, simp)

text \<open>induction for infinite streams and admissable predicates\<close>
lemma ind:
  "\<lbrakk>adm P; P \<epsilon>; \<And>a s. P s  \<Longrightarrow> P (\<up>a \<bullet> s)\<rbrakk> \<Longrightarrow> P x"
apply (unfold adm_def)
apply (erule_tac x="\<lambda>i. stake i\<cdot>x" in allE, auto)
apply (simp add: stakeind)
by (simp add: reach_stream)

lemma finind2: "#s = Fin k \<Longrightarrow> P \<epsilon> \<Longrightarrow> (\<And>t a. #t < \<infinity> \<Longrightarrow> P t \<Longrightarrow> P (\<up>a \<bullet> t)) \<Longrightarrow> P s"
proof -
  assume "#s = Fin k" and "P \<epsilon>" and "\<And>t a. #t < \<infinity> \<Longrightarrow> P t \<Longrightarrow> P (\<up>a \<bullet> t)"
  then show "P s"
  proof (induction k arbitrary: s)
    case 0
    then show ?case
      by auto
  next
    case (Suc k)
    then obtain a t where "s = \<up>a \<bullet> t" and "#t = Fin k"
      by (metis Fin_Suc bot_is_0 lnat.con_rews lnat.sel_rews(2) slen_empty_eq srt_decrements_length surj_scons)
    then show ?case
      by (simp add: Suc.IH Suc.prems(2) Suc.prems(3))
  qed
qed

lemma finind3: "#s < \<infinity> \<Longrightarrow> P \<epsilon> \<Longrightarrow> (\<And>t a. #t < \<infinity> \<Longrightarrow> P t \<Longrightarrow> P (\<up>a \<bullet> t)) \<Longrightarrow> P s"
  by (metis finind2 less_le ninf2Fin)

(* ----------------------------------------------------------------------- *)
subsection \<open>Other properties of @{term stake}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>composition of \<open>stake\<close>\<close>
lemma stakeostake[simp]: "stake k\<cdot>(stake n\<cdot>x) = stake (min k n)\<cdot>x"
apply (rule_tac x="n" in spec)
apply (rule_tac x="k" in spec)
apply (rule ind [of _ x], simp+)
apply (rule allI)+
apply (case_tac "xa", simp+)
by (case_tac "x", simp+)

(* stake always returns a prefix of the input stream *)
lemma ub_stake[simp]: "stake n\<cdot>x \<sqsubseteq> x"
by (rule stream.take_below)

(* definition of stake *)
lemma stake_suc: "stake (Suc n)\<cdot>s = (stake 1\<cdot>s) \<bullet> stake n\<cdot>(srt\<cdot>s)"
by (metis (no_types, lifting) One_nat_def Rep_cfun_strict1 sconc_snd_empty stake_Suc stream.sel_rews(2) stream.take_0 stream.take_strict surj_scons)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sdrop}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>basic properties of @{term sdrop}\<close>

(* dropping n\<cdot>\<epsilon> is the empty stream *)
lemma strict_sdrop[simp]: "sdrop n\<cdot>\<epsilon> = \<epsilon>"
by (simp add: sdrop_def, induct_tac n, auto)

(* dropping 0\<cdot>s returns s *)
lemma sdrop_0[simp]: "sdrop 0\<cdot>s = s"
by (simp add: sdrop_def)

(* dropping an additional element is equivalent to calling srt *)
lemma sdrop_back_rt: "sdrop (Suc n)\<cdot>s = srt\<cdot>(sdrop n\<cdot>s)"
by (simp add: sdrop_def)

(* dropping an additional element is equivalent to sdrop with srt as part of the stream *)
lemma sdrop_forw_rt: "sdrop (Suc n)\<cdot>s = sdrop n\<cdot>(srt\<cdot>s)"
apply (simp add: sdrop_def)
by (subst iterate_Suc2 [THEN sym], simp)

(* dropping n + 1 elements from a non-empty stream is equivalent to dropping n items from the rest *)
lemma sdrop_scons[simp]: "sdrop (Suc n)\<cdot>(\<up>a \<bullet> as) = sdrop n\<cdot>as"
by (simp add: sdrop_forw_rt)

(* if dropping n items produces the empty stream then the stream contains n elements or less *)
lemma sdrop_stakel1: "\<forall>s. sdrop n\<cdot>s = \<epsilon> \<longrightarrow> stake n\<cdot>s = s"
apply (induct_tac n, auto)
by (rule_tac x=s in scases, auto)

(* dropping k+x elements is equivalent to dropping x elements first and then k elements *)
lemma sdrop_plus: "sdrop (k+x)\<cdot>xs = sdrop k\<cdot>(sdrop x\<cdot>xs)"
by (simp add: iterate_iterate sdrop_def)

text \<open>Dropping from infinite streams still returns infinite streams\<close>
lemma fair_sdrop[rule_format]:
  "\<forall>x. #x = \<infinity> \<longrightarrow> #(sdrop n\<cdot>x) = \<infinity>"
apply (induct_tac n, simp, clarify)
by (rule_tac x=x in scases, auto)

text \<open>streams can be split by @{term stake} and @{term sdrop}\<close>
lemma split_streaml1[simp]:
  "stake n\<cdot>s \<bullet> sdrop n\<cdot>s = s"
apply (rule spec [where x = s])
apply (induct_tac n, auto)
by (rule_tac x=x in scases, auto)

text \<open>@{term sdrop} may only create infinite outputs for infinite inputs\<close>
lemma fair_sdrop_rev:
  "#(sdrop k\<cdot>x) = \<infinity> \<Longrightarrow> #x = \<infinity>"
apply (simp add: atomize_imp)
apply (rule_tac x="x" in spec)
apply (induct_tac k, simp)
apply (rule allI, rule impI)
apply (rule_tac x="x" in scases, simp)
by (erule_tac x="s" in allE, simp)

text \<open>construct @{term "sdrop j"} from @{term "sdrop k"} (with @{term "j \<le> k"})\<close>
lemma sdropl5:
  "j \<le> k \<Longrightarrow> sdrop j\<cdot>(stake k\<cdot>x) \<bullet> sdrop k\<cdot>x = sdrop j\<cdot>x"
apply (simp add: atomize_imp)
apply (rule_tac x="j" in spec)
apply (rule_tac x="x" in spec)
apply (induct_tac k, auto)
apply (rule_tac x="x" in scases, auto)
by (case_tac "xa", auto)

text \<open>Dropping as inverse of prepending a finite stream\<close>
lemma sdropl6:
  "#x = Fin k \<Longrightarrow> sdrop k\<cdot>(x \<bullet> y) = y"
apply (simp add: atomize_imp)
apply (rule_tac x="x" in spec)
apply (rule_tac x="y" in spec)
apply (induct_tac k, auto)
by (rule_tac x="xa" in scases, auto)

(* relation between srt and drop *)
lemma srt_drop : "srt\<cdot>(sdrop n\<cdot>s) = sdrop (Suc n)\<cdot>s" by (simp add: sdrop_back_rt)

(* sdrop n\<cdot>s should not result in the empty stream *)
lemma drop_not_all : "Fin n < #s \<Longrightarrow> sdrop n\<cdot>s \<noteq> \<epsilon>"
proof (induct n)
  show "Fin 0 < #s \<Longrightarrow> sdrop 0\<cdot>s \<noteq> \<epsilon>" by auto

  have "\<And> n. Fin n < #s \<Longrightarrow> #(sdrop n\<cdot>s) = lnsuc\<cdot>(#(srt\<cdot>(sdrop n\<cdot>s)))" by (metis not_le sdrop_stakel1 srt_decrements_length ub_slen_stake)
  hence "\<And> n. Fin n < #s \<Longrightarrow> sdrop n\<cdot>s \<noteq> \<epsilon>" using only_empty_has_length_0 by fastforce
  thus "\<And> n. (Fin n < #s \<Longrightarrow> sdrop n\<cdot>s \<noteq> \<epsilon>) \<Longrightarrow> Fin (Suc n) < #s \<Longrightarrow> sdrop (Suc n)\<cdot>s \<noteq> \<epsilon>" by simp
qed

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term snth}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Basic properties of @{term snth}\<close>

(* the element k + 1 of the stream s is identical to the element k of the rest of s *)
lemma snth_rt: "snth (Suc k) s = snth k (srt\<cdot>s)"
apply (simp add: snth_def)
by (subst sdrop_forw_rt,rule refl)

(* semantically equivalent to snth_rt *)
lemma snth_scons[simp]: "snth (Suc k) (\<up>a \<bullet> s) = snth k s"
by (simp add: snth_rt)

(* indexing starts at 0, so the 0'th element is equal to the head *)
lemma snth_shd[simp]: "snth 0 s = shd s"
by (simp add: snth_def)

text \<open>If two streams of same length agree on every element,
  all their finite prefixes are equal\<close>
lemma snths_eq_lemma [rule_format]:
  "\<forall>x y. #x = #y \<and> (\<forall>n. Fin n < #x \<longrightarrow> snth n x = snth n y)
           \<longrightarrow> stake k\<cdot>x = stake k\<cdot>y"
apply (induct_tac k, auto)
apply (rule_tac x=x in scases, auto)
apply (rule_tac x=y in scases, auto)
apply (erule_tac x="s" in allE)
apply (erule_tac x="sa" in allE, auto)
apply (erule_tac x="Suc na" in allE, simp)
by (erule_tac x="0" in allE, auto)

text \<open>If two streams of same length agree on every element, they are equal\<close>
lemma snths_eq:
  "\<lbrakk>#x = #y; \<forall>n. Fin n < #x \<longrightarrow> snth n x = snth n y\<rbrakk> \<Longrightarrow> x = y"
apply (rule stream.take_lemma)
by (rule snths_eq_lemma, auto)

(* easy to use rule to show equality on infinite streams *)
(* if two finite streams x, s are identical at every position then x and s are identical *)
lemma sinf_snt2eq: assumes "#s=\<infinity>" and "#x=\<infinity>" and "\<And>i. (snth i s = snth i x)"
  shows "s=x"
by (simp add: assms snths_eq)

lemma snthp_shd: assumes"\<And>n.  P(snth n s)"
  shows"P(shd s)"
  by (metis assms snth_shd)

lemma snthp_shd2:  assumes"\<And>n.  P(snth n (\<up>m \<bullet> s))"
  shows"P(m)"
  by (metis assms shd1 snth_shd)

lemma snthp_snth: assumes"\<And>n.  P(snth n (\<up>m \<bullet> s))"
      shows"P(snth n(s))"
  by (metis assms snth_scons)

lemma snthp_srt:  assumes"\<And>n. P(snth n (s))"
      shows"P(snth n(srt\<cdot>s))"
  by (metis assms snth_rt)
(* ----------------------------------------------------------------------- *)
section \<open>Further lemmas\<close>
(* ----------------------------------------------------------------------- *)

(* concatenation is associative *)
lemma assoc_sconc[simp]: "(s1\<bullet>s2)\<bullet>s3 = s1\<bullet>s2\<bullet>s3"
apply (rule_tac x="#s1" in lncases, auto)
by (rule finind [of "s1"], auto)

(* 2 very specific lemmas, used in \<open>stake_add\<close> *)
  lemma stake_conc: "stake i\<cdot>s \<bullet> x = stake (Suc i)\<cdot>s \<Longrightarrow> x = stake 1\<cdot>(sdrop i\<cdot>s)"
  apply (induction i arbitrary: s)
  apply (simp add: One_nat_def)
  by (smt assoc_sconc inject_scons sdrop_forw_rt stake_Suc stream.take_strict strict_sdrop surj_scons)

  lemma stake_concat:"stake i\<cdot>s \<bullet> stake (Suc j)\<cdot>(sdrop i\<cdot>s) = stake (Suc i)\<cdot>s \<bullet> stake j\<cdot>(sdrop (Suc i)\<cdot>s)"
  proof -
    obtain x where x_def: "stake i\<cdot>s \<bullet> x = stake (Suc i)\<cdot>s"
      by (metis (no_types, hide_lams) Suc_n_not_le_n linear min_def split_streaml1 stream.take_take)
    thus ?thesis
      by (smt One_nat_def Rep_cfun_strict1 assoc_sconc sconc_snd_empty sdrop_back_rt stake_Suc stake_conc stream.take_0 stream.take_strict strict_sdrop surj_scons)
  qed

(* for arbitrary natural numbers i, j and any streams s the following lemma holds: *)
lemma stake_add: "stake (i+j)\<cdot>s = (stake i\<cdot>s) \<bullet> (stake j\<cdot>(sdrop i\<cdot>s))"
apply (induction i arbitrary: j)
apply simp
by (metis add_Suc_shift stake_concat)

text \<open>Finite, equal streams agree on all postfixes\<close>
lemma inject_sconc: "\<lbrakk>#x = Fin k; x \<bullet> y = x \<bullet> z\<rbrakk> \<Longrightarrow> y = z"
apply (simp add: atomize_imp)
apply (rule_tac x=x in spec)
apply (induct_tac k, auto)
apply (rule_tac x=x in scases, auto)
by (drule inject_scons, auto)

lemma sconc_inj: assumes "#s < \<infinity>"
  shows "inj (Rep_cfun (sconc s))"
  by (meson assms injI inject_sconc lnat_well_h2)

(* x is a prefix of x \<bullet> y*)
lemma sconc_prefix [simp]: "x \<sqsubseteq> x \<bullet> y"
apply (rule_tac x="#x" in lncases, auto)
apply (rule finind [of x], auto)
by (rule monofun_cfun_arg)

text \<open>Prepending to infinite streams produces infinite streams again\<close>
lemma slen_sconc_snd_inf: "#y=\<infinity> \<Longrightarrow> #(x \<bullet> y) = \<infinity>"
apply (rule_tac x="#x" in lncases, auto)
by (rule finind [of "x"], auto)

(* stake n results in a stream of length n, so sdrop n then results in the empty stream *)
lemma sdropostake: "sdrop n\<cdot>(stake n\<cdot>s) = \<epsilon>"
apply (rule spec [where x = n])
apply (rule ind [of _ s], auto)
by (case_tac x, auto)

(* for all x it holds that if (P \<epsilon> \<and> (\<forall>a s. P s \<longrightarrow> P (s \<bullet> \<up>a))) then it follows that P applied to stake n\<cdot>x is true *)
lemma stakeind2:
  "\<forall>x. (P \<epsilon> \<and> (\<forall>a s. P s \<longrightarrow> P (s \<bullet> \<up>a))) \<longrightarrow> P (stake n\<cdot>x)"
  apply(induction n)
   apply simp
  apply auto
  apply (subst stake_suc)
  by (metis (no_types, lifting) sconc_snd_empty sdrop_back_rt sdropostake split_streaml1 stake_suc surj_scons)

(* if P is admissible and P holds for the empty stream and \<And>a s. P s implies P (s \<bullet> \<up>a) then P also holds for x *)
lemma ind2: assumes "adm P" and "P \<epsilon>"  and "\<And>a s. P s  \<Longrightarrow> P (s \<bullet> \<up>a)"
  shows "P x"
by (metis assms(1) assms(2) assms(3) stakeind2 stream.take_induct)

(* if P holds for bottom and it holds that lscons: "(\<And>x xs. x\<noteq>\<bottom>\<Longrightarrow>P xs \<Longrightarrow> P (x&&xs))" and the length of xs is finite, then P holds also for xs *)
lemma stream_fin_induct: assumes Bot: "P \<bottom>" and lscons: "(\<And>x xs. x\<noteq>\<bottom>\<Longrightarrow>P xs \<Longrightarrow> P (x&&xs))" and fin: "#xs<\<infinity>"
  shows "P xs"
  by (metis finind infI lnless_def sconc_fst_empty sconc_scons' sup'_def up_defined assms)

(* if length of s is finite => P holds for s => P is admissible => P holds for s *)
lemma stream_infs: "(\<And>s. #s<\<infinity> \<Longrightarrow> P s) \<Longrightarrow> adm P \<Longrightarrow> P s"
  by (metis inf_less_eq leI notinfI3 slen_stake_fst_inf stream.take_induct)

lemma slen_stake: "#s \<ge> Fin n \<Longrightarrow> #(stake n\<cdot>s) = Fin n"
proof (induction n)
  case 0
  then show ?case
    by simp
next
  case (Suc n)
  assume "#s \<ge> Fin (Suc n)"
  then have "#s \<ge> Fin n"
    by (simp add: Suc.prems Fin_leq_Suc_leq)
  obtain r where "stake (Suc n)\<cdot>s = (stake n\<cdot>s) \<bullet> r"
    by (metis (no_types) Rep_cfun_strict1 sconc_snd_empty stake_concat stream.take_0)
  then have "r \<noteq> \<epsilon>"
    by (metis (mono_tags, lifting) Fin_02bot Fin_Suc One_nat_def Suc.prems \<open>Fin n \<le> #s\<close> bot_is_0 drop_not_all inject_Fin lnle_def lnless_def n_not_Suc_n only_empty_has_length_0 sdropostake slen_scons srt_drop stake_Suc stake_conc strictI surj_scons)
  have "#((stake n\<cdot>s) \<bullet> r) \<ge> Fin (Suc n)"
  proof -
    have f1: "#(stake n\<cdot>s) = Fin n"
      using Suc.IH \<open>Fin n \<le> #s\<close> by fastforce
    have f2: "\<forall>s sa. (sa::'a stream) \<sqsubseteq> sa \<bullet> s"
      by simp
    have "\<exists>n. stake n\<cdot>s \<bullet> r \<noteq> stake n\<cdot>s \<and> Fin n = Fin n"
      using f1 by (metis \<open>r \<noteq> \<epsilon>\<close> inject_sconc sconc_snd_empty)
    then have "#(stake n\<cdot>s \<bullet> r) \<noteq> Fin n"
      by (metis Suc.IH \<open>Fin n \<le> #s\<close> \<open>r \<noteq> \<epsilon>\<close> fin2stake sdropl6 sdropostake)
    then show ?thesis
      using f2 f1 by (metis (no_types) less2lnleD lnless_def monofun_cfun_arg)
  qed
  then show ?case
    by (metis \<open>stake (Suc n)\<cdot>s = stake n\<cdot>s \<bullet> r\<close> dual_order.antisym ub_slen_stake)
qed

(* ----------------------------------------------------------------------- *)
section \<open>Additional lemmas for approximation, chains and continuity\<close>
(* ----------------------------------------------------------------------- *)

text \<open>A finite prefix of length @{term "k"} is created by @{term "stake k"}\<close>
lemma approxl1:
  "\<forall>s1 s2. s1 \<sqsubseteq> s2 \<and> #s1 = Fin k \<longrightarrow> stake k\<cdot>s2 = s1"
apply (induct_tac k, auto)
apply (rule_tac x=s1 in scases, auto)
apply (rule_tac x=s2 in scases, auto)
apply (erule_tac x="s" in allE)
apply (erule_tac x="sa" in allE)
by (drule less_all_sconsD, auto)

text \<open>A prefix of a stream is equal to the original one or a finite prefix\<close>
lemma approxl2:
  "s1 \<sqsubseteq> s2 \<Longrightarrow> (s1 = s2) \<or> (\<exists>n. stake n\<cdot>s2 = s1 \<and> Fin n = #s1)"
apply (rule_tac x="#s1" in lncases, auto)
apply (rule eq_less_and_fst_inf, assumption+)
by (insert approxl1
  [rule_format, of "s1" "s2"], auto)

text \<open>In infinite chains, all streams are finite\<close>
lemma inf_chainl1:
  "\<lbrakk>chain Y; \<not>finite_chain Y\<rbrakk> \<Longrightarrow> \<exists>k. #(Y i) = Fin k"
apply (rule ccontr, simp, frule infI)
apply (frule_tac k="i" in inf2max, assumption)
apply (frule_tac i="i" in max_in_chainI3, simp+)
by (simp add: finite_chain_def)

text \<open>Each prefix of a stream can be expanded to the original stream\<close>
lemma approxl3: "s1 \<sqsubseteq> s2 \<Longrightarrow> \<exists>t. s1\<bullet>t = s2"
apply (rule_tac x="#s1" in lncases, simp)
apply (drule eq_less_and_fst_inf, simp+)
apply (subst approxl1
  [rule_format, of "s1" "s2", THEN sym], simp+)
by (rule_tac x="sdrop k\<cdot>s2" in exI, simp)

text \<open>In infinite chains, there is an element which is a true prefix of another one\<close>
lemma inf_chainl2:
  "\<lbrakk>chain Y; \<not> finite_chain Y\<rbrakk> \<Longrightarrow> \<exists>j. Y k \<sqsubseteq> Y j \<and> #(Y k) < #(Y j)"
apply (auto simp add: finite_chain_def max_in_chain_def)
apply (erule_tac x="k" in allE, auto)
apply (frule_tac i=k and j=j in chain_mono, assumption)
apply (rule_tac x="j" in exI, simp)
apply (auto simp add: lnless_def)
apply (rule mono_slen, assumption)
by (frule eq_slen_eq_and_less, simp+)

text \<open>In infinite chains, the length of the streams is unbounded\<close>
lemma inf_chainl3:
  "chain Y \<and> \<not>finite_chain Y \<longrightarrow> (\<exists>k. Fin n \<le> #(Y k))"
apply (induct_tac n, auto)
apply (case_tac "Fin n = #(Y k)")
apply (frule_tac k=k in inf_chainl2, auto)
apply (rule_tac x="j" in exI)
apply (drule sym)
apply (rule_tac x="#(Y j)" in lncases, auto)
apply (rule_tac x="k" in exI)
by (rule_tac x="#(Y k)" in lncases, auto)

text \<open>In infinite chains, the lub is infinite\<close>
lemma inf_chainl4:
  "\<lbrakk>chain Y; \<not>finite_chain Y\<rbrakk> \<Longrightarrow> #(lub(range Y)) = \<infinity>"
apply (rule_tac x="#(Lub Y)" in lncases, auto)
apply (frule_tac n = "Suc k" in inf_chainl3
  [rule_format, OF conjI], assumption, erule exE)
apply (subgoal_tac "Y ka \<sqsubseteq> (Lub Y)")
apply (drule monofun_cfun_arg [of _ _ slen], simp)
apply (frule_tac x = "Fin (Suc k)" and
  y = "#(Y ka)" and z = "Fin k" in trans_lnle, simp+)
by (rule is_ub_thelub)

text \<open>Each chain becomes finite by mapping @{term "stake n"} to every element\<close>
lemma finite_chain_stake:
  "chain Y \<Longrightarrow> finite_chain (\<lambda>i. stake n\<cdot>(Y i))"
apply (frule ch2ch_Rep_cfunR [of _ "stake n"])
apply (rule ccontr)
apply (frule inf_chainl4 [of "\<lambda>i. stake n\<cdot>(Y i)"],assumption)
by (simp add: contlub_cfun_arg [THEN sym])

text \<open>every finite prefix of the lub is also prefix of some element in the chain\<close>
lemma lub_approx:
  "chain Y \<Longrightarrow> \<exists>k. stake n\<cdot>(lub (range Y)) = stake n\<cdot>(Y k)"
apply (subst contlub_cfun_arg, assumption)
apply (frule finite_chain_stake [of _ n])
apply (simp add: finite_chain_def, auto)
apply (rule_tac x="i" in exI)
by (rule lub_finch1
  [THEN lub_eqI, of "\<lambda>i. stake n\<cdot>(Y i)"], auto)

text \<open>If @{term f} is monotone and for each @{term x} there is a finite prefix
  @{term y} such that @{term "f x = f y"}, @{term f} is continuous\<close>
lemma pr_contI:
  "\<lbrakk>monofun f; \<forall>x.\<exists>n. (f x) = f (stake n\<cdot>x)\<rbrakk> \<Longrightarrow> cont f"
apply (rule contI2, assumption)
apply (rule allI, rule impI)
apply (erule_tac x="lub (range Y)" in allE, erule exE)
apply (frule_tac n = n in lub_approx, erule exE)
apply (subgoal_tac "f (stake n\<cdot>(Y k)) \<sqsubseteq> f (Y k)")
apply (subgoal_tac "f (Y k) \<sqsubseteq> (\<Squnion>i. f (Y i))")
apply (drule_tac x="f (stake n\<cdot>(Y k))" and
  y="f (Y k)" and z = "\<Squnion>i. f (Y i)" in below_trans)
apply (rule is_ub_thelub)
apply (rule_tac f=f in ch2ch_monofun, assumption+)
apply (clarsimp)
apply (rule is_ub_thelub)
apply (rule_tac f=f in ch2ch_monofun, assumption+)
by (rule_tac f = f in monofunE, simp+)

text \<open>For continuous functions, each finite prefix of @{term "f\<cdot>x"} only
  depends on a finite prefix of @{term "x"}\<close>
lemma fun_approxl1:
  "\<exists>j. stake k\<cdot>(f\<cdot>x) = stake k\<cdot>(f\<cdot>(stake j\<cdot>x))"
apply (subgoal_tac "f\<cdot>x = (\<Squnion>i. f\<cdot>(stake i\<cdot>x))")
apply (erule ssubst)
apply (rule lub_approx)
apply (rule chain_monofun)
apply (rule ch2ch_Rep_cfunL)
apply (rule stream.chain_take)
apply (subst contlub_cfun_arg [THEN sym])
apply (rule ch2ch_Rep_cfunL)
apply (rule stream.chain_take)
apply (subst reach_stream)
by (rule refl)

text \<open>For continuous functions, any finite output for stream @{term "x"} can also be
  obtained by some finite prefix of @{term "x"}\<close>
lemma fun_approxl2: "#(f\<cdot>x) = Fin k \<Longrightarrow> \<exists>j. f\<cdot>x = f\<cdot>(stake j\<cdot>x)"
apply (insert fun_approxl1 [of k "f" x], auto)
apply (rule_tac x="j" in exI)
apply (frule fin2stake [THEN sym], simp)
apply (rule stream.take_lemma, simp)
apply (case_tac "n \<le> k")
apply (simp add: min_def)+
apply (rule po_eq_conv [THEN iffD2])
apply (rule conjI)
apply (rule monofun_cfun_fun)
apply (rule chain_mono)
apply (rule stream.chain_take, simp+)
apply (subgoal_tac "f\<cdot>(stake j\<cdot>x) \<sqsubseteq> f\<cdot>x")
apply (rule below_trans, auto)
apply (drule sym, drule sym, simp)
by (rule monofun_cfun_arg, simp)

(* if two streams are unequal, it holds for a finite stream a that a \<bullet> s1 is unequal to a \<bullet> s2 *)
lemma sconc_neq_h: assumes "s1 \<noteq> s2"
  shows "#a < \<infinity> \<longrightarrow> a \<bullet> s1 \<noteq> a \<bullet> s2"
  apply(rule ind [of _a ])
    apply(rule admI)
    apply (rule impI)
    apply (metis inf_chainl4 l42 neq_iff)
   apply (simp add: assms)
  by (metis inf_ub inject_scons less_le sconc_scons slen_sconc_snd_inf)

(* if two streams are unequal and a stream a has finite lenght, it holds that a \<bullet> s1 is unequal to a \<bullet> s2 *)
lemma sconc_neq: assumes "s1 \<noteq> s2" and "#a < \<infinity>"
  shows "a \<bullet> s1 \<noteq> a \<bullet> s2"
using assms(1) assms(2) sconc_neq_h by blast

lemma stake_prefix: "#s < \<infinity> \<Longrightarrow> t \<noteq> \<epsilon> \<Longrightarrow> s = t \<bullet> u \<Longrightarrow> \<exists>k. t = stake (Suc k)\<cdot>s"
proof -
  assume "#s < \<infinity>" and "t \<noteq> \<epsilon>" and "s = t \<bullet> u"
  then obtain k where "t = stake k\<cdot>s"
    by (metis approxl2 fin2stake inf_less_eq minimal monofun_cfun_arg ninf2Fin not_le sconc_snd_empty)
  then obtain l where "k = Suc l"
    by (metis Rep_cfun_strict1 \<open>t \<noteq> \<epsilon>\<close> not0_implies_Suc stream.take_0)
  thus ?thesis
    using \<open>t = stake k\<cdot>s\<close> by blast
qed

lemma stake_prefix2: "#s = Fin n \<Longrightarrow> s = stake n\<cdot>(s \<bullet> t)"
  by (metis approxl1 minimal monofun_cfun_arg sconc_snd_empty)

lemma slen_conc: "#s < \<infinity> \<Longrightarrow> t \<noteq> \<epsilon> \<Longrightarrow> #s \<ge> Fin n \<Longrightarrow> #(s \<bullet> t) > Fin n"
  by (metis (no_types, hide_lams) stake_prefix2 infI less_le less_le_trans mono_slen sconc_neq sconc_snd_empty stream.take_below)

lemma stake_srt_conc [simp]: "srt\<cdot>((stake 1\<cdot>s)\<bullet>(s)) = s"
  apply (cases s)
  apply simp
  by (metis One_nat_def Rep_cfun_strict1 lscons_conv sconc_snd_empty stake_Suc stream.con_rews(2) stream.sel_rews(5) stream.take_0 surj_scons)

(* ----------------------------------------------------------------------- *)
section \<open>Lemmas for the remaining definitions\<close>
(* ----------------------------------------------------------------------- *)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term slookahd}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>@{term slookahd} is continuous\<close>
lemma cont_slookahd[simp]: "cont (\<lambda> s. if s=\<epsilon> then \<bottom> else eq (shd s))"
apply (rule pr_contI)
apply (rule monofunI, auto)
apply (rule_tac x=x in scases, auto)
apply (rule_tac x=y in scases, auto)
apply (drule less_all_sconsD, simp)
apply (rule_tac x=x in scases, auto)
by (rule_tac x="Suc 0" in exI, auto)

(* slookahd applied to the empty stream results in the bottom element for any function eq *)
lemma strict_slookahd[simp]: "slookahd\<cdot>\<epsilon>\<cdot>eq = \<bottom>"
by (simp add: slookahd_def cont2cont_LAM)

(* if s isn't the empty stream, the function eq will be applied to the head of s *)
lemma slookahd_scons[simp]: "s\<noteq>\<epsilon> \<Longrightarrow> slookahd\<cdot>s\<cdot>eq = eq (shd s)"
by (simp add: slookahd_def cont2cont_LAM)

(* the constant function that always returns the empty stream unifies the two cases of slookahd *)
lemma strict2_slookahd[simp]: "slookahd\<cdot>xs\<cdot>(\<lambda>y. \<epsilon>) = \<epsilon>"
by (cases xs, simp_all)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sinftimes}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>basic properties of @{term sntimes} and @{term sinftimes}\<close>

(* repeating the empty stream produces the empty stream again for any n*)
lemma sntimes_eps[simp]: "sntimes n \<epsilon> = \<epsilon>"
by (induct_tac n, simp+)

(* after repeating the stream \<up>s n-times the head is s *)
  (* n>0 otherwise \<open>0 \<star> \<up>s = \<epsilon>\<close> *)
lemma shd_sntime [simp]: assumes "n>0" shows "shd (n \<star> \<up>s) = s"
by (metis assms gr0_implies_Suc shd1 sntimes.simps(2))

(* infinitely cycling the empty stream produces the empty stream again *)
lemma strict_icycle[simp]: "sinftimes \<epsilon> = \<epsilon>"
by (subst sinftimes_def [THEN fix_eq2], auto)

(* repeating a stream infinitely often is equivalent to repeating it once and then infinitely often *)
lemma sinftimes_unfold: "sinftimes s = s \<bullet> sinftimes s"
by (subst sinftimes_def [THEN fix_eq2], auto)

text \<open>For nonempty @{term s}, @{term "sinftimes s"} is infinite\<close>
lemma slen_sinftimes: "s \<noteq> \<epsilon> \<Longrightarrow> #(sinftimes s) = \<infinity>"
apply (rule ccontr)
apply (rule_tac x="#(sinftimes s)" in lncases, auto)
apply (rule_tac x="#s" in lncases)
apply (insert sinftimes_unfold [of s], auto)
by (insert slen_sconc_all_finite
  [rule_format, of "s" _ "sinftimes s"], force)

(* lenght of sinftimes of (\<up>a) is infinity *)
lemma [simp]: "#(sinftimes (\<up>a)) = \<infinity>"
by (simp add: slen_sinftimes)

(* converting the element x to a singleton stream, repeating the singleton and re-extracting x with
   lshd is equivalent to imposing the discrete order on x *)
lemma lshd_sinf [simp]: "lshd\<cdot>\<up>x\<^sup>\<infinity> = updis x"
by (metis lshd_updis sinftimes_unfold)

(* the infinite repetition of the stream x has the same head as x *)
lemma shd_sinf[simp]: "shd (x\<^sup>\<infinity>) = shd x"
by (metis assoc_sconc shd1 sinftimes_unfold strict_icycle surj_scons)

(* srt has no effect on an infinite constant stream of x *)
lemma srt_sinf [simp]: "srt\<cdot>\<up>x\<^sup>\<infinity> = ((\<up>x)\<^sup>\<infinity>)"
by (metis lscons_conv sinftimes_unfold stream.sel_rews(5) up_defined)

(* if the stream x contains y elements then the first y elements of the infinite repetition of x will
   be x again *)
lemma stake_y [simp]: assumes "#x = Fin y"
    shows "stake y\<cdot>(sinftimes x) = x"
by (metis approxl1 assms minimal monofun_cfun_arg sconc_snd_empty sinftimes_unfold)

(* the infinite repetitions of the singleton stream \<up>s consists only of the element s *)
lemma snth_sinftimes[simp]: "snth i ((\<up>s)\<^sup>\<infinity>) = s"
apply (induction i)
apply (simp)
by (simp add: snth_rt)

(* dropping any finite number of elements from an infinite constant stream doesn't affect the stream *)
lemma sdrops_sinf[simp]: "sdrop i\<cdot>((\<up>x)\<^sup>\<infinity>) = ((\<up>x)\<^sup>\<infinity>)"
apply (induction i)
apply(simp)
by (simp add: sdrop_forw_rt)

(* for a finite natural number "i", following relation between sntimes and stake holds:  *)
lemma sntimes_stake: "i \<star> \<up>x = stake i\<cdot>((\<up>x)\<^sup>\<infinity>)"
apply(induction i)
apply simp
by (metis sinftimes_unfold sntimes.simps(2) stake_Suc)

(* for every finite number "i" is sntimes \<noteq> sinftimes. *)
lemma snNEqSinf [simp]: "i \<star> \<up>x \<noteq> ((\<up>x)\<^sup>\<infinity>)"
by (metis lshd_sinf sdropostake sdrops_sinf sntimes_stake stream.sel_rews(3) up_defined)

(* for every natural number i, dropping the first (i*y) elements results in the same infinite stream *)
  (* the first i "blocks" of x are dropped *)
lemma sdrop_sinf[simp]: assumes "Fin y = #x"
  shows "sdrop (i * y)\<cdot>(sinftimes x) = sinftimes x"
apply(induction i)
apply(simp)
by (metis assms mult_Suc sdrop_plus sdropl6 sinftimes_unfold)

(* repeating the empty stream again produces the empty stream *)
lemma sinf_notEps[simp]: assumes "xs \<noteq> \<epsilon>" shows "(sinftimes xs) \<noteq> \<epsilon>"
using assms slen_sinftimes by fastforce

(* sinftimes has no effect on streams that are already infinite *)
(* removed simp because of lemma stakewhile_sinftimes_lemma*)
lemma sinf_inf: assumes "#s = \<infinity>"
  shows "s\<^sup>\<infinity> = s"
by (metis assms sconc_fst_inf sinftimes_unfold)

(* sinftimes is idempotent *)
lemma sinf_dupE [simp]: "(sinftimes s)\<^sup>\<infinity> = (s\<^sup>\<infinity>)"
using sinf_inf slen_sinftimes by force

(* alternative unfold rule for sntimes, new element is appended on the end *)
lemma sntimes_Suc2: "(Suc i) \<star> s = (i\<star>s) \<bullet> s"
apply (induction i)
apply simp
by (metis assoc_sconc sntimes.simps(2))

(* Blockwise stake from sinftimes to sntimes. *)
lemma sinf2sntimes: assumes "Fin y = #x"
  shows "stake (i*y)\<cdot>(x\<^sup>\<infinity>) = i\<star>x"
apply(induction i)
apply simp
by (metis assms mult_Suc sdrop_plus sdrop_sinf sntimes.simps(2) stake_add stake_y)

(* for any natural number i, sntimes is a prefix of sinftimes *)
lemma snT_le_sinfT [simp]: "i\<star>s \<sqsubseteq> (s\<^sup>\<infinity>)"
by (metis minimal monofun_cfun_arg ninf2Fin sconc_fst_inf sconc_snd_empty sinf2sntimes sinf_inf sntimes.simps(2) sntimes_Suc2 ub_stake)

(* repeating the stream s i times produces a prefix of repeating s i+1 times *)
lemma sntimes_leq: "i\<star>s \<sqsubseteq> (Suc i)\<star>s"
by (metis minimal monofun_cfun_arg sconc_snd_empty sntimes_Suc2)

(* the repetitions of a stream constitute a chain *)
lemma sntimes_chain: "chain (\<lambda>i. i\<star>s)"
by (meson po_class.chainI sntimes_leq)

(* xs is an infinite repetition of the finite stream x. Then dropping any fixed number i of repetitions
   of x leaves xs unchanged. *)
lemma sdrop_sinf2: assumes "xs = x\<bullet>xs" and "#x = Fin y"
  shows "sdrop (y*i)\<cdot>xs = xs"
apply (induction i)
apply simp
by (metis assms mult_Suc_right sdrop_plus sdropl6)

(* the recursive definition for a stream (xs = x\<bullet>xs) is identical to the infinite repetition of x at
   every multiple of the length of x *)
lemma stake_eq_sinf: assumes "xs = x\<bullet>xs" and "#x = Fin y"
  shows "stake (i*y)\<cdot>xs = stake (i*y)\<cdot>(sinftimes x)"
proof (induction i)
  case 0 thus ?case by simp
next
  case (Suc i)
  have drop_xs:"sdrop (i*y)\<cdot>xs = xs" by (metis assms mult.commute sdrop_sinf2)

  have "stake (Suc i * y)\<cdot>xs  =  stake (i*y)\<cdot>xs \<bullet> stake y\<cdot>(sdrop (i*y)\<cdot>xs)" by (metis add.commute mult_Suc stake_add)
  hence eq1:"stake (Suc i * y)\<cdot>xs =  stake (i*y)\<cdot>xs \<bullet> x"  by (metis approxl1 assms drop_xs minimal monofun_cfun_arg sconc_snd_empty)

  have "stake (Suc i * y)\<cdot>(sinftimes x) = stake (i*y)\<cdot>(sinftimes x) \<bullet> stake y\<cdot>(sdrop (i*y)\<cdot>(sinftimes x))"
    by (metis add.commute mult_Suc stake_add)
  hence eq2:"stake (Suc i * y)\<cdot>(sinftimes x) =  stake (i*y)\<cdot>(sinftimes x) \<bullet> x" by (simp add: assms(2))

  thus ?case using Suc.IH eq1 by auto
qed

(* when repeating a stream s a different number of times, one of the repetitions will be a prefix of
   the other *)
lemma stake_sntimes2sntimes: assumes "j\<le>k" and "#s = Fin y"
  shows "stake (j*y)\<cdot>(k\<star>s) = j\<star>s"
by (smt assms(1) assms(2) min_def mult_le_mono1 sinf2sntimes stakeostake)

(* for a stream s, a natural y and an arbitrary natural j, apply blockwise stake sntimes. *)
lemma lubStake2sn: assumes "#s = Fin y"
  shows "(\<Squnion> i. stake (y*j)\<cdot>(i\<star>s)) = j\<star>s" (is "(\<Squnion>i. ?c i) = _")
proof -
  have "max_in_chain j (\<lambda>i. ?c i)" by (simp add: assms max_in_chainI mult.commute stake_sntimes2sntimes)
  thus ?thesis by (simp add: assms maxinch_is_thelub mult.commute sntimes_chain stake_sntimes2sntimes)
qed

(* building block of the lemma sntimesLub_Fin *)
lemma sntimesChain: assumes "#s = Fin y" and "y \<noteq> 0"
  shows "\<forall>j. stake (y*j)\<cdot>(\<Squnion> i. i\<star>s) = stake (y*j)\<cdot> (s\<^sup>\<infinity>)"
by (metis assms(1) contlub_cfun_arg lubStake2sn mult.commute sinf2sntimes sntimes_chain)

(* proof for lemma sntimesLub_Fin *)
lemma sntimesLub_Fin: assumes "#s = Fin y" and "y \<noteq> 0"
  shows "(\<Squnion> i. i\<star>s) = (s\<^sup>\<infinity>)"
proof -
  have  "\<forall>j. stake (j*y)\<cdot>(\<Squnion> i. i\<star>s) = stake (j*y)\<cdot> (s\<^sup>\<infinity>)" by (metis assms(1) assms(2) mult.commute sntimesChain)
  hence "\<forall>j. stake j\<cdot>(\<Squnion> i. i\<star>s) = stake j\<cdot> (s\<^sup>\<infinity>)" using assms by (metis gstake2stake)
  thus ?thesis by (simp add:  stream.take_lemma)
qed

(* for any stream s the LUB of sntimes is sinftimes *)
lemma sntimesLub[simp]:"(\<Squnion> i. i\<star>s) = (s\<^sup>\<infinity>)"
apply(cases "#s = \<infinity>")
apply (metis inf2max sconc_fst_inf sinf_inf sntimes.simps(2) sntimes_chain)
by (metis Fin_0 lncases lub_eq_bottom_iff slen_empty_eq sntimesLub_Fin sntimes_chain sntimes_eps strict_icycle)

(* shows that any recursive definition with the following form is equal to sinftimes *)
lemma rek2sinftimes: assumes "xs = x \<bullet> xs" and "x\<noteq>\<epsilon>"
  shows "xs = sinftimes x"
proof (cases "#x = \<infinity>")
  case True thus ?thesis by (metis assms(1) sconc_fst_inf sinftimes_unfold)
next
  case False
  obtain y where y_def: "Fin y = #x \<and> y\<noteq>0"  by (metis False Fin_02bot assms(2) infI lnzero_def slen_empty_eq)
  hence "\<forall>i. stake (i*y)\<cdot>xs = stake (i*y)\<cdot>(x\<^sup>\<infinity>)" using assms(1) stake_eq_sinf by fastforce
  hence "\<forall>i. stake i\<cdot>xs = stake i\<cdot>(x\<^sup>\<infinity>)" using gstake2stake y_def by blast
  thus ?thesis by (simp add: stream.take_lemma)
qed

(* specializes the result from rek2sinftimes to singleton streams *)
lemma s2sinftimes: assumes "xs = \<up>x \<bullet> xs"
  shows "xs = ((\<up>x)\<^sup>\<infinity>)"
using assms rek2sinftimes by fastforce

(* shows that the infinite repetition of a stream x is the least fixed point of iterating (\<Lambda> s. x \<bullet> s),
   which maps streams to streams *)
lemma fix2sinf[simp]: "fix\<cdot>(\<Lambda> s. x \<bullet> s) = (x\<^sup>\<infinity>)"
  by (metis eta_cfun fix_eq fix_strict rek2sinftimes sconc_snd_empty strict_icycle)

lemma snth_bool_sinftimes: "snth (Suc n) ((\<up>bool \<bullet> \<up>(\<not> bool))\<^sup>\<infinity>) = (\<not> snth n ((\<up>bool \<bullet> \<up>(\<not>bool))\<^sup>\<infinity>))"
  apply (induction n)
  apply (metis assoc_sconc shd1 sinftimes_unfold snth_scons snth_shd)
  by (metis (no_types, hide_lams) sconc_fst_empty sconc_scons' sinftimes_unfold snth_scons sup'_def)

lemma sinftimes_srt: "srt\<cdot>((\<up>a \<bullet> \<up>b)\<^sup>\<infinity>) = ((\<up>b \<bullet> \<up>a)\<^sup>\<infinity>)"
  apply (subst sinftimes_unfold, simp)
  by (metis (no_types, lifting) assoc_sconc rek2sinftimes sinftimes_unfold strictI)

lemma sinftimes_snth:"(n mod 2 = 0 \<longrightarrow> snth n ((\<up>a \<bullet> \<up>b)\<^sup>\<infinity>) = a) \<and> (n mod 2 = 1 \<longrightarrow> snth n ((\<up>a \<bullet> \<up>b)\<^sup>\<infinity>) = b)"
proof(induction n arbitrary: a b)
  case 0
  then show ?case
    by simp
next
  case (Suc n)
  moreover obtain m where m_def:"n\<noteq>0 \<Longrightarrow> n = Suc m"
    using not0_implies_Suc by auto
  ultimately show ?case
    apply(cases "n = 0")
    apply(subst sinftimes_unfold, simp)
    apply (metis sconc_scons shd1 sinftimes_unfold snth_scons snth_shd)
    apply auto
    apply(subst sinftimes_unfold, simp)
    apply (simp add: snth_rt)
    apply (metis One_nat_def even_Suc parity_cases sinftimes_srt)
    apply(subst sinftimes_unfold, simp)
    apply (simp add: snth_rt)
    by (metis One_nat_def even_Suc parity_cases sinftimes_srt)
qed

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term smap}\<close>
(* ----------------------------------------------------------------------- *)

(* smapping a function to the empty stream gives us the empty stream *)
lemma strict_smap[simp]: "smap f\<cdot>\<epsilon> = \<epsilon>"
by (subst smap_def [THEN fix_eq2], simp)

(* smap distributes over concatenation *)
lemma smap_scons[simp]: "smap f\<cdot>(\<up>a \<bullet> s) = \<up>(f a) \<bullet> smap f\<cdot>s"
by (subst smap_def [THEN fix_eq2], simp)

(* if \<And>a as. f\<cdot>(\<up>a \<bullet> as) is equal to \<up>(g a) \<bullet> f\<cdot>as and f applied to bottom returns the bottom element, then
 f applied to s is the same as applying smap to g\<cdot>s *)
lemma rek2smap: assumes "\<And>a as. f\<cdot>(\<up>a \<bullet> as) = \<up>(g a) \<bullet> f\<cdot>as"
  and "f\<cdot>\<bottom> = \<bottom>"
  shows "f\<cdot>s = smap g\<cdot>s"
apply(rule ind [of _s])
by(simp_all add: assms)

(* mapping f over a singleton stream is equivalent to applying f to the only element in the stream *)
lemma [simp]: "smap f\<cdot>(\<up>a) = \<up>(f a)"
by (subst smap_def [THEN fix_eq2], simp)

(* smap leaves the length of a stream unchanged *)
lemma slen_smap[simp]: "#(smap f\<cdot>x) = #x"
by (rule ind [of _ x], auto)

text \<open>@{term smap} maps each element @{term x} to @{term "f(x)"}\<close>
lemma smap_snth_lemma:
  "Fin n < #s \<Longrightarrow> snth n (smap f\<cdot>s) = f (snth n s)"
apply (simp add: atomize_imp)
apply (rule_tac x="s" in spec)
apply (induct_tac n, simp+)
by (rule allI, rule_tac x="x" in scases, simp+)+

text\<open>Doing smap in two passes, applying h in the first pass and g in the second is
equivalent to applying g \<circ> h in a single pass\<close>
lemma smaps2smap: "smap g\<cdot>(smap h\<cdot>xs) =  smap (\<lambda> x. g (h x))\<cdot>xs"
by (simp add: smap_snth_lemma snths_eq)

text \<open>@{term sdrop} after @{term smap} is like @{term smap} after @{term sdrop}\<close>
lemma sdrop_smap[simp]: "sdrop k\<cdot>(smap f\<cdot>s) = smap f\<cdot>(sdrop k\<cdot>s)"
apply (rule_tac x="k" in spec)
apply (rule ind [of _ s], simp+)
apply (rule allI)
by (case_tac "x", simp+)

text \<open>@{term "smap f"} is a homomorphism on streams with respect to concatenation\<close>
lemma smap_split: "smap f\<cdot>(a \<bullet> b) = (smap f\<cdot>a) \<bullet> (smap f\<cdot>b)"
proof (rule lncases [of "#a"], simp)
  fix k assume "#a = Fin k"
  thus ?thesis by (rule finind [of "a"], simp_all)
qed

(* smap distributes over infinite repetition *)
lemma smap2sinf[simp]: "smap f\<cdot>(x\<^sup>\<infinity>)= ((smap f\<cdot>x)\<^sup>\<infinity>)"
by (metis (no_types) rek2sinftimes sinftimes_unfold slen_empty_eq slen_smap smap_split strict_icycle)

(* smap and infinity *)
lemma l5: "smap g\<cdot>((\<up>x)\<^sup>\<infinity>) = ((\<up>(g x))\<^sup>\<infinity>)"
  by simp

(* for any nonempty stream it holds that smap f to stream s is \<up>(f (shd s)) \<bullet> smap f\<cdot>(srt\<cdot>s) *)
lemma smap_hd_rst : "s \<noteq> \<epsilon> \<Longrightarrow> smap f\<cdot>s = \<up>(f (shd s)) \<bullet> smap f\<cdot>(srt\<cdot>s)" by (metis smap_scons surj_scons)

lemma smap_inj:"inj f \<Longrightarrow> inj (Rep_cfun (smap f))"
  apply(rule injI)
  apply(rule snths_eq,auto)
  apply (metis slen_smap)
  by (metis inj_eq slen_smap smap_snth_lemma)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sprojfst} and @{term sprojsnd}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>basic properties of @{term sprojfst}\<close>

(* sprojfst extracts the first element of the first tuple in any non-empty stream of tuples *)
lemma sprojfst_scons[simp]: "sprojfst\<cdot>(\<up>(x, y) \<bullet> s) = \<up>x \<bullet> sprojfst\<cdot>s"
by (unfold sprojfst_def, simp)

(* the empty stream is a fixed point of sprojfst *)
lemma strict_sprojfst[simp]: "sprojfst\<cdot>\<epsilon> = \<epsilon>"
by (unfold sprojfst_def, simp)

(* sprojfst extracts the first element of any singleton tuple-stream *)
lemma [simp]: "sprojfst\<cdot>(\<up>(a,b)) = \<up>a"
by (simp add: sprojfst_def)

text \<open>same properties for @{term sprojsnd}\<close>

(* sprojsnd extracts the second element of the first tuple in any non-empty stream of tuples *)
lemma sprojsnd_scons[simp]: "sprojsnd\<cdot>(\<up>(x,y) \<bullet> s) = \<up>y \<bullet> sprojsnd\<cdot>s"
by (unfold sprojsnd_def, simp)

(* the empty stream is a fixed point of sprojsnd *)
lemma strict_sprojsnd[simp]: "sprojsnd\<cdot>\<epsilon> = \<epsilon>"
by (unfold sprojsnd_def, simp)

(* sprojsnd extracts the second element of any singleton tuple-stream *)
lemma [simp]: "sprojsnd\<cdot>(\<up>(a,b)) = \<up>b"
  by (simp add: sprojsnd_def)

lemma sprojsnd_shd:
  assumes "s \<noteq> \<epsilon>"
  shows "shd (sprojsnd\<cdot>s) = snd (shd s)"
  by (metis assms prod.collapse shd1 sprojsnd_scons surj_scons)

lemma sconc_sprojsnd_shd:
  shows "shd (sprojsnd\<cdot>(\<up>a \<bullet> s)) = snd a"
  by (simp add: sprojsnd_shd)

text \<open>@{term sprojfst} / @{term sprojsnd} and @{term srt} commute\<close>

(* commutativity of sprojsnd and srt *)
lemma rt_Sproj_2_eq: "sprojsnd\<cdot>(srt\<cdot>x) = srt\<cdot>(sprojsnd\<cdot>x)"
by (rule ind [of _ x], auto)

(* commutativity of sprojsnd and srt *)
lemma rt_Sproj_1_eq: "sprojfst\<cdot>(srt\<cdot>x) = srt\<cdot>(sprojfst\<cdot>x)"
by (rule ind [of _ x], auto)

text \<open>length of projections and the empty stream\<close>

(* relation between sprojsnd and sprojfst with respect to the length operator *)
lemma slen_sprojs_eq: "#(sprojsnd\<cdot>x) = #(sprojfst\<cdot>x)"
by (rule ind [of _ "x"], auto)

(* if sprojfst\<cdot>x is the empty stream, then x was already empty *)
lemma strict_rev_sprojfst: "sprojfst\<cdot>x = \<epsilon> \<Longrightarrow> x = \<epsilon>"
by (rule ccontr, rule_tac x=x in scases, auto)

(* if sprojsnd\<cdot>x is the empty stream, then x was already empty *)
lemma strict_rev_sprojsnd: "sprojsnd\<cdot>x = \<epsilon> \<Longrightarrow> x = \<epsilon>"
by (rule ccontr, rule_tac x=x in scases, auto)

(* sprojfst does not change the length of x *)
lemma slen_sprojfst: "#(sprojfst\<cdot>x) = #x"
by (rule ind [of _ "x"], auto)

(* sprojsnd does not change the length of x *)
lemma slen_sprojsnd: "#(sprojsnd\<cdot>x) = #x"
by (rule ind [of _ "x"], auto)

(* updis does not change the length *)
lemma slen_updis_eq: "#s1 = #s2 \<Longrightarrow> #(updis x1 && s1) = #(updis x2 && s2)"
  by (simp add: lscons_conv)

(* helper lemma for deconstruct_infstream *)
lemma deconstruct_infstream_h:
  assumes "#s = \<infinity>" obtains x xs where "(updis x) && xs = s \<and> #xs = \<infinity>"
  using assms inf_scase lscons_conv by blast

(* deconstruction of infinite streams *)
lemma deconstruct_infstream:
  assumes "#s = \<infinity>" obtains x xs where "(updis x) && xs = s \<and> #xs = \<infinity> \<and> xs \<noteq> \<epsilon>"
  by (metis Inf'_neq_0 assms deconstruct_infstream_h slen_empty_eq)

text \<open>Behaviour of projections on the n-th element in a stream\<close>

lemma sprojfst_shd[simp]: assumes "s\<noteq>\<epsilon>" shows "shd (sprojfst\<cdot>s) = fst (shd s)"
  by (metis assms prod.collapse shd1 sprojfst_scons surj_scons)

lemma sprojfst_snth[simp]: assumes "Fin n < #s" shows "snth n (sprojfst\<cdot>s) = fst (snth n s)"
  using assms
proof(induction n arbitrary: s)
  case 0
  then show ?case
    apply simp
    apply(rule sprojfst_shd)
    by auto
next
  case (Suc n)
  then show ?case
    apply(simp add: snth_rt)
    by (metis not_less rt_Sproj_1_eq slen_rt_ile_eq)
qed

lemma sprojfst_shd2[simp]: "shd (sprojfst\<cdot>(\<up>a \<bullet> s)) = fst (a)"
  by simp

lemma sprojsnd_snth:
  assumes "Fin n < #s"
  shows "snth n (sprojsnd\<cdot>s) = snd (snth n s)"
  using assms
  apply (induction n arbitrary: s)
  using sprojsnd_shd apply force
  by (metis leD leI rt_Sproj_2_eq slen_rt_ile_eq snth_rt)

lemma sprojsnd_shd2[simp]: "shd (sprojsnd\<cdot>(\<up>a \<bullet> s)) = snd (a)"
  by (simp add: sconc_sprojsnd_shd)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sfilter}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>basic properties of @{term sfilter}\<close>

(* note that M is a set, not a predicate *)
lemma strict_sfilter[simp]: "sfilter M\<cdot>\<epsilon> = \<epsilon>"
by (subst sfilter_def [THEN fix_eq2], simp)

(* if the head of a stream is in M, then sfilter will keep the head *)
lemma sfilter_in[simp]:
  "a \<in> M \<Longrightarrow> sfilter M\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> sfilter M\<cdot>s"
by (subst sfilter_def [THEN fix_eq2], simp)

(* if the head of a stream isn't in M, then sfilter will discard the head *)
lemma sfilter_nin[simp]:
  "a \<notin> M \<Longrightarrow> sfilter M\<cdot>(\<up>a \<bullet> s) = sfilter M\<cdot>s"
by (subst sfilter_def [THEN fix_eq2], simp)

(* if the sole element in a singleton stream is in M then sfilter is a no-op *)
lemma [simp]: "a \<in> M \<Longrightarrow> sfilter M\<cdot>(\<up>a) = \<up>a"
by (subst sfilter_def [THEN fix_eq2], simp)

(* if the sole element in a singleton stream is not in M then sfilter produces the empty stream *)
lemma [simp]: "a \<notin> M \<Longrightarrow> sfilter M\<cdot>(\<up>a) = \<epsilon>"
by (subst sfilter_def [THEN fix_eq2], simp)

text \<open>@{term sfilter} and @{term sinftimes}\<close>

(* filtering all elements that aren't in {a} from a stream consisting only of the element a has no effect *)
lemma sfilter_sinftimes_in[simp]:
  "sfilter {a}\<cdot>(sinftimes (\<up>a)) = sinftimes (\<up>a)"
apply (rule stream.take_lemma)
apply (induct_tac n, auto)
apply (subst sinftimes_unfold, simp)
apply (rule sym)
by (subst sinftimes_unfold, simp)

(* if the element a isn't in the set F then filtering a stream of infinitely many a's using F will
   produce the empty stream *)
lemma sfilter_sinftimes_nin:
  "a \<notin> F \<Longrightarrow> (F \<ominus> (sinftimes (\<up>a))) = \<epsilon>"
proof -
  assume a_nin_F: "a \<notin> F"
  have "\<And>i. (F \<ominus> (stake i\<cdot>(sinftimes (\<up>a)))) = \<epsilon>"
  proof (induct_tac i, simp_all)
    fix n assume "F \<ominus> (stake n\<cdot>(sinftimes (\<up>a))) = \<epsilon>"
    hence "F \<ominus> (stake (Suc n)\<cdot>(\<up>a \<bullet> sinftimes (\<up>a))) = \<epsilon>" using a_nin_F by simp
    thus "F \<ominus> stake (Suc n)\<cdot>(sinftimes (\<up>a)) = \<epsilon>" by (subst sinftimes_unfold)
  qed
  hence "(F \<ominus> (\<Squnion>i. stake i\<cdot>(sinftimes (\<up>a)))) = \<epsilon>" by (simp add:contlub_cfun_arg)
  thus ?thesis by (simp add: reach_stream)
qed

text \<open>Filtering a postfix is at most as long as filtering the whole stream\<close>
lemma slen_sfilter_sdrop_ile:
  "#(sfilter X\<cdot>(sdrop n\<cdot>p)) \<le> #(sfilter X\<cdot>p)"
apply (rule spec [where x = "n"])
apply (rule ind [of _ p], auto)
apply (subst lnle_def, simp del: lnle_conv)
apply (case_tac "x", auto)
apply (case_tac "a \<in> X", auto)
apply (erule_tac x="nat" in allE)
by (rule trans_lnle, auto)

text \<open>If the filtered stream is infinite, each filtered postfix is infinite\<close>
lemma slen_sfilter_sdrop:
  "\<forall>p X. #(sfilter X\<cdot>p) = \<infinity> \<longrightarrow> #(sfilter X\<cdot>(sdrop n\<cdot>p)) = \<infinity>"
apply (induct_tac n, auto)
apply (rule_tac x=p in scases, auto)
by (case_tac "a\<in>X", auto)

text \<open>@{term sfilter} on @{term "stake n"} returns \<open>\<epsilon>\<close> if none of the first
  @{term n} elements is included in the filter\<close>
lemma sfilter_empty_snths_nin_lemma:
  "\<forall>p. (\<forall>n. Fin n < #p \<longrightarrow> snth n p \<notin> X) \<longrightarrow> sfilter X\<cdot>(stake k\<cdot>p) = \<epsilon>"
apply (induct_tac k, auto)
apply (rule_tac x=p in scases, auto)
apply (case_tac "a\<in>X", auto)
apply (erule_tac x="0" in allE, simp)
apply (case_tac "n", auto)
apply (erule_tac x="s" in allE, auto)
by (erule_tac x="Suc n" in allE, auto)

text \<open>@{term sfilter} returns \<open>\<epsilon>\<close> if no element is included in the filter\<close>
lemma ex_snth_in_sfilter_nempty:
  "(\<forall>n. Fin n < #p \<longrightarrow> snth n p \<notin> X) \<Longrightarrow> sfilter X\<cdot>p = \<epsilon>"
apply (subgoal_tac "sfilter X\<cdot>p = (\<Squnion>k. sfilter X\<cdot>(stake k\<cdot>p))")
apply (erule ssubst)
apply (subst lub_eq_bottom_iff, simp)
apply (subst sfilter_empty_snths_nin_lemma, simp+)
apply (subst contlub_cfun_arg [THEN sym], simp)
by (simp add: reach_stream)

text \<open>@{term sfilter} returns the original streams if every element is included in the filter\<close>
lemma sfilter_snths_in_lemma:
  "\<forall>p. (\<forall>n. Fin n < #p \<longrightarrow> snth n p \<in> X) \<longrightarrow> sfilter X\<cdot>(stake k\<cdot>p) = stake k\<cdot>p"
  apply (induct_tac k, auto)
  apply (rule_tac x=p in scases, auto)
  apply (case_tac "a\<in>X", auto)
   apply (case_tac "n", auto)
   apply (erule_tac x="s" in allE, auto)
   apply (erule_tac x="Suc n" in allE, auto)
  by (erule_tac x="0" in allE, simp)

lemma sfilter_snths_in_stream_lemma:assumes a1:" \<And> n . Fin n <#p  \<Longrightarrow> snth n p \<in> X"
  shows  " p =  sfilter X\<cdot>(p)"
  apply (subst reach_stream [THEN sym], rule sym)
  apply (subst reach_stream [THEN sym],case_tac "#p=\<infinity>")
   apply(smt Inf.INF_cong a1 approxl1 assms monofun_cfun_arg sfilter_snths_in_lemma slen_stake_fst_inf stream.take_below)
  by (metis (no_types, hide_lams) assms infI  fin2stake sfilter_snths_in_lemma)

text \<open>The filtered stream is at most as long as the original one\<close>
lemma slen_sfilterl1: "#(sfilter S\<cdot>x) \<le> #x"
apply (rule ind [of _ x], auto)
apply (subst lnle_def, simp del: lnle_conv)
apply (case_tac "a \<in> S", auto)
by (rule trans_lnle, auto)

text \<open>If the filtered stream is infinite, the original one is infinite as well\<close>
lemma sfilterl4:
  "#(sfilter X\<cdot>x) = \<infinity> \<Longrightarrow> #x = \<infinity>"
by (insert slen_sfilterl1 [of X x], auto)

text \<open>Prepending to the original stream never shortens the filtered result\<close>
lemma sfilterl2:
  "\<forall>z. #(sfilter X\<cdot>s) \<le> #(sfilter X\<cdot>((stake n\<cdot>z) \<bullet> s))"
apply (induct_tac n, auto)
apply (rule_tac x=z in scases, auto)
apply (case_tac "a\<in>X", auto)
apply (erule_tac x="sa" in allE)
by (drule trans_lnle, auto)

text \<open>The filtered result is not changed by concatenating streams which are
  filtered to \<open>\<epsilon>\<close>\<close>
lemma sfilterl3:
  "\<forall>s. #s = Fin k \<and> sfilter S\<cdot>s = \<epsilon> \<longrightarrow>
       sfilter S\<cdot>(s\<bullet>Z) = sfilter S\<cdot>Z"
apply (induct_tac k, auto)
apply (rule_tac x=s in scases, auto)
by (case_tac "a \<in> S", auto)

text \<open>A stream can be split by @{term stake} and @{term sdrop} for filtering\<close>
lemma split_sfilter: "sfilter X\<cdot>x = sfilter X\<cdot>(stake n\<cdot>x) \<bullet> sfilter X\<cdot>(sdrop n\<cdot>x)"
apply (rule_tac x=x in spec)
apply (induct_tac n, simp)
apply (rule allI)
apply (rule_tac x=x in scases, simp)
apply (erule_tac x="s" in allE, auto)
by (case_tac "a \<in> X", auto)

text \<open>double filtering\<close>
lemma int_sfilterl1[simp]: "sfilter S\<cdot>(sfilter M\<cdot>s) = sfilter (S \<inter> M)\<cdot>s"
apply (rule ind [of _ s], auto)
apply (case_tac "a \<in> S \<inter> M", auto)
by (case_tac "a \<in> M", auto)

text \<open>Streams can be split for filtering\<close>
lemma add_sfilter:
  "#x = Fin k \<Longrightarrow> sfilter t\<cdot>(x \<bullet> y) = sfilter t\<cdot>x \<bullet> sfilter t\<cdot>y"
apply (simp add: atomize_imp)
apply (rule_tac x="y" in spec)
apply (rule_tac x="x" in spec)
apply (induct_tac k, auto)
apply (rule_tac x="x" in scases, auto)
by (case_tac "a \<in> t", auto)

text \<open>After applying @{term "smap f"}, all elements are in the range of @{term f}\<close>
lemma sfilter_smap_nrange:
  "m \<notin> range f \<Longrightarrow> sfilter {m}\<cdot>(smap f\<cdot>x) = \<epsilon>"
apply (rule ex_snth_in_sfilter_nempty [rule_format], simp)
apply (subst smap_snth_lemma, simp+)
apply (rule notI)
apply (drule sym)
by (drule_tac f="f" in range_eqI, simp)

lemma sfilter_lub_inf: assumes "\<And>n. \<exists>i. Fin n \<le> #(A \<ominus> (Y i))" and "chain Y"
  shows " #(A \<ominus> (\<Squnion>i. Y i)) = \<infinity>"
proof(rule ccontr)
  assume as: "#(A \<ominus> (\<Squnion>i::nat. Y i)) \<noteq> \<infinity>"
  obtain n where n_def:"#(A \<ominus> (\<Squnion>i. Y i)) = Fin n"
    using as lncases by auto
  obtain i where i_def:"Fin (Suc n) \<le>  #(A \<ominus> (Y i))"
    using assms(1) by blast
  have "#(A \<ominus> (Y i)) \<le> #(A \<ominus> (\<Squnion>i::nat. Y i))"
    using assms(2) cont_pref_eq1I is_ub_thelub mono_slen by blast
  thus False
    using dual_order.trans i_def n_def by fastforce
qed

lemma snth_filter: "Fin n < #s \<Longrightarrow> snth n s\<in>A \<Longrightarrow> sfilter A\<cdot>s \<noteq>\<bottom>"
  apply(induction n arbitrary: s)
  apply auto
  apply (metis lnsuc_neq_0_rev sfilter_in slen_scons strict_slen surj_scons)
  apply(simp add: snth_rt)
  by (metis Fin_02bot Fin_Suc inject_Fin lnzero_def n_not_Suc_n not_le only_empty_has_length_0 sfilter_in sfilter_nin slen_rt_ile_eq slen_scons stream.sel_rews(2) strictI surj_scons)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term stakewhile}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>basic properties of @{term stakewhile}\<close>

(* stakewhile f to an empty stream returns the empty stream *)
lemma strict_stakewhile[simp]: "stakewhile f\<cdot>\<epsilon> = \<epsilon>"
by (subst stakewhile_def [THEN fix_eq2], simp)

(* if the head a passes the predicate f, then the result of stakewhile will start with \<up>a *)
lemma stakewhile_t[simp]: "f a \<Longrightarrow> stakewhile f\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> stakewhile f\<cdot>s"
by (subst stakewhile_def [THEN fix_eq2], simp)

(* if the head a fails the predicate f, then stakewhile will produce the empty stream *)
lemma stakewhile_f[simp]: "\<not>f a \<Longrightarrow> stakewhile f\<cdot>(\<up>a \<bullet> s) = \<epsilon>"
by (subst stakewhile_def [THEN fix_eq2], simp)

(* if the element a passes the predicate f, then stakewhile applied to \<up>a is a no-op *)
lemma [simp]: "f a \<Longrightarrow> stakewhile f\<cdot>(\<up>a) = \<up>a"
by (subst stakewhile_def [THEN fix_eq2], simp)

(* if the element a fails the predicate f, then stakewhile applied to \<up>a will produce the empty stream *)
lemma [simp]: "\<not>f a \<Longrightarrow> stakewhile f\<cdot>(\<up>a) = \<epsilon>"
by (subst stakewhile_def [THEN fix_eq2], simp)

(* stakewhile can't increase the length of a stream *)
lemma stakewhile_less [simp]: "#(stakewhile f\<cdot>s)\<le>#s"
apply(rule ind [of _ s], auto)
apply (metis (mono_tags, lifting) admI inf_chainl4 inf_ub l42)
by (metis bot_is_0 lnle_def lnsuc_lnle_emb minimal slen_empty_eq slen_scons stakewhile_f stakewhile_t)

(* stakewhile doesn't take elements past an element that fails the predicate f *)
lemma stakewhile_slen[simp]: "\<not>f (snth n s) \<Longrightarrow> #(stakewhile f\<cdot>s)\<le>Fin n"
apply(induction n arbitrary: s)
apply (metis Fin_02bot lnat_po_eq_conv lnzero_def sdrop_0 slen_empty_eq snth_def stakewhile_f strict_stakewhile surj_scons)
by (smt inject_scons slen_rt_ile_eq snth_rt stakewhile_f stakewhile_t stream.take_strict strict_stakewhile surj_scons ub_slen_stake)

(* the prefix of the constant stream of x's whose elements aren't equal to x is empty *)
lemma [simp]: "stakewhile (\<lambda>a. a \<noteq> x)\<cdot>\<up>x\<^sup>\<infinity> = \<epsilon>"
by (metis (full_types)sinftimes_unfold stakewhile_f)

(* stakewhile produces a prefix of the input *)
lemma stakewhile_below[simp]: "stakewhile f\<cdot>s \<sqsubseteq> s"
apply(induction s)
apply(simp+)
by (smt minimal monofun_cfun_arg stakewhile_f stakewhile_t stream.con_rews(2) stream.sel_rews(5) surj_scons)

(* if stakewhile leaves a stream s unchanged, then every element must pass the predicate f *)
lemma stakewhile_id_snth: assumes "stakewhile f\<cdot>s = s" and "Fin n < #s"
shows "f (snth n s)"
by (metis Fin_leq_Suc_leq assms(1) assms(2) less2eq less2lnleD lnless_def stakewhile_slen)

(* if stakewhile produces a result of length n or greater, then the nth element in s must pass f *)
lemma stakewhile_snth[simp]: assumes  "Fin n < #(stakewhile f\<cdot>s)"
shows "f (snth n s)"
by (meson assms not_less stakewhile_slen)

(* if stakewhile changes the stream s, then there must be an element in s that fails the predicate f *)
lemma stakewhile_notin [simp]:
  shows "stakewhile f\<cdot>s \<noteq> s \<Longrightarrow> #(stakewhile f\<cdot>s) = Fin n \<Longrightarrow> \<not> f (snth n s)"
  apply(induction n arbitrary:s)
   apply (metis Fin_02bot lnat.con_rews slen_scons snth_shd stakewhile_t surj_scons)
  by (smt Fin_02bot Fin_Suc approxl2 inject_scons lnat.con_rews lnat_po_eq_conv lnsuc_lnle_emb lnzero_def slen_empty_eq slen_rt_ile_eq snth_rt snth_shd stakewhile_below stakewhile_slen stakewhile_t stream.take_strict surj_scons ub_slen_stake)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term stwbl}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>basic properties for @{term stwbl}\<close>

(* stwbl f to an empty stream returns the empty stream *)
lemma strict_stwbl[simp]: "stwbl f\<cdot>\<epsilon> = \<epsilon>"
by (subst stwbl_def [THEN fix_eq2], simp)

(* if the head a passes the predicate f, then the result of stwbl will start with \<up>a *)
lemma stwbl_t[simp]: "f a \<Longrightarrow> stwbl f\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> stwbl f\<cdot>s"
by (subst stwbl_def [THEN fix_eq2], simp)

(* if the head a fails the predicate f, then stwbl will produce only \<up>a *)
lemma stwbl_f[simp]: "\<not> f a \<Longrightarrow> stwbl f\<cdot>(\<up>a \<bullet> s) = \<up>a"
by (subst stwbl_def [THEN fix_eq2], simp)

(* if s is not empty, then stwbl f also does not return the empty stream *)
lemma stwbl_notEps: "s\<noteq>\<epsilon> \<Longrightarrow> (stwbl f\<cdot>s)\<noteq>\<epsilon>"
by (smt lnat.con_rews lnzero_def sconc_snd_empty slen_scons strict_slen stwbl_f stwbl_t surj_scons)

(* if stwbl f applied to s returns the empty stream, then s was empty *)
lemma stwbl_eps: "stwbl f\<cdot>s = \<epsilon> \<longleftrightarrow> s=\<epsilon>"
using strict_stwbl stwbl_notEps by blast

text \<open>@{term sfilter} after @{term stakewhile}: produce the empty stream\<close>
lemma sfilter_twl1[simp]:
  "sfilter X\<cdot>(stakewhile (\<lambda>x. x\<notin>X)\<cdot>p) = \<epsilon>"
apply (rule ind [of _ p], auto)
by (case_tac "a\<in>X", auto)

text \<open>@{term sfilter} after @{term stakewhile}: redundant filtering\<close>
lemma sfilter_twl2[simp]:
  "sfilter X\<cdot>(stakewhile (\<lambda>x. x\<in>X)\<cdot>p) = stakewhile (\<lambda>x. x\<in>X)\<cdot>p"
apply (rule ind [of _ p], auto)
by (case_tac "a\<in>X", auto)

text \<open>If @{term "stakewhile (\<lambda>p. p = t)"} returns an infinite stream, all prefixes
  of the original stream only consist of "@{term t}"s\<close>
lemma stakewhile_sinftimes_lemma:
  "\<forall>z. #(stakewhile (\<lambda>p. p = t)\<cdot>z) = \<infinity> \<longrightarrow> stake n\<cdot>z = stake n\<cdot>(sinftimes (\<up>t))"
apply (induct_tac n, auto)
apply (subst sinftimes_unfold, simp)
apply (rule_tac x=z in scases, auto)
by (case_tac "a=t", auto)

text \<open>If @{term "stakewhile (\<lambda>p. p = t)"} returns an infinite stream, the original stream
  is an infinite "@{term t}"-stream\<close>
lemma stakewhile_sinftimesup:
  "#(stakewhile (\<lambda>p. p = t)\<cdot>z) = \<infinity> \<Longrightarrow> z = sinftimes (\<up>t)"
apply (rule stream.take_lemma)
by (rule stakewhile_sinftimes_lemma [rule_format])

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sdropwhile}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>basic properties for @{term sdropwhile}\<close>

(* sdropwhile f applied to the empty stream returns the empty stream *)
lemma strict_sdropwhile[simp]: "sdropwhile f\<cdot>\<epsilon> = \<epsilon>"
by (subst sdropwhile_def [THEN fix_eq2], simp)

(* if the head a passes the predicate f, then the result of sdropwhile will drop the head *)
lemma sdropwhile_t[simp]: "f a \<Longrightarrow> sdropwhile f\<cdot>(\<up>a \<bullet> s) = sdropwhile f\<cdot>s"
by (subst sdropwhile_def [THEN fix_eq2], simp)

(* if the head a fails the predicate f, then the result of sdropwhile will start with \<up>a *)
lemma sdropwhile_f[simp]: "\<not>f a \<Longrightarrow> sdropwhile f\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> s"
by (subst sdropwhile_def [THEN fix_eq2], simp)

(* if the only element in a singleton stream passes the predicate f, then sdropwhile will produce
   the empty stream *)
lemma [simp]: "f a \<Longrightarrow> sdropwhile f\<cdot>(\<up>a) = \<epsilon>"
by (subst sdropwhile_def [THEN fix_eq2], simp)

(* if the only element in a singleton stream fails the predicate f, then sdropwhile will be a no-op *)
lemma [simp]: "\<not>f a \<Longrightarrow> sdropwhile f\<cdot>(\<up>a) = \<up>a"
by (subst sdropwhile_def [THEN fix_eq2], simp)

text \<open>special cases of @{term sfilter} after @{term sdropwhile}\<close>

(* the elements removed by sdropwhile are a subset of the elements removed by sfilter *)
lemma sfilter_dwl1[simp]:
  "sfilter X\<cdot>(sdropwhile (\<lambda>x. x\<notin>X)\<cdot>p) = sfilter X\<cdot>p"
apply (rule ind [of _ p], auto)
by (case_tac "a\<in>X", auto)

(* the elements kept by sfilter are a subset of the elements kept by sdropwhile *)
lemma sfilter_dwl2:
  "sfilter T\<cdot>s \<noteq> \<epsilon> \<Longrightarrow> sdropwhile (\<lambda>a. a \<notin> T)\<cdot>s \<noteq> \<epsilon>"
apply (rule notI)
apply (erule notE)
apply (subst sfilter_dwl1 [THEN sym])
by simp

text \<open>Construct @{term stwbl} from @{term stakewhile}, @{term stake} and @{term sdropwhile}\<close>
lemma stwbl_stakewhile: "stwbl f\<cdot>s = stakewhile f\<cdot>s \<bullet> (stake (Suc 0)\<cdot>(sdropwhile f\<cdot>s))"
apply (rule stream.take_lemma)
apply (rule_tac x="s" in spec)
apply (induct_tac n, simp+)
apply (rule allI)
apply (rule_tac x="x" in scases, simp+)
by (case_tac "f a", simp+)

text \<open>Constructing @{term sdropwhile} from @{term stakewhile} and @{term sdrop}\<close>
lemma stakewhile_sdropwhilel1:
  "\<forall>x. #(stakewhile f\<cdot>x) = Fin n \<longrightarrow> sdropwhile f\<cdot>x = sdrop n\<cdot>x"
apply (induct_tac n, auto)
apply (rule_tac x=x in scases, auto)
apply (case_tac "f a", auto)
apply (rule_tac x=x in scases, auto)
by (case_tac "f a", auto)

text \<open>@{term sdropwhile} is idempotent\<close>
lemma sdropwhile_idem: "sdropwhile f\<cdot>(sdropwhile f\<cdot>x) = sdropwhile f\<cdot>x"
apply (rule ind [of _ x], auto)
by (case_tac "f a", auto)

text \<open>@{term stakewhile} after @{term sdropwhile} gives the empty stream\<close>
lemma tdw[simp]: "stakewhile f\<cdot>(sdropwhile f\<cdot>s) = \<epsilon>"
apply (rule ind [of _ s], auto)
by (case_tac "f a", auto)

(* relation between stakewhile and sdropwhile *)
lemma stakewhileDropwhile: "stakewhile f\<cdot>s \<bullet> (sdropwhile f\<cdot>s) = s "
apply(rule ind [of _s])
apply (rule admI)
apply (metis (no_types, lifting) approxl2 inf_chainl4 lub_eqI lub_finch2 sconc_fst_inf split_streaml1 stakewhile_below stakewhile_sdropwhilel1)
apply simp
by (metis assoc_sconc sconc_fst_empty sdropwhile_f sdropwhile_t stakewhile_t tdw)

text \<open>For the head of @{term "sdropwhile f\<cdot>x"}, @{term f} does not hold\<close>
lemma sdropwhile_resup: "sdropwhile f\<cdot>x = \<up>a \<bullet> s \<Longrightarrow> \<not> f a"
apply (subgoal_tac "sdropwhile f\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> s")
apply (case_tac "f a", auto)
apply rotate_tac
apply (drule cfun_arg_cong [of _ _ "stakewhile f"], simp)
apply (drule sym, simp)
by (rule sdropwhile_idem)

text \<open>elimination rule for @{term sfilter} after @{term sdropwhile}\<close>
lemma sfilter_srtdwl3[simp]:
  "sfilter X\<cdot>(srt\<cdot>(sdropwhile (\<lambda>x. x\<notin>X)\<cdot>p)) = srt\<cdot>(sfilter X\<cdot>p)"
apply (rule ind [of _ p], auto)
by (case_tac "a\<in>X", auto)

text \<open>Further results concerning @{term sfilter}\<close>

text \<open>After filtering by filter @{term T}, the head of the result is in @{term T}
  (for non-empty results)\<close>
lemma sfilter_ne_resup: "sfilter T\<cdot>s \<noteq> \<epsilon> \<Longrightarrow> shd (sfilter T\<cdot>s) \<in> T"
apply (subst sfilter_dwl1 [THEN sym])
apply (rule_tac x="sdropwhile (\<lambda>x. x \<notin> T)\<cdot>s" in scases, auto)
apply (drule sfilter_dwl2, simp)
apply (rule_tac x="s" in scases, auto)
apply (case_tac "aa \<in> T", auto)
apply (drule inject_scons, simp)
by (drule sdropwhile_resup, simp)

text \<open>same result for @{term sconc} syntax\<close>
lemma sfilter_resl2:
  "sfilter T\<cdot>s = \<up>a \<bullet> as \<Longrightarrow> a \<in> T"
apply (case_tac "sfilter T\<cdot>s = \<epsilon>", simp)
by (drule sfilter_ne_resup, simp)

text \<open>After filtering with filter @{term T}, each element is in @{term T}\<close>
lemma sfilterl7:
  "\<lbrakk>Fin n < #x; sfilter T\<cdot>s = x\<rbrakk> \<Longrightarrow> snth n x \<in> T"
apply (simp add: atomize_imp)
apply (rule_tac x="s" in spec)
apply (rule_tac x="x" in spec)
apply (induct_tac n, auto)
apply (rule sfilter_ne_resup)
apply (rule_tac x="sfilter T\<cdot>xa" in scases, auto)
apply (rule_tac x="xa" in scases, auto)
apply (simp add: Fin_Suc [THEN sym] del: Fin_Suc)
apply (case_tac "a \<in> T", auto)
apply (case_tac "sfilter T\<cdot>s = \<epsilon>",simp+)
apply (simp add: Fin_Suc [THEN sym] del: Fin_Suc)
apply (rule_tac x="sfilter T\<cdot>s" in scases, auto)
apply (erule_tac x="sa" in allE,simp+)
apply (frule sfilter_resl2)
apply (drule mp)
by (rule_tac x="srt\<cdot>(sdropwhile (\<lambda>x. x\<notin>T)\<cdot>s)" in exI,simp+)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term srtdw}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>basic properties of @{term srtdw}\<close>

(* srtdw f applied to the empty stream always returns the empty stream *)
lemma [simp]: "srtdw f\<cdot>\<epsilon> = \<epsilon>"
by (simp add: srtdw_def)

(* the rest of any singleton stream is the empty stream, regardless of whether the only element in
   the stream was dropped *)
lemma [simp]: "srtdw f\<cdot>(\<up>a) = \<epsilon>"
apply (simp add: srtdw_def)
by (case_tac "f a", auto)

(* if the head a passes the predicate f, srtdw will drop the head *)
lemma [simp]: "f a \<Longrightarrow> srtdw f\<cdot>(\<up>a\<bullet>as) = srtdw f\<cdot>as"
by (auto simp add: srtdw_def)

(* if the head a fails the predicate f, srtdw will produce the rest of the stream *)
lemma [simp]: "\<not> f a \<Longrightarrow> srtdw f\<cdot>(\<up>a\<bullet>as) = as"
by (simp add: srtdw_def)

text \<open>@{term "sfilter M"} after @{term "srtdw (\<lambda>x. x \<notin> M)"} almost behaves
  like @{term "sfilter M"} alone\<close>
lemma sfilterl8:
  "sfilter M\<cdot>x \<noteq> \<epsilon> \<Longrightarrow>
    #(sfilter M\<cdot>x) = lnsuc\<cdot>(#(sfilter M\<cdot>(srtdw (\<lambda>x. x \<notin> M)\<cdot>x)))"
apply (simp add: atomize_imp)
apply (rule ind [of _ x], simp+)
apply (rule impI)
by (case_tac "a \<in> M", simp+)

text \<open>similar result for infinite streams\<close>
lemma sfilter_srtdwl2:
  "#(sfilter X\<cdot>s) = \<infinity> \<Longrightarrow> #(sfilter X\<cdot>(srtdw (\<lambda>a. a \<notin> X)\<cdot>s)) = \<infinity>"
apply (case_tac "sfilter X\<cdot>s = \<epsilon>", auto)
by (drule sfilterl8, auto)

text \<open>streams can be split by @{term stwbl} and @{term srtdw}\<close>
lemma stwbl_srtdw: "stwbl f\<cdot>s \<bullet> srtdw f\<cdot>s = s"
apply (rule stream.take_lemma)
apply (rule_tac x="s" in spec)
apply (induct_tac n, simp+)
apply (rule allI)
apply (rule_tac x="x" in scases, simp+)
by (case_tac "f a", simp+)

(* the length of srtdw f\<cdot>x is always smaller than the length of x *)
lemma slen_srtdw: "#(srtdw f\<cdot>x) \<le> #x"
apply (rule ind [of _ x])
apply (subst lnle_conv [THEN sym], simp del: lnle_conv, simp)
apply (case_tac "f a", simp+)
by (rule trans_lnle, simp+)

(* stwbl produces a prefix of the input *)
lemma stwbl_below [simp]: "stwbl f\<cdot>s \<sqsubseteq> s"
by (metis (no_types) minimal monofun_cfun_arg sconc_snd_empty stwbl_srtdw)

(* relation between srtdw and stwbl *)
lemma srtdw_stwbl [simp]: "srtdw f\<cdot> (stwbl f\<cdot>s) = \<epsilon>" (is "?F s")
proof(rule ind [of _s ])
  show "adm ?F" by simp
  show "?F \<epsilon>" by simp
  fix a
  fix s
  assume IH: "?F s"
  thus "?F (\<up>a \<bullet> s)"
  proof (cases "f a")
    case True thus ?thesis by (simp add: IH)
  next
    case False thus ?thesis by simp
  qed
qed

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term srcdups}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Basic simplification rules for @{term srcdups}\<close>

(* srcdups applied to the empty stream returns the empty stream *)
lemma strict_srcdups[simp]: "srcdups\<cdot>\<epsilon> = \<epsilon>"
by (subst srcdups_def [THEN fix_eq2], simp)

(* a singleton stream can't possibly contain duplicates *)
lemma [simp]: "srcdups\<cdot>(\<up>a) = \<up>a"
by (subst srcdups_def [THEN fix_eq2], simp)

(* if the head a of a stream is followed by a duplicate, only one of the two elements will be kept by srcdups *)
lemma srcdups_eq[simp]: "srcdups\<cdot>(\<up>a\<bullet>\<up>a\<bullet>s) = srcdups\<cdot>(\<up>a\<bullet>s)"
apply (subst srcdups_def [THEN fix_eq2], simp)
by (rule sym, subst srcdups_def [THEN fix_eq2], simp)

(* if the head a of a stream is followed by a distinct element, both elements will be keypt by srcdups *)
lemma srcdups_neq[simp]:
  "a\<noteq>b \<Longrightarrow> srcdups\<cdot>(\<up>a \<bullet> \<up>b \<bullet> s) = \<up>a \<bullet>  srcdups\<cdot>(\<up>b \<bullet> s)"
  by (subst srcdups_def [THEN fix_eq2], simp)

lemma srcdups_slen [simp]: "#(srcdups\<cdot>s) \<le> #s"
  apply (rule ind [of _ s])
  apply (simp_all)
  apply (metis (mono_tags, lifting) admI inf_chainl4 inf_ub l42)
  apply (rule_tac x=s in scases, simp_all)
  apply (case_tac "a = aa", simp_all)
  using less_lnsuc order.trans by blast

(*Used for ABP-Composition of sender and receiver*)
lemma srcdups_eq2:"a=b \<Longrightarrow> srcdups\<cdot>(\<up>a\<bullet>\<up>b\<bullet>s) = srcdups\<cdot>(\<up>b\<bullet>s)"
  by simp

lemma srcdups_ex:"\<exists>y. srcdups\<cdot>(\<up>a\<bullet>s) = \<up>a\<bullet>y"
  by(subst srcdups_def [THEN fix_eq2], auto)

lemma srcdups_shd[simp]:"shd (srcdups\<cdot>(\<up>a\<bullet>s)) = a"
  by(subst srcdups_def [THEN fix_eq2],auto)

lemma srcdups_srt:"srt\<cdot>(srcdups\<cdot>(\<up>a\<bullet>s)) = (srcdups\<cdot>(sdropwhile (\<lambda>z. z = a)\<cdot>s))"
  by(subst srcdups_def [THEN fix_eq2], auto)

lemma srcdups_shd2[simp]:"s\<noteq>\<epsilon> \<Longrightarrow> shd (srcdups\<cdot>s) = shd s"
  by(subst srcdups_def [THEN fix_eq2],auto)

lemma srcdups_srt2:"s\<noteq>\<epsilon> \<Longrightarrow> srt\<cdot>(srcdups\<cdot>s) = (srcdups\<cdot>(sdropwhile (\<lambda>z. z = shd s)\<cdot>(srt\<cdot>s)))"
  by(subst srcdups_def [THEN fix_eq2],auto)

lemma srcdups_imposs_h:"Fin 1 < #(srcdups\<cdot>s) \<Longrightarrow> shd(srcdups\<cdot>s)\<noteq>shd(srt\<cdot>(srcdups\<cdot>s))"
  apply (cases "s=\<epsilon>")
  using empty_is_shortest apply fastforce
  apply (subst srcdups_srt2,auto)
  apply (subgoal_tac "srcdups\<cdot>(sdropwhile (\<lambda>z. z = shd s)\<cdot>(srt\<cdot>s))\<noteq>\<epsilon>")
  apply (metis (mono_tags, lifting) sdropwhile_resup srcdups_shd2 strict_srcdups surj_scons)
proof -
  assume a1: "s \<noteq> \<epsilon>"
  assume a2: "Fin 1 < #(srcdups\<cdot>s)"
  have f1:"Fin 0 = 0"
    using Fin_02bot bot_is_0 by presburger
  then have "lnsuc\<cdot>0 = Fin (Suc 0)"
    by (metis Fin_Suc)
  then show "srcdups\<cdot> (sdropwhile (\<lambda>a. a = shd s)\<cdot>(srt\<cdot>s)) \<noteq> \<epsilon>"
    using a2 a1 f1
    by (metis Suc_leI less2nat not_le not_one_le_zero srcdups_srt2 srt_decrements_length strict_slen zero_le_one)
qed

lemma srcdups_imposs:"srcdups\<cdot>(\<up>a \<bullet> s) \<noteq> \<up>a \<bullet> \<up>a \<bullet> y"
  apply(cases "#(srcdups\<cdot>(\<up>a \<bullet>s)) < Fin 1 ")
  apply (metis One_nat_def bot_is_0 lnat.con_rews neq02Suclnle not_less slen_scons)
  apply(insert srcdups_imposs_h[of "\<up>a\<bullet> s"])
  by (metis Fin_02bot Fin_Suc One_nat_def lnat.con_rews lnat.sel_rews(2) lscons_conv neq_iff shd1
      slen_scons stream.sel_rews(5) up_defined)

lemma srcdupsimposs: "srcdups\<cdot>(\<up>a \<bullet> s) \<noteq> \<up>a \<bullet> \<up>a \<bullet> srcdups\<cdot>s"
  by (simp add: srcdups_imposs)

lemma srcdupsimposs2_h2:"\<forall>x. srcdups\<cdot>(\<up>a \<bullet> s)\<noteq> \<up>a \<bullet> \<up>a \<bullet> x"
  by (simp add: srcdups_imposs)

lemma srcdupsimposs2: "srcdups\<cdot>(\<up>a \<bullet> s) \<noteq> \<up>a \<bullet> \<up>a \<bullet> s"
  by(simp add: srcdups_imposs)

lemma srcdups_anotb_h:"srcdups\<cdot>(\<up>a\<bullet>\<up>b) = \<up>a \<bullet> \<up>b \<Longrightarrow> a \<noteq> b"
  by (metis sconc_snd_empty srcdups_imposs)

lemma srcdups_anotb:"srcdups\<cdot>(\<up>a \<bullet> \<up>b \<bullet> s) = \<up>a \<bullet> \<up>b \<bullet> s \<Longrightarrow> a\<noteq> b"
  using srcdupsimposs2_h2 by auto

lemma srcdups2srcdups: "srcdups\<cdot>(srcdups\<cdot>s) = srcdups\<cdot>s"
proof(induction rule: ind [of _ s])
  case 1
  then show ?case
    by simp
next
  case 2
  then show ?case
    by simp
next
  case (3 a s)
  have f1:"a = shd s \<Longrightarrow> s\<noteq>\<epsilon>\<Longrightarrow> srcdups\<cdot>(\<up>a \<bullet> s) = srcdups\<cdot>s"
    using srcdups_eq[of "shd s" "srt\<cdot>s"] surj_scons[of s] by auto
  have f2:"a=shd s \<Longrightarrow> s\<noteq>\<epsilon> \<Longrightarrow> srcdups\<cdot>(srcdups\<cdot>(\<up>a \<bullet> s)) = srcdups\<cdot>(\<up>a \<bullet> s)"
    using f1 "3.IH" by auto
  moreover have"a\<noteq>shd s \<Longrightarrow> srcdups\<cdot>(\<up>a \<bullet> s) = \<up>a\<bullet>srcdups\<cdot>s"
    by (metis srcdups_neq srcdups_shd srcdups_srt strict_sdropwhile surj_scons)
  ultimately have f3:"a\<noteq> shd s \<Longrightarrow>srcdups\<cdot>(srcdups\<cdot>(\<up>a \<bullet> s)) = srcdups\<cdot>(\<up>a \<bullet> s)"
  proof -
    assume a1: "a \<noteq> shd s"
    then have f2: "srcdups\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> srcdups\<cdot>s"
      by (metis \<open>a \<noteq> shd s \<Longrightarrow> srcdups\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> srcdups\<cdot>s\<close>)
    obtain ss :: "'a stream \<Rightarrow> 'a \<Rightarrow> 'a stream" where
      f3: "\<forall>a s. srcdups\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> ss s a"
      by (meson srcdups_ex)
    then have f4: "\<up>(shd s) \<bullet> srt\<cdot>s = s \<longrightarrow> srcdups\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> \<up>(shd s) \<bullet> ss (srt\<cdot>s) (shd s)"
      using f2 by metis
    have f5: "\<up>(shd s) \<bullet> srt\<cdot>s = s \<longrightarrow> srcdups\<cdot>(\<up>(shd s) \<bullet> ss (srt\<cdot>s) (shd s)) = srcdups\<cdot>s"
      using f3 by (metis "3.IH")
    { assume "\<up>a \<bullet> s \<noteq> srcdups\<cdot>(\<up>a \<bullet> s)"
      then have "s \<noteq> \<epsilon>"
        by force
      then have ?thesis
        using f5 f4 f2 a1 by (simp add: surj_scons) }
    then show ?thesis
      by fastforce
  qed
  then show ?case
    using f2 by fastforce
qed

lemma srcdups_prefix_neq:"x \<sqsubseteq> y \<Longrightarrow> srcdups\<cdot>x \<noteq>x \<Longrightarrow> srcdups\<cdot>y \<noteq> y"
proof(induction arbitrary: y rule: ind [of _ x])
    case 1
    then show ?case
      by simp
  next
    case 2
    then show ?case
      by simp
  next
    case (3 a s)
    have f1:"a=shd s \<Longrightarrow> srcdups\<cdot>(\<up>a \<bullet> s) = srcdups\<cdot>s"
      by (metis "3.prems"(2) srcdups_eq2 srcdups_shd srcdups_srt strict_sdropwhile strict_srcdups surj_scons)
    have f2:"a\<noteq>shd s \<Longrightarrow> srcdups\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> srcdups\<cdot>s"
      by (metis srcdups_neq srcdups_shd srcdups_srt strict_sdropwhile surj_scons)
    then have f3:"a\<noteq>shd s\<Longrightarrow> srcdups\<cdot>s \<noteq> s"
      using "3.prems" by auto
    show ?case
      by (smt "3.IH" "3.prems"(1) f1 f2 f3 less_fst_sconsD lscons_conv scases srcdups2srcdups
         srcdups_eq srcdups_ex srcdups_srt srcdupsimposs2 stream.con_rews(2) stream.sel_rews(5)
         sup'_def surj_scons)
qed

lemma srcdups_smap_adm [simp]:
  "adm (\<lambda>a. srcdups\<cdot>(smap f\<cdot>(srcdups\<cdot>a)) = smap f\<cdot>(srcdups\<cdot>a)
    \<longrightarrow> srcdups\<cdot>(smap f\<cdot>a) = smap f\<cdot>(srcdups\<cdot>a))"
  apply (rule adm_imp, auto)
  apply(rule adm_upward)
  apply rule+
  using srcdups_prefix_neq
  by (metis monofun_cfun_arg)

lemma srcdups_smap_com_h:"s\<noteq>\<epsilon> \<Longrightarrow> a \<noteq> shd s \<Longrightarrow> srcdups\<cdot>(smap f\<cdot>(srcdups\<cdot>(\<up>a \<bullet> s))) = smap f\<cdot>(srcdups\<cdot>(\<up>a \<bullet> s)) \<Longrightarrow>f (shd s) \<noteq> f a"
  apply(cases "shd(srt\<cdot>s) \<noteq> shd s")
  apply (insert srcdups_neq[of a "shd s" "srt\<cdot>s"] surj_scons[of s], simp)
  apply (metis smap_scons srcdups_ex srcdupsimposs2_h2)
  apply (insert srcdups_neq[of a "shd s" "srt\<cdot>s"] surj_scons[of s], simp)
  apply(insert srcdups_ex[of "shd s" "srt\<cdot>s"],auto)
  by (simp add: srcdupsimposs2_h2)

lemma srcdups_smap_com:
  shows "srcdups\<cdot>(smap f\<cdot>(srcdups\<cdot>s)) = smap f\<cdot>(srcdups\<cdot>s) \<Longrightarrow> srcdups\<cdot>(smap f\<cdot>s)= smap f\<cdot>(srcdups\<cdot>s)"
  proof(induction rule: ind [of _ s])
    case 1
    then show ?case
      by simp
  next
    case 2
    then show ?case
      by simp
  next
    case (3 a s)
    have s_eps: "s = \<bottom> \<Longrightarrow>  srcdups\<cdot>(\<up>(f a) \<bullet> smap f\<cdot>s) = smap f\<cdot>(srcdups\<cdot>(\<up>a \<bullet> s))" by simp
    hence f1: "shd s = a \<Longrightarrow> ?case"
      by (metis "3.IH" "3.prems" smap_scons srcdups_eq surj_scons)
    have h1: "s\<noteq>\<bottom> \<Longrightarrow> s = (\<up>(shd s) \<bullet> srt\<cdot>s)" by (simp add: surj_scons)
    have h2: "s\<noteq>\<bottom> \<Longrightarrow> shd s\<noteq>a \<Longrightarrow>f (shd s) \<noteq> f a \<Longrightarrow> srcdups\<cdot>(smap f\<cdot>(\<up>a \<bullet> (\<up>(shd s) \<bullet> srt\<cdot>s))) = smap f\<cdot>(srcdups\<cdot>(\<up>a \<bullet>  (\<up>(shd s) \<bullet> srt\<cdot>s)))"
    proof -
      assume a1: "f (shd s) \<noteq> f a"
      assume a2: "s \<noteq> \<epsilon>"
      assume a3: "shd s \<noteq> a"
      have f4: "s = \<up>(shd s) \<bullet> srt\<cdot>s"
        using a2 by (metis h1)
      obtain ss :: "'b stream \<Rightarrow> 'b \<Rightarrow> 'b stream" where
        f5: "\<forall>b s. srcdups\<cdot>(\<up>b \<bullet> s) = \<up>b \<bullet> ss s b"
        by (meson srcdups_ex)
      then have f6: "\<up>(shd s) \<bullet> ss (srt\<cdot>s) (shd s) = srcdups\<cdot>s"
        using f4 by metis
      have f7: "srcdups\<cdot> (\<up>(f a) \<bullet> \<up>(f (shd s)) \<bullet> smap f\<cdot> (ss (srt\<cdot>s) (shd s))) = \<up>(f a) \<bullet> srcdups\<cdot> (\<up>(f (shd s)) \<bullet> smap f\<cdot> (ss (srt\<cdot>s) (shd s)))"
        using a1 by auto
      have f8: "\<up>a \<bullet> \<up>(shd s) \<bullet> ss (srt\<cdot>s) (shd s) = srcdups\<cdot>(\<up>a \<bullet> \<up>(shd s) \<bullet> srt\<cdot>s)"
        using f5 a3 by (metis (no_types) srcdups_neq)
      then have f9: "\<up>(f a) \<bullet> \<up>(f (shd s)) \<bullet> smap f\<cdot> (ss (srt\<cdot>s) (shd s)) = smap f\<cdot>(srcdups\<cdot>(\<up>a \<bullet> s))"
        using f4 by (metis (no_types) smap_scons)
      then obtain ssa :: "'a stream \<Rightarrow> 'a \<Rightarrow> 'a stream" where
        f10: "\<up>(f a) \<bullet> ssa (\<up>(f (shd s)) \<bullet> ssa (smap f\<cdot>(ss (srt\<cdot>s) (shd s))) (f (shd s))) (f a) = srcdups\<cdot>(smap f\<cdot>(srcdups\<cdot>(\<up>a \<bullet> s)))"
        by (simp add: "3.prems")
      then have f11: "\<up>(f a) \<bullet> ssa (\<up>(f (shd s)) \<bullet> ssa (smap f\<cdot>(ss (srt\<cdot>s) (shd s))) (f (shd s))) (f a) = srcdups\<cdot> (\<up>(f a) \<bullet> \<up>(f (shd s)) \<bullet> smap f\<cdot> (ss (srt\<cdot>s) (shd s)))"
        using f9 by presburger
      have "\<up>(f a) \<bullet> ssa (\<up>(f (shd s)) \<bullet> ssa (smap f\<cdot>(ss (srt\<cdot>s) (shd s))) (f (shd s))) (f a) = \<up>(f a) \<bullet> smap f\<cdot>(srcdups\<cdot>s)"
        using f10 f8 f6 f4 by (metis (no_types) "3.prems" smap_scons)
      then have "srcdups\<cdot>(smap f\<cdot>s) = smap f\<cdot>(srcdups\<cdot>s)"
        using f11 f7 f6 by (metis (no_types) "3.IH" inject_scons smap_scons)
      then have "srcdups\<cdot> (smap f\<cdot>(\<up>a \<bullet> \<up>(shd s) \<bullet> srt\<cdot>s)) = smap f\<cdot> (\<up>a \<bullet> \<up>(shd s) \<bullet> ss (srt\<cdot>s) (shd s))"
        using f6 f4 a1 by (metis (no_types) smap_scons srcdups_neq)
      then show ?thesis
        using f8 by presburger
    qed
    have f2: "s\<noteq>\<bottom> \<Longrightarrow> shd s\<noteq>a \<Longrightarrow>f (shd s) \<noteq> f a \<Longrightarrow> ?case"
      using h1 h2 by auto
    have f3: "s\<noteq>\<bottom> \<Longrightarrow> shd s\<noteq>a \<Longrightarrow>f (shd s) = f a \<Longrightarrow> ?case"
      by (simp add: "3.prems" srcdups_smap_com_h)
    then show ?case using f1 f2 by fastforce
  qed

lemma srcdups_nbot: "s\<noteq>\<bottom>\<Longrightarrow>srcdups\<cdot>s \<noteq> \<bottom>"
  by (metis lscons_conv srcdups_ex stream.con_rews(2) surj_scons)

lemma srcdups_fin: assumes "#(srcdups\<cdot>s)<\<infinity>" and "#s=\<infinity>"
  obtains x where "srcdups\<cdot>x = srcdups\<cdot>s" and "x\<sqsubseteq>s" and "#x < \<infinity>"
proof -
  obtain n where "srcdups\<cdot>(stake n\<cdot>s) = srcdups\<cdot>s"
    by (metis assms(1) fun_approxl2 min.strict_order_iff ninf2Fin)
  thus ?thesis
    using lnless_def that by auto
qed

lemma srcdups_step: "srcdups\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> srcdups\<cdot>(sdropwhile (\<lambda>x. x=a)\<cdot>s)"
  apply(rule ind [of _ s], simp_all)
  by (metis lscons_conv srcdups_ex srcdups_srt stream.sel_rews(5) up_defined)

lemma snprefix: "\<not>x\<sqsubseteq>y \<Longrightarrow> lshd\<cdot>x=lshd\<cdot>y \<Longrightarrow> \<not>(srt\<cdot>x)\<sqsubseteq>(srt\<cdot>y)"
  apply auto
  by (metis lshd_updis monofun_cfun_arg stream.sel_rews(2) stream.sel_rews(3) sup'_def surj_scons)

lemma srcdups_consec_noteq: "Fin (Suc n) < #(srcdups\<cdot>xs) \<Longrightarrow> snth n (srcdups\<cdot>xs) \<noteq> snth (Suc n) (srcdups\<cdot>xs)"
proof
  fix n :: nat
  assume "Fin (Suc n) < #(srcdups\<cdot>xs)" and "snth n (srcdups\<cdot>xs) = snth (Suc n) (srcdups\<cdot>xs)"
  then obtain a s where "sdrop n\<cdot>(srcdups\<cdot>xs) = \<up>a \<bullet> \<up>a \<bullet> s"
    by (metis convert_inductive_asm drop_not_all sdrop_back_rt snth_def surj_scons)
  then have p: "srcdups\<cdot>(sdrop n\<cdot>(srcdups\<cdot>xs)) \<noteq> sdrop n\<cdot>(srcdups\<cdot>xs)"
    by (simp add: srcdupsimposs2_h2)
  have not_p: "srcdups\<cdot>(sdrop n\<cdot>(srcdups\<cdot>xs)) = sdrop n\<cdot>(srcdups\<cdot>xs)"
  proof -
    have "srcdups\<cdot>(sdrop n\<cdot>(srcdups\<cdot>xs)) = sdrop n\<cdot>(srcdups\<cdot>(srcdups\<cdot>xs))"
    proof (induction n)
      case 0
      then show ?case
        by simp
    next
      case (Suc n)
      then show ?case
        by (metis sdrop_back_rt srcdups2srcdups srcdups_srt2 stream.sel_rews(2))
    qed
    thus "srcdups\<cdot>(sdrop n\<cdot>(srcdups\<cdot>xs)) = sdrop n\<cdot>(srcdups\<cdot>xs)"
      by (simp add: srcdups2srcdups)
  qed
  thus "False"
    using p by auto
qed

lemma bool_stream_snth:
  fixes s t :: "bool stream" and n :: nat and a :: bool
  shows "s = \<up>a \<bullet> t \<longrightarrow> Fin n < #(srcdups\<cdot>s) \<longrightarrow> snth n (srcdups\<cdot>s) = (even n = a)"
proof (induction n)
  case 0
  then show ?case
    by simp
next
  case (Suc n)
  then show ?case
    using convert_inductive_asm even_Suc srcdups_consec_noteq by blast
qed

lemma srcdups_snth_stake_fin: "\<And>s n. #s = Fin k \<Longrightarrow> k > (Suc n) \<Longrightarrow> snth n s \<noteq> snth (Suc n) s \<Longrightarrow> srcdups\<cdot>(stake (Suc n)\<cdot>s) \<noteq> srcdups\<cdot>s"
proof (induction k rule: less_induct)
  case (less k)
  then show ?case
  proof (cases "k \<le> Suc 0")
    case True
    then show ?thesis
      using less.prems(2) by linarith
  next
    case False
    then obtain a b t where "s = \<up>a \<bullet> \<up>b \<bullet> t"
      by (metis drop_not_all leI le_SucI less.prems(1) less2nat_lemma sdrop_0 sdrop_back_rt surj_scons)
    obtain l where "k = Suc l"
      using Suc_less_eq2 less.prems(2) by blast
    then have "l < k"
      by simp
    moreover have "#(\<up>b \<bullet> t) = Fin l"
      using \<open>k = Suc l\<close> \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> less.prems(1) by auto
    then show ?thesis
    proof (cases n)
      case 0
      then have "srcdups\<cdot>(stake (Suc n)\<cdot>s) = \<up>a"
        by (simp add: \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close>)
      moreover have "srcdups\<cdot>s \<noteq> \<up>a"
      proof -
        have "snth 0 s \<noteq> snth (Suc 0) s"
          using "0" less.prems(3) by blast
        then have "a \<noteq> b"
          by (simp add: \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close>)
        then have "srcdups\<cdot>s = \<up>a \<bullet> srcdups\<cdot>(\<up>b \<bullet> t)"
          using \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> srcdups_neq by blast
        then show ?thesis
          using srcdups_nbot by force
      qed
      ultimately show ?thesis
        by auto
    next
      case (Suc m)
      have "Suc m < l"
        using Suc \<open>k = Suc l\<close> less.prems(2) by blast
      moreover have "snth m (\<up>b \<bullet> t) \<noteq> snth (Suc m) (\<up>b \<bullet> t)"
      proof -
        have "\<up>b \<bullet> t = srt\<cdot>s"
          by (simp add: \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close>)
        then show ?thesis
          by (metis (no_types) Suc less.prems(3) sdrop_forw_rt snth_def)
      qed
      ultimately have "srcdups\<cdot>(stake (Suc m)\<cdot>(\<up>b \<bullet> t)) \<noteq> srcdups\<cdot>(\<up>b \<bullet> t)"
        using \<open>#(\<up>b \<bullet> t) = Fin l\<close> \<open>l < k\<close> less.IH by blast
      then have "srcdups\<cdot>(\<up>b \<bullet> (stake m\<cdot>t)) \<noteq> srcdups\<cdot>(\<up>b \<bullet> t)"
        by simp
      then have "srcdups\<cdot>s \<noteq> \<up>a \<bullet> (srcdups\<cdot>(\<up>b \<bullet> (stake m\<cdot>t)))"
        by (metis (no_types, lifting) \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> inject_scons srcdups2srcdups srcdups_eq srcdups_neq srcdups_step)
      then show ?thesis
      proof -
        { assume "a \<noteq> b"
          then have "srcdups\<cdot>(\<up>a \<bullet> \<up>b \<bullet> stake m\<cdot>t) \<noteq> srcdups\<cdot>s"
            using \<open>srcdups\<cdot>s \<noteq> \<up>a \<bullet> srcdups\<cdot>(\<up>b \<bullet> stake m\<cdot>t)\<close> by auto
          then have ?thesis
            using Suc \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> by force }
        then show ?thesis
          using Suc \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> \<open>srcdups\<cdot>(\<up>b \<bullet> stake m\<cdot>t) \<noteq> srcdups\<cdot>(\<up>b \<bullet> t)\<close> by fastforce
      qed
    qed
  qed
qed

lemma srcdups_end_neq: "#s < \<infinity> \<Longrightarrow> a \<noteq> b \<Longrightarrow> srcdups\<cdot>(s \<bullet> \<up>a \<bullet> \<up>b) = srcdups\<cdot>(s \<bullet> \<up>a) \<bullet> \<up>b"
proof (rule finind3 [of s], simp+)
  assume "#s < \<infinity>" and "a \<noteq> b"
  then show "srcdups\<cdot>(\<up>a \<bullet> \<up>b) = \<up>a \<bullet> \<up>b"
    by (metis lscons_conv srcdups_neq srcdups_step strict_sdropwhile strict_srcdups sup'_def)
next
  fix t :: "'a stream" and c :: 'a
  assume "#t < \<infinity>" and "srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>b) = srcdups\<cdot>(t \<bullet> \<up>a) \<bullet> \<up>b"
  then have "srcdups\<cdot>(\<up>c \<bullet> (t \<bullet> \<up>a)) \<bullet> \<up>b = srcdups\<cdot>(\<up>c \<bullet> (t \<bullet> \<up>a \<bullet> \<up>b))"
  proof (cases "t = \<epsilon>")
    case True
    then show ?thesis
      by (metis (no_types, lifting) \<open>srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>b) = srcdups\<cdot>(t \<bullet> \<up>a) \<bullet> \<up>b\<close> assoc_sconc inject_scons sconc_snd_empty srcdups_eq srcdups_neq)
  next
    case False
    then have not_empty: "t \<noteq> \<epsilon>"
      by simp
    then show ?thesis
    proof (cases "c = shd t")
      case True
      then show ?thesis
        by (metis False \<open>srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>b) = srcdups\<cdot>(t \<bullet> \<up>a) \<bullet> \<up>b\<close> sconc_scons srcdups_eq surj_scons)
    next
      case False
      then have "srcdups\<cdot>(\<up>c \<bullet> (t \<bullet> \<up>a \<bullet> \<up>b)) = \<up>c \<bullet> srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>b)"
      proof -
        have "\<up>(shd t) \<bullet> srt\<cdot>t = t"
          using not_empty surj_scons by blast
        then show ?thesis
          by (metis (no_types) False assoc_sconc srcdups_neq)
      qed
      then show ?thesis
      proof -
        have "\<up>(shd t) \<bullet> srt\<cdot>t = t"
          by (meson not_empty surj_scons)
        then show ?thesis
          by (metis (no_types) False \<open>srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>b) = srcdups\<cdot>(t \<bullet> \<up>a) \<bullet> \<up>b\<close> assoc_sconc srcdups_neq)
      qed
    qed
  qed
  thus "srcdups\<cdot>((\<up>c \<bullet> t) \<bullet> \<up>a \<bullet> \<up>b) = srcdups\<cdot>((\<up>c \<bullet> t) \<bullet> \<up>a) \<bullet> \<up>b"
    by simp
qed

lemma srcdups_end_eq: "srcdups\<cdot>(s \<bullet> \<up>a \<bullet> \<up>a) = srcdups\<cdot>(s \<bullet> \<up>a)"
proof (cases "#s < \<infinity>")
  case True
  then show ?thesis
  proof (rule finind3, simp)
    show "srcdups\<cdot>(\<up>a \<bullet> \<up>a) = \<up>a"
      by (simp add: srcdups_step)
  next
    fix t :: "'a stream" and b :: 'a
    assume "#t < \<infinity>" and "srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>a) = srcdups\<cdot>(t \<bullet> \<up>a)"
    then show "srcdups\<cdot>((\<up>b \<bullet> t) \<bullet> \<up>a \<bullet> \<up>a) = srcdups\<cdot>((\<up>b \<bullet> t) \<bullet> \<up>a)"
    proof (cases "t = \<epsilon>")
      case True
      then show ?thesis
        by (metis sconc_snd_empty srcdups_eq srcdups_neq)
    next
      case False
      then have 1: "t \<noteq> \<epsilon>"
        by simp
      then show ?thesis
      proof(cases "shd t = b")
        case True
        then show ?thesis
          by (metis False \<open>srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>a) = srcdups\<cdot>(t \<bullet> \<up>a)\<close> assoc_sconc srcdups_eq surj_scons)
      next
        case False
        have "t \<noteq> \<epsilon>"
          by (simp add: "1")
        then have "srcdups\<cdot>(\<up>b \<bullet> t \<bullet> \<up>a \<bullet> \<up>a) = \<up>b \<bullet> srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>a)"
          by (metis (no_types, lifting) False assoc_sconc srcdups_neq surj_scons)
        then show ?thesis
          by (metis (no_types, lifting) "1" False \<open>srcdups\<cdot>(t \<bullet> \<up>a \<bullet> \<up>a) = srcdups\<cdot>(t \<bullet> \<up>a)\<close> sconc_scons srcdups_neq surj_scons)
      qed
    qed
  qed
next
  case False
  then show ?thesis
    by (simp add: less_le)
qed

lemma srcdups_sntimes: "n > 0 \<Longrightarrow> srcdups\<cdot>(sntimes n (\<up>a)) = \<up>a"
proof (induction n)
  case 0
  then show ?case
    by simp
next
  case (Suc n)
  then show ?case
  proof (cases "n > 0")
    case True
    then show ?thesis
      by (metis Suc.IH gr0_implies_Suc sntimes.simps(2) srcdups_eq)
  next
    case False
    then show ?thesis
      by auto
  qed
qed

lemma srcdups_sntimes_prefix: "n > 0 \<Longrightarrow> srcdups\<cdot>((sntimes n (\<up>a)) \<bullet> s) = \<up>a \<bullet> srcdups\<cdot>(sdropwhile (\<lambda>x. x=a)\<cdot>s)"
proof (induction n)
  case 0
  then show ?case
    by simp
next
  case (Suc n)
  then show ?case
  proof (cases "n > 1")
    case True
    then obtain m where "n = Suc m" and "m > 0"
      by (metis One_nat_def Suc_lessE)
    then have "srcdups\<cdot>((sntimes (Suc n) (\<up>a)) \<bullet> s) = srcdups\<cdot>((sntimes n (\<up>a)) \<bullet> s)"
      by (simp add: \<open>n = Suc m\<close>)
    then show ?thesis
      using Suc.IH \<open>n = Suc m\<close> zero_less_Suc by auto
  next
    case False
    have "srcdups\<cdot>(\<up>a \<bullet> s) = \<up>a \<bullet> srcdups\<cdot>(sdropwhile (\<lambda>x. x=a)\<cdot>s)"
      using srcdups_step by blast
    moreover have "sntimes 1 (\<up>a) = \<up>a"
      by (simp add: One_nat_def)
    ultimately show ?thesis
      by (metis (no_types, lifting) False One_nat_def Suc_lessI assoc_sconc neq0_conv sntimes.simps(2) srcdups_eq)
  qed
qed

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sscanl}\<close>
(* ----------------------------------------------------------------------- *)

(* SSCANL with the empty stream results in the empty stream *)
lemma SSCANL_empty[simp]: "SSCANL n f q \<epsilon> = \<epsilon>"
by (induct_tac n, auto)

text \<open>monotonicity of SSCANL\<close>
lemma mono_SSCANL:
  "\<forall> x y q. x \<sqsubseteq> y \<longrightarrow> SSCANL n f q x \<sqsubseteq> SSCANL n f q y"
apply (induct_tac n, auto)
apply (drule lessD, erule disjE, simp)
apply (erule exE)+
apply (erule conjE)+
by (simp, rule monofun_cfun_arg, simp)

text \<open>result of @{term "SSCANL n"} only depends on first @{term n}
  elements of input stream\<close>
lemma contlub_SSCANL:
  "\<forall>f q s. SSCANL n f q s = SSCANL n f q (stake n\<cdot>s)"
apply (induct_tac n, auto)
apply (rule_tac x=s in scases)
apply auto
apply (rule_tac x=s in scases)
by auto

text \<open>@{term SSCANL} is a chain. This means that, for all fixed inputs,
  @{term "SSCANL i"} returns a prefix of @{term "SSCANL (Suc i)"}\<close>
lemma chain_SSCANL: "chain SSCANL"
apply (rule chainI)
apply (subst fun_below_iff)+
apply (induct_tac i, auto)
apply (rule monofun_cfun_arg)
apply (erule_tac x="x" in allE)
apply (erule_tac x="x xa (shd xb)" in allE)
by (erule_tac x="srt\<cdot>xb" in allE, auto)

text \<open>@{term sscanl} is a continuous function\<close>
lemma cont_lub_SSCANL: "cont (\<lambda>s. \<Squnion>i. SSCANL i f q s)"
apply (rule cont2cont_lub)
apply (rule ch2ch_fun)
apply (rule chainI)
apply (rule fun_belowD [of _ _ "q"])
apply (rule fun_belowD [of _ _ "f"])
apply (rule chainE)
apply (rule chain_SSCANL)
apply (rule pr_contI)
apply (rule monofunI)
apply (rule mono_SSCANL [rule_format], assumption)
apply (rule allI)
apply (rule_tac x="i" in exI)
by (rule contlub_SSCANL [rule_format])

text \<open>Basic simplification rules for @{term sscanl}\<close>
(* sscanl applied to the empty stream returns the empty stream *)
lemma sscanl_empty[simp]: "sscanl f q\<cdot>\<epsilon> = \<epsilon>"
apply (simp add: sscanl_def)
apply (subst beta_cfun, rule cont_lub_SSCANL)
by (subst is_lub_const
  [THEN lub_eqI, of "\<epsilon>", THEN sym], simp)

(* scanning \<up>a\<bullet>s using q as the initial element is equivalent to computing \<up>(f q a) and appending the
   result of scanning s with (f q a) as the initial element *)
lemma sscanl_scons[simp]:
  "sscanl f q\<cdot>(\<up>a\<bullet>s) = \<up>(f q a) \<bullet> sscanl f (f q a)\<cdot>s"
apply (simp add: sscanl_def)
apply (subst beta_cfun, rule cont_lub_SSCANL)+
apply (subst contlub_cfun_arg)
apply (rule ch2ch_fun, rule ch2ch_fun)
apply (rule chainI)
apply (rule fun_belowD [of _ _ "f"])
apply (rule chain_SSCANL [THEN chainE])
apply (subst lub_range_shift [where j="Suc 0", THEN sym])
apply (rule ch2ch_fun, rule ch2ch_fun)
apply (rule chainI)
apply (rule fun_belowD [of _ _ "f"])
by (rule chain_SSCANL [THEN chainE], simp)

(* scanning a singleton stream is equivalent to computing \<up>(f a b) *)
lemma sscanl_one[simp]: "sscanl f a\<cdot>(\<up>b) = \<up>(f a b)"
by (insert sscanl_scons [of f a b \<epsilon>], auto)

text \<open>applying @{term sscanl} never shortens the stream\<close>
lemma fair2_sscanl: "#x \<le> #(sscanl f a\<cdot>x)"
apply (rule spec [where x = a])
apply (rule ind [of _ x], auto)
by (subst lnle_def, simp del: lnle_conv)

(* The first element of the result of sscanl_h is (f q (shd s)) *)
lemma sscanl_shd: "s\<noteq>\<epsilon> \<Longrightarrow> shd (sscanl f q\<cdot>s) = (f q (shd s))"
by (metis shd1 sscanl_scons surj_scons)

(* dropping the first element of the result of sscanl is equivalent to beginning the scan with
   (f a (shd s)) as the initial element and proceeding with the rest of the input *)
lemma sscanl_srt: "srt\<cdot>(sscanl f a\<cdot>s) = sscanl f (f a (shd s)) \<cdot>(srt\<cdot>s) "
by (metis (no_types, lifting) sconc_fst_empty sconc_scons' sscanl_empty sscanl_scons stream.sel_rews(2) stream.sel_rews(5) sup'_def surj_scons up_defined)

(* the n + 1'st element produced by sscanl is the result of mering the n + 1'st item of s with the n'th
   element produced by sscanl *)
lemma sscanl_snth:  "Fin (Suc n) < #s \<Longrightarrow> snth (Suc n) (sscanl f a\<cdot>s) = f (snth n (sscanl f a\<cdot>s)) (snth (Suc n) s)"
apply(induction n arbitrary:  a s)
apply (smt Fin_02bot Fin_leq_Suc_leq less2lnleD less_lnsuc lnat_po_eq_conv lnless_def lnzero_def shd1 slen_empty_eq slen_rt_ile_eq snth_scons snth_shd sscanl_scons surj_scons)
by (smt Fin_Suc lnat_po_eq_conv lnle_def lnless_def lnsuc_lnle_emb lnzero_def minimal slen_scons snth_scons sscanl_scons strict_slen surj_scons)

(* the result of sscanl has the same length as the input stream x *)
lemma fair_sscanl[simp]: "#(sscanl f a\<cdot>x) = #x"
apply (rule spec [where x = a])
by (rule ind [of _ x], auto)

(* Verification of sscanl with sscanl_nth *)

primrec sscanl_nth :: "nat \<Rightarrow> ('a \<Rightarrow> 'a  \<Rightarrow> 'a) \<Rightarrow> 'a  \<Rightarrow> 'a stream \<Rightarrow> 'a" where
"sscanl_nth 0 f q s =  f q (shd s)" |
"sscanl_nth (Suc n) f q s = sscanl_nth n f (f q (shd s)) (srt\<cdot>s)"

(* Nth element of sscanl is equal to sscanl_nth *)
lemma sscanl2sscanl_nth:
  "Fin n<#s \<Longrightarrow> snth n (sscanl f q\<cdot>s) = sscanl_nth n f q s"
proof (induction n arbitrary: q s, auto)
  fix q :: "'a" and s :: "'a stream" and k :: "lnat"
  assume a1: "#s = lnsuc\<cdot>k"
  hence h1: "s \<noteq> \<epsilon>"
    using lnsuc_neq_0_rev strict_slen by auto
  thus "shd (sscanl f q\<cdot>s) = f q (shd s)"
    by (simp add: sscanl_shd)
next
  fix n :: "nat" and  q :: "'a" and s :: "'a stream"
  assume a2: "\<And>q s. Fin n < #s \<Longrightarrow> snth n (sscanl f q\<cdot>s) = sscanl_nth n f q s"
  assume a3: "Fin (Suc n) < #s"
  thus "snth (Suc n) (sscanl f q\<cdot>s) = sscanl_nth n f (f q (shd s)) (srt\<cdot>s)"
    by (metis a2 a3 leI not_less slen_rt_ile_eq snth_rt sscanl_srt)
qed

lemma sscan_ntimes_loop:
  assumes "\<And>r. sscanl f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanl f state\<cdot>r)"
  shows "sscanl f state\<cdot>(sntimes n s) = sntimes n out"
  using assms
  by (induction n, simp_all)

lemma sscanl_inftimes_loop:
  assumes "\<And>r. sscanl f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanl f state\<cdot>r)"
  shows "sscanl f state\<cdot>(sinftimes s) = sinftimes out"
  using assms
  by (metis rek2sinftimes sinftimes_unfold slen_empty_eq sscanl_empty fair_sscanl strict_icycle)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term szip}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Basic simplification rules of @{term szip}\<close>

(* szip applied to \<epsilon>\<cdot>s returns the empty stream *)
lemma strict_szip_fst[simp]: "szip\<cdot>\<epsilon>\<cdot>s = \<epsilon>"
by (subst szip_def [THEN fix_eq2],simp)

(* szip applied to s\<cdot>\<epsilon> returns the empty stream *)
lemma strict_szip_snd[simp]: "szip\<cdot>s\<cdot>\<epsilon> = \<epsilon>"
by (subst szip_def [THEN fix_eq2], simp)

(* unfolding szip *)
lemma szip_scons[simp]: "szip\<cdot>(\<up>a\<bullet>s1)\<cdot>(\<up>b\<bullet>s2) = \<up>(a,b) \<bullet> (szip\<cdot>s1\<cdot>s2)"
by (subst szip_def [THEN fix_eq2], simp)

(* rules for szip *)
lemma [simp]: "szip\<cdot>(\<up>a)\<cdot>(\<up>b \<bullet> y) = \<up>(a,b)"
by (subst szip_def [THEN fix_eq2], simp)

(* rules for szip *)
lemma [simp]: "szip\<cdot>(\<up>a \<bullet> x)\<cdot>(\<up>b) = \<up>(a,b)"
by (subst szip_def [THEN fix_eq2], simp)

(* rules for szip *)
lemma [simp]: "szip\<cdot>(\<up>a)\<cdot>(\<up>b) = \<up>(a,b)"
by (subst szip_def [THEN fix_eq2], simp)

text \<open>If @{term szip} returns an empty stream, an input stream was empty\<close>
lemma strict_rev_szip: "szip\<cdot>x\<cdot>y = \<epsilon> \<Longrightarrow> x = \<epsilon> \<or> y = \<epsilon>"
apply (rule_tac x=x in scases, auto)
by (rule_tac x=y in scases, auto)

text \<open>@{term sprojfst} and @{term sprojsnd} are "inverse" functions of
  @{term szip} - if the other zipped stream is infinite\<close>
lemma sprojfst_szipl1[rule_format]:
  "\<forall>x. #x = \<infinity> \<longrightarrow> sprojfst\<cdot>(szip\<cdot>i\<cdot>x) = i"
apply (rule ind [of _ i], auto)
by (rule_tac x=x in scases, auto)

(* analogous for sprojsnd *)
lemma sprojsnd_szipl1[rule_format]:
  "\<forall>x. #x = \<infinity> \<longrightarrow> sprojsnd\<cdot>(szip\<cdot>x\<cdot>i) = i"
apply (rule ind [of _ i], auto)
by (rule_tac x=x in scases, auto)

(* zipping the infinite constant streams \<up>x\<infinity> and \<up>y\<infinity> is equivalent to infinitely repeating the tuple
   \<up>(x, y) *)
lemma szip2sinftimes[simp]: "szip\<cdot>((\<up>x)\<^sup>\<infinity>)\<cdot>((\<up>y)\<^sup>\<infinity>) = ((\<up>(x, y))\<^sup>\<infinity>) "
by (metis s2sinftimes sinftimes_unfold szip_scons)

(* the length of szip\<cdot>as\<cdot>bs is the minimum of the lengths of as and bs *)
lemma szip_len [simp]: "#(szip\<cdot>as\<cdot>bs) = min (#as) (#bs)"
apply(induction as arbitrary: bs)
apply(rule admI)
apply auto[1]
apply (metis inf_chainl4 inf_less_eq lub_eqI lub_finch2 min_def slen_sprojsnd sprojsnd_szipl1)
apply simp
apply(case_tac "bs=\<epsilon>")
apply auto[1]
proof -
  fix u :: "'a discr u"
  fix as:: "'a stream"
  fix bs:: "'b stream"
  assume as1: "u \<noteq> \<bottom>" and
    as2: "(\<And>bs::'b stream. #(szip\<cdot>as\<cdot>bs) = min (#as) (#bs))" and as3: "bs \<noteq> \<epsilon>"
  obtain a where a_def: "updis a = u" by (metis (mono_tags)as1 lshd_updis stream.sel_rews(4) stream.sel_rews(5) surj_scons)
  obtain b bs2 where b_def: "bs = \<up>b \<bullet> bs2" by (metis as3 surj_scons)
  hence "#(szip\<cdot>(\<up>a \<bullet> as)\<cdot>(\<up>b \<bullet> bs2)) = min (#(\<up>a \<bullet> as)) (#(\<up>b \<bullet> bs2))" by (simp add: as2 min_def)
  thus "#(szip\<cdot>(u && as)\<cdot>bs) = min (#(u && as)) (#bs)" by (metis a_def b_def lscons_conv)
qed

lemma szip_nth: "Fin n < #s1 \<Longrightarrow> Fin n < #s2 \<Longrightarrow> snth n (szip\<cdot>s1\<cdot>s2) = (snth n s1, snth n s2)"
  apply(induction n arbitrary: s1 s2)
  apply auto
   apply (metis lnsuc_neq_0 only_empty_has_length_0 shd1 surj_scons szip_scons)
  apply(simp add: snth_rt)
  by (smt empty_is_shortest leD not_le only_empty_has_length_0 only_empty_has_length_0 only_empty_has_length_0 slen_rt_ile_eq slen_rt_ile_eq snth_rt snth_scons stream.sel_rews(2) stream.sel_rews(2) strict_slen strict_slen strict_slen strict_szip_snd surj_scons surj_scons szip_scons)

lemma szip_sdrop: "sdrop n\<cdot>(szip\<cdot>s\<cdot>t) = szip\<cdot>(sdrop n\<cdot>s)\<cdot>(sdrop n\<cdot>t)"
  apply(induction n arbitrary: s t, simp)
  by (metis (no_types, lifting) sdrop_forw_rt sdrop_scons stream.sel_rews(2) strict_szip_fst
            strict_szip_snd surj_scons szip_scons)
(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sscanlA}\<close>
(* ----------------------------------------------------------------------- *)

lemma sscanla_cont: "cont (\<lambda>s. sprojfst\<cdot>(sscanl (\<lambda>(_,b). f b) (undefined, s0)\<cdot>s))"
  by simp

lemma sscanla_len [simp]: "#(sscanlA f s0\<cdot>s) = #s"
  by (simp add: sscanlA_def slen_sprojfst)

lemma sscanla_bot [simp]: "sscanlA f s0\<cdot>\<bottom> = \<bottom>"
  by (simp add: sscanlA_def)

lemma sscanla_step [simp]: "sscanlA f s0\<cdot>(\<up>a \<bullet> as) = \<up>(fst (f s0 a)) \<bullet> sscanlA f (snd (f s0 a))\<cdot>as"
  apply(simp add: sscanlA_def sprojfst_def)
proof -
  have "(case f s0 a of (a, x) \<Rightarrow> f x) = (case (undefined::'a, snd (f s0 a)) of (a, x) \<Rightarrow> f x)"
by (metis (no_types) old.prod.case prod.collapse)
  then have "\<up>(shd as) \<bullet> srt\<cdot>as = as \<longrightarrow> sscanl (\<lambda>(a, y). f y) (f s0 a)\<cdot>as = sscanl (\<lambda>(a, y). f y) (undefined, snd (f s0 a))\<cdot> (\<up>(shd as) \<bullet> srt\<cdot>as)"
    by (metis (no_types) sscanl_scons)
  then show "\<up>(fst (f s0 a)) \<bullet> smap fst\<cdot> (sscanl (\<lambda>(a, y). f y) (f s0 a)\<cdot> as) = \<up>(fst (f s0 a)) \<bullet> smap fst\<cdot> (sscanl (\<lambda>(a, y). f y) (undefined, snd (f s0 a))\<cdot> as)"
    using surj_scons by force
qed

lemma sscanla_one [simp]: "sscanlA f b\<cdot>(\<up>x) = \<up>(fst (f b x))"
  apply(simp add: sscanlA_def)
  by (metis prod.collapse sconc_snd_empty sprojfst_scons strict_sprojfst)

lemma sscanla_shd: "s\<noteq>\<epsilon> \<Longrightarrow> shd (sscanlA f q\<cdot>s) = fst (f q (shd s))"
  by (metis shd1 sscanla_step surj_scons)

lemma sscanla_srt: "srt\<cdot>(sscanlA f a\<cdot>s) = sscanlA f (snd (f a (shd s)))\<cdot>(srt\<cdot>s)"
  by (metis (no_types, lifting) sconc_fst_empty sconc_scons' sscanla_bot sscanla_step stream.sel_rews(2) stream.sel_rews(5) sup'_def surj_scons up_defined)

lemma sscanla_ntimes_loop:
  assumes "\<And>r. sscanlA f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanlA f state\<cdot>r)"
  shows "sscanlA f state\<cdot>(sntimes n s) = sntimes n out"
  using assms
  by (induction n, simp_all)

lemma sscanla_inftimes_loop:
  assumes "\<And>r. sscanlA f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanlA f state\<cdot>r)"
  shows "sscanlA f state\<cdot>(sinftimes s) = sinftimes out"
  using assms
  by (metis rek2sinftimes sinftimes_unfold slen_empty_eq sscanla_bot sscanla_len strict_icycle)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sscanlAg}\<close>
(* ----------------------------------------------------------------------- *)

lemma sscanlag_cont: "cont (\<lambda>s. (sscanl (\<lambda>(b,_). f b) (s0, undefined)\<cdot>s))"
  by simp

lemma sscanlag_len [simp]: "#(sscanlAg f s0\<cdot>s) = #s"
  by(simp add: sscanlAg_def slen_sprojsnd)

lemma sscanlag_bot [simp]: "sscanlAg f s0\<cdot>\<bottom> = \<bottom>"
  by (simp add: sscanlAg_def)

lemma sscanlag_one [simp]: "sscanlAg f b\<cdot>(\<up>x) = \<up>(fst(f b x), snd (f b x))"
  by(simp add: sscanlAg_def)

lemma sscanlag_step [simp]: "sscanlAg f s0\<cdot>(\<up>a \<bullet> as) = \<up>((f s0 a)) \<bullet> sscanlAg f (fst (f s0 a))\<cdot>as"
  apply(simp add: sscanlAg_def sprojfst_def)
  by (smt case_prod_conv prod.collapse sscanl_empty sscanl_scons surj_scons)

lemma sscanlag_shd: "s\<noteq>\<epsilon> \<Longrightarrow> shd (sscanlAg f q\<cdot>s) = (f q (shd s))"
  by (metis shd1 sscanlag_step surj_scons)

lemma sscanlag_srt: "srt\<cdot>(sscanlAg f a\<cdot>s) = sscanlAg f (fst (f a (shd s)))\<cdot>(srt\<cdot>s)"
  by (metis (no_types, lifting) sconc_fst_empty sconc_scons' sscanlag_bot sscanlag_step stream.sel_rews(2) stream.sel_rews(5) sup'_def surj_scons up_defined)

lemma snth_sscanlAg:
  assumes "Fin (Suc j)<#i"
    shows "snth (Suc j) (sscanlAg f s0\<cdot>i) = f (fst (snth j (sscanlAg f s0\<cdot>i))) (snth (Suc j) i)"
  apply(simp add: sscanlAg_def)
  by (metis (mono_tags, lifting) assms case_prod_conv prod.exhaust_sel sscanl_snth)

lemma sscanlag_ntimes_loop:
  assumes "\<And>r. sscanlAg f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanlAg f state\<cdot>r)"
  shows "sscanlAg f state\<cdot>(sntimes n s) = sntimes n out"
  using assms
  by (induction n, simp_all)

lemma sscanlag_inftimes_loop:
  assumes "\<And>r. sscanlAg f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanlAg f state\<cdot>r)"
  shows "sscanlAg f state\<cdot>(sinftimes s) = sinftimes out"
  using assms
  by (metis rek2sinftimes sinftimes_unfold slen_empty_eq sscanlag_bot sscanlag_len strict_icycle)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sscanlAfst}\<close>
(* ----------------------------------------------------------------------- *)

lemma sscanlafst_cont: "cont (\<lambda>s. sprojfst\<cdot>(sscanlAg (\<lambda>(_,b). f b) (undefined, s0)\<cdot>s))"
  by simp

lemma sscanlafst_len [simp]: "#(sscanlAfst f s0\<cdot>s) = #s"
  by (simp add: sscanlAfst_def slen_sprojfst)

lemma sscanlafst_bot [simp]: "sscanlAfst f s0\<cdot>\<bottom> = \<bottom>"
  by (simp add: sscanlAfst_def)

lemma sscanlafst_step [simp]: "sscanlAfst f s0\<cdot>(\<up>a \<bullet> as) = \<up>(fst (f s0 a)) \<bullet> sscanlAfst f (fst (f s0 a))\<cdot>as"
  apply (simp add: sscanlAfst_def sprojfst_def sscanlAg_def)
  by (smt approxl2 case_prod_conv eta_cfun fair_sscanl fin2stake prod.collapse sconc_prefix sconc_snd_empty slen_scons slen_smap smap_hd_rst sprojfst_def sscanl_empty sscanl_shd sscanl_srt strict_sprojfst)

lemma sscanlafst_one [simp]: "sscanlAfst f b\<cdot>(\<up>x) = \<up>(fst (f b x))"
  apply(simp add: sscanlAfst_def)
  by (metis prod.collapse sconc_snd_empty sprojfst_scons strict_sprojfst)

lemma sscanlafst_shd: "s\<noteq>\<epsilon> \<Longrightarrow> shd (sscanlAfst f q\<cdot>s) = fst (f q (shd s))"
  by (metis shd1 sscanlafst_step surj_scons)

lemma sscanlafst_srt: "srt\<cdot>(sscanlAfst f a\<cdot>s) = sscanlAfst f (fst (f a (shd s)))\<cdot>(srt\<cdot>s)"
  by (metis (no_types, lifting) sconc_fst_empty sconc_scons' sscanlafst_bot sscanlafst_step stream.sel_rews(2) stream.sel_rews(5) sup'_def surj_scons up_defined)

lemma sscanlafst_snth: assumes "Fin (Suc n) < #s" and "s2 = fst (shd (sscanlAg f state\<cdot>s))"
  shows "snth (Suc n) (sscanlAfst f state\<cdot>s) = snth n (sscanlAfst f s2\<cdot>(srt\<cdot>s))"
  apply(simp add: assms sscanlAfst_def)
  apply(subst sprojfst_snth)
  apply(simp add: assms)
  apply (meson assms(1) leD leI slen_rt_ile_eq)
  apply(subst snth_sscanlAg)
  apply(simp add: assms)
  by (metis (no_types, lifting) assms(1) empty_is_shortest shd1 snth_scons snth_sscanlAg sscanlag_step surj_scons)

lemma sscanlafst_ntimes_loop:
  assumes "\<And>r. sscanlAfst f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanlAfst f state\<cdot>r)"
  shows "sscanlAfst f state\<cdot>(sntimes n s) = sntimes n out"
  using assms
  by (induction n, simp_all)

lemma sscanlafst_inftimes_loop:
  assumes "\<And>r. sscanlAfst f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanlAfst f state\<cdot>r)"
  shows "sscanlAfst f state\<cdot>(sinftimes s) = sinftimes out"
  using assms
  by (metis rek2sinftimes sinftimes_unfold slen_empty_eq sscanlafst_bot sscanlafst_len strict_icycle)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sscanlAsnd}\<close>
(* ----------------------------------------------------------------------- *)

lemma sscanlasnd_cont: "cont (\<lambda>s. sprojsnd\<cdot>(sscanl (\<lambda>(b,_). f b) (s0, undefined)\<cdot>s))"
  by simp

lemma sscanlasnd_len [simp]: "#(sscanlAsnd f s0\<cdot>s) = #s"
  by(simp add: sscanlAsnd_def slen_sprojsnd)

lemma sscanlasnd_bot [simp]: "sscanlAsnd f s0\<cdot>\<bottom> = \<bottom>"
  by (simp add: sscanlAsnd_def)

lemma sscanlasnd_step [simp]: "sscanlAsnd f s0\<cdot>(\<up>a \<bullet> as) = \<up>(snd (f s0 a)) \<bullet> sscanlAsnd f (fst (f s0 a))\<cdot>as"
  apply(simp add: sscanlAsnd_def sprojsnd_def sscanlAg_def)
proof -
  have "(case f s0 a of (x, a) \<Rightarrow> f x) = (case (fst (f s0 a), undefined::'a) of (x, a) \<Rightarrow> f x)"
    by (metis (no_types) old.prod.case prod.collapse)
  then have "\<up>(shd as) \<bullet> srt\<cdot>as = as \<longrightarrow>(sscanl (\<lambda>(b, uu). f b) (f s0 a)\<cdot>as)= (sscanl (\<lambda>(b, uu). f b) (fst (f s0 a), undefined)\<cdot>as)"
    by (metis (no_types) sscanl_scons)
  then show "\<up>(snd (f s0 a)) \<bullet> smap snd\<cdot>(sscanl (\<lambda>(b, uu). f b) (f s0 a)\<cdot>as) = \<up>(snd (f s0 a)) \<bullet> smap snd\<cdot>(sscanl (\<lambda>(b, uu). f b) (fst (f s0 a), undefined)\<cdot>as)"
    using surj_scons by force
qed

lemma sscanlasnd_one [simp]: "sscanlAsnd f b\<cdot>(\<up>x) = \<up>(snd (f b x))"
  apply(simp add: sscanlAsnd_def)
  by (metis eq_snd_iff sconc_snd_empty sprojsnd_scons strict_sprojsnd)

lemma sscanlasnd_shd: "s\<noteq>\<epsilon> \<Longrightarrow> shd (sscanlAsnd f q\<cdot>s) = snd (f q (shd s))"
  by (metis shd1 sscanlasnd_step surj_scons)

lemma sscanlasnd_srt: "srt\<cdot>(sscanlAsnd f a\<cdot>s) = sscanlAsnd f (fst (f a (shd s)))\<cdot>(srt\<cdot>s)"
  by (metis (no_types, lifting) sconc_fst_empty sconc_scons' sscanlasnd_bot sscanlasnd_step stream.sel_rews(2) stream.sel_rews(5) sup'_def surj_scons up_defined)

lemma sscanlasnd_snth: assumes "Fin (Suc n)<#s" and "s2 = fst(shd(sscanlAg f state\<cdot>s))"
  shows "snth (Suc n) (sscanlAsnd f state\<cdot>s) = snth n (sscanlAsnd f s2\<cdot>(srt\<cdot>s))"
  apply(simp add: assms sscanlAsnd_def)
  apply(subst sprojsnd_snth)
   apply(simp add: assms)
  by (metis assms(1) empty_is_shortest eta_cfun rt_Sproj_2_eq smap_snth_lemma snth_rt sprojsnd_def sscanlag_len sscanlag_shd sscanlag_srt)

lemma sscanlasnd_snth2:
  assumes "Fin (Suc n) < #(\<up>a \<bullet> s)"
  shows "snth (Suc n) (sscanlAsnd f state\<cdot>(\<up>a \<bullet> s)) = snth n (sscanlAsnd f (fst (f state a))\<cdot>s)"
  using assms
  apply (induction s arbitrary: a rule: ind)
  by simp_all

lemma sscanlasnd_ntimes_loop:
  assumes "\<And>r. sscanlAsnd f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanlAsnd f state\<cdot>r)"
  shows "sscanlAsnd f state\<cdot>(sntimes n s) = sntimes n out"
  using assms
  by (induction n, simp_all)

lemma sscanlasnd_inftimes_loop:
  assumes "\<And>r. sscanlAsnd f state\<cdot>(s \<bullet> r) = out \<bullet> (sscanlAsnd f state\<cdot>r)"
  shows "sscanlAsnd f state\<cdot>(sinftimes s) = sinftimes out"
  using assms
  by (metis rek2sinftimes sinftimes_unfold slen_empty_eq sscanlasnd_bot sscanlasnd_len strict_icycle)

lemma sscanlasnd2sinftimes:
  assumes "#s=\<infinity>"
    and "sscanlAsnd f state\<cdot>s = out \<bullet> (sscanlAsnd f state\<cdot>s)"
    and "out \<noteq> \<epsilon>"
  shows "sscanlAsnd f state\<cdot>s = sinftimes out"
  using assms rek2sinftimes by auto

lemma sscanl2smap:
  assumes "\<And>e. fst(f s e) = s"
  and "g = (\<lambda>a. snd(f s a))"
shows"sscanlAsnd f s = smap g"
  apply(rule cfun_eqI)
  by(induct_tac x rule: ind,simp_all add: assms)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term merge}\<close>
(* ----------------------------------------------------------------------- *)

(* unfolding of merge function *)
lemma merge_unfold: "merge f\<cdot>(\<up>x \<bullet> xs)\<cdot>(\<up>y\<bullet> ys) = \<up>(f x y) \<bullet> merge f\<cdot>xs\<cdot>ys"
  by(simp add: merge_def)

(* relation between merge and snth *)
lemma merge_snth[simp]: "Fin n <#xs \<Longrightarrow>Fin n < #ys \<Longrightarrow> snth n (merge f\<cdot>xs\<cdot>ys) = f (snth n xs) (snth n ys)"
  apply(induction n arbitrary:xs ys)
   apply (metis Fin_02bot merge_unfold lnless_def lnzero_def shd1 slen_empty_eq snth_shd surj_scons)
  by (smt Fin_Suc Fin_leq_Suc_leq Suc_eq_plus1_left merge_unfold inject_lnsuc less2eq less2lnleD lnle_conv lnless_def lnsuc_lnle_emb sconc_snd_empty sdropostake shd1 slen_scons snth_rt snth_scons split_streaml1 stream.take_strict surj_scons ub_slen_stake)

(* merge applied to f\<cdot>\<epsilon>\<cdot>ys return the empty stream *)
lemma merge_eps1[simp]: "merge f\<cdot>\<epsilon>\<cdot>ys = \<epsilon>"
  by(simp add: merge_def)

(* merge applied to f\<cdot>xs\<cdot>\<epsilon> also returns the empty stream *)
lemma merge_eps2[simp]: "merge f\<cdot>xs\<cdot>\<epsilon> = \<epsilon>"
  by(simp add: merge_def)

(* relation between srt and merge *)
lemma [simp]: "srt\<cdot>(merge f\<cdot>(\<up>a \<bullet> as)\<cdot>(\<up>b \<bullet> bs)) = merge f\<cdot>as\<cdot>bs"
  by (simp add: merge_unfold)

(* the length of merge f\<cdot>as\<cdot>bs is the minimum of the lengths of as and bs *)
lemma merge_len [simp]: "#(merge f\<cdot>as\<cdot>bs) = min (#as) (#bs)"
by(simp add: merge_def)

(* the merge function is commutative *)
lemma merge_commutative: assumes "\<And> a b. f a b = f b a"
  shows "merge f\<cdot>as\<cdot>bs = merge f\<cdot>bs\<cdot>as"
  apply(rule snths_eq)
   apply (simp add: min.commute)
  by (simp add: assms)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term siterate}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>@{term siterate} is defined by running @{term sscanl} on an arbitrary
  infinite stream. Only the stream length is relevant for the result\<close>
lemma siterate_inv_lemma:
  "\<forall>x z a. #z = #x
     \<longrightarrow> stake n\<cdot>(sscanl (\<lambda>a b. f a) a\<cdot>x) =
        stake n\<cdot>(sscanl (\<lambda>a b. f a) a\<cdot>z)"
apply (induct_tac n, auto)
apply (rule_tac x=x in scases, auto)
by (rule_tac x=z in scases, auto)

text \<open>@{term siterate} is well-defined (because it is independent of
  the infinite stream on which @{term sscanl} is applied)\<close>
lemma siterate_def2:
  "#x = \<infinity> \<Longrightarrow> siterate f a = \<up>a \<bullet> sscanl (\<lambda>a b. f a) a\<cdot>x"
apply (subst siterate_def)
apply (rule someI2_ex)
apply (rule_tac x="sinftimes (\<up>(SOME a. True))" in exI, simp)
apply (rule cfun_arg_cong)
apply (rule stream.take_lemma)
by (rule siterate_inv_lemma [rule_format], simp)

text \<open>unfolding of @{term siterate} definition\<close>
lemma siterate_scons: "siterate f a = \<up>a \<bullet> siterate f (f a)"
apply (rule stream.take_lemma [OF spec [where x="a"]])
apply (induct_tac n, auto)
apply (insert siterate_def2 [of _ f], atomize)
apply (erule_tac x="sinftimes (\<up>x)" in allE, auto)
by (subst sinftimes_unfold, simp)

(* to define the nth element of siterate we define a helper function \<open>niterate\<close> *)
(* \<open>iterate\<close> cannot be used, because the function is only about CPO's, maybe some
of those lemmata about niterate could be in Prelude, but not all of them *)
primrec niterate :: "nat \<Rightarrow> ('a::type \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)" where
    "niterate 0 = (\<lambda> F x. x)"
  | "niterate (Suc n) = (\<lambda> F x. F (niterate n F x))"

(* niterate applied to the successor of n is the same as applying niterate to n F *)
lemma niterate_Suc2: "niterate (Suc n) F x = niterate n F (F x)"
apply(induction n)
by(simp_all)

(* relation between iterate and niterate *)
lemma niter2iter: "iterate g\<cdot>h\<cdot>x = niterate g (Rep_cfun h) x"
apply (induction g)
by(simp_all)

(* iterate and the empty stream *)
lemma iterate_eps [simp]: assumes "g \<epsilon> = \<epsilon>"
  shows "(iterate i\<cdot>(\<Lambda> h. (\<lambda>s. s \<bullet> h (g s)))\<cdot>\<bottom>) \<epsilon> = \<epsilon>"
using assms by (induction i, auto)

(* fix and the empty stream *)
lemma fix_eps [simp]: assumes "g \<epsilon> = \<epsilon>"
  shows "(\<mu> h. (\<lambda>s. s \<bullet> h (g s))) \<epsilon> = \<epsilon>"
proof -
  have aI: "max_in_chain 0 (\<lambda>i. (iterate i\<cdot>(\<Lambda> h. (\<lambda>s. s \<bullet> h (g s)))\<cdot>\<bottom>) \<epsilon> )" by (simp add: max_in_chainI assms)
  hence "(\<Squnion>i. (iterate i\<cdot>(\<Lambda> h. (\<lambda>s. s \<bullet> h (g s)))\<cdot>\<bottom>) \<epsilon>) = \<epsilon>"  using assms by auto
  hence " (\<Squnion> i. iterate i\<cdot>(\<Lambda> h. (\<lambda>s. s \<bullet> h (g s)))\<cdot>\<bottom>) \<epsilon> = \<epsilon>" by (simp add: lub_fun)
  thus ?thesis using fix_def2 by (metis (no_types, lifting) lub_eq)
qed

(* beginning the iteration of the function h with the element (h x) is equivalent to beginning the
   iteration with x and dropping the head of the iteration *)
lemma siterate_sdrop: "siterate h (h x) = sdrop 1\<cdot>(siterate h x)"
by (metis One_nat_def sdrop_0 sdrop_scons siterate_scons)

(* iterating the function h infinitely often after having already iterated i times is equivalent to
   beginning the iteration with x and then dropping i elements from the resulting stream *)
lemma siterate_drop2iter: "siterate h (niterate i h x) = sdrop i\<cdot>(siterate h x)"
apply (induction i)
apply (simp add: One_nat_def)
by (simp add: sdrop_back_rt siterate_sdrop One_nat_def)

(* the head of iterating the function g on x doesn't have any applications of g *)
lemma shd_siter[simp]: "shd (siterate g x) = x"
by (simp add: siterate_def)

(* dropping i elements from the infinite iteration of the function g on x and then extracting the head
   is equivalent to computing the i'th iteration via niterate *)
lemma shd_siters: "shd (sdrop i\<cdot>(siterate g x)) = niterate i g x"
by (metis shd_siter siterate_drop2iter)

text \<open>Addition of two numbers using @{term "siterate Suc"}\<close>
lemma snth_siterate_Suc: "snth k (siterate Suc j) = k + j"
apply (rule_tac x="j" in spec)
apply (induct_tac k, simp)
apply (rule allI)
by (subst siterate_scons, simp)+

(* applying snth to k and siterate Suc 0 returns k *)
lemma snth_siterate_Suc_0[simp]: "snth k (siterate Suc 0) = k"
by (simp add: snth_siterate_Suc)

(* relation between sdrop and siterate *)
lemma sdrop_siterate:
  "sdrop k\<cdot>(siterate Suc j) = siterate Suc (j + k)"
apply (rule_tac x="j" in spec)
apply (induct_tac k, simp+)
apply (rule allI)
by (subst siterate_scons, simp)

text \<open>@{term siterate} only creates infinite outputs\<close>
lemma [simp]: "#(siterate f k) = \<infinity>"
apply (rule infI)
apply (rule allI)
apply (rule_tac x="k" in spec)
apply (induct_tac k, simp+)
by (subst siterate_scons, simp)+

(* the i'th element of the infinite stream of iterating the function g on x can alternatively be found
   with (niterate i g x) *)
lemma snth_siter: "snth i (siterate g x) = niterate i g x"
by (simp add: shd_siters snth_def)

(* dropping j elements from the stream x and then extracting the i'th element is equivalent to extracting
   the i+j'th element directly *)
lemma snth_sdrop: "snth i (sdrop j\<cdot>x) = snth (i+j) x"
by (simp add: sdrop_plus snth_def)

(* extracting the i+1'st element from the stream of iterating the function g on x is equivalent to extracting
   the i'th element and then applying g one more time *)
lemma snth_snth_siter: "snth (Suc i) (siterate g x) = g (snth i (siterate g x))"
by (simp add: snth_siter)

(* dropping the first element from the chain of iterates is equivalent to shifting the chain by applying g *)
lemma sdrop_siter:  "sdrop 1\<cdot>(siterate g x) = smap g\<cdot>(siterate g x)"
apply(rule sinf_snt2eq)
apply (simp add: fair_sdrop)
apply simp
by (simp add: smap_snth_lemma snth_sdrop snth_snth_siter One_nat_def)

(* if the functions g and h commute then g also commutes with any number of iterations of h *)
lemma iterate_insert: assumes "\<forall>z. h (g z) = g (h z)"
  shows "niterate i h (g x) = g (niterate i h x)"
using assms by (induction i, auto)

(* lifts iterate_insert from particular iterations to streams of iterations *)
lemma siterate_smap:  assumes "\<forall>z. g (h z) = h (g z)"
  shows "smap g\<cdot>(siterate h x) = siterate h (g x)"
apply (rule sinf_snt2eq, auto)
by (simp add: assms smap_snth_lemma snth_siter iterate_insert)

(* iterating the function g on x is equivalent to the stream produced by concatenating \<up>x and the
   iteration of g on x shifted by another application of g *)
lemma siterate_unfold: "siterate g x = \<up>x \<bullet> smap g\<cdot>(siterate g x)"
by (metis siterate_scons siterate_smap)

(* iterating the identity function produces an infinite constant stream of the element x *)
lemma siter2sinf: "siterate id x = sinftimes (\<up>x)"
by (metis id_apply s2sinftimes siterate_scons)

(* dropping i and iterating the identity function returns siterate id x *)
lemma "sdrop i\<cdot>(siterate id x) = siterate id x"
  by (smt sdrops_sinf siter2sinf)

(* if g acts as the identity for the element x then iterating g on x produces an infinite constant
   stream of x *)
lemma siter2sinf2: assumes "g x = x"
  shows "siterate g x = sinftimes (\<up>x)"
by (smt assms s2sinftimes siterate_scons)

(* shows the equivalence of an alternative recursive definition of iteration *)
lemma rek2niter: assumes "xs = \<up>x \<bullet> (smap g\<cdot>xs)"
  shows "snth i xs = niterate i g x"
proof (induction i)
  case 0 thus ?case by (metis assms niterate.simps(1) shd1 snth_shd)
next
  case (Suc i)
  have "#xs = \<infinity>" by (metis Inf'_def assms below_refl fix_least_below inf_less_eq lnle_def slen_scons slen_smap)
  thus ?case by (metis Fin_neq_inf Suc assms inf_ub lnle_def lnless_def niterate.simps(2) smap_snth_lemma snth_scons)
qed

(* important *)
(* recursively mapping the function g over the rest of xs is equivalent to the stream of iterations of g on x *)
lemma rek2siter: assumes "xs = \<up>x \<bullet> (smap g\<cdot>xs)"
  shows "xs = siterate g x"
apply (rule sinf_snt2eq, auto)
apply (metis Inf'_def assms fix_least inf_less_eq lnle_conv slen_scons slen_smap)
by (metis assms rek2niter snth_siter)

(* shows that siterate produces the least fixed point of the alternative recursive definition *)
lemma fixrek2siter: "fix\<cdot>(\<Lambda> s . (\<up>x \<bullet> smap g\<cdot>s)) =  siterate g x"
by (metis (no_types) cfcomp1 cfcomp2 fix_eq rek2siter)

(* dropping elements from a stream of iterations is equivalent to adding iterations to every element *)
lemma sdrop2smap: "sdrop i\<cdot>(siterate g x) = smap (niterate i g)\<cdot>(siterate g x)"
by (simp add: iterate_insert siterate_drop2iter siterate_smap)

(* ----------------------------------------------------------------------- *)
section \<open>Adm simp rules\<close>
(* ----------------------------------------------------------------------- *)

text\<open>For functions g and h producing sets the following predicate is admissible\<close>
lemma adm_subsetEq [simp]: "adm (\<lambda>s. g\<cdot>s \<subseteq> h\<cdot>s)"
by (metis (full_types) SetPcpo.less_set_def adm_below cont_Rep_cfun2)

text\<open>For a function g producing sets and a set cs the following predicate is admissible\<close>
lemma adm_subsetEq_rc [simp]: "adm (\<lambda>s. g\<cdot>s \<subseteq> cs)"
by (metis (no_types, lifting) adm_def chain_monofun contlub_cfun_arg lub_below set_cpo_simps(1))

text\<open>For a function h producing sets and a set cs the following predicate is admissible\<close>
lemma adm_subsetEq_lc [simp]: "adm (\<lambda>s. cs \<subseteq> h\<cdot>s)"
by (simp add: adm_subst adm_superset)

text\<open>For a set cs and a function g producing sets, the following predicate is admissible\<close>
lemma adm_subsetNEq_rc [simp]: "adm (\<lambda>s. \<not> g\<cdot>s \<subseteq> cs)"
  apply(rule admI)
  apply(rule+)
  by (metis SetPcpo.less_set_def is_ub_thelub monofun_cfun_arg subset_eq)

text\<open>For a function g over streams, the admissiblity of the following predicate over streams holds\<close>
lemma sValues_adm2[simp]: "adm (\<lambda>a. sValues\<cdot>(g\<cdot>a) \<subseteq> sValues\<cdot>a)"
apply(rule admI)
by (smt SetPcpo.less_set_def ch2ch_Rep_cfunR contlub_cfun_arg is_ub_thelub lub_below subset_iff)

(* admissibility of finstream *)
lemma adm_finstream [simp]: "adm (\<lambda>s. #s<\<infinity> \<longrightarrow> P s)"
apply(rule admI)
apply auto
using inf_chainl4 lub_eqI lub_finch2 by fastforce

(* admissibility of fin below *)
lemma adm_fin_below: "adm (\<lambda>x . \<not> Fin n \<sqsubseteq> # x)"
  apply(rule admI)
  apply auto
  by (metis inf_chainl3 finite_chain_def maxinch_is_thelub)

(* admissibility of fin below for special case of \<le> *)
lemma adm_fin_below2: "adm (\<lambda>x . \<not> Fin n \<le> # x)"
by(simp only: lnle_def adm_fin_below)

(* ----------------------------------------------------------------------- *)
section \<open>New @{term sfilter} lemmata and @{term sfoot}\<close>
(* ----------------------------------------------------------------------- *)

(* ----------------------------------------------------------------------- *)
subsection \<open>New @{term sfilter} lemmata\<close>
(* ----------------------------------------------------------------------- *)

text\<open>Appending the singleton stream \<up>a increases the length of the stream y by one\<close>
lemma slen_lnsuc:
  shows "#(y \<bullet> \<up>a) = lnsuc\<cdot>(#y)"
  apply(induction y)
    apply (smt admI fold_inf inf_chainl4 lub_eqI lub_finch2 sconc_fst_inf)
   apply (metis sconc_fst_empty sconc_snd_empty slen_scons)
  by (metis (no_types, lifting) assoc_sconc slen_scons stream.con_rews(2) stream.sel_rews(5) surj_scons)

(* if filtering the stream s2 with the set A produces infinitely many elements then prepending any
   finite stream s1 to s2 will still produce infinitely many elements *)
lemma sfilter_conc2[simp]: assumes "#(sfilter A\<cdot>s2) = \<infinity>" and "#s1 < \<infinity>"
  shows "#(sfilter A\<cdot>(s1\<bullet>s2)) = \<infinity>"
proof -
  have "(sfilter A\<cdot>(s1\<bullet>s2)) = ((sfilter A\<cdot>s1) \<bullet> (sfilter A\<cdot>s2))"
    using add_sfilter assms(2) lnless_def ninf2Fin by fastforce
  thus ?thesis by (simp add: assms(1) slen_sconc_snd_inf)
qed

(* if the stream z is a prefix of another non-empty stream (y\<bullet>\<up>a) but isn't equal to it, then z is
   also a prefix of y *)
lemma below_conc: assumes "z \<sqsubseteq> (y\<bullet>\<up>a)" and "z\<noteq>(y\<bullet>\<up>a)"
  shows "z\<sqsubseteq>y"
proof(cases "#y = \<infinity>")
  case True thus ?thesis using assms(1) sconc_fst_inf by auto
next
  case False
  obtain n_y where "Fin n_y= #y" using False ninf2Fin by fastforce
  have "#z \<le> #(y\<bullet>\<up>a)" using assms(1) mono_slen by blast
  have "#z \<noteq> #(y\<bullet>\<up>a)" using assms(1) assms(2) eq_slen_eq_and_less by blast
  hence "#z < #(y\<bullet>\<up>a)" using \<open>#z \<le> #(y \<bullet> \<up>a)\<close> lnle_def lnless_def by blast
  obtain n_z where nz_def: "Fin n_z = #z" using approxl2 assms(1) assms(2) by blast
  have "#y < #(y \<bullet> \<up>a)"
    by (metis \<open>Fin n_y = #y\<close> eq_slen_eq_and_less inject_sconc lnless_def minimal monofun_cfun_arg sconc_snd_empty stream.con_rews(2) sup'_def up_defined)
  have "#y < \<infinity>" by (simp add: False lnless_def)
  hence "Fin n_z \<le> #y" by (metis Fin_Suc \<open>#z < #(y \<bullet> \<up>a)\<close> less2lnleD lnsuc_lnle_emb nz_def slen_lnsuc)
  have "\<And>s. stake n_y\<cdot>(y \<bullet> s) = y" by (simp add: \<open>Fin n_y = #y\<close> approxl1)
  hence "stake n_z\<cdot>y = stake n_z\<cdot>(y\<bullet>\<up>a)" by (metis \<open>Fin n_y = #y\<close> \<open>Fin n_z \<le> #y\<close> less2nat min_def stakeostake)
  thus ?thesis by (metis \<open>Fin n_z = #z\<close> approxl1 assms(1) stream.take_below)
qed

(* for any set A and singleton stream \<up>a the following predicate over streams is admissible *)
lemma sfilter_conc_adm: "adm (\<lambda>b. #b<\<infinity> \<longrightarrow> #(A \<ominus> b) < #(A \<ominus> b \<bullet> \<up>a))" (is "adm ?F")
by (metis (mono_tags, lifting) admI inf_chainl4 lnless_def lub_eqI lub_finch2)

(* the element a is kept when filtering with A, so (x \<bullet> \<up>a) produces a larger result than just x,
   provided that x is finite *)
lemma sfilter_conc: assumes "a\<in>A"
  shows "#x<\<infinity> \<Longrightarrow> #(A \<ominus> x) < #(A \<ominus> (x \<bullet> \<up>a))" (is "_ \<Longrightarrow> ?F x")
  proof(induction x)
    show "adm (\<lambda>b. #b < \<infinity> \<longrightarrow> #(A \<ominus> b) < #(A \<ominus> b \<bullet> \<up>a))" using sfilter_conc_adm by blast
   show "?F \<epsilon>" using assms(1) lnless_def by auto
  next
  fix u :: "'a discr u"
  fix s :: "'a stream"
  assume "u\<noteq>\<bottom>" and "#s<\<infinity> \<Longrightarrow> ?F s" and "#(u && s) < \<infinity>"
  obtain ua where "(updis ua) = u" by (metis \<open>u \<noteq> \<bottom>\<close> discr.exhaust upE)
  hence "u && s = \<up>ua \<bullet>s" using lscons_conv by blast
  thus "?F (u&&s)"
  by (smt \<open>#(u && s) < \<infinity>\<close> \<open>#s < \<infinity> \<Longrightarrow> #(A \<ominus> s) < #(A \<ominus> s \<bullet> \<up>a)\<close> assoc_sconc fold_inf lnat.sel_rews(2) lnless_def monofun_cfun_arg sfilter_in sfilter_nin slen_scons)
qed

(* for any finite stream s and set A, if filtering s with A doesn't produce the empty stream, then
   filtering and infinite repetition are associative *)
lemma sfilter_sinf [simp]: assumes "#s<\<infinity>" and "(A \<ominus> s) \<noteq> \<epsilon>"
  shows "A \<ominus> (s\<^sup>\<infinity>) = ((A \<ominus> s)\<^sup>\<infinity>)"
by (metis add_sfilter assms(1) assms(2) infI lnless_def rek2sinftimes sinftimes_unfold)

(* if filtering the stream s with the set A produces infinitely many elements, then filtering the
   rest of s with A also produces infinitely many elements *)
lemma sfilter_srt_sinf [simp]: assumes "#(A \<ominus> s) = \<infinity>"
  shows  "#(A \<ominus> (srt\<cdot>s)) = \<infinity>"
by (smt assms inf_scase inject_scons sfilter_in sfilter_nin stream.sel_rews(2) surj_scons)

(* additional snth--lemma *)
lemma sfilter_ntimes [simp]: "#({True} \<ominus> ((sntimes n (\<up>False))\<bullet>ora2)) = #({True} \<ominus> ora2)"
  apply(induction n)
    by auto

(* snth to sntimes *)
lemma snth2sntimes: "(\<And>i. i<n \<Longrightarrow> snth i s = False) \<Longrightarrow> Fin n < #s \<Longrightarrow> (sntimes n (\<up>False)) \<sqsubseteq> s"
proof(induction n arbitrary: s)
  case 0
  then show ?case by auto
next
  case (Suc n)
    have "shd s = False"
      using Suc.prems snth_shd by blast
     hence "s = \<up>False \<bullet> (srt\<cdot>s)"
       using Suc.prems(2) empty_is_shortest surj_scons by force
    have "(\<And>i. i < n \<Longrightarrow> snth i (srt\<cdot>s) = False)"
      using Suc.prems snth_rt by auto
     hence "n\<star>\<up>False \<sqsubseteq> (srt\<cdot>s)"
       by (meson Suc.IH Suc.prems(2) linorder_not_le slen_rt_ile_eq)
     hence "\<up>False \<bullet> (n\<star>\<up>False) \<sqsubseteq> \<up>False \<bullet> (srt\<cdot>s)"
       by (simp add: monofun_cfun_arg)
     then show ?case
       using \<open>s = \<up>False \<bullet> srt\<cdot>s\<close> by auto
qed

(* length of sntimes *)
lemma sntimes_len [simp]: "#(n\<star>\<up>a) = Fin n"
  apply(induction n)
  by auto

(* if length of a stream is Fin n, then snth (n+m) (xs\<bullet>ys) is equal to snth m ys *)
lemma snth_scons2: assumes "#xs = Fin n"
  shows "snth (n+m) (xs\<bullet>ys) = snth m ys"
  apply(simp add: snth_def)
  by (simp add: add.commute assms sdrop_plus sdropl6)

(* if ({True} \<ominus> s) is unequal to bottom, then (sntimes n (\<up>False)) \<bullet> \<up>True is a prefix of s *)
lemma sbool_ntimes_f: assumes "({True} \<ominus> s) \<noteq>\<bottom>"
  obtains n where "(sntimes n (\<up>False)) \<bullet> \<up>True \<sqsubseteq> s"
proof -
  have h1: "\<exists>i. snth i s = True"
    by (metis assms ex_snth_in_sfilter_nempty singletonD)
  obtain n where "Fin n < #s" and n_def: "n = Least (\<lambda>i. snth i s = True)"
    by (smt assms ex_snth_in_sfilter_nempty less2nat not_less not_less_Least not_less_iff_gr_or_eq singletonD trans_lnless)
  have "snth n s = True"
    using LeastI h1 n_def by force
  have "\<And>i. i<n \<Longrightarrow> snth i s \<noteq> True" using not_less_Least n_def by fastforce
  hence"\<And>i. i<n \<Longrightarrow> snth i s = False" by auto
  hence "(sntimes n (\<up>False)) \<sqsubseteq> s"
    using \<open>Fin n < #s\<close> snth2sntimes by blast
  obtain xs where xs_def: "s = (sntimes n (\<up>False)) \<bullet> xs"
    using \<open>n\<star>\<up>False \<sqsubseteq> s\<close> approxl3 by auto
  hence "xs\<noteq>\<bottom>"
    by (metis assms sfilter_ntimes slen_empty_eq strict_sfilter)
  have "shd xs = snth n s"
    by (simp add: sdropl6 snth_def xs_def)
  hence "shd xs = True"
    using \<open>snth n s = True\<close> by auto
  thus ?thesis
    by (metis (full_types)\<open>xs \<noteq> \<epsilon>\<close> lscons_conv minimal monofun_cfun_arg sup'_def surj_scons that xs_def)
  qed

(* ----------------------------------------------------------------------- *)
section \<open>@{term sfoot}\<close>
(* ----------------------------------------------------------------------- *)

(* appending the singleton stream \<up>a to a finite stream s causes sfoot to extract a again *)
lemma sfoot1[simp]: assumes "xs = s\<bullet>(\<up>a)" and "#xs < \<infinity>"
   shows "sfoot xs = a"
proof -
  have "xs \<noteq> \<epsilon>" using assms(1) strictI by force
  obtain n where n_def: "Fin n = #xs" by (metis assms(2) lncases lnless_def)
  hence "n>0" using assms(2) gr0I using Fin_02bot \<open>xs \<noteq> \<epsilon>\<close> lnzero_def slen_empty_eq by fastforce
  hence "(THE n'. lnsuc\<cdot>(Fin n') = #xs) = n-1" by (metis (mono_tags, lifting) Fin_Suc Suc_diff_1 n_def inject_Fin inject_lnsuc the_equality)
  have "snth (n-1) xs = a" by (metis Fin_0 Fin_Suc Suc_diff_1 assms(1) n_def bot_is_0 inject_lnsuc lnat.con_rews lscons_conv neq0_conv sdropl6 shd1 slen_lnsuc snth_def sup'_def)
  thus ?thesis by (metis \<open>(THE n'. lnsuc\<cdot>(Fin n') = #xs) = n - 1\<close> sfoot_def)
qed

(* sfoot extracts the element a from any finite stream ending with \<up>a *)
lemma sfoot12 [simp]: assumes "#s<\<infinity>"
  shows "sfoot (s\<bullet>\<up>a) = a"
by (metis assms fold_inf inject_lnsuc lnless_def monofun_cfun_arg sfoot1 slen_lnsuc)

(* sfoot extracts a from the singleton stream \<up>a *)
lemma sfoot_one [simp]: "sfoot (\<up>a) = a"
by (metis Inf'_neq_0 inf_ub lnle_def lnless_def sconc_fst_empty sfoot12 strict_slen)

(* concatenating finite streams produces another finite stream *)
lemma sconc_slen [simp]: assumes "#s<\<infinity>" and "#xs<\<infinity>"
  shows "#(s\<bullet>xs) < \<infinity>"
by (metis Fin_neq_inf assms(1) assms(2) infI inf_ub lnle_def lnless_def slen_sconc_all_finite)

lemma sconc_slen2: "\<And>(s1::'a stream) s2::'a stream. #(s1 \<bullet> s2) = #s1 + #s2"
proof -
  fix s1::"'a stream"
  fix s2::"'a stream"

  have "#s1 = \<infinity> \<Longrightarrow> #(s1 \<bullet> s2) = #s1 + #s2"
    by (simp add: plus_lnatInf_r)
  moreover
  have "#s2 = \<infinity> \<Longrightarrow> #(s1 \<bullet> s2) = #s1 + #s2"
    by (simp add: slen_sconc_snd_inf)
  moreover
  have "#s1 \<noteq> \<infinity> \<Longrightarrow> #s2 \<noteq> \<infinity> \<Longrightarrow> #(s1 \<bullet> s2) = #s1 + #s2"
  proof-
    assume "#s1 \<noteq> \<infinity>"
    then obtain l_s1 where l_s1_def: "Fin l_s1 = #s1"
      using infI by metis
    assume " #s2 \<noteq> \<infinity>"
    then obtain l_s2 where l_s2_def: "Fin l_s2 =  #s2"
      using infI by metis
    show ?thesis
      using l_s1_def l_s2_def by (metis lnat_plus_fin slen_sconc_all_finite)
  qed

  then show "#(s1 \<bullet> s2) = #s1 + #s2"
    using calculation by linarith
qed

(* if the foot of a non-empty stream xs is a, then xs consists of another stream s (possibly empty)
   concatenated with \<up>a *)
lemma sfoot2 [simp]: assumes "sfoot xs = a" and "xs\<noteq>\<epsilon>"
  shows "\<exists>s. xs = s \<bullet> \<up>a"
proof (cases "#xs = \<infinity>")
  case True thus ?thesis by (metis sconc_fst_inf)
next
  case False
  obtain n where "#xs = Fin n" using False lncases by auto
  hence "(THE n'. lnsuc\<cdot>(Fin n') = #xs) = n-1"
    by (smt Fin_02bot Fin_Suc Suc_diff_1 assms(2) bot_is_0 inject_Fin inject_lnsuc neq0_conv slen_empty_eq the_equality)
  have "stake (n-1)\<cdot>xs \<bullet> \<up>(snth (n-1) xs) = xs"
    by (smt Fin_0 Fin_Suc Inf'_def Suc_diff_1 \<open>#xs = Fin n\<close> assms(2) fin2stake fix_least_below lnle_def neq0_conv notinfI3 sconc_snd_empty sdrop_back_rt sdropostake slen_empty_eq snth_def split_streaml1 surj_scons ub_slen_stake)
  thus ?thesis by (metis \<open>(THE n'. lnsuc\<cdot>(Fin n') = #xs) = n - 1\<close> assms(1) sfoot_def)
qed

(* when sfoot is applied to the concatenation of two finite streams s and xs, and xs is not empty,
   then sfoot will produce the foot of xs *)
lemma sfoot_conc [simp]: assumes "#s<\<infinity>" and "#xs<\<infinity>" and "xs\<noteq>\<epsilon>"
  shows "sfoot (s\<bullet>xs) = sfoot xs"
by (metis (no_types, hide_lams) assms(1) assms(2) assms(3) assoc_sconc sconc_slen sfoot1 sfoot2)

(* if the finite stream s contains more than one element then the foot of s will be the foot of the
   rest of s *)
lemma sfoot_sdrop: assumes "Fin 1<#s" and "#s<\<infinity>"
  shows "sfoot (srt\<cdot>s) = sfoot s"
proof -
  obtain s' where "s = s' \<bullet> \<up>(sfoot s)" by (metis assms(1) below_antisym bot_is_0 lnless_def minimal sfoot2 strict_slen)
  hence "s' \<noteq> \<epsilon>"
    by (metis Fin_02bot Fin_Suc One_nat_def assms(1) lnless_def lnzero_def slen_lnsuc strict_slen)
  hence "srt\<cdot>s = srt\<cdot>s' \<bullet> \<up>(sfoot s)"
    by (smt \<open>s = s' \<bullet> \<up>(sfoot s)\<close> assoc_sconc inject_scons sconc_snd_empty strictI surj_scons)
  thus ?thesis
    by (metis \<open>s = s' \<bullet> \<up>(sfoot s)\<close> \<open>s' \<noteq> \<epsilon>\<close> assms(2) inf_ub lnle_conv lnless_def sconc_snd_empty sfoot1 slen_sconc_snd_inf strictI surj_scons)
qed

(* if length of xs is finite, then it holds that sfoot (\<up>a \<bullet> \<up>b \<bullet> xs) = sfoot (\<up>b \<bullet> xs) *)
lemma [simp]: assumes "#xs < \<infinity>"
  shows "sfoot (\<up>a \<bullet> \<up>b \<bullet> xs) = sfoot (\<up>b \<bullet> xs)"
using assms lnless_def by auto

(* the foot of any stream s is the nth element of s for some natural number n *)
lemma sfoot_exists [simp]:"\<exists>n. snth n s = sfoot s"
by (metis sfoot_def)

(* if the stream s contains n+1 elements then the foot of s will be found at index n *)
lemma  sfoot_exists2:
  shows "Fin (Suc n) = #s \<Longrightarrow> snth n s = sfoot s"
  apply(induction n arbitrary: s)
   apply (metis (mono_tags, lifting) Fin_02bot Fin_Suc Zero_lnless_infty inject_lnsuc lnzero_def sconc_fst_empty sconc_snd_empty sfoot12 slen_empty_eq slen_scons snth_shd surj_scons)
  by (smt Fin_Suc Fin_neq_inf fold_inf inf_ub inject_lnsuc lnat.con_rews lnle_conv lnless_def lnzero_def sconc_snd_empty sfoot_conc slen_scons snth_rt strict_slen surj_scons)

text \<open>Streams can be split for filtering\<close>
lemma add_sfilter2: assumes "#x < \<infinity>"
  shows "sfilter A\<cdot>(x \<bullet> y) = sfilter A\<cdot>x \<bullet> sfilter A\<cdot>y"
by (metis (no_types) add_sfilter assms lncases lnless_def)

(* if lenght of s is Fin (Suc n), then it holds that (stake n\<cdot>s) \<bullet> \<up>(sfoot s) = s *)
lemma sfood_id: assumes"#s = Fin (Suc n)"
  shows "(stake n\<cdot>s) \<bullet> \<up>(sfoot s) = s"
  using assms apply(induction n arbitrary: s)
   apply simp
   apply (metis Fin_02bot Fin_Suc lnat.sel_rews(2) lnsuc_neq_0_rev lnzero_def lscons_conv sfoot_exists2 slen_scons snth_shd strict_slen sup'_def surj_scons)
  apply (subst stake_suc)
  apply simp
  by (smt Fin_02bot Fin_Suc One_nat_def Rep_cfun_strict1 Zero_not_Suc leI lnat.sel_rews(2) lnle_Fin_0 lnzero_def notinfI3 sconc_snd_empty sfoot_sdrop slen_rt_ile_eq slen_scons stake_Suc stream.take_0 strict_slen surj_scons)

lemma footind: "#s = Fin k \<Longrightarrow> P \<epsilon> \<Longrightarrow> (\<And>t a. #t < \<infinity> \<Longrightarrow> P t \<Longrightarrow> P (t \<bullet> \<up>a)) \<Longrightarrow> P s"
proof -
  assume "#s = Fin k" and "P \<epsilon>" and "\<And>t a. #t < \<infinity> \<Longrightarrow> P t \<Longrightarrow> P (t \<bullet> \<up>a)"
  then show "P s"
  proof (induction k arbitrary: s rule: less_induct)
    case (less k)
    then have IH: "\<And>t. #t < Fin k \<Longrightarrow> P \<epsilon> \<Longrightarrow> (\<And>u b. #u < \<infinity> \<Longrightarrow> P u \<Longrightarrow> P (u \<bullet> \<up>b)) \<Longrightarrow> P t"
      by (meson lnat_well_h1)
    then show ?case
    proof (cases "k = 0")
      case True
      then show ?thesis
        using less.prems(1) less.prems(2) by force
    next
      case False
      then obtain u b where "s = u \<bullet> \<up>b"
        using less.prems(1) sfoot2 by force
      then have "#u < Fin k"
        by (metis fold_inf leI less.prems(1) ln_less lnsuc_lnle_emb notinfI3 slen_lnsuc)
      then show ?thesis
        by (metis IH \<open>s = u \<bullet> \<up>b\<close> inf_ub less.prems(2) less.prems(3) less_le not_less)
    qed
  qed
qed

lemma footind2: "#s < \<infinity> \<Longrightarrow> P \<epsilon> \<Longrightarrow> (\<And>t a. #t < \<infinity> \<Longrightarrow> P t \<Longrightarrow> P (t \<bullet> \<up>a)) \<Longrightarrow> P s"
  by (metis footind infI less_le)

lemma srcdups_sfoot:
  "s \<noteq> \<epsilon> \<Longrightarrow> #s < \<infinity> \<Longrightarrow> sfoot (srcdups\<cdot>s) = sfoot s"
proof (rule footind2, simp+)
  fix t :: "'a stream" and a :: 'a
  assume "#t < \<infinity>" and "sfoot (srcdups\<cdot>t) = sfoot t"
  show "sfoot (srcdups\<cdot>(t \<bullet> \<up>a)) = a"
  proof (rule footind2 [of t], auto, simp add: \<open>#t < \<infinity>\<close>)
    fix t :: "'a stream" and b :: 'a
    assume "#t < \<infinity>" and "sfoot (srcdups\<cdot>(t \<bullet> \<up>a)) = a"
    then show "sfoot (srcdups\<cdot>(t \<bullet> \<up>b \<bullet> \<up>a)) = a"
    proof -
      have "\<And>l. l < \<infinity> \<or> l = \<infinity>"
        by (meson inf_less_eq le_less_linear)
      then show ?thesis
        by (metis (no_types) Fin_Suc \<open>#t < \<infinity>\<close> \<open>sfoot (srcdups\<cdot>(t \<bullet> \<up>a)) = a\<close> lnat_well_h2 notinfI3 sfoot12 slen_lnsuc srcdups_end_eq srcdups_end_neq srcdups_slen)
    qed
  qed
qed

lemma sfoot_end:
  fixes s and a
  assumes "#s < \<infinity>" and "s \<noteq> \<epsilon>"
  shows "\<exists>t n. s = t \<bullet> (sntimes n (\<up>(sfoot s))) \<and> (t = \<epsilon> \<or> sfoot s \<noteq> sfoot t)"
  apply (rule footind2)
  apply (simp add: assms(1))
   apply (metis sconc_fst_empty sntimes.simps(1))
proof -
  fix t :: "'a stream" and a :: 'a
  assume "#t < \<infinity>" and "\<exists>ta n. t = ta \<bullet> (sntimes n (\<up>(sfoot t))) \<and> (ta = \<epsilon> \<or> sfoot t \<noteq> sfoot ta)"
  then obtain u n where "t = u \<bullet> (sntimes n (\<up>(sfoot t)))" and "u = \<epsilon> \<or> sfoot t \<noteq> sfoot u"
    by blast
  then have expr: "t \<bullet> \<up>a = u \<bullet> (sntimes n (\<up>(sfoot t))) \<bullet> \<up>a"
    by (metis assoc_sconc)
  then show "\<exists>ta n. ((t \<bullet> \<up>a) =(ta \<bullet> (n\<star>(\<up>(sfoot (t \<bullet> \<up>a)))))) \<and> ((ta = \<epsilon>) \<or> (sfoot (t \<bullet> \<up>a) \<noteq> sfoot ta))"
  proof (cases "a = sfoot t")
    case True
    then have "t \<bullet> \<up>a = u \<bullet> (sntimes (Suc n) (\<up>(sfoot t)))"
      by (metis expr sntimes_Suc2)
    then show ?thesis
      by (metis True \<open>#t < \<infinity>\<close> \<open>u = \<epsilon> \<or> sfoot t \<noteq> sfoot u\<close> sfoot12)
  next
    case False
    then have "t \<bullet> \<up>a = (u \<bullet> (sntimes n (\<up>(sfoot t)))) \<bullet> (sntimes (Suc 0) (\<up>(sfoot (t \<bullet> \<up>a))))"
      using \<open>#t < \<infinity>\<close> \<open>t = u \<bullet> (n\<star>\<up>(sfoot t))\<close> by auto
    then show ?thesis
      by (metis False \<open>#t < \<infinity>\<close> \<open>t = u \<bullet> (n\<star>\<up>(sfoot t))\<close> sfoot12)
  qed
qed

lemma srcdups_split_fin: "#s = Fin k \<Longrightarrow> Suc n < k \<Longrightarrow> snth n s \<noteq> snth (Suc n) s \<Longrightarrow> srcdups\<cdot>s = srcdups\<cdot>(stake (Suc n)\<cdot>s) \<bullet> (srcdups\<cdot>(sdrop (Suc n)\<cdot>s))"
proof (induction k arbitrary: n s)
  case 0
  then show ?case
    by auto
next
  case (Suc k)
  then obtain a t where "s = \<up>a \<bullet> t"
    by (metis Fin_0 Suc_neq_Zero strict_slen surj_scons)
  assume "snth n s \<noteq> snth (Suc n) s"
  then have "Suc n < Suc k"
    using Suc.prems(2) by blast
  then show ?case
  proof (cases "k > 1")
    case True
    then obtain a b t where "s = \<up>a \<bullet> \<up>b \<bullet> t"
    proof -
      assume a1: "\<And>a b t. s = \<up>a \<bullet> \<up>b \<bullet> t \<Longrightarrow> thesis"
      have "#(\<epsilon>::'a stream) = \<bottom>"
        using bot_is_0 by auto
      then show ?thesis
        using a1 by (metis Fin_Suc Suc.prems(1) True inject_lnsuc less2nat_lemma lnat.con_rews lnle_def minimal not_le srt_decrements_length surj_scons)
    qed
    then have "t \<noteq> \<epsilon>"
      using Suc.prems(1) True by force
    then show ?thesis
    proof (cases "n = 0")
      case True
      then have "a \<noteq> b"
        using Suc.prems(3) \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> by auto
      then show ?thesis
        using True \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> by auto
    next
      case False
      then obtain m where "n = Suc m"
        using not0_implies_Suc by blast
      have "#(\<up>b \<bullet> t) = Fin k"
        using Suc.prems(1) \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> by auto
      moreover have "snth n s = snth m (\<up>b \<bullet> t)"
        by (simp add: \<open>n = Suc m\<close> \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close>)
      ultimately have "srcdups\<cdot>(\<up>b \<bullet> t) = srcdups\<cdot>(stake n\<cdot>(\<up>b \<bullet> t)) \<bullet> (srcdups\<cdot>(sdrop n\<cdot>(\<up>b \<bullet> t)))"
        by (metis Suc.IH Suc.prems(2) Suc.prems(3) Suc_less_SucD \<open>n = Suc m\<close> \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> snth_scons)
      then show ?thesis
      proof (cases "srcdups\<cdot>s = srcdups\<cdot>(\<up>b \<bullet> t)")
        case True
        then show ?thesis
        proof -
          have "a = b"
            by (metis (no_types) True \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> srcdups_shd)
          then show ?thesis
            by (simp add: \<open>n = Suc m\<close> \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> \<open>srcdups\<cdot>(\<up>b \<bullet> t) = srcdups\<cdot> (stake n\<cdot> (\<up>b \<bullet> t)) \<bullet> srcdups\<cdot> (sdrop n\<cdot>(\<up>b \<bullet> t))\<close>)
        qed
      next
        case False
        then show ?thesis
        proof -
          have "a \<noteq> b"
            using False \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> srcdups_eq2 by blast
          then show ?thesis
            by (simp add: \<open>n = Suc m\<close> \<open>s = \<up>a \<bullet> \<up>b \<bullet> t\<close> \<open>srcdups\<cdot>(\<up>b \<bullet> t) = srcdups\<cdot> (stake n\<cdot> (\<up>b \<bullet> t)) \<bullet> srcdups\<cdot> (sdrop n\<cdot>(\<up>b \<bullet> t))\<close>)
        qed
      qed
    qed
  next
    case False
    then have "k \<le> 1"
      by auto
    then show ?thesis
    proof (cases "k = 0")
      case True
      then show ?thesis
        using Suc.prems(2) by blast
    next
      case False
      then have "k = 1"
        using \<open>k \<le> 1\<close> by auto
      then obtain a b where "s = \<up>a \<bullet> \<up>b"
        by (metis One_nat_def Rep_cfun_strict1 Suc.prems(1) \<open>\<And>thesis. (\<And>a t. s = \<up>a \<bullet> t \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> sconc_snd_empty sfood_id stake_Suc stream.take_0)
      then have "a \<noteq> b"
        using Suc.prems(2) Suc.prems(3) \<open>k = 1\<close> by auto
      then have "srcdups\<cdot>s = \<up>a \<bullet> \<up>b"
        by (metis \<open>s = \<up>a \<bullet> \<up>b\<close> lscons_conv srcdups_neq srcdups_step strict_sdropwhile strict_srcdups sup'_def)
      then show ?thesis
        using Suc.prems(2) \<open>k = 1\<close> \<open>s = \<up>a \<bullet> \<up>b\<close> by auto
    qed
  qed
qed

lemma srcdups_split_inf: "#s = \<infinity> \<Longrightarrow> snth n s \<noteq> snth (Suc n) s \<Longrightarrow> srcdups\<cdot>s = srcdups\<cdot>(stake (Suc n)\<cdot>s) \<bullet> (srcdups\<cdot>(sdrop (Suc n)\<cdot>s))"
proof (induction n arbitrary: s)
  case 0
  then obtain a b t where "s = \<up>a \<bullet> \<up>b \<bullet> t" and "a \<noteq> b"
    by (metis inf_scase shd1 snth_scons snth_shd)
  then show ?case
    by auto
next
  case (Suc n)
  obtain a t where "s = \<up>a \<bullet> t"
    using Suc.prems(1) inf_scase by blast
  then have "#t = \<infinity>"
    using Suc.prems(1) by auto
  moreover have "snth n t \<noteq> snth (Suc n) t"
    using Suc.prems(2) \<open>s = \<up>a \<bullet> t\<close> by auto
  ultimately have "srcdups\<cdot>t = srcdups\<cdot>(stake (Suc n)\<cdot>t) \<bullet> (srcdups\<cdot>(sdrop (Suc n)\<cdot>t))"
    using Suc.IH by blast
  then show ?case
  proof (cases "a = shd t")
    case True
    then have "srcdups\<cdot>s = srcdups\<cdot>t"
      by (metis Inf'_neq_0 \<open>#t = \<infinity>\<close> \<open>s = \<up>a \<bullet> t\<close> slen_empty_eq srcdups_eq surj_scons)
    then show ?thesis
      using True \<open>#t = \<infinity>\<close> \<open>s = \<up>a \<bullet> t\<close> \<open>srcdups\<cdot>t = srcdups\<cdot> (stake (Suc n)\<cdot>t) \<bullet> srcdups\<cdot>(sdrop (Suc n)\<cdot>t)\<close> inf_scase by fastforce
  next
    case False
    then have "srcdups\<cdot>s = \<up>a \<bullet> srcdups\<cdot>t"
      by (metis Inf'_neq_0 \<open>#t = \<infinity>\<close> \<open>s = \<up>a \<bullet> t\<close> slen_empty_eq srcdups_neq surj_scons)
    then show ?thesis
      using False \<open>#t = \<infinity>\<close> \<open>s = \<up>a \<bullet> t\<close> \<open>srcdups\<cdot>t = srcdups\<cdot> (stake (Suc n)\<cdot>t) \<bullet> srcdups\<cdot>(sdrop (Suc n)\<cdot>t)\<close> inf_scase by fastforce
  qed
qed

lemma srcdups_split2: "Fin (Suc n) < #s \<Longrightarrow> snth n s \<noteq> snth (Suc n) s \<Longrightarrow> srcdups\<cdot>s = srcdups\<cdot>(stake (Suc n)\<cdot>s) \<bullet> (srcdups\<cdot>(sdrop (Suc n)\<cdot>s))"
  by (metis less2nat ninf2Fin not_le srcdups_split_fin srcdups_split_inf)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sValues}\<close>
(* ----------------------------------------------------------------------- *)

(* sValues equality rule *)
lemma sValues_eq: "{z. \<exists>n. Fin n < #s \<and> z = snth n s} = {snth n s |n. Fin n < #s}"
by auto

(* another sValues equality rule *)
lemma sValues_eq2: "{snth n s |n. Fin n < #s} = {z. \<exists>n. Fin n < #s \<and> z = snth n s}"
by auto

text \<open>A stream and its prefix agree on their first elements\<close>
lemma snth_less: "\<lbrakk>Fin n < #x; x \<sqsubseteq> y\<rbrakk> \<Longrightarrow> snth n x = snth n y"
apply (simp add: atomize_imp)
apply (rule_tac x="x" in spec)
apply (rule_tac x="y" in spec)
apply (induct_tac n, auto)
by (drule lessD, auto)+

lemma slen_snth_prefix: "#s > Fin n \<Longrightarrow> snth n s = snth n (s \<bullet> t)"
  by (simp add: monofun_cfun_arg snth_less)

lemma srcdups_sconc:
  "#xs < \<infinity> \<Longrightarrow> xs \<noteq> \<epsilon> \<Longrightarrow>
    srcdups\<cdot>(xs \<bullet> ys) = (srcdups\<cdot>xs) \<bullet> (srcdups\<cdot>(sdropwhile (\<lambda>x. x=sfoot xs)\<cdot>ys))"
proof -
  assume "#xs < \<infinity>" and "xs \<noteq> \<epsilon>"
  then obtain t n where "xs = t \<bullet> (sntimes n (\<up>(sfoot xs)))" and "t = \<epsilon> \<or> sfoot t \<noteq> sfoot xs"
    using sfoot_end by fastforce
  then show ?thesis
  proof (cases "t = \<epsilon>")
    case True
    then have "xs \<bullet> ys = (sntimes n (\<up>(sfoot xs))) \<bullet> ys"
      using \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> by auto
    then have "srcdups\<cdot>(xs \<bullet> ys) = (\<up>(sfoot xs)) \<bullet> srcdups\<cdot>(sdropwhile (\<lambda>x. x=sfoot xs)\<cdot>ys)"
      by (metis Fin_02bot True \<open>xs = t \<bullet>( n\<star>\<up>(sfoot xs))\<close> \<open>xs \<noteq> \<epsilon>\<close> lnzero_def neq0_conv sconc_fst_empty slen_empty_eq sntimes_len srcdups_sntimes_prefix)
    then show ?thesis
      by (metis Fin_02bot True \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> \<open>xs \<noteq> \<epsilon>\<close> lnzero_def neq0_conv sconc_fst_empty slen_empty_eq sntimes_len srcdups_sntimes)
  next
    case False
    then obtain k where "#t = Fin (Suc k)"
      by (metis Fin_02bot \<open>t = \<epsilon> \<or> sfoot t \<noteq> sfoot xs\<close> \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> bot_is_0 ninf2Fin not0_implies_Suc sconc_fst_inf slen_empty_eq)
    then show ?thesis
    proof (cases "ys = \<epsilon>")
      case True
      then show ?thesis
        by simp
    next
      case False
      have "snth k (xs \<bullet> ys) \<noteq> snth (Suc k) (xs \<bullet> ys)"
      proof
        assume "snth k (xs \<bullet> ys) = snth (Suc k) (xs \<bullet> ys)"
        then have "snth k xs = snth (Suc k) xs"
          by (metis Fin_02bot Fin_Suc Suc_neq_Zero \<open>#t = Fin (Suc k)\<close> \<open>#xs < \<infinity>\<close> \<open>t = \<epsilon> \<or> sfoot t \<noteq> sfoot xs\<close> \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> stake_prefix slen_snth_prefix inject_Fin le2lnle leI less_le lnless_def lnzero_def monofun_cfun_arg notinfI3 sfoot_exists2 stream.take_below strict_slen)
        then show "False"
          by (metis Fin_02bot Fin_Suc Suc_neq_Zero \<open>#t = Fin (Suc k)\<close> \<open>t = \<epsilon> \<or> sfoot t \<noteq> sfoot xs\<close> \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> slen_snth_prefix inject_Fin leI ln_less lnzero_def neq0_conv notinfI3 sconc_snd_empty sdropl6 sfoot_exists2 shd_sntime slen_empty_eq snth_def sntimes_len)
      qed
      moreover have "Fin (Suc k) < #(xs \<bullet> ys)"
        by (metis False \<open>#t = Fin (Suc k)\<close> \<open>#xs < \<infinity>\<close> \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> minimal mono_slen monofun_cfun_arg sconc_snd_empty slen_conc)
      ultimately have "srcdups\<cdot>(xs \<bullet> ys) = srcdups\<cdot>(stake (Suc k)\<cdot>(xs \<bullet> ys)) \<bullet> srcdups\<cdot>(sdrop (Suc k)\<cdot>(xs \<bullet> ys))"
        using srcdups_split2 by blast
      then have "srcdups\<cdot>(xs \<bullet> ys) = srcdups\<cdot>t \<bullet> srcdups\<cdot>((sntimes n (\<up>(sfoot xs))) \<bullet> ys)"
        by (metis \<open>#t = Fin (Suc k)\<close> \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> assoc_sconc stake_prefix2 sdropl6)
      then have "srcdups\<cdot>(xs \<bullet> ys) = srcdups\<cdot>t \<bullet> \<up>(sfoot xs) \<bullet> srcdups\<cdot>(sdropwhile (\<lambda>x. x=sfoot xs)\<cdot>ys)"
        by (metis \<open>t = \<epsilon> \<or> sfoot t \<noteq> sfoot xs\<close> \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> \<open>xs \<noteq> \<epsilon>\<close> neq0_conv sconc_snd_empty sntimes.simps(1) srcdups_sntimes_prefix)
      moreover have "srcdups\<cdot>xs = srcdups\<cdot>t \<bullet> \<up>(sfoot xs)"
      proof -
        have "srcdups\<cdot>xs = srcdups\<cdot>t \<bullet> srcdups\<cdot>(sntimes n (\<up>(sfoot xs)))"
          by (metis \<open>#t = Fin (Suc k)\<close> \<open>snth k (xs \<bullet> ys) \<noteq> snth (Suc k) (xs \<bullet> ys)\<close> \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> convert_inductive_asm slen_snth_prefix stake_prefix2 not_less notinfI3 sconc_snd_empty sdropl6 slen_conc srcdups_split2 strict_srcdups ub_slen_stake)
        then show ?thesis
          by (metis \<open>t = \<epsilon> \<or> sfoot t \<noteq> sfoot xs\<close> \<open>xs = t \<bullet> (n\<star>\<up>(sfoot xs))\<close> \<open>xs \<noteq> \<epsilon>\<close> neq0_conv sconc_snd_empty sntimes.simps(1) srcdups_sntimes)
      qed
      ultimately show ?thesis
        by simp
    qed
  qed
qed

text \<open>monotonicity of @{term sValues}\<close>
lemma sValues_mono: "monofun (\<lambda>s. {snth n s |n. Fin n < #s})"
apply (simp add: sValues_eq2)
apply (rule monofunI)
apply (rule_tac x="#x" in lncases)
apply (drule eq_less_and_fst_inf, simp+)
apply (simp add: atomize_imp)
apply (rule_tac x="y" in spec)
apply (rule_tac x="x" in spec)
apply (induct_tac k, simp+)
apply (auto simp add: less_set_def)
apply (drule lessD, auto)
apply (erule_tac x="q" in allE)
apply (erule_tac x="w" in allE, auto)
apply (case_tac "na", auto)
apply (rule_tac x="0" in exI, auto)
apply (frule_tac f="slen" in monofun_cfun_arg, simp)
apply (rule_tac x="Suc nat" in exI, auto)
apply (rule_tac x="#w" in lncases, auto)
by (rule snth_less, auto)

text \<open>In infinite chains, the length of the streams is unbounded\<close>
lemma inf_chainl3rf:
  "\<lbrakk>chain Y; \<not>finite_chain Y\<rbrakk> \<Longrightarrow> \<exists>k. Fin n \<le> #(Y k)"
by (rule inf_chainl3 [rule_format], auto)

text \<open>@{term sValues} is a continuous function\<close>
lemma sValues_cont: "cont (\<lambda>s. {snth n s | n. Fin n < #s})"
apply (rule contI2)
apply (rule sValues_mono)
apply (simp add: sValues_eq2)
apply (rule allI, rule impI)
apply (simp add: less_set_def)
apply (auto simp add: lub_eq_Union)
apply (case_tac "finite_chain Y")
apply (subst lub_finch2 [THEN lub_eqI], simp)
apply (rule_tac x="LEAST i. max_in_chain i Y" in exI)
apply (rule_tac x="n" in exI, simp)
apply (subst lub_finch2 [THEN lub_eqI, THEN sym], simp+)
apply (frule_tac n="Suc n" in inf_chainl3rf, simp+)
apply (erule exE)
apply (rule_tac x="k" in exI)
apply (rule_tac x="n" in exI)
apply (rule conjI)
apply (rule_tac x="#(Y k)" in lncases, simp+)
apply (rule sym)
apply (rule snth_less)
apply (rule_tac x="#(Y k)" in lncases, simp+)
by (rule is_ub_thelub)

text \<open>@{term sValues} is a continuous function\<close>
lemma sValues_def2: "sValues\<cdot>s = {snth n s | n. Fin n < #s}"
apply (subst sValues_def)
apply (subst beta_cfun)
by (rule sValues_cont, simp)

(* continuity of sValues *)
lemma sValues_cont2: "\<forall>Y. chain Y \<longrightarrow> sValues\<cdot>(\<Squnion> i. Y i) = (\<Squnion> i. sValues\<cdot>(Y i))"
by (simp add: contlub_cfun_arg)

lemma srcdups_bool_prefix:
  fixes xs :: "bool stream" and ys :: "bool stream"
  assumes "lshd\<cdot>(srcdups\<cdot>xs) = lshd\<cdot>(srcdups\<cdot>ys)" and "#(srcdups\<cdot>xs) \<le> #(srcdups\<cdot>ys)"
  shows "(srcdups\<cdot>xs) \<sqsubseteq> (srcdups\<cdot>ys)"
proof (rule scases [of xs])
  assume "xs = \<epsilon>"
  then have "srcdups\<cdot>xs = \<epsilon>"
    by simp
  thus "srcdups\<cdot>xs \<sqsubseteq> srcdups\<cdot>ys"
    by simp
next
  fix a :: bool and s :: "bool stream"
  assume "xs = \<up>a \<bullet> s"
  have "lshd\<cdot>(srcdups\<cdot>ys) = updis a"
    by (metis \<open>xs = \<up>a \<bullet> s\<close> assms(1) lshd_updis srcdups_step)
  then have "lshd\<cdot>ys = updis a"
    by (metis lshd_updis srcdups_shd2 stream.sel_rews(3) strict_srcdups surj_scons up_defined)
  then have "\<forall>n. Fin n < #(srcdups\<cdot>ys) \<longrightarrow> snth n (srcdups\<cdot>ys) = (even n = a)"
    by (metis (no_types, lifting) bool_stream_snth lshd_updis stream.sel_rews(3) sup'_def surj_scons)
  then have ys_expr: "\<forall>n. Fin n < #(srcdups\<cdot>xs) \<longrightarrow> snth n (srcdups\<cdot>ys) = (even n = a)"
    using assms(2) less_le_trans by blast
  then have first_n_eq: "\<forall>n. Fin n < #(srcdups\<cdot>xs) \<longrightarrow> snth n (srcdups\<cdot>xs) = snth n (srcdups\<cdot>ys)"
    using \<open>xs = \<up>a \<bullet> s\<close> bool_stream_snth by blast
  then show "srcdups\<cdot>xs \<sqsubseteq> srcdups\<cdot>ys"
  proof (cases "#(srcdups\<cdot>xs) < \<infinity>")
    case False
    then have "#(srcdups\<cdot>xs) = #(srcdups\<cdot>ys)"
      using assms(2) less_le by fastforce
    then have "\<forall>k. snth k (srcdups\<cdot>xs) = snth k (srcdups\<cdot>ys)"
      by (metis False Fin_neq_inf first_n_eq inf_ub order.not_eq_order_implies_strict)
    then have "srcdups\<cdot>xs = srcdups\<cdot>ys"
      by (simp add: \<open>\<forall>k. snth k (srcdups\<cdot>xs) = snth k (srcdups\<cdot>ys)\<close> \<open>#(srcdups\<cdot>xs) = #(srcdups\<cdot>ys)\<close> snths_eq)
    thus "srcdups\<cdot>xs \<sqsubseteq> srcdups\<cdot>ys"
      by simp
  next
    case True
    then obtain k where "#(srcdups\<cdot>xs) = Fin k"
      using lnat_well_h2 by blast
    then have eq_len: "#(srcdups\<cdot>xs) = #(stake k\<cdot>(srcdups\<cdot>ys))"
      using assms(2) slen_stake by force
    have "\<forall>n. Fin n < #(srcdups\<cdot>xs) \<longrightarrow> snth n (srcdups\<cdot>xs) = snth n (stake k\<cdot>(srcdups\<cdot>ys))"
      by (metis eq_len first_n_eq snth_less stream.take_below)
    then have "srcdups\<cdot>xs = stake k\<cdot>(srcdups\<cdot>ys)"
      by (simp add: \<open>\<forall>n. Fin n < #(srcdups\<cdot>xs) \<longrightarrow> snth n (srcdups\<cdot>xs) = snth n (stake k\<cdot>(srcdups\<cdot>ys))\<close> eq_len snths_eq)
    thus ?thesis
      by simp
  qed
qed

lemma srcdups_snth_stake_inf: "#s = \<infinity> \<Longrightarrow> snth n s \<noteq> snth (Suc n) s \<Longrightarrow> srcdups\<cdot>(stake (Suc n)\<cdot>s) \<noteq> srcdups\<cdot>s"
proof
  assume "#s = \<infinity>" and "snth n s \<noteq> snth (Suc n) s" and "srcdups\<cdot>(stake (Suc n)\<cdot>s) = srcdups\<cdot>s"
  have "#(stake (Suc (Suc n))\<cdot>s) = Fin (Suc (Suc n))"
    by (simp add: \<open>#s = \<infinity>\<close> slen_stake_fst_inf)
  moreover have "Suc (Suc n) > Suc n"
    by simp
  moreover have "snth n (stake (Suc (Suc n))\<cdot>s) \<noteq> snth (Suc n) (stake (Suc (Suc n))\<cdot>s)"
    by (metis Fin_leq_Suc_leq Suc_n_not_le_n \<open>snth n s \<noteq> snth (Suc n) s\<close> calculation(1) less2nat_lemma not_le snth_less stream.take_below)
  ultimately have "srcdups\<cdot>(stake (Suc n)\<cdot>(stake (Suc (Suc n))\<cdot>s)) \<noteq> srcdups\<cdot>(stake (Suc (Suc n))\<cdot>s)"
    using srcdups_snth_stake_fin by blast
  then have "srcdups\<cdot>(stake (Suc n)\<cdot>s) \<noteq> srcdups\<cdot>(stake (Suc (Suc n))\<cdot>s)"
    by (simp add: min_def)
  moreover have "srcdups\<cdot>(stake (Suc (Suc n))\<cdot>s) = srcdups\<cdot>s"
  proof (rule ccontr)
    assume "srcdups\<cdot>(stake (Suc (Suc n))\<cdot>s) \<noteq> srcdups\<cdot>s"
    moreover have "srcdups\<cdot>(stake (Suc n)\<cdot>s) \<sqsubseteq> srcdups\<cdot>(stake (Suc (Suc n))\<cdot>s)"
      by (simp add: less_imp_le_nat monofun_cfun_arg stake_mono)
    ultimately have "srcdups\<cdot>(stake (Suc n)\<cdot>s) \<noteq> srcdups\<cdot>s"
      by (metis below_antisym monofun_cfun_arg stream.take_below)
    then show "False"
      by (simp add: \<open>srcdups\<cdot>(stake (Suc n)\<cdot>s) = srcdups\<cdot>s\<close>)
  qed
  ultimately show "False"
    by (simp add: \<open>srcdups\<cdot>(stake (Suc n)\<cdot>s) = srcdups\<cdot>s\<close>)
qed

text \<open>Basic properties of @{term sValues}\<close>

(* sValues applied to the empty stream returns the empty set *)
lemma [simp]: "sValues\<cdot>\<epsilon> = {}"
by (auto simp add: sValues_def2 lnless_def)

(* the head of any stream is always an element of the domain *)
lemma sValues2un[simp]: "sValues\<cdot>(\<up>z \<bullet> s) = {z} \<union> sValues\<cdot>s"
apply (auto simp add: sValues_def2)
apply (case_tac "n", auto)
apply (rule_tac x="0" in exI, auto)
by (rule_tac x="Suc n" in exI, auto)

lemma srcdups_dom_h: assumes "sValues\<cdot>(srcdups\<cdot>s) = sValues\<cdot>s"
  shows "sValues\<cdot>(srcdups\<cdot>(\<up>a \<bullet> s)) = insert a (sValues\<cdot>s)"
proof (cases "shd s = a")
  case True
  have "srcdups\<cdot>(\<up>a \<bullet> \<up>a \<bullet> srt\<cdot>s) = srcdups\<cdot>(\<up>a \<bullet> srt\<cdot>s)"
    using srcdups_eq by blast
  hence "a \<in> sValues\<cdot>(srcdups\<cdot>(\<up>a \<bullet> srt\<cdot>s))"
    by (simp add: srcdups_step)
  then show ?thesis
    by (metis True Un_insert_left assms insert_absorb2 sValues2un srcdups_eq srcdups_step strict_sdropwhile sup_bot.left_neutral surj_scons)
next
  case False
  then show ?thesis
    by (metis (no_types, lifting) assms insert_is_Un sValues2un srcdups_neq srcdups_step strict_sdropwhile surj_scons)
qed

lemma srcdups_dom [simp]: "sValues\<cdot>(srcdups\<cdot>xs) = sValues\<cdot>xs"
apply(rule ind, simp_all)
  by (simp add: srcdups_dom_h)

(* only the empty stream has no elements in its domain *)
lemma strict_sValues_rev: "sValues\<cdot>s = {} \<Longrightarrow> s = \<epsilon>"
apply (auto simp add: sValues_def2)
apply (rule_tac x="s" in scases, auto)
by (metis Fin_02bot gr_0 lnzero_def)

lemma sValues_notempty:"s\<noteq>\<epsilon> \<longleftrightarrow> sValues\<cdot>s\<noteq>{}"
  using strict_sValues_rev by auto

(* the infinite repetition of a only has a in its domain *)
(*with new lemmata not necessary:
 apply (subst sinftimes_unfold, simp)*)
(*apply (induct_tac n, auto)
apply (subst sinftimes_unfold, simp)
apply (rule_tac x="0" in exI)
by (subst sinftimes_unfold, simp)*)
lemma [simp]: "sValues\<cdot>(sinftimes (\<up>a)) = {a}"
by (auto simp add: sValues_def2)

(* any singleton stream of z only has z in its domain *)
lemma [simp]: "sValues\<cdot>(\<up>z) = {z}"
by (auto simp add: sValues_def2)

(* if an element z is in the domain of a stream s, then z is the n'th element of s for some n *)
lemma sValues2snth: "z \<in> sValues\<cdot>s \<Longrightarrow> \<exists>n. snth n s = z"
by (auto simp add: sValues_def2)

(* if the natural number n is less than the length of the stream s, then snth n s is in the domain of s *)
lemma snth2sValues: "Fin n < #s \<Longrightarrow> snth n s \<in> sValues\<cdot>s"
  by (auto simp add: sValues_def2)

lemma smap_well:"sValues\<cdot>x\<subseteq>range f \<Longrightarrow>  \<exists>s. smap f\<cdot>s = x"
  apply(rule_tac x = "smap (inv f)\<cdot>x" in exI)
  by (simp add: snths_eq smap_snth_lemma f_inv_into_f snth2sValues subset_eq)

lemma smap_inv_id[simp]: "sValues\<cdot>s \<subseteq> range F \<Longrightarrow> smap (F \<circ> (inv F))\<cdot>s = s"
  apply (induction s  rule: ind )
  by(simp_all add: f_inv_into_f)

lemma smap_inv_eq[simp]:"inj F \<Longrightarrow> smap (inv F \<circ> F)\<cdot>x = x"
  by (metis inv_o_cancel smap_inv_id subset_UNIV surj_id surj_iff)

(* checking if the domain of a stream x isn't a subset of another set M is an admissible predicate *)
lemma [simp]: "adm (\<lambda>x. \<not> sValues\<cdot>x \<subseteq> M)"
apply (rule admI)
apply (rule notI)
apply (frule_tac x="0" in is_ub_thelub)
apply (frule_tac f="sValues" in monofun_cfun_arg)
by (erule_tac x="0" in allE, auto simp add: less_set_def)

text \<open>filtering with a superset of the stream's domain does not change the stream\<close>
lemma sfilter_sValuesl3:
  "sValues\<cdot>s \<subseteq> X \<longrightarrow> sfilter X\<cdot>s = s"
apply (rule impI)
apply (rule stream.take_lemma)
apply (simp add: atomize_imp)
apply (rule_tac x="s" in spec)
apply (rule_tac x="X" in spec)
apply (induct_tac n, simp+)
apply (rule allI)+
apply (rule impI)
by (rule_tac x="xa" in scases, simp+)

text \<open>filtering with the stream's domain does not change the stream\<close>
lemma sfilter_sValuesl4 [simp]:
  "sfilter (sValues\<cdot>s)\<cdot>s = s"
by (rule sfilter_sValuesl3 [rule_format, of "s" "sValues\<cdot>s"], simp)

lemma sfilter_fin: assumes "#(A \<ominus> s) < \<infinity>"
  shows "\<exists>n. (A \<ominus> (sdrop n\<cdot>s)) = \<bottom>"
  apply(rule ccontr)
  apply auto
  by (metis assms fun_approxl2 lnat_well_h2 sconc_neq_h sconc_snd_empty split_sfilter)

lemma s_one_dom_inf: assumes "sValues\<cdot>s = {x}" and "#s = \<infinity>"
    shows "s = ((\<up>x)\<^sup>\<infinity>)"
  by (metis Fin_02bot Fin_Suc Suc_n_not_le_n assms(1) assms(2) bot_is_0 inject_Fin less_or_eq_imp_le sinftimes_unfold singleton_iff slen_scons slen_sinftimes snth2sValues snth_sinftimes snths_eq strict_icycle strict_slen)

lemma sfilter_bot_dom: "(A \<ominus> s) = \<bottom> \<Longrightarrow> sValues\<cdot>s \<subseteq> UNIV - A"
  apply(induction s rule: ind)
    apply auto
  by (metis DiffD2 inject_scons rev_subsetD sfilter_in sfilter_nin strictI)

text \<open>The domain of a concatenated stream is the union of the single domains\<close>
lemma sValues_sconc2un:
  "#x = Fin k \<Longrightarrow> sValues\<cdot>(x \<bullet> y) = sValues\<cdot>x \<union> sValues\<cdot>y"
apply (simp add: atomize_imp)
apply (rule_tac x="x" in spec)
apply (induct_tac k, simp+)
apply (rule allI, rule impI)
by (rule_tac x="x" in scases, simp+)

(* sValues applied to s1\<bullet>s2 is a subset of the union of sValues s1 and sValues s2 *)
lemma sconc_sValues: "sValues\<cdot>(s1\<bullet>s2) \<subseteq> sValues\<cdot>s1 \<union> sValues\<cdot>s2"
by (metis SetPcpo.less_set_def below_refl lncases sconc_fst_inf sValues_sconc2un sup.coboundedI1)

(* relation between sValues and sfoot *)
lemma sfoot_dom: assumes "#s = Fin (Suc n)" and "sValues\<cdot>s\<subseteq>A"
  shows "sfoot s\<in>A"
by (metis Suc_n_not_le_n assms(1) assms(2) contra_subsetD leI less2nat_lemma sfoot_exists2 snth2sValues)

(* stakewhile doesn't include the element a that failed the predicate f in the result *)
lemma stakewhile_dom[simp]:assumes "\<not>f a"
  shows "a\<notin>sValues\<cdot>(stakewhile f\<cdot>s)"
by (smt assms below_antisym lnle_conv lnless_def mem_Collect_eq sValues_def2 snth_less stakewhile_below stakewhile_slen)

lemma srcdups_sconc_duplicates:
  assumes "#xs < \<infinity>" and "xs \<noteq> \<epsilon>" and "srcdups\<cdot>xs = srcdups\<cdot>(xs \<bullet> ys)"
  shows "sValues\<cdot>ys \<subseteq> {sfoot xs}"
proof -
  have "srcdups\<cdot>(xs \<bullet> ys) = (srcdups\<cdot>xs) \<bullet> (srcdups\<cdot>(sdropwhile (\<lambda>x. x=sfoot xs)\<cdot>ys))"
    using assms(1) assms(2) srcdups_sconc by blast
  then have "srcdups\<cdot>xs = srcdups\<cdot>xs \<bullet> (srcdups\<cdot>(sdropwhile (\<lambda>x. x=sfoot xs)\<cdot>ys))"
    using assms(3) by presburger
  moreover have "#(srcdups\<cdot>xs) < \<infinity>"
    by (meson assms(1) leD leI srcdups_slen trans_lnle)
  ultimately have "srcdups\<cdot>(sdropwhile (\<lambda>x. x=sfoot xs)\<cdot>ys) = \<epsilon>"
    using sconc_neq_h by fastforce
  then have "sdropwhile (\<lambda>x. x=sfoot xs)\<cdot>ys = \<epsilon>"
    using srcdups_nbot by blast
  then show ?thesis
    by (metis (full_types) insertI1 sconc_snd_empty stakewhileDropwhile stakewhile_dom subsetI)
qed

(* if stakewhile changes the stream s, which is a prefix of the stream s', then stakewhile of s and s'
   produce the same result *)
lemma stakewhile_finite_below:
shows "stakewhile f\<cdot>s \<noteq> s \<Longrightarrow> s\<sqsubseteq>s' \<Longrightarrow> stakewhile f\<cdot>s = stakewhile f\<cdot>s'"
apply(induction s)
apply simp+
by (smt approxl1 approxl2 lnless_def monofun_cfun_arg rev_below_trans snth_less stakewhile_below stakewhile_notin stakewhile_snth)

(* if there is an element in the stream s that fails the predicate f, then stakewhile will change s *)
lemma stakewhile_noteq[simp]: assumes "\<not>f (snth n s)" and "Fin n < #s"
  shows "stakewhile f\<cdot>s \<noteq> s"
proof (rule ccontr)
  assume "\<not> stakewhile f\<cdot>s \<noteq> s"
  hence "sValues\<cdot>(stakewhile f\<cdot>s) = sValues\<cdot>s" by simp
  hence "(snth n s)\<in>sValues\<cdot>(stakewhile f\<cdot>s)" by (simp add: assms(2) snth2sValues)
  thus False by (simp add: assms(1))
qed

(* if there's an element a in the domain of s which fails the predicate f, then stwbl will produce a
   finite result *)
lemma stwbl_fin [simp]: assumes "a\<in>sValues\<cdot>s" and "\<not> f a"
  shows "#(stwbl f\<cdot>s) < \<infinity>"
by (metis assms(1) assms(2) inf_ub lnle_conv lnless_def notinfI3 sconc_slen sValues2snth stakewhile_slen stwbl_stakewhile ub_slen_stake)

(* stwbl keeps at least all the elements that stakewhile keeps *)
lemma stakewhile_stwbl [simp]: "stakewhile f\<cdot>(stwbl f\<cdot>s) = stakewhile f\<cdot>s"
proof -
  have "\<And>s sa. (s::'a stream) \<sqsubseteq> s \<bullet> sa"
    by simp
  then have "stakewhile f\<cdot>(stwbl f\<cdot>s) = stwbl f\<cdot>s \<longrightarrow> stakewhile f\<cdot>(stwbl f\<cdot>s) = stakewhile f\<cdot>s"
    by (metis (no_types) below_antisym monofun_cfun_arg stwbl_below stwbl_stakewhile)
  then show ?thesis
    using stakewhile_finite_below stwbl_below by blast
qed

(* sValues applied to sntimes n s is a subset of sValues applied to s *)
lemma sntimes_sValues1[simp]: "sValues\<cdot>(sntimes n s) \<subseteq> sValues\<cdot>s"
proof (induction n)
  case 0 thus ?case by simp
next
  case (Suc n) thus ?case using sconc_sValues sntimes.simps(2) sup.orderE by auto
qed

(* if filtering everything except z from the stream x doesn't produce the empty stream, then z must
   be an element of the domain of x *)
lemma sfilter2dom:
  "sfilter {z}\<cdot>x \<noteq> \<epsilon> \<Longrightarrow> z \<in> sValues\<cdot>x"
apply (subgoal_tac "\<exists>k. snth k x = z \<and> Fin k < #x", erule exE)
apply (erule conjE)
apply (drule sym, simp)
apply (rule snth2sValues, simp)
apply (rule ccontr, simp)
by (insert ex_snth_in_sfilter_nempty [of x "{z}"], auto)

text \<open>For injective functions @{term f} with @{term "f(y) = x"}, @{term x} can only
  be contained in @{term "smap f\<cdot>s"} if the original stream contained @{term y}\<close>
lemma sValues_smapl1: "\<lbrakk>x \<in> sValues\<cdot>(smap f\<cdot>s); inj f; f y = x\<rbrakk> \<Longrightarrow> y \<in> sValues\<cdot>s"
  by (smt mem_Collect_eq sValues_def2 slen_smap smap_snth_lemma the_inv_f_f)
    (*
apply (auto simp add: sValues_def2)
apply (rule_tac x="n" in exI, simp)
apply (simp add: smap_snth_lemma)
by (simp add: inj_on_def) *)

(* appending another stream xs can't shrink the domain of a stream x *)
lemma sValues_sconc[simp]: "sValues\<cdot>x \<subseteq> sValues\<cdot>(x \<bullet> xs)"
by (metis minimal monofun_cfun_arg sconc_snd_empty set_cpo_simps(1))

(* repeating a stream doesn't add elements to the domain *)
lemma sinftimes_sValues[simp]: "sValues\<cdot>(sinftimes s) \<subseteq> sValues\<cdot>s"
by (smt chain_monofun contlub_cfun_arg lub_below set_cpo_simps(1) sntimesLub sntimes_chain sntimes_sValues1)

(* repeating a stream doesn't remove elements from the domain either *)
lemma sinf_sValues [simp]: "sValues\<cdot>(s\<^sup>\<infinity>) = sValues\<cdot>s"
by (metis antisym_conv sValues_sconc sinftimes_sValues sinftimes_unfold)

(* sfilter doesn't add elements to the domain *)
lemma sbfilter_sbdom[simp]: "sValues\<cdot>(sfilter A\<cdot>s) \<subseteq> sValues\<cdot>s"
apply(rule ind [of _s], auto)
by (metis (mono_tags, lifting) UnE contra_subsetD sValues2un sfilter_in sfilter_nin singletonD)

(* smap can only produce elements in the range of the mapped function f *)
lemma smap_sValues_range [simp]: "sValues\<cdot>(smap f\<cdot>s) \<subseteq> range f"
by (smt mem_Collect_eq range_eqI sValues_def2 slen_smap smap_snth_lemma subsetI)

(* every element produced by (smap f) is in the image of the function f *)
lemma smap_sValues: "sValues\<cdot>(smap f\<cdot>s) =  f ` sValues\<cdot>s"
apply(rule)
apply (smt image_eqI mem_Collect_eq sValues_def2 slen_smap smap_snth_lemma subsetI)
by (smt image_subset_iff mem_Collect_eq sValues_def2 slen_smap smap_snth_lemma)

(* lemmas for SB *)
(* if the stream a is a prefix of the stream b then a's domain is a subset of b's *)
lemma sValues_prefix [simp]: "a \<sqsubseteq> b \<Longrightarrow> sValues\<cdot>a \<subseteq> sValues\<cdot>b"
by (metis SetPcpo.less_set_def monofun_cfun_arg)

(* the lub of a chain of streams contains any elements contained in any stream in the chain *)
lemma sValues_chain2lub: "chain S \<Longrightarrow> sValues\<cdot>(S i) \<subseteq> sValues\<cdot>(\<Squnion> j. S j)"
using sValues_prefix is_ub_thelub by auto

(* if every element in a chain S is a prefix of s then also the least upper bound in the chain S if prefix of s *)
lemma lubChainpre: "chain S \<Longrightarrow> S i  \<Longrightarrow> \<forall>i. S i \<sqsubseteq> s \<Longrightarrow> (\<Squnion> j. S j) \<sqsubseteq> s"
by (simp add: lub_below)

(* if every element in a chain S is a prefix of s, then the domain of S i is a subset of the domain of s *)
lemma sValues_chainprefix: "chain S \<Longrightarrow> \<forall>i. S i \<sqsubseteq> s \<Longrightarrow> \<forall>i. sValues\<cdot>(S i) \<subseteq> sValues\<cdot>s"
by simp

(* if every element in a chain S is a prefix of s, then the domain of the lub is a subset of the domain of s *)
lemma sValues_chainlub: "chain S \<Longrightarrow>  \<forall>i. S i \<sqsubseteq> s \<Longrightarrow> sValues\<cdot>(\<Squnion> j. S j) \<subseteq> sValues\<cdot>s"
using sValues_prefix lub_below by blast

(* streams appearing later in the chain S contain the elements of preceding streams *)
lemma sValues_chain_below: "chain S \<Longrightarrow> i \<le> j \<Longrightarrow> sValues\<cdot>(S i) \<subseteq> sValues\<cdot>(S j)"
by (simp add: po_class.chain_mono)

(* for two elements i, j with i \<le> j in a chain S it holds that the domain of S i is a subset of the domain of S j *)
lemma sValues_lub2union: "chain S \<Longrightarrow> finite_chain S \<Longrightarrow> sValues\<cdot>(\<Squnion> j. S j) \<subseteq> (\<Union>i. sValues\<cdot>(S i))"
using l42 by fastforce

(* important *)
(* the lub doesn't have any elements that don't appear somewhere in the chain *)
lemma sValues_lub: "chain S \<Longrightarrow> sValues\<cdot>(\<Squnion> j. S j) = (\<Union>i. sValues\<cdot>(S i))"
apply (simp add: contlub_cfun_arg)
by (simp add: lub_eq_Union)

lemma sscanlasnd_smap_state_loop:
  assumes"\<And>e. e \<in> sValues\<cdot>s \<Longrightarrow> fst (f state e) = state"
shows "sscanlAsnd f state\<cdot>(s) = smap (\<lambda>e. snd (f state e))\<cdot>s"
  using assms
  apply (induction s rule: ind)
  apply (rule adm_imp)
  apply (rule admI)
  apply (meson sValues_chain2lub set_rev_mp)
  by simp_all

(* core lemma for exchanging transition function (general lemma) *)
lemma sscanla_exchange_f:
  assumes "\<And>e state. P e \<Longrightarrow> F1 state e = F2 state e"
    and "\<forall>x \<in> sValues\<cdot>s. P x"
  shows "sscanlAsnd F1 state\<cdot>s = sscanlAsnd F2 state\<cdot>s"
  using assms
  apply (induction s arbitrary: state rule: ind)
  apply (rule adm_imp, simp)+
  apply (rule admI)
  apply (meson sValues_chain2lub subsetCE)
  by simp_all

text \<open>Let i in N be an index of the chain S of streams and B a set of messages.\<close>
lemma l44: assumes "chain S" and "\<forall>i. sValues\<cdot>(S i) \<subseteq> B"
  shows "sValues\<cdot>(\<Squnion> j. S j) \<subseteq> B"
by (metis (mono_tags, lifting) UN_E assms sValues_lub subsetCE subsetI)

(* helper lemma *)
lemma l6: "chain S \<Longrightarrow> \<forall>i. sValues\<cdot>(S i) \<subseteq> B \<Longrightarrow> sValues\<cdot>(\<Squnion> j. S (j + (SOME k. A))) \<subseteq> B"
by (simp add: l44 lub_range_shift)

(* dropping elements can't increase the domain *)
lemma sdrop_sValues[simp]: "sValues\<cdot>(sdrop n\<cdot>s)\<subseteq>sValues\<cdot>s"
by (metis Un_upper2 approxl2 sValues_prefix sValues_sconc2un sdrop_0 sdropostake split_streaml1 stream.take_below)

(* if none of the elements in the domain of the stream s are in the set A, then filtering s with A
   produces the empty stream *)
lemma sfilter_sValues_eps: "sValues\<cdot>s \<inter> A = {} \<Longrightarrow> (A \<ominus> s) = \<epsilon>"
by (meson disjoint_iff_not_equal ex_snth_in_sfilter_nempty snth2sValues)

(* if x in sValues\<cdot>(A\<ominus>s) then x is in A *)
lemma sValues_sfilter1: assumes "x\<in>sValues\<cdot>(A\<ominus>s)"
shows "x\<in>A"
by (smt assms mem_Collect_eq sValues_def2 sfilterl7)

(* if u is not bottom then sValues\<cdot>s\<subseteq>sValues\<cdot>(u && s) *)
lemma sValues_subset: assumes "u\<noteq>\<bottom>"
shows "sValues\<cdot>s\<subseteq>sValues\<cdot>(u && s)"
by (metis Un_upper2 assms sValues2un stream.con_rews(2) stream.sel_rews(5) surj_scons)

(* if u is not bottom then sValues\<cdot>(A\<ominus>s)\<subseteq>sValues\<cdot>(A \<ominus> (u && s)) *)
lemma sValues_sfilter_subset: assumes "u\<noteq>\<bottom>"
shows "sValues\<cdot>(A\<ominus>s)\<subseteq>sValues\<cdot>(A \<ominus> (u && s))"
by (smt Un_upper2 assms eq_iff sValues2un sfilter_in sfilter_nin stream.con_rews(2) stream.sel_rews(5) surj_scons)

(* if x in A then x\<in>sValues\<cdot>s implies x\<in>(sValues\<cdot>(A \<ominus> s)) *)
lemma sValues_sfilter2: assumes  "x\<in>A"
shows "x\<in>sValues\<cdot>s \<Longrightarrow> x\<in>(sValues\<cdot>(A \<ominus> s))"
apply(induction s)
apply(rule admI)
apply rule
  apply (metis (mono_tags, lifting) UN_iff ch2ch_Rep_cfunR contlub_cfun_arg sValues_lub)
apply simp
by (smt UnE assms empty_iff insert_iff sconc_sValues sValues2un sValues_sconc sValues_sfilter_subset sfilter_in stream.con_rews(2) stream.sel_rews(5) subsetCE surj_scons)

(* sValues applied to A\<ominus>s returns the intersection of sValues applied to s and A *)
lemma sValues_sfilter[simp]: "sValues\<cdot>(A\<ominus>s) = sValues\<cdot>s \<inter> A"
apply rule
apply (meson IntI sbfilter_sbdom sValues_sfilter1 subset_iff)
apply rule
  by (simp add: sValues_sfilter2)

(* if sfilter of A\<cdot>s is s then sValues\<cdot>s is a subset of A *)
lemma sfilterEq2sValues_h: "sfilter A\<cdot>s = s \<longrightarrow> sValues\<cdot>s \<subseteq> A"
  apply(rule ind [of _s])
    apply (smt admI inf.orderI sValues_sfilter)
   apply(simp)
  apply(rule)
  by (metis inf.orderI sValues_sfilter)

(* sfilter of A\<cdot>s is s implies that sValues\<cdot>s is a subset of A *)
lemma sfilterEq2sValues: "sfilter A\<cdot>s = s \<Longrightarrow> sValues\<cdot>s \<subseteq> A"
  by (simp add: sfilterEq2sValues_h)

(* if \<forall>a\<in>sValues\<cdot>s. f a then stwbl applied to f\<cdot>s returns s *)
lemma stwbl_id_help:
  shows "(\<forall>a\<in>sValues\<cdot>s. f a) \<longrightarrow> stwbl f\<cdot>s = s"
  apply (rule ind [of _s])
    apply(rule adm_imp)
     apply(rule admI, rule+)
     using sValues_chain2lub apply blast
    apply(rule admI)
    apply (metis cont2contlubE cont_Rep_cfun2 lub_eq)
   using strict_stwbl apply blast
  apply rule+
  by simp

(* \<And> a. a\<in>sValues\<cdot>s \<Longrightarrow> f a implies that stwbl applied to f\<cdot>s is s *)
lemma stwbl_id [simp]: "(\<And> a. a\<in>sValues\<cdot>s \<Longrightarrow> f a) \<Longrightarrow> stwbl f\<cdot>s = s"
by (simp add: stwbl_id_help)

(* if a in sValues s and \<not>f a then it holds that \<exists>x. (stwbl f\<cdot>s) = stakewhile f\<cdot>s \<bullet> \<up>x *)
lemma stwbl2stakewhile: assumes "a\<in>sValues\<cdot>s" and "\<not>f a"
  shows "\<exists>x. (stwbl f\<cdot>s) = stakewhile f\<cdot>s \<bullet> \<up>x"
proof -
  have "#(stwbl f\<cdot>s) < \<infinity>" using assms(1) assms(2) snth2sValues stwbl_fin by blast
  hence "stwbl f\<cdot>s \<noteq> \<epsilon>" by (metis assms(1) assms(2) stakewhile_dom strict_stakewhile stwbl_notEps)
  thus ?thesis
    by (smt Fin_02bot approxl2 assms(1) assms(2) bottomI lnle_def lnzero_def mem_Collect_eq sconc_snd_empty sValues_def2 sdrop_0 slen_empty_eq slen_rt_ile_eq split_streaml1 stakewhile_below stakewhile_noteq stakewhile_sdropwhilel1 stwbl_notEps stwbl_stakewhile surj_scons tdw ub_slen_stake)
qed

(* if a in sValues s and \<not>f a it holds that \<not> f (sfoot (stwbl f\<cdot>s)) *)
lemma stwbl_sfoot: assumes "a\<in>sValues\<cdot>s" and "\<not>f a"
  shows "\<not> f (sfoot (stwbl f\<cdot>s))"
proof(rule ccontr)
  assume "\<not> \<not> f (sfoot (stwbl f\<cdot>s))"
  hence "f (sfoot (stwbl f\<cdot>s))" by blast
  obtain x where x_def:"(stwbl f\<cdot>s) = stakewhile f\<cdot>s \<bullet> \<up>x"
    using assms(1) assms(2) stwbl2stakewhile by blast
  hence "sfoot (stwbl f\<cdot>s) = x"
    using assms(1) assms(2) sfoot1 stwbl_fin by blast
  have "stakewhile f\<cdot>s \<bullet> \<up>x \<sqsubseteq> s" by (metis stwbl_below x_def)
  have "f x"
    using \<open>f (sfoot (stwbl f\<cdot>s))\<close> \<open>sfoot (stwbl f\<cdot>s) = x\<close> by blast
  thus False
    by (metis approxl2 assms(1) assms(2) inject_sconc sconc_snd_empty sdropwhile_resup stakewhileDropwhile stakewhile_below stakewhile_dom stakewhile_stwbl x_def)
(*    by (smt Fin_02bot \<open>sfoot (stwbl f\<cdot>s) = x\<close> approxl2 assms(1) assms(2) assoc_sconc bottomI lnle_def lnzero_def sconc_fst_empty sconc_snd_empty sdrop_0 sdropwhile_t sfoot1 slen_empty_eq slen_rt_ile_eq split_streaml1 stakewhile_below stakewhile_dom stakewhile_sdropwhilel1 stakewhile_stwbl stream.take_strict strict_stakewhile stwbl_fin stwbl_notEps stwbl_stakewhile surj_scons tdw ub_slen_stake) *)
qed

(* stwbl applied to f and stwbl f\<cdot>s returns stwbl f\<cdot>s *)
lemma stwbl2stbl[simp]: "stwbl f\<cdot>(stwbl f\<cdot>s) = stwbl f\<cdot>s"
  apply(rule ind [of _s])
    apply simp_all
  by (metis sconc_snd_empty stwbl_f stwbl_t)

(* (\<lambda>x. b \<notin> sValues\<cdot>x) is admissible *)
lemma adm_nsValues [simp]:  "adm (\<lambda>x. b \<notin> sValues\<cdot>x)"
proof (rule admI)
  fix Y
  assume as1: "chain Y" and as2: "\<forall>i. b\<notin>sValues\<cdot>(Y i)"
  thus "b\<notin>sValues\<cdot>(\<Squnion>i. Y i)"
  proof (cases "finite_chain Y")
    case True thus ?thesis using as1 as2 l42 by fastforce
  next
    case False
    hence "#(\<Squnion>i. Y i) = \<infinity>" using as1 inf_chainl4 by blast
    hence "\<And>n. snth n (\<Squnion>i. Y i) \<noteq> b"
    proof -
      fix n
      obtain j where "Fin n < # (Y j)"  by (metis False inf_chainl2 as1 inf_chainl3rf less_le)
      hence "snth n (Y j) \<noteq>b" using as2 snth2sValues by blast
      thus "snth n (\<Squnion>i. Y i) \<noteq> b" using \<open>Fin n < #(Y j)\<close> as1 is_ub_thelub snth_less by blast
    qed
    thus ?thesis using sValues2snth by blast
  qed
qed

(* strdw_filter helper lemma *)
lemma strdw_filter_h: "b\<in>sValues\<cdot>s \<longrightarrow> lnsuc\<cdot>(#({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>s)) = #({b} \<ominus> s)"
proof(rule ind [of _s])
  have "adm (\<lambda>a. lnsuc\<cdot>(#({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>a)) = #({b} \<ominus> a))" by simp
  thus "adm (\<lambda>a. b \<in> sValues\<cdot>a \<longrightarrow> lnsuc\<cdot>(#({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>a)) = #({b} \<ominus> a))" by simp
  show "b \<in> sValues\<cdot>\<epsilon> \<longrightarrow> lnsuc\<cdot>(#({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>\<epsilon>)) = #({b} \<ominus> \<epsilon>)" by simp
  fix a
  fix s
  assume IH: " b \<in> sValues\<cdot>s \<longrightarrow> lnsuc\<cdot>(#({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>s)) = #({b} \<ominus> s)"
  show " b \<in> sValues\<cdot>(\<up>a \<bullet> s) \<longrightarrow> lnsuc\<cdot>(#({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>(\<up>a \<bullet> s))) = #({b} \<ominus> \<up>a \<bullet> s)"
  proof (cases "a=b")
    case True thus ?thesis by simp
  next
    case False
    hence f1:"#({b} \<ominus> \<up>a \<bullet> s) = #({b} \<ominus> s)" using sfilter_nin singletonD by auto
    hence f2:"#({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>(\<up>a \<bullet> s)) = #({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>(s))" using False by auto
    hence "b \<in> sValues\<cdot>(\<up>a \<bullet> s) \<Longrightarrow> b\<in>sValues\<cdot>s" using False by auto
    thus ?thesis using IH f2 local.f1 by auto
  qed
qed

(* strdw filter lemma *)
lemma strdw_filter: "b\<in>sValues\<cdot>s \<Longrightarrow> lnsuc\<cdot>(#({b} \<ominus> srtdw (\<lambda>a. a \<noteq> b)\<cdot>s)) = #({b} \<ominus> s)"
by(simp add: strdw_filter_h)

(* length of stwbl filter *)
lemma stwbl_filterlen[simp]: "b\<in>sValues\<cdot>ts \<longrightarrow> #({b} \<ominus> stwbl (\<lambda>a. a \<noteq> b)\<cdot>ts) = Fin 1"
  apply(rule ind [of _ ts])
    apply(rule adm_imp)
     apply simp
    apply simp
   apply simp
  apply auto
  by (metis (mono_tags, lifting) Fin_02bot Fin_Suc One_nat_def lnzero_def sconc_snd_empty sfilter_in sfilter_nin singletonD singletonI slen_scons strict_sfilter strict_slen stwbl_f stwbl_t)

(* srtdw concatenation *)
lemma srtdw_conc: "b\<in>sValues\<cdot>ts  \<Longrightarrow> (srtdw (\<lambda>a. a \<noteq> b)\<cdot>(ts \<bullet> as)) = srtdw (\<lambda>a. a \<noteq> b)\<cdot>(ts) \<bullet> as"
  apply(induction ts arbitrary: as)
    apply (rule adm_imp)
     apply auto
   apply(rule admI)
   apply rule+
   apply (metis (no_types, lifting) approxl3 assoc_sconc is_ub_thelub)
proof -
  fix u ts as
  assume as1: "u \<noteq> \<bottom>" and as2: "(\<And>as. b \<in> sValues\<cdot>ts \<Longrightarrow> srtdw (\<lambda>a. a \<noteq> b)\<cdot>(ts \<bullet> as) = srtdw (\<lambda>a. a \<noteq> b)\<cdot>ts \<bullet> as)"
       and as3: "b \<in> sValues\<cdot>(u && ts)"
  obtain a where a_def: "updis a = u" by (metis Exh_Up as1 discr.exhaust)
  have "a\<noteq>b \<Longrightarrow> b\<in>sValues\<cdot>ts" by (metis UnE a_def as3 lscons_conv sValues2un singletonD)
  hence "a\<noteq>b \<Longrightarrow> srtdw (\<lambda>a. a \<noteq> b)\<cdot>(\<up>a\<bullet> (ts \<bullet> as)) = srtdw (\<lambda>a. a \<noteq> b)\<cdot>(\<up>a\<bullet> ts) \<bullet> as " using as2 a_def by auto
  thus "srtdw (\<lambda>a. a \<noteq> b)\<cdot>((u && ts) \<bullet> as) = srtdw (\<lambda>a. a \<noteq> b)\<cdot>(u && ts) \<bullet> as "
    by (smt a_def inject_scons lscons_conv sconc_scons stwbl_f stwbl_srtdw)
qed

(* stwbl concatenation *)
lemma stwbl_conc[simp]: "b\<in>sValues\<cdot>ts \<Longrightarrow>
    (stwbl (\<lambda>a. a \<noteq> b)\<cdot>(stwbl (\<lambda>a. a \<noteq> b)\<cdot>ts \<bullet> xs)) =
    (stwbl (\<lambda>a. a \<noteq> b)\<cdot>(ts))"
  apply(induction ts)
    apply(rule adm_imp)
     apply simp
    apply(rule admI)
    apply (metis (no_types, lifting) ch2ch_Rep_cfunR contlub_cfun_arg inf_chainl4 lub_eqI lub_finch2 sconc_fst_inf stwbl2stbl)
   apply simp
  by (smt UnE assoc_sconc sValues2un singletonD stream.con_rews(2) stream.sel_rews(5) stwbl_f stwbl_t surj_scons)

(* ----------------------------------------------------------------------- *)
section \<open>@{term siterateBlock}\<close>
(* ----------------------------------------------------------------------- *)

(* block-iterating the function f on the stream x is equivalent to the stream produced by concatenating x
   and the iteration of f on x shifted by another application of f *)
lemma siterateBlock_unfold: "siterateBlock f x = x \<bullet> siterateBlock f (f x)"
by(subst siterateBlock_def [THEN fix_eq2], auto)

(* if g doesn't change the length of the input, then iterating g doesn't either *)
lemma niterate_len[simp]: assumes "\<forall>z. #z = #(g z)"
  shows "#((niterate i g) x) = #x"
using assms by(induction i, auto)

(* dropping i blocks from siterateBlock g x is equivalent to beginning siterateBlock after i iterations
   of g have already been applied *)
lemma siterateBlock_sdrop2: assumes "#x = Fin y" and "\<forall>z. #z = #(g z)"
  shows "sdrop (y*i)\<cdot>(siterateBlock g x) = siterateBlock g ((niterate i g) x)"
apply (induction i, auto)
by (metis assms(1) assms(2) niterate_len sdrop_plus sdropl6 siterateBlock_unfold)

(* the y*i'th element of siterateBlock is the same as the head of the i'th iteration *)
lemma siterateBlock_snth: assumes "#x = Fin y" and "\<forall>z. #z = #(g z)" and "#x > Fin 0"
  shows "snth (y*i) (siterateBlock g x) = shd ((niterate i g) x)"
proof -
  have eq1: "sdrop (y*i)\<cdot>(siterateBlock g x) = siterateBlock g ((niterate i g) x)" using assms(1) assms(2) siterateBlock_sdrop2 by blast

  have "#((niterate i g) x) > 0" by (metis Fin_02bot assms(2) assms(3) lnzero_def niterate_len)
  hence "shd (siterateBlock g ((niterate i g) x)) = shd (((niterate i g) x))" by (metis Fin_0 minimal monofun_cfun_arg sconc_snd_empty siterateBlock_unfold snth_less snth_shd)
  thus ?thesis by (simp add: eq1 snth_def)
qed

(* dropping a single block from siterateBlock is equivalent to beginning the iteration with (g x) *)
lemma siterateBlock_sdrop: assumes "#x = Fin y"
  shows "sdrop y\<cdot>(siterateBlock g x) = siterateBlock g (g x)"
by (metis assms sdropl6 siterateBlock_unfold)

(* block-iterating the function g on the empty stream produces the empty stream again *)
lemma siterateBlock_eps[simp]: assumes "g \<epsilon> = \<epsilon>"
  shows "siterateBlock g \<epsilon> = \<epsilon>"
by(simp add: siterateBlock_def assms)

(* block-iterating the identity on the element x is equivalent to infinitely repeating x *)
lemma siterateBlock2sinf: "siterateBlock id x = sinftimes x"
by (metis id_apply rek2sinftimes siterateBlock_eps siterateBlock_unfold strict_icycle)

(* siterateBlock doesn't affect infinite streams *)
lemma siterBlock_inf [simp]: assumes "#s = \<infinity>"
  shows "siterateBlock f s = s"
by (metis assms sconc_fst_inf siterateBlock_unfold)

(* the first element of siterateBlock doesn't have any applications of g *)
lemma siterateBlock_shd [simp]: "shd (siterateBlock g (\<up>x)) = x"
by (metis shd1 siterateBlock_unfold)

(* helper lemma for siterateBlock2siter *)
lemma siterateBlock2niter: "snth i (siterateBlock (\<lambda>s. (smap g\<cdot>s)) (\<up>x)) = niterate i g x" (is "snth i (?B) = ?N i")
proof -
  have f1: "#(\<up>x) = Fin 1" by simp
  have "\<forall>z. #z = #((\<lambda>s. (smap g\<cdot>s)) z)" by simp
  hence f2: " snth (i) (siterateBlock (\<lambda>s. (smap g\<cdot>s)) (\<up>x)) = shd (niterate i (\<lambda>s. (smap g\<cdot>s)) (\<up>x))"
  by (metis Fin_0 Fin_Suc One_nat_def f1 lnat.con_rews lnless_def lnzero_def minimal nat_mult_1 siterateBlock_snth)

  have "shd (niterate i (\<lambda>s. (smap g\<cdot>s)) (\<up>x)) = niterate i g x"
  proof (induction i)
    case 0 thus ?case by simp
  next
    case (Suc i) thus ?case
    by (smt Fin_0 f1 inject_scons neq0_conv niterate.simps(2) niterate_len slen_smap smap_scons strict_slen surj_scons zero_less_one)
  qed
  thus ?thesis by (simp add: f2)
qed

(* siterateBlock creates an infinitely long stream *)
lemma siterateBlock_len [simp]: "#(siterateBlock (\<lambda>s. (smap g\<cdot>s)) (\<up>x)) = \<infinity>"
apply (rule infI)
apply (rule allI)
apply (rule_tac x="x" in spec)
apply (induct_tac k, simp+)
apply (metis bot_is_0 lnat.con_rews siterateBlock_unfold slen_scons strict_slen)
by (metis Fin_Suc lnat.sel_rews(2) sconc_snd_empty siterateBlock_unfold slen_scons smap_scons strict_smap)

(* iterating the identity function commutes with any function f *)
lemma siterateBlock_smap: "siterateBlock id (smap f\<cdot>x) =  smap f\<cdot>(siterateBlock id x)"
by (simp add: siterateBlock2sinf)

(* converting x to a singleton stream and applying siterateBlock using smap g is equivalent to
   iterating using g directly on x *)
lemma siterateBlock2siter [simp]: "siterateBlock (\<lambda>s. (smap g\<cdot>s)) (\<up>x) = siterate g x"
apply (rule sinf_snt2eq, auto)
by (simp add: siterateBlock2niter snth_siter)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term sislivespf}\<close>
(* ----------------------------------------------------------------------- *)

text \<open>Some different formulations and implications of the @{term sislivespf} definition\<close>
(* if length of f\<cdot>x is infinite then also length of x is infinite, and then sislivespf f holds *)
lemma sislivespfI:
  "(\<And>x. #(f\<cdot>x) = \<infinity> \<Longrightarrow> #x = \<infinity>) \<Longrightarrow> sislivespf f"
by (simp add: sislivespf_def)

(* if length of x is finite then also length of f\<cdot>x is finite, and then it holds that sislivespf f *)
lemma sislivespfI2:
  "(\<And>k. \<forall>x. #x = Fin k \<longrightarrow> #(f\<cdot>x) \<noteq> \<infinity>) \<Longrightarrow> sislivespf f"
apply (rule sislivespfI)
by (rule_tac x="#x" in lncases, simp+)

(* if sislivespf f holds and length of x is finite, then also length of f\<cdot>x is finite *)
lemma sislivespfD1:
  "\<lbrakk>sislivespf f; #x = Fin k\<rbrakk> \<Longrightarrow> #(f\<cdot>x) \<noteq> \<infinity>"
apply (rule notI)
by (simp add: sislivespf_def)

(* if sislivespf f holds and f\<cdot>x has infinite length, then x has infinite length *)
lemma sislivespfD2:
  "\<lbrakk>sislivespf f; #(f\<cdot>x) = \<infinity>\<rbrakk> \<Longrightarrow> #x = \<infinity>"
by (simp add: sislivespf_def)

(* ----------------------------------------------------------------------- *)
section \<open>Lemmas on lists and streams\<close>
(* ----------------------------------------------------------------------- *)

(* ----------------------------------------------------------------------- *)
subsection \<open>@{term list2s}\<close>
(* ----------------------------------------------------------------------- *)

(* consing onto a list is equivalent to prepending an element to a stream *)
lemma [simp]: "list2s (a#as) = \<up>a \<bullet> list2s as"
by (simp add: lscons_conv)

declare list2s_Suc [simp del]

(* infinite lists don't exist *)
lemma [simp]: "#(list2s x) \<noteq> \<infinity>"
by (induct x, simp+)

text \<open>Every finite stream can be converted to a list\<close>
lemma s2list_ex:
  "#s = Fin k \<Longrightarrow> \<exists>l. list2s l = s"
apply (simp add: atomize_imp)
apply (rule_tac x="s" in spec)
apply (induct_tac k, simp+)
apply (rule_tac x="[]" in exI, simp+)
apply (rule allI, rule impI)
apply (rule_tac x="x" in scases, simp+)
apply (erule_tac x="s" in allE)
apply (drule mp)
apply (simp add: Fin_Suc [THEN sym] del: Fin_Suc)
apply (erule exE)
by (rule_tac x="a # l" in exI, simp)

(* the empty stream corresponds to the empty list *)
lemma [simp]: "s2list \<epsilon> = []"
apply (simp add: s2list_def)
apply (rule someI2_ex)
apply (rule_tac x="[]" in exI, simp)
apply (simp add: atomize_imp)
by (induct_tac x, simp+)

(* the singleton stream corresponds to the singleton list *)
lemma [simp]: "s2list (\<up>a) = [a]"
apply (simp add: s2list_def)
apply (rule someI2_ex)
apply (rule_tac x="[a]" in exI, simp)
apply (simp add: atomize_imp)
apply (induct_tac x, auto)
by (case_tac "list", simp+)

(* the empty list is the bottom element for lists *)
lemma [simp]: "[] \<sqsubseteq> l"
by (simp add: sq_le_list)

text \<open>The prefix relation translates from lists to streams\<close>
lemma list2s_emb: "\<lbrakk>#s \<noteq> \<infinity>; #s' \<noteq> \<infinity>\<rbrakk> \<Longrightarrow> (s2list s \<sqsubseteq> s2list s') = (s \<sqsubseteq> s')"
apply (simp add: s2list_def)
apply (rule someI2_ex)
apply (rule_tac x="#s'" in lncases, simp)
apply (frule s2list_ex, simp)
apply (rule someI2_ex)
apply (rule_tac x="#s" in lncases, simp)
apply (frule s2list_ex, simp)
apply (rule iffI)
apply (drule sym, drule sym, simp)
apply (simp add: sq_le_list)
by (simp add: sq_le_list)

text \<open>@{term list2s} is monotone\<close>
lemma list2s_mono: "l \<sqsubseteq> l' \<Longrightarrow> list2s l \<sqsubseteq> list2s l'"
by (simp add: sq_le_list)

text \<open>Prepending a fixed element to a list is a monotone function\<close>
lemma monofun_lcons: "monofun (\<lambda>l. a # l)"
apply (rule monofunI)
apply (simp add: atomize_imp)
apply (rule_tac x="a" in spec)
apply (induct_tac x, simp+)
apply (rule allI)
apply (simp add: sq_le_list)
apply (rule allI)
apply (rule impI)
apply (simp add: sq_le_list)
by (rule monofun_cfun_arg, simp)

text \<open>Head and rest on streams translate to head and rest on lists\<close>
lemma s2list2lcons: "#s \<noteq> \<infinity> \<Longrightarrow> s2list (\<up>a \<bullet> s) = a # (s2list s)"
apply (rule_tac x="#s" in lncases, simp+)
apply (simp add: atomize_imp)
apply (rule_tac x="s" in spec)
apply (rule_tac x="a" in spec)
apply (induct_tac k, simp+)
apply (rule allI,rule allI, rule impI)
apply (rule_tac x="xa" in scases, simp+)
apply (simp add: s2list_def)
apply (rule someI2_ex)
apply (frule s2list_ex, simp)
apply (rule someI2_ex)
apply (frule s2list_ex)
apply (erule exE)
apply (rule_tac x="x#a#l" in exI, simp+)
by (rule list2s_inj [THEN iffD1], simp)

text \<open>@{term s2list} is left-inverse to @{term list2s}\<close>
lemma [simp]: "s2list (list2s l) = l"
apply (induct_tac l, simp+)
by (subst s2list2lcons, simp+)

text \<open>Evaluation of @{term list2s} from right to left\<close>
lemma slistl5[simp]: "list2s (l @ [m]) = list2s l \<bullet> \<up>m"
by (induct_tac l, simp+)

(* ----------------------------------------------------------------------- *)
subsection \<open>List- and stream-processing functions\<close>
(* ----------------------------------------------------------------------- *)

(* concatenating streams corresponds to concatenating lists *)
lemma listConcat: "<l1> \<bullet> <l2> = <(l1 @ l2)>"
apply(induction l1)
by auto

(* smap for streams is equivalent to map for lists *)
lemma smap2map: "smap g\<cdot>(<ls>) = <(map g ls)>"
apply(induction ls)
by auto

(* the notion of length is the same for streams as for lists *)
lemma list2streamFin: "#(<ls>) = Fin (length ls)"
apply(induction ls)
by auto

text \<open>Monotone list-processing functions induce monotone stream-processing functions
  by applying them to the stream's k-element prefix\<close>
lemma mono_slpf2spf:
  "monofun f \<Longrightarrow> monofun (\<lambda>s. list2s (f (s2list (stake k\<cdot>s))))"
apply (rule monofunI)
apply (simp add: atomize_imp)
apply (rule_tac x="y" in spec)
apply (rule_tac x="x" in spec)
apply (induct_tac k, simp+)
apply (rule impI)
apply (drule mp, assumption)
apply (rule allI)+
apply (rule impI)
apply (drule lessD, simp)
apply (erule disjE, simp)
apply (rule list2s_mono)
apply (rule_tac f="f" in monofunE,simp+)
apply (erule exE)+
apply (erule conjE)
apply (erule exE,simp)
apply (erule conjE)
apply (rule list2s_mono)
apply (rule_tac f="f" in monofunE,simp+)
apply (rule_tac x="xa" in scases,simp)
apply (subst list2s_emb,simp+)
apply (rule monofun_cfun_arg)+
by simp

text \<open>Applying a monotone list-processing function to the @{term k}-element prefix of a stream
  is monotone with respect to @{term k}\<close>
lemma chain_slpf2spf:
  "monofun f \<Longrightarrow> list2s (f (s2list (stake i\<cdot>x))) \<sqsubseteq> list2s (f (s2list (stake (Suc i)\<cdot>x)))"
apply (rule list2s_mono)
apply (rule_tac f="f" in monofunE,simp+)
apply (subst list2s_emb,simp+)
by (rule chainE, simp)

text \<open>Now, a list-processing function is converted to a stream-processing one by building
  the LUB of applying the function to all prefixes of the stream\<close>
lemma slpf2spfl_contl:
  "monofun f \<Longrightarrow>
  cont (\<lambda>s. (\<Squnion>k. list2s (f (s2list (stake k\<cdot>s)))))"
apply (rule cont2cont_lub)
apply (rule chainI)
apply (rule chain_slpf2spf, simp)
apply (rule pr_contI)
apply (rule mono_slpf2spf, assumption)
apply (rule allI)
by (rule_tac x="k" in exI, simp)

text \<open>The output function of @{term slpf2spf} is continuous\<close>
lemma slpf2spf_cont:
  "monofun f \<Longrightarrow>
     (\<Lambda> s. (\<Squnion>k. list2s (f (s2list (stake k\<cdot>s)))))\<cdot>s = (\<Squnion>k. list2s (f (s2list (stake k\<cdot>s))))"
apply (subst beta_cfun)
by (rule slpf2spfl_contl, assumption, simp)

text \<open>Applying @{term "slpf2spf f"} to an element @{term x}\<close>
lemma slpf2spf_def2:
  "monofun f \<Longrightarrow> slpf2spf f\<cdot>x = (\<Squnion>k. list2s (f (s2list (stake k\<cdot>x))))"
apply (simp add: slpf2spf_def)
by (rule slpf2spf_cont)

text \<open>The output of @{term slpf2spf} is live\<close>
lemma sislivespf_slpf2spf:
  "monofun f \<Longrightarrow> sislivespf (slpf2spf f)"
apply (rule sislivespfI)
apply (rule_tac x="#x" in lncases, assumption)
apply (simp add: slpf2spf_def2)
apply (subgoal_tac
  "finite_chain (\<lambda>k. list2s (f (s2list (stake k\<cdot>x))))")
apply (simp add: finite_chain_def)
apply (erule conjE, erule exE)
apply (frule lub_finch1, simp+)
apply (frule lub_eqI, simp)
apply (simp add: finite_chain_def, rule conjI)
apply (rule chainI)
apply (rule chain_slpf2spf, assumption)
apply (rule_tac x="k" in exI)
apply (simp add: max_in_chain_def)
apply (rule allI, rule impI)
apply (subgoal_tac "stake j\<cdot>x = stake k\<cdot>x", simp)
apply (subst fin2stake [THEN sym], simp+)
by (simp add: min_def)

text \<open>Any live stream-processing function can be converted to a monotone
  list-processing function\<close>
lemma sspf2lpf_mono:
  "sislivespf f \<Longrightarrow> monofun (sspf2lpf f)"
apply (rule monofunI)
apply (simp add: sspf2lpf_def)
apply (subst list2s_emb)
apply (rule notI, frule sislivespfD2, simp+)+
apply (rule monofun_cfun_arg)
by (simp add: sq_le_list)

text \<open>The result of applying continuous functions to infinite inputs
  does not change on even longer inputs\<close>
lemma monofun_spf_ubl[simp]:
  "#(f\<cdot>x) = \<infinity> \<Longrightarrow> f\<cdot>(x \<bullet> y) = f\<cdot>x"
apply (rule sym)
apply (rule eq_less_and_fst_inf [of "f\<cdot>x"])
by (rule monofun_cfun_arg, auto)

text \<open>Some special results about @{term smap} and injective functions
  on streams of natural successors\<close>
lemma inj_sfilter_smap_siteratel1:
  "inj f \<Longrightarrow> sfilter {f j}\<cdot>(smap f\<cdot>(siterate Suc (Suc (k + j)))) = \<epsilon>"
apply (rule ex_snth_in_sfilter_nempty [rule_format])
apply (simp add: atomize_imp)
apply (rule impI)
apply (subst smap_snth_lemma, simp+)
apply (simp add: snth_siterate_Suc)
apply (rule notI)
by (frule_tac x="Suc (n+(k+j))" and y="j" in injD, simp+)

(* an element m can't appear infinitely often in a stream produced by mapping an injective function f
   over the natural numbers *)
lemma inj_sfilter_smap_siteratel2[simp]:
  "inj f \<Longrightarrow> #(sfilter {m}\<cdot>(smap f\<cdot>(siterate Suc j))) \<noteq> \<infinity>"
apply (case_tac "m\<in>range f")
apply (rule_tac b="m" and f="f" in rangeE, simp+)
apply (rule notI)
apply (drule_tac n="Suc x" in slen_sfilter_sdrop [rule_format], simp)
apply (simp add: sdrop_siterate)
apply (simp add: inj_sfilter_smap_siteratel1)
by (simp add: sfilter_smap_nrange)

(* ----------------------------------------------------------------------- *)
subsection \<open>compact lemmas\<close>
(* ----------------------------------------------------------------------- *)

(* finite chains have lub  *)
lemma finChainapprox: assumes "chain Y" and "# (\<Squnion>i. Y i) =Fin  k"
  shows "\<exists>i. Y i = (\<Squnion>i. Y i)"
  using assms(1) assms(2) inf_chainl4 lub_eqI lub_finch2 by fastforce

(* finite streams are compact *)
lemma finCompact: assumes "#s = Fin k"
  shows "compact s"
  proof (rule compactI2)
  fix Y assume as1: "chain Y" and as2: "s \<sqsubseteq> (\<Squnion>i. Y i)"
  show "\<exists>i. s \<sqsubseteq> Y i" by (metis approxl2 as1 as2 assms finChainapprox lub_approx stream.take_below)
qed

(* the empty stream is compact *)
lemma "compact \<epsilon>"
  by simp

(* \<up>x is compact *)
lemma "compact (\<up>x)"
  by (simp add: sup'_def)

(* not so compact stuff *)
lemma nCompact: assumes "chain Y" and "\<forall>i. (Y i \<sqsubseteq> x)" and "\<forall>i.  (Y i \<noteq> x)" and "x \<sqsubseteq> (\<Squnion>i. Y i)"
  shows "\<not>(compact x)"
  by (meson assms below_antisym compactD2)

(* infinite streams are not compact *)
lemma infNCompact: assumes "#s = \<infinity>"
  shows"\<not> (compact s)"
  proof (rule nCompact)
     show "chain (\<lambda>i. stake i\<cdot>s)" by simp
    show "\<forall>i. stake i\<cdot>s \<sqsubseteq> s" by simp
   show "\<forall>i. stake i\<cdot>s \<noteq> s" by (metis Inf'_neq_0 assms fair_sdrop sdropostake strict_slen)
  show "s \<sqsubseteq> (\<Squnion> i. stake i\<cdot>s)" by (simp add: reach_stream)
qed

(* sinftimes (\<up>x) is not compact *)
lemma "\<not> (compact (sinftimes (\<up>x)))"
  by (simp add: infNCompact slen_sinftimes)

(* add function *)
definition add:: "nat stream \<rightarrow> nat stream \<rightarrow> nat stream" where
"add \<equiv> \<Lambda> s1 s2 . smap (\<lambda> s3. (fst s3) + (snd s3))\<cdot>(szip\<cdot>s1\<cdot>s2)"

(* add is continuous *)
lemma "cont (\<lambda> s1 s2 . smap (\<lambda> s3. (fst s3) + (snd s3))\<cdot>(szip\<cdot>s1\<cdot>s2))"
by simp

(* add returns the same result as merge plus *)
lemma "add = merge plus"
by(simp add: add_def merge_def)

(* unfolding rule for add *)
lemma add_unfold: "add\<cdot>(\<up>x \<bullet> xs)\<cdot>(\<up>y\<bullet> ys) = \<up>(x+y) \<bullet> add\<cdot>xs\<cdot>ys"
  by(simp add: add_def)

(* relation between snth and add *)
lemma add_snth: "Fin n <#xs \<Longrightarrow>Fin n < #ys \<Longrightarrow> snth n (add\<cdot>xs\<cdot>ys) = snth n xs + snth n ys"
  apply(induction n arbitrary: xs ys)
   apply (metis Fin_02bot add_unfold lnless_def lnzero_def shd1 slen_empty_eq snth_shd surj_scons)
  by (smt Fin_Suc Fin_leq_Suc_leq Suc_eq_plus1_left add_unfold inject_lnsuc less2eq less2lnleD lnle_conv lnless_def lnsuc_lnle_emb sconc_snd_empty sdropostake shd1 slen_scons snth_rt snth_scons split_streaml1 stream.take_strict surj_scons ub_slen_stake)

(* add applied to the empty stream always returns the empty stream *)
lemma add_eps1[simp]: "add\<cdot>\<epsilon>\<cdot>ys = \<epsilon>"
  by(simp add: add_def)

(* add applied to the empty stream always returns the empty stream *)
lemma add_eps2[simp]: "add\<cdot>xs\<cdot>\<epsilon> = \<epsilon>"
  by(simp add: add_def)

(* relation between srt and add *)
lemma [simp]: "srt\<cdot>(add\<cdot>(\<up>a \<bullet> as)\<cdot>(\<up>b \<bullet> bs)) = add\<cdot>as\<cdot>bs"
  by (simp add: add_unfold)

(* helper lemma for commutativity of add *)
lemma add_commu_helper: assumes "\<And>y. add\<cdot>x\<cdot>y = add\<cdot>y\<cdot>x"
  shows "add\<cdot>(\<up>a \<bullet> x)\<cdot>y = add\<cdot>y\<cdot>(\<up>a \<bullet> x)"
  apply(cases "y = \<epsilon>")
   apply auto[1]
  by (metis (no_types, lifting) Groups.add_ac(2) assms add_unfold surj_scons)

(* the add function is commutative *)
lemma add_commutative: "add\<cdot>x\<cdot>y = add\<cdot>y\<cdot>x"
  apply(induction x arbitrary: y)
    apply(simp_all)
  by (metis add_commu_helper stream.con_rews(2) stream.sel_rews(5) surj_scons)

(* relation between add, lnsuc and srt *)
lemma add_len: assumes "xs\<noteq>\<bottom>" and "u\<noteq>\<bottom>"
  shows "#(add\<cdot>xs\<cdot>(u && ys)) = lnsuc\<cdot>(#(add\<cdot>(srt\<cdot>xs)\<cdot>ys))"
  by (metis (no_types, lifting) add_unfold assms(1) assms(2) slen_scons stream.con_rews(2) stream.sel_rews(5) surj_scons)

(* helper lemma for add_slen *)
lemma add_slen_help [simp]: "#xs \<sqsubseteq> #ys \<Longrightarrow> #(add\<cdot>xs\<cdot>ys) = #xs"
  apply(induction xs arbitrary: ys)
    apply(rule admI)
    apply rule+
    apply (smt ch2ch_Rep_cfunL ch2ch_Rep_cfunR contlub_cfun_arg contlub_cfun_fun lub_below_iff lub_eq)
   apply(simp)
  proof -
  fix u
  fix xs ys :: "nat stream"
  assume as1: "u \<noteq> \<bottom>" and as2: "(\<And>ys. #xs \<sqsubseteq> #ys \<Longrightarrow> #(add\<cdot>xs\<cdot>ys) = #xs)" and as3: " #(u && xs) \<sqsubseteq> #ys"
  obtain a where a_def: "updis a = u" by (metis as1 discr.exhaust upE)
  show "#(add\<cdot>(u && xs)\<cdot>ys) = #(u && xs)"
  proof (cases "ys = \<epsilon>")
   case True thus ?thesis using add_eps2 as3 bot_is_0 bottomI strict_slen by auto
  next
  case False
  hence "#(add\<cdot>xs\<cdot>(srt\<cdot>ys)) = #xs" by (metis a_def as2 as3 lnat.inverts lscons_conv slen_scons surj_scons)
  thus ?thesis by (metis False \<open>updis a = u\<close> add_unfold lscons_conv slen_scons surj_scons)
  qed
qed

(* the length of the stream returned by add is the minimum of the length of the two input streams of add *)
lemma add_slen [simp]: "#(add\<cdot>x\<cdot>y) = min (#x) (#y)"
  apply(cases "#x\<le>#y")
   apply (metis add_slen_help lnle_def min.commute min_absorb2)
  by (metis add_commutative add_slen_help linear lnle_def min.absorb2)

(* if the stream has infinite length, the length of the stream returned by add is the length of the second input stream of add *)
lemma add_slen_sinf [simp]:
  shows " #xs = \<infinity> \<Longrightarrow> #(add\<cdot>xs\<cdot>ys) =(#ys)"
  by (simp add: min.absorb2)

(* relation between snth and add *)
lemma snth_add: "Fin n < #ys \<Longrightarrow> snth n (add\<cdot>\<up>x\<^sup>\<infinity>\<cdot>ys) = snth n (smap (\<lambda>z. z + x)\<cdot>ys)"
  apply(induction n arbitrary: ys)
   apply (smt Fin_02bot add.commute add_unfold lnless_def lnzero_def shd1 sinftimes_unfold slen_empty_eq smap_snth_lemma snth_shd surj_scons)
  by (smt Fin_Suc add_slen_sinf add_unfold lnle_conv lnless_def lnsuc_lnle_emb sinftimes_unfold slen_empty_eq slen_scons slen_sinftimes slen_smap smap_snth_lemma snth_scons strict_icycle surj_scons)

(* relation between add and smap *)
lemma add2smap: "add\<cdot>((\<up>x)\<^sup>\<infinity>)\<cdot>ys = smap (\<lambda>z. z+x)\<cdot>ys"
  apply(rule snths_eq)
   apply auto[1]
  by (metis add_slen_sinf lnat.con_rews lnzero_def lscons_conv slen_empty_eq slen_scons slen_sinftimes snth_add sup'_def)

(* helper lemma for add2smapsu *)
lemma add2smapsuc_helper:" Suc = (\<lambda>z. z+1)"
by auto

(* relation between add and smap applied to (Suc)\<cdot>sc *)
lemma inf_srcdups_stake_snth_sdrop:
  assumes "#s = \<infinity>" and "srcdups\<cdot>s = srcdups\<cdot>(stake k\<cdot>s)"
  shows "snth n (sdrop k\<cdot>s) = snth k s"
proof (induction n)
  case 0
  then show ?case
    by (simp add: snth_def)
next
  case (Suc n)
  then have "snth (Suc n) (sdrop k\<cdot>s) \<noteq> snth k s \<Longrightarrow> False"
  proof -
    assume "snth (Suc n) (sdrop k\<cdot>s) \<noteq> snth k s"
    have "#s = \<infinity>"
      by (simp add: assms(1))
    moreover have "snth (n + k) s \<noteq> snth (n + k + 1) s"
      by (metis Suc.IH Suc.prems Suc_eq_plus1 \<open>snth (Suc n) (sdrop k\<cdot>s) \<noteq> snth k s\<close> semiring_normalization_rules(23) snth_sdrop)
    ultimately have "srcdups\<cdot>(stake (n + k + 1)\<cdot>s) \<noteq> srcdups\<cdot>s"
      by (metis add2smapsuc_helper srcdups_snth_stake_inf)
    moreover have "srcdups\<cdot>(stake (n + k + 1)\<cdot>s) = srcdups\<cdot>(stake k\<cdot>s)"
    proof -
      have "srcdups\<cdot>(stake k\<cdot>s) \<sqsubseteq> srcdups\<cdot>(stake (n + k + 1)\<cdot>s)"
      proof -
        have "k + (1 + n) = n + k + 1"
          by simp
        then show ?thesis
          by (metis (no_types) minimal monofun_cfun_arg sconc_snd_empty stake_add)
      qed
      then show ?thesis
        by (metis assms(2) below_antisym monofun_cfun_arg stream.take_below)
    qed
    ultimately show "False"
      by (simp add: assms(2))
  qed
  then show ?case
    by blast
qed

lemma srcdups_split:
  assumes "#(srcdups\<cdot>s) < \<infinity>" and "#s = \<infinity>"
  obtains n where "s = (stake n\<cdot>s) \<bullet> ((\<up>(snth n s))\<^sup>\<infinity>)"
proof -
  obtain k where "srcdups\<cdot>s = srcdups\<cdot>(stake k\<cdot>s)"
    by (meson assms(1) fun_approxl2 lnat_well_h2)
  then have "sdrop k\<cdot>s \<noteq> srt\<cdot>(sdrop k\<cdot>s) \<Longrightarrow> False"
  proof -
    assume "sdrop k\<cdot>s \<noteq> srt\<cdot>(sdrop k\<cdot>s)"
    moreover have "#(sdrop k\<cdot>s) = #(srt\<cdot>(sdrop k\<cdot>s))"
      by (metis assms(2) fair_sdrop sdrop_back_rt)
    ultimately obtain n where "snth n (sdrop k\<cdot>s) \<noteq> snth n (srt\<cdot>(sdrop k\<cdot>s))"
      using snths_eq by blast
    moreover have "snth n (srt\<cdot>(sdrop k\<cdot>s)) = snth k s"
      by (metis \<open>srcdups\<cdot>s = srcdups\<cdot>(stake k\<cdot>s)\<close> assms(2) inf_srcdups_stake_snth_sdrop snth_rt)
    then show "False"
      by (metis (no_types) \<open>snth n (srt\<cdot>(sdrop k\<cdot>s)) = snth k s\<close> \<open>srcdups\<cdot>s = srcdups\<cdot>(stake k\<cdot>s)\<close> assms(2) calculation inf_srcdups_stake_snth_sdrop)
  qed
  then have "sdrop k\<cdot>s = \<up>(snth k s) \<bullet> (sdrop k\<cdot>s)"
    by (metis Inf'_neq_0 assms(2) fair_sdrop snth_def strict_slen surj_scons)
  then have "sdrop k\<cdot>s = ((\<up>(snth k s))\<^sup>\<infinity>)"
    using s2sinftimes by blast
  then have "s = (stake k\<cdot>s) \<bullet> ((\<up>(snth k s))\<^sup>\<infinity>)"
    by (metis split_streaml1)
  thus ?thesis
    by (metis that)
qed

lemma add2smapsuc:"add\<cdot>((\<up>1)\<^sup>\<infinity>)\<cdot>s=smap (Suc)\<cdot>s"
  by (metis add_eps2 add_unfold plus_1_eq_Suc rek2smap sinftimes_unfold)

(* relation between add and smap *)
lemma add2smap_f: "add\<cdot>((\<up>x)\<^sup>\<infinity>) = smap (\<lambda>z. z+x)"
apply(rule cfun_eqI)
by (metis (no_types, lifting) add_commutative add_eps2 add_unfold rek2smap sinftimes_unfold)

(* relation between shd and updis *)
lemma shd_updis:"shd (u && s) = (THE a. updis a= u)"
by(simp add: shd_def the_equality, metis)

(* smap applied to the identity + stream returns the stream *)
lemma smap_id:"smap (id)\<cdot>s = s"
apply(induction s, auto)
apply(simp add: smap_hd_rst)
using stream.con_rews(2) surj_scons by fastforce

(* smap applied to the identity + stream returns the identity + stream *)
lemma smapid2ID_h:"smap id\<cdot> s = ID\<cdot> s"
apply(simp add: ID_def)
by(rule snths_eq, auto, simp add: smap_id)

(* smap applied to the identity returns the identity *)
lemma smapid2ID:"smap id= ID"
by(rule cfun_eqI, simp add: smapid2ID_h)

(* add applied to \<up>0\<infinity>\<cdot>s returns the identity + stream *)
lemma add2ID_h:"add\<cdot>((\<up>0)\<^sup>\<infinity>)\<cdot>s=ID\<cdot>s"
proof(induction s rule: ind)
  case 1
  then show ?case
    by simp
next
case 2
  then show ?case
    by simp
next
  case (3 a s)
  then show ?case
    by (metis ID1 add_unfold semiring_normalization_rules(5) sinftimes_unfold)
qed

(* add applied to \<up>0\<infinity> returns the identity *)
lemma add2ID:"add\<cdot>\<up>0\<^sup>\<infinity> = ID"
by (simp add: add2ID_h cfun_eqI)

(*
(* Setup type relator for streams*)

(* TODO: Remove Warning
  https://fa.isabelle.narkive.com/wKVBUrdK/isabelle-setup-lifting-no-relator-for-the-type-warning
  HOL/Library/Quotient_Set.thy
  *)
definition "rel_stream R x y \<equiv> \<forall>(e1::'e::countable) (e2::'f::countable). R e1 e2 \<longrightarrow> e1\<in> sValues\<cdot>x \<longleftrightarrow> e2\<in> sValues\<cdot>y" (*Does not work*)

definition vstream :: "('a \<Rightarrow> 'b) \<Rightarrow> 'b stream \<Rightarrow> 'a stream" (*Probably also does not work*)
  where "vstream f s \<equiv> smap (inv f)\<cdot>s"

lemma stream_quotient [quot_thm]:
  assumes "Quotient3 R Abs Rep"
  shows "Quotient3 (rel_stream R) (vstream Rep) (vstream Abs)"
proof (rule Quotient3I)
  from assms have "\<And>x. Abs (Rep x) = x" by (rule Quotient3_abs_rep)
  then show "\<And>xs. vstream Rep (vstream Abs xs) = xs"
    unfolding vstream_def sorry
next
  show "\<And>xs. rel_stream R (vstream Abs xs) (vstream Abs xs)"
    unfolding rel_stream_def vstream_def
    apply auto sorry
next
  fix r s
  show "rel_stream R r s = (rel_stream R r r \<and> rel_stream R s s \<and> vstream Rep r = vstream Rep s)"
    unfolding rel_stream_def vstream_def set_eq_iff
    apply auto sorry
qed

declare [[mapQ3 stream = (rel_stream, stream_quotient)]]
*)

end
(*>*)