(*
  File:      HOL/Computational_Algebra/Squarefree.thy
  Author:    Manuel Eberl <eberlm@in.tum.de>

  Squarefreeness and decomposition of ring elements into square part and squarefree part
*)
section \<open>Squarefreeness\<close>
theory Squarefree
imports Primes
begin

(* TODO: Generalise to n-th powers *)

definition squarefree :: "'a :: comm_monoid_mult \<Rightarrow> bool" where
  "squarefree n \<longleftrightarrow> (\<forall>x. x ^ 2 dvd n \<longrightarrow> x dvd 1)"

lemma squarefreeI: "(\<And>x. x ^ 2 dvd n \<Longrightarrow> x dvd 1) \<Longrightarrow> squarefree n"
  by (auto simp: squarefree_def)

lemma squarefreeD: "squarefree n \<Longrightarrow> x ^ 2 dvd n \<Longrightarrow> x dvd 1"
  by (auto simp: squarefree_def)

lemma not_squarefreeI: "x ^ 2 dvd n \<Longrightarrow> \<not>x dvd 1 \<Longrightarrow> \<not>squarefree n"
  by (auto simp: squarefree_def)

lemma not_squarefreeE [case_names square_dvd]:
  "\<not>squarefree n \<Longrightarrow> (\<And>x. x ^ 2 dvd n \<Longrightarrow> \<not>x dvd 1 \<Longrightarrow> P) \<Longrightarrow> P"
  by (auto simp: squarefree_def)

lemma not_squarefree_0 [simp]: "\<not>squarefree (0 :: 'a :: comm_semiring_1)"
  by (rule not_squarefreeI[of 0]) auto

lemma squarefree_factorial_semiring:
  assumes "n \<noteq> 0"
  shows   "squarefree (n :: 'a :: factorial_semiring) \<longleftrightarrow> (\<forall>p. prime p \<longrightarrow> \<not>p ^ 2 dvd n)"
  unfolding squarefree_def
proof safe
  assume *: "\<forall>p. prime p \<longrightarrow> \<not>p ^ 2 dvd n"
  fix x :: 'a assume x: "x ^ 2 dvd n"
  {
    assume "\<not>is_unit x"
    moreover from assms and x have "x \<noteq> 0" by auto
    ultimately obtain p where "p dvd x" "prime p"
      using prime_divisor_exists by blast
    with * have "\<not>p ^ 2 dvd n" by blast
    moreover from \<open>p dvd x\<close> have "p ^ 2 dvd x ^ 2" by (rule dvd_power_same)
    ultimately have "\<not>x ^ 2 dvd n" by (blast dest: dvd_trans)
    with x have False by contradiction
  }
  thus "is_unit x" by blast
qed auto

lemma squarefree_factorial_semiring':
  assumes "n \<noteq> 0"
  shows   "squarefree (n :: 'a :: factorial_semiring) \<longleftrightarrow>
             (\<forall>p\<in>prime_factors n. multiplicity p n = 1)"
proof (subst squarefree_factorial_semiring [OF assms], safe)
  fix p assume "\<forall>p\<in>#prime_factorization n. multiplicity p n = 1" "prime p" "p^2 dvd n"
  with assms show False
    by (cases "p dvd n")
       (auto simp: prime_factors_dvd power_dvd_iff_le_multiplicity not_dvd_imp_multiplicity_0)
qed (auto intro!: multiplicity_eqI simp: power2_eq_square [symmetric])

