(*
    Author:     Tobias Nipkow, 2008
*)

section "The Gibbard-Satterthwaite Theorem"

theory GS imports Arrow_Order
begin

text\<open>The Gibbard-Satterthwaite theorem as a corollary to Arrow's
theorem. The proof follows Nisan~\<^cite>\<open>"NisanRTV07"\<close>.\<close>

definition "manipulable f == \<exists>P\<in>Prof. \<exists>i. \<exists>L\<in>Lin. (f P, f(P(i:=L))) : P i"

definition "dict f i == \<forall>P\<in>Prof.\<forall>a. a \<noteq> f P \<longrightarrow> (a,f P) : P i"

definition
 Top :: "alt set \<Rightarrow> pref \<Rightarrow> pref" where
"Top S L \<equiv> {(a,b). (a,b) \<in> L \<and> (a \<in> S \<and> b \<in> S \<or> a \<notin> S \<and> b \<notin> S)} \<union>
             {(a,b). a \<notin> S \<and> b \<in> S}"

lemma Top_in_Lin: "L:Lin \<Longrightarrow> Top S L : Lin"
apply(simp add:Top_def slo_defs Sigma_def)
unfolding trans_def
apply blast
done

lemma Top_in_Prof: "P:Prof \<Longrightarrow> Top S o P : Prof"
by(simp add:Prof_def Pi_def Top_in_Lin)

lemma not_manipulable: "\<not> manipulable f \<longleftrightarrow>
 (\<forall>P\<in>Prof.\<forall>i.\<forall>L\<in>Lin. f P \<noteq> f(P(i:=L)) \<longrightarrow>
   (f(P(i := L)), f P) : P i \<and> (f P, f(P(i := L))) : L)" (is "?A = ?B")
proof
  assume ?A
  show ?B
  proof(clarsimp)
    fix P i L assume 0: "P \<in> Prof" "L \<in> Lin" "f P \<noteq> f (P(i := L))"
    moreover hence 1: "P i: Lin" "P(i:=L): Prof" by(simp add:Prof_def Pi_def)+
    ultimately have "(f (P(i := L)), f P) \<in> P i" (is ?L)
      using \<open>?A\<close> unfolding manipulable_def by (metis notin_Lin_iff)
    moreover have "(f P, f (P(i := L))) \<in> L" (is ?R)
      using 0 1 fun_upd_upd[of P] fun_upd_triv[of P] fun_upd_same[of P]
      using \<open>?A\<close> unfolding manipulable_def by (metis notin_Lin_iff)
    ultimately show "?L \<and> ?R" ..
  qed
next
  assume ?B
  show ?A
  proof(clarsimp simp:manipulable_def)
    fix P i L assume "P \<in> Prof" "L \<in> Lin" "(f P, f (P(i := L))) \<in> P i"
    moreover hence "P i: Lin" by(simp add:Prof_def Pi_def)
    ultimately show False
      using \<open>?B\<close> by(metis Lin_irrefl)
  qed
qed

definition "swf(f) \<equiv> \<lambda>P. {(a,b). a\<noteq>b \<and> f(Top {a,b} o P) = b}"

locale GS =
fixes f
assumes not_manip: "\<not> manipulable f"
and onto: "f ` Prof = UNIV"
begin

lemma mono:
assumes "P\<in>Prof" "P'\<in>Prof" "\<forall>i a. (a, f P) : P i \<longrightarrow> (a, f P) : P' i"
shows "f P' = f P"
proof-
  obtain h :: "indi \<Rightarrow> nat" where
    injh: "inj h" and surjh: "h ` I = {0..<N}"
    by(metis ex_bij_betw_finite_nat[OF finite_indi] bij_betw_def)
  let ?M = "%n i. if h i < n then P' i else P i"
  have N: "!!i. h i < N" using surjh by auto
  have MProf: "!!n. ?M n : Prof" and P'Lin: "!!i. P' i : Lin"
    using \<open>P:Prof\<close> \<open>P':Prof\<close> by(simp add:Prof_def Pi_def)+
  { fix n have "n<=N \<Longrightarrow> f(?M n) = f P"
    proof(induct n)
      case 0 show ?case by simp
    next
      case (Suc n)
      let ?up = "(?M n)(inv h n := P' (inv h n))"
      have 1: "?M(Suc n) = ?up" using surjh Suc(2)
        by(simp (no_asm_simp) add:fun_eq_iff f_inv_into_f)
          (metis injh inv_f_f less_antisym)
      show ?case
      proof(rule ccontr)
        assume "\<not> ?case"
        with \<open>?M(Suc n) = ?up\<close> Suc have 0: "f ?up \<noteq> f(?M n)" by simp
        from nonmanip[OF MProf P'Lin 0] assms(3) show False
          using N surjh Suc Lin_irrefl[OF P'Lin]
          by(fastforce simp: f_inv_into_f)
      qed
    qed
  }
  from this[of N] N show "f P' = f P" by simp
qed

lemma una_Top: assumes "P:Prof" "S \<noteq> {}" shows "f(Top S o P) : S"
proof -
  obtain h :: "indi \<Rightarrow> nat" where
    injh: "inj h" and surjh: "h ` I = {0..<N}"
    by(metis ex_bij_betw_finite_nat[OF finite_indi] bij_betw_def)
  from assms obtain a where "a:S" by blast
  from onto obtain Pa where "Pa:Prof" "f Pa = a"
    by(metis inv_into_into UNIV_I f_inv_into_f)
  let ?M = "%n i. if h i < n then Top S (P i) else Pa i"
  have N: "!!i. h i < N" using surjh by auto
  have MProf: "!!n. ?M n : Prof" using \<open>P:Prof\<close> \<open>Pa:Prof\<close>
    by(simp add:Prof_def Pi_def Top_in_Lin mktop_Lin)
  { fix n have "n<=N \<Longrightarrow> f(?M n) : S"
    proof(induct n)
      case 0 thus ?case using \<open>f Pa = a\<close> \<open>a:S\<close> by simp
    next
      case (Suc n)
      show ?case
      proof cases
        assume "f(?M n) = f(?M(Suc n))"
        thus ?case using Suc by simp
      next
        let ?up = "(?M n)(inv h n := Top S (P(inv h n)))"
        assume "f(?M n) \<noteq> f(?M(Suc n))"
        also have eq: "?M(Suc n) = ?up" using surjh Suc
          by(simp (no_asm_simp) add:fun_eq_iff f_inv_into_f)
            (metis injh inv_f_eq less_antisym)
        finally have n: "f(?M n) \<noteq> f(?up)" .
        with nonmanip[OF MProf Top_in_Lin n[symmetric]] Suc eq \<open>P:Prof\<close>
        show ?case by (simp add:Top_def Prof_def Pi_def)
      qed
    qed
  }
  from this[of N] N show ?thesis by(simp add:comp_def)
qed

lemma SWF_swf: "swf f : SWF"
proof (rule Pi_I)
  fix P assume "P: Prof"
  show "swf f P : Lin"
  proof(unfold Lin_def strict_linear_order_on_def, auto)
    show "total(swf f P)"
    proof(simp add: total_on_def, intro allI impI)
      fix a b :: alt assume "a\<noteq>b"
      thus "(a,b) \<in> swf f P \<or> (b,a) \<in> swf f P"
        unfolding swf_def using una_Top[of P "{a,b}"] \<open>P:Prof\<close>
        by simp(metis insert_commute)
    qed
    show "irrefl(swf f P)" by(simp add: irrefl_def swf_def)
    show "trans(swf f P)"
    proof (clarsimp simp:trans_def swf_def insert_commute)
      fix a b c assume "a\<noteq>b" "b\<noteq>c" "f(Top{a,b} \<circ> P) = b" "f(Top{b,c} \<circ> P) = c"
      hence "a\<noteq>c" by(auto simp: insert_commute)
      note 3 = Top_in_Prof[OF \<open>P:Prof\<close>, of "{a,b,c}"]
      { assume "f (Top {a, b, c} \<circ> P) = a"
        hence "f(Top{a,b} \<circ> P) = a"
          using mono[OF 3 Top_in_Prof[OF \<open>P:Prof\<close>], of "{a,b}"]
          by(auto simp:Top_def)
        with \<open>f(Top{a,b} \<circ> P) = b\<close> \<open>a\<noteq>b\<close> have False by simp
      } moreover
      { assume "f (Top {a, b, c} \<circ> P) = b"
        hence "f(Top{b,c} \<circ> P) = b"
          using mono[OF 3 Top_in_Prof[OF \<open>P:Prof\<close>], of "{b,c}"]
          by(auto simp:Top_def)
        with \<open>f(Top{b,c} \<circ> P) = c\<close> \<open>b\<noteq>c\<close> have False by simp
      }
      ultimately have "f (Top {a, b, c} \<circ> P) = c"
        using una_Top[OF \<open>P:Prof\<close>, of "{a,b,c}", simplified] by blast
      hence "f(Top{a,c} \<circ> P) = c" (is ?R)
        using mono[OF 3 Top_in_Prof[OF \<open>P:Prof\<close>], of "{a,c}"]
        by (auto simp:Top_def)
      thus "a\<noteq>c \<and> ?R" using \<open>a\<noteq>c\<close> by blast
    qed
  qed
qed

lemma Top_top: "L:Lin \<Longrightarrow> (!!a. a\<noteq>b \<Longrightarrow> (a,b) : L) \<Longrightarrow> Top {b} L = L"
apply(auto simp:Top_def slo_defs)
apply (metis trans_def)
apply (metis trans_def)
done

lemma una_swf: "unanimity(swf f)"
proof(clarsimp simp:swf_def unanimity_def)
  fix P a b
  assume "P:Prof" and abP: "\<forall>i. (a, b) \<in> P i"
  hence "a \<noteq> b" by(fastforce simp:Prof_def Pi_def slo_defs)
  let ?abP = "Top {a,b} \<circ> P"
  have "?abP : Prof" using \<open>P:Prof\<close> by(simp add:Prof_def Pi_def Top_in_Lin)
  have top: "!!i c. b\<noteq>c \<Longrightarrow> (c,b) : Top {a,b} (P i)"
    using abP by(auto simp:Top_def)
  have "Top {b} o ?abP = ?abP" using \<open>P:Prof\<close>
    by (simp add:fun_eq_iff top Top_top Prof_def Pi_def Top_in_Lin)
  moreover have "f(Top {b} o ?abP) = b"
    by (metis una_Top[OF \<open>?abP : Prof\<close>] empty_not_insert singletonE)
  ultimately have "f ?abP = b" by simp
  thus "a\<noteq>b \<and> f ?abP = b" using \<open>a\<noteq>b\<close> by blast
qed

lemma IIA_swf: "IIA(swf f)"
proof(clarsimp simp: IIA_def)
  fix P P' a b
  assume "P:Prof" "P':Prof" and iff: "\<forall>i. ((a,b) \<in> P i) = ((a,b) \<in> P' i)"
  hence [simp]: "!!i x. (x,x) ~: P i \<and> (x,x) ~: P' i"
    by(simp add:Prof_def Pi_def slo_defs)
  have iff':  "a\<noteq>b \<longrightarrow> (\<forall>i. ((b,a) \<in> P i) = ((b,a) \<in> P' i))"
    using iff \<open>P:Prof\<close> \<open>P':Prof\<close> unfolding Prof_def Pi_def
    by simp (metis iff notin_Lin_iff)
  let ?abP = "Top {a,b} o P" let ?abP' = "Top {a,b} o P'"
  have "\<forall>i c. (c, f ?abP) : ?abP i \<longrightarrow> (c, f ?abP) : ?abP' i"
    using una_Top[of P "{a,b}", OF \<open>P:Prof\<close>] iff iff' by(auto simp add:Top_def)
  then have "f (Top {a,b} \<circ> P) = f (Top {a,b} \<circ> P')"
    using Top_in_Prof[OF \<open>P:Prof\<close>] Top_in_Prof[OF \<open>P':Prof\<close>]
          mono[of "Top {a, b} \<circ> P"]  by metis
  thus "(a <\<^bsub>swf f P\<^esub> b) = (a <\<^bsub>swf f P'\<^esub> b)" by(simp add: swf_def)
qed

lemma dict_swf: assumes "dictator (swf f) i" shows "dict f i"
proof (auto simp:dict_def)
  fix P a assume "P:Prof" "a\<noteq>f P"
  have "f (Top {a,f P} \<circ> P) = f P"
    using mono[OF \<open>P:Prof\<close> Top_in_Prof[OF \<open>P:Prof\<close>,of "{a,f P}"]]
    by (auto simp:Top_def)
  moreover have "P i = {(a,b). a\<noteq>b \<and> f(Top {a,b} \<circ> P) = b}"
    using assms \<open>P:Prof\<close> by(simp add:dictator_def swf_def)
  ultimately show "(a,f P) : P i" using \<open>a\<noteq>f P\<close> by simp
qed

theorem Gibbard_Satterthwaite:
  "\<exists>i. dict f i"
by (metis Arrow SWF_swf una_swf IIA_swf dict_swf)

end

theorem Gibbard_Satterthwaite:
  "\<not> manipulable f \<Longrightarrow> \<forall>a.\<exists>P\<in>Prof. a = f P \<Longrightarrow> \<exists>i. dict f i"
using GS.Gibbard_Satterthwaite[of f,unfolded GS_def]
by blast

end


(* Author: Fabian Immler, TUM *)

section \<open>Sequence of Properties on Subsequences\<close>

theory Diagonal_Subsequence
imports Complex_Main
begin

locale subseqs =
  fixes P::"nat\<Rightarrow>(nat\<Rightarrow>nat)\<Rightarrow>bool"
  assumes ex_subseq: "\<And>n s. strict_mono (s::nat\<Rightarrow>nat) \<Longrightarrow> \<exists>r'. strict_mono r' \<and> P n (s \<circ> r')"
begin

definition reduce where "reduce s n = (SOME r'::nat\<Rightarrow>nat. strict_mono r' \<and> P n (s \<circ> r'))"

lemma subseq_reduce[intro, simp]:
  "strict_mono s \<Longrightarrow> strict_mono (reduce s n)"
  unfolding reduce_def by (rule someI2_ex[OF ex_subseq]) auto

lemma reduce_holds:
  "strict_mono s \<Longrightarrow> P n (s \<circ> reduce s n)"
  unfolding reduce_def by (rule someI2_ex[OF ex_subseq]) (auto simp: o_def)

primrec seqseq :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "seqseq 0 = id"
| "seqseq (Suc n) = seqseq n \<circ> reduce (seqseq n) n"

lemma subseq_seqseq[intro, simp]: "strict_mono (seqseq n)"
proof (induct n)
  case 0 thus ?case by (simp add: strict_mono_def)
next
  case (Suc n) thus ?case by (subst seqseq.simps) (auto intro!: strict_mono_o)
qed

lemma seqseq_holds:
  "P n (seqseq (Suc n))"
proof -
  have "P n (seqseq n \<circ> reduce (seqseq n) n)"
    by (intro reduce_holds subseq_seqseq)
  thus ?thesis by simp
qed

definition diagseq :: "nat \<Rightarrow> nat" where "diagseq i = seqseq i i"

lemma diagseq_mono: "diagseq n < diagseq (Suc n)"
proof -
  have "diagseq n < seqseq n (Suc n)"
    using subseq_seqseq[of n] by (simp add: diagseq_def strict_mono_def)
  also have "\<dots> \<le> seqseq n (reduce (seqseq n) n (Suc n))"
    using strict_mono_less_eq seq_suble by blast
  also have "\<dots> = diagseq (Suc n)" by (simp add: diagseq_def)
  finally show ?thesis .
qed

lemma subseq_diagseq: "strict_mono diagseq"
  using diagseq_mono by (simp add: strict_mono_Suc_iff diagseq_def)

primrec fold_reduce where
  "fold_reduce n 0 = id"
| "fold_reduce n (Suc k) = fold_reduce n k \<circ> reduce (seqseq (n + k)) (n + k)"

lemma subseq_fold_reduce[intro, simp]: "strict_mono (fold_reduce n k)"
proof (induct k)
  case (Suc k) from strict_mono_o[OF this subseq_reduce] show ?case by (simp add: o_def)
qed (simp add: strict_mono_def)

lemma ex_subseq_reduce_index: "seqseq (n + k) = seqseq n \<circ> fold_reduce n k"
  by (induct k) simp_all

lemma seqseq_fold_reduce: "seqseq n = fold_reduce 0 n"
  by (induct n) (simp_all)

lemma diagseq_fold_reduce: "diagseq n = fold_reduce 0 n n"
  using seqseq_fold_reduce by (simp add: diagseq_def)

lemma fold_reduce_add: "fold_reduce 0 (m + n) = fold_reduce 0 m \<circ> fold_reduce m n"
  by (induct n) simp_all

lemma diagseq_add: "diagseq (k + n) = (seqseq k \<circ> (fold_reduce k n)) (k + n)"
proof -
  have "diagseq (k + n) = fold_reduce 0 (k + n) (k + n)"
    by (simp add: diagseq_fold_reduce)
  also have "\<dots> = (seqseq k \<circ> fold_reduce k n) (k + n)"
    unfolding fold_reduce_add seqseq_fold_reduce ..
  finally show ?thesis .
qed

lemma diagseq_sub:
  assumes "m \<le> n" shows "diagseq n = (seqseq m \<circ> (fold_reduce m (n - m))) n"
  using diagseq_add[of m "n - m"] assms by simp

lemma subseq_diagonal_rest: "strict_mono (\<lambda>x. fold_reduce k x (k + x))"
  unfolding strict_mono_Suc_iff fold_reduce.simps o_def
proof
  fix n
  have "fold_reduce k n (k + n) < fold_reduce k n (k + Suc n)" (is "?lhs < _")
    by (auto intro: strict_monoD)
  also have "\<dots> \<le> fold_reduce k n (reduce (seqseq (k + n)) (k + n) (k + Suc n))"
    by (auto intro: less_mono_imp_le_mono seq_suble strict_monoD)
  finally show "?lhs < \<dots>" .
qed

lemma diagseq_seqseq: "diagseq \<circ> ((+) k) = (seqseq k \<circ> (\<lambda>x. fold_reduce k x (k + x)))"
  by (auto simp: o_def diagseq_add)

lemma diagseq_holds:
  assumes subseq_stable: "\<And>r s n. strict_mono r \<Longrightarrow> P n s \<Longrightarrow> P n (s \<circ> r)"
  shows "P k (diagseq \<circ> ((+) (Suc k)))"
  unfolding diagseq_seqseq by (intro subseq_stable subseq_diagonal_rest seqseq_holds)

end

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_list_nat_perm_symm
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun elem :: "'a => 'a list => bool" where
"elem x (nil2) = False"
| "elem x (cons2 z xs) = ((z = x) | (elem x xs))"

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
"deleteBy x y (nil2) = nil2"
| "deleteBy x y (cons2 y2 ys) =
     (if (x y) y2 then ys else cons2 y2 (deleteBy x y ys))"

fun isPermutation :: "'a list => 'a list => bool" where
"isPermutation (nil2) (nil2) = True"
| "isPermutation (nil2) (cons2 z x2) = False"
| "isPermutation (cons2 x3 xs) y =
     ((elem x3 y) &
        (isPermutation
           xs (deleteBy (% (x4 :: 'a) => % (x5 :: 'a) => (x4 = x5)) x3 y)))"

theorem property0 :
  "((isPermutation xs ys) ==> (isPermutation ys xs))"
  oops

end


(*File: PBIJ.thy*)
(*Authors: Lennart Beringer and Martin Hofmann, LMU Munich 2008*)
theory PBIJ imports OBJ begin

subsection{*Partial bijections*}

text{*Partial bijections between locations will be used in the next
section to define indistinguishability of objects and heaps. We define
such bijections as sets of pairs which satisfy the obvious
condition.*}

type_synonym PBij = "(Location \<times> Location) set"
definition Pbij :: "PBij set"
where "Pbij = { \<beta> . \<forall> l1 l2 l3 l4. (l1,l2):\<beta> \<longrightarrow> (l3,l4):\<beta> \<longrightarrow>
                              ((l1 = l3) = (l2 = l4))}"

