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

section \<open>Preliminaries\<close>

theory Preliminaries
imports
  Main
  "HOL-Library.Multiset"
  "HOL-Library.FuncSet"
  "HOL-Library.Permutations"
  "HOL-ex.Birthday_Paradox"
  Card_Partitions.Card_Partitions
  Bell_Numbers_Spivey.Bell_Numbers
  Card_Multisets.Card_Multisets
  Card_Number_Partitions.Card_Number_Partitions
begin

subsection \<open>Additions to Finite Set Theory\<close>

lemma subset_with_given_card_exists:
  assumes "n \<le> card A"
  shows "\<exists>B \<subseteq> A. card B = n"
using assms proof (induct n)
  case 0
  then show ?case by auto
next
  case (Suc n)
  from this obtain B where "B \<subseteq> A" "card B = n" by auto
  from this \<open>B \<subseteq> A\<close> \<open>card B = n\<close> have "card B < card A"
    using Suc.prems by linarith
  from \<open>Suc n \<le> card A\<close> card_infinite have "finite A" by force
  from this \<open>B \<subseteq> A\<close> finite_subset have "finite B" by blast
  from \<open>card B < card A\<close> \<open>B \<subseteq> A\<close> obtain a where "a \<in> A" "a \<notin> B"
    by (metis less_irrefl subsetI subset_antisym)
  have "insert a B \<subseteq> A" "card (insert a B) = Suc n"
    using \<open>finite B\<close> \<open>a \<in> A\<close> \<open>a \<notin> B\<close> \<open>B \<subseteq> A\<close> \<open>card B = n\<close> by auto
  then show ?case by blast
qed

subsection \<open>Additions to Equiv Relation Theory\<close>

lemmas univ_commute' = univ_commute[unfolded Equiv_Relations.proj_def]

lemma univ_predicate_impl_forall:
  assumes "equiv A R"
  assumes "P respects R"
  assumes "X \<in> A // R"
  assumes "univ P X"
  shows "\<forall>x\<in>X. P x"
proof -
  from assms(1,3) obtain x where "x \<in> X"
    by (metis equiv_class_self quotientE)
  from \<open>x \<in> X\<close> assms(1,3) have "X = R `` {x}"
    by (metis Image_singleton_iff equiv_class_eq quotientE)
  from assms(1,2,4) this show ?thesis
    using equiv_class_eq_iff univ_commute' by fastforce
qed

lemma univ_preserves_predicate:
  assumes "equiv A r"
  assumes "P respects r"
  shows "{x \<in> A. P x} // r = {X \<in> A // r. univ P X}"
proof
  show "{x \<in> A. P x} // r \<subseteq> {X \<in> A // r. univ P X}"
  proof
    fix X
    assume "X \<in> {x \<in> A. P x} // r"
    from this obtain x where "x \<in> {x \<in> A. P x}" and "X = r `` {x}"
      using quotientE by blast
    have "X \<in> A // r"
      using \<open>X = r `` {x}\<close> \<open>x \<in> {x \<in> A. P x}\<close>
      by (auto intro: quotientI)
    moreover have "univ P X"
      using \<open>X = r `` {x}\<close> \<open>x \<in> {x \<in> A. P x}\<close> assms
      by (simp add: proj_def[symmetric] univ_commute)
    ultimately show "X \<in> {X \<in> A // r. univ P X}" by auto
  qed
next
  show "{X \<in> A // r. univ P X} \<subseteq> {x \<in> A. P x} // r"
  proof
    fix X
    assume "X \<in> {X \<in> A // r. univ P X}"
    from this have "X \<in> A // r" and "univ P X" by auto
    from \<open>X \<in> A // r\<close> obtain x where "x \<in> A" and "X = r `` {x}"
      using quotientE by blast
    have "x \<in> {x \<in> A. P x}"
      using \<open>x \<in> A\<close> \<open>X = r `` {x}\<close> \<open>univ P X\<close> assms
      by (simp add: proj_def[symmetric] univ_commute)
    from this show "X \<in> {x \<in> A. P x} // r"
      using \<open>X = r `` {x}\<close> by (auto intro: quotientI)
  qed
qed

lemma Union_quotient_restricted:
  assumes "equiv A r"
  assumes "P respects r"
  shows "\<Union>({x \<in> A. P x} // r) = {x \<in> A. P x}"
