(*  Title:      Well-Quasi-Orders
    Author:     Christian Sternagel <c.sternagel@gmail.com>
    Maintainer: Christian Sternagel
    License:    LGPL
*)

section \<open>Almost-Full Relations\<close>

theory Almost_Full_Relations
imports Minimal_Bad_Sequences
begin

lemma (in mbs) mbs':
  assumes "\<not> almost_full_on P A"
  shows "\<exists>m \<in> BAD P. \<forall>g. (m, g) \<in> gseq \<longrightarrow> good P g"
using assms and mbs unfolding almost_full_on_def by blast

(*TODO: move to Option.thy of Isabelle/HOL?*)
subsection \<open>Adding a Bottom Element to a Set\<close>

definition with_bot :: "'a set \<Rightarrow> 'a option set" ("_\<^sub>\<bottom>" [1000] 1000)
where
  "A\<^sub>\<bottom> = {None} \<union> Some ` A"

lemma with_bot_iff [iff]:
  "Some x \<in> A\<^sub>\<bottom> \<longleftrightarrow> x \<in> A"
  by (auto simp: with_bot_def)

lemma NoneI [simp, intro]:
  "None \<in> A\<^sub>\<bottom>"
  by (simp add: with_bot_def)

lemma not_None_the_mem [simp]:
  "x \<noteq> None \<Longrightarrow> the x \<in> A \<longleftrightarrow> x \<in> A\<^sub>\<bottom>"
  by auto

lemma with_bot_cases:
  "u \<in> A\<^sub>\<bottom> \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> u = Some x \<Longrightarrow> P) \<Longrightarrow> (u = None \<Longrightarrow> P) \<Longrightarrow> P"
  by auto

lemma with_bot_empty_conv [iff]:
  "A\<^sub>\<bottom> = {None} \<longleftrightarrow> A = {}"
  by (auto elim: with_bot_cases)

lemma with_bot_UNIV [simp]:
  "UNIV\<^sub>\<bottom> = UNIV"
proof (rule set_eqI)
  fix x :: "'a option"
  show "x \<in> UNIV\<^sub>\<bottom> \<longleftrightarrow> x \<in> UNIV" by (cases x) auto
qed

subsection \<open>Adding a Bottom Element to an Almost-Full Set\<close>

fun
  option_le :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a option \<Rightarrow> 'a option \<Rightarrow> bool"
where
  "option_le P None y = True" |
  "option_le P (Some x) None = False" |
  "option_le P (Some x) (Some y) = P x y"

lemma None_imp_good_option_le [simp]:
  assumes "f i = None"
  shows "good (option_le P) f"
  by (rule goodI [of i "Suc i"]) (auto simp: assms)

lemma almost_full_on_with_bot:
  assumes "almost_full_on P A"
  shows "almost_full_on (option_le P) A\<^sub>\<bottom>" (is "almost_full_on ?P ?A")
proof
  fix f :: "nat \<Rightarrow> 'a option"
  assume *: "\<forall>i. f i \<in> ?A"
  show "good ?P f"
  proof (cases "\<forall>i. f i \<noteq> None")
    case True
    then have **: "\<And>i. Some (the (f i)) = f i"
      and "\<And>i. the (f i) \<in> A" using * by auto
    with almost_full_onD [OF assms, of "the \<circ> f"] obtain i j where "i < j"
      and "P (the (f i)) (the (f j))" by auto
    then have "?P (Some (the (f i))) (Some (the (f j)))" by simp
    then have "?P (f i) (f j)" unfolding ** .
    with \<open>i < j\<close> show "good ?P f" by (auto simp: good_def)
  qed auto
qed

subsection \<open>Disjoint Union of Almost-Full Sets\<close>

fun
  sum_le :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a + 'b \<Rightarrow> 'a + 'b \<Rightarrow> bool"
where
  "sum_le P Q (Inl x) (Inl y) = P x y" |
  "sum_le P Q (Inr x) (Inr y) = Q x y" |
  "sum_le P Q x y = False"

lemma not_sum_le_cases:
  assumes "\<not> sum_le P Q a b"
    and "\<And>x y. \<lbrakk>a = Inl x; b = Inl y; \<not> P x y\<rbrakk> \<Longrightarrow> thesis"
    and "\<And>x y. \<lbrakk>a = Inr x; b = Inr y; \<not> Q x y\<rbrakk> \<Longrightarrow> thesis"
    and "\<And>x y. \<lbrakk>a = Inl x; b = Inr y\<rbrakk> \<Longrightarrow> thesis"
    and "\<And>x y. \<lbrakk>a = Inr x; b = Inl y\<rbrakk> \<Longrightarrow> thesis"
  shows thesis
  using assms by (cases a b rule: sum.exhaust [case_product sum.exhaust]) auto

text \<open>
  When two sets are almost-full, then their disjoint sum is almost-full.
\<close>
lemma almost_full_on_Plus:
  assumes "almost_full_on P A" and "almost_full_on Q B"
  shows "almost_full_on (sum_le P Q) (A <+> B)" (is "almost_full_on ?P ?A")
proof
  fix f :: "nat \<Rightarrow> ('a + 'b)"
  let ?I = "f -` Inl ` A"
  let ?J = "f -` Inr ` B"
  assume "\<forall>i. f i \<in> ?A"
  then have *: "?J = (UNIV::nat set) - ?I" by (fastforce)
  show "good ?P f"
  proof (rule ccontr)
    assume bad: "bad ?P f"
    show False
    proof (cases "finite ?I")
      assume "finite ?I"
      then have "infinite ?J" by (auto simp: *)
      then interpret infinitely_many1 "\<lambda>i. f i \<in> Inr ` B"
        by (unfold_locales) (simp add: infinite_nat_iff_unbounded)
      have [dest]: "\<And>i x. f (enum i) = Inl x \<Longrightarrow> False"
        using enum_P by (auto simp: image_iff) (metis Inr_Inl_False)
      let ?f = "\<lambda>i. projr (f (enum i))"
      have B: "\<And>i. ?f i \<in> B" using enum_P by (auto simp: image_iff) (metis sum.sel(2))
      { fix i j :: nat
        assume "i < j"
        then have "enum i < enum j" using enum_less by auto
        with bad have "\<not> ?P (f (enum i)) (f (enum j))" by (auto simp: good_def)
        then have "\<not> Q (?f i) (?f j)" by (auto elim: not_sum_le_cases) }
      then have "bad Q ?f" by (auto simp: good_def)
      moreover from \<open>almost_full_on Q B\<close> and B
        have "good Q ?f" by (auto simp: good_def almost_full_on_def)
      ultimately show False by blast
    next
      assume "infinite ?I"
      then interpret infinitely_many1 "\<lambda>i. f i \<in> Inl ` A"
        by (unfold_locales) (simp add: infinite_nat_iff_unbounded)
      have [dest]: "\<And>i x. f (enum i) = Inr x \<Longrightarrow> False"
        using enum_P by (auto simp: image_iff) (metis Inr_Inl_False)
      let ?f = "\<lambda>i. projl (f (enum i))"
      have A: "\<forall>i. ?f i \<in> A" using enum_P by (auto simp: image_iff) (metis sum.sel(1))
      { fix i j :: nat
        assume "i < j"
        then have "enum i < enum j" using enum_less by auto
        with bad have "\<not> ?P (f (enum i)) (f (enum j))" by (auto simp: good_def)
        then have "\<not> P (?f i) (?f j)" by (auto elim: not_sum_le_cases) }
      then have "bad P ?f" by (auto simp: good_def)
      moreover from \<open>almost_full_on P A\<close> and A
        have "good P ?f" by (auto simp: good_def almost_full_on_def)
      ultimately show False by blast
    qed
  qed
qed

subsection \<open>Dickson's Lemma for Almost-Full Relations\<close>

text \<open>
  When two sets are almost-full, then their Cartesian product is almost-full.
\<close>

definition
  prod_le :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'a \<times> 'b \<Rightarrow> bool"
where
  "prod_le P1 P2 = (\<lambda>(p1, p2) (q1, q2). P1 p1 q1 \<and> P2 p2 q2)"

lemma prod_le_True [simp]:
  "prod_le P (\<lambda>_ _. True) a b = P (fst a) (fst b)"
  by (auto simp: prod_le_def)

lemma almost_full_on_Sigma:
  assumes "almost_full_on P1 A1" and "almost_full_on P2 A2"
  shows "almost_full_on (prod_le P1 P2) (A1 \<times> A2)" (is "almost_full_on ?P ?A")
proof (rule ccontr)
  assume "\<not> almost_full_on ?P ?A"
  then obtain f where f: "\<forall>i. f i \<in> ?A"
    and bad: "bad ?P f" by (auto simp: almost_full_on_def)
  let ?W = "\<lambda>x y. P1 (fst x) (fst y)"
  let ?B = "\<lambda>x y. P2 (snd x) (snd y)"
  from f have fst: "\<forall>i. fst (f i) \<in> A1" and snd: "\<forall>i. snd (f i) \<in> A2"
    by (metis SigmaE fst_conv, metis SigmaE snd_conv)
  from almost_full_on_imp_homogeneous_subseq [OF assms(1) fst]
    obtain \<phi> :: "nat \<Rightarrow> nat" where mono: "\<And>i j. i < j \<Longrightarrow> \<phi> i < \<phi> j"
    and *: "\<And>i j. i < j \<Longrightarrow> ?W (f (\<phi> i)) (f (\<phi> j))" by auto
  from snd have "\<forall>i. snd (f (\<phi> i)) \<in> A2" by auto
  then have "snd \<circ> f \<circ> \<phi> \<in> SEQ A2" by auto
  with assms(2) have "good P2 (snd \<circ> f \<circ> \<phi>)" by (auto simp: almost_full_on_def)
  then obtain i j :: nat
    where "i < j" and "?B (f (\<phi> i)) (f (\<phi> j))" by auto
  with * [OF \<open>i < j\<close>] have "?P (f (\<phi> i)) (f (\<phi> j))" by (simp add: case_prod_beta prod_le_def)
  with mono [OF \<open>i < j\<close>] and bad show False by auto
qed

subsection \<open>Higman's Lemma for Almost-Full Relations\<close>

lemma almost_full_on_lists:
  assumes "almost_full_on P A"
  shows "almost_full_on (list_emb P) (lists A)" (is "almost_full_on ?P ?A")