text{*Domain and codomain are defined as expected.*}

definition Pbij_Dom::"PBij \<Rightarrow> (Location set)"
where "Pbij_Dom \<beta> = {l . \<exists> ll .(l,ll):\<beta>}"

definition Pbij_Rng::"PBij \<Rightarrow> (Location set)"
where "Pbij_Rng \<beta> = {ll . \<exists> l .(l,ll):\<beta>}"

text{*We also define the inverse operation, the composition, and a
test deciding when one bijection extends another.*}

definition Pbij_inverse::"PBij \<Rightarrow> PBij"
where "Pbij_inverse \<beta> = {(l,ll) . (ll,l):\<beta>}"
(*<*)
lemma Pbij_inverseI:"(l1,l2):\<beta> \<Longrightarrow> (l2,l1):Pbij_inverse \<beta>"
by (simp add: Pbij_inverse_def)
lemma Pbij_inverseD:"(l1,l2):Pbij_inverse \<beta> \<Longrightarrow> (l2,l1):\<beta>"
by (simp add: Pbij_inverse_def)
(*>*)

definition Pbij_compose::"PBij \<Rightarrow> PBij \<Rightarrow> PBij"
where "Pbij_compose \<beta> \<gamma> = {(l,ll) . \<exists> l1 . (l,l1):\<beta> \<and> (l1,ll):\<gamma>}"
(*<*)
lemma Pbij_composeI: "\<lbrakk>(l1, l2) \<in> \<beta>; (l2, l3) \<in> \<gamma>\<rbrakk> \<Longrightarrow> (l1, l3) \<in> Pbij_compose \<beta> \<gamma>"
by (simp add: Pbij_compose_def, rule_tac x=l2 in exI, simp)
lemma Pbij_composeD: "(l1, l3) \<in> Pbij_compose \<beta> \<gamma> \<Longrightarrow> \<exists> l2 . (l1, l2) \<in> \<beta> \<and> (l2, l3) \<in> \<gamma>"
by (simp add: Pbij_compose_def)
(*>*)

definition Pbij_extends ::"PBij \<Rightarrow> PBij \<Rightarrow> bool"
where "Pbij_extends \<gamma> \<beta> = (\<beta> \<subseteq> \<gamma>)"

text{*These definitions satisfy the following properties.*}

lemma Pbij_insert:
  "\<lbrakk>\<beta> \<in> Pbij;l \<notin> Pbij_Rng \<beta>; ll \<notin> Pbij_Dom \<beta>\<rbrakk>
  \<Longrightarrow> insert (ll, l) \<beta> \<in> Pbij"
(*<*)
apply (simp add: Pbij_def)
apply clarsimp
apply rule
  apply clarsimp apply (simp add: Pbij_Dom_def Pbij_Rng_def) apply fast
  apply clarsimp apply (simp add: Pbij_Dom_def Pbij_Rng_def) apply fast
done
(*>*)

lemma Pbij_injective:
  "\<beta>:Pbij \<Longrightarrow> (\<forall> l l1 l2 . (l1,l):\<beta> \<longrightarrow> (l2,l):\<beta> \<longrightarrow> l1=l2)"
(*<*)
by (simp add: Pbij_def)
(*>*)

lemma Pbij_inverse_DomRng[rule_format]:
  "\<gamma> = Pbij_inverse \<beta> \<Longrightarrow>
   (Pbij_Dom \<beta> = Pbij_Rng \<gamma> \<and> Pbij_Dom \<gamma> = Pbij_Rng \<beta>)"
(*<*)
by (simp add: Pbij_inverse_def Pbij_Dom_def Pbij_Rng_def)
(*>*)

lemma Pbij_inverse_Dom: "Pbij_Dom \<beta> = Pbij_Rng (Pbij_inverse \<beta>)"
(*<*)
by (simp add: Pbij_inverse_def Pbij_Dom_def Pbij_Rng_def)
(*>*)

lemma Pbij_inverse_Rng: "Pbij_Dom (Pbij_inverse \<beta>) = Pbij_Rng \<beta>"
(*<*)
by (simp add: Pbij_inverse_def Pbij_Dom_def Pbij_Rng_def)
(*>*)

lemma Pbij_inverse_Pbij: "\<beta>:Pbij \<Longrightarrow> (Pbij_inverse \<beta>) : Pbij"
(*<*)
by (simp add: Pbij_def Pbij_inverse_def)
(*>*)

lemma Pbij_inverse_Inverse[rule_format]:
  "\<gamma> = Pbij_inverse \<beta> \<Longrightarrow> (\<forall> l ll . ((l,ll):\<beta>) = ((ll,l):\<gamma>))"
(*<*)
by (simp add: Pbij_inverse_def)
(*>*)

lemma Pbij_compose_Dom:
  "Pbij_Dom (Pbij_compose \<beta> \<gamma>) \<subseteq> Pbij_Dom \<beta>"
(*<*)
by (simp add: Pbij_compose_def Pbij_Dom_def, fast)
(*>*)

lemma Pbij_compose_Rng:
  "Pbij_Rng (Pbij_compose \<beta> \<gamma>) \<subseteq> Pbij_Rng \<gamma>"
(*<*)
by (simp add: Pbij_compose_def Pbij_Rng_def, fast)
(*>*)

lemma Pbij_compose_Pbij:
  "\<lbrakk>\<beta> : Pbij; \<gamma> : Pbij\<rbrakk> \<Longrightarrow> Pbij_compose \<beta> \<gamma> : Pbij"
(*<*)
by (simp add: Pbij_compose_def Pbij_def, clarsimp)
(*>*)

lemma Pbij_extends_inverse:
 "Pbij_extends \<gamma> (Pbij_inverse \<beta>) = Pbij_extends (Pbij_inverse \<gamma>) \<beta>"
(*<*)
by (simp add: Pbij_extends_def Pbij_inverse_def, fast)
(*>*)

lemma Pbij_extends_reflexive:"Pbij_extends \<beta> \<beta>"
(*<*)
by (simp add: Pbij_extends_def)
(*>*)

lemma Pbij_extends_transitive:
"\<lbrakk>Pbij_extends \<beta> \<gamma>; Pbij_extends \<gamma> \<delta>\<rbrakk> \<Longrightarrow> Pbij_extends \<beta> \<delta>"
(*<*)
by (simp add: Pbij_extends_def)
(*>*)

(*<*)
lemma Pbij_inverse_extends_twice_Aux:
"\<lbrakk> \<delta> = Pbij_inverse \<epsilon>; Pbij_extends \<epsilon> \<gamma>; \<gamma> = Pbij_inverse  \<beta>\<rbrakk>
 \<Longrightarrow> Pbij_extends \<delta> \<beta>"
by (simp add: Pbij_extends_def Pbij_inverse_def, fastforce)
(*>*)

lemma Pbij_inverse_extends_twice:
" Pbij_extends (Pbij_inverse (Pbij_inverse \<beta>)) \<beta>"
(*<*)
by (simp add: Pbij_extends_def Pbij_inverse_def)
(*>*)