proof
  show "\<Union>({x \<in> A. P x} // r) \<subseteq> {x \<in> A. P x}"
  proof
    fix x
    assume "x \<in> \<Union>({x \<in> A. P x} // r)"
    from this obtain X where "x \<in> X" and "X \<in> {x \<in> A. P x} // r" by blast
    from this obtain x' where "X = r `` {x'}" and "x' \<in> {x \<in> A. P x}"
      using quotientE by blast
    from this \<open>x \<in> X\<close> have "x \<in> A"
      using \<open>equiv A r\<close> by (simp add: equiv_class_eq_iff)
    moreover from \<open>X = r `` {x'}\<close> \<open>x \<in> X\<close> \<open>x' \<in> {x \<in> A. P x}\<close> have "P x"
      using \<open>P respects r\<close> congruentD by fastforce
    ultimately show "x \<in> {x \<in> A. P x}" by auto
  qed
next
  show "{x \<in> A. P x} \<subseteq> \<Union>({x \<in> A. P x} // r)"
  proof
    fix x
    assume "x \<in> {x \<in> A. P x}"
    from this have "x \<in> r `` {x}"
      using \<open>equiv A r\<close> equiv_class_self by fastforce
    from \<open>x \<in> {x \<in> A. P x}\<close> have "r `` {x} \<in> {x \<in> A. P x} // r"
      by (auto intro: quotientI)
    from this \<open>x \<in> r `` {x}\<close> show "x \<in> \<Union>({x \<in> A. P x} // r)" by auto
  qed
qed

lemma finite_equiv_implies_finite_carrier:
  assumes "equiv A R"
  assumes "finite (A // R)"
  assumes "\<forall>X \<in> A // R. finite X"
  shows "finite A"
proof -
  from \<open>equiv A R\<close> have "A = \<Union>(A // R)"
    by (simp add: Union_quotient)
  from this \<open>finite (A // R)\<close> \<open>\<forall>X \<in> A // R. finite X\<close> show "finite A"
    using finite_Union by fastforce
qed

lemma finite_quotient_iff:
  assumes "equiv A R"
  shows "finite A \<longleftrightarrow> (finite (A // R) \<and> (\<forall>X \<in> A // R. finite X))"
using assms by (meson equiv_type finite_equiv_class finite_equiv_implies_finite_carrier finite_quotient)

subsubsection \<open>Counting Sets by Splitting into Equivalence Classes\<close>

lemma card_equiv_class_restricted:
  assumes "finite {x \<in> A. P x}"
  assumes "equiv A R"
  assumes "P respects R"
  shows "card {x \<in> A. P x} = sum card ({x \<in> A. P x} // R)"
proof -
  have "card {x \<in> A. P x} = card (\<Union>({x \<in> A. P x} // R))"
    using \<open>equiv A R\<close> \<open>P respects R\<close> by (simp add: Union_quotient_restricted)
  also have "card (\<Union>({x \<in> A. P x} // R)) = (\<Sum>C\<in>{x \<in> A. P x} // R. card C)"
  proof -
    from \<open>finite {x \<in> A. P x}\<close> have "finite ({x \<in> A. P x} // R)"
      using \<open>equiv A R\<close> by (metis finite_imageI proj_image)
    moreover from \<open>finite {x \<in> A. P x}\<close> have "\<forall>C\<in>{x \<in> A. P x} // R. finite C"
      using \<open>equiv A R\<close> \<open>P respects R\<close> Union_quotient_restricted
        Union_upper finite_subset by fastforce
    moreover have "\<forall>C1 \<in> {x \<in> A. P x} // R. \<forall>C2 \<in> {x \<in> A. P x} // R. C1 \<noteq> C2 \<longrightarrow> C1 \<inter> C2 = {}"
      using \<open>equiv A R\<close> quotient_disj
      by (metis (no_types, lifting) mem_Collect_eq quotientE quotientI)
    ultimately show ?thesis
      by (subst card_Union_disjoint) (auto simp: pairwise_def disjnt_def)
  qed
  finally show ?thesis .
qed

lemma card_equiv_class_restricted_same_size:
  assumes "equiv A R"
  assumes "P respects R"
  assumes "\<And>F. F \<in> {x \<in> A. P x} // R \<Longrightarrow> card F = k"
  shows "card {x \<in> A. P x} = k * card ({x \<in> A. P x} // R)"
proof cases
  assume "finite {x \<in> A. P x}"
  have "card {x \<in> A. P x} = sum card ({x \<in> A. P x} // R)"
    using \<open>finite {x \<in> A. P x}\<close> \<open>equiv A R\<close> \<open>P respects R\<close>
    by (simp add: card_equiv_class_restricted)
  also have "sum card ({x \<in> A. P x} // R) = k * card ({x \<in> A. P x} // R)"
    by (simp add: \<open>\<And>F. F \<in> {x \<in> A. P x} // R \<Longrightarrow> card F = k\<close>)
  finally show ?thesis .
next
  assume "infinite {x \<in> A. P x}"
  from this have "infinite (\<Union>({a \<in> A. P a} // R))"
    using \<open>equiv A R\<close> \<open>P respects R\<close> by (simp add: Union_quotient_restricted)
  from this have "infinite ({x \<in> A. P x} // R) \<or> (\<exists>X \<in> {x \<in> A. P x} // R. infinite X)"
    by auto
  from this show ?thesis
  proof
    assume "infinite ({x \<in> A. P x} // R)"
    from this \<open>infinite {x \<in> A. P x}\<close> show ?thesis by simp
  next
    assume "\<exists>X \<in> {x \<in> A. P x} // R. infinite X"
    from this \<open>infinite {x \<in> A. P x}\<close> show ?thesis
      using \<open>\<And>F. F \<in> {x \<in> A. P x} // R \<Longrightarrow> card F = k\<close> card_infinite by auto
  qed
qed

lemma card_equiv_class:
  assumes "finite A"
  assumes "equiv A R"
  shows "card A = sum card (A // R)"
proof -
  have "(\<lambda>x. True) respects R" by (simp add: congruentI)
  from \<open>finite A\<close> \<open>equiv A R\<close> this show ?thesis
    using card_equiv_class_restricted[where P="\<lambda>x. True"] by auto
qed

lemma card_equiv_class_same_size:
  assumes "equiv A R"
  assumes "\<And>F. F \<in> A // R \<Longrightarrow> card F = k"
  shows "card A = k * card (A // R)"
proof -
  have "(\<lambda>x. True) respects R" by (simp add: congruentI)
  from \<open>equiv A R\<close> \<open>\<And>F. F \<in> A // R \<Longrightarrow> card F = k\<close> this show ?thesis
    using card_equiv_class_restricted_same_size[where P="\<lambda>x. True"] by auto
qed

subsection \<open>Additions to FuncSet Theory\<close>

lemma finite_same_card_bij_on_ext_funcset:
  assumes "finite A" "finite B" "card A = card B"
  shows "\<exists>f. f \<in> A \<rightarrow>\<^sub>E B \<and> bij_betw f A B"
proof -
  from assms obtain f' where f': "bij_betw f' A B"
    using finite_same_card_bij by auto
  define f where "\<And>x. f x = (if x \<in> A then f' x else undefined)"
  have "f \<in> A \<rightarrow>\<^sub>E B"
    using f' unfolding f_def by (auto simp add: bij_betwE)
  moreover have "bij_betw f A B"
  proof -
    have "bij_betw f' A B \<longleftrightarrow> bij_betw f A B"
      unfolding f_def by (auto intro!: bij_betw_cong)
    from this \<open>bij_betw f' A B\<close> show ?thesis by auto
  qed
  ultimately show ?thesis by auto
qed

lemma card_extensional_funcset:
  assumes "finite A"
  shows "card (A \<rightarrow>\<^sub>E B) = card B ^ card A"
using assms by (simp add: card_PiE prod_constant)

lemma bij_betw_implies_inj_on_and_card_eq:
  assumes "finite B"
  assumes "f \<in> A \<rightarrow>\<^sub>E B"
  shows "bij_betw f A B \<longleftrightarrow> inj_on f A \<and> card A = card B"
proof
  assume "bij_betw f A B"
  from this show "inj_on f A \<and> card A = card B"
    by (simp add: bij_betw_imp_inj_on bij_betw_same_card)
next
  assume "inj_on f A \<and> card A = card B"
  from this have "inj_on f A" and "card A = card B" by auto
  from \<open>f \<in> A \<rightarrow>\<^sub>E B\<close> have "f ` A \<subseteq> B" by auto
  from \<open>inj_on f A\<close> have "card (f ` A) = card A" by (simp add: card_image)
  from \<open>f ` A \<subseteq> B\<close> \<open>card A = card B\<close> this have "f ` A = B"
    by (simp add: \<open>finite B\<close> card_subset_eq)
  from \<open>inj_on f A\<close> this show "bij_betw f A B" by (rule bij_betw_imageI)
qed

lemma bij_betw_implies_surj_on_and_card_eq:
  assumes "finite A"
  assumes "f \<in> A \<rightarrow>\<^sub>E B"
  shows "bij_betw f A B \<longleftrightarrow> f ` A = B \<and> card A = card B"
proof
  assume "bij_betw f A B"
  show "f ` A = B \<and> card A = card B"
    using \<open>bij_betw f A B\<close> bij_betw_imp_surj_on bij_betw_same_card by blast
next
  assume "f ` A = B \<and> card A = card B"
  from this have "f ` A = B" and "card A = card B" by auto
  from this have "inj_on f A"
    by (simp add: \<open>finite A\<close> inj_on_iff_eq_card)
  from this \<open>f ` A = B\<close> show "bij_betw f A B" by (rule bij_betw_imageI)
qed

subsection \<open>Additions to Permutations Theory\<close>

lemma
  assumes "f \<in> A \<rightarrow>\<^sub>E B" "f ` A = B"
  assumes "p permutes B" "(\<forall>x. f' x = p (f x))"
  shows "(\<lambda>b. {x\<in>A. f x = b}) ` B = (\<lambda>b. {x\<in>A. f' x = b}) ` B"
proof
  show "(\<lambda>b. {x \<in> A. f x = b}) ` B \<subseteq> (\<lambda>b. {x \<in> A. f' x = b}) ` B"
  proof
    fix X
    assume "X \<in> (\<lambda>b. {x \<in> A. f x = b}) ` B"
    from this obtain b where X_eq: "X = {x \<in> A. f x = b}" and "b \<in> B" by blast
    from assms(3, 4) have "\<And>x. f x = b \<longleftrightarrow> f' x = p b" by (metis permutes_def)
    from \<open>p permutes B\<close> X_eq this have "X = {x \<in> A. f' x = p b}"
      using Collect_cong by auto
    moreover from \<open>b \<in> B\<close> \<open>p permutes B\<close> have "p b \<in> B"
      by (simp add: permutes_in_image)
    ultimately show "X \<in> (\<lambda>b. {x \<in> A. f' x = b}) ` B" by blast
  qed
next
  show "(\<lambda>b. {x \<in> A. f' x = b}) ` B \<subseteq> (\<lambda>b. {x \<in> A. f x = b}) ` B"
  proof
    fix X
    assume "X \<in> (\<lambda>b. {x \<in> A. f' x = b}) ` B"
    from this obtain b where X_eq: "X = {x \<in> A. f' x = b}" and "b \<in> B" by blast
    from assms(3, 4) have "\<And>x. f' x = b \<longleftrightarrow> f x = inv p b"
      by (auto simp add: permutes_inverses(1, 2))
    from \<open>p permutes B\<close> X_eq this have "X = {x \<in> A. f x = inv p b}"
      using Collect_cong by auto
    moreover from \<open>b \<in> B\<close> \<open>p permutes B\<close> have "inv p b \<in> B"
      by (simp add: permutes_in_image permutes_inv)
    ultimately show "X \<in> (\<lambda>b. {x \<in> A. f x = b}) ` B" by blast
  qed
qed

subsection \<open>Additions to List Theory\<close>

text \<open>
The theorem @{thm [source] card_lists_length_eq} contains the superfluous assumption @{term "finite A"}.
Here, we derive that fact without that unnecessary assumption.
\<close>

lemma lists_length_eq_Suc_eq_image_Cons:
  "{xs. set xs \<subseteq> A \<and> length xs = Suc n} = (\<lambda>(x, xs). x#xs) ` (A \<times> {xs. set xs \<subseteq> A \<and> length xs = n})"
  (is "?A = ?B")
proof
  show "?A \<subseteq> ?B"
  proof
    fix xs
    assume "xs \<in> ?A"
    from this show "xs \<in> ?B" by (cases xs) auto
  qed
next
  show "?B \<subseteq> ?A" by auto
qed

lemma lists_length_eq_Suc_eq_empty_iff:
  "{xs. set xs \<subseteq> A \<and> length xs = Suc n} = {} \<longleftrightarrow> A = {}"
proof (induct n)
  case 0
  have "{xs. set xs \<subseteq> A \<and> length xs = Suc 0} = {x#[] |x. x \<in> A}"
  proof
    show "{[x] |x. x \<in> A} \<subseteq> {xs. set xs \<subseteq> A \<and> length xs = Suc 0}" by auto
  next
    show "{xs. set xs \<subseteq> A \<and> length xs = Suc 0} \<subseteq> {[x] |x. x \<in> A}"
    proof
      fix xs
      assume "xs \<in> {xs. set xs \<subseteq> A \<and> length xs = Suc 0}"
      from this have "set xs \<subseteq> A \<and> length xs = Suc 0" by simp
      from this have "\<exists>x. xs = [x] \<and> x \<in> A"
        by (metis Suc_length_conv insert_subset length_0_conv list.set(2))
      from this show "xs \<in> {[x] |x. x \<in> A}" by simp
    qed
  qed
  then show ?case by simp
next
  case (Suc n)
  from this show ?case by (auto simp only: lists_length_eq_Suc_eq_image_Cons)
qed

lemma lists_length_eq_eq_empty_iff:
  "{xs. set xs \<subseteq> A \<and> length xs = n} = {} \<longleftrightarrow> (A = {} \<and> n > 0)"
proof (cases n)
  case 0
  then show ?thesis by auto
next
  case (Suc n)
  then show ?thesis by (auto simp only: lists_length_eq_Suc_eq_empty_iff)
qed

lemma finite_lists_length_eq_iff:
  "finite {xs. set xs \<subseteq> A \<and> length xs = n} \<longleftrightarrow> (finite A \<or> n = 0)"
proof
  assume "finite {xs. set xs \<subseteq> A \<and> length xs = n}"
  from this show "finite A \<or> n = 0"
  proof (induct n)
    case 0
    then show ?case by simp
  next
    case (Suc n)
    have "inj (\<lambda>(x, xs). x#xs)"
      by (auto intro: inj_onI)
    from this Suc(2) have "finite (A \<times> {xs. set xs \<subseteq> A \<and> length xs = n})"
      using finite_imageD inj_on_subset subset_UNIV lists_length_eq_Suc_eq_image_Cons[of A n]
      by fastforce
    from this have "finite A"
      by (cases "A = {}")
        (auto simp only: lists_length_eq_eq_empty_iff dest: finite_cartesian_productD1)
    from this show ?case by auto
  qed
next
  assume "finite A \<or> n = 0"
  from this show "finite {xs. set xs \<subseteq> A \<and> length xs = n}"
    by (auto intro: finite_lists_length_eq)
qed

lemma card_lists_length_eq:
  shows "card {xs. set xs \<subseteq> B \<and> length xs = n} = card B ^ n"
proof cases
  assume "finite B"
  then show ?thesis by (rule card_lists_length_eq)
next
  assume "infinite B"
  then show ?thesis
  proof cases
    assume "n = 0"
    from this have "{xs. set xs \<subseteq> B \<and> length xs = n} = {[]}" by auto
    from this \<open>n = 0\<close> show ?thesis by simp
  next
    assume "n \<noteq> 0"
    from this \<open>infinite B\<close> have "infinite {xs. set xs \<subseteq> B \<and> length xs = n}"
      by (simp add: finite_lists_length_eq_iff)
    from this \<open>infinite B\<close> show ?thesis by auto
  qed
qed

subsection \<open>Additions to Disjoint Set Theory\<close>

lemma bij_betw_congI:
  assumes "bij_betw f A A'"
  assumes "\<forall>a \<in> A. f a = g a"
  shows "bij_betw g A A'"
using assms bij_betw_cong by fastforce

lemma disjoint_family_onI[intro]:
  assumes "\<And>m n. m \<in> S \<Longrightarrow> n \<in> S \<Longrightarrow> m \<noteq> n \<Longrightarrow> A m \<inter> A n = {}"
  shows "disjoint_family_on A S"
using assms unfolding disjoint_family_on_def by simp

text \<open>
The following lemma is not needed for this development, but is useful
and could be moved to Disjoint Set theory or Equiv Relation theory if
translated from set partitions to equivalence relations.
\<close>

lemma infinite_partition_on:
  assumes "infinite A"
  shows "infinite {P. partition_on A P}"
proof -
  from \<open>infinite A\<close> obtain x where "x \<in> A"
    by (meson finite.intros(1) finite_subset subsetI)
  from \<open>infinite A\<close> have "infinite (A - {x})"
    by (simp add: infinite_remove)
  define singletons_except_one
    where "singletons_except_one = (\<lambda>a'. (\<lambda>a. if a = a' then {a, x} else {a}) ` (A - {x}))"
  have "infinite (singletons_except_one ` (A - {x}))"
  proof -
    have "inj_on singletons_except_one (A - {x})"
      unfolding singletons_except_one_def by (rule inj_onI) auto
    from \<open>infinite (A - {x})\<close> this show ?thesis
      using finite_imageD by blast
  qed
  moreover have "singletons_except_one ` (A - {x}) \<subseteq> {P. partition_on A P}"
  proof
    fix P
    assume "P \<in> singletons_except_one ` (A - {x})"
    from this obtain a' where "a' \<in> A - {x}" and P: "P = singletons_except_one a'" by blast
    have "partition_on A ((\<lambda>a. if a = a' then {a, x} else {a}) ` (A - {x}))"
      using \<open>x \<in> A\<close> \<open>a' \<in> A - {x}\<close> by (auto intro: partition_onI)
    from this have "partition_on A P"
      unfolding P singletons_except_one_def .
    from this show "P \<in> {P. partition_on A P}" ..
  qed
  ultimately show ?thesis by (simp add: infinite_super)
qed

lemma finitely_many_partition_on_iff:
  "finite {P. partition_on A P} \<longleftrightarrow> finite A"
using finitely_many_partition_on infinite_partition_on by blast

subsection \<open>Additions to Multiset Theory\<close>

lemma mset_set_subseteq_mset_set:
  assumes "finite B" "A \<subseteq> B"
  shows "mset_set A \<subseteq># mset_set B"
proof -
  from \<open>A \<subseteq> B\<close> \<open>finite B\<close> have "finite A" using finite_subset by blast
  {
    fix x
    have "count (mset_set A) x \<le> count (mset_set B) x"
      using \<open>finite A\<close> \<open>finite B\<close> \<open>A \<subseteq> B\<close>
      by (metis count_mset_set(1, 3) eq_iff subsetCE zero_le_one)
  }
  from this show "mset_set A \<subseteq># mset_set B"
    using mset_subset_eqI by blast
qed

lemma mset_set_set_mset:
  assumes "M \<subseteq># mset_set A"
  shows "mset_set (set_mset M) = M"
proof -
  {
    fix x
    from \<open>M \<subseteq># mset_set A\<close> have "count M x \<le> count (mset_set A) x"
      by (simp add: mset_subset_eq_count)
    from this have "count (mset_set (set_mset M)) x = count M x"
      by (metis count_eq_zero_iff count_greater_eq_one_iff count_mset_set
        dual_order.antisym dual_order.trans finite_set_mset)
  }
  from this show ?thesis by (simp add: multiset_eq_iff)
qed

lemma mset_set_set_mset':
  assumes "\<forall>x. count M x \<le> 1"
  shows "mset_set (set_mset M) = M"
proof -
  {
    fix x
    from assms have "count M x = 0 \<or> count M x = 1" by (auto elim: le_SucE)
    from this have "count (mset_set (set_mset M)) x = count M x"
      by (metis count_eq_zero_iff count_mset_set(1,3) finite_set_mset)
  }
  from this show ?thesis by (simp add: multiset_eq_iff)
qed

lemma card_set_mset:
  assumes "M \<subseteq># mset_set A"
  shows "card (set_mset M) = size M"
using assms
by (metis mset_set_set_mset size_mset_set)

lemma card_set_mset':
  assumes "\<forall>x. count M x \<le> 1"
  shows "card (set_mset M) = size M"
using assms
by (metis mset_set_set_mset' size_mset_set)

lemma count_mset_set_leq:
  assumes "finite A"
  shows "count (mset_set A) x \<le> 1"
using assms by (metis count_mset_set(1,3) eq_iff zero_le_one)

lemma count_mset_set_leq':
  assumes "finite A"
  shows "count (mset_set A) x \<le> Suc 0"
using assms count_mset_set_leq by fastforce

lemma msubset_mset_set_iff:
  assumes "finite A"
  shows "set_mset M \<subseteq> A \<and> (\<forall>x. count M x \<le> 1) \<longleftrightarrow> (M \<subseteq># mset_set A)"
proof
  assume "set_mset M \<subseteq> A \<and> (\<forall>x. count M x \<le> 1)"
  from this assms show "M \<subseteq># mset_set A"
    by (metis count_inI count_mset_set(1) le0 mset_subset_eqI subsetCE)
next
  assume "M \<subseteq># mset_set A"
  from this assms have "set_mset M \<subseteq> A"
    using mset_subset_eqD by fastforce
  moreover {
    fix x
    from \<open>M \<subseteq># mset_set A\<close> have "count M x \<le> count (mset_set A) x"
      by (simp add: mset_subset_eq_count)
    from this \<open>finite A\<close> have "count M x \<le> 1"
      by (meson count_mset_set_leq le_trans)
  }
  ultimately show "set_mset M \<subseteq> A \<and> (\<forall>x. count M x \<le> 1)" by simp
qed

lemma image_mset_fun_upd:
  assumes "x \<notin># M"
  shows "image_mset (f(x := y)) M = image_mset f M"
using assms by (induct M) auto

subsection \<open>Additions to Number Partitions Theory\<close>

lemma Partition_diag:
  shows "Partition n n = 1"
by (cases n) (auto simp only: Partition_diag Partition.simps(1))

subsection \<open>Cardinality Theorems with Iverson Function\<close>

definition iverson :: "bool \<Rightarrow> nat"
where
  "iverson b = (if b then 1 else 0)"

lemma card_partition_on_size1_eq_iverson:
  assumes "finite A"
  shows "card {P. partition_on A P \<and> card P \<le> k \<and> (\<forall>X\<in>P. card X = 1)} = iverson (card A \<le> k)"
proof (cases "card A \<le> k")
  case True
  from this \<open>finite A\<close> show ?thesis
    unfolding iverson_def
    using card_partition_on_size1_eq_1 by fastforce
next
  case False
  from this \<open>finite A\<close> show ?thesis
    unfolding iverson_def
    using card_partition_on_size1_eq_0 by fastforce
qed

lemma card_number_partitions_with_only_parts_1:
  "card {N. (\<forall>n. n\<in># N \<longrightarrow> n = 1) \<and> number_partition n N \<and> size N \<le> x} = iverson (n \<le> x)"
proof -
  show ?thesis
  proof cases
    assume "n \<le> x"
    from this show ?thesis
      using card_number_partitions_with_only_parts_1_eq_1
      unfolding iverson_def by auto
  next
    assume "\<not> n \<le> x"
    from this show ?thesis
      using card_number_partitions_with_only_parts_1_eq_0
      unfolding iverson_def by auto
  qed
qed

end


(*  Title:      HOL/Algebra/Congruence.thy
    Author:     Clemens Ballarin, started 3 January 2008
    Copyright:  Clemens Ballarin
*)

theory Congruence
imports
  Main
  "~~/src/HOL/Library/FuncSet"
begin

section \<open>Objects\<close>

subsection \<open>Structure with Carrier Set.\<close>

record 'a partial_object =
  carrier :: "'a set"

lemma funcset_carrier:
  "\<lbrakk> f \<in> carrier X \<rightarrow> carrier Y; x \<in> carrier X \<rbrakk> \<Longrightarrow> f x \<in> carrier Y"
  by (fact funcset_mem)

lemma funcset_carrier':
  "\<lbrakk> f \<in> carrier A \<rightarrow> carrier A; x \<in> carrier A \<rbrakk> \<Longrightarrow> f x \<in> carrier A"
  by (fact funcset_mem)

subsection \<open>Structure with Carrier and Equivalence Relation \<open>eq\<close>\<close>

record 'a eq_object = "'a partial_object" +
  eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl ".=\<index>" 50)

definition
  elem :: "_ \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> bool" (infixl ".\<in>\<index>" 50)
  where "x .\<in>\<^bsub>S\<^esub> A \<longleftrightarrow> (\<exists>y \<in> A. x .=\<^bsub>S\<^esub> y)"

definition
  set_eq :: "_ \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> bool" (infixl "{.=}\<index>" 50)
  where "A {.=}\<^bsub>S\<^esub> B \<longleftrightarrow> ((\<forall>x \<in> A. x .\<in>\<^bsub>S\<^esub> B) \<and> (\<forall>x \<in> B. x .\<in>\<^bsub>S\<^esub> A))"

definition
  eq_class_of :: "_ \<Rightarrow> 'a \<Rightarrow> 'a set" ("class'_of\<index>")
  where "class_of\<^bsub>S\<^esub> x = {y \<in> carrier S. x .=\<^bsub>S\<^esub> y}"

definition
  eq_closure_of :: "_ \<Rightarrow> 'a set \<Rightarrow> 'a set" ("closure'_of\<index>")
  where "closure_of\<^bsub>S\<^esub> A = {y \<in> carrier S. y .\<in>\<^bsub>S\<^esub> A}"

definition
  eq_is_closed :: "_ \<Rightarrow> 'a set \<Rightarrow> bool" ("is'_closed\<index>")
  where "is_closed\<^bsub>S\<^esub> A \<longleftrightarrow> A \<subseteq> carrier S \<and> closure_of\<^bsub>S\<^esub> A = A"

abbreviation
  not_eq :: "_ \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl ".\<noteq>\<index>" 50)
  where "x .\<noteq>\<^bsub>S\<^esub> y == ~(x .=\<^bsub>S\<^esub> y)"

abbreviation
  not_elem :: "_ \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> bool" (infixl ".\<notin>\<index>" 50)
  where "x .\<notin>\<^bsub>S\<^esub> A == ~(x .\<in>\<^bsub>S\<^esub> A)"

abbreviation
  set_not_eq :: "_ \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> bool" (infixl "{.\<noteq>}\<index>" 50)
  where "A {.\<noteq>}\<^bsub>S\<^esub> B == ~(A {.=}\<^bsub>S\<^esub> B)"

locale equivalence =
  fixes S (structure)
  assumes refl [simp, intro]: "x \<in> carrier S \<Longrightarrow> x .= x"
    and sym [sym]: "\<lbrakk> x .= y; x \<in> carrier S; y \<in> carrier S \<rbrakk> \<Longrightarrow> y .= x"
    and trans [trans]:
      "\<lbrakk> x .= y; y .= z; x \<in> carrier S; y \<in> carrier S; z \<in> carrier S \<rbrakk> \<Longrightarrow> x .= z"

(* Lemmas by Stephan Hohe *)

lemma elemI:
  fixes R (structure)
  assumes "a' \<in> A" and "a .= a'"
  shows "a .\<in> A"
unfolding elem_def
using assms
by fast

lemma (in equivalence) elem_exact:
  assumes "a \<in> carrier S" and "a \<in> A"
  shows "a .\<in> A"
using assms
by (fast intro: elemI)

lemma elemE:
  fixes S (structure)
  assumes "a .\<in> A"
    and "\<And>a'. \<lbrakk>a' \<in> A; a .= a'\<rbrakk> \<Longrightarrow> P"
  shows "P"
using assms
unfolding elem_def
by fast

lemma (in equivalence) elem_cong_l [trans]:
  assumes cong: "a' .= a"
    and a: "a .\<in> A"
    and carr: "a \<in> carrier S"  "a' \<in> carrier S"
    and Acarr: "A \<subseteq> carrier S"
  shows "a' .\<in> A"
using a
apply (elim elemE, intro elemI)
proof assumption
  fix b
  assume bA: "b \<in> A"
  note [simp] = carr bA[THEN subsetD[OF Acarr]]
  note cong
  also assume "a .= b"
  finally show "a' .= b" by simp
qed

lemma (in equivalence) elem_subsetD:
  assumes "A \<subseteq> B"
    and aA: "a .\<in> A"
  shows "a .\<in> B"
using assms
by (fast intro: elemI elim: elemE dest: subsetD)

lemma (in equivalence) mem_imp_elem [simp, intro]:
  "[| x \<in> A; x \<in> carrier S |] ==> x .\<in> A"
  unfolding elem_def by blast

lemma set_eqI:
  fixes R (structure)
  assumes ltr: "\<And>a. a \<in> A \<Longrightarrow> a .\<in> B"
    and rtl: "\<And>b. b \<in> B \<Longrightarrow> b .\<in> A"
  shows "A {.=} B"
unfolding set_eq_def
by (fast intro: ltr rtl)

lemma set_eqI2:
  fixes R (structure)
  assumes ltr: "\<And>a b. a \<in> A \<Longrightarrow> \<exists>b\<in>B. a .= b"
    and rtl: "\<And>b. b \<in> B \<Longrightarrow> \<exists>a\<in>A. b .= a"
  shows "A {.=} B"
  by (intro set_eqI, unfold elem_def) (fast intro: ltr rtl)+

lemma set_eqD1:
  fixes R (structure)
  assumes AA': "A {.=} A'"
    and "a \<in> A"
  shows "\<exists>a'\<in>A'. a .= a'"
using assms
unfolding set_eq_def elem_def
by fast

lemma set_eqD2:
  fixes R (structure)
  assumes AA': "A {.=} A'"
    and "a' \<in> A'"
  shows "\<exists>a\<in>A. a' .= a"
using assms
unfolding set_eq_def elem_def
by fast

lemma set_eqE:
  fixes R (structure)
  assumes AB: "A {.=} B"
    and r: "\<lbrakk>\<forall>a\<in>A. a .\<in> B; \<forall>b\<in>B. b .\<in> A\<rbrakk> \<Longrightarrow> P"
  shows "P"
using AB
unfolding set_eq_def
by (blast dest: r)

lemma set_eqE2:
  fixes R (structure)
  assumes AB: "A {.=} B"
    and r: "\<lbrakk>\<forall>a\<in>A. (\<exists>b\<in>B. a .= b); \<forall>b\<in>B. (\<exists>a\<in>A. b .= a)\<rbrakk> \<Longrightarrow> P"
  shows "P"
using AB
unfolding set_eq_def elem_def
by (blast dest: r)

lemma set_eqE':
  fixes R (structure)
  assumes AB: "A {.=} B"
    and aA: "a \<in> A" and bB: "b \<in> B"
    and r: "\<And>a' b'. \<lbrakk>a' \<in> A; b .= a'; b' \<in> B; a .= b'\<rbrakk> \<Longrightarrow> P"
  shows "P"
proof -
  from AB aA
      have "\<exists>b'\<in>B. a .= b'" by (rule set_eqD1)
  from this obtain b'
      where b': "b' \<in> B" "a .= b'" by auto

  from AB bB
      have "\<exists>a'\<in>A. b .= a'" by (rule set_eqD2)
  from this obtain a'
      where a': "a' \<in> A" "b .= a'" by auto

  from a' b'
      show "P" by (rule r)
qed

lemma (in equivalence) eq_elem_cong_r [trans]:
  assumes a: "a .\<in> A"
    and cong: "A {.=} A'"
    and carr: "a \<in> carrier S"
    and Carr: "A \<subseteq> carrier S" "A' \<subseteq> carrier S"
  shows "a .\<in> A'"
using a cong
proof (elim elemE set_eqE)
  fix b
  assume bA: "b \<in> A"
     and inA': "\<forall>b\<in>A. b .\<in> A'"
  note [simp] = carr Carr Carr[THEN subsetD] bA
  assume "a .= b"
  also from bA inA'
       have "b .\<in> A'" by fast
  finally
       show "a .\<in> A'" by simp
qed

lemma (in equivalence) set_eq_sym [sym]:
  assumes "A {.=} B"
    and "A \<subseteq> carrier S" "B \<subseteq> carrier S"
  shows "B {.=} A"
using assms
unfolding set_eq_def elem_def
by fast

(* FIXME: the following two required in Isabelle 2008, not Isabelle 2007 *)
(* alternatively, could declare lemmas [trans] = ssubst [where 'a = "'a set"] *)

lemma (in equivalence) equal_set_eq_trans [trans]:
  assumes AB: "A = B" and BC: "B {.=} C"
  shows "A {.=} C"
  using AB BC by simp

lemma (in equivalence) set_eq_equal_trans [trans]:
  assumes AB: "A {.=} B" and BC: "B = C"
  shows "A {.=} C"
  using AB BC by simp

lemma (in equivalence) set_eq_trans [trans]:
  assumes AB: "A {.=} B" and BC: "B {.=} C"
    and carr: "A \<subseteq> carrier S"  "B \<subseteq> carrier S"  "C \<subseteq> carrier S"
  shows "A {.=} C"
proof (intro set_eqI)
  fix a
  assume aA: "a \<in> A"
  with carr have "a \<in> carrier S" by fast
  note [simp] = carr this

  from aA
       have "a .\<in> A" by (simp add: elem_exact)
  also note AB
  also note BC
  finally
       show "a .\<in> C" by simp
next
  fix c
  assume cC: "c \<in> C"
  with carr have "c \<in> carrier S" by fast
  note [simp] = carr this

  from cC
       have "c .\<in> C" by (simp add: elem_exact)
  also note BC[symmetric]
  also note AB[symmetric]
  finally
       show "c .\<in> A" by simp
qed

(* FIXME: generalise for insert *)

(*
lemma (in equivalence) set_eq_insert:
  assumes x: "x .= x'"
    and carr: "x \<in> carrier S" "x' \<in> carrier S" "A \<subseteq> carrier S"
  shows "insert x A {.=} insert x' A"
  unfolding set_eq_def elem_def
apply rule
apply rule
apply (case_tac "xa = x")
using x apply fast
apply (subgoal_tac "xa \<in> A") prefer 2 apply fast
apply (rule_tac x=xa in bexI)
using carr apply (rule_tac refl) apply auto [1]
apply safe
*)

lemma (in equivalence) set_eq_pairI:
  assumes xx': "x .= x'"
    and carr: "x \<in> carrier S" "x' \<in> carrier S" "y \<in> carrier S"
  shows "{x, y} {.=} {x', y}"
unfolding set_eq_def elem_def
proof safe
  have "x' \<in> {x', y}" by fast
  with xx' show "\<exists>b\<in>{x', y}. x .= b" by fast
next
  have "y \<in> {x', y}" by fast
  with carr show "\<exists>b\<in>{x', y}. y .= b" by fast
next
  have "x \<in> {x, y}" by fast
  with xx'[symmetric] carr
  show "\<exists>a\<in>{x, y}. x' .= a" by fast
next
  have "y \<in> {x, y}" by fast
  with carr show "\<exists>a\<in>{x, y}. y .= a" by fast
qed

lemma (in equivalence) is_closedI:
  assumes closed: "!!x y. [| x .= y; x \<in> A; y \<in> carrier S |] ==> y \<in> A"
    and S: "A \<subseteq> carrier S"
  shows "is_closed A"
  unfolding eq_is_closed_def eq_closure_of_def elem_def
  using S
  by (blast dest: closed sym)

lemma (in equivalence) closure_of_eq:
  "[| x .= x'; A \<subseteq> carrier S; x \<in> closure_of A; x \<in> carrier S; x' \<in> carrier S |] ==> x' \<in> closure_of A"
  unfolding eq_closure_of_def elem_def
  by (blast intro: trans sym)

lemma (in equivalence) is_closed_eq [dest]:
  "[| x .= x'; x \<in> A; is_closed A; x \<in> carrier S; x' \<in> carrier S |] ==> x' \<in> A"
  unfolding eq_is_closed_def
  using closure_of_eq [where A = A]
  by simp

lemma (in equivalence) is_closed_eq_rev [dest]:
  "[| x .= x'; x' \<in> A; is_closed A; x \<in> carrier S; x' \<in> carrier S |] ==> x \<in> A"
  by (drule sym) (simp_all add: is_closed_eq)

lemma closure_of_closed [simp, intro]:
  fixes S (structure)
  shows "closure_of A \<subseteq> carrier S"
unfolding eq_closure_of_def
by fast

lemma closure_of_memI:
  fixes S (structure)
  assumes "a .\<in> A"
    and "a \<in> carrier S"
  shows "a \<in> closure_of A"
unfolding eq_closure_of_def
using assms
by fast

lemma closure_ofI2:
  fixes S (structure)
  assumes "a .= a'"
    and "a' \<in> A"
    and "a \<in> carrier S"
  shows "a \<in> closure_of A"
unfolding eq_closure_of_def elem_def
using assms
by fast

lemma closure_of_memE:
  fixes S (structure)
  assumes p: "a \<in> closure_of A"
    and r: "\<lbrakk>a \<in> carrier S; a .\<in> A\<rbrakk> \<Longrightarrow> P"
  shows "P"
proof -
  from p
      have acarr: "a \<in> carrier S"
      and "a .\<in> A"
      by (simp add: eq_closure_of_def)+
  thus "P" by (rule r)
qed

lemma closure_ofE2:
  fixes S (structure)
  assumes p: "a \<in> closure_of A"
    and r: "\<And>a'. \<lbrakk>a \<in> carrier S; a' \<in> A; a .= a'\<rbrakk> \<Longrightarrow> P"
  shows "P"
proof -
  from p have acarr: "a \<in> carrier S" by (simp add: eq_closure_of_def)

  from p have "\<exists>a'\<in>A. a .= a'" by (simp add: eq_closure_of_def elem_def)
  from this obtain a'
      where "a' \<in> A" and "a .= a'" by auto

  from acarr and this
      show "P" by (rule r)
qed

(*
lemma (in equivalence) classes_consistent:
  assumes Acarr: "A \<subseteq> carrier S"
  shows "is_closed (closure_of A)"
apply (blast intro: elemI elim elemE)
using assms
apply (intro is_closedI closure_of_memI, simp)
 apply (elim elemE closure_of_memE)
proof -
  fix x a' a''
  assume carr: "x \<in> carrier S" "a' \<in> carrier S"
  assume a''A: "a'' \<in> A"
  with Acarr have "a'' \<in> carrier S" by fast
  note [simp] = carr this Acarr

  assume "x .= a'"
  also assume "a' .= a''"
  also from a''A
       have "a'' .\<in> A" by (simp add: elem_exact)
  finally show "x .\<in> A" by simp
qed
*)
(*
lemma (in equivalence) classes_small:
  assumes "is_closed B"
    and "A \<subseteq> B"
  shows "closure_of A \<subseteq> B"
using assms
by (blast dest: is_closedD2 elem_subsetD elim: closure_of_memE)

lemma (in equivalence) classes_eq:
  assumes "A \<subseteq> carrier S"
  shows "A {.=} closure_of A"
using assms
by (blast intro: set_eqI elem_exact closure_of_memI elim: closure_of_memE)

lemma (in equivalence) complete_classes:
  assumes c: "is_closed A"
  shows "A = closure_of A"
using assms
by (blast intro: closure_of_memI elem_exact dest: is_closedD1 is_closedD2 closure_of_memE)
*)

lemma equivalence_subset:
  assumes "equivalence L" "A \<subseteq> carrier L"
  shows "equivalence (L\<lparr> carrier := A \<rparr>)"
proof -
  interpret L: equivalence L
    by (simp add: assms)
  show ?thesis
    by (unfold_locales, simp_all add: L.sym assms rev_subsetD, meson L.trans assms(2) contra_subsetD)
qed

end


(*  Title:       Supremum and Liminf of Lazy Lists
    Author:      Jasmin Blanchette <j.c.blanchette at vu.nl>, 2014, 2017, 2020
    Author:      Dmitriy Traytel <traytel at inf.ethz.ch>, 2014
    Maintainer:  Jasmin Blanchette <j.c.blanchette at vu.nl>
*)

section \<open>Supremum and Liminf of Lazy Lists\<close>

theory Lazy_List_Liminf
  imports Coinductive.Coinductive_List
begin

text \<open>
Lazy lists, as defined in the \emph{Archive of Formal Proofs}, provide finite and infinite lists in
one type, defined coinductively. The present theory introduces the concept of the union of all
elements of a lazy list of sets and the limit of such a lazy list. The definitions are stated more
generally in terms of lattices. The basis for this theory is Section 4.1 (``Theorem Proving
Processes'') of Bachmair and Ganzinger's chapter.
\<close>

subsection \<open>Library\<close>

lemma less_llength_ltake: "i < llength (ltake k Xs) \<longleftrightarrow> i < k \<and> i < llength Xs"
  by simp

subsection \<open>Supremum\<close>

definition Sup_llist :: "'a set llist \<Rightarrow> 'a set" where
  "Sup_llist Xs = (\<Union>i \<in> {i. enat i < llength Xs}. lnth Xs i)"

lemma lnth_subset_Sup_llist: "enat i < llength Xs \<Longrightarrow> lnth Xs i \<subseteq> Sup_llist Xs"
  unfolding Sup_llist_def by auto

lemma Sup_llist_imp_exists_index: "x \<in> Sup_llist Xs \<Longrightarrow> \<exists>i. enat i < llength Xs \<and> x \<in> lnth Xs i"
  unfolding Sup_llist_def by auto

lemma exists_index_imp_Sup_llist: "enat i < llength Xs \<Longrightarrow> x \<in> lnth Xs i \<Longrightarrow> x \<in> Sup_llist Xs"
  unfolding Sup_llist_def by auto

lemma Sup_llist_LNil[simp]: "Sup_llist LNil = {}"
  unfolding Sup_llist_def by auto

lemma Sup_llist_LCons[simp]: "Sup_llist (LCons X Xs) = X \<union> Sup_llist Xs"
  unfolding Sup_llist_def
proof (intro subset_antisym subsetI)
  fix x
  assume "x \<in> (\<Union>i \<in> {i. enat i < llength (LCons X Xs)}. lnth (LCons X Xs) i)"
  then obtain i where len: "enat i < llength (LCons X Xs)" and nth: "x \<in> lnth (LCons X Xs) i"
    by blast
  from nth have "x \<in> X \<or> i > 0 \<and> x \<in> lnth Xs (i - 1)"
    by (metis lnth_LCons' neq0_conv)
  then have "x \<in> X \<or> (\<exists>i. enat i < llength Xs \<and> x \<in> lnth Xs i)"
    by (metis len Suc_pred' eSuc_enat iless_Suc_eq less_irrefl llength_LCons not_less order_trans)
  then show "x \<in> X \<union> (\<Union>i \<in> {i. enat i < llength Xs}. lnth Xs i)"
    by blast
qed ((auto)[], metis i0_lb lnth_0 zero_enat_def, metis Suc_ile_eq lnth_Suc_LCons)

lemma lhd_subset_Sup_llist: "\<not> lnull Xs \<Longrightarrow> lhd Xs \<subseteq> Sup_llist Xs"
  by (cases Xs) simp_all

subsection \<open>Supremum up-to\<close>

definition Sup_upto_llist :: "'a set llist \<Rightarrow> enat \<Rightarrow> 'a set" where
  "Sup_upto_llist Xs j = (\<Union>i \<in> {i. enat i < llength Xs \<and> enat i \<le> j}. lnth Xs i)"

lemma Sup_upto_llist_eq_Sup_llist_ltake: "Sup_upto_llist Xs j = Sup_llist (ltake (eSuc j) Xs)"
  unfolding Sup_upto_llist_def Sup_llist_def
  by (smt Collect_cong Sup.SUP_cong iless_Suc_eq lnth_ltake less_llength_ltake mem_Collect_eq)

lemma Sup_upto_llist_enat_0[simp]:
  "Sup_upto_llist Xs (enat 0) = (if lnull Xs then {} else lhd Xs)"
proof (cases "lnull Xs")
  case True
  then show ?thesis
    unfolding Sup_upto_llist_def by auto
next
  case False
  show ?thesis
    unfolding Sup_upto_llist_def image_def by (simp add: lhd_conv_lnth enat_0 enat_0_iff)
qed

lemma Sup_upto_llist_Suc[simp]:
  "Sup_upto_llist Xs (enat (Suc j)) =
   Sup_upto_llist Xs (enat j) \<union> (if enat (Suc j) < llength Xs then lnth Xs (Suc j) else {})"
  unfolding Sup_upto_llist_def image_def by (auto intro: le_SucI elim: le_SucE)

lemma Sup_upto_llist_infinity[simp]: "Sup_upto_llist Xs \<infinity> = Sup_llist Xs"
  unfolding Sup_upto_llist_def Sup_llist_def by simp

lemma Sup_upto_llist_0[simp]: "Sup_upto_llist Xs 0 = (if lnull Xs then {} else lhd Xs)"
  unfolding zero_enat_def by (rule Sup_upto_llist_enat_0)

lemma Sup_upto_llist_eSuc[simp]:
  "Sup_upto_llist Xs (eSuc j) =
   (case j of
      enat k \<Rightarrow> Sup_upto_llist Xs (enat (Suc k))
    | \<infinity> \<Rightarrow> Sup_llist Xs)"
  by (auto simp: eSuc_enat split: enat.split)

lemma Sup_upto_llist_mono[simp]: "j \<le> k \<Longrightarrow> Sup_upto_llist Xs j \<subseteq> Sup_upto_llist Xs k"
  unfolding Sup_upto_llist_def by auto

lemma Sup_upto_llist_subset_Sup_llist: "Sup_upto_llist Xs j \<subseteq> Sup_llist Xs"
  unfolding Sup_llist_def Sup_upto_llist_def by auto

lemma elem_Sup_llist_imp_Sup_upto_llist:
  "x \<in> Sup_llist Xs \<Longrightarrow> \<exists>j < llength Xs. x \<in> Sup_upto_llist Xs (enat j)"
  unfolding Sup_llist_def Sup_upto_llist_def by blast

lemma lnth_subset_Sup_upto_llist: "j < llength Xs \<Longrightarrow> lnth Xs j \<subseteq> Sup_upto_llist Xs j"
  unfolding Sup_upto_llist_def by auto

lemma finite_Sup_llist_imp_Sup_upto_llist:
  assumes "finite X" and "X \<subseteq> Sup_llist Xs"
  shows "\<exists>k. X \<subseteq> Sup_upto_llist Xs (enat k)"
  using assms
proof induct
  case (insert x X)
  then have x: "x \<in> Sup_llist Xs" and X: "X \<subseteq> Sup_llist Xs"
    by simp+
  from x obtain k where k: "x \<in> Sup_upto_llist Xs (enat k)"
    using elem_Sup_llist_imp_Sup_upto_llist by fast
  from X obtain k' where k': "X \<subseteq> Sup_upto_llist Xs (enat k')"
    using insert.hyps(3) by fast
  have "insert x X \<subseteq> Sup_upto_llist Xs (max k k')"
    using k k' by (metis (mono_tags) Sup_upto_llist_mono enat_ord_simps(1) insert_subset
      max.cobounded1 max.cobounded2 subset_iff)
  then show ?case
    by fast
qed simp

subsection \<open>Liminf\<close>

definition Liminf_llist :: "'a set llist \<Rightarrow> 'a set" where
  "Liminf_llist Xs =
   (\<Union>i \<in> {i. enat i < llength Xs}. \<Inter>j \<in> {j. i \<le> j \<and> enat j < llength Xs}. lnth Xs j)"

lemma Liminf_llist_LNil[simp]: "Liminf_llist LNil = {}"
  unfolding Liminf_llist_def by simp

lemma Liminf_llist_LCons:
  "Liminf_llist (LCons X Xs) = (if lnull Xs then X else Liminf_llist Xs)" (is "?lhs = ?rhs")
proof (cases "lnull Xs")
  case nnull: False
  show ?thesis
  proof
    {
      fix x
      assume "\<exists>i. enat i \<le> llength Xs
        \<and> (\<forall>j. i \<le> j \<and> enat j \<le> llength Xs \<longrightarrow> x \<in> lnth (LCons X Xs) j)"
      then have "\<exists>i. enat (Suc i) \<le> llength Xs
        \<and> (\<forall>j. Suc i \<le> j \<and> enat j \<le> llength Xs \<longrightarrow> x \<in> lnth (LCons X Xs) j)"
        by (cases "llength Xs",
            metis not_lnull_conv[THEN iffD1, OF nnull] Suc_le_D eSuc_enat eSuc_ile_mono
              llength_LCons not_less_eq_eq zero_enat_def zero_le,
            metis Suc_leD enat_ord_code(3))
      then have "\<exists>i. enat i < llength Xs \<and> (\<forall>j. i \<le> j \<and> enat j < llength Xs \<longrightarrow> x \<in> lnth Xs j)"
        by (metis Suc_ile_eq Suc_n_not_le_n lift_Suc_mono_le lnth_Suc_LCons nat_le_linear)
    }
    then show "?lhs \<subseteq> ?rhs"
      by (simp add: Liminf_llist_def nnull) (rule subsetI, simp)

    {
      fix x
      assume "\<exists>i. enat i < llength Xs \<and> (\<forall>j. i \<le> j \<and> enat j < llength Xs \<longrightarrow> x \<in> lnth Xs j)"
      then obtain i where
        i: "enat i < llength Xs" and
        j: "\<forall>j. i \<le> j \<and> enat j < llength Xs \<longrightarrow> x \<in> lnth Xs j"
        by blast

      have "enat (Suc i) \<le> llength Xs"
        using i by (simp add: Suc_ile_eq)
      moreover have "\<forall>j. Suc i \<le> j \<and> enat j \<le> llength Xs \<longrightarrow> x \<in> lnth (LCons X Xs) j"
        using Suc_ile_eq Suc_le_D j by force
      ultimately have "\<exists>i. enat i \<le> llength Xs \<and> (\<forall>j. i \<le> j \<and> enat j \<le> llength Xs \<longrightarrow>
        x \<in> lnth (LCons X Xs) j)"
        by blast
    }
    then show "?rhs \<subseteq> ?lhs"
      by (simp add: Liminf_llist_def nnull) (rule subsetI, simp)
  qed
qed (simp add: Liminf_llist_def enat_0_iff(1))

lemma lfinite_Liminf_llist: "lfinite Xs \<Longrightarrow> Liminf_llist Xs = (if lnull Xs then {} else llast Xs)"
proof (induction rule: lfinite_induct)
  case (LCons xs)
  then obtain y ys where
    xs: "xs = LCons y ys"
    by (meson not_lnull_conv)
  show ?case
    unfolding xs by (simp add: Liminf_llist_LCons LCons.IH[unfolded xs, simplified] llast_LCons)
qed (simp add: Liminf_llist_def)

lemma Liminf_llist_ltl: "\<not> lnull (ltl Xs) \<Longrightarrow> Liminf_llist Xs = Liminf_llist (ltl Xs)"
  by (metis Liminf_llist_LCons lhd_LCons_ltl lnull_ltlI)

lemma Liminf_llist_subset_Sup_llist: "Liminf_llist Xs \<subseteq> Sup_llist Xs"
  unfolding Liminf_llist_def Sup_llist_def by fast

lemma image_Liminf_llist_subset: "f ` Liminf_llist Ns \<subseteq> Liminf_llist (lmap ((`) f) Ns)"
  unfolding Liminf_llist_def by auto

lemma Liminf_llist_imp_exists_index:
  "x \<in> Liminf_llist Xs \<Longrightarrow> \<exists>i. enat i < llength Xs \<and> x \<in> lnth Xs i"
  unfolding Liminf_llist_def by auto

lemma not_Liminf_llist_imp_exists_index:
  "\<not> lnull Xs \<Longrightarrow> x \<notin> Liminf_llist Xs \<Longrightarrow> enat i < llength Xs \<Longrightarrow>
   (\<exists>j. i \<le> j \<and> enat j < llength Xs \<and> x \<notin> lnth Xs j)"
  unfolding Liminf_llist_def by auto

lemma finite_subset_Liminf_llist_imp_exists_index:
  assumes
    nnil: "\<not> lnull Xs" and
    fin: "finite X" and
    in_lim: "X \<subseteq> Liminf_llist Xs"
  shows "\<exists>i. enat i < llength Xs \<and> X \<subseteq> (\<Inter>j \<in> {j. i \<le> j \<and> enat j < llength Xs}. lnth Xs j)"
proof -
  show ?thesis
  proof (cases "X = {}")
    case True
    then show ?thesis
      using nnil by (auto intro: exI[of _ 0] simp: zero_enat_def[symmetric])
  next
    case nemp: False

    have in_lim':
      "\<forall>x \<in> X. \<exists>i. enat i < llength Xs \<and> x \<in> (\<Inter>j \<in> {j. i \<le> j \<and> enat j < llength Xs}. lnth Xs j)"
      using in_lim[unfolded Liminf_llist_def] in_mono by fastforce
    obtain i_of where
      i_of_lt: "\<forall>x \<in> X. enat (i_of x) < llength Xs" and
      in_inter: "\<forall>x \<in> X. x \<in> (\<Inter>j \<in> {j. i_of x \<le> j \<and> enat j < llength Xs}. lnth Xs j)"
      using bchoice[OF in_lim'] by blast

    define i_max where
      "i_max = Max (i_of ` X)"

    have "i_max \<in> i_of ` X"
      by (simp add: fin i_max_def nemp)
    then obtain x_max where
      x_max_in: "x_max \<in> X" and
      i_max_is: "i_max = i_of x_max"
      unfolding i_max_def by blast
    have le_i_max: "\<forall>x \<in> X. i_of x \<le> i_max"
      unfolding i_max_def by (simp add: fin)
    have "enat i_max < llength Xs"
      using i_of_lt x_max_in i_max_is by auto
    moreover have "X \<subseteq> (\<Inter>j \<in> {j. i_max \<le> j \<and> enat j < llength Xs}. lnth Xs j)"
    proof
      fix x
      assume x_in: "x \<in> X"
      then have x_in_inter: "x \<in> (\<Inter>j \<in> {j. i_of x \<le> j \<and> enat j < llength Xs}. lnth Xs j)"
        using in_inter by auto
      moreover have "{j. i_max \<le> j \<and> enat j < llength Xs}
        \<subseteq> {j. i_of x \<le> j \<and> enat j < llength Xs}"
        using x_in le_i_max by auto
      ultimately show "x \<in> (\<Inter>j \<in> {j. i_max \<le> j \<and> enat j < llength Xs}. lnth Xs j)"
        by auto
    qed
    ultimately show ?thesis
      by auto
  qed
qed

lemma Liminf_llist_lmap_image:
  assumes f_inj: "inj_on f (Sup_llist (lmap g xs))"
  shows "Liminf_llist (lmap (\<lambda>x. f ` g x) xs) = f ` Liminf_llist (lmap g xs)" (is "?lhs = ?rhs")
proof
  show "?lhs \<subseteq> ?rhs"
  proof
    fix x
    assume "x \<in> Liminf_llist (lmap (\<lambda>x. f ` g x) xs)"
    then obtain i where
      i_lt: "enat i < llength xs" and
      x_in_fgj: "\<forall>j. i \<le> j \<longrightarrow> enat j < llength xs \<longrightarrow> x \<in> f ` g (lnth xs j)"
      unfolding Liminf_llist_def by auto

    have ex_in_gi: "\<exists>y. y \<in> g (lnth xs i) \<and> x = f y"
      using f_inj i_lt x_in_fgj unfolding inj_on_def Sup_llist_def by auto
    have "\<exists>y. \<forall>j. i \<le> j \<longrightarrow> enat j < llength xs \<longrightarrow> y \<in> g (lnth xs j) \<and> x = f y"
      apply (rule exI[of _ "SOME y. y \<in> g (lnth xs i) \<and> x = f y"])
      using someI_ex[OF ex_in_gi] x_in_fgj f_inj i_lt x_in_fgj unfolding inj_on_def Sup_llist_def
      by simp (metis (no_types, lifting) imageE)
    then show "x \<in> f ` Liminf_llist (lmap g xs)"
      using i_lt unfolding Liminf_llist_def by auto
  qed
next
  show "?rhs \<subseteq> ?lhs"
    using image_Liminf_llist_subset[of f "lmap g xs", unfolded llist.map_comp] by auto
qed

lemma Liminf_llist_lmap_union:
  assumes "\<forall>x \<in> lset xs. \<forall>Y \<in> lset xs. g x \<inter> h Y = {}"
  shows "Liminf_llist (lmap (\<lambda>x. g x \<union> h x) xs) =
    Liminf_llist (lmap g xs) \<union> Liminf_llist (lmap h xs)" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x_in: "x \<in> ?lhs"
  then obtain i where
    i_lt: "enat i < llength xs" and
    j: "\<forall>j. i \<le> j \<and> enat j < llength xs \<longrightarrow> x \<in> g (lnth xs j) \<or> x \<in> h (lnth xs j)"
    using x_in[unfolded Liminf_llist_def, simplified] by blast

  then have "(\<exists>i'. enat i' < llength xs \<and> (\<forall>j. i' \<le> j \<and> enat j < llength xs \<longrightarrow> x \<in> g (lnth xs j)))
     \<or> (\<exists>i'. enat i' < llength xs \<and> (\<forall>j. i' \<le> j \<and> enat j < llength xs \<longrightarrow> x \<in> h (lnth xs j)))"
    using assms[unfolded disjoint_iff_not_equal] by (metis in_lset_conv_lnth)
  then show "x \<in> ?rhs"
    unfolding Liminf_llist_def by simp
next
  fix x
  show "x \<in> ?rhs \<Longrightarrow> x \<in> ?lhs"
    using assms unfolding Liminf_llist_def by auto
qed

lemma Liminf_set_filter_commute:
  "Liminf_llist (lmap (\<lambda>X. {x \<in> X. p x}) Xs) = {x \<in> Liminf_llist Xs. p x}"
  unfolding Liminf_llist_def by force

subsection \<open>Liminf up-to\<close>

definition Liminf_upto_llist :: "'a set llist \<Rightarrow> enat \<Rightarrow> 'a set" where
  "Liminf_upto_llist Xs k =
   (\<Union>i \<in> {i. enat i < llength Xs \<and> enat i \<le> k}.
      \<Inter>j \<in> {j. i \<le> j \<and> enat j < llength Xs \<and> enat j \<le> k}. lnth Xs j)"

lemma Liminf_upto_llist_eq_Liminf_llist_ltake:
  "Liminf_upto_llist Xs j = Liminf_llist (ltake (eSuc j) Xs)"
  unfolding Liminf_upto_llist_def Liminf_llist_def
  by (smt Collect_cong Sup.SUP_cong iless_Suc_eq lnth_ltake less_llength_ltake mem_Collect_eq)

lemma Liminf_upto_llist_enat[simp]:
  "Liminf_upto_llist Xs (enat k) =
   (if enat k < llength Xs then lnth Xs k else if lnull Xs then {} else llast Xs)"
proof (cases "enat k < llength Xs")
  case True
  then show ?thesis
    unfolding Liminf_upto_llist_def by force
next
  case k_ge: False
  show ?thesis
proof (cases "lnull Xs")
  case nil: True
  then show ?thesis
    unfolding Liminf_upto_llist_def by simp
next
  case nnil: False
  then obtain j where
    j: "eSuc (enat j) = llength Xs"
    using k_ge by (metis eSuc_enat_iff enat_ile le_less_linear lhd_LCons_ltl llength_LCons)

  have fin: "lfinite Xs"
    using k_ge not_lfinite_llength by fastforce
  have le_k: "enat i < llength Xs \<and> i \<le> k \<longleftrightarrow> enat i < llength Xs" for i
    using k_ge linear order_le_less_subst2 by fastforce
  have "Liminf_upto_llist Xs (enat k) = llast Xs"
    using j nnil lfinite_Liminf_llist[OF fin] nnil
    unfolding Liminf_upto_llist_def Liminf_llist_def using llast_conv_lnth[OF j[symmetric]]
    by (simp add: le_k)
  then show ?thesis
    using k_ge nnil by simp
  qed
qed

lemma Liminf_upto_llist_infinity[simp]: "Liminf_upto_llist Xs \<infinity> = Liminf_llist Xs"
  unfolding Liminf_upto_llist_def Liminf_llist_def by simp

lemma Liminf_upto_llist_0[simp]:
  "Liminf_upto_llist Xs 0 = (if lnull Xs then {} else lhd Xs)"
  unfolding Liminf_upto_llist_def image_def
  by (simp add: enat_0[symmetric]) (simp add: enat_0 lnth_0_conv_lhd)

lemma Liminf_upto_llist_eSuc[simp]:
  "Liminf_upto_llist Xs (eSuc j) =
   (case j of
      enat k \<Rightarrow> Liminf_upto_llist Xs (enat (Suc k))
    | \<infinity> \<Rightarrow> Liminf_llist Xs)"
  by (auto simp: eSuc_enat split: enat.split)

lemma elem_Liminf_llist_imp_Liminf_upto_llist:
  "x \<in> Liminf_llist Xs \<Longrightarrow>
   \<exists>i < llength Xs. \<forall>j. i \<le> j \<and> j < llength Xs \<longrightarrow> x \<in> Liminf_upto_llist Xs (enat j)"
  unfolding Liminf_llist_def Liminf_upto_llist_def using enat_ord_simps(1) by force

end