proof (rule ccontr)
  interpret mbs ?A .
  assume "\<not> ?thesis"
  from mbs' [OF this] obtain m
    where bad: "m \<in> BAD ?P"
    and min: "\<forall>g. (m, g) \<in> gseq \<longrightarrow> good ?P g" ..
  then have lists: "\<And>i. m i \<in> lists A"
    and ne: "\<And>i. m i \<noteq> []" by auto

  define h t where "h = (\<lambda>i. hd (m i))" and "t = (\<lambda>i. tl (m i))"
  have m: "\<And>i. m i = h i # t i" using ne by (simp add: h_def t_def)

  have "\<forall>i. h i \<in> A" using ne_lists [OF ne] and lists by (auto simp add: h_def)
  from almost_full_on_imp_homogeneous_subseq [OF assms this] obtain \<phi> :: "nat \<Rightarrow> nat"
    where less: "\<And>i j. i < j \<Longrightarrow> \<phi> i < \<phi> j"
      and P: "\<forall>i j. i < j \<longrightarrow> P (h (\<phi> i)) (h (\<phi> j))" by blast

  have bad_t: "bad ?P (t \<circ> \<phi>)"
  proof
    assume "good ?P (t \<circ> \<phi>)"
    then obtain i j where "i < j" and "?P (t (\<phi> i)) (t (\<phi> j))" by auto
    moreover with P have "P (h (\<phi> i)) (h (\<phi> j))" by blast
    ultimately have "?P (m (\<phi> i)) (m (\<phi> j))"
      by (subst (1 2) m) (rule list_emb_Cons2, auto)
    with less and \<open>i < j\<close> have "good ?P m" by (auto simp: good_def)
    with bad show False by blast
  qed

  define m' where "m' = (\<lambda>i. if i < \<phi> 0 then m i else t (\<phi> (i - \<phi> 0)))"

  have m'_less: "\<And>i. i < \<phi> 0 \<Longrightarrow> m' i = m i" by (simp add: m'_def)
  have m'_geq: "\<And>i. i \<ge> \<phi> 0 \<Longrightarrow> m' i = t (\<phi> (i - \<phi> 0))" by (simp add: m'_def)

  have "\<forall>i. m' i \<in> lists A" using ne_lists [OF ne] and lists by (auto simp: m'_def t_def)
  moreover have "length (m' (\<phi> 0)) < length (m (\<phi> 0))" using ne by (simp add: t_def m'_geq)
  moreover have "\<forall>j<\<phi> 0. m' j = m j" by (auto simp: m'_less)
  ultimately have "(m, m') \<in> gseq" using lists by (auto simp: gseq_def)
  moreover have "bad ?P m'"
  proof
    assume "good ?P m'"
    then obtain i j where "i < j" and emb: "?P (m' i) (m' j)" by (auto simp: good_def)
    { assume "j < \<phi> 0"
      with \<open>i < j\<close> and emb have "?P (m i) (m j)" by (auto simp: m'_less)
      with \<open>i < j\<close> and bad have False by blast }
    moreover
    { assume "\<phi> 0 \<le> i"
      with \<open>i < j\<close> and emb have "?P (t (\<phi> (i - \<phi> 0))) (t (\<phi> (j - \<phi> 0)))"
        and "i - \<phi> 0 < j - \<phi> 0" by (auto simp: m'_geq)
      with bad_t have False by auto }
    moreover
    { assume "i < \<phi> 0" and "\<phi> 0 \<le> j"
      with \<open>i < j\<close> and emb have "?P (m i) (t (\<phi> (j - \<phi> 0)))" by (simp add: m'_less m'_geq)
      from list_emb_Cons [OF this, of "h (\<phi> (j - \<phi> 0))"]
        have "?P (m i) (m (\<phi> (j - \<phi> 0)))" using ne by (simp add: h_def t_def)
      moreover have "i < \<phi> (j - \<phi> 0)"
        using less [of 0 "j - \<phi> 0"] and \<open>i < \<phi> 0\<close> and \<open>\<phi> 0 \<le> j\<close>
        by (cases "j = \<phi> 0") auto
      ultimately have False using bad by blast }
    ultimately show False using \<open>i < j\<close> by arith
  qed
  ultimately show False using min by blast
qed

subsection \<open>Natural Numbers\<close>

lemma almost_full_on_UNIV_nat:
  "almost_full_on (\<le>) (UNIV :: nat set)"
proof -
  let ?P = "subseq :: bool list \<Rightarrow> bool list \<Rightarrow> bool"
  have *: "length ` (UNIV :: bool list set) = (UNIV :: nat set)"
    by (metis Ex_list_of_length surj_def)
  have "almost_full_on (\<le>) (length ` (UNIV :: bool list set))"
  proof (rule almost_full_on_hom)
    fix xs ys :: "bool list"
    assume "?P xs ys"
    then show "length xs \<le> length ys"
      by (metis list_emb_length)
  next
    have "finite (UNIV :: bool set)" by auto
    from almost_full_on_lists [OF eq_almost_full_on_finite_set [OF this]]
      show "almost_full_on ?P UNIV" unfolding lists_UNIV .
  qed
  then show ?thesis unfolding * .
qed

end


(* Copyright 2021 (C) Mihails Milehins *)

section\<open>Simple categories\<close>
theory CZH_ECAT_Simple
  imports
    CZH_Foundations.CZH_SMC_Simple
    CZH_ECAT_NTCF
    CZH_ECAT_Small_Functor
begin

subsection\<open>Background\<close>

text\<open>
The section presents a variety of simple categories,
(such as the empty category \<open>0\<close> and the singleton category \<open>1\<close>)
and functors between them (see \<^cite>\<open>"mac_lane_categories_2010"\<close>
for further information).
\<close>

subsection\<open>Empty category \<open>0\<close>\<close>

subsubsection\<open>Definition and elementary properties\<close>

text\<open>See Chapter I-2 in \<^cite>\<open>"mac_lane_categories_2010"\<close>.\<close>

definition cat_0 :: "V"
  where "cat_0 = [0, 0, 0, 0, 0, 0]\<^sub>\<circ>"

text\<open>Components.\<close>

lemma cat_0_components:
  shows "cat_0\<lparr>Obj\<rparr> = 0"
    and "cat_0\<lparr>Arr\<rparr> = 0"
    and "cat_0\<lparr>Dom\<rparr> = 0"
    and "cat_0\<lparr>Cod\<rparr> = 0"
    and "cat_0\<lparr>Comp\<rparr> = 0"
    and "cat_0\<lparr>CId\<rparr> = 0"
  unfolding cat_0_def dg_field_simps by (simp_all add: nat_omega_simps)

text\<open>Slicing.\<close>

lemma cat_smc_cat_0: "cat_smc cat_0 = smc_0"
  unfolding cat_smc_def cat_0_def smc_0_def dg_field_simps
  by (simp add: nat_omega_simps)

lemmas_with (in \<Z>) [folded cat_smc_cat_0, unfolded slicing_simps]:
  cat_0_is_arr_iff = smc_0_is_arr_iff

subsubsection\<open>\<open>0\<close> is a category\<close>

lemma (in \<Z>) category_cat_0[cat_cs_intros]: "category \<alpha> cat_0"
proof(intro categoryI)
  show "vfsequence cat_0" "vcard cat_0 = 6\<^sub>\<nat>"
    by (simp_all add: cat_0_def nat_omega_simps)
qed
  (
    auto simp:
      \<Z>_axioms
      cat_0_components
      cat_0_is_arr_iff
      cat_smc_cat_0
      \<Z>.semicategory_smc_0
  )

lemmas [cat_cs_intros] = \<Z>.category_cat_0

subsubsection\<open>Opposite of the category \<open>0\<close>\<close>

lemma op_cat_cat_0[cat_op_simps]: "op_cat (cat_0) = cat_0"
proof(rule cat_smc_eqI)
  define \<beta> where "\<beta> = \<omega> + \<omega>"
  interpret \<beta>: \<Z> \<beta> unfolding \<beta>_def by (rule \<Z>_\<omega>\<omega>)
  show "category \<beta> (op_cat cat_0)"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
  show "category \<beta> cat_0" by (cs_concl cs_shallow cs_intro: cat_cs_intros)
qed
  (
    simp_all add:
      cat_0_components op_cat_components cat_smc_cat_0
      slicing_commute[symmetric] smc_op_simps
  )

subsection\<open>Empty functors\<close>

subsubsection\<open>Definition and elementary properties\<close>

definition cf_0 :: "V \<Rightarrow> V"
  where "cf_0 \<AA> = [0, 0, cat_0, \<AA>]\<^sub>\<circ>"

text\<open>Components.\<close>

lemma cf_0_components:
  shows "cf_0 \<AA>\<lparr>ObjMap\<rparr> = 0"
    and "cf_0 \<AA>\<lparr>ArrMap\<rparr> = 0"
    and "cf_0 \<AA>\<lparr>HomDom\<rparr> = cat_0"
    and "cf_0 \<AA>\<lparr>HomCod\<rparr> = \<AA>"
  unfolding cf_0_def dghm_field_simps by (simp_all add: nat_omega_simps)

text\<open>Slicing.\<close>

lemma cf_smcf_cf_0: "cf_smcf (cf_0 \<AA>) = smcf_0 (cat_smc \<AA>)"
  unfolding
    dg_field_simps dghm_field_simps
    cf_smcf_def cf_0_def smc_0_def cat_0_def smcf_0_def cat_smc_def
  by (simp add: nat_omega_simps)

text\<open>Opposite empty category homomorphism.\<close>

lemma op_cf_cf_0: "op_cf (cf_0 \<CC>) = cf_0 (op_cat \<CC>)"
  unfolding
    cf_0_def op_cat_def op_cf_def cat_0_def dghm_field_simps dg_field_simps
  by (simp add: nat_omega_simps)

subsubsection\<open>Object map\<close>

lemma cf_0_ObjMap_vsv[cat_cs_intros]: "vsv (cf_0 \<CC>\<lparr>ObjMap\<rparr>)"
  unfolding cf_0_components by simp

subsubsection\<open>Arrow map\<close>

lemma cf_0_ArrMap_vsv[cat_cs_intros]: "vsv (cf_0 \<CC>\<lparr>ArrMap\<rparr>)"
  unfolding cf_0_components by simp

subsubsection\<open>Empty functor is a faithful functor\<close>

lemma cf_0_is_ft_functor:
  assumes "category \<alpha> \<AA>"
  shows "cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<AA>"
proof(rule is_ft_functorI)
  interpret \<AA>: category \<alpha> \<AA> by (rule assms(1))
  show "cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
  proof(rule is_functorI, unfold cat_smc_cat_0 cf_smcf_cf_0)
    show "vfsequence (cf_0 \<AA>)" unfolding cf_0_def by simp
    show "vcard (cf_0 \<AA>) = 4\<^sub>\<nat>"
      unfolding cf_0_def by (simp add: nat_omega_simps)
    from \<Z>.smcf_0_is_ft_semifunctor assms show
      "smcf_0 (cat_smc \<AA>) : smc_0 \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
      by auto
  qed (auto simp: assms \<AA>.category_cat_0 cat_0_components cf_0_components)
  show "cf_smcf (cf_0 \<AA>) : cat_smc cat_0 \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> cat_smc \<AA>"
    by
      (
        auto simp:
          assms
          \<AA>.\<Z>_axioms
          \<AA>.smcf_0_is_ft_semifunctor
          category.cat_semicategory
          cf_smcf_cf_0
          cat_smc_cat_0
      )
qed

lemma cf_0_is_ft_functor'[cf_cs_intros]:
  assumes "category \<alpha> \<AA>"
    and "\<BB>' = \<AA>"
    and "\<AA>' = cat_0"
  shows "cf_0 \<AA> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>f\<^sub>a\<^sub>i\<^sub>t\<^sub>h\<^sub>f\<^sub>u\<^sub>l\<^bsub>\<alpha>\<^esub> \<BB>'"
  using assms(1) unfolding assms(2,3) by (rule cf_0_is_ft_functor)

lemma cf_0_is_functor:
  assumes "category \<alpha> \<AA>"
  shows "cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<AA>"
  using cf_0_is_ft_functor[OF assms] by auto

lemma cf_0_is_functor'[cat_cs_intros]:
  assumes "category \<alpha> \<AA>"
    and "\<BB>' = \<AA>"
    and "\<AA>' = cat_0"
  shows "cf_0 \<AA> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
  using assms(1) unfolding assms(2,3) by (rule cf_0_is_functor)

subsubsection\<open>Further properties\<close>

lemma is_functor_is_cf_0_if_cat_0:
  assumes "\<FF> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
  shows "\<FF> = cf_0 \<CC>"
proof(rule cf_smcf_eqI)
  interpret \<FF>: is_functor \<alpha> cat_0 \<CC> \<FF> by (rule assms(1))
  show "\<FF> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(1))
  then have dom_lhs: "\<D>\<^sub>\<circ> (\<FF>\<lparr>ObjMap\<rparr>) = 0" "\<D>\<^sub>\<circ> (\<FF>\<lparr>ArrMap\<rparr>) = 0"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_0_components)+
  show "cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  show "cf_smcf \<FF> = cf_smcf (cf_0 \<CC>)"
    unfolding cf_smcf_cf_0
    by
      (
        rule is_semifunctor_is_smcf_0_if_smc_0,
        rule \<FF>.cf_is_semifunctor[unfolded slicing_simps cat_smc_cat_0]
      )
qed simp_all

lemma (in is_functor) cf_comp_cf_cf_0[cat_cs_simps]: "\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA> = cf_0 \<BB>"
proof(rule cf_eqI)
  show "\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (cs_concl cs_intro: cat_cs_intros)
  then have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA>)\<lparr>ObjMap\<rparr>) = cat_0\<lparr>Obj\<rparr>"
    and ArrMap_dom_lhs: "\<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA>)\<lparr>ArrMap\<rparr>) = cat_0\<lparr>Arr\<rparr>"
    by (cs_concl cs_simp: cat_cs_simps)+
  show "cf_0 \<BB> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  then have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_0 \<BB>\<lparr>ObjMap\<rparr>) = cat_0\<lparr>Obj\<rparr>"
    and ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_0 \<BB>\<lparr>ArrMap\<rparr>) = cat_0\<lparr>Arr\<rparr>"
    by (cs_concl cs_simp: cat_cs_simps)+
  show "(\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA>)\<lparr>ObjMap\<rparr> = cf_0 \<BB>\<lparr>ObjMap\<rparr>"
    by
      (
        rule vsv_eqI,
        unfold ObjMap_dom_lhs ObjMap_dom_rhs ArrMap_dom_lhs ArrMap_dom_rhs
      )
      (auto simp: cat_0_components intro: cat_cs_intros)
  show "(\<FF> \<circ>\<^sub>C\<^sub>F cf_0 \<AA>)\<lparr>ArrMap\<rparr> = cf_0 \<BB>\<lparr>ArrMap\<rparr>"
    by
      (
        rule vsv_eqI,
        unfold ObjMap_dom_lhs ObjMap_dom_rhs ArrMap_dom_lhs ArrMap_dom_rhs
      )
      (auto simp: cat_0_components intro: cat_cs_intros)
qed simp_all

lemmas [cat_cs_simps] = is_functor.cf_comp_cf_cf_0

subsection\<open>Empty natural transformation\<close>

subsubsection\<open>Definition and elementary properties\<close>

text\<open>See Chapter X-1 in \<^cite>\<open>"mac_lane_categories_2010"\<close>.\<close>

definition ntcf_0 :: "V \<Rightarrow> V"
  where "ntcf_0 \<CC> = [0, cf_0 \<CC>, cf_0 \<CC>, cat_0, \<CC>]\<^sub>\<circ>"

text\<open>Components.\<close>

lemma ntcf_0_components:
  shows "ntcf_0 \<CC>\<lparr>NTMap\<rparr> = 0"
    and [cat_cs_simps]: "ntcf_0 \<CC>\<lparr>NTDom\<rparr> = cf_0 \<CC>"
    and [cat_cs_simps]: "ntcf_0 \<CC>\<lparr>NTCod\<rparr> = cf_0 \<CC>"
    and [cat_cs_simps]: "ntcf_0 \<CC>\<lparr>NTDGDom\<rparr> = cat_0"
    and [cat_cs_simps]: "ntcf_0 \<CC>\<lparr>NTDGCod\<rparr> = \<CC>"
  unfolding ntcf_0_def nt_field_simps by (simp_all add: nat_omega_simps)

text\<open>Slicing.\<close>

lemma ntcf_ntsmcf_ntcf_0: "ntcf_ntsmcf (ntcf_0 \<AA>) = ntsmcf_0 (cat_smc \<AA>)"
  unfolding
    ntcf_ntsmcf_def ntcf_0_def ntsmcf_0_def cat_smc_def
    cf_smcf_def smcf_0_def cf_0_def cat_0_def smc_0_def
    dg_field_simps dghm_field_simps nt_field_simps
  by (simp add: nat_omega_simps)

text\<open>Duality.\<close>

lemma op_ntcf_ntcf_0: "op_ntcf (ntcf_0 \<CC>) = ntcf_0 (op_cat \<CC>)"
  by
    (
      simp_all add:
        op_ntcf_def ntcf_0_def op_cat_def op_cf_cf_0 cat_0_def
        nt_field_simps dg_field_simps nat_omega_simps
    )

subsubsection\<open>Natural transformation map\<close>

lemma ntcf_0_NTMap_vsv[cat_cs_intros]: "vsv (ntcf_0 \<CC>\<lparr>NTMap\<rparr>)"
  unfolding ntcf_0_components by simp

lemma ntcf_0_NTMap_vdomain[cat_cs_simps]: "\<D>\<^sub>\<circ> (ntcf_0 \<CC>\<lparr>NTMap\<rparr>) = 0"
  unfolding ntcf_0_components by simp

lemma ntcf_0_NTMap_vrange[cat_cs_simps]: "\<R>\<^sub>\<circ> (ntcf_0 \<CC>\<lparr>NTMap\<rparr>) = 0"
  unfolding ntcf_0_components by simp

subsubsection\<open>Empty natural transformation is a natural transformation\<close>

lemma (in category) cat_ntcf_0_is_ntcfI:
  "ntcf_0 \<CC> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
proof(intro is_ntcfI)
  show "vfsequence (ntcf_0 \<CC>)" unfolding ntcf_0_def by simp
  show "vcard (ntcf_0 \<CC>) = 5\<^sub>\<nat>"
    unfolding ntcf_0_def by (simp add: nat_omega_simps)
  show "ntcf_ntsmcf (ntcf_0 \<CC>) :
    cf_smcf (cf_0 \<CC>) \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F cf_smcf (cf_0 \<CC>) :
    cat_smc cat_0 \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
    unfolding ntcf_ntsmcf_ntcf_0 cf_smcf_cf_0 cat_smc_cat_0
    by (cs_concl cs_shallow cs_intro: smc_cs_intros slicing_intros)
qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

lemma (in category) cat_ntcf_0_is_ntcfI'[cat_cs_intros]:
  assumes "\<FF>' = cf_0 \<CC>"
    and "\<GG>' = cf_0 \<CC>"
    and "\<AA>' = cat_0"
    and "\<BB>' = \<CC>"
    and "\<FF>' = \<FF>"
    and "\<GG>' = \<GG>"
  shows "ntcf_0 \<CC> : \<FF>' \<mapsto>\<^sub>C\<^sub>F \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>'"
  unfolding assms by (rule cat_ntcf_0_is_ntcfI)

lemmas [cat_cs_intros] = category.cat_ntcf_0_is_ntcfI'

lemma is_ntcf_is_ntcf_0_if_cat_0:
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
  shows "\<NN> = ntcf_0 \<CC>" and "\<FF> = cf_0 \<CC>" and "\<GG> = cf_0 \<CC>"
proof-
  interpret \<NN>: is_ntcf \<alpha> cat_0 \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
  note is_ntsmcf_is_ntsmcf_0_if_smc_0 = is_ntsmcf_is_ntsmcf_0_if_smc_0
    [
      OF \<NN>.ntcf_is_ntsmcf[unfolded cat_smc_cat_0],
      folded smcf_dghm_smcf_0 ntsmcf_tdghm_ntsmcf_0
    ]
  show \<FF>_def: "\<FF> = cf_0 \<CC>" and \<GG>_def: "\<GG> = cf_0 \<CC>"
    by (all\<open>intro is_functor_is_cf_0_if_cat_0\<close>)
      (cs_concl cs_shallow cs_intro: cat_cs_intros)+
  show "\<NN> = ntcf_0 \<CC>"
  proof(rule ntcf_ntsmcf_eqI)
    show "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (rule assms(1))
    show "ntcf_0 \<CC> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
      by (cs_concl cs_shallow cs_simp: \<FF>_def \<GG>_def cs_intro: cat_cs_intros)
  qed
    (
      simp_all add:
        \<FF>_def \<GG>_def is_ntsmcf_is_ntsmcf_0_if_smc_0 ntcf_ntsmcf_ntcf_0
    )
qed

subsubsection\<open>Further properties\<close>

lemma ntcf_vcomp_ntcf_ntcf_0[cat_cs_simps]:
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
  shows "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<CC> = ntcf_0 \<CC>"
proof(rule ntcf_ntsmcf_eqI)
  interpret \<NN>: is_ntcf \<alpha> cat_0 \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
  show "\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<CC> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
    unfolding is_ntcf_is_ntcf_0_if_cat_0[OF assms]
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  show "ntcf_0 \<CC> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  show "ntcf_ntsmcf (\<NN> \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F ntcf_0 \<CC>) = ntcf_ntsmcf (ntcf_0 \<CC>)"
    unfolding
      slicing_commute[symmetric]
      ntsmcf_vcomp_ntsmcf_ntsmcf_0
        [
          OF \<NN>.ntcf_is_ntsmcf[unfolded cat_smc_cat_0],
          folded ntcf_ntsmcf_ntcf_0
        ]
      ..
qed simp_all

lemma ntcf_vcomp_ntcf_0_ntcf[cat_cs_simps]:
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>C\<^sub>F \<GG> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
  shows "ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> = ntcf_0 \<CC>"
proof(rule ntcf_ntsmcf_eqI)
  interpret \<NN>: is_ntcf \<alpha> cat_0 \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
  show "ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
    unfolding is_ntcf_is_ntcf_0_if_cat_0[OF assms]
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  show "ntcf_0 \<CC> : cf_0 \<CC> \<mapsto>\<^sub>C\<^sub>F cf_0 \<CC> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  show "ntcf_ntsmcf (ntcf_0 \<CC> \<bullet>\<^sub>N\<^sub>T\<^sub>C\<^sub>F \<NN>) = ntcf_ntsmcf (ntcf_0 \<CC>)"
    unfolding
      slicing_commute[symmetric]
      ntsmcf_vcomp_ntsmcf_0_ntsmcf
        [
          OF \<NN>.ntcf_is_ntsmcf[unfolded cat_smc_cat_0],
          folded ntcf_ntsmcf_ntcf_0
        ]
      ..
  qed simp_all

lemma (in is_functor) cf_ntcf_comp_cf_ntcf_0[cat_cs_simps]:
  "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<AA> = ntcf_0 \<BB>"
proof(rule ntcf_eqI)
  show "\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<AA> : cf_0 \<BB> \<mapsto>\<^sub>C\<^sub>F cf_0 \<BB> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have dom_lhs: "\<D>\<^sub>\<circ> ((\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<AA>)\<lparr>NTMap\<rparr>) = cat_0\<lparr>Obj\<rparr>"
    by (cs_concl cs_simp: cat_cs_simps)
  show "ntcf_0 \<BB> : cf_0 \<BB> \<mapsto>\<^sub>C\<^sub>F cf_0 \<BB> : cat_0 \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have dom_rhs: "\<D>\<^sub>\<circ> (ntcf_0 \<BB>\<lparr>NTMap\<rparr>) = cat_0\<lparr>Obj\<rparr>"
    by (cs_concl cs_simp: cat_cs_simps)
  show "(\<FF> \<circ>\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>C\<^sub>F ntcf_0 \<AA>)\<lparr>NTMap\<rparr> = ntcf_0 \<BB>\<lparr>NTMap\<rparr>"
    by (rule vsv_eqI, unfold dom_lhs dom_rhs)
      (auto simp: cat_0_components intro!: cat_cs_intros)+
qed simp_all

lemmas [cat_cs_simps] = is_functor.cf_ntcf_comp_cf_ntcf_0

subsection\<open>\<open>1\<close>: category with one object and one arrow\<close>

subsubsection\<open>Definition and elementary properties\<close>

text\<open>See Chapter I-2 in \<^cite>\<open>"mac_lane_categories_2010"\<close>.\<close>

definition cat_1 :: "V \<Rightarrow> V \<Rightarrow> V"
  where "cat_1 \<aa> \<ff> =
    [
      set {\<aa>},
      set {\<ff>},
      set {\<langle>\<ff>, \<aa>\<rangle>},
      set {\<langle>\<ff>, \<aa>\<rangle>},
      set {\<langle>[\<ff>, \<ff>]\<^sub>\<circ>, \<ff>\<rangle>},
      set {\<langle>\<aa>, \<ff>\<rangle>}
    ]\<^sub>\<circ>"

text\<open>Components.\<close>

lemma cat_1_components:
  shows "cat_1 \<aa> \<ff>\<lparr>Obj\<rparr> = set {\<aa>}"
    and "cat_1 \<aa> \<ff>\<lparr>Arr\<rparr> = set {\<ff>}"
    and "cat_1 \<aa> \<ff>\<lparr>Dom\<rparr> = set {\<langle>\<ff>, \<aa>\<rangle>}"
    and "cat_1 \<aa> \<ff>\<lparr>Cod\<rparr> = set {\<langle>\<ff>, \<aa>\<rangle>}"
    and "cat_1 \<aa> \<ff>\<lparr>Comp\<rparr> = set {\<langle>[\<ff>, \<ff>]\<^sub>\<circ>, \<ff>\<rangle>}"
    and "cat_1 \<aa> \<ff>\<lparr>CId\<rparr> = set {\<langle>\<aa>, \<ff>\<rangle>}"
  unfolding cat_1_def dg_field_simps by (simp_all add: nat_omega_simps)

text\<open>Slicing.\<close>

lemma smc_cat_1: "cat_smc (cat_1 \<aa> \<ff>) = smc_1 \<aa> \<ff>"
  unfolding cat_smc_def cat_1_def smc_1_def dg_field_simps
  by (simp add: nat_omega_simps)

lemmas_with [folded smc_cat_1, unfolded slicing_simps]:
  cat_1_is_arrI = smc_1_is_arrI
  and cat_1_is_arrD = smc_1_is_arrD
  and cat_1_is_arrE = smc_1_is_arrE
  and cat_1_is_arr_iff = smc_1_is_arr_iff
  and cat_1_Comp_app[cat_cs_simps] = smc_1_Comp_app

subsubsection\<open>Object\<close>

lemma cat_1_ObjI[cat_cs_intros]:
  assumes "a = \<aa>"
  shows "a \<in>\<^sub>\<circ> cat_1 \<aa> \<ff> \<lparr>Obj\<rparr>"
  unfolding cat_1_components(1) assms by simp

subsubsection\<open>Identity\<close>

lemma cat_1_CId_app: "cat_1 \<aa> \<ff>\<lparr>CId\<rparr>\<lparr>\<aa>\<rparr> = \<ff>"
  unfolding cat_1_components by simp

subsubsection\<open>\<open>1\<close> is a category\<close>

lemma (in \<Z>) category_cat_1:
  assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "category \<alpha> (cat_1 \<aa> \<ff>)"
proof(intro categoryI, unfold smc_cat_1)
  show "vfsequence (cat_1 \<aa> \<ff>)"
    unfolding cat_1_def by (simp add: nat_omega_simps)
  show "vcard (cat_1 \<aa> \<ff>) = 6\<^sub>\<nat>"
    unfolding cat_1_def by (simp add: nat_omega_simps)
qed (auto simp: assms semicategory_smc_1 cat_1_is_arr_iff cat_1_components)

lemmas [cat_cs_intros] = \<Z>.category_cat_1

lemma (in \<Z>) finite_category_cat_1:
  assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "finite_category \<alpha> (cat_1 \<aa> \<ff>)"
  by (intro finite_categoryI')
    (auto simp: cat_1_components intro: category_cat_1[OF assms])

lemmas [cat_small_cs_intros] = \<Z>.finite_category_cat_1

subsubsection\<open>Opposite of the category \<open>1\<close>\<close>

lemma (in \<Z>) cat_1_op[cat_op_simps]:
  assumes "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>" and "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "op_cat (cat_1 \<aa> \<ff>) = cat_1 \<aa> \<ff>"
proof(rule cat_eqI, unfold cat_op_simps)
  from assms show "category \<alpha> (op_cat (cat_1 \<aa> \<ff>))"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
  from assms show "category \<alpha> (cat_1 \<aa> \<ff>)"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  show "op_cat (cat_1 \<aa> \<ff>)\<lparr>Comp\<rparr> = cat_1 \<aa> \<ff>\<lparr>Comp\<rparr>"
    unfolding cat_1_components op_cat_components fflip_vsingleton ..
qed (simp_all add: cat_1_components)

lemma (in \<Z>) cat_1_op_0[cat_op_simps]: "op_cat (cat_1 0 0) = cat_1 0 0"
  by
    (
      cs_concl cs_shallow
        cs_simp: cat_op_simps cs_intro: V_cs_intros cat_cs_intros
    )

subsubsection\<open>Further properties\<close>

lemma cf_const_if_HomCod_is_cat_1:
  assumes "\<KK> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
  shows "\<KK> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>"
proof(rule cf_eqI)
  interpret \<KK>: is_functor \<alpha> \<BB> \<open>cat_1 \<aa> \<ff>\<close> \<KK> by (rule assms(1))
  show "cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> cat_1 \<aa> \<ff>"
    by (cs_concl cs_intro: cat_cs_intros)
  have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>" by (simp add: cat_cs_simps)
  have ObjMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>) = \<BB>\<lparr>Obj\<rparr>"
    by (simp add: cat_cs_simps)
  have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>" by (simp add: cat_cs_simps)
  have ArrMap_dom_rhs: "\<D>\<^sub>\<circ> (cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>) = \<BB>\<lparr>Arr\<rparr>"
    by (simp add: cat_cs_simps)
  show "\<KK>\<lparr>ObjMap\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Obj\<rparr>"
    then have "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> cat_1 \<aa> \<ff>\<lparr>Obj\<rparr>"
      by (auto intro: \<KK>.cf_ObjMap_app_in_HomCod_Obj)
    then have "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = \<aa>" by (auto simp: cat_1_components)
    with prems show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
      by (auto simp: cat_cs_simps)
  qed (auto intro: cat_cs_intros)
  show "\<KK>\<lparr>ArrMap\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix a assume prems: "a \<in>\<^sub>\<circ> \<BB>\<lparr>Arr\<rparr>"
    then have "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> \<in>\<^sub>\<circ> cat_1 \<aa> \<ff>\<lparr>Arr\<rparr>"
      by (auto intro: \<KK>.cf_ArrMap_app_in_HomCod_Arr)
    then have "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = \<ff>" by (auto simp: cat_1_components)
    with prems show "\<KK>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr> = cf_const \<BB> (cat_1 \<aa> \<ff>) \<aa>\<lparr>ArrMap\<rparr>\<lparr>a\<rparr>"
      by (auto simp: cat_1_CId_app cat_cs_simps)
  qed (auto intro: cat_cs_intros)
qed (simp_all add: assms)

lemma cf_const_if_HomDom_is_cat_1:
  assumes "\<KK> : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
  shows "\<KK> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)"
proof-

  interpret \<KK>: is_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<CC> \<KK> by (rule assms(1))

  from cat_1_components(1) have \<aa>: "\<aa> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (auto simp: \<KK>.HomDom.cat_in_Obj_in_Vset)
  from cat_1_components(2) have \<ff>: "\<ff> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (auto simp: \<KK>.HomDom.cat_in_Arr_in_Vset)

  from \<aa> \<ff> interpret cf_1:
    is_tm_functor \<alpha> \<open>cat_1 \<aa> \<ff>\<close> \<CC> \<open>cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<close>
    by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)

  show ?thesis
  proof(rule cf_eqI)
    show "cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>) : cat_1 \<aa> \<ff> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>"
      by (cs_concl cs_shallow cs_intro: cat_cs_intros)
    have ObjMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ObjMap\<rparr>) = set {\<aa>}"
      by (simp add: cat_cs_simps cat_1_components)
    have ObjMap_dom_rhs:
      "\<D>\<^sub>\<circ> (cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>) = set {\<aa>}"
      by (simp add: cat_cs_simps cat_1_components)
    show "\<KK>\<lparr>ObjMap\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix a assume "a \<in>\<^sub>\<circ> set {\<aa>}"
      then have a_def: "a = \<aa>" by simp
      show "\<KK>\<lparr>ObjMap\<rparr>\<lparr>a\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ObjMap\<rparr>\<lparr>a\<rparr>"
        by
          (
            cs_concl cs_shallow
              cs_simp: cat_1_components(1) cat_cs_simps a_def
              cs_intro: V_cs_intros
          )
    qed auto

    have ArrMap_dom_lhs: "\<D>\<^sub>\<circ> (\<KK>\<lparr>ArrMap\<rparr>) = set {\<ff>}"
      by (simp add: cat_cs_simps cat_1_components)
    have ArrMap_dom_rhs:
      "\<D>\<^sub>\<circ> (cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>) = set {\<ff>}"
      by (simp add: cat_cs_simps cat_1_components)

    show "\<KK>\<lparr>ArrMap\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix f assume "f \<in>\<^sub>\<circ> set {\<ff>}"
      then have f_def: "f = \<ff>" by simp
      show "\<KK>\<lparr>ArrMap\<rparr>\<lparr>f\<rparr> = cf_const (cat_1 \<aa> \<ff>) \<CC> (\<KK>\<lparr>ObjMap\<rparr>\<lparr>\<aa>\<rparr>)\<lparr>ArrMap\<rparr>\<lparr>f\<rparr>"
        unfolding f_def
        by (subst cat_1_CId_app[symmetric, of \<ff> \<aa>])
          (
            cs_concl cs_shallow
              cs_simp: cat_1_components(1,2) cat_cs_simps
              cs_intro: V_cs_intros cat_cs_intros
          )
    qed auto

  qed (simp_all add: assms)