lemma squarefree_factorial_semiring'':
  assumes "n \<noteq> 0"
  shows   "squarefree (n :: 'a :: factorial_semiring) \<longleftrightarrow>
             (\<forall>p. prime p \<longrightarrow> multiplicity p n \<le> 1)"
  by (subst squarefree_factorial_semiring'[OF assms]) (auto simp: prime_factors_multiplicity)

lemma squarefree_unit [simp]: "is_unit n \<Longrightarrow> squarefree n"
proof (rule squarefreeI)
  fix x assume "x^2 dvd n" "n dvd 1"
  hence "is_unit (x^2)" by (rule dvd_unit_imp_unit)
  thus "is_unit x" by (simp add: is_unit_power_iff)
qed

lemma squarefree_1 [simp]: "squarefree (1 :: 'a :: algebraic_semidom)"
  by simp

lemma squarefree_minus [simp]: "squarefree (-n :: 'a :: comm_ring_1) \<longleftrightarrow> squarefree n"
  by (simp add: squarefree_def)

lemma squarefree_mono: "a dvd b \<Longrightarrow> squarefree b \<Longrightarrow> squarefree a"
  by (auto simp: squarefree_def intro: dvd_trans)

lemma squarefree_multD:
  assumes "squarefree (a * b)"
  shows   "squarefree a" "squarefree b"
  by (rule squarefree_mono[OF _ assms], simp)+

lemma squarefree_prime_elem:
  assumes "prime_elem (p :: 'a :: factorial_semiring)"
  shows   "squarefree p"
proof -
  from assms have "p \<noteq> 0" by auto
  show ?thesis
  proof (subst squarefree_factorial_semiring [OF \<open>p \<noteq> 0\<close>]; safe)
    fix q assume *: "prime q" "q^2 dvd p"
    with assms have "multiplicity q p \<ge> 2" by (intro multiplicity_geI) auto
    thus False using assms \<open>prime q\<close> prime_multiplicity_other[of q "normalize p"]
      by (cases "q = normalize p") simp_all
  qed
qed

lemma squarefree_prime:
  assumes "prime (p :: 'a :: factorial_semiring)"
  shows   "squarefree p"
  using assms by (intro squarefree_prime_elem) auto

lemma squarefree_mult_coprime:
  fixes a b :: "'a :: factorial_semiring_gcd"
  assumes "coprime a b" "squarefree a" "squarefree b"
  shows   "squarefree (a * b)"
proof -
  from assms have nz: "a * b \<noteq> 0" by auto
  show ?thesis unfolding squarefree_factorial_semiring'[OF nz]
  proof
    fix p assume p: "p \<in> prime_factors (a * b)"
    with nz have "prime p"
      by (simp add: prime_factors_dvd)
    have "\<not> (p dvd a \<and> p dvd b)"
    proof
      assume "p dvd a \<and> p dvd b"
      with \<open>coprime a b\<close> have "is_unit p"
        by (auto intro: coprime_common_divisor)
      with \<open>prime p\<close> show False
        by simp
    qed
    moreover from p have "p dvd a \<or> p dvd b" using nz
      by (auto simp: prime_factors_dvd prime_dvd_mult_iff)
    ultimately show "multiplicity p (a * b) = 1" using nz p assms(2,3)
      by (auto simp: prime_elem_multiplicity_mult_distrib prime_factors_multiplicity
            not_dvd_imp_multiplicity_0 squarefree_factorial_semiring')
  qed
qed

lemma squarefree_prod_coprime:
  fixes f :: "'a \<Rightarrow> 'b :: factorial_semiring_gcd"
  assumes "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> a \<noteq> b \<Longrightarrow> coprime (f a) (f b)"
  assumes "\<And>a. a \<in> A \<Longrightarrow> squarefree (f a)"
  shows   "squarefree (prod f A)"
  using assms
  by (induction A rule: infinite_finite_induct)
     (auto intro!: squarefree_mult_coprime prod_coprime_right)

lemma squarefree_powerD: "m > 0 \<Longrightarrow> squarefree (n ^ m) \<Longrightarrow> squarefree n"
  by (cases m) (auto dest: squarefree_multD)

lemma squarefree_power_iff:
  "squarefree (n ^ m) \<longleftrightarrow> m = 0 \<or> is_unit n \<or> (squarefree n \<and> m = 1)"
proof safe
  assume "squarefree (n ^ m)" "m > 0" "\<not>is_unit n"
  show "m = 1"
  proof (rule ccontr)
    assume "m \<noteq> 1"
    with \<open>m > 0\<close> have "n ^ 2 dvd n ^ m" by (intro le_imp_power_dvd) auto
    from this and \<open>\<not>is_unit n\<close> have "\<not>squarefree (n ^ m)" by (rule not_squarefreeI)
    with \<open>squarefree (n ^ m)\<close> show False by contradiction
  qed
qed (auto simp: is_unit_power_iff dest: squarefree_powerD)

definition squarefree_nat :: "nat \<Rightarrow> bool" where
  [code_abbrev]: "squarefree_nat = squarefree"

lemma squarefree_nat_code_naive [code]:
  "squarefree_nat n \<longleftrightarrow> n \<noteq> 0 \<and> (\<forall>k\<in>{2..n}. \<not>k ^ 2 dvd n)"
proof safe
  assume *: "\<forall>k\<in>{2..n}. \<not> k\<^sup>2 dvd n" and n: "n > 0"
  show "squarefree_nat n" unfolding squarefree_nat_def
  proof (rule squarefreeI)
    fix k assume k: "k ^ 2 dvd n"
    have "k dvd n" by (rule dvd_trans[OF _ k]) auto
    with n have "k \<le> n" by (intro dvd_imp_le)
    with bspec[OF *, of k] k have "\<not>k > 1" by (intro notI) auto
    moreover from k and n have "k \<noteq> 0" by (intro notI) auto
    ultimately have "k = 1" by presburger
    thus "is_unit k" by simp
  qed
qed (auto simp: squarefree_nat_def squarefree_def intro!: Nat.gr0I)

definition square_part :: "'a :: factorial_semiring \<Rightarrow> 'a" where
  "square_part n = (if n = 0 then 0 else
     normalize (\<Prod>p\<in>prime_factors n. p ^ (multiplicity p n div 2)))"

lemma square_part_nonzero:
  "n \<noteq> 0 \<Longrightarrow> square_part n = normalize (\<Prod>p\<in>prime_factors n. p ^ (multiplicity p n div 2))"
  by (simp add: square_part_def)

lemma square_part_0 [simp]: "square_part 0 = 0"
  by (simp add: square_part_def)

lemma square_part_unit [simp]: "is_unit x \<Longrightarrow> square_part x = 1"
  by (auto simp: square_part_def prime_factorization_unit)

lemma square_part_1 [simp]: "square_part 1 = 1"
  by simp

lemma square_part_0_iff [simp]: "square_part n = 0 \<longleftrightarrow> n = 0"
  by (simp add: square_part_def)

lemma normalize_uminus [simp]:
  "normalize (-x :: 'a :: {normalization_semidom, comm_ring_1}) = normalize x"
  by (rule associatedI) auto

lemma multiplicity_uminus_right [simp]:
  "multiplicity (x :: 'a :: {factorial_semiring, comm_ring_1}) (-y) = multiplicity x y"
proof -
  have "multiplicity x (-y) = multiplicity x (normalize (-y))"
    by (rule multiplicity_normalize_right [symmetric])
  also have "\<dots> = multiplicity x y" by simp
  finally show ?thesis .
qed

lemma multiplicity_uminus_left [simp]:
  "multiplicity (-x :: 'a :: {factorial_semiring, comm_ring_1}) y = multiplicity x y"
proof -
  have "multiplicity (-x) y = multiplicity (normalize (-x)) y"
    by (rule multiplicity_normalize_left [symmetric])
  also have "\<dots> = multiplicity x y" by simp
  finally show ?thesis .
qed

lemma prime_factorization_uminus [simp]:
  "prime_factorization (-x :: 'a :: {factorial_semiring, comm_ring_1}) = prime_factorization x"
  by (rule prime_factorization_cong) simp_all

lemma square_part_uminus [simp]:
    "square_part (-x :: 'a :: {factorial_semiring, comm_ring_1}) = square_part x"
  by (simp add: square_part_def)

lemma prime_multiplicity_square_part:
  assumes "prime p"
  shows   "multiplicity p (square_part n) = multiplicity p n div 2"
proof (cases "n = 0")
  case False
  thus ?thesis unfolding square_part_nonzero[OF False] multiplicity_normalize_right
    using finite_prime_divisors[of n] assms
    by (subst multiplicity_prod_prime_powers)
       (auto simp: not_dvd_imp_multiplicity_0 prime_factors_dvd multiplicity_prod_prime_powers)
qed auto

lemma square_part_square_dvd [simp, intro]: "square_part n ^ 2 dvd n"
proof (cases "n = 0")
  case False
  thus ?thesis
    by (intro multiplicity_le_imp_dvd)
       (auto simp: prime_multiplicity_square_part prime_elem_multiplicity_power_distrib)
qed auto

lemma prime_multiplicity_le_imp_dvd:
  assumes "x \<noteq> 0" "y \<noteq> 0"
  shows   "x dvd y \<longleftrightarrow> (\<forall>p. prime p \<longrightarrow> multiplicity p x \<le> multiplicity p y)"
  using assms by (auto intro: multiplicity_le_imp_dvd dvd_imp_multiplicity_le)

lemma dvd_square_part_iff: "x dvd square_part n \<longleftrightarrow> x ^ 2 dvd n"
proof (cases "x = 0"; cases "n = 0")
  assume nz: "x \<noteq> 0" "n \<noteq> 0"
  thus ?thesis
    by (subst (1 2) prime_multiplicity_le_imp_dvd)
       (auto simp: prime_multiplicity_square_part prime_elem_multiplicity_power_distrib)
qed auto

definition squarefree_part :: "'a :: factorial_semiring \<Rightarrow> 'a" where
  "squarefree_part n = (if n = 0 then 1 else n div square_part n ^ 2)"

lemma squarefree_part_0 [simp]: "squarefree_part 0 = 1"
  by (simp add: squarefree_part_def)

lemma squarefree_part_unit [simp]: "is_unit n \<Longrightarrow> squarefree_part n = n"
  by (auto simp add: squarefree_part_def)

lemma squarefree_part_1 [simp]: "squarefree_part 1 = 1"
  by simp

lemma squarefree_decompose: "n = squarefree_part n * square_part n ^ 2"
  by (simp add: squarefree_part_def)

lemma squarefree_part_uminus [simp]:
  assumes "x \<noteq> 0"
  shows   "squarefree_part (-x :: 'a :: {factorial_semiring, comm_ring_1}) = -squarefree_part x"
proof -
  have "-(squarefree_part x * square_part x ^ 2) = -x"
    by (subst squarefree_decompose [symmetric]) auto
  also have "\<dots> = squarefree_part (-x) * square_part (-x) ^ 2" by (rule squarefree_decompose)
  finally have "(- squarefree_part x) * square_part x ^ 2 =
                  squarefree_part (-x) * square_part x ^ 2" by simp
  thus ?thesis using assms by (subst (asm) mult_right_cancel) auto
qed

lemma squarefree_part_nonzero [simp]: "squarefree_part n \<noteq> 0"
  using squarefree_decompose[of n] by (cases "n \<noteq> 0") auto

lemma prime_multiplicity_squarefree_part:
  assumes "prime p"
  shows   "multiplicity p (squarefree_part n) = multiplicity p n mod 2"
proof (cases "n = 0")
  case False
  hence n: "n \<noteq> 0" by auto
  have "multiplicity p n mod 2 + 2 * (multiplicity p n div 2) = multiplicity p n" by simp
  also have "\<dots> = multiplicity p (squarefree_part n * square_part n ^ 2)"
    by (subst squarefree_decompose[of n]) simp
  also from assms n have "\<dots> = multiplicity p (squarefree_part n) + 2 * (multiplicity p n div 2)"
    by (subst prime_elem_multiplicity_mult_distrib)
       (auto simp: prime_elem_multiplicity_power_distrib prime_multiplicity_square_part)
  finally show ?thesis by (subst (asm) add_right_cancel) simp
qed auto

lemma prime_multiplicity_squarefree_part_le_Suc_0 [intro]:
  assumes "prime p"
  shows   "multiplicity p (squarefree_part n) \<le> Suc 0"
  by (simp add: assms prime_multiplicity_squarefree_part)

lemma squarefree_squarefree_part [simp, intro]: "squarefree (squarefree_part n)"
  by (subst squarefree_factorial_semiring'')
     (auto simp: prime_multiplicity_squarefree_part_le_Suc_0)

lemma squarefree_decomposition_unique:
  assumes "square_part m = square_part n"
  assumes "squarefree_part m = squarefree_part n"
  shows   "m = n"
  by (subst (1 2) squarefree_decompose) (simp_all add: assms)

lemma normalize_square_part [simp]: "normalize (square_part x) = square_part x"
  by (simp add: square_part_def)

lemma square_part_even_power': "square_part (x ^ (2 * n)) = normalize (x ^ n)"
proof (cases "x = 0")
  case False
  have "normalize (square_part (x ^ (2 * n))) = normalize (x ^ n)" using False
    by (intro multiplicity_eq_imp_eq)
       (auto simp: prime_multiplicity_square_part prime_elem_multiplicity_power_distrib)
  thus ?thesis by simp
qed (auto simp: power_0_left)

lemma square_part_even_power: "even n \<Longrightarrow> square_part (x ^ n) = normalize (x ^ (n div 2))"
  by (subst square_part_even_power' [symmetric]) auto

lemma square_part_odd_power': "square_part (x ^ (Suc (2 * n))) = normalize (x ^ n * square_part x)"
proof (cases "x = 0")
  case False
  have "normalize (square_part (x ^ (Suc (2 * n)))) = normalize (square_part x * x ^ n)"
  proof (rule multiplicity_eq_imp_eq, goal_cases)
    case (3 p)
    hence "multiplicity p (square_part (x ^ Suc (2 * n))) =
             (2 * (n * multiplicity p x) + multiplicity p x) div 2"
      by (subst prime_multiplicity_square_part)
         (auto simp: False prime_elem_multiplicity_power_distrib algebra_simps simp del: power_Suc)
    also from 3 False have "\<dots> = multiplicity p (square_part x * x ^ n)"
      by (subst div_mult_self4) (auto simp: prime_multiplicity_square_part
            prime_elem_multiplicity_mult_distrib prime_elem_multiplicity_power_distrib)
    finally show ?case .
  qed (insert False, auto)
  thus ?thesis by (simp add: mult_ac)
qed auto

lemma square_part_odd_power:
  "odd n \<Longrightarrow> square_part (x ^ n) = normalize (x ^ (n div 2) * square_part x)"
  by (subst square_part_odd_power' [symmetric]) auto

end


section \<open>Combinatory Logic\<close>

(*:maxLineLen=78:*)

theory Combinators
  imports "../implication_logic"
begin

subsection \<open>Definitions\<close>

text \<open>Combinatory logic, following Curry (TODO: citeme), can be formulated as
      follows.\<close>

datatype Var = Var nat ("\<X>")

datatype SKComb =
    Var_Comb Var ("\<^bold>\<langle>_\<^bold>\<rangle>" [100] 100)
  | S_Comb ("S")
  | K_Comb ("K")
  | Comb_App "SKComb" "SKComb"  (infixl "\<cdot>" 75)

text \<open> Note that in addition to \<^term>\<open>S\<close> and \<^term>\<open>K\<close> combinators,
       \<^typ>\<open>SKComb\<close> provides terms for \<^emph>\<open>variables\<close>. This is helpful when
       studying \<open>\<lambda>\<close>-abstraction embedding.\<close>

subsection \<open>Typing\<close>

text \<open>The fragment of the \<^typ>\<open>SKComb\<close> types without
      \<^term>\<open>Var_Comb\<close> terms can be given \<^emph>\<open>simple types\<close>:\<close>

datatype 'a Simple_Type =
    Atom 'a  ("\<^bold>\<lbrace> _ \<^bold>\<rbrace>" [100] 100)
  | To "'a Simple_Type" "'a Simple_Type" (infixr "\<^bold>\<Rightarrow>" 70)

inductive
Simply_Typed_SKComb
   :: "SKComb \<Rightarrow> 'a Simple_Type \<Rightarrow> bool" (infix "\<Colon>" 65)
where
    S_type : "S \<Colon> (\<phi> \<^bold>\<Rightarrow> \<psi> \<^bold>\<Rightarrow> \<chi>) \<^bold>\<Rightarrow> (\<phi> \<^bold>\<Rightarrow> \<psi>) \<^bold>\<Rightarrow> \<phi> \<^bold>\<Rightarrow> \<chi>"
  | K_type : "K \<Colon> \<phi> \<^bold>\<Rightarrow> \<psi> \<^bold>\<Rightarrow> \<phi>"
  | Application_type : "E\<^sub>1 \<Colon> \<phi> \<^bold>\<Rightarrow> \<psi> \<Longrightarrow> E\<^sub>2 \<Colon> \<phi> \<Longrightarrow> E\<^sub>1 \<cdot> E\<^sub>2 \<Colon> \<psi>"

subsection \<open>Lambda Abstraction\<close>

text \<open>Here a simple embedding of the \<open>\<lambda>\<close>-calculus into combinator logic is
      presented.\<close>

text \<open>The SKI embedding below is originally due to David Turner
      @{cite turnerAnotherAlgorithmBracket1979}.\<close>

text \<open>Abstraction over combinators where the abstracted variable is not free
      are simplified using the \<^term>\<open>K\<close> combinator.\<close>

primrec free_variables_in_SKComb :: "SKComb \<Rightarrow> Var set" ("free\<^sub>S\<^sub>K")
  where
    "free\<^sub>S\<^sub>K (\<^bold>\<langle>x\<^bold>\<rangle>) = {x}"
  | "free\<^sub>S\<^sub>K S = {}"
  | "free\<^sub>S\<^sub>K K = {}"
  | "free\<^sub>S\<^sub>K (E\<^sub>1 \<cdot> E\<^sub>2) = (free\<^sub>S\<^sub>K E\<^sub>1) \<union> (free\<^sub>S\<^sub>K E\<^sub>2)"

primrec Turner_Abstraction
  :: "Var \<Rightarrow> SKComb \<Rightarrow> SKComb" ("\<^bold>\<lambda>_. _" [90,90] 90)
  where
    abst_S: "\<^bold>\<lambda>x. S = K \<cdot> S"
  | abst_K: "\<^bold>\<lambda>x. K = K \<cdot> K"
  | abst_var: "\<^bold>\<lambda>x. \<^bold>\<langle>y\<^bold>\<rangle> = (if x = y then S \<cdot> K \<cdot> K else K \<cdot> \<^bold>\<langle>y\<^bold>\<rangle>)"
  | abst_app:
     "\<^bold>\<lambda> x. (E\<^sub>1 \<cdot> E\<^sub>2) = (if (x \<in> free\<^sub>S\<^sub>K (E\<^sub>1 \<cdot> E\<^sub>2))
                       then S \<cdot> (\<^bold>\<lambda> x. E\<^sub>1) \<cdot> (\<^bold>\<lambda> x. E\<^sub>2)
                       else K \<cdot> (E\<^sub>1 \<cdot> E\<^sub>2))"

subsection \<open>Common Combinators\<close>

text \<open>This section presents various common combinators.  Some combinators are
      simple enough to express in using \<^term>\<open>S\<close> and \<^term>\<open>K\<close>, however others
      are more easily expressed using \<open>\<lambda>\<close>-abstraction.
      TODO: Cite Haskell Curry's PhD thesis.\<close>

text \<open>A useful lemma is the type of the \<^emph>\<open>identity\<close> combinator, designated by
      \<^emph>\<open>I\<close> in the literature.\<close>

lemma Identity_type: "S \<cdot> K \<cdot> K \<Colon> \<phi> \<^bold>\<Rightarrow> \<phi>"
  using K_type S_type Application_type by blast

text \<open>Another significant combinator is the \<open>C\<close> combinator, which
      corresponds to \<^verbatim>\<open>flip\<close> in Haskell.\<close>

lemma C_type:
  "\<^bold>\<lambda> \<X> 1. \<^bold>\<lambda> \<X> 2. \<^bold>\<lambda> \<X> 3. (\<^bold>\<langle>\<X> 1\<^bold>\<rangle> \<cdot> \<^bold>\<langle>\<X> 3\<^bold>\<rangle> \<cdot> \<^bold>\<langle>\<X> 2\<^bold>\<rangle>)
       \<Colon> (\<phi> \<^bold>\<Rightarrow> \<psi> \<^bold>\<Rightarrow> \<chi>) \<^bold>\<Rightarrow> \<psi> \<^bold>\<Rightarrow> \<phi> \<^bold>\<Rightarrow> \<chi>"
  by (simp, meson Identity_type Simply_Typed_SKComb.simps)

text \<open>Haskell also has a function \<^verbatim>\<open>(.)\<close>, which is referred to as the \<^emph>\<open>B\<close>
      combinator.\<close>

lemma B_type: "S \<cdot> (K \<cdot> S) \<cdot> K \<Colon> (\<psi> \<^bold>\<Rightarrow> \<chi>) \<^bold>\<Rightarrow> (\<phi> \<^bold>\<Rightarrow> \<psi>) \<^bold>\<Rightarrow> \<phi> \<^bold>\<Rightarrow> \<chi>"
  by (meson Simply_Typed_SKComb.simps)

text \<open>The final combinator given is the \<^emph>\<open>B\<close> combinator.\<close>

lemma W_type:
  "\<^bold>\<lambda> \<X> 1. \<^bold>\<lambda> \<X> 2. (\<^bold>\<langle>\<X> 1\<^bold>\<rangle> \<cdot> \<^bold>\<langle>\<X> 2\<^bold>\<rangle> \<cdot> \<^bold>\<langle>\<X> 2\<^bold>\<rangle>) \<Colon> (\<phi> \<^bold>\<Rightarrow> \<phi> \<^bold>\<Rightarrow> \<chi>) \<^bold>\<Rightarrow> \<phi> \<^bold>\<Rightarrow> \<chi>"
  by (simp, meson Identity_type Simply_Typed_SKComb.simps)

subsection \<open> The Curry Howard Correspondence \<close>

text \<open> The (polymorphic) typing for a combinator \<^term>\<open>X\<close> is given by the
       relation \<^term>\<open>X \<Colon> \<phi>\<close>. \<close>

text \<open> Combinator types form an instance of implicational intuitionistic logic. \<close>

interpretation Combinator_implication_logic:
  implication_logic "\<lambda> \<phi>. \<exists> X. X \<Colon> \<phi>" "(\<^bold>\<Rightarrow>)"
proof qed (meson Simply_Typed_SKComb.intros)+

text \<open> The implicational intuitionistic logic generated by combinator logic is \<^emph>\<open>free\<close> in the
       following sense: If \<^term>\<open>X \<Colon> \<phi>\<close> holds for some combinator \<^term>\<open>X\<close>
       then \<^term>\<open>\<phi>\<close> may be interpreted as logical consequence in any given
       implicational intuitionistic logic instance. \<close>

text \<open> The fact that any valid type in combinator logic may be interpreted in
       implicational intuitionistic logic is a form of the \<^emph>\<open>Curry-Howard correspondence\<close>. TODO: Cite \<close>

primrec (in implication_logic) Simple_Type_interpretation
                           :: "'a Simple_Type \<Rightarrow> 'a" ("\<^bold>\<lparr> _ \<^bold>\<rparr>" [50]) where
     "\<^bold>\<lparr> Atom p \<^bold>\<rparr> = p"
   | "\<^bold>\<lparr> \<phi> \<^bold>\<Rightarrow> \<psi> \<^bold>\<rparr> = \<^bold>\<lparr> \<phi> \<^bold>\<rparr> \<rightarrow> \<^bold>\<lparr> \<psi> \<^bold>\<rparr>"

lemma (in implication_logic) Curry_Howard_correspondence:
  "X \<Colon> \<phi> \<Longrightarrow> \<turnstile> \<^bold>\<lparr> \<phi> \<^bold>\<rparr>"
  by (induct rule: Simply_Typed_SKComb.induct,
      (simp add: axiom_k axiom_s modus_ponens)+)

end


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

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

datatype Nat = Z | S "Nat"

fun le :: "Nat => Nat => bool" where
  "le (Z) y = True"
| "le (S z) (Z) = False"
| "le (S z) (S x2) = le z x2"

fun lmerge :: "Nat list => Nat list => Nat list" where
  "lmerge (nil2) y = y"
| "lmerge (cons2 z x2) (nil2) = cons2 z x2"
| "lmerge (cons2 z x2) (cons2 x3 x4) =
     (if le z x3 then cons2 z (lmerge x2 (cons2 x3 x4)) else
        cons2 x3 (lmerge (cons2 z x2) x4))"

fun pairwise :: "(Nat list) list => (Nat list) list" where
  "pairwise (nil2) = nil2"
| "pairwise (cons2 xs (nil2)) = cons2 xs (nil2)"
| "pairwise (cons2 xs (cons2 ys xss)) =
     cons2 (lmerge xs ys) (pairwise xss)"

(*fun did not finish the proof*)
function mergingbu2 :: "(Nat list) list => Nat list" where
  "mergingbu2 (nil2) = nil2"
| "mergingbu2 (cons2 xs (nil2)) = xs"
| "mergingbu2 (cons2 xs (cons2 z x2)) =
     mergingbu2 (pairwise (cons2 xs (cons2 z x2)))"
  by pat_completeness auto

fun risers :: "Nat list => (Nat list) list" where
  "risers (nil2) = nil2"
| "risers (cons2 y (nil2)) = cons2 (cons2 y (nil2)) (nil2)"
| "risers (cons2 y (cons2 y2 xs)) =
     (if le y y2 then
        (case risers (cons2 y2 xs) of
           nil2 => nil2
           | cons2 ys yss => cons2 (cons2 y ys) yss)
        else
        cons2 (cons2 y (nil2)) (risers (cons2 y2 xs)))"

fun msortbu2 :: "Nat list => Nat list" where
  "msortbu2 x = mergingbu2 (risers x)"

fun insert :: "Nat => Nat list => Nat list" where
  "insert x (nil2) = cons2 x (nil2)"
| "insert x (cons2 z xs) =
     (if le x z then cons2 x (cons2 z xs) else cons2 z (insert x xs))"

fun isort :: "Nat list => Nat list" where
  "isort (nil2) = nil2"
| "isort (cons2 y xs) = insert y (isort xs)"

theorem property0 :
  "((msortbu2 xs) = (isort xs))"
  oops

end


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

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

datatype Nat = Z | S "Nat"

datatype Tree = TNode "Tree" "Nat" "Tree" | TNil

fun le :: "Nat => Nat => bool" where
"le (Z) y = True"
| "le (S z) (Z) = False"
| "le (S z) (S x2) = le z x2"

fun insert :: "Nat => Nat list => Nat list" where
"insert x (nil2) = cons2 x (nil2)"
| "insert x (cons2 z xs) =
     (if le x z then cons2 x (cons2 z xs) else cons2 z (insert x xs))"

fun isort :: "Nat list => Nat list" where
"isort (nil2) = nil2"
| "isort (cons2 y xs) = insert y (isort xs)"

fun flatten :: "Tree => Nat list => Nat list" where
"flatten (TNode q z r) y = flatten q (cons2 z (flatten r y))"
| "flatten (TNil) y = y"

fun add :: "Nat => Tree => Tree" where
"add x (TNode q z r) =
   (if le x z then TNode (add x q) z r else TNode q z (add x r))"
| "add x (TNil) = TNode TNil x TNil"

fun toTree :: "Nat list => Tree" where
"toTree (nil2) = TNil"
| "toTree (cons2 y xs) = add y (toTree xs)"

fun tsort :: "Nat list => Nat list" where
"tsort x = flatten (toTree x) (nil2)"

theorem property0 :
  "((tsort xs) = (isort xs))"
  oops

end


theory Inductive_Demo
imports Main
begin

subsection "Inductive definition of the even numbers"

inductive ev :: "nat \<Rightarrow> bool" where
ev0: "ev 0" |
evSS: "ev n \<Longrightarrow> ev (Suc(Suc n))"

thm ev0 evSS
thm ev.intros

text \<open>Using the introduction rules:\<close>

lemma "ev (Suc(Suc(Suc(Suc 0))))"
apply(rule evSS)
apply(rule evSS)
apply(rule ev0)
done

thm evSS[OF evSS[OF ev0]]

text \<open>A recursive definition of evenness:\<close>

fun evn :: "nat \<Rightarrow> bool" where
"evn 0 = True" |
"evn (Suc 0) = False" |
"evn (Suc(Suc n)) = evn n"

text \<open>A simple example of rule induction:\<close>

lemma "ev n \<Longrightarrow> evn n"
apply(induction rule: ev.induct)
 apply(simp)
apply(simp)
done

text \<open>An induction on the computation of @{const evn}:\<close>

lemma "evn n \<Longrightarrow> ev n"
apply(induction n rule: evn.induct)
  apply (simp add: ev0)
 apply simp
apply(simp add: evSS)
done

text \<open>No problem with termination
because the premises are always smaller than the conclusion:\<close>

declare ev.intros[simp,intro]

text \<open>A shorter proof:\<close>

lemma "evn n \<Longrightarrow> ev n"
apply(induction n rule: evn.induct)
apply(simp_all)
done

text \<open>The power of "arith":\<close>

lemma "ev n \<Longrightarrow> \<exists>k. n = 2*k"
apply(induction rule: ev.induct)
 apply(simp)
apply arith
done

subsection "Inductive definition of the reflexive transitive closure"

inductive
  star :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
for r where
refl:  "star r x x" |
step:  "r x y \<Longrightarrow> star r y z \<Longrightarrow> star r x z"

lemma star_trans:
  "star r x y \<Longrightarrow> star r y z \<Longrightarrow> star r x z"
apply(induction rule: star.induct)
apply(assumption)
apply(rename_tac u x y)
apply(metis step)
done

end


theory Ex01
imports Main
begin

(* Exercise 1.1 *)

value "2 + (2::nat)"
value "(2::nat) * (5 + 3)"
value "(3::nat) * 4 - 2 * (7 + 1)"

(* Exercise 1.2 *)

lemma nat_add_comm: "(a::nat) + b = b + a"
  by auto

lemma nat_add_assoc:
  fixes a b c :: nat
  shows "(a + b) + c = a + (b + c)"
  by auto

lemma
  fixes a b c :: nat
  shows "(a + b) + c = a + (c + b)"
  by auto

(* Exercise 1.3 *)

fun count :: "'a list \<Rightarrow> 'a \<Rightarrow> nat" where
  "count []     e = 0"
| "count (x#xs) e = (if x = e then 1 + count xs e else count xs e)"

value "count [] 1"
value "count [1::nat,2,4,5,2,3,1,3,4,1] 1"

theorem "count xs x \<le> length xs"
  apply(induction xs)
  apply(auto)
  done

(* Exercise 1.4 *)

fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
  "snoc []     e = e # []"
| "snoc (x#xs) e = x # snoc xs e"

value "snoc [] 2"
value "snoc [1,2,3] (4::int)"

lemma "snoc [] e = [e]"
  by auto

fun reverse :: "'a list \<Rightarrow> 'a list" where
  "reverse []     = []"
| "reverse (x#xs) = snoc (reverse xs) x"

value "reverse []"
value "reverse [1,2,4,5,3::int]"
value "reverse [a,b,c]"

lemma "reverse [a,b,c] = [c,b,a]"
  by auto

lemma aux: "reverse (snoc xs x) = (x # (reverse xs))"
  apply(induction xs)
  apply(auto)
  done

theorem "reverse (reverse xs) = xs"
  apply(induction xs)
  apply(auto simp: aux)
  done

(* Homework 1.1 *)

fun pow2 :: "nat \<Rightarrow> nat" where
  "pow2 0       = 1"
| "pow2 (Suc n) = 2 * pow2 n"

value "pow2 3 = 8"

(*
   Informal proof of "pow2 (n + m) = pow2 n * pow2 m"

   We use induction over n.
   Base case n=0:
   pow2 (0 + m) = pow2 0 * pow2 m
 =  < 0 + m = m >
   pow2 m = pow2 0 * pow2 m
 =  < pow2 0 = 1 >
   pow2 m = 1 * pow2 m
 =  < 1 * m = m, in which [m:=pow2 m] >
   pow2 m = pow2 m

   Inductive case:
   (IH): pow2 (n + m) = pow2 n * pow2 m

   pow2 ((Suc n) + m) = pow2 (Suc n) * pow2 m
 =  < pow2 (Suc n) = 2 * pow2 n >
   pow2 ((Suc n) + m) = (2 * pow2 n) * pow2 m >
 =  < (a*b)*c = a*(b*c), in which [a,b,c:=2,pow2 n, pow2 m] >
   pow2 ((Suc n) + m) = 2 * (pow2 n * pow2 m)
 =  < Using Inductive Hypothesis >
   pow2 ((Suc n) + m) = 2 * pow2 (n + m)
 =  < (Suc n) + m = Suc(n + m) >
   pow2 (Suc(n + m)) = 2 * pow2 (n + m)
 =  < pow2 (Suc n() = 2 * pow2 n, in which [n:=n+m] >
   2 * pow2 (n + m) = 2 * pow2 (n + m)

*)

lemma "pow2 (n + m) = pow2 n * pow2 m"
  apply(induction n)
  apply(auto)
  done

(* Homework 1.2 *)

fun double :: "'a list \<Rightarrow> 'a list" where
  "double []       = []"
| "double (x # xs) = x # x # double xs"

value "double []"
value "double [a,b,c,d]"

lemma aux2: "double(xs @ [x]) = double xs @ [x,x]"
  apply(induction xs)
  apply(auto)
  done

lemma rev_double: "rev(double xs) = double(rev xs)"
  apply(induction xs)
  apply(auto simp: aux2)
  done

end


theory sumOfFirstN
  imports Main
begin

theorem sum_of_first_n:
  shows "(∑i::nat = 0..n. i) = (n * (n + 1)) div 2" (is "?P n")
proof (induction n)
  case 0
  show ?case by simp
next
  case (Suc n)
  thus ?case by simp
qed

end


theory Simplicial_complex
  imports
    Boolean_functions
begin

section\<open>Simplicial Complexes\<close>

lemma Pow_singleton: "Pow {a} = {{},{a}}" by auto

lemma Pow_pair: "Pow {a,b} = {{},{a},{b},{a,b}}" by auto

locale simplicial_complex
  = fixes n::"nat"
begin

text\<open>A simplex (in $n$ vertexes) is any set of vertexes,
  including the empty set.\<close>

definition simplices :: "nat set set"
  where "simplices = Pow {0..<n}"

lemma "{} \<in> simplices"
  unfolding simplices_def by simp

lemma "{0..<n} \<in> simplices"
  unfolding simplices_def by simp

text\<open>A simplicial complex (in $n$ vertexes) is a collection of
  sets of vertexes such that every subset of
  a set of vertexes also belongs to the simplicial complex.\<close>

definition simplicial_complex :: "nat set set => bool"
  where "simplicial_complex K \<equiv>  (\<forall>\<sigma>\<in>K. (\<sigma> \<in> simplices) \<and> (Pow \<sigma>) \<subseteq> K)"

lemma
  finite_simplicial_complex:
  assumes "simplicial_complex K"
  shows "finite K"
  by (metis assms finite_Pow_iff finite_atLeastLessThan rev_finite_subset simplices_def simplicial_complex_def subsetI)

lemma finite_simplices:
  assumes "simplicial_complex K"
  and "v \<in> K"
shows "finite v"
  using assms finite_simplex simplicial_complex.simplicial_complex_def by blast

definition simplicial_complex_set :: "nat set set set"
  where "simplicial_complex_set = (Collect simplicial_complex)"

lemma simplicial_complex_empty_set:
  fixes K::"nat set set"
  assumes k: "simplicial_complex K"
  shows "K = {} \<or> {} \<in> K" using k unfolding simplicial_complex_def Pow_def by auto

lemma
  simplicial_complex_monotone:
  fixes K::"nat set set"
  assumes k: "simplicial_complex K" and s: "s \<in> K" and rs: "r \<subseteq> s"
  shows "r \<in> K"
  using k rs s
  unfolding simplicial_complex_def Pow_def by auto

text\<open>One example of simplicial complex with four simplices.\<close>

lemma
  assumes three: "(3::nat) < n"
  shows "simplicial_complex {{},{0},{1},{2},{3}}"
  apply (simp_all add: Pow_singleton simplicial_complex_def simplices_def)
  using Suc_lessD three by presburger

lemma "\<not> simplicial_complex {{0,1},{1}}"
  by (simp add: Pow_pair simplicial_complex_def)

text\<open>Another example of simplicial complex with five simplices.\<close>

lemma
  assumes three: "(3::nat) < n"
  shows "simplicial_complex {{},{0},{1},{2},{3},{0,1}}"
  apply (simp add: Pow_pair Pow_singleton simplicial_complex_def simplices_def)
  using Suc_lessD three by presburger

text\<open>Another example of simplicial complex with ten simplices.\<close>

lemma
  assumes three: "(3::nat) < n"
  shows "simplicial_complex
    {{2,3},{1,3},{1,2},{0,3},{0,2},{3},{2},{1},{0},{}}"
  apply (simp add: Pow_pair Pow_singleton simplicial_complex_def simplices_def)
  using Suc_lessD three by presburger

end

section\<open>Simplicial complex induced by a monotone Boolean function\<close>

text\<open>In this section we introduce the definition of the
  simplicial complex induced by a monotone Boolean function,
  following the definition in Scoville~\<^cite>\<open>\<open>Def. 6.9\<close> in "SC19"\<close>.\<close>

text\<open>First we introduce the set of tuples for which
  a Boolean function is @{term False}.\<close>

definition ceros_of_boolean_input :: "bool vec => nat set"
  where "ceros_of_boolean_input v = {x. x < dim_vec v \<and> vec_index v x = False}"

lemma
  ceros_of_boolean_input_l_dim:
  assumes a: "a \<in> ceros_of_boolean_input v"
  shows "a < dim_vec v"
  using a unfolding ceros_of_boolean_input_def by simp

lemma "ceros_of_boolean_input v = {x. x < dim_vec v \<and> \<not> vec_index v x}"
  unfolding ceros_of_boolean_input_def by simp

lemma
  ceros_of_boolean_input_complementary:
  shows "ceros_of_boolean_input v = {x. x < dim_vec v} - {x. vec_index v x}"
  unfolding ceros_of_boolean_input_def by auto

(*lemma ceros_in_UNIV: "ceros_of_boolean_input f \<subseteq> (UNIV::nat set)"
  using subset_UNIV .*)

lemma monotone_ceros_of_boolean_input:
  fixes r and s::"bool vec"
  assumes r_le_s: "r \<le> s"
  shows "ceros_of_boolean_input s \<subseteq> ceros_of_boolean_input r"
proof (intro subsetI, unfold ceros_of_boolean_input_def, intro CollectI, rule conjI)
  fix x
  assume "x \<in> {x. x < dim_vec s \<and> vec_index s x = False}"
  hence xl: "x < dim_vec s" and nr: "vec_index s x = False" by simp_all
  show "vec_index r x = False"
    using r_le_s nr xl unfolding less_eq_vec_def
    by auto
  show "x < dim_vec r"
  using r_le_s xl unfolding less_eq_vec_def
    by auto
qed

text\<open>We introduce here instantiations of the typ\<open>bool\<close>
  type for the type classes class\<open>zero\<close> and class\<open>one\<close>
  that will simplify notation at some points:\<close>

instantiation bool :: "{zero,one}"
begin

definition
 zero_bool_def: "0 == False"

definition
 one_bool_def: "1 == True"

instance  proof  qed

end

text\<open>Definition of the simplicial complex induced
  by a Boolean function \<open>f\<close> in dimension \<open>n\<close>.\<close>

definition
  simplicial_complex_induced_by_monotone_boolean_function
    :: "nat => (bool vec => bool) => nat set set"
  where "simplicial_complex_induced_by_monotone_boolean_function n f =
        {y. \<exists>x. dim_vec x = n \<and> f x \<and> ceros_of_boolean_input x = y}"

text\<open>The simplicial complex induced by a Boolean function
  is a subset of the powerset of the set of vertexes.\<close>

lemma
  simplicial_complex_induced_by_monotone_boolean_function_subset:
  "simplicial_complex_induced_by_monotone_boolean_function n (v::bool vec => bool)
    \<subseteq> Pow (({0..n}::nat set))"
  using ceros_of_boolean_input_def
   simplicial_complex_induced_by_monotone_boolean_function_def
  by force

corollary
  "simplicial_complex_induced_by_monotone_boolean_function n (v::bool vec => bool)
    \<subseteq> Pow ((UNIV::nat set))" by simp

text\<open>The simplicial complex induced by a
  monotone Boolean function is a simplicial complex.
  This result is proven in Scoville as part of the
  proof of Proposition 6.16~\<^cite>\<open>\<open>Prop. 6.16\<close> in "SC19"\<close>.\<close>

context simplicial_complex
begin

lemma
  monotone_bool_fun_induces_simplicial_complex:
  assumes mon: "boolean_functions.monotone_bool_fun n f"
  shows "simplicial_complex (simplicial_complex_induced_by_monotone_boolean_function n f)"
  unfolding simplicial_complex_def
proof (rule, unfold simplicial_complex_induced_by_monotone_boolean_function_def, safe)
    fix \<sigma> :: "nat set" and x :: "bool vec"
    assume fx: "f x" and dim_vec_x: "n = dim_vec x"
    show "ceros_of_boolean_input x \<in> simplicial_complex.simplices (dim_vec x)"
      using ceros_of_boolean_input_def dim_vec_x simplices_def by force
  next
    fix \<sigma> :: "nat set" and x :: "bool vec" and \<tau> :: "nat set"
    assume fx: "f x" and dim_vec_x: "n = dim_vec x" and tau_def: "\<tau> \<subseteq> ceros_of_boolean_input x"
    show "\<exists>xb. dim_vec xb = dim_vec x \<and> f xb \<and> ceros_of_boolean_input xb = \<tau>"
    proof (rule exI [of _ "vec n (\<lambda>i. if i \<in> \<tau> then False else True)"], intro conjI)
     show "dim_vec (vec n (\<lambda>i. if i \<in> \<tau> then False else True)) = dim_vec x"
      unfolding dim_vec using dim_vec_x .
     from mon have mono: "mono_on (carrier_vec n) f"
      unfolding boolean_functions.monotone_bool_fun_def .
     show "f (vec n (\<lambda>i. if i \<in> \<tau> then False else True))"
     proof -
      have "f x \<le> f (vec n (\<lambda>i. if i \<in> \<tau> then False else True))"
      proof (rule mono_onD [OF mono])
        show "x \<in> carrier_vec n" using dim_vec_x by simp
        show "vec n (\<lambda>i. if i \<in> \<tau> then False else True) \<in> carrier_vec n" by simp
        show "x \<le> vec n (\<lambda>i. if i \<in> \<tau> then False else True)"
          using tau_def dim_vec_x unfolding ceros_of_boolean_input_def
          using less_eq_vec_def by fastforce
      qed
      thus ?thesis using fx by simp
    qed
    show "ceros_of_boolean_input (vec n (\<lambda>i. if i \<in> \<tau> then False else True)) = \<tau>"
      using \<open>\<tau> \<subseteq> ceros_of_boolean_input x\<close> ceros_of_boolean_input_def dim_vec_x by auto
  qed
qed

end

text\<open>Example 6.10 in Scoville, the threshold function
  for $2$ in dimension $4$ (with vertexes $0$,$1$,$2$,$3$)\<close>

definition bool_fun_threshold_2_3 :: "bool vec => bool"
  where "bool_fun_threshold_2_3 = (\<lambda>v. if 2 \<le> count_true v then True else False)"

lemma set_list_four: shows "{0..<4} = set [0,1,2,3::nat]" by auto

lemma comp_fun_commute_lambda:
  "comp_fun_commute_on UNIV ((+)
  \<circ> (\<lambda>i. if vec 4 f $ i then 1 else (0::nat)))"
  unfolding comp_fun_commute_on_def by auto

lemma "bool_fun_threshold_2_3
          (vec 4 (\<lambda>i. if i = 0 \<or> i = 1 then True else False)) = True"
  unfolding bool_fun_threshold_2_3_def
  unfolding count_true_def
  unfolding dim_vec
  unfolding sum.eq_fold
  using index_vec [of _ 4]
  apply auto
  unfolding set_list_four
  unfolding comp_fun_commute_on.fold_set_fold_remdups [OF comp_fun_commute_lambda, simplified]
  by simp

lemma
  "0 \<notin> ceros_of_boolean_input (vec 4 (\<lambda>i. if i = 0 \<or> i = 1 then True else False))"
  and "1 \<notin> ceros_of_boolean_input (vec 4 (\<lambda>i. if i = 0 \<or> i = 1 then True else False))"
  and "2 \<in> ceros_of_boolean_input (vec 4 (\<lambda>i. if i = 0 \<or> i = 1 then True else False))"
  and "3 \<in> ceros_of_boolean_input (vec 4 (\<lambda>i. if i = 0 \<or> i = 1 then True else False))"
  and "{2,3} \<subseteq> ceros_of_boolean_input (vec 4 (\<lambda>i. if i = 0 \<or> i = 1 then True else False))"
  unfolding ceros_of_boolean_input_def by simp_all

lemma "bool_fun_threshold_2_3 (vec 4 (\<lambda>i. if i = 3 then True else False)) = False"
  unfolding bool_fun_threshold_2_3_def
  unfolding count_true_def
  unfolding dim_vec
  unfolding sum.eq_fold
  using index_vec [of _ 4]
  apply auto
  unfolding set_list_four
  unfolding comp_fun_commute_on.fold_set_fold_remdups [OF comp_fun_commute_lambda, simplified]
  by simp

lemma "bool_fun_threshold_2_3 (vec 4 (\<lambda>i. if i = 0 then False else True))"
  unfolding bool_fun_threshold_2_3_def
  unfolding count_true_def
  unfolding dim_vec
  unfolding sum.eq_fold
  using index_vec [of _ 4]
  apply auto
  unfolding set_list_four
  unfolding comp_fun_commute_on.fold_set_fold_remdups [OF comp_fun_commute_lambda, simplified]
  by simp

section\<open>The simplicial complex induced by the threshold function\<close>

lemma
  empty_set_in_simplicial_complex_induced:
  "{} \<in> simplicial_complex_induced_by_monotone_boolean_function 4 bool_fun_threshold_2_3"
  unfolding simplicial_complex_induced_by_monotone_boolean_function_def
  unfolding bool_fun_threshold_2_3_def
  apply rule
  apply (rule exI [of _ "vec 4 (\<lambda>x. True)"])
  unfolding count_true_def ceros_of_boolean_input_def by auto

lemma singleton_in_simplicial_complex_induced:
  assumes x: "x < 4"
  shows "{x} \<in> simplicial_complex_induced_by_monotone_boolean_function 4 bool_fun_threshold_2_3"
  (is "?A \<in> simplicial_complex_induced_by_monotone_boolean_function 4 bool_fun_threshold_2_3")
proof (unfold simplicial_complex_induced_by_monotone_boolean_function_def, rule,
      rule exI [of _ "vec 4 (\<lambda>i. if i \<in> ?A then False else True)"],
      intro conjI)
  show "dim_vec (vec 4 (\<lambda>i. if i \<in> {x} then False else True)) = 4" by simp
  show "bool_fun_threshold_2_3 (vec 4 (\<lambda>i. if i \<in> ?A then False else True))"
    unfolding bool_fun_threshold_2_3_def
    unfolding count_true_def
    unfolding dim_vec
    unfolding sum.eq_fold
    using index_vec [of _ 4]
    apply auto
    unfolding set_list_four
    unfolding comp_fun_commute_on.fold_set_fold_remdups [OF comp_fun_commute_lambda, simplified]
    by simp
  show "ceros_of_boolean_input (vec 4 (\<lambda>i. if i \<in> ?A then False else True)) = ?A"
    unfolding ceros_of_boolean_input_def using x by auto
qed

lemma pair_in_simplicial_complex_induced:
  assumes x: "x < 4" and y: "y < 4"
  shows "{x,y} \<in> simplicial_complex_induced_by_monotone_boolean_function 4 bool_fun_threshold_2_3"
  (is "?A \<in> simplicial_complex_induced_by_monotone_boolean_function 4 bool_fun_threshold_2_3")
proof (unfold simplicial_complex_induced_by_monotone_boolean_function_def, rule,
      rule exI [of _ "vec 4 (\<lambda>i. if i \<in> ?A then False else True)"],
      intro conjI)
  show "dim_vec (vec 4 (\<lambda>i. if i \<in> {x, y} then False else True)) = 4" by simp
  show "bool_fun_threshold_2_3 (vec 4 (\<lambda>i. if i \<in> ?A then False else True))"
    unfolding bool_fun_threshold_2_3_def
    unfolding count_true_def
    unfolding dim_vec
    unfolding sum.eq_fold
    using index_vec [of _ 4]
    apply auto
    unfolding set_list_four
    unfolding comp_fun_commute_on.fold_set_fold_remdups [OF comp_fun_commute_lambda, simplified]
    by simp
  show "ceros_of_boolean_input (vec 4 (\<lambda>i. if i \<in> ?A then False else True)) = ?A"
    unfolding ceros_of_boolean_input_def using x y by auto
qed

lemma finite_False: "finite {x. x < dim_vec a \<and> vec_index (a::bool vec) x = False}" by auto

lemma finite_True: "finite {x. x < dim_vec a \<and> vec_index (a::bool vec) x = True}" by auto

lemma UNIV_disjoint: "{x. x < dim_vec a \<and> vec_index (a::bool vec) x = True}
  \<inter> {x. x < dim_vec a \<and> vec_index (a::bool vec) x = False} = {}"
  by auto

lemma UNIV_union: "{x. x < dim_vec a \<and> vec_index (a::bool vec) x = True}
  \<union> {x. x < dim_vec a \<and> vec_index (a::bool vec) x = False} = {x. x < dim_vec a}"
  by auto

lemma card_UNIV_union:
  "card {x. x < dim_vec a \<and> vec_index (a::bool vec) x = True}
  + card {x. x < dim_vec a \<and> vec_index (a::bool vec) x = False}
  = card {x. x < dim_vec a}"
  (is "card ?true + card ?false = _")
proof -
  have "card ?true + card ?false = card (?true \<union> ?false) + card (?true \<inter> ?false)"
    using card_Un_Int [OF finite_True [of a] finite_False [of a]] .
  also have "... = card {x. x < dim_vec a}"
    unfolding UNIV_union UNIV_disjoint by simp
  finally show ?thesis by simp
qed

lemma card_complementary:
  "card (ceros_of_boolean_input v)
    + card {x. x < (dim_vec v) \<and> (vec_index v x = True)} = (dim_vec v)"
  unfolding ceros_of_boolean_input_def
  using card_UNIV_union [of v] by simp

corollary
  card_ceros_of_boolean_input:
  shows "card (ceros_of_boolean_input a) \<le> dim_vec a"
 using card_complementary [of a] by simp

lemma
  vec_fun:
  assumes "v \<in> carrier_vec n"
  shows "\<exists>f. v = vec n f" using assms unfolding carrier_vec_def by fastforce

corollary
  assumes "dim_vec v = n"
  shows "\<exists>f. v = vec n f"
  using carrier_vecI [OF assms] unfolding carrier_vec_def by fastforce

lemma
  vec_l_eq:
  assumes "i < n"
  shows "vec (Suc n) f $ i = vec n f $ i"
  by (simp add: assms less_SucI)

lemma
  card_boolean_function:
  assumes d: "v \<in> carrier_vec n"
  shows "card {x. x < n  \<and> v $ x = True} = (\<Sum>i = 0..<n. if v $ i then 1 else (0::nat))"
using d proof (induction n arbitrary: v rule: nat_less_induct)
  case (1 n)
  assume hyp: "\<forall>m<n. \<forall>x. x \<in> carrier_vec m \<longrightarrow>
      card {xa. xa < m \<and> x $ xa = True} = (\<Sum>i = 0..<m. if x $ i then 1 else 0)"
    and d: "v \<in> carrier_vec n"
  show "card {x. x < n \<and> v $ x = True} = (\<Sum>i = 0..<n. if v $ i then 1 else 0)"
  using d proof (cases n)
    case 0
    then show ?thesis by simp
  next
    case (Suc m)
    assume v: "v \<in> carrier_vec n"
    obtain f :: "nat => bool" where v_f: "v = vec n f" using vec_fun [OF v] by auto
    have "card {x. x < m \<and> (vec m f) $ x = True} = (\<Sum>i = 0..<m. if (vec m f) $ i then 1 else 0)"
      using hyp v Suc by simp
    show ?thesis unfolding v_f unfolding Suc
    proof (cases "vec (Suc m) f $ m = True")
      case True
      have one: "{x. x < Suc m \<and> vec (Suc m) f $ x = True} =
          ({x. x < m \<and> vec (Suc m) f $ x = True} \<union> {x. x = m \<and> (vec (Suc m) f) $ x = True})"
        by auto
      have two: "disjnt {x. x < m \<and> vec (Suc m) f $ x = True} {x. x = m \<and> (vec (Suc m) f) $ x = True}"
        using disjnt_iff by blast
      have "card {x. x < Suc m \<and> vec (Suc m) f $ x = True}
            = card {x. x < m \<and> (vec (Suc m) f) $ x = True} + card {x. x = m \<and> (vec (Suc m) f) $ x = True}"
        unfolding one
        by (rule card_Un_disjnt [OF _ _ two], simp_all)
      also have "... = card {x. x < m \<and> (vec  m f) $ x = True} + 1"
      proof -
        have one: "{x. x < m \<and> vec (Suc m) f $ x = True} = {x. x < m \<and> vec m f $ x = True}"
          using vec_l_eq [of _ m] by auto
        have eq: "{x. x = m \<and> vec (Suc m) f $ x = True} = {m}" using True by auto
        hence two: "card {x. x = m \<and> vec (Suc m) f $ x = True} = 1" by simp
        show ?thesis using one two by simp
      qed
      finally have lhs: "card {x. x < Suc m \<and> vec (Suc m) f $ x = True} = card {x. x < m \<and> vec m f $ x = True} + 1" .
      have "(\<Sum>i = 0..<Suc m. if vec (Suc m) f $ i then 1 else 0) =
           (\<Sum>i = 0..<m. if vec (Suc m) f $ i then 1 else 0) + (if vec (Suc m) f $ m then 1 else 0)"
        by simp
      also have "... = (\<Sum>i = 0..<m. if vec m f $ i then 1 else 0) + 1"
        using vec_l_eq [of _ m] True by simp
      finally have rhs: "(\<Sum>i = 0..<Suc m. if vec (Suc m) f $ i then 1 else 0) =
        (\<Sum>i = 0..<m. if vec m f $ i then 1 else 0) + 1" .
      show "card {x. x < Suc m \<and> vec (Suc m) f $ x = True} =
        (\<Sum>i = 0..<Suc m. if vec (Suc m) f $ i then 1 else 0)"
        unfolding lhs rhs using hyp Suc by simp
    next
      case False
      have one: "{x. x < Suc m \<and> vec (Suc m) f $ x = True} =
          ({x. x < m \<and> vec (Suc m) f $ x = True} \<union> {x. x = m \<and> (vec (Suc m) f) $ x = True})"
        by auto
      have two: "disjnt {x. x < m \<and> vec (Suc m) f $ x = True} {x. x = m \<and> (vec (Suc m) f) $ x = True}"
        using disjnt_iff by blast
      have "card {x. x < Suc m \<and> vec (Suc m) f $ x = True}
            = card {x. x < m \<and> (vec (Suc m) f) $ x = True} + card {x. x = m \<and> (vec (Suc m) f) $ x = True}"
        unfolding one
        by (rule card_Un_disjnt [OF _ _ two], simp_all)
      also have "... = card {x. x < m \<and> (vec  m f) $ x = True} + 0"
      proof -
        have one: "{x. x < m \<and> vec (Suc m) f $ x = True} = {x. x < m \<and> vec m f $ x = True}"
          using vec_l_eq [of _ m] by auto
        have eq: "{x. x = m \<and> vec (Suc m) f $ x = True} = {}" using False by auto
        hence two: "card {x. x = m \<and> vec (Suc m) f $ x = True} = 0" by simp
        show ?thesis using one two by simp
      qed
      finally have lhs: "card {x. x < Suc m \<and> vec (Suc m) f $ x = True} = card {x. x < m \<and> vec m f $ x = True} + 0" .
      have "(\<Sum>i = 0..<Suc m. if vec (Suc m) f $ i then 1 else 0) =
           (\<Sum>i = 0..<m. if vec (Suc m) f $ i then 1 else 0) + (if vec (Suc m) f $ m then 1 else 0)"
        by simp
      also have "... = (\<Sum>i = 0..<m. if vec m f $ i then 1 else 0)"
        using vec_l_eq [of _ m] False by simp
      finally have rhs: "(\<Sum>i = 0..<Suc m. if vec (Suc m) f $ i then 1 else 0) =
        (\<Sum>i = 0..<m. if vec m f $ i then 1 else 0)" .
      show "card {x. x < Suc m \<and> vec (Suc m) f $ x = True} =
        (\<Sum>i = 0..<Suc m. if vec (Suc m) f $ i then 1 else 0)"
        unfolding lhs rhs using hyp Suc by simp
    qed
  qed
qed

lemma card_ceros_count_UNIV:
  shows "card (ceros_of_boolean_input a) + count_true ((a::bool vec)) = dim_vec a"
  using card_complementary [of a]
  using card_boolean_function
  unfolding ceros_of_boolean_input_def
  unfolding count_true_def by simp

text\<open>We calculate the carrier set of the @{const ceros_of_boolean_input}
  function for dimensions $2$, $3$ and $4$.\<close>

text\<open>Vectors of dimension $2$.\<close>

lemma
  dim_vec_2_cases:
  assumes dx: "dim_vec x = 2"
  shows "(x $ 0 = x $ 1 = True) \<or> (x $ 0 = False \<and> x $ 1 = True)
       \<or> (x $ 0 = True \<and> x $ 1 = False) \<or> (x $ 0 = x $ 1 = False)"
  by auto

lemma tt_2: assumes dx: "dim_vec x = 2"
  and be: "x $ 0 = True \<and> x $ 1 = True"
  shows "ceros_of_boolean_input x = {}"
  using dx be unfolding ceros_of_boolean_input_def using less_2_cases by auto

lemma tf_2: assumes dx: "dim_vec x = 2"
  and be: "x $ 0 = True \<and> x $ 1 = False"
  shows "ceros_of_boolean_input x = {1}"
  using dx be unfolding ceros_of_boolean_input_def using less_2_cases by auto

lemma ft_2: assumes dx: "dim_vec x = 2"
  and be: "x $ 0 = False \<and> x $ 1 = True"
  shows "ceros_of_boolean_input x = {0}"
  using dx be unfolding ceros_of_boolean_input_def using less_2_cases by auto

lemma ff_2: assumes dx: "dim_vec x = 2"
  and be: "x $ 0 = False \<and> x $ 1 = False"
  shows "ceros_of_boolean_input x = {0,1}"
  using dx be unfolding ceros_of_boolean_input_def using less_2_cases by auto

lemma
  assumes dx: "dim_vec x = 2"
  shows "ceros_of_boolean_input x \<in> {{},{0},{1},{0,1}}"
  using dim_vec_2_cases [OF ]
  using tt_2 [OF dx] tf_2 [OF dx] ft_2 [OF dx] ff_2 [OF dx]
  by (metis insertCI)

text\<open>Vectors of dimension $3$.\<close>

lemma less_3_cases:
  assumes n: "n < 3" shows "n = 0 \<or> n = 1 \<or> n = (2::nat)"
  using n by linarith

lemma
  dim_vec_3_cases:
  assumes dx: "dim_vec x = 3"
  shows "(x $ 0 = x $ 1 = x $ 2 = False) \<or> (x $ 0 = x $ 1 = False \<and> x $ 2 = True)
       \<or> (x $ 0 = x $ 2 = False \<and> x $ 1 = True) \<or> (x $ 0 = False \<and> x $ 1 = x $ 2 = True)
       \<or> (x $ 0 = True \<and> x $ 1 = x $ 2 = False) \<or> (x $ 0 = x $ 2 = True \<and> x $ 1 = False)
       \<or> (x $ 0 = x $ 1 = True \<and> x $ 2 = False) \<or> (x $ 0 = x $ 1 = x $ 2 = True)"
  by auto

lemma fff_3: assumes dx: "dim_vec x = 3"
  and be: "x $ 0 = False \<and> x $ 1 = False \<and> x $ 2 = False"
  shows "ceros_of_boolean_input x = {0,1,2}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_3_cases by auto

lemma fft_3: assumes dx: "dim_vec x = 3"
  and be: "x $ 0 = False \<and> x $ 1 = False \<and> x $ 2 = True"
  shows "ceros_of_boolean_input x = {0,1}"
  using dx be unfolding ceros_of_boolean_input_def
  using less_3_cases by auto

lemma ftf_3: assumes dx: "dim_vec x = 3"
  and be: "x $ 0 = False \<and> x $ 1 = True \<and> x $ 2 = False"
  shows "ceros_of_boolean_input x = {0,2}"
  using dx be unfolding ceros_of_boolean_input_def
  using less_3_cases by fastforce

lemma ftt_3: assumes dx: "dim_vec x = 3"
  and be: "x $ 0 = False \<and> x $ 1 = True \<and> x $ 2 = True"
  shows "ceros_of_boolean_input x = {0}"
  using dx be unfolding ceros_of_boolean_input_def
  using less_3_cases by auto

lemma tff_3: assumes dx: "dim_vec x = 3"
  and be: "x $ 0 = True \<and> x $ 1 = False \<and> x $ 2 = False"
  shows "ceros_of_boolean_input x = {1,2}"
  using dx be unfolding ceros_of_boolean_input_def
  using less_3_cases by auto

lemma tft_3: assumes dx: "dim_vec x = 3"
  and be: "x $ 0 = True \<and> x $ 1 = False \<and> x $ 2 = True"
  shows "ceros_of_boolean_input x = {1}"
  using dx be unfolding ceros_of_boolean_input_def
  using less_3_cases by auto

lemma ttf_3: assumes dx: "dim_vec x = 3"
  and be: "x $ 0 = True \<and> x $ 1 = True \<and> x $ 2 = False"
  shows "ceros_of_boolean_input x = {2}"
  using dx be unfolding ceros_of_boolean_input_def
  using less_3_cases by fastforce

lemma ttt_3: assumes dx: "dim_vec x = 3"
  and be: "x $ 0 = True \<and> x $ 1 = True \<and> x $ 2 = True"
  shows "ceros_of_boolean_input x = {}"
  using dx be unfolding ceros_of_boolean_input_def
  using less_3_cases by auto

lemma
  assumes dx: "dim_vec x = 3"
  shows "ceros_of_boolean_input x \<in> {{},{0},{1},{2},{0,1},{0,2},{1,2},{0,1,2}}"
  using dim_vec_3_cases [OF ]
  using fff_3 [OF dx] fft_3 [OF dx] ftf_3 [OF dx] ftt_3 [OF dx]
  using tff_3 [OF dx] tft_3 [OF dx] ttf_3 [OF dx] ttt_3 [OF dx]
  by (smt (z3) insertCI)

text\<open>Vectors of dimension $4$.\<close>

lemma less_4_cases:
  assumes n: "n < 4"
  shows "n = 0 \<or> n = 1 \<or> n = 2 \<or> n = (3::nat)"
  using n by linarith

lemma
  dim_vec_4_cases:
  assumes dx: "dim_vec x = 4"
  shows "(x $ 0 = x $ 1 = x $ 2 = x $ 3 = False) \<or> (x $ 0 = x $ 1 = x $ 2 = False \<and> x $ 3 = True)
       \<or> (x $ 0 = x $ 1 = x $ 3 = False \<and> x $ 2 = True) \<or> (x $ 0 = x $ 1 = False \<and> x $ 2 = x $ 3 = True)
       \<or> (x $ 0 = x $ 2 = x $ 3 = False \<and> x $ 1 = True) \<or> (x $ 0 = x $ 2 = False \<and> x $ 1 = x $ 3 = True)
       \<or> (x $ 0 = x $ 3 = False \<and> x $ 1 = x $ 2 = True) \<or> (x $ 0 = False \<and> x $ 1 = x $ 2 = x $ 3 = True)
       \<or> (x $ 0 = True \<and> x $ 1 = x $ 2 = x $ 3 = False) \<or> (x $ 0 = x $ 3 = True \<and> x $ 1 = x $ 2 = False)
       \<or> (x $ 0 = x $ 2 = True \<and> x $ 1 = x $ 3 = False) \<or> (x $ 0 = x $ 2 = x $ 3 = True \<and> x $ 1 = False)
       \<or> (x $ 0 = x $ 1 = True \<and> x $ 2 = x $ 3 = False) \<or> (x $ 0 = x $ 1 = x $ 3 = True \<and> x $ 2 = False)
       \<or> (x $ 0 = x $ 1 = x $ 2 = True \<and> x $ 3 = False) \<or> (x $ 0 = x $ 1 = x $ 2 = x $ 3 = True)"
  by blast

lemma ffff_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = False \<and> x $ 1 = False \<and> x $ 2 = False \<and> x $ 3 = False"
  shows "ceros_of_boolean_input x = {0,1,2,3}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma ffft_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = False \<and> x $ 1 = False \<and> x $ 2 = False \<and> x $ 3 = True"
  shows "ceros_of_boolean_input x = {0,1,2}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma fftf_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = False \<and> x $ 1 = False \<and> x $ 2 = True \<and> x $ 3 = False"
  shows "ceros_of_boolean_input x = {0,1,3}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma fftt_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = False \<and> x $ 1 = False \<and> x $ 2 = True \<and> x $ 3 = True"
  shows "ceros_of_boolean_input x = {0,1}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma ftff_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = False \<and> x $ 1 = True \<and> x $ 2 = False \<and> x $ 3 = False"
  shows "ceros_of_boolean_input x = {0,2,3}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma ftft_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = False \<and> x $ 1 = True \<and> x $ 2 = False \<and> x $ 3 = True"
  shows "ceros_of_boolean_input x = {0,2}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma fttf_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = False \<and> x $ 1 = True \<and> x $ 2 = True \<and> x $ 3 = False"
  shows "ceros_of_boolean_input x = {0,3}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma fttt_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = False \<and> x $ 1 = True \<and> x $ 2 = True \<and> x $ 3 = True"
  shows "ceros_of_boolean_input x = {0}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma tfff_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = True \<and> x $ 1 = False \<and> x $ 2 = False \<and> x $ 3 = False"
  shows "ceros_of_boolean_input x = {1,2,3}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma tfft_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = True \<and> x $ 1 = False \<and> x $ 2 = False \<and> x $ 3 = True"
  shows "ceros_of_boolean_input x = {1,2}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma tftf_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = True \<and> x $ 1 = False \<and> x $ 2 = True \<and> x $ 3 = False"
  shows "ceros_of_boolean_input x = {1,3}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma tftt_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = True \<and> x $ 1 = False \<and> x $ 2 = True \<and> x $ 3 = True"
  shows "ceros_of_boolean_input x = {1}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma ttff_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = True \<and> x $ 1 = True \<and> x $ 2 = False \<and> x $ 3 = False"
  shows "ceros_of_boolean_input x = {2,3}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma ttft_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = True \<and> x $ 1 = True \<and> x $ 2 = False \<and> x $ 3 = True"
  shows "ceros_of_boolean_input x = {2}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma tttf_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = True \<and> x $ 1 = True \<and> x $ 2 = True \<and> x $ 3 = False"
  shows "ceros_of_boolean_input x = {3}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma tttt_4: assumes dx: "dim_vec x = 4"
  and be: "x $ 0 = True \<and> x $ 1 = True \<and> x $ 2 = True \<and> x $ 3 = True"
  shows "ceros_of_boolean_input x = {}"
  using dx be
  unfolding ceros_of_boolean_input_def
  using less_4_cases by auto

lemma
  ceros_of_boolean_input_set:
  assumes dx: "dim_vec x = 4"
  shows "ceros_of_boolean_input x \<in> {{},{0},{1},{2},{3},{0,1},{0,2},{0,3},{1,2},{1,3},{2,3},
    {0,1,2},{0,1,3},{0,2,3},{1,2,3},{0,1,2,3}}"
  using dim_vec_4_cases [OF ]
  using ffff_4 [OF dx] ffft_4 [OF dx] fftf_4 [OF dx] fftt_4 [OF dx]
  using ftff_4 [OF dx] ftft_4 [OF dx] fttf_4 [OF dx] fttt_4 [OF dx]
  using tfff_4 [OF dx] tfft_4 [OF dx] tftf_4 [OF dx] tftt_4 [OF dx]
  using ttff_4 [OF dx] ttft_4 [OF dx] tttf_4 [OF dx] tttt_4 [OF dx]
  by (smt (z3) insertCI)

context simplicial_complex
begin

text\<open>The simplicial complex induced by the monotone Boolean function
  @{const bool_fun_threshold_2_3} has the following explicit expression.\<close>

lemma
  simplicial_complex_induced_by_monotone_boolean_function_4_bool_fun_threshold_2_3:
  shows "{{},{0},{1},{2},{3},{0,1},{0,2},{0,3},{1,2},{1,3},{2,3}}
    = simplicial_complex_induced_by_monotone_boolean_function 4 bool_fun_threshold_2_3"
  (is "{{},?a,?b,?c,?d,?e,?f,?g,?h,?i,?j} = _")
proof (rule)
  show "{{},?a,?b,?c,?d,?e,?f,?g,?h,?i,?j}
    \<subseteq> simplicial_complex_induced_by_monotone_boolean_function 4 bool_fun_threshold_2_3"
    by (simp add:
        empty_set_in_simplicial_complex_induced
        singleton_in_simplicial_complex_induced pair_in_simplicial_complex_induced)+
  show "simplicial_complex_induced_by_monotone_boolean_function 4 bool_fun_threshold_2_3
    \<subseteq> {{},?a,?b,?c,?d,?e,?f,?g,?h,?i,?j}"
      unfolding simplicial_complex_induced_by_monotone_boolean_function_def
      unfolding bool_fun_threshold_2_3_def
    proof
    fix y::"nat set"
    assume y: "y \<in> {y. \<exists>x. dim_vec x = 4 \<and> (if 2 \<le> count_true x then True else False) \<and> ceros_of_boolean_input x = y}"
      then obtain x::"bool vec"
        where ct_ge_2: "(if 2 \<le> count_true x then True else False)"
          and cx: "ceros_of_boolean_input x = y" and dx: "dim_vec x = 4" by auto
      have "count_true x + card (ceros_of_boolean_input x) = dim_vec x"
       using card_ceros_count_UNIV [of x] by simp
      hence "card (ceros_of_boolean_input x) \<le> 2"
        using ct_ge_2
        using card_boolean_function
        using dx by presburger
      hence card_le: "card y \<le> 2" using cx by simp
      have "y \<in> {{},?a,?b,?c,?d,?e,?f,?g,?h,?i,?j}"
      proof (rule ccontr)
        assume "y \<notin> {{},?a,?b,?c,?d,?e,?f,?g,?h,?i,?j}"
        then have y_nin: "y \<notin> set [{},?a,?b,?c,?d,?e,?f,?g,?h,?i,?j]" by simp
        have "y \<in> set [{0,1,2},{0,1,3},{0,2,3},{1,2,3},{0,1,2,3}]"
          using ceros_of_boolean_input_set [OF dx] y_nin
          unfolding cx by simp
        hence "card y \<ge> 3" by auto
        thus False using card_le by simp
      qed
      then show "y \<in> {{},?a,?b,?c,?d,?e,?f,?g,?h,?i,?j}"
      by simp
  qed
qed

end

end