Theory Preliminaries

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

section ‹Preliminaries›

theory Preliminaries
imports
  Main
  "HOL-Library.Multiset"
  "HOL-Library.FuncSet"
  "HOL-Combinatorics.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 ‹Additions to Finite Set Theory›

lemma subset_with_given_card_exists:
  assumes "n  card A"
  shows "B  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  A" "card B = n" by auto
  from this B  A card B = n have "card B < card A"
    using Suc.prems by linarith
  from Suc n  card A card.infinite have "finite A" by force
  from this B  A finite_subset have "finite B" by blast
  from card B < card A B  A obtain a where "a  A" "a  B"
    by (metis less_irrefl subsetI subset_antisym)
  have "insert a B  A" "card (insert a B) = Suc n"
    using finite B a  A a  B B  A card B = n by auto
  then show ?case by blast
qed

subsection ‹Additions to Equiv Relation Theory›

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  A // R"
  assumes "univ P X"
  shows "xX. P x"
proof -
  from assms(1,3) obtain x where "x  X"
    by (metis equiv_class_self quotientE)
  from x  X 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  A. P x} // r = {X  A // r. univ P X}"
proof
  show "{x  A. P x} // r  {X  A // r. univ P X}"
  proof
    fix X
    assume "X  {x  A. P x} // r"
    from this obtain x where "x  {x  A. P x}" and "X = r `` {x}"
      using quotientE by blast
    have "X  A // r"
      using X = r `` {x} x  {x  A. P x}
      by (auto intro: quotientI)
    moreover have "univ P X"
      using X = r `` {x} x  {x  A. P x} assms
      by (simp add: proj_def[symmetric] univ_commute)
    ultimately show "X  {X  A // r. univ P X}" by auto
  qed
next
  show "{X  A // r. univ P X}  {x  A. P x} // r"
  proof
    fix X
    assume "X  {X  A // r. univ P X}"
    from this have "X  A // r" and "univ P X" by auto
    from X  A // r obtain x where "x  A" and "X = r `` {x}"
      using quotientE by blast
    have "x  {x  A. P x}"
      using x  A X = r `` {x} univ P X assms
      by (simp add: proj_def[symmetric] univ_commute)
    from this show "X  {x  A. P x} // r"
      using X = r `` {x} by (auto intro: quotientI)
  qed
qed

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

lemma finite_equiv_implies_finite_carrier:
  assumes "equiv A R"
  assumes "finite (A // R)"
  assumes "X  A // R. finite X"
  shows "finite A"