qed

text\<open>\newpage\<close>

end


theory "FMap-Join"
imports "FMap-HOLCF" "HOLCF-Join"
begin

default_sort type

subsubsection {* Binary joins of finite maps *}

lemma fdom_join[simp]:
  "compatible m1 m2 \<Longrightarrow> fdom (m1 \<squnion> m2) = fdom m1"
  by (metis join_above1 fmap_below_dom)

lemma fdom_compatible:
  "compatible m1 m2 \<Longrightarrow> fdom m1 = fdom m2"
by (metis join_above1 join_above2 fmap_below_dom)

lemma the_lookup_compatible_and_join:
  assumes "compatible m1 m2"
  assumes [simp]: "x \<in> fdom m1"
  shows "compatible (m1 f! x) (m2 f! x) \<and> (m1 f! x) \<squnion> (m2 f! x) = (m1 \<squnion> m2) f! x"
proof (rule is_join_and_compatible)
  show "m1 f! x \<sqsubseteq> (m1 \<squnion> m2) f! x"
    by (rule fmap_belowE[OF join_above1[OF `compatible m1 m2`]])
  show "m2 f! x \<sqsubseteq> (m1 \<squnion> m2) f! x"
    by (rule fmap_belowE[OF join_above2[OF `compatible m1 m2`]])
  fix a
  assume "m1 f! x \<sqsubseteq> a"
  assume "m2 f! x \<sqsubseteq> a"

  note fdom_compatible[OF `compatible m1 m2`, symmetric, simp]
  note fdom_join[OF `compatible m1 m2`, simp]

  have "m1 \<sqsubseteq> (m1 \<squnion> m2)(x f\<mapsto> a)"
    apply (rule fmap_upd_belowI2)
    apply auto[1]
    apply (rule fmap_belowE[OF join_above1[OF `compatible m1 m2`]])
    apply (rule `m1 f! x \<sqsubseteq> a`)
    done
  moreover
  have "m2 \<sqsubseteq> (m1 \<squnion> m2)(x f\<mapsto> a)"
    apply (rule fmap_upd_belowI2)
    apply auto[1]
    apply (rule fmap_belowE[OF join_above2[OF `compatible m1 m2`]])
    apply (rule `m2 f! x \<sqsubseteq> a`)
    done
  ultimately
  have "(m1 \<squnion> m2) \<sqsubseteq> (m1 \<squnion> m2)(x f\<mapsto> a)"
    by (rule join_below[OF `compatible m1 m2`])
  thus " m1 \<squnion> m2 f! x \<sqsubseteq> a"
    by (metis (full_types) fmap_belowE the.simps lookup_fmap_upd)
