(*
  File:     Indep_System.thy
  Author:   Jonas Keinholz

Independence systems
*)
section \<open>Independence systems\<close>
theory Indep_System
  imports Main
begin

lemma finite_psubset_inc_induct:
  assumes "finite A" "X \<subseteq> A"
  assumes "\<And>X. (\<And>Y. X \<subset> Y \<Longrightarrow> Y \<subseteq> A \<Longrightarrow> P Y) \<Longrightarrow> P X"
  shows "P X"
proof -
  have wf: "wf {(X,Y). Y \<subset> X \<and> X \<subseteq> A}"
    by (rule wf_bounded_set[where ub = "\<lambda>_. A" and f = id]) (auto simp add: \<open>finite A\<close>)
  show ?thesis
  proof (induction X rule: wf_induct[OF wf, case_names step])
    case (step X)
    then show ?case using assms(3)[of X] by blast
  qed
qed

text \<open>
  An \emph{independence system} consists of a finite ground set together with an independence
  predicate over the sets of this ground set. At least one set of the carrier is independent and
  subsets of independent sets are also independent.
\<close>

locale indep_system =
  fixes carrier :: "'a set"
  fixes indep :: "'a set \<Rightarrow> bool"
  assumes carrier_finite: "finite carrier"
  assumes indep_subset_carrier: "indep X \<Longrightarrow> X \<subseteq> carrier"
  assumes indep_ex: "\<exists>X. indep X"
  assumes indep_subset: "indep X \<Longrightarrow> Y \<subseteq> X \<Longrightarrow> indep Y"
begin

lemmas psubset_inc_induct [case_names carrier step] = finite_psubset_inc_induct[OF carrier_finite]
lemmas indep_finite [simp] = finite_subset[OF indep_subset_carrier carrier_finite]

text \<open>
  The empty set is independent.
\<close>

lemma indep_empty [simp]: "indep {}"
  using indep_ex indep_subset by auto

subsection \<open>Sub-independence systems\<close>

text \<open>
  A subset of the ground set induces an independence system.
\<close>

definition indep_in where "indep_in \<E> X \<longleftrightarrow> X \<subseteq> \<E> \<and> indep X"

lemma indep_inI:
  assumes "X \<subseteq> \<E>"
  assumes "indep X"
  shows "indep_in \<E> X"
  using assms unfolding indep_in_def by auto

lemma indep_in_subI: "indep_in \<E> X \<Longrightarrow> indep_in \<E>' (X \<inter> \<E>')"
  using indep_subset unfolding indep_in_def by auto

lemma dep_in_subI:
  assumes "X \<subseteq> \<E>'"
  shows "\<not> indep_in \<E>' X \<Longrightarrow> \<not> indep_in \<E> X"
  using assms unfolding indep_in_def by auto

lemma indep_in_subset_carrier: "indep_in \<E> X \<Longrightarrow> X \<subseteq> \<E>"
  unfolding indep_in_def by auto

lemma indep_in_subI_subset:
  assumes "\<E>' \<subseteq> \<E>"
  assumes "indep_in \<E>' X"
  shows "indep_in \<E> X"
proof -
  have "indep_in \<E> (X \<inter> \<E>)" using assms indep_in_subI by auto
  moreover have "X \<inter> \<E> = X" using assms indep_in_subset_carrier by auto
  ultimately show ?thesis by auto
qed

lemma indep_in_supI:
  assumes "X \<subseteq> \<E>'" "\<E>' \<subseteq> \<E>"
  assumes "indep_in \<E> X"
  shows "indep_in \<E>' X"
proof -
  have "X \<inter> \<E>' = X" using assms by auto
  then show ?thesis using assms indep_in_subI[where \<E> = \<E> and \<E>' = \<E>' and X = X] by auto
qed

lemma indep_in_indep: "indep_in \<E> X \<Longrightarrow> indep X"
  unfolding indep_in_def by auto

lemmas indep_inD = indep_in_subset_carrier indep_in_indep

lemma indep_system_subset [simp, intro]:
  assumes "\<E> \<subseteq> carrier"
  shows "indep_system \<E> (indep_in \<E>)"
  unfolding indep_system_def indep_in_def
  using finite_subset[OF assms carrier_finite] indep_subset by auto

text \<open>
  We will work a lot with different sub structures. Therefore, every definition `foo' will have
  a counterpart `foo\_in' which has the ground set as an additional parameter. Furthermore, every
  result about `foo' will have another result about `foo\_in'. With this, we usually don't have to
  work with @{command interpretation} in proofs.
\<close>

context
  fixes \<E>
  assumes "\<E> \<subseteq> carrier"
begin

interpretation \<E>: indep_system \<E> "indep_in \<E>"
  using \<open>\<E> \<subseteq> carrier\<close> by auto

lemma indep_in_sub_cong:
  assumes "\<E>' \<subseteq> \<E>"
  shows "\<E>.indep_in \<E>' X \<longleftrightarrow> indep_in \<E>' X"
  unfolding \<E>.indep_in_def indep_in_def using assms by auto

lemmas indep_in_ex = \<E>.indep_ex
lemmas indep_in_subset = \<E>.indep_subset
lemmas indep_in_empty = \<E>.indep_empty

end

subsection \<open>Bases\<close>

text \<open>
  A \emph{basis} is a maximal independent set, i.\,e.\ an independent set which becomes dependent on
  inserting any element of the ground set.
\<close>

definition basis where "basis X \<longleftrightarrow> indep X \<and> (\<forall>x \<in> carrier - X. \<not> indep (insert x X))"

lemma basisI:
  assumes "indep X"
  assumes "\<And>x. x \<in> carrier - X \<Longrightarrow> \<not> indep (insert x X)"
  shows "basis X"
  using assms unfolding basis_def by auto

lemma basis_indep: "basis X \<Longrightarrow> indep X"
  unfolding basis_def by auto

lemma basis_max_indep: "basis X \<Longrightarrow> x \<in> carrier - X \<Longrightarrow> \<not> indep (insert x X)"
  unfolding basis_def by auto

lemmas basisD = basis_indep basis_max_indep
lemmas basis_subset_carrier = indep_subset_carrier[OF basis_indep]
lemmas basis_finite [simp] = indep_finite[OF basis_indep]

lemma indep_not_basis:
  assumes "indep X"
  assumes "\<not> basis X"
  shows "\<exists>x \<in> carrier - X. indep (insert x X)"
  using assms basisI by auto

lemma basis_subset_eq:
  assumes "basis B\<^sub>1"
  assumes "basis B\<^sub>2"
  assumes "B\<^sub>1 \<subseteq> B\<^sub>2"
  shows "B\<^sub>1 = B\<^sub>2"
proof (rule ccontr)
  assume "B\<^sub>1 \<noteq> B\<^sub>2"
  then obtain x where x: "x \<in> B\<^sub>2 - B\<^sub>1" using assms by auto
  then have "insert x B\<^sub>1 \<subseteq> B\<^sub>2" using assms by auto
  then have "indep (insert x B\<^sub>1)" using assms basis_indep[of B\<^sub>2] indep_subset by auto
  moreover have "x \<in> carrier - B\<^sub>1" using assms x basis_subset_carrier by auto
  ultimately show False using assms basisD by auto
qed

definition basis_in where
  "basis_in \<E> X \<longleftrightarrow> indep_system.basis \<E> (indep_in \<E>) X"

lemma basis_iff_basis_in: "basis B \<longleftrightarrow> basis_in carrier B"
proof -
  interpret \<E>: indep_system carrier "indep_in carrier"
    by auto

  show "basis B \<longleftrightarrow> basis_in carrier B"
    unfolding basis_in_def
  proof (standard, goal_cases LTR RTL)
    case LTR
    show ?case
    proof (rule \<E>.basisI)
      show "indep_in carrier B" using LTR basisD indep_subset_carrier indep_inI by auto
    next
      fix x
      assume "x \<in> carrier - B"
      then have "\<not> indep (insert x B)" using LTR basisD by auto
      then show "\<not> indep_in carrier (insert x B)" using indep_inD by auto
    qed
  next
    case RTL
    show ?case
    proof (rule basisI)
      show "indep B" using RTL \<E>.basis_indep indep_inD by blast
    next
      fix x
      assume "x \<in> carrier - B"
      then have "\<not> indep_in carrier (insert x B)" using RTL \<E>.basisD by auto
      then show "\<not> indep (insert x B)" using indep_subset_carrier indep_inI by blast
    qed
  qed
qed

context
  fixes \<E>
  assumes "\<E> \<subseteq> carrier"
begin

interpretation \<E>: indep_system \<E> "indep_in \<E>"
  using \<open>\<E> \<subseteq> carrier\<close> by auto

lemma basis_inI_aux: "\<E>.basis X \<Longrightarrow> basis_in \<E> X"
  unfolding basis_in_def by auto

lemma basis_inD_aux: "basis_in \<E> X \<Longrightarrow> \<E>.basis X"
  unfolding basis_in_def by auto

lemma not_basis_inD_aux: "\<not> basis_in \<E> X \<Longrightarrow> \<not> \<E>.basis X"
  using basis_inI_aux by auto

lemmas basis_inI = basis_inI_aux[OF \<E>.basisI]
lemmas basis_in_indep_in = \<E>.basis_indep[OF basis_inD_aux]
lemmas basis_in_max_indep_in = \<E>.basis_max_indep[OF basis_inD_aux]
lemmas basis_inD = \<E>.basisD[OF basis_inD_aux]
lemmas basis_in_subset_carrier = \<E>.basis_subset_carrier[OF basis_inD_aux]
lemmas basis_in_finite = \<E>.basis_finite[OF basis_inD_aux]
lemmas indep_in_not_basis_in = \<E>.indep_not_basis[OF _ not_basis_inD_aux]
lemmas basis_in_subset_eq = \<E>.basis_subset_eq[OF basis_inD_aux basis_inD_aux]

end

context
  fixes \<E>
  assumes *: "\<E> \<subseteq> carrier"
begin

interpretation \<E>: indep_system \<E> "indep_in \<E>"
  using * by auto

lemma basis_in_sub_cong:
  assumes "\<E>' \<subseteq> \<E>"
  shows "\<E>.basis_in \<E>' B \<longleftrightarrow> basis_in \<E>' B"
proof (safe, goal_cases LTR RTL)
  case LTR
  show ?case
  proof (rule basis_inI)
    show "\<E>' \<subseteq> carrier" using assms * by auto
  next
    show "indep_in \<E>' B"
      using * assms LTR \<E>.basis_in_subset_carrier \<E>.basis_in_indep_in indep_in_sub_cong by auto
  next
    fix x
    assume "x \<in> \<E>' - B"
    then show "\<not> indep_in \<E>' (insert x B)"
      using * assms LTR \<E>.basis_in_max_indep_in \<E>.basis_in_subset_carrier indep_in_sub_cong by auto
  qed
next
  case RTL
  show ?case
  proof (rule \<E>.basis_inI)
    show "\<E>' \<subseteq> \<E>" using assms by auto
  next
    show "\<E>.indep_in \<E>' B"
      using * assms RTL basis_in_subset_carrier basis_in_indep_in indep_in_sub_cong by auto
  next
    fix x
    assume "x \<in> \<E>' - B"
    then show "\<not> \<E>.indep_in \<E>' (insert x B)"
      using * assms RTL basis_in_max_indep_in basis_in_subset_carrier indep_in_sub_cong by auto
  qed
qed

end

subsection \<open>Circuits\<close>

text \<open>
  A \emph{circuit} is a minimal dependent set, i.\,e.\ a set which becomes independent on removing
  any element of the ground set.
\<close>

definition circuit where "circuit X \<longleftrightarrow> X \<subseteq> carrier \<and> \<not> indep X \<and> (\<forall>x \<in> X. indep (X - {x}))"

lemma circuitI:
  assumes "X \<subseteq> carrier"
  assumes "\<not> indep X"
  assumes "\<And>x. x \<in> X \<Longrightarrow> indep (X - {x})"
  shows "circuit X"
  using assms unfolding circuit_def by auto

lemma circuit_subset_carrier: "circuit X \<Longrightarrow> X \<subseteq> carrier"
  unfolding circuit_def by auto
lemmas circuit_finite [simp] = finite_subset[OF circuit_subset_carrier carrier_finite]

lemma circuit_dep: "circuit X \<Longrightarrow> \<not> indep X"
  unfolding circuit_def by auto

lemma circuit_min_dep: "circuit X \<Longrightarrow> x \<in> X \<Longrightarrow> indep (X - {x})"
  unfolding circuit_def by auto

lemmas circuitD = circuit_subset_carrier circuit_dep circuit_min_dep

lemma circuit_nonempty: "circuit X \<Longrightarrow> X \<noteq> {}"
  using circuit_dep indep_empty by blast

lemma dep_not_circuit:
  assumes "X \<subseteq> carrier"
  assumes "\<not> indep X"
  assumes "\<not> circuit X"
  shows "\<exists>x \<in> X. \<not> indep (X - {x})"
  using assms circuitI by auto

lemma circuit_subset_eq:
  assumes "circuit C\<^sub>1"
  assumes "circuit C\<^sub>2"
  assumes "C\<^sub>1 \<subseteq> C\<^sub>2"
  shows "C\<^sub>1 = C\<^sub>2"
proof (rule ccontr)
  assume "C\<^sub>1 \<noteq> C\<^sub>2"
  then obtain x where "x \<notin> C\<^sub>1" "x \<in> C\<^sub>2" using assms by auto
  then have "indep C\<^sub>1" using indep_subset \<open>C\<^sub>1 \<subseteq> C\<^sub>2\<close> circuit_min_dep[OF \<open>circuit C\<^sub>2\<close>, of x] by auto
  then show False using assms circuitD by auto
qed

definition circuit_in where
  "circuit_in \<E> X \<longleftrightarrow> indep_system.circuit \<E> (indep_in \<E>) X"

context
  fixes \<E>
  assumes "\<E> \<subseteq> carrier"
begin