proof -
  from equiv A R have "A = (A // R)"
    by (simp add: Union_quotient)
  from this finite (A // R) X  A // R. finite X show "finite A"
    using finite_Union by fastforce
qed

lemma finite_quotient_iff:
  assumes "equiv A R"
  shows "finite A  (finite (A // R)  (X  A // R. finite X))"
using assms by (meson equiv_type finite_equiv_class finite_equiv_implies_finite_carrier finite_quotient)

subsubsection ‹Counting Sets by Splitting into Equivalence Classes›

lemma card_equiv_class_restricted:
  assumes "finite {x  A. P x}"
  assumes "equiv A R"
  assumes "P respects R"
  shows "card {x  A. P x} = sum card ({x  A. P x} // R)"
proof -
  have "card {x  A. P x} = card (({x  A. P x} // R))"
    using equiv A R P respects R by (simp add: Union_quotient_restricted)
  also have "card (({x  A. P x} // R)) = (C{x  A. P x} // R. card C)"
  proof -
    from finite {x  A. P x} have "finite ({x  A. P x} // R)"
      using equiv A R by (metis finite_imageI proj_image)
    moreover from finite {x  A. P x} have "C{x  A. P x} // R. finite C"
      using equiv A R P respects R Union_quotient_restricted
        Union_upper finite_subset by fastforce
    moreover have "C1  {x  A. P x} // R. C2  {x  A. P x} // R. C1  C2  C1  C2 = {}"
      using equiv A R 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 "F. F  {x  A. P x} // R  card F = k"
  shows "card {x  A. P x} = k * card ({x  A. P x} // R)"
proof cases
  assume "finite {x  A. P x}"
  have "card {x  A. P x} = sum card ({x  A. P x} // R)"
    using finite {x  A. P x} equiv A R P respects R
    by (simp add: card_equiv_class_restricted)
  also have "sum card ({x  A. P x} // R) = k * card ({x  A. P x} // R)"
    by (simp add: F. F  {x  A. P x} // R  card F = k)
  finally show ?thesis .
next
  assume "infinite {x  A. P x}"
  from this have "infinite (({a  A. P a} // R))"
    using equiv A R P respects R by (simp add: Union_quotient_restricted)
  from this have "infinite ({x  A. P x} // R)  (X  {x  A. P x} // R. infinite X)"
    by auto
  from this show ?thesis
  proof
    assume "infinite ({x  A. P x} // R)"
    from this infinite {x  A. P x} show ?thesis by simp
  next
    assume "X  {x  A. P x} // R. infinite X"
    from this infinite {x  A. P x} show ?thesis
      using F. F  {x  A. P x} // R  card F = k 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 "(λx. True) respects R" by (simp add: congruentI)
  from finite A equiv A R this show ?thesis
    using card_equiv_class_restricted[where P="λx. True"] by auto
qed

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

subsection ‹Additions to FuncSet Theory›

lemma finite_same_card_bij_on_ext_funcset:
  assumes "finite A" "finite B" "card A = card B"
  shows "f. f  A E B  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 "x. f x = (if x  A then f' x else undefined)"
  have "f  A 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  bij_betw f A B"
      unfolding f_def by (auto intro!: bij_betw_cong)
    from this bij_betw f' A B show ?thesis by auto
  qed
  ultimately show ?thesis by auto
qed

lemma card_extensional_funcset:
  assumes "finite A"
  shows "card (A 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  A E B"
  shows "bij_betw f A B  inj_on f A  card A = card B"
proof
  assume "bij_betw f A B"
  from this show "inj_on f A  card A = card B"
    by (simp add: bij_betw_imp_inj_on bij_betw_same_card)
next
  assume "inj_on f A  card A = card B"
  from this have "inj_on f A" and "card A = card B" by auto
  from f  A E B have "f ` A  B" by auto
  from inj_on f A have "card (f ` A) = card A" by (simp add: card_image)
  from f ` A  B card A = card B this have "f ` A = B"
    by (simp add: finite B card_subset_eq)
  from inj_on f A 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  A E B"
  shows "bij_betw f A B  f ` A = B  card A = card B"
proof
  assume "bij_betw f A B"
  show "f ` A = B  card A = card B"
    using bij_betw f A B bij_betw_imp_surj_on bij_betw_same_card by blast
next
  assume "f ` A = B  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: finite A inj_on_iff_eq_card)
  from this f ` A = B show "bij_betw f A B" by (rule bij_betw_imageI)
qed

subsection ‹Additions to Permutations Theory›

lemma
  assumes "f  A E B" "f ` A = B"
  assumes "p permutes B" "(x. f' x = p (f x))"
  shows "(λb. {xA. f x = b}) ` B = (λb. {xA. f' x = b}) ` B"
proof
  show "(λb. {x  A. f x = b}) ` B  (λb. {x  A. f' x = b}) ` B"
  proof
    fix X
    assume "X  (λb. {x  A. f x = b}) ` B"
    from this obtain b where X_eq: "X = {x  A. f x = b}" and "b  B" by blast
    from assms(3, 4) have "x. f x = b  f' x = p b" by (metis permutes_def)
    from p permutes B X_eq this have "X = {x  A. f' x = p b}"
      using Collect_cong by auto
    moreover from b  B p permutes B have "p b  B"
      by (simp add: permutes_in_image)
    ultimately show "X  (λb. {x  A. f' x = b}) ` B" by blast
  qed
next
  show "(λb. {x  A. f' x = b}) ` B  (λb. {x  A. f x = b}) ` B"
  proof
    fix X
    assume "X  (λb. {x  A. f' x = b}) ` B"
    from this obtain b where X_eq: "X = {x  A. f' x = b}" and "b  B" by blast
    from assms(3, 4) have "x. f' x = b  f x = inv p b"
      by (auto simp add: permutes_inverses(1, 2))
    from p permutes B X_eq this have "X = {x  A. f x = inv p b}"
      using Collect_cong by auto
    moreover from b  B p permutes B have "inv p b  B"
      by (simp add: permutes_in_image permutes_inv)
    ultimately show "X  (λb. {x  A. f x = b}) ` B" by blast
  qed
qed

subsection ‹Additions to List Theory›

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

lemma lists_length_eq_Suc_eq_image_Cons:
  "{xs. set xs  A  length xs = Suc n} = (λ(x, xs). x#xs) ` (A × {xs. set xs  A  length xs = n})"
  (is "?A = ?B")
proof
  show "?A  ?B"
  proof
    fix xs
    assume "xs  ?A"
    from this show "xs  ?B" by (cases xs) auto
  qed
next
  show "?B  ?A" by auto
qed

lemma lists_length_eq_Suc_eq_empty_iff:
  "{xs. set xs  A  length xs = Suc n} = {}  A = {}"
proof (induct n)
  case 0
  have "{xs. set xs  A  length xs = Suc 0} = {x#[] |x. x  A}"
  proof
    show "{[x] |x. x  A}  {xs. set xs  A  length xs = Suc 0}" by auto
  next
    show "{xs. set xs  A  length xs = Suc 0}  {[x] |x. x  A}"
    proof
      fix xs
      assume "xs  {xs. set xs  A  length xs = Suc 0}"
      from this have "set xs  A  length xs = Suc 0" by simp
      from this have "x. xs = [x]  x  A"
        by (metis Suc_length_conv insert_subset length_0_conv list.set(2))
      from this show "xs  {[x] |x. x  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  A  length xs = n} = {}  (A = {}  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  A  length xs = n}  (finite A  n = 0)"
proof
  assume "finite {xs. set xs  A  length xs = n}"
  from this show "finite A  n = 0"
  proof (induct n)
    case 0
    then show ?case by simp
  next
    case (Suc n)
    have "inj (λ(x, xs). x#xs)"
      by (auto intro: inj_onI)
    from this Suc(2) have "finite (A × {xs. set xs  A  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  n = 0"
  from this show "finite {xs. set xs  A  length xs = n}"
    by (auto intro: finite_lists_length_eq)
qed

lemma card_lists_length_eq:
  shows "card {xs. set xs  B  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  B  length xs = n} = {[]}" by auto
    from this n = 0 show ?thesis by simp
  next
    assume "n  0"
    from this infinite B have "infinite {xs. set xs  B  length xs = n}"
      by (simp add: finite_lists_length_eq_iff)
    from this infinite B show ?thesis by auto
  qed
qed

subsection ‹Additions to Disjoint Set Theory›

lemma bij_betw_congI:
  assumes "bij_betw f A A'"
  assumes "a  A. f a = g a"
  shows "bij_betw g A A'"
using assms bij_betw_cong by fastforce

lemma disjoint_family_onI[intro]:
  assumes "m n. m  S  n  S  m  n  A m  A n = {}"
  shows "disjoint_family_on A S"
using assms unfolding disjoint_family_on_def by simp

text ‹
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.
›

lemma infinite_partition_on:
  assumes "infinite A"
  shows "infinite {P. partition_on A P}"
proof -
  from infinite A obtain x where "x  A"
    by (meson finite.intros(1) finite_subset subsetI)
  from infinite A have "infinite (A - {x})"
    by (simp add: infinite_remove)
  define singletons_except_one
    where "singletons_except_one = (λa'. (λ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 infinite (A - {x}) this show ?thesis
      using finite_imageD by blast
  qed
  moreover have "singletons_except_one ` (A - {x})  {P. partition_on A P}"
  proof
    fix P
    assume "P  singletons_except_one ` (A - {x})"
    from this obtain a' where "a'  A - {x}" and P: "P = singletons_except_one a'" by blast
    have "partition_on A ((λa. if a = a' then {a, x} else {a}) ` (A - {x}))"
      using x  A a'  A - {x} by (auto intro: partition_onI)
    from this have "partition_on A P"
      unfolding P singletons_except_one_def .
    from this show "P  {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}  finite A"
using finitely_many_partition_on infinite_partition_on by blast

subsection ‹Additions to Multiset Theory›

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

lemma mset_set_set_mset:
  assumes "M ⊆# mset_set A"
  shows "mset_set (set_mset M) = M"
proof -
  {
    fix x
    from M ⊆# mset_set A have "count M x  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 "x. count M x  1"
  shows "mset_set (set_mset M) = M"
proof -
  {
    fix x
    from assms have "count M x = 0  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 ⊆# 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 "x. count M x  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  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  Suc 0"
using assms count_mset_set_leq by fastforce

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

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

subsection ‹Additions to Number Partitions Theory›

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

subsection ‹Cardinality Theorems with Iverson Function›

definition iverson :: "bool  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  card P  k  (XP. card X = 1)} = iverson (card A  k)"
proof (cases "card A  k")
  case True
  from this finite A show ?thesis
    unfolding iverson_def
    using card_partition_on_size1_eq_1 by fastforce
next
  case False
  from this finite A 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. (n. n∈# N  n = 1)  number_partition n N  size N  x} = iverson (n  x)"
proof -
  show ?thesis
  proof cases
    assume "n  x"
    from this show ?thesis
      using card_number_partitions_with_only_parts_1_eq_1
      unfolding iverson_def by auto
  next
    assume "¬ n  x"
    from this show ?thesis
      using card_number_partitions_with_only_parts_1_eq_0
      unfolding iverson_def by auto
  qed
qed

end