qed

lemma the_lookup_join[simp]:
  assumes "compatible m1 m2"
  shows "(m1 \<squnion> m2) f! x = (m1 f! x) \<squnion> (m2 f! x)"
  apply (cases "x \<in> fdom m1")
  apply (metis assms the_lookup_compatible_and_join)
  apply (metis assms fdomIff fdom_compatible fdom_join join_self)
  done

lemma fmap_lookup_bot_join[simp]:
  assumes "compatible m1 m2"
  shows "(m1 \<squnion> m2) f!\<^sub>\<bottom> x = (m1 f!\<^sub>\<bottom> x) \<squnion> (m2 f!\<^sub>\<bottom> x)"
  apply (cases "x \<in> fdom m1")
  apply (metis assms fdom_compatible fdom_join fmap_lookup_bot_simps(1) the_lookup_join)
  apply (metis assms fdom_compatible fdom_join fmap_lookup_bot_simps(3) join_bottom(2))
  done

lemma the_lookup_compatible:
  assumes "compatible m1 m2"
  shows "compatible (m1 f! x) (m2 f! x)"
  apply (cases "x \<in> fdom m1")
  apply (metis assms the_lookup_compatible_and_join)
  apply (metis assms compatible_refl fdomIff fdom_compatible)
  done

lift_definition fmap_join :: "'a f\<rightharpoonup> 'b::cpo \<Rightarrow> 'a f\<rightharpoonup> 'b  \<Rightarrow> 'a f\<rightharpoonup> 'b"
is "\<lambda>m1 m2 x. (if x \<in> fdom m1 then Some ((m1 f! x) \<squnion> (m2 f! x)) else None)"
  by (auto simp add: dom_def)

lemma fdom_fmap_join'[simp]: "fdom (fmap_join m1 m2) = fdom m1"
  apply (subst fdom.rep_eq)
  apply (subst fmap_join.rep_eq)
  apply (auto, metis not_Some_eq)
  done

lemma the_lookup_fmap_join'[simp]: "x \<in> fdom m1 \<Longrightarrow> (fmap_join m1 m2) f! x = (m1 f! x) \<squnion> (m2 f! x)"
  apply (subst lookup.rep_eq)
  apply (subst fmap_join.rep_eq)
  apply simp
  done

lemma compatible_fmapI:
  assumes "\<And> x. \<lbrakk> x \<in> fdom m1 ; x \<in> fdom m2 \<rbrakk> \<Longrightarrow> compatible (m1 f! x) (m2 f! x)"
  assumes "fdom m1 = fdom m2"
  shows "compatible m1 m2"