interpretation \<E>: indep_system \<E> "indep_in \<E>"
  using \<open>\<E> \<subseteq> carrier\<close> by auto

lemma circuit_inI_aux: "\<E>.circuit X \<Longrightarrow> circuit_in \<E> X"
  unfolding circuit_in_def by auto

lemma circuit_inD_aux: "circuit_in \<E> X \<Longrightarrow> \<E>.circuit X"
  unfolding circuit_in_def by auto

lemma not_circuit_inD_aux: "\<not> circuit_in \<E> X \<Longrightarrow> \<not> \<E>.circuit X"
  using circuit_inI_aux by auto

lemmas circuit_inI = circuit_inI_aux[OF \<E>.circuitI]

lemmas circuit_in_subset_carrier = \<E>.circuit_subset_carrier[OF circuit_inD_aux]
lemmas circuit_in_finite = \<E>.circuit_finite[OF circuit_inD_aux]
lemmas circuit_in_dep_in = \<E>.circuit_dep[OF circuit_inD_aux]
lemmas circuit_in_min_dep_in = \<E>.circuit_min_dep[OF circuit_inD_aux]
lemmas circuit_inD = \<E>.circuitD[OF circuit_inD_aux]
lemmas circuit_in_nonempty = \<E>.circuit_nonempty[OF circuit_inD_aux]
lemmas dep_in_not_circuit_in = \<E>.dep_not_circuit[OF _ _ not_circuit_inD_aux]
lemmas circuit_in_subset_eq = \<E>.circuit_subset_eq[OF circuit_inD_aux circuit_inD_aux]

end

lemma circuit_in_subI:
  assumes "\<E>' \<subseteq> \<E>" "\<E> \<subseteq> carrier"
  assumes "circuit_in \<E>' C"
  shows "circuit_in \<E> C"
proof (rule circuit_inI)
  show "\<E> \<subseteq> carrier" using assms by auto