text{*The identity bijection on a heap associates each element of the
heap's domain with itself.*}

definition mkId::"Heap \<Rightarrow> (Location \<times> Location) set"
where "mkId h = {(l1,l2) . l1 = l2 \<and> l1 : Dom h}"

lemma mkId1: "(mkId h):Pbij"
(*<*)
by (simp add: mkId_def Pbij_def)
(*>*)

lemma mkId2: "Pbij_Dom (mkId h) = Dom h"
(*<*)
by (simp add: Dom_def Pbij_Dom_def mkId_def)
(*>*)

lemma mkId2b: "Pbij_Rng (mkId h) = Dom h"
(*<*)
by (simp add: Dom_def Pbij_Rng_def mkId_def)
(*>*)

lemma mkId4: "l:Dom h \<Longrightarrow> (l,l):(mkId h)"
(*<*)
by (simp add: mkId_def)
(*>*)

lemma mkId4b: "(l,ll):(mkId h) \<Longrightarrow> l:Dom h \<and> l = ll"
(*<*)
by (simp add: mkId_def, clarsimp)
(*>*)

text{*End of theory PBIJ*}
end


section \<open>Frequency Moment $k$\<close>

theory Frequency_Moment_k
  imports
    Frequency_Moments
    Landau_Ext
    Lp.Lp
    Median_Method.Median
    Product_PMF_Ext
begin

text \<open>This section contains a formalization of the algorithm for the $k$-th frequency moment.
It is based on the algorithm described in \<^cite>\<open>\<open>\textsection 2.1\<close> in "alon1999"\<close>.\<close>

type_synonym fk_state = "nat \<times> nat \<times> nat \<times> nat \<times> (nat \<times> nat \<Rightarrow> (nat \<times> nat))"

fun fk_init :: "nat \<Rightarrow> rat \<Rightarrow> rat \<Rightarrow> nat \<Rightarrow> fk_state pmf" where
  "fk_init k \<delta> \<epsilon> n =
    do {
      let s\<^sub>1 = nat \<lceil>3 * real k * n powr (1-1/real k) / (real_of_rat \<delta>)\<^sup>2\<rceil>;
      let s\<^sub>2 = nat \<lceil>-18 * ln (real_of_rat \<epsilon>)\<rceil>;
      return_pmf (s\<^sub>1, s\<^sub>2, k, 0, (\<lambda>_ \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. (0,0)))
    }"

fun fk_update :: "nat \<Rightarrow> fk_state \<Rightarrow> fk_state pmf" where
  "fk_update a (s\<^sub>1, s\<^sub>2, k, m, r) =
    do {
      coins \<leftarrow> prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. bernoulli_pmf (1/(real m+1)));
      return_pmf (s\<^sub>1, s\<^sub>2, k, m+1, \<lambda>i \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2}.
        if coins i then
          (a,0)
        else (
          let (x,l) = r i in (x, l + of_bool (x=a))
        )
      )
    }"

fun fk_result :: "fk_state \<Rightarrow> rat pmf" where
  "fk_result (s\<^sub>1, s\<^sub>2, k, m, r) =
    return_pmf (median s\<^sub>2 (\<lambda>i\<^sub>2 \<in> {0..<s\<^sub>2}.
      (\<Sum>i\<^sub>1\<in>{0..<s\<^sub>1}. rat_of_nat (let t = snd (r (i\<^sub>1, i\<^sub>2)) + 1 in m * (t^k - (t - 1)^k))) / (rat_of_nat s\<^sub>1))
    )"

lemma bernoulli_pmf_1: "bernoulli_pmf 1 = return_pmf True"
  by (rule pmf_eqI, simp add:indicator_def)

fun fk_space_usage :: "(nat \<times> nat \<times> nat \<times> rat \<times> rat) \<Rightarrow> real" where
  "fk_space_usage (k, n, m, \<epsilon>, \<delta>) = (
    let s\<^sub>1 = nat \<lceil>3*real k* (real n) powr (1-1/ real k) / (real_of_rat \<delta>)\<^sup>2 \<rceil> in
    let s\<^sub>2 = nat \<lceil>-(18 * ln (real_of_rat \<epsilon>))\<rceil> in
    4 +
    2 * log 2 (s\<^sub>1 + 1) +
    2 * log 2 (s\<^sub>2 + 1) +
    2 * log 2 (real k + 1) +
    2 * log 2 (real m + 1) +
    s\<^sub>1 * s\<^sub>2 * (2 + 2 * log 2 (real n+1) + 2 * log 2 (real m+1)))"

definition encode_fk_state :: "fk_state \<Rightarrow> bool list option" where
  "encode_fk_state =
    N\<^sub>e \<Join>\<^sub>e (\<lambda>s\<^sub>1.
    N\<^sub>e \<Join>\<^sub>e (\<lambda>s\<^sub>2.
    N\<^sub>e \<times>\<^sub>e
    N\<^sub>e \<times>\<^sub>e
    (List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e (N\<^sub>e \<times>\<^sub>e N\<^sub>e))))"

lemma "inj_on encode_fk_state (dom encode_fk_state)"
proof -
  have "is_encoding encode_fk_state"
    by (simp add:encode_fk_state_def)
     (intro dependent_encoding exp_golomb_encoding fun_encoding)

  thus ?thesis by (rule encoding_imp_inj)
qed

text \<open>This is an intermediate non-parallel form @{term "fk_update"} used only in the correctness proof.\<close>

fun fk_update_2 :: "'a \<Rightarrow> (nat \<times> 'a \<times> nat) \<Rightarrow> (nat \<times> 'a \<times> nat) pmf" where
  "fk_update_2 a (m,x,l) =
    do {
      coin \<leftarrow> bernoulli_pmf (1/(real m+1));
      return_pmf (m+1,if coin then (a,0) else (x, l + of_bool (x=a)))
    }"

definition sketch where "sketch as i = (as ! i, count_list (drop (i+1) as) (as ! i))"

lemma fk_update_2_distr:
  assumes "as \<noteq> []"
  shows "fold (\<lambda>x s. s \<bind> fk_update_2 x) as (return_pmf (0,0,0)) =
  pmf_of_set {..<length as} \<bind> (\<lambda>k. return_pmf (length as, sketch as k))"
  using assms
proof (induction as rule:rev_nonempty_induct)
  case (single x)
  show ?case using single
    by (simp add:bind_return_pmf pmf_of_set_singleton bernoulli_pmf_1 lessThan_def sketch_def)
next
  case (snoc x xs)
  let ?h = "(\<lambda>xs k. count_list (drop (Suc k) xs) (xs ! k))"
  let ?q = "(\<lambda>xs k. (length xs, sketch xs k))"

  have non_empty: " {..<Suc (length xs)} \<noteq> {}" " {..<length xs} \<noteq> {}" using snoc by auto

  have fk_update_2_eta:"fk_update_2 x = (\<lambda>a. fk_update_2 x (fst a, fst (snd a), snd (snd a)))"
    by auto

  have "pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
    (\<lambda>coin. return_pmf (if coin then length xs else k))) =
    bernoulli_pmf (1 / (real (length xs) + 1)) \<bind> (\<lambda>y. pmf_of_set {..<length xs} \<bind>
      (\<lambda>k. return_pmf (if y then length xs else k)))"
    by (subst bind_commute_pmf, simp)
  also have "... = pmf_of_set {..<length xs + 1}"
    using snoc(1) non_empty
    by (intro pmf_eqI, simp add: pmf_bind measure_pmf_of_set)
     (simp add:indicator_def algebra_simps frac_eq_eq)
  finally have b: "pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
    (\<lambda>coin. return_pmf (if coin then length xs else k))) = pmf_of_set {..<length xs +1}" by simp

  have "fold (\<lambda>x s. (s \<bind> fk_update_2 x)) (xs@[x]) (return_pmf (0,0,0)) =
    (pmf_of_set {..<length xs} \<bind> (\<lambda>k. return_pmf (length xs, sketch xs k))) \<bind> fk_update_2 x"
    using snoc by (simp add:case_prod_beta')
  also have "... = (pmf_of_set {..<length xs} \<bind> (\<lambda>k. return_pmf (length xs, sketch xs k))) \<bind>
    (\<lambda>(m,a,l). bernoulli_pmf (1 / (real m + 1)) \<bind> (\<lambda>coin.
    return_pmf (m + 1, if coin then (x, 0) else (a, (l + of_bool (a = x))))))"
    by (subst fk_update_2_eta, subst fk_update_2.simps, simp add:case_prod_beta')
  also have "... = pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
    (\<lambda>coin. return_pmf (length xs + 1, if coin then (x, 0) else (xs ! k, ?h xs k + of_bool (xs ! k = x)))))"
    by (subst bind_assoc_pmf, simp add: bind_return_pmf sketch_def)
  also have "... = pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
    (\<lambda>coin. return_pmf (if coin then length xs else k) \<bind> (\<lambda>k'. return_pmf (?q (xs@[x]) k'))))"
    using non_empty
    by (intro bind_pmf_cong, auto simp add:bind_return_pmf nth_append count_list_append sketch_def)
  also have "... = pmf_of_set {..<length xs} \<bind> (\<lambda>k. bernoulli_pmf (1 / (real (length xs) + 1)) \<bind>
    (\<lambda>coin. return_pmf (if coin then length xs else k))) \<bind> (\<lambda>k'. return_pmf (?q (xs@[x]) k'))"
    by (subst bind_assoc_pmf, subst bind_assoc_pmf, simp)
  also have "... = pmf_of_set {..<length (xs@[x])} \<bind> (\<lambda>k'. return_pmf (?q (xs@[x]) k'))"
    by (subst b, simp)
  finally show ?case by simp
qed

context
  fixes \<epsilon> \<delta> :: rat
  fixes n k :: nat
  fixes as
  assumes k_ge_1: "k \<ge> 1"
  assumes \<epsilon>_range: "\<epsilon> \<in> {0<..<1}"
  assumes \<delta>_range: "\<delta> > 0"
  assumes as_range: "set as \<subseteq> {..<n}"
begin

definition s\<^sub>1 where "s\<^sub>1 = nat \<lceil>3 * real k * (real n) powr (1-1/real k) / (real_of_rat \<delta>)\<^sup>2\<rceil>"
definition s\<^sub>2 where "s\<^sub>2 = nat \<lceil>-(18 * ln (real_of_rat \<epsilon>))\<rceil>"

definition "M\<^sub>1 = {(u, v). v < count_list as u}"
definition "\<Omega>\<^sub>1 = measure_pmf (pmf_of_set M\<^sub>1)"

definition "M\<^sub>2 = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set M\<^sub>1)"
definition "\<Omega>\<^sub>2 = measure_pmf M\<^sub>2"

interpretation prob_space "\<Omega>\<^sub>1"
  unfolding \<Omega>\<^sub>1_def by (simp add:prob_space_measure_pmf)

interpretation \<Omega>\<^sub>2:prob_space "\<Omega>\<^sub>2"
  unfolding \<Omega>\<^sub>2_def by (simp add:prob_space_measure_pmf)

lemma split_space: "(\<Sum>a\<in>M\<^sub>1. f (snd a)) = (\<Sum>u \<in> set as. (\<Sum>v \<in>{0..<count_list as u}. f v))"
proof -
  define A where "A = (\<lambda>u. {u} \<times> {v. v < count_list as u})"

  have a: "inj_on snd (A x)" for x
    by (simp add:A_def inj_on_def)

  have "\<And>u v. u < count_list as v \<Longrightarrow> v \<in> set as"
    by (subst count_list_gr_1, force)
  hence "M\<^sub>1 = \<Union> (A ` set as)"
    by (auto simp add:set_eq_iff A_def M\<^sub>1_def)
  hence "(\<Sum>a\<in>M\<^sub>1. f (snd a)) = sum (f \<circ> snd)  (\<Union> (A ` set as))"
    by (intro sum.cong, auto)
  also have "... = sum (\<lambda>x. sum (f \<circ> snd) (A x)) (set as)"
    by (rule sum.UNION_disjoint, simp, simp add:A_def, simp add:A_def, blast)
  also have "... = sum (\<lambda>x. sum f (snd ` A x)) (set as)"
    by (intro sum.cong, auto simp add:sum.reindex[OF a])
  also have "... = (\<Sum>u \<in> set as. (\<Sum>v \<in>{0..<count_list as u}. f v))"
    unfolding A_def by (intro sum.cong, auto)
  finally show ?thesis by blast
qed

lemma
  assumes "as \<noteq> []"
  shows fin_space: "finite M\<^sub>1"
    and non_empty_space: "M\<^sub>1 \<noteq> {}"
    and card_space: "card M\<^sub>1 = length as"
proof -
  have "M\<^sub>1 \<subseteq> set as \<times> {k. k < length as}"
  proof (rule subsetI)
    fix x
    assume a:"x \<in> M\<^sub>1"
    have "fst x \<in> set as"
      using a by (simp add:case_prod_beta count_list_gr_1 M\<^sub>1_def)
    moreover have "snd x < length as"
      using a count_le_length order_less_le_trans
      by (simp add:case_prod_beta M\<^sub>1_def) fast
    ultimately show "x \<in> set as \<times> {k. k < length as}"
      by (simp add:mem_Times_iff)
  qed
  thus fin_space: "finite M\<^sub>1"
    using finite_subset by blast

  have "(as ! 0, 0) \<in> M\<^sub>1"
    using assms(1) unfolding M\<^sub>1_def
    by (simp, metis count_list_gr_1 gr0I length_greater_0_conv not_one_le_zero nth_mem)
  thus "M\<^sub>1 \<noteq> {}" by blast

  show "card M\<^sub>1 = length as"
    using fin_space split_space[where f="\<lambda>_. (1::nat)"]
    by (simp add:sum_count_set[where X="set as" and xs="as", simplified])
qed

lemma
  assumes "as \<noteq> []"
  shows integrable_1: "integrable \<Omega>\<^sub>1 (f :: _ \<Rightarrow> real)" and
    integrable_2: "integrable \<Omega>\<^sub>2 (g :: _ \<Rightarrow> real)"