proof (rule compatibleI)
  show "m1 \<sqsubseteq> fmap_join m1 m2"
    apply (rule fmap_belowI)
    apply simp
    apply simp
    by (metis "HOLCF-Join.join_above1" assms(1) assms(2))
  show "m2 \<sqsubseteq> fmap_join m1 m2"
    apply (rule fmap_belowI)
    apply (simp add: assms(2))
    apply (simp add: assms(2))
    by (metis "HOLCF-Join.join_above2" assms(1) assms(2))
  fix a
  assume "m1 \<sqsubseteq> a"
  assume "m2 \<sqsubseteq> a"
  show "fmap_join m1 m2 \<sqsubseteq> a"
    apply (rule fmap_belowI)
    apply (metis fdom_fmap_join' fmap_below_dom[OF `m1 \<sqsubseteq> a`])
    apply (metis fmap_belowE[OF `m1 \<sqsubseteq> a`] fmap_belowE[OF `m2 \<sqsubseteq> a`] assms(1) assms(2) fdom_fmap_join' join_below the_lookup_fmap_join')
    done
qed

lemma fmap_restr_join:
  assumes [simp]: "finite S"
  assumes [simp]:"compatible m1 m2"
  shows "fmap_restr S (m1 \<squnion> m2) = fmap_restr S m1 \<squnion> fmap_restr S m2"
proof-
  have [simp]: "compatible (fmap_restr S m1) (fmap_restr S m2)"
    by (auto intro!: compatible_fmapI simp add: the_lookup_compatible fdom_compatible[OF assms(2)])
  show ?thesis
    by (rule fmap_eqI, auto)
qed

lemma fmap_upd_join:
  assumes "S = insert x (fdom \<rho>1)"
  and "x \<notin> fdom \<rho>1"
  and "x \<notin> fdom \<rho>2"
  and compat1: "compatible (\<rho>1(x f\<mapsto> y)) (\<rho>2\<^bsub>[S]\<^esub>)"
  shows "(\<rho>1(x f\<mapsto> y)) \<squnion> (\<rho>2\<^bsub>[S]\<^esub>) = (\<rho>1 \<squnion> (\<rho>2\<^bsub>[S - {x}]\<^esub>))(x f\<mapsto> y)" (is "?L = ?R")
proof(rule fmap_eqI)
  have "finite S" using assms(1) by auto

  have *: "\<And> xa . xa \<in> S \<Longrightarrow> xa \<noteq> x \<Longrightarrow> \<rho>2\<^bsub>[S - {x}]\<^esub> f! xa = \<rho>2\<^bsub>[S]\<^esub> f! xa"
    using `finite S` by (case_tac "xa \<in> fdom \<rho>2", auto)

  have compat2: "compatible \<rho>1 (\<rho>2\<^bsub>[S - {x}]\<^esub>)"
    apply (rule compatible_fmapI)
    using compat1
    apply -
    apply (drule_tac x = xa in the_lookup_compatible)
    apply (subst *)
    using assms(1) apply simp
    apply (metis assms(2))

    apply (subst (asm) lookup_fmap_upd_other)
    apply (metis `x \<notin> fdom \<rho>1`)
    apply assumption
    using assms(2) assms(1)
    by auto

  show "fdom ?L = fdom ?R"
    using compat1 compat2 by auto
  fix y
  assume "y \<in> fdom ?L"
  hence "y \<in> S" by (metis assms(1) compat1 fdom_join fmap_upd_fdom)
  show "?L f! y = ?R f! y"
  proof(cases "y = x")
    case True
    thus ?thesis
      apply (subst the_lookup_join[OF compat1])
      apply (subst lookup_fmap_expand2[OF `finite S` `y\<in> S`])
      using `x \<notin> fdom \<rho>2` compat2  `y\<in> S`
      by auto
  next
    case False
    thus ?thesis
      apply simp
      apply (subst the_lookup_join[OF compat1], auto)
      apply (subst the_lookup_join[OF compat2])
      apply (case_tac "y \<in> fdom \<rho>2")
      using `finite S`  `y \<in> S`
      by auto
  qed
qed

lemma fmap_expand_join_disjunct:
  assumes "fdom m1 \<inter> fdom m2 = {}"
  shows "m1\<^bsub>[fdom m1 \<union> fdom m2]\<^esub> \<squnion> m2\<^bsub>[fdom m1 \<union> fdom m2]\<^esub> = m1 f++ m2"
proof-
  from assms(1) have disj: "\<And> x. x \<in> fdom m1 \<Longrightarrow> x \<notin> fdom m2" "\<And> x. x \<in> fdom m2 \<Longrightarrow> x \<notin> fdom m1" by auto
  have [simp]:"compatible (m1\<^bsub>[fdom m1 \<union> fdom m2]\<^esub>) (m2\<^bsub>[fdom m1 \<union> fdom m2]\<^esub>)"
    by (fastforce intro: compatible_fmapI simp add: disj)
  show ?thesis by (fastforce simp add: disj)
qed

subsubsection {* Finite maps have greatest lowest bounds *}

instance fmap :: (type, Nonempty_Meet_cpo) Bounded_Nonempty_Meet_cpo
apply default
proof-
  fix S :: "('a f\<rightharpoonup> 'b) set"
  assume "S \<noteq> {}" and "\<exists>z. S >| z"
  then obtain b where "\<And> m. m\<in>S \<Longrightarrow> b \<sqsubseteq> m" by (metis is_lbD)
  hence [simp]:"\<And> m. m \<in> S \<Longrightarrow> fdom m = fdom b" by (metis fmap_below_dom)

  obtain f where f: "\<And> x. x \<in> fdom b \<Longrightarrow> (\<lambda>m . m f! x) ` S >>| f x "
  proof-
    {
    fix x
    assume "x \<in> fdom b"
    have "(\<lambda>m . m f! x) ` S \<noteq> {}" using `S \<noteq> {}` by auto
    then obtain l where  "(\<lambda>m . m f! x) ` S >>| l" by (metis nonempty_meet_exists)
    hence "(\<lambda>m . m f! x) ` S >>| (SOME l. (\<lambda>m . m f! x) ` S >>| l)"
      by (rule someI)
    }
    thus ?thesis by (rule that)
  qed

  let ?zm = "\<lambda> x. if x \<in> fdom b then Some (f x) else None"
  have "dom ?zm = fdom b" by (auto simp add: dom_def)

  obtain z where [simp]: "fdom z = fdom b" and z: "\<And> x m . x \<in> fdom b \<Longrightarrow> (\<lambda>m . m f! x) ` S >>| (z f! x)"
  proof-
    show ?thesis
      apply (rule that[of "Abs_fmap ?zm"])
      apply (subst fdom.rep_eq)
      apply (subst  Abs_fmap_inverse)
      prefer 3
      apply (subst (2) lookup.rep_eq)
      apply (subst  Abs_fmap_inverse)
      apply (auto simp add: dom_def)
      apply (erule f)
      done
  qed

  have "S >>| z"
    apply (rule is_glbI)
    apply (rule is_lbI)
    apply (rule fmap_belowI)
    apply simp
    apply (rule is_lbD)
    apply (rule is_glbD1)
    apply (rule z, simp)
    apply auto
    apply (rule fmap_belowI)
    apply (metis `S \<noteq> {}` `\<And>m. m \<in> S \<Longrightarrow> fdom m = fdom b` `fdom z = fdom b` all_not_in_conv fmap_below_dom is_lbD)
    apply (rule is_glbD2)
    apply (rule z, simp)
    apply (rule is_lbI)
    apply (erule imageE)
    apply (erule ssubst)
    apply (rule fmap_belowE)
    apply (erule (1) is_lbD)
    done
  thus "\<exists> z. S >>| z" by auto
qed

lemma fmap_empty_join[simp]: "fdom f = S \<Longrightarrow> f\<emptyset>\<^bsub>[S]\<^esub> \<squnion> f = f"
  by (metis fmap_bottom_below larger_is_join2)

lemma bottom_of_fdom[simp]: "finite S \<Longrightarrow> bottom_of {y. fdom y = S} = f\<emptyset>\<^bsub>[S]\<^esub>"
  using bottom_of_cone_above[where x = "f\<emptyset>\<^bsub>[S]\<^esub>"]
  by simp
end


section \<open>Outer Algorithm\label{sec:outer_algorithm}\<close>

text \<open>This section introduces the final solution with optimal size space usage. Internally it relies
on the inner algorithm described in Section~\ref{sec:inner_algorithm}, dependending on the
paramaters $n$, $\varepsilon$ and $\delta$ it either uses the inner algorithm directly or if
$\varepsilon^{-1}$ is larger than $\ln n$ it runs $\frac{\varepsilon^{-1}}{\ln \ln n}$ copies of the
inner algorithm (with the modified failure probability $\frac{1}{\ln n}$) using an expander to
select its seeds. The theorems below verify that the probability that the relative
accuracy of the median of the copies is too large is below $\varepsilon$.\<close>

theory Distributed_Distinct_Elements_Outer_Algorithm
  imports
    Distributed_Distinct_Elements_Accuracy
    Prefix_Free_Code_Combinators.Prefix_Free_Code_Combinators
    Frequency_Moments.Landau_Ext
    Landau_Symbols.Landau_More
begin

unbundle intro_cong_syntax

text \<open>The following are non-asymptotic hard bounds on the space usage for the sketches and seeds
repsectively. The end of this section contains a proof the sum is asymptotically in
$\mathcal O(\ln( \varepsilon^{-1}) \delta^{-1} + \ln n)$.\<close>

definition "state_space_usage = (\<lambda>(n,\<delta>,\<epsilon>). 2^40 * (ln(1/\<epsilon>)+1)/ \<delta>^2 + log 2 (log 2 n + 3))"
definition "seed_space_usage = (\<lambda>(n,\<delta>,\<epsilon>). 2^30 + 2^23*ln n+48*(log 2(1/\<delta>)+16)\<^sup>2 + 336*ln (1/\<epsilon>))"

locale outer_algorithm =
  fixes n :: nat
  fixes \<epsilon> :: real
  fixes \<delta> :: real
  assumes n_gt_0: "n > 0"
  assumes \<epsilon>_gt_0: "\<epsilon> > 0" and \<epsilon>_lt_1: "\<epsilon> < 1"
  assumes \<delta>_gt_0: "\<delta> > 0" and \<delta>_lt_1: "\<delta> < 1"
begin

definition n\<^sub>0 where "n\<^sub>0 = max (real n) (exp (exp 5))"
definition stage_two where "stage_two = (\<epsilon> < (1/ln n\<^sub>0))"
definition \<epsilon>\<^sub>i :: real where "\<epsilon>\<^sub>i = (if stage_two then (1/ln n\<^sub>0) else \<epsilon>)"
definition m :: nat where "m = (if stage_two then nat \<lceil>4 * ln (1/ \<epsilon>)/ln (ln n\<^sub>0)\<rceil> else 1)"
definition \<alpha> where "\<alpha> = (if stage_two then (1/ln n\<^sub>0) else 1)"

lemma m_lbound:
  assumes "stage_two"
  shows "m \<ge> 4 * ln (1/ \<epsilon>)/ln(ln n\<^sub>0)"
proof -
  have "m = real (nat \<lceil>4 * ln (1 / \<epsilon>) / ln (ln n\<^sub>0)\<rceil>)"
    using assms unfolding m_def by simp
  also have "... \<ge> 4 * ln (1 / \<epsilon>) / ln (ln n\<^sub>0)"
    by linarith
  finally show ?thesis by simp
qed

lemma n_lbound:
  "n\<^sub>0 \<ge> exp (exp 5)" "ln n\<^sub>0 \<ge> exp 5" "5 \<le> ln (ln n\<^sub>0)" "ln n\<^sub>0 > 1" "n\<^sub>0 > 1"
proof -
  show 0:"n\<^sub>0 \<ge> exp (exp 5)"
    unfolding n\<^sub>0_def by simp
  have "(1::real) \<le> exp (exp 5)"
    by (approximation 5)
  hence "n\<^sub>0 \<ge> 1"
    using 0 by argo
  thus 1:"ln n\<^sub>0 \<ge> exp 5"
    using 0 by (intro iffD2[OF ln_ge_iff]) auto
  moreover have "1 < exp (5::real)"
    by (approximation 5)
  ultimately show 2:"ln n\<^sub>0 > 1"
    by argo
  show "5 \<le> ln (ln n\<^sub>0)"
    using 1 2 by (subst ln_ge_iff) simp
  have "(1::real) < exp (exp 5)"
    by (approximation 5)
  thus "n\<^sub>0 > 1"
    using 0 by argo
qed

lemma \<epsilon>1_gt_0: "0 < \<epsilon>\<^sub>i"
  using n_lbound(4) \<epsilon>_gt_0 unfolding \<epsilon>\<^sub>i_def
  by (cases "stage_two") simp_all

lemma \<epsilon>1_lt_1: "\<epsilon>\<^sub>i < 1"
  using n_lbound(4) \<epsilon>_lt_1 unfolding \<epsilon>\<^sub>i_def
  by (cases "stage_two") simp_all

lemma m_gt_0_aux:
  assumes "stage_two"
  shows "1 \<le> ln (1 / \<epsilon>) / ln (ln n\<^sub>0)"
proof -
  have "ln n\<^sub>0 \<le> 1 / \<epsilon>"
    using n_lbound(4)
    using assms unfolding pos_le_divide_eq[OF \<epsilon>_gt_0] stage_two_def
    by (simp add:divide_simps ac_simps)
  hence "ln (ln n\<^sub>0) \<le> ln (1 / \<epsilon>)"
    using n_lbound(4) \<epsilon>_gt_0 by (intro iffD2[OF ln_le_cancel_iff] divide_pos_pos) auto
  thus "1 \<le> ln (1 / \<epsilon>) / ln (ln n\<^sub>0)"
    using n_lbound(3)
    by (subst pos_le_divide_eq) auto
qed

lemma m_gt_0: "m > 0"
proof (cases "stage_two")
  case True
  have "0 < 4 * ln (1/ \<epsilon>)/ln(ln n\<^sub>0)"
    using m_gt_0_aux[OF True] by simp
  also have "... \<le> m"
    using m_lbound[OF True] by simp
  finally have "0 < real m"
    by simp
  then show ?thesis by simp
next
  case False
  then show ?thesis unfolding m_def by simp
qed

lemma \<alpha>_gt_0: "\<alpha> > 0"
  using n_lbound(4) unfolding \<alpha>_def
  by (cases "stage_two") auto

lemma \<alpha>_le_1: "\<alpha> \<le> 1"
  using n_lbound(4) unfolding \<alpha>_def
  by (cases "stage_two") simp_all

sublocale I: inner_algorithm "n" "\<epsilon>\<^sub>i" "\<delta>"
  unfolding inner_algorithm_def using n_gt_0 \<delta>_gt_0 \<delta>_lt_1 \<epsilon>1_gt_0 \<epsilon>1_lt_1 by auto

abbreviation \<Theta> where "\<Theta> \<equiv> \<E> m \<alpha> I.\<Omega>"

sublocale \<Theta>: expander_sample_space m \<alpha> I.\<Omega>
  unfolding expander_sample_space_def using I.\<Omega>.sample_space \<alpha>_gt_0 m_gt_0 by auto

type_synonym state = "inner_algorithm.state list"

fun single :: "nat \<Rightarrow> nat \<Rightarrow> state" where
  "single \<theta> x = map (\<lambda>j. I.single (select \<Theta> \<theta> j) x) [0..<m]"

fun merge :: "state \<Rightarrow> state \<Rightarrow> state" where
  "merge x y = map (\<lambda>(x,y). I.merge x y) (zip x y)"

fun estimate :: "state \<Rightarrow> real" where
  "estimate x = median m (\<lambda>i. I.estimate (x ! i))"

definition \<nu> :: "nat \<Rightarrow> nat set \<Rightarrow> state"
  where "\<nu> \<theta> A = map (\<lambda>i. I.\<tau> (select \<Theta> \<theta> i) A) [0..<m]"

text \<open>The following three theorems verify the correctness of the algorithm. The term @{term "\<tau>"}
is a mathematical description of the sketch for a given subset, while @{term "single"},
@{term "merge"} are the actual functions that compute the sketches.\<close>

theorem merge_result: "merge (\<nu> \<omega> A) (\<nu> \<omega> B) = \<nu> \<omega> (A \<union> B)" (is "?L = ?R")
proof -
  have 0: "zip [0..<m] [0..<m] = map (\<lambda>x. (x,x)) [0..<m]" for m
    by (induction m, auto)

  have "?L = map (\<lambda>x. I.merge (I.\<tau> (select \<Theta> \<omega> x) A) (I.\<tau> (select \<Theta> \<omega> x) B)) [0..<m]"
    unfolding \<nu>_def
    by (simp add:zip_map_map 0 comp_def case_prod_beta)
  also have "... = map (\<lambda>x.  I.\<tau> (select \<Theta> \<omega> x) (A \<union> B)) [0..<m]"
    by (intro map_cong I.merge_result \<Theta>.range) auto
  also have "... = ?R"
    unfolding \<nu>_def by simp
  finally show ?thesis by simp
qed

theorem single_result: "single \<omega> x = \<nu> \<omega> {x}" (is "?L = ?R")
proof -
  have "?L = map (\<lambda>j. I.single (select \<Theta> \<omega> j) x) [0..<m]"
    by (simp del:I.single.simps)
  also have "... = ?R"
    unfolding \<nu>_def by (intro map_cong I.single_result \<Theta>.range) auto
  finally show ?thesis by simp
qed

theorem estimate_result:
  assumes "A \<subseteq> {..<n}" "A \<noteq> {}"
  defines "p \<equiv> (pmf_of_set {..<size \<Theta>})"
  shows "measure p {\<omega>. \<bar>estimate (\<nu> \<omega> A)- real (card A)\<bar> > \<delta> * real (card A)} \<le> \<epsilon>" (is "?L \<le> ?R")
proof (cases "stage_two")
  case True
  define I where "I = {x. \<bar>x - real (card A)\<bar> \<le> \<delta> * real (card A)}"
  have int_I: "interval I"
    unfolding interval_def I_def by auto

  define \<mu> where "\<mu> = measure I.\<Omega> {\<omega>. I.estimate (I.\<tau> \<omega> A) \<notin> I}"

  have 0:"\<mu> + \<alpha> > 0"
    unfolding \<mu>_def
    by (intro add_nonneg_pos \<alpha>_gt_0) auto

  have "\<mu> \<le> \<epsilon>\<^sub>i"
    unfolding \<mu>_def I_def using I.estimate_result[OF assms(1,2)]
    by (simp add: not_le del:I.estimate.simps)
  also have "... = 1/ln n\<^sub>0"
    using True unfolding \<epsilon>\<^sub>i_def by simp
  finally have "\<mu> \<le> 1/ln n\<^sub>0" by simp
  hence "\<mu> + \<alpha> \<le> 1/ln n\<^sub>0 + 1/ln n\<^sub>0"
    unfolding \<alpha>_def using True by (intro add_mono) auto
  also have "... = 2/ln n\<^sub>0"
    by simp
  finally have 1:"\<mu> + \<alpha> \<le> 2 / ln n\<^sub>0"
    by simp
  hence 2:"ln n\<^sub>0 \<le> 2 / (\<mu> + \<alpha>)"
    using 0 n_lbound by (simp add:field_simps)

  have "\<mu> + \<alpha> \<le> 2/ln n\<^sub>0"
    by (intro 1)
  also have "... \<le> 2/exp 5"
    using n_lbound by (intro divide_left_mono) simp_all
  also have "... \<le> 1/2"
    by (approximation 5)
  finally have 3:"\<mu> + \<alpha> \<le> 1/2" by simp

  have 4: "2 * ln 2 + 8 * exp (- 1) \<le> (5::real)"
    by (approximation 5)

  have "?L = measure p {\<omega>. median m (\<lambda>i. I.estimate (\<nu> \<omega> A  ! i)) \<notin> I}"
    unfolding I_def by (simp add:not_le)
  also have "... \<le>
    measure p {\<theta>. real (card {i \<in> {..<m}. I.estimate (I.\<tau> (select \<Theta> \<theta> i) A) \<notin> I})\<ge> real m/2}"
  proof (rule pmf_mono)
    fix \<theta> assume "\<theta> \<in> set_pmf p"
    assume a:"\<theta> \<in> {\<omega>. median m (\<lambda>i. I.estimate (\<nu> \<omega> A ! i)) \<notin> I}"
    have "real m = 2 * real m - real m"
      by simp
    also have "... \<le> 2 * real m - 2 * card {i. i < m \<and> I.estimate (\<nu> \<theta> A ! i) \<in> I}"
      using median_est[OF int_I, where n="m"] a
      by (intro diff_left_mono Nat.of_nat_mono)
       (auto simp add:not_less[symmetric] simp del:I.estimate.simps)
    also have "... = 2 * (real (card {..<m}) - card {i. i < m \<and> I.estimate (\<nu> \<theta> A ! i) \<in> I})"
      by (simp del:I.estimate.simps)
    also have "... = 2 * real (card {..<m} - card {i. i < m \<and> I.estimate (\<nu> \<theta> A ! i) \<in> I})"
      by (intro_cong "[\<sigma>\<^sub>2 (*)]" more:of_nat_diff[symmetric] card_mono)
        (auto simp del:I.estimate.simps)
    also have "... = 2 * real (card ({..<m} - {i. i < m \<and> I.estimate (\<nu> \<theta> A ! i) \<in> I}))"
      by (intro_cong "[\<sigma>\<^sub>2 (*), \<sigma>\<^sub>1 of_nat]" more:card_Diff_subset[symmetric])
        (auto simp del:I.estimate.simps)
    also have "... = 2 * real (card {i\<in>{..<m}. I.estimate (\<nu> \<theta> A ! i) \<notin> I})"
      by (intro_cong "[\<sigma>\<^sub>2 (*), \<sigma>\<^sub>1 of_nat, \<sigma>\<^sub>1 card]") (auto simp del:I.estimate.simps)
    also have "... = 2 * real (card {i \<in> {..<m}. I.estimate (I.\<tau> (select \<Theta> \<theta> i) A) \<notin> I})"
      unfolding \<nu>_def by (intro_cong "[\<sigma>\<^sub>2 (*), \<sigma>\<^sub>1 of_nat, \<sigma>\<^sub>1 card]" more:restr_Collect_cong)
       (simp del:I.estimate.simps)
    finally have "real m \<le> 2 * real (card {i \<in> {..<m}. I.estimate (I.\<tau> (select \<Theta> \<theta> i) A) \<notin> I})"
      by simp
    thus "\<theta> \<in> {\<theta>. real m / 2 \<le> real (card {i \<in> {..<m}. I.estimate (I.\<tau> (select \<Theta> \<theta> i) A) \<notin> I})}"
      by simp
  qed
  also have "...=measure \<Theta>{\<theta>. real(card {i \<in> {..<m}. I.estimate (I.\<tau> (\<theta> i) A) \<notin> I})\<ge>(1/2)*real m}"
    unfolding sample_pmf_alt[OF \<Theta>.sample_space] p_def by (simp del:I.estimate.simps)
  also have "... \<le> exp (-real m * ((1/2) * ln (1/ (\<mu> + \<alpha>)) - 2*exp (-1)))"
    using 3 m_gt_0 \<alpha>_gt_0 unfolding \<mu>_def by (intro \<Theta>.tail_bound) force+
  also have "... \<le> exp (-real m * ((1/2) * ln (ln n\<^sub>0 / 2) - 2*exp (-1)))"
    using 0 2 3 n_lbound
    by (intro iffD2[OF exp_le_cancel_iff] mult_right_mono mult_left_mono_neg[where c="-real m"]
        diff_mono mult_left_mono iffD2[OF ln_le_cancel_iff]) (simp_all)
  also have "... = exp (-real m * (ln (ln n\<^sub>0) / 2 - (ln 2/2 + 2*exp (-1))))"
    using n_lbound by (subst ln_div) (simp_all add:algebra_simps)
  also have "... \<le> exp (-real m * (ln (ln n\<^sub>0) / 2 - (ln (ln (exp(exp 5))) / 4)))"
    using 4
    by (intro iffD2[OF exp_le_cancel_iff] mult_left_mono_neg[where c="-real m"] diff_mono) simp_all
  also have "... \<le> exp (-real m * (ln (ln n\<^sub>0) / 2 - (ln (ln n\<^sub>0) / 4)))"
    using n_lbound
    by (intro iffD2[OF exp_le_cancel_iff] mult_left_mono_neg[where c="-real m"] diff_mono) simp_all
  also have "... = exp (- real m * (ln (ln n\<^sub>0)/ 4) )"
    by (simp add:algebra_simps)
  also have "... \<le> exp (- (4 * ln (1/ \<epsilon>)/ln(ln n\<^sub>0)) * (ln (ln n\<^sub>0)/4))"
    using m_lbound[OF True] n_lbound
    by (intro iffD2[OF exp_le_cancel_iff] mult_right_mono divide_nonneg_pos) simp_all
  also have "... = exp (- ln (1/ \<epsilon>))"
    using n_lbound by simp
  also have "... = \<epsilon>"
    using \<epsilon>_gt_0 by (subst ln_inverse[symmetric]) auto
  finally show ?thesis by simp
next
  case False
  have m_eq: "m = 1"
    unfolding m_def using False by simp
  hence "?L = measure p {\<omega>. \<delta> * real (card A) < \<bar>I.estimate (\<nu> \<omega> A ! 0) - real (card A)\<bar>}"
    unfolding estimate.simps m_eq median_def by simp
  also have "... =  measure p {\<omega>. \<delta>*real(card A)<\<bar>I.estimate (I.\<tau> (select \<Theta> \<omega> 0) A)-real(card A)\<bar>}"
    unfolding \<nu>_def m_eq by (simp del: I.estimate.simps)
  also have "... = measure \<Theta> {\<omega>. \<delta>*real(card A) < \<bar>I.estimate (I.\<tau> (\<omega> 0) A)-real(card A)\<bar>}"
    unfolding sample_pmf_alt[OF \<Theta>.sample_space] p_def by (simp del:I.estimate.simps)
  also have "...=
    measure (map_pmf (\<lambda>\<theta>. \<theta> 0) \<Theta>) {\<omega>. \<delta>*real(card A) < \<bar>I.estimate (I.\<tau> \<omega> A)-real(card A)\<bar>}"
    by simp
  also have "... = measure I.\<Omega> {\<omega>. \<delta>*real(card A) < \<bar>I.estimate (I.\<tau> \<omega> A)-real(card A)\<bar>}"
    using m_eq by (subst \<Theta>.uniform_property) auto
  also have "... \<le> \<epsilon>\<^sub>i"
    by (intro I.estimate_result[OF assms(1,2)])
  also have "... = ?R"
    unfolding \<epsilon>\<^sub>i_def using False by simp
  finally show ?thesis
    by simp
qed

text \<open>The function @{term "encode_state"} can represent states as bit strings.
This enables verification of the space usage.\<close>

definition encode_state
  where "encode_state = Lf\<^sub>e I.encode_state m"

lemma encode_state: "is_encoding encode_state"
  unfolding encode_state_def
  by (intro fixed_list_encoding I.encode_state)

lemma state_bit_count:
  "bit_count (encode_state (\<nu> \<omega> A)) \<le> state_space_usage (real n, \<delta>, \<epsilon>)"
    (is "?L \<le> ?R")
proof -
  have 0: "length (\<nu> \<omega> A) = m"
    unfolding \<nu>_def by simp
  have "?L = (\<Sum>x\<leftarrow>\<nu> \<omega> A. bit_count (I.encode_state x))"
    using 0 unfolding encode_state_def fixed_list_bit_count by simp
  also have "... = (\<Sum>x\<leftarrow>[0..<m]. bit_count (I.encode_state (I.\<tau> (select \<Theta> \<omega> x) A)))"
    unfolding \<nu>_def by (simp add:comp_def)
  also have "... \<le> (\<Sum>x\<leftarrow>[0..<m]. ereal (2^36 *(ln (1/\<epsilon>\<^sub>i)+ 1)/\<delta>\<^sup>2 + log 2 (log 2 (real n) + 3)))"
    using I.state_bit_count by (intro sum_list_mono I.state_bit_count \<Theta>.range)
  also have "... = ereal ( real m * (2^36 *(ln (1/\<epsilon>\<^sub>i)+ 1)/\<delta>\<^sup>2 + log 2 (log 2 (real n) + 3)))"
    unfolding sum_list_triv_ereal by simp
  also have "... \<le> 2^40 * (ln(1/\<epsilon>)+1)/ \<delta>^2 + log 2 (log 2 n + 3)" (is "?L1 \<le> ?R1")
  proof (cases "stage_two")
    case True
    have "\<lceil>4*ln (1/\<epsilon>)/ln(ln n\<^sub>0)\<rceil> \<le> 4*ln (1/\<epsilon>)/ln(ln n\<^sub>0) + 1"
      by simp
    also have "... \<le> 4*ln (1/\<epsilon>)/ln(ln n\<^sub>0) + ln (1/\<epsilon>)/ln(ln n\<^sub>0)"
      using m_gt_0_aux[OF True] by (intro add_mono) auto
    also have "... = 5 * ln (1/\<epsilon>)/ln(ln n\<^sub>0)" by simp
    finally have 3: "\<lceil>4*ln (1/\<epsilon>)/ln(ln n\<^sub>0)\<rceil> \<le> 5 * ln (1/\<epsilon>)/ln(ln n\<^sub>0)"
      by simp

    have 4: "0 \<le> log 2 (log 2 (real n) + 3)"
      using n_gt_0
      by (intro iffD2[OF zero_le_log_cancel_iff] add_nonneg_pos) auto

    have 5: "1 / ln 2 + 3 / exp 5 \<le> exp (1::real)"  "1.2 / ln 2 \<le> (2::real)"
      by (approximation 5)+

    have "log 2(log 2 (real n)+3) \<le> log 2 (log 2 n\<^sub>0 + 3)"
      using n_gt_0 by (intro iffD2[OF log_le_cancel_iff] add_mono add_nonneg_pos
          iffD2[OF zero_le_log_cancel_iff]) (simp_all add:n\<^sub>0_def)
    also have "... = ln (ln n\<^sub>0 / ln 2 + 3) / ln 2"
      unfolding log_def by simp
    also have "... \<le> ln (ln n\<^sub>0/ln 2 + (3 / exp 5) * ln n\<^sub>0) / ln 2"
      using n_lbound by (intro divide_right_mono iffD2[OF ln_le_cancel_iff] add_mono add_nonneg_pos)
       (simp_all add:divide_simps)
    also have "... = ln ( ln n\<^sub>0 * (1 /ln 2 + 3/exp 5)) / ln 2"
      by (simp add:algebra_simps)
    also have "... \<le> ln ( ln n\<^sub>0 * exp 1) / ln 2"
      using n_lbound by (intro divide_right_mono iffD2[OF ln_le_cancel_iff] add_mono
          mult_left_mono 5 Rings.mult_pos_pos add_pos_nonneg) auto
    also have "... = (ln (ln n\<^sub>0) + 1) / ln 2"
      using n_lbound by (subst ln_mult) simp_all
    also have "... \<le> (ln (ln n\<^sub>0) + 0.2 * ln (ln n\<^sub>0)) / ln 2"
      using n_lbound by (intro divide_right_mono add_mono) auto
    also have "... = (1.2/ ln 2) * ln (ln n\<^sub>0)"
      by simp
    also have "... \<le> 2 * ln (ln n\<^sub>0)"
      using n_lbound by (intro mult_right_mono 5) simp
    finally have "log 2(log 2 (real n)+3) \<le> 2 * ln (ln n\<^sub>0)"
      by simp
    hence 6: "log 2(log 2 (real n)+3)/ln(ln n\<^sub>0) \<le> 2"
      using n_lbound by (subst pos_divide_le_eq) simp_all

    have "?L1 = real(nat \<lceil>4*ln (1/\<epsilon>)/ln(ln n\<^sub>0)\<rceil>)*(2^36*(ln (ln n\<^sub>0)+1)/\<delta>^2+log 2(log 2 (real n)+3))"
      using True unfolding m_def \<epsilon>\<^sub>i_def by simp
    also have "... = \<lceil>4*ln (1/\<epsilon>)/ln(ln n\<^sub>0)\<rceil>*(2^36*(ln (ln n\<^sub>0)+1)/\<delta>^2+log 2(log 2 (real n)+3))"
      using m_gt_0_aux[OF True] by (subst of_nat_nat) simp_all
    also have "... \<le> (5*ln (1/\<epsilon>)/ln(ln n\<^sub>0)) *(2^36*(ln (ln n\<^sub>0)+1)/\<delta>^2+log 2(log 2 (real n)+3))"
      using n_lbound(3) \<delta>_gt_0  4 by (intro ereal_mono mult_right_mono
          add_nonneg_nonneg divide_nonneg_pos mult_nonneg_nonneg 3) simp_all
    also have "... \<le> (5 * ln (1/\<epsilon>)/ln(ln n\<^sub>0))*((2^36+2^36)*ln (ln n\<^sub>0)/\<delta>^2+log 2(log 2 (real n)+3))"
      using n_lbound \<epsilon>_gt_0 \<epsilon>_lt_1
      by (intro ereal_mono mult_left_mono add_mono divide_right_mono divide_nonneg_pos) auto
    also have "... = 5*(2^37)* ln (1/\<epsilon>)/ \<delta>^2 + (5*ln (1/\<epsilon>)) * (log 2(log 2 (real n)+3)/ln(ln n\<^sub>0))"
      using n_lbound by (simp add:algebra_simps)
    also have "... \<le> 5*(2^37)* ln (1/\<epsilon>)/ \<delta>^2 + (5*ln(1/ \<epsilon>)) * 2"
      using \<epsilon>_gt_0 \<epsilon>_lt_1 by (intro add_mono ereal_mono order.refl mult_left_mono 6) auto
    also have "... = 5*(2^37)* ln (1/\<epsilon>)/ \<delta>^2 + 5*2*ln(1/ \<epsilon>) / 1"
      by simp
    also have "... \<le> 5*(2^37)* ln (1/\<epsilon>)/ \<delta>^2 + 5*2*ln(1/ \<epsilon>) / \<delta>^2"
      using \<delta>_gt_0 \<delta>_lt_1 \<epsilon>_gt_0 \<epsilon>_lt_1
      by (intro add_mono ereal_mono divide_left_mono Rings.mult_pos_pos power_le_one) auto
    also have "... = (5*(2^37+2))* (ln (1/\<epsilon>)+0)/ \<delta>^2 + 0"
      by (simp add:algebra_simps)
    also have "... \<le> 2^40 * (ln (1 / \<epsilon>)+1) / \<delta>^2 +  log 2 (log 2 (real n) + 3)"
      using \<delta>_gt_0 \<delta>_lt_1 \<epsilon>_gt_0 \<epsilon>_lt_1 n_gt_0 by (intro add_mono ereal_mono divide_right_mono
          mult_right_mono iffD2[OF zero_le_log_cancel_iff] add_nonneg_pos) auto
    finally show ?thesis by simp
  next
    case False
    have "?L1 = 2^36 *(ln (1/\<epsilon>)+ 1)/\<delta>\<^sup>2 + log 2 (log 2 (real n) + 3)"
      using False unfolding \<epsilon>\<^sub>i_def m_def by simp
    also have "... \<le> ?R1"
      using \<delta>_gt_0 \<delta>_lt_1 \<epsilon>_gt_0 \<epsilon>_lt_1
      by (intro ereal_mono add_mono divide_right_mono mult_right_mono add_nonneg_nonneg) auto
    finally show ?thesis by simp
  qed
  finally show ?thesis
    unfolding state_space_usage_def by simp
qed

text \<open>Encoding function for the seeds which are just natural numbers smaller than
@{term "size \<Theta>"}.\<close>

definition encode_seed
  where "encode_seed = Nb\<^sub>e (size \<Theta>)"

lemma encode_seed:
  "is_encoding encode_seed"
  unfolding encode_seed_def by (intro bounded_nat_encoding)

lemma random_bit_count:
  assumes "\<omega> < size \<Theta>"
  shows "bit_count (encode_seed \<omega>) \<le> seed_space_usage (real n, \<delta>, \<epsilon>)"
    (is "?L \<le> ?R")
proof -
  have 0: "size \<Theta> > 0"
    using \<Theta>.sample_space unfolding sample_space_def by simp
  have 1: "size I.\<Omega> > 0"
    using I.\<Omega>.sample_space unfolding sample_space_def by simp

  have "(55+60*ln (ln n\<^sub>0))^3 \<le> (180+60*ln (ln n\<^sub>0))^3"
    using n_lbound by (intro power_mono add_mono) auto
  also have "... = 180^3 * (1+ln (ln n\<^sub>0)/real 3)^3"
    unfolding power_mult_distrib[symmetric] by simp
  also have "... \<le> 180^3 * exp (ln (ln n\<^sub>0))"
    using n_lbound by (intro mult_left_mono exp_ge_one_plus_x_over_n_power_n) auto
  also have "... = 180^3 * ln n\<^sub>0"
    using n_lbound by (subst exp_ln) auto
  also have "... \<le> 180^3 * max (ln n) (ln (exp (exp 5)))"
    using n_gt_0 unfolding n\<^sub>0_def by (subst ln_max_swap) auto
  also have "... \<le> 180^3 * (ln n + exp 5)"
    using n_gt_0 unfolding ln_exp by (intro mult_left_mono) auto
  finally have 2:"(55+60*ln (ln n\<^sub>0))^3 \<le> 180^3 * ln n + 180^3*exp 5"
    by simp

  have 3:"((1::real)+180^3*exp 5) \<le> 2^30" "((4::real)/ln 2 + 180^3) \<le> 2^23"
    by (approximation 10)+

  have "?L = ereal (real (floorlog 2 (size \<Theta> - 1)))"
    using assms unfolding encode_seed_def bounded_nat_bit_count by simp
  also have "... \<le> ereal (real (floorlog 2 (size \<Theta>)))"
    by (intro ereal_mono Nat.of_nat_mono floorlog_mono) auto
  also have "... = ereal (1 + of_int \<lfloor>log 2 (real (sample_space.size \<Theta>))\<rfloor>)"
    using 0 unfolding floorlog_def by simp
  also have "... \<le> ereal (1 + log 2 (real (size \<Theta>)))"
    by (intro add_mono ereal_mono) auto
  also have "... = 1 + log 2 (real (size I.\<Omega>) * (2^4) ^ ((m - 1) * nat \<lceil>ln \<alpha> / ln 0.95\<rceil>))"
    unfolding \<Theta>.size by simp
  also have "... = 1 + log 2 (real (size I.\<Omega>) * 2^ (4 * (m - 1) * nat \<lceil>ln \<alpha> / ln 0.95\<rceil>))"
    unfolding power_mult by simp
  also have "... = 1 + log 2 (real (size I.\<Omega>)) + (4*(m-1)* nat\<lceil>ln \<alpha> / ln 0.95\<rceil>)"
    using 1 by (subst log_mult) simp_all
  also have "... \<le> 1+log 2(2 powr (4*log 2 n + 48 * (log 2 (1/\<delta>)+16)\<^sup>2+ (55+60*ln (1/\<epsilon>\<^sub>i))^3))+
    (4*(m-1)* nat\<lceil>ln \<alpha> / ln 0.95\<rceil>)"
    using 1 by (intro ereal_mono add_mono iffD2[OF log_le_cancel_iff] I.random_bit_count) auto
  also have "...=1+4*log 2 n+48*(log 2(1/\<delta>)+16)\<^sup>2+(55+60*ln (1/\<epsilon>\<^sub>i))^3+(4*(m-1)*nat\<lceil>ln \<alpha>/ln 0.95\<rceil>)"
    by (subst log_powr_cancel) auto
  also have "... \<le> 2^30 + 2^23*ln n+48*(log 2(1/\<delta>)+16)\<^sup>2 + 336*ln (1/\<epsilon>)" (is "?L1 \<le> ?R1")
  proof (cases "stage_two")
    case True

    have "-1 < (0::real)" by simp
    also have "... \<le> ln \<alpha> / ln 0.95"
      using \<alpha>_gt_0 \<alpha>_le_1 by (intro divide_nonpos_neg) auto
    finally have 4: "- 1 < ln \<alpha> / ln 0.95" by simp

    have 5: "- 1 / ln 0.95 \<le> (20::real)"
      by (approximation 10)

    have "(4*(m-1)*nat\<lceil>ln \<alpha>/ln 0.95\<rceil>) = 4 * (real m-1) * of_int \<lceil>ln \<alpha>/ln 0.95\<rceil>"
      using 4 m_gt_0 unfolding of_nat_mult by (subst of_nat_nat) auto
    also have "... \<le> 4 * (real m-1) * (ln \<alpha>/ln 0.95 + 1)"
      using m_gt_0 by (intro mult_left_mono) auto
    also have "... = 4 * (real m-1) * (-ln (ln n\<^sub>0)/ln 0.95 + 1)"
      using n_lbound True unfolding \<alpha>_def
      by (subst ln_inverse[symmetric]) (simp_all add:inverse_eq_divide)
    also have "... = 4 * (real m - 1 ) * (ln (ln n\<^sub>0) * (-1/ln 0.95) + 1)"
      by simp
    also have "... \<le> 4 * (real m - 1 ) * (ln (ln n\<^sub>0) * 20 + 1)"
      using n_lbound m_gt_0 by (intro mult_left_mono add_mono 5) auto
    also have "... = 4 * (real (nat \<lceil>4 * ln (1 / \<epsilon>) / ln (ln n\<^sub>0)\<rceil>)-1) *  (ln (ln n\<^sub>0) * 20 + 1)"
      using True unfolding m_def by simp
    also have "... = 4 * (real_of_int \<lceil>4 * ln (1 / \<epsilon>) / ln (ln n\<^sub>0)\<rceil>-1) *  (ln (ln n\<^sub>0) * 20 + 1)"
      using m_gt_0_aux[OF True] by (subst of_nat_nat) simp_all
    also have "... \<le> 4 * (4 * ln (1 / \<epsilon>) / ln (ln n\<^sub>0)) * (ln (ln n\<^sub>0) * 20 + 1)"
      using n_lbound by (intro mult_left_mono mult_right_mono) auto
    also have "... \<le> 4 * (4 * ln (1 / \<epsilon>) / ln (ln n\<^sub>0)) * (ln (ln n\<^sub>0) * 20 + ln (ln n\<^sub>0))"
      using \<epsilon>_gt_0 \<epsilon>_lt_1 n_lbound
      by (intro mult_left_mono mult_right_mono add_mono divide_nonneg_pos Rings.mult_nonneg_nonneg)
       simp_all
    also have "... = 336 * ln (1  / \<epsilon>)"
      using n_lbound by simp
    finally have 6: "4 * (m-1) * nat \<lceil>ln \<alpha>/ln 0.95\<rceil> \<le> 336 * ln (1/\<epsilon>)"
      by simp

    have "?L1 =1+4*log 2 n+48*(log 2(1/\<delta>)+16)\<^sup>2+(55+60*ln (ln n\<^sub>0))^3+(4*(m-1)*nat\<lceil>ln \<alpha>/ln 0.95\<rceil>)"
      using True unfolding \<epsilon>\<^sub>i_def by simp
    also have "... \<le> 1+4*log 2 n+48*(log 2(1/\<delta>)+16)\<^sup>2+(180^3 * ln n + 180^3*exp 5) + 336 * ln (1/\<epsilon>)"
      by (intro add_mono 6 2 ereal_mono order.refl)
    also have "... = (1+180^3*exp 5)+ (4/ln 2 + 180^3)*ln n+48*(log 2(1/\<delta>)+16)\<^sup>2+ 336 * ln (1/\<epsilon>)"
      by (simp add:log_def algebra_simps)
    also have "... \<le> 2^30 + 2^23*ln n+48*(log 2(1/\<delta>)+16)\<^sup>2+ 336 * ln (1/\<epsilon>)"
      using n_gt_0 by (intro add_mono ereal_mono 3 order.refl mult_right_mono) auto
    finally show ?thesis by simp
  next
    case False
    hence "1 / \<epsilon> \<le> ln n\<^sub>0"
      using \<epsilon>_gt_0 n_lbound
      unfolding stage_two_def not_less by (simp add:divide_simps ac_simps)
    hence 7: "ln (1 / \<epsilon>) \<le> ln (ln n\<^sub>0)"
      using n_lbound \<epsilon>_gt_0 \<epsilon>_lt_1
      by (intro iffD2[OF ln_le_cancel_iff]) auto

    have 8: "0 \<le> 336*ln (1/\<epsilon>) "
      using \<epsilon>_gt_0 \<epsilon>_lt_1 by auto

    have "?L1 = 1 + 4 * log 2 (real n) + 48 * (log 2 (1 / \<delta>) + 16)\<^sup>2 + (55 + 60 * ln (1 / \<epsilon>)) ^ 3"
      using False unfolding \<epsilon>\<^sub>i_def m_def by simp
    also have "... \<le> 1 + 4 * log 2 (real n) + 48 * (log 2 (1 / \<delta>) + 16)\<^sup>2 + (55 + 60 * ln (ln n\<^sub>0))^3"
      using \<epsilon>_gt_0 \<epsilon>_lt_1
      by (intro add_mono order.refl ereal_mono power_mono mult_left_mono add_nonneg_nonneg 7) auto
    also have "... \<le> 1+4*log 2(real n)+48*(log 2 (1 / \<delta>)+16)\<^sup>2+(180^3*ln (real n) + 180 ^ 3 * exp 5)"
      by (intro add_mono ereal_mono 2 order.refl)
    also have "... = (1+180^3*exp 5)+ (4/ln 2 + 180^3)*ln n+48*(log 2(1/\<delta>)+16)\<^sup>2+ 0"
      by (simp add:log_def algebra_simps)
    also have "... \<le> 2^30 + 2^23*ln n+48*(log 2(1/\<delta>)+16)\<^sup>2 + 336*ln (1/\<epsilon>)"
      using n_gt_0 by (intro add_mono ereal_mono 3 order.refl mult_right_mono 8) auto
    finally show ?thesis by simp
  qed
  also have "... = seed_space_usage (real n, \<delta>, \<epsilon>)"
    unfolding seed_space_usage_def by simp
  finally show ?thesis by simp
qed

text \<open>The following is an alternative form expressing the correctness and space usage theorems.
If @{term "x"} is expression formed by @{term "single"} and @{term "merge"} operations. Then
@{term "x"} requires @{term "state_space_usage (real n, \<delta>, \<epsilon>)"} bits to encode and
@{term "estimate x"} approximates the count of the distinct universe elements in the expression.

For example:

@{term "estimate (merge (single \<omega> 1) (merge (single \<omega> 5) (single \<omega> 1)))"} approximates the
cardinality of @{term "{1::nat, 5, 1}"} i.e. $2$.\<close>

datatype sketch_tree = Single nat | Merge sketch_tree sketch_tree

fun eval :: "nat \<Rightarrow> sketch_tree \<Rightarrow> state"
  where
    "eval \<omega> (Single x) = single \<omega> x" |
    "eval \<omega> (Merge x y) = merge (eval \<omega> x) (eval \<omega> y)"

fun sketch_tree_set :: "sketch_tree \<Rightarrow> nat set"
  where
    "sketch_tree_set (Single x) = {x}" |
    "sketch_tree_set (Merge x y) = sketch_tree_set x \<union> sketch_tree_set y"

theorem correctness:
  fixes Y
  assumes "sketch_tree_set t \<subseteq> {..<n}"
  defines "p \<equiv> pmf_of_set {..<size \<Theta>}"
  defines "Y \<equiv> real (card (sketch_tree_set t))"
  shows "measure p {\<omega>. \<bar>estimate (eval \<omega> t) - Y\<bar> > \<delta> * Y} \<le> \<epsilon>" (is "?L \<le> ?R")
proof -
  define A where "A = sketch_tree_set t"
  have Y_eq: "Y = real (card A)"
    unfolding Y_def A_def by simp

  have 0:"eval \<omega> t = \<nu> \<omega> A" for \<omega>
    unfolding A_def using single_result merge_result
    by (induction t) (auto simp del:merge.simps single.simps)

  have 1: "A \<subseteq> {..<n}"
    using assms(1) unfolding A_def by blast

  have 2: "A \<noteq> {}"
    unfolding A_def by (induction t) auto

  show ?thesis
    unfolding 0 Y_eq p_def by (intro estimate_result 1 2)
qed

theorem space_usage:
  assumes "\<omega> < size \<Theta>"
  shows
    "bit_count (encode_state (eval \<omega> t)) \<le> state_space_usage (real n, \<delta>, \<epsilon>)" (is "?A")
    "bit_count (encode_seed \<omega>) \<le> seed_space_usage (real n, \<delta>, \<epsilon>)" (is "?B")
proof-
  define A where "A = sketch_tree_set t"

  have 0:"eval \<omega> t = \<nu> \<omega> A" for \<omega>
    unfolding A_def using single_result merge_result
    by (induction t) (auto simp del:merge.simps single.simps)

  show ?A
    unfolding 0 by (intro state_bit_count)
  show ?B
    using random_bit_count[OF assms] by simp
qed

end

text \<open>The functions @{term "state_space_usage"} and @{term "seed_space_usage"} are exact bounds
on the space usage for the state and the seed. The following establishes asymptotic bounds
with respect to the limit $n, \delta^{-1}, \varepsilon^{-1} \rightarrow \infty$.\<close>

context
begin

text \<open>Some local notation to ease proofs about the asymptotic space usage of the algorithm:\<close>

private definition n_of :: "real \<times> real \<times> real \<Rightarrow> real" where "n_of = (\<lambda>(n, \<delta>, \<epsilon>). n)"
private definition \<epsilon>_of :: "real \<times> real \<times> real \<Rightarrow> real" where "\<epsilon>_of = (\<lambda>(n, \<delta>, \<epsilon>). \<epsilon>)"
private definition \<delta>_of :: "real \<times> real \<times> real \<Rightarrow> real" where "\<delta>_of = (\<lambda>(n, \<delta>, \<epsilon>). \<delta>)"

private abbreviation F :: "(real \<times> real \<times> real) filter"
  where "F \<equiv> (at_top \<times>\<^sub>F at_right 0 \<times>\<^sub>F at_right 0)"

private lemma var_simps:
  "n_of = fst"
  "\<delta>_of = (\<lambda>x. fst (snd x))"
  "\<epsilon>_of = (\<lambda>x. snd (snd x))"
  unfolding n_of_def \<delta>_of_def \<epsilon>_of_def by (auto simp add:case_prod_beta)

private lemma evt_n: "eventually (\<lambda>x. n_of x \<ge> n) F"
  unfolding var_simps by (intro eventually_prod1' eventually_prod2' eventually_ge_at_top)
      (simp add:prod_filter_eq_bot)

private lemma evt_n_1: "\<forall>\<^sub>F x in F. 0 \<le> ln (n_of x)"
  by (intro eventually_mono[OF evt_n[of "1"]] ln_ge_zero) simp

private lemma evt_n_2: "\<forall>\<^sub>F x in F. 0 \<le> ln (ln (n_of x))"
  using order_less_le_trans[OF exp_gt_zero]
  by (intro eventually_mono[OF evt_n[of "exp 1"]] ln_ge_zero iffD2[OF ln_ge_iff]) auto

private lemma evt_\<delta>: "eventually (\<lambda>x. 1/\<delta>_of x \<ge> \<delta> \<and> \<delta>_of x > 0) F"
  unfolding var_simps by (intro eventually_prod1' eventually_prod2' eventually_conj
      real_inv_at_right_0_inf eventually_at_right_less) (simp_all add:prod_filter_eq_bot)

private lemma evt_\<epsilon>: "eventually (\<lambda>x. 1/\<epsilon>_of x \<ge> \<epsilon> \<and> \<epsilon>_of x > 0) F"
  unfolding var_simps by (intro eventually_prod1' eventually_prod2' eventually_conj
      real_inv_at_right_0_inf eventually_at_right_less) (simp_all add:prod_filter_eq_bot)

private lemma evt_\<epsilon>_1: "\<forall>\<^sub>F x in F. 0 \<le> ln (1 / \<epsilon>_of x)"
  by (intro eventually_mono[OF evt_\<epsilon>[of "1"]] ln_ge_zero) simp

theorem asymptotic_state_space_complexity:
  "state_space_usage \<in> O[F](\<lambda>(n, \<delta>, \<epsilon>). ln (1/\<epsilon>)/\<delta>^2 + ln (ln n))"
  (is "_ \<in> O[?F](?rhs)")
proof -
  have 0:"(\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (1 / \<epsilon>_of x))"
    using order_less_le_trans[OF exp_gt_zero]
    by (intro landau_o.big_mono eventually_mono[OF evt_\<epsilon>[of "exp 1"]])
      (auto intro!: iffD2[OF ln_ge_iff] simp add:abs_ge_iff)

  have 1:"(\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (n_of x))"
    using order_less_le_trans[OF exp_gt_zero]
    by (intro landau_o.big_mono eventually_mono[OF evt_n[of "exp 1"]])
      (auto intro!:iffD2[OF ln_ge_iff] simp add:abs_ge_iff)

  have "(\<lambda>x. ((ln (1/\<epsilon>_of x)+1)* (1/\<delta>_of x)\<^sup>2))\<in> O[?F](\<lambda>x. ln(1/\<epsilon>_of x)* (1/\<delta>_of x)\<^sup>2)"
    by (intro landau_o.mult sum_in_bigo 0) simp_all
  hence 2: "(\<lambda>x. 2^40*((ln (1/\<epsilon>_of x)+1)* (1/\<delta>_of x)\<^sup>2))\<in> O[?F](\<lambda>x. ln(1/\<epsilon>_of x)* (1/\<delta>_of x)\<^sup>2)"
    unfolding cmult_in_bigo_iff by simp

  have 3: "(1::real) \<le> exp 2"
    by (approximation 5)

  have "(\<lambda>x. ln (n_of x) / ln 2 + 3) \<in> O[?F](\<lambda>x. ln (n_of x))"
    using 1 by (intro sum_in_bigo) simp_all
  hence "(\<lambda>x. ln (ln (n_of x) / ln 2 + 3)) \<in> O[?F](\<lambda>x. ln (ln (n_of x)))"
    using order_less_le_trans[OF exp_gt_zero] order_trans[OF 3]
    by (intro landau_ln_2[where a="2"] eventually_mono[OF evt_n[of "exp 2"]])
     (auto intro!:iffD2[OF ln_ge_iff] add_nonneg_nonneg divide_nonneg_pos)
  hence 4: "(\<lambda>x. log 2 (log 2 (n_of x) + 3))\<in> O[?F](\<lambda>x. ln(ln(n_of x)))"
    unfolding log_def by simp

  have 5: "\<forall>\<^sub>F x in ?F. 0 \<le> ln (1 / \<epsilon>_of x) * (1 / \<delta>_of x)\<^sup>2"
    by (intro eventually_mono[OF eventually_conj[OF evt_\<epsilon>_1 evt_\<delta>[of "1"]]]) auto

  have "state_space_usage = (\<lambda>x. state_space_usage (n_of x, \<delta>_of x, \<epsilon>_of x))"
    by (simp add:case_prod_beta' n_of_def \<epsilon>_of_def \<delta>_of_def)
  also have "... = (\<lambda>x. 2 ^ 40 * ((ln (1 / (\<epsilon>_of x)) + 1)* (1/\<delta>_of x)\<^sup>2) + log 2 (log 2 (n_of x)+3))"
    unfolding state_space_usage_def by (simp add:divide_simps)
  also have "... \<in> O[?F](\<lambda>x. ln (1/\<epsilon>_of x)* (1/\<delta>_of x)\<^sup>2 + ln (ln (n_of x)))"
    by (intro landau_sum 2 4 5 evt_n_2)
  also have "... = O[?F](?rhs)"
    by (simp add:case_prod_beta' n_of_def \<epsilon>_of_def \<delta>_of_def divide_simps)
  finally show ?thesis by simp
qed

theorem asymptotic_seed_space_complexity:
  "seed_space_usage \<in> O[F](\<lambda>(n, \<delta>, \<epsilon>). ln (1/\<epsilon>)+ln (1/\<delta>)^2 + ln n)"
  (is "_ \<in> O[?F](?rhs)")
proof -
  have 0: "\<forall>\<^sub>F x in ?F. 0 \<le> (ln (1 / \<delta>_of x))\<^sup>2"
    by simp

  have 1: "\<forall>\<^sub>F x in ?F. 0 \<le> ln (1 / \<epsilon>_of x) + (ln (1 / \<delta>_of x))\<^sup>2"
    by (intro eventually_mono[OF eventually_conj[OF evt_\<epsilon>_1 0]] add_nonneg_nonneg) auto

  have 2: "(\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (1 / \<delta>_of x))"
    using order_less_le_trans[OF exp_gt_zero]
    by (intro landau_o.big_mono eventually_mono[OF evt_\<delta>[of "exp 1"]])
      (auto intro!:iffD2[OF ln_ge_iff] simp add:abs_ge_iff)

  have "(\<lambda>x. 1) \<in> O[at_top \<times>\<^sub>F at_right 0 \<times>\<^sub>F at_right 0](\<lambda>x. ln (n_of x))"
    using order_less_le_trans[OF exp_gt_zero]
    by (intro landau_o.big_mono eventually_mono[OF evt_n[of "exp 1"]])
      (auto intro!:iffD2[OF ln_ge_iff] simp add:abs_ge_iff)
  hence 3: "(\<lambda>x. 1) \<in> O[?F](\<lambda>x. ln (1 / \<epsilon>_of x) + (ln (1 / \<delta>_of x))\<^sup>2 + ln (n_of x))"
    by (intro landau_sum_2 1 evt_n_1 0 evt_\<epsilon>_1) simp
  have 4: "(\<lambda>x. ln (n_of x)) \<in> O[?F](\<lambda>x. ln (1 / \<epsilon>_of x) + (ln (1 / \<delta>_of x))\<^sup>2 + ln (n_of x))"
    by (intro landau_sum_2 1 evt_n_1) simp
  have "(\<lambda>x. log 2 (1 / \<delta>_of x) + 16) \<in> O[?F](\<lambda>x. ln (1 / \<delta>_of x))"
    using 2 unfolding log_def by (intro sum_in_bigo) simp_all
  hence 5: "(\<lambda>x. (log 2 (1 / \<delta>_of x) + 16)\<^sup>2) \<in> O[?F](\<lambda>x. ln (1/\<epsilon>_of x)+(ln (1/\<delta>_of x))\<^sup>2)"
    using 0 unfolding power2_eq_square by (intro landau_sum_2 landau_o.mult evt_\<epsilon>_1) simp_all
  have 6: "(\<lambda>x. (log 2 (1 / \<delta>_of x) + 16)\<^sup>2) \<in> O[?F](\<lambda>x. ln (1/\<epsilon>_of x)+(ln (1/\<delta>_of x))\<^sup>2+ln (n_of x))"
    by (intro landau_sum_1[OF _ _ 5] 1 evt_n_1)
  have 7: "(\<lambda>x. ln (1/\<epsilon>_of x)) \<in> O[?F](\<lambda>x. ln (1/\<epsilon>_of x)+(ln (1/\<delta>_of x))\<^sup>2+ln (n_of x))"
    by (intro landau_sum_1 1 evt_\<epsilon>_1 0 evt_n_1) simp

  have "seed_space_usage = (\<lambda>x. seed_space_usage (n_of x, \<delta>_of x, \<epsilon>_of x))"
    by (simp add:case_prod_beta' n_of_def \<epsilon>_of_def \<delta>_of_def)
  also have "... = (\<lambda>x. 2^30+2^23*ln (n_of x)+48*(log 2 (1/(\<delta>_of x))+16)\<^sup>2 + 336 * ln (1 / \<epsilon>_of x))"
    unfolding seed_space_usage_def by (simp add:divide_simps)
  also have "... \<in> O[?F](\<lambda>x. ln (1/\<epsilon>_of x)+ln (1/\<delta>_of x)^2 + ln (n_of x))"
    using 3 4 6 7 by (intro sum_in_bigo) simp_all
  also have "... = O[?F](?rhs)"
    by (simp add:case_prod_beta' n_of_def \<epsilon>_of_def \<delta>_of_def)
  finally show ?thesis by simp
qed

definition "space_usage x = state_space_usage x + seed_space_usage x"

theorem asymptotic_space_complexity:
  "space_usage \<in> O[at_top \<times>\<^sub>F at_right 0 \<times>\<^sub>F at_right 0](\<lambda>(n, \<delta>, \<epsilon>). ln (1/\<epsilon>)/\<delta>^2 + ln n)"
proof -
  let ?f1 = "(\<lambda>x. ln (1/\<epsilon>_of x)*(1/\<delta>_of x^2)+ln (ln (n_of x)))"
  let ?f2 = "(\<lambda>x. ln(1/\<epsilon>_of x)+ln(1/\<delta>_of x)^2+ln (n_of x))"

  have 0: "\<forall>\<^sub>F x in F. 0 \<le> (1 / (\<delta>_of x)\<^sup>2)"
    unfolding var_simps by (intro eventually_prod1' eventually_prod2' eventually_inv)
      (simp_all add:prod_filter_eq_bot eventually_nonzero_simps)

  have 1: "\<forall>\<^sub>F x in F. 0 \<le> ln (1 / \<epsilon>_of x) * (1 / (\<delta>_of x)\<^sup>2)"
    by (intro eventually_mono[OF eventually_conj[OF evt_\<epsilon>_1 0]] mult_nonneg_nonneg) auto

  have 2: "\<forall>\<^sub>F x in F. 0 \<le> ln (1 / \<epsilon>_of x) * (1 / (\<delta>_of x)\<^sup>2) + ln (ln (n_of x))"
    by (intro eventually_mono[OF eventually_conj[OF 1 evt_n_2]] add_nonneg_nonneg) auto

  have 3: "\<forall>\<^sub>F x in F. 0 \<le> ln (1 / (\<delta>_of x)\<^sup>2)"
    unfolding power_one_over[symmetric]
    by (intro eventually_mono[OF evt_\<delta>[of "1"]] ln_ge_zero) simp

  have 4: "\<forall>\<^sub>F x in F. 0 \<le> ln (1 / \<epsilon>_of x) + (ln (1 / \<delta>_of x))\<^sup>2 + ln (n_of x)"
    by (intro eventually_mono[OF eventually_conj[OF evt_n_1 eventually_conj[OF evt_\<epsilon>_1 3]]]
        add_nonneg_nonneg) auto

  have 5: "(\<lambda>_. 1) \<in> O[F](\<lambda>x. 1 / (\<delta>_of x)\<^sup>2)"
    unfolding var_simps by (intro bigo_prod_1 bigo_prod_2 bigo_inv)
      (simp_all add:power_divide prod_filter_eq_bot)

  have 6: "(\<lambda>_. 1) \<in> O[F](\<lambda>x. ln (1 / \<epsilon>_of x))"
    unfolding var_simps
    by (intro bigo_prod_1 bigo_prod_2 bigo_inv) (simp_all add:prod_filter_eq_bot)

  have 7: "state_space_usage \<in> O[F](\<lambda>x. ln (1 / \<epsilon>_of x) * (1 / (\<delta>_of x)\<^sup>2) + ln (ln (n_of x)))"
    using asymptotic_state_space_complexity unfolding \<epsilon>_of_def \<delta>_of_def n_of_def
    by (simp add:case_prod_beta')

  have 8: "seed_space_usage \<in> O[F](\<lambda>x. ln (1 / \<epsilon>_of x) + (ln (1 / \<delta>_of x))\<^sup>2 + ln (n_of x))"
    using asymptotic_seed_space_complexity unfolding \<epsilon>_of_def \<delta>_of_def n_of_def
    by (simp add:case_prod_beta')

  have 9: "(\<lambda>x. ln (n_of x)) \<in> O[F](\<lambda>x. ln (1 / \<epsilon>_of x) * (1 / (\<delta>_of x)\<^sup>2) + ln (n_of x))"
    by (intro landau_sum_2 evt_n_1 1) simp

  have "(\<lambda>x. (ln (1 / \<delta>_of x))\<^sup>2) \<in> O[F](\<lambda>x. 1 / \<delta>_of x^2)"
    unfolding var_simps
    by (intro bigo_prod_1 bigo_prod_2 bigo_inv) (simp_all add:power_divide prod_filter_eq_bot)
  hence 10: "(\<lambda>x. (ln (1 / \<delta>_of x))\<^sup>2) \<in> O[F](\<lambda>x. ln (1 / \<epsilon>_of x) * (1 / \<delta>_of x^2) + ln (n_of x))"
    by (intro landau_sum_1 evt_n_1 1 landau_o.big_mult_1' 6)
  have 11: "(\<lambda>x. ln (1 / \<epsilon>_of x)) \<in> O[F](\<lambda>x. ln (1 / \<epsilon>_of x) * (1 / \<delta>_of x^2) + ln (n_of x))"
    by (intro landau_sum_1 evt_n_1 1 landau_o.big_mult_1 5) simp
  have 12: "(\<lambda>x. ln (1/\<epsilon>_of x) * (1/\<delta>_of x^2)) \<in> O[F](\<lambda>x. ln (1/\<epsilon>_of x)*(1/\<delta>_of x^2)+ln (n_of x))"
    by (intro landau_sum_1 1 evt_n_1) simp

  have "(\<lambda>x. ln (ln (n_of x))) \<in> O[F](\<lambda>x. ln (n_of x))"
    unfolding var_simps by (intro bigo_prod_1 bigo_prod_2) (simp_all add:prod_filter_eq_bot)
  hence 13: "(\<lambda>x. ln (ln (n_of x))) \<in> O[F](\<lambda>x. ln (1 / \<epsilon>_of x) * (1 / \<delta>_of x^2) + ln (n_of x))"
    by (intro landau_sum_2 evt_n_1 1)

  have "space_usage = (\<lambda>x. state_space_usage x + seed_space_usage x)"
    unfolding space_usage_def by simp
  also have "... \<in> O[F](\<lambda>x. ?f1 x + ?f2 x)"
    by (intro landau_sum 2 4 7 8)
  also have "... \<subseteq> O[F](\<lambda>x. ln (1 / \<epsilon>_of x) * (1/\<delta>_of x^2) + ln (n_of x))"
    by (intro landau_o.big.subsetI sum_in_bigo 9 10 11 12 13)
  also have "... = O[F](\<lambda>(n, \<delta>, \<epsilon>). ln (1/\<epsilon>)/\<delta>^2 + ln n)"
    unfolding \<epsilon>_of_def \<delta>_of_def n_of_def
    by (simp add:case_prod_beta')
  finally show ?thesis by simp
qed

end

unbundle no_intro_cong_syntax

end