next
  show "C \<subseteq> \<E>" using assms circuit_in_subset_carrier[of \<E>' C] by auto
next
  show "\<not> indep_in \<E> C"
    using assms
      circuit_in_dep_in[where \<E> = \<E>' and X = C]
      circuit_in_subset_carrier dep_in_subI[where \<E>' = \<E>' and \<E> = \<E>]
    by auto
next
  fix x
  assume "x \<in> C"
  then show "indep_in \<E> (C - {x})"
    using assms circuit_in_min_dep_in indep_in_subI_subset by auto
qed

lemma circuit_in_supI:
  assumes "\<E>' \<subseteq> \<E>" "\<E> \<subseteq> carrier" "C \<subseteq> \<E>'"
  assumes "circuit_in \<E> C"
  shows "circuit_in \<E>' C"
proof (rule circuit_inI)
  show "\<E>' \<subseteq> carrier" using assms by auto
next
  show "C \<subseteq> \<E>'" using assms by auto
next
  have "\<not> indep_in \<E> C" using assms circuit_in_dep_in by auto
  then show "\<not> indep_in \<E>' C" using assms dep_in_subI[of C \<E>] by auto
next
  fix x
  assume "x \<in> C"
  then have "indep_in \<E> (C - {x})" using assms circuit_in_min_dep_in by auto
  then have "indep_in \<E>' ((C - {x}) \<inter> \<E>')" using indep_in_subI by auto
  moreover have "(C - {x}) \<inter> \<E>' = C - {x}" using assms circuit_in_subset_carrier by auto
  ultimately show "indep_in \<E>' (C - {x})" by auto
qed

context
  fixes \<E>
  assumes *: "\<E> \<subseteq> carrier"
begin

interpretation \<E>: indep_system \<E> "indep_in \<E>"
  using * by auto

lemma circuit_in_sub_cong:
  assumes "\<E>' \<subseteq> \<E>"
  shows "\<E>.circuit_in \<E>' C \<longleftrightarrow> circuit_in \<E>' C"
proof (safe, goal_cases LTR RTL)
  case LTR
  show ?case
  proof (rule circuit_inI)
    show "\<E>' \<subseteq> carrier" using assms * by auto
  next
    show "C \<subseteq> \<E>'"
      using assms LTR \<E>.circuit_in_subset_carrier by auto
  next
    show "\<not> indep_in \<E>' C"
      using assms LTR \<E>.circuit_in_dep_in indep_in_sub_cong[OF *] by auto
  next
    fix x
    assume "x \<in> C"
    then show "indep_in \<E>' (C - {x})"
      using assms LTR \<E>.circuit_in_min_dep_in indep_in_sub_cong[OF *] by auto
  qed
next
  case RTL
  show ?case
  proof (rule \<E>.circuit_inI)
    show "\<E>' \<subseteq> \<E>" using assms * by auto
  next
    show "C \<subseteq> \<E>'"
      using assms * RTL circuit_in_subset_carrier by auto
  next
    show "\<not> \<E>.indep_in \<E>' C"
      using assms * RTL circuit_in_dep_in indep_in_sub_cong[OF *] by auto
  next
    fix x
    assume "x \<in> C"
    then show "\<E>.indep_in \<E>' (C - {x})"
      using assms * RTL circuit_in_min_dep_in indep_in_sub_cong[OF *] by auto
  qed
qed

end

lemma circuit_imp_circuit_in:
  assumes "circuit C"
  shows "circuit_in carrier C"
proof (rule circuit_inI)
  show "C \<subseteq> carrier" using circuit_subset_carrier[OF assms] .
next
  show "\<not> indep_in carrier C" using circuit_dep[OF assms] indep_in_indep by auto
next
  fix x
  assume "x \<in> C"
  then have "indep (C - {x})" using circuit_min_dep[OF assms] by auto
  then show "indep_in carrier (C - {x})" using circuit_subset_carrier[OF assms] by (auto intro: indep_inI)
qed auto

subsection \<open>Relation between independence and bases\<close>

text \<open>
  A set is independent iff it is a subset of a basis.
\<close>

lemma indep_imp_subset_basis:
  assumes "indep X"
  shows "\<exists>B. basis B \<and> X \<subseteq> B"
  using assms
proof (induction X rule: psubset_inc_induct)
  case carrier
  show ?case using indep_subset_carrier[OF assms] .
next
  case (step X)
  {
    assume "\<not> basis X"
    then obtain x where "x \<in> carrier" "x \<notin> X" "indep (insert x X)"
      using step.prems indep_not_basis by auto
    then have ?case using step.IH[of "insert x X"] indep_subset_carrier by auto
  }
  then show ?case by auto
qed

lemmas subset_basis_imp_indep = indep_subset[OF basis_indep]

lemma indep_iff_subset_basis: "indep X \<longleftrightarrow> (\<exists>B. basis B \<and> X \<subseteq> B)"
  using indep_imp_subset_basis subset_basis_imp_indep by auto

lemma basis_ex: "\<exists>B. basis B"
  using indep_imp_subset_basis[OF indep_empty] by auto

context
  fixes \<E>
  assumes *: "\<E> \<subseteq> carrier"
begin

interpretation \<E>: indep_system \<E> "indep_in \<E>"
  using * by auto

lemma indep_in_imp_subset_basis_in:
  assumes "indep_in \<E> X"
  shows "\<exists>B. basis_in \<E> B \<and> X \<subseteq> B"
  unfolding basis_in_def using \<E>.indep_imp_subset_basis[OF assms] .

lemmas subset_basis_in_imp_indep_in = indep_in_subset[OF * basis_in_indep_in[OF *]]

lemma indep_in_iff_subset_basis_in: "indep_in \<E> X \<longleftrightarrow> (\<exists>B. basis_in \<E> B \<and> X \<subseteq> B)"
  using indep_in_imp_subset_basis_in subset_basis_in_imp_indep_in by auto

lemma basis_in_ex: "\<exists>B. basis_in \<E> B"
  unfolding basis_in_def using \<E>.basis_ex .

lemma basis_in_subI:
  assumes "\<E>' \<subseteq> \<E>" "\<E> \<subseteq> carrier"
  assumes "basis_in \<E>' B"
  shows "\<exists>B' \<subseteq> \<E> - \<E>'. basis_in \<E> (B \<union> B')"
proof -
  have "indep_in \<E> B" using assms basis_in_indep_in indep_in_subI_subset by auto
  then obtain B' where B': "basis_in \<E> B'" "B \<subseteq> B'"
    using assms indep_in_imp_subset_basis_in[of B] by auto
  show ?thesis
  proof (rule exI)
    have "B' - B \<subseteq> \<E> - \<E>'"
    proof
      fix x
      assume *: "x \<in> B' - B"
      then have "x \<in> \<E>" "x \<notin> B"
        using assms \<open>basis_in \<E> B'\<close> basis_in_subset_carrier[of \<E>] by auto
      moreover {
        assume "x \<in> \<E>'"
        moreover have "indep_in \<E> (insert x B)"
          using * assms indep_in_subset[OF _ basis_in_indep_in] B' by auto
        ultimately have "indep_in \<E>' (insert x B)"
          using assms basis_in_subset_carrier unfolding indep_in_def by auto
        then have False using assms * \<open>x \<in> \<E>'\<close> basis_in_max_indep_in by auto
      }
      ultimately show "x \<in> \<E> - \<E>'"  by auto
    qed
    moreover have "B \<union> (B' - B) = B'" using \<open>B \<subseteq> B'\<close> by auto
    ultimately show "B' - B \<subseteq> \<E> - \<E>' \<and> basis_in \<E> (B \<union> (B' - B))"
      using \<open>basis_in \<E> B'\<close> by auto
  qed
qed

lemma basis_in_supI:
  assumes "B \<subseteq> \<E>'" "\<E>' \<subseteq> \<E>" "\<E> \<subseteq> carrier"
  assumes "basis_in \<E> B"
  shows "basis_in \<E>' B"
proof (rule basis_inI)
  show "\<E>' \<subseteq> carrier" using assms by auto
next
  show "indep_in \<E>' B"
  proof -
    have "indep_in \<E>' (B \<inter> \<E>')"
      using assms basis_in_indep_in[of \<E> B] indep_in_subI by auto
    moreover have "B \<inter> \<E>' = B" using assms by auto
    ultimately show ?thesis by auto
  qed
next
  show "\<And>x. x \<in> \<E>' - B \<Longrightarrow> \<not> indep_in \<E>' (insert x B)"
    using assms basis_in_subset_carrier basis_in_max_indep_in dep_in_subI[of _ \<E> \<E>'] by auto
qed

end

subsection \<open>Relation between dependence and circuits\<close>

text \<open>
  A set is dependent iff it contains a circuit.
\<close>

lemma dep_imp_supset_circuit:
  assumes "X \<subseteq> carrier"
  assumes "\<not> indep X"
  shows "\<exists>C. circuit C \<and> C \<subseteq> X"
  using assms
proof (induction X rule: remove_induct)
  case (remove X)
  {
    assume "\<not> circuit X"
    then obtain x where "x \<in> X" "\<not> indep (X - {x})"
      using remove.prems dep_not_circuit by auto
    then obtain C where "circuit C" "C \<subseteq> X - {x}"
      using remove.prems remove.IH[of x] by auto
    then have ?case by auto
  }
  then show ?case using remove.prems by auto
qed (auto simp add: carrier_finite finite_subset)

lemma supset_circuit_imp_dep:
  assumes "circuit C \<and> C \<subseteq> X"
  shows "\<not> indep X"
  using assms indep_subset circuit_dep by auto

lemma dep_iff_supset_circuit:
  assumes "X \<subseteq> carrier"
  shows "\<not> indep X \<longleftrightarrow> (\<exists>C. circuit C \<and> C \<subseteq> X)"
  using assms dep_imp_supset_circuit supset_circuit_imp_dep by auto

context
  fixes \<E>
  assumes "\<E> \<subseteq> carrier"
begin

interpretation \<E>: indep_system \<E> "indep_in \<E>"
  using \<open>\<E> \<subseteq> carrier\<close> by auto

lemma dep_in_imp_supset_circuit_in:
  assumes "X \<subseteq> \<E>"
  assumes "\<not> indep_in \<E> X"
  shows "\<exists>C. circuit_in \<E> C \<and> C \<subseteq> X"
  unfolding circuit_in_def using \<E>.dep_imp_supset_circuit[OF assms] .

lemma supset_circuit_in_imp_dep_in:
  assumes "circuit_in \<E> C \<and> C \<subseteq> X"
  shows "\<not> indep_in \<E> X"
  using assms \<E>.supset_circuit_imp_dep unfolding circuit_in_def by auto

lemma dep_in_iff_supset_circuit_in:
  assumes "X \<subseteq> \<E>"
  shows "\<not> indep_in \<E> X \<longleftrightarrow> (\<exists>C. circuit_in \<E> C \<and> C \<subseteq> X)"
  using assms dep_in_imp_supset_circuit_in supset_circuit_in_imp_dep_in by auto

end

subsection \<open>Ranks\<close>

definition lower_rank_of :: "'a set \<Rightarrow> nat" where
  "lower_rank_of carrier' \<equiv> Min {card B | B. basis_in carrier' B}"

definition upper_rank_of :: "'a set \<Rightarrow> nat" where
  "upper_rank_of carrier' \<equiv> Max {card B | B. basis_in carrier' B}"

lemma collect_basis_finite: "finite (Collect basis)"
proof -
  have "Collect basis \<subseteq> {X. X \<subseteq> carrier}"
    using basis_subset_carrier by auto
  moreover have "finite \<dots>"
    using carrier_finite by auto
  ultimately show ?thesis using finite_subset by auto
qed

context
  fixes \<E>
  assumes *: "\<E> \<subseteq> carrier"
begin

interpretation \<E>: indep_system \<E> "indep_in \<E>"
  using * by auto

lemma collect_basis_in_finite: "finite (Collect (basis_in \<E>))"
  unfolding basis_in_def using \<E>.collect_basis_finite .

lemma lower_rank_of_le: "lower_rank_of \<E> \<le> card \<E>"
proof -
  have "\<exists>n \<in> {card B | B. basis_in \<E> B}. n \<le> card \<E>"
    using card_mono[OF \<E>.carrier_finite basis_in_subset_carrier[OF *]] basis_in_ex[OF *] by auto
  moreover have "finite {card B | B. basis_in \<E> B}"
    using collect_basis_in_finite by auto
  ultimately show ?thesis
    unfolding lower_rank_of_def using basis_ex Min_le_iff by auto
qed

lemma upper_rank_of_le: "upper_rank_of \<E> \<le> card \<E>"
proof -
  have "\<forall>n \<in> {card B | B. basis_in \<E> B}. n \<le> card \<E>"
    using card_mono[OF \<E>.carrier_finite basis_in_subset_carrier[OF *]] by auto
  then show ?thesis
    unfolding upper_rank_of_def using basis_in_ex[OF *] collect_basis_in_finite by auto
qed

context
  fixes \<E>'
  assumes **: "\<E>' \<subseteq> \<E>"
begin

interpretation \<E>'\<^sub>1: indep_system \<E>' "indep_in \<E>'"
  using * ** by auto
interpretation \<E>'\<^sub>2: indep_system \<E>' "\<E>.indep_in \<E>'"
  using * ** by auto

lemma lower_rank_of_sub_cong:
  shows "\<E>.lower_rank_of \<E>' = lower_rank_of \<E>'"
proof -
  have "\<And>B. \<E>'\<^sub>1.basis B \<longleftrightarrow> \<E>'\<^sub>2.basis B"
    using ** basis_in_sub_cong[OF *, of \<E>']
    unfolding basis_in_def \<E>.basis_in_def by auto
  then show ?thesis
    unfolding lower_rank_of_def \<E>.lower_rank_of_def
    using basis_in_sub_cong[OF * **]
    by auto
qed

lemma upper_rank_of_sub_cong:
  shows "\<E>.upper_rank_of \<E>' = upper_rank_of \<E>'"
proof -
  have "\<And>B. \<E>'\<^sub>1.basis B \<longleftrightarrow> \<E>'\<^sub>2.basis B"
    using ** basis_in_sub_cong[OF *, of \<E>']
    unfolding basis_in_def \<E>.basis_in_def by auto
  then show ?thesis
    unfolding upper_rank_of_def \<E>.upper_rank_of_def
    using basis_in_sub_cong[OF * **]
    by auto
qed

end

end

end

end


theory Chapter3
imports "HOL-IMP.BExp"
        "HOL-IMP.ASM"
        "Short_Theory"
begin

text{*
\section*{Chapter 3}

\exercise
To show that @{const asimp_const} really folds all subexpressions of the form
@{term "Plus (N i) (N j)"}, define a function
*}

fun optimal :: "aexp \<Rightarrow> bool" where
(* your definition/proof here *)

text{*
that checks that its argument does not contain a subexpression of the form
@{term "Plus (N i) (N j)"}. Then prove that the result of @{const asimp_const}
is optimal:
*}

lemma "optimal (asimp_const a)"
(* your definition/proof here *)

text{*
This proof needs the same @{text "split:"} directive as the correctness proof of
@{const asimp_const}. This increases the chance of nontermination
of the simplifier. Therefore @{const optimal} should be defined purely by
pattern matching on the left-hand side,
without @{text case} expressions on the right-hand side.
\endexercise

\exercise
In this exercise we verify constant folding for @{typ aexp}
where we sum up all constants, even if they are not next to each other.
For example, @{term "Plus (N 1) (Plus (V x) (N 2))"} becomes
@{term "Plus (V x) (N 3)"}. This goes beyond @{const asimp}.
Below we follow a particular solution strategy but there are many others.

First, define a function @{text sumN} that returns the sum of all
constants in an expression and a function @{text zeroN} that replaces all
constants in an expression by zeroes (they will be optimized away later):
*}

fun sumN :: "aexp \<Rightarrow> int" where
(* your definition/proof here *)

fun zeroN :: "aexp \<Rightarrow> aexp" where
(* your definition/proof here *)

text {*
Next, define a function @{text sepN} that produces an arithmetic expression
that adds the results of @{const sumN} and @{const zeroN}. Prove that
@{text sepN} preserves the value of an expression.
*}

definition sepN :: "aexp \<Rightarrow> aexp" where
(* your definition/proof here *)

lemma aval_sepN: "aval (sepN t) s = aval t s"
(* your definition/proof here *)

text {*
Finally, define a function @{text full_asimp} that uses @{const asimp}
to eliminate the zeroes left over by @{const sepN}.
Prove that it preserves the value of an arithmetic expression.
*}

definition full_asimp :: "aexp \<Rightarrow> aexp" where
(* your definition/proof here *)

lemma aval_full_asimp: "aval (full_asimp t) s = aval t s"
(* your definition/proof here *)

text{*
\endexercise

\exercise\label{exe:subst}
Substitution is the process of replacing a variable
by an expression in an expression. Define a substitution function
*}

fun subst :: "vname \<Rightarrow> aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
(* your definition/proof here *)

text{*
such that @{term "subst x a e"} is the result of replacing
every occurrence of variable @{text x} by @{text a} in @{text e}.
For example:
@{lemma[display] "subst ''x'' (N 3) (Plus (V ''x'') (V ''y'')) = Plus (N 3) (V ''y'')" by simp}

Prove the so-called \concept{substitution lemma} that says that we can either
substitute first and evaluate afterwards or evaluate with an updated state:
*}

lemma subst_lemma: "aval (subst x a e) s = aval e (s(x := aval a s))"
(* your definition/proof here *)

text {*
As a consequence prove that we can substitute equal expressions by equal expressions
and obtain the same result under evaluation:
*}
lemma "aval a1 s = aval a2 s
  \<Longrightarrow> aval (subst x a1 e) s = aval (subst x a2 e) s"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Take a copy of theory @{short_theory "AExp"} and modify it as follows.
Extend type @{typ aexp} with a binary constructor @{text Times} that
represents multiplication. Modify the definition of the functions @{const aval}
and @{const asimp} accordingly. You can remove @{const asimp_const}.
Function @{const asimp} should eliminate 0 and 1 from multiplications
as well as evaluate constant subterms. Update all proofs concerned.
*}

text{*
\endexercise

\exercise
Define a datatype @{text aexp2} of extended arithmetic expressions that has,
in addition to the constructors of @{typ aexp}, a constructor for
modelling a C-like post-increment operation $x{++}$, where $x$ must be a
variable. Define an evaluation function @{text "aval2 :: aexp2 \<Rightarrow> state \<Rightarrow> val \<times> state"}
that returns both the value of the expression and the new state.
The latter is required because post-increment changes the state.

Extend @{text aexp2} and @{text aval2} with a division operation. Model partiality of
division by changing the return type of @{text aval2} to
@{typ "(val \<times> state) option"}. In case of division by 0 let @{text aval2}
return @{const None}. Division on @{typ int} is the infix @{text div}.
*}

text{*
\endexercise

\exercise
The following type adds a @{text LET} construct to arithmetic expressions:
*}

datatype lexp = Nl int | Vl vname | Plusl lexp lexp | LET vname lexp lexp

text{* The @{const LET} constructor introduces a local variable:
the value of @{term "LET x e\<^sub>1 e\<^sub>2"} is the value of @{text e\<^sub>2}
in the state where @{text x} is bound to the value of @{text e\<^sub>1} in the original state.
Define a function @{const lval} @{text"::"} @{typ "lexp \<Rightarrow> state \<Rightarrow> int"}
that evaluates @{typ lexp} expressions. Remember @{term"s(x := i)"}.

Define a conversion @{const inline} @{text"::"} @{typ "lexp \<Rightarrow> aexp"}.
The expression \mbox{@{term "LET x e\<^sub>1 e\<^sub>2"}} is inlined by substituting
the converted form of @{text e\<^sub>1} for @{text x} in the converted form of @{text e\<^sub>2}.
See Exercise~\ref{exe:subst} for more on substitution.
Prove that @{const inline} is correct w.r.t.\ evaluation.
\endexercise

\exercise
Show that equality and less-or-equal tests on @{text aexp} are definable
*}

definition Le :: "aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
(* your definition/proof here *)

definition Eq :: "aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
(* your definition/proof here *)

text{*
and prove that they do what they are supposed to:
*}

lemma bval_Le: "bval (Le a1 a2) s = (aval a1 s \<le> aval a2 s)"
(* your definition/proof here *)

lemma bval_Eq: "bval (Eq a1 a2) s = (aval a1 s = aval a2 s)"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Consider an alternative type of boolean expressions featuring a conditional: *}

datatype ifexp = Bc2 bool | If ifexp ifexp ifexp | Less2 aexp aexp

text {*  First define an evaluation function analogously to @{const bval}: *}

fun ifval :: "ifexp \<Rightarrow> state \<Rightarrow> bool" where
(* your definition/proof here *)

text{* Then define two translation functions *}

fun b2ifexp :: "bexp \<Rightarrow> ifexp" where
(* your definition/proof here *)

fun if2bexp :: "ifexp \<Rightarrow> bexp" where
(* your definition/proof here *)

text{* and prove their correctness: *}

lemma "bval (if2bexp exp) s = ifval exp s"
(* your definition/proof here *)

lemma "ifval (b2ifexp exp) s = bval exp s"
(* your definition/proof here *)

text{*
\endexercise

\exercise
We define a new type of purely boolean expressions without any arithmetic
*}

datatype pbexp =
  VAR vname | NOT pbexp | AND pbexp pbexp | OR pbexp pbexp

text{*
where variables range over values of type @{typ bool},
as can be seen from the evaluation function:
*}

fun pbval :: "pbexp \<Rightarrow> (vname \<Rightarrow> bool) \<Rightarrow> bool" where
"pbval (VAR x) s = s x"  |
"pbval (NOT b) s = (\<not> pbval b s)" |
"pbval (AND b1 b2) s = (pbval b1 s \<and> pbval b2 s)" |
"pbval (OR b1 b2) s = (pbval b1 s \<or> pbval b2 s)"

text {* Define a function that checks whether a boolean exression is in NNF
(negation normal form), i.e., if @{const NOT} is only applied directly
to @{const VAR}s: *}

fun is_nnf :: "pbexp \<Rightarrow> bool" where
(* your definition/proof here *)

text{*
Now define a function that converts a @{text bexp} into NNF by pushing
@{const NOT} inwards as much as possible:
*}

fun nnf :: "pbexp \<Rightarrow> pbexp" where
(* your definition/proof here *)

text{*
Prove that @{const nnf} does what it is supposed to do:
*}

lemma pbval_nnf: "pbval (nnf b) s = pbval b s"
(* your definition/proof here *)

lemma is_nnf_nnf: "is_nnf (nnf b)"
(* your definition/proof here *)

text{*
An expression is in DNF (disjunctive normal form) if it is in NNF
and if no @{const OR} occurs below an @{const AND}. Define a corresponding
test:
*}

fun is_dnf :: "pbexp \<Rightarrow> bool" where
(* your definition/proof here *)

text {*
An NNF can be converted into a DNF in a bottom-up manner.
The critical case is the conversion of @{term (sub) "AND b1 b2"}.
Having converted @{text b\<^sub>1} and @{text b\<^sub>2}, apply distributivity of @{const AND}
over @{const OR}. If we write @{const OR} as a multi-argument function,
we can express the distributivity step as follows:
@{text "dist_AND (OR a\<^sub>1 ... a\<^sub>n) (OR b\<^sub>1 ... b\<^sub>m)"}
= @{text "OR (AND a\<^sub>1 b\<^sub>1) (AND a\<^sub>1 b\<^sub>2) ... (AND a\<^sub>n b\<^sub>m)"}. Define
*}

fun dist_AND :: "pbexp \<Rightarrow> pbexp \<Rightarrow> pbexp" where
(* your definition/proof here *)

text {* and prove that it behaves as follows: *}

lemma pbval_dist: "pbval (dist_AND b1 b2) s = pbval (AND b1 b2) s"
(* your definition/proof here *)

lemma is_dnf_dist: "is_dnf b1 \<Longrightarrow> is_dnf b2 \<Longrightarrow> is_dnf (dist_AND b1 b2)"
(* your definition/proof here *)

text {* Use @{const dist_AND} to write a function that converts an NNF
  to a DNF in the above bottom-up manner.
*}

fun dnf_of_nnf :: "pbexp \<Rightarrow> pbexp" where
(* your definition/proof here *)

text {* Prove the correctness of your function: *}

lemma "pbval (dnf_of_nnf b) s = pbval b s"
(* your definition/proof here *)

lemma "is_nnf b \<Longrightarrow> is_dnf (dnf_of_nnf b)"
(* your definition/proof here *)

text{*
\endexercise

\exercise\label{exe:stack-underflow}
A \concept{stack underflow} occurs when executing an @{text ADD}
instruction on a stack of size less than 2. In our semantics
a term @{term "exec1 ADD s stk"} where @{prop "length stk < 2"}
is simply some unspecified value, not an error or exception --- HOL does not have those concepts.
Modify theory @{short_theory "ASM"}
such that stack underflow is modelled by @{const None}
and normal execution by @{text Some}, i.e., the execution functions
have return type @{typ "stack option"}. Modify all theorems and proofs
accordingly.
Hint: you may find @{text"split: option.split"} useful in your proofs.
*}

text{*
\endexercise

\exercise\label{exe:register-machine}
This exercise is about a register machine
and compiler for @{typ aexp}. The machine instructions are
*}
type_synonym reg = nat
datatype instr = LDI val reg | LD vname reg | ADD reg reg

text {*
where type @{text reg} is a synonym for @{typ nat}.
Instruction @{term "LDI i r"} loads @{text i} into register @{text r},
@{term "LD x r"} loads the value of @{text x} into register @{text r},
and @{term[names_short] "ADD r\<^sub>1 r\<^sub>2"} adds register @{text r\<^sub>2} to register @{text r\<^sub>1}.

Define the execution of an instruction given a state and a register state;
the result is the new register state: *}

type_synonym rstate = "reg \<Rightarrow> val"

fun exec1 :: "instr \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
(* your definition/proof here *)

text{*
Define the execution @{const[source] exec} of a list of instructions as for the stack machine.

The compiler takes an arithmetic expression @{text a} and a register @{text r}
and produces a list of instructions whose execution places the value of @{text a}
into @{text r}. The registers @{text "> r"} should be used in a stack-like fashion
for intermediate results, the ones @{text "< r"} should be left alone.
Define the compiler and prove it correct:
*}

theorem "exec (comp a r) s rs r = aval a s"
(* your definition/proof here *)

text{*
\endexercise

\exercise\label{exe:accumulator}
This exercise is a variation of the previous one
with a different instruction set:
*}

datatype instr0 = LDI0 val | LD0 vname | MV0 reg | ADD0 reg

text{*
All instructions refer implicitly to register 0 as a source or target:
@{const LDI0} and @{const LD0} load a value into register 0, @{term "MV0 r"}
copies the value in register 0 into register @{text r}, and @{term "ADD0 r"}
adds the value in register @{text r} to the value in register 0;
@{term "MV0 0"} and @{term "ADD0 0"} are legal. Define the execution functions
*}

fun exec01 :: "instr0 \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
(* your definition/proof here *)

text{*
and @{const exec0} for instruction lists.

The compiler takes an arithmetic expression @{text a} and a register @{text r}
and produces a list of instructions whose execution places the value of @{text a}
into register 0. The registers @{text "> r"} should be used in a stack-like fashion
for intermediate results, the ones @{text "\<le> r"} should be left alone
(with the exception of 0). Define the compiler and prove it correct:
*}

theorem "exec0 (comp0 a r) s rs 0 = aval a s"
(* your definition/proof here *)

text{*
\endexercise
*}

end


(* Title: Group_Divisible_Designs.thy
   Author: Chelsea Edmonds
*)

section \<open>Group Divisible Designs\<close>
text \<open>Definitions in this section taken from the handbook \cite{colbournHandbookCombinatorialDesigns2007}
and Stinson \cite{stinsonCombinatorialDesignsConstructions2004} \<close>
theory Group_Divisible_Designs imports Resolvable_Designs
begin

subsection \<open>Group design \<close>
text \<open>We define a group design to have an additional paramater $G$ which is a partition on the point
set $V$. This is not defined in the handbook, but is a precursor to GDD's without index constraints\<close>

locale group_design = proper_design +
  fixes groups :: "'a set set" ("\<G>")
  assumes group_partitions: "partition_on \<V> \<G>"
  assumes groups_size: "card \<G> > 1"
begin

lemma groups_not_empty: "\<G> \<noteq> {}"
  using groups_size by auto

lemma num_groups_lt_points: "card \<G> \<le> \<v>"
  by (simp add: partition_on_le_set_elements finite_sets group_partitions)

lemma groups_disjoint: "disjoint \<G>"
  using group_partitions partition_onD2 by auto

lemma groups_disjoint_pairwise: "G1 \<in> \<G> \<Longrightarrow> G2 \<in> \<G> \<Longrightarrow> G1 \<noteq> G2 \<Longrightarrow> disjnt G1 G2"
  using group_partitions partition_onD2 pairwiseD by fastforce

lemma point_in_one_group: "x \<in> G1 \<Longrightarrow> G1 \<in> \<G> \<Longrightarrow> G2 \<in> \<G> \<Longrightarrow> G1 \<noteq> G2 \<Longrightarrow> x \<notin> G2"
  using groups_disjoint_pairwise by (simp add: disjnt_iff)

lemma point_has_unique_group: "x \<in> \<V> \<Longrightarrow> \<exists>!G. x \<in> G \<and> G \<in> \<G>"
  using partition_on_partition_on_unique group_partitions
  by fastforce

lemma rep_number_point_group_one:
  assumes "x \<in> \<V>"
  shows  "card {g \<in> \<G> . x \<in> g} = 1"
proof -
  obtain g' where "g' \<in> \<G>" and "x \<in> g'"
    using assms point_has_unique_group by blast
  then have "{g \<in> \<G> . x \<in> g} = {g'}"
    using  group_partitions partition_onD4 by force
  thus ?thesis
    by simp
qed

lemma point_in_group: "G \<in> \<G> \<Longrightarrow> x \<in> G \<Longrightarrow> x \<in> \<V>"
  using group_partitions partition_onD1 by auto

lemma point_subset_in_group: "G \<in> \<G> \<Longrightarrow> ps \<subseteq> G \<Longrightarrow> ps \<subseteq> \<V>"
  using point_in_group by auto

lemma group_subset_point_subset: "G \<in> \<G> \<Longrightarrow> G' \<subseteq> G \<Longrightarrow> ps \<subseteq> G' \<Longrightarrow> ps \<subseteq> \<V>"
  using point_subset_in_group by auto

lemma groups_finite: "finite \<G>"
  using finite_elements finite_sets group_partitions by auto

lemma group_elements_finite: "G \<in> \<G> \<Longrightarrow> finite G"
  using groups_finite finite_sets group_partitions
  by (meson finite_subset point_in_group subset_iff)

lemma v_equals_sum_group_sizes: "\<v> = (\<Sum>G \<in> \<G>. card G)"
  using group_partitions groups_disjoint partition_onD1 card_Union_disjoint group_elements_finite
  by fastforce

lemma gdd_min_v: "\<v> \<ge> 2"
proof -
  have assm: "card \<G> \<ge> 2" using groups_size by simp
  then have "\<And> G . G \<in> \<G> \<Longrightarrow> G \<noteq> {}" using partition_onD3 group_partitions by auto
  then have "\<And> G . G \<in> \<G> \<Longrightarrow> card G \<ge> 1"
    using group_elements_finite card_0_eq by fastforce
  then have " (\<Sum>G \<in> \<G>. card G) \<ge> 2" using assm
    using sum_mono by force
  thus ?thesis using v_equals_sum_group_sizes
    by linarith
qed

lemma min_group_size: "G \<in> \<G> \<Longrightarrow> card G \<ge> 1"
  using partition_onD3 group_partitions
  using group_elements_finite not_le_imp_less by fastforce

lemma group_size_lt_v:
  assumes "G \<in> \<G>"
  shows "card G < \<v>"
proof -
  have "(\<Sum>G' \<in> \<G>. card G') = \<v>" using gdd_min_v v_equals_sum_group_sizes
    by linarith
  then have split_sum: "card G + (\<Sum>G' \<in> (\<G> - {G}). card G') = \<v>" using assms sum.remove
    by (metis groups_finite v_equals_sum_group_sizes)
  have "card (\<G> - {G}) \<ge> 1" using groups_size
    by (simp add: assms groups_finite)
  then obtain G' where gin: "G' \<in> (\<G> - {G})"
    by (meson elem_exists_non_empty_set less_le_trans less_numeral_extra(1))
  then have "card G' \<ge> 1" using min_group_size by auto
  then have "(\<Sum>G' \<in> (\<G> - {G}). card G') \<ge> 1"
    by (metis gin finite_Diff groups_finite leI less_one sum_eq_0_iff)
  thus ?thesis using split_sum
    by linarith
qed

subsubsection \<open>Group Type \<close>

text \<open>GDD's have a "type", which is defined by a sequence of group sizes $g_i$, and the number
of groups of that size $a_i$: $g_1^{a_1}g2^{a_2}...g_n^{a_n}$ \<close>
definition group_sizes :: "nat set" where
"group_sizes \<equiv> {card G | G . G \<in> \<G>}"

definition groups_of_size :: "nat \<Rightarrow> nat" where
"groups_of_size g \<equiv> card { G \<in> \<G> . card G = g }"

definition group_type :: "(nat \<times> nat) set" where
"group_type \<equiv> {(g, groups_of_size g) | g . g \<in> group_sizes }"

lemma group_sizes_min: "x \<in> group_sizes \<Longrightarrow> x \<ge> 1 "
  unfolding group_sizes_def using min_group_size group_size_lt_v by auto

lemma group_sizes_max: "x \<in> group_sizes \<Longrightarrow> x < \<v> "
  unfolding group_sizes_def using min_group_size group_size_lt_v by auto

lemma group_size_implies_group_existance: "x \<in> group_sizes \<Longrightarrow> \<exists>G. G \<in> \<G> \<and> card G = x"
  unfolding group_sizes_def by auto

lemma groups_of_size_zero: "groups_of_size 0 = 0"
proof -
  have empty: "{G \<in> \<G> . card G = 0} = {}" using min_group_size
    by fastforce
  thus ?thesis unfolding groups_of_size_def
    by (simp add: empty)
qed

lemma groups_of_size_max:
  assumes "g \<ge> \<v>"
  shows "groups_of_size g = 0"
proof -
  have "{G \<in> \<G> . card G = g} = {}" using group_size_lt_v assms by fastforce
  thus ?thesis unfolding groups_of_size_def
    by (simp add: \<open>{G \<in> \<G>. card G = g} = {}\<close>)
qed

lemma group_type_contained_sizes: "(g, a) \<in> group_type \<Longrightarrow> g \<in> group_sizes"
  unfolding group_type_def by simp

lemma group_type_contained_count: "(g, a) \<in> group_type \<Longrightarrow> card {G \<in> \<G> . card G = g} = a"
  unfolding group_type_def groups_of_size_def by simp

lemma group_card_in_sizes: "g \<in> \<G> \<Longrightarrow> card g \<in> group_sizes"
  unfolding group_sizes_def by auto

lemma group_card_non_zero_groups_of_size_min:
  assumes "g \<in> \<G>"
  assumes "card g = a"
  shows "groups_of_size a \<ge> 1"
proof -
  have "g \<in> {G \<in> \<G> . card G = a}" using assms by simp
  then have "{G \<in> \<G> . card G = a} \<noteq> {}" by auto
  then have "card {G \<in> \<G> . card G = a} \<noteq> 0"
    by (simp add: groups_finite)
  thus ?thesis unfolding groups_of_size_def by simp
qed

lemma elem_in_group_sizes_min_of_size:
  assumes "a \<in> group_sizes"
  shows "groups_of_size a \<ge> 1"
  using assms group_card_non_zero_groups_of_size_min group_size_implies_group_existance by blast

lemma group_card_non_zero_groups_of_size_max:
  shows "groups_of_size a \<le> \<v>"
proof -
  have "{G \<in> \<G> . card G = a} \<subseteq> \<G>" by simp
  then have "card {G \<in> \<G> . card G = a} \<le> card \<G>"
    by (simp add: card_mono groups_finite)
  thus ?thesis
    using groups_of_size_def num_groups_lt_points by auto
qed

lemma group_card_in_type: "g \<in> \<G> \<Longrightarrow> \<exists> x . (card g, x) \<in> group_type \<and> x \<ge> 1"
  unfolding group_type_def using group_card_non_zero_groups_of_size_min
  by (simp add: group_card_in_sizes)

lemma partition_groups_on_size: "partition_on \<G> {{ G \<in> \<G> . card G = g } | g . g \<in> group_sizes}"
proof (intro partition_onI, auto)
  fix g
  assume a1: "g \<in> group_sizes"
  assume " \<forall>x. x \<in> \<G> \<longrightarrow> card x \<noteq> g"
  then show False using a1 group_size_implies_group_existance by auto
next
  fix x
  assume "x \<in> \<G>"
  then show "\<exists>xa. (\<exists>g. xa = {G \<in> \<G>. card G = g} \<and> g \<in> group_sizes) \<and> x \<in> xa"
    using  group_card_in_sizes by auto
qed

lemma group_size_partition_covers_points: "\<Union>(\<Union>{{ G \<in> \<G> . card G = g } | g . g \<in> group_sizes}) = \<V>"
  by (metis (no_types, lifting) group_partitions partition_groups_on_size partition_onD1)

lemma groups_of_size_alt_def_count: "groups_of_size g = count {# card G . G \<in># mset_set \<G> #} g"
proof -
  have a: "groups_of_size g =  card { G \<in> \<G> . card G = g }" unfolding groups_of_size_def by simp
  then have "groups_of_size g =  size {# G \<in># (mset_set \<G>) . card G = g #}"
    using groups_finite by auto
  then have size_repr: "groups_of_size g =  size {# x \<in># {# card G . G \<in># mset_set \<G> #} . x = g #}"
    using groups_finite by (simp add: filter_mset_image_mset)
  have "group_sizes = set_mset ({# card G . G \<in># mset_set \<G> #})"
    using group_sizes_def groups_finite by auto
  thus ?thesis using size_repr by (simp add: count_size_set_repr)
qed

lemma v_sum_type_rep: "\<v> = (\<Sum> g \<in> group_sizes . g * (groups_of_size g))"
proof -
  have gs: "set_mset {# card G . G \<in># mset_set \<G> #} = group_sizes"
    unfolding group_sizes_def using groups_finite by auto
  have "\<v> = card (\<Union>(\<Union>{{ G \<in> \<G> . card G = g } | g . g \<in> group_sizes}))"
    using group_size_partition_covers_points by simp
  have v1: "\<v> = (\<Sum>x \<in># {# card G . G \<in># mset_set \<G> #}. x)"
    by (simp add: sum_unfold_sum_mset v_equals_sum_group_sizes)
  then have "\<v> = (\<Sum>x \<in> set_mset {# card G . G \<in># mset_set \<G> #} . x * (count {# card G . G \<in># mset_set \<G> #} x))"
    using mset_set_size_card_count by (simp add: v1)
  thus ?thesis using gs groups_of_size_alt_def_count by auto
qed

end

subsubsection \<open>Uniform Group designs\<close>
text \<open>A group design requiring all groups are the same size\<close>
locale uniform_group_design = group_design +
  fixes u_group_size :: nat ("\<m>")
  assumes uniform_groups: "G \<in> \<G> \<Longrightarrow> card G = \<m>"

begin

lemma m_positive: "\<m> \<ge> 1"
proof -
  obtain G where "G \<in> \<G>" using groups_size elem_exists_non_empty_set gr_implies_not_zero by blast
  thus ?thesis using uniform_groups min_group_size by fastforce
qed

lemma uniform_groups_alt: " \<forall> G \<in> \<G> . card G = \<m>"
  using uniform_groups by blast

lemma uniform_groups_group_sizes: "group_sizes = {\<m>}"
  using design_points_nempty group_card_in_sizes group_size_implies_group_existance
    point_has_unique_group uniform_groups_alt by force

lemma uniform_groups_group_size_singleton: "is_singleton (group_sizes)"
  using uniform_groups_group_sizes by auto

lemma set_filter_eq_P_forall:"\<forall> x \<in> X . P x \<Longrightarrow> Set.filter P X = X"
  by (simp add: Collect_conj_eq Int_absorb2 Set.filter_def subsetI)

lemma uniform_groups_groups_of_size_m: "groups_of_size \<m> = card \<G>"
proof(simp add: groups_of_size_def)
  have "{G \<in> \<G>. card G = \<m>} = \<G>" using uniform_groups_alt set_filter_eq_P_forall by auto
  thus "card {G \<in> \<G>. card G = \<m>} = card \<G>" by simp
qed

lemma uniform_groups_of_size_not_m: "x \<noteq> \<m> \<Longrightarrow> groups_of_size x = 0"
  by (simp add: groups_of_size_def card_eq_0_iff uniform_groups)

end

subsection \<open>GDD\<close>
text \<open>A GDD extends a group design with an additional index parameter.
Each pair of elements must occur either \Lambda times if in diff groups, or 0 times if in the same
group \<close>

locale GDD = group_design +
  fixes index :: int ("\<Lambda>")
  assumes index_ge_1: "\<Lambda> \<ge> 1"
  assumes index_together: "G \<in> \<G> \<Longrightarrow> x \<in> G \<Longrightarrow> y \<in> G \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<B> index {x, y} = 0"
  assumes index_distinct: "G1 \<in> \<G> \<Longrightarrow> G2 \<in> \<G> \<Longrightarrow> G1 \<noteq> G2 \<Longrightarrow> x \<in> G1 \<Longrightarrow> y \<in> G2 \<Longrightarrow>
    \<B> index {x, y} = \<Lambda>"
begin

lemma points_sep_groups_ne: "G1 \<in> \<G> \<Longrightarrow> G2 \<in> \<G> \<Longrightarrow> G1 \<noteq> G2 \<Longrightarrow> x \<in> G1 \<Longrightarrow> y \<in> G2 \<Longrightarrow> x \<noteq> y"
  by (meson point_in_one_group)

lemma index_together_alt_ss: "ps \<subseteq> G \<Longrightarrow> G \<in> \<G> \<Longrightarrow> card ps = 2 \<Longrightarrow> \<B> index ps = 0"
  using index_together by (metis card_2_iff insert_subset)

lemma index_distinct_alt_ss: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> (\<And> G . G \<in> \<G> \<Longrightarrow> \<not> ps \<subseteq> G) \<Longrightarrow>
    \<B> index ps = \<Lambda>"
  using index_distinct by (metis card_2_iff empty_subsetI insert_subset point_has_unique_group)

lemma gdd_index_options: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> \<B> index ps = 0 \<or> \<B> index ps = \<Lambda>"
  using index_distinct_alt_ss index_together_alt_ss by blast

lemma index_zero_implies_same_group: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> \<B> index ps = 0 \<Longrightarrow>
    \<exists> G \<in> \<G> . ps \<subseteq> G" using index_distinct_alt_ss gr_implies_not_zero
  by (metis index_ge_1 less_one of_nat_0 of_nat_1 of_nat_le_0_iff)

lemma index_zero_implies_same_group_unique: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> \<B> index ps = 0 \<Longrightarrow>
    \<exists>! G \<in> \<G> . ps \<subseteq> G"
  by (meson GDD.index_zero_implies_same_group GDD_axioms card_2_iff' group_design.point_in_one_group
      group_design_axioms in_mono)

lemma index_not_zero_impl_diff_group: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> \<B> index ps = \<Lambda> \<Longrightarrow>
    (\<And> G . G \<in> \<G> \<Longrightarrow> \<not> ps \<subseteq> G)"
  using index_ge_1 index_together_alt_ss by auto

lemma index_zero_implies_one_group:
  assumes "ps \<subseteq> \<V>"
  and "card ps = 2"
  and "\<B> index ps = 0"
  shows "size {#b \<in>#  mset_set \<G> . ps \<subseteq> b#} = 1"
proof -
  obtain G where ging: "G \<in> \<G>" and psin: "ps \<subseteq> G"
    using index_zero_implies_same_group groups_size assms by blast
  then have unique: "\<And> G2 . G2 \<in> \<G> \<Longrightarrow> G \<noteq> G2 \<Longrightarrow> \<not> ps \<subseteq> G2"
    using index_zero_implies_same_group_unique by (metis assms)
  have "\<And> G'. G' \<in> \<G> \<longleftrightarrow> G' \<in># mset_set \<G>"
    by (simp add: groups_finite)
  then have eq_mset: "{#b \<in>#  mset_set \<G> . ps \<subseteq> b#} = mset_set {b \<in> \<G> . ps \<subseteq> b}"
    using filter_mset_mset_set groups_finite by blast
  then have "{b \<in> \<G> . ps \<subseteq> b} = {G}" using unique psin
    by (smt Collect_cong ging singleton_conv)
  thus ?thesis by (simp add: eq_mset)
qed

lemma index_distinct_group_num_alt_def: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow>
    size {#b \<in>#  mset_set \<G> . ps \<subseteq> b#} = 0 \<Longrightarrow> \<B> index ps = \<Lambda>"
  by (metis gdd_index_options index_zero_implies_one_group numeral_One zero_neq_numeral)

lemma index_non_zero_implies_no_group:
  assumes "ps \<subseteq> \<V>"
    and  "card ps = 2"
    and "\<B> index ps = \<Lambda>"
  shows "size {#b \<in>#  mset_set \<G> . ps \<subseteq> b#} = 0"
proof -
  have "\<And> G . G \<in> \<G> \<Longrightarrow>  \<not> ps \<subseteq> G" using index_not_zero_impl_diff_group assms by simp
  then have "{#b \<in>#  mset_set \<G> . ps \<subseteq> b#} = {#}"
    using filter_mset_empty_if_finite_and_filter_set_empty by force
  thus ?thesis by simp
qed

lemma gdd_index_non_zero_iff: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow>
    \<B> index ps = \<Lambda> \<longleftrightarrow> size {#b \<in>#  mset_set \<G> . ps \<subseteq> b#} = 0"
  using index_non_zero_implies_no_group index_distinct_group_num_alt_def by auto

lemma gdd_index_zero_iff: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow>
    \<B> index ps = 0 \<longleftrightarrow> size {#b \<in>#  mset_set \<G> . ps \<subseteq> b#} = 1"
  apply (auto simp add: index_zero_implies_one_group)
  by (metis GDD.gdd_index_options GDD_axioms index_non_zero_implies_no_group old.nat.distinct(2))

lemma points_index_upper_bound: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> \<B> index ps \<le> \<Lambda>"
  using gdd_index_options index_ge_1
  by (metis int_one_le_iff_zero_less le_refl of_nat_0 of_nat_0_le_iff of_nat_le_iff zero_less_imp_eq_int)

lemma index_1_imp_mult_1:
  assumes "\<Lambda> = 1"
  assumes "bl \<in># \<B>"
  assumes "card bl \<ge> 2"
  shows "multiplicity bl = 1"
proof (rule ccontr)
  assume "\<not> (multiplicity bl = 1)"
  then have "multiplicity bl \<noteq> 1" and "multiplicity bl \<noteq> 0" using assms by simp_all
  then have m: "multiplicity bl \<ge> 2" by linarith
  obtain ps where ps: "ps \<subseteq> bl \<and> card ps = 2"
    using nat_int_comparison(3) obtain_subset_with_card_n by (metis assms(3))
  then have "\<B> index ps \<ge> 2"
    using m points_index_count_min ps by blast
  then show False using assms index_distinct ps antisym_conv2 not_numeral_less_zero
      numeral_le_one_iff points_index_ps_nin semiring_norm(69) zero_neq_numeral
    by (metis gdd_index_options int_int_eq int_ops(2))
qed

lemma simple_if_block_size_gt_2:
  assumes "\<And> bl . card bl \<ge> 2"
  assumes "\<Lambda> = 1"
  shows "simple_design \<V> \<B>"
  using index_1_imp_mult_1 assms apply (unfold_locales)
  by (metis card.empty not_numeral_le_zero)

end

subsubsection \<open>Sub types of GDD's \<close>

text \<open>In literature, a GDD is usually defined in a number of different ways,
including factors such as block size limitations \<close>
locale K_\<Lambda>_GDD = K_block_design + GDD

locale k_\<Lambda>_GDD = block_design + GDD

sublocale k_\<Lambda>_GDD \<subseteq> K_\<Lambda>_GDD \<V> \<B> "{\<k>}" \<G> \<Lambda>
  by (unfold_locales)

locale K_GDD = K_\<Lambda>_GDD \<V> \<B> \<K> \<G> 1
  for point_set ("\<V>") and block_collection ("\<B>") and sizes ("\<K>") and groups ("\<G>")

locale k_GDD = k_\<Lambda>_GDD \<V> \<B> \<k> \<G> 1
  for point_set ("\<V>") and block_collection ("\<B>") and u_block_size ("\<k>") and groups ("\<G>")

sublocale k_GDD \<subseteq> K_GDD \<V> \<B> "{\<k>}" \<G>
  by (unfold_locales)

lemma (in K_GDD) multiplicity_1:  "bl \<in># \<B> \<Longrightarrow> card bl \<ge> 2 \<Longrightarrow> multiplicity bl = 1"
  using index_1_imp_mult_1 by simp

locale RGDD = GDD + resolvable_design

subsection \<open> GDD and PBD Constructions \<close>
text \<open> GDD's are commonly studied alongside PBD's (pairwise balanced designs). Many constructions
have been developed for designs to create a GDD from a PBD and vice versa. In particular,
Wilsons Construction is a well known construction, which is formalised in this section. It
should be noted that many of the more basic constructions in this section are often stated without
proof/all the necessary assumptions in textbooks/course notes.\<close>

context GDD
begin

subsubsection \<open>GDD Delete Point construction\<close>
lemma delete_point_index_zero:
  assumes "G \<in> {g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}}"
  and "y \<in> G" and "z \<in> G" and "z\<noteq> y"
shows "(del_point_blocks x) index {y, z} = 0"
proof -
  have "y \<noteq> x" using assms(1) assms(2) by blast
  have "z \<noteq> x" using assms(1) assms(3) by blast
  obtain G' where ing: "G' \<in> \<G>" and ss: "G \<subseteq> G'"
    using assms(1) by auto
  have "{y, z} \<subseteq> G" by (simp add: assms(2) assms(3))
  then have "{y, z} \<subseteq> \<V>"
    by (meson ss ing group_subset_point_subset)
  then have "{y, z} \<subseteq> (del_point x)"
    using \<open>y \<noteq> x\<close> \<open>z \<noteq> x\<close> del_point_def by fastforce
  thus ?thesis using delete_point_index_eq index_together
    by (metis assms(2) assms(3) assms(4) in_mono ing ss)
qed

lemma delete_point_index:
  assumes "G1 \<in> {g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}}"
  assumes "G2 \<in> {g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}}"
  assumes "G1 \<noteq> G2" and "y \<in> G1" and "z \<in> G2"
  shows "del_point_blocks x index {y, z} = \<Lambda>"
proof -
  have "y \<noteq> x" using assms by blast
  have "z \<noteq> x" using assms by blast
  obtain G1' where ing1: "G1' \<in> \<G>" and t1: "G1 = G1' - {x}"
    using assms(1) by auto
  obtain G2' where ing2: "G2' \<in> \<G>" and t2: "G2 = G2' - {x}"
    using assms(2) by auto
  then have ss1: "G1 \<subseteq> G1'" and ss2: "G2 \<subseteq> G2'" using t1 by auto
  then have "{y, z} \<subseteq> \<V>" using ing1 ing2 ss1 ss2 assms(4) assms(5)
    by (metis empty_subsetI insert_absorb insert_subset point_in_group)
  then have "{y, z} \<subseteq> del_point x"
    using \<open>y \<noteq> x\<close> \<open>z \<noteq> x\<close> del_point_def by auto
  then have indx: "del_point_blocks x index {y, z} = \<B> index {y, z}"
    using delete_point_index_eq by auto
  have "G1' \<noteq> G2'" using assms t1 t2 by fastforce
  thus ?thesis using index_distinct
    using indx assms(4) assms(5) ing1 ing2 t1 t2 by auto
qed

lemma delete_point_group_size:
  assumes "{x} \<in> \<G> \<Longrightarrow> card \<G> > 2"
  shows "1 < card {g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}}"
proof (cases "{x} \<in> \<G>")
  case True
  then have "\<And> g . g \<in> (\<G> - {{x}}) \<Longrightarrow> x \<notin> g"
    by (meson disjnt_insert1 groups_disjoint pairwise_alt)
  then have simpg: "\<And> g . g \<in> (\<G> - {{x}}) \<Longrightarrow> g - {x} = g"
    by simp
  have "{g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}} = {g - {x} |g. (g \<in> \<G> - {{x}})}" using True
    by force
  then have "{g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}} = {g |g. (g \<in> \<G> - {{x}})}" using simpg
    by (smt (verit) Collect_cong)
  then have eq: "{g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}} =  \<G> - {{x}}" using set_self_img_compr by blast
  have "card (\<G> - {{x}}) = card \<G> - 1" using True
    by (simp add: groups_finite)
  then show ?thesis using True assms eq diff_is_0_eq' by force
next
  case False
  then have "\<And>g' y. {x} \<notin> \<G> \<Longrightarrow> g' \<in> \<G> \<Longrightarrow> y \<in> \<G> \<Longrightarrow> g' - {x} = y - {x} \<Longrightarrow> g' = y"
    by (metis all_not_in_conv insert_Diff_single insert_absorb insert_iff points_sep_groups_ne)
  then have inj: "inj_on (\<lambda> g . g - {x}) \<G>" by (simp add: inj_onI False)
  have "{g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}} = {g - {x} |g. g \<in> \<G>}" using False by auto
  then have "card {g - {x} |g. g \<in> \<G> \<and> g \<noteq> {x}} = card \<G>" using inj groups_finite card_image
    by (auto simp add: card_image setcompr_eq_image)
  then show ?thesis using groups_size by presburger
qed

lemma GDD_by_deleting_point:
  assumes "\<And>bl. bl \<in># \<B> \<Longrightarrow> x \<in> bl \<Longrightarrow> 2 \<le> card bl"
  assumes "{x} \<in> \<G> \<Longrightarrow> card \<G> > 2"
  shows "GDD (del_point x) (del_point_blocks x) {g - {x} | g . g \<in> \<G> \<and> g \<noteq> {x}} \<Lambda>"
proof -
  interpret pd: proper_design "del_point x" "del_point_blocks x"
    using delete_point_proper assms by blast
  show ?thesis using delete_point_index_zero delete_point_index assms delete_point_group_size
    by(unfold_locales) (simp_all add: partition_on_remove_pt group_partitions index_ge_1 del_point_def)
qed

end

context K_GDD begin

subsubsection \<open>PBD construction from GDD\<close>
text \<open>Two well known PBD constructions involve taking a GDD and either combining the groups and
blocks to form a new block collection, or by adjoining a point \<close>

text \<open>First prove that combining the groups and block set results in a constant index \<close>
lemma kgdd1_points_index_group_block:
  assumes "ps \<subseteq> \<V>"
  and "card ps = 2"
  shows "(\<B> + mset_set \<G>) index ps = 1"
proof -
  have index1: "(\<And> G . G \<in> \<G> \<Longrightarrow> \<not> ps \<subseteq> G) \<Longrightarrow> \<B> index ps = 1"
    using index_distinct_alt_ss assms by fastforce
  have groups1: "\<B> index ps = 0 \<Longrightarrow> size {#b \<in>#  mset_set \<G> . ps \<subseteq> b#} = 1"
    using index_zero_implies_one_group assms by simp
  then have "(\<B> + mset_set \<G>) index ps = size (filter_mset ((\<subseteq>) ps) (\<B> + mset_set \<G>))"
    by (simp add: points_index_def)
  thus ?thesis using index1 groups1 gdd_index_non_zero_iff gdd_index_zero_iff assms
      gdd_index_options points_index_def filter_union_mset union_commute
    by (smt (z3) empty_neutral(1) less_irrefl_nat nonempty_has_size of_nat_1_eq_iff)
qed

text \<open>Combining blocks and the group set forms a PBD \<close>
lemma combine_block_groups_pairwise: "pairwise_balance \<V> (\<B> + mset_set \<G>) 1"
proof -
  let ?B = "\<B> + mset_set \<G>"
  have ss: "\<And> G. G \<in> \<G> \<Longrightarrow> G \<subseteq> \<V>"
    by (simp add: point_in_group subsetI)
  have "\<And> G. G \<in> \<G> \<Longrightarrow> G \<noteq> {}" using group_partitions
    using partition_onD3 by auto
  then interpret inc: design \<V> ?B
  proof (unfold_locales)
    show "\<And>b. (\<And>G. G \<in> \<G> \<Longrightarrow> G \<noteq> {}) \<Longrightarrow> b \<in># \<B> + mset_set \<G> \<Longrightarrow> b \<subseteq> \<V>"
      by (metis finite_set_mset_mset_set groups_finite ss union_iff wellformed)
    show "(\<And>G. G \<in> \<G> \<Longrightarrow> G \<noteq> {}) \<Longrightarrow> finite \<V>" by (simp add: finite_sets)
    show "\<And>bl. (\<And>G. G \<in> \<G> \<Longrightarrow> G \<noteq> {}) \<Longrightarrow> bl \<in># \<B> + mset_set \<G> \<Longrightarrow> bl \<noteq> {}"
      using blocks_nempty groups_finite by auto
  qed
  show ?thesis proof (unfold_locales)
    show "inc.\<b> \<noteq> 0" using b_positive by auto
    show "(1 ::nat) \<le> 2" by simp
    show "2 \<le> inc.\<v>" by (simp add: gdd_min_v)
    then show "\<And>ps. ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> ((\<B> + mset_set \<G>) index ps) = 1"
      using kgdd1_points_index_group_block by simp
  qed
qed

lemma combine_block_groups_PBD:
  assumes "\<And> G. G \<in> \<G> \<Longrightarrow> card G \<in> \<K>"
  assumes "\<And> k . k \<in> \<K> \<Longrightarrow> k \<ge> 2"
  shows "PBD \<V> (\<B> + mset_set \<G>) \<K>"
proof -
  let ?B = "\<B> + mset_set \<G>"
  interpret inc: pairwise_balance \<V> ?B 1 using combine_block_groups_pairwise by simp
  show ?thesis using assms block_sizes groups_finite positive_ints
    by (unfold_locales) auto
qed

text \<open>Prove adjoining a point to each group set results in a constant points index \<close>
lemma kgdd1_index_adjoin_group_block:
  assumes "x \<notin> \<V>"
  assumes "ps \<subseteq> insert x \<V>"
  assumes "card ps = 2"
  shows "(\<B> + mset_set {insert x g |g. g \<in> \<G>}) index ps = 1"
proof -
  have "inj_on ((insert) x) \<G>"
    by (meson assms(1) inj_onI insert_ident point_in_group)
  then have eq: "mset_set {insert x g |g. g \<in> \<G>} = {# insert x g . g \<in># mset_set \<G>#}"
    by (simp add: image_mset_mset_set setcompr_eq_image)
  thus ?thesis
  proof (cases "x \<in> ps")
    case True
    then obtain y where y_ps: "ps = {x, y}" using assms(3)
      by (metis card_2_iff doubleton_eq_iff insertE singletonD)
    then have ynex: "y \<noteq> x" using assms by fastforce
    have yinv: "y \<in> \<V>"
      using assms(2) y_ps ynex by auto
    have all_g: "\<And> g. g \<in># (mset_set {insert x g |g. g \<in> \<G>}) \<Longrightarrow> x \<in> g"
      using eq by force
    have iff: "\<And> g . g \<in> \<G> \<Longrightarrow> y \<in> (insert x g) \<longleftrightarrow> y \<in> g" using ynex by simp
    have b: "\<B> index ps = 0"
      using True assms(1) points_index_ps_nin by fastforce
    then have "(\<B> + mset_set {insert x g |g. g \<in> \<G>}) index ps =
        (mset_set {insert x g |g. g \<in> \<G>}) index ps"
      using eq by (simp add: point_index_distrib)
    also have  "... = (mset_set {insert x g |g. g \<in> \<G>}) rep y" using points_index_pair_rep_num
      by (metis (no_types, lifting) all_g y_ps)
    also have 0: "... = card {b \<in> {insert x g |g. g \<in> \<G>} . y \<in> b}"
      by (simp add: groups_finite rep_number_on_set_def)
    also have 1: "... = card {insert x g |g. g \<in> \<G> \<and> y \<in> insert x g}"
      by (smt (verit) Collect_cong mem_Collect_eq)
    also have 2: " ... = card {insert x g |g. g \<in> \<G> \<and> y \<in> g}"
      using iff by metis
    also have "... = card {g \<in> \<G> . y \<in> g}" using 1 2 0 empty_iff eq groups_finite ynex insert_iff
      by (metis points_index_block_image_add_eq points_index_single_rep_num rep_number_on_set_def)
    finally have "(\<B> + mset_set {insert x g |g. g \<in> \<G>}) index ps = 1"
      using rep_number_point_group_one yinv by simp
    then show ?thesis
      by simp
  next
    case False
    then have v: "ps \<subseteq> \<V>" using assms(2) by auto
    then have "(\<B> + mset_set {insert x g |g. g \<in> \<G>}) index ps = (\<B> + mset_set \<G>) index ps"
      using eq by (simp add: points_index_block_image_add_eq False point_index_distrib)
    then show ?thesis using v assms kgdd1_points_index_group_block by simp
  qed
qed

lemma pairwise_by_adjoining_point:
  assumes "x \<notin> \<V>"
  shows "pairwise_balance (add_point x) (\<B> + mset_set { insert x g | g. g \<in> \<G>}) 1"
proof -
  let ?B = "\<B> + mset_set { insert x g | g. g \<in> \<G>}"
  let ?V = "add_point x"
  have vdef: "?V = \<V> \<union> {x}" using add_point_def by simp
  show ?thesis unfolding add_point_def using finite_sets design_blocks_nempty
  proof (unfold_locales, simp_all)
    have "\<And> G. G \<in> \<G> \<Longrightarrow> insert x G \<subseteq> ?V"
      by (simp add: point_in_group subsetI vdef)
    then have "\<And> G. G \<in># (mset_set { insert x g | g. g \<in> \<G>}) \<Longrightarrow> G \<subseteq> ?V"
      by (smt (verit, del_insts) elem_mset_set empty_iff infinite_set_mset_mset_set mem_Collect_eq)
    then show "\<And>b. b \<in># \<B> \<or> b \<in># mset_set {insert x g |g. g \<in> \<G>} \<Longrightarrow> b \<subseteq> insert x \<V>"
      using wellformed add_point_def by fastforce
  next
    have "\<And> G. G \<in> \<G> \<Longrightarrow> insert x G \<noteq> {}" using group_partitions
      using partition_onD3 by auto
    then have gnempty: "\<And> G. G \<in># (mset_set { insert x g | g. g \<in> \<G>}) \<Longrightarrow> G \<noteq> {}"
      by (smt (verit, del_insts) elem_mset_set empty_iff infinite_set_mset_mset_set mem_Collect_eq)
    then show "\<And>bl. bl \<in># \<B> \<or> bl \<in># mset_set {insert x g |g. g \<in> \<G>} \<Longrightarrow> bl \<noteq> {}"
      using blocks_nempty by auto
  next
    have "card \<V> \<ge> 2" using gdd_min_v by simp
    then have "card (insert x \<V>) \<ge> 2"
      by (meson card_insert_le dual_order.trans finite_sets)
    then show "2 \<le> (card (insert x \<V>))" by auto
  next
    show "\<And>ps. ps \<subseteq> insert x \<V> \<Longrightarrow>
          card ps = 2 \<Longrightarrow> (\<B> + mset_set {insert x g |g. g \<in> \<G>}) index ps = Suc 0"
      using kgdd1_index_adjoin_group_block by (simp add: assms)
  qed
qed

lemma PBD_by_adjoining_point:
  assumes "x \<notin> \<V>"
  assumes "\<And> k . k \<in> \<K> \<Longrightarrow> k \<ge> 2"
  shows "PBD (add_point x) (\<B> + mset_set { insert x g | g. g \<in> \<G>}) (\<K> \<union> {(card g) + 1 | g . g \<in> \<G>})"
proof -
  let ?B = "\<B> + mset_set { insert x g | g. g \<in> \<G>}"
  let ?V = "(add_point x)"
  interpret inc: pairwise_balance ?V ?B 1 using pairwise_by_adjoining_point assms by auto
  show ?thesis using  block_sizes positive_ints proof (unfold_locales)
    have xg: "\<And> g. g \<in> \<G> \<Longrightarrow> x \<notin> g"
      using assms point_in_group by auto
    have "\<And> bl . bl \<in># \<B> \<Longrightarrow> card bl \<in> \<K>" by (simp add: block_sizes)
    have "\<And> bl . bl \<in># mset_set {insert x g |g. g \<in> \<G>} \<Longrightarrow> bl \<in> {insert x g | g . g \<in> \<G>}"
      by (simp add: groups_finite)
    then have "\<And> bl . bl \<in># mset_set {insert x g |g. g \<in> \<G>} \<Longrightarrow>
      card bl \<in>  {(card g + 1) |g. g \<in> \<G>}"
    proof -
      fix bl
      assume "bl \<in># mset_set {insert x g |g. g \<in> \<G>}"
      then have "bl \<in> {insert x g | g . g \<in> \<G>}" by (simp add: groups_finite)
      then obtain g where gin: "g \<in> \<G>" and i: "bl = insert x g" by auto
      thus "card bl \<in>  {(card g + 1) |g. g \<in> \<G>}"
        using gin group_elements_finite i xg by auto
    qed
    then show "\<And>bl. bl \<in># \<B> + mset_set {insert x g |g. g \<in> \<G>} \<Longrightarrow>
        (card bl) \<in> \<K> \<union> {(card g + 1) |g. g \<in> \<G>}"
      using  UnI1 UnI2 block_sizes union_iff by (smt (z3) mem_Collect_eq)
    show "\<And>x. x \<in> \<K> \<union> { (card g + 1) |g. g \<in> \<G>} \<Longrightarrow> 0 < x"
      using min_group_size positive_ints by auto
    show "\<And>k.  k \<in> \<K> \<union> {(card g + 1) |g. g \<in> \<G>} \<Longrightarrow> 2 \<le> k"
      using min_group_size positive_ints assms by fastforce
  qed
qed

subsubsection \<open>Wilson's Construction\<close>
text \<open>Wilson's construction involves the combination of multiple k-GDD's. This proof was
based of Stinson \cite{stinsonCombinatorialDesignsConstructions2004}\<close>

lemma wilsons_construction_proper:
  assumes "card I = w"
  assumes "w > 0"
  assumes "\<And> n. n \<in> \<K>' \<Longrightarrow> n \<ge> 2"
  assumes "\<And> B . B \<in># \<B> \<Longrightarrow> K_GDD (B \<times> I) (f B) \<K>' {{x} \<times> I |x . x \<in> B }"
  shows "proper_design (\<V> \<times> I) (\<Sum>B \<in># \<B>. (f B))" (is "proper_design ?Y ?B")
proof (unfold_locales, simp_all)
  show "\<And>b. \<exists>x\<in>#\<B>. b \<in># f x \<Longrightarrow> b \<subseteq> \<V> \<times> I"
  proof -
    fix b
    assume "\<exists>x\<in>#\<B>. b \<in># f x"
    then obtain B where "B \<in># \<B>" and "b \<in># (f B)" by auto
    then interpret kgdd: K_GDD "(B \<times> I)" "(f B)" \<K>' "{{x} \<times> I |x . x \<in> B }" using assms by auto
    show "b \<subseteq> \<V> \<times> I" using kgdd.wellformed
      using \<open>B \<in># \<B>\<close> \<open>b \<in># f B\<close> wellformed by fastforce
  qed
  show "finite (\<V> \<times> I)" using finite_sets assms bot_nat_0.not_eq_extremum card.infinite by blast
  show "\<And>bl. \<exists>x\<in>#\<B>. bl \<in># f x \<Longrightarrow> bl \<noteq> {}"
  proof -
    fix bl
    assume "\<exists>x\<in>#\<B>. bl \<in># f x"
    then obtain B where "B \<in># \<B>" and "bl \<in># (f B)" by auto
    then interpret kgdd: K_GDD "(B \<times> I)" "(f B)" \<K>' "{{x} \<times> I |x . x \<in> B }" using assms by auto
    show "bl \<noteq> {}" using kgdd.blocks_nempty by (simp add: \<open>bl \<in># f B\<close>)
  qed
  show "\<exists>i\<in>#\<B>. f i \<noteq> {#}"
  proof -
    obtain B where "B \<in># \<B>"
      using design_blocks_nempty by auto
    then interpret kgdd: K_GDD "(B \<times> I)" "(f B)" \<K>' "{{x} \<times> I |x . x \<in> B }" using assms by auto
    have "f B \<noteq> {#}" using kgdd.design_blocks_nempty by simp
    then show "\<exists>i\<in>#\<B>. f i \<noteq> {#}" using \<open>B \<in># \<B>\<close> by auto
  qed
qed

lemma pair_construction_block_sizes:
  assumes "K_GDD (B \<times> I) (f B) \<K>' {{x} \<times> I |x . x \<in> B }"
  assumes "B \<in># \<B>"
  assumes "b \<in># (f B)"
  shows "card b \<in> \<K>'"
proof -
  interpret bkgdd: K_GDD "(B \<times> I)" "(f B)" \<K>' "{{x} \<times> I |x . x \<in> B }"
    using assms by simp
  show "card b \<in> \<K>'" using bkgdd.block_sizes by (simp add:assms)
qed

lemma wilsons_construction_index_0:
  assumes "\<And> B . B \<in># \<B> \<Longrightarrow> K_GDD (B \<times> I) (f B) \<K>' {{x} \<times> I |x . x \<in> B }"
  assumes "G \<in> {GG \<times> I |GG. GG \<in> \<G>}"
  assumes "X \<in> G"
  assumes "Y \<in> G"
  assumes "X \<noteq> Y"
  shows "(\<Sum>\<^sub># (image_mset f \<B>)) index {X, Y} = 0"
proof -
  obtain G' where gi: "G = G' \<times> I" and ging: "G' \<in> \<G>" using assms by auto
  obtain x y ix iy where xpair: "X = (x, ix)" and ypair: "Y = (y, iy)" using assms by auto
  then have ixin: "ix \<in> I" and xing: "x \<in> G'" using assms gi by auto
  have iyin: "iy \<in> I" and ying: "y \<in> G'" using assms ypair gi by auto
  have ne_index_0: "x \<noteq> y \<Longrightarrow> \<B> index {x, y} = 0"
    using ying xing index_together ging by simp
  have "\<And> B. B \<in># \<B> \<Longrightarrow> (f B) index {(x, ix), (y, iy)} = 0"
  proof -
    fix B
    assume assm: "B \<in># \<B>"
    then interpret kgdd: K_GDD "(B \<times> I)" "(f B)" \<K>' "{{x} \<times> I |x . x \<in> B }" using assms by simp
    have not_ss_0: "\<not> ({(x, ix), (y, iy)} \<subseteq> (B \<times> I)) \<Longrightarrow> (f B) index {(x, ix), (y, iy)} = 0"
      by (metis kgdd.points_index_ps_nin)
    have "x \<noteq> y \<Longrightarrow> \<not> {x, y} \<subseteq> B" using ne_index_0 assm points_index_0_left_imp by auto
    then have "x \<noteq> y \<Longrightarrow> \<not> ({(x, ix), (y, iy)} \<subseteq> (B \<times> I))" using assms
      by (meson empty_subsetI insert_subset mem_Sigma_iff)
    then have nexy: "x \<noteq> y \<Longrightarrow> (f B) index {(x, ix), (y, iy)} = 0" using not_ss_0 by simp
    have "x = y \<Longrightarrow> ({(x, ix), (y, iy)} \<subseteq> (B \<times> I)) \<Longrightarrow> (f B) index {(x, ix), (y, iy)} = 0"
    proof -
      assume eq: "x = y"
      assume "({(x, ix), (y, iy)} \<subseteq> (B \<times> I))"
      then obtain g where "g \<in> {{x} \<times> I |x . x \<in> B }" and "(x, ix) \<in> g" and "(y, ix) \<in> g"
        using eq  by auto
      then show ?thesis using kgdd.index_together
        by (smt (verit, best) SigmaD1 SigmaD2 SigmaI assms(4) assms(5) gi mem_Collect_eq xpair ypair)
    qed
    then show "(f B) index {(x, ix), (y, iy)} = 0" using not_ss_0 nexy by auto
  qed
  then have "\<And> B. B \<in># (image_mset f \<B>) \<Longrightarrow> B index {(x, ix), (y, iy)} = 0" by auto
  then show "(\<Sum>\<^sub># (image_mset f \<B>)) index {X, Y} = 0"
    by (simp add: points_index_sum xpair ypair)
qed

lemma wilsons_construction_index_1:
  assumes "\<And> B . B \<in># \<B> \<Longrightarrow> K_GDD (B \<times> I) (f B) \<K>' {{x} \<times> I |x . x \<in> B }"
  assumes "G1 \<in> {G \<times> I |G. G \<in> \<G>}"
  assumes "G2 \<in> {G \<times> I |G. G \<in> \<G>}"
  assumes "G1 \<noteq> G2"
  and "(x, ix) \<in> G1" and "(y, iy) \<in> G2"
  shows "(\<Sum>\<^sub># (image_mset f \<B>)) index {(x, ix), (y, iy)} = (1 ::int)"
proof -
  obtain G1' where gi1: "G1 = G1' \<times> I" and ging1: "G1' \<in> \<G>" using assms by auto
  obtain G2' where gi2: "G2 = G2' \<times> I" and ging2: "G2' \<in> \<G>" using assms by auto
  have xing: "x \<in> G1'" using assms gi1 by simp
  have ying: "y \<in> G2'" using assms gi2 by simp
  have gne: "G1' \<noteq> G2'" using assms gi1 gi2 by auto
  then have xyne: "x \<noteq> y" using xing ying ging1 ging2 point_in_one_group by blast
  have "\<exists>! bl . bl \<in># \<B> \<and> {x, y} \<subseteq> bl" using index_distinct points_index_one_unique_block
    by (metis ging1 ging2 gne of_nat_1_eq_iff xing ying)
  then obtain bl where blinb:"bl \<in># \<B>" and xyblss: "{x, y} \<subseteq> bl" by auto
  then have "\<And> b . b \<in># \<B> - {#bl#} \<Longrightarrow> \<not> {x, y} \<subseteq> b" using points_index_one_not_unique_block
    by (metis ging1 ging2 gne index_distinct int_ops(2) nat_int_comparison(1) xing ying)
  then have not_ss: "\<And> b . b \<in># \<B> - {#bl#} \<Longrightarrow> \<not> ({(x, ix), (y, iy)} \<subseteq> (b \<times> I))" using assms
    by (meson SigmaD1 empty_subsetI insert_subset)
  then have pi0: "\<And> b . b \<in># \<B> - {#bl#} \<Longrightarrow> (f b) index {(x, ix), (y, iy)}  = 0"
  proof -
    fix b
    assume assm: "b \<in># \<B> - {#bl#}"
    then have "b \<in># \<B>" by (meson in_diffD)
    then interpret kgdd: K_GDD "(b \<times> I)" "(f b)" \<K>' "{{x} \<times> I |x . x \<in> b }" using assms by simp
    show "(f b) index {(x, ix), (y, iy)} = 0"
      using assm not_ss by (metis kgdd.points_index_ps_nin)
  qed
  let ?G = "{{x} \<times> I |x . x \<in> bl }"
  interpret bkgdd: K_GDD "(bl \<times> I)" "(f bl)" \<K>' ?G using assms blinb by simp
  obtain g1 g2 where xing1: "(x, ix) \<in> g1" and ying2: "(y, iy) \<in> g2" and g1g: "g1 \<in> ?G"
      and g2g: "g2 \<in> ?G" using assms(5) assms(6) gi1 gi2
    by (metis (no_types, lifting) bkgdd.point_has_unique_group insert_subset mem_Sigma_iff xyblss)
  then have "g1 \<noteq> g2" using xyne by blast
  then have pi1: "(f bl) index {(x, ix), (y, iy)} = 1"
    using bkgdd.index_distinct xing1 ying2 g1g g2g by simp
  have "(\<Sum>\<^sub># (image_mset f \<B>)) index {(x, ix), (y, iy)} =
      (\<Sum>B \<in># \<B>. (f B) index {(x, ix), (y, iy)} )"
    by (simp add: points_index_sum)
  then have "(\<Sum>\<^sub># (image_mset f \<B>)) index {(x, ix), (y, iy)} =
      (\<Sum>B \<in># (\<B> - {#bl#}). (f B) index {(x, ix), (y, iy)}) + (f bl) index {(x, ix), (y, iy)}"
    by (metis (no_types, lifting) add.commute blinb insert_DiffM sum_mset.insert)
  thus ?thesis using pi0 pi1 by simp
qed

theorem Wilsons_Construction:
  assumes "card I = w"
  assumes "w > 0"
  assumes "\<And> n. n \<in> \<K>' \<Longrightarrow> n \<ge> 2"
  assumes "\<And> B . B \<in># \<B> \<Longrightarrow> K_GDD (B \<times> I) (f B) \<K>' {{x} \<times> I |x . x \<in> B }"
  shows "K_GDD (\<V> \<times> I) (\<Sum>B \<in># \<B>. (f B)) \<K>' {G \<times> I | G . G \<in> \<G>}"
proof -
  let ?Y = "\<V> \<times> I" and ?H = "{G \<times> I | G . G \<in> \<G>}" and ?B = "\<Sum>B \<in># \<B>. (f B)"
  interpret pd: proper_design ?Y ?B using wilsons_construction_proper assms by auto
  have "\<And> bl . bl \<in># (\<Sum>B \<in># \<B>. (f B)) \<Longrightarrow> card bl \<in> \<K>'"
    using assms pair_construction_block_sizes by blast
  then interpret kdes: K_block_design ?Y ?B \<K>'
    using assms(3) by (unfold_locales) (simp_all,fastforce)
  interpret gdd: GDD ?Y ?B ?H "1:: int"
  proof (unfold_locales)
    show "partition_on (\<V> \<times> I) {G \<times> I |G. G \<in> \<G>}"
      using assms groups_not_empty design_points_nempty group_partitions
      by (simp add: partition_on_cart_prod)
    have "inj_on (\<lambda> G. G \<times> I) \<G>"
      using inj_on_def pd.design_points_nempty by auto
    then have "card {G \<times> I |G. G \<in> \<G>} = card \<G>" using card_image by (simp add: Setcompr_eq_image)
    then show "1 < card {G \<times> I |G. G \<in> \<G>}" using groups_size by linarith
    show "(1::int) \<le> 1" by simp
    have gdd_fact: "\<And> B . B \<in># \<B> \<Longrightarrow> K_GDD (B \<times> I) (f B) \<K>' {{x} \<times> I |x . x \<in> B }"
      using assms by simp
    show "\<And>G X Y. G \<in> {GG \<times> I |GG. GG \<in> \<G>} \<Longrightarrow> X \<in> G \<Longrightarrow> Y \<in> G \<Longrightarrow> X \<noteq> Y
        \<Longrightarrow> (\<Sum>\<^sub># (image_mset f \<B>)) index {X, Y} = 0"
      using wilsons_construction_index_0[OF assms(4)] by auto
    show "\<And>G1 G2 X Y. G1 \<in> {G \<times> I |G. G \<in> \<G>} \<Longrightarrow> G2 \<in> {G \<times> I |G. G \<in> \<G>}
      \<Longrightarrow> G1 \<noteq> G2 \<Longrightarrow> X \<in> G1 \<Longrightarrow> Y \<in> G2 \<Longrightarrow> ((\<Sum>\<^sub># (image_mset f \<B>)) index {X, Y}) = (1 ::int)"
      using wilsons_construction_index_1[OF assms(4)] by blast
  qed
  show ?thesis by (unfold_locales)
qed

end

context pairwise_balance
begin

lemma PBD_by_deleting_point:
  assumes "\<v> > 2"
  assumes "\<And> bl . bl \<in># \<B> \<Longrightarrow> card bl \<ge> 2"
  shows "pairwise_balance (del_point x) (del_point_blocks x) \<Lambda>"
proof (cases "x \<in> \<V>")
  case True
  interpret des: design "del_point x" "del_point_blocks x"
    using delete_point_design assms by blast
  show ?thesis using assms design_blocks_nempty del_point_def del_point_blocks_def
  proof (unfold_locales, simp_all)
    show "2 < \<v> \<Longrightarrow> (\<And>bl. bl \<in># \<B> \<Longrightarrow> 2 \<le> card bl) \<Longrightarrow> 2 \<le> (card (\<V> - {x}))"
      using card_Diff_singleton_if diff_diff_cancel diff_le_mono2 finite_sets less_one
      by fastforce
    have "\<And> ps . ps  \<subseteq> \<V> - {x} \<Longrightarrow> ps \<subseteq> \<V>" by auto
    then show "\<And>ps. ps \<subseteq> \<V> - {x} \<Longrightarrow> card ps = 2  \<Longrightarrow> {#bl - {x}. bl \<in># \<B>#} index ps = \<Lambda>"
      using delete_point_index_eq del_point_def del_point_blocks_def by simp
  qed
next
  case False
  then show ?thesis
    by (simp add: del_invalid_point del_invalid_point_blocks pairwise_balance_axioms)
qed
end

context k_GDD
begin

lemma bibd_from_kGDD:
  assumes "\<k> > 1"
  assumes "\<And> g. g \<in> \<G> \<Longrightarrow> card g = \<k> - 1"
  assumes " x \<notin> \<V>"
  shows "bibd (add_point x) (\<B> + mset_set { insert x g | g. g \<in> \<G>}) (\<k>) 1"
proof -
  have "\<And> k . k\<in> {\<k>} \<Longrightarrow> k = \<k>"
    by blast
  then have kge: "\<And> k . k\<in> {\<k>} \<Longrightarrow> k \<ge> 2" using assms(1) by simp
  have "\<And> g . g \<in> \<G> \<Longrightarrow> card g + 1 = \<k>" using assms k_non_zero
    by auto
  then have s: "({\<k>} \<union> {(card g) + 1 | g . g \<in> \<G>}) = {\<k>}"
    by auto
  then interpret pbd: PBD "(add_point x)" "\<B> + mset_set { insert x g | g. g \<in> \<G>}" "{\<k>}"
    using PBD_by_adjoining_point[of "x"] kge assms by (smt (z3) Collect_cong)
  show ?thesis using assms pbd.block_sizes block_size_lt_v finite_sets add_point_def
    by (unfold_locales) (simp_all)
qed

end

context PBD
begin

lemma pbd_points_index1: "ps \<subseteq> \<V> \<Longrightarrow> card ps = 2 \<Longrightarrow> \<B> index ps = 1"
  using balanced by simp

lemma pbd_index1_points_imply_unique_block:
  assumes "b1 \<in># \<B>" and "b2 \<in># \<B>" and "b1 \<noteq> b2"
  assumes "x \<noteq> y" and "{x, y} \<subseteq> b1" and "x \<in> b2"
  shows "y \<notin> b2"
proof (rule ccontr)
  let ?ps = "{# b \<in># \<B> . {x, y} \<subseteq> b#}"
  assume "\<not> y \<notin> b2"
  then have a: "y \<in> b2" by linarith
  then have "{x, y} \<subseteq> b2"
    by (simp add: assms(6))
  then have "b1 \<in># ?ps" and "b2 \<in># ?ps" using assms by auto
  then have ss: "{#b1, b2#} \<subseteq># ?ps" using assms
    by (metis insert_noteq_member mset_add mset_subset_eq_add_mset_cancel single_subset_iff)
  have "size {#b1, b2#} = 2" using assms by auto
  then have ge2: "size ?ps \<ge> 2" using assms ss by (metis size_mset_mono)
  have pair: "card {x, y} = 2" using assms by auto
  have "{x, y} \<subseteq> \<V>" using assms wellformed by auto
  then have "\<B> index {x, y} = 1" using pbd_points_index1 pair by simp
  then show False using points_index_def ge2
    by (metis numeral_le_one_iff semiring_norm(69))
qed

lemma strong_delete_point_groups_index_zero:
  assumes "G \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b}"
  assumes "xa \<in> G" and "y \<in> G" and "xa \<noteq> y"
  shows "(str_del_point_blocks x) index {xa, y} = 0"
proof (auto simp add: points_index_0_iff str_del_point_blocks_def)
  fix b
  assume a1: "b \<in># \<B>" and a2: "x \<notin> b" and a3: "xa \<in> b" and a4: "y \<in> b"
  obtain b' where "G = b' - {x}" and "b' \<in># \<B>" and  "x \<in> b'" using assms by blast
  then show False using a1 a2 a3 a4 assms pbd_index1_points_imply_unique_block
    by fastforce
qed

lemma strong_delete_point_groups_index_one:
  assumes "G1 \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b}"
  assumes "G2 \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b}"
  assumes "G1 \<noteq> G2" and "xa \<in> G1" and "y \<in> G2"
  shows  "(str_del_point_blocks x) index {xa, y} = 1"
proof -
  obtain b1 where gb1: "G1 = b1 - {x}" and b1in: "b1 \<in># \<B>" and xin1: "x \<in> b1" using assms by blast
  obtain b2 where gb2: "G2 = b2 - {x}" and b2in: "b2 \<in># \<B>" and xin2:"x \<in> b2" using assms by blast
  have bneq: "b1 \<noteq> b2 " using assms(3) gb1 gb2 by auto
  have "xa \<noteq> y" using gb1 b1in xin1 gb2 b2in xin2 assms(3) assms(4) assms(5) insert_subset
    by (smt (verit, best) Diff_eq_empty_iff Diff_iff empty_Diff insertCI pbd_index1_points_imply_unique_block)
  then have pair: "card {xa, y} = 2" by simp
  have inv: "{xa, y} \<subseteq> \<V>" using gb1 b1in gb2 b2in assms(4) assms(5)
    by (metis Diff_cancel Diff_subset insert_Diff insert_subset wellformed)
  have "{# bl \<in># \<B> . x \<in> bl#} index {xa, y} = 0"
  proof (auto simp add: points_index_0_iff)
    fix b assume a1: "b \<in># \<B>" and a2: "x \<in> b" and a3: "xa \<in> b" and a4: "y \<in> b"
    then have yxss: "{y, x} \<subseteq> b2"
      using assms(5) gb2 xin2 by blast
    have "{xa, x} \<subseteq> b1"
      using assms(4) gb1 xin1 by auto
    then have "xa \<notin> b2" using pbd_index1_points_imply_unique_block
      by (metis DiffE assms(4) b1in b2in bneq gb1 singletonI xin2)
    then have "b2 \<noteq> b" using a3 by auto
    then show False using pbd_index1_points_imply_unique_block
      by (metis DiffD2 yxss a1 a2 a4 assms(5) b2in gb2 insertI1)
  qed
  then have "(str_del_point_blocks x) index {xa, y} = \<B> index {xa, y}"
    by (metis multiset_partition plus_nat.add_0 point_index_distrib str_del_point_blocks_def)
  thus ?thesis using pbd_points_index1 pair inv by fastforce
qed

lemma blocks_with_x_partition:
  assumes "x \<in> \<V>"
  shows "partition_on (\<V> - {x}) {b - {x} |b. b \<in># \<B> \<and> x \<in> b}"
proof (intro partition_onI )
  have gtt: "\<And> bl. bl \<in># \<B> \<Longrightarrow> card bl \<ge> 2" using block_size_gt_t
    by (simp add: block_sizes nat_int_comparison(3))
  show "\<And>p. p \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b} \<Longrightarrow> p \<noteq> {}"
  proof -
    fix p assume "p \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b}"
    then obtain b where ptx: "p = b - {x}" and "b \<in># \<B>" and xinb: "x \<in> b" by blast
    then have ge2: "card b \<ge> 2" using gtt by (simp add: nat_int_comparison(3))
    then have "finite b" by (metis card.infinite not_numeral_le_zero)
    then have "card p = card b - 1" using xinb ptx by simp
    then have "card p \<ge> 1" using ge2 by linarith
    thus "p \<noteq> {}" by auto
  qed
  show "\<Union> {b - {x} |b. b \<in># \<B> \<and> x \<in> b} = \<V> - {x}"
  proof (intro subset_antisym subsetI)
    fix xa
    assume "xa \<in> \<Union> {b - {x} |b. b \<in># \<B> \<and> x \<in> b}"
    then obtain b where "xa \<in> b" and "b \<in># \<B>" and "x \<in> b" and "xa \<noteq> x" by auto
    then show "xa \<in> \<V> - {x}" using wf_invalid_point by blast
  next
    fix xa
    assume a: "xa \<in> \<V> - {x}"
    then have nex: "xa \<noteq> x" by simp
    then have pair: "card {xa, x} = 2" by simp
    have "{xa, x} \<subseteq> \<V>" using a assms by auto
    then have "card {b \<in> design_support . {xa, x} \<subseteq> b} = 1"
      using balanced points_index_simple_def pbd_points_index1 assms by (metis pair)
    then obtain b where des: "b \<in> design_support" and ss: "{xa, x} \<subseteq> b"
      by (metis (no_types, lifting) card_1_singletonE mem_Collect_eq singletonI)
    then show "xa \<in> \<Union> {b - {x} |b. b \<in># \<B> \<and> x \<in> b}"
      using des ss nex design_support_def by auto
  qed
  show "\<And>p p'. p \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b} \<Longrightarrow> p' \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b} \<Longrightarrow>
    p \<noteq> p' \<Longrightarrow> p \<inter> p' = {}"
  proof -
    fix p p'
    assume p1: "p \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b}" and p2: "p' \<in> {b - {x} |b. b \<in># \<B> \<and> x \<in> b}"
      and pne: "p \<noteq> p'"
    then obtain b where b1: "p = b - {x}" and b1in:"b \<in># \<B>" and xinb1:"x \<in> b" by blast
    then obtain b' where b2: "p' = b' - {x}" and b2in: "b' \<in># \<B>" and xinb2: "x \<in> b'"
      using p2 by blast
    then have "b \<noteq> b'" using pne b1 by auto
    then have "\<And> y. y \<in> b \<Longrightarrow> y \<noteq> x \<Longrightarrow> y \<notin> b'"
      using b1in b2in xinb1 xinb2 pbd_index1_points_imply_unique_block
      by (meson empty_subsetI insert_subset)
    then have "\<And> y. y \<in> p \<Longrightarrow> y \<notin> p'"
      by (metis Diff_iff b1 b2 insertI1)
    then show "p \<inter> p' = {}" using disjoint_iff by auto
  qed
qed

lemma KGDD_by_deleting_point:
  assumes "x \<in> \<V>"
  assumes "\<B> rep x < \<b>"
  assumes "\<B> rep x > 1"
  shows "K_GDD (del_point x) (str_del_point_blocks x) \<K> { b - {x} | b . b \<in># \<B> \<and> x \<in> b}"
proof -
  have "\<And> bl. bl \<in># \<B> \<Longrightarrow> card bl \<ge> 2" using block_size_gt_t
    by (simp add: block_sizes nat_int_comparison(3))
  then interpret des: proper_design "(del_point x)" "(str_del_point_blocks x)"
    using strong_delete_point_proper assms by blast
  show ?thesis using blocks_with_x_partition strong_delete_point_groups_index_zero
      strong_delete_point_groups_index_one str_del_point_blocks_def del_point_def
  proof (unfold_locales, simp_all add: block_sizes positive_ints assms)
    have ge1: "card {b . b \<in># \<B> \<and> x \<in> b} > 1"
      using assms(3) replication_num_simple_def design_support_def by auto
    have fin: "finite {b . b \<in># \<B> \<and> x \<in> b}" by simp
    have inj: "inj_on (\<lambda> b . b - {x}) {b . b \<in># \<B> \<and> x \<in> b}"
      using assms(2) inj_on_def mem_Collect_eq by auto
    then have "card {b - {x} |b. b \<in># \<B> \<and> x \<in> b} = card {b . b \<in># \<B> \<and> x \<in> b}"
      using card_image fin by (simp add: inj card_image setcompr_eq_image)
    then show "Suc 0 < card {b - {x} |b. b \<in># \<B> \<and> x \<in> b}" using ge1
      by presburger
  qed
qed

lemma card_singletons_eq: "card {{a} | a . a \<in> A} = card A"
  by (simp add: card_image Setcompr_eq_image)

lemma KGDD_from_PBD: "K_GDD \<V> \<B> \<K> {{x} | x . x \<in> \<V>}"
proof (unfold_locales,auto simp add: Setcompr_eq_image partition_on_singletons)
  have "card ((\<lambda>x. {x}) ` \<V>) \<ge> 2" using t_lt_order card_singletons_eq
    by (metis Collect_mem_eq setcompr_eq_image)
  then show "Suc 0 < card ((\<lambda>x. {x}) ` \<V>)" by linarith
  show "\<And>xa xb. xa \<in> \<V> \<Longrightarrow> xb \<in> \<V> \<Longrightarrow> \<B> index {xa, xb} \<noteq> Suc 0 \<Longrightarrow> xa = xb"
  proof (rule ccontr)
    fix xa xb
    assume ain: "xa \<in> \<V>" and bin: "xb \<in> \<V>" and ne1: "\<B> index {xa, xb} \<noteq> Suc 0"
    assume "xa \<noteq> xb"
    then have "card {xa, xb} = 2" by auto
    then have "\<B> index {xa, xb} = 1"
      by (simp add: ain bin)
    thus False using ne1 by linarith
  qed
qed

end

context bibd
begin
lemma kGDD_from_bibd:
  assumes "\<Lambda> = 1"
  assumes "x \<in> \<V>"
  shows "k_GDD (del_point x) (str_del_point_blocks x) \<k> { b - {x} | b . b \<in># \<B> \<and> x \<in> b}"
proof -
  interpret pbd: PBD \<V> \<B> "{\<k>}" using assms
    using PBD.intro \<Lambda>_PBD_axioms by auto
  have lt: "\<B> rep x < \<b>" using block_num_gt_rep
    by (simp add: assms(2))
  have "\<B> rep x > 1" using r_ge_two assms by simp
  then interpret kgdd: K_GDD "(del_point x)" "str_del_point_blocks x"
    "{\<k>}" "{ b - {x} | b . b \<in># \<B> \<and> x \<in> b}"
    using pbd.KGDD_by_deleting_point lt assms by blast
  show ?thesis using del_point_def str_del_point_blocks_def by (unfold_locales) (simp_all)
qed

end
end