proof -
  have fin_omega: "finite (set_pmf (pmf_of_set M\<^sub>1))"
    using fin_space[OF assms] non_empty_space[OF assms] by auto
  thus "integrable \<Omega>\<^sub>1 f"
    unfolding \<Omega>\<^sub>1_def
    by (rule integrable_measure_pmf_finite)

  have "finite (set_pmf M\<^sub>2)"
    unfolding M\<^sub>2_def using fin_omega
    by (subst set_prod_pmf) (auto intro:finite_PiE)

  thus "integrable \<Omega>\<^sub>2 g"
    unfolding \<Omega>\<^sub>2_def by (intro integrable_measure_pmf_finite)
qed

lemma sketch_distr:
  assumes "as \<noteq> []"
  shows "pmf_of_set {..<length as} \<bind> (\<lambda>k. return_pmf (sketch as k)) = pmf_of_set M\<^sub>1"
proof -
  have "x < y \<Longrightarrow> y < length as \<Longrightarrow>
    count_list (drop (y+1) as) (as ! y) < count_list (drop (x+1) as) (as ! y)" for x y
    by (intro count_list_lt_suffix suffix_drop_drop, simp_all)
     (metis Suc_diff_Suc diff_Suc_Suc diff_add_inverse lessI less_natE)
  hence a1: "inj_on (sketch as) {k. k < length as}"
    unfolding sketch_def by (intro inj_onI) (metis Pair_inject mem_Collect_eq nat_neq_iff)

  have "x < length as \<Longrightarrow> count_list (drop (x+1) as) (as ! x) < count_list as (as ! x)" for x
    by (rule count_list_lt_suffix, auto simp add:suffix_drop)
  hence "sketch as ` {k. k < length as} \<subseteq> M\<^sub>1"
    by (intro image_subsetI, simp add:sketch_def M\<^sub>1_def)
  moreover have "card M\<^sub>1 \<le> card (sketch as ` {k. k < length as})"
    by (simp add: card_space[OF assms(1)] card_image[OF a1])
  ultimately have "sketch as ` {k. k < length as} = M\<^sub>1"
    using fin_space[OF assms(1)] by (intro card_seteq, simp_all)
  hence "bij_betw (sketch as) {k. k < length as} M\<^sub>1"
    using a1 by (simp add:bij_betw_def)
  hence "map_pmf (sketch as) (pmf_of_set {k. k < length as}) = pmf_of_set M\<^sub>1"
    using assms by (intro map_pmf_of_set_bij_betw, auto)
  thus ?thesis by (simp add: sketch_def map_pmf_def lessThan_def)
qed

lemma fk_update_distr:
  "fold (\<lambda>x s. s \<bind> fk_update x) as (fk_init k \<delta> \<epsilon> n) =
  prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. fold (\<lambda>x s. s \<bind> fk_update_2 x) as (return_pmf (0,0,0)))
    \<bind> (\<lambda>x. return_pmf (s\<^sub>1,s\<^sub>2,k, length as, \<lambda>i\<in>{0..<s\<^sub>1}\<times>{0..<s\<^sub>2}. snd (x i)))"
proof (induction as rule:rev_induct)
  case Nil
  then show ?case
    by (auto simp:Let_def s\<^sub>1_def[symmetric] s\<^sub>2_def[symmetric] bind_return_pmf)
next
  case (snoc x xs)

  have fk_update_2_eta:"fk_update_2 x = (\<lambda>a. fk_update_2 x (fst a, fst (snd a), snd (snd a)))"
    by auto

  have a: "fk_update x (s\<^sub>1, s\<^sub>2, k, length xs, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (f i)) =
    prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>i. fk_update_2 x (f i)) \<bind>
    (\<lambda>a. return_pmf (s\<^sub>1,s\<^sub>2, k, Suc (length xs), \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (a i)))"
    if b: "f \<in> set_pmf (prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
                  (\<lambda>_. fold (\<lambda>a s. s \<bind> fk_update_2 a) xs (return_pmf (0, 0, 0))))" for f
  proof -
    have c:"fst (f i) = length xs" if d:"i \<in> {0..<s\<^sub>1} \<times>{0..<s\<^sub>2}" for i
    proof (cases "xs = []")
      case True
      then show ?thesis using b d by (simp add: set_Pi_pmf)
    next
      case False
      hence "{..<length xs} \<noteq> {}" by force
      thus ?thesis using b d
        by (simp add:set_Pi_pmf fk_update_2_distr[OF False] PiE_dflt_def) force
    qed
    show ?thesis
      apply (subst fk_update_2_eta, subst fk_update_2.simps, simp)
      apply (simp add: Pi_pmf_bind_return[where d'="undefined"] bind_assoc_pmf)
      apply (rule bind_pmf_cong, simp add:c cong:Pi_pmf_cong)
      by (auto simp add:bind_return_pmf case_prod_beta)
  qed

  have "fold (\<lambda>x s. s \<bind> fk_update x) (xs @ [x]) (fk_init k \<delta> \<epsilon> n) =
     prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. fold (\<lambda>x s. s \<bind> fk_update_2 x) xs (return_pmf (0,0,0)))
    \<bind> (\<lambda>\<omega>. return_pmf (s\<^sub>1,s\<^sub>2,k, length xs, \<lambda>i\<in>{0..<s\<^sub>1}\<times>{0..<s\<^sub>2}. snd (\<omega> i)) \<bind> fk_update x)"
    using snoc
    by (simp add:restrict_def bind_assoc_pmf del:fk_init.simps)
  also have "... =  prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
    (\<lambda>_. fold (\<lambda>a s. s \<bind> fk_update_2 a) xs (return_pmf (0, 0, 0))) \<bind>
    (\<lambda>f. prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>i. fk_update_2 x (f i)) \<bind>
    (\<lambda>a. return_pmf (s\<^sub>1, s\<^sub>2, k, Suc (length xs), \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (a i))))"
    using a
    by (intro bind_pmf_cong, simp_all add:bind_return_pmf del:fk_update.simps)
  also have "... =  prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
    (\<lambda>_. fold (\<lambda>a s. s \<bind> fk_update_2 a) xs (return_pmf (0, 0, 0))) \<bind>
    (\<lambda>f. prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>i. fk_update_2 x (f i))) \<bind>
    (\<lambda>a. return_pmf (s\<^sub>1, s\<^sub>2, k, Suc (length xs), \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (a i)))"
    by (simp add:bind_assoc_pmf)
  also have "... = (prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
    (\<lambda>_. fold (\<lambda>a s. s \<bind> fk_update_2 a) (xs@[x]) (return_pmf (0,0,0)))
    \<bind> (\<lambda>a. return_pmf (s\<^sub>1,s\<^sub>2,k, length (xs@[x]), \<lambda>i\<in>{0..<s\<^sub>1}\<times>{0..<s\<^sub>2}. snd (a i))))"
    by (simp, subst Pi_pmf_bind, auto)

  finally show ?case by blast
qed

lemma power_diff_sum:
  fixes a b :: "'a :: {comm_ring_1,power}"
  assumes "k > 0"
  shows "a^k - b^k = (a-b) * (\<Sum>i = 0..<k. a ^ i * b ^ (k - 1 - i))" (is "?lhs = ?rhs")
proof -
  have insert_lb: "m < n \<Longrightarrow> insert m {Suc m..<n} = {m..<n}" for m n :: nat
    by auto

  have "?rhs = sum (\<lambda>i. a * (a^i * b^(k-1-i))) {0..<k} -
    sum (\<lambda>i. b * (a^i * b^(k-1-i))) {0..<k}"
    by (simp add: sum_distrib_left[symmetric] algebra_simps)
  also have "... = sum ((\<lambda>i. (a^i * b^(k-i))) \<circ> (\<lambda>i. i+1)) {0..<k} -
    sum (\<lambda>i. (a^i * (b^(1+(k-1-i))))) {0..<k}"
    by (simp add:algebra_simps)
  also have "... = sum ((\<lambda>i. (a^i * b^(k-i))) \<circ> (\<lambda>i. i+1)) {0..<k} -
    sum (\<lambda>i. (a^i * b^(k-i))) {0..<k}"
    by (intro arg_cong2[where f="(-)"] sum.cong arg_cong2[where f="(*)"]
        arg_cong2[where f="(\<lambda>x y. x ^ y)"]) auto
  also have "... = sum (\<lambda>i. (a^i * b^(k-i))) (insert k {1..<k}) -
    sum (\<lambda>i. (a^i * b^(k-i))) (insert 0 {Suc 0..<k})"
    using assms
    by (subst sum.reindex[symmetric], simp, subst insert_lb, auto)
  also have "... = ?lhs"
    by simp
  finally show ?thesis by presburger
qed

lemma power_diff_est:
  assumes "k > 0"
  assumes "(a :: real) \<ge> b"
  assumes "b \<ge> 0"
  shows "a^k -b^k \<le> (a-b) * k * a^(k-1)"
proof -
  have " \<And>i. i < k \<Longrightarrow> a ^ i * b ^ (k - 1 - i) \<le> a ^ i * a ^ (k-1-i)"
    using assms by (intro mult_left_mono power_mono) auto
  also have "\<And>i. i < k \<Longrightarrow> a ^ i * a ^ (k - 1 - i) = a ^ (k - Suc 0)"
    using assms(1) by (subst power_add[symmetric], simp)
  finally have a: "\<And>i. i < k \<Longrightarrow> a ^ i * b ^ (k - 1 - i) \<le> a ^ (k - Suc 0)"
    by blast
  have "a^k - b^k = (a-b) * (\<Sum>i = 0..<k. a ^ i * b ^ (k - 1 - i))"
    by (rule power_diff_sum[OF assms(1)])
  also have "... \<le> (a-b) * (\<Sum>i = 0..<k.  a^(k-1))"
    using a assms by (intro mult_left_mono sum_mono, auto)
  also have "... = (a-b) * (k * a^(k-Suc 0))"
    by simp
  finally show ?thesis by simp
qed

text \<open>Specialization of the Hoelder inquality for sums.\<close>
lemma Holder_inequality_sum:
  assumes "p > (0::real)" "q > 0" "1/p + 1/q = 1"
  assumes "finite A"
  shows "\<bar>\<Sum>x\<in>A. f x * g x\<bar> \<le> (\<Sum>x\<in>A. \<bar>f x\<bar> powr p) powr (1/p) * (\<Sum>x\<in>A. \<bar>g x\<bar> powr q) powr (1/q)"
proof -
  have "\<bar>LINT x|count_space A. f x * g x\<bar> \<le>
    (LINT x|count_space A. \<bar>f x\<bar> powr p) powr (1 / p) *
    (LINT x|count_space A. \<bar>g x\<bar> powr q) powr (1 / q)"
    using assms integrable_count_space
    by (intro Lp.Holder_inequality, auto)
  thus ?thesis
    using assms by (simp add: lebesgue_integral_count_space_finite[symmetric])
qed

lemma real_count_list_pos:
  assumes "x \<in> set as"
  shows "real (count_list as x) > 0"
  using count_list_gr_1 assms by force

lemma fk_estimate:
  assumes "as \<noteq> []"
  shows "length as * of_rat (F (2*k-1) as) \<le> n powr (1 - 1 / real k) * (of_rat (F k as))^2"
  (is "?lhs \<le> ?rhs")
proof (cases "k \<ge> 2")
  case True
  define M where "M = Max (count_list as ` set as)"
  have "M \<in> count_list as ` set as"
    unfolding M_def using assms by (intro Max_in, auto)
  then obtain m where m_in: "m \<in> set as" and m_def: "M = count_list as m"
    by blast

  have a: "real M > 0" using m_in count_list_gr_1 by (simp add:m_def, force)
  have b: "2*k-1 = (k-1) + k" by simp

  have " 0 < real (count_list as m)"
    using m_in count_list_gr_1 by force
  hence "M powr k = real (count_list as m) ^ k"
    by (simp add: powr_realpow m_def)
  also have "... \<le> (\<Sum>x\<in>set as. real (count_list as x) ^ k)"
    using m_in by (intro member_le_sum, simp_all)
  also have "... \<le> real_of_rat (F k as)"
    by (simp add:F_def of_rat_sum of_rat_power)
  finally have d: "M powr k \<le> real_of_rat (F k as)" by simp

  have e: "0 \<le> real_of_rat (F k as)"
    using F_gr_0[OF assms(1)] by (simp add: order_le_less)

  have "real (k - 1) / real k + 1 = real (k - 1) / real k + real k / real k"
    using assms True by simp
  also have "... =  real (2 * k - 1) / real k"
    using b by (subst add_divide_distrib[symmetric], force)
  finally have f: "real (k - 1) / real k + 1 = real (2 * k - 1) / real k"
    by blast

  have "real_of_rat (F (2*k-1) as) =
    (\<Sum>x\<in>set as. real (count_list as x) ^ (k - 1) * real (count_list as x) ^ k)"
    using b by (simp add:F_def of_rat_sum sum_distrib_left of_rat_mult power_add of_rat_power)
  also have "... \<le> (\<Sum>x\<in>set as. real M ^ (k - 1) * real (count_list as x) ^ k)"
    by (intro sum_mono mult_right_mono power_mono of_nat_mono) (auto simp:M_def)
  also have "... = M powr (k-1) * of_rat (F k as)" using a
    by (simp add:sum_distrib_left F_def of_rat_mult of_rat_sum of_rat_power powr_realpow)
  also have "... = (M powr k) powr (real (k - 1) / real k) * of_rat (F k as) powr 1"
    using e by (simp add:powr_powr)
  also have "... \<le>  (real_of_rat (F k as)) powr ((k-1)/k) * (real_of_rat (F k as) powr 1)"
    using d by (intro mult_right_mono powr_mono2, auto)
  also have "... = (real_of_rat (F k as)) powr ((2*k-1) / k)"
    by (subst powr_add[symmetric], subst f, simp)
  finally have a: "real_of_rat (F (2*k-1) as) \<le> (real_of_rat (F k as)) powr ((2*k-1) / k)"
    by blast

  have g: "card (set as) \<le> n"
    using card_mono[OF _ as_range] by simp

  have "length as = abs (sum (\<lambda>x. real (count_list as x)) (set as))"
    by (subst of_nat_sum[symmetric], simp add: sum_count_set)
  also have "... \<le> card (set as) powr ((k-Suc 0)/k) *
    (sum (\<lambda>x. \<bar>real (count_list as x)\<bar> powr k) (set as)) powr (1/k)"
    using assms True
    by (intro Holder_inequality_sum[where p="k/(k-1)" and q="k" and f="\<lambda>_.1", simplified])
     (auto simp add:algebra_simps add_divide_distrib[symmetric])
  also have "... = (card (set as)) powr ((k-1) / real k) * of_rat (F k as) powr (1/ k)"
    using real_count_list_pos
    by (simp add:F_def of_rat_sum of_rat_power powr_realpow)
  also have "... = (card (set as)) powr (1 - 1 / real k) * of_rat (F k as) powr (1/ k)"
    using k_ge_1
    by (subst of_nat_diff[OF k_ge_1], subst diff_divide_distrib, simp)
  also have "... \<le> n powr (1 - 1 / real k) * of_rat (F k as) powr (1/ k)"
    using k_ge_1 g
    by (intro mult_right_mono powr_mono2, auto)
  finally have h: "length as \<le> n powr (1 - 1 / real k) * of_rat (F k as) powr (1/real k)"
    by blast

  have i:"1 / real k + real (2 * k - 1) / real k = real 2"
    using True by (subst add_divide_distrib[symmetric], simp_all add:of_nat_diff)

  have "?lhs \<le> n powr (1 - 1/k) * of_rat (F k as) powr (1/k) * (of_rat (F k as)) powr ((2*k-1) / k)"
    using a h F_ge_0 by (intro mult_mono mult_nonneg_nonneg, auto)
  also have "... = ?rhs"
    using i F_gr_0[OF assms] by (simp add:powr_add[symmetric] powr_realpow[symmetric])
  finally show ?thesis
    by blast
next
  case False
  have "n = 0 \<Longrightarrow> False"
    using as_range assms by auto
  hence "n > 0"
    by auto
  moreover have "k = 1"
    using assms k_ge_1 False by linarith
  moreover have "length as = real_of_rat (F (Suc 0) as)"
    by (simp add:F_def sum_count_set of_nat_sum[symmetric] del:of_nat_sum)
  ultimately show ?thesis
    by (simp add:power2_eq_square)
qed

definition result
  where "result a = of_nat (length as) * of_nat (Suc (snd a) ^ k - snd a ^ k)"

lemma result_exp_1:
  assumes "as \<noteq> []"
  shows "expectation result = real_of_rat (F k as)"
proof -
  have "expectation result = (\<Sum>a\<in>M\<^sub>1. result a * pmf (pmf_of_set M\<^sub>1) a)"
    unfolding \<Omega>\<^sub>1_def using non_empty_space assms fin_space
    by (subst integral_measure_pmf_real) auto
  also have "... = (\<Sum>a\<in>M\<^sub>1. result a / real (length as))"
   using non_empty_space assms fin_space card_space by simp
  also have "... = (\<Sum>a\<in>M\<^sub>1. real (Suc (snd a) ^ k - snd a ^ k))"
    using assms by (simp add:result_def)
  also have "... = (\<Sum>u\<in>set as. \<Sum>v = 0..<count_list as u. real (Suc v ^ k) - real (v ^ k))"
    using k_ge_1 by (subst split_space, simp add:of_nat_diff)
  also have "... = (\<Sum>u\<in>set as. real (count_list as u)^k)"
    using k_ge_1 by (subst sum_Suc_diff') (auto simp add:zero_power)
  also have "... = of_rat (F k as)"
    by (simp add:F_def of_rat_sum of_rat_power)
  finally show ?thesis by simp
qed

lemma result_var_1:
  assumes "as \<noteq> []"
  shows "variance result \<le> (of_rat (F k as))\<^sup>2 * k * n powr (1 - 1 / real k)"
proof -
  have k_gt_0: "k > 0" using k_ge_1 by linarith

  have c:"real (Suc v ^ k) - real (v ^ k) \<le> k * real (count_list as a) ^ (k - Suc 0)"
    if c_1: "v < count_list as a" for a v
  proof -
    have "real (Suc v ^ k) - real (v ^ k) \<le> (real (v+1) - real v) * k * (1 + real v) ^ (k - Suc 0)"
      using k_gt_0 power_diff_est[where a="Suc v" and b="v"] by simp
    moreover have "(real (v+1) - real v) = 1" by auto
    ultimately have "real (Suc v ^ k) - real (v ^ k) \<le> k * (1 + real v) ^ (k - Suc 0)"
      by auto
    also have "... \<le> k * real (count_list as a) ^ (k- Suc 0)"
      using c_1 by (intro mult_left_mono power_mono, auto)
    finally show ?thesis by blast
  qed

  have "length as * (\<Sum>a\<in> M\<^sub>1. (real (Suc (snd a)  ^ k - (snd a) ^ k))\<^sup>2) =
    length as * (\<Sum>a\<in> set as. (\<Sum>v \<in> {0..<count_list as a}.
    real (Suc v ^ k - v ^ k) * real (Suc v ^ k - v^k)))"
    by (subst split_space, simp add:power2_eq_square)
  also have "... \<le> length as * (\<Sum>a\<in> set as. (\<Sum>v \<in> {0..<count_list as a}.
    k * real (count_list as a) ^ (k-1) * real (Suc v ^ k - v ^ k)))"
    using c by (intro mult_left_mono sum_mono mult_right_mono) (auto simp:power_mono of_nat_diff)
  also have "... = length as * k * (\<Sum>a\<in> set as. real (count_list as a) ^ (k-1) *
    (\<Sum>v \<in> {0..<count_list as a}. real (Suc v ^ k) - real (v ^ k)))"
    by (simp add:sum_distrib_left ac_simps of_nat_diff power_mono)
  also have "... = length as * k * (\<Sum>a\<in> set as. real (count_list as a ^ (2*k-1)))"
    using assms k_ge_1
    by (subst sum_Suc_diff', auto simp: zero_power[OF k_gt_0] mult_2 power_add[symmetric])
  also have "... = k * (length as * of_rat (F (2*k-1) as))"
    by (simp add:sum_distrib_left[symmetric] F_def of_rat_sum of_rat_power)
  also have "... \<le> k * (of_rat (F k as)^2 * n powr (1 - 1 / real k))"
    using fk_estimate[OF assms] by (intro mult_left_mono) (auto simp: mult.commute)
  finally have b: "real (length as) * (\<Sum>a\<in> M\<^sub>1. (real (Suc (snd a) ^ k - (snd a) ^ k))\<^sup>2) \<le>
    k * ((of_rat (F k as))\<^sup>2 * n powr (1 - 1 / real k))"
    by blast

  have "expectation (\<lambda>\<omega>. (result \<omega> :: real)^2) - (expectation result)^2 \<le> expectation (\<lambda>\<omega>. result \<omega>^2)"
    by simp
  also have "... = (\<Sum>a\<in>M\<^sub>1. (length as * real (Suc (snd a) ^ k - snd a ^ k))\<^sup>2 * pmf (pmf_of_set M\<^sub>1) a)"
    using fin_space non_empty_space assms unfolding \<Omega>\<^sub>1_def result_def
    by (subst integral_measure_pmf_real[where A="M\<^sub>1"], auto)
  also have "... = (\<Sum>a\<in>M\<^sub>1. length as * (real (Suc (snd a) ^ k - snd a ^ k))\<^sup>2)"
    using assms non_empty_space fin_space by (subst pmf_of_set)
     (simp_all add:card_space power_mult_distrib power2_eq_square ac_simps)
  also have "... \<le> k * ((of_rat (F k as))\<^sup>2 * n powr (1 - 1 / real k))"
    using b by (simp add:sum_distrib_left[symmetric])
  also have "... = of_rat (F k as)^2 * k * n powr (1 - 1 / real k)"
    by (simp add:ac_simps)
  finally have "expectation (\<lambda>\<omega>. result \<omega>^2) - (expectation result)^2 \<le>
    of_rat (F k as)^2 * k * n powr (1 - 1 / real k)"
    by blast

  thus ?thesis
    using integrable_1[OF assms] by (simp add:variance_eq)
qed

theorem fk_alg_sketch:
  assumes "as \<noteq> []"
  shows "fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n) =
    map_pmf (\<lambda>x. (s\<^sub>1,s\<^sub>2,k,length as, x)) M\<^sub>2" (is "?lhs = ?rhs")
proof -
  have "?lhs = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})
    (\<lambda>_. fold (\<lambda>x s. s \<bind> fk_update_2 x) as (return_pmf (0, 0, 0))) \<bind>
    (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (x i)))"
    by (subst fk_update_distr, simp)
  also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set {..<length as} \<bind>
    (\<lambda>k. return_pmf (length as, sketch as k))) \<bind>
    (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (x i)))"
    by (subst fk_update_2_distr[OF assms], simp)
  also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set {..<length as} \<bind>
    (\<lambda>k. return_pmf (sketch as k)) \<bind> (\<lambda>s. return_pmf (length as, s))) \<bind>
    (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (x i)))"
    by (subst bind_assoc_pmf, subst bind_return_pmf, simp)
  also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set {..<length as} \<bind>
    (\<lambda>k. return_pmf (sketch as k))) \<bind>
    (\<lambda>x. return_pmf (\<lambda>i \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. (length as, x i))) \<bind>
    (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, \<lambda>i\<in>{0..<s\<^sub>1} \<times> {0..<s\<^sub>2}. snd (x i)))"
    by (subst Pi_pmf_bind_return[where d'="undefined"], simp, simp add:restrict_def)
  also have "... = prod_pmf ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2}) (\<lambda>_. pmf_of_set {..<length as} \<bind>
    (\<lambda>k. return_pmf (sketch as k))) \<bind>
    (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, restrict x ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})))"
    by (subst bind_assoc_pmf, simp add:bind_return_pmf cong:restrict_cong)
  also have "... = M\<^sub>2 \<bind>
    (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, restrict x ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})))"
    by (subst sketch_distr[OF assms], simp add:M\<^sub>2_def)
  also have "... = M\<^sub>2 \<bind> (\<lambda>x. return_pmf (s\<^sub>1, s\<^sub>2, k, length as, x))"
    by (rule bind_pmf_cong, auto simp add:PiE_dflt_def M\<^sub>2_def set_Pi_pmf)
  also have "... = ?rhs"
    by (simp add:map_pmf_def)
  finally show ?thesis by simp
qed

definition mean_rv
  where "mean_rv \<omega> i\<^sub>2 = (\<Sum>i\<^sub>1 = 0..<s\<^sub>1. result (\<omega> (i\<^sub>1, i\<^sub>2))) / of_nat s\<^sub>1"

definition median_rv
    where "median_rv \<omega> = median s\<^sub>2 (\<lambda>i\<^sub>2. mean_rv \<omega> i\<^sub>2)"

lemma fk_alg_correct':
  defines "M \<equiv> fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n) \<bind> fk_result"
  shows "\<P>(\<omega> in measure_pmf M. \<bar>\<omega> - F k as\<bar> \<le> \<delta> * F k as) \<ge> 1 - of_rat \<epsilon>"
proof (cases "as = []")
  case True
  have a: "nat \<lceil>- (18 * ln (real_of_rat \<epsilon>))\<rceil> > 0"  using \<epsilon>_range by simp
  show ?thesis using True \<epsilon>_range
    by (simp add:F_def M_def bind_return_pmf median_const[OF a] Let_def)
next
  case False

  have "set as \<noteq> {}" using assms False by blast
  hence n_nonzero: "n > 0" using as_range by fastforce

  have fk_nonzero: "F k as > 0"
    using F_gr_0[OF False] by simp

  have s1_nonzero: "s\<^sub>1 > 0"
    using \<delta>_range k_ge_1 n_nonzero by (simp add:s\<^sub>1_def)
  have s2_nonzero: "s\<^sub>2 > 0"
    using \<epsilon>_range by (simp add:s\<^sub>2_def)

  have real_of_rat_mean_rv: "\<And>x i. mean_rv x = (\<lambda>i. real_of_rat (mean_rv x i))"
    by (rule ext, simp add:of_rat_divide of_rat_sum of_rat_mult result_def mean_rv_def)
  have real_of_rat_median_rv: "\<And>x. median_rv x = real_of_rat (median_rv x)"
    unfolding median_rv_def using s2_nonzero
    by (subst real_of_rat_mean_rv, simp add: median_rat median_restrict)

  have space_\<Omega>\<^sub>2: "space \<Omega>\<^sub>2 = UNIV" by (simp add:\<Omega>\<^sub>2_def)

  have fk_result_eta: "fk_result = (\<lambda>(x,y,z,u,v). fk_result (x,y,z,u,v))"
    by auto

  have a:"fold (\<lambda>x state. state \<bind> fk_update x) as (fk_init k \<delta> \<epsilon> n) =
    map_pmf (\<lambda>x. (s\<^sub>1,s\<^sub>2,k,length as, x)) M\<^sub>2"
    by (subst fk_alg_sketch[OF False]) (simp add:s\<^sub>1_def[symmetric] s\<^sub>2_def[symmetric])

  have "M =  map_pmf (\<lambda>x. (s\<^sub>1, s\<^sub>2, k, length as, x)) M\<^sub>2 \<bind> fk_result"
    by (subst M_def, subst a, simp)
  also have "... = M\<^sub>2 \<bind> return_pmf \<circ> median_rv"
    by (subst fk_result_eta)
     (auto simp add:map_pmf_def bind_assoc_pmf bind_return_pmf median_rv_def mean_rv_def comp_def
       M\<^sub>1_def result_def median_restrict)
  finally have b: "M = M\<^sub>2 \<bind> return_pmf \<circ> median_rv"
    by simp

  have result_exp:
    "i\<^sub>1 < s\<^sub>1 \<Longrightarrow> i\<^sub>2 < s\<^sub>2 \<Longrightarrow> \<Omega>\<^sub>2.expectation (\<lambda>x. result (x (i\<^sub>1, i\<^sub>2))) = real_of_rat (F k as)"
    for i\<^sub>1 i\<^sub>2
    unfolding \<Omega>\<^sub>2_def M\<^sub>2_def
    using integrable_1[OF False] result_exp_1[OF False]
    by (subst expectation_Pi_pmf_slice, auto simp:\<Omega>\<^sub>1_def)

  have result_var: "\<Omega>\<^sub>2.variance (\<lambda>\<omega>. result (\<omega> (i\<^sub>1, i\<^sub>2))) \<le> of_rat (\<delta> * F k as)^2 * real s\<^sub>1 / 3"
    if result_var_assms: "i\<^sub>1 < s\<^sub>1" "i\<^sub>2 < s\<^sub>2" for i\<^sub>1 i\<^sub>2
  proof -
    have "3 * real k * n powr (1 - 1 / real k) =
      (of_rat \<delta>)\<^sup>2 * (3 * real k * n powr (1 - 1 / real k) / (of_rat \<delta>)\<^sup>2)"
      using \<delta>_range by simp
    also have "... \<le>  (real_of_rat \<delta>)\<^sup>2 * (real s\<^sub>1)"
      unfolding s\<^sub>1_def
      by (intro mult_mono of_nat_ceiling, simp_all)
    finally have f2_var_2: "3 * real k * n powr (1 - 1 / real k) \<le> (of_rat \<delta>)\<^sup>2 * (real s\<^sub>1)"
      by blast

    have "\<Omega>\<^sub>2.variance (\<lambda>\<omega>. result (\<omega> (i\<^sub>1, i\<^sub>2)) :: real)  = variance result"
      using result_var_assms integrable_1[OF False]
      unfolding \<Omega>\<^sub>2_def M\<^sub>2_def \<Omega>\<^sub>1_def
      by (subst variance_prod_pmf_slice, auto)
    also have "... \<le> of_rat (F k as)^2 * real k * n powr (1 - 1 / real k)"
      using assms False result_var_1 \<Omega>\<^sub>1_def by simp
    also have "... =
      of_rat (F k as)^2 * (real k * n powr (1 - 1 / real k))"
      by (simp add:ac_simps)
    also have "... \<le> of_rat (F k as)^2 * (of_rat \<delta>^2 * (real s\<^sub>1 / 3))"
      using f2_var_2 by (intro mult_left_mono, auto)
    also have "... = of_rat (F k as * \<delta>)^2 * (real s\<^sub>1 / 3)"
      by (simp add: of_rat_mult power_mult_distrib)
    also have "... = of_rat (\<delta> * F k as)^2 * real s\<^sub>1 / 3"
      by (simp add:ac_simps)
    finally show ?thesis
      by simp
  qed

  have mean_rv_exp: "\<Omega>\<^sub>2.expectation (\<lambda>\<omega>. mean_rv \<omega> i) = real_of_rat (F k as)"
    if mean_rv_exp_assms: "i < s\<^sub>2" for i
  proof -
    have "\<Omega>\<^sub>2.expectation (\<lambda>\<omega>. mean_rv \<omega> i) = \<Omega>\<^sub>2.expectation (\<lambda>\<omega>. \<Sum>n = 0..<s\<^sub>1. result (\<omega> (n, i)) / real s\<^sub>1)"
      by (simp add:mean_rv_def sum_divide_distrib)
    also have "... = (\<Sum>n = 0..<s\<^sub>1. \<Omega>\<^sub>2.expectation (\<lambda>\<omega>. result (\<omega> (n, i))) / real s\<^sub>1)"
      using integrable_2[OF False]
      by (subst Bochner_Integration.integral_sum, auto)
    also have "... = of_rat (F k as)"
      using s1_nonzero mean_rv_exp_assms
      by (simp add:result_exp)
    finally show ?thesis by simp
  qed

  have mean_rv_var: "\<Omega>\<^sub>2.variance (\<lambda>\<omega>. mean_rv \<omega> i) \<le> real_of_rat (\<delta> * F k as)^2/3"
    if mean_rv_var_assms: "i < s\<^sub>2" for i
  proof -
    have a:"\<Omega>\<^sub>2.indep_vars (\<lambda>_. borel) (\<lambda>n x. result (x (n, i)) / real s\<^sub>1) {0..<s\<^sub>1}"
      unfolding \<Omega>\<^sub>2_def M\<^sub>2_def using mean_rv_var_assms
      by (intro indep_vars_restrict_intro'[where f="fst"], simp, simp add:restrict_dfl_def, simp, simp)
    have "\<Omega>\<^sub>2.variance (\<lambda>\<omega>. mean_rv \<omega> i) = \<Omega>\<^sub>2.variance (\<lambda>\<omega>. \<Sum>j = 0..<s\<^sub>1. result (\<omega> (j, i)) / real s\<^sub>1)"
      by (simp add:mean_rv_def sum_divide_distrib)
    also have "... = (\<Sum>j = 0..<s\<^sub>1. \<Omega>\<^sub>2.variance (\<lambda>\<omega>. result (\<omega> (j, i)) / real s\<^sub>1))"
      using a integrable_2[OF False]
      by (subst \<Omega>\<^sub>2.var_sum_all_indep, auto simp add:\<Omega>\<^sub>2_def)
    also have "... = (\<Sum>j = 0..<s\<^sub>1. \<Omega>\<^sub>2.variance (\<lambda>\<omega>. result (\<omega> (j, i))) / real s\<^sub>1^2)"
      using integrable_2[OF False]
      by (subst \<Omega>\<^sub>2.variance_divide, auto)
    also have "... \<le> (\<Sum>j = 0..<s\<^sub>1. ((real_of_rat (\<delta> * F k as))\<^sup>2 * real s\<^sub>1 / 3) / (real s\<^sub>1^2))"
      using result_var[OF _ mean_rv_var_assms]
      by (intro sum_mono divide_right_mono, auto)
    also have "... = real_of_rat (\<delta> * F k as)^2/3"
      using s1_nonzero
      by (simp add:algebra_simps power2_eq_square)
    finally show ?thesis by simp
  qed

  have "\<Omega>\<^sub>2.prob {y. of_rat (\<delta> * F k as) < \<bar>mean_rv y i - real_of_rat (F k as)\<bar>} \<le> 1/3"
    (is "?lhs \<le> _") if c_assms: "i < s\<^sub>2" for i
  proof -
    define a where "a = real_of_rat (\<delta> * F k as)"
    have c: "0 < a" unfolding  a_def
      using assms \<delta>_range fk_nonzero
      by (metis zero_less_of_rat_iff mult_pos_pos)
    have "?lhs \<le> \<Omega>\<^sub>2.prob {y \<in> space \<Omega>\<^sub>2. a \<le> \<bar>mean_rv y i -  \<Omega>\<^sub>2.expectation (\<lambda>\<omega>. mean_rv \<omega> i)\<bar>}"
      by (intro \<Omega>\<^sub>2.pmf_mono[OF \<Omega>\<^sub>2_def], simp add:a_def mean_rv_exp[OF c_assms] space_\<Omega>\<^sub>2)
    also have "... \<le> \<Omega>\<^sub>2.variance (\<lambda>\<omega>. mean_rv \<omega> i)/a^2"
      by (intro \<Omega>\<^sub>2.Chebyshev_inequality integrable_2 c False)  (simp add:\<Omega>\<^sub>2_def)
    also have "... \<le> 1/3" using c
      using mean_rv_var[OF c_assms]
      by (simp add:algebra_simps, simp add:a_def)
    finally show ?thesis
      by blast
  qed

  moreover have "\<Omega>\<^sub>2.indep_vars (\<lambda>_. borel) (\<lambda>i \<omega>. mean_rv \<omega> i) {0..<s\<^sub>2}"
    using s1_nonzero unfolding \<Omega>\<^sub>2_def M\<^sub>2_def
    by (intro indep_vars_restrict_intro'[where f="snd"] finite_cartesian_product)
     (simp_all add:mean_rv_def restrict_dfl_def space_\<Omega>\<^sub>2)
  moreover have " - (18 * ln (real_of_rat \<epsilon>)) \<le> real s\<^sub>2"
    by (simp add:s\<^sub>2_def, linarith)
  ultimately have "1 - of_rat \<epsilon> \<le>
    \<Omega>\<^sub>2.prob {y \<in> space \<Omega>\<^sub>2. \<bar>median s\<^sub>2 (mean_rv y) - real_of_rat (F k as)\<bar> \<le> of_rat (\<delta> * F k as)}"
    using \<epsilon>_range
    by (intro \<Omega>\<^sub>2.median_bound_2, simp_all add:space_\<Omega>\<^sub>2)
  also have "... = \<Omega>\<^sub>2.prob {y. \<bar>median_rv y - real_of_rat (F k as)\<bar> \<le> real_of_rat (\<delta> * F k as)}"
    by (simp add:median_rv_def space_\<Omega>\<^sub>2)
  also have "... =  \<Omega>\<^sub>2.prob {y. \<bar>median_rv y - F k as\<bar> \<le> \<delta> * F k as}"
    by (simp add:real_of_rat_median_rv of_rat_less_eq flip: of_rat_diff)
  also have "... = \<P>(\<omega> in measure_pmf M. \<bar>\<omega> - F k as\<bar> \<le> \<delta> * F k as)"
    by (simp add: b comp_def map_pmf_def[symmetric] \<Omega>\<^sub>2_def)
  finally show ?thesis by simp
qed

lemma fk_exact_space_usage':
  defines "M \<equiv> fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n)"
  shows "AE \<omega> in M. bit_count (encode_fk_state \<omega>) \<le> fk_space_usage (k, n, length as, \<epsilon>, \<delta>)"
    (is "AE \<omega> in M. (_  \<le> ?rhs)")
proof -
  define H where "H = (if as = [] then return_pmf (\<lambda>i\<in> {0..<s\<^sub>1}\<times>{0..<s\<^sub>2}. (0,0)) else M\<^sub>2)"

  have a:"M = map_pmf (\<lambda>x.(s\<^sub>1,s\<^sub>2,k,length as, x)) H"
  proof (cases "as \<noteq> []")
    case True
    then show ?thesis
      unfolding M_def fk_alg_sketch[OF True] H_def
      by (simp add:M\<^sub>2_def)
  next
    case False
    then show ?thesis
      by (simp add:H_def M_def s\<^sub>1_def[symmetric] Let_def s\<^sub>2_def[symmetric] map_pmf_def bind_return_pmf)
  qed

  have "bit_count (encode_fk_state (s\<^sub>1, s\<^sub>2, k, length as, y)) \<le> ?rhs"
    if b:"y \<in> set_pmf H" for y
  proof -
    have b0:" as \<noteq> [] \<Longrightarrow> y \<in> {0..<s\<^sub>1} \<times> {0..<s\<^sub>2} \<rightarrow>\<^sub>E M\<^sub>1"
      using b non_empty_space fin_space by (simp add:H_def M\<^sub>2_def set_prod_pmf)

    have "bit_count ((N\<^sub>e \<times>\<^sub>e N\<^sub>e) (y x)) \<le>
      ereal (2 * log 2 (real n + 1) + 1) + ereal (2 * log 2 (real (length as) + 1) + 1)"
      (is "_ \<le> ?rhs1")
      if b1_assms: "x \<in> {0..<s\<^sub>1}\<times>{0..<s\<^sub>2}" for x
    proof -
      have "fst (y x) \<le> n"
      proof (cases "as = []")
        case True
        then show ?thesis using b b1_assms by (simp add:H_def)
      next
        case False
        hence "1 \<le> count_list as (fst (y x))"
          using b0 b1_assms by (simp add:PiE_iff case_prod_beta M\<^sub>1_def, fastforce)
        hence "fst (y x) \<in> set as"
          using count_list_gr_1 by metis
        then show ?thesis
          by (meson lessThan_iff less_imp_le_nat subsetD as_range)
      qed
      moreover have "snd (y x) \<le> length as"
      proof (cases "as = []")
        case True
        then show ?thesis using b b1_assms by (simp add:H_def)
      next
        case False
        hence "(y x) \<in> M\<^sub>1"
          using b0 b1_assms by auto
        hence "snd (y x) \<le> count_list as (fst (y x))"
          by (simp add:M\<^sub>1_def case_prod_beta)
        then show ?thesis using count_le_length by (metis order_trans)
      qed
      ultimately have "bit_count (N\<^sub>e (fst (y x))) + bit_count (N\<^sub>e (snd (y x))) \<le> ?rhs1"
        using exp_golomb_bit_count_est  by (intro add_mono, auto)
      thus ?thesis
        by (subst dependent_bit_count_2, simp)
    qed

    moreover have "y \<in> extensional ({0..<s\<^sub>1} \<times> {0..<s\<^sub>2})"
      using b0 b PiE_iff by (cases "as = []", auto simp:H_def PiE_iff)

    ultimately have "bit_count ((List.product [0..<s\<^sub>1] [0..<s\<^sub>2] \<rightarrow>\<^sub>e N\<^sub>e \<times>\<^sub>e N\<^sub>e) y) \<le>
      ereal (real s\<^sub>1 * real s\<^sub>2) * (ereal (2 * log 2 (real n + 1) + 1) +
      ereal (2 * log 2 (real (length as) + 1) + 1))"
      by (intro fun_bit_count_est[where xs="(List.product [0..<s\<^sub>1] [0..<s\<^sub>2])", simplified], auto)
    hence "bit_count (encode_fk_state (s\<^sub>1, s\<^sub>2, k, length as, y)) \<le>
       ereal (2 * log 2 (real s\<^sub>1 + 1) + 1) +
      (ereal (2 * log 2 (real s\<^sub>2 + 1) + 1) +
      (ereal (2 * log 2 (real k + 1) + 1) +
      (ereal (2 * log 2 (real (length as) + 1) + 1) +
      (ereal (real s\<^sub>1 * real s\<^sub>2) * (ereal (2 * log 2 (real n+1) + 1) +
       ereal (2 * log 2 (real (length as)+1) + 1))))))"
      unfolding encode_fk_state_def dependent_bit_count
      by (intro add_mono exp_golomb_bit_count, auto)
    also have "... \<le> ?rhs"
      by (simp add: s\<^sub>1_def[symmetric] s\<^sub>2_def[symmetric] Let_def) (simp add:ac_simps)
    finally show "bit_count (encode_fk_state (s\<^sub>1, s\<^sub>2, k, length as, y)) \<le> ?rhs"
      by blast
  qed
  thus ?thesis
    by (simp add: a AE_measure_pmf_iff del:fk_space_usage.simps)
qed

end

text \<open>Main results of this section:\<close>

theorem fk_alg_correct:
  assumes "k \<ge> 1"
  assumes "\<epsilon> \<in> {0<..<1}"
  assumes "\<delta> > 0"
  assumes "set as \<subseteq> {..<n}"
  defines "M \<equiv> fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n) \<bind> fk_result"
  shows "\<P>(\<omega> in measure_pmf M. \<bar>\<omega> - F k as\<bar> \<le> \<delta> * F k as) \<ge> 1 - of_rat \<epsilon>"
  unfolding M_def using fk_alg_correct'[OF assms(1-4)] by blast

theorem fk_exact_space_usage:
  assumes "k \<ge> 1"
  assumes "\<epsilon> \<in> {0<..<1}"
  assumes "\<delta> > 0"
  assumes "set as \<subseteq> {..<n}"
  defines "M \<equiv> fold (\<lambda>a state. state \<bind> fk_update a) as (fk_init k \<delta> \<epsilon> n)"
  shows "AE \<omega> in M. bit_count (encode_fk_state \<omega>) \<le> fk_space_usage (k, n, length as, \<epsilon>, \<delta>)"
  unfolding M_def using fk_exact_space_usage'[OF assms(1-4)] by blast

theorem fk_asymptotic_space_complexity:
  "fk_space_usage \<in>
  O[at_top \<times>\<^sub>F at_top \<times>\<^sub>F at_top \<times>\<^sub>F at_right (0::rat) \<times>\<^sub>F at_right (0::rat)](\<lambda> (k, n, m, \<epsilon>, \<delta>).
  real k * real n powr (1-1/ real k) / (of_rat \<delta>)\<^sup>2 * (ln (1 / of_rat \<epsilon>)) * (ln (real n) + ln (real m)))"
  (is "_ \<in> O[?F](?rhs)")
proof -
  define k_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> nat" where "k_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). k)"
  define n_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> nat" where "n_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). n)"
  define m_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> nat" where "m_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). m)"
  define \<epsilon>_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<epsilon>_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). \<epsilon>)"
  define \<delta>_of :: "nat \<times> nat \<times> nat \<times> rat \<times> rat \<Rightarrow> rat" where "\<delta>_of = (\<lambda>(k, n, m, \<epsilon>, \<delta>). \<delta>)"

  define g1 where
    "g1 = (\<lambda>x. real (k_of x)*(real (n_of x)) powr (1-1/ real (k_of x)) * (1 / of_rat (\<delta>_of x)^2))"

  define g where
    "g = (\<lambda>x. g1 x * (ln (1 / of_rat (\<epsilon>_of x))) * (ln (real (n_of x)) + ln (real (m_of x))))"

  define s1_of where "s1_of = (\<lambda>x.
    nat \<lceil>3 * real (k_of x) * real (n_of x) powr (1 - 1 / real (k_of x)) / (real_of_rat (\<delta>_of x))\<^sup>2\<rceil>)"
  define s2_of where "s2_of = (\<lambda>x. nat \<lceil>- (18 * ln (real_of_rat (\<epsilon>_of x)))\<rceil>)"

  have evt: "(\<And>x.
    0 < real_of_rat (\<delta>_of x) \<and> 0 < real_of_rat (\<epsilon>_of x) \<and>
    1/real_of_rat (\<delta>_of x) \<ge> \<delta> \<and> 1/real_of_rat (\<epsilon>_of x) \<ge> \<epsilon> \<and>
    real (n_of x) \<ge> n \<and> real (k_of x) \<ge> k \<and> real (m_of x) \<ge> m\<Longrightarrow> P x)
    \<Longrightarrow> eventually P ?F"  (is "(\<And>x. ?prem x \<Longrightarrow> _) \<Longrightarrow> _")
    for \<delta> \<epsilon> n k m P
    apply (rule eventually_mono[where P="?prem" and Q="P"])
    apply (simp add:\<epsilon>_of_def case_prod_beta' \<delta>_of_def n_of_def k_of_def m_of_def)
     apply (intro eventually_conj eventually_prod1' eventually_prod2'
        sequentially_inf eventually_at_right_less inv_at_right_0_inf)
    by (auto simp add:prod_filter_eq_bot)

  have 1:
    "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (n_of x))"
    "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (m_of x))"
    "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (k_of x))"
    by (intro landau_o.big_mono eventually_mono[OF evt], auto)+

  have "(\<lambda>x. ln (real (m_of x) + 1)) \<in> O[?F](\<lambda>x. ln (real (m_of x)))"
    by (intro landau_ln_2[where a="2"] evt[where m="2"] sum_in_bigo 1, auto)
  hence 2: " (\<lambda>x. log 2 (real (m_of x) + 1)) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
    by (intro landau_sum_2  eventually_mono[OF evt[where n="1" and m="1"]])
     (auto simp add:log_def)

  have 3: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
    using order_less_le_trans[OF exp_gt_zero] ln_ge_iff
    by (intro landau_o.big_mono  evt[where \<epsilon>="exp 1"])
     (simp add: abs_ge_iff, blast)

  have 4: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. 1 / (real_of_rat (\<delta>_of x))\<^sup>2)"
    using one_le_power
    by (intro landau_o.big_mono evt[where \<delta>="1"])
     (simp add:power_one_over[symmetric], blast)

  have "(\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
    using order_less_le_trans[OF exp_gt_zero] ln_ge_iff
    by (intro landau_o.big_mono  evt[where n="exp 1"])
     (simp add: abs_ge_iff, blast)

  hence 5: "(\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
    by (intro landau_sum_1 evt[where n="1" and m="1"], auto)

  have "(\<lambda>x. -ln(of_rat (\<epsilon>_of x))) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
    by (intro landau_o.big_mono evt) (auto simp add:ln_div)
  hence 6: "(\<lambda>x. real (s2_of x)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
    unfolding s2_of_def
    by (intro landau_nat_ceil 3, simp)

  have 7: "(\<lambda>_. 1) \<in> O[?F](\<lambda>x. real (n_of x) powr (1 - 1 / real (k_of x)))"
    by (intro landau_o.big_mono evt[where n="1" and k="1"])
     (auto simp add: ge_one_powr_ge_zero)

  have 8: "(\<lambda>_. 1) \<in> O[?F](g1)"
    unfolding g1_def by (intro landau_o.big_mult_1 1 7 4)

  have "(\<lambda>x. 3 * (real (k_of x) * (n_of x) powr (1 - 1 / real (k_of x)) / (of_rat (\<delta>_of x))\<^sup>2))
    \<in> O[?F](g1)"
    by (subst landau_o.big.cmult_in_iff, simp, simp add:g1_def)
  hence 9: "(\<lambda>x. real (s1_of x)) \<in> O[?F](g1)"
    unfolding s1_of_def by (intro landau_nat_ceil 8, auto simp:ac_simps)

  have 10: "(\<lambda>_. 1) \<in> O[?F](g)"
    unfolding g_def by (intro landau_o.big_mult_1 8 3 5)

  have "(\<lambda>x. real (s1_of x)) \<in> O[?F](g)"
    unfolding g_def by (intro landau_o.big_mult_1 5 3 9)
  hence "(\<lambda>x. ln (real (s1_of x) + 1)) \<in> O[?F](g)"
    using 10 by (intro landau_ln_3 sum_in_bigo, auto)
  hence 11: "(\<lambda>x. log 2 (real (s1_of x) + 1)) \<in> O[?F](g)"
    by (simp add:log_def)

  have 12: " (\<lambda>x. ln (real (s2_of x) + 1)) \<in> O[?F](\<lambda>x. ln (1 / real_of_rat (\<epsilon>_of x)))"
    using evt[where \<epsilon>="2"] 6 3
    by (intro landau_ln_3 sum_in_bigo, auto)

  have 13: "(\<lambda>x. log 2 (real (s2_of x) + 1)) \<in> O[?F](g)"
    unfolding g_def
    by (rule landau_o.big_mult_1, rule landau_o.big_mult_1', auto simp add: 8 5 12 log_def)

  have "(\<lambda>x. real (k_of x)) \<in> O[?F](g1)"
    unfolding g1_def using 7 4
    by (intro landau_o.big_mult_1, simp_all)
  hence "(\<lambda>x. log 2 (real (k_of x) + 1)) \<in> O[?F](g1)"
    by (simp add:log_def) (intro landau_ln_3 sum_in_bigo 8, auto)
  hence 14: "(\<lambda>x. log 2 (real (k_of x) + 1)) \<in> O[?F](g)"
    unfolding g_def  by (intro landau_o.big_mult_1 3 5)

  have 15: "(\<lambda>x. log 2 (real (m_of x) + 1)) \<in> O[?F](g)"
    unfolding g_def using 2 8 3
    by (intro landau_o.big_mult_1', simp_all)

  have "(\<lambda>x. ln (real (n_of x) + 1)) \<in> O[?F](\<lambda>x. ln (real (n_of x)))"
    by (intro landau_ln_2[where a="2"] eventually_mono[OF evt[where n="2"]] sum_in_bigo 1, auto)
  hence " (\<lambda>x. log 2 (real (n_of x) + 1)) \<in> O[?F](\<lambda>x. ln (real (n_of x)) + ln (real (m_of x)))"
    by (intro landau_sum_1 evt[where n="1" and m="1"])
     (auto simp add:log_def)
  hence 16: "(\<lambda>x. real (s1_of x) * real (s2_of x) *
    (2 + 2 * log 2 (real (n_of x) + 1) + 2 * log 2 (real (m_of x) + 1))) \<in> O[?F](g)"
    unfolding g_def using 9 6 5 2
    by (intro landau_o.mult sum_in_bigo, auto)

  have "fk_space_usage = (\<lambda>x. fk_space_usage (k_of x, n_of x, m_of x, \<epsilon>_of x, \<delta>_of x))"
    by (simp add:case_prod_beta' k_of_def n_of_def \<epsilon>_of_def \<delta>_of_def m_of_def)
  also have "... \<in> O[?F](g)"
    using 10 11 13 14 15 16
    by (simp add:fun_cong[OF s1_of_def[symmetric]] fun_cong[OF s2_of_def[symmetric]] Let_def)
     (intro sum_in_bigo, auto)
  also have "... = O[?F](?rhs)"
    by (simp add:case_prod_beta' g1_def g_def n_of_def \<epsilon>_of_def \<delta>_of_def m_of_def k_of_def)
  finally show ?thesis by simp
qed

end


chapter \<open>Denotational Semantics\<close>

theory Denotational
imports
    TESL
    Run

begin
text\<open>
  The denotational semantics maps TESL formulae to sets of satisfying runs.
  Firstly, we define the semantics of atomic formulae (basic constructs of the
  TESL language), then we define the semantics of compound formulae as the
  intersection of the semantics of their components: a run must satisfy all
  the individual formulae of a compound formula.
\<close>
section \<open>Denotational interpretation for atomic TESL formulae\<close>
(*<*)
consts dummyT0 ::\<open>'\<tau> tag_const\<close>
consts dummyDeltaT ::\<open>'\<tau> tag_const\<close>

notation dummyT0     (\<open>t\<^sub>0\<close>)
notation dummyDeltaT (\<open>\<delta>t\<close>)
(*>*)

fun TESL_interpretation_atomic
    :: \<open>('\<tau>::linordered_field) TESL_atomic \<Rightarrow> '\<tau> run set\<close> (\<open>\<lbrakk> _ \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>)
where
  \<comment> \<open>@{term \<open>K\<^sub>1 sporadic \<tau> on K\<^sub>2\<close>} means that @{term \<open>K\<^sub>1\<close>} should tick at an
      instant where the time on @{term \<open>K\<^sub>2\<close>} is @{term \<open>\<tau>\<close>}.\<close>
    \<open>\<lbrakk> K\<^sub>1 sporadic \<tau> on K\<^sub>2 \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L =
        {\<rho>. \<exists>n::nat. hamlet ((Rep_run \<rho>) n K\<^sub>1) \<and> time ((Rep_run \<rho>) n K\<^sub>2) = \<tau>}\<close>
  \<comment> \<open>@{term \<open>time-relation \<lfloor>K\<^sub>1, K\<^sub>2\<rfloor> \<in> R\<close>} means that at each instant, the time
      on @{term \<open>K\<^sub>1\<close>} and the time on @{term \<open>K\<^sub>2\<close>} are in relation~@{term \<open>R\<close>}.\<close>
  | \<open>\<lbrakk> time-relation \<lfloor>K\<^sub>1, K\<^sub>2\<rfloor> \<in> R \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L =
        {\<rho>. \<forall>n::nat. R (time ((Rep_run \<rho>) n K\<^sub>1), time ((Rep_run \<rho>) n K\<^sub>2))}\<close>
  \<comment> \<open>@{term \<open>master implies slave\<close>} means that at each instant at which
      @{term \<open>master\<close>} ticks, @{term \<open>slave\<close>} also ticks.\<close>
  | \<open>\<lbrakk> master implies slave \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L =
        {\<rho>. \<forall>n::nat. hamlet ((Rep_run \<rho>) n master) \<longrightarrow> hamlet ((Rep_run \<rho>) n slave)}\<close>
  \<comment> \<open>@{term \<open>master implies not slave\<close>} means that at each instant at which
      @{term \<open>master\<close>} ticks, @{term \<open>slave\<close>} does not tick.\<close>
  | \<open>\<lbrakk> master implies not slave \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L =
        {\<rho>. \<forall>n::nat. hamlet ((Rep_run \<rho>) n master) \<longrightarrow> \<not>hamlet ((Rep_run \<rho>) n slave)}\<close>
  \<comment> \<open>@{term \<open>master time-delayed by \<delta>\<tau> on measuring implies slave\<close>} means that
      at each instant at which  @{term \<open>master\<close>} ticks, @{term \<open>slave\<close>} will
      tick after a delay @{term \<open>\<delta>\<tau>\<close>} measured on the time scale
      of @{term \<open>measuring\<close>}.\<close>
  | \<open>\<lbrakk> master time-delayed by \<delta>\<tau> on measuring implies slave \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L =
    \<comment> \<open>
      When master ticks, let's call @{term \<open>t\<^sub>0\<close>} the current date on measuring. Then,
      at the first instant when the date on measuring is @{term \<open>t\<^sub>0+\<delta>t\<close>},
      slave has to tick.
    \<close>
        {\<rho>. \<forall>n. hamlet ((Rep_run \<rho>) n master) \<longrightarrow>
                 (let measured_time = time ((Rep_run \<rho>) n measuring) in
                  \<forall>m \<ge> n.  first_time \<rho> measuring m (measured_time + \<delta>\<tau>)
                            \<longrightarrow> hamlet ((Rep_run \<rho>) m slave)
                 )
        }\<close>
  \<comment> \<open>@{term \<open>K\<^sub>1 weakly precedes K\<^sub>2\<close>} means that each tick on @{term \<open>K\<^sub>2\<close>}
        must be preceded by or coincide with at least one tick on @{term \<open>K\<^sub>1\<close>}.
        Therefore, at each instant @{term \<open>n\<close>}, the number of ticks on @{term \<open>K\<^sub>2\<close>}
        must be less or equal to the number of ticks on @{term \<open>K\<^sub>1\<close>}.\<close>
  | \<open>\<lbrakk> K\<^sub>1 weakly precedes K\<^sub>2 \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L =
        {\<rho>. \<forall>n::nat. (run_tick_count \<rho> K\<^sub>2 n) \<le> (run_tick_count \<rho> K\<^sub>1 n)}\<close>
  \<comment> \<open>@{term \<open>K\<^sub>1 strictly precedes K\<^sub>2\<close>} means that each tick on @{term \<open>K\<^sub>2\<close>}
        must be preceded by at least one tick on @{term \<open>K\<^sub>1\<close>} at a previous instant.
        Therefore, at each instant n, the number of ticks on @{term \<open>K\<^sub>2\<close>}
        must be less or equal to the number of ticks on @{term \<open>K\<^sub>1\<close>}
        at instant n - 1.\<close>
  | \<open>\<lbrakk> K\<^sub>1 strictly precedes K\<^sub>2 \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L =
        {\<rho>. \<forall>n::nat. (run_tick_count \<rho> K\<^sub>2 n) \<le> (run_tick_count_strictly \<rho> K\<^sub>1 n)}\<close>
  \<comment> \<open>@{term \<open>K\<^sub>1 kills K\<^sub>2\<close>} means that when @{term \<open>K\<^sub>1\<close>} ticks, @{term \<open>K\<^sub>2\<close>}
        cannot tick and is not allowed to tick at any further instant.\<close>
  | \<open>\<lbrakk> K\<^sub>1 kills K\<^sub>2 \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L =
        {\<rho>. \<forall>n::nat. hamlet ((Rep_run \<rho>) n K\<^sub>1)
                        \<longrightarrow> (\<forall>m\<ge>n. \<not> hamlet ((Rep_run \<rho>) m K\<^sub>2))}\<close>

section \<open>Denotational interpretation for TESL formulae\<close>

text\<open>
  To satisfy a formula, a run has to satisfy the conjunction of its atomic
  formulae. Therefore, the interpretation of a formula is the intersection
  of the interpretations of its components.
\<close>
fun TESL_interpretation :: \<open>('\<tau>::linordered_field) TESL_formula \<Rightarrow> '\<tau> run set\<close>
  (\<open>\<lbrakk>\<lbrakk> _ \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>)
where
  \<open>\<lbrakk>\<lbrakk> [] \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = {_. True}\<close>
| \<open>\<lbrakk>\<lbrakk> \<phi> # \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk> \<phi> \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<inter> \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>

lemma TESL_interpretation_homo:
  \<open>\<lbrakk> \<phi> \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<inter> \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<phi> # \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
by simp

subsection \<open>Image interpretation lemma\<close>

theorem TESL_interpretation_image:
  \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<Inter> ((\<lambda>\<phi>. \<lbrakk> \<phi> \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L) ` set \<Phi>)\<close>
by (induction \<Phi>, simp+)

subsection \<open>Expansion law\<close>
text \<open>Similar to the expansion laws of lattices.\<close>

theorem TESL_interp_homo_append:
  \<open>\<lbrakk>\<lbrakk> \<Phi>\<^sub>1 @ \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi>\<^sub>1 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<inter> \<lbrakk>\<lbrakk> \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
by (induction \<Phi>\<^sub>1, simp, auto)

section \<open>Equational laws for the denotation of TESL formulae\<close>

lemma TESL_interp_commute:
  shows \<open>\<lbrakk>\<lbrakk> \<Phi>\<^sub>1 @ \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi>\<^sub>2 @ \<Phi>\<^sub>1 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
by (simp add: TESL_interp_homo_append inf_sup_aci(1))

lemma TESL_interp_left_commute:
  \<open>\<lbrakk>\<lbrakk> \<Phi>\<^sub>1 @ (\<Phi>\<^sub>2 @ \<Phi>\<^sub>3) \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi>\<^sub>2 @ (\<Phi>\<^sub>1 @ \<Phi>\<^sub>3) \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
unfolding TESL_interp_homo_append by auto

lemma TESL_interp_idem:
  \<open>\<lbrakk>\<lbrakk> \<Phi> @ \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
using TESL_interp_homo_append by auto

lemma TESL_interp_left_idem:
  \<open>\<lbrakk>\<lbrakk> \<Phi>\<^sub>1 @ (\<Phi>\<^sub>1 @ \<Phi>\<^sub>2) \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi>\<^sub>1 @ \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
using TESL_interp_homo_append by auto

lemma TESL_interp_right_idem:
  \<open>\<lbrakk>\<lbrakk> (\<Phi>\<^sub>1 @ \<Phi>\<^sub>2) @ \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi>\<^sub>1 @ \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
unfolding TESL_interp_homo_append by auto

lemmas TESL_interp_aci = TESL_interp_commute
                         TESL_interp_assoc
                         TESL_interp_left_commute
                         TESL_interp_left_idem

text \<open>The empty formula is the identity element.\<close>
lemma TESL_interp_neutral1:
  \<open>\<lbrakk>\<lbrakk> [] @ \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
by simp

lemma TESL_interp_neutral2:
  \<open>\<lbrakk>\<lbrakk> \<Phi> @ [] \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
by simp

section \<open>Decreasing interpretation of TESL formulae\<close>
text\<open>
  Adding constraints to a TESL formula reduces the number of satisfying runs.
\<close>
lemma TESL_sem_decreases_head:
  \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<supseteq> \<lbrakk>\<lbrakk> \<phi> # \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
by simp

lemma TESL_sem_decreases_tail:
  \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<supseteq> \<lbrakk>\<lbrakk> \<Phi> @ [\<phi>] \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
by (simp add: TESL_interp_homo_append)

text \<open>
  Repeating a formula in a specification does not change the specification.
\<close>
lemma TESL_interp_formula_stuttering:
  assumes \<open>\<phi> \<in> set \<Phi>\<close>
    shows \<open>\<lbrakk>\<lbrakk> \<phi> # \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  have \<open>\<phi> # \<Phi> = [\<phi>] @ \<Phi>\<close> by simp
  hence \<open>\<lbrakk>\<lbrakk> \<phi> # \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> [\<phi>] \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<inter> \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    using TESL_interp_homo_append by simp
  thus ?thesis using assms TESL_interpretation_image by fastforce
qed

text \<open>
  Removing duplicate formulae in a specification does not change the specification.
\<close>
lemma TESL_interp_remdups_absorb:
  \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> remdups \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof (induction \<Phi>)
  case Cons
    thus ?case using TESL_interp_formula_stuttering by auto
qed simp

text \<open>
  Specifications that contain the same formulae have the same semantics.
\<close>
lemma TESL_interp_set_lifting:
  assumes \<open>set \<Phi> = set \<Phi>'\<close>
    shows \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi>' \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  have \<open>set (remdups \<Phi>) = set (remdups \<Phi>')\<close>
    by (simp add: assms)
  moreover have fxpnt\<Phi>: \<open>\<Inter> ((\<lambda>\<phi>. \<lbrakk> \<phi> \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L) ` set \<Phi>) = \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    by (simp add: TESL_interpretation_image)
  moreover have fxpnt\<Phi>': \<open>\<Inter> ((\<lambda>\<phi>. \<lbrakk> \<phi> \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L) ` set \<Phi>') = \<lbrakk>\<lbrakk> \<Phi>' \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    by (simp add: TESL_interpretation_image)
  moreover have \<open>\<Inter> ((\<lambda>\<phi>. \<lbrakk> \<phi> \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L) ` set \<Phi>) = \<Inter> ((\<lambda>\<phi>. \<lbrakk> \<phi> \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L) ` set \<Phi>')\<close>
    by (simp add: assms)
  ultimately show ?thesis using TESL_interp_remdups_absorb by auto
qed

text \<open>
  The semantics of specifications is contravariant with respect to their inclusion.
\<close>
theorem TESL_interp_decreases_setinc:
  assumes \<open>set \<Phi> \<subseteq> set \<Phi>'\<close>
    shows \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<supseteq> \<lbrakk>\<lbrakk> \<Phi>' \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  obtain \<Phi>\<^sub>r where decompose: \<open>set (\<Phi> @ \<Phi>\<^sub>r) = set \<Phi>'\<close> using assms by auto
  hence \<open>set (\<Phi> @ \<Phi>\<^sub>r) = set \<Phi>'\<close> using assms by blast
  moreover have \<open>(set \<Phi>) \<union> (set \<Phi>\<^sub>r) = set \<Phi>'\<close>
    using assms decompose by auto
  moreover have \<open>\<lbrakk>\<lbrakk> \<Phi>' \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi> @ \<Phi>\<^sub>r \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    using TESL_interp_set_lifting decompose by blast
  moreover have \<open>\<lbrakk>\<lbrakk> \<Phi> @ \<Phi>\<^sub>r \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<inter> \<lbrakk>\<lbrakk> \<Phi>\<^sub>r \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    by (simp add: TESL_interp_homo_append)
  moreover have \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<supseteq> \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<inter> \<lbrakk>\<lbrakk> \<Phi>\<^sub>r \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close> by simp
  ultimately show ?thesis by simp
qed

lemma TESL_interp_decreases_add_head:
  assumes \<open>set \<Phi> \<subseteq> set \<Phi>'\<close>
    shows \<open>\<lbrakk>\<lbrakk> \<phi> # \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<supseteq> \<lbrakk>\<lbrakk> \<phi> # \<Phi>' \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
using assms TESL_interp_decreases_setinc by auto

lemma TESL_interp_decreases_add_tail:
  assumes \<open>set \<Phi> \<subseteq> set \<Phi>'\<close>
    shows \<open>\<lbrakk>\<lbrakk> \<Phi> @ [\<phi>] \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<supseteq> \<lbrakk>\<lbrakk> \<Phi>' @ [\<phi>] \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
using TESL_interp_decreases_setinc[OF assms]
  by (simp add: TESL_interpretation_image dual_order.trans)

lemma TESL_interp_absorb1:
  assumes \<open>set \<Phi>\<^sub>1 \<subseteq> set \<Phi>\<^sub>2\<close>
    shows \<open>\<lbrakk>\<lbrakk> \<Phi>\<^sub>1 @ \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
by (simp add: Int_absorb1 TESL_interp_decreases_setinc
                          TESL_interp_homo_append assms)

lemma TESL_interp_absorb2:
  assumes \<open>set \<Phi>\<^sub>2 \<subseteq> set \<Phi>\<^sub>1\<close>
    shows \<open>\<lbrakk>\<lbrakk> \<Phi>\<^sub>1 @ \<Phi>\<^sub>2 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi>\<^sub>1 \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
using TESL_interp_absorb1 TESL_interp_commute assms by blast

section \<open>Some special cases\<close>

lemma NoSporadic_stable [simp]:
  \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<subseteq> \<lbrakk>\<lbrakk> NoSporadic \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from filter_is_subset have \<open>set (NoSporadic \<Phi>) \<subseteq> set \<Phi>\<close> .
  from TESL_interp_decreases_setinc[OF this] show ?thesis .
qed

lemma NoSporadic_idem [simp]:
  \<open>\<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<inter> \<lbrakk>\<lbrakk> NoSporadic \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L = \<lbrakk>\<lbrakk> \<Phi> \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
using NoSporadic_stable by blast

lemma NoSporadic_setinc:
  \<open>set (NoSporadic \<Phi>) \<subseteq> set \<Phi>\<close>
by (rule filter_is_subset)

(*<*)
no_notation dummyT0    (\<open>t\<^sub>0\<close>)
no_notation dummyDeltaT (\<open>\<delta>t\<close>)
(*>